	.ENABL	LC
	.Title	DV - Virtual disk handler
	.Ident	/800103/
;
;
;	This handler provides a virtual disk capability
;	for IAS.  The handler works by using the virtual
;	blocks of a file as physical blocks of a disk.
;	The filename to use is requested and the file is
;	opened when the handler is initialized.
;
;	The virtual disk handler properties are:
;	  It is synchronous.
;	  It services a single unit.
;
;	The author is:
;
;	Shack Toms
;	Technical Advisors, Inc.
;	4455 Fletcher
;	Wayne, Michigan 48184
;
;	Version 01		January 1980
;

	.Sbttl	Operating principles
;
;	The virtual disk handler uses the virtual blocks of
;	an ordinary disk file as the physical blocks of an
;	imaginary disk. All of the normal disk qio's will work
;	on the virtual disk, except for diagnostic functions.
;	In particular INITIALIZE, MOUNT, CREATE/DIRECTORY, etc.
;	will all work on the virtual disk. Tasks, both overlaid
;	and unoverlaid, will run from it. Note that while task
;	image files files must be logically contiguous on the
;	virtual disk, they may be non-contiguous on the "real"
;	disk. This may happen if the file the virtual disk was
;	given at initialization (MCR LOA DV) was non-contiguous.
;
;	The operation is very simple. When the handler is loaded,
;	it requests a filename. The filename is entered with
;	options. The file is opened and the handler enters the
;	idle loop. All ACP functions are handled by ..disp and
;	by the ACP task. Thus, the handler really only does
;	anything on express requests, write logical, read logical,
;	attach, detach, and set characteristics. All of these
;	except read and write logical are handled as usual for
;	synchronous handlers. For read and write logical the handler
;	maps the user buffer with apr3 and sends a qio to the
;	"real" disk handler to do a read virtual of the corresponding
;	blocks in the virtual disk file. If the transfer is
;	larger than 4k words, it is handled in several chunks.
;
;	All operations are synchronous. There would be little
;	point in doing otherwise since nearly all real disk
;	handlers use FIFO dequeueing of requests from a single
;	task.
;
;	When the fake disk filename is requested the user may
;	also enter several options.
;		/CReate		Create new fake disk file
;				Default: /NOCR
;
;		/SUpercede	Supercede existing fake disk file
;				Default: /NOSU
	.Page
;
;		/EMulate	Emulate a known real disk
;				Example: /EM:RL02
;				This switch exists primarily for
;				DSC. DSC does not have access to
;				the volume size information in the
;				PUD. It therefore uses the information
;				in characteristics word 2 to obtain
;				the device type and from this it infers
;				the volume size. /EMulate sets up
;				U.C2 in the pud, and establishes
;				an appropriate default for volume size.
;				For an RL02 this would set U.C2 in the
;				PUD to 25160(8), and set the default size
;				to 20480(10).
;				Default: For new files the default is
;					 /EM:Unknown (Which DSC doesn't
;					 recognize.) For existing fake
;					 disk files, the value stored
;					 in the file header is used.
;
;		/SIze		Specify volume size
;				Default: Depends on /EM, for /EM:UNKNOWN
;					 the default is 20000. blocks.
;					 For existing fake disk files
;					 the value stored in the file
;					 header is used.
;
;		/EXtendsize	Specify increment by which to extend file.
;				Note: A positive extendsize means to use
;				a contiguous increment, a negative one
;				means to use a non-contiguous increment.
;				Default: Minimum of Size/8. and 1000.
;					 blocks. For existing files the
;					 value stored in the file header
;					 is used.
	.Page
;
;		/BAd		Simulate badblocked disk
;				This switch is primarily here for FCP.
;				When F11ACP dynamically extends the index
;				file it does not initialize the newly
;				created headers. When a file is created
;				which uses one of these headers FCP
;				tries to read the header so it can
;				establish a file sequence number. This
;				causes two problems. First the data
;				in the file header may happen to
;				checksum properly (it may be a file
;				header from the disk in a former life
;				before being reinitialized by DSC, say.)
;				In this case nothing much happens
;				except that the initial file sequence
;				number will not be 1. This possibility
;				is present for all disks real and
;				virtual. Another possibility, which
;				exists only for virtual disks is
;				that the file header will be after
;				end of file in the fake disk file.
;				In this case the handler can do one
;				of two things. With /NOBA the handler
;				returns a fatal hardware error, FCP
;				then returns a file processor read error.
;				With /BAd, the handler writes a
;				badblocks data pattern and says it read
;				successfully. When a request is made
;				to read the last block in the volume
;				/BAd causes the handler to simulate
;				the reading of a bad block data file
;				which shows no bad blocks.
;				Default: /BA
;
;		/LIst		Type /em,/si,/ex settings
;				Default: /NOLI
	.Page
;
;		/REset		Reset /em,/si,/ex info in file
;				When a fake disk file is created using
;				/CR or /SU the handler will write
;				the /em,/si,/ex settings in an unused
;				part of the file header before closing
;				the file. Reset causes this to be
;				written even with /NOCR/NOSU.
;				Default: /NORE
;
;		/DEbug		Spew forth lots of info while running
;				This causes request node info to
;				be listed on ti0: after dequeueing any
;				request and after dispatching to read
;				or write logical. It may print more
;				or less info as this program is updated.
;				Default: /NODE
;
;		/WRitecheck	Use read after write check (unimplemented)
;		/WC		Same as writecheck
;	

	.Sbttl	Macro definitions

	.Mcall	Exit$s,wtlo$s,.inh0,.enb0,qiow$,alun$,dir$,Wtse$,qiow$s
	.Mcall	Fdbdf$,fdrc$A,fdbk$A,fdop$A,nmblk$,Fsrsz$,Fdbk$R
	.Mcall	Fdat$R
	.Mcall	Finit$,open$,close$,read$,write$,wait$
	.Mcall	Csi$,Csi$1,Csi$2,Csi$SW,Csi$SV,Csi$ND
;
;	DE	-- Dispatch table entry definition
;
;	This macro adds a function to the dispatch table
;	It defines the symbol maxfn to be the maximum function
;	code covered by the table.
;
Maxfn	= -1					; Required for DE
;
.Macro	DE	Worda, Disp
	Maxfn = Maxfn+400
	$$$ = 0
	.Irp	$$,<Worda>
	$$$$ = 0
	.Iif idn <$$>, <DCF>, $$$$ = 10		; DCF functions
	.Iif idn <$$>, <ATT>, $$$$ = 20		; Attachable
	.Iif idn <$$>, <NOUNL>, $$$$ = 40	; Not unloading
	.Iif idn <$$>, <F11>, $$$$ = 100	; Files 11
	.Iif idn <$$>, <MOU>, $$$$ = 200	; Mounted
	.Iif idn <$$>, <R>, $$$$ = 400		; Read access
	.Iif idn <$$>, <W>, $$$$ = 1000		; Write access
	.Iif idn <$$>, <E>, $$$$ = 2000		; Extend access
	.Iif idn <$$>, <D>, $$$$ = 4000		; Delete access
	.Iif idn <$$>, <X0>, $$$$ = 20000	; Express bit 0
	.Iif idn <$$>, <SF0>, $$$$ = 40000	; Subfunction 0
	.Iif idn <$$>, <SEND>, $$$$ = 100000	; Send/request
	.Iif idn <$$>, <ACP>, $$$$ = 160300	; Normal stuff for ACP
	.Iif eq	$$$$,		.Error	;Bad dispatch attribute ''$$''
	$$$ = $$$!$$$$
	.Endm
	.Word	$$$
	.If nb	disp
	.Word	disp
	.Iff
	.Iif eq	$$$&100000	.Error	;No dispatch address given
	.Word	0
	.Endc
.Endm	DE
	.Page
.Macro	News	string,parm,cont
	.Enabl	lsb
	.Even
	.Word	1$
	.If b	<parm>
	.Word	2$
	.Iff
	.Word	Parm
	.Endc
1$:
	.Iif	nb,<cont>	.Byte	cont
	.Asciz	string
	.Even
2$:	.Dsabl	lsb
.Endm	News

.Macro	Blab	mesage
	mov	mesage,-(sp)
	call	domsg
	rol	(sp)+
.Endm	Blab

.Macro	push	stuff
	.irp	$$,<stuff>
	mov	$$,-(sp)
	.endm
.Endm	push

.Macro	pop	stuff
	.irp	$$,<stuff>
	mov	(sp)+,$$
	.endm
.Endm	pop

.Macro	EM	Device,c2,szh,szl
	.nchr	$$,<Device>	; number of bytes in ascii
	$$ = $$+2/3*2		; number of bytes in rad50
	.If	ne,$$
	.rad50	/Device/
	.If	gt,$$-4
	.=.+4-$$
	.Iff
	.rept	4-$$
	.byte	0
	.endm
	.endc
	.word	c2,szh,szl
	.iff
	.word	0
	.endc
.Endm	EM
	.Page
	.Sbttl	Equates

Bsize	=	128.		; Buffer size for terminal i/o
Mesbsz	=	256.		; Buffer size for news formatting
EMtsz	=	10.		; Size of EM table entry

Evnrm	=	1		; event flag mask for normal requests
Ennrm	=	1		; event flag # for normal requests
Evexp	=	2		; event flag mask for express requests
Enexp	=	2		; event flag # for express requests
Evall	=	3		; event flag mask for any request
Enxfr	=	4		; event flag # for transfer flag

UsrDE	=	1		; Switch mask for DEbug
UsrSI	=	2		; Switch mask for SIze
UsrCR	=	4		; Switch mask for CReate
UsrSU	=	10		; Switch mask for SUpercede
UsrEX	=	20		; Switch mask for EXtendsize
UsrLI	=	40		; Switch mask for LIst
UsrRE	=	100		; Switch mask for REset
UsrWC	=	200		; Switch mask for Write Check (Unimplemented)
UsrBA	=	400		; Switch mask for BAd (*Set on /NOBA*)
UsrEM	=	1000		; Switch mask for EMulate
	.Page
	.Sbttl	Handler tables

	.Psect	Data,d

Device::
	.Ascii	/DV/

Uit::
	.Word	Dispat,1,0,0,0
UitA:	.Word	0		; Pud pointer
UitB:	.Word	0		; Normal node
UitC:	.Word	0		; Express node

Unlflg:	.Word	0		; Unload flag
Xfred:	.Word	0		; Count of bytes transferred
Carry:	.Blkw	1		; Place to save carry
Option::.Blkw	1		; User option flags

EMtbl:
	EM	Unknown,0,0,20000.	; Don't know
	EM	RF1,000400,0,1024.	; 1 platter RF
	EM	RF2,020400,0,2048.	; 2 platter RF
	EM	RF3,040400,0,3072.	; 3 platter RF
	EM	RF4,060400,0,4096.	; 4 platter RF
	EM	RF5,100400,0,5120.	; 5 platter RF
	EM	RF6,120400,0,6144.	; 6 platter RF
	EM	RF7,140400,0,7168.	; 7 platter RF
	EM	RF8,160400,0,8192.	; 8 platter RF
	EM	RK03,021060,0,4800.
	EM	RK05,001060,0,4800.
	EM	RK05F,41020,0,4800.
	EM	RP02,41460,0,40000.
	EM	RP03A,101460,1,32400
	EM	RP03B,141460,1,32400
	EM	RP04,002060,2,117426
	EM	RP05,022060,2,117426
	EM	RP06,042060,5,031276
	EM	RS03,002400,0,1024.
	EM	RS04,022400,0,2048.
	EM	RK06,003160,0,27126.
	EM	RK07,023160,0,53790.
	EM	RX01,002430,0,512.
	EM	RM03,004560,2,1140
	EM	RL01,005160,0,10240.
	EM	RL02,025160,0,20480.
	EM				; End of table
	.Page
	.Sbttl	Dispatch table

Dispat::
	.Word	ersre		; Send/Request failure routine
	.Word	More		; Send/Request success routine

; Bits are: DCF,ATT,NOUNL,F11,MOU,R,W,E,D,X0,SF0,SEND (Defined in DE)
;	    ACP is equivalent to MOU,F11,SEND,SF0,X0

	DE	<>			,Erifc	;00 - Express requests
	DE	<DCF,MOU,X0,W>		,Write	;01 - Write logical, check
	DE	<DCF,MOU,SF0,X0,R>	,Read	;02 - Read logical
	DE	<ATT,SF0,X0>		,Attach	;03 - Attach
	DE	<ATT,SF0,X0>		,Detach	;04 - Detach
	DE	<X0>			,Setcha	;05 - Set/sense char
	DE	<>			,Erifc	;06 - Device control
	DE	<>			,Erifc	;07 - More device control
	DE	<MOU,DCF,X0>		,Erifc	;10 - Diagnostics
	DE	<ACP,NOUNL>			;11 - Find
	DE	<ACP,W>				;12 - Unlock block
	DE	<ACP,NOUNL>			;13 - Remove
	DE	<ACP,NOUNL>			;14 - Enter
	DE	<ACP,NOUNL,R>			;15 - Access for read
	DE	<ACP,NOUNL,R,W>			;16 - Access fpr write
	DE	<ACP,NOUNL,R,W,E>		;17 - Access for extend
	DE	<ACP>				;20 - Deaccess
	DE	<ACP,R>				;21 - Read virtual
	DE	<ACP,W>				;22 - Write virtual
	DE	<ACP,NOUNL,E>			;23 - Extend
	DE	<ACP,NOUNL,W>			;24 - Create
	DE	<ACP,D>				;25 - Delete
	DE	<ACP,R>				;26 - Read attributes
	DE	<ACP,W>				;27 - Write attributes
	DE	<MOU,F11,SEND,X0>		;30 - Mount volume

	.Print	Maxfn				;Maximum function code
	.Page
	.Sbttl	File system data

	Fsrsz$	0,,Data

	CSI$

Csiblk::
	.Blkw	C.size		; Define CSI data block

Swtbl:
	Csi$SW	SIZE,UsrSI,,,NEG,SIsva,;LONG
	Csi$SW	CREATE,UsrCR,,,NEG,,;LONG
	Csi$SW	SUPERCEDE,UsrSU,,,NEG,,;LONG
	Csi$SW	DEBUG,UsrDE,,,NEG,,;LONG
	Csi$SW	EXTENDSIZE,UsrEX,,,,EXsva,;LONG
	Csi$SW	LIST,UsrLI,,,NEG,,;LONG
	Csi$SW	RESET,UsrRE,,,NEG,,;LONG
	Csi$SW	WRITECHECK,UsrWC,,,NEG,,;LONG
	Csi$SW	WC,UsrWC,,,NEG
	Csi$SW	BAD,UsrBA,,CLEAR,NEG,,;LONG
	Csi$SW	EMULATE,UsrEM,,,NEG,EMsva,;LONG
	Csi$ND

	Csi$SV	ASCII,SIstr,12.,SIsva
	Csi$SV	DECIMAL,EXval,2,EXsva
	Csi$SV	ASCII,EMstr,6,EMsva
	Csi$ND

Dskfdb::			; Define FDB for virtual disk
	Fdbdf$
	Fdrc$A	Fd.rwm		; Use Read/Write mode
	Fdbk$A	,,,Enxfr,Iostat
	Fdop$A	1,Csiblk+c.dsds,Dfnb,Fo.upd

Dfnb:
	Nmblk$	VIRTUAL,DSK,0,SY,0

Attrbk:	.Blkw	11.		; Buffer for Read/Write Attributes

Volszh:	.Blkw	1		; High volume size
Volszl:	.Blkw	1		; Low volume size

Atvols:	.Word	volszh
Exval:	.Blkw	1		; Extend parameter (must follow atvols)
Pudc2:	.Blkw	1		; Pud U.C2 word (must follow EXval)

Buffer:	.Blkb	Bsize

Mesptr:	.Blkw	1		; pointer into mesbuf
Mesbuf:	.Blkb	Mesbsz

SIstr:	.Blkb	12.		; Size parameter string
EMstr:	.Blkb	6		; Emulate parameter string
EMr50:	.Blkw	2		; Above in rad50

Iostat:	.Blkw	2

Curfun:	.Blkw	1		; Current transfer direction (0/1 for r/w)

Vlbn:				; Starting lbl of xfer on virtual disk
Vlbnh:	.Blkw	1		; High
Vlbnl:	.Blkw	1		; Low

Ratblk:	.Byte	-4,22.		; Read attributes block
	.Word	Attrbk,0	; Address of buffer, terminator

Watblk:	.Byte	4,22.		; Write attributes block
	.Word	Attrbk,0	; Address of buffer, terminator
	.Page
	.Sbttl	DPB's

Asgti2:
	Alun$	2,TI,0

Getdsk:
	Qiow$	IO.RPR,2,Enxfr,,Iostat,,<Buffer,Bsize,0,Prompt,Psize>

Getatr:
	Qiow$	Io.rat,1,Enxfr,,Iostat,,<,Ratblk>

Putatr:
	Qiow$	Io.wat,1,Enxfr,,Iostat,,<,Watblk>

Prompt:	.Ascii	<12>/Fake disk file? /
Psize=.-prompt
	.Even


	.Sbttl	Initialization
;
;	The initialization code does the following:
;
;	Declare residency
;	Discover and open disk file
;	Process static options
;	Fall through to idle code
;
;

	.Psect	code,i

Init::
	mov	#uit,r0		; address of uit
	mov	device,r2	; device type
	mov	#uf.rh!uf.tl,r3	; declare residency and enable task loading
	call	@#..dsut	; do it
	bcs	exit99		; go away if nok
	finit$			; initialize file system
	mov	#mesbuf,mesptr	; initialize message system
	call	getcml		; get a command line
	bcs	exit88		; exit on error
	call	parse		; parse command line
	bcs	exit88		; j on error
	call	open		; open fake disk file
	bcs	exit88		; j on error
	call	setsiz		; set up various sizes
	call	reset		; reset values in header 
	call	setpud		; set up pud
				; fall through to idle loop
	.Page
	.Sbttl	Idle Loop
;
;
;	Idle Loop
;
;
;
Idle:
	tst	unlflg		; are we unloading?
	bne	exit00		; j if so
	wtlo$s	0,#evall	; wait for something to happen
More:
	mov	#uit,r0		; make sure we have this
	mov	.crtsk,r3	; get my atl address
	mov	a.ef(r3),r5	; get my event flags
	bit	#evexp,r5	; was it an express request?
	beq	1$		; j if no
	call	@#..dqre	; dq it
	bcc	express		; j if ok
1$:	bit	#evnrm,r5	; was it a normal request?
	beq	idle		; no request, go to sleep
	call	@#..dqrn
	bcc	normal		; do normal request
	br	more		; go for more
	.Page
	.Sbttl	Handler exit Code
;
;
;	Handler exit Code
;
;
Exit00:
	close$	#dskfdb		; close disk
Exit88:
	mov	#uit,r0
	call	@#..dnrc	; declare non resident
Exit99:
	exit$s			; go away
	br	exit99		; for sure	
	.Page
	.Sbttl	Request Complete Processing
;
;
;	Requst Complete Processing
;
;	various routines of form erxxx to exit with error ie.xxx
;
;	done  - successful operation
;	okxfr - transfer complete (# bytes in r4)
;
Erblk:				; Invalid logical block number
	mov	#ie.blk,r3
	br	goway

Erfhe:				; Can't read/write fake disk file
	mov	#ie.fhe,r3
	br	goway

Erdaa:				; Device already attached
	mov	#ie.daa,r3
	br	goway

Erdna:				; Device not attached
	mov	#ie.dna,r3
	br	goway

Erpri:				; Privelege violation
	mov	#ie.pri,r3
	br	goway

Ersre:				; Send recieve error
	mov	#ie.sre,r3
	br	goway

Erifc:				; Invalid function code
	mov	#ie.ifc,r3
	br	goway

Erspc:				; Illegal user buffer
	mov	#ie.spc,r3
	br	goway

Done:				; Non data transfer request complete
	mov	#is.suc,r3
	br	goway

Okxfr:				; Data transfer request complete
	mov	#is.suc,r3
	br	goway2

Goway:
	clr	r4
Goway2:	clr	r2
	call	@#..iodn
	br	more
	.Page
	.Sbttl	Express Requests
;
;
;	Express requests
;
;
Expres:
	call	debug		; go tell about irq node
	clr	uitc		; clear rna for next time
	mov	r.fc(r1),r5
	cmp	r5,#io.kil
	beq	kill
	cmp	r5,#io.rdn
	beq	rdown
	cmp	r5,#io.unl
	beq	unload
	br	erifc
;
;
;	Kill all requests
;
;
Kill:	mov	r.at(r1),r.pb(r1) ; get atl address
	mov	r.td(r1),r.pb+2(r1) ; get std address
	mov	(r2),r.pb+4(r1) ; set up pud entry
	br	flush		; go flush queues
;
;
;	Rundown
;
;
Rdown:	tst	r.at(r1)	; user request?
	bne	erifc		; j if so, must be from exec
;
;
;	Flush queues
;
Flush:
	call	@#..flsh	; flush i/o queue
	call	@#..fifl	; flush file system
	br	done		; that's it
;
;
;	Unload
;
;
Unload:	tst	r.at(r1)	; user request?
	bne	erifc		; j if so, illegal for user
	inc	unlflg		; set up for exit
	br	done		; go for more
	.Page
	.Sbttl	Normal Requests
;
;
;	Normal request
;
;
Normal:
	call	debug		; tell about irq node
	clr	uitb		; clear this for dqrn
	mov	r.fc(r1),r5	; get function code
	cmp	r5,#maxfn	; is it in range
	bhi	erifc		; illegal if no
	bit	#iq.umd,r5	; is it diagnostic??
	bne	erifc		; not allowed
	call	@#..vacc	; validate access
	bcs	erpri		; j if priv violation
	jmp	@#..disp	; request ok so dispatch it
	.Page
	.Sbttl	Attach/Detach/Set Characteristics
;
;
;	Attach
;
;
Attach:
	call	@#..atun	; Try to attach unit
	bcs	erdaa		; j if no good
	br	done		; j for joy
;
;
;	Detach
;
;
Detach:
	call	@#..dtun	; Try to detach unit
	bcs	erdna		; j if no good
	br	done		; success
;
;
;	Setcha
;
;
Setcha:
	call	setpud		; fix up pud
	br	done		; succeed
	.Page
	.Sbttl	Write
;
;
;	Write
;
;
Write:
	call	debug		; see if s/r changed it
	mov	r.fc(r1),r5	; get function code
	bic	#io.wlc,r5	; Write logical or writecheck?
	bne	erifc		; illegal if no
	inc	r5		; show write direction
	br	iocomm		; go do common things
	.Page
	.Sbttl	Read
;
;
;	Read
;
;
Read:
	call	debug		; see if s/r changed it
	movb	r.fc(r1),r5	; any funny stuff?
	bne	erifc		; illegal if so
;	clr	r5		; show read
;	br	iocomm
	.Page
	.Sbttl	Iocomm - Common IO proc
;
;
;	Iocomm
;
;	Common transfer processing
;
;	Inputs
;	   r1		rna address
;	   r5		0/1 for read/write
;
Iocomm:
	mov	r5,curfun	; save direction
	call	vdate		; validate transfer addr in r4,r5
	bcs	erspc		; j on error
	call	blkchk		; check out disk address
	bcs	erblk		; j if no good
	mov	r.pb+6(r1),vlbnh; starting disk address (high)
	mov	r.pb+10(r1),vlbnl;starting disk address (low)
	add	#1,vlbnl	; Virtual block number is "Physical" + 1
	adc	vlbnh		; ....
	clr	xfred		; show no bytes transferred
	push	r1		; save rna, gets trashed by virtual addr
10$:	call	mapxfr		; map transfer, r1 is virtual address
	call	doxfr		; transfer some bytes
	ror	-(sp)		; save carry
	add	r2,xfred	; show bytes transferred
	add	r2,r5		; increment physical address
	adc	r4		; ....
	mov	r2,r0		; copy of byte count
	call	@#.calbl	; turn into block count
	add	r0,vlbnl	; add to block number
	adc	vlbnh		; ....
	rol	(sp)+		; get back carry
	bcc	20$		; j if transfer ok
	call	dbgxfr		; else blab about it
	pop	r1		; recover rna
	jmp	erfhe		; show bad transfer as hardware error
20$:	sub	r2,r3		; are we done?
	bne	10$		; j if no
	mov	xfred,r4	; yes, get byte count
	pop	r1		; recover rna
	jmp	okxfr		; and go away
	.Page
	.Sbttl	Vdate -- Validate transfer address
;
;	Vdate
;
;	R1 must contain the irq node address
;	R5 must contain 0/1 for read/write
;
;	Returns physical address in r4,r5
;	Returns byte count in r3
;
Vdate:
	mov	r.pb(r1),r2	; get buffer address
	mov	r.pb+2(r1),r3	; and byte count
	beq	80$		; disallow zero byte count
	call	@#..vxfr	; validate transfer
	bcs	80$		; j if bad buffer
	ash	#-4,r4		; get high order bits right
	bit	#1,r5		; odd address?
	bne	80$		; error if so
	bit	#1,r3		; odd byte count?
	bne	80$		; error if so
	clc			; show success
	br	99$		; and go
80$:	sec			; show error
99$:	return
	.Page
	.Sbttl	Blkchk - checks disk address
;
;
;	Inputs
;	  r1 - request node address
;	  r3 - Transfer size in bytes (must be <> 0)
;	  uita - address of pud
;
;	r0 is clobbered
;
Blkchk:
	jsr	r5,$savrg	; save r3-r5
	mov	r.pb+6(r1),r4	; starting block number
	mov	r.pb+10(r1),r5	; ....
	mov	r3,r0		; byte count
	call	@#.calbl	; compute # of blocks
	add	r0,r5		; ending block number + 1
	adc	r4		; ....
	mov	uita,r3		; get pud address
1$:	cmp	u.lbh(r3),r4	; ok?
	bne	2$		; j if we know already
	cmp	u.lbn(r3),r5	; ok?
2$:	return			; carry is set if u.lbn is lower than
				; ending block+1
	.Page
	.Sbttl	Mapxfr -- map apr3 and calculate offset
;
;	Mapxfr
;
;	Input
;	  r4,r5	Physical core address of transfer
;	  r3	Byte count
;
;	Output
;	  r1	Transfer virtual address
;	  r2	Transfer length
;
Mapxfr:
	jsr	r5,$savrg	; save r3-r5
	mov	#77406,-(sp)	; get a large pdr
	ashc	#12,r4		; get par
	push	r4		; push it for spd3
	call	@#..spd3	; remap apr3 to user area
	cmp	(sp)+,(sp)+	; trash old mapping
	ash	#-12,r5		; get offset
	bic	#177700,r5	; and only offset
	mov	#20000,r2	; maximum transfer
	sub	r5,r2		; max transfer with offset
	bic	#511.,r2	; round down to nearest block
	cmp	r2,r3		; is this too much
	blos	1$		; j if no
	mov	r3,r2		; use actual byte count
1$:	add	#60000,r5	; apr3 offset
	mov	r5,r1		; R1 now has where transfer goes
	return			; R2 now has how big it is
	.Page
	.Sbttl	Doxfr -- Transfer data
;
;	Doxfr
;
;	Transfer data
;
;	Inputs:
;		r1	Virtual address of transfer
;		r2	Byte count to transfer
;		Vlbnh/l Virtual disk lbn of transfer
;		Curfun	0/1 for read/write
;
;	Outputs:
;		r2	number of bytes actually transferred
;		cc-c	set iff error during transfer
;
Doxfr:
	jsr	r5,$savrg	; save r3-r5
	Fdbk$R	#Dskfdb,r1,r2,#Vlbn	; Set up for transfer
	tst	curfun		; what sort of transfer
	bne	30$		; j if write
	Read$			; read blocks
	bcc	50$		; go wait if ok
	tstb	f.err+1(r0)	; i/o error?
	bne	20$		; j if no
	cmpb	#ie.eof,f.err(r0); end of file?
	bne	20$		; j if no
	bit	#UsrBA,option	; doing bad things?
	bne	20$		; j if no
	call	xfrbad		; emulate ...bad data
	br	99$		; end it all

20$:	sec			; show error
	br	90$		; exit

30$:	Write$			; write data to file
	bcs	90$		; j on error

50$:	Wait$			; Wait for directive
90$:	mov	Iostat+2,r2	; get byte count	
99$:	return
	.Page
	.Sbttl	Xfrbad -- Emulate reading ...bad data
;
;	Xfrbad
;
;	Input:
;	  r1	Virtual address of transfer
;	  r2	Number of bytes to transfer
;
;	Output:
;	  r2	Set to number of bytes transferred
;	  cc-c	Cleared
;	  r0,r1	Clobbered
;
Xfrbad:
	jsr	r5,$savrg	; save r3-r5
	mov	r2,r0		; copy byte count
	mov	r2,-(sp)	; twice
	asr	r2		; turn byte count into word count
	call	@#.calbl	; calculate  # of blocks
	mov	vlbnh,r4	; get copy of virtual address
	mov	vlbnl,r5	; ....
10$:	mov	uita,r3		; pud address
	cmp	vlbnh,u.lbh(r3)	; are we transferring last block?
	bne	30$		; j if no
	cmp	vlbnl,u.lbn(r3)	; check some more
	bne	30$		; j if no

				; last block
	dec	r2		; first word
	blt	60$		; j if done
	mov	#1401,(r1)+	; use 1-3 windows
	dec	r2		; second word
	blt	60$		; j if done
	mov	#146000,(r1)+	; zero words used in mapping
	mov	#253.,r3	; count of clear words
20$:	dec	r2		; can we do this word
	blt	60$		; j if no
	clr	(r1)+		; do it
	sob	r3,20$		; do all
	dec	r2		; one more word
	blt	60$		; j if no good
	mov	#147401,(r1)+	; checksum
	br	50$		;

30$:				; ordinary block
	mov	#128.,r3	; double word count
40$:	dec	r2		;
	blt	60$		;
	mov	#165555,(r1)+	; badblock data word
	dec	r2		;
	blt	60$		; another
	mov	#133333,(r1)+	;
	sob	r3,40$		; do as many as we can

50$:	add	#1,r5		; increment block pointer
	adc	r4		; ....
	sob	r0,10$		; j if not done
	dec	r2		; fake extra decrement
60$:	inc	r2		; adjust word count
	asl	r2		; make it a byte count
	sub	(sp)+,r2	; get negative of bytes transferred
	neg	r2		; true byte count
	clc			; show success
	return			; that's all
	.Page
	.Sbttl	Setpud -- Set up device stuff in pud
;
;	Input:
;		uita -- Pud address
;		Volszh/l -- 2 word volume size
;
Setpud:
	push	r0		; save a register
	mov	uita,r0		; get pud
	mov	#uc.mnt!uc.f11!uc.pse!uc.dir,u.c1(r0) ; char word 1
	mov	Pudc2,u.c2(r0)	; characteristics word 2
	mov	#512.,u.c4(r0)	; block size
	mov	volszh,u.lbh(r0); volume size
	mov	volszl,u.lbn(r0); ....
	pop	r0
	return

	.Sbttl	Getcml -- get our command line
;
;	Getcml
;
;	Getcml assigns our ti to lun 2
;	It then issues a read with prompt
;	If there is a command read error, a message is printed
;
;	CC-C is set iff an error occurs
;

	.Psect	code

Getcml:
	dir$	#asgti2		; assign ti0: to lun 2
	bcs	99$		; j on error, can't blab
	dir$	#getdsk		; get disk file name
	bcs	80$		; j on directive error
	tstb	iostat		; bad news?
	bge	99$		; j if no

	Blab	#mrderr		; read error
	sec			; show it
	br	99$

80$:	Blab	#mrdirf		; read directive failure

99$:	return

	.Psect	data

Mrderr:	News	</Fatal command read error %P -- bye./>,Iostat
Mrdirf:	News	</Fatal directive error in read (%D.) -- bye./>,0
	.Page
	.Sbttl	Parse -- Parse command line/analyse switches
;
;	Parse
;
;	Parses the command line
;	Evaluates the switches
;	Establishes defaults
;	Prints error messages
;	Sets cc-c on errror
;	Clobbers r0-r5
;

	.Psect	code

Parse:
	Csi$1	#csiblk,#buffer,iostat+2 ; parse string
	bcc	10$		; j if ok

	Blab	#Mbadfi		; else talk
	br	99$		; and exit

10$:
	Csi$2	,OUTPUT,#Swtbl	; analyse switches
	bcc	20$		; j if ok

	Blab	#Mbadsw		; else talk
	br	99$

20$:
	bitb	#cs.equ!cs.wld!cs.mor,c.stat(r0)
	beq	30$		; j if strange characters present

	Blab	#mfunny		; no funny stuff in command line, please
	sec			; show error
	br	99$

30$:
	mov	c.mkw1(r0),r1	; get user options
	mov	c.mkw2(r0),r2	; find negated options
	com	r2		; and
	bic	r2,r1		; clear them
	mov	r1,option	; put them away

	call	emuswi		; establish default size, c2
	bcs	99$		; j on error

	call	sizswi		; establish size
	bcs	99$

	call	extswi		; establish extendsize

99$:	return

	.Psect	data

Mbadfi:	News	</Fatal file specification error "%VA" -- bye./>,Csiblk+c.fild
Mbadsw:	News	</Fatal -- invalid switches, bye./>
Mfunny:	News	</Fatal funny stuff in command line, bye./>
	.Page
	.Sbttl	Emuswi -- Process emulate switch
;
;	Emuswi
;
;	Establishes volume size in r0/r1
;	Establishes characteristics word two in pudc2
;

	.Psect	code

Emuswi:
	bit	#UsrEM,option	; option taken?
	bne	10$		; j if no
	mov	#20000.,r1	; else establish default
	clr	r0		; ....
	clr	pudc2		; and u.c2 value
	br	99$		; and leave
10$:	mov	#Emstr+6,r0	; get address of string end
	mov	#6,r2		; maximum of 6 chars
13$:	bicb	#200,-(r0)	; clear junk if present
	cmpb	(r0),#<'A+40>	; compare char with lower case a
	blo	15$		; j if not lower case
	cmpb	(r0),#<'Z+40>	; compare char with lower case z
	bhi	15$		; j if not lower case
	bicb	#40,(r0)	; make lower case into upper case
15$:	sob	r2,13$		; do all
	mov	#Emr50,r3	; address of output
	clr	r1		; no dots allowed
	clr	2(r3)		; default 2nd half to zero
	call	$Cat5		; convert
	mov	r1,(r3)		; first half to rad50
	bcs	20$		; j if early termination
	clr	r1		; reset r1
	call	$Cat5		; convert 2nd half
	mov	r1,2(r3)	; and stash it
	bcc	25$		; j if full conversion
20$:	tstb	r2		; was termination on a null
	bne	40$		; j if not, print message
25$:	mov	#Emtbl,r2	; address of table
30$:	cmp	(r2)+,(r3)+	; compare first word
	bne	35$		; j if unequal
	cmp	(r2),(r3)	; compare second word
	beq	80$		; j if a match
35$:	add	#Emtsz-2,r2	; else get to next table entry
	tst	-(r3)		; backup r3
	tst	(r2)		; terminating null?
	bne	30$		; j if not

40$:	Blab	#mbadem		; say no good
	sec			; say we mean it
	br	99$		; and go away

80$:	tst	(r2)+		; get to pud value
	mov	(r2)+,pudc2	; save this
	mov	(r2)+,r0	; high order disk address
	mov	(r2),r1		; low order disk address

99$:	return

	.Psect	data

Mbadem:	News	</Fatal can't emulate given device, bye./>
	.Page
	.Sbttl	Sizswi -- handle size switch
;
;	Modifies volume size in r0/r1
;
;	Cc-c set on error
;
	.Psect	code

Sizswi:
	bit	#UsrSI,option	; was size specified?
	beq	99$		; j if no
	mov	#Volszh,r3	; use this to store size
	mov	#Sistr,r5	; get address of size string
	mov	#12.,r4		; and length
20$:	tstb	sistr-1(r4)	; back over nulls
	bne	30$		; j if not null
	sob	r4,20$		; try again
30$:	call	.dd2ct		; get size
	bcs	40$		; j if no good
	mov	(r3)+,r0	; get size
	mov	(r3),r1		; ....
	mov	r0,r2		; check out size
	bmi	40$		; j if ng
	bis	r1,r2		; check out size cont'd
	bne	99$		; j if ok

40$:	Blab	#mbadsi		; say bad size
	sec			; show error

99$:	return

	.Psect	data

Mbadsi:	News	</Fatal invalid size specification -- bye./>
	.Page
	.Sbttl	Extswi - Process extend size switch
;
;	Extswi
;
;	Accepts volume size in r0/r1
;	Calculates default extend size as min(volsiz/8.,1000.)
;	Returns proper volume size in volszh/l
;	Returns proper extend size in EXval
;	Clears Cc-c
;

	.Psect	code

Extswi:
	mov	#1000.,r2	; get standard
	mov	r1,Volszl	; write out volume size
	mov	r0,Volszh	; high order
	bne	50$		; j if must use standard extend
	ash	#-3,r1		; volume size/8.
	cmp	r1,r2		; is it larger
	bhis	50$		; j if so
	mov	r1,r2		; else use volsz/8
50$:	bit	#UsrEX,option	; does the user override the default?
	bne	99$		; j if so
	mov	r2,EXval	; else use default
99$:	clc			; show success
	return
	.Page
	.Sbttl	Open -- Open the fake disk file
;
;	Open
;
;	This routine opens the fake disk file
;
;	r0 is set to the address of the fdb
;	Cc-c is set on error
;	On error r0-r3 are cobbered

	.Psect	code

Open:
	mov	#Dskfdb,r0
	movb	#fo.upd,f.facc(r0) ; default is open for update
	bit	#UsrSU,option	; are we superceding
	beq	10$		; j if no
	movb	#fo.wrt,f.facc(r0) ; say so
	br	20$		; and specify file attributes
10$:	bit	#UsrCR,option	; are we creating?
	beq	30$		; j if no
	movb	#fo.wrt!fa.nsp,f.facc(r0) ; else say so
20$:	Fdat$R	,#r.fix,,#512.	; specify file attributes
30$:	Open$			; open file
	bcc	99$		; j if no error

	mov	#popner,r1	; set up parameter block
	movb	f.err(r0),r3	; get f.err
	mov	r3,(r1)+	; sign extended
	movb	f.err+1(r0),r3	; do the same
	mov	r3,(r1)+	; with f.err+1
	Blab	#mopner		; write reason
	Blab	#mopne1		; and filename

99$:	return

	.Psect	data

Mopner:	News	</Fatal open failure %2D/>,,'+
Popner:	.Blkw	2
Mopne1:	News	</ %X -- bye./>,Dskfdb+f.fnb+n.fnam
	.Page
	.Sbttl	Setsiz -- Sets up various sizes
;
;	Setsiz
;
;	Reads file attributes in the header to determine
;	The prior values of Pudc2, volszh/l, Exval
;
;	r0-r2,attrbk	Clobbered
;

	.Psect	code

Setsiz:
	mov	option,r1	; get options
	bit	#UsrCR!UsrSU,r1	; did we write anything yet?
	bne	99$		; j if no
	com	r1		; negate options
	bit	#UsrEX!UsrSI!UsrEM,r1 ; find out if we have everything
	beq	99$		; j if we do
	dir$	#Getatr		; read stuff we wrote
	tstb	Iostat		; did it work?
	bpl	3$		; j if so
	Blab	#mrdatr		; else speak
	br	99$		; and exit
3$:	mov	#Attrbk+20,r0	; address of volsz+2
	mov	(r0),-(sp)	; check for zero
	bis	-(r0),(sp)+	; is it
	bne	5$		; j if no
	Blab	#mnoatr		; else talk
	br	99$		; and exit
5$:	bit	#UsrSI,r1	; did we have a size specification?
	beq	10$		; j if so
	mov	#volszh,r2	; we better get one
	mov	(r0)+,(r2)+	; use what we wrote as
	mov	(r0),(r2)	; volume size
10$:	bit	#UsrEX,r1	; did we get an extend specification
	beq	20$		; j if so
	mov	attrbk+22,EXval	; else use one in file header
20$:	bit	#UsrEM,r1	; did we get an emulate spec
	beq	99$		; j if so
	mov	attrbk+24,Pudc2	; else use one in file header
99$:	call	list		; list attributes
	mov	exval,dskfdb+f.aloc ; set up extend size
	return			; and go away

	.Psect	data

Mrdatr:	News	</Warning - read attributes failure %2P/>,Iostat
Mnoatr:	News	</Warning - no attributes found for file./>
	.Page
	.Sbttl	List -- Output Volume size and extendsize
;
;	List
;

	.Psect	code

List:
	bit	#UsrLI,option	; are we doing it?
	beq	99$		; j if no
	Blab	#Mlist0		; first part
	mov	pudc2,r3	; get pud word
	beq	20$		; j if unknown
10$:	mov	#EMtbl+EMtsz,r5	; address of table 1st known entry
15$:	cmp	4(r5),r3	; is this the proper entry
	beq	40$		; j if so
	add	#EMtsz,r5	; else increment pointer
	tst	(r5)		; 
	bne	15$		; and try again
20$:	Blab	#Mlista		; say unknown
	br	50$		; do more
40$:	mov	r5,Mlistb+2	; place pointer to device name
	Blab	#Mlistb		; talk about it
50$:	Blab	#Mlist		; the rest
99$:	return			; and go away


	.Psect	data

Mlist0:	News	</Emulating />,,'+
Mlista:	News	</Unknown Device/>,,'+
Mlistb:	News	</%6<%2R%6>%6J/>,,'+
Mlist:	News	</, Volume size %T., Extendsize %D./>,Atvols
	.Page
	.Sbttl	Reset -- Reset file attributes
;
;	Reset
;
;	r0-r2	Clobberred

	.Psect	code

Reset:
	bit	#UsrRE!UsrCR!UsrSU,option ; are we doing it?
	beq	99$		; j if no
	mov	#Dskfdb,r0	; get fdb addr
	mov	#Attrbk,r2	; Attribute block address
	mov	#7,r1		; 7 words of attrbk come from fdb
5$:	mov	(r0)+,(r2)+	; do it
	sob	r1,5$		; all
	mov	#atvols,r1	; address of size block
	mov	(r1)+,r0	; get volume size
	mov	(r0)+,(r2)+	; ....
	mov	(r0)+,(r2)+	; ....
	mov	(r1)+,(r2)+	; and extend size
	mov	(r1),(r2)	; and pudc2
	dir$	#Putatr		; write them out
	tstb	iostat		; did it work?
	bpl	99$		; j if so
	blab	#mwratr		; else speak
99$:	return			; and go away

	.Psect	data

Mwratr:	News	</Warning write attributes failure %2P/>,Iostat
	.Page
	.Sbttl	Debug -- Output request nodes while debugging
;
;	Debug
;
;	Input:
;
;	  r1 -- Request node address
;

	.Psect	code

Debug:
	bit	#UsrDE,option	; are we doing it?
	beq	99$		; j if no
	push	<r2,r3>		; save regs
	tst	r.at(r1)	; Is this an exec request?
	bne	1$		; j if no
	Blab	#moqir1		; else say so
	mov	#pbkir3,r3	; get to next parameter block
	br	2$		; go on
1$:	mov	#pbkir1,r3	; get address of parameter block
	mov	r.td(r1),r2	; get address of taskname
	mov	(r2)+,(r3)+	; get taskname
	mov	(r2)+,(r3)+	; ....
	mov	r.at(r1),r2	; address of atl
	mov	a.ti(r2),r2	; pud address of requestor's ti
	movb	u.un(r2),(r3)+	; ti unit number
	clrb	(r3)+
	Blab	#moqir2
2$:	movb	r.gc(r1),(r3)+	; uic
	clrb	(r3)+
	movb	r.pc(r1),(r3)+
	clrb	(r3)+
	movb	r.lu(r1),(r3)+	; lun
	clrb	(r3)+
	movb	r.pr(r1),(r3)+	; priority
	clrb	(r3)+
	movb	r.fn(r1),(r3)+	; event flag
	clrb	(r3)+
	Blab	#moqir3
	mov	r.fc(r1),(r3)+	; function code
	mov	r1,(r3)		; say that again
	add	#r.fc,(r3)+	; set up for byte list
	mov	r.sb(r1),(r3)+	; i/o status block address
	mov	r.ae(r1),(r3)+	; ast entry
	Blab	#moqir4
	movb	r.dp(r1),r2	; dpb size
	sub	#6,r2		; get number of parameters
	mov	r2,(r3)+
	ble	4$		; j if no parameters (<0 for exec rqst)
	push	r1
	add	#r.pb,r1
3$:	mov	(r1)+,(r3)+	; save parameters
	sob	r2,3$
	pop	r1
	Blab	#moqir5
4$:	pop	<r3,r2>		; Get back stuff
99$:	return			; and go away

	.Psect	data

Moqir1:	News	<"%NI/O Request from EXEC">,Pbkir1
Moqir2:	News	<"%NI/O Request from %2R TT%O">,Pbkir2
Moqir3:	News	<"Uic [%O,%O]  Lun %M  Priority %M  Event Flag %M">,Pbkir3
Moqir4:	News	<"Function %P (%2B) Iosb addr %P  Ast %P">,Pbkir4
Moqir5:	News	<"Parameters: %N%8S%VP">,Pbkir5

Pbkir1:	.Blkw	0
Pbkir2:	.Blkw	3
Pbkir3:	.Blkw	5
Pbkir4:	.Blkw	4
Pbkir5:	.Blkw	7
	.Page
	.Sbttl	Dbgxfr -- Blab about bad transfer
;
;	Dbgxfr
;

	.Psect	code

Dbgxfr:
	bit	#Usrde,option	; are we debugging?
	beq	9$		; j if no
	push	r2		; blab about internal i/o failure
	movb	Dskfdb+f.err,r2	;
	mov	r2,pioe		;
	movb	Dskfdb+f.err+1,r2;
	mov	r2,pioe+2	;
	Blab	#mioe
	pop	r2
9$:	return

	.Psect	data

Mioe:	News	<"Warning -- Internal I/O failure %2D">
Pioe:	.Blkw	2
	.Page
	.Sbttl	Domsg -- Print news on user terminal
;
;

	.Psect	code

Domsg:
	jsr	r2,$savvr
	mov	12(sp),r0	; get address of stuff
	ror	12(sp)		; save carry flag
	mov	(r0)+,r1	; get address of string
	mov	(r0),r2		; get address of parameter block
	mov	mesptr,r0	; get address in output buffer
	clr	-(sp)		; assume no continuation
	tstb	(r1)		; leading null?
	beq	5$		; j if so, don't continue
	cmpb	#'+,(r1)	; continuation char?
	bne	10$		; j if no
	inc	(sp)		; show continuation
5$:	inc	r1		; skip idle char
10$:	call	$edmsg		; format message
	tst	(sp)+		; should we print now?
	bne	99$		; j if no
	mov	r0,r1		; get ending pointer+1
	mov	#mesbuf,r0	; get address again
	sub	r0,r1		; now r1 is message length
	qiow$s	#io.wlb,#2,#Enxfr,,,,<r0,r1,#40>
99$:	mov	r0,mesptr	; pointer to next free byte
	return
	.End	init
