 	title	Peripheral Utility Transfer Routines
;++
;
; File transfer program, knows many DEC formats.
;
; Copyright (C) 1995, 1996, 1997, 1998 By John Wilson.  All rights reserved.
; This program may be freely distributed provided that no charge is made for
; distribution and that all versions include this copyright notice and give
; proper credit to the original author (including first billing in the message
; displayed when the program is started).
;
; This program has many loose ends.  The RSTS support is read-only, and there's
; no trace of Files-11 support.  I'd like to change the main loop (print a
; prompt) to handle an async .FORK queue during the KB wait loop so that
; support for Megan Gentry's RTEFTP protocol (the server side) can be added w/o
; skating on a lot of thin ice, but haven't yet.  Also it would be nice to
; support ASPI tapes.
;
; TO DO LIST:
;
; Should handle bad block replacement with DL: and DM: RT-11 volumes.
;
; Several different cleanup concepts need to be sorted out:
;
; SQUEEZE should move empty blocks to end under RT-11
; CLEAN should update SATT.SYS under RSTS
; something should combine contiguous empty blocks under RT-11
;
; 09/18/90	JMBW	Created (OS/278, COS310 read-only version).
; 03/22/94	JMBW	Bypass BIOS to emulate RX50, RX02/03 (sort of) and RX01
;			(maybe -- it seems most PC FDC's blow off SD support).
; 03/23/94	JMBW	Concept of "logged-in" device.
; 03/30/94	JMBW	TYPE command works (DOS, OS/8, RT-11).
; 04/02/94	JMBW	TU58/COM port driver added.
; 07/09/94	JMBW	COPY command can write into RT-11 file system.
; 07/23/94	JMBW	LD: disk files work like subdirectories.
; 07/30/94	JMBW	Reads RSTS disks (RDS 0.0-1.2).
; 11/01/94	JMBW	FORMAT creates image files, WIPEOUT added for RT-11.
; 01/10/95	JMBW	V1.0 released.
; 01/29/95	JMBW	Cached dir code for OS/8 (adapted from RT-11 code).
; 05/18/95	JMBW	Writes and inits OS/8 disks.  V1.1 released.
; 05/30/95	JMBW	Exclude tracks 0, 78, 79 when initting OS/278 RX50s.
; 07/09/95	JMBW	RX23, RX33 support (RX33 untested w/real media).
; 07/11/95	JMBW	RX26, "RX52" support (RX26 untested).
; 08/05/96	JMBW	Auto-sense image file type on MOUNT.
; 08/08/96	JMBW	Indirect command files ("@ file"), PUTR.INI.
; 08/11/96	JMBW	COPY/FILE/DEV, PC-style floppy disks and images.
; 08/24/96	JMBW	RX26 support debugged (finally got a 2.88MB drive).
; 08/26/96	JMBW	Maintains software TG43 signal for CompatiCard.  V1.2.
; 10/24/96	JMBW	Fixed problems with null OS/8 tentative files.  V1.21.
; 07/24/97	JMBW	Supports SCSI disks using ASPI driver.
; 07/27/97	JMBW	INIT/SEGMENTS:n switch.
; 10/30/97	JMBW	Fixed TU58 bug with COPY/FILE/DEV.  V1.22.
; 11/24/97	JMBW	MOUNT/PARTITION:n switch (for RT-11 DU:).  V1.23.
; 12/01/97	JMBW	Fixed TU58 baud rate parser.  DISMOUNT/UNLOAD.  V1.24.
; 12/02/97	JMBW	SET DISMOUNT command.
; 04/11/98	JMBW	Added RAxx series drive types.
; 04/12/98	JMBW	Fixed handling of OS/278 disks with 2nd word of dir seg
;			set wrong, also fixed size for INIT /OS8/RX50.  V1.25.
; 06/04/98	JMBW	Fixed math error in RTWDIR, got incorrect # of dir segs
;			for disks with exactly 289. files.  V1.26.
; 06/09/98	JMBW	Fixed DXILV for OS/8 RX02s (never worked!).  V1.27.
; 06/11/98	JMBW	I'm an idiot.  Now split into DXILV/DYILV.  V1.28.
;
; FDCs that work in single density mode:
; SMC		FDC37C65+ (non-+ version suspected to work too)
; Goldstar	GM82C765B
;
;--
	.radix	8	;por supuesto
;
;	include	sym.inc	;(symbols for SYMDEB's benefit, this line not needed)
;
tab=	11
lf=	12
cr=	15
crlf=	cr+(lf*400)
;
dbufl=	512d		;length of floppy buffer
indsiz=	128d		;length of indirect file buffer
bufsiz=	2000		;size of general purpose buf (one RT-11 dir segment)
;
; Cram in-line string into buffer at ES:DI.
; (or call RTN with in-line arg, if specified.)
cram	macro	string,rtn
	local	a,b
ifb <rtn>
	call	cram1		;;CRAM1 crams in-line counted arg into ES:DI
else
	call	rtn
endif
a	db	b,string
b=	$-a-1
	endm
;
; Define a byte field in a record (_ is current offset).
; Num is # bytes, default is 1.
defb	macro	nam,num
&nam=	byte ptr _
ifnb <&num>
_=	_+&num
else
_=	_+1
endif
	endm
;
; Define a word field in a record (_ is current offset).
; Num is # words, default is 1.
defw	macro	nam,num
&nam=	word ptr _
ifnb <&num>
_=	_+(&num*2)
else
_=	_+2
endif
	endm
;
; Define a dispatch table entry, giving an error message if order doesn't
; agree with NAM.  ADDR is the call address.
disp	macro	nam,addr
if nam eq _
	dw	&addr
_=_+2
else
	%out	Dispatch table out of order:  &nam
	.err
endif
	endm
;
; Define a keyword record for TBLUK, given a string containing exactly one
; hyphen to show the minimum allowable abbreviation.
;	db	length to match
;	db	total length
;	db	'KEYWORD'
;	dw	ADDR
kw	macro	text,addr
kh=	0
ki=	0
	irpc	kc,text
ki=	ki+1
ifidn <kc>,<->
kh=	ki
endif
	endm ;; irpc
ife kh
	.err
	%out	No hyphen in string:  &text
	exitm
endif ;; ife kh
	db	kh-1,ki-1
	irpc	kc,text
ifdif <kc>,<->
	db	'&kc'
endif
	endm ;; irpc
	dw	addr
	endm
;
; Give an error message if an assumption is false (for code that depends on
; special knowledge of something in order to work).
.assume	macro	cond
if &cond
else
	.err
	%out	Assumption &cond is false
endif
	endm
;
; Define an ASPI error message table entry
amsg	macro	val,str
	local	a,b
a	db	&val,0,b,&str
b=	$-a-3
	endm
;
; Define a token for file system, dev type etc.
token	macro	name
&name=_
_=_+2
	endm
;
; Call and return.
callr	macro	dst
	jmp	&dst
	endm
;
; Set up OS types, each must be unique, low byte is word size (12. or 16.)
;
ostype	macro	nam,sym
&nam=	&sym
&sym=	&sym+100h
	endm
;
twelv=	12d	;PDP-8 file structures
sixtn=	16d	;PDP-11 file structures
;
	ostype	frgn,sixtn	;foreign (no file system)
	ostype	cos310,twelv	;COS-310
;;;	ostype	ods1,sixtn	;RSX-11, IAS, early VAX/VMS
	ostype	os8,twelv	;OS/8, OS/78, OS/278
;;;	ostype	putr,twelv	;TSS/8, PUTR.SAV format
	ostype	rsts,sixtn	;RSTS disk structure 0.0, 1.1, 1.2
	ostype	rt11,sixtn	;RT-11
;;;	ostype	tss8,twelv	;TSS/8, COPY.SAV format
;
; Drive type (real, equivalent to real (5.25" vs. 8"), or simulated (image)):
;
_=2	; (all valid types are non-zero)
	token	mscp	;size is whatever they say
	token	ra60	;UDA50/RA60 (205 MB)
	token	ra70	;UDA50/RA70 (280 MB)
	token	ra71	;UDA50/RA71 (700 MB)
	token	ra72	;UDA50/RA72 (1.0 GB)
	token	ra73	;UDA50/RA73 (2.0 GB)
	token	ra80	;UDA50/RA80 (121 MB)
	token	ra81	;UDA50/RA81 (456 MB)
	token	ra82	;UDA50/RA82 (622 MB)
	token	ra90	;UDA50/RA90 (1.2 GB)
	token	ra92	;UDA50/RA92 (1.5 GB)
	token	rk02	;RK11/RK02 (1.2 MB)
	token	rk05	;RK11/RK05 (2.5 MB)
	token	rk06	;RK611/RK06 (14 MB)
	token	rk07	;RK611/RK07 (28 MB)
	token	rl01	;RL11/RL01 (5 MB)
	token	rl02	;RL11/RL02 (10 MB)
	token	rs03	;RH11/RS03 (512 KB)
	token	rs04	;RH11/RS04 (1.0 MB)
flpbeg=	_	; beginning of floppy types
	token	rx01	;RX11/RX01 (250.25 KB) 77x1x26
	token	rx02	;RX211/RX02 (500.5 KB) 77x1x26
	token	rx03	;RX211/RX03 (1001 KB) -- semi-documented RX02 DS mod
	token	rx23	;???/RX23 (1.44 MB) 80x2x18
	token	rx24	;???/RX24 (720 KB) 80x2x9
	token	rx26	;???/RX26 (2.88 MB) 80x2x36
	token	rx31	;???/RX31 (360 KB) 40x2x9 (needs double-step on AT)
;;; not currently supported by anything
	token	rx33	;RQDX3/RX33 (1.2 MB) 80x2x15
	token	rx50	;RX50 (400 KB) 80x1x10
	token	rx52	;RX50/double sided (800 KB) -- "RX52" is my name for it
			;(may not really exist, but supported by P/OS)
flpend=	_-1	; end of floppy types
.assume <flpend lt 400>	;FDCMOS and FDTYPE expect token to fit in a byte
	token	tu56	;TC08/TU56 (129.x12.x2702'), TC11/TU56 (256.x16.x578.)
	token	tu58	;DL11/TU58 (256 KB)
;
; Actual hardware type used to simulate the drive
;
_=0
	token	hwfile	;image file
	token	hwflop	;floppy disk (DU:, DX:, DY:, DZ:)
	token	hwpart	;hard disk partition
	token	hwtu58	;TU58 attached to serial port (DD:)
	token	hwaspi	;ASPI SCSI device
	token	hweftp	;Megan Gentry's RTEFTP protocol via packet driver
;
; Logical device record (one for each mounted device)
;
_=0
	defw	next		;ptr to next record
	defw	logd		;logical device name (right-justified)
	defw	logu		;flag,,unit #
	defw	hwtype		;hardware type (image file, floppy, etc.)
	defw	fsys,0		;file system structure
	defb	wsize,2		; low byte is word size (12d or 16d)
	defw	med		;medium type (RX01, etc.)
	defw	dsrini		;init DSR (called on each dev change)
	defw	rdblk		;routine to read CX blocks starting at DX:AX
	defw	rdasc		;RDBLK, ASCII mode
	defw	wrblk		;routine to write CX blocks starting at DX:AX
	defw	wrasc		;WRBLK, ASCII mode (if there's a difference)
	defw	handle		;handle to file (if disk image)
	defw	fintlv		;routine to compute floppy interleave for AX
iovecs=_	; I/O vectors start here
	defw	defset		;set up defaults before first access
	defw	savcwd		;save dir context before switching devs
	defw	rstcwd		;restore dir context after switching devs
	defw	volnam		;print vol name
	defw	gdir		;get dir name
	defw	dirhdr		;print directory listing header
	defw	dirinp		;init for dir lookup
	defw	dirget		;get next dir entry
	defw	dirdis		;display dir entry
	defw	diremp		;display empty dir entry
	defw	dirnam		;print dir name
	defw	dirfin		;finish up dir access (flush dirty bufs etc.)
	defw	dirsum		;print summary after directory listing
	defw	open		;open most recently DIRGETted file for input
	defw	read		;read from input file
	defw	reset		;close input file
	defw	dirout		;init for dir write
	defw	create		;create output file
	defw	write		;write to output file
	defw	wlast		;write last buffer (partial block) to file
	defw	close		;close output file
	defw	delfil		;delete file
	defw	chdir		;change current dir
	defw	wboot		;write bootstrap
	defw	wipout		;wipe out (zero) unused areas for compression
niovec=(_-iovecs)/2
	defw	totsiz,4	;total dev size in bytes (including trk 0 etc.)
	defw	totblk,4	;total dev size in blocks (including DEC166)
	defw	devsiz,4	;device size in usable 512-byte blocks
	defw	actsiz,2	;active device size (RT-11)
	defb	initf		;init flag, cleared in all devs at each prompt
	defb	ecache		;NZ => enable dir cache (RSTS)
	defb	tapflg		;NZ => tape (otherwise disk)
	; filesystem-dependent data
	defw	pcs		;pack clustersize
	defw	dcs		;dev clustersize
	defw	curdir,2	;.WORD current ppn (RSTS)
				;or .LONG starting blk # (RT-11)
	defw	cursiz,2	;current LD: size (RT-11)
	defw	actdir,2	;active dir (during search, usually = CURDIR)
	defw	mfddcn		;DCN of first cluster of MFD (RSTS)
	defw	satptr		;DCN of last cluster allocated (RSTS)
	defw	extra		;# extra bytes/dir segment (OS/8, RT-11)
	defw	dirbuf		;ptr to head of dir buffer chain
	defw	dirclu		;dir clustersize
	defw	dirwnd,7	;dir retrieval window (MUST FOLLOW DIRCLU)
	defw	rdslev		;RDS level word (RSTS)
	; device-dependent data
	defb	drive		;physical BIOS drive #, TU58 unit, SCSI target
	defb	host		;host adapter # (SCSI)
	defb	lun		;logical unit # (SCSI)
	defw	port		;COM port base I/O address
	defw	secsz,2		;sector size (only LSW valid unless SCSI)
	defb	ilimg		;1 => interleaved image file (must be undone)
	defb	blksec		;shift count to convert blk # to sec #
				;=9-LOG2(SECSZ)
	defb	ncyls		;# cylinders
	defb	nhds		;# heads
	defb	nsecs		;# sectors per track
	defw	rdsec		;read sector (FDRDS or equiv.)
	defw	wrsec		;write sector (FDWRS or equiv.)
reclen=	_
;
; BINFLG values:
bin=	0	;binary transfer
text=	2	;text transfer (translate to ASCII and back)
.assume <(rdasc-rdblk) eq (text-bin)>
.assume <(wrasc-wrblk) eq (text-bin)>
;
; File size table entry:
; (for figuring out medium type based on image file size)
_=0
	defw	flmed		;medium type
	defw	flsiz,2		;actual image file size in bytes
	defw	flusz,2		;usable device size in bytes
	defw	flbsz,2		;size of bad sector track (etc.) in bytes
	defw	flcyl		;# cylinders
	defb	flhd		;# heads
	defw	flsec		;# sectors
	defw	flbs		;# b/s
	defb	flilv		;1 if interleaved (must be undone)
fllen=_
;
; Macro to define a file size table entry:
;	dw	med		;medium type code
;	dd	size		;image size in bytes
;	dd	use		;usable part of disk in bytes
;	dd	bad		;size of bad sector file in bytes
;	dw	cyl		;cylinders
;	db	hd		;heads
;	dw	sec		;sectors
;	dw	bs		;bytes/sector
;	db	ilv		;NZ => interleaved file (logical blk order)
;
filsiz	macro	med,siz,use,bad,cyl,hd,sec,bs,ilv
	dw	&med		;;medium type code
	;; size of image file in bytes
ifnb <&siz>
	dd	&siz		;;file size given explicitly
else
	dd	&cyl*&hd*&sec*&bs ;;default is the whole device
endif
	;; size of usable part of device in bytes
ifnb <&use>
	dd	&use		;;usable size given explicitly
else
 ifnb <&bad>
	dd	(&cyl*&hd*&sec*&bs)-(&bad) ;;all but bad block list
 else
	dd	&cyl*&hd*&sec*&bs
 endif
endif
	;; size of bad sector file in bytes
ifnb <&bad>
	dd	&bad		;;size of bad sector file
else
	dd	0		;;no bad sector file
endif
	dw	&cyl		;;cylinders
	db	&hd		;;heads (i.e. tracks)
	dw	&sec		;;sectors
	dw	&bs		;;bytes/sector
ifnb <&ilv>
	db	&ilv		;;NZ => file is interleaved (logical blk order)
else
	db	0
endif
	endm
;
; OS/8 dir segment buffer format:
;
_=1000			;256. words of data first
	defw	ossblk	;block #
	defw	ossnxt	;ptr to next buf or 0
	defb	ossdrt	;NZ => buf is dirty
osslen=_
;
; RSTS dir buffer format:
;
_=1000			;512. bytes of data first
	defw	rdsbkl	;abs 24-bit block number (LSW) (or 0 if not used yet)
	defb	rdsbkh	; " " " (MSB)
	defb	rdsdrt	;NZ => buf is dirty
	defw	rdsnxt	;ptr to next buf or 0
rdslen=_
;
; RT-11 dir segment buffer format:
;
_=2000			;1024. bytes of data first
	defw	rtsblk,2 ;starting abs blk # of block pair
	defw	rtsnxt	;ptr to next buf or 0
	defb	rtsdrt	;NZ => buf is dirty
rtslen=_
;
; FDC hardware registers:
;
fdc=	3F0h	;base address
fdccc4=	fdc+0	;Micro Solutions CompatiCard IV control register
fdcfcr=	fdc+1	;FDC format control register (SMC FDC37C65C+ only)
		;(my homemade FDC has it at 3F6h)
fdcdor=	fdc+2	;FDC digital output register
fdcmsr=	fdc+4	;FDC main status register
fdcdat=	fdc+5	;FDC data register
fdcdcr=	fdc+7	;FDC diskette control register (data rate, etc.)
fdcdir=	fdc+7	;FDC digital input register (disk change line in b7)
;
mfm=	100	;MF flag set (double density)
fm=	0	;MF flag clear (single density)
;
seek_status equ byte ptr 043Eh	;int flag (b7), "recal needed" bits (b3-b0)
motor_status equ byte ptr 043Fh	;motor bits (b7 = spin-up first (write))
motor_count equ byte ptr 0440h	;# timer ticks until motor turnoff
timer_low equ word ptr 046Ch	;low word of system time
;
code	segment
	assume	cs:code
	org	100h		;.COM file
;
; Global register usage:
;
; BP	generally points at a dev record
; DS	points at code
; ES	points at code (except when temporarily used for buffers)
; SS	points at code (stack is after code, before buffers)
; DF=0
;
start:	cld			;DF=0
	; make sure we have enough memory to run
	and	sp,not 0Fh	;round down to paragraph boundary
	cmp	sp,offset mem	;enough?
	jb	notmem		;no
	mov	ds:himem,sp	;save ptr (PSP:0006 isn't quite right)
;;; huh?  shouldn't SP be set to MEM here, and MEM should be mult of 16.
	mov	bx,sp		;copy
	mov	cl,4		;shift count
	shr	bx,cl		;find # paragraphs to keep
	mov	sp,offset pdl	;shrink stack
	mov	ah,4Ah		;func=setblock
	int	21h
	; allocate a large I/O buffer
	mov	bx,-1		;get all available memory
getm1:	mov	ah,48h		;func=getblock
	int	21h		;give it a try
	jnc	getm2		;got it, go see how big
	test	bx,bx		;anything left?
	jnz	getm1		;yes
notmem:	cram	'?Not enough memory',wrng
	mov	ax,4C01h	;func=punt
	int	21h
getm2:	cmp	bx,800h		;at least 32KB?
	jb	notmem		;no, can't even hold one big cluster
	mov	ds:bigbuf,ax	;save ptr
	mov	ax,16d		;segment size
	mul	bx		;find total # bytes
	mov	ds:bigsiz,ax	;save
	mov	ds:bigsiz+2,dx
	mov	dx,offset ctrlc	;pt at ^C vector
	mov	ax,2523h	;func=set INT 23h vector
	int	21h
	; get # of floppy drives
	int	11h		;among other things
	xor	bl,bl		;assume none
	test	al,1		;are there any?
	jz	numfd1		;no
	rol	al,1		;left 2
	rol	al,1
	and	al,3		;isolate
	inc	ax		;get actual #
	mov	bl,al		;copy
numfd1:	mov	al,bl		;copy
	mov	ds:numfd,al	;save
	add	al,'A'-1	;get max valid floppy drive letter
	mov	ds:maxfd,al	;save
	cmp	bl,1		;exactly one floppy?
	jne	$+3
	 inc	bx		;yes, pretend there are two
	mov	ds:firhd,bl	;unit # of first HD
	add	bl,'A'		;physical drive letter of first HD
	mov	ds:lethd,bl	;save
	; get drive types from CMOS if AT
	mov	ax,0FFFFh	;point at last paragraph of real mode memory
	mov	es,ax
	cmp	byte ptr es:0Eh,0FCh ;AT?
	jne	numfd2
	mov	al,10h		;floppy types are at CMOS location 0010
	out	70h,al
	jmp	short $+2	;hocus pocus (I/O delay on non-local-bus ATs)
	in	al,71h		;get types, A in high nibble, B in low
	mov	bl,al		;copy
	and	bx,0Fh		;isolate B: type
	mov	ah,ds:fdcmos[bx] ;translate
	mov	bl,al		;copy
	mov	cl,4		;shift count
	shr	bl,cl		;right-justify A: drive type
	mov	al,ds:fdcmos[bx] ;translate
	mov	word ptr ds:fdtype,ax ;save
numfd2:	; get # of hard drives
	xor	ax,ax		;load 0
	mov	es,ax		;into ES
	mov	al,byte ptr es:0475h ;get # drives
	mov	ds:numhd,al	;save
	; get row count for **MORE** processing
	mov	al,byte ptr es:0484h ;EGA and later, # lines on screen -1
	test	al,al		;did we get anything?
	jnz	$+4
	 mov	al,25d-1	;no, all pre-EGA boards had 25d lines only
	mov	ds:lmax,al	;save
	push	ds		;restore ES (trashed in INT 21h AH=35h above)
	pop	es
	; make sure disk buffer doesn't span 64KB boundary
	mov	ax,ds		;get seg addr
	mov	cl,4		;bit count
	sal	ax,cl		;left 4 (lose high bits)
	add	ax,offset dbuf1	;pt at buffer
	add	ax,dbufl-1	;see if it spans (OK to stop just short)
	jnc	nospan		;no, skip
	 mov	ds:dbuf,offset dbuf2 ;yes, well this won't
nospan:	; get currently logged in DOS disk letter to use as default
	mov	ah,19h		;func=get logged in DOS disk
	int	21h
	add	al,'A'		;convert to drive letter
	mov	ah,al		;duplicate
	mov	word ptr ds:curdsk,ax ;save
	; look for an ASPI manager (Advanced SCSI Programming Interface)
	mov	dx,offset scsimg ;filename
	mov	ax,3D00h	;func=open /RONLY
	int	21h
	jc	lkasp3		;failed, doesn't exist
	; got something, make sure it's not a file and that it accepts IOCTL RD
	mov	bx,ax		;copy handle
	mov	ax,4400h	;func=IOCTL (get dev flags)
	int	21h
	jc	lkasp1		;failed
	and	dx,40200	;isolate IOCTL RD, DEVICE bits
	cmp	dx,40200	;both must be set
	jne	lkasp1
	; OK so far, ask for entry point
	mov	dx,offset buf	;point at scratch buf
	mov	cx,4		;byte count
	mov	ax,4402h	;func=IOCTL (read control string)
	int	21h
	jc	lkasp1		;failed
	cmp	ax,4		;got all four bytes?
	jne	lkasp1		;no
	mov	ax,word ptr ds:buf ;fetch entry point
	mov	dx,word ptr ds:buf+2
	mov	ds:aspi,ax	;save
	mov	ds:aspi+2,dx
lkasp1:	mov	ah,3Eh		;func=close handle
	int	21h
lkasp2:	mov	ax,ds:aspi	;see if we got anything
	or	ax,ds:aspi+2
	jz	lkasp3		;no, skip this
	; do "SCSI HA inquiry" cmd, see if manager can handle incomplete xfrs
	mov	si,offset hainq	;pt to cmd block
	mov	cx,lhainq
	mov	di,offset srb	;ES:DI=SRB buf
	push	es		;save SRB addr as call arg
	push	di
	rep	movsb		;copy cmd
	call	dword ptr ds:aspi ;call ASPI driver
	pop	ax		;flush stack
	pop	ax
	call	aspwt		;await completion
	call	serr		;check for error
	cmp	word ptr ds:srb+4,55AAh ;did handler see our stupid sig?
	jne	lkasp3
	test	byte ptr ds:srb+3Ah,2 ;residual byte count supported?
	jz	lkasp3
	 inc	ds:resbc	;set flag
lkasp3:	; get SWITCHAR (undocumented!)
	mov	ax,3700h	;func=get SWITCHAR
	int	21h
	mov	ds:swchar,dl	;save it
	; look for PUTR.INI
	mov	dx,offset inifil ;point at init file name
	mov	ax,3D00h	;func=open /RONLY
	int	21h
	jnc	infl9		;got it
	; check executable's directory if DOS 3.0 or later
	mov	ah,30h		;func=get DOS version
	int	21h
	cmp	al,3		;3.X or higher?
	jb	infl11		;no
	push	ds		;save
	mov	ds,word ptr ds:[002Ch] ;point at environment
	xor	si,si		;starting offset
infl1:	lodsb			;read a byte
	test	al,al		;end of environment?
	jz	infl3
infl2:	lodsb			;no, look for end of string
	test	al,al
	jnz	infl2
	jmp	short infl1	;now it could be end of env
infl3:	; found end of environment, copy executable's full filespec
	lodsw			;skip # of parameters
	mov	di,offset buf	;point at where to put filename
	mov	dx,di		;save a ptr
	mov	bx,di		;pt at begn of path element
infl4:	lodsb			;get a byte
	test	al,al		;end of string?
	jz	infl7
	cmp	al,':'		;colon?
	je	infl5
	cmp	al,'/'		;slash?
	je	infl5
	cmp	al,'\'		;backslash?
	jne	infl6
infl5:	lea	bx,[di+1]	;pt at begn of next path element
infl6:	cmp	di,offset buf+bufsiz ;off end of buf?
	je	infl10		;yes
	stosb			;otherwise save it
	jmp	short infl4	;loop
infl7:	; replace last path element with init file's name
	pop	ds		;restore
	mov	di,bx		;point at last path element
	mov	si,offset inifil ;point at init file name
infl8:	lodsb			;get a byte
	cmp	di,offset buf+bufsiz ;off end of buf?
	je	infl11		;yes
	stosb			;save if not
	test	al,al		;done all?
	jnz	infl8		;loop if not
	; try to open it there
	mov	ax,3D00h	;func=open /RONLY
	int	21h
	jc	infl11		;forget about it
infl9:	mov	ds:indhnd,ax	;save handle
	mov	ds:indctr,0	;buffer initially empty
	jmp	short infl11
infl10:	pop	ds		;restore
infl11:	; put up banner
	mov	di,offset lbuf	;pt at buf
 cram 'PUTR V1.28  Copyright (C) 1995-1998 by John Wilson <wilson@dbit.com>'
	mov	byte ptr ds:lnum,10d ;don't **MORE**
	call	flush
	cram	'All rights reserved'
	call	flush		;put up msg
	call	flush		;+blank line
	cram	'COPY mode is ASCII, SET COPY BINARY to change'
	call	flush
;+
;
; Main loop.
;
;-
mloop:	; reset everything (in case error abort, ^C, or 'Q' from **MORE**)
	mov	ax,cs		;copy cs
	mov	ds,ax		;to all
	mov	es,ax
	cli			;ints off (may have been already via INT inst)
	mov	sp,offset pdl	;;reset stack
	sti			;;ints on after next inst
	mov	ss,ax
	; flush dir buffers
	xor	bp,bp		;load 0 (don't get caught in a loop!)
	xchg	bp,ds:indev	;get input dev, zap it
	test	bp,bp		;anything?
	jz	mlp1
	call	ss:dsrini[bp]	;init
	xor	bx,bx		;switch to input
	call	ss:rstcwd[bp]
	call	ss:dirfin[bp]	;finish up dir I/O
mlp1:	xor	bp,bp		;load 0
	xchg	bp,ds:outdev	;get output dev, zap it
	test	bp,bp		;anything?
	jz	mlp2
	call	ss:dsrini[bp]	;init
	mov	bx,2		;switch to output
	call	ss:rstcwd[bp]
	call	ss:dirfin[bp]	;finish up dir I/O
mlp2:	mov	ax,ds:kepmem	;flush unkept memory
	mov	ds:fremem,ax
	; close any extraneous open handles (they may have aborted an xfr)
	mov	bx,-1		;-1 means closed
	xchg	bx,ds:inhnd	;see if it was open
	test	bh,bh
	js	mlp3		;no
	mov	ah,3Eh		;func=close
	int	21h
	mov	bx,-1		;-1 again
mlp3:	xchg	bx,ds:outhnd	;see if this was open
	test	bh,bh
	js	mlp4		;no
	mov	ah,3Eh		;func=close
	int	21h
mlp4:	; flush incomplete dev rec (from TYPE, or aborted MOUNT etc.)
	xor	bp,bp		;load 0
	xchg	bp,ds:tmpdev	;clear it, see if NZ
	test	bp,bp
	jz	mlp5
	call	retrec		;return to free list
mlp5:	; mark all devs as not initted
	mov	bp,ds:logdev	;get head of dev list
	jmp	short mlp7	;jump into loop
mlp6:	mov	ss:initf[bp],0	;mark as not initted
	mov	bp,ss:next[bp]	;follow link
mlp7:	test	bp,bp		;end?
	jnz	mlp6
	mov	byte ptr ds:fdrst,0 ;FDC may need resetting
	test	byte ptr ds:cc4fdc,-1 ;is it a CompatiCard IV?
	jz	mlp8
	mov	dx,fdccc4	;yes, point at CC4 control port
	mov	al,0Ch		;give it a freshly-reset value
	out	dx,al
mlp8:	; print prompt
	mov	di,offset lbuf	;pt at buffer
	mov	al,'('		;put in parentheses
	stosb
	test	byte ptr ds:nprmpt,-1 ;no prompt?
	jnz	mlp9		;right, don't get caught in a loop
	inc	byte ptr ds:nprmpt ;in case we don't survive this
	mov	dl,ds:curdsk	;is a DOS disk current?
	test	dl,dl
	jnz	mlp10		;yes
	mov	bp,ds:logdev	;[get head of device list]
	push	di		;save
	call	ss:dsrini[bp]	;init DSR
	call	ss:defset[bp]	;set defaults
	pop	di		;restore
	call	pdev		;show device name
	xor	cx,cx		;no trailing \ (or whatever)
	call	ss:dirnam[bp]	;show dir name
	jmp	short mlp11
mlp9:	mov	si,offset badprm ;prompt
	mov	cx,13d		;length
	rep	movsb		;copy
	jmp	short mlp12	;continue
mlp10:	mov	al,dl		;copy
	mov	ah,':'		;add colon
	stosw
	xor	cx,cx		;no trailing \
	call	dosddl		;display dir for drive in DL
mlp11:	dec	byte ptr ds:nprmpt ;success, clear flag
mlp12:	mov	ax,">)"		;add ")>"
	stosw
	mov	byte ptr ds:lnum,2 ;no **MORE**
	call	flush1		;flush
	call	gtlin		;get a line from the keyboard
	; get today's date so we can interpret OS/8 dates
	push	cx		;save
	mov	ah,2Ah		;func=get date
	int	21h
mlp13:	mov	word ptr ds:day,dx ;save
	mov	ds:year,cx	;save
	sub	cx,1970d	;subtract OS/8 base
	and	cl,not 7	;get mult of 8d
	add	cx,1970d	;add this back in
	mov	ds:yrbase,cx	;save OS/8 base year
	mov	ah,2Ch		;func=get time
	int	21h
	mov	word ptr ds:min,cx ;save
	mov	ds:sec,dh
	mov	ah,2Ah		;func=get date
	int	21h
	cmp	word ptr ds:day,dx ;check for change
	jne	mlp13		;whoops, we passed midnight
	pop	cx		;restore
	call	skip		;skip blanks etc.
	jc	mlp14		;blank line, reprompt
	cmp	al,'@'		;open indirect file?
	je	mlp15
	cmp	al,';'		;comment?
	je	mlp14		;ignore line if so
	cmp	al,'!'		;either way
	je	mlp14
	call	getw		;get a word
	jc	mlp14		;just got a separator, reprompt
	mov	ax,offset cmdtab ;pt at command table
	call	tbluk		;look up
	jc	mlp19
	call	ax		;call the routine
mlp14:	jmp	mloop		;loop
mlp15:	; starts with "@", look for filename
	inc	si		;eat the "@"
	dec	cx
	mov	bx,-1		;mark handle as empty
	xchg	bx,ds:indhnd	;and get old value
	test	bx,bx		;was it open?
	js	mlp16
	mov	ah,3Eh		;yes, func=close
	int	21h
mlp16:	call	getw		;get filename
	jc	mlp17		;failed
	call	confrm		;should be EOL
	mov	si,bx		;point at filename
	mov	cx,dx
	mov	di,offset dotcmd ;default extension
	call	defext		;apply it (get filename ptr in DX)
	mov	ax,3D00h	;func=open /RONLY
	int	21h
	jc	mlp18
	mov	ds:indhnd,ax	;save handle
	mov	ds:indctr,0	;buffer needs to be loaded
	jmp	short mlp14	;back into loop
mlp17:	jmp	misprm
mlp18:	jmp	fnf
mlp19:	; undefined keyword, see if they want to log into a new device
	push	bx		;save
	push	dx
	mov	si,bx		;back up
	add	cx,dx
	mov	ah,1		;must include colon
	call	getlog		;get logical device
	jc	mlp26		;invalid
	; look for dev name on log dev list
	mov	bp,ds:logdev	;get head of list
	xor	dx,dx		;no prev entry
	jmp	short mlp22
mlp20:	cmp	ss:logd[bp],ax	;is this it?
	jne	mlp21
	cmp	ss:logu[bp],bx
	je	mlp24		;yes
mlp21:	mov	dx,bp		;no, save ptr
	mov	bp,ss:next[bp]	;follow link
mlp22:	test	bp,bp		;is there more?
	jnz	mlp20		;loop if so
	; not on list, see if it could be a DOS disk
	or	bh,al		;2nd letter or unit specified?
	jnz	mlp26		;one or the other, invalid
	call	confrm		;yes, make sure confirmed
	push	ax		;save
	mov	dl,ah		;copy
	sub	dl,'A'-1	;convert to number
	mov	si,offset buf	;pt at buf
	mov	ah,47h		;func=get CWD
	int	21h		;(make sure drive is really there)
	jc	mlp23		;nope
	dec	dx		;numbers start at 0 for login
	mov	ah,0Eh		;func=log in
	int	21h
	jc	mlp23		;error, don't log in
	pop	ax		;restore
	mov	al,ah		;duplicate
	mov	word ptr ds:curdsk,ax ;log in
	mov	byte ptr ds:nprmpt,0 ;assume we can prompt
	jmp	mloop		;(will flush stack)
mlp23:	jmp	baddrv		;no such drive
mlp24:	; found it, relink at head of list
	call	confrm		;make sure confirmed
	mov	byte ptr ds:curdsk,0 ;don't use DOS drive
	test	dx,dx		;was there a prev rec?
	jz	mlp25		;it was already logged in, easy (flush stack)
	mov	bx,dx		;copy ptr
	mov	ax,ss:next[bp]	;unlink bp
	mov	ds:next[bx],ax
	mov	ax,bp		;copy
	xchg	ax,ds:logdev	;set new head of list, get old
	mov	ss:next[bp],ax	;link rest of list in
mlp25:	mov	byte ptr ds:nprmpt,0 ;assume we can prompt
	jmp	mloop		;reprompt (flush stack)
mlp26:	; error
	pop	cx		;restore length
	pop	dx		;and ptr
	mov	di,dx		;copy
	add	di,cx		;pt at end
	mov	al,'?'		;?
	stosb
	mov	ax,crlf		;<CRLF>
	stosw
	add	cl,3		;add to length
	mov	bx,0002h	;handle=STDERR
	mov	ah,40h		;func=write
	int	21h
	jmp	mloop
;
cmdtab:	;kw	<A-NALYZE>,analyz ;analyze floppy format
	kw	<B-OOT>,boot	;write bootstrap
	kw	<CD->,cd	;change directory
	kw	<CH-DIR>,cd	;syn. for CD
	kw	<CL-S>,cls	;clear screen
	kw	<CO-PY>,copy	;copy file(s)
	kw	<DEL-ETE>,delete ;delete file(s)
	kw	<DIR-ECTORY>,dir ;directory of device
	kw	<DIS-MOUNT>,dismnt ;dismount mounted device
	kw	<DUM-P>,dump	;dump a block
	kw	<EXI-T>,exit	;exit from program
	kw	<FOR-MAT>,format ;format floppy, create file, zero partition
	kw	<INI-TIALIZE>,init ;write blank file system
	kw	<MOU-NT>,mount	;mount disk or pseudo-disk
	kw	<Q-UIT>,exit	;syn. for EXIT
	kw	<SE-T>,set	;set parameters
	kw	<SH-OW>,show	;show device parameters
;;;;	kw	<SQ-UEEZE>,squeez ;make empty areas contiguous
	kw	<ST-OP>,exit	;syn. for EXIT
	kw	<TYP-E>,typ	;type a file
	kw	<VOL-UME>,vol	;print volume name
	kw	<WIPE-OUT>,wipe	;write zeros on unused blocks (for GZIP etc.)
 kw <WP->,wprot ;;;
	db	0
;+
;
; ^C exit vector.
;
;-
ctrlc:	mov	bx,-1		;mark indirect file as closed
	xchg	bx,cs:indhnd	;and get current handle (DS value not known)
	test	bx,bx		;is it open?
	js	ctrlc1		;no
	mov	ah,3Eh		;func=close
	int	21h
ctrlc1:	jmp	mloop		;restart
;+
;
; Analyze floppy format.
;
; I haven't decided what would be useful output from this.
;
;-
analyz:	call	gdevn		;parse device (if any)
	cmp	ss:dirinp[bp],offset dosdi ;is it a DOS disk?
	je	anlz99		;yes, doesn't count
	cmp	ss:hwtype[bp],hwflop ;is it a floppy disk?
	jne	anlz99		;no
	call	ss:defset[bp]	;set defaults
	call	ss:dsrini[bp]	;init for input
;;; need to do lots of stepping and looping:
	mov	byte ptr ds:flpcyl,0 ;init cyl to 0
;;; do next cyl
	mov	byte ptr ds:flphd,0 ;head too
;;; do next surface

;;; is there a way to wait for an index pulse?
;;; can't find it in FDC data sheets

	mov	ch,ds:flpcyl	;get cyl
	mov	dh,ds:flphd	;and head
	call	fdrid		;read ID
;	jc	...

;;; SI points to C,H,R,N

;;; loop until value repeats

;;; N.B. ints can screw us up, but we can't disable them
;;; maybe check twice and see if we got the same numbers?

	ret
anlz99:	cram	'?Must be floppy disk',error
;+
;
; Write bootstrap.
;
;-
boot:	call	gdevn		;parse device (if any)
	call	ss:defset[bp]	;set defaults
	callr	ss:wboot[bp]	;go, return
noboot:	cram	"?Don't know how to write bootstrap on that file system",error
;+
;
; Change directory.
;
;-
cd:	call	gdev		;parse device (if any)
	call	ss:defset[bp]	;set defaults
	call	skip		;anything given?
	jnc	cd1		;yes
	mov	di,offset lbuf	;pt at buffer
	call	pdev		;show device name
	xor	cx,cx		;no filename
	call	ss:dirnam[bp]	;show dir name
	jmp	flush		;flush, return
cd1:	callr	ss:chdir[bp]	;change dir, return
;+
;
; Clear screen.
;
;-
cls:	call	confrm		;make sure confirmed
;; should check for ANSI.SYS etc. and use ESC [2J if found
	mov	ah,0Fh		;func=get video mode
	int	10h
	xor	ah,ah		;func=set video mode
	int	10h
cret:	ret
;+
;
; COPY inspec [outspec]
;
;-
copy:	mov	ax,ds:bindef	;get default ASCII/binary flag
	mov	ds:binflg,ax	;set text mode by default
	mov	byte ptr ds:binswt,0 ;no /BINARY or /ASCII yet
	mov	byte ptr ds:devflg,0 ;no /DEV yet
	mov	byte ptr ds:ovride,0 ;don't override protection on output
	call	copswt		;check for switches
	; get input filespec
	call	gdev		;parse device name
	mov	ds:indev,bp	;save input dev rec
	call	ss:defset[bp]	;set defaults
	call	ss:gdir[bp]	;get dir name
	mov	di,offset fname1 ;pt at buffer
	xor	bl,bl		;no implied wildcards
	call	filnam		;parse filename
	xor	bx,bx		;input file
	call	ss:savcwd[bp]	;save dir
	call	copswt		;look for any more switches
	mov	byte ptr ds:notfnd,1 ;nothing found yet
	; get output filespec
	call	gdev		;get output dev name
	mov	ds:outdev,bp	;save output dev rec
	call	ss:defset[bp]	;set defaults
	call	ss:gdir[bp]	;get dir name
	mov	di,offset fname3 ;pt at buffer
	xor	bl,bl		;no implied wildcards
	call	filnam		;parse filename
	mov	bx,2		;output file
	call	ss:savcwd[bp]	;save dir
	call	copswt		;check for switches
	call	confrm		;make sure EOL
	; decide what we're doing
	mov	al,ds:devflg	;get /DEV, /FIL flag
	test	al,al		;either specified?
	jz	copy1
	 jmp	icopy		;[device image copy, SF set on AL]
copy1:	; copy file(s)
	mov	si,offset fname1 ;pt at source filespec
	cmp	byte ptr [si],0	;anything?
	jnz	copy2
	mov	word ptr [si],".*" ;no, change to *.*
	mov	byte ptr [si+2],'*'
copy2:	mov	di,offset fname3 ;pt at dest filespec
	cmp	byte ptr [di],0	;anything?
	jnz	copy4
copy3:	lodsb			;no, copy input filespec
	stosb
	test	al,al		;end?
	jnz	copy3		;loop if not
copy4:	mov	bp,ds:indev	;get input device again
	call	ss:dsrini[bp]	;init DSR
	xor	bx,bx		;input dev
	call	ss:rstcwd[bp]	;restore CWD
	call	ss:dirinp[bp]	;init dir input
	mov	bp,ds:outdev	;get output dev
	call	ss:dsrini[bp]	;init DSR
	mov	bx,2		;output dev
	call	ss:rstcwd[bp]	;restore CWD
	call	ss:dirout[bp]	;init dir I/O
copy5:	; check next file
	mov	bp,ds:indev	;get input device
	call	ss:dsrini[bp]	;init DSR
	xor	bx,bx		;switch to input dev
	call	ss:rstcwd[bp]
	call	ss:dirget[bp]	;get next entry
	jc	copy6		;no more
	jz	copy5		;skip empty areas and dirs
	mov	si,offset fname1 ;pt at source wildcard
	mov	bx,offset fname3 ;dest wildcard
	mov	dx,offset fname4 ;dest buffer
	push	di		;save
	call	mapwld		;check for match
	pop	di		;[restore]
	jne	copy5		;ignore
	; it's a match, type filenames
	mov	byte ptr ds:notfnd,0 ;found one
	call	flush		;display filename
	; open output file
	mov	bp,ds:outdev	;get output device
	call	ss:dsrini[bp]	;init DSR
	mov	bx,2		;switch to output
	call	ss:rstcwd[bp]
	mov	si,offset fname4 ;pt at filename
	call	ss:create[bp]	;create the file
	; copy the file
	mov	bp,ds:indev	;get input dev
	call	ss:dsrini[bp]	;init DSR
	xor	bx,bx		;switch to input
	call	ss:rstcwd[bp]
	call	ss:open[bp]	;open
	jc	copy7
	call	fcopy		;copy the file
	mov	bp,ds:indev	;get input device again
	call	ss:dsrini[bp]	;set up input dev
	xor	bx,bx		;select input dir
	call	ss:rstcwd[bp]
	call	ss:reset[bp]	;close input file
	mov	bp,ds:outdev	;get output dev
	call	ss:dsrini[bp]	;init
	mov	bx,2		;switch to output
	call	ss:rstcwd[bp]
	call	ss:close[bp]	;close output file
	jmp	short copy5	;look for more
copy6:	; no more (dir flushing is handled in MLOOP)
	cmp	byte ptr ds:notfnd,0 ;find anything?
	jz	$+5		;yes
	 jmp	fnf		;file not found
	ret
copy7:	jmp	dirio		;dir I/O err
;+
;
; Handle COPY switches.
;
;-
copswt:	call	skip		;skip white space
	jc	copsw3
	cmp	al,ds:swchar	;switch?
	jne	copsw3
	inc	si		;eat the /
	dec	cx
	call	getw		;get the switch
	jc	copsw1
	mov	ax,offset copsws ;point at switch list
	call	tbluk		;look it up
	jc	copsw2
	call	ax		;call the routine
	jmp	short copswt	;check for more
copsw1:	jmp	synerr		;missing switch
copsw2:	jmp	badswt		;bad switch
copsw3:	ret
;
copsws	label	byte
	kw	<A-SCII>,copasc	;/ASCII (convert to/from text)
	kw	<B-INARY>,copbin ;/BINARY (don't convert to/from text)
	kw	<D-EVICE>,copdev ;/DEVICE (source and/or dest are whole dev)
	kw	<F-ILES>,copfil	;/FILES (use w/DEV to say src or dst is file)
	kw	<OVERRIDE->,copovr ;/OVERRIDE (override prot on output file)
	db	0
;
copasc:	; /ASCII
	mov	ds:binflg,text	;set text mode
	mov	byte ptr ds:binswt,-1 ;flag given
	ret
;
copbin:	; /BINARY
	mov	ds:binflg,bin	;set binary mode
	mov	byte ptr ds:binswt,-1
	ret
;
copdev:	; /DEVICE
	or	byte ptr ds:devflg,1 ;set device flag (src ior dst is device)
	ret
;
copfil:	; /FILES
	or	byte ptr ds:devflg,200 ;set files flag (src xor dst is file)
	ret
;
copovr:	; /OVERRIDE
	mov	byte ptr ds:ovride,1 ;delete output file w/same name
	ret			;even if protected
;+
;
; COPY/DEV dev1: dev2:
; COPY/DEV/FILE dev1: dev2:file
; COPY/DEV/FILE dev1:file dev2:
;
; Make block-by-block image copy of entire device (or image file).
;
; /BINARY means to do it sector-by-sector.
;
; al	DEVFLG value
;	b0=/DEVICE, b7=/FILES
; FNAME1 .ASCIZ source filename
; FNAME3 .ASCIZ destination filename
;
;-
icopy:	mov	cx,bin		;use binary mode
	xchg	cx,ds:binflg	;set flag, get its value
.assume <(bin eq 0) and (text lt 400)>
	xor	cl,(bin xor text) ;flip it
	and	cl,ds:binswt	;/BINARY only if explicitly given
	mov	ds:secflg,cl	;save (NZ => /BINARY)
	mov	bl,ds:fname1	;get first char of each filename
	mov	bh,ds:fname3	;each will be NUL if no filename
	test	al,al		;/FILES?
	js	icpy2		;yes
	; just /DEVICE
	or	bl,bh		;neither filename should be given
	jnz	icpy1		;error if one is
	; make sure input and output aren't same device
	mov	bp,ds:indev	;get input dev
	cmp	bp,ds:outdev	;same as output dev?
	jne	icpy3		;skip if not
	jmp	iosame		;input and output devs are same
icpy1:	jmp	synerr
icpy2:	test	al,1		;can't have /FILES alone, needs /DEVICE too
	jz	icpy1
	cmp	bl,1		;normalize flags
	sbb	bl,bl		;0 if was non-zero, otherwise -1
	cmp	bh,1
	sbb	bh,bh
	add	bl,bh		;should have exactly one file
	inc	bl		;right?
	jnz	icpy1		;no
icpy3:	; open input device or file
	mov	bp,ds:indev	;get ptr
	call	ss:dsrini[bp]	;init DSR
	xor	bx,bx		;input dev
	call	ss:rstcwd[bp]	;restore CWD
	call	ss:dirinp[bp]	;init dir input (required even if raw)
	test	byte ptr ds:fname1,-1 ;is there an input filename?
	jnz	icpy6		;yes, find the file
	; input is device
	cmp	ss:dirinp[bp],offset dosdi ;is it a DOS disk?
	je	icpy5
	mov	ax,ss:devsiz[bp] ;get size
	mov	dx,ss:devsiz+2[bp]
	mov	ds:isize,ax	;save
	mov	ds:isize+2,dx
	; get device size in bytes
	test	byte ptr ds:secflg,-1 ;doing sector copy?
	jz	icpy7
	mov	al,ss:nsecs[bp]	;get # sectors
	mul	byte ptr ss:nhds[bp] ;* # heads
	mov	dl,ss:ncyls[bp]	;get # cyls
	xor	dh,dh		;DH=0
	mul	dx		;find total # of sectors
	mov	ds:isize,ax	;that's the real input size
	mov	ds:isize+2,dx
	; calculate actual size in bytes, may differ from image file size
	mov	bx,ax		;save low order
	mov	ax,ss:secsz[bp]	;get sector size
	mul	dx		;find high order
	xchg	ax,bx		;save, get low order sector count
	mul	word ptr ss:secsz[bp] ;multiply
	add	dx,bx		;add high order
	mov	bx,ss:med[bp]	;while we're here, check device type
	cmp	bx,flpbeg	;must be floppy for sector copy
	jb	icpy4
	cmp	bx,flpend
	jbe	icpy8
icpy4:	jmp	notflp
icpy5:	jmp	short icpy9
icpy6:	jmp	short icpy11
icpy7:	mov	cl,9d		;shift count
	rol	ax,cl		;left 9 bits
	shl	dx,cl		;make space
	mov	bx,ax		;copy
	and	bh,777/400	;trim to 9 bits
	xor	ax,bx		;isolate high 7
	or	dx,bx		;insert in MSW
icpy8:	mov	ds:fbcnt,ax	;save device size in bytes
	mov	ds:fbcnt+2,dx
	xor	ax,ax		;load 0
	mov	ds:iblk,ax	;init block #
	mov	ds:iblk+2,ax
	; get current date and time in case output is file
	mov	ax,ds:year	;get year
	mov	bx,word ptr ds:day ;month,,day
	mov	ds:fyear,ax	;save year
	mov	word ptr ds:fday,bx ;month,,day
	mov	byte ptr ds:fdatf,-1 ;date is valid
	mov	ax,word ptr ds:min ;get hour,,min
	mov	bl,ds:sec	;second
	mov	word ptr ds:fmin,ax ;save hour,,min
	mov	ds:fsec,bl	;second
	mov	byte ptr ds:ftimf,-1 ;time is valid
	mov	ax,offset iread	;pt at raw read routine
	jmp	short icpy12
icpy9:	cram	"?Can't read raw DOS disk",error
icpy10:	jmp	fnf
icpy11:	; find file (or first match if wildcard)
	call	ss:dirget[bp]	;get next entry
	jc	icpy10		;no more, file not found
	jz	icpy11		;skip empty areas and dirs
	mov	si,offset fname1 ;pt at wildcard
	call	wild		;check for match
	jne	icpy11		;ignore
	call	ss:open[bp]	;open it
	mov	ax,ss:read[bp]	;get read routine
icpy12:	; AX=read routine, open output file or device
	push	ax		;save
	mov	bp,ds:outdev	;get ptr
	call	ss:dsrini[bp]	;init DSR
	mov	bx,2		;output dev
	call	ss:rstcwd[bp]	;restore CWD
	call	ss:dirout[bp]	;init dir I/O (required even if raw)
	test	byte ptr ds:fname3,-1 ;is there an output filename?
	jnz	icpy17		;yes, create the file
	; output is device
	cmp	ss:dirinp[bp],offset dosdi ;is it a DOS disk?
	je	icpy16
	test	byte ptr ds:secflg,-1 ;doing sector copy?
	jz	icpy14
	mov	al,ss:nsecs[bp]	;get # sectors
	mul	byte ptr ss:nhds[bp] ;* # heads
	mov	dl,ss:ncyls[bp]	;get # cyls
	xor	dh,dh		;DH=0
	mul	dx		;find total # of sectors
	; calculate actual size in bytes, may differ from image file size
	mov	bx,ax		;save low order
	mov	ax,ss:secsz[bp]	;get sector size
	mul	dx		;find high order
	xchg	ax,bx		;save, get low order sector count
	mul	word ptr ss:secsz[bp] ;multiply
	add	dx,bx		;add high order
	mov	bx,ss:med[bp]	;while we're here, get device type
	cmp	bx,flpbeg	;must be floppy for sector copy
	jb	icpy13
	cmp	bx,flpend
	jbe	icpy15
icpy13:	jmp	notflp		;isn't
icpy14:	mov	cl,9d		;shift count
	rol	ax,cl		;left 9 bits
	shl	dx,cl		;make space
	mov	bx,ax		;copy
	and	bh,777/400	;trim to 9 bits
	xor	ax,bx		;isolate high 7
	or	dx,bx		;insert in MSW
icpy15:	xor	ax,ax		;load 0
	mov	ds:oblk,ax	;init block #
	mov	ds:oblk+2,ax
	mov	bx,offset iwrite ;pt at raw write/write-last routines
	mov	cx,offset iwlast
	jmp	short icpy18
icpy16:	cram	"?Can't write raw DOS disk",error
icpy17:	; create file
	mov	si,offset fname3 ;pt at filename
	call	ss:create[bp]	;create the file
	mov	bx,ss:write[bp]	;get write routines
	mov	cx,ss:wlast[bp]
icpy18:	; actually copy the device
	pop	ax		;restore read routine ptr
	call	dcopy		;copy the device
	; close input and output
	test	byte ptr ds:fname1,-1 ;was there an input file?
	jz	icpy19		;no
	mov	bp,ds:indev	;get input device again
	call	ss:dsrini[bp]	;set up input dev
	xor	bx,bx		;select input dir
	call	ss:rstcwd[bp]
	call	ss:reset[bp]	;close input file
icpy19:	test	byte ptr ds:fname3,-1 ;was there an output file?
	jz	icpy20		;no
	mov	bp,ds:outdev	;get output dev
	call	ss:dsrini[bp]	;init
	mov	bx,2		;switch to output
	call	ss:rstcwd[bp]
	call	ss:close[bp]	;close output file
icpy20:	ret
;+
;
; Read device data.
;
; On entry:
; es:di	ptr to buf (normalized)
; cx	# bytes free in buf (FFFF if >64KB)
; ss:bp	log dev rec
;
; On return:
; cx	# bytes really read (.LE. value on entry)
;
; CF=1 if nothing was read:
;  ZF=1 end of device
;  ZF=0 buffer not big enough to hold anything, needs to be flushed
;
;-
iread:	mov	bx,ds:isize	;get remaining size
	test	ds:isize+2,-1	;check high word
	jz	ird1		;zero, low word is right
	 mov	bx,-1		;say 64K blks (or sectors) -1
ird1:	test	bx,bx		;end of device?
	jz	ird5		;yes, ZF=1
	test	byte ptr ds:secflg,-1 ;sector copy?
	jnz	ird6		;yes
	; logical block mode
	mov	al,ch		;get # full blocks free in buf
	shr	al,1
	jz	ird4		;nothing, say so
	cbw			;AH=0
	cmp	ax,bx		;more than what's left?
	jb	ird2
	 mov	ax,bx		;stop at end of dev
ird2:	mov	cx,ax		;copy block count
	mov	ax,ds:iblk	;get starting block
	mov	dx,ds:iblk+2
	push	cx		;save # blks requested
	push	di		;save ptr (in case of retry)
	call	ss:rdblk[bp]	;read data
	pop	di		;[restore]
	pop	ax
	jc	ird7		;read error
ird3:	add	ds:iblk,ax	;success, update block
	adc	ds:iblk+2,0
	sub	ds:isize,ax	;update size
	sbb	ds:isize+2,0	;CF=0 (already checked)
	ret
ird4:	or	al,1		;clear ZF (buf full)
ird5:	stc			;set CF
	ret
ird6:	jmp	short ird8
ird7:	; read error, make sure we get the good surrounding blocks
	shr	ax,1		;try for half that many blocks (before bad one)
	jnz	ird2		;unless it was only one block
	push	es		;save
	push	di
	push	ds		;copy DS to ES
	pop	es
	mov	di,offset lbuf	;point at buf
	cram	'%Bad block '
	mov	ax,ds:iblk	;fetch it
	mov	dx,ds:iblk+2
	call	pdnum
	cram	' on input device'
	call	flush
	pop	si		;restore (into ES:SI like RTRD etc.)
	pop	es
	mov	ax,1		;block count=1
	mov	cx,512d		;byte count=one block
	jmp	short ird3	;go return it
ird8:	; sector mode
	mov	ax,cx		;copy count
	xor	dx,dx		;zero-extend
	div	ss:secsz[bp]	;find # complete sectors that will fit in buf
	test	ax,ax		;space for anything?
	jz	ird4		;no
	cmp	ax,bx		;more than what's left?
	jb	ird9
	 mov	ax,bx		;stop at end of dev
ird9:	mov	si,di		;put buf addr in ES:SI
	mov	cx,ax		;copy sector count
	mov	ax,ds:iblk	;get starting sector #
	mov	dx,ds:iblk+2
	mov	ds:flpvec,offset secxrd ;point at read routine
	call	secxfr		;read a track, or partial track if no space
	add	ds:iblk,cx	;update block #
	adc	ds:iblk+2,0
	sub	ds:isize,cx	;remove from count
	sbb	ds:isize+2,0
	mov	ax,cx		;copy
	mul	ss:secsz[bp]	;find # bytes read
	mov	cx,ax		;in CX
	clc			;happy
	ret
;+
;
; Write to device.
;
; es:si	buffer
; cx	length of data
; ss:bp	log dev rec
;
; On return, cx contains the number of bytes actually written (presumably a
; multiple of the clustersize), .LE. the value on entry.
;
;-
iwrite:	test	byte ptr ds:secflg,-1 ;sector copy?
	jnz	iwr3		;yes
	mov	al,ch		;get # full 512-byte blocks
	shr	al,1
	jz	iwr1		;nothing, skip
	cbw			;AH=0
	push	cx		;save
	mov	cx,ax		;copy
	mov	ax,ds:oblk	;get starting block #
	mov	dx,ds:oblk+2
	add	ds:oblk,cx	;update
	adc	ds:oblk+2,0
	call	ss:wrblk[bp]	;write data
	pop	cx		;[restore]
	jc	iwr2		;failed
iwr1:	and	cx,not 777	;truncate byte count (wrote whole blks only)
	ret
iwr2:	jmp	wrerr		;error
iwr3:	; sector mode
	mov	ax,cx		;copy count
	xor	dx,dx		;zero-extend
	div	ss:secsz[bp]	;find # complete sectors that can be written
	test	ax,ax		;space for anything?
	jz	iwr4		;no
	mov	cx,ax		;copy sector count
	mov	ax,ds:oblk	;get starting sector #
	mov	dx,ds:oblk+2
	mov	ds:flpvec,offset secxwr ;point at write routine
	call	secxfr		;write a track, or partial track if no space
	add	ds:oblk,cx	;update block #
	adc	ds:oblk+2,0
	mov	ax,cx		;copy
	mul	ss:secsz[bp]	;find # bytes written
	mov	cx,ax		;in CX
	ret
iwr4:	xor	cx,cx		;can't write even one sector
	ret
;+
;
; Write last buffer of data to output device.
;
; es:si	string
; cx	length of data
; ss:bp	log dev rec
;
;-
iwlast:	jcxz	iwl1		;none, skip
	mov	bx,512d		;block size
	test	byte ptr ds:secflg,-1 ;sector copy?
	jz	iwl2		;no
	 mov	bx,ss:secsz[bp]	;yes, use sector size instead
iwl2:	sub	bx,cx		;find # NULs to add (in [1,SIZE))
	xchg	bx,cx		;swap
	lea	di,[bx+si]	;point past data
	xor	al,al		;load 0
	rep	stosb		;pad it out
	sub	di,si		;find length
	mov	cx,di		;copy
	jmp	iwrite		;write data, return
iwl1:	ret
;+
;
; Transfer sectors to/from floppy.
;
; We only try to transfer one track at a time.  If there's more space in the
; buffer, FCOPY will call right back anyway so there's no point in getting all
; tangled up maintaining the current block number and counts of the number of
; sectors transferred and the number left to go.
;
; dx:ax	starting sector #
; cx	# sectors to copy
; es:si	buffer (updated on return)
; FLPVEC points to single-sector read or write routine, called with:
;	es:si	buffer addr
;	FLPCYL	cylinder
;	FLPHD	head
;	cl	sector
;
; Returns:
; cx	actual # sectors transferred
;
;-
secxfr:	; transfer one sector at a time if not at beginning of track
	mov	bl,ss:nsecs[bp]	;get # sectors/track
	xor	bh,bh
	div	bx		;DL=sector-1, AX=cyl*nhds+head
	mov	di,ax		;save
	div	byte ptr ss:nhds[bp] ;AH=head, AL=cyl
	mov	ds:flphd,ah	;save
	mov	ds:flpcyl,al
	mov	ax,di		;get cyl*nhds+head again
	test	dl,dl		;at begn of track?
	jnz	secx1		;no, just do one sector at a time
	; also do one at a time if buf too small for whole track
	cmp	cx,bx		;>=1 track?
	jae	secx4		;yes
secx1:	; transfer one sector at a time until buf full or reached end of track
	mov	di,cx		;copy # to go
	inc	dx		;sectors start at 1, not 0
	xor	bx,bx		;init count of # actually done
	mov	cl,dl		;copy starting sector
secx2:	push	di		;save
	push	bx
	push	cx
	call	ds:flpvec	;read or write
	pop	cx		;[restore]
	pop	bx
	pop	di
	inc	bx		;count it
	inc	cx		;bump to next sector
	dec	di		;done all?
	jz	secx3		;yes
	cmp	cl,ss:nsecs[bp]	;more to do?
	jbe	secx2		;yes, loop until reach EOT or satisfy count
secx3:	mov	cx,bx		;copy # sectors transferred
	ret
secx4:	; transfer an entire track, doing the sectors out of order so as to get
	; 2:1 soft interleave, the data are transferred to and from the buffer
	; at the correct offsets so the interleave doesn't affect the data
	; transferred, just the speed (this is assuming we're too slow for 1:1
	; interleave, if this isn't true, which may well be the case these
	; days, then this is actually slower than the obvious approach! should
	; do some timing to find out)
	mov	cl,ss:nsecs[bp]	;get # sectors
	mul	word ptr ds:copskw ;figure out soft skew factor
	xor	ch,ch		;CH=0
	div	cx		;DL=starting sector (numbered starting at 0)
	mov	bl,dl		;copy
	push	es		;save
	push	ds		;copy DS to ES
	pop	es
	mov	di,offset buf	;pt at buf
	xor	ch,ch		;CX=# sectors
	xor	al,al		;load 0
	mov	dx,cx		;save
	rep	stosb		;nuke out table
	pop	es		;restore
	xor	bh,bh		;nuke high byte
secx5:	cmp	ds:buf[bx],bh	;have we done this one?
	jz	secx6		;no
	inc	bl		;+1 (wrapping to 0 not a prob)
	cmp	bl,ss:nsecs[bp]	;off end of track?
	jb	secx5		;no, check this loc
	sub	bl,ss:nsecs[bp]	;wrap
	jmp	short secx5
secx6:	not	byte ptr ds:buf[bx] ;set flag
	push	bx		;save
	push	dx
	push	si
	mov	cl,bl		;get sector
	inc	cx		;starts at 1
	mov	ax,ss:secsz[bp]	;get sector size
	mul	bx		;find byte offset from base of track
	add	si,ax		;index from curr ptr
	call	ds:flpvec	;transfer the sector
	pop	si		;restore
	pop	dx
	pop	bx
	dec	dx		;done all?
	jz	secx8		;yes
	add	bl,ds:copilv	;bump to next sector
	jc	secx7		;wrapped for sure
	cmp	bl,ss:nsecs[bp]	;off EOT?
	jb	secx5
secx7:	sub	bl,ss:nsecs[bp]	;wrap
	jmp	short secx5
secx8:	; finished transferring track
	mov	ax,ss:secsz[bp]	;get sector size
	mov	cl,ss:nsecs[bp]	;get # sectors read
	xor	ch,ch
	mul	cx		;compute size of track in bytes
	add	si,ax		;update ptr in case continuing
	ret
;+
;
; Read sector for SECXFR.
;
; ss:bp	log dev rec
; FLPCYL cyl #
; FLPHD	head #
; cl	sector #
; es:si	buffer pointer (updated on return)
;
;-
secxrd:	push	es		;save
	push	si
	push	cx
	push	ds		;copy DS to ES
	pop	es
	mov	ch,ds:flpcyl	;get cyl
	mov	dh,ds:flphd	;and head
	call	ss:rdsec[bp]	;read it
	jc	scxrd2
	pop	ax		;flush sector #
scxrd1:	pop	di		;restore buffer ptr
	pop	es
	mov	si,ds:dbuf	;point at buf
	mov	cx,ss:secsz[bp]	;get sector size
	shr	cx,1		;word count
	rep	movsw		;copy
	mov	si,di		;updated buf addr
	ret
scxrd2:	; read error, print message
	push	ds		;copy DS to ES
	pop	es
	mov	di,offset lbuf	;point at buf
	cram	'%Read error, track '
	mov	al,ds:flpcyl	;print cyl
	call	pbyte
	cmp	ss:nhds[bp],2	;double sided?
	jb	scxrd3		;no
	cram	', head '
	mov	al,ds:flphd	;print head
	call	pbyte
scxrd3:	cram	', sector '
	pop	ax		;print sector
	call	pbyte
	call	flush
	jmp	short scxrd1
;+
;
; Write sector for SECXFR.
;
; ss:bp	log dev rec
; FLPCYL cyl #
; FLPHD	head #
; cl	sector #
; es:si	buffer pointer (updated on return)
;
;-
secxwr:	push	es		;save
	push	cx		;save sector #
	mov	di,ds:dbuf	;point at buf
	mov	ax,ds		;get segs
	mov	bx,es
	mov	ds,bx		;swap
	mov	es,ax
	mov	cx,ss:secsz[bp]	;get sector size
	shr	cx,1		;/2
	rep	movsw		;copy into buf
	mov	ds,ax		;restore
	pop	cx
	mov	ch,ds:flpcyl	;get cyl
	mov	dh,ds:flphd	;and head
	cmp	ch,ss:ncyls[bp]	;off end of disk?
	jae	scxwr1		;punt if so (wrote all that would fit already)
	push	si		;save pointer
	call	ss:wrsec[bp]	;write it
	jc	scxwr2		;error
	pop	si		;restore
	pop	es
	ret
scxwr1:	jmp	odsmal
scxwr2:	mov	di,offset lbuf	;point at buf
	cram	'%Write error, track '
	mov	al,ds:flpcyl	;print cyl
	call	pbyte
	cmp	ss:nhds[bp],2	;double sided?
	jb	scxwr3		;no
	cram	', head '
	mov	al,ds:flphd	;print head
	call	pbyte
scxwr3:	cram	', sector '
	pop	ax		;print sector
	call	pbyte
	call	flush
	pop	si		;restore
	pop	es
	ret
;+
;
; Copy a file or device.
;
; DS:INDEV ptr to input log dev rec
; DS:OUTDEV ptr to output log dev rec
;
; For copying devices, enter at DCOPY with:
; ax	ptr to READ routine
; bx	ptr to WRITE routine
; cx	ptr to WLAST routine
;
;-
fcopy:	mov	bp,ds:indev	;get input dev
	mov	ax,ss:read[bp]	;get read routine
	mov	bp,ds:outdev	;get output dev
	mov	bx,ss:write[bp]	;get write routines
	mov	cx,ss:wlast[bp]
dcopy:	; enter here with AX, BX, CX set up
	mov	ds:aread,ax	;save
	mov	ds:awrite,bx
	mov	ds:awlast,cx
	mov	byte ptr ds:eof,0 ;not EOF yet
	mov	ax,ds:bigbuf	;get ptr to buf
	mov	ds:bigptr+2,ax	;save
	mov	ds:bigptr,0	;offset=0
	mov	ax,ds:bigsiz	;get size of buf
	mov	ds:bigctr,ax
	mov	ax,ds:bigsiz+2
	mov	ds:bigctr+2,ax
fcpy1:	; fill buffer
	mov	bp,ds:indev	;get input dev
	call	ss:dsrini[bp]	;select it
	xor	bx,bx		;select dir
	call	ss:rstcwd[bp]
fcpy2:	; do next read
	mov	cx,ds:bigctr	;get # bytes left
	cmp	ds:bigctr+2,0	;is it more than 64KB?
	jz	$+5
	 mov	cx,-1		;stop just short
	les	di,dword ptr ds:bigptr ;get ptr
	mov	ax,cx		;copy
	add	ax,di		;will this wrap around?
	jnc	fcpy3		;no
	mov	cx,di		;copy
	not	cx		;# bytes until EOB-1 (so ADD won't overflow)
fcpy3:	call	ds:aread	;read as much as we can
	jc	fcpy4		;EOF or EOB, skip
	sub	ds:bigctr,cx	;eat this chunk
	sbb	ds:bigctr+2,0
	add	cx,ds:bigptr	;advance ptr (don't carry!)
	mov	ax,cx		;copy
	and	cx,0Fh		;normalize ptr
	mov	ds:bigptr,cx
	mov	cl,4		;shift count
	shr	ax,cl		;get # whole pars advanced
	add	ds:bigptr+2,ax	;update
	jmp	short fcpy2	;scarf more
fcpy4:	jnz	fcpy5		;skip
	inc	ds:eof		;set EOF flag
fcpy5:	; empty buffer as much as possible
	mov	bp,ss:outdev	;get output dev rec
	call	ss:dsrini[bp]	;select it
	mov	bx,2		;select dir too
	call	ss:rstcwd[bp]
	mov	ax,ds:bigsiz	;get size of buffer
	mov	dx,ds:bigsiz+2
	sub	ax,ds:bigctr	;-amount free = amount used
	sbb	dx,ds:bigctr+2
	mov	ds:bigctr,ax	;save
	mov	ds:bigctr+2,dx
	mov	ax,ds:bigbuf	;reinit ptr
	mov	ds:bigptr+2,ax
	mov	ds:bigptr,0	;offset=0
fcpy6:	; do next write
	mov	cx,ds:bigctr	;get # bytes left
	cmp	ds:bigctr+2,0	;is it more than 64KB?
	jz	$+5
	 mov	cx,-1		;stop just short
	jcxz	fcpy8		;EOF
	les	si,dword ptr ds:bigptr ;get ptr
	mov	ax,cx		;copy
	add	ax,si		;will this wrap around?
	jnc	fcpy7		;no
	mov	cx,si		;copy
	not	cx		;# bytes until EOB-1
fcpy7:	call	ds:awrite	;write as much as we can
	jcxz	fcpy8		;can't, skip
	sub	ds:bigctr,cx	;eat this chunk
	sbb	ds:bigctr+2,0
	add	cx,ds:bigptr	;advance ptr
	mov	ax,cx		;copy
	and	cx,0Fh		;normalize
	mov	ds:bigptr,cx
	mov	cl,4		;shift count
	shr	ax,cl		;get # whole pars advanced
	add	ds:bigptr+2,ax	;update
	jmp	short fcpy6	;write more
fcpy8:	; copy what's left back to begn of buffer so we can read more
	; (assume all clustersizes<(64KB-16.) so we can do it in one go)
	mov	cx,ds:bigctr	;get low word of length
	push	ds		;save
	mov	es,ds:bigbuf	;set up dest
	xor	di,di
	lds	si,dword ptr ds:bigptr ;get source
	mov	bx,cx		;save length
	shr	cx,1		;/2 to get wc
	rep	movsw		;[copy words]
	rcl	cl,1		;catch CF
	rep	movsb		;copy odd byte if any
	pop	ds		;restore
	cmp	byte ptr ds:eof,0 ;is that it?
	jnz	fcpy9		;yes
	mov	ax,di		;copy ptr
	and	di,0Fh		;offset
	mov	ds:bigptr,di	;save
	mov	cl,4		;bit count
	shr	ax,cl		;find offset in paragraphs
	add	ax,ds:bigbuf	;add base
	mov	ds:bigptr+2,ax	;save segment
	mov	ax,ds:bigsiz	;get size of buf
	mov	dx,ds:bigsiz+2
	sub	ax,bx		;find # free bytes
	sbb	dx,0
	mov	ds:bigctr,ax	;save
	mov	ds:bigctr+2,dx
	jmp	fcpy1		;refill buffer
fcpy9:	; end of file, force whatever's left out (CX=byte count)
	mov	cx,bx		;get count again
	mov	es,ds:bigbuf	;pt at beginning
	xor	si,si
	call	ds:awlast	;write last buffer to disk
	push	ds		;copy DS to ES
	pop	es
	ret
;+
;
; Delete file(s).
;
;-
delete:	mov	byte ptr ds:noqry,0 ;init flags
	mov	byte ptr ds:ovride,0
	call	delswt		;check for switches
	; get filespec
	call	gdev		;parse device name, get dev rec in bp
	call	ss:defset[bp]	;set defaults
	call	ss:gdir[bp]	;get dir name
	mov	di,offset fname1 ;pt at buffer
	xor	bl,bl		;no implied wildcards
	call	filnam		;parse filename
	call	delswt		;check for switches
	call	confrm		;make sure EOL
	call	ss:dsrini[bp]	;init DSR
	call	ss:dirinp[bp]	;init dir I/O
	mov	byte ptr ds:notfnd,1 ;nothing found yet
	; init fake output device
	mov	ds:indev,bp	;set input device
	mov	ds:outdev,bp	;it's both really, doesn't matter
del1:	; check next file
	call	ss:dirget[bp]	;get next entry
	jc	del4		;no more
	jz	del1		;skip empty areas
	mov	si,offset fname1 ;pt at wildcard
	push	di		;save
	call	wild		;check for match
	pop	di		;[restore]
	jne	del1		;ignore
	; it's a match, type filename
	mov	byte ptr ds:notfnd,0 ;found one
	cmp	byte ptr ds:noqry,0 ;should we ask before deleting?
	jnz	del2		;no
	mov	byte ptr ds:lnum,4 ;don't **MORE** (query, error, prompt, +1)
	mov	ax," ?"		;'? '
	stosw
	call	flush1		;print prompt
	call	yorn		;yes or no?
	jc	del1		;loop if no
	jmp	short del3
del2:	call	flush		;display filename
del3:	; delete the file
	call	ss:delfil[bp]	;delete it
	jmp	short del1	;look for more
del4:	; no more
	call	ss:dirfin[bp]	;finish up dir I/O
	cmp	byte ptr ds:notfnd,0 ;find anything?
	jz	$+5		;yes
	 jmp	fnf		;file not found
	ret
del5:	jmp	dirio		;dir I/O err
;+
;
; Handle DELETE switches.
;
;-
delswt:	call	skip		;skip white space
	jc	delsw3
	cmp	al,ds:swchar	;switch?
	jne	delsw3
	inc	si		;eat the /
	dec	cx
	call	getw		;get the switch
	jc	delsw1
	mov	ax,offset delsws ;point at switch list
	call	tbluk		;look it up
	jc	delsw2
	call	ax		;call the routine
	jmp	short delswt	;check for more
delsw1:	jmp	synerr		;missing switch
delsw2:	jmp	badswt		;bad switch
delsw3:	ret
;
delsws	label	byte
	kw	<NOQ-UERY>,delnoq ;/NOQUERY (don't prompt before deleting)
	kw	<OVERRIDE->,delovr ;/OVERRIDE (override protection)
	db	0
;
delnoq:	mov	byte ptr ds:noqry,1 ;set flag
	ret
;
delovr:	mov	byte ptr ds:ovride,1 ;set flag
	ret
;+
;
; Directory of file(s).
;
;-
dir:	mov	byte ptr ds:dirflg,0 ;no flags set
	call	dirswt		;handle switches
	; get filename
	call	gdev		;parse device name, get dev rec in bp
	call	ss:defset[bp]	;set defaults
	call	ss:gdir[bp]	;get dir name
	mov	di,offset fname1 ;pt at buffer
	mov	bl,1		;implied wildcards
	call	filnam		;parse filename
	call	dirswt		;handle switches
	call	confrm		;make sure confirmed
	call	ss:dsrini[bp]	;init DSR (switch drives etc.)
	; print banner
	call	pvol		;print volume name (leave di=lbuf)
	cram	' Directory of '
	call	pdev		;print dev name
	mov	cx,1		;filename follows directory name
	call	ss:dirnam[bp]	;print dir name
	mov	si,offset fname1 ;pt at buffer
	cmp	byte ptr [si],0	;is there a wildcard?
	jnz	dir5		;yes, good
	mov	si,offset wldcrd ;no, use "*.*"
dir5:	lodsb			;get a byte
	test	al,al		;end?
	jz	dir6
	stosb			;store
	jmp	short dir5
dir6:	call	flush		;print line
	call	flush		;blank line
	call	ss:dirhdr[bp]	;print header
	call	ss:dirinp[bp]	;init dir input
	mov	byte ptr ds:notfnd,1 ;nothing found yet
dir7:	; process next file
	call	ss:dirget[bp]	;get next entry
	jc	dir10		;end of list
	jnz	dir8		;not .EMPTY.
	; empty area
	cmp	byte ptr ds:fname1,0 ;do we have a filename?
	jnz	dir7		;yes, skip empties
	call	ss:diremp[bp]	;display it
	call	flush		;flush it
	jmp	short dir7
dir8:	cmp	byte ptr ds:fname1,0 ;do we have a wildcard?
	jz	dir9		;no
	; check to see if wildcard match
	push	di		;save output line ptr
	mov	si,offset fname1 ;pt at 1st
	call	wild		;does it?
	pop	di		;[restore]
	jne	dir7		;no, skip
dir9:	mov	byte ptr ds:notfnd,0 ;found one
	call	ss:dirdis[bp]	;display file
	; end of line
	call	flush		;flush it
	jmp	short dir7	;around for more
dir10:	call	ss:dirfin[bp]	;finish up
	cmp	byte ptr ds:notfnd,0 ;find anything?
	jz	dir11
	call	fnf		;no
dir11:	call	ss:dirsum[bp]	;print summary
	mov	di,offset lbuf	;blank line
	callr	flush
;+
;
; Handle DIRECTORY switches.
;
;-
dirswt:	call	skip		;skip white space
	jc	dirsw3
	cmp	al,ds:swchar	;switch?
	jne	dirsw3
	inc	si		;eat the /
	dec	cx
	call	getw		;get the switch
	jc	dirsw1
	mov	ax,offset dirsws ;point at switch list
	call	tbluk		;look it up
	jc	dirsw2
	call	ax		;call the routine
	jmp	short dirswt	;check for more
dirsw1:	jmp	synerr		;missing switch
dirsw2:	jmp	badswt		;bad switch
dirsw3:	ret
;
dirsws	label	byte
	kw	<F-ULL>,dirfu	;/FULL (verbose listing)
	db	0
;
dirfu:	; /FULL
	or	byte ptr ds:dirflg,200 ;show everything
	ret
;+
;
; DISMOUNT ddu: [/UNLOAD]
;
; Dismount mounted logical device.
;
;-
dismnt:	mov	al,ds:dsmunl	;get /[NO]UNLOAD default
	mov	byte ptr ds:unlswt,al ;init flag
	call	dmtswt		;handle switches
	call	gdevn		;look up device
	call	dmtswt		;handle switches
	call	confrm		;should be EOL
	cmp	ss:dirinp[bp],offset dosdi ;is it a DOS disk?
	je	dsmt1		;yes, no good (no permanent dev record anyway)
	mov	al,ds:unlswt	;get switch
	jmp	short dmnt	;dismount it, return
dsmt1:	cram	"?Can't dismount DOS disk",error
;
dmtswt:	; handle DISMOUNT switches
	call	skip		;skip white space
	jc	dmtsw3
	cmp	al,ds:swchar	;switch?
	jne	dmtsw3
	inc	si		;eat the /
	dec	cx
	call	getw		;get the switch
	jc	dmtsw1
	mov	ax,offset dmtsws ;point at switch list
	call	tbluk		;look it up
	jc	dmtsw2
	mov	ds:unlswt,al	;save value
	jmp	short dmtswt	;check for more
dmtsw1:	jmp	synerr		;missing switch
dmtsw2:	jmp	badswt		;bad switch
dmtsw3:	ret
;
dmtsws	label	byte
	kw	<NOUN-LOAD>,0
	kw	<UN-LOAD>,1
	db	0
;+
;
; Dismount device whose logical dev record is at SS:BP.
;
; al	NZ => unload volume (if supported)
;
;-
dmnt:	cmp	ss:hwtype[bp],hwfile ;image file?
	jne	dmnt1
	mov	bx,ss:handle[bp] ;yes, get handle
	mov	ah,3Eh		;func=close
	int	21h
dmnt1:	cmp	ss:hwtype[bp],hwaspi ;ASPI?
	jne	dmnt2		;no
	test	al,al		;/UNLOAD?
	jz	dmnt2		;no
	mov	ds:ssunt1,ds	;set seg addr of BUF
	mov	si,offset ssunt	;pt at cmd to start/stop drive
	mov	cx,lssunt
	call	aspcmd		;send cmd
	jnc	dmnt2		;success
	cram	'?Error ejecting disk',error
dmnt2:	; unlink from dev list
	mov	ax,ss:next[bp]	;get link
	mov	bx,ds:logdev	;get head of list
	cmp	bx,bp		;is this it?
	je	dmnt4		;easy
dmnt3:	; find it on logical dev list
	mov	si,bx		;save ptr
	mov	bx,ds:next[bx]	;follow link
	cmp	bx,bp		;is this it?
	jne	dmnt3		;loop if not
	mov	ds:next[si],ax	;unlink
	jmp	short dmnt5
dmnt4:	; this rec was first on list, change back to DOS disk
	mov	ds:logdev,ax	;unlink
	mov	al,ds:dosdsk	;get DOS disk
	mov	ds:curdsk,al	;make it the logged-in device
dmnt5:	jmp	retrec		;flush record, return
;
if 1 ;;; playing with Zip disks
;
wprot:	call	gdevn		;look up device
	call	confrm		;should be EOL
	cmp	ss:hwtype[bp],hwaspi ;ASPI?
	jne	wprot1		;no
	mov	ds:wpzip1,ds	;set seg addr of BUF
	mov	si,offset wprots
	mov	cx,wprotl
	mov	ds:wpzipl,cx	;save length
	mov	ds:wpzips,cl
	mov	di,offset buf
	rep	movsb		;copy into buf
	mov	si,offset wpzip	;command to write prot/enable Zip
	mov	cx,lwpzip
	call	aspcmd		;send cmd
	jnc	wprot1		;success
	cram	'?Error diddling Zip disk',error
wprot1:	ret
;
;wprots	db	'APlaceForYourStuff'
;wprots	db	'GoToHell'
wprots	db	'FOO'
wprotl=	$-wprots
;
endif
;+
;
; DUMP dev:nnnn
;
; Dump block nnnn (octal) in octal and sixbit.
;
;-
dump:	call	gdev		;get dev name
;;;	cmp	ss:fsys[bp],0	;doesn't work for native devices
;;;	je	...
	call	getn		;get a number
	mov	cx,1		;read 1 block
	mov	di,offset buf	;pt at temp buf
	call	ss:rdblk[bp]	;get the block
	jnc	dump1
	jmp	rderr
dump1:	xor	ax,ax		;offset
dump2:	; do next line
	push	ax		;save
	mov	di,offset lbuf	;pt at buf
	mov	cx,3		;digit count
	call	poct		;print offset
	mov	ax," /"		;'/ '
	stosw
	mov	cx,8d		;loop count
dump3:	; dump bytes in octal
	push	cx		;save
	lodsb			;get a word
	mov	cx,3		;digit count
	call	poct		;write it
	mov	al,' '		;blank
	stosb
	pop	cx		;restore
	loop	dump3		;loop
	stosb			;add another blank
	sub	si,8d		;back to begn
	mov	cl,8d		;reload counter
dump4:	; dump ASCII bytes
	lodsb			;get a byte
	and	al,177		;trim to 7 bits
	cmp	al,' '		;printing char?
	jb	dump5
	cmp	al,177
	jb	dump6
dump5:	mov	al,'.'		;no, change to dot
dump6:	stosb			;save
	loop	dump4		;loop
	push	si		;save
	call	flush		;flush line
	pop	si		;restore
	pop	ax
	add	ax,10		;skip to next 8. bytes
	cmp	si,offset buf+512d ;done all of block?
	jne	dump2		;loop
	ret
;+
;
; Exit.
;
;-
exit:	; dismount all devices
	mov	bp,ds:logdev	;get head of list
	test	bp,bp		;anything?
	jz	exit1
	mov	al,ds:dsmunl	;get /[NO]UNLOAD default
	call	dmnt		;dismount it
	jmp	short exit	;handle new head of list, until none
exit1:	; reset floppy system
	xor	dl,dl		;say drive 0
	xor	ah,ah		;func=reset
	int	13h
	int	20h		;exit
;+
;
; FORMAT dev: /switches
; (see GMOUNT for switches)
;
;-
format:	mov	bx,-1		;don't get logical name
	mov	ds:othswt,offset inisw ;"INIT" switch table
	mov	ds:nsegs,0	;(use default if no /SEGMENTS:n switch)
	call	gmount		;parse stuff, get temp rec at SS:BP
	call	crtdev		;create device (instead of OPNDEV)
	cmp	ss:hwtype[bp],hwfile ;image file?
	jne	fmt3
	mov	ax,ss:med[bp]	;get medium type
	test	ax,ax		;defaulted?
	jz	fmt1
	cmp	ax,mscp		;MSCP?
	jne	fmt2
fmt1:	; prompt for size of image file
	cram	'File size (bytes): ',wrng
	call	gtlin		;get line
	call	getn		;read number
	and	ax,not 777	;trim to 512 bytes
	mov	ss:totsiz[bp],ax ;save
	mov	ss:totsiz+2[bp],dx
	jmp	short fmt3
fmt2:	; if image file of floppy, see if it should be interleaved
	cmp	ax,flpbeg	;is it a floppy?
	jb	fmt3
	cmp	ax,flpend
	ja	fmt3
	 call	askilv		;yes, decide whether to interleave
fmt3:	cmp	ss:hwtype[bp],hwflop ;floppy?
	jne	fmt6
	test	ss:med[bp],-1	;yes, medium type specified?
	jnz	fmt6
	mov	bl,ss:drive[bp]	;get drive #
	xor	bh,bh
	mov	al,ds:fdtype[bx] ;look up drive type
	test	al,al		;known?
	jz	fmt4		;no, assume they have at least some plan
	cmp	al,rx33		;1.2MB drive?
	jne	fmt5		;no
fmt4:	mov	al,rx50		;otherwise default to RX50
fmt5:	xor	ah,ah		;AH=0
	mov	ss:med[bp],ax	;save
fmt6:	call	setmed		;set medium-related stuff
	call	setsys		;set file system related stuff
fmt7:	; format volume
	mov	bx,ss:hwtype[bp] ;get hardware type
	call	ds:fmthw[bx]	;dispatch (format the volume)

;;; should do DLBAD/DMBAD as a separate step (dev-independent)

;;; then add null BAD.TSK style bad blk list in last good data block

	; do file-system-specific software init
	test	ss:fsys[bp],-1	;did they specify a file system?
	jz	fmt8		;no, don't try to write a blank one
	; write blank file system (if specified)
	mov	bx,ss:fsys[bp]	;get file system
	mov	si,offset inisys ;pt at table
	call	wdluk		;look it up
	jc	fmt8
	 call	ax		;init
fmt8:	cmp	ss:hwtype[bp],hwflop ;floppy drive?
	jne	fmt10
fmt9:	; prompt to format more if floppy
	cram	'Format more disks (Y/N)? ',wrng
	call	gtlin		;read a line
	call	getw		;get their answer
	jc	fmt9		;if any
	cmp	byte ptr [bx],'Y' ;does it start with 'Y'?
	je	fmt7
fmt10:	ret
;
_=0
fmthw	label	word
	disp	hwfile,fmtimg	;format image file
	disp	hwflop,fmtflp	;format floppy
	disp	hwpart,fmthdp	;format hard disk partition
	disp	hwtu58,cret	;format TU58 (nothing to do)
;+
;
; Format image file.
;
;-
fmtimg:	mov	ax,ss:totsiz[bp] ;get total size
	mov	dx,ss:totsiz+2[bp]
	sub	ax,ds:badsec	;subtract bad sector file info from SETMED
	sbb	dx,ds:badsec+2
	mov	ds:fbcnt,ax	;save
	mov	ds:fbcnt+2,dx
	; write FBCNT zeros
	mov	es,ds:bigbuf	;point at buffer
	xor	di,di		;point at beginning
	mov	cx,ds:bigsiz	;get size
	cmp	ds:bigsiz+2,di	;is that it?
	jz	fmti1
	 mov	cx,-1		;no, >64KB so stop at end
fmti1:	mov	ds:bigctr,cx	;save length
	xor	ax,ax		;load 0
	shr	cx,1		;/2
	rep	stosw		;clear out begn of buf
	adc	cl,cl		;get CF back
	rep	stosb		;clear odd byte
fmti2:	; write next buffer of zeros
	mov	es,ds:bigbuf	;pt at buffer
	mov	cx,ds:bigctr	;get # bytes in buf, or 64KB-1
	test	ds:fbcnt+2,-1	;almost done?
	jnz	fmti3		;no
	cmp	ds:fbcnt,cx	;yes, should we truncate?
	jae	fmti3
	 mov	cx,ds:fbcnt	;yes
fmti3:	jcxz	fmti4		;nothing to write, done
	mov	bx,ss:handle[bp] ;get file handle
	push	ds		;save
	push	es		;copy ES to DS
	pop	ds
	xor	dx,dx		;offset=0
	mov	ah,40h		;func=write
	int	21h
	pop	ds		;[restore]
	jc	fmti7		;error
	cmp	ax,cx		;did we write all?
	jne	fmti7
	sub	ds:fbcnt,ax	;subtract
	sbb	ds:fbcnt+2,0
	jmp	short fmti2	;loop
fmti4:	; all done with zeros, add bad block file if any
	xor	di,di		;point at begn of buf
	mov	cx,ds:bigctr	;get # bytes in first page of buf
	; ES:DI=byte after last byte to be written, CX=# bytes free there
	; add bad block file if appropriate
	mov	bx,ds:tmed	;get medium type
	mov	si,offset filbad ;pt at table
	call	wdluk		;look it up
	jc	fmti5
	 call	ax		;add it, update DI
fmti5:	mov	cx,di		;copy
	jcxz	fmti6		;nothing to write, skip
	mov	bx,ss:handle[bp] ;get file handle
	push	ds		;save
	push	es		;copy ES to DS
	pop	ds
	xor	dx,dx		;offset=0
	mov	ah,40h		;func=write
	int	21h
	pop	ds		;[restore]
	jc	fmti7		;error
	cmp	ax,cx		;did we write all?
	jne	fmti7
fmti6:	push	ds		;restore original ES
	pop	es
	ret
fmti7:	jmp	wrerr		;write error
;
if 0
;;;; save this for CREATE
fmtimg:	; create image file (replace bp with new temp record)
	mov	ds:indev,bp	;save temp rec ptr
	mov	si,ds:tfnam	;get ptr to filename
	mov	cx,ds:tfnam+2	;length
	call	gdev		;parse device name
	mov	ds:outdev,bp	;save dev rec
	call	ss:defset[bp]	;set defaults
	call	ss:gdir[bp]	;get dir name
	mov	di,offset fname1 ;pt at buffer
	xor	bl,bl		;no implied wildcards
	call	filnam		;parse filename
	call	confrm		;make sure EOL
	; say what we're doing
	mov	di,offset lbuf	;pt at buf
	cram	'Creating image file '
	call	pdev		;print dev name
	mov	cx,1		;filename follows directory name
	call	ss:dirnam[bp]	;print dir name
	mov	si,offset fname1 ;pt at buffer
fmti1:	lodsb			;get a byte
	test	al,al		;end?
	jz	fmti2
	stosb			;store
	jmp	short fmti1
fmti2:	call	flush		;print line
	call	aysure		;see if they're sure
;;; this should be rigged for DOS, foreign container files are too confusing
	mov	ax,ds:tfsys	;get file system (not defaulted)
	mov	ss:fsys[bp],ax	;save it
;;;
	; determine length
	xor	ax,ax		;clear for now
	mov	ds:fbcnt,ax
	mov	ds:fbcnt+2,ax
	mov	ds:badsec,ax	;no bad sector file
	mov	ds:badsec+2,ax
	mov	bx,ds:tmed	;get medium type
	mov	si,offset filfmt ;pt at table
	call	wdluk		;look it up
	jc	fmti3
	call	ax		;go figure length, set up for bad sec file
	jmp	short fmti4
fmti3:	; unknown, ask them
	cram	'File size (bytes): ',wrng
	call	gtlin		;get line
	call	getn		;read number
	and	ax,not 777	;trim to 512 bytes
fmti4:	mov	ds:fbcnt,ax	;save
	mov	ds:fbcnt+2,dx
	; init DEVSIZ
	mov	cx,ss:devsiz[bp] ;DEVSIZ initted?
	or	cx,ss:devsiz+2[bp]
;;; when wouldn't it be?  this may be needless now
	jnz	fmti5		;yes, skip it
	mov	ss:totsiz[bp],ax ;set total size in bytes
	mov	ss:totsiz+2[bp],dx
	mov	cl,9d		;bit count
	shr	ax,cl		;convert to blocks
	ror	dx,cl
	mov	cx,dx		;copy
	and	cl,200		;isolate high 9 bits
	or	ax,cx		;compose low word
	mov	ss:devsiz[bp],ax
	and	dx,177		;low 7 bits
	mov	ss:devsiz+2[bp],dx
	mov	ss:totblk[bp],ax ;set total size in blocks
	mov	ss:totblk+2[bp],dx
fmti5:	; get creation date
	mov	ax,ds:year	;copy date
	mov	ds:fyear,ax
	mov	ax,word ptr ds:day
	mov	word ptr ds:fday,ax
	mov	ax,word ptr ds:min ;time
	mov	word ptr ds:fmin,ax
	mov	al,ds:sec
	mov	ds:fsec,al
	mov	word ptr ds:ftimf,-1 ;mark both as valid
	; open the file
	mov	bp,ds:outdev	;make sure we still have bp
	call	ss:dsrini[bp]	;init DSR
	call	ss:dirinp[bp]	;init dir I/O
	call	ss:dirout[bp]	;both ways (in case different)
	mov	si,offset fname1 ;pt at filename
	call	ss:create[bp]	;create the file
	; remove space reserved for bad sector file
	mov	ax,ds:fbcnt	;fetch
	mov	dx,ds:fbcnt+2
	sub	ax,ds:badsec	;subtract
	sbb	dx,ds:badsec+2
	mov	ds:fbcnt,ax	;save
	mov	ds:fbcnt+2,dx
	; write FBCNT zeros
	mov	ds:binflg,bin	;binary mode
	mov	es,ds:bigbuf	;point at buffer
	xor	di,di		;point at beginning
	mov	cx,ds:bigsiz	;get size
	cmp	ds:bigsiz+2,di	;is that it?
	jz	fmti6
	 mov	cx,-1		;no, >64KB so stop at end
fmti6:	mov	ds:bigctr,cx	;save length
	xor	ax,ax		;load 0
	shr	cx,1		;/2
	rep	stosw		;clear out begn of buf
	adc	cl,cl		;get CF back
	rep	stosb		;clear odd byte
fmti7:	; write next buffer of zeros
	mov	es,ds:bigbuf	;pt at buffer
	xor	si,si
	mov	cx,ds:bigctr	;get # bytes in buf
	cmp	ds:fbcnt+2,si	;almost done?
	jnz	fmti8		;no
	cmp	ds:fbcnt,cx	;yes, should we truncate?
	jae	fmti8
	mov	cx,ds:fbcnt	;yes
fmti8:	jcxz	fmti9		;nothing to write, done
	call	ss:write[bp]	;write a buffer
	jcxz	fmti9		;must be just about done, go finish up
	sub	ds:fbcnt,cx	;subtract
	sbb	ds:fbcnt+2,0
	jmp	short fmti7	;loop
fmti9:	; wrote all except possibly one partial block, add bad block file
	xor	si,si		;point at data
	cmp	ds:fbcnt+2,si	;<64KB left right?
	jnz	fmti11		;we're bugged if not
	mov	di,ds:fbcnt	;get # bytes we need to write
	mov	cx,ds:bigctr	;get # bytes in first page of buf
	sub	cx,di		;find # free
	; ES:DI=byte after last byte to be written, CX=# bytes free there
	; add bad block file if appropriate
	mov	bx,ds:tmed	;get medium type
	mov	si,offset filbad ;pt at table
	call	wdluk		;look it up
	jc	fmti10
	call	ax		;add it, update di
fmti10:	xor	si,si		;point at begn
	mov	cx,di		;get length
	push	cx		;save
	call	ss:write[bp]	;write it
	mov	si,cx		;skip whatever couldn't be written
	pop	cx		;catch desired length
	sub	cx,si		;find # bytes still to go
	call	ss:wlast[bp]	;should have fit, well pad it anyway
	push	ds		;restore ES
	pop	es
	call	ss:close[bp]	;close file
	call	ss:dirfin[bp]	;clean up
	mov	bp,ds:indev	;restore original BP
	ret
fmti11:	jmp	wrerr		;BIGBUF must be too small for cluster, ugh
endif ;;;; 0
;+
;
; Prompt to see if they want a block or sector image file.
;
;-
askilv:	mov	ax,ds:tintlv	;get /INTERLEAVE flag
	mov	byte ptr ss:ilimg[bp],al ;assume sector image, or what they say
	test	ah,ah		;did they say anything?
	jnz	askil1		;yes, don't prompt
	cram	'Create (B)lock or (S)ector image file? [S] ',wrng
	call	gtlin		;read a line
	call	getw		;get their answer
	jc	askil1		;if any
	cmp	byte ptr [bx],'S' ;does it start with 'S'?
	je	askil1
	cmp	byte ptr [bx],'B' ;how about 'B'?
	jne	askilv
	inc	ss:ilimg[bp]	;block-by-block
askil1:	ret
;
; List of routines to construct bad block table.
;
filbad	dw	rl01,dlbad	;RL01
	dw	rl02,dlbad	;RL02
	dw	rk06,dmbad	;RK06
	dw	rk07,dmbad	;RK07
	dw	0
;
dlbad:	; construct RL01 bad sector file (es:di points to buf, updated)
	; N.B. RSTS 7.0 DSKINT is bugged, displays SN as 32-bit octal #
	; instead of skipping bit 15 of each word.  9.7 is OK though.
	cmp	cx,40d*256d	;enough space for bad block file?
	jb	membad		;no, we lose
	push	es		;save
	push	di
	push	ds		;copy DS to ES
	pop	es
	cram	'Serial # [1234512345]: ',wrng ;prompt for serial #
	call	gtlin		;get a line
	call	getw		;get a word
	jc	dlbad2
	call	cvto		;get a number
	sal	ax,1		;left a bit
	rcl	dx,1		;into dx
	shr	ax,1		;fix, clear b15
	and	dh,177		;clear b15
dlbad1:	; pack SN in dx:ax
	pop	di		;point at free space
	pop	es
	mov	si,di		;save a copy
	stosw			;save low word
	mov	ax,dx		;high word
	stosw
	xor	ax,ax		;load 0
	stosw			;(reserved)
	stosw			;data pack (not alignment pack)
	dec	ax		;all ones
	mov	cx,(126d*2)+(128d*2) ;pad out, 18-bit version is all ones
	rep	stosw
	push	ds		;save
	push	es		;copy ES to DS
	pop	ds
	mov	cx,9d*256d*2	;# words to copy (9 more block pairs)
	rep	movsw
	pop	ds		;restore
	ret
dlbad2:	mov	ax,12345	;default
	mov	dx,ax
	jmp	short dlbad1
membad:	cram	'?Out of memory writing bad block file',error
;
dmbad:	; construct RK06 bad sector file (es:di points to buf, updated)
	cmp	cx,22d*512d	;enough space for bad block file?
	jb	membad		;no, we lose
	push	es		;save
	push	di
	push	ds		;copy DS to ES
	pop	es
	cram	'Serial # [12345]: ',wrng ;prompt for serial #
	call	gtlin		;get a line
	call	getw		;get a word
	jc	dmbad2
	call	cvto		;get a number
dmbad1:	; pack SN in ax
	pop	di		;point at free space
	pop	es
	mov	si,di		;save a copy
	stosw			;save SN
	xor	ax,ax		;load 0
	stosw			;(reserved, high word of SN on RLs)
	stosw			;(reserved)
	stosw			;data pack (not alignment pack)
	dec	ax		;all ones
	mov	cx,(126d*2)	;pad out, 18-bit version is all ones
	rep	stosw
	push	ds		;save
	push	es		;copy ES to DS
	pop	ds
	mov	cx,21d*512d/2	;# words to copy (21. more blocks)
	rep	movsw
	pop	ds		;restore
	ret
dmbad2:	mov	ax,12345	;default
	jmp	short dmbad1
dmbad3:	jmp	membad
;+
;
; Format floppy.
;
; ss:bp	log dev rec
;
;-
fmtflp:	call	prsent		;wait until they're ready
	call	ss:dsrini[bp]	;init for I/O
	mov	word ptr ds:flphd,0 ;init head, cyl #
	; set up FLPVEC to give special handling for DECmate 5.25" disks
	mov	ax,offset fdzrt	;normally use 1:1
	mov	bx,ss:med[bp]	;get medium type
	cmp	bx,rx50		;RX50 or RX52?
	je	fflp1
	cmp	bx,rx52
	jne	fflp3
fflp1:	mov	bx,ss:fsys[bp]	;get file system
	cmp	bx,os8		;OS/8 or COS-310?
	je	fflp2
	cmp	bx,cos310
	jne	fflp3
fflp2:	mov	ax,offset fdzos	;interleave depends on track #
fflp3:	mov	ds:flpvec,ax	;save
fflp4:	; format next track
	call	ptrkhd		;display track (and head if DS)
	mov	al,ds:flpcyl	;get cyl #
	call	ds:flpvec	;compute hard interleave table for this track
	mov	di,ds:dbuf	;pt at buffer
	push	si		;save
	mov	cl,ss:nsecs[bp]	;loop count
	xor	ch,ch
fflp5:	; write C,H,R,N values for each sector
	mov	ax,word ptr ds:flphd ;get head,,cyl
	xchg	al,ah		;><
	stosw			;save C, H
	lodsb			;R is from table
	mov	ah,ds:fdlen	;N is whatever we set
	stosw
	loop	fflp5
	mov	dh,ds:flphd	;get head
	mov	ch,ds:flpcyl	;and cyl
	call	fdftk		;format track
	jc	fflp7
	pop	si		;restore ptr to interleave table
	call	vtrack		;verify
	cmp	ss:nhds[bp],2	;double sided?
	jb	fflp6
	xor	byte ptr ds:flphd,1 ;yes, flip head #
	jnz	fflp4		;go do side 1 of this cyl
fflp6:	inc	ds:flpcyl	;go to next cyl
	mov	al,ds:flpcyl	;get it
	cmp	al,ss:ncyls[bp]	;done all?
	jb	fflp4		;loop if not
	callr	fmtcmp		;print msg, return
fflp7:	jmp	fderr		;go decode error
;+
;
; RX50 format interleave routines.
;
; Each of these routines is called once before each track is formated, with the
; cylinder number in AL of the track about to be formatted.  They should return
; a pointer in si to a 10-byte list of sector numbers, in the order they should
; be written on the disk.
;
;-
fdzrt:	; format RX50 for RT-11
	mov	si,offset ilv11	;always 1:1, driver does 2:1 in software
	ret
;
fdzos:	; format RX50 for OS/8
	; 1:1 except tracks 0, 78, and 79, which are 2:1
	test	al,al		;track 0?
	jz	fdzos2
	cmp	al,78d		;78. or above?
	jae	fdzos1
	; tracks 1-77, start 2 sectors later each track
	mov	si,offset ostk1	;pt at starting posn
	dec	ax		;-1 (start pattern at track 1)
	cbw			;AH=0
	mov	bl,5		;get track-1 mod 5
	div	bl		;into ah
	mov	al,ah		;get remainder
	cbw			;AH=0
	sal	al,1		;*2
	sub	si,ax		;back up
	ret
fdzos1:	ja	fdzos3		;79., skip
fdzos2:	; track 0 or 78., use 2:1 interleave
	mov	si,offset ostk78 ;pt at table
	ret
fdzos3:	mov	si,offset ostk79 ;pt at table
	ret
;
	db	    3,4,5,6,7,8d,9d,10d
ostk1	db	1,2,3,4,5,6,7,8d,9d,10d ;1:1 2-sector skew tracks 1-77.
ostk78	db	1,6,2,7,3,8d,4,9d,5,10d ;2:1 for 0 and 78.
ostk79	db	5,10d,1,6,2,7,3,8d,4,9d ;2:1, 2-sector skew from track 78.
;+
;
; Print cyl # from FLPCYL, and head from FLPHD if double sided.
;
; bp	dev rec ptr
;
;-
ptrkhd:	mov	di,offset lbuf	;pt at buf
	cram	'Track '
	mov	al,ds:flpcyl	;get curr cyl #
	call	pbyte		;convert to decimal
	cmp	ss:nhds[bp],2	;double-sided?
	jb	ptkhd1		;no
	cram	' Head '
	mov	al,ds:flphd	;get head #
	call	pbyte		;decimal
ptkhd1:	mov	al,cr		;cr
	stosb
	inc	ds:lnum		;don't count this because no LF
	jmp	flush1		;display, return
;+
;
; Print "Format complete" message
;
;-
fmtcmp:	mov	di,offset lbuf	;pt at buf
	cram	'Format complete'
	jmp	flush		;display, return
;+
;
; Verify a track.
;
; si	ptr to interleave table used to format the track
;
;-
vtrack:	; build table of sectors which we've already formated
	mov	di,offset buf	;pt at BUF
	mov	cl,ds:fdeot	;get track length
	mov	dl,cl		;copy
	mov	dh,cl		;again
	xor	ch,ch		;CH=0
	mov	al,ch		;AL too
	rep	stosb		;clear flags
	xor	bx,bx		;starting offset
vtk1:	; find next unread sector (2:1 soft interleave)
	inc	bx		;+1 (will be +2 in a sec)
	jmp	short vtk3
vtk2:	cmp	ds:buf[bx],bh	;have we done this one?
	jz	vtk4		;no, do it
vtk3:	inc	bx		;+1
	cmp	bl,dh		;off end of track?
	jb	vtk2
	sub	bl,dh		;yes, wrap
	jmp	short vtk2
vtk4:	inc	ds:buf[bx]	;set flag
	push	bx		;save
	push	dx
	push	si
	mov	dh,ds:flphd	;get head #
	mov	cl,[bx+si]	;sec #
	mov	ch,ds:flpcyl	;cyl #
	call	fdrds		;read sector (with retries)
	jc	vtk5		;error, punt
	pop	si		;restore
	pop	dx
	pop	bx
	dec	dl		;done?
	jnz	vtk1		;loop if not
	ret
vtk5:	call	error		;punt
verr1	db	verr2,lf,'?Verify error'
verr2=	$-verr1-1
;+
;
; "Format" a hard disk partition.
;
;-
fmthdp:	cram	"?Don't know how to do HDs yet",error
;+
;
; INIT dev /FILESYSTEM /MEDIUM
;
; Wipe all files from the volume, initialize it for use.
;
;-
init:	mov	bx,-1		;don't get logical name
	mov	ds:othswt,offset inisw ;"INIT" switch table
	mov	ds:nsegs,0	;(use default if no /SEGMENTS:n switch)
	call	gmount		;parse stuff, get temp rec at SS:BP
	call	opndev		;actually open the device
	call	defmed		;figure out medium defaults if needed
	call	setmed		;set medium-related stuff
	call	setsys		;set file system related stuff
	; write blank filesystem
	mov	bx,ss:fsys[bp]	;get file system
	test	bx,bx		;any?
	jz	init1
	mov	si,offset inisys ;pt at table
	call	wdluk		;look it up
	jc	init2		;not found
	callr	ax		;init, return
init1:	cram	'?Must specify file system type',error
init2:	cram	"?Don't know how to init that filesystem",error
;
inisw	label	byte
	kw	<SEG-MENTS>,iniseg ;set # segments in RT-11 directory
	db	0
;
inisys	dw	os8,zos		;init OS/8 disk
	dw	rt11,zrt	;init RT-11 disk
	dw	0
;+
;
; Zero a disk with OS/8 file structure.
;
; bp	log dev rec
;
;-
zos:	call	ss:dsrini[bp]	;init I/O
	; get # info words per entry
	mov	di,offset lbuf	;pt at buf
	cram	'Number of info words per dir entry [1]: '
	call	flush1
	call	gtlin		;get a line
	call	getw		;get a word
	jc	zos1
	call	cvto		;get a number
	jmp	short zos2
zos1:	; default # info words is 1 (for date)
	mov	ax,1		;default is 1
	cwd			;DX=0
zos2:	test	dx,dx		;DX must be 0
	jnz	zos3
	cmp	ax,256d-5	;at least one entry must fit in dir seg
	jbe	zos4
zos3:	jmp	zos8		;invalid # of info words
zos4:	mov	cx,10000	;negate
	sub	cx,ax
	and	ch,7777/400	;might be 0
	push	cx		;save
	mov	di,offset lbuf	;pt at buf
	cram	'Allocate space for system [N]? '
	call	flush1
	call	yorn		;get response
	pop	cx		;[restore]
	mov	dx,7		;[start of data area for data disk]
	jc	zos5
	 mov	dl,70		;start of data area for system disk
zos5:	; ensure that device size is in range
	cmp	ss:devsiz+2[bp],0 ;make sure size .lt. 64K blocks
	jnz	zos7
	cmp	ss:devsiz[bp],dx ;space for dir plus at least one data blk?
	jbe	zos7		;(utterly useless if not)
	; init home block
	mov	di,offset buf	;point at buffer
	mov	si,di		;save a copy
	mov	ax,7777		;0000/ one entry in seg
	stosw
	mov	ax,dx		;0001/ starting blk # of empty area
	stosw
	xor	ax,ax		;0002/ next dir seg (none)
	stosw
	stosw			;0003/ no tentative file
	mov	ax,cx		;0004/ -(# info words)
	stosw
	xor	ax,ax		;0005/ .EMPTY. block
	stosw
	mov	ax,dx		;get starting block
	sub	ax,ss:devsiz[bp] ;subtract device size (get -(size of .EMPTY.))
	and	ah,7777/400	;trim to 12 bits
	stosw			;0006/ -length
	xor	ax,ax		;might as well clear out rest
	mov	cx,256d-7	;first 7 words already done
	rep	stosw
	; write directory in block 1 (si=ptr to buf)
	mov	ax,1		;home block is block 1
	xor	dx,dx
	mov	cx,1		;write 1 block
	call	ss:wrblk[bp]	;go
	jc	zos6
;;; write dummy boot block
	ret
zos6:	jmp	wrerr
zos7:	cram	'?Invalid device size',error
zos8:	cram	'?Invalid # of info words',error
;+
;
; Zero a disk with RT-11 file structure.
;
; bp	log dev rec
;
;-
zrt:	call	ss:dsrini[bp]	;init I/O
	; ensure that device size is in range
	cmp	ss:cursiz[bp],6+2+1 ;space for boot + one dir seg + one blk?
	jae	zrt1		;(utterly useless if not)
	cram	'?Invalid device size',error
zrt1:	; init home block
	mov	bx,offset buf	;pt at disk buffer
	mov	di,bx		;copy
	mov	cx,1000/2	;word count
	xor	ax,ax		;load 0's
	rep	stosw		;nuke it
	lea	di,[bx+722]	;pt at cluster size
	inc	ax		;(HB+722) cluster size is always 1
	stosw
	mov	al,6		;(HB+724) dir starts at 6 (regardless of this)
	stosw
	mov	ax,107123	;(HB+726) version=.RAD50 /V05/
	stosw
	mov	ax,"  "		;blanks
	mov	cx,3*12d/2	;byte count (pad all 3 text fields)
	rep	stosw
	; get volume label
	mov	di,offset lbuf	;pt at buf
	cram	'Volume ID <RT11A>: '
rt11a=	$-8d
	call	flush1
	call	gtlin		;read a line
	mov	di,offset buf+730 ;pt at vol ID
	call	skip		;did user enter anything?
	jc	zrt4
	mov	dx,12d		;max field size
zrt2:	lodsb			;get a byte
	cmp	al,' '		;ctrl char?
	jb	zrt3		;(ZF=0)
	stosb			;save
	dec	dx		;count
zrt3:	loopnz	zrt2		;loop until full or done
	jmp	short zrt5
zrt4:	mov	si,offset rt11a	;pt at string
	mov	cx,5		;count
	rep	movsb
zrt5:	; get owner name
	mov	di,offset lbuf	;pt at buf
	cram	'Owner name: '
	call	flush1
	call	gtlin		;read a line
	mov	di,offset buf+744 ;pt at owner name
	call	skip		;did user enter anything?
	jc	zrt8		;no
	mov	dx,12d		;max field size
zrt6:	lodsb			;get a byte
	cmp	al,' '		;ctrl char?
	jb	zrt7		;(ZF=0)
	stosb			;save
	dec	dx		;count
zrt7:	loopnz	zrt6		;loop until full or done
zrt8:	mov	di,offset buf+760 ;system ID
	cram	'DECRT11A'
	mov	si,offset buf	;pt at buf
	mov	cx,(1000/2)-1	;word count, except for first and last words
	xor	bx,bx		;init sum
zrt9:	lodsw			;get next
	add	bx,ax		;add it in
	loop	zrt9		;loop
	neg	bx		;negate
	mov	[si],bx		;poke it in
	; write home block
	mov	si,offset buf	;pt at buffer
	mov	ax,ss:curdir[bp] ;get base of partition
	mov	dx,ss:curdir+2[bp]
	add	ax,1		;home block is block 1
	adc	dx,0
	mov	cx,1		;write 1 block
	call	ss:wrblk[bp]	;go
	; decide how many dir segments to use
	mov	dx,ds:nsegs	;get value from /SEGMENTS:n switch
	test	dx,dx		;if any
	jnz	zrt11		;yes, use it
	mov	si,offset rtnseg ;pt at # of segments table
zrt10:	lodsw			;get size
	mov	bx,ax		;copy
	lodsw			;get # segments
	mov	dx,ax		;take it
	cmp	bx,ss:cursiz[bp] ;< actual size?
	jb	zrt10		;loop if so
zrt11:	; write a null directory
	mov	di,offset buf	;pt at buffer
	xor	ax,ax		;load 0
	mov	cx,1000/2	;WC
	rep	stosw		;nuke it
	mov	di,offset buf	;pt at begn again
	; write 5-word segment header
	mov	ax,dx		;get # segs
	stosw			;word 1 -- total # segments
	xor	ax,ax		;no next seg
	stosw			;word 2 -- ptr to next segment in chain
	inc	ax		;1
	stosw			;word 3 -- # of highest segment in use
	xor	ax,ax		;0
	stosw			;word 4 -- # of extra words per entry
	mov	ax,dx		;get # segs
	sal	ax,1		;*2 = # blocks in directory
	add	ax,6		;add starting block #
	stosw			;word 5 -- starting data blk for this seg
	; write < UNUSED > entry
	mov	ax,1000		;type=< UNUSED >
	stosw
	mov	ax,23747	;.RAD50/FOO/
	stosw			;filename is meaningless
	stosw
	stosw
	mov	ax,ss:cursiz[bp] ;get size of partition
	sub	ax,word ptr ds:buf+8d ;find amount left for files
	stosw			;length
	xor	ax,ax		;job/chan info
	stosw
	stosw			;date is meaningless on empties
	mov	ax,4000		;end-of-segment marker
	stosw
	mov	si,offset buf	;pt at buffer
	mov	ax,ss:curdir[bp] ;get base of partition
	mov	dx,ss:curdir+2[bp]
	add	ax,6		;first dir block
	adc	dx,0
	mov	cx,1		;write 1 block
	call	ss:wrblk[bp]	;go
;;; write dummy boot block
	ret
;
; Table from RT-11 V04.00 SUG:
;
; dev	mnem	segs	total blocks
; RX01	DX	1	494
; RX01	PD	1	494
; TU58	DD	1	512
; TU56	DT	1	578	N.B. doesn't match table below!
; RX02	DY	4	988
; RF11	RF	4
; RS03/4 DS	4	1024/2048
; RK05	RK	16	4800
; RL01	DL	16	10240/20480
; RK07	DM	31	x/53790
; RP03	DP	31
;
; Sizes from Tony Konashenok <avk@hafnium.cchem.berkeley.edu> (who got them out
; of RT-11 V5.4D DUP.SAV), confirmed by Bob Schor <bschor@vms.cis.pitt.edu>
; (who got them by experimenting with DUP)
rtnseg	dw	512d	;Up to 512 blocks
	dw	1	;we get 1 segment.
	dw	2048d	;Up to 2048 blocks
	dw	4	;we get 4 segments.
	dw	12288d	;Up to 12288 blocks
	dw	16d	;we get 16 segments.
	dw	-1	;Over that
	dw	31d	;we get 31 segments (max allowed).
;
iniseg:	; INIT /SEGMENTS:n switch
	jcxz	insg2		;can't be EOL
	lodsb			;eat the ':'
	dec	cx		;count it off
	cmp	al,':'		;must be ':'
	je	insg1
	cmp	al,'='		;or '='
	jne	insg3
insg1:	call	getn		;get number
	dec	ax		;change 1 to 0
	cmp	ax,31d-1	;in range [1,31.]?
	ja	insg4		;no
	inc	ax		;yes, fix it
	mov	ds:nsegs,ax	;save
	ret
insg2:	jmp	misprm		;missing parameter
insg3:	jmp	synerr		;syntax error
insg4:	jmp	outran		;number out of range
;+
;
; MOUNT log: [filespec]/struc/medium
;
; log: is logical device name (of the form d[d][n]:)
; filespec is name of disk image file (if not real disk)
; /STRUC is the file structure (e.g. /OS8, /RSTS, default is /RT11)
; /MEDIUM is the medium type (for floppy drives, default is /RX50)
;
; Possible commands:
; MOUNT A: /OS8 (defaults to A:, RX50)
; MOUNT DZ0: A: /OS8
; MOUNT DY0: B: /RX02 /RT11
; MOUNT DX0: A: /RX01 /RT11
; MOUNT DL0: C:SY.DSK /RT11
; MOUNT DU0: /DRIVE=0 /BPART=2 (doesn't work yet)
; MOUNT DD0: COM1:19200/DRIVE=1
; MOUNT X: SCSI5: /MSCP/RT11/PART:1
;
;-
mount:	xor	bx,bx		;get logical dev name
	mov	ds:othswt,0	;no "other" switches
	call	gmount		;get MOUNT command line
	call	opndev		;actually open the device
	call	defmed		;figure out medium defaults if needed
	call	setmed		;set medium-related stuff
	call	defsys		;figure out file system if needed
	call	setsys		;set file system related stuff
	; do file-system-specific init
	mov	bx,ss:fsys[bp]	;get it
	mov	si,offset mntsys ;pt at table
	call	wdluk		;look it up
	jc	mount1
	 call	ax
mount1:	; we'll succeed, so make sure MLOOP doesn't close file or flush rec
	mov	ax,ds:fremem	;make sure we don't flush the dev rec's RAM
	mov	ds:kepmem,ax
	mov	ds:tmpdev,0	;tell MLOOP not to return it
	mov	ds:outhnd,-1	;and don't close the image file, if any
	; link logical device record into table second (so as not to log in)
	mov	bx,ds:logdev	;get head of list
	test	bx,bx		;is there anything?
	jz	mount2
	mov	ax,bp		;yes, copy
	xchg	ax,ds:next[bx]	;link us in, fetch rest of list
	mov	ss:next[bp],ax	;link it to us
	ret
mount2:	mov	ss:next[bp],bx	;rest of list is empty
	mov	ds:logdev,bp	;just us
	ret
;
mnthd:	; mount hard drive partition
;;;; should get geometry
;;;;
	ret
;
; mount file system (once hardware is set up)
mntsys	dw	cos310,mntos	;COS-310
	dw	os8,mntos	;OS/8
	dw	rsts,mntrs	;RSTS
	dw	rt11,mntrt	;RT11
	dw	0
;
mntos:	; mount OS/8 (or COS-310) file system
	ret			;no special processing
;
mntrs:	; mount RSTS file system
	; calculate device cluster size
	mov	ax,1		;assume DCS=1
	mov	cx,ss:devsiz+2[bp] ;get high order of dev size
	jcxz	mntrs2		;DCS is indeed 1
mntrs1:	; see how many times we have to divide the dev size by 2 to make
	; the high order word of the size go away
	sal	ax,1		;left a bit
	shr	cx,1		;right a bit
	jnz	mntrs1		;loop
mntrs2:	cmp	ax,64d		;<=64. right?
	jbe	mntrs3
	cram	'?Invalid DCS',error
mntrs3:	mov	ss:dcs[bp],ax	;save DCS
	; read pack label (in MFD if RDS 0.0)
	call	ss:dsrini[bp]	;init DSR
	mov	di,ds:dbuf	;pt at buffer
	mov	ax,1		;home block
	mov	cx,ax		;read 1 block
	mul	ss:dcs[bp]	;starting at DCN 1
	call	ss:rdblk[bp]	;fetch it
	mov	si,ds:dbuf	;get ptr to home block
	mov	di,offset lbuf	;pt at buf
	cram	'Pack ID='
	mov	ax,[si+14]	;get pack ID again
	call	radnb
	mov	ax,[si+16]
	call	radnb
	cram	', PCS='
	mov	ax,[si+10]	;get pack clustersize
	mov	ss:pcs[bp],ax	;save
	mov	bx,ax		;copy
	dec	bx		;-1
	and	bx,ax		;make sure power of 2
	jnz	mntrs4		;nope
	cmp	ax,64d		;.LE.64?
	ja	mntrs4
	call	pbyte		;yes, convert it
	cram	', DCS='
	mov	ax,ss:dcs[bp]	;get DCS
	call	pbyte
	cram	', RDS level '
	test	byte ptr [si+13],40 ;new (V8.0+) pack?
	jnz	mntrs5
	; RDS 0.0
	xor	ax,ax		;RDS 0.0
	jmp	short mntrs6
mntrs4:	cram	'?Invalid PCS',error
mntrs5:	; RDS 1.X
	mov	ax,[si+4]	;DCN of MFD
	mov	ss:mfddcn[bp],ax ;save
	mov	ax,[si+6]	;get RDS level
mntrs6:	; RDS level ah.al
	mov	ss:rdslev[bp],ax ;set in log dev rec
	push	ax		;save
	mov	al,ah
	call	pbyte		;print major version
	mov	al,'.'		;.
	stosb
	pop	ax		;restore
	call	pbyte
	call	flush		;flush
	mov	ss:curdir[bp],1	;ppn=[0,1]
	mov	ss:satptr[bp],1	;init SATT.SYS cluster alloc ptr

;;; need to look up [0,1]SATT.SYS
;;; also save # of PC's on disk for GETCLU wraparound

	ret
;
mntrt:	; mount RT11 file system
	call	rtpart		;set up partition
	jnc	mntrt1		;success
	cram	'?Nonexistent partition',error
mntrt1:	ret
;
rtpart:	; set up partition selected by TPART
	mov	ss:curdir[bp],0	;log in to root (no LD:s)
	mov	ax,ds:tpart	;get partition # (default=0)
	mov	ss:curdir+2[bp],ax ;save
	mov	bx,ss:devsiz+4[bp] ;see if dev is huge
	or	bx,ss:devsiz+6[bp]
	jnz	rtprt2		;yes, all partitions are full size
	cmp	ax,ss:devsiz+2[bp] ;is this last partition?
	jb	rtprt2		;no
	ja	rtprt1		;beyond, error
	mov	ax,ss:devsiz[bp] ;get low order size
	test	ax,ax		;if any
	jnz	rtprt3		;yes
	; exact 32 MB multiple so part # is too high
rtprt1:	stc			;bad partition #
	ret
rtprt2:	mov	ax,0FFFFh	;give max possible size
rtprt3:	mov	ss:cursiz[bp],ax ;set size of partition
	clc			;happy
	ret
;+
;
; Set various things.
;
;-
set:	call	getw		;get parameter
	jc	set1		;missing
	mov	ax,offset setlst ;point at keyword list
	call	tbluk		;look it up
	jc	set2		;not found
	callr	ax		;call the routine
set1:	jmp	misprm		;missing keyword
set2:	jmp	synerr		;bad keyword
;
setlst	label	byte
	kw	<C-OPY>,stcopy	;set ASCII/BINARY default for COPY
	kw	<D-ISMOUNT>,setdsm ;set DISMOUNT /[NO]UNLOAD default
	kw	<F-DC>,setfdc	;set FDC type
	kw	<M-ORE>,stmore	;enable/disable **MORE** processing
	db	0
;
stcopy:	; SET COPY
	call	getw		;get parameter
	jc	stcpy1
	mov	ax,offset scpytb ;pt at table
	call	tbluk		;look up
	jc	stcpy2
	mov	ds:bindef,ax	;save value
	callr	confrm		;should be EOL
stcpy1:	jmp	misprm		;missing parameter
stcpy2:	jmp	synerr		;bad keyword
;
setdsm:	; SET DISMOUNT
	call	getw		;get parameter
	jc	stdsm1
	mov	ax,offset dmtsws ;pt at table
	call	tbluk		;look up
	jc	stdsm2
	mov	ds:dsmunl,al	;save value
	callr	confrm		;should be EOL
stdsm1:	jmp	misprm		;missing parameter
stdsm2:	jmp	synerr		;bad keyword
;
setfdc:	; SET FDC
	call	getw		;get parameter
	jc	stfdc1
	mov	ax,offset sfdctb ;pt at table
	call	tbluk		;look up
	jc	stfdc2
	mov	byte ptr ds:cc4fdc,al ;save value
	callr	confrm		;should be EOL
stfdc1:	jmp	misprm		;missing parameter
stfdc2:	jmp	synerr		;bad keyword
;
stmore:	; SET MORE
	call	getw		;get parameter
	jc	stmor1
	mov	ax,offset onoff	;pt at table
	call	tbluk		;look up
	jc	stmor2
	mov	ds:more,al	;save value
	callr	confrm		;should be EOL
stmor1:	jmp	misprm		;missing parameter
stmor2:	jmp	synerr		;bad keyword
;
scpytb	label	byte
	kw	<A-SCII>,text
	kw	<B-INARY>,bin
	db	0
;
sfdctb	label	byte
	kw	<C-OMPATICARD>,1 ;Micro Solutions CompatiCard IV
	kw	<G-ENERIC>,0	;anything else
;;; maybe should add an entry for 37C65 chips that use an unusual way to set
;;; vertical mode, for now I just write the port if the version code matches
;;; but that could lead to trouble with FDCs that return the same version code
;;; (a lot do) but don't like writes to 3F1h
	db	0
;
onoff	label	byte
	kw	<OF-F>,0
	kw	<ON->,-1
	db	0
;+
;
; Show dev parameters.
;
;-
show:	call	gdevn		;get dev name (or use default)
	call	confrm		;check for EOL
	mov	di,offset lbuf	;point at buf
	call	pdev		;print dev name
	mov	al,' '		;add a blank
	stosb
	cmp	ss:dirinp[bp],offset dosdi ;is it a DOS disk?
	jne	show1		;no
	cram	'DOS'		;DOS device, no useful information
	callr	flush
show1:	cmp	ss:hwtype[bp],hwfile ;image file?
	jne	show2		;no
	test	byte ptr ss:ilimg[bp],-1 ;yes, interleaved?
	jz	show2
	cram	'Interleaved '	;yes
show2:	mov	bx,ss:med[bp]	;get medium type
	mov	si,offset devnam ;point at name list
	call	pname		;print it
	mov	ax," ,"		;', '
	stosw
	mov	bx,ss:fsys[bp]	;get file system
	mov	si,offset fsynam ;point at name list
	call	pname		;print it
	mov	ax," ,"		;', '
	stosw
	mov	ax,ss:devsiz[bp] ;get # usable blocks
	mov	dx,ss:devsiz+2[bp]
	push	ax		;(save)
	push	dx
	call	pdnum		;print it
	cram	' total usable block'
	pop	dx		;(restore)
	pop	ax
	dec	ax		;size=1?
	jnz	show3
	cmp	dx,ax		;(AX now =0)
	jz	show4
show3:	mov	al,'s'		;add 's' if not
	stosb
show4:	; add current partition/LD: size for RT-11
	cmp	ss:fsys[bp],rt11 ;RT?
	jne	show7
	call	flush		;flush line, start new one
	mov	ax,ss:cursiz[bp] ;get # usable blocks
	mov	dx,ss:cursiz+2[bp]
	push	dx		;save
	push	ax
	call	pdnum		;print it
	cram	' block'
	pop	dx		;(restore)
	pop	ax
	dec	ax		;size=1?  (as above)
	jnz	show5
	cmp	dx,ax		;(AX now =0)
	jz	show6
show5:	mov	al,'s'		;add 's' if not
	stosb
show6:	cram	' in current volume'
show7:	callr	flush
;+
;
; TYPE {wildcard}
;
;-
typ:	; get filespec
	call	gdev		;parse device name, get dev rec in bp
	call	ss:defset[bp]	;set defaults
	call	ss:gdir[bp]	;get dir name
	mov	di,offset fname1 ;pt at buffer
	xor	bl,bl		;no implied wildcards
	call	filnam		;parse filename
	call	confrm		;make sure EOL
	xor	bx,bx		;input file
	call	ss:savcwd[bp]	;save dir
	call	ss:dsrini[bp]	;init DSR
	call	ss:dirinp[bp]	;init dir input
	mov	byte ptr ds:notfnd,1 ;nothing found yet
	; init fake output device
	mov	ds:binflg,text	;set text mode
	push	bp		;save
	call	getrec		;get a record (to be flushed in main loop)
	mov	ss:dsrini[bp],offset cret ;no init needed
	mov	ss:rstcwd[bp],offset cret ;no settings to restore
	mov	ss:write[bp],offset wtty ;output routine
	mov	ss:wlast[bp],offset wtty ;write last block (not called)
	mov	ss:dirfin[bp],offset cret ;no dir finish
	mov	ds:outdev,bp	;set output pseudo-device
	pop	bp		;restore
	mov	ds:indev,bp	;set input device
typ1:	; check next file
	call	ss:dirget[bp]	;get next entry
	jc	typ4		;no more
	jz	typ1		;skip empty areas and dirs
	mov	si,offset fname1 ;pt at wildcard
	push	di		;save
	call	wild		;check for match
	pop	di		;[restore]
	jne	typ1		;ignore
	; it's a match, type filename
	call	flush		;display filename
	xor	al,al		;load 0
	xchg	al,ds:notfnd	;found one, see if first
	test	al,al		;is it first?
	jnz	typ2		;yes, skip
	mov	byte ptr ds:lnum,1 ;**MORE** on next line
typ2:	; type the file
	mov	ds:optr,offset lbuf ;init output ptr
	mov	byte ptr ds:col,0 ;init col
	call	ss:open[bp]	;open it
	jc	typ5
	call	fcopy		;copy the file
	mov	di,ds:optr	;get output ptr
	cmp	di,offset lbuf	;anything on line?
	je	typ3		;no
	call	flush		;yes, flush it
typ3:	mov	bp,ds:indev	;get input device again
	call	ss:dsrini[bp]	;init it
	xor	bx,bx		;select input dir
	call	ss:rstcwd[bp]
	call	ss:reset[bp]	;close input file
	jmp	short typ1	;look for more
typ4:	; no more
	call	ss:dirfin[bp]	;finish up dir I/O
	cmp	byte ptr ds:notfnd,0 ;find anything?
	jz	$+5		;yes
	 jmp	fnf		;file not found
	ret
typ5:	jmp	dirio		;dir I/O err
;+
;
; Write to TTY for TYPE command.
;
; es:si	string
; cx	length (preserved on return)
;
;-
wtty:	jcxz	wtty6		;nothing (WLAST), skip
	push	cx		;save length (we always succeed)
	mov	di,ds:optr	;get output buf ptr
	mov	dx,ds		;copy
	mov	bx,es
wtty1:	mov	ds,bx		;exchange for now
	mov	es,dx
wtty2:	lodsb			;get a char
	cmp	al,' '		;ctrl char?
	jb	wtty8
wtty3:	cmp	byte ptr cs:col,78d ;will this be penultimate col?
	je	wtty7		;yes
wtty4:	stosb			;save
	inc	cs:col		;col+1
wtty5:	loop	wtty2		;loop
	mov	ds,dx		;restore
	mov	es,bx
	mov	ds:optr,di	;save
	pop	cx		;restore # chars written
wtty6:	clc			;got it all
	ret
wtty7:	; wrap while writing text char
	call	wrap		;go handle wrap
	jmp	short wtty4	;continue
wtty8:	; control character
	cmp	al,cr		;ignore CR
	je	wtty5
	cmp	al,lf		;EOL?
	je	wtty12
	cmp	al,tab		;tab?
	je	wtty10
	push	ax		;generic control char, save
	cmp	byte ptr cs:col,78d ;should we wrap before "^"?
	jne	wtty9
	 call	wrap		;yes
wtty9:	mov	al,'^'		;^
	stosb
	inc	cs:col		;col+1
	pop	ax		;restore char
	xor	al,100		;convert to printing char
	cmp	al,'L'		;^L?
	jne	wtty3
	; ^L causes **MORE**
	cmp	byte ptr cs:col,78d ;will this be penultimate col?
	jne	$+5
	 call	wrap
	stosb			;save
	push	bx		;save
	push	cx
	push	dx
	push	si
	mov	ds,dx		;restore seg
	call	flush		;flush line
	pop	si		;restore
	pop	dx
	pop	cx
	pop	bx
	mov	byte ptr ds:col,0 ;start over
	mov	byte ptr ds:lnum,1 ;**MORE** on next line
	mov	ds,bx
	jmp	short wtty5
wtty10:	; tab
	push	cx		;save
	xor	ch,ch		;CH=0
	mov	al,' '		;load blank
	mov	ah,cs:col	;get col
	add	ah,8d		;+8d
	and	ah,not 7	;back up to next tab stop
	cmp	ah,80d		;off EOL?
	je	wtty11
	mov	cl,ah		;copy col
	xchg	ah,cs:col	;update
	sub	cl,ah		;# cols to go
	rep	stosb		;write them
	pop	cx		;restore
	jmp	wtty5
wtty11:	mov	ah,78d		;stop 2 before
	mov	cl,ah		;copy
	xchg	ah,cs:col	;update
	sub	cl,ah		;# cols to go (may be 0)
	rep	stosb
	pop	cx		;restore
	call	wrap		;wrap
	jmp	wtty5
wtty12:	; lf
	push	bx		;save
	push	cx
	push	dx
	push	si
	mov	ds,dx		;restore seg
	call	flush		;flush line
	pop	si		;restore
	pop	dx
	pop	cx
	pop	bx
	mov	byte ptr ds:col,0 ;start over
	mov	ds,bx
	jmp	wtty5
;
wrap:	; handle wrap in WTTY
	push	ax		;save
	push	bx
	push	cx
	push	dx
	push	si
	mov	al,'!'		;indicate wrap
	stosb
	mov	ds,dx		;restore seg
	call	flush		;flush line (resets DI)
	pop	si		;restore
	pop	dx
	pop	cx
	pop	bx
	pop	ax
	mov	byte ptr ds:col,0 ;back to 0
	mov	ds,bx
	ret
;
if 0
costyp:	; type COS-310 file
	mov	ax,ds:stblk	;starting block
	mov	ds:blk,ax	;save
	mov	ax,ds:fsize	;# blks
	mov	ds:cnt,ax	;save
	xor	cx,cx		;count=0
cost1:	; get next line
	call	cosw		;get a word
	jc	cost5		;EOF
	mov	bx,10000	;abs(length)
	sub	bx,ax
	and	bx,7777		;isolate (may have been 0)
	jz	cost5		;EOF (length must be gt 0)
	push	bx		;save length
	; print line #
	call	cosw		;get line #
;;	mov	di,offset buf+4	;pt at buf
	push	cx		;save
	mov	bx,10d		;base
	mov	cx,4		;loop count
cost2:	cwd			;DX=0
	div	bx		;/10
	or	dl,'0'		;cvt rem to ASCII
	dec	di		;-1
	mov	[di],dl		;save char
	loop	cost2		;loop
	; print the line itself
	pop	cx		;restore count
	add	di,4		;advance again
	mov	al,tab		;tab
	stosb			;save
	pop	dx		;get WC back
	jmp	short cost4	;go count line #, return
cost3:	call	cosw		;get next word
	mov	bl,al		;save
	sal	ax,1		;left 2
	sal	ax,1
	mov	al,ah		;get left char
	call	coschr		;save it
	mov	al,bl		;restore
	call	coschr		;save right char
cost4:	dec	dx		;done all?
	jnz	cost3		;loop if not
	mov	ax,cr+(lf*400)	;crlf
	stosw			;save it
	push	cx		;save
;;	mov	dx,offset buf	;buf addr
	mov	cx,di		;length
	sub	cx,dx
	mov	bx,1		;stdout
	mov	ah,40h		;func=write
	int	21h		;do it
	pop	cx		;restore
	jmp	short cost1	;loop
cost5:	jz	$+3		;no i/o err
	 clc			;no err
	ret
;
cosw:	; get next word in COS-310 file, C=1 Z=1 if EOF, C=1 Z=0 if I/O err
	jcxz	cosw2		;skip
cosw1:	lodsw			;get a word
	dec	cx		;-1
	clc			;no prob
	ret
cosw2:	cmp	ds:cnt,cx	;anything left to get?  (CX=0)
	jz	cosw3		;no, fake it
	mov	ax,ds:blk	;get blk #
	push	dx		;save
	push	di
;;;	call	rdsec		;read the sector
	pop	di		;[restore]
	pop	dx
	jc	cosw4		;bugged
	inc	ds:blk		;block+1
	dec	ds:cnt		;count-1
	jmp	short cosw1	;try again
cosw3:	xor	ax,ax		;return 0 (Z=1)
	stc			;err
	ret
cosw4:	xor	ax,ax		;return 0
	or	bh,1		;Z=0
	stc			;C=1
	ret
;
endif
;
coschr:	; write COS-310 char in al
	and	al,77		;isolate
	jz	cosch1		;null, don't even bother
	add	al,' '-1	;cvt to ascii
	cmp	al,'\'		;backslash?
	je	cosch2		;yes, special
	stosb			;save
cosch1:	ret
cosch2:	mov	al,tab		;\ is tab
	stosb
	ret
;+
;
; Print volume name.
;
;-
vol:	call	gdevn		;parse device name, get dev rec in BP
	call	ss:defset[bp]	;set defaults
	call	ss:gdir[bp]	;get dir name (matters for RT-11)
	call	confrm		;make sure confirmed
	call	ss:dsrini[bp]	;init DSR
	call	pvol		;print volume name (leave DI=lbuf)
	callr	flush		;blank line
;+
;
; Wipe out unused parts of disk (so Kermit, GZIP, COMPRESS, etc. can win big).
;
;-
wipe:	call	gdevn		;parse device name, get dev rec in bp
	callr	ss:wipout[bp]	;wipe it out
;
	subttl	device mount/init code
;
	comment _

Steps in preparing a volume for use:

GMOUNT	get name, switches

OPNDEV	open device (or CRTDEV for FORMAT)

DEFMED	iff medium type defaulted (guess from size or by reading floppy), not
	for FORMAT (which fills in medium type/size stuff itself)

SETMED	now that medium type is finalized (except possibly the ILIMG flag for
	RX50/52 image files), set all vectors and sizes for it

DEFSYS	iff OS defaulted, try to guess it, try interleaved and not for
	RX50/RX52 image files if guessing (MOUNT only)

SETSYS	now that OS type is finalized, set all vectors for it

_
;+
;
; Parse MOUNT/FORMAT/INIT command args.
;
; [ldev:] [filespec] [/switches]
;
; bx	0 to parse logical dev name, -1 not to
; si,cx	cmd line descriptor
; OTHSWT  table of other switches (besides the medium/filesystem ones)
;
; Prints message and returns to MLOOP on error.
; Otherwise sets up TAREA and dev record as much as possible, returns ptr to
; dev record in SS:BP.
;
;-
gmount:	push	cx		;save
	xor	al,al		;load 0
	mov	di,offset tarea	;pt at temp area
	mov	cx,ltarea	;length
	rep	stosb		;clear it out
	pop	cx		;restore
	mov	ds:tdev,bx	;skip logical dev name for FORMAT/INIT cmds
gmnt1:	call	skip		;skip blanks, tabs
	jc	gmnt2		;done, see if we have everything
	cmp	al,ds:swchar	;switch?
	je	gmnt3		;handle it
	cmp	ds:tdev,0	;do we already have a logical device?
	jz	gmnt10		;no, this must be it
	cmp	ds:tfnam,0	;do we already have a filename?
	jnz	gmnt9		;yes, this is an error
	call	getw		;get filename
	mov	ds:tfnam,bx	;save ptr
	mov	ds:tfnam+2,dx	;and length
	jmp	short gmnt1
gmnt2:	jmp	gmnt11
gmnt3:	; handle switches
	inc	si		;eat the / or whatever
	dec	cx
	call	getan		;get alphanumeric switch (stop at ':' etc.)
	jc	gmnt9
	mov	ax,offset strtab ;pt at structure types
	call	tbluk		;is it one of those?
	jc	gmnt4
	cmp	ds:tfsys,0	;was there already a file system type?
	jnz	gmnt9		;yes
	mov	ds:tfsys,ax	;save this one
	jmp	short gmnt1
gmnt4:	mov	ax,offset medtab ;pt at medium types
	call	tbluk		;is it one of those?
	jc	gmnt5
	cmp	ds:tmed,0	;do we have one already?
	jnz	gmnt9		;yes
	mov	ds:tmed,ax	;save this one
	jmp	short gmnt1
gmnt5:	mov	ax,offset partab ;pt at partition stuff table
	call	tbluk		;look it up
	jc	gmnt6
	call	ax		;call the routine
	jmp	short gmnt1
gmnt6:	mov	ax,offset mnttab ;point at other mount switches
	call	tbluk		;look it up
	jc	gmnt7
	call	ax		;call the routine
	jmp	short gmnt1
gmnt7:	mov	ax,ds:othswt	;point at other switches
	test	ax,ax		;anything?
	jz	gmnt8		;no
	call	tbluk		;look it up
	jc	gmnt8
	call	ax		;call the routine
	jmp	short gmnt1
gmnt8:	jmp	badswt		;bad switch
gmnt9:	jmp	synerr		;go complain
gmnt10:	xor	ah,ah		;no colon needed
	call	getlog		;get logical name
	jc	gmnt9
	mov	ds:tdev,ax	;save
	mov	ds:tdev+2,bx
	jmp	gmnt1
gmnt11:	; end of line, check to see if this all made sense
	cmp	ds:tdev,0	;is there a logical name
	jnz	gmnt12		;yes
	cram	'?Missing logical name',error
gmnt12:	mov	ax,ds:tdev	;get dev name
	mov	bx,ds:tdev+2	;and flag,,unit
	; if there's already a device with this name, dismount it
	mov	bp,ds:logdev	;get head of list
	jmp	short gmnt15
gmnt13:	cmp	ss:logd[bp],ax	;match?
	jne	gmnt14
	cmp	ss:logu[bp],bx
	jne	gmnt14
	push	ax		;save
	push	bx
	mov	al,ds:dsmunl	;get /[NO]UNLOAD default
	call	dmnt		;dismount device
	pop	bx		;restore
	pop	ax
	jmp	short gmnt16	;go allocate it
gmnt14:	mov	bp,ss:next[bp]	;get next
gmnt15:	test	bp,bp		;is there one?
	jnz	gmnt13		;loop if so
gmnt16:	; set up a record for it
	call	getrec		;get a record
	mov	ss:logd[bp],ax	;set dev name
	mov	ss:logu[bp],bx	;and unit #
	mov	ax,ds:tfsys	;get file system (if any)
	mov	ss:fsys[bp],ax	;save
	mov	ax,ds:tmed	;get medium type (if any)
	mov	ss:med[bp],ax	;save
	; interpret filename and/or switches
	cmp	ds:tfnam,0	;got image filename?
	jnz	gmnt19		;yes
	cmp	byte ptr ds:tdrv+1,0 ;how about /DRIVE?
	jnz	gmnt17		;yes
	; no filename or /DRIVE, use logical name if just one letter
	mov	ax,ds:tdev	;get log dev name
	test	al,al		;is log dev name just one letter?
	jnz	gmnt18		;no, bugged
	cmp	byte ptr ds:tdev+3,0 ;was unit # given?
	jnz	gmnt18		;yes, bugged
	mov	al,ah		;copy
	callr	gdrvl		;handle drive letter
gmnt17:	callr	gdrive		;handle drive
gmnt18:	cram	'?Missing drive or file name',error
gmnt19:	callr	image		;parse image filename (or drive or COM port)
;
strtab:	kw	<COS-310>,cos310 ;uses OS/8 format but text files are weird
	kw	<F-OREIGN>,frgn	;just blocks as far as we're concerned
	kw	<OS-8>,os8	;OS/8, OS/78, OS/278 all use the same format
	kw	<OS78->,os8
	kw	<OS278->,os8
	kw	<RD-S>,rsts	;RSTS Disk Structure
	kw	<RS-TSE>,rsts	;synonym
	kw	<RT-11>,rt11	;RT-11 format
	db	0
;
medtab:	kw	<7-20KB>,rx24	;here for backwards compatibility only
	kw	<MS-CP>,mscp
	kw	<RA6-0>,ra60
	kw	<RA70->,ra70
	kw	<RA71->,ra71
	kw	<RA72->,ra72
	kw	<RA73->,ra73
	kw	<RA80->,ra80
	kw	<RA81->,ra81
	kw	<RA82->,ra82
	kw	<RA90->,ra90
	kw	<RA92->,ra92
	kw	<RK02->,rk02
	kw	<RK-05>,rk05
	kw	<RK06->,rk06
	kw	<RK07->,rk07
	kw	<RL-01>,rl01
	kw	<RL02->,rl02
	kw	<RS03->,rs03
	kw	<RS-04>,rs04
	kw	<RX01->,rx01
	kw	<RX02->,rx02
	kw	<RX03->,rx03
	kw	<RX23->,rx23
	kw	<RX24->,rx24
	kw	<RX26->,rx26
	kw	<RX33->,rx33
	kw	<RX-50>,rx50
	kw	<RX52->,rx52
	kw	<TU56->,tu56
	kw	<TU58->,tu58
	db	0
;
partab:	kw	<BP-ARTITION>,mbpar ;BIOS partition #, 1-4
	kw	<DR-IVE>,mdrv	;hard or floppy disk unit #
	kw	<TY-PE>,mtype	;partition type (hex)
	db	0
;
mnttab:	kw	<I-NTERLEAVE>,intlv ;interleaved image file
	kw	<NOI-NTERLEAVE>,noilv ;non-interleaved image file
	kw	<PA-RTITION>,part ;RT-11 partition #
	kw	<RO-NLY>,ronly	;read-only access to device
	kw	<RW->,rdwrt	;read/write access to device
	db	0
;
mdrv:	; /DRIVE parm
	call	eqnum		;get "=n"
	mov	ds:tdrv,ax	;save
	ret
;
mbpar:	; /BPARTITION parm
	call	eqnum		;get "=n"
	test	al,al		;make sure it's from 1 to 4
	jz	outra1
	cmp	al,4
	ja	outra1
	mov	ds:tbpart,ax	;save
	ret
;
eqnum:	; parse "=n", return number +100h in AX (# must be .LE.255)
	call	skip		;skip blanks, etc.
	jc	mispr1
	cmp	al,':'		;:
	je	eqnum1
	cmp	al,'='		;or =, right?
	jne	mispr1
eqnum1:	inc	si		;yes, eat it
	dec	cx
	call	getn		;get number
	test	ah,ah		;not ridiculous?
	jnz	outra1
	inc	ah		;=1
	ret
mispr1:	jmp	misprm		;missing parm
outra1:	jmp	outran		;out of range
;
mtype:	; /TYPE=hh
	call	skip		;skip blanks, etc.
	jc	mispr1
	cmp	al,'='		;=, right?
	jne	mispr1
	inc	si		;yes, eat it
	dec	cx
	call	geth		;get number
	test	ah,ah		;out of range?
	jnz	outra1
	inc	ah		;=1
	mov	ds:ttype,ax	;save
	ret
;
intlv:	; /INTERLEAVE
	mov	ds:tintlv,101h	;high byte set, low byte=flag
	ret
;
noilv:	; /NOINTERLEAVE
	mov	ds:tintlv,100h	;high byte set, low byte=flag
	ret
;
part:	; /PARTITION=n
	call	skip		;skip blanks, etc.
	jc	part2
	cmp	al,':'		;:
	je	part1
	cmp	al,'='		;or =, right?
	jne	part2
part1:	inc	si		;yes, eat it
	dec	cx
	call	getn		;get number
	mov	ds:tpart,ax	;save
	ret
part2:	jmp	misprm		;missing parm
;
ronly:	; /RONLY
	mov	ds:tronly,101h	;high byte set, low byte=RO flag
	ret
;
rdwrt:	; /RW
	mov	ds:tronly,100h	;high byte set, low byte=RO flag
	ret
;+
;
; Decode image filename from GMOUNT.
;
; ss:bp	log dev rec
;
;-
image:	; filename given, see if it's just a drive name
	mov	si,ds:tfnam	;get ptr to name
	mov	bx,ds:tfnam+2	;length of name
	mov	ah,[si+bx-1]	;get last char
	cmp	bx,2		;right length for "x:"?
	jne	imag1
	cmp	ah,':'		;ends in colon?
	jne	imag1
	mov	al,[si]		;get drive letter
	cmp	al,'A'		;yes, is it a letter?
	jb	imag1
	cmp	al,'Z'
	ja	imag1
	; drive letter
	mov	ds:tfnam,0	;forget filename
	jmp	gdrvl		;go handle it
imag1:	; not a drive letter, see if SCSIht_l:
	cmp	bx,5		;at least long enough for "SCSI:"?
	jb	imag2		;no
	cmp	ah,':'		;ends in colon?
	jne	imag2
	cmp	word ptr [si],"CS" ;SCSI?
	jne	imag2
	cmp	word ptr [si+2],"IS"
	jne	imag2		;no
	jmp	gscsi		;handle it
imag2:	; not SCSI, maybe then it's a COM port
	cmp	bx,5		;long enough for "COMn:"?
	jb	imag4
	cmp	byte ptr [si+4],':' ;colon in the right place?
	jne	imag4
	cmp	word ptr [si],"OC" ;COM?
	jne	imag4
	cmp	byte ptr [si+2],'M'
	jne	imag4		;no
	mov	al,[si+3]	;get unit #
	sub	al,'1'		;subtract base
	cmp	al,4		;valid?
	jae	imag4		;no
	jmp	getcom		;get COM port
imag3:	jmp	swtcon
imag4:	; it's a file, make sure no /DRIVE, /BPART, /TYPE
	mov	ss:hwtype[bp],hwfile ;set type
	mov	al,byte ptr ds:tdrv+1 ;see if any set
	or	al,byte ptr ds:tbpart+1
	or	al,byte ptr ds:ttype+1
	jnz	imag3		;switch conflict if so
	; set default ptrs to block I/O routines (for linear block image)
	mov	ss:rdblk[bp],offset rdfil ;read from file
	mov	ss:wrblk[bp],offset wrfil ;write to file
imag5:	mov	ss:dsrini[bp],offset cret ;no DSR init
	ret
;+
;
; Parse COM port parameters for actual TU58 drive.
;
; bp	log dev rec
; al	unit # (0-3)
; si	pts at 'COMn:bbbbb' string
;
;-
getcom:	; it's a COM port, see if it exists
	add	al,al		;*2
	push	ds		;save
	xor	bx,bx		;point at BIOS data
	mov	ds,bx
	mov	bh,4		;RS232_BASE=400h
	mov	bl,al		;index
	mov	cx,[bx]		;get base port #
	pop	ds		;restore
	jcxz	gcom2		;no such port
	mov	ss:port[bp],cx	;save
	mov	ax,tu58		;default medium is TU58
	cmp	ax,ss:med[bp]	;is that it?
	je	gcom5
	cmp	ss:med[bp],0	;is it something else?
	jz	gcom4		;no, good
gcom1:	jmp	swtcon
gcom2:	cram	'?No such port',error
gcom3:	cram	'?Invalid baud rate',error
gcom4:	mov	ss:med[bp],ax	;set medium type if defaulted
gcom5:	; it does, get baud rate if given
	mov	bx,3		;baud rate divisor for 38.4kbps (default)
	mov	cx,ds:tfnam+2	;get length
	sub	cx,5		;subtract what we ate
	jz	gcom6		;that's all there is
	add	si,5		;skip past colon
	call	getn		;parse baud rate
	test	cx,cx		;that's everything, right?
	jnz	gcom3
	mov	bx,2		;min baud rate
	cmp	ax,2		;will their baud rate cause overflow?
	jb	$+4
	 mov	bx,ax		;no, use it
	mov	ax,0C200h	;divisor is 1C200h/(baud rate)
	mov	dx,1
	div	bx
	mov	bx,ax		;copy
gcom6:	; BX=baud rate divisor, init port for programmed I/O
	mov	dx,ss:port[bp]	;get base port #
	add	dx,3		;line ctrl reg
	mov	al,203		;DLAB=1
	out	dx,al
	sub	dx,3		;baud rate divisor
	mov	al,bl		;write low byte
	out	dx,al
	inc	dx		;+1
	mov	al,bh		;write high byte
	out	dx,al
	inc	dx		;+2
	inc	dx
	mov	al,3		;8 data bits, 1 stop, no parity
	out	dx,al
	dec	dx		;-2
	dec	dx
	xor	al,al		;disable all ints
	out	dx,al
	add	dx,3		;modem ctrl reg
	mov	al,3		;set RTS, DTR
	out	dx,al
	; make sure switches are consistant for TU58
	mov	al,byte ptr ds:tdrv ;get drive # (default=0)
	cmp	al,1		;0 or 1, right?
	ja	gcom7
	mov	ss:drive[bp],al	;save
	mov	al,byte ptr ds:tbpart+1 ;make sure nothing extraneous set
	or	al,byte ptr ds:ttype+1
	jnz	gcom8		;switch conflict if so
	mov	ss:dsrini[bp],offset ddinit
	mov	ss:rdblk[bp],offset rddd
	mov	ss:wrblk[bp],offset wrdd
	mov	ss:devsiz[bp],512d ;# blks
	mov	ss:totblk[bp],512d ;total is same
	mov	ss:totsiz+2[bp],4 ;total in bytes=2^18.
	mov	ss:hwtype[bp],hwtu58 ;it's a real TU58 drive
	ret
gcom7:	jmp	baddrv		;invalid drive #
gcom8:	jmp	swtcon		;switch conflict
;+
;
; Decode hard drive/floppy information.
;
; ss:bp	logical dev record
; al	drive letter
;
;-
gdrvl:	cmp	byte ptr ds:tdrv+1,0 ;/DRIVE already given?
	jnz	gdrvl1		;switch conflict if so
	mov	bl,byte ptr ds:tbpart+1 ;see if /BPART or /TYPE given
	or	bl,byte ptr ds:ttype+1 ;(required for hard drives)
	sub	al,'A'		;convert to phys unit #
	cmp	al,ds:firhd	;floppy or hard?
	jb	gdrvl2		;floppy
if 0
 jmp short gdrvl2 ;;;;
 %out temp fix for 8" C:
endif
	sub	al,ds:firhd	;hard, subtract base
	test	bl,bl		;they gave /BPART and/or /TYPE right?
	jnz	gdrvl3		;yes
	cram	'?Partition not specified',error
gdrvl1:	jmp	swtcon		;switch conflict
gdrvl2:	test	bl,bl		;floppy, partition must not be specified
	jnz	gdrvl1		;switch conflict
gdrvl3:	mov	ah,1		;set "valid" flag
	mov	ds:tdrv,ax	;save
gdrive:	; enter here with DS:TDRV set up
	mov	bl,byte ptr ds:tbpart+1 ;check for /BPART or /TYPE (again)
	or	bl,byte ptr ds:ttype+1 ;(to see if hard or floppy)
	jnz	gdrv2		;hard, skip
	; floppy
	cmp	al,ds:firhd	;floppy, in range?
	jae	gdrv1		;no
if 0
 %out temp fix for 8" C:
 ;;; (comment out the JAE GDRV1 above)
endif
	mov	ss:hwtype[bp],hwflop ;floppy drive
	mov	ss:drive[bp],al	;save unit #
	ret
gdrv1:	jmp	baddrv		;no such drive
gdrv2:	; hard disk partition
	cmp	al,ds:numhd	;in range?
	jae	gdrv1		;punt if not
	or	al,80h		;set "HD" bit
	mov	ss:drive[bp],al	;save
	; read partition table
	mov	cx,5		;retry count
gdrv3:	push	cx		;save
	mov	dl,byte ptr ds:tdrv ;get drive #
	xor	dh,dh		;head=0
	mov	cx,1		;track 0, sector 1
	mov	bx,ds:dbuf	;pt at buffer
	mov	ax,0201h	;func=read 1 sector
	int	13h
	jnc	gdrv4
	xor	ah,ah		;func=reset
	int	13h
	pop	cx		;restore retry count
	loop	gdrv3
	cram	'?Error reading partition table',error
gdrv4:	; search partition table for our partition
	pop	cx		;flush count
	mov	cl,4		;loop count (CH=0 from above)
	xor	dx,dx		;load 0
	xchg	dx,ds:tbpart	;get flag,,partition, zero it
	mov	ax,ds:ttype	;and flag,,type
	add	bx,1BEh		;pt at first table slot
gdrv5:	cmp	byte ptr [bx+4],0 ;is this slot empty?
	jz	gdrv7		;yes, skip it
	inc	byte ptr ds:tbpart ;actual partition +1
	test	dh,dh		;are we going by partition #?
	jz	gdrv6
	dec	dl		;yes, see if we're there
	jz	gdrv8		;we are, check type if we have it
	jmp	short gdrv7	;go check next slot
gdrv6:	cmp	al,[bx+4]	;is this the type byte we're looking for?
	je	gdrv9		;we're done if so
gdrv7:	add	bx,10h		;skip to next slot
	loop	gdrv5		;loop through all
	cram	'?No such partition',error
gdrv8:	test	ah,ah		;found partition, can we double-check type?
	jz	gdrv9		;no, we're satisfied
	cmp	al,[bx+4]	;yes, does it match?
	je	gdrv9		;yes
	cram	'?Partition type mismatch',error
gdrv9:	; DS:BX points to partition table entry
	mov	dh,[bx+1]	;get head
	mov	cx,[bx+2]	;cyl, sector
	mov	al,[bx+4]	;type
;;; put them somewhere
	mov	ss:hwtype[bp],hwpart ;type=H.D. partition
	ret
;+
;
; Actually open the device or container file found by GMOUNT.
;
; ss:bp	logical device record
;
;-
opndev:	mov	bx,ss:hwtype[bp] ;get hardware type
	callr	ds:opnhw[bx]	;dispatch
;
_=0
opnhw	label	word
	disp	hwfile,opnimg	;open image file
	disp	hwflop,cret	;open floppy (already done)
	disp	hwpart,opnhd	;open hard disk partition
	disp	hwtu58,cret	;open TU58 (already done)
	disp	hwaspi,cret	;open ASPI device (already done)
;
opnimg:	; open image file
	mov	ss:dsrini[bp],offset cret ;no DSR init
	mov	ss:rdblk[bp],offset rdfil ;read from file
	mov	ss:wrblk[bp],offset wrfil ;write to file
	mov	si,ds:tfnam	;get ptr to filename
	mov	cx,ds:tfnam+2	;get length
	mov	di,offset dotdsk ;default extension
	call	defext		;apply it if needed
	mov	ax,3D00h	;func=open /RO
	test	byte ptr ds:tronly,-1 ;did they say /RO?
	jnz	opni1
	 mov	al,02h		;no, change it to open /RW
opni1:	int	21h
	jnc	opni2		;skip if OK
	jmp	fnf		;file not found
opni2:	mov	ss:handle[bp],ax ;save handle
	mov	ds:outhnd,ax	;make sure it gets closed if we abort
	xor	dx,dx		;set offset=0000:0000
	xor	cx,cx
	mov	bx,ax		;copy handle
	mov	ax,4202h	;func=lseek from EOF
	int	21h
	mov	ss:totsiz[bp],ax ;save total size
	mov	ss:totsiz+2[bp],dx
if 1
	mov	cl,9d		;bit count
	shr	ax,cl		;convert to blocks
	ror	dx,cl
	mov	cx,dx		;copy
	and	cl,200		;isolate high 9 bits
	or	ax,cx		;compose low word
	mov	ss:devsiz[bp],ax
	and	dx,177		;low 7 bits
	mov	ss:devsiz+2[bp],dx
	mov	ss:totblk[bp],ax ;set total size in blocks
	mov	ss:totblk+2[bp],dx
endif
	ret
;
opnhd:	; one of these days
;;;
	ret
;+
;
; Same as above, but creates file for FORMAT.
;
; ss:bp	log dev rec
;
;-
crtdev:	mov	bx,ss:hwtype[bp] ;get hardware type
	callr	ds:crthw[bx]	;dispatch
;
_=0
crthw	label	word
	disp	hwfile,crtimg	;create image file
	disp	hwflop,cret	;create floppy (nothing to do)
	disp	hwpart,crthd	;create hard disk partition
	disp	hwtu58,cret	;create TU58 (nothing to do)
;
crtimg:	; create image file
	test	byte ptr ds:tronly,-1 ;did they say /RO?
	jnz	crti2		;pinhead
	call	aysure		;make sure they're sure
;;; maybe should ask only if the file exists already?
	mov	ss:dsrini[bp],offset cret ;no DSR init
	mov	ss:rdblk[bp],offset rdfil ;read from file
	mov	ss:wrblk[bp],offset wrfil ;write to file
	mov	si,ds:tfnam	;get ptr to filename
	mov	cx,ds:tfnam+2	;get length
	mov	di,offset dotdsk ;default extension
	call	defext		;apply it if needed
	xor	cx,cx		;mode=default
	mov	ah,3Ch		;func=create
	int	21h
	jnc	crti1		;skip if OK
	jmp	crerr		;file creation error
crti1:	mov	ss:handle[bp],ax ;save handle
	mov	ds:outhnd,ax	;make sure it gets closed if we abort
	ret
crti2:	jmp	rodev		;can't format a read-only device
;
crthd:	; one of these days
	ret
;+
;
; Figure out default medium type (from size or by reading if floppy).
;
; Note that we can't tell an interleaved RX50 (or RX52) image file from a
; non-interleaved one by the size alone (it's 400KB either way), so we'll hold
; off setting ILIMG until DEFSYS for RX50/52s.
;
; ss:bp	logical device record
;
;-
defmed:	cmp	ss:hwtype[bp],hwfile ;image file?
	jne	dmed8		;no
	; look up file type on size (take the biggest that fits)
	mov	ax,ss:totsiz[bp] ;get total image file size
	mov	dx,ss:totsiz+2[bp]
	mov	bx,offset fsztab ;pt at table
	xor	si,si		;nothing found yet
dmed1:	cmp	dx,ds:flsiz+2[bx] ;too small?
	jb	dmed4
	ja	dmed2		;definitely fits
	cmp	ax,ds:flsiz[bx]	;check low word
	jb	dmed4		;too small
dmed2:	; if medium type already known, we're just checking for interleave
	; (filter out other medium types because file may be bigger than
	; necessary w/o hurting anything, that shouldn't confuse us)
	mov	cx,ss:med[bp]	;get current medium type
	jcxz	dmed3		;none, great
	cmp	ds:flmed[bx],cx	;yes, is this the right dev type?
	jne	dmed4		;skip it if not
	mov	ax,ds:tintlv	;get /[NO]INTERLEAVE flag
	test	ah,ah		;did they specify interleave or not?
	jz	dmed3		;no, just take it
	cmp	al,ds:flilv[bx]	;does it match?
	jne	dmed4		;no
dmed3:	mov	si,bx		;save a copy
dmed4:	add	bx,fllen	;skip to next entry
	cmp	bx,offset fszend ;off end?  (including catch-all)
	jb	dmed1		;loop if not
	test	si,si		;get anything?
	jz	dmed6		;no, file too small
	mov	al,ds:flilv[si]	;get interleave flag
	mov	ss:ilimg[bp],al	;save (may already match)
	mov	ax,ds:flmed[si]	;get medium type
	mov	ss:med[bp],ax	;set it, if not already set
dmed5:	ret
dmed6:	; didn't find anything <= this dev's size
	cmp	ss:med[bp],mscp	;did they already say /MSCP?
	je	dmed5		;yes
	test	ss:med[bp],-1	;did they say anything?
	jnz	dmed7		;yes, guess the size was just wrong
	 mov	ss:med[bp],mscp	;assume MSCP if nothing else fits
dmed7:	ret
dmed8:	; not an image file, see if floppy
	cmp	ss:hwtype[bp],hwflop ;floppy disk?
	jne	dmed14
	test	ss:med[bp],-1	;medium specified?
	jnz	dmed13		;yes
	; try reading a sector a few different ways to guess disk type
	mov	si,offset fdtyps ;point at table
dmed9:	lodsw			;get a word
	test	ax,ax		;end of table?
	jz	dmed18		;too bad
	push	si		;save
	call	ax		;set up FDC for test
	pop	si
	lodsw			;get table addr
	mov	bx,ax		;copy
	test	bx,bx		;does it exist?
	jnz	dmed10
	 lodsw			;no, get type (this is a leaf on the tree)
dmed10:	push	ax		;save both (AX is junk if BX is non-zero)
	push	bx
	lodsb			;get cyl
	mov	ch,al
	lodsb			;head
	mov	dh,al
	lodsb			;sector
	mov	cl,al
	push	si		;save
	test	cl,cl		;read specific sector, or just read header?
	js	dmed11		;header
	call	fdrds		;try to read
	jmp	short dmed12
dmed11:	call	fdrid		;read a header
	jc	dmed12		;failed
	mov	al,[si+3]	;get N (SI points to C,H,R,N)
	cmp	ds:fdlen,al	;match?
	je	dmed12		;yes
	stc			;say error
dmed12:	pop	si		;[restore]
	pop	bx
	pop	ax
	jc	dmed9		;loop if failed
	mov	si,bx		;follow branch
	test	si,si		;or was it a leaf?
	jnz	dmed9		;branch, follow it
	mov	ss:med[bp],ax	;leaf, we got it
dmed13:	ret
dmed14:	cmp	ss:hwtype[bp],hwaspi ;ASPI disk?
	jne	dmed15		;no
	mov	ax,mscp		;default=MSCP
	jmp	short dmed16
dmed15:	; not a floppy, see if TU58
	cmp	ss:hwtype[bp],hwtu58 ;TU58?
	jne	dmed17
	mov	ax,tu58		;default=TU58 (the only sensible thing)
dmed16:	; set default type from AX if none specified
	test	ss:med[bp],-1	;medium specified?
	jnz	dmed17		;yes
	 mov	ss:med[bp],ax	;use default
dmed17:	ret
dmed18:	cram	'?Unable to detect disk type',error
;
; Table of file sizes and device geometry.  Used by DEFMED to guess the medium
; type, and by SETMED to set up all the lengths once the medium type is known.
; This table is sorted in order of increasing image file size, so that DEFMED
; can use the latest entry <= the current image file to determine the image
; type.
;
; "2BSD" means geometry was supplied or supplemented by /etc/disktab entry
; from 2BSD UNIX (in cases where DEC docs were lacking or wrong).
;
fsztab	label	byte
	filsiz	rx01,252928d,252928d,,77d,1,26d,128d,1 ;252928. interleaved
	filsiz	rx01,,252928d,,77d,1,26d,128d,0 ;256256. non-interleaved
	filsiz	tu58,,,,1,1,512d,512d,0	;TU58 256 KB
	filsiz	tu56,,,,1,1,578d,512d,0	;TU56 289 KB
	filsiz	rx50,,,,80d,1,10d,512d,1 ;RX50 400 KB (interleaved or not)
	filsiz	rx50,,,,80d,1,10d,512d,0 ;(2nd so ILIMG is cleared for DEFSYS)
	filsiz	rx02,505856d,505856d,,77d,1,26d,256d,1 ;505856. interleaved
	filsiz	rx02,,505856d,,77d,1,26d,256d,0 ;512512. non-interleaved
	filsiz	rs03,,,,64d,1,64d,128d,0 ;RS03 512 KB
	filsiz	rx24,,,,80d,2,9d,512d,0	;RX24 720 KB
	filsiz	rx52,,,,80d,2,10d,512d,1 ;RX52 800 KB (interleaved or not)
	filsiz	rx52,,,,80d,2,10d,512d,0
	filsiz	rx03,1011712d,1011712d,,77d,2,26d,256d,1 ;1011712. interleaved
	filsiz	rx03,,1011712d,,77d,2,26d,256d,0 ;1025024. non-interleaved
	filsiz	rs04,,,,64d,1,64d,256d,0 ;RS04 1024 KB
	filsiz	rk02,,,,200d,2,12d,256d,0 ;RK02 1.2 MB (ignore 3 spare tracks)
	filsiz	rx33,,,,80d,2,15d,512d,0 ;RX33 1.2 MB
	filsiz	rx23,,,,80d,2,18d,512d,0 ;RX23 1.44 MB
	filsiz	rk05,,,,200d,2,12d,512d,0 ;RK05 2.5 MB (ignore 3 spare tracks)
	filsiz	rx26,,,,80d,2,36d,512d,0 ;RX26 2.88 MB
	filsiz	rl01,,,40d*256d,256d,2,40d,256d,0 ;RL01 5 MB
	filsiz	rl02,,,40d*256d,512d,2,40d,256d,0 ;RL02 10 MB
	filsiz	rk06,,,22d*512d,411d,3,22d,512d,0 ;RK06 14 MB
	filsiz	rk07,,,22d*512d,815d,3,22d,512d,0 ;RK07 28 MB
	filsiz	ra80,,,,546d,14d,31d,512d ;RA80 121 MB (560. cyls w/RCT)
	filsiz	ra60,,,,1588d,6,42d,512d ;RA60 205 MB (1592. cyls w/RCT)
	filsiz	ra70,,,,1507d,11d,33d,512d ;RA70 280 MB (no RCT 2BSD)
	filsiz	ra81,,,,1248d,14d,51d,512d ;RA81 456 MB (1258. cyls w/RCT 2BSD)
	filsiz	ra82,,,,1423d,15d,57d,512d ;RA82 622 MB (1427. cyls w/RCT 2BSD)
	filsiz	ra71,,,,1915d,14d,51d,512d ;RA71 700 MB (no RCT 2BSD)
	filsiz	ra72,,,,1915d,20d,51d,512d ;RA72 1.0 GB (no RCT 2BSD)
	filsiz	ra90,,,,2649d,13d,69d,512d ;RA90 1.2 GB (2656. cyls w/RCT)
	filsiz	ra92,,,,3099d,13d,73d,512d ;RA92 1.5 GB (3101. cyls w/RCT)
				;(2BSD RA92 /etc/disktab entry differs wildly)
	filsiz	ra73,,,,2667d,21d,70d,512d ;RA73 2.0 GB (no RCT 2BSD)
;
fszend	label	byte	;end of actual device types
;
; Floppy disk autosizing tables.
;
; Each entry looks like this:
;
;	dw	addr of routine to set up FDC this type, 0 if end of list
;	dw	addr of table to skip to if successful, or 0 if just one type
; [	dw	disk type if successful, if previous word was 0 ]
;	db	cyl,head,sec	to try to read
;
; If SEC is negative then any sector will do (so use FDRID because it's
; faster).
;
fdtyps	dw	inidz,dd512	;512 b/s DD disks in HD drive
	db	0,0,-1
	dw	ini23,hd512	;512 b/s HD disks
	db	0,0,-1
	dw	inidy,hd256	;256 b/s HD disks (8" or workalikes)
	db	0,0,-1
	dw	inidx,0,rx01	;RX01 if this works
	db	0,0,-1
	dw	ini24,0,rx24	;RX24 (250 kHz vs. 300 kHz with DD512)
	db	0,0,-1		;(this would see 360KB drives too)
	dw	ini26,0,rx26	;RX26 if this works
	db	0,0,-1
	dw	0		;end of list
;
dd512	dw	inidz,0,rx52	;RX52 if DS and has 10 sectors
	db	0,1,10d
	dw	inidz,0,rx50	;RX50 if SS and has 10 sectors
	db	0,0,10d
	dw	0
;
hd256	dw	inidy,0,rx03	;RX03 if has side 1
	db	0,1,-1
	dw	inidy,0,rx02	;otherwise must be RX02
	db	0,0,-1
	dw	0
;
hd512	dw	ini23,0,rx23	;RX23 if has 18 sectors
	db	0,0,18d
	dw	ini33,0,rx33	;otherwise must be RX33
	db	0,0,15d
	dw	0
;+
;
; Set all parameters that depend on medium type.
;
; bp	log dev rec
; BADSEC  is left set up for this device (with size of bad sector track)
;
;-
setmed:	mov	ds:badsec,0	;init size of bad sector track
	mov	ds:badsec+2,0
	mov	bx,ss:med[bp]	;get disk type
	cmp	bx,mscp		;MSCP (i.e. variable size) device?
	je	smed4		;yes, keep actual file size
	mov	al,ss:ilimg[bp]	;get interleaved image file flag
	mov	si,offset fsztab ;point at file size table
smed1:	cmp	[si],bx		;is this it?
.assume <flmed eq 0>
	je	smed3		;yes
smed2:	add	si,fllen	;bump to next
	cmp	si,offset fszend ;done all?
	jb	smed1		;loop if not
	jmp	short smed5
smed3:	; found matching device, copy its info if interleave flag matches
	cmp	ds:flilv[si],al	;match?
	jne	smed2		;no
	mov	ax,ds:flbsz[si]	;get size of bad block track in bytes
	mov	dx,ds:flbsz+2[si]
	mov	ds:badsec,ax	;save
	mov	ds:badsec+2,dx
	mov	ax,ds:flsiz[si]	;get file size in bytes
	mov	dx,ds:flsiz+2[si]
	mov	ss:totsiz[bp],ax ;save
	mov	ss:totsiz+2[bp],dx
	; assume a block is 512. bytes and init TOTBLK
	; (can change it later if assumption is wrong)
	mov	cl,9d		;shift count
	shr	ax,cl		;divide by 512.
	ror	dx,cl
	mov	cx,dx		;copy
	and	dl,not 177	;isolate high 9
	xor	cx,dx		;isolate low 7
	mov	ss:totblk+2[bp],cx ;save high order
	or	ax,dx		;compose low order
	mov	ss:totblk[bp],ax ;save
	; same for DEVSIZ
	mov	ax,ds:flusz[si]	;get usable file size
	mov	dx,ds:flusz+2[si]
	mov	cl,9d		;shift count
	shr	ax,cl		;divide by 512.
	ror	dx,cl
	mov	cx,dx		;copy
	and	dl,not 177	;isolate high 9
	xor	cx,dx		;isolate low 7
	mov	ss:devsiz+2[bp],cx ;save high order
	or	ax,dx		;compose low order
	mov	ss:devsiz[bp],ax ;save
	jmp	short smed5
smed4:	; use actual file size for device size (MSCP or other variable size)
	mov	ax,ss:totsiz[bp] ;get file size in bytes
	mov	dx,ss:totsiz+2[bp]
	mov	cl,9d		;shift count
	shr	ax,cl		;divide by 512.
	ror	dx,cl
	mov	cx,dx		;copy
	and	dl,not 177	;isolate high 9
	xor	cx,dx		;isolate low 7
	mov	ss:totblk+2[bp],cx ;save high order
	mov	ss:devsiz+2[bp],cx
	or	ax,dx		;compose low order
	mov	ss:totblk[bp],ax ;save
	mov	ss:devsiz[bp],ax
smed5:	; set up device geometry (used only for floppies at the moment)
	cmp	ss:hwtype[bp],hwaspi ;SCSI?
	je	smed6
	mov	ax,ds:flcyl[si]	;copy # cyls
	mov	ss:ncyls[bp],al	;save low byte
	mov	al,ds:flhd[si]	;# heads
	mov	ss:nhds[bp],al
	mov	ax,ds:flsec[si]	;# sectors
	mov	ss:nsecs[bp],al	;save low byte
	mov	ax,ds:flbs[si]	;# bytes/sector
	mov	ss:secsz[bp],ax
smed6:	; handle any needed special treatment
	mov	si,offset smedty ;pt at table
	call	wdluk		;lookup (BX still = med type)
	jc	smed7		;invalid
	 callr	ax		;init I/O routine ptrs, return
smed7:	ret
;
smedty	label	word		;medium types
				;cyls/heads/sectors, # bytes/sector
	dw	rx01,sfddx	;77/1/26, 128 b/s
	dw	rx02,sfddy	;77/1/26, 256 b/s
	dw	rx03,sfdda	;77/2/26, 256 b/s
	dw	rx23,sfd23	;80/2/18, 512 b/s
	dw	rx26,sfd26	;80/2/36, 512 b/s
	dw	rx33,sfd33	;80/2/15, 512 b/s
	dw	rx50,sfddz	;80/1/10, 512 b/s
	dw	rx52,sfddz	;80/2/10, 512 b/s
	dw	rx24,sfd24	;80/2/9, 512 b/s
	dw	0
;
sfddx:	; RX01 floppy
	mov	ax,offset inidx	;init
	mov	bx,offset dxilv	;interleave routine
	jmp	short sfddx1
;
sfddy:	; RX02(-like) floppy
	mov	ax,offset inidy
	mov	bx,offset dyilv	;interleave routine
	jmp	short sfddx1
;
sfdda:	; RX03(-like) floppy
	mov	ax,offset inidy
	mov	bx,offset dyilv
sfddx1:	; enter here to finish setting up RX01/02/03 floppy
	; AX=init routine, BX=interleave routine
	mov	ss:dsrini[bp],ax ;FDC init routine
	mov	ss:fintlv[bp],bx ;interleave routine
	mov	ss:rdblk[bp],offset rddx ;read from floppy
	mov	ss:wrblk[bp],offset wrdx
	mov	ax,offset fdrds	;assume actual hardware
	mov	bx,offset fdwrs
	cmp	ss:hwtype[bp],hwflop ;right?
	je	sfddx2
	mov	ax,offset rddxf	;no, must be file otherwise
	mov	bx,offset wrdxf
sfddx2:	mov	ss:rdsec[bp],ax	;save
	mov	ss:wrsec[bp],bx
	mov	cl,2		;shift count to convert 128 (sec) to 512 (blk)
	cmp	ss:secsz[bp],256d ;double density?
	jne	sfddx3
	 dec	cx		;yes, fix shift count
sfddx3:	mov	ss:blksec[bp],cl ;save it
	ret
;
sfd24:	; RX24 floppy (720 KB)
	mov	ax,offset ini24
	jmp	short sfddu
;
sfd23:	; RX23 floppy (1.44 MB)
	mov	ax,offset ini23
	jmp	short sfddu
;
sfd26:	; RX26 floppy (2.88 MB)
	mov	ax,offset ini26
	jmp	short sfddu
;
sfd33:	; RX33 floppy (1.2 MB)
	mov	ax,offset ini33
	;jmp	short sfddu
;
sfddu:	; set up RX23/RX24/RX26/RX33 disk or image file
	; AX=DSRINI value
	mov	ss:dsrini[bp],ax ;save
	mov	ss:rdblk[bp],offset rddz
	mov	ss:wrblk[bp],offset wrdz
	mov	ss:fintlv[bp],offset duilv
	mov	ax,offset fdrds	;assume actual hardware
	mov	bx,offset fdwrs
	cmp	ss:hwtype[bp],hwflop ;right?
	je	sfddu1
	mov	ax,offset rdduf	;no, must be file otherwise
	mov	bx,offset wrduf
sfddu1:	mov	ss:rdsec[bp],ax	;save
	mov	ss:wrsec[bp],bx
	ret
;
sfddz:	; RX50 floppy
	mov	ss:dsrini[bp],offset inidz
	mov	ss:rdblk[bp],offset rddz
	mov	ss:wrblk[bp],offset wrdz
	mov	ss:fintlv[bp],offset dzilv
	mov	ax,offset fdrds	;assume actual hardware
	mov	bx,offset fdwrs
	cmp	ss:hwtype[bp],hwflop ;right?
	je	sfddz1
	mov	ax,offset rddzf	;no, must be file otherwise
	mov	bx,offset wrdzf
sfddz1:	mov	ss:rdsec[bp],ax	;save
	mov	ss:wrsec[bp],bx
	ret
;+
;
; Try to guess file system if defaulted.
;
;-
defsys:	test	ss:fsys[bp],-1	;did they tell us?
	jnz	dsys6		;yes
	xor	cx,cx		;no idea yet
dsys1:	push	cx		;save current file system guess
	push	dx		;save ILIMG value that goes with CX
	call	ss:dsrini[bp]	;init DSR
	pop	dx		;restore
	pop	cx
	mov	si,offset chklst ;point at list of routines
dsys2:	lodsw			;get next addr
	test	ax,ax		;end of table?
	jz	dsys3		;yes
	push	si		;save
	push	cx		;save current file system guess
	push	dx		;save ILIMG of that guess
	call	ax		;see if this could be it
	pop	dx		;[restore]
	pop	cx
	pop	si
	jc	dsys2		;no, keep trying
	test	cx,cx		;did we already have a guess?
	jnz	dsys7		;yes, ambiguous
	mov	cx,ax		;save current guess
	mov	dl,ss:ilimg[bp]	;remember whether interleaved
	jmp	short dsys2
dsys3:	; finished trying all tests in table
	cmp	ss:hwtype[bp],hwfile ;image file?
	jne	dsys5		;no
	cmp	ss:med[bp],rx50	;is it an RX50 image?
	je	dsys4
	cmp	ss:med[bp],rx52	;or "RX52" image?
	jne	dsys5
dsys4:	; RX50 or RX52 image file, make second pass through table with ILIMG on
	; (since these files are the same size whether interleaved or not, we
	; can't set ILIMG based on file size alone)
	test	byte ptr ds:tintlv+1,-1 ;did they give explicit interleave?
	jnz	dsys5		;yes, don't mess with it then
	cmp	ss:ilimg[bp],al	;have we already tried both interleaves?
	jnz	dsys5		;yes, see what we got
	inc	ss:ilimg[bp]	;try it the other way
	jmp	short dsys1
dsys5:	jcxz	dsys7		;never found anything
	mov	ss:fsys[bp],cx	;set it
	mov	ss:ilimg[bp],dl	;remember how ILIMG was set

;;; maybe display message saying what we got?

dsys6:	ret
dsys7:	jmp	unksys		;unknown or ambiguous filesystem
;
; List of routines to call (with SS:BP=DSRINI'd dev rec) to see whether the
; current device could possibly be a particular file system.  If not, the
; routine should return CF=1, if so return CF=0 and the file system code in ax.
;
chklst	dw	chkos		;OS/8
	dw	chkrs		;RSTS/E
	dw	chkrt		;RT-11
	dw	0
;
chkos:	; see if it's an OS/8 disk (by doing dir consistency check)
	mov	ss:fsys[bp],os8	;make TRIM12 work temporarily
	xor	dl,dl		;init bitmap of blks 1-6
	mov	ax,1		;start with dir segment #1 (i.e. blk #1)
chkos1:	; handle dir seg # ax (1-6)
	mov	cl,al		;copy seg #
	mov	bl,1		;load a 1
	sal	bl,cl		;shift into place
	test	dl,bl		;bit already set?
	jnz	chkos2		;infinite segment loop, not valid OS/8 dir
	or	dl,bl		;otherwise remember we've been here
	push	ax		;save blk #
	push	dx		;and bitmap
	push	di		;and # info words if any
	mov	di,offset buf	;pt at buffer
	xor	dx,dx		;zero-extend blk #
	mov	cx,1		;read 1 block
	call	ss:rdblk[bp]	;go
	pop	di		;[restore]
	pop	dx
	pop	ax
	jc	chkos2		;error
	cmp	cx,512d		;got all 512. bytes of home block?
	jb	chkos2		;no
	; check header
	mov	bx,[si+10]	;get -(# info words)
	neg	bx		;make positive
	and	bh,7777/400	;trim to 12 bits
	add	bx,bx		;*2
	dec	ax		;is this block 1?
	mov	ax,[si+2]	;[get starting blk # for files in this seg]
	jnz	chkos4		;no
	mov	di,bx		;yes, this is the defn of # info words
	mov	ds:iblk,ax	;init block ctr
	jmp	short chkos5
chkos2:	stc			;fail (keep this centrally located)
chkos3:	mov	ss:fsys[bp],0	;[back the way it was]
	ret
chkos4:	cmp	di,bx		;does this match what was in block 1?
	jne	chkos2
	cmp	ds:iblk,ax	;continues where prev seg left off right?
	jne	chkos2
chkos5:	mov	bx,[si]		;get -(# entries)
	neg	bx		;make positive
	and	bh,7777/400	;trim to 12 bits
	add	si,5*2		;skip to begn of dir
chkos6:	; go through all file entries, make sure it's all believable
	cmp	si,offset buf+512d-4 ;space for 2 words?
	ja	chkos2
	lodsw			;eat a word
	test	ax,ax		;.EMPTY. block?
	jz	chkos7		;yes (otherwise file)
	add	si,4*2-2	;skip remainder of filename
	jc	chkos2
	add	si,di		;skip info words
	jc	chkos2
chkos7:	cmp	si,offset buf+512d-2 ;space for one word?
	ja	chkos2
	lodsw			;get -(length)
	mov	cx,10000	;abs val
	sub	cx,ax
	and	ch,7777/400	;trim in case 0
	add	ds:iblk,cx	;update ptr
	cmp	ds:iblk,10000	;>4K blocks?
	ja	chkos2		;invalid if so
	dec	bx		;done all entries?
	jnz	chkos6		;loop if not
	mov	ax,word ptr ds:buf+4 ;get ptr to next dir seg
	test	ax,ax		;end of chain?  (CF=0)
	jz	chkos8		;yes, yay
	cmp	ax,6		;otherwise must be in [1,6]
	ja	chkos2
	jmp	chkos1
chkos8:	mov	ax,os8		;[looks like an OS/8 disk]
	jmp	short chkos3	;[skip -- CF=0 from TEST AX,AX]
;
chkrs:	; see if it's a RSTS/E disk (by checking pack label record)
	mov	di,offset buf	;pt at buffer
	mov	ax,1		;home block is block 1
	xor	dx,dx
	mov	cx,1		;read 1 block
	call	ss:rdblk[bp]	;go
	jc	chkrs7		;error
	cmp	cx,512d		;got all 512. bytes of home block?
	jb	chkrs7		;no
	; RDS 0.0 MFD header and 1.X pack label records are both at the begn of
	; block 1 and look enough alike that we can check for both
	lodsw			;+00 is 0 or 1, or link word in RDS 0.0
	lodsw			;+02 is flag marking blockette as used
	inc	ax		;must be -1
	jnz	chkrs7
	lodsw			;+04 is reserved (but non-zero on my V9.7 pack)
	lodsw			;+06 is reserved MBZ (0.0) or RDS level (1.X)
	test	ax,ax		;0 is OK for RDS 0.0
	jz	chkrs1
	cmp	ah,1		;1.anything is OK
	jne	chkrs7
chkrs1:	lodsw			;+10 is pack clustersize
	mov	bx,ax		;copy
	sub	bx,1		;-1 (btw, can't be 0)
	jc	chkrs7		;too bad
	and	ax,bx		;must be power of 2
	jnz	chkrs7
	lodsw			;+12 pack status bits
	lodsw			;+14 first word of pack ID
	mov	di,offset buf	;(overlay beginning of buf)
	call	rad50		;convert to decimal
	lodsw			;+16 second word of pack ID
	call	rad50
	; see if pack label looks reasonable
	lea	si,[di-6]	;point at it
	mov	cx,6		;length
chkrs2:	lodsb			;get a char
	cmp	al,' '		;blank?
	je	chkrs5		;yes, make sure no more non-blank
	cmp	al,'0'		;must be letter or number
	jb	chkrs7
	cmp	al,'9'
	jbe	chkrs3
	cmp	al,'A'
	jb	chkrs7
	cmp	al,'Z'
	ja	chkrs7
chkrs3:	loop	chkrs2		;keep going
	jmp	short chkrs6	;6-character label, no sweat
chkrs4:	lodsb			;get another
	cmp	al,' '		;must be blank
	jne	chkrs7		;no, invalid
chkrs5:	loop	chkrs4		;count through blanks
chkrs6:	mov	ax,rsts		;looks good
	clc
	ret
chkrs7:	stc			;no
	ret
;
chkrt:	; see if it's an RT-11 disk (by checking signature in home block)
	call	rtpart		;try mounting RT-11 partition
	jc	chkrt2		;failed
	mov	di,offset buf	;pt at buffer
	mov	ax,ss:curdir[bp] ;get base of partition
	mov	dx,ss:curdir+2[bp]
	add	ax,1		;home block is block 1
	adc	dx,0
	mov	cx,1		;read 1 block
	call	ss:rdblk[bp]	;go
	jc	chkrt2		;error
	cmp	cx,512d		;got all 512. bytes of home block?
	jb	chkrt2		;no
	add	si,760		;index to system ID field
	mov	ax,si		;save
	mov	di,offset sgnrt	;point at "DECRT11A" signature
	mov	cx,12d/2	;12 chars long including blanks
	repe	cmpsw		;match?
	je	chkrt1		;yes
	mov	si,ax		;restore SI
	mov	di,offset sgnvex ;point at "DECVMSEXCHNG" signature
				;(thanks to Tim Shoppa for this information)
	mov	cl,12d/2	;12 chars long (CH=0 from above)
	repe	cmpsw		;match?
	jne	chkrt2		;no
chkrt1:	mov	ax,rt11		;yay
	ret			;CF=0 from REPE CMPSW
chkrt2:	stc			;it's not us
	ret
;+
;
; Set all parameters that depend on file system.
;
;-
setsys:	mov	bx,ss:fsys[bp]	;get file system
	mov	si,offset setsy	;pt at table
	call	wdluk		;look it up
	jc	ssys2		;not found?!
	call	ax
	test	byte ptr ds:tronly,-1 ;did they say /RONLY?
	jz	ssys2		;no
	; read-only, shoot out vectors that would try to write
	mov	si,offset rovecs ;point at list
ssys1:	lodsw			;get an entry
	mov	di,ax		;copy
	inc	ax		;end of table?
	jz	ssys2		;yes
	mov	word ptr ss:[bp+di],offset rodev ;pt at routine to bomb out
	jmp	short ssys1	;loop
ssys2:	ret
;
rovecs	dw	wrblk
	dw	wrasc
	dw	dirout
	dw	create
	dw	write
	dw	wlast
	dw	close
	dw	delfil
	dw	wboot
	dw	wipout
	dw	-1
;
; Routines to set up pointers for file system
setsy	dw	frgn,setfr	;FOREIGN
	dw	cos310,setos	;COS-310
	dw	os8,setos	;OS/8
	dw	rsts,setrs	;RSTS
	dw	rt11,setrt	;RT11
	dw	0
;
setfr:	; set up for FOREIGN file system
	mov	si,offset frvecs ;pt at vectors
	callr	setvec		;set them, return
;
setos:	; set up for OS/8 or COS-310 file system
	mov	ax,ss:med[bp]	;get medium type
	mov	bx,767d		;# usable blocks in RX50
	cmp	ax,rx50
	je	setos1
	add	bx,bx		;*2 for DS RX50
	cmp	ax,rx52
	jne	setos2
setos1:	; tracks 0, 78, 79, are for slushware on OS/278
	; also last 3 blocks of track 77 (for some reason)
	mov	ss:devsiz[bp],bx ;fix up size
	mov	ss:totblk[bp],bx
setos2:	mov	ss:rdasc[bp],offset rdos ;read and convert to ASCII
	mov	ss:wrasc[bp],offset wros ;convert to 12-bit and write
	mov	si,offset osvecs ;pt at other vectors
	callr	setvec		;set them, return
;
setrs:	; set up for RSTS/E file system
	mov	ss:rdasc[bp],offset rsrd ;stripping NULs done after clu read
	mov	si,offset rsvecs ;pt at other vectors
	callr	setvec		;set them, return
;
setrt:	; set up for RT-11 file system
	mov	ax,ss:med[bp]	;get medium type
	cmp	ax,rl01		;see if DL: or DM:
	je	setrt1
	cmp	ax,rl02
	je	setrt1
	cmp	ax,rk06
	je	setrt1
	cmp	ax,rk07
	jne	setrt2
setrt1:	; DL: or DM:, knock 10. blocks off DEVSIZ for bad block replacements
	sub	ss:devsiz[bp],10d ;do it (DEVSIZ+2 is 0 for these disk types)
;;; this would be a good place to replace RDBLK/WRBLK with routines that check
;;; the bad block replacement table
setrt2:	mov	ss:rdasc[bp],offset rdrt ;routine to read and strip NULs
	call	mntrt		;mount appropriate partition, or bomb
	mov	si,offset rtvecs ;pt at other vectors
	callr	setvec		;set them, return
;
	subttl	parsing routines
;+
;
; Parse a (possibly wildcarded) filename.
;
; On entry:
; si,cx	cmd line descriptor
; di	buffer in which to put .ASCIZ wildcard (updated on return)
; bl<0>	0 => omitted fields are null
;	1 => omitted fields are *
;
;-
filnam:	jcxz	fn4		;nothing, skip
	mov	dx,si		;to see if we get anything
	xor	ah,ah		;no '.' yet
	cmp	byte ptr [si],'.' ;null name?
	jne	fn1		;no
	test	bl,1		;yes, leave it?
	jz	fn1		;yes
	mov	al,'*'		;save a *
	stosb
fn1:	lodsb			;get a char
	cmp	al,' '		;separator?
	jbe	fn3
	cmp	al,ds:swchar	;switch?
	je	fn3
	cmp	al,'.'		;ext?
	jne	$+4		;no
	 mov	ah,al		;remember so
	cmp	al,'a'		;lc?
	jb	fn2
	cmp	al,'z'
	ja	fn2
	and	al,not 40	;convert to uc
fn2:	stosb			;save it
	loop	fn1		;loop
	inc	si		;correct for below
fn3:	dec	si		;unget delimiter
	cmp	dx,si		;did we get anything?
	je	fn4		;no
	test	ah,ah		;was there an ext?
	jnz	fn4		;yes
	mov	al,'.'		;add dot
	stosb
	test	bl,1		;do we care?
	jz	fn4		;no
	mov	al,'*'		;*
	stosb
fn4:	xor	al,al		;AL=0, CF=0
	stosb			;mark end
	ret
;+
;
; Apply a default extension to a DOS filename.
;
; si,cx	describe filename (with 5 bytes available for "/.EXT/<0>")
;	(cx must not be 0)
; di	points at default .ASCIZ extension (with "." at beginning)
; dx	returns ptr to .ASCIZ filename
;
;-
defext:	mov	dx,si		;save a ptr
	xor	bl,bl		;no '.' yet
dfex1:	lodsb			;get a char
	cmp	al,'.'		;possible extension?
	je	dfex3
	cmp	al,'/'		;slash?
	je	dfex2
	cmp	al,'\'		;either way?
	jne	dfex4
dfex2:	xor	al,al		;clear flag (previous "." was part of path)
dfex3:	mov	bl,al		;set "." flag, or clear it
dfex4:	loop	dfex1		;loop
	test	bl,bl		;already got a "." in final path element?
	jnz	dfex6		;yes, we're done
	; copy in default extension
	xchg	si,di		;swap places
dfex5:	lodsb			;get a char
	stosb			;save it
	test	al,al		;done all?  (including final NUL)
	jnz	dfex5		;loop if not
	ret
dfex6:	mov	[si],cl		;mark end (CL=0 from LOOP)
	ret
;+
;
; Convert two TEXT characters to ASCII.
;
; ds:si	pointer to word to LODSW (or enter at TEXT3 if already done)
; es:di	output buffer (including blanks)
; ds:bx	output buffer (blanks squished out)
;
;-
text2:	lodsw			;get them
text3:	; enter here if AX already loaded
	mov	ch,al		;save low char
	sal	ax,1		;left 2
	sal	ax,1
	mov	al,ah		;get the char
	call	text4		;display it
	mov	al,ch		;low char
text4:	and	al,77		;isolate
	jz	text5		;space, special case
	mov	ah,al		;copy
	sub	ah,40		;get sign bits
	and	ah,100		;the one we want
	or	al,ah		;set it (or not)
	stosb
	mov	[bx],al		;save
	inc	bx
	ret
text5:	mov	al,' '		;blank
	stosb			;not saved in buf at [bx]
	ret
;+
;
; Convert word in ax to .RAD50 at es:di.
;
;-
rad50:	mov	bx,50		;radix
	xor	dx,dx		;DX=0
	div	bx		;divide (remainder in DL)
	div	bl		;divide (AL=quotient, AH=rem)
	mov	bl,al		;get first char
	mov	al,ds:r50[bx]
	stosb
	mov	bl,ah		;2nd char
	mov	al,ds:r50[bx]
	stosb
	mov	bl,dl		;3rd char
	mov	al,ds:r50[bx]
	stosb
	ret
;+
;
; Convert word in ax to .RAD50 at es:di, squishing out blanks.
;
;-
radnb:	mov	bx,50		;radix
	xor	dx,dx		;DX=0
	div	bx		;divide (remainder in DL)
	div	bl		;divide (AL=quotient, AH=rem)
	mov	bl,al		;get first char
	mov	al,ds:r50[bx]
	cmp	al,' '		;save unless blank
	je	$+3
	 stosb
	mov	bl,ah		;2nd char
	mov	al,ds:r50[bx]
	cmp	al,' '
	je	$+3
	 stosb
	mov	bl,dl		;3rd char
	mov	al,ds:r50[bx]
	cmp	al,' '
	je	$+3
	 stosb
	ret
;+
;
; Get radix-50 filename (no dir path) into RTFILE.
;
; ax	default extension
; si,cx	cmd line descriptor (updated on return)
;
; CF=1 means no filename was given
;
;-
gradfn:	push	ax		;save
	call	skip		;skip to filename
	call	grad		;get filename part
	jc	gradf1		;nothing, error
	mov	ds:rtfile,bx	;save filename
	mov	ds:rtfile+2,dx
	test	al,al		;end of filename?
	jz	gradf2		;yes, use default
	cmp	al,'.'		;otherwise must be .
	jne	gradf3		;nope
	inc	si		;eat the .
	dec	cx
	call	grad		;get extension
	mov	ds:rtfile+4,bx	;save
	clc			;happy return
gradf1:	pop	ax		;flush default extension
	ret
gradf2:	pop	ds:rtfile+4	;catch default extension (CF=0 from TEST AL,AL)
	ret
gradf3:	jmp	synerr		;syntax error
;+
;
; Get a radix-50 filename element (up to 6 chars).
;
; si,cx	input buf descriptor (updated on return)
; bx,dx	return first, second groups of 3 chars
; al	returns char we stopped on (0 if EOL)
;
; CF=1 if nothing gotten (AL=0).
;
;-
grad:	xor	bx,bx		;in case null
	xor	dx,dx
	call	rdig		;get a digit
	jc	grad3
	mov	bx,50*50	;multiplier
	mul	bx		;put in 1st posn, DX=0
	mov	bx,ax
	call	rdig		;2nd digit
	jc	grad2
	mov	ah,50		;multiplier
	mul	ah		;put in 2nd posn
	add	bx,ax
	call	rdig		;3rd digit
	jc	grad2
	add	bx,ax
	call	rdig		;4th digit
	jc	grad2
	mov	dx,50*50	;multiplier
	mul	dx		;put in posn
	mov	dx,ax		;save in DX
	call	rdig		;5th digit
	jc	grad2
	mov	ah,50		;multiplier
	mul	ah		;put in posn
	add	dx,ax
	call	rdig		;6th digit
	jc	grad2
	add	dx,ax
grad1:	call	rdig		;eat excess digits
	jnc	grad1		;and throw them away
grad2:	clc			;happy
grad3:	ret
;+
;
; Get radix 50 digit into ax.
; Returns CF=1 and AL=char if not a radix 50 char (0 if EOL).
;
;-
rdig:	xor	al,al		;in case EOL
	jcxz	rdig2		;end of line, skip
	lodsb			;get a char
	dec	cx		;assume we're taking it
	cbw			;AH=0 if valid
	cmp	al,'$'		;#?
	je	rdig3
	cmp	al,'%'		;%?
	je	rdig4
	cmp	al,'0'		;digit?
	jb	rdig1
	cmp	al,'9'
	jbe	rdig5		;yes
	cmp	al,'A'		;letter?
	jb	rdig1
	cmp	al,'Z'
	jbe	rdig7		;yes
	cmp	al,'a'		;lower case letter?
	jb	rdig1
	cmp	al,'z'
	jbe	rdig6		;yes
rdig1:	dec	si		;invalid, unget
	inc	cx
rdig2:	stc			;unhappy return
	ret
rdig3:	mov	al,33		;$ (CF=0 from CMP)
	ret
rdig4:	mov	al,35		;% (CF=0 from CMP)
	ret
rdig5:	sub	al,'0'-36	;digits start at 36 (CF=0)
	ret
rdig6:	and	al,not 40	;convert to upper
rdig7:	sub	al,'A'-1	;letters start at 1 (CF=0)
	ret
;+
;
; Get a TEXT filename element (up to 6 chars).
;
; si,cx	input buf descriptor (updated on return)
; bx,dx,di  return first, second, third pairs of chars
; al	returns char we stopped on (0 if EOL)
;
; CF=1 if nothing gotten (AL=0).
;
;-
gtext:	xor	bx,bx		;in case null
	xor	dx,dx
	xor	di,di
	call	tchar		;get a char
	jc	gtxt3
	mov	bh,al		;copy
	shr	bx,1		;shift into place
	shr	bx,1
	call	tchar		;2nd digit
	jc	gtxt2
	or	bl,al
	call	tchar		;3rd digit
	jc	gtxt2
	mov	dh,al		;copy
	shr	dx,1		;shift into place
	shr	dx,1
	call	tchar		;4th digit
	jc	gtxt2
	or	dl,al
	call	tchar		;5th digit
	jc	gtxt2
	xchg	al,ah		;><
	shr	ax,1		;shift into place
	shr	ax,1
	mov	di,ax		;save
	call	tchar		;6th digit
	jc	gtxt2
	or	di,ax
gtxt1:	call	tchar		;eat excess digits
	jnc	gtxt1		;and throw them away
gtxt2:	clc			;happy
gtxt3:	ret
;+
;
; Get TEXT char into AL (AH=0).
; Returns CF=1 and AL=char if not a radix 50 char (0 if EOL).
;
;-
tchar:	xor	al,al		;in case EOL
	jcxz	tchr2		;end of line, skip
	lodsb			;get a char
	dec	cx		;assume we're taking it
	cmp	al,'0'		;digit?
	jb	tchr1
	cmp	al,'9'
	jbe	tchr3		;yes
	cmp	al,'A'		;letter?
	jb	tchr1
	cmp	al,'Z'
	jbe	tchr3		;yes
	cmp	al,'a'		;lower case letter?
	jb	tchr1
	cmp	al,'z'
	jbe	tchr3		;yes
tchr1:	dec	si		;invalid, unget
	inc	cx
tchr2:	stc			;unhappy return
	ret
tchr3:	and	ax,77		;truncate, AH=0, CF=0
	ret
;+
;
; Find length of .ASCIZ string.
;
; si	points to string (preserved)
; cx	returns length
;
;-
lenz:	mov	cx,si		;copy
lenz1:	lodsb			;get a byte
	test	al,al		;end?
	jnz	lenz1		;loop if not
	xchg	si,cx		;restore si, copy
	sub	cx,si		;find length (including ^@)
	dec	cx		;(not including ^@)
	ret
;+
;
; Check for a wildcard (or not) match.
;
; On entry:
; si	points to .ASCIZ /wildcard/
; di	points to .ASCIZ /test string/
;
; On return, ZF is set if it was a match.
;
;-
wild:	lodsb			;get a byte
	cmp	al,'?'		;match 1 char?
	je	wild2		;yes
	cmp	al,'*'		;match any # of chars?
	je	wild3		;yes
	; not wildcard char - just check it
	scasb			;is it the same?
	jne	wild1		;no, return
	test	al,al		;yes, end (of both)?
	jnz	wild		;loop if not
wild1:	ret
wild2:	; ? - match exactly one char
	xor	al,al		;load 0
	scasb			;skip 1 char
	jnz	wild		;OK if not end of string
	or	al,1		;Z=0
	ret
wild3:	; * - match anything
	push	si		;save
	push	di
	call	wild		;check (recursively for each posn of di)
	pop	di		;restore
	pop	si
	jz	wild1		;got it
	mov	al,[di]		;get char
	inc	di		;skip
	cmp	al,'.'		;can't match .
	je	wild4		;skip if that's it
	test	al,al		;end?
	jnz	wild3		;loop if not end
wild4:	or	al,1		;never found it, Z=0
	ret
;+
;
; Map a test string from a source wildcard to a destination wildcard, if it
; matches the source wildcard.
;
; The idea is, if the user says COPY *.FOR *.FTN then we should (for example)
; copy TEST.FOR to TEST.FTN.
;
; On entry:
; si	points to .ASCIZ /source wildcard/
; di	points to .ASCIZ /test string/
; bx	points to .ASCIZ /destination wildcard/
; dx	points to output buffer (receives .ASCIZ string)
;
; On return, ZF=1 if it was a match.
;
;-
mapwld:	lodsb			;get a byte
	cmp	al,'?'		;match 1 char?
	je	mpwld2		;yes
	cmp	al,'*'		;match any # of chars?
	je	mpwld3		;yes
	; not wildcard char - just check it
	scasb			;is it the same?
	jne	mpwld1		;no, return
	test	al,al		;yes, end (of both)?
	jnz	mapwld		;loop if not
	call	mpwcpy		;copy whatever's left
	jnc	mpwld6		;should be no more wildcard chars
mpwld1:	ret
mpwld2:	; ? - match exactly one char
	mov	ah,[di]		;get the char
	inc	di		;skip it
	test	ah,ah		;EOL?
	jz	mpwld5		;yes, bugged
	cmp	ah,'.'		;can't match .
	je	mpwld5		;skip if that's it
	call	mpwcpy		;copy up to ?
	jc	mpwld6		;missing, invalid dest wildcard
	cmp	al,'?'		;it IS a ? right?
	jne	mpwld6		;invalid if not
	xchg	dx,di		;swap for now
	mov	al,ah		;copy
	stosb			;save
	xchg	dx,di		;restore things
	jmp	short mapwld
mpwld3:	; * - match anything
	call	mpwcpy		;copy up to *
	jc	mpwld6		;invalid if missing
	cmp	al,'*'		;it IS a * right?
	jne	mpwld6		;invalid if not
mpwld4:	push	si		;save
	push	di
	push	bx
	push	dx
	call	mapwld		;check (recursively for each posn of di)
	pop	dx		;restore
	pop	bx
	pop	di
	pop	si
	jz	mpwld1		;got it
	mov	al,[di]		;get char
	inc	di		;skip
	cmp	al,'.'		;can't match .
	je	mpwld5		;skip if that's it
	xchg	dx,di		;swap
	stosb			;save char
	xchg	dx,di		;restore
	test	al,al		;end?
	jnz	mpwld4		;loop if not end
mpwld5:	or	al,1		;never found it, ZF=0
	ret
mpwld6:	cram	'?Incompatible source and destination wildcards',error
;
mpwcpy:	; copy non-wildcard part of output spec up to next wildcard char
	; return CF=1 if reached end of string w/no wildcard
	xchg	bx,si		;swap for a second
	xchg	dx,di
mpwcp1:	lodsb			;get a char
	test	al,al		;end?
	jz	mpwcp2
	cmp	al,'?'		;wildcard char?
	je	mpwcp3
	cmp	al,'*'
	je	mpwcp3
	stosb			;no, save
	jmp	short mpwcp1	;loop
mpwcp2:	stosb			;write EOL
	stc			;EOL
mpwcp3:	xchg	bx,si		;[restore]
	xchg	dx,di
	ret
;
	subttl	DOS file structure
;+
;
; Print volume name.
;
;-
dosvn:	mov	dx,offset dosroo ;pt at wildcard
	mov	cx,08h		;find VOLSER
	mov	ah,4Eh		;func=find first match
	int	21h		;do it
	jc	nolbl		;not found, no label (leave as blanks)
	cram	' is '		;it worked
	mov	si,80h+30d	;pt at filename
	mov	dx,di		;init
dosvn1:	lodsb			;get a byte
	test	al,al		;end?
	jz	dosvn3
	cmp	al,'.'		;period?
	jne	dosvn2
	cmp	si,80h+30d+8d+1	;yes, after 8 chars of vol name?
	je	dosvn1		;yes, ignore it
dosvn2:	stosb			;copy
	cmp	al,' '		;blank?
	jne	dosvn1		;loop if not
	lea	dx,[di-1]	;save ptr to blank
	jmp	short dosvn1
dosvn3:	cmp	al,' '		;were there trailing blanks?
	jne	dosvn4		;no
	mov	di,dx		;back up to last blank
dosvn4:	ret
nolbl:	cram	' has no label'
	ret
;+
;
; Set default dir for DOS.
;
;-
dosds:	push	si		;save
	push	cx
	mov	cx,64d		;get buf for path
	call	getmem
	mov	ss:actdir[bp],si ;save ptr to dir name
	mov	di,si		;copy
	mov	dl,byte ptr ss:logd+1[bp] ;get drive letter
	sub	dl,'A'-1	;convert to 1=A, 2=B, etc.
	mov	ah,47h		;func=get curr directory
	int	21h
	jc	dosds5
	; normalize path separators
	mov	ah,'/'		;SWITCHAR is usually '/'
	cmp	byte ptr ds:swchar,ah ;is it?
	jne	dosds1		;no, use '/' for path separator
	 mov	ah,'\'		;yes, use '\'
dosds1:	lodsb			;get a char
	test	al,al		;end of string?
	jz	dosds4
	cmp	al,'/'		;forward slash?
	je	dosds2
	cmp	al,'\'		;backslash?
	jne	dosds3
dosds2:	mov	al,ah		;normalize slashes
dosds3:	stosb
	jmp	short dosds1
dosds4:	pop	cx		;restore
	pop	si
	ret
dosds5:	jmp	dirio		;dir I/O error
;+
;
; Save DOS CWD.
;
; bx	0 for input dev, 2 for output dev
;
;-
dossav:	mov	ax,ss:actdir[bp] ;get ptr to active dir name
	mov	ds:savdir[bx],ax
	ret
;+
;
; Restore DOS CWD.
;
; bx	0 for input dev, 2 for output dev
;
;-
dosrst:	mov	ax,ds:savdir[bx] ;get ptr to active dir name
	mov	ss:actdir[bp],ax
	ret
;
dosdh:	; DOS dir listing header (there is none, but init counters)
	xor	ax,ax		;load 0
	mov	ds:nfile,ax	;no files yet
	mov	ds:nblk,ax	;use NBLK for byte count
	mov	ds:nblk+2,ax
	ret
;+
;
; Init for dir lookup (called through SS:DIRINP[BP]).
;
;-
dosdi:	mov	di,offset buf	;pt at temp buf
	mov	dx,di		;save ptr
	mov	al,byte ptr ss:logd+1[bp] ;get drive letter
	mov	ah,':'		;d:
	stosw
	mov	cx,1		;filename prefix
	call	dosdn		;add dir name
	mov	ax,".*"		;'*.'
	stosw
	mov	ax,'*'		;'*'<0>
	stosw
	mov	cx,177761	;everything but volser, system, hidden
	mov	ah,4Eh		;func=find first match
	int	21h		;do it
	sbb	ax,ax		;-1 if err, else 0
	not	ax		;flip
	mov	ds:matchf,ax	;save
	ret
;+
;
; Get next dir entry (called through SS:DIRGET[BP]).
;
; On return:
; CF=1		no more entries
; CF=0 ZF=1	empty block (for file systems that support them)
; CF=0 ZF=0	file
;
; If file, DS:LBUF contains filename for display, di points to end of display
; filename and beginning of .ASCIZ filename with blanks collapsed for
; comparison.
;
; For example:
; FOO   .SVFOO.SV
; ^LBUF    ^di   ^0
;
; Various information about the file is stored in global variables, some of it
; in file system-specific variables (to be interpreted by the system-specific
; DIRDIS routines) and the rest in standard places:
;
; DS:LBUF	DB filename, see above
; DS:FBCNT	DD max equivalent file size in 8-bit bytes depending on BINFLG
;		(may really be less if ASCII file due to stripping nulls, etc.)
; DS:FDATF	DB NZ if date is valid:
;  DS:FDAY	DB day (1-31.)
;  DS:FMONTH	DB month (1-12.)
;  DS:FYEAR	DW year (4 digits)
; DS:FTIMF	DB NZ if time is valid:
;  DS:FSEC	DB sec (0-59. or -1 if not supported)
;  DS:FMIN	DB minute (0-59.)
;  DS:FHOUR	DB hour (0-23.)
;
;-
dosdg:	; get DOS dir entry
	cmp	ds:matchf,0	;error last time?
	jnz	dsdg1		;no
	stc			;no more files
	ret
dsdg1:	mov	word ptr ds:ftimf,0 ;no date or time
	mov	si,80h+21d	;pt at file info
	; get file type
	lodsb			;get it
	mov	ds:fattr,al	;save
	; DOS time is 16 bits:  HHHHHMMMMMMSSSSS
	; HHHHH=hour (0-23.), MMMMMM=minute (0-59.), SSSSS=second/2 (0-29.)
	; note that 12 midnight is not representable because 0 means "no time"
	lodsw			;get time
	test	ax,ax		;was there one?
	jz	dsdg2
	mov	bl,al		;get sec/2
	and	bl,37		;isolate
	sal	bl,1		;*2=seconds
	mov	ds:fsec,bl	;save
	mov	cl,3		;bit count
	shr	ax,cl		;align hour
	dec	cx		;count=2
	shr	al,cl		;align minute
	and	ax,1F3Fh	;isolate
	mov	word ptr ds:fmin,ax ;save
	inc	ds:ftimf	;time is valid
dsdg2:	; DOS date is 16 bits:  YYYYYYYMMMMDDDDD
	; YYYYYYY is year-1980, MMMM and DDDD are the usual
	lodsw			;get date
	test	ax,ax		;was there one?
	jz	dsdg3
	mov	cl,3		;bit count
	mov	bx,ax		;copy
	sal	bx,cl		;shift month into place
	mov	bl,al		;get day again
	and	bx,0F1Fh	;isolate month,,day
	mov	word ptr ds:fday,bx ;save
	mov	al,ah		;get year-1980
	shr	al,1		;shift into place
	cbw			;AH=0
	add	ax,1980d	;add base
	mov	ds:fyear,ax	;save
	inc	ds:fdatf	;date is valid
dsdg3:	; get file size
	lodsw			;low word
	mov	ds:fbcnt,ax
	lodsw			;high word
	mov	ds:fbcnt+2,ax
	; copy and format the filename
	mov	di,offset lbuf	;pt at line buffer
	mov	cx,12d/2	;wc
	mov	ax,"  "		;data
	rep	stosw		;blank 12. bytes (FILENAME.EXT)
	mov	cx,di		;save ptr to begn of filename
	; copy the filename as-is
	xor	ah,ah		;no '.' yet
dsdg4:	lodsb			;get next byte
	test	al,al		;end?
	jz	dsdg5
	cmp	al,'.'		;dot?
	jne	$+4		;no
	 mov	ah,al		;yes, remember
	stosb			;save
	jmp	short dsdg4	;loop
dsdg5:	; add dot if there was none (. and .. fool us the right way here)
	test	ah,ah		;was there a dot?
	jnz	dsdg6		;yes (AL=0)
	mov	al,'.'		;no, write one
	stosb
	xor	al,al		;load a 0
dsdg6:	stosb			;mark end
	; now copy the filename alone, or the whole thing if . or ..
	mov	di,offset lbuf	;pt at buf again
	mov	si,offset lbuf+12d ;pt at begn of copied filename
	cmp	byte ptr [si],'.' ;does it start with .?
	je	dsdg9		;yes, extension is meaningless
dsdg7:	; copy filename (up to .)
	lodsb			;get a char
	cmp	al,'.'		;end of filename?
	je	dsdg8		;yes, skip
	stosb			;save
	jmp	short dsdg7	;loop
dsdg8:	; end of filename, copy '.' and extension
	mov	di,offset lbuf+8d ;pt at ext
	stosb			;save the '.'
dsdg9:	; copy extension (or whole filename if . or ..)
	lodsb			;get a char
	test	al,al		;end of filespec?
	jz	dsdg10		;yes, skip
	stosb			;save
	jmp	short dsdg9	;loop
dsdg10:	; make a copy of the squished name for opening, etc.
	mov	si,offset lbuf+12d ;pt at filename
	mov	di,offset dosfil ;pt at buffer
dsdg11:	lodsb			;get a byte
	stosb			;save
	test	al,al		;end?
	jnz	dsdg11		;loop until copied
	; search for next file
	mov	dx,80h		;some people think DOS 3.0+ needs DTA in DS:DX
	mov	ah,4Fh		;func=find next
	int	21h		;do it
	adc	ds:matchf,0	;up to 0 if err
	mov	di,offset lbuf+12d ;pt at filename
	mov	al,ds:fattr	;get attribute
	not	al		;flip
	and	al,20		;CF=0, ZF=0 unless directory
	ret
;
dossum:	; DOS dir listing summary
	mov	di,offset lbuf	;pt at buf
	; print # files, # bytes
	mov	ax,ds:nfile	;get # files
	push	ax		;save
	mov	cx,9d		;field width
	xor	dx,dx		;0-extend
	call	cnum		;print
	cram	' file'
	pop	ax		;restore #
	call	adds		;add s
	mov	cx,offset lbuf+28d ;pt at dest col
	sub	cx,di		;find # blanks to write
	mov	ax,ds:nblk	;get byte count
	mov	dx,ds:nblk+2
	push	dx		;save
	push	ax
	call	cnum
	cram	' byte'
	pop	ax		;restore
	pop	dx
	call	dadds		;add s
	call	flush		;flush line
	; print # free bytes
	mov	dl,byte ptr ss:logd+1[bp] ;get drive letter
	sub	dl,'A'-1	;convert to 1=A, 2=B, etc.
	mov	ah,36h		;func=get disk size info
	int	21h		;AX=clustersize, BX=avail clusters, CX=b/s
	mul	cx		;calc bytes/cluster
	mov	cx,ax		;save low order
	mov	ax,bx		;get free space
	mul	dx		;find high order partial product
	xchg	ax,cx		;save middle word, get old low order
	mul	bx		;find low order partial product
	add	dx,cx		;find low 32 bits of 48-bit product
	push	dx		;save
	push	ax
	mov	cx,28d		;field size
	call	cnum		;print it
	cram	' byte'
	pop	dx		;restore
	pop	ax
	call	dadds		;add s
	cram	' free'
	callr	flush		;flush, return
;+
;
; Put current directory name in output buffer.  Called through SS:DIRNAM[BP].
;
; ss:bp	log dev rec
; es:di	buffer ptr (updated on exit)
; cx	0 if for prompt (omit trailing '\' for DOS)
;	1 if path prefix
; dx	preserved
;
;-
dosdn:	; print DOS dir name (CX=1 to add \, 0 not to)
	mov	al,'/'		;SWITCHAR is usually '/'
	cmp	byte ptr ds:swchar,al ;is it?
	jne	dosdn1		;no, use '/' for path separator
	 mov	al,'\'		;yes, use '\'
dosdn1:	stosb			;write the first one for sure
	mov	ah,al		;save
	mov	si,ss:actdir[bp] ;get ptr to dir
	lodsb			;get a byte
	test	al,al		;root?
	jz	dosdn3		;yes, leave it regardless of cx
dosdn2:	stosb			;save it
	lodsb			;get next
	test	al,al		;end?
	jnz	dosdn2		;loop if not
	mov	al,ah		;get path sep
	rep	stosb		;write one if CX=1
dosdn3:	ret
;
dosddl:	; print dir for drive in dl
	mov	ah,'/'		;SWITCHAR is usually '/'
	cmp	byte ptr ds:swchar,ah ;is it?
	jne	dospd1		;no, use '/' for path separator
	 mov	ah,'\'		;yes, use '\'
dospd1:	mov	al,ah		;add leading slash
	stosb
	mov	si,di		;copy
	sub	dl,'A'-1	;convert to 1=A, 2=B, etc.
	push	ax		;save path separater
	mov	ah,47h		;func=get curr directory
	int	21h
	pop	ax		;[restore]
	jc	dospd7
	cmp	byte ptr [si],0	;nothing?  (i.e. root)
	jz	dospd6		;yes, give just one slash (regardless of cx)
dospd2:	lodsb			;get a char
	test	al,al		;end of string?
	jz	dospd5
	cmp	al,'/'		;forward slash?
	je	dospd3
	cmp	al,'\'		;backslash?
	jne	dospd4
dospd3:	mov	al,ah		;normalize slashes
dospd4:	stosb
	jmp	short dospd2
dospd5:	mov	al,ah		;add trailing \ if filename follows
	rep	stosb		;0 or 1
dospd6:	ret
dospd7:	jmp	dirio		;dir I/O error
;+
;
; Change DOS directory.
;
;-
doscd:	mov	di,offset buf	;pt at buffer
	mov	dx,di		;with dx too
	mov	al,byte ptr ss:logd+1[bp] ;get drive letter
	mov	ah,':'		;d:
	stosw
doscd1:	lodsb			;get a char
	cmp	al,' '		;blank or ctrl?
	jbe	doscd2		;yes, ignore
	stosb
doscd2:	loop	doscd1		;loop through all
	xor	al,al		;mark end
	stosb
	mov	ah,3Bh		;func=CHDIR
	int	21h
	jc	doscd3		;err
	ret
doscd3:	jmp	dirio		;not really appropriate
;+
;
; Get directory name, make it temporarily current.
;
;-
dosgd:	jcxz	dsgd5		;done if nothing
	mov	al,[si]		;get curr char
	cmp	al,' '		;blank or ctrl char?
	jbe	dsgd5
	cmp	al,ds:swchar	;switchar?
	je	dsgd5
	cmp	al,'/'		;path from root?
	je	dsgd1
	cmp	al,'\'		;either way
	jne	dsgd2
dsgd1:	mov	bx,ss:actdir[bp] ;yes, get ptr to begn of dir name
	mov	byte ptr [bx],0	;start from root
	inc	si		;eat the '\'
	dec	cx
dsgd2:	; parse next dir name
	jcxz	dsgd5		;done if nothing
	push	si		;save posn
	push	cx
dsgd3:	lodsb			;get a char
	cmp	al,' '		;blank or ctrl char?
	jbe	dsgd4
	cmp	al,ds:swchar	;switch?
	je	dsgd4
	cmp	al,'/'		;path sep?
	je	dsgd6
	cmp	al,'\'
	je	dsgd6
	loop	dsgd3		;loop if not
dsgd4:	pop	cx		;unget
	pop	si
dsgd5:	ret
dsgd6:	; got a path element
	dec	cx		;count it
	mov	ah,'/'		;get path sep
	cmp	ah,ds:swchar	;can't use / if it's for switches
	jne	$+4
	 mov	ah,'\'		;use \ instead
	mov	bx,si		;save cmd line ptr
	mov	dx,cx		;and remaining length
	mov	di,ss:actdir[bp] ;get ptr to path as it is now
	xor	al,al		;look for 0
	mov	cx,64d		;length
	repnz	scasb		;find it (always succeeds)
	mov	di,64d-1	;find length (not including NUL)
	sub	di,cx
	pop	cx		;restore length
	pop	si		;and ptr
	sub	cx,dx		;find length of pathname element
	dec	cx		;don't count the path sep
	jz	dsgd10		;syntax error if null
	cmp	byte ptr [si],'.' ;. or ..?
	je	dsgd12		;yes, see which
	; add new dir name onto end of path, if it will fit
	push	di		;save
	test	di,di		;is there anything already?
	jz	$+3
	 inc	di		;yes, we'll add a \ to it
	add	di,cx		;find total length with everything
	cmp	di,64d-1	;will it fit in 64. bytes with the NUL?
	pop	di		;[restore di]
	ja	dsgd11		;no
	add	di,ss:actdir[bp] ;add base
	cmp	di,ss:actdir[bp] ;did we move?
	je	dsgd7		;no, starting at root
	mov	al,ah		;yes, add path sep
	stosb
dsgd7:	lodsb			;get a char
	cmp	al,'a'		;lower case?
	jb	dsgd8
	cmp	al,'z'
	ja	dsgd8
	and	al,not 40	;yes, convert to upper
dsgd8:	stosb			;save
	loop	dsgd7		;copy whole dir name
	cmp	al,'.'		;was last char .?
	jne	$+3
	 dec	di		;yes, un-put
	xor	al,al		;mark end
	stosb
dsgd9:	mov	si,bx		;restore
	mov	cx,dx
	jmp	short dsgd2
dsgd10:	jmp	synerr		;null dir name
dsgd11:	jmp	lngnam		;name too long
dsgd12:	; . or .. -- see which
	inc	si		;eat the .
	dec	cx
	jz	dsgd9		;that's it, skip it
	lodsb			;get another char
	dec	cx		;count it
	jnz	dsgd10		;that should be all
	cmp	al,'.'		;must be ..
	jne	dsgd10
	mov	si,ss:actdir[bp] ;get ptr to dir
	cmp	byte ptr [si],0	;is it root?
	jz	dsgd9		;yes, don't go above
	mov	di,si		;in case only one path element
	jmp	short dsgd14	;into loop
dsgd13:	mov	di,si		;save a copy
	dec	di		;back up
dsgd14:	lodsb			;get a char
	cmp	al,ah		;is this a path sep?
	je	dsgd13		;yes, save posn
	test	al,al		;end of path?
	jnz	dsgd14		;loop if not
	stosb			;lop off last dir name (AL=0)
	jmp	short dsgd9	;around for more
;+
;
; Display dir entry from most recent DIRGET.  Called through SS:DIRDIS[BP].
;
; es:di	buf ptr as returned by DIRGET (updated on return)
;
;-
dosdd:	; display DOS dir entry
	inc	ds:nfile	;bump # files
	test	byte ptr ds:fattr,20 ;directory?
	jz	dosdd1
	; it's a directory, length is meaningless
	cram	'  <DIR>   '
	jmp	short dosdd2
dosdd1:	; it's a file, give the size
	mov	cx,10d		;# spaces
	mov	ax,ds:fbcnt	;byte count
	mov	dx,ds:fbcnt+2
	add	ds:nblk,ax	;(add to total)
	adc	ds:nblk+2,dx
	call	cnum		;print it right-justified
dosdd2:	; add date, if any
	cmp	byte ptr ds:fdatf,0 ;was there a date?
	jz	dosdd3		;no
	mov	ax,"  "		;2 blanks
	stosw
	call	pdate		;print date
	cmp	byte ptr ds:ftimf,0 ;time?
	jz	dosdd3		;no
	mov	ax,"  "		;2 more blanks
	stosw
	call	ptime		;print time
dosdd3:	ret
;+
;
; Open most recently DIRGETted file for input.  Called through SS:OPEN[BP].
;
; bp	input dev rec
;
; Returns CF=1 if can't proceed (tried to read directory).
;
;-
dosop:	; open DOS file for input
	test	byte ptr ds:fattr,20 ;was it a directory?
	jnz	dosop2		;yes, can't read that
	; whip up filename in BUF
	mov	di,offset buf	;pt at temp buf
	mov	dx,di		;save ptr
	mov	al,byte ptr ss:logd+1[bp] ;get drive letter
	mov	ah,':'		;d:
	stosw
	mov	cx,1		;filename prefix
	call	dosdn		;add dir name
	mov	si,offset dosfil ;pt at DOS filename
dosop1:	lodsb			;get a char
	stosb			;save
	test	al,al		;end?
	jnz	dosop1		;loop if not
	mov	ah,3Dh		;func=open /RONLY (AL=0)
	int	21h
	jc	dosop3
	mov	ds:inhnd,ax	;save
	ret
dosop2:	stc			;error return
	ret
dosop3:	cram	'?Open error',error
;+
;
; Read file data.
;
; On entry:
; es:di	ptr to buf (normalized)
; cx	# bytes free in buf (FFFF if >64KB)
;
; On return:
; cx	# bytes read (may be 0 in text mode if block was all NULs etc.)
;
; CF=1 if nothing was read:
;  ZF=1 end of file
;  ZF=0 buffer not big enough to hold anything, needs to be flushed
;
;-
dosrd:	; read DOS file data
	jcxz	dosrd1		;nothing to read
	mov	bx,ds:inhnd	;get file handle
	push	ds		;save DS
	push	es		;copy ES to DS
	pop	ds
	mov	dx,di		;point at buf
	mov	ah,3Fh		;func=read
	int	21h
	pop	ds		;[restore]
	jc	dosrd3		;error
	mov	cx,ax		;copy
	test	cx,cx		;get anything?
	jz	dosrd2		;no, ZF=1, set CF
	ret
dosrd1:	or	al,1		;ZF=0
dosrd2:	stc			;CF=1
	ret
dosrd3:	jmp	rderr
;+
;
; Close input file opened by SS:OPEN[BP].  Called through SS:RESET[BP].
;
;-
dosrs:	; reset input file
	mov	bx,-1		;mark as closed
	xchg	bx,ds:inhnd	;get handle
	mov	ah,3Eh		;func=close
	int	21h
	ret
;+
;
; Create output file.
;
; ds:si	.ASCIZ filename
; DS:FBCNT max size of file in bytes
;
;-
doscr:	; whip up filename in BUF
	mov	di,offset buf	;pt at temp buf
	mov	dx,di		;save ptr
	mov	al,byte ptr ss:logd+1[bp] ;get drive letter
	mov	ah,':'		;d:
	stosw
	mov	cx,1		;filename prefix
	push	si		;save
	call	dosdn		;add dir name
	pop	si		;restore
doscr1:	lodsb			;get a char
	stosb			;save
	test	al,al		;end?
	jnz	doscr1		;loop if not
	xor	cx,cx		;mode=0
	mov	ah,3Ch		;func=create
	int	21h
	jc	doscr2
	mov	ds:outhnd,ax	;save handle
	ret
doscr2:
;;; if error=protected file of same name exists, check if ds:ovride set,
;;; unprotect and retry if so
	jmp	crerr
;+
;
; Write data to output file (handle conversion if ASCII mode).
; Called through SS:WRITE[BP].
;
; es:si	buffer
; cx	length of data
;
; On return, cx contains the number of bytes actually written (presumably a
; multiple of the clustersize).
;
;-
doswr:	; write to DOS file
	push	ds		;save
	mov	dx,si		;copy ptr
	mov	bx,ds:outhnd	;get handle
	push	es		;copy ES to DS
	pop	ds
	mov	ah,40h		;func=write
	int	21h
	pop	ds		;[restore]
	jc	$+3
	 ret
	jmp	wrerr
;+
;
; Close output file.  Called through SS:CLOSE[BP].
;
; ss:bp	log dev rec
;
;-
doscl:	; close DOS output file
	; first set date and time
	xor	ax,ax		;(assume no time)
	cmp	ds:fdatf,al	;do we know date?
	jz	doscl3		;no, leave time/date as-is (=now)
	; convert date to DOS disk format
	mov	dx,ds:fyear	;get year
	sub	dx,1980d	;subtract base
	jnc	$+4
	 xor	dx,dx		;can't go earlier than 1980.
	cmp	dx,119d		;DOS dates run out at 2099d (postdated file?)
	jbe	$+5
	 mov	dx,119d		;stop if after (?!)
	mov	cl,4		;make space for month
	sal	dx,cl
	or	dl,ds:fmonth	;OR in month
	inc	cx		;make space for day
	sal	dx,cl
	or	dl,ds:fday	;OR in day
	; convert time to DOS disk format (or use 0 if undefined)
	cmp	ds:ftimf,al	;is time defined?
	jz	doscl1		;no, leave AX=0
	mov	al,ds:fhour	;get hour
	mov	cl,6		;make space for minute
	sal	ax,cl
	or	al,ds:fmin	;OR in minute
	dec	cx		;make space for second/2
	sal	ax,cl
	mov	ch,ds:fsec	;get second
	sar	ch,1		;sec/2
	js	$+4		;<0, seconds not supported by file system
	 or	al,ch		;OR it in
	test	ax,ax		;exactly 12 midnight?
	jnz	doscl2
doscl1:	inc	ax		;yes, say 00:00:02 or DIR won't show it
doscl2:	mov	cx,ax		;copy time
	mov	bx,ds:outhnd	;get handle
	mov	ax,5701h	;func=set file date/time
	int	21h
doscl3:	mov	bx,-1		;mark as closed
	xchg	bx,ds:outhnd	;get handle
	mov	ah,3Eh		;func=close
	int	21h
	ret
;+
;
; Delete file.  Called through SS:DELFIL[BP] after DIRGET.
;
;-
dosdl:	; whip up filename in BUF
	mov	di,offset buf	;pt at temp buf
	mov	dx,di		;save ptr
	mov	al,byte ptr ss:logd+1[bp] ;get drive letter
	mov	ah,':'		;d:
	stosw
	mov	cx,1		;filename prefix
	call	dosdn		;add dir name
	mov	si,offset dosfil ;pt at DOS filename
dosdl1:	lodsb			;get a char
	stosb			;save
	test	al,al		;end?
	jnz	dosdl1		;loop if not
	mov	ah,41h		;func=delete
	int	21h		;give it a shot
	jc	dosdl2
	ret
dosdl2:	jmp	delerr
;
	subttl	RT-11 file structure
;
	comment	_

An RT-11 directory consists of 1 to 31. segments, each of which is two
256-word blocks long, including a 5-word header:

+0	dw	total number of segments (1-31.)
+2	dw	next dir seg (1-31., not block #) or 0 if no more
+4	dw	seg # of highest seg in use (valid in seg 1 only)
+6	dw	# info bytes per dir entry (must be even)
+10	dw	starting blk # of 1st file (for this seg)
+12 first dir entry starts here

Directory segments are normally allocated with segment 1 occupying device
blocks 6 and 7, segment 2 in blocks 8. and 9., and so on, with the first data
block starting immediately after the last directory segment.  Segments higher
than the highest seg in use (3rd word of header) are uninitialized but are
still reserved for later directory use (they will be linked into the directory
when there is no space left in the current chain).  The directory is actually
supposed to be movable with the actual starting block number located in the
word at offset 724(8) in the home block, but it appears that RT-11 actually
ignores this and is hard-coded for block 6.

In each segment, directory entries begin immediately after the 5-word header.

Entry format:

+0	.word	status		;status bits, see below
+2	.rad50	/FILNAM/	;file name
+6	.rad50	/EXT/		;extension
+10	.word	length		;length of file in blocks
+12	.byte	channel		;channel on which file is open (if tentative)
+13	.byte	job		;job # that has file open (if tentative)
+14	.word	creation	;date of creation, YYMMMMDDDDDYYYYY (Y=yr-1972)
+16	.blkb	n		;extra bytes, n is even, word 4 of header

Status bits:
400	tentative file (not .CLOSEd yet)
1000	< UNUSED > area
2000	permanent file
102000  protected permanent file
4000	end of segment (rest of entry is missing)

The high two YY bits in the date are an afterthought added in RT-11 V5 to
extend the date format beyond AD 2004.  Previous versions don't know about
them, and there are bugs in the SYSLIB functions that touch them anyway.

Note that TSX+ saves the creation time of permanent files in the word at +12
(which is no longer needed once the file is no longer tentative).
_
;+
;
; Print volume name.
;
; ss:bp	log dev rec
; es:di	buf (updated on return)
;
;-
rtvn:	push	di		;save
	mov	di,ds:dbuf	;pt at buffer
	mov	ax,ss:actdir[bp] ;get base
	mov	dx,ss:actdir+2[bp]
	add	ax,1		;rel blk 1 (home blk)
	adc	dx,0
	mov	cx,1		;count=1 blk
	call	ss:rdblk[bp]	;fetch it
	jc	rtvn3
	add	si,730		;get ptr to vol ID
	pop	di
	cram	' is '		;assume this will work
	mov	bx,di		;save a copy
	call	rtvncp		;copy vol name
	cmp	bx,di		;did we move?
	je	rtvn1		;skip if not
	mov	al,' '		;add a blank
	stosb			;save
rtvn1:	call	rtvncp		;copy owner name
	cmp	di,bx		;did we get anything?
	jne	rtvn2		;no
	sub	di,4		;back up
	jmp	nolbl		;no label
rtvn2:	ret
rtvn3:	jmp	rderr
;
rtvncp:	; copy vol name described by SI, CX
	mov	cx,12d		;length
	call	skip		;skip any leading blanks
	jc	rtvnc3		;missing, skip
	mov	dx,di		;init
rtvnc1:	lodsb			;get a byte
	stosb			;save it
	cmp	al,' '		;blank?
	je	rtvnc2
	mov	dx,di		;no, save position
rtvnc2:	loop	rtvnc1
	cmp	al,' '		;were there trailing blanks?
	jne	rtvnc3		;no, don't trim
	mov	di,dx		;pt past last non-blank char
rtvnc3:	ret
;+
;
; Set defaults for RT-11.
;
; si,cx	preserved
;
;-
rtds:	mov	ax,ss:curdir[bp] ;get current LD:
	mov	dx,ss:curdir+2[bp]
	mov	ss:actdir[bp],ax ;set active LD:
	mov	ss:actdir+2[bp],dx
	mov	ax,ss:cursiz[bp] ;get size of LD:
	mov	ss:actsiz[bp],ax
	xor	ax,ax		;high word always 0
	mov	ss:actsiz+2[bp],ax
	ret
;+
;
; Save RT-11 CWD.
;
; bx	0 for input dev, 2 for output dev
;
;-
rtsav:	mov	ax,ss:actdir[bp] ;get active LD:
	mov	dx,ss:actdir+2[bp]
	mov	ds:savdir[bx],ax
	mov	ds:svdirh[bx],dx
	mov	ax,ss:actsiz[bp]
	mov	ds:savsiz[bx],ax
	ret
;+
;
; Restore RT-11 CWD.
;
; bx	0 for input dev, 2 for output dev
;
;-
rtrst:	mov	ax,ds:savdir[bx] ;get saved stuff
	mov	dx,ds:svdirh[bx]
	mov	ss:actdir[bp],ax ;set active LD:
	mov	ss:actdir+2[bp],dx
	mov	ax,ds:savsiz[bx]
	mov	ss:actsiz[bp],ax
	ret
;+
;
; Print directory heading.
;
;-
rtdh:	mov	ds:nfile,0	;no files yet
	mov	ds:nblk,0	;no blocks seen
	mov	ds:nfree,0	;no frees
	mov	di,offset lbuf	;pt at buf
	mov	al,' '		;blank
	stosb
	mov	ax,word ptr ds:day ;get month,,day
	mov	dx,ds:year	;year
	call	pdate1		;print
	callr	flush		;flush, return
;
rtdi:	; RT-11 dir input init
	cmp	ss:initf[bp],0	;already initted since last prompt?
	jnz	rtdi1		;yes
	inc	ss:initf[bp]	;no, but it will be
	; allocate first dir seg buffer (nothing is possible if this fails)
	mov	cx,rtslen	;size of dir buffer
	call	getmem		;allocate dir buffer
	mov	ss:dirbuf[bp],si ;save ptr
	xor	ax,ax		;load 0
	mov	ds:rtsblk[si],ax ;nothing in here yet
	mov	ds:rtsblk+2[si],ax
	mov	ds:rtsdrt[si],al ;not dirty
	mov	ds:rtsnxt[si],ax ;no next
rtdi1:	mov	ax,1		;first seg
	mov	ds:inseg,al	;(save)
	call	rtseg		;read it (AH=0)
	mov	ax,ss:actdir[bp] ;get base of dir
	mov	dx,ss:actdir+2[bp]
	add	ax,[si+8d]	;add starting block for 1st file
	adc	dx,0
	mov	ds:stblk,ax	;save
	mov	ds:stblk+2,dx
	mov	ds:fsize,0	;say preceding file null
	mov	ds:inent,5*2	;start just after header
	ret
;
rtdg:	; get RT-11 dir entry
	mov	al,ds:inseg	;make sure seg is still there
	cbw			;AH=0 (really read it)
	call	rtseg		;(in case output is same device, may page out)
	mov	bx,si		;save base (subtracted before returning)
	add	si,ds:inent	;index to curr posn
rtdg1:	; get next entry (SI=ptr, BX=base of buf)
	mov	word ptr ds:ftimf,0 ;no date or time
	mov	ax,ds:fsize	;get size of previous
	add	ds:stblk,ax	;update starting blk ptr
	adc	ds:stblk+2,0
	mov	di,offset lbuf	;pt at buf (whether empty or not)
	lodsw			;get status word
	test	ah,4000/100h	;end of segment?
	jz	$+5
	 jmp	rtdg5		;yes, go get next seg
	mov	ds:fattr,ah	;save
	test	ah,1400/100h	;empty area or tentative file?
	jnz	rtdg4
	push	bx		;save bx
	lodsw			;FILNAM
	call	rad50
	lodsw
	call	rad50
	mov	al,'.'		;.
	stosb
	lodsw			;EXT
	call	rad50
	pop	bx		;restore
	lodsw			;get length
	mov	ds:fsize,ax	;save
	mov	cl,7d		;shift count
	ror	ax,cl		;compute # bytes in file (including NULs)
	mov	dx,ax		;get high 7 bits
	and	ax,177000	;isolate low 7 bits
	and	dh,1		;and high 9
	mov	ds:fbcnt,ax	;save
	mov	ds:fbcnt+2,dx
	inc	si		;skip channel #
	inc	si		;job #
	lodsw			;get date
	test	ax,ax		;valid?
	jz	rtdg2		;no
	; RT-11 date format is:  YYMMMMDDDDDYYYYY
	; (leftmost two Y bits were added (compatibly) in RT-11 V5)
	; MMMM, DDDDD -- 1-12. and 1-31. as usual
	; YYYYYYY is YEAR-1972.
	mov	dx,ax		;get month,,day
	mov	cl,2		;bit count
	shr	dx,cl		;shift both
	inc	cx		;change to 3
	shr	dl,cl		;move day into place
	and	dx,0F1Fh	;isolate
	mov	word ptr ds:fday,dx ;save
	and	ax,140037	;isolate year
	shr	ah,1		;V5 bits right 1
	or	al,ah		;concatenate
	cbw			;AH=0
	add	ax,1972d	;add base year
	mov	ds:fyear,ax	;save
	inc	ds:fdatf	;set flag
rtdg2:	sub	si,bx		;subtract base
	mov	ds:pextra,si	;save ptr to RTS or who knows what
	add	si,ss:extra[bp]	;skip extra bytes if any
	mov	ds:inent,si	;update
	callr	sqfn		;make squished copy of filename, return
rtdg4:	jmp	short rtdg6
rtdg5:	; no more entries in this segment, read next one
	mov	ax,[bx+2]	;get next seg #
	test	ax,ax		;any?
	jz	rtdg7		;no
	mov	ds:inseg,al	;yes, save #
	cbw			;AH=0 (really read)
	call	rtseg		;get the segment
	mov	bx,si		;save ptr to base of buf
	mov	ds:fsize,0	;say prev file null (already added)
	add	si,4*2		;skip to starting blk
	lodsw			;get starting data blk #
;	cmp	ax,ds:stblk	;should match
;	jne	rtdg8		;dir consistency error
;;; yeah it should match but need to subtract ACTDIR first, and now
;;; both STBLK and ACTDIR are 32-bit numbers
	jmp	rtdg1		;try again
rtdg6:	; < UNUSED >
	add	si,6		;skip filename
	lodsw			;get file length
	mov	ds:fsize,ax	;save
	add	ds:nfree,ax	;update # frees (even if not displayed)
	add	si,4		;skip open file info, creation date
	add	si,ss:extra[bp]	;skip extra bytes
	sub	si,bx		;subtract base
	mov	ds:inent,si	;update
	xor	al,al		;CF=0 ZF=1
	ret
rtdg7:	; end of dir
	stc			;no more
	ret
rtdg8:	jmp	baddir		;starting blk # from header is wrong
;+
;
; Make squished copy of filename in LBUF.
;
; di	ptr to end of filename
;
; On return, di is unchanged, the buffer space starting at di contains an
; ASCIZ copy of the filename between LBUF and di, with blanks removed.
;
; Returns CF=ZF=0, suitable for direct return from DIRGET.
;
;-
sqfn:	mov	dx,di		;save ptr
	mov	si,offset lbuf	;pt at formated filename
	mov	cx,di		;calc length
	sub	cx,si
sqfn1:	lodsb			;get one
	cmp	al,' '		;blank?
	je	$+3
	 stosb			;no, save
	loop	sqfn1		;loop
	xor	al,al		;mark end (CF=0)
	stosb
	mov	di,dx		;restore
	inc	ax		;CF still 0, ZF=0
	ret
;
rtdf:	; RT-11 dir finish (flush dirty segment buffers)
	mov	si,ss:dirbuf[bp] ;get ptr to buf chain
rtdf1:	call	rtfseg		;flush
	mov	si,ds:rtsnxt[si] ;follow chain
	test	si,si		;anything?
	jnz	rtdf1		;loop if so
	ret
;+
;
; Print directory listing summary.
;
;-
rtsum:	mov	di,offset lbuf	;pt at buf
	mov	al,' '		;blank
	stosb
	mov	ax,ds:nfile	;get # files shown
	push	ax		;save
	call	pnum
	cram	' File'
	pop	ax		;restore
	call	adds		;add s
	mov	ax," ,"		;', '
	stosw
	mov	ax,ds:nblk	;get # blocks shown
	push	ax		;save
	call	pnum		;print
	cram	' Block'
	pop	ax		;restore
	call	adds		;add s
	call	flush		;flush
	mov	al,' '		;blank
	stosb
	mov	ax,ds:nfree	;get # free blocks
	push	ax		;save
	call	pnum
	cram	' Free block'
	pop	ax		;restore
	call	adds		;add s
	callr	flush		;flush, return
;
adds:	; add "s" to output buf unless AX=1
	dec	ax		;just one?
	jz	adds1
	mov	al,'s'		;add s if not
	stosb
adds1:	ret
;
dadds:	; double precision version of above ("s" unless DX:AX=1)
	test	dx,dx		;definitely not 1?
	jnz	dadds1
	dec	ax		;just one?
	jz	dadds2
dadds1:	mov	al,'s'		;add s if not
	stosb
dadds2:	ret
;+
;
; Display RT-11 dir name.
;
; ss:bp	log dev rec
; es:di	buf
; cx	1 to print trailing \, 0 not to
;
;-
rtdn:	; display RT-11 dir name
	mov	al,'\'		;starts with \
	stosb
	xor	ax,ax		;load 0
	xchg	ax,ss:actdir[bp] ;get active dir, set to 0
	test	ax,ax		;already at root?
	jnz	rtdn1
	 ret			;yes, no dir name
rtdn1:	; search for a file containing that offset
	mov	dx,ss:actdir+2[bp] ;get high addr (partition #)
	mov	ds:rtdnam+2,ax	;save abs block #
	mov	ds:rtdnam+4,dx
	mov	ds:rtdnam,0	;search by block #
	mov	ax,ss:devsiz[bp] ;get root dev size
	mov	ss:actsiz[bp],ax
	xor	cl,1		;1 not to print trailing \
	mov	ds:rtdsep,cx	;save flag
rtdn2:	push	di		;save buf ptr
	call	rtdir		;look for dir
	pop	di		;[restore]
	jc	rtdn4		;not found, should never happen
	push	ax		;save relative offset
	mov	ax,ds:stblk	;get starting abs block of dir file
	mov	dx,ds:stblk+2
	mov	ss:actdir[bp],ax ;save
	mov	ss:actdir+2[bp],dx
	mov	ax,[si+8d]	;get size of dir
	mov	ss:actsiz[bp],ax ;save
	inc	si		;skip flags
	inc	si
	lodsw			;get dir name
	call	radnb
	lodsw
	call	radnb
	cmp	word ptr [si],16003 ;.rad50/DSK/?
	je	rtdn3		;yes, save
	mov	al,'.'		;'.'
	stosb
	lodsw			;extension
	call	radnb
rtdn3:	mov	al,'\'		;'\'
	stosb
	pop	ax		;get relative block #
	test	ax,ax		;is this the dir itself?
	jnz	rtdn2		;loop if not
	sub	di,ds:rtdsep	;unput \ if needed
	ret
rtdn4:	jmp	baddir
;+
;
; Change RT-11 directory.
;
;-
rtcd:	mov	ax,1		;no \ needed after last pathname element
	call	rtgetd		;get dir
	call	confrm		;make sure confirmed
	mov	ax,ss:actdir[bp] ;get active dir, make current
	mov	dx,ss:actdir+2[bp]
	mov	ss:curdir[bp],ax
	mov	ss:curdir+2[bp],dx
	mov	ax,ss:actsiz[bp]
	mov	ss:cursiz[bp],ax
	ret
;+
;
; Get RT-11 directory name (and make it active).
;
;-
rtgd:	xor	ax,ax		;require \ at end of each pathname element
rtgetd:	; enter here with AX=flag (for terminating char)
	mov	ds:rtdsep,ax	;save
	jcxz	rtgd1		;done if nothing
	cmp	al,ds:swchar	;switchar?
	je	rtgd1		;EOL
	cmp	al,'/'		;path from root?
	je	rtgd2
	cmp	al,'\'		;either way
	je	rtgd2
	jmp	short rtgd5	;no, skip
rtgd1:	ret
rtgd2:	; starting at root, not current LD:
	mov	ss:actdir[bp],0	;start at begn of partition
	mov	ax,ss:actdir+6[bp] ;see if huge disk
	or	ax,ss:actdir+4[bp]
	jnz	rtgd3		;yes
	mov	ax,ss:actdir+2[bp] ;get partition
	cmp	ax,ss:devsiz+2[bp] ;is this last partition of disk?
	jne	rtgd3		;no
	mov	ax,ss:devsiz[bp] ;yes, use partial partition
	jmp	short rtgd4	;skip
rtgd3:	mov	ax,0FFFFh	;biggest possible partition
rtgd4:	mov	ss:actsiz[bp],ax ; save
	inc	si		;eat the '\'
	dec	cx
rtgd5:	push	si		;save posn
	push	cx
	; see if . or ..
	jcxz	rtgd6		;skip if nothing
	cmp	byte ptr [si],'.' ;starts with .?
	je	rtgd14
rtgd6:	call	grad		;get filename
	jc	rtgd12
	mov	ds:rtdnam,bx	;save filename
	mov	ds:rtdnam+2,dx
	mov	bx,16003	;default ext (.RAD50/DSK/)
	cmp	al,'.'		;ends with dot, right?
	jne	rtgd7
	inc	si		;eat the dot
	dec	cx
	call	grad		;get extension
rtgd7:	mov	ds:rtdnam+4,bx	;save extension
	cmp	ds:rtdsep,0	;does it have to end in path sep?
	jnz	rtgd9		;no, so don't check
	; part of a filespec, make sure path element ends with / or \
	cmp	al,ds:swchar	;switch?
	je	rtgd12		;yes, not path sep
	cmp	al,'/'		;path sep?
	je	rtgd8
	cmp	al,'\'		;either way
	jne	rtgd12		;no
rtgd8:	inc	si		;yes, eat the separator
	dec	cx
rtgd9:	pop	ax		;flush stack
	pop	ax
	push	si		;save line descriptor
	push	cx
	call	rtdir		;look up dir element
	mov	ax,[si+10]	;[get size]
	pop	cx		;[restore]
	pop	si
	jc	rtgd11		;error
	mov	ss:actsiz[bp],ax ;save size
	mov	ax,ds:stblk	;get starting block
	mov	dx,ds:stblk+2
	mov	ss:actdir[bp],ax ;save
	mov	ss:actdir+2[bp],dx
rtgd10:	; decide whether to look for more (depending on separator)
	cmp	ds:rtdsep,0	;did path el have to end in path sep?
	jz	rtgd5		;yes, so we've already checked
	jcxz	rtgd13		;that's it
	mov	al,[si]		;get separator char
	cmp	al,ds:swchar	;switch?
	je	rtgd13		;yes, return
	inc	si		;no, eat it
	dec	cx
	cmp	al,'/'		;more to come?
	je	rtgd5
	cmp	al,'\'
	je	rtgd5
	jmp	synerr		;no
rtgd11:	jmp	dnf		;dir not found
rtgd12:	pop	cx		;unget
	pop	si
rtgd13:	ret
rtgd14:	; . or ..
	inc	si		;eat the .
	dec	cx
	jz	rtgd15		;just .
	cmp	byte ptr [si],'.' ;..?
	je	rtgd18		;yes
rtgd15:	; . -- do nothing
	call	rdig		;make sure that's the last radix 50 char
	jnc	rtgd12		;it should be
	cmp	ds:rtdsep,0	;do we care what the sep is?
	jnz	rtgd17		;no
	cmp	al,ds:swchar	;switch?
	je	rtgd12		;yes, not path sep
	cmp	al,'/'		;path sep?
	je	rtgd16
	cmp	al,'\'		;either way
	jne	rtgd12		;no
rtgd16:	inc	si		;eat it
	dec	cx
rtgd17:	pop	ax		;flush stack
	pop	ax
	jmp	short rtgd10
rtgd18:	; .. -- go up a directory
	inc	si		;eat the .
	dec	cx
	call	rdig		;make sure that's the last radix 50 char
	jnc	rtgd12		;filename if not
	cmp	ds:rtdsep,0	;do we care what the sep is?
	jnz	rtgd20		;no
	cmp	al,ds:swchar	;switch?
	je	rtgd12		;yes, not path sep
	cmp	al,'/'		;path sep?
	je	rtgd19
	cmp	al,'\'		;either way
	jne	rtgd12		;no
rtgd19:	inc	si		;eat it
	dec	cx
rtgd20:	pop	ax		;flush stack
	pop	ax
	; search disk for directory containing current dir
	xor	ax,ax		;load 0
	xchg	ax,ss:actdir[bp] ;get active dir, set to 0
	mov	dx,ss:actdir+2[bp]
	test	ax,ax		;root already?
	jz	rtgd10		;yes, no op
	mov	bx,ss:actdir+6[bp] ;see if huge disk
	or	bx,ss:actdir+4[bp]
	jnz	rtgd21		;yes
	mov	bx,ss:actdir+2[bp] ;get partition
	cmp	bx,ss:devsiz+2[bp] ;is this last partition of disk?
	jne	rtgd21		;no
	mov	bx,ss:devsiz[bp] ;yes, use partial partition
	jmp	short rtgd22	;skip
rtgd21:	mov	bx,0FFFFh	;biggest possible partition
rtgd22:	mov	ss:actsiz[bp],bx ;save
	push	si		;save line descriptor
	push	cx
	; search for a file containing this dir's offset
	mov	ds:rtdnam+2,ax	;save abs block #
	mov	ds:rtdnam+4,dx
	mov	ds:rtdnam,0	;search by block #
rtgd23:	call	rtdir		;look for dir
	jc	rtgd25		;not found, should never happen
	test	ax,ax		;is this the dir itself?
	jz	rtgd24		;yes, don't CD into it
	mov	ax,ds:stblk	;get starting abs block of dir file
	mov	dx,ds:stblk+2
	mov	ss:actdir[bp],ax ;save
	mov	ss:actdir+2[bp],dx
	mov	ax,[si+8d]	;get size of dir
	mov	ss:actsiz[bp],ax ;save
	jmp	short rtgd23
rtgd24:	pop	cx
	pop	si
	jmp	rtgd10
rtgd25:	jmp	baddir
;
rtdd:	; display RT-11 dir entry
	mov	ax,ds:fsize	;size
	inc	ds:nfile	;bump # files
	add	ds:nblk,ax	;and # blks
	xor	dx,dx		;0-extend
	mov	cx,6		;size of field
	call	cnum		;print it right-justified
	; add P for Protected
	mov	cx,14d		;# blanks to write if RTS but no date
	test	byte ptr ds:fattr,200 ;protected?
	jz	rtdd1
	mov	al,'P'		;yes
	stosb
	dec	cx
rtdd1:	; add date, if any
	cmp	byte ptr ds:fdatf,0 ;was there a date?
	jz	rtdd2		;no
	sub	cl,12d		;1 or 2 blanks
	mov	al,' '
	rep	stosb
	call	pdate		;print
	mov	cx,2		;just two blanks if RTS
rtdd2:	; if there are two extra words, it may be RSTS RTS name (from FIT.BAC)
	cmp	word ptr ss:extra[bp],4 ;4 bytes?
	jne	rtdd3
	mov	al,' '		;yes, pad
	rep	stosb
	mov	si,ds:pextra	;point at them
	add	si,ss:dirbuf[bp] ;add base of dir buf
	lodsw			;RTS
	call	rad50
	lodsw			;NAM
	call	rad50
	mov	cx,2		;2 blanks needed
rtdd3:	; add starting block if verbose listing
	test	byte ptr ds:dirflg,200 ;verbose?
	jz	rtdd4
	add	cx,5		;add 5-digit block # to # cols coming
	mov	ax,ds:stblk	;get starting block #
	mov	dx,ds:stblk+2
	sub	ax,ss:actdir[bp] ;subtract base
	sbb	dx,ss:actdir+2[bp]
	call	cnum		;print it right-justified
rtdd4:	ret
;
rtde:	; display empty RT-11 entry
	mov	di,offset lbuf	;pt at buf again
	cram	'< UNUSED >'
	mov	cx,6		;# spaces
	mov	ax,ds:fsize	;size
	xor	dx,dx		;0-extend
	jmp	cnum		;print it right-justified, return (no date)
;
rtop:	; open RT-11 file for input
	mov	ax,ds:stblk	;get starting blk #
	mov	dx,ds:stblk+2
	mov	ds:iblk,ax	;save
	mov	ds:iblk+2,dx
	mov	ax,ds:fsize	;get size
	mov	ds:isize,ax	;save
	clc			;happy
	ret
;
rtrd:	; read RT-11 file data
	mov	bx,ds:isize	;get remaining size
	test	bx,bx		;EOF?
	jz	rtrd3		;yes, ZF=1
	mov	al,ch		;get # full blocks free in buf
	shr	al,1
	jz	rtrd2
	cbw			;AH=0
	cmp	ax,bx		;more than what's left?
	jb	rtrd1
	 mov	ax,bx		;stop at EOF
rtrd1:	mov	cx,ax		;copy block count
	mov	ax,ds:iblk	;get starting block
	mov	dx,ds:iblk+2
	add	ds:iblk,cx	;update
	adc	ds:iblk+2,0
	sub	ds:isize,cx
	mov	si,ds:binflg	;get binary flag
	call	ss:rdblk[bp+si]	;read data
	jc	rtrd4
	ret
rtrd2:	or	al,1		;ZF=0
rtrd3:	stc			;ZF set already, set CF
	ret
rtrd4:	jmp	rderr
;
rtdo:	; RT-11 dir output init
	cmp	ss:initf[bp],0	;already initted since last prompt?
	jnz	rtdo1		;yes
	inc	ss:initf[bp]	;no, but it will be
	; allocate first dir seg buffer (nothing is possible if this fails)
	mov	cx,rtslen	;size of dir buffer
	call	getmem		;allocate dir buffer
	mov	ss:dirbuf[bp],si ;save ptr
	xor	ax,ax		;load 0
	mov	ds:rtsblk[si],ax ;nothing in here yet
	mov	ds:rtsblk+2[si],ax
	mov	ds:rtsdrt[si],al ;not dirty
	mov	ds:rtsnxt[si],ax ;no next
rtdo1:	ret
;
rtcr:	; create RT file
	; parse filename (at DS:SI), convert to radix-50
	call	lenz		;get length
	call	grad		;get filename
	jc	rtcr2
	cmp	al,'.'		;ends with dot, right?
	jne	rtcr2		;no
	mov	ds:rtfile,bx	;save filename
	mov	ds:rtfile+2,dx
	inc	si		;eat the dot
	dec	cx
	call	grad		;get extension
	test	al,al		;ends at end of string, right?
	jnz	rtcr2
	mov	ds:rtfile+4,bx	;save extension
	; search for smallest empty area that's big enough for it
	mov	ax,ds:fbcnt	;get byte count
	mov	dx,ds:fbcnt+2
	mov	bx,1000		;bytes/block
	cmp	dx,bx		;make sure it'll fit in <64KB blks
	jb	rtcr3
rtcr1:	jmp	odfull		;full
rtcr2:	jmp	badnam		;bad filename
rtcr3:	add	ax,777		;round up to next block
	adc	dx,0
	div	bx		;find # blocks needed
	; search directory for first < UNUSED > area .LE. AX blocks long
	mov	dx,ax		;save length
	mov	al,1		;starting seg #
rtcr4:	mov	ds:outseg,al	;save
	push	dx		;save min size
	cbw			;AH=0 (really read it)
	call	rtseg		;get the seg
	mov	bx,si		;save base of buf
	add	si,8d		;skip to starting blk #
	lodsw			;get it
	xor	dx,dx		;high order=0
	mov	ds:osize,dx	;say prev file was null (preserve OBLK)
	add	ax,ss:actdir[bp] ;add base of LD: (if any)
	adc	dx,ss:actdir+2[bp]
	mov	ds:oblk,ax	;save
	mov	ds:oblk+2,dx
	pop	dx		;restore
rtcr5:	; examine next file entry within this segment (DS:SI=ptr)
	mov	ax,ds:osize	;get size of previous
	add	ds:oblk,ax	;update starting blk ptr
	adc	ds:oblk+2,0
	lodsw			;get status word
	test	ah,4000/100h	;end of segment?
	jnz	rtcr7		;yes, go get next seg
	mov	cx,[si+6]	;get size
	mov	ds:osize,cx	;save
	test	ah,1400/100h	;empty area or tentative file?
	jz	rtcr6
	cmp	cx,dx		;yes, is it big enough?
	jae	rtcr8		;yes
rtcr6:	add	si,6*2		;skip FILNAM.EXT, length, job,,chan, date
	add	si,ss:extra[bp]	;skip extra bytes if any
	jmp	short rtcr5	;get next entry
rtcr7:	; get next seg
	mov	ax,[bx+2]	;get link to next seg
	test	ax,ax		;any?
	jnz	rtcr4		;get it if so
	jmp	short rtcr1
rtcr8:	; found one that's big enough, save ptr to entry (OBLK, OSIZE set up)
	dec	si		;-2 (undo LODSW)
	dec	si
	sub	si,bx		;subtract base (in case bufs shuffled)
	mov	ds:outent,si	;save
	mov	ds:owrtn,0	;init size
	ret
;
rtwr:	; write to RT-11 file
	mov	al,ch		;get # full blocks
	shr	al,1
	jz	rtwr1		;nothing, skip
	cbw			;AH=0
	push	cx		;save
	mov	cx,ax		;copy
	sub	ds:osize,ax	;eat this out of < UNUSED > area
	jc	rtwr3		;whoops, this should never happen
	add	ds:owrtn,ax	;update # blks written
	mov	ax,ds:oblk	;get starting block #
	mov	dx,ds:oblk+2
	add	ds:oblk,cx	;update
	adc	ds:oblk+2,0
	call	ss:wrblk[bp]	;write data
	pop	cx		;[restore]
	jc	rtwr2		;failed
rtwr1:	and	cx,not 777	;truncate byte count (wrote whole blks only)
	ret
rtwr2:	jmp	wrerr		;error
rtwr3:	jmp	oswbug		;error msg
;+
;
; Write last buffer of data to output file.
;
; es:si	string
; cx	length of data
;
;-
rtwl:	; write last partial block to RT-11 file
	jcxz	rtwl1		;none, skip
	mov	bx,1000		;RT-11 block size
	sub	bx,cx		;find # NULs to add (in [1,777])
	xchg	bx,cx		;swap
	lea	di,[bx+si]	;point past data
	xor	al,al		;load 0
	rep	stosb		;pad it out
	mov	cx,1000		;write a whole block
	jmp	short rtwr	;write data, return
rtwl1:	ret
;+
;
; Close RT-11 output file.
;
; If the < UNUSED > area we wrote the file on turned out to be exactly the
; right length then all we have to do is write in the file info and mark it as
; a permanent file.  If it's not an exact fit we also have to create a new
; < UNUSED > area after this one for the leftover block(s).
;
; We'll take the cheap way out, instead of splitting segments and shuffling
; things around like RT-11 does (which doesn't always work anyway), we'll read
; the entire dir into a contiguous buffer, fix it, and write it back out.  If
; the directory fits entirely into the RTSEG buf chain this will be about as
; fast as any other way, and it will always work unless the directory is
; completely full.
;
;-
rtcl:	; close RT-11 output file
	call	rtrdir		;read directory
	; delete any other file of the same name
	mov	dx,ds:dirent	;length of entry
	mov	ax,ds:dirsiz	;size of dir
	mov	ds,ds:bigbuf	;pt at buffer
	mov	bx,5*2		;starting posn
rtcl1:	cmp	bx,ax		;done?
	je	rtcl4
	test	byte ptr [bx+1],2000/100h ;permanent file?
	jz	rtcl3		;no, don't bother
	lea	si,[bx+2]	;pt at filename
	mov	di,offset rtfile ;pt at output file
	mov	cx,3		;wc
	repe	cmpsw		;match?
	jne	rtcl3		;no
	; found a file of the same name, delete it
	test	byte ptr [bx+1],100000/100h ;protected?
	jz	rtcl2
	cmp	byte ptr cs:ovride,0 ;yes, should we override it?
	jnz	rtcl2		;yes
	push	es		;restore DS
	pop	ds
	jmp	prtfil		;can't overwrite protected file
rtcl2:	mov	word ptr [bx],1000 ;mark as < UNUSED >
rtcl3:	add	bx,dx		;bump to next entry
	jmp	short rtcl1	;loop
rtcl4:	push	es		;restore DS
	pop	ds
	; create new entry
	mov	es,ds:bigbuf	;pt at buffer
	mov	bx,ds:outptr	;get ptr to output file entry
	mov	ax,es:[bx+10]	;get size of area
	sub	ax,ds:owrtn	;-size of file
	jz	rtcl5		;exact fit, easy
	; slide rest of dir down a slot to make space for new < UNUSED > area
	mov	si,ds:dirsiz	;point past end of dir
	mov	cx,si		;find # bytes to move
	sub	cx,bx
	shr	cx,1		;/2=WC
	dec	si		;pt at last word
	dec	si
	mov	di,si		;copy
	mov	dx,ds:dirent	;length of file entry
	add	di,dx		;pt at dest
	push	ds		;save
	push	es		;copy ES to DS
	pop	ds
	std			;move backwards
	rep	movsw		;copy
	cld			;restore
	mov	[di+2+10],ax	;save smaller size in new area
	pop	ds		;restore
	add	ds:dirsiz,dx	;update dir size
	; update INPTR if it's after this point
	cmp	bp,ds:indev	;is it the right dev?
	jne	rtcl5		;no
	mov	ax,ss:actdir[bp] ;yes, get LD: base
	mov	dx,ss:actdir+2[bp]
	cmp	ax,ds:savdir	;is it the input one?
	jne	rtcl5
	cmp	dx,ds:svdirh
	jne	rtcl5
	mov	al,ds:dirseg	;yes, get curr seg
	cmp	al,ds:inseg	;is it the curr input one too?
	jne	rtcl5
	cmp	ds:inptr,bx	;is INPTR below this spot?
	jb	rtcl5		;no
	mov	di,ds:dirent	;yes, get length
	add	ds:inptr,di	;update
rtcl5:	mov	di,bx		;point at file entry
	mov	ax,2000		;permanent file
	stosw
	mov	si,offset rtfile ;output filename
	movsw			;copy it
	movsw
	movsw
	mov	ax,ds:owrtn	;size
	stosw
	xor	ax,ax		;nuke open file info
	stosw
	cmp	ds:fdatf,al	;do we know date?
	jz	rtcl6		;no, leave it as 0 (=unknown)
	; convert date to RT-11 disk format
	mov	dx,ds:fyear	;get year
	sub	dx,1972d	;subtract base
	jnc	$+4
	 xor	dx,dx		;can't go earlier than 1972.
	cmp	dx,127d		;dates run out at 2099. (postdated file?)
	jbe	$+5
	 mov	dx,127d		;stop if after (?!)
	mov	dh,dl		;copy high 2 bits into b15:14
	sal	dh,1
	and	dx,140037	;isolate + separate
	mov	ch,ds:fmonth	;get month
	sal	ch,1		;shift into place
	sal	ch,1
	or	dh,ch
	mov	ah,ds:fday	;get day (AX=0 from above)
	mov	cl,3		;bit count
	shr	ax,cl
	or	ax,dx		;compose final date
rtcl6:	stosw			;save date (or 0 if unknown)
	push	ds		;restore ES
	pop	es
	; set extra bytes to ^R/RT11  / if exactly 4 bytes (RTS for FIT.BAC)
	cmp	ss:extra[bp],4	;exactly 4 extra bytes?
	jne	rtcl7		;no
	mov	ax,71677	;.rad50/RT1/
	stosw
	mov	ax,140700	;.rad50/1  /
	stosw
rtcl7:	jmp	rtwdir		;write dir back, return
;+
;
; Delete most recently DIRGETted file.  Called through SS:DELFIL[BP].
;
;-
rtdl:	mov	al,ds:inseg	;get input seg #
	cbw			;AH=0 (really get it)
	call	rtseg		;(shouldn't be necessary, it should be in)
	mov	ds:rtsdrt[si],1	;mark seg buf as dirty
	add	si,ds:inent	;add offset
	sub	si,16		;back up to prev entry
	sub	si,ss:extra[bp]
	mov	al,[si+1]	;get flags
	test	al,al		;protected?
	jns	rtdl1
	cmp	byte ptr ds:ovride,0 ;should we override protection?
	jnz	rtdl1		;yes
	cram	'?Protected file',error
rtdl1:	test	al,2000/100h	;permanent?
	jz	rtdl2		;no, so what is it?
	mov	word ptr [si],1000 ;now it's < UNUSED >
	ret
rtdl2:	jmp	baddir		;corrupt directory
;+
;
; Write bootstrap.
;
;-
rtboot:	call	rtds		;set defaults
	mov	ax,1		;no \ needed after last pathname element
	call	rtgetd		;get dir
	call	confrm		;make sure at EOL
	mov	di,offset lbuf	;pt at buffer
	cram	'Writing bootstrap on '
	call	pdev		;print dev name
	xor	cx,cx		;no filename follows
	call	ss:dirnam[bp]	;print dir name
	call	flush		;flush line
	call	flush		;blank line afterwards
rtbt1:	cram	'Monitor file [.SYS]: ',wrng
	call	rtbtfl		;look up file
	jc	rtbt1		;reprompt
	mov	ax,ds:stblk	;get starting block of monitor file
	mov	dx,ds:stblk+2
	add	ax,1		;skip to blk 1
	adc	dx,0
	mov	cx,4		;read blks 1-4 (not 0-4, SSM is wrong)
	mov	es,ds:bigbuf	;pt at buffer
	mov	di,1000		;starting addr
	call	ss:rdblk[bp]	;read it
	jc	rtbt3
	mov	ax,ds:rtfile	;get monitor filename
	mov	es:4724,ax	;patch it in
	mov	ax,ds:rtfile+2
	mov	es:4726,ax
	push	ds		;restore ES
	pop	es
rtbt2:	cram	'Device handler file [.SYS]: ',wrng
	call	rtbtfl		;look up file
	jc	rtbt2		;reprompt
	mov	ax,ds:stblk	;get starting block of handler file
	mov	dx,ds:stblk+2
	mov	cx,1		;read first block
	mov	di,offset buf	;pt at buf
	call	ss:rdblk[bp]	;read it
	jnc	rtbt4
rtbt3:	jmp	rderr
rtbt4:	mov	ax,[si+62]	;get addr of start of driver
	mov	cx,[si+64]	;get length
	cmp	ch,1000/100h	;>1 blk?
	ja	rtbt6
	push	ax		;save
	push	cx
	push	[si+66]		;save offset of B.READ into primary driver
	; find blk # of last byte of primary driver
	add	cx,ax		;bump to just after end of primary driver
	dec	cx		;pt at last byte
	mov	cl,ch		;get blk # containing last byte
	shr	cl,1
	xor	ch,ch		;CH=0
	cmp	cx,ds:fsize	;off EOF?
	jae	rtbt6		;yes, invalid
	; find blk # of first byte of primary driver
	mov	al,ah		;get starting blk #
	shr	al,1		;(byte addr /1000)
	cbw			;AH=0
	cwd			;DX=0
	; find # blks to read and read them
	sub	cx,ax		;1 if spans blks, 0 if not
	inc	cx		;so read 1 or 2 blks
	add	ax,ds:stblk	;add base of file
	adc	dx,ds:stblk+2
	mov	di,offset buf	;pt at buffer
	call	ss:rdblk[bp]	;read in the primary driver
	jc	rtbt3
	pop	dx		;restore B.READ offset
	pop	cx		;restore length, ptr
	pop	ax
	and	ah,777/100h	;trim off blk #
	add	ax,offset buf	;add base of buf
	mov	si,ax		;pt with ds:si
	mov	es,ds:bigbuf	;pt at big buf
	; the next few patches aren't in SSM but someone did them, must be DUP
	mov	es:4730,dx	;set B$READ = B.READ offset
	mov	ax,ds:rtfile	;set B$DEVN = dev name
	mov	es:4716,ax	;(hope this is right!)
	xor	di,di		;dest offset
	rep	movsb		;copy the primary driver
	xor	al,al		;AL=0
	mov	ch,1000/100h	;pt at end of blk
	sub	cx,di		;find # free bytes
	rep	stosb		;clear out rest of primary boot
	; write out primary driver
	xor	si,si		;pt at it
	mov	ax,ss:actdir[bp] ;blk 0 of LD:
	mov	dx,ss:actdir+2[bp]
	mov	cx,1		;count
	call	ss:wrblk[bp]	;write it out
	jc	rtbt5
	; write out secondary boot
	mov	si,1000		;pt at it
	mov	ax,ss:actdir[bp] ;blks 2-5 of LD:
	mov	dx,ss:actdir+2[bp]
	add	ax,2
	adc	dx,0
	mov	cx,4		;count
	call	ss:wrblk[bp]	;write it out
	jc	rtbt5
	ret
rtbt5:	jmp	wrerr
rtbt6:	cram	'?Corrupt device handler file',error
;
rtbtfl:	; get filename, look it up
	call	gtlin		;read response
	mov	ax,75273	;^RSYS (default ext)
	call	gradfn		;get radix-50 filename
	jc	rtbf4		;none, go print dir
	call	confrm		;make sure EOL
	call	rtdi		;init for dir input
rtbf1:	call	rtdg		;get next dir entry
	jc	rtbf2		;end
	jz	rtbf1		;empty, skip it
	; retrieve pointer to dir entry
	mov	si,ds:inent	;get input entry
	add	si,ss:dirbuf[bp] ;add base of buf
	sub	si,16		;back up an entry
	sub	si,ss:extra[bp]
	push	si		;save
	inc	si		;skip to filename
	inc	si
	mov	di,offset rtfile ;pt at name to look up
	mov	cx,3		;count
	repe	cmpsw		;match?
	pop	si		;[restore]
	jne	rtbf1		;loop if not
	ret			;CF=0
rtbf2:	mov	di,offset lbuf	;pt at buffer
	cram	'%Not found'
	call	flush		;print msg
	stc			;error return
rtbf3:	ret
rtbf4:	; they pressed return, give a list of .SYS files
	call	rtdi		;init for dir input
rtbf5:	call	rtdg		;get next dir entry
	jc	rtbf3		;end
	jz	rtbf5		;loop if empty
	cmp	word ptr [di-2],"SY" ;see if .SYS
	jne	rtbf5
	cmp	byte ptr [di-3],'S'
	jne	rtbf5
	call	flush		;print name if so
	jmp	short rtbf5	;loop
;+
;
; Wipe out unused areas in RT-11 or OS/8 disk or LD:.
;
; bp	dev rec
; si,cx	point to cmd line just after dev (may be dir name (LD:))
;
;-
rtwp:	call	ss:defset[bp]	;set defaults
	call	ss:gdir[bp]	;get dir name
	call	confrm		;make sure confirmed
	call	ss:dsrini[bp]	;init DSR (switch drives etc.)
	call	ss:dirinp[bp]	;init dir input
	; load up a bufferful of zeros
	mov	es,ds:bigbuf	;point at buffer
	xor	di,di		;point at beginning
	mov	cx,ds:bigsiz	;get size
	cmp	ds:bigsiz+2,di	;is that it?
	jz	rtwp1
	 mov	cx,-1		;no, >64KB so stop at end
rtwp1:	push	cx		;save
	xor	ax,ax		;load 0
	shr	cx,1		;/2
	rep	stosw		;clear out begn of buf (ignore odd byte)
	pop	ax		;get length back
	push	ds		;restore ES
	pop	es
	mov	cl,9d		;bit count
	shr	ax,cl		;find # blocks in buf
	jz	rtwp8		;not even one, lose
	mov	ds:bigctr,ax	;save length
rtwp2:	; process next file
	call	ss:dirget[bp]	;get next entry
	jc	rtwp6		;end of list
	jnz	rtwp2		;not < UNUSED >, skip it
	; it's < UNUSED >, zero it
	mov	ax,ds:stblk	;get starting blk #
	mov	dx,ds:stblk+2
	mov	ds:oblk,ax	;save
	mov	ds:oblk+2,dx
	mov	ax,ds:fsize	;get size
	mov	ds:osize,ax	;save
rtwp3:	; write next bufferload of zeros
	mov	es,ds:bigbuf	;get buf ptr
	xor	si,si
	mov	ax,ds:oblk	;get block #
	mov	dx,ds:oblk+2
	mov	cx,ds:bigctr	;get # blks in buf
	cmp	cx,ds:osize	;> than what's left?
	jb	rtwp4
	mov	cx,ds:osize
	jcxz	rtwp5		;nothing to do, skip
rtwp4:	push	cx		;save
	call	ss:wrblk[bp]	;write
	pop	cx		;[restore]
	jc	rtwp7		;error
rtwp5:	add	ds:oblk,cx	;update blk #
	adc	ds:oblk+2,0
	sub	ds:osize,cx	;and # blks to go
	jnz	rtwp3		;loop if nonzero
	jmp	short rtwp2	;handle next file
rtwp6:	ret
rtwp7:	jmp	wrerr
rtwp8:	cram	'?Not enough memory for buffer',error
;+
;
; Read entire RT-11 directory into BIGBUF.
;
; ss:bp	log dev rec
; cx	returns length in bytes of dir read (missing all end-of-seg markers)
;	(also recorded in DIRSIZ)
; DS:DIRENT  records length of entry
;
;-
rtrdir:	xor	ax,ax		;load 0
	mov	ds:inptr,ax	;say files not yet found
	mov	ds:outptr,ax
	inc	ax		;get segment #1
	mov	ds:dirseg,al	;save
	call	rtseg		;read it (AH=0)
	cmp	ds:bigsiz+2,0	;make sure buf can hold the whole dir
	jnz	rtrdr2		;definitely
	mov	ax,[si+4]	;get # segs in use
	test	ax,ax		;valid?
	jz	rtrdr1
	cmp	ax,31d
	ja	rtrdr1
	mov	cl,10d		;1024 bytes in a segment
	sal	ax,cl		;find # bytes needed
	cmp	ds:bigsiz,ax	;will it fit?
	jae	rtrdr2		;yes
rtrdr1:	jmp	baddir		;corrupt directory
rtrdr2:	mov	es,ds:bigbuf	;pt at buffer
	xor	di,di		;pt at begn
	mov	cx,5		;copy first 5 words
	rep	movsw		;go
	sub	si,5*2		;correct ptr
	mov	ax,[si+6]	;get # extra bytes
	add	ax,16		;add size of rest of dir entry
	mov	ds:dirent,ax	;save
rtrdr3:	; set up ptr to detect falling off end
	mov	bx,si		;copy
	neg	bx		;make negative for LEA later
	add	si,5*2		;pt past header
	lea	dx,[di+2000-12-2] ;-12 for header, -2 for end-of-segment word
	sub	dx,ds:dirent	;subtract # info bytes in last dir entry
rtrdr4:	; check next entry (SI=ptr, BX=-<base of seg buf>, DX=max DI value)
	test	byte ptr [si+1],4000/100h ;end of segment?
	jnz	rtrdr7
	cmp	di,dx		;space for a file entry?
	jae	rtrdr1		;no, invalid dir
	; see if this is the current input entry
	cmp	bp,ds:indev	;is it the right dev?
	jne	rtrdr5		;no
	mov	ax,ss:actdir[bp] ;yes, get LD: base
	cmp	ax,ds:savdir	;is it the input one?
	jne	rtrdr5
	mov	ax,ss:actdir+2[bp]
	cmp	ax,ds:svdirh
	jne	rtrdr5
	mov	al,ds:dirseg	;yes, get curr seg
	cmp	al,ds:inseg	;is it the curr input one too?
	jne	rtrdr5
	lea	ax,[bx+si]	;get relative ptr
	cmp	ax,ds:inent	;is this the input entry?
	jne	rtrdr5
	mov	ds:inptr,di	;save
	mov	ds:iptr1,di	;init updated version
rtrdr5:	; see if this is the current output entry
	cmp	bp,ds:outdev	;is it the right dev?
	jne	rtrdr6		;no
	mov	ax,ss:actdir[bp] ;yes, get LD: base
	cmp	ax,ds:savdir+2	;is it the output one?
	jne	rtrdr6
	mov	ax,ss:actdir+2[bp]
	cmp	ax,ds:svdirh+2
	jne	rtrdr6
	mov	al,ds:dirseg	;yes, get curr seg
	cmp	al,ds:outseg	;is it the curr output one too?
	jne	rtrdr6
	lea	ax,[bx+si]	;get relative ptr
	cmp	ax,ds:outent	;is this the output entry?
	jne	rtrdr6
	mov	ds:outptr,di	;save
	mov	ds:optr1,di	;init updated version
rtrdr6:	; copy dir entry
	mov	cx,ds:dirent	;get size of entry
	shr	cx,1		;/2=WC
	rep	movsw		;copy
	jmp	short rtrdr4	;loop
rtrdr7:	; end of segment
	neg	bx		;flip BX back
	mov	ax,[bx+2]	;get next dir seg
	test	ax,ax		;end?
	jz	rtrdr8
	mov	ds:dirseg,al	;update curr seg #
	push	di		;save
	push	es
	push	ds		;copy DS to ES
	pop	es
	cbw			;AH=0 (really read)
	call	rtseg		;get next seg
	pop	es		;restore
	pop	di
	jmp	rtrdr3		;loop
rtrdr8:	mov	ds:dirsiz,di	;save
	push	ds		;restore ES
	pop	es
	mov	cx,di		;get length
	ret
;+
;
; Write entire RT-11 directory from BIGBUF (read by RTRDIR).
;
; ss:bp	log dev rec
; DS:DIRSIZ  gives size of dir in bytes (incl 5-word header, no end-seg words)
;
;-
rtwdir:	mov	es,ds:bigbuf	;pt at buf
	; find # segments we'll need
	mov	ax,2000-(5*2)-2	;seg size, -<header>, -<end-of-segment word>
	cwd			;zero-extend
	div	word ptr ds:dirent ;find # whole dir entries per dir seg
	mov	bx,ax		;save
	mov	ax,ds:dirsiz	;get # bytes of dir info
	sub	ax,5*2		;subtract header
	xor	dx,dx		;zero-extend
	div	word ptr ds:dirent ;find # dir entries to be written (DX=0)
	add	ax,bx		;round up to next seg
	dec	ax
	div	bx		;AX=total number of dir segments needed
	cmp	ax,es:0		;.LE. total # available?
	jbe	rtwdr1
	jmp	dirful		;dir is full
rtwdr1:	mov	es:4,ax		;update highest seg in use
	mov	byte ptr ds:dirseg,1 ;number of first dir seg
	mov	si,5*2		;pt past header
	push	ds		;restore ES
	pop	es
rtwdr2:	; copy next segment
	push	si		;save BIGBUF ptr
	mov	al,ds:dirseg	;seg #
	mov	ah,1		;alloc buf but don't read from disk
	call	rtseg		;get buf
	mov	ds:rtsdrt[si],1	;mark dirty
	mov	di,si		;copy ptr
	mov	bx,di		;copy
	neg	bx		;make negative for LEA later
	; set link to next segment
	mov	al,ds:dirseg	;get curr seg #
	cbw			;AH=0
	mov	ds,ds:bigbuf	;pt into buf
	cmp	ax,ds:4		;is this the last seg?
	jne	rtwdr3
	 mov	ax,-1		;yes, no next seg
rtwdr3:	inc	ax		;+1
	mov	ds:2,ax		;set ptr to next dir seg
	; calc last addr to start copying an entry
	lea	dx,[di+2000-2]	;get last possible addr for end-of-segment word
	sub	dx,cs:dirent	;subtract # info bytes in last dir entry
	; copy header
	xor	si,si		;get header from first 5 words
	mov	cx,5		;word count
	rep	movsw		;copy
	pop	si		;restore BIGBUF ptr
rtwdr4:	; copy next file entry
	cmp	si,cs:dirsiz	;done?
	je	rtwdr7		;yes
	cmp	di,dx		;any space left in segment?
	jae	rtwdr8		;no, continue with next segment
	mov	ax,[si+10]	;get length
	add	ds:10,ax	;update starting posn of file area
	; see if this is the current input entry
	cmp	bp,cs:indev	;is it the right dev?
	jne	rtwdr5		;no
	mov	ax,ss:actdir[bp] ;get active LD:
	cmp	ax,cs:savdir	;is it the input one?
	jne	rtwdr5
	mov	ax,ss:actdir+2[bp]
	cmp	ax,cs:svdirh
	jne	rtwdr5
	cmp	si,cs:inptr	;yes, does ptr match?
	jne	rtwdr5
	mov	al,cs:dirseg	;save current dir seg
	mov	cs:inseg,al
	lea	ax,[bx+di]	;save relative ptr
	mov	cs:inent,ax
rtwdr5:	; see if this is the current output entry
	cmp	bp,cs:outdev	;is it the right dev?
	jne	rtwdr6		;no
	mov	ax,ss:actdir[bp] ;get active LD:
	cmp	ax,cs:savdir+2	;is it the input one?
	jne	rtwdr6
	mov	ax,ss:actdir+2[bp]
	cmp	ax,cs:svdirh+2
	jne	rtwdr6
	cmp	si,cs:outptr	;yes, does ptr match?
	jne	rtwdr6
	mov	al,cs:dirseg	;save current dir seg
	mov	cs:outseg,al
	lea	ax,[bx+di]	;save relative ptr
	mov	cs:outent,ax
rtwdr6:	; copy dir entry
	mov	cx,cs:dirent	;get size of dir entry
	shr	cx,1		;/2=WC
	rep	movsw		;copy
	jmp	short rtwdr4	;loop
rtwdr7:	jmp	short rtwdr9
rtwdr8:	; finish off this segment
	mov	ax,4000		;end of segment marker
	stosw			;save
	push	es		;restore DS
	pop	ds
	inc	ds:dirseg	;bump seg #
	jmp	rtwdr2		;loop
rtwdr9:	; finish off whole directory
	mov	ax,4000		;end of segment marker
	stosw
	push	es		;restore DS
	pop	ds
	ret
;+
;
; Search active RT-11 directory for a directory file.
;
; ss:bp	log dev rec
; RTDNAM is set up with either the 3-word RADIX-50 dir filename,
;	or if the first word is 0, the 2nd/3rd word is the abs blk # to find
;
; On return, CF=0 if found and:
; si	points at file entry in BUF
; ax	contains relative blk # of RTDNAM+2 if searching by block
;
; Otherwise CF=1 if not found.
;
;-
rtdir:	mov	ax,1		;first seg
rtdir1:	call	rtdseg		;read it
	mov	ax,ss:actdir[bp] ;get base of active dir
	mov	dx,ss:actdir+2[bp]
	add	ax,[si+8d]	;add starting block for 1st file
	adc	dx,0
	mov	ds:stblk,ax
	mov	ds:stblk+2,dx
	mov	ds:fsize,0	;say preceding file null
	add	si,5*2		;start just after header
	mov	dx,offset buf+2000-16-2 ;end of dir, -16 for dir entry,
				;-2 for EOS word
	sub	dx,word ptr ds:buf+6 ;subtract # info bytes
rtdir2:	; SI=dir ptr, DX=last acceptable starting addr
	mov	ax,ds:fsize	;get size of previous
	add	ds:stblk,ax	;update starting blk ptr
	adc	ds:stblk+2,0
	test	byte ptr [si+1],4000/100h ;end of segment?
	jnz	rtdir5		;yes, go get next seg
	cmp	si,dx		;off end of dir?
	ja	rtdir6		;yes, corrupt
	test	byte ptr [si+1],2000/100h ;permanent file?
	jz	rtdir4		;no, skip it
	; see if it's a match
	mov	di,offset rtdnam ;pt at dir name
	cmp	word ptr [di],0	;are we looking for a name or a blk #?
	jz	rtdir3		;blk #
	push	si		;save
	inc	si		;pt at filename
	inc	si
	mov	cx,3		;3 words
	repe	cmpsw		;match?
	pop	si		;[restore]
	jne	rtdir4		;no
	ret			;got it
rtdir3:	mov	ax,[di+2]	;get desired blk #
	mov	cx,[di+4]
	sub	ax,ds:stblk	;subtract starting block of this file
	sbb	cx,ds:stblk+2
	jnz	rtdir4		;(too big to compare)
	cmp	ax,[si+8d]	;< length?
	jae	rtdir4
	clc			;yes, we got it (AX=relative blk #)
	ret
rtdir4:	mov	ax,[si+8d]	;get size
	mov	ds:fsize,ax	;save
	add	si,16		;skip file entry
	add	si,word ptr ds:buf+6 ;skip extra bytes
	jmp	short rtdir2	;loop
rtdir5:	mov	ax,word ptr ds:buf+2 ;get link to next word
	test	ax,ax		;end?
	jz	rtdir7		;yes, EOF
	cmp	ax,31d		;.LE.31 right?
	ja	rtdir6
	jmp	rtdir1
rtdir6:	jmp	baddir		;corrupt directory
rtdir7:	stc			;not found
	ret
;+
;
; Read dir seg for tree handling routines (into BUF, w/no caching since we're
; making only one pass and the cache wouldn't work).
;
; ax	seg to read
; si	returns ptr to BUF
;
;-
rtdseg:	add	ax,ax		;*2 (blks/seg)
	add	ax,6-2		;dir starts at blk 6
	cwd			;DX=0
	add	ax,ss:actdir[bp] ;add base of current LD: file (or 0 if none)
	adc	dx,ss:actdir+2[bp]
	mov	cx,2		;read 2 blks
	mov	di,offset buf	;point at buffer
	call	ss:rdblk[bp]	;go
	mov	si,offset buf	;point at buffer
	ret
;+
;
; Get RT-11 dir segment.
;
; al	segment #
; ah	NZ to return buf but don't read if not cached (going to write it)
; ss:bp	log dev rec
;
; Returns ptr to 1024-byte segment in SI.
;
;-
rtseg:	test	al,al		;make sure valid
	jz	rtsg3
	cmp	al,31d		;must be in [1,31.]
	ja	rtsg3
	mov	cl,ah		;save flag
	cbw			;AH=0
	cwd			;DX=0
	add	ax,ax		;*2 (blks/seg)
	add	ax,6-(2*1)	;dir seg 1 starts at blk 6
	add	ax,ss:actdir[bp] ;add base of current LD: file (or 0 if none)
	adc	dx,ss:actdir+2[bp]
	mov	si,ss:dirbuf[bp] ;head of buffer chain
	mov	bx,ds:rtsblk[si] ;is this our first buf request?
	or	bx,ds:rtsblk+2[si] ;(never filled in blk #)
	jz	rtsg10		;yes, use our pre-alloced buf
	xor	bx,bx		;no prev
rtsg1:	; see if we already have it
	; SI=buf to check, BX=prev or 0, DX:AX=abs starting block # of dir seg
	cmp	ax,ds:rtsblk[si] ;is this it?
	jne	rtsg2
	cmp	dx,ds:rtsblk+2[si]
	je	rtsg4		;yes, relink and return
rtsg2:	mov	di,ds:rtsnxt[si] ;get ptr to next
	test	di,di		;if any
	jz	rtsg6		;none, need to read it
	mov	bx,si		;save for linking
	mov	si,di		;follow link
	jmp	short rtsg1	;keep looking
rtsg3:	jmp	baddir
rtsg4:	; found it
	test	bx,bx		;is it first in line?
	jz	rtsg5		;yes, no need to relink
	mov	ax,si		;pt at it
	xchg	ax,ss:dirbuf[bp] ;get head of chain, set new head
	xchg	ax,ds:rtsnxt[si] ;link rest of chain to head
	mov	ds:rtsnxt[bx],ax ;unlink the one we just moved
rtsg5:	ret
rtsg6:	; we don't have it, try to allocate a new buffer
	; SI=LRU buf, BX=the one before that or 0 if there's only 1
	; DX:AX=starting abs blk # of dir seg
	push	si		;save
	push	cx
	mov	cx,rtslen	;# bytes
	call	askmem		;ask for a buffer
	pop	cx		;[catch flag]
	pop	di		;[catch ptr to last buf in chain]
	jnc	rtsg9		;got it, read the buf in
	mov	si,di		;restore
	; failed, write out the last one
	test	bx,bx		;is there a penultimate buffer?
	jz	rtsg7		;no
	mov	ds:rtsnxt[bx],0	;yes, unlink final buffer from it
	jmp	short rtsg8
rtsg7:	mov	ss:dirbuf[bp],bx ;this is the only one, unlink it
rtsg8:	push	ax		;save blk
	push	dx
	push	cx		;and flag
	call	rtfseg		;flush it
	pop	cx		;restore
	pop	dx
	pop	ax
rtsg9:	; link buf in as first
	mov	bx,si		;copy ptr
	xchg	bx,ss:dirbuf[bp] ;get current chain, set new head
	mov	ds:rtsnxt[si],bx ;link it on
rtsg10:	; buf is linked in at head of chain -- SI=buf, DX:AX= abs blk #, CL=flg
	mov	ds:rtsblk[si],ax ;set starting blk #
	mov	ds:rtsblk+2[si],dx
	mov	ds:rtsdrt[si],0	;buf is clean
	test	cl,cl		;should we read it?
	jnz	rtsg11		;no, all we wanted was the buf
	mov	cx,2		;read 2 blks
	mov	di,si		;point at buffer
	push	si		;save
	call	ss:rdblk[bp]	;go
	pop	si		;[restore]
	jc	rtsg12		;err
	mov	ax,[si+6]	;get # extra bytes
	mov	ss:extra[bp],ax	;save
rtsg11:	ret
rtsg12:	jmp	dirio
;+
;
; Flush RT-11 dir segment buffer, if dirty.
;
; ss:bp	dev rec
; ds:si	ptr to buffer (preserved on exit)
;
;-
rtfseg:	cmp	ds:rtsdrt[si],0	;is buf dirty?
	jz	rtfsg1		;no
	mov	ax,ds:rtsblk[si] ;get blk #
	mov	dx,ds:rtsblk+2[si]
	mov	cx,2		;2 blks/seg
	push	si		;save
	call	ss:wrblk[bp]	;go
	pop	si		;[restore]
	jc	rtfsg2		;err
rtfsg1:	ret
rtfsg2:	jmp	dirio
;
	subttl	RSTS file structure
;
	comment	_

I'd better write down a few things that Paul Koning <koning@lkg.dec.com>
(formerly of the RSTS group) clarified for me before I forget them:

PCNs are used only to index SATT.SYS, and even though it seems weird the
Internals manual is right about PCN 0 starting at DCN 1, the purpose is to keep
the boot block from being involved in [0,1]SATT.SYS at all.  PCNs are not used
anywhere else, but the PCS sets an implicit lower bound for FCSes and dir
cluster sizes.

All retrieval ptrs (including the ones in the RDS 1.X MFD/GFD arrays and the
ones in blockette 31 of every UFD block) are DCNs, and point to the first DC
of a file (or directory) cluster.  The appropriate number of consecutive bits
are set in [0,1]SATT.SYS to cover all PCs of the cluster.  The retrieval list
contains one retrieval DCN for each file (or directory) cluster in the file
(dir), even if it's a contiguous file.

If DCS>1, the block(s) between the boot block and the first block of DC 1 are
wasted, as are the blocks in the partial PC at the end of the pack (if the pack
size isn't a multiple of PCS, plus DCS).

The idea of modifying the directory link word format for dir clustersizes >16
was proposed but never implemented.  On disks with PCS>16, (the max was
extended to 64 in RSTS 9.5) the directories all remain at clu=16, with the
remainder of each directory cluster wasted.

_
;+
;
; Print volume name.
;
;-
rsvn:	cram	' is '		;we always succeed
	push	di		;save
	mov	di,ds:dbuf	;pt at buffer
	mov	ax,1		;DCN 1 (pack label (MFD in 0.0))
	mov	cx,ax		;count=1 blk
	mul	ss:dcs[bp]	;*DCS to get block #
	call	ss:rdblk[bp]	;fetch it
	lea	si,[di+14]	;point at pack ID
	pop	di		;restore
	lodsw			;convert to ASCII
	call	radnb
	lodsw
	callr	radnb		;and return
;
rsds:	; set defaults
	mov	ax,ss:curdir[bp] ;get current ppn
	mov	ss:actdir[bp],ax ;set active ppn
	ret
;+
;
; Save RSTS CWD.
;
; bx	0 for input dev, 2 for output dev
;
;-
rssav:	mov	ax,ss:actdir[bp] ;get active dir
	mov	ds:savdir[bx],ax
	push	si		;save
	push	cx
	mov	cl,3		;shift count
	sal	bx,cl		;buf size = 8 words
	lea	si,ss:dirclu[bp] ;pt at clu, retrieval pointers
	lea	di,ds:savwnd[bx] ;pt at save buffer
	mov	cx,8d		;copy 8 words
.assume <dirwnd eq dirclu+2>
	rep	movsw		;copy
	pop	cx		;restore
	pop	si
	ret
;+
;
; Restore RSTS CWD.
;
; bx	0 for input dev, 2 for output dev
;
;-
rsrst:	mov	ax,ds:savdir[bx] ;get saved stuff
	mov	ss:actdir[bp],ax ;set active LD:
	mov	cl,3		;shift count
	sal	bx,cl		;buf size = 8 words
	lea	si,ds:savwnd[bx] ;pt at save buffer
	lea	di,ss:dirclu[bp] ;pt at clu, retrieval pointers
	mov	cx,8d		;copy 8 words
.assume <dirwnd eq dirclu+2>
	rep	movsw		;copy
	ret
;+
;
; Print directory heading.
;
;-
rsdh:	xor	ax,ax		;load 0
	mov	ds:nfile,ax	;no files yet
	mov	ds:nblk,ax	;no blocks seen
	mov	ds:nblk+2,ax
	mov	di,offset lbuf	;pt at buf
	call	cram1		;here's the string
	db	rsdh2
rsdh1	db	' Name .Ext    Size    Prot   Access       '
	db	'Date     Time  Clu  RTS    Pos'
rsdh2=	$-rsdh1
	callr	flush		;print, return
;
rsdi:	; RSTS dir input init
	cmp	ss:initf[bp],0	;already initted since last prompt?
	jnz	rsdi1		;yes
	inc	ss:initf[bp]	;no, but it will be
	; allocate first dir blk buffer (nothing is possible if this fails)
	mov	cx,rdslen	;size of dir buffer
	call	getmem		;allocate dir buffer
	mov	ss:dirbuf[bp],si ;save ptr
	xor	ax,ax		;load 0
	mov	ds:rdsbkl[si],ax ;nothing in here yet
	mov	ds:rdsbkh[si],al
	mov	ds:rdsdrt[si],al ;not dirty
	mov	ds:rdsnxt[si],ax ;no next
rsdi1:	; find dir and fetch retrieval
	mov	ss:ecache[bp],1	;enable caching
	mov	ax,ss:dirwnd[bp] ;get retrieval ptr for first dir block
	mul	ss:dcs[bp]	;*DCS to get block
	call	rsrdir		;read dir block
	lodsw			;get ptr to first entry
	mov	ds:inent,ax	;save
	ret
;+
;
; Find directory.
;
; ss:bp	log dev rec (SS:ACTDIR[BP] contains ppn to find)
; ax	returns starting DCN of dir
;
;-
rsfd:	cmp	ss:rdslev[bp],0	;RDS level 0.0?
	jnz	rsfd6		;no
	; RDS 0.0 -- search MFD for UFD
;;; should be able clear ECACHE and use RSLINK
	mov	ax,1		;start at MFD root
	mul	ss:dcs[bp]	;*DCS to get starting block
	mov	ds:rsblk,ax	;save
	mov	ds:rsblk+2,dx
	mov	cx,1		;count=1
	mov	di,offset buf	;pt at buffer
	call	ss:rdblk[bp]	;read in dir block
	jc	rsfd5		;error
rsfd1:	; check next entry (si=curr blockette ptr, link in first word)
	lodsw			;get link
	and	ax,not 17	;end?
	jz	rsfd4		;yes, not found
	mov	bl,ah		;get cluster #
	mov	si,ax		;save
	and	bx,7*2		;isolate
	mov	ax,word ptr ds:buf+762[bx] ;look up DCN
	mul	ss:dcs[bp]	;*DCS to get base block
	push	si		;save
	mov	cl,12d		;shift count
	shr	si,cl		;get blk within cluster
	add	ax,si		;add it in
	adc	dx,0
	cmp	ax,ds:rsblk	;see if that's the block we have
	jne	rsfd2
	cmp	dx,ds:rsblk+2
	je	rsfd3		;yes, no need to re-read
rsfd2:	mov	ds:rsblk,ax	;update
	mov	ds:rsblk+2,dx
	mov	cx,1		;count=1
	mov	di,offset buf	;pt at buffer
	call	ss:rdblk[bp]	;read
	jc	rsfd5		;error
rsfd3:	pop	si		;catch blockette ptr
	and	si,37*20	;isolate offset
	add	si,offset buf	;index into buf
	test	byte ptr [si+10],100 ;check USTAT byte to see if UFD
	jz	rsfd1		;no, loop
	mov	ax,[si+2]	;get PPN
	cmp	ax,ss:actdir[bp] ;is this it?
	jne	rsfd1		;loop if not
	mov	ax,[si+16]	;get starting DCN
	ret
rsfd4:	jmp	dnf		;dir not found
rsfd5:	jmp	dirio		;dir read error
rsfd6:	; RDS 1.1 or later -- look up through MFD and GFD
	mov	ax,ss:mfddcn[bp] ;get starting DCN of MFD
	mul	ss:dcs[bp]	;*DCS to get blk #
	mov	cx,1		;read 1 blk
	add	ax,cx		;+1 to starting DCN map (clu guaranteed >=4)
	adc	dx,0
	mov	di,offset buf	;pt at buffer
	call	ss:rdblk[bp]	;read the block
	jc	rsfd5
	mov	bl,byte ptr ss:actdir+1[bp] ;get project #
	xor	bh,bh		;BH=0
	sal	bx,1		;*2
	mov	ax,[si+bx]	;look up base DCN of GFD
	test	ax,ax		;is there any?
	jz	rsfd4		;no
	mul	ss:dcs[bp]	;*DCS to get blk #
	mov	cx,1		;read 1 blk
	add	ax,cx		;+1 to starting DCN map (clu guaranteed >=4)
	adc	dx,0
	mov	di,offset buf	;pt at buffer
	call	ss:rdblk[bp]	;read the block
	jc	rsfd5
	mov	bl,byte ptr ss:actdir[bp] ;get programmer #
	xor	bh,bh		;BH=0
	sal	bx,1		;*2
	mov	ax,[si+bx]	;look up base DCN of UFD
	test	ax,ax		;is there any?
	jz	rsfd4
	ret
;
rsdn:	; display RSTS dir name
	mov	al,'['		;[
	stosb
	mov	al,byte ptr ss:actdir+1[bp] ;proj
	call	pbyte
	mov	al,','		;,
	stosb
	mov	al,byte ptr ss:actdir[bp] ;prog
	call	pbyte
	mov	al,']'		;]
	stosb
	ret
;
rscd:	; change RSTS dir
	call	rsgd		;get dir
	call	confrm		;make sure confirmed
	mov	ax,ss:actdir[bp] ;get active dir, make current
	mov	ss:curdir[bp],ax
	ret
;
rsgd:	; get dir name
	jcxz	rsgd4		;nothing, skip
	mov	al,[si]		;get next char
	cmp	al,'['		;open bracket?
	jne	rsgd2		;no
	inc	si		;yes, eat it
	dec	cx
	call	gbyte		;get project
	mov	bh,ah		;save
	cmp	al,','		;comma?
	jne	rsgd1
	inc	si		;yes, eat it
	dec	cx
	call	gbyte		;get programmer
	mov	bl,ah		;save
	cmp	al,']'		;close bracket?
	je	rsgd3		;yes
rsgd1:	jmp	synerr
rsgd2:	; look for one-character logicals -- !@#$%&
	mov	bh,byte ptr ss:curdir+1[bp] ;[proj,0]
	xor	bl,bl
	cmp	al,'#'		;#
	je	rsgd3
	mov	bx,102h		;[1,2]
	cmp	al,'$'		;$
	je	rsgd3
	mov	bx,103h		;[1,3]
	cmp	al,'!'
	je	rsgd3
	mov	bx,104h		;[1,4]
	cmp	al,'%'		;%
	je	rsgd3
	mov	bx,105h		;[1,5]
	cmp	al,'&'		;&
;;; we won't support '@', the ASSIGNable PPN
	jne	rsgd4
rsgd3:	mov	ss:actdir[bp],bx ;save
	inc	si		;eat delimiter
	dec	cx
rsgd4:	; find dir
	push	si		;save
	push	cx
	call	rsfd		;find directory
	mul	ss:dcs[bp]	;*DCS to get blk #
	mov	cx,1		;block count=1
	mov	di,offset buf	;pt at buf
	call	ss:rdblk[bp]	;read starting dir block (should be cached!)
	jc	rsgd5
	add	si,760		;point at clu, retrieval list
	lea	di,ss:dirclu[bp] ;pt into dev rec
.assume <dirwnd eq dirclu+2>	;assume same order as in dir
	mov	cx,8d		;copy 8 words
	rep	movsw
	and	ss:dirclu[bp],37 ;trim to 5 bits (lose flag in b15)
	pop	cx		;restore
	pop	si
	ret
rsgd5:	jmp	dirio
;
rsdd:	; display RSTS dir entry
	mov	ax,ds:fsize	;size
	mov	dx,ds:fsize+2	;high order
	inc	ds:nfile	;bump # files
	add	ds:nblk,ax	;bump # blocks
	adc	ds:nblk+2,dx
	mov	cx,8d		;field size
	call	cnum		;print it right-justified
	mov	dx,di		;save
	mov	ax,"  "		;pad field out to 3 blanks
	stosw
	stosb
	xchg	dx,di		;restore, save
	mov	ah,ds:fattr	;get USTAT byte
	mov	al,'C'		;Contiguous?
	test	ah,20
	jz	$+3
	 stosb			;yes
	mov	al,'P'		;Protected?
	test	ah,40
	jz	$+3
	 stosb			;yes
	mov	al,'L'		;Located?
	test	ah,2
	jz	$+3
	 stosb			;yes
	mov	di,dx		;restore
	mov	ax,'<'		;<
	stosb
	mov	al,ds:fprot	;protection code (AH=0 from above)
	cwd			;DX=0
	mov	cx,3		;field size=3
	call	cnum		;print prot code
	mov	al,'>'		;>
	stosb
	mov	al,' '		;blank
	stosb
	mov	ax,ds:idla	;get date of last access
	call	dosdat		;convert
	mov	ax,cx		;copy
	call	pdate1		;print it
	mov	al,' '		;blank
	stosb
	call	pdate		;date of creation
	mov	al,' '		;blank
	stosb
	call	ptime		;time of creation
	mov	ax,ds:ifcs	;file cluster size
	cwd			;DX=0
	mov	cx,4		;field size
	call	cnum		;convert
	mov	al,' '		;blank
	stosb
	mov	ax,ds:irts	;get RTS name
	test	ax,ax		;skip it if large file
	jz	rsdd2
	call	rad50		;convert
	mov	ax,ds:irts+2
	call	rad50
	jmp	short rsdd2
rsdd1:	cram	'------'	;no RTS name for large files
rsdd2:	mov	ax,ds:fsize	;null file?
	or	ax,ds:fsize+2
	jz	rsdd3
	mov	ax,ds:iretr	;get retrieval pointer
	push	di		;save
	call	rslink		;fetch
	pop	di		;[restore]
	jc	rsdd4		;corrupt dir
	inc	si		;skip link
	inc	si
	lodsw			;get ptr
	xor	dx,dx		;0-extend
	mov	cx,6		;field size
	callr	cnum		;print, return
rsdd3:	cram	' -----'	;no posn for null files
	ret
rsdd4:	jmp	baddir		;missing retrieval list, corrupt dir
;+
;
; Get RSTS dir entry.
;
; UFD entry format:
;
; +0	.word	next	;link to next (!2=contains bad, !4=cacheable)
; +2	.rad50	/FILNAM/ ;filename
; +6	.rad50	/EXT/	;extension
; +10	.byte	ustat	;USTAT byte
;			;!2=placed (US.PLC), !4=opened for write (US.WRT),
;			;!10=opened for update (US.UPD), !20=contig (US.NOX),
;			;!40=protected (US.NOK), !100=UFD (US.UFD),
;			;!200=marked for deletion (US.DEL)
; +11	.byte	prot	;protection code
;			;!1=read prot against owner (UP.RPO), or exec if !100
;			;!2=write prot against owner (UP.WPO), or R/W if !100
;			;!4=read prot against proj (UP.RPG), or exec if !100
;			;!10=write prot against proj (UP.WPG), or R/W if !100
;			;!20=read prot against world (UP.RPW), or exec if !100
;			;!40=write prot against world (UP.WPW), or R/W if !100
;			;!100=executable (UP.RUN), modifies others as above
;			;!200=zero first on delete, priv'ed if !100 (UP.PRV)
; +12	.byte	count	;access count (for system files only), 0 otherwise
; +13	.byte	res	;reserved (these used to be OP/RR in RDS 0.0)
; +14	.word	acc	;link to accounting blockette (!4=seq cach if NEXT&4)
; +16	.word	retr	;link to first retrieval blockette, or 0 if size=0
;
;-
rsdg:	; get RSTS dir entry
	mov	ax,ds:inent	;get ptr to next entry
	call	rslink		;follow it
	jnc	$+3
	 ret
	lodsw			;fetch link to next
	mov	ds:inent,ax	;save
	mov	di,offset lbuf	;pt at LBUF
	test	byte ptr [si-2+10],100 ;file or UFD?
	jnz	rsdg		;UFD, ignore (possible only in RDS 0.0 [1,1])
	lodsw			;FILNAM
	call	rad50
	lodsw
	call	rad50
	mov	al,'.'		;.
	stosb
	lodsw			;EXT
	call	rad50
	lodsw			;get UPROT,,USTAT
	mov	word ptr ds:fattr,ax ;save
	inc	si		;skip access count or open/read regardless
	inc	si
	lodsw			;get link to accounting entry
	mov	bx,ax		;save
	lodsw			;get link to first retrieval (or 0)
	mov	ds:iretr,ax	;save
	mov	ax,bx		;restore
	call	rslink		;follow link to accounting stuff
	jc	rsdg2		;error, must always be present
	lodsw			;get link to attribute stuff
	mov	ds:iattr,ax	;save
	lodsw			;get DLA
	mov	ds:idla,ax
	lodsw			;get low order size
	mov	ds:fsize,ax	;save
	mov	ds:fsize+2,0	;assume high order is 0
	lodsw			;get DOC
	push	si		;save
	call	dosdat		;convert
	pop	si		;restore
	mov	ds:fyear,dx	;store date
	mov	word ptr ds:fday,cx
	mov	ds:fdatf,al	;set flag
	lodsw			;get TOC
	; low 11 bits of RSTS time are # minutes until midnight
	and	ah,3777/100h	;trim to 11 bits in case V10.0+ pack
	neg	ax		;make that minutes *since* midnight
	add	ax,24d*60d
	mov	bl,60d		;separate hours from minutes
	div	bl
	xchg	al,ah		;get hour,,minute
	mov	word ptr ds:fmin,ax ;save
	mov	byte ptr ds:fsec,-1 ;don't know second
	mov	byte ptr ds:ftimf,1 ;time is valid
	lodsw			;get 1st word of RTS name
	mov	ds:irts,ax
	test	ax,ax		;is it 0?
	lodsw			;[get 2nd word]
	mov	ds:irts+2,ax	;[save]
	jnz	rsdg1
	mov	byte ptr ds:fsize+2,al ;yes, high byte of large file size
rsdg1:	lodsw			;get FCS
	mov	ds:ifcs,ax	;save
	; calculate size of file in bytes (including NULs if text file)
;;; it might be nice to use RMS attributes if there are any, to find out
;;; the number of significant bytes in the last block
	mov	cl,9d		;shift count
	mov	ax,ds:fsize	;get it
	mov	dx,ds:fsize+2
	sal	dx,cl		;*512.
	rol	ax,cl
	mov	bx,ax		;copy middle bits
	and	bh,777/100h	;trim to 9 bits
	or	dx,bx
	and	ax,not 777	;clear out low 9 bits
	mov	ds:fbcnt,ax	;save
	mov	ds:fbcnt+2,dx
	mov	di,offset lbuf+10d ;restore di
	callr	sqfn		;squish filename, return
rsdg2:	jmp	baddir		;corrupt dir
;+
;
; Convert RSTS date to date, month, year.
;
; RSTS dates (same as DOS-11) are 16-bit words containing the year minus 1970.
; times 1000., plus the day within the year.
;
; ax	DOS-11 date
;
; On return:
; cl	day
; ch	month
; dx	year
; al	flag (NZ => date is valid)
;
;-
dosdat:	xor	dx,dx		;0-extend
	mov	bx,1000d	;split year from month/day
	div	bx
	add	ax,1970d	;add base year
	mov	cx,dx		;catch remainder
	mov	dx,ax		;copy year
	mov	ax,28d		;# days in Feb
	test	dl,3		;leap year?  (2000. AD counts)
	jnz	dsdat1
	 inc	ax		;yes
dsdat1:	mov	ds:feb,al	;save
	add	ax,365d-28d	;find length of year
	cmp	cx,ax		;is it possible?
	ja	dsdat3		;no
	jcxz	dsdat3		;can't be 0 either
	mov	si,offset jan	;point at year table
	xor	ah,ah		;AH=0
dsdat2:	lodsb			;get month
	sub	cx,ax		;subtract
	jnc	dsdat2		;loop unless carry
	add	cx,ax		;correct
	sub	si,offset jan	;find month-1, +1
	mov	ax,si		;copy
	mov	ch,al		;copy again
	mov	al,1		;valid
	ret
dsdat3:	xor	al,al		;not valid
	ret
;
rsdf:	; RSTS dir finish
	ret
;
rssum:	; RSTS dir listing summary
	mov	di,offset lbuf	;pt at buf
	call	flush		;blank line
	cram	'Total of '
	mov	ax,ds:nblk	;get # blocks
	mov	dx,ds:nblk+2
	push	dx		;save
	push	ax
	call	pdnum		;display 32-bit number
	cram	' block'
	pop	ax		;restore
	pop	dx
	call	dadds		;add s
	cram	' in '
	mov	ax,ds:nfile	;get # files
	push	ax		;save
	call	pnum		;print
	cram	' file'
	pop	ax		;restore
	call	adds		;add s
	cram	' in '
	call	pdev		;print dev name
	call	rsdn		;and dir name
	callr	flush		;flush, return
;
rsop:	; open RSTS file for input
	mov	ax,ds:fsize	;get size
	mov	ds:isize,ax	;save
	mov	ax,ds:fsize+2
	mov	ds:isize+2,ax
	mov	ds:irptr,8d*2	;init retrieval ptr to follow link to first
	ret
;+
;
; Read file data.
;
; On entry:
; es:di	ptr to buf (normalized)
; cx	# bytes free in buf (FFFF if >64KB)
;
; On return:
; cx	# bytes read (may be 0 in text mode if block was all NULs etc.)
;
; CF=1 if nothing was read:
;  ZF=1 end of file
;  ZF=0 buffer not big enough to hold anything, needs to be flushed
;
;-
rsrd:	push	di		;save starting ptr
rsrd1:	; DI=addr, CX=length
	push	cx		;save # free bytes left in buf
	mov	bx,-1		;assume >64K blocks
	test	ds:isize+2,bx	;is it?
	jnz	rsrd2		;yes
	mov	bx,ds:isize	;get remaining size
	test	bx,bx		;EOF?
	jnz	rsrd2
	jmp	rsrd8		;yes
rsrd2:	mov	al,ch		;get # full blocks free in buf
	shr	al,1
	cbw			;AH=0
	cmp	ax,ds:ifcs	;smaller than one cluster?
	jb	rsrd8		;yes, skip (might have fit if partial last clu)
	cmp	ax,bx		;more than what's left?
	jb	rsrd3
	 mov	ax,bx		;stop at end
rsrd3:	; read next cluster
	mov	bx,ds:irptr	;get retrieval ptr
	cmp	bx,8d*2		;off end of window?
	jb	rsrd4		;no
	; window turn
	push	di		;save
	push	es
	push	ds		;copy DS to ES
	pop	es
	mov	ax,ds:iretr	;get link to next
	call	rslink		;follow it
	jc	rsrd10		;shouldn't happen!
	mov	di,offset iretr	;point at retrieval window buf
	mov	cx,8d		;blockette size
	rep	movsw		;copy
	pop	es		;restore
	pop	di
	mov	bx,2		;point at first retrieval word
rsrd4:	mov	ax,ds:iretr[bx]	;look up retrieval word
	inc	bx		;+2
	inc	bx
	mov	ds:irptr,bx	;update
	mul	ss:dcs[bp]	;*DCS to get starting blk #
	mov	cx,ds:ifcs	;get input file cluster size
	sub	ds:isize,cx	;subtract
	sbb	ds:isize+2,0
	jnc	rsrd5
	; last partial cluster
	xor	bx,bx		;load 0
	mov	ds:isize+2,bx	;clear
	xchg	bx,ds:isize	;and fetch low word
	add	cx,bx		;fix actual block count
rsrd5:	call	ss:rdblk[bp]	;read data
	jc	rsrd11		;error, skip
	mov	di,si		;pt past data
	add	di,cx
	cmp	ds:binflg,0	;binary mode?
	jz	rsrd7		;yes
	; text mode, remove NULs
	mov	di,si		;pt at data
	mov	dx,di		;save starting posn
rsrd6:	lods	byte ptr es:[si] ;get a byte
	test	al,al		;NUL?
	jz	$+3
	 stosb			;save if not
	loop	rsrd6		;loop
	mov	cx,di		;find # bytes written
	sub	cx,dx
rsrd7:	; CX=# bytes just read, DI=first free buf loc
	mov	ax,cx		;copy
	pop	cx		;restore # that were free
	sub	cx,ax		;find # to go
	jmp	rsrd1		;around for next file cluster
rsrd8:	; can't fit anything more in buf (di pts past what we've read)
	pop	ax		;flush free count in buf
	mov	cx,di		;copy end of stuff read
	pop	si		;restore ptr to begn
	sub	cx,si		;get length (CF=0)
	jz	rsrd9		;got nothing, skip
	ret
rsrd9:	; read nothing, see if EOF
	mov	ax,ds:isize	;get size
	or	ax,ds:isize+2	;ZF=0 if not EOF
	stc			;unhappy return
	ret
rsrd10:	jmp	baddir		;retrieval list ran out before EOF
rsrd11:	jmp	rderr		;read error
;
rsdo:	; RSTS dir output init

;;; punt in flames if pack needs CLEANing

	cmp	ss:initf[bp],0	;already initted since last prompt?
	jnz	rsdo1		;yes
	inc	ss:initf[bp]	;no, but it will be
	; allocate first dir blk buffer (nothing is possible if this fails)
	mov	cx,rdslen	;size of dir buffer
	call	getmem		;allocate dir buffer
	mov	ss:dirbuf[bp],si ;save ptr
	xor	ax,ax		;load 0
	mov	ds:rdsbkl[si],ax ;nothing in here yet
	mov	ds:rdsbkh[si],al
	mov	ds:rdsdrt[si],al ;not dirty
	mov	ds:rdsnxt[si],ax ;no next
rsdo1:	; chase down last entry
	mov	ax,ss:dirwnd[bp] ;get retrieval ptr for first dir block

;;; skip all this if NFF pack

	mul	ss:dcs[bp]	;*DCS to get block
	call	rsrdir		;read dir block
	lodsw			;get ptr to first entry
;;;;;	mov	ds:inent,ax	;save

	ret
;+
;
; Get RSTS dir block.
;
; dl:ax	block #
; dh	NZ to return buf but don't read if not cached (going to write it)
; ss:bp	log dev rec
;
; Returns ptr in si.
;
;-
rsrdir:	mov	si,ss:dirbuf[bp] ;head of buffer chain
	xor	bx,bx		;no prev
	cmp	ds:rdsbkl[si],bx ;is this our first buf request?
	jnz	rsdr1		;(assumption:  blk 0 (boot) is not cached)
	cmp	ds:rdsbkh[si],bl ;hm?
	jz	rsdr9		;yes, use our pre-alloced buf
rsdr1:	; see if we already have it
	cmp	ax,ds:rdsbkl[si] ;is this it?
	jne	rsdr2
	cmp	dl,ds:rdsbkh[si] ;hm?
	je	rsdr3		;yes, relink and return
rsdr2:	mov	cx,ds:rdsnxt[si] ;get ptr to next
	jcxz	rsdr5		;none, need to read it
	mov	bx,si		;save for linking
	mov	si,cx		;follow link
	jmp	short rsdr1	;keep looking
rsdr3:	; found it
	test	bx,bx		;is it first in line?
	jz	rsdr4		;yes, no need to relink
	mov	ax,si		;pt at it
	xchg	ax,ss:dirbuf[bp] ;get head of chain, set new head
	xchg	ax,ds:rdsnxt[si] ;link rest of chain to head
	mov	ds:rdsnxt[bx],ax ;unlink the one we just moved
rsdr4:	ret
rsdr5:	; we don't have it, try to allocate a new buffer
	push	si		;save
	mov	cx,rdslen	;# bytes
	call	askmem		;ask for a buffer
	pop	di		;[catch ptr to last buf in chain]
	jnc	rsdr8		;got it, read the buf in
	mov	si,di		;restore
	; failed, write out the last one
	test	bx,bx		;is there a penultimate buffer?
	jz	rsdr6		;no
	mov	ds:rdsnxt[bx],0	;yes, unlink final buffer from it
	jmp	short rsdr7
rsdr6:	mov	ss:dirbuf[bp],bx ;this is the only one, unlink it
rsdr7:	push	ax		;save blk
	push	dx		;and flag
	call	rswdir		;flush it
	pop	dx		;restore
	pop	ax
rsdr8:	; link buf in as first
	mov	bx,si		;copy ptr
	xchg	bx,ss:dirbuf[bp] ;get current chain, set new head
	mov	ds:rdsnxt[si],bx ;link it on
rsdr9:	; buf is linked in at head of chain
	mov	ds:rdsbkl[si],ax ;set blk
	mov	ds:rdsbkh[si],dl
	mov	ds:rdsdrt[si],0	;buf is clean
	test	dh,dh		;should we read it?
	jnz	rsdr10		;no, all we wanted was the buf
	mov	cx,1		;read 1 blk (DH=0)
	mov	di,si		;point at buffer
	push	si		;save
	call	ss:rdblk[bp]	;go
	pop	si		;[restore]
	jc	rsdr11		;err
rsdr10:	ret
rsdr11:	jmp	dirio
;+
;
; Write RSTS dir block buffer, if dirty.
;
; ss:bp	dev rec
; ds:si	ptr to buffer (preserved on exit)
;
;-
rswdir:	cmp	ds:rdsdrt[si],0	;is buf dirty?
	jz	rswd1		;no
	mov	ax,ds:rdsbkl[si] ;get blk #
	mov	dl,ds:rdsbkh[si]
	xor	dh,dh		;high byte=0
	mov	cx,1		;1 blk
	push	si		;save
	call	ss:wrblk[bp]	;go
	pop	si		;[restore]
	jc	rswd2		;err
rswd1:	ret
rswd2:	jmp	dirio
;+
;
; Follow RDS dir link.
;
; ax	link to follow
; si	points to destination blockette on return
; bx	points to base of dir block buf on return (so can set "dirty" flag)
; CF=1	if no next blockette (RSLNKE only)
;
; link:
; 15:12	relative blk # in clu
; 11:9	relative clu # in dir (0-6)
; 8:4	blockette (8. words) within block
; 3:0	don't care (used for flags or to ensure blockette is non-null)
;
;-
rslink:	and	ax,not 17	;end?
	jz	rslnk1		;yes
rslnkn:	; same with no end-of-chain check (so can address blkette 0)
	push	ax		;save
	mov	bl,ah		;copy clu #
	and	bx,7*2		;isolate it
	cmp	bl,7*2		;make sure it's blk 0-6
	je	rslnk2		;no, error
	add	bx,bp		;add base of log dev record
	mov	cl,12d		;bit count
	mov	dh,ah		;get blk within cluster
	shr	dx,cl		;into dx
	cmp	dx,ss:dirclu[bp] ;less than dir clustersize right?
	jae	rslnk2		;no, invalid
	mov	ax,ds:dirwnd[bx] ;look up retrieval
	test	ax,ax		;0?  (unmapped part of dir)
	jz	rslnk2		;error if so
	mov	bx,dx		;save blk within cluster
	mul	ss:dcs[bp]	;*DCS
	add	ax,bx		;add it in
	adc	dl,0		;(DH=0 so really fetch it)
	call	rsrdir		;get the cluster
	pop	bx		;restore
	and	bx,37*20	;isolate byte offset
	xchg	bx,si		;swap (so BX=base of block)
	add	si,bx		;add it in (CF=0)
	ret
rslnk1:	stc			;end of chain
	ret
rslnk2:	jmp	baddir		;link was to nonexistent block
;+
;
; Alloc a cluster.
;
; ss:bp	log dev rec
; cx	size of contiguous area needed (pack clusters)
;
;-
getclu:

	mov	ax,ss:satptr[bp] ;get starting loc


;+
;
; Return a cluster.
;
;-
retclu:



;
	subttl	OS/8 (and COS-310) file structure
;
	comment	_

OS/8 disks have a directory in blocks 1-6, consisting of a linked list of
256-word blocks (starting at block 1), each of which includes a 5-word header:

+0000	dw	-(# entries in seg)
+0001	dw	starting blk # of 1st file in seg
+0002	dw	next dir seg or 0
+0003	dw	tentative file ptr (meaningful while file is open under OS/8)
+0004	dw	-(# info words per dir entry) (usually -1 -- date)
+0005 first dir entry starts here

Each file entry looks like this:

	text	/FILNAM/
	text	/EX/
	; optional info words
	; first may be date:  MMMMDDDDDYYY, where YYY=MOD(YEAR-1970,8)
	-length

Entries for .EMPTY. areas are just two words:

	0
	-length
_
;+
;
; Set defaults for OS/8.
;
; si,cx	preserved
;
;-
osds:	mov	ax,ss:curdir[bp] ;get current LD:
	mov	ss:actdir[bp],ax ;set active LD:
	mov	ax,ss:cursiz[bp] ;get size of LD:
	mov	ss:actsiz[bp],ax
	xor	ax,ax		;high word always 0
	mov	ss:actsiz+2[bp],ax
	ret
;+
;
; Save OS/8 CWD.
;
; bx	0 for input dev, 2 for output dev
;
;-
ossav:	mov	ax,ss:actdir[bp] ;get active LD:
	mov	ds:savdir[bx],ax
	mov	ax,ss:actsiz[bp]
	mov	ds:savsiz[bx],ax
	ret
;+
;
; Restore OS/8 CWD.
;
; bx	0 for input dev, 2 for output dev
;
;-
osrst:	mov	ax,ds:savdir[bx] ;get saved stuff
	mov	ss:actdir[bp],ax ;set active LD:
	mov	ax,ds:savsiz[bx]
	mov	ss:actsiz[bp],ax
	ret
;
osdh:	; print OS/8 dir header
	mov	di,offset lbuf	;pt at buffer
	cram	' Name .Ex  Size     Date'
	test	byte ptr ds:dirflg,200 ;verbose listing?
	jz	osdh1
	cram	'      Loc'	;add location
osdh1:	call	flush		;flush line
	xor	ax,ax		;load 0
	mov	ds:nfile,ax	;nuke # files, blocks, frees
	mov	ds:nblk,ax
	mov	ds:nfree,ax
	ret
;
osdi:	; OS/8 & COS-310 dir input init
	cmp	ss:initf[bp],0	;already initted since last prompt?
	jnz	osdi1		;yes
	inc	ss:initf[bp]	;no, but it will be
	; allocate first dir seg buffer (nothing is possible if this fails)
	mov	cx,osslen	;size of dir buffer
	call	getmem		;allocate dir buffer
	mov	ss:dirbuf[bp],si ;save ptr
	xor	ax,ax		;load 0
	mov	ds:ossblk[si],ax ;nothing in here yet
	mov	ds:ossdrt[si],al ;not dirty
	mov	ds:ossnxt[si],ax ;no next
osdi1:	mov	ax,1		;first seg
	call	osnext		;get it
	mov	ds:fsize,0	;say preceding file null
	callr	osfix		;make sure we're pointing at an entry, return
;
osdg:	; get OS/8 & COS-310 dir entry
	mov	al,ds:inseg	;make sure seg is still there
	cbw			;AH=0 (really read it)
	call	osseg		;(in case output is same device, may page out)
	mov	ax,ds:inent	;get offset of current input entry
	test	ax,ax		;at end?
	jns	osdg1
	stc			;yes
	ret
osdg1:	; get next entry (SI=buffer, AX=offset)
	mov	bx,si		;save base (subtracted before returning)
	add	si,ax		;index to curr posn
	mov	ds:oinent,ax	;take snapshot in case delete/rename
	mov	dl,ds:inseg
	mov	ds:oinseg,dl
	push	bx		;save
	cmp	ax,5*2		;at begn of seg?
;;	je	osdg2		;yes, no previous
	mov	ax,ds:fsize	;get size of previous
	add	ds:stblk,ax	;update starting blk ptr
osdg2:	mov	word ptr ds:ftimf,0 ;no date or time
	mov	di,offset lbuf	;pt at buf (whether empty or not)
	mov	bx,offset lbuf+9d
	lodsw			;get first word
	xor	dx,dx		;(in case empty area)
	mov	ds:pextra,dx	;in case no extras
	test	ax,ax		;is it empty?
	jz	osdg6		;yes (AX=0 to update free space count)
	call	text3		;FILNAM
	call	text2
	call	text2
	mov	al,'.'		;.
	stosb
	mov	[bx],al		;(in both places)
	inc	bx
	call	text2		;EX
	mov	ds:pextra,si	;save ptr to info word(s)
	; get file date if there was one
	mov	cx,ss:extra[bp]	;get extra byte count
	jcxz	osdg5		;no date if nothing
	mov	ax,[si]		;fetch first extra word (if any)
	add	si,cx		;skip extra word(s)
	test	ax,ax		;is date valid?
	jz	osdg5		;no
	; OS/8 date is 12 bits:  MMMMDDDDDYYY
	; MMMM=month (1-12.), DDDDD=day (1-31.), YYY=year-1970 (0-7)
	; obviously the yyy format ran out long ago, so normally we would add
	; some multiple of 8 to it (retrieved from a word in the OS/8 monitor)
	;
	; We'll use DIRECT.SV's heuristic:  add the most recent year which is a
	; multiple of 8. years after 1970 (computed from the DOS date), then
	; subtract 8 years if this would yield a year which is after today.
	; This means dates will be right for files less than 8 years old.
	; Otherwise you lose.  TSS/8 used to use a similar date system, and
	; they patched all the CUSPs a couple of times to give new base years
	; other than 1970 (each time it ran out).  The last one ran out around
	; 1984...
	mov	dx,ax		;copy month,,day*8d
	mov	cl,3		;bit count
	shr	dl,cl
	and	dx,0F1Fh	;isolate both
	and	ax,7		;isolate MOD(YEAR-1970,8)
	add	ax,ds:yrbase	;add base
	cmp	ax,ds:year	;is it after this year?
	jb	osdg4		;before, skip
	ja	osdg3		;after, back up
	cmp	dx,word ptr ds:day ;this year, check day
	jbe	osdg4		;today or before, skip
osdg3:	sub	ax,8d		;back 8 years
osdg4:	mov	word ptr ds:fday,dx ;save month,,day
	mov	ds:fyear,ax	;and year
	inc	ds:fdatf	;date is valid
osdg5:	mov	dx,100h		;flag for XOR below (CF=0 ZF=0)
	mov	[bx],dl		;mark end
	mov	ax,-1		;mask
osdg6:	; DL,DH -- XORed together to set ZF, AX=0 if .EMPTY., -1 if file
	mov	bx,ax		;copy
	not	bx		;invert
	lodsw			;get -(length)
	mov	cx,10000	;abs val
	sub	cx,ax
	and	ch,7777/400	;might have been 0
	mov	ds:fsize,cx
	and	bx,cx		;copy size if .EMPTY.
	add	ds:nfree,bx	;add it on (or not if not .EMPTY.)
	mov	bx,dx		;copy
	mov	ax,384d		;384d 8-bit chars per 256d 12-bit words
	cmp	ds:binflg,text	;text mode?
	je	osdg7		;keep this value if so
	 mov	ax,512d		;no, 512d 8-bit bytes per 256d 12-bit words
osdg7:	mul	cx		;find byte count
	mov	ds:fbcnt,ax	;save
	mov	ds:fbcnt+2,dx
	pop	ax		;catch base of buffer
	sub	si,ax		;find offset
	mov	ds:inent,si	;update
	dec	ds:ndent	;# entries -1
	; find next entry now so that INENT will point at it
	push	bx
	push	di
	call	osfix
	pop	di
	pop	bx
	xor	bh,bl		;CF=0, ZF=(BH.EQ.BL)
	ret
;+
;
; Routine to ensure that INSEG/INENT point at an actual directory entry (file
; or .EMPTY.), rather than pointing off the end of a segment.  This is to
; ensure that OSCL, OSDL, OSRDIR, and OSWDIR will handle relocating INSEG/INENT
; correctly if they reorganize the directory.
;
; INENT is set to -1 if there are no more entries in the directory (normal
; range is 5*2 to 254.*2).
;
;-
osfix:	cmp	ds:ndent,0	;anything left in seg?
	jz	$+3
	 ret			;yes, we must be OK
	; link to next segment
	mov	al,ds:inseg	;make sure seg is still there
	cbw			;AH=0 (really read it)
	call	osseg
	mov	ax,[si+4]	;get link to next
	call	osnext		;follow it
	jnc	osfix		;make sure it's not empty
	mov	ds:inent,-1	;flag as end (will never match a valid ptr)
	ret
;+
;
; Move to next segment of OS/8 dir.
;
; ax	link word (or 0 if end)
;
; On return, CF=1 if end of directory, otherwise:
;
; bx	return pointer to buffer
; si	returns pointer to dir entry area (5 words past BX)
;
;-
osnext:	test	ax,ax		;any?
	jz	osnxt3		;no
	mov	ds:inseg,al	;yes, save #
	xor	ah,ah		;really read
	call	osseg		;get dir seg
	mov	bx,si		;save base
	lodsw			;get -(# entries)
	mov	cx,10000	;abs
	sub	cx,ax
	and	ch,7777/400	;trim to 12 bits in case 0000
	mov	ds:ndent,cx
	lodsw			;get starting blk # of 1st file
	add	ax,ss:actdir[bp] ;add base of dir
	cmp	byte ptr ds:inseg,1 ;first segment?
	je	osnxt1		;yes, accept w/o question
	; make sure it's what we expect
	cmp	ax,ds:stblk	;should match
;;	jne	...		;error (does happen in OS/278, computed value
				;is the correct one)
	jmp	short osnxt2	;well keep computed value anyway
osnxt1:	mov	ds:stblk,ax	;save
osnxt2:	add	si,3*2		;skip (next dir seg),(tentative file info)
				;and -(# info words per dir entry), CF=0
	mov	ds:inent,5*2	;[save offset]
	ret
osnxt3:	stc			;end of dir
	ret
;
osdd:	; display OS/8 dir entry
	mov	ax,ds:fsize	;size
	inc	ds:nfile	;bump # files
	add	ds:nblk,ax	;and # blks
	cwd			;0-extend (always <=7777)
	mov	cx,6		;# spaces
	call	cnum		;print it right-justified
	; add date, if any
	mov	cx,2+11d+2+4	;# cols for loc if no date
	cmp	byte ptr ds:fdatf,0 ;was there a date?
	jz	osdd1		;no
	mov	ax,"  "		;2 blanks
	stosw
	call	pdate		;print date
	mov	cx,2+4		;2 blanks before loc
osdd1:	test	byte ptr ds:dirflg,200 ;verbose listing?
	jz	osdd2		;no
	mov	ax,ds:stblk	;get starting block #
	xor	dx,dx		;0-extend
	callr	cnum		;add blanks, print it, return
osdd2:	ret
;
osde:	; display empty OS/8 entry
	mov	di,offset lbuf	;pt at buf again
	cram	'.EMPTY.'
	mov	ax,ds:fsize	;size
	cwd			;0-extend (always <=7777)
	mov	cx,8d		;size of field
	callr	cnum		;print it right-justified, return (no date)
;
osdf:	; OS/8 dir finish (flush dirty segment buffers)
	mov	si,ss:dirbuf[bp] ;get ptr to buf chain
osdf1:	call	osfseg		;flush
	mov	si,ds:ossnxt[si] ;follow chain
	test	si,si		;anything?
	jnz	osdf1		;loop if so
	ret
;
ossum:	; OS/8 dir listing summary
;;; this isn't based on anything, should look at DIRECT.PA
	mov	di,offset lbuf	;pt at buf
	call	flush		;blank line
	mov	ax,ds:nfile	;# files
	push	ax		;save
	call	pnum
	cram	' file'
	pop	ax		;restore
	call	adds		;add s
	mov	ax," ,"		;', '
	stosw
	mov	ax,ds:nblk	;# blocks
	push	ax		;save
	call	pnum
	cram	' block'
	pop	ax		;restore
	call	adds		;add s
	mov	ax," ,"		;', '
	stosw
	mov	ax,ds:nfree	;# frees
	call	pnum
	cram	' free'
	callr	flush		;flush, return
;
osop:	; open OS/8 file for input
	mov	ax,ds:stblk	;get starting blk #
	mov	ds:iblk,ax	;save
	mov	ax,ds:fsize	;get size
	mov	ds:isize,ax	;save
	mov	byte ptr ds:ieof,0 ;not EOF
	ret
;
osrd:	; read OS/8 file data
	mov	bx,ds:isize	;get remaining size
	test	bx,bx		;EOF?
	jz	osrd3		;yes, ZF=1
	mov	al,ch		;get # full blocks free in buf
	shr	al,1
	jz	osrd2		;nothing will fit
	cbw			;AH=0
	cmp	ax,bx		;more than what's left?
	jb	osrd1
	 mov	ax,bx		;stop at EOF
osrd1:	mov	cx,ax		;copy block count
	mov	ax,ds:iblk	;get starting block
	xor	dx,dx		;OS/8 devs are always .LE.4096 blks
	add	ds:iblk,cx	;update
	sub	ds:isize,cx
	mov	si,ds:binflg	;get binary flag
	jmp	ss:rdblk[bp+si]	;read data, return
osrd2:	or	al,1		;ZF=0
osrd3:	stc			;ZF already set, set CF
	ret
;
osdo:	; OS/8 dir output init
	cmp	ss:initf[bp],0	;already initted since last prompt?
	jnz	osdo1		;yes
	inc	ss:initf[bp]	;no, but it will be
	; allocate first dir seg buffer (nothing is possible if this fails)
	mov	cx,osslen	;size of dir buffer
	call	getmem		;allocate dir buffer
	mov	ss:dirbuf[bp],si ;save ptr
	xor	ax,ax		;load 0
	mov	ds:ossblk[si],ax ;nothing in here yet
	mov	ds:ossdrt[si],al ;not dirty
	mov	ds:ossnxt[si],ax ;no next
osdo1:	ret
;
oscr:	; create OS/8 file
	; parse filename (at DS:SI), convert to TEXT form (truncated ASCII)
	call	lenz		;get length
	call	gtext		;get filename
	jc	oscr3
	cmp	al,'.'		;ends with dot, right?
	jne	oscr3
	mov	ds:rtfile,bx	;save filename
	mov	ds:rtfile+2,dx
	mov	ds:rtfile+4,di
	inc	si		;eat the dot
	dec	cx
	call	gtext		;get extension
	test	al,al		;ends at end of string, right?
	jnz	oscr3
	mov	ds:rtfile+6,bx	;save extension
	; search for smallest .EMPTY. area that's big enough for it
	mov	ax,ds:fbcnt	;get byte count
	mov	dx,ds:fbcnt+2
	mov	bx,384d-1	;ASCII chars/block -1
	cmp	ds:binflg,text	;text mode?
	je	oscr1
	 mov	bx,512d-1	;binary bytes/block -1
oscr1:	cmp	dx,bx		;make sure it'll fit in <64KB blks
	jbe	oscr4
oscr2:	jmp	odfull		;full
oscr3:	jmp	badnam		;bad filename
oscr4:	add	ax,bx		;round up to next block
	adc	dx,0
	inc	bx		;+1 to full block size
	div	bx		;find # blocks needed
	; search directory for first .EMPTY. area .LE. AX blocks long
	mov	dx,ax		;save length
	mov	al,1		;starting seg #
oscr5:	mov	ds:outseg,al	;save
	push	dx		;save min size
	cbw			;AH=0 (really read it)
	call	osseg		;get the seg
	pop	dx		;restore
	mov	bx,si		;save base of buf
	add	si,5*2		;skip to data
	mov	cx,10000	;find +<# entries>
	mov	di,cx		;(copy)
	sub	cx,[bx]
	and	ch,7777/400	;(force 12 bits in case 0)
	jcxz	oscr9		;null seg
	mov	ax,[bx+2]	;get starting blk
	add	ax,ss:actdir[bp] ;add base of LD: (if any)
	mov	ds:oblk,ax	;save
	sub	di,[bx+8d]	;get # info words on each dir entry
	and	di,7777		;trim to 12 bits in case 0
	sal	di,1		;*2 to get # bytes
	mov	ds:osize,0	;say prev file was null (preserve OBLK)
oscr6:	; examine next file entry within this segment (SI=ptr, BX=base,
	; CX=# file entries to go, DX=size needed, DI=# info bytes)
	mov	ax,ds:osize	;get size of previous
	add	ds:oblk,ax	;update starting blk ptr
	lodsw			;get first word
	test	ax,ax		;.EMPTY.?
	jnz	oscr7		;no
	mov	ax,10000	;yes, find size
	sub	ax,[si]
	and	ah,7777/400
	cmp	ax,dx		;is it big enough?
	jae	oscr10		;yes, take it
	jmp	short oscr8
oscr7:	add	si,8d-2		;skip rest of filename
	add	si,di		;skip info word(s) if any
	mov	ax,10000	;find size
	sub	ax,[si]
	and	ah,7777/400
oscr8:	mov	ds:osize,ax	;save
	inc	si		;skip length
	inc	si
	loop	oscr6
oscr9:	; get next seg
	mov	ax,[bx+4]	;get link to next seg
	test	ax,ax		;any?
	jnz	oscr5		;get it if so
	jmp	short oscr2
oscr10:	; found one that's big enough, save ptr to entry (OBLK, OSIZE set up)
	mov	ds:osize,ax	;save
	dec	si		;-2 (undo LODSW)
	dec	si
	sub	si,bx		;subtract base (in case bufs shuffled)
	mov	ds:outent,si	;save
	mov	ds:owrtn,0	;init size
	ret
;
oswr:	; write to OS/8 file
	mov	di,ds:binflg	;get binary flag
	mov	ax,cx		;copy # bytes
	mov	bx,512d		;get # bytes per block (binary mode, 256 words)
	test	di,di		;binary mode?
.assume <bin eq 0>
	jz	oswr1
	 mov	bx,384d		;# bytes/block in ASCII mode
oswr1:	xor	dx,dx		;zero-extend
	div	bx		;find # full blocks
	mov	cx,ax		;save count
	mul	bx		;round byte count to block multiple
	push	ax		;save
	test	ax,ax		;anything?
	jz	oswr2
	sub	ds:osize,cx	;eat this out of .EMPTY. area
	jc	oswbug		;whoops, this should never happen
	add	ds:owrtn,cx	;update # blks written
	mov	ax,ds:oblk	;get starting block #
	xor	dx,dx		;always <32MB in OS/8
	add	ds:oblk,cx	;update
	mov	di,ds:binflg	;get binary flag
	call	ss:wrblk[bp+di]	;write data
	jc	oswr3		;failed
oswr2:	pop	cx
	ret
oswr3:	pop	cx		;flush stack
	jmp	wrerr		;error
oswbug:	cram	'?BUG:  Output area too small',error
;+
;
; Write last buffer of data to output file.
;
; es:si	string
; cx	length of data
;
;-
oswl:	; write last partial block to OS/8 file
	jcxz	oswl3		;nothing, skip
	mov	dx,512d		;OS/8 block size
	cmp	ds:binflg,bin	;binary file?
	je	oswl1
	 mov	dx,384d		;text file block size
oswl1:	mov	bx,dx		;OS/8 block size
	sub	bx,cx		;find # NULs to add (in [1,777])
	xchg	bx,cx		;swap
	lea	di,[bx+si]	;point past data
	cmp	ds:binflg,bin	;binary file?
	je	oswl2
	mov	al,'Z'-100	;add ^Z if not
	stosb
	dec	cx		;subtract from count
oswl2:	xor	al,al		;load 0
	rep	stosb		;pad it out
	mov	cx,dx		;write a whole block
	jmp	oswr		;write data, return
oswl3:	ret
;+
;
; Close OS/8 output file.
;
; Same logic as RT-11 version.
;
;-
oscl:	; close OS/8 output file
	call	osrdir		;read directory, init IPTR1, OPTR1
	; delete any other file of the same name
	mov	ax,ds:dirsiz	;size of dir
	mov	ds,ds:bigbuf	;pt at buffer
	push	ds		;copy to ES too
	pop	es
	mov	bx,5*2		;starting posn
	mov	dx,bx		;output posn too
oscl1:	; check next entry (BX=input ptr, DX=output ptr, AX=end)
	cmp	bx,ax		;done?
	je	oscl6		;yes, skip
	; see if this is the current input entry
	cmp	bp,cs:indev	;is it the right dev?
	jne	oscl2		;no
	mov	si,ss:actdir[bp] ;yes, get LD: base
	cmp	si,cs:savdir	;is it the input one?
	jne	oscl2
	cmp	bx,cs:inptr	;is this the file?
	jne	oscl2
	 mov	cs:iptr1,dx	;update
oscl2:	; see if this is the current output entry
	cmp	bx,cs:outptr	;is this the output file (dir/dev match)
	jne	oscl3
	 mov	cs:optr1,dx	;update
oscl3:	cmp	word ptr [bx],0	;file or .EMPTY.?
	jz	oscl4		;.EMPTY., don't bother
	mov	si,bx		;point at filename
	push	es		;save
	push	cs		;copy CS to ES
	pop	es
	mov	di,offset rtfile ;pt at output file
	mov	cx,4		;WC
	repe	cmpsw		;match?
	pop	es		;[restore]
	jne	oscl5
	; found a file of the same name, delete it
	add	bx,cs:dirent	;skip file entry
	sub	bx,4		;pretend it's a .EMPTY. (size at [BX+2]
oscl4:	; .EMPTY. (or deleting file)
	mov	di,dx		;copy
	mov	word ptr [di],0	;.EMPTY.
	mov	si,[bx+2]	;get -length
	mov	[di+2],si	;save
	add	bx,4		;skip both
	add	dx,4
	jmp	short oscl1	;loop
oscl5:	; keep file
	mov	si,bx		;point at source
	mov	di,dx		;dest
	mov	cx,cs:dirent	;get size
	shr	cx,1		;/2
	rep	movsw		;copy
	mov	bx,si		;update
	mov	dx,di
	jmp	short oscl1
oscl6:	; finished deleting all files w/same name
	mov	cs:dirsiz,dx	;save updated dir size
	push	cs		;restore DS but leave ES
	pop	ds
	; create new entry (calc amount to slide dir down)
	mov	bx,ds:optr1	;get (relocated) ptr to output file entry
	mov	di,ds:dirent	;get dir entry size
	sub	di,4		;-4 bytes we already have (.EMPTY.)
	mov	ax,10000	;find positive value of size of .EMPTY. area
	sub	ax,es:[bx+2]
	and	ah,7777/400	;trim in case 0
	sub	ax,ds:owrtn	;-size of file
	jz	oscl7		;exact fit, easy
	 add	di,4		;we'll need 4 bytes for another .EMPTY.
oscl7:	; see if input file posn needs updating
	cmp	bp,ds:indev	;is it the right dev?
	jne	oscl8		;no
	mov	si,ss:actdir[bp] ;yes, get LD: base
	cmp	si,ds:savdir	;is it the input one?
	jne	oscl8
	cmp	ds:iptr1,bx	;is file after here?
	jb	oscl8
	add	ds:iptr1,di	;update
oscl8:	; slide rest of dir down to make space for new entry
	mov	si,ds:dirsiz	;point past end of dir
	add	ds:dirsiz,di	;(update)
	mov	cx,si		;find # bytes to move
	sub	cx,bx
	shr	cx,1		;/2=wc
	dec	si		;pt at last word
	dec	si
	add	di,si		;point past new end
	push	ds		;save
	push	es		;copy ES to DS
	pop	ds
	std			;move backwards
	rep	movsw		;copy
	cld			;restore
	neg	ax		;find negative size of extra space
	and	ah,7777/400
	mov	[di+4],ax	;save smaller size in new area (if any)
	pop	ds		;restore
	; write new file entry
	mov	di,bx		;point at file entry
	mov	si,offset rtfile
	movsw			;copy filename
	movsw
	movsw
	movsw			;extension
	cmp	ds:dirent,5*2	;are there any info words?
	je	oscl10		;no
	; write date in first info word
	xor	ax,ax		;init to 0
	cmp	ds:fdatf,al	;do we know date?
	jz	oscl9		;no, leave it as 0 (=unknown)
	; convert date to OS/8 disk format (MMMMDDDDDYYY, YYY=MOD(YEAR-1970,8))
	mov	dx,ds:fyear	;get year
	sub	dx,1970d	;subtract base
	jnc	$+4
	 xor	dl,dl		;can't go earlier than 1970.
	and	dl,7		;isolate
	mov	al,ds:fday	;get day
	mov	cl,3		;bit count
	sal	al,cl		;shift into place
	or	al,dl		;OR in year offset
	mov	ah,ds:fmonth	;get month
oscl9:	stosw			;save
	mov	cx,ds:dirent	;get total dir entry size
	sub	cx,6*2		;subtract out filename, 1st info word, length
	xor	al,al		;load 0
	rep	stosb		;nuke out rest of info words (or not if CX=0)
oscl10:	mov	ax,10000	;-size
	sub	ax,ds:owrtn
	and	ah,7777/400	;trim in case 0
	stosw
	push	ds		;copy DS to ES
	pop	es
	callr	oswdir		;write dir back, return
;+
;
; Delete most recently DIRGETted file.  Called through SS:DELFIL[BP].
;
;-
osdl:	mov	al,ds:oinseg	;get old input seg #
	cbw			;AH=0 (really get it)
	call	osseg		;read it
	mov	ax,10000	;find positive # info words
	sub	ax,[si+8d]
	and	ah,7777/400	;may be 0
	add	ax,ax		;*2
	add	ax,5*2		;add in filename, extension, length
	mov	ds:dirent,ax	;save length in bytes
	mov	ds:ossdrt[si],1	;mark seg buf as dirty
	mov	bx,ds:oinent	;get offset
	lea	di,[bx+si]	;point at begn of file entry
	add	bx,ds:dirent	;point at whatever follows this entry
	mov	cx,256d*2+1	;block length, +1 (for length word)
	sub	cx,bx		;find # words to copy (include length word)
	lea	si,[bx+si-2]	;point at length word of this entry
	shr	cx,1		;word count
	xor	ax,ax		;mark this entry as .EMPTY.
	stosw
	rep	movsw		;copy length word, rest of segment
	cmp	ds:inent,cx	;at end of dir?
	js	osdl1		;yes, we're done
	; relocate INENT if still in this segment
	mov	al,ds:oinseg	;get seg # we're messing with
	cmp	al,ds:inseg	;still current seg even after DIRGET?
	jne	osdl1		;no, relax
	mov	ax,ds:dirent	;get size of file entry
	sub	ax,2*2		;subtract size of .EMPTY. we changed it to
	sub	ds:inent,ax	;back up INENT by the difference
osdl1:	ret
;+
;
; Read entire OS/8 directory into BIGBUF.
;
; ss:bp	log dev rec
; cx	returns length in bytes of dir read
;	(also recorded in DIRSIZ)
; DS:DIRENT  records length of file entry
;
; If the input file is on this volume, INPTR and IPTR1 are set to point at the
; file described by INDEV/SAVDIR+0/INSEG/INENT.  Same goes for OUTPTR and OPTR1
; based on OUTDEV/SAVDIR+2/OUTSEG/OUTENT.
;
;-
osrdir:	; init, load first seg
	xor	ax,ax		;load 0
	mov	ds:inptr,ax	;say files not yet found
	mov	ds:outptr,ax
	inc	ax		;get segment #1
	mov	ds:dirseg,al	;save
	call	osseg		;read it (AH=0)
	cmp	ds:bigsiz+2,0	;make sure buf can hold the whole dir
	jnz	ordr1		;definitely
	cmp	ds:bigsiz,5*2	;big enough for header?
	jb	ordr4
ordr1:	; copy 5-word header into BIGBUF
	mov	es,ds:bigbuf	;pt at buffer
	xor	di,di		;pt at begn
	mov	cx,5		;copy first 5 words
	rep	movsw		;go
	sub	si,5*2		;correct ptr
	mov	ax,10000	;find positive # info words
	sub	ax,[si+8d]
	and	ah,7777/400	;may be 0
	add	ax,ax		;*2
	add	ax,5*2		;add in filename, extension, length
	mov	ds:dirent,ax	;save length in bytes
ordr2:	; process next seg -- set up ptr to detect falling off end
	mov	bx,si		;copy
	neg	bx		;make negative for LEA later
	mov	ax,10000	;find positive # entries
	sub	ax,[si]
	and	ax,7777		;isolate, see if zero
	jz	ordr3		;zero, skip
	mov	ds:dircnt,ax	;save
	add	si,5*2		;pt past header
	lea	dx,[di+1000-12]	;-12 for header
	jmp	short ordr6
ordr3:	jmp	ordr11		;null segment, skip
ordr4:	jmp	nomem		;out of memory
ordr5:	jmp	baddir		;corrupt directory
ordr6:	; check next entry
	; SI=input ptr, DI=output ptr, BX=-<base of seg buf>, DX=max DI value
	; see if this is the current input entry
	cmp	bp,ds:indev	;is it the right dev?
	jne	ordr7		;no
	mov	ax,ss:actdir[bp] ;yes, get LD: base
	cmp	ax,ds:savdir	;is it the input one?
	jne	ordr7
	mov	al,ds:dirseg	;yes, get curr seg
	cmp	al,ds:inseg	;is it the curr input one too?
	jne	ordr7
	lea	ax,[bx+si]	;get relative ptr
	cmp	ax,ds:inent	;is this the input entry?
	jne	ordr7
	mov	ds:inptr,di	;save
ordr7:	; see if this is the current output entry
	cmp	bp,ds:outdev	;is it the right dev?
	jne	ordr8		;no
	mov	ax,ss:actdir[bp] ;yes, get LD: base
	cmp	ax,ds:savdir+2	;is it the output one?
	jne	ordr8
	mov	al,ds:dirseg	;yes, get curr seg
	cmp	al,ds:outseg	;is it the curr output one too?
	jne	ordr8
	lea	ax,[bx+si]	;get relative ptr
	cmp	ax,ds:outent	;is this the output entry?
	jne	ordr8
	mov	ds:outptr,di	;save
ordr8:	; copy dir entry
	mov	cx,4		;assume .EMPTY.
	cmp	word ptr [si],0	;is it?
	jz	ordr9		;yes
	 mov	cx,ds:dirent	;no, get length
ordr9:	mov	ax,di		;copy output ptr
	add	ax,cx		;what it will be if we do it
	cmp	di,dx		;space for a file entry?
	jae	ordr5		;no, invalid dir
	cmp	ds:bigsiz+2,0	;make sure we have space
	jnz	ordr10		;definitely
	cmp	ds:bigsiz,ax
	jb	ordr4		;no
ordr10:	shr	cx,1		;bc/2=wc
	rep	movsw		;copy
	dec	ds:dircnt	;done all in seg?
	jnz	ordr6		;loop if not
ordr11:	; end of segment
	neg	bx		;flip bx back
	mov	ax,[bx+4]	;get next dir seg
	test	ax,ax		;end?
	jz	ordr12
	mov	ds:dirseg,al	;update curr seg #
	push	di		;save
	push	es
	push	ds		;copy DS to ES
	pop	es
	cbw			;AH=0 (really read)
	call	osseg		;get next seg
	pop	es		;restore
	pop	di
	jmp	ordr2		;loop
ordr12:	mov	ds:dirsiz,di	;save
	push	ds		;restore ES
	pop	es
	mov	cx,di		;get length
	ret
;+
;
; Write entire OS/8 directory from BIGBUF (read by OSRDIR).
;
; ss:bp	log dev rec
; DS:DIRSIZ  gives size of dir in bytes
;
;-
oswdir:	mov	es,ds:bigbuf	;pt at buf
	; count up # segments needed to check for overflow
	mov	si,5*2		;point at first file
	mov	dl,1		;init segment
	xor	cx,cx		;nothing to add on first pass
oswd1:	mov	bx,5*2		;hypothetical posn in output segment
	add	bx,cx		;add curr file entry
oswd2:	cmp	si,ds:dirsiz	;at end of dir?
	je	oswd4		;yes, done
	mov	cx,2*2		;assume .EMPTY.
	cmp	word ptr es:[si],0 ;is it?
	jz	oswd3		;skip if so
	 mov	cx,ds:dirent
oswd3:	add	si,cx		;eat the entry
	add	bx,cx		;(pretend to) add to current segment
	cmp	bx,256d*2	;off end?
	jbe	oswd2		;no, loop
	inc	dx		;bump to new segment
	cmp	dl,6		;overflowed 6 segments?
	jbe	oswd1		;loop if not
	jmp	dirful		;dir is full
oswd4:	mov	byte ptr ds:dirseg,1 ;number of first dir seg
	mov	si,5*2		;pt past header
	mov	word ptr es:0,10000 ;init -(# entries)
	mov	word ptr es:4,0	;no next
	mov	word ptr es:6,0	;no tentative file
	push	ds		;restore ES
	pop	es
oswd5:	; copy next segment
	push	si		;save BIGBUF ptr
	mov	al,ds:dirseg	;seg #
	mov	ah,1		;alloc buf but don't read from disk
	call	osseg		;get buf
	mov	ds:ossdrt[si],1	;mark dirty
	mov	di,si		;copy ptr
	mov	bx,si		;save start of segment
	mov	ds,ds:bigbuf	;pt into buf
	; copy initial header
	xor	si,si		;get header from first 5 words
	mov	cx,5		;word count
	rep	movsw		;copy
	pop	si		;restore BIGBUF ptr
oswd6:	; copy next dir entry
	cmp	si,cs:dirsiz	;done?
	je	oswd10		;yes
	lea	ax,[bx+(256d*2)] ;point past end of segment buf
	mov	cx,2*2		;assume 2 words
	cmp	word ptr [si],0	;.EMPTY.?
	jz	oswd7		;yes, only two words
	 mov	cx,cs:dirent	;get dir entry size
oswd7:	sub	ax,cx		;back up
	cmp	di,ax		;will it fit?
	ja	oswd11		;no
	; see if this is the current input entry
	cmp	bp,cs:indev	;is it the right dev?
	jne	oswd8		;no
	mov	ax,ss:actdir[bp] ;get active LD:
	cmp	ax,ds:savdir	;is it the input one?
	jne	oswd8
	cmp	si,cs:iptr1	;yes, does ptr match?
	jne	oswd8
	mov	al,cs:dirseg	;save current dir seg
	mov	cs:inseg,al
	mov	ax,di		;save relative ptr
	sub	ax,bx
	mov	cs:inent,ax
oswd8:	; see if this is the current output entry
	cmp	bp,cs:outdev	;is it the right dev?
	jne	oswd9		;no
	mov	ax,ss:actdir[bp] ;get active LD:
	cmp	ax,ds:savdir+2	;is it the input one?
	jne	oswd9
	cmp	si,cs:optr1	;yes, does ptr match?
	jne	oswd9
	mov	al,cs:dirseg	;save current dir seg
	mov	cs:outseg,al
	mov	ax,di		;save relative ptr
	sub	ax,bx
	mov	cs:outent,ax
oswd9:	; copy dir entry
	shr	cx,1		;word count
	rep	movsw		;copy
	dec	word ptr es:[bx] ;update # entries in seg
	mov	ax,10000	;find positive size
	sub	ax,[si-2]
	and	ah,7777/400	;trim in case 0
	add	ds:2,ax		;update starting block #
	jmp	oswd6
oswd10:	; end of dir
	push	es		;restore ds
	pop	ds
	ret
oswd11:	; segment is full, chain to next
	push	es		;restore ds
	pop	ds
	inc	ds:dirseg	;bump seg #
	mov	al,ds:dirseg	;fetch it
	mov	[bx+4],al	;set link ptr
	jmp	oswd5		;loop
;+
;
; Get OS/8 dir segment.
;
; al	segment #
; ah	NZ to return buf but don't read if not cached (going to write it)
; ss:bp	log dev rec
;
; Returns ptr in SI.
;
;-
osseg:	test	al,al		;make sure valid
	jz	ossg2
	cmp	al,6		;must be in [1,6]
	ja	ossg2
	mov	dl,ah		;save flag
	cbw			;AH=0
	add	ax,ss:actdir[bp] ;add base of current LD: file (or 0 if none)
ossegb:	; enter here with AX=starting blk #, DL=flag
	mov	si,ss:dirbuf[bp] ;head of buffer chain
	xor	bx,bx		;no prev
	cmp	ds:ossblk[si],bx ;is this our first buf request?
	jz	ossg9		;yes, use our pre-alloced buf
ossg1:	; see if we already have it
	cmp	ax,ds:ossblk[si] ;is this it?
	je	ossg3		;yes, relink and return
	mov	cx,ds:ossnxt[si] ;get ptr to next
	jcxz	ossg5		;none, need to read it
	mov	bx,si		;save for linking
	mov	si,cx		;follow link
	jmp	short ossg1	;keep looking
ossg2:	jmp	baddir
ossg3:	; found it
	test	bx,bx		;is it first in line?
	jz	ossg4		;yes, no need to relink
	mov	ax,si		;pt at it
	xchg	ax,ss:dirbuf[bp] ;get head of chain, set new head
	xchg	ax,ds:ossnxt[si] ;link rest of chain to head
	mov	ds:ossnxt[bx],ax ;unlink the one we just moved
ossg4:	ret
ossg5:	; we don't have it, try to allocate a new buffer
	push	si		;save
	mov	cx,osslen	;# bytes
	call	askmem		;ask for a buffer
	pop	di		;[catch ptr to last buf in chain]
	jnc	ossg8		;got it, read the buf in
	mov	si,di		;restore
	; failed, write out the last one
	test	bx,bx		;is there a penultimate buffer?
	jz	ossg6		;no
	mov	ds:ossnxt[bx],0	;yes, unlink final buffer from it
	jmp	short ossg7
ossg6:	mov	ss:dirbuf[bp],bx ;this is the only one, unlink it
ossg7:	push	ax		;save blk
	push	dx		;and flag
	call	osfseg		;flush it
	pop	dx		;restore
	pop	ax
ossg8:	; link buf in as first
	mov	bx,si		;copy ptr
	xchg	bx,ss:dirbuf[bp] ;get current chain, set new head
	mov	ds:ossnxt[si],bx ;link it on
ossg9:	; buf is linked in at head of chain -- SI=buf, AL=seg to read, AH=flag
	mov	ds:ossblk[si],ax ;set blk #
	mov	ds:ossdrt[si],0	;buf is clean
	test	dl,dl		;should we read it?
	jnz	ossg10		;no, all we wanted was the buf
	xor	dx,dx		;high word=0
	mov	cx,1		;read 1 blk
	mov	di,si		;point at buffer
	push	si		;save
	call	ss:rdblk[bp]	;go
	pop	si		;[restore]
	jc	ossg11		;err
	mov	ax,10000	;12-bit negate
	sub	ax,[si+8d]	;get # info words per dir entry
	and	ah,7777/400	;may be 0
	sal	ax,1		;change to # bytes
	mov	ss:extra[bp],ax
ossg10:	ret
ossg11:	jmp	dirio
;+
;
; Flush OS/8 dir segment buffer, if dirty.
;
; ss:bp	dev rec
; ds:si	ptr to buffer (preserved on exit)
;
;-
osfseg:	cmp	ds:ossdrt[si],0	;is buf dirty?
	jz	osfsg1		;no
	mov	ax,ds:ossblk[si] ;get blk #
	xor	dx,dx		;high word=0
	mov	cx,1		;1 blk/seg
	push	si		;save
	call	ss:wrblk[bp]	;go
	pop	si		;[restore]
	jc	osfsg2		;err
osfsg1:	ret
osfsg2:	jmp	dirio
;
	subttl	random utility routines
;+
;
; Read a line from the keyboard into LBUF.
;
; si,cx	returns descriptor of line
;
;-
gtlin:	mov	al,ds:lmax	;reset **MORE** count
	mov	ds:lnum,al
	mov	di,offset lbuf	;pt at buffer
	test	ds:indhnd,-1	;is there an indirect file open?
	jns	gtln1		;yes, use it instead of keyboard
	mov	dx,offset kbbuf	;pt at buffer
	mov	ah,0Ah		;func=read line
	int	21h		;do it
	mov	dl,lf		;echo lf (DOS didn't)
	mov	ah,02h		;func=CONOUT
	int	21h
	mov	si,offset kbbuf+1 ;pt at length
	lodsb			;get length
	cbw			;AH=0
	mov	cx,ax		;copy length
	mov	bx,di		;copy buf ptr
	rep	movsb		;copy the line into LBUF
	mov	si,bx		;point at it
	mov	cx,ax		;get length
	ret
gtln1:	; reading from indirect file, get next line
	mov	cx,ds:indctr	;get # bytes left in buf
	jcxz	gtln4		;none, refill buffer
	mov	si,ds:indptr	;get buf ptr
gtln2:	lodsb			;get a byte
	cmp	al,cr		;carriage return?
	je	gtln3		;ignore if so
	cmp	al,lf		;end of line?
	je	gtln5		;yes
	cmp	di,offset lbuf+80d ;buf full?
	je	gtln3
	 stosb			;save in LBUF if it will fit
gtln3:	loop	gtln2		;loop
gtln4:	; refill file buf
	mov	dx,offset indbuf ;point at buf
	mov	si,dx		;rewind si too
	mov	cx,indsiz	;size of buf
	mov	bx,ds:indhnd	;handle
	mov	ah,3Fh		;func=read
	int	21h
	jc	gtln6
	mov	cx,ax		;copy length
	test	ax,ax		;end of file?
	jnz	gtln2		;no, back into loop
	mov	ah,3Eh		;func=close
	int	21h
	mov	ds:indhnd,-1	;mark as closed
	cmp	di,offset lbuf	;had we read a partial line?
	je	gtlin		;no, get one from the keyboard
gtln5:	; process line
	dec	cx		;count the LF (or not if EOF)
	mov	ds:indptr,si	;save
	mov	ds:indctr,cx
	mov	cx,di		;get current ptr
	mov	si,offset lbuf	;point at begn of line
	sub	cx,si		;find length
	mov	dx,si		;point at it
	mov	bx,0001h	;handle=STDOUT
	mov	ah,40h		;func=print
	int	21h		;no point in worrying about errors
	mov	dl,cr		;echo <CRLF>
	mov	ah,02h
	int	21h
	mov	dl,lf
	mov	ah,02h
	int	21h
	ret
gtln6:	; "@" file read error
	mov	ah,3Eh		;func=close
	int	21h
	mov	ds:indhnd,-1	;mark as closed
	cram	'?Indirect file read error',error
;+
;
; Ask user if they're sure (abort if not).
;
;-
aysure:	cram	'Are you sure (Y/N)? ',wrng
	call	gtlin		;read a line
	call	getw		;get their answer
	jc	aysure		;if any
	cmp	byte ptr [bx],'Y' ;does it start with 'Y'?
	jne	$+3
	 ret
	cram	'?Command canceled',error
;+
;
; Wait for user to press ENTER.
;
;-
prsent:	cram	'Press ENTER when ready...',wrng
prsen1:	mov	ah,08h		;func=unbuffered input
	int	21h
	cmp	al,cr		;cr?
	jne	prsen1		;loop until it is (or ^C)
	mov	dx,offset crlfs	;pt at string
	mov	cx,2		;length
	mov	bx,0002h	;handle=STDERR
	mov	ah,40h		;func=write
	int	21h
	ret
;+
;
; Get response to yes-or-no question.
;
; Return CF=0 on 'Y', CF=1 on anything else.
;
;-
yorn:	call	gtlin		;read a line
	call	getw		;get their answer
	jc	yorn1		;if any
	cmp	byte ptr [bx],'Y' ;does it start with 'Y'?
	je	yorn1
	 stc
yorn1:	ret
;+
;
; Cram in-line string into output buf.
;
;-
cram1:	mov	cx,si		;save si
	pop	si		;restore source ptr
	lodsb			;get length
	cbw			;AH=0
	xchg	cx,ax		;copy length, get original SI
	rep	movsb		;copy string
	xchg	ax,si		;OK, now restore SI
	jmp	ax		;return
;+
;
; Convert byte (AL) to decimal in output buf (ES:DI).
;
;-
pbyte:	cmp	al,10d		;small enough to just print?
	jb	pbyte1
	aam			;no, split it
	push	ax		;save remainder
	mov	al,ah		;get quotient
	call	pbyte		;recurse
	pop	ax		;restore
pbyte1:	or	al,'0'		;convert to decimal
	stosb			;save
	ret
;+
;
; Convert word (AX) to decimal in output buf (ES:DI).
;
;-
pnum:	mov	bx,10d		;divisor
pnum1:	cmp	ax,bx		;small enough to just print?
	jb	pnum2
	xor	dx,dx		;0-extend
	div	bx		;divide
	push	dx		;save remainder
	call	pnum1		;recurse
	pop	ax		;restore
pnum2:	or	al,'0'		;convert
	stosb
	ret
;+
;
; Convert doubleword (DX:AX) to decimal in output buf (ES:DI).
;
;-
pdnum:	mov	bx,10d		;radix
pdnum1:	test	dx,dx		;anything in high-order?
	jnz	pdnum2		;yes
	cmp	ax,bx		;small enough to just print?
	jb	pdnum3		;yes, skip all this
pdnum2:	mov	cx,ax		;copy out of the way
	mov	ax,dx		;copy high order
	xor	dx,dx		;zero-extend
	div	bx		;AX=high word of quotient, DX=rem
	xchg	ax,cx		;get low word of dividend
	div	bx		;AX=low word of quotient, DX=rem
	push	dx		;save remainder
	mov	dx,cx		;DX:AX=quotient
	call	pdnum1		;recurse
	pop	ax		;restore
pdnum3:	or	al,'0'		;convert to digit
	stosb			;save
	ret
;+
;
; Convert CX-digit word (AX) to octal in output buf (ES:DI).
;
;-
poct:	add	di,cx		;move to end of buf
	mov	bx,di		;copy
poct1:	mov	dl,al		;get digit
	and	dl,7
	or	dl,'0'		;convert to ASCII
	dec	bx		;store
	mov	[bx],dl
	shr	ax,1		;/8
	shr	ax,1
	shr	ax,1
	loop	poct1		;loop
	ret
;+
;
; Convert number to decimal, right-justified.
;
; dx:ax	number to print
; cx	size of field
; di	pts to buffer
;
;-
cnum:	mov	bl,al		;save
	mov	al,' '		;load blank
	rep	stosb		;fill field
	mov	al,bl		;restore
	mov	si,di		;copy ptr
cnum1:	cmp	dx,9d		;number .le. 655359?
	jbe	cnum4		;yes, goody (use hardware divide)
	; result won't fit in 16 bits (quo.le.65535, rem.le.9)
	; do the division in software
	; (I wrote this routine long before realizing that it can be easily
	; done as long division with two DIVs since the divisor still fits in
	; 16 bits)
	xor	bl,bl		;init rem
	mov	cx,32d		;bit count
cnum2:	shl	ax,1		;shift
	rcl	dx,1		;into dx
	rcl	bl,1		;into bl
	cmp	bl,10d		;will it fit?
	jb	cnum3		;no
	sub	bl,10d		;yes
	inc	ax		;shift in a 1
cnum3:	loop	cnum2		;loop
	or	bl,'0'		;convert to ascii
	dec	si		;-1
	mov	[si],bl		;put in buf
	jmp	short cnum1	;loop
cnum4:	mov	cl,10d		;load a 10
cnum5:	div	cx		;divide
	or	dl,'0'		;convert to ascii
	dec	si		;-1
	mov	[si],dl		;put in buf
	xor	dx,dx		;DX=0
	test	ax,ax		;anything left?
	jnz	cnum5		;yes, loop
	ret
;+
;
; Print the time in FHOUR, FMIN, FSEC (unless negative).
;
;-
ptime:	mov	bx,"00"		;we'll need this
	mov	al,ds:fhour	;get hour
	aam			;split digits
	xchg	al,ah		;><
	or	ax,bx		;make ASCII
	stosw			;save
	mov	al,':'		;:
	stosb
	mov	al,ds:fmin	;minute
	aam
	xchg	al,ah
	or	ax,bx
	stosw
	mov	al,':'		;:
	stosb
	mov	al,ds:fsec	;second
	test	al,al		;negative?
	js	ptime1		;yes, file system doesn't support seconds
	aam			;OK, go ahead
	xchg	al,ah
	or	ax,bx
	stosw
	ret
ptime1:	dec	di		;unput the ':'
	ret
;+
;
; Print the date in FYEAR, FMONTH, FDAY.
;
;-
pdate:	mov	ax,word ptr ds:fday ;get month,,day
	mov	dx,ds:fyear
pdate1:	; use DX=year, AH=month, AL=day
	mov	bl,ah		;save month
	aam			;split the digits
	xchg	al,ah		;><
	or	ax,"00"		;convert
	stosw			;save
	mov	al,'-'		;-
	stosb
	mov	al,bl		;copy month
	add	al,bl		;*2
	add	al,bl		;*3
	cbw			;AH=0
	add	ax,offset months ;pt at table
	mov	si,ax		;with si
	movsw			;2 bytes
	movsb			;3rd
	mov	al,'-'		;-
	stosb
	mov	ax,dx		;get year
	callr	pnum		;print, return
;+
;
; Print a logical device name.
;
; bp	dev rec
; di	buffer (updated on exit)
;
;-
pdev:	mov	ax,ss:logd[bp]	;get name
	mov	bx,ss:logu[bp]	;and unit info
	test	al,al		;got a 1st letter?
	jz	$+3
	 stosb			;yes
	mov	[di],ah		;save 2nd (or only) letter
	inc	di
	test	bh,bh		;is there a unit #?
	jz	pdev1
	mov	al,bl		;yes, get it
	call	pbyte		;convert
pdev1:	mov	al,':'		;:
	stosb
	ret
;+
;
; Print volume name.
;
;-
pvol:	mov	di,offset lbuf	;pt at buf
	call	flush		;blank line
	cram	' Volume in drive '
	call	pdev		;print dev name
	dec	di		;unput ':'
	call	ss:volnam[bp]	;print vol name
	callr	flush		;print line, return
;+
;
; Print name corresponding to a value.
;
; bx	value to look up
; si	pointer to list of:
;	DW value
;	DB length,'string'
;	list must contain all possible values (otherwise will run off end)
; di	buffer (updated on exit)
;
;-
pname:	lodsw			;get an entry
	cmp	ax,bx		;is this it?
	lodsb			;[get length]
	cbw			;[zero extend, they're all <128]
	je	pname1		;this is it
	add	si,ax		;skip it
	jmp	short pname
pname1:	mov	cx,ax		;copy
	rep	movsb		;copy string into buffer
	ret
;
symnam	macro	sym,nam		;;define record giving symbol and its name
	local	a,b
	dw	&sym
a	db	b,&nam
b=	$-a-1
	endm
;
fsynam	label	byte
	symnam	frgn,'FOREIGN'
	symnam	cos310,'COS310'
	symnam	os8,'OS/8'
	symnam	rsts,'RSTS/E'
	symnam	rt11,'RT-11'
;
devnam	label	byte
	symnam	mscp,'MSCP'	;arbitrary block image
	symnam	ra60,'RA60'
	symnam	ra70,'RA70'
	symnam	ra71,'RA71'
	symnam	ra72,'RA72'
	symnam	ra73,'RA73'
	symnam	ra80,'RA80'
	symnam	ra81,'RA81'
	symnam	ra82,'RA82'
	symnam	ra90,'RA90'
	symnam	ra92,'RA92'
	symnam	rk02,'RK02'
	symnam	rk05,'RK05'
	symnam	rk06,'RK06'
	symnam	rk07,'RK07'
	symnam	rl01,'RL01'
	symnam	rl02,'RL02'
	symnam	rs03,'RS03'
	symnam	rs04,'RS04'
	symnam	rx01,'RX01'
	symnam	rx02,'RX02'
	symnam	rx03,'RX03'
	symnam	rx23,'RX23'
	symnam	rx24,'RX24'	;PC-style 720KB disks
	symnam	rx26,'RX26'
	symnam	rx31,'RX31'	;PC-style 360KB disks
	symnam	rx33,'RX33'
	symnam	rx50,'RX50'
	symnam	rx52,'RX52'	;(my name for it)
	symnam	tu56,'TU56'
	symnam	tu58,'TU58'
;+
;
; Flush output line buffer.
;
; es:di	pointer into LBUF (reset on return)
;
; Preserves SI.
;
;-
flush:	mov	ax,crlf		;<CRLF>
	stosw
flush1:	; no <CRLF>
	push	si		;save
	dec	ds:lnum		;dec line #
	jnz	flush2		;no **MORE**
	mov	al,ds:lmax	;get starting #
	mov	ds:lnum,al	;reset
	test	byte ptr ds:more,-1 ;is **MORE** processing enabled?
	jz	flush2		;no, skip all this
	call	wrng		;say **MORE**
	db	8d,'**MORE**'
	mov	ah,07h		;func=direct console input
	int	21h
	push	ax		;save char
	call	wrng		;no more
	db	10d,cr,8d dup(' '),cr ;blank out the **MORE**
	pop	ax		;restore char
	cmp	al,3		;^C?
	je	flush3		;enough of that
	cmp	al,'Q'		;quit?
	je	flush3
	cmp	al,'q'
	je	flush3
	cmp	al,cr		;CR?
	jne	flush2
	 mov	byte ptr ds:lnum,1 ;lset just 1 line through
flush2:	mov	dx,offset lbuf	;pt at buffer
	mov	cx,di		;calc length
	sub	cx,dx
	mov	bx,0001h	;STDOUT
	mov	ah,40h		;func=write
	int	21h
	pop	si		;restore
	mov	di,offset lbuf	;often needed
	ret
flush3:	jmp	mloop		;restart (flush stack)
;
synerr:	cram	'?Syntax error',error
badswt:	cram	'?Bad switch',error
swtcon:	cram	'?Switch conflict',error
nomem:	cram	'?Insufficient memory',error
misprm:	cram	'?Missing parameter',error
baddrv:	cram	'?No such drive',error
notrdy:	cram	'?Device not ready',error
;badmed:	cram	'?Illegal medium type for that device',error
badnam:	cram	'?Invalid filename',error
outran:	cram	'?Number out of range',error
fnf:	cram	'?File not found',error
dnf:	cram	'?Dir not found',error
dirio:	cram	'?Dir I/O error',error
baddir:	cram	'?Corrupt directory',error
dirful:	cram	'?Directory full',error
delerr:	cram	'?Error deleting file',error
rderr:	cram	'?Read error',error
wrerr:	cram	'?Write error',error
crerr:	cram	'?File creation error',error
iosame:	cram	'?Input and output are same device',error
notflp:	cram	'?Floppy devices required for sector copy',error
prtfil:	cram	'?Output file is protected',error
odfull:	cram	'?Output device full',error
odsmal:	cram	'?Output device too small',error
rodev:	cram	'?Output device is read only',error
lngnam:	cram	'?Filespec too long',error
unksys:	cram	'?Unable to identify file system',error
ilfunc:	cram	'?Illegal function for FOREIGN volume',error
nowipe:	cram	'?WIPEOUT not supported for this file system',error
;+
;
; Error handler.
;
;-
error:	push	ds		;restore ES if changed
	pop	es
	pop	si		;restore
	lodsb			;get length
	cbw			;AH=0
	mov	cx,ax		;copy string to buffer
	mov	di,offset lbuf
	mov	dx,di		;copy ptr
	rep	movsb
	mov	ax,crlf		;<CRLF>
	stosw
	mov	cx,di		;find length
	sub	cx,dx
	mov	bx,0002h	;handle=STDERR
	mov	ah,40h		;func=write
	int	21h
	jmp	mloop		;go flush stack and restart
;+
;
; Warning handler.
;
;-
wrng:	pop	si		;restore
	lodsb			;get length
	cbw			;AH=0
	mov	dx,si		;addr
	mov	cx,ax		;copy length
	add	si,cx		;skip string
	mov	bx,0002h	;handle=STDERR
	mov	ah,40h		;func=write
	int	21h
	jmp	si		;return
;+
;
; Look up a word on a table.
;
; Each entry on the table is the word to match, followed by the word to
; return on a match.  List is terminated by DW 0.
;
; bx	word to find
; si	table
;
; Word from table is returned in ax unless CF=1, in which case no match was
; found.
;
;-
wdluk:	lodsw			;get a word
	test	ax,ax		;end?
	jz	wdluk1
	cmp	ax,bx		;match?
	lodsw			;[get next word]
	jne	wdluk		;no
	ret
wdluk1:	stc			;error
	ret
;+
;
; Parse a word from the input line.
;
; ds:si	current position
; cx	# chars left
;
; On return:
; si	points at posn after last char of word
; cx	updated
; bx	points at begn of word if CF=0
; dx	length of word
;
;-
getw:	jcxz	getw2		;EOL already
getw1:	mov	bx,si		;in case word starts here
	lodsb			;get a char
	cmp	al,' '		;blank or ctrl?
	ja	getw4		;no
	loop	getw1		;loop
getw2:	stc			;no luck
	ret
getw3:	lodsb			;get a char
getw4:	cmp	al,' '		;blank or ctrl?
	jbe	getw6		;yes, end of word
	cmp	al,ds:swchar	;/
	je	getw6
	cmp	al,'='		;=
	je	getw6
if 0
	cmp	al,'<'		;<
	je	getw6
endif
	cmp	al,'a'		;lower case?
	jb	getw5
	cmp	al,'z'		;hm?
	ja	getw5
	and	al,not 40	;yes, convert
	mov	[si-1],al	;put back
getw5:	loop	getw3		;loop
	inc	si		;compensate for next inst
getw6:	dec	si		;unget
	mov	dx,si		;calc length
	sub	dx,bx		;CF=0
	ret
;+
;
; As above but stops at first nonalphanumeric char.
;
;-
getan:	jcxz	getw2		;EOL already
getan1:	mov	bx,si		;in case word starts here
	lodsb			;get a char
	cmp	al,' '		;blank or ctrl?
	ja	getan4		;no
	loop	getan1		;loop
getan2:	stc			;no luck
	ret
getan3:	lodsb			;get a char
getan4:	cmp	al,'0'		;digit?
	jb	getan6		;no, end of word
	cmp	al,'9'
	jbe	getan5		;yes, keep it
	cmp	al,'A'		;upper case letter?
	jb	getan6		;no
	cmp	al,'Z'
	jbe	getan5		;yes, keep it
	cmp	al,'a'		;lower case letter?
	jb	getan6		;no
	cmp	al,'z'
	ja	getan6
	and	al,not 40	;yes, convert
	mov	[si-1],al	;put back
getan5:	loop	getan3		;loop
	inc	si		;compensate for next inst
getan6:	dec	si		;unget
	mov	dx,si		;calc length
	sub	dx,bx		;CF=0
	ret
;+
;
; Parse an octal number from the input line.
;
; si,cx	input line descriptor (updated on return)
; dx:ax	returns number
;
;-
geto:	call	getw		;parse it
	jc	cvtn3
cvto:	; enter here to parse number from GETW
	mov	di,dx		;get length
	push	si		;save
	mov	si,bx		;point at it
	xor	bx,bx		;init #
	xor	dx,dx		;high word
cvto1:	lodsb			;get a digit
	sub	al,'0'		;convert to binary
	cmp	al,7		;digit?
	ja	cvtn2
	push	cx		;save
	mov	cl,3		;shift count
	sal	dx,cl		;make space in high word
	rol	bx,cl		;rotate low word
	pop	cx		;restore
	mov	ah,bl		;get 3 bits that belong in high word
	and	ah,7		;isolate
	or	dl,ah		;put them in
	and	bl,not 7	;remove
	or	bl,al		;OR in new digit
	dec	di		;done all?
	jnz	cvto1		;loop if not
	mov	ax,bx		;copy number
	pop	si		;restore
	ret
;+
;
; Parse a decimal number from the input line.
;
; si,cx	input line descriptor (updated on return)
; dx:ax	returns number
;
;-
getn:	call	getw		;parse it
	jc	cvtn3
cvtn:	; enter here to parse number from GETW
	mov	di,dx		;get length
	push	si		;save
	mov	si,bx		;point at it
	xor	bx,bx		;init #
	xor	dx,dx		;high word
cvtn1:	lodsb			;get a digit
	sub	al,'0'		;convert to binary
	cmp	al,9d		;digit?
	ja	cvtn2
	cbw			;AH=0
	push	ax		;save new digit
	mov	ax,10d		;multiplier
	mul	dx		;high word *10
	test	dx,dx		;overflow?
	jnz	cvtn2
	push	ax		;save
	mov	ax,10d		;low word *10
	mul	bx
	pop	bx		;catch high word
	add	dx,bx		;add it in
	pop	bx		;catch new digit
	add	bx,ax		;add it in
	adc	dx,0
	jc	cvtn2		;overflow
	dec	di		;done all?
	jnz	cvtn1		;loop if not
	mov	ax,bx		;copy number
	pop	si		;restore
	ret
cvtn2:	; these two labels are ref'ed from above and below too
	cram	'?Bad number',error
cvtn3:	cram	'?Missing number',error
;+
;
; Parse a hex number from the input line.
;
; si,cx	input line descriptor (updated on return)
; ax	returns number
;
;-
geth:	call	getw		;parse it
	jc	cvtn3
cvth:	; enter here to parse number from GETW
	push	cx		;save
	mov	di,dx		;get length
	xor	dx,dx		;init #
	mov	cl,4		;shift count
	mov	al,[bx+di-1]	;get last char
	and	al,not 40	;convert to U.C. if letter
	cmp	al,'H'		;trailing H?
	jne	cvth1		;no
	dec	di		;yes, count it
	jz	cvtn2		;nothing left, complain
cvth1:	mov	al,[bx]		;get a digit
	inc	bx
	sub	al,'0'		;convert to binary
	cmp	al,9d		;digit?
	jbe	cvth2
	sub	al,'A'-('9'+1)+10d ;no, see if in A-F
	cmp	al,5
	ja	cvtn2		;no, bad number
	add	al,0Ah		;convert back to 0A-0F
cvth2:	cbw			;AH=0
	test	dh,0F0h		;is there space for another digit?
	jnz	cvtn2
	sal	dx,cl		;yes, slide over
	or	dl,al		;OR in new digit
	dec	di		;done all?
	jnz	cvth1		;loop if not
	mov	ax,dx		;copy number
	pop	cx		;restore
	ret
;+
;
; Look up a keyword in a table.
;
; ds:bx	keyword } from GETW
; dx	length  }
; cs:ax	table
;
; Returns CF=1 if not found, otherwise AX=number from table.
;
; This routine doesn't require that DS=CS, so it may be used to parse
; environment strings.
;
; si,cx preserved either way.
;
;-
tbluk:	push	cx		;save
	push	si
	push	ds
	mov	si,ax		;pt at table
	push	ds		;copy DS to ES
	pop	es
	push	cs		;and CS to DS
	pop	ds
	xor	ch,ch		;CH=0
tbluk1:	lodsw			;get length,,length to match
	test	al,al		;end?
	jz	tbluk4
	mov	cl,ah		;assume bad length
	cmp	al,dl		;is ours long enough?
	ja	tbluk2		;no
	sub	ah,dl		;too long?
	jc	tbluk2		;yes
	mov	cl,dl		;just right
	mov	di,bx		;point at keyword
	repe	cmpsb		;match?
	je	tbluk3
	add	cl,ah		;no, add extra length
tbluk2:	add	si,cx		;skip to end
	inc	si		;skip jump addr
	inc	si
	jmp	short tbluk1	;loop
tbluk3:	; got it
	mov	cl,ah		;get extra length
	add	si,cx		;skip to end
	lodsw			;get dispatch addr
	stc			;makes CF=0 below
tbluk4:	; not found
	cmc			;CF=-CF
	pop	ds		;restore regs
	pop	si
	pop	cx
	ret
;+
;
; Skip blanks.
;
; si	line ptr
; cx	# chars left
;
; Returns CF=1 if EOL, or CF=0 and AL=char at [SI].
;
;-
skip:	jcxz	skip2		;EOL already
skip1:	lodsb			;get a char
	cmp	al,' '		;blank or ctrl char?
	ja	skip3		;no (CF=0)
	loop	skip1		;loop
skip2:	stc			;EOL
	ret
skip3:	dec	si		;unget
	ret
;+
;
; Make sure there is nothing more on the input line.
;
;-
confrm:	call	skip		;is there?
	jnc	$+3		;yes
	 ret
	cram	'?Not confirmed',error
;+
;
; Get logical device name of the form "d[d][u]:".
;
; si,cx	input line descriptor (updated on exit)
; ah	1 to require ':', 0 not to
;
; ax	returns one- or two-letter logical device name (right-justified)
; bl	returns unit #
; bh	non-zero if BL valid
;
;-
getlog:	call	skip		;skip blanks, tabs
	jc	glog6
	xor	dx,dx		;init dev name
	xor	bx,bx		;init flag,,unit #
	push	si		;save in case invalid
	push	cx
glog1:	; get logical device name
	lodsb			;get a byte
	and	al,not 40	;convert to upper case
	cmp	al,'A'		;letter?
	jb	glog2
	cmp	al,'Z'
	ja	glog2
	test	dl,dl		;already have two letters?
	jnz	glog5		;yes, error
	mov	dl,dh		;shift over
	mov	dh,al
	loop	glog1
	jmp	short glog8	;done
glog2:	; get unit #
	dec	si		;unget
glog3:	lodsb			;get a digit
	sub	al,'0'		;convert to binary
	cmp	al,9d		;is it a digit?
	ja	glog4
	xchg	ah,bl		;yes, get current #, save ':' flag
	cmp	ax,25d*100h+5	;will number overflow?
	ja	glog5
	aad			;add in new digit
	mov	ah,bl		;restore ':' flag
	mov	bl,al		;save number
	mov	bh,1		;set flag
	loop	glog3		;loop
	jmp	short glog8
glog4:	dec	si		;unget
	add	al,'0'		;fix char
	cmp	al,':'		;colon?
	je	glog7
	cmp	al,ds:swchar	;switch?
	je	glog8
	cmp	al,' '		;white space?
	jbe	glog8
glog5:	; invalid device name
	pop	cx		;restore
	pop	si
glog6:	stc			;error return
	ret
glog7:	inc	si		;eat colon
	dec	cx
	cbw			;don't require it any more (AL=':')
glog8:	test	ah,ah		;are we still worried about a colon?
	jnz	glog5		;yes, invalid
	mov	ax,dx		;copy dev name
	add	sp,4		;flush stack, CF=0
	ret
;+
;
; Get a byte number from input line.
;
; si,cx	line descriptor (updated)
; ah	returns number
; al	returns non-digit character following number
;
;-
gbyte:	xor	ah,ah		;init number
	jcxz	gbyt2		;nothing, return
gbyt1:	lodsb			;get a character
	sub	al,'0'		;convert to binary
	cmp	al,9d		;digit?
	ja	gbyt3		;no
	aad			;add in new digit
	mov	ah,al		;copy
	loop	gbyt1		;loop
gbyt2:	xor	al,al		;say delimiter is NUL
	ret
gbyt3:	dec	si		;unget
	mov	al,[si]		;get char again
	ret
;+
;
; Allocate memory from heap.  Punt (with a message) if we fail.
;
; cx	size of block to allocate
; si	returns pointer
;
;-
getmem:	call	askmem		;get memory
	jc	gmem1		;failed, punt
	ret
gmem1:	cram	'?Out of memory',error
;+
;
; As above, but just return with CF=1 if not available instead of aborting.
;
; The heap is maintained in our combined code/data segment immediately
; following the stack.  Free memory is available starting at the address stored
; in DS:FREMEM, ending at the address stored in DS:HIMEM.  The entire heap is
; flushed before each command by copying DS:KEPMEM (which points to the end of
; memory that will be kept) to DS:FREMEM.  Logical device records are kept
; around by copying DS:FREMEM to DS:KEPMEM after they're allocated, at the end
; of each successful MOUNT command.  Logical device records are freed by
; putting them in a linked list which is checked each time a new record is
; needed before it is allocated from the heap.  That means if the user mounts a
; bunch of devices and then dismounts them, the heap has permanently shrunk and
; we may run out of memory.  But if they mounted too many devices the heap
; would be gone anyway, not really worth worrying about.
;
; AX, BX, DX preserved.
;
;-
askmem:	mov	si,ds:fremem	;get ptr
	add	cx,si		;find end
	jc	amem1
	cmp	cx,ds:himem	;off end of our memory?
	ja	amem1
	mov	ds:fremem,cx	;update ptr
	clc			;got it
	ret
amem1:	stc			;failed
	ret
;+
;
; Get a logical device record.
;
; bp	returns ptr
; si,cx	nuked
;
;-
getrec:	mov	bp,ds:frerec	;get head of list
	test	bp,bp		;did we get anything?
	jz	grec1		;no
	mov	cx,ss:next[bp]	;unlink
	mov	ds:frerec,cx
	jmp	short grec2
grec1:	mov	cx,reclen	;length
	call	getmem		;allocate core
	mov	bp,si		;copy ptr
grec2:	; clear it out
	push	ax		;save
	push	di
	mov	di,bp		;point at it
	xor	al,al		;load 0
	mov	cx,reclen	;# bytes
	rep	stosb		;nuke it
	pop	di		;restore
	pop	ax
	mov	ds:tmpdev,bp	;save ptr
	ret
;+
;
; Return a logical device record to the free list.
;
; bp	ptr to record
;
;-
retrec:	cmp	bp,ds:fremem	;already freed?  (called from MLOOP)
	jae	rrec1		;yes
	mov	ax,bp		;copy ptr
	xchg	ax,ds:frerec	;get list, set new head
	mov	ss:next[bp],ax	;link list to head
rrec1:	ret
;+
;
; Parse a logical dev name and look up its record.
;
; If there's no device name, we use the default, which is either DS:CURDSK (a
; DOS disk letter), or if DS:CURDSK=0 then it's the first logical device on the
; DS:LOGDEV list.  If a device name is given, it is either a logical device (if
; it's on the DS:LOGDEV list), or a DOS drive (if not and it's just one letter
; and no unit number), or invalid.
;
; bp	returns record
; si,cx	updated
;
;-
gdevn:	xor	ah,ah		;no colon needed
	jmp	short gdev1
gdev:	mov	ah,1		;require colon
gdev1:	call	getlog		;get logical name
	mov	bp,ds:logdev	;[get head of device list]
	jnc	gdev3
	; no logical name, use logged-in default
	mov	ah,ds:curdsk	;is a DOS disk current?
	test	ah,ah
	jz	gdev2		;no, we already have ptr
	xor	al,al		;yes, set up dev info
	xor	bx,bx
	jmp	short gdev5	;create a record
gdev2:	ret
gdev3:	; see if it's defined
	cmp	ss:logd[bp],ax	;check for match
	jne	gdev4
	cmp	ss:logu[bp],bx
	je	gdev6		;got it, whee
gdev4:	mov	bp,ss:next[bp]	;follow link
	test	bp,bp		;more?
	jnz	gdev3		;loop if so
	; undefined, see if it's just one letter (DOS disk)
	or	bh,al		;unit flag or second letter?
	jnz	gdev7		;one or the other, error
gdev5:	; DOS disk, create temporary dev record
	push	si		;save cmd line
	push	cx
	call	getrec		;get temp record for DOS pseudo-device
	pop	cx
	pop	si
	; init the record but don't link it anywhere (flushed on next cmd)
	mov	ds:dosroo,ah	;save drive letter
	mov	ss:logd[bp],ax	;set name
	mov	ss:logu[bp],bx
	mov	ss:dsrini[bp],offset cret ;set vectors
	mov	ss:rdasc[bp],offset dosrd ;ASCII and binary are same on DOS
	push	si		;save
	push	di		;;; is anyone really using DI?
	push	cx
	mov	si,offset dosvec ;pt at other vectors
	call	setvec		;set them, return
	pop	cx		;restore
	pop	di
	pop	si
gdev6:	ret
gdev7:	cram	'?Invalid logical device name',error
;+
;
; Set file I/O vectors.
;
; ss:bp	log dev rec
; si	ptr to vector list
;
;-
setvec:	lea	di,[bp+iovecs]	;pt at dest
	mov	cx,niovec	;# words
	rep	movsw		;copy them in
	ret
;+
;
; Multiply two 32-bit numbers (unsigned).
;
; dx:ax	32-bit multiplicand
; bx:cx	32-bit multiplier
;
; On return:
; dx:cx:bx:ax  64-bit product
; bp	preserved
;
;-
mul32:	; (DX:AX)*(CX:BX) => (CX*DX):(AX*CX+BX*DX):(AX*BX) (with carry)
	mov	di,dx		;save high order
	push	ax		;save
	mov	ax,cx		;get CX
	mul	dx		;CX*DX
	xchg	di,dx		;DI=word 3
	mov	si,ax		;SI=word 2
	mov	ax,bx		;get BX
	mul	dx		;BX*DX
	add	si,dx		;add high order to words 2/3
	adc	di,0
	xchg	ax,cx		;save word 1, get CX
	pop	dx		;restore AX
	push	dx		;save again
	mul	dx		;AX*CX
	add	cx,ax		;add to word 1/2/3
	adc	si,dx
	adc	di,0
	pop	ax		;restore AX once again
	mul	bx		;AX*BX
	mov	bx,dx		;copy high order
	add	bx,cx		;add word 1
	adc	si,0		;ripple up
	adc	di,0
	mov	cx,si		;copy
	mov	dx,di
	ret
;+
;
; Divide a 64-bit number by a 32-bit number (unsigned).
;
; dx:cx:bx:ax  64-bit dividend
; di:si	32-bit divisor
;
; On return:
; dx:cx:bx:ax  64-bit quotient
; di:si	32-bit remainder
; bp	preserved
;
;-
div32:	push	bp		;save
	mov	ds:dvsr0,si	;save divisor
	mov	ds:dvsr1,di
	xor	si,si		;init partial remainder
	xor	di,di
	mov	bp,64d		;bit count
div1:	sal	ax,1		;dividend left a bit
	rcl	bx,1
	rcl	cx,1
	rcl	dx,1
	rcl	si,1		;into partial remainder
	rcl	di,1
	cmp	ds:dvsr1,di	;will divisor fit?
	jb	div2		;yes
	ja	div3		;no
	cmp	ds:dvsr0,si	;check low word
	ja	div3		;no
div2:	sub	si,ds:dvsr0	;yes, subtract it out
	sbb	di,ds:dvsr1
	inc	ax		;shift in a 1
div3:	dec	bp		;done all bits?
	jnz	div1		;loop if not
	pop	bp		;restore
	ret
;
	subttl	read binary block routines
;+
;
; All routines have these arguments:
;
; On entry:
; bp	dev record
; dx:ax	block number to read
; cx	number of blocks to read
; es:di	ptr to buf
;
; On return, CF=0 and:
; es:si	ptr to data read
; cx	count of bytes read
;
; Or CF=1 on read error (or cluster out of range).
;
;-
rdfil:	; read block(s) from file
	push	cx		;save length
	mov	ch,dl		;get block *256. into CX:DX
	mov	cl,ah
	mov	dh,al
	xor	dl,dl
	sal	dh,1		;*512.
	rcl	cx,1
	mov	bx,ss:handle[bp] ;get handle
	mov	ax,4200h	;func=LSEEK from BOF
	int	21h
	pop	cx		;[restore cluster count]
	jc	rdfil1
	push	ds		;save
	push	es		;copy ES to DS
	pop	ds
	mov	dx,di		;get buf ptr
	mov	ch,cl		;get count *512.
	sal	ch,1
	xor	cl,cl
	mov	ah,3Fh		;func=read
	int	21h
	pop	ds		;[restore]
	jc	rdfil1
	cmp	ax,cx		;got it all?
	jne	rdfil1
	mov	si,dx		;point at it (CX is set up)
	jmp	short trim12	;trim if needed, return
rdfil1:	stc			;error return
	ret
;
trim12:	; trim words if 12-bit device (ES:SI=ptr, CX=ctr)
	cmp	ss:wsize[bp],12d ;12-bit device?
	jne	trim14		;no
	mov	di,si		;copy ptr
	mov	bx,cx		;and byte count
	shr	bx,1		;word count
	mov	al,0Fh		;mask
trim13:	inc	di		;+1
	and	es:[di],al	;isolate (CF=0)
	inc	di		;+1
	dec	bx		;loop
	jnz	trim13
trim14:	clc			;read was successful either way
	ret
;
rddx:	; read block(s) from RX01/02/03 floppy
	mov	bx,ax		;get starting block #
	add	bx,cx		;add count
	adc	dx,0		;carry
	jnz	rddx6		;whoops
	cmp	bx,ss:devsiz[bp] ;off end of disk?  (end+1 is OK)
	ja	rddx6
	push	cx		;save block count
	push	di		;save ptr
	mov	bx,cx		;copy
	mov	cl,ss:blksec[bp] ;get shift count
	sal	ax,cl		;abs starting sector number
	sal	bx,cl		;sector count
	mov	cx,bx		;copy back
rddx1:	; read next sector
	push	cx		;save count
	push	ax		;save cluster #
	mov	bl,26d		;divisor
	div	bl		;AX=sector,,cyl
	mov	dh,al		;copy cyl #
	mov	cl,ss:nhds[bp]	;get # sides
	dec	cx		;0 if SS, 1 if DS
	and	dh,cl		;low bit is really side if DS
	shr	al,cl		;cyl /2 if DS
	xchg	al,ah		;><
	mov	cx,ax		;copy
	call	ss:fintlv[bp]	;compute interleave
	push	di		;save ptr
	call	ss:rdsec[bp]	;read sector
	pop	di		;[restore]
	jc	rddx5		;error
	mov	si,ds:dbuf	;pt at data
	mov	cx,ss:secsz[bp]	;byte count
	shr	cx,1		;word count
	; unpack 12-bit words from first 3/4 of sector, or just copy if 16-bit
	cmp	ss:wsize[bp],12d ;12-bit device?
	jne	rddx3		;no
	shr	cx,1		;/2 (2 words at a time)
rddx2:	; from RX8E prints:  bits from disk drive shift into low order end
	; of shift register, clocked 8 times for 8-bit mode or 12x for 12
	lodsw			;get first two bytes
	xchg	al,ah		;high bit first
	shr	ax,1		;right 4
	shr	ax,1
	shr	ax,1
	shr	ax,1
	stosw
	dec	si		;back up
	lodsw			;get 2nd, 3rd byte
	xchg	al,ah		;high bit first
	and	ah,17
	stosw
	loop	rddx2		;loop
rddx3:	rep	movsw		;copy (or drop through after LOOP)
rddx4:	pop	ax		;restore sector #
	inc	ax		;+1
	pop	cx
	loop	rddx1		;do next sector
	pop	si		;restore ptr
	pop	cx		;restore block count
	xchg	cl,ch		;*512.
	sal	ch,1		;CF=0
	ret
rddx5:	; error
	add	sp,8d		;flush stack
rddx6:	stc			;error
	ret
;
rddz:	; read block(s) from RX50 (etc.) floppy (anything with 512 bytes/sec)
	mov	bx,ax		;get starting block #
	add	bx,cx		;add count
	adc	dx,0		;carry
	jnz	rddz3		;whoops
	cmp	bx,ss:devsiz[bp] ;off end of disk?  (end+1 is OK)
	ja	rddz3
	push	cx		;save block count
	push	di		;save ptr
rddz1:	; read next sector
	push	cx		;save count
	push	ax		;save cluster #
	call	ss:fintlv[bp]	;compute interleave
	push	di		;save ptr
	call	ss:rdsec[bp]	;read sector
	pop	di		;[restore]
	jc	rddz2		;error
	mov	si,ds:dbuf	;pt at data
	mov	cx,512d/2	;word count
	rep	movsw		;copy
	pop	ax		;restore sector #
	inc	ax		;+1
	pop	cx
	loop	rddz1		;do next sector
	pop	si		;restore ptr
	pop	cx		;restore block count
	xchg	cl,ch		;*512.
	sal	ch,1
	callr	trim12		;trim if appropriate
rddz2:	; error
	add	sp,8d		;flush stack
rddz3:	stc			;error
	ret
;
	subttl	write binary block routines
;+
;
; All routines have these arguments:
;
; On entry:
; bp	dev record
; ax:dx	block number to write
; cx	number of blocks to write
; es:si	ptr to buf
;
; On return, CF=0 on success.
;
;-
wrfil:	; write block(s) to disk image file
	push	cx		;save length
	mov	ch,dl		;get block *256. into CX:DX
	mov	cl,ah
	mov	dh,al
	xor	dl,dl
	sal	dh,1		;*512.
	rcl	cx,1
	mov	bx,ss:handle[bp] ;get handle
	mov	ax,4200h	;func=LSEEK from BOF
	int	21h
	pop	cx		;[restore cluster count]
	jc	wrfil1
	push	ds		;save
	push	es		;copy ES to DS
	pop	ds
	mov	dx,si		;get buf ptr
	mov	ch,cl		;get count *512.
	sal	ch,1
	xor	cl,cl
	mov	ah,40h		;func=read
	int	21h
	pop	ds		;[restore]
	jc	wrfil1
	cmp	ax,cx		;got it all?
	je	wrfil2		;yes, CF=0
wrfil1:	stc			;error return
wrfil2:	ret
;
wrdx:	; write block(s) to RX01/02/03 floppy
	mov	bx,ax		;get starting block #
	add	bx,cx		;add count
	adc	dx,0		;carry
	jnz	wrdx4		;whoops
	cmp	bx,ss:devsiz[bp] ;off end of disk?  (end+1 is OK)
	ja	wrdx4
	mov	bx,cx		;copy
	mov	cl,ss:blksec[bp] ;get shift count
	sal	ax,cl		;abs starting sector number
	sal	bx,cl		;sector count
	mov	cx,bx		;copy back
wrdx1:	; write next sector
	push	cx		;save count
	push	ax		;save sector #
	mov	di,ds:dbuf	;pt at buf
	mov	dx,ds		;get segs
	mov	bx,es
	mov	ds,bx		;reverse them
	mov	es,dx
	mov	cx,ss:secsz[bp]	;byte count
	shr	cx,1		;word count
	; pack 12-bit words into first 3/4 of sector, or just copy if 16-bit
	cmp	ss:wsize[bp],12d ;12-bit device?
	jne	wrdx3		;no
	shr	cx,1		;/2 (2 words at a time)
	push	cx		;save sector size /4 for padding
wrdx2:	lodsw			;get first word
	sal	ax,1		;left 4
	sal	ax,1
	sal	ax,1
	sal	ax,1
	xchg	al,ah		;write high bit first
	stosw
	lodsw			;get second word
	and	ah,17		;just to make sure
	or	byte ptr es:[di-1],ah ;OR in high four bits
	stosb			;write low eight
	loop	wrdx2		;loop
	pop	cx		;restore count /4
	rep	stosb		;fill rest of sector with last byte written
wrdx3:	rep	movsw		;copy (or drop through after REP STOSB)
	pop	ax		;catch sector #
	push	ax		;save again
	mov	ds,dx		;restore
	push	bx		;save ES value
	push	si		;save ptr
	mov	bl,26d		;divisor
	div	bl		;AX=sector,,cyl
	mov	dh,al		;copy cyl #
	mov	cl,ss:nhds[bp]	;get # sides
	dec	cx		;0 if SS, 1 if DS
	and	dh,cl		;low bit is really side if DS
	shr	al,cl		;cyl /2 if DS
	xchg	al,ah		;><
	mov	cx,ax		;copy
	call	ss:fintlv[bp]	;compute interleave
	mov	bx,ds:dbuf	;ES:BX=buffer
	call	ss:wrsec[bp]	;write sector
	pop	si		;[restore ptr]
	pop	es
	pop	ax		;[restore sector #]
	pop	cx
	jc	wrdx4		;error
	inc	ax		;+1
	loop	wrdx1		;do next sector
	clc			;happy
	ret
wrdx4:	stc			;error
	ret
;
wrdz:	; write block(s) to RX50 (etc.) floppy (anything with 512 bytes/sec)
	mov	bx,ax		;get starting block #
	add	bx,cx		;add count
	adc	dx,0		;carry
	jnz	wrdz4		;whoops
	cmp	bx,ss:devsiz[bp] ;off end of disk?  (end+1 is OK)
	ja	wrdz4
wrdz1:	; write next sector
	push	cx		;save count
	push	ax		;save cluster #
	mov	di,ds:dbuf	;pt at buf
	mov	dx,ds		;get segs
	mov	bx,es
	mov	ds,bx		;reverse them
	mov	es,dx
	mov	cx,512d/2	;word count
	; trim all words to 12 bits if PDP-8 mode
	cmp	ss:wsize[bp],12d ;12-bit device?
	jne	wrdz3		;no
	push	ax		;save cluster #
wrdz2:	lodsw			;get a word
	and	ah,7777/400	;trim to 12 bits
	stosw			;save
	loop	wrdz2		;(CX=0 afterwards, drop through the REP MOVSW)
	pop	ax		;(restore cluster)
wrdz3:	rep	movsw		;copy into sector buffer (doesn't span 64KB)
	mov	ds,dx		;restore
	push	bx		;save ES value
	push	si		;save ptr
	call	ss:fintlv[bp]	;compute interleave
	mov	bx,ds:dbuf	;ES:BX=buffer
	call	ss:wrsec[bp]	;write sector
	pop	si		;restore ptr
	pop	es		;restore ES
	pop	ax		;restore sector #
	pop	cx
	jc	wrdz4		;error
	inc	ax		;+1
	loop	wrdz1		;do next sector
	ret			;CF is still 0
wrdz4:	stc			;error
	ret
;
	subttl	read ASCII block routines
;+
;
; Read ASCII block(s).
;
; Register usage is the same as the binary read routines.
;
;-
rdos:	; read OS/8 block and convert to ASCII
	cmp	byte ptr ds:ieof,0 ;end of file?
	jnz	rdos8
	call	ss:rdblk[bp]	;read
	jc	rdos6		;error
	mov	di,si		;copy ptr
	mov	dx,si		;twice
	mov	bx,cx		;copy count
	shr	bx,1		;/2=wc
	shr	bx,1		;/4=count of char triplets
	mov	cl,4		;bit count
rdos1:	; read two words, write three chars
	lods	word ptr es:[si] ;get a word
	and	al,177		;7-bit ASCII
	jz	rdos2		;skip if NUL
	cmp	al,'Z'-100	;EOF?
	je	rdos7
	stosb			;save 1st byte
rdos2:	sal	ah,cl		;left 4
	mov	ch,ah		;save
	lods	word ptr es:[si] ;get 2nd word
	and	al,177		;7 bits
	jz	rdos3
	cmp	al,'Z'-100	;EOF?
	je	rdos7
	stosb
rdos3:	mov	al,ah		;copy
	or	al,ch		;complete 3rd char
	and	al,177		;7 bits
	jz	rdos4
	cmp	al,'Z'-100	;EOF?
	je	rdos7
	stosb
rdos4:	dec	bx		;done all?
	jnz	rdos1		;loop
rdos5:	mov	si,dx		;set ptr
	mov	cx,di		;compute length
	sub	cx,si		;(CF=0)
rdos6:	ret
rdos7:	; ^Z (soft EOF)
	inc	ds:ieof		;set EOF flag
	jmp	short rdos5
rdos8:	; hit ^Z last time
	xor	cx,cx		;CX=0
	stc			;EOF
	ret
;
rdcos:	; read COS310 block and convert to ASCII
;;; this is more complicated
	ret
;
rdrt:	; read RT11 data and strip NULs
	call	ss:rdblk[bp]	;read
	jc	rdrt3
	mov	di,si		;copy ptr
	mov	dx,si		;save
rdrt1:	; trim NULs
	lods	byte ptr es:[si] ;get a byte
	test	al,al		;^@?
	jz	rdrt2
	 stosb			;save if not
rdrt2:	loop	rdrt1		;loop
	sub	di,dx		;find length (CF=0)
	mov	cx,di		;get count
	mov	si,dx		;and addr
rdrt3:	ret
;
	subttl	write ASCII block routines
;+
;
; Read ASCII block(s).
;
; Register usage is the same as the binary write routines:
;
; On entry:
; bp	dev record
; ax:dx	block number to write
; cx	number of blocks to write
; es:si	ptr to buf
;
; On return, CF=0 on success.
;
;-
wros:	; write ASCII blocks to OS/8 disk
	mov	di,offset buf	;point at buf
	push	cx		;save blk count
	push	dx		;save blk #
	push	ax
	mov	bx,384d/3	;# ASCII char triplets per 256-word block
	mov	cx,4
wros1:	lods	word ptr es:[si] ;get first two chars
	mov	[di],al		;save
	mov	[di+2],ah
	lods	byte ptr es:[si] ;get third
	mov	ah,al		;copy
	shr	ah,cl		;split into two nibbles
	and	al,17
	mov	[di+1],ah	;save LH
	mov	[di+3],al	;RH
	add	di,cx		;skip
	dec	bx		;loop through all
	jnz	wros1
	pop	ax		;catch blk #
	pop	dx
	push	dx		;save again
	push	ax
	push	es		;save source ptr
	push	si
	push	ds		;copy DS to ES
	pop	es
	mov	si,offset buf	;pt at buf
	mov	cx,1		;1 block
	call	ss:wrblk[bp]	;write it
	pop	si		;[restore all]
	pop	es
	pop	ax
	pop	dx
	pop	cx
	jc	wros2		;error, return
	inc	ax		;bump block (OS/8 disks always <4K blks)
	loop	wros		;loop through all blocks (CF=0)
wros2:	ret
;
	subttl	interleave
;+
;
; RX01 interleave routine.
;
; bp	logical device rec
; ch	cylinder (0-75.)
; cl	logical sector (0-25.)
;
; On return:
; ch	cylinder (1-76.)
; cl	sector (1-26.)
;
; From RT-11 V04 DY.MAC:
;
; ISEC=(ISEC-1)*2
; IF(ISEC.GE.26) ISEC=ISEC-25
; ISEC=MOD(ISEC+ITRK*6,26)+1
; ITRK=ITRK+1
;
; PDP-8 interleave is the same but there's no skew.
;
;-
dxilv:	add	cl,cl		;sec*2
	cmp	cl,ss:nsecs[bp]	;off EOT?
	jb	dxilv1
	sub	cl,ss:nsecs[bp]	;start over at 1
	inc	cx
dxilv1:	cmp	ss:wsize[bp],16d ;PDP-11 disk?
	jne	dxilv2		;no, no skew
	mov	al,6		;skew factor=6
	mul	ch		;*track
	add	al,cl		;add (sec-1)
	adc	ah,0
	div	ss:nsecs[bp]	;track size
	mov	cl,ah		;get remainder
dxilv2:	add	cx,101h		;track,,sector +1
	ret
;+
;
; RX02/03 interleave routine.
;
; As above except interleave is 3:1 for PDP-8 floppies.
;
;-
dyilv:	cmp	ss:wsize[bp],16d ;PDP-11 disk?
	jne	dyilv2		;no, assume PDP-8
	; 2:1 interleave, 6-sector skew
	add	cl,cl		;sec*2
	cmp	cl,ss:nsecs[bp]	;off EOT?
	jb	dyilv1
	sub	cl,ss:nsecs[bp]	;start over at 1
	inc	cx
dyilv1:	mov	al,6		;skew factor=6
	mul	ch		;*track
	add	al,cl		;add (sec-1)
	adc	ah,0
	div	ss:nsecs[bp]	;track size
	mov	cl,ah		;get remainder
	add	cx,101h		;track,,sector +1
	ret
dyilv2:	; 3:1 interleave, no skew
	mov	al,cl		;copy
	mov	ah,3		;*3
	mul	ah		;(AH=0)
	div	ss:nsecs[bp]	;mod track size
	mov	cl,ah		;copy
	add	cx,101h		;track,,sector +1
	cmp	ch,ss:ncyls[bp]	;wrapped off end (hacked handler)?
	jb	dyilv3		;no
	 xor	ch,ch		;start over at track 0
dyilv3:	ret
;+
;
; RX23/RX24/26/33 interleave routine.
;
; Soft interleave is not used with these drives, so our job is easy.
;
; ss:bp	logical device rec
; ax	absolute sector number
;
; On return:
; ch	cylinder (0 :: NCYLS-1)
; cl	sector (1 :: NSECS)
; dh	head (0 :: NHDS-1)
;
;-
duilv:	div	ss:nsecs[bp]	;AX=sector,,track
	mov	cl,ah		;save sector
	xor	ah,ah		;zero-extend
	div	ss:nhds[bp]	;AX=head,,cyl
	mov	dh,ah		;copy head
	mov	ch,al		;and cyl
	inc	cx		;sector +1
	ret
;
if 0
; Version of above that uses all of side 0 before starting side 1
; in case I run into something that does this with 1:1 interleave, no skew,
; and no track offset (i.e. not RX52 or RX03)
sdilv:	div	ss:nsecs[bp]	;AX=sector,,track
	mov	cl,ah		;save sector
	xor	ah,ah		;zero-extend track
	div	ss:ncyls[bp]	;AX=cyl,,head
	mov	dh,al		;get head
	mov	ch,ah		;get cyl
	inc	cx		;sector +1
	ret
endif
;+
;
; RX50 interleave routine.
;
; bp	logical device rec
; ax	absolute sector number
;
; On return:
; ch	cylinder (0-79.)
; cl	sector (1-10.)
; dh	head (0-1)
;
; From P/OS V3.2 DZDRV.MAC:
;
; IHEAD=ITRK/80
; ITRK=MOD(ITRK,80)
; ISEC=(ISEC-1)*2
; IF(ISEC.GE.10) ISEC=ISEC-9
; ISEC=MOD(ISEC+ITRK*2,10)+1
; ITRK=MOD(ITRK+1,80)
;
; Note that the disk starts on track 1 and wraps around after track 79 so that
; track 0 is the last track.  On double-sided disks (did these ever exist?),
; you then continue onto track 1 of side 1, wrapping at 79 and ending on track
; 0 of side 1.
;
;-
dzilv:	; P/OS DZDRV.MAC supports DS RX50s, don't know if they ever existed
	; interleave scheme starts over on side 1 after completing side 0
	xor	dh,dh		;init head
	cmp	ax,ss:devsiz[bp] ;on side 0?
	jb	dzilv1
	sub	ax,ss:devsiz[bp] ;no, start over on side 1
	inc	dh
dzilv1:	div	ss:nsecs[bp]	;AX=sector,,cyl
	xchg	al,ah		;><
	mov	cx,ax		;copy
	sal	cl,1		;sec*2
	cmp	cl,ss:nsecs[bp]	;>=10?
	jb	dzilv2
	sub	cl,ss:nsecs[bp]	;start over at 1
	inc	cx
dzilv2:	cmp	ss:wsize[bp],16d ;PDP-11 disk?
	jne	dzilv3		;no, no skew
	mov	al,2		;skew factor
	mul	ch		;*track
	add	al,cl		;add (sec-1)
	adc	ah,0
	div	ss:nsecs[bp]	;track size
	mov	cl,ah		;get remainder
dzilv3:	add	cx,101h		;track,,sector +1
	cmp	ch,ss:ncyls[bp]	;off end of disk?
	jne	dzilv4
	 xor	ch,ch		;yes, wrap around to make track 0 last track
dzilv4:	ret
;
	subttl	floppy image file I/O
;+
;
; Read/write sector from 8" floppy image file.
;
; bp	log dev rec
; cl	sector
; ch	cyl
; dh	head
;
; Buffer is at DS:DBUF
;
; Aborts (printing msg) on error.
;
;-
rddxf:	call	seekdx		;seek
	jc	rddxf2		;track 0 of block image, return E5s
	mov	ah,3Fh		;func=read
	int	21h		;set CF
	jc	rddxf1
	 ret
rddxf1:	jmp	rderr
rddxf2:	push	es		;save
	push	ds		;copy DS to ES
	pop	es
	mov	di,dx		;point at buf
	mov	al,0E5h		;pretend track 0 is freshly formated
	rep	stosb
	pop	es
	clc			;happy return
	ret
;
wrdxf:	call	seekdx		;seek
	jc	wrdxf2		;track 0 of block image
	mov	ah,40h		;func=write
	int	21h		;set CF
	jc	wrdxf1
	 ret
wrdxf1:	jmp	wrerr
wrdxf2:	clc			;say we're happy
	ret
;+
;
; Calculate 8" floppy image file address and seek there.
;
; On entry:
; bp	log dev rec
; ch	track
; cl	sector
; dh	head
;
; On return, file pointer is at the correct sector, and:
; bx	file handle
; cx	sector length
; dx	pointer to DS:DBUF
;
; Or CF=1 if block image and sector is on track 0 (i.e. is not part of file).
;
;-
seekdx:	test	ss:ilimg[bp],-1	;interleaved image file?
	jz	sekdx3		;no
	; undo track-to-track skew if PDP-11 disk
	sub	cx,101h		;track, sec -1
	jc	sekdx5		;it's track 0, bit bucket
	cmp	ss:wsize[bp],16d ;PDP-11 disk?
	jne	sekdx1		;no, had no skew so don't undo
	mov	al,-6		;track skew
	imul	ch		;*track # (-450. :: 0)
	add	al,cl		;add sector
	adc	ah,0
	add	ax,26d*18d	;ensure positive (mod 26.)
	mov	cl,26d		;secs/track
	div	cl		;get sector mod 26.
	mov	cl,ah		;get remainder
sekdx1:	; undo sector interleave
	shr	cl,1		;/2
	jnc	sekdx2
	 add	cl,26d/2	;odd sectors are from 2nd revolution
sekdx2:	inc	cx		;sec +1
sekdx3:	; now do the math, depending on sector size and # of sides
	mov	al,26d		;sectors/track
	cmp	ss:nhds[bp],2	;double sided?
	jb	sekdx4		;no
	add	al,al		;sectors/cylinder
	test	dh,dh		;side 2?
	jz	sekdx4
	add	cl,26d		;yes, skip to other head
sekdx4:	mul	ch		;get base sector # of cylinder
	dec	cx		;start sector #s at 0
	add	al,cl		;add it in
	adc	ah,0
	mul	ss:secsz[bp]	;find base addr
	; DX:AX is starting addr in file, seek there
	mov	cx,dx		;in cx:dx
	mov	dx,ax
	mov	bx,ss:handle[bp] ;get handle
	mov	ax,4200h	;func=seek from BOF
	int	21h
	jc	sekdx6
sekdx5:	; enter here with CF=1 if track 0
	mov	cx,ss:secsz[bp]	;[byte count]
	mov	dx,ds:dbuf	;[buf addr]
	ret			;CF=1 from JC SEKDX5 or 0 from INT 21h
sekdx6:	jmp	sekerr		;seek error
;+
;
; Read/write sector from RX50/RX52 floppy image file.
;
; bp	log dev rec
; cl	sector
; ch	cyl
; dh	head
;
; Buffer is at DS:DBUF
;
; Aborts (printing msg) on error.
;
;-
rddzf:	call	seekdz		;seek
	mov	ah,3Fh		;func=read
	int	21h		;set CF
	jc	rddzf1
	 ret
rddzf1:	jmp	rderr
;
wrdzf:	call	seekdz		;seek
	mov	ah,40h		;func=write
	int	21h		;set CF
	jc	wrdzf1
	 ret
wrdzf1:	jmp	wrerr
;+
;
; Calculate RX50/RX52 floppy image file address and seek there.
;
; On entry:
; bp	log dev rec
; ch	track
; cl	sector
; dh	head
;
; On return, file pointer is at the correct sector, and:
; bx	file handle
; cx	sector length
; dx	pointer to DS:DBUF
;
;-
seekdz:	test	ss:ilimg[bp],-1	;interleaved image file?
	jz	sekdz4		;no
	; undo track-to-track skew if PDP-11 disk (PDP-8 has none)
	sub	cx,101h		;track, sec -1
	jnc	sekdz1		;it's track 0, bit bucket
	 add	ch,ss:ncyls[bp]	;wrap to end of disk
sekdz1:	cmp	ss:wsize[bp],16d ;PDP-11 disk?
	jne	sekdz2		;no, had no skew so don't undo
	mov	al,-2		;track skew
	imul	ch		;*track # (-158. :: 0)
	add	al,cl		;add sector
	adc	ah,0
	add	ax,10d*16d	;ensure positive (mod 10.)
	mov	cl,10d		;secs/track
	div	cl		;get sector mod 26.
	mov	cl,ah		;get remainder
sekdz2:	; undo sector interleave
	shr	cl,1		;/2
	jnc	sekdz3
	 add	cl,10d/2	;odd sectors are from 2nd revolution
sekdz3:	inc	cx		;sec +1
sekdz4:	; now do the math, depending on sector size and # of sides
	mov	al,10d		;sectors/track
	cmp	ss:nhds[bp],2	;double sided?
	jb	sekdz5		;no
	mov	al,10d*2	;sectors/cylinder
	test	dh,dh		;side 2?
	jz	sekdz5
	add	cl,10d		;yes, skip 10. sectors
sekdz5:	mul	ch		;get base sector # of cylinder
	dec	cx		;start sector #s at 0
	add	al,cl		;add it in
	adc	ah,0
	mul	ss:secsz[bp]	;find base addr
	; DX:AX is starting addr in file, seek there
	mov	cx,dx		;in CX:DX
	mov	dx,ax
	mov	bx,ss:handle[bp] ;get handle
	mov	ax,4200h	;func=seek from BOF
	int	21h
	jc	sekdz6
	mov	cx,ss:secsz[bp]	;(byte count)
	mov	dx,ds:dbuf	;(buf addr)
	ret
sekdz6:	jmp	sekerr		;seek error
;+
;
; Read/write sector from RX23/RX24/RX26/RX33 floppy image file.
;
; bp	log dev rec
; cl	sector
; ch	cyl
; dh	head
;
; Buffer is at DS:DBUF
;
; Aborts (printing msg) on error.
;
;-
rdduf:	call	seekdu		;seek
	mov	ah,3Fh		;func=read
	int	21h		;set CF
	jc	rdduf1
	 ret
rdduf1:	jmp	rderr
;
wrduf:	call	seekdu		;seek
	mov	ah,40h		;func=write
	int	21h		;set CF
	jc	wrduf1
	 ret
wrduf1:	jmp	wrerr
;+
;
; Calculate RX23/RX24/RX26/RX33 floppy image file address and seek there.
;
; This has only been tested with RX33s, I'm not actually sure whether there is
; any standard DEC way to connect 3.5" disks to a PDP-11.  I'm assuming that
; the other formats also use 1:1 interleave and no skew since they seem to
; mirror PC formats and PCs don't play tricks with interleave.  Hopefully if
; this is not true someone will tell me!
;
; On entry:
; bp	log dev rec
; ch	track
; cl	sector
; dh	head
;
; On return, file pointer is at the correct sector, and:
; bx	file handle
; cx	sector length
; dx	pointer to DS:DBUF
;
;-
seekdu:	; don't worry about interleaved files since a sector image is the same
	; as a block image with RX33 disks
	; now do the math, depending on sector size and # of sides
	mov	al,ch		;get cyl
	mul	ss:nhds[bp]	;*2 if 2-sided
	add	al,dh		;add in head # to get abs track #
	dec	cx		;start sector #s at 0
	mul	ss:nsecs[bp]	;find abs sector # of base of track
	add	al,cl		;add sector within track
	adc	ah,0
	mul	ss:secsz[bp]	;find byte address of sector
	; DX:AX is starting addr in file, seek there
	mov	cx,dx		;put in CX:DX
	mov	dx,ax
	mov	bx,ss:handle[bp] ;get handle
	mov	ax,4200h	;func=seek from BOF
	int	21h
	jc	sekdu1
	mov	cx,ss:secsz[bp]	;(byte count)
	mov	dx,ds:dbuf	;(buf addr)
	ret
sekdu1:	jmp	sekerr		;seek error
;
	subttl	floppy I/O
;
; Change dx from OLD (if specified) to NEW in the fewest possible bytes.
ioport	macro	new,old
ifnb <old>
if new gt old
 if new le old+2
  if new eq old+2
	inc	dx
  endif
	inc	dx
 else
  if (high new) eq (high old)
	add	dl,new-old
  else
	mov	dx,new
  endif
 endif
endif
if new lt old
 if new ge old-2
  if new eq old-2
	dec	dx
  endif
	dec	dx
 else
  if (high new) eq (high old)
	sub	dl,old-new
  else
	mov	dx,new
  endif
 endif
endif
else
	mov	dx,new		;;no "old" specified
endif
	endm
;+
;
; Init floppy drive for a particular format.
;
; bp	dev record
;
; Specify command takes 2 bytes of args, stored at FDSPC.
;
; First byte:
;
;  7     4 3     0
; +-------+-------+
; |  SRT  |  HUT  |
; +-------+-------+
;
; SRT	step rate time
;	1 MHz:		(16.-SRT)/2 msec
;	500 kHz:	(16.-SRT) msec
;	300 kHz:	(16.-SRT)*5/3 msec
;	250 kHz:	(16.-SRT)*2 msec
;
; HUT	head unload time (treat 0 as 16.)
;	1 MHz:		HUT*8. msec
;	500 kHz:	HUT*16. msec
;	300 kHz:	HUT*80./3 msec
;	250 kHz:	HUT*32. msec
;
; Second byte:
;
;  7       1  0
; +---------+--+
; |   HLT   |ND|
; +---------+--+
;
; HLT	head load time (treat 0 as 128.)
;	1 MHz:		HLT msec
;	500 kHz:	HLT*2 msec
;	300 kHz:	HLT*10./3 msec
;	250 kHz:	HLT*4 msec
;
; ND	not DMA mode if 1, DMA mode if 0
;
;-
inidx:	; RX01 (8" SS SD)
	mov	word ptr ds:fdspc,066Fh ;SRT=10ms @16MHz, HUT=240ms, HLT=6ms,
				;DMA
	mov	word ptr ds:fdlen,1A00h ;26. secs/trk, 128. bytes/sec
	mov	word ptr ds:fdgpl,08007h ;gap length=7, max xfr=128. secs
				;(some FDC chips define DTL to be b/s if N=0
	mov	word ptr ds:fdmtr,18d ;1 second motor spin-up time
	mov	byte ptr ds:fdden,fm ;single density
	mov	word ptr ds:fdgpf,0E51Bh ;gap length (format)=27., fill=E5
	mov	byte ptr ds:fddcr,0 ;data rate = 250kHz/360RPM
	mov	byte ptr ds:fdvrt,0 ;longitudinal mode
	jmp	fdini		;init, return
;
inidy:	; RX02 (8" SS DD) or so-called "RX03" (8" DS DD)
	mov	word ptr ds:fdspc,066Fh ;SRT=10ms @16MHz, HUT=240ms, HLT=6ms,
				;DMA
	mov	word ptr ds:fdlen,1A01h ;26. secs/trk, 256. bytes/sec
	mov	word ptr ds:fdgpl,0FF0Eh ;gap length=14., max xfr=255. secs
	mov	word ptr ds:fdmtr,18d ;1 second motor spin-up time
	mov	byte ptr ds:fdden,mfm ;double density
	mov	word ptr ds:fdgpf,0E536h ;gap length (format)=54., fill=E5
	mov	byte ptr ds:fddcr,0 ;data rate = 500kHz/360RPM
	mov	byte ptr ds:fdvrt,0 ;longitudinal mode
	jmp	fdini		;init, return
;
ini24:	; RX24 3.5" (or 5.25" disk in TM100-4 on regular single-rate PC FDC)
;;; these parameters work for 360KB disks too, although in a 1.2MB drive they
;;; must be double-stepped (48 TPI disk in a 96 TPI drive)

;;; 320KB disks are also the same except that GAP3 is 1Bh (GAP3FORMAT is still
;;; 50h)
	mov	word ptr ds:fdspc,02DFh ;SRT=6ms @8MHz, HUT=480ms, HLT=4ms, DMA
	mov	word ptr ds:fdlen,0902h ;9. secs/trk, 512. bytes/sec
	mov	word ptr ds:fdgpl,0FF2Ah ;gap length=42., max xfr=255. secs
				;i82078 book says GAP3=1Bh, WRONG
	mov	word ptr ds:fdmtr,9d+1 ;1/2 second motor spin-up time
	mov	byte ptr ds:fdden,mfm ;double density
	mov	word ptr ds:fdgpf,0F650h ;gap length (format)=80., fill=F6
				;i82078 book says GAP3=54h, WRONG
	mov	byte ptr ds:fddcr,2 ;data rate = 250kHz/300RPM
	mov	byte ptr ds:fdvrt,0 ;longitudinal mode
	jmp	fdini		;init, return
;
ini23:	; RX23 (3.5" DS HD)
	mov	word ptr ds:fdspc,02CFh ;SRT=4ms @16MHz, HUT=240ms, HLT=2ms,
				;DMA
	mov	word ptr ds:fdlen,1202h ;18. secs/trk, 512. bytes/sec
	mov	word ptr ds:fdgpl,0FF1Bh ;gap length=27., max xfr=255. secs
	mov	word ptr ds:fdmtr,9d+1 ;1/2 second motor spin-up time
	mov	byte ptr ds:fdden,mfm ;double density
	mov	word ptr ds:fdgpf,0F66Ch ;gap length (format)=108., fill=F6
				;i82078 book says GAP3=54h, WRONG
	mov	byte ptr ds:fddcr,0 ;data rate = 500kHz/300RPM
	mov	byte ptr ds:fdvrt,0 ;longitudinal mode
	jmp	fdini		;init, return
;
ini26:	; RX26 (3.5" DS ED)
	mov	word ptr ds:fdspc,02AFh ;SRT=3ms (@32MHz), HUT=120ms, HLT=1ms,
				;DMA
	mov	word ptr ds:fdlen,2402h ;36. secs/trk, 512. bytes/sec
	mov	word ptr ds:fdgpl,0FF1Bh ;gap length=27., max xfr=255. secs
				;i82078 data book says GAP3=38h, WRONG
	mov	word ptr ds:fdmtr,9d+1 ;1/2 second motor spin-up time
	mov	byte ptr ds:fdden,mfm ;double density
	mov	word ptr ds:fdgpf,0F654h ;gap length (format)=84., fill=F6
				;PC8477B and i82078 data books both say
				;GAP3=53h, but this is what FORMAT.COM uses
				;(with Award BIOS anyway), and Linux too
	mov	byte ptr ds:fddcr,3 ;data rate = 1MHz/300RPM
	mov	byte ptr ds:fdvrt,-1 ;vertical mode
	jmp	short fdini	;init, return
;
ini33:	; RX33 (5.25" DS HD)
	mov	word ptr ds:fdspc,02DFh ;SRT=3ms, HUT=240ms, HLT=2ms, DMA
	mov	word ptr ds:fdlen,0F02h ;15. secs/trk, 512. bytes/sec
	mov	word ptr ds:fdgpl,0FF1Bh ;gap length=27., max xfr=255. secs
				;i82078 book says GAP3=2Ah, WRONG
	mov	word ptr ds:fdmtr,9d+1 ;1/2 second motor spin-up time
	mov	byte ptr ds:fdden,mfm ;double density
	mov	word ptr ds:fdgpf,0E554h ;gap length (format)=84., fill=E5
				;i82078 book says GAP3=50h, WRONG
	mov	byte ptr ds:fddcr,0 ;data rate = 500kHz/360RPM
	mov	byte ptr ds:fdvrt,0 ;longitudinal mode
	jmp	short fdini	;init, return
;
inidz:	; RX50 (5.25" SS DD 96tpi)
	mov	word ptr ds:fdspc,02DFh ;SRT=6ms, HUT=480ms, HLT=4ms, DMA
	mov	word ptr ds:fdlen,0A02h ;10. secs/trk, 512. bytes/sec
	mov	word ptr ds:fdgpl,0FF14h ;gap length=20., max xfr=255. secs
	mov	word ptr ds:fdmtr,9d+1 ;1/2 second motor spin-up time
	mov	byte ptr ds:fdden,mfm ;double density
	mov	word ptr ds:fdgpf,0E518h ;gap length (format)=24., fill=E5
	mov	byte ptr ds:fddcr,1 ;data rate = 250kHz/300RPM or 300kHz/360RPM
				;use 2 (250kHz/300RPM) for PC/XT w/TM100-4
	mov	byte ptr ds:fdvrt,0 ;longitudinal mode
	;jmp	short fdini	;init, return
;+
;
; Init floppy I/O.
;
;-
fdini:	mov	al,ss:drive[bp]	;get drive #
	mov	ds:fddrv,al	;save
	; build digital output register value
	push	es		;save
	xor	ax,ax		;load 0 into ES
	mov	es,ax
	cli			;so MOTOR_STATUS doesn't change before our eyes
	mov	al,es:motor_status ;;get motor bits
	pop	es		;;restore
	and	al,17		;;isolate
	mov	cx,4		;;loop count
	xor	ah,ah		;;init unit #
	mov	ah,10		;;assume drive 0, set IE
fdini1:	ror	al,1		;;right a bit
	jnc	fdini2
	mov	ah,14		;;calc unit # (leave IE set)
	sub	ah,cl		;;10 + unit #
fdini2:	loop	fdini1		;;loop through all 4 bits
	or	al,ah		;;OR it in (with IE)
	; hard reset FDC (it might be in some new mode we don't know about)
	ioport	fdcdor		;;digital output register
	test	byte ptr ds:fdrst,-1 ;;already done?  (once after each prompt)
	jnz	fdini3
	out	dx,al		;;hard reset (or not, these days)
	jmp	short $+2	;;miniscule I/O delay
	or	al,4		;;reenable
	out	dx,al		;;enable FDC
	inc	ds:fdrst	;;set flag
	ioport	fdccc4,fdcdor	;;switch to CompatiCard IV control reg
	mov	al,10		;;set DMA enable
	mov	ds:cc4ctl,al	;;save
	test	byte ptr ds:cc4fdc,-1 ;;is it a CC4?
	jz	fdini3		;;no
	 out	dx,al		;;(got overwritten when we wrote FDCDOR)
fdini3:	sti			;;reenable ints
	; set data rate
	ioport	fdcdcr		;pt at port (DX is either FDCDOR or FDCCC4)
	mov	al,ds:fddcr	;set value
	out	dx,al
	; send specify command (set timing for this drive)
	; this has to do with the drive head movement timing, not the disk
	; format, the numbers used hopefully will work on all drives, anyway
	; for PC-like disks they're the same numbers BIOS uses
	mov	si,offset necbuf ;pt at buf
	mov	byte ptr [si],3	;cmd=specify
	mov	ax,ds:fdspc	;get specify bytes
	mov	[si+1],ax	;save
	mov	cx,3		;length
	call	sfdc		;send to FDC
	; check FDC chip version
	mov	si,offset necbuf ;pt at buf
	mov	byte ptr [si],20 ;cmd=get version (or invalid cmd on uPD765)
	mov	cx,1		;length
	call	sfdc		;send to FDC
	mov	cx,1		;length
	call	rfdcn		;get reply
	jc	fdini5		;evidently it doesn't understand
	mov	al,ds:necbuf	;get value
	cmp	al,200		;original uPD765 (or clone)?
	je	fdini5		;yes, doesn't know about vertical mode
	; set or clear perpendicular mode
	cmp	al,240		;could it be SMC37C65LJP+?
	jne	fdini4		;no
	ioport	fdcfcr		;point at format control reg (if it exists)
	mov	al,ds:fdvrt	;get vertical flag (in all bits)
	and	al,200		;isolate b7
	out	dx,al		;tell SMC chip which mode to use
fdini4:	mov	si,offset necbuf ;pt at buf
	mov	byte ptr [si],22 ;cmd=perpendicular mode
	mov	al,ds:fdvrt	;get vertical flag (in all bits)
	and	al,3		;set/clear GAP,WGATE
	; the per-drive bits (and OW) are cute but not supported in all FDCs
	mov	[si+1],al	;save
	mov	cx,2		;length
	call	sfdc		;send to FDC
fdini5:	ret
;
fdrds:	; read sector(s)
	mov	byte ptr ds:fdspn,0 ;no spin-up needed (retry instead)
	mov	ax,0A646h	;multitrack, skip deleted data, read data
	jmp	short fdxfr	;(doesn't work w/o multitrack bit!)
;
fdwrs:	; write sector(s)
	mov	byte ptr ds:fdspn,-1 ;spin up before writing
	mov	ax,854Ah	;multitrack, write sector,,DMA cmd
	jmp	short fdxfr	;write, return
;
if 0 ; this is never used
fdvfs:	; verify sector(s)
	mov	byte ptr ds:fdspn,0 ;no spin-up needed (retry instead)
	mov	ax,0A642h	;same as read w/different cmd to DMAC
;; actually, I think it just checks CRCs and needs no host data at all
	jmp	short fdxfr	;verify, return
endif
;
fdftk:	; format track
	mov	byte ptr ds:fdspn,-1 ;spin up before writing
	mov	ax,0D4Ah	;format track,,DMA cmd
	;jmp	short fdxfr	;do it, return
;+
;
; Perform a floppy transfer.
;
; al	DMA command
; ah	FDC command
; cl	sector
; ch	cyl
; dh	head
; ;dl	block count (not used, always 1)
;
; Buffer is always at DS:DBUF
;
; Returns CF=0 on success, otherwise CF=1 and al contains error code:
; 0	controller timeout (hardware failure)
; 1	seek error
; 2	some kind of transfer error (sector not found, fault)
; 200	write protect
;
;-
fdxfr:	mov	ds:fdcmd,ax	;save FDC cmd
	mov	word ptr ds:fdsec,cx ;and cyl,,sec
	mov	word ptr ds:fdnum,dx ;and head,,blk count (not used)
	mov	ds:fdtry,5	;init retry counter
fxfr1:	; compute length
	mov	cl,ds:fdlen	;get sector length (0=128., 1=256., 2=512.)
	add	cl,7		;correct
	mov	dx,1		;always copy one sector
	sal	dx,cl		;find byte count
	mov	cx,dx		;copy
	mov	al,byte ptr ds:fdcmd ;get DMA command
	call	dmaset		;set up DMA controller
				;(count will be too high if formating, but...)
	call	fdmon		;turn motor on
	call	fdsek		;seek if needed
	jc	fxfr5		;error
	; send I/O command to FDC
	mov	al,byte ptr ds:fdcmd+1 ;get FDC command
	or	al,ds:fdden	;get density flag
	mov	si,offset necbuf ;point at where string goes
	mov	ah,ds:fdhd	;get head
	sal	ah,1		;left 2
	sal	ah,1
	or	ah,ds:fddrv	;OR in drive #
	mov	[si],ax		;head/drive,,cmd
	test	al,10		;format cmd?
	jnz	fxfr2		;yes
	; read or write
	mov	al,ds:fdcyl	;cyl
	mov	[si+2],al
	mov	al,ds:fdhd	;head
	mov	[si+3],al
	mov	al,ds:fdsec	;rec (sector)
	mov	[si+4],al
	mov	ax,word ptr ds:fdlen ;get EOT,,N
	mov	[si+5],ax
	mov	ax,word ptr ds:fdgpl ;get DTL,,GPL
	mov	[si+7],ax
	mov	cx,9d		;length
	jmp	short fxfr3
fxfr2:	; format
	mov	ax,word ptr ds:fdlen ;get secs/trk,,bytes/sec
	mov	[si+2],ax
	mov	ax,word ptr ds:fdgpf ;get filler byte,,gap 3 length
	mov	[si+4],ax
	mov	cx,6		;length
fxfr3:	; whichever, send command
	call	sfdc		;write it
	jc	fxfr5		;timeout
	call	fdcwt		;wait for interrupt
	jc	fxfr5		;timeout
	call	rfdc		;read status
	jc	fxfr5		;timeout
	test	byte ptr ds:necbuf,300 ;happy completion?
	jnz	fxfr4		;no
	ret
fxfr4:	mov	al,2		;assume general error
	test	byte ptr ds:necbuf+1,2 ;write protect?
	jz	fxfr5
	mov	al,200		;yes, no point in retrying
	stc			;return
	ret
fxfr5:	; timeout or error
	mov	bl,ds:fddrv	;get drive #
	xor	bh,bh		;BH=0
	mov	byte ptr ds:fdccl[bx],-1 ;force recal
	dec	ds:fdtry	;retry?
	jz	fxfr6		;no, fail
	jmp	fxfr1		;yes
fxfr6:	stc
	ret
;+
;
; Seek to FDCYL if needed.
;
; CF=1 on error, AL=error code.
;
;-
fdsek:	; see whether a seek is needed
	mov	bl,ds:fddrv	;get drive #
	xor	bh,bh		;BH=0
	mov	al,ds:fdcyl	;get desired cyl
	cmp	al,ds:fdccl[bx]	;are we there?
	je	fdsek1		;yes
	xchg	al,ds:fdccl[bx]	;save if not
	cmp	al,-1		;do we even know where we are?
	jne	fdsek2		;yes
	; recal
	mov	ds:fdccl[bx],al	;set back to -1 until we succeed
	mov	si,offset necbuf ;pt at buf
	mov	ah,ds:fddrv	;get unit #
	mov	al,7		;cmd=recal
	mov	[si],ax		;save
	mov	cx,2		;length
	call	fdpos		;do recal operation
	jnc	fdsek2
	; retry the recal once, may require > 77 step pulses on 80-track drives
	; (older FDC chips give up after 77 pulses)
	mov	si,offset necbuf ;pt at buf
	mov	ah,ds:fddrv	;get unit #
	mov	al,7		;cmd=recal
	mov	[si],ax		;save
	mov	cx,2		;length
	call	fdpos		;do recal operation
	jnc	fdsek2
	jmp	short fdsek7
fdsek1:	jmp	short fdsek6
fdsek2:	; seek to cyl
	mov	si,offset necbuf ;pt at buffer
	mov	byte ptr [si],17 ;command=seek
	mov	al,ds:fdhd	;get head
	sal	al,1		;left 2
	sal	al,1
	or	al,ds:fddrv	;OR in drive #
	mov	ah,ds:fdcyl	;cyl #
	mov	[si+1],ax	;save
	mov	cx,3		;length
	call	fdpos		;do seek operation
	jc	fdsek7		;failed
	mov	bl,ds:fddrv	;get drive #
	xor	bh,bh		;BH=0
	mov	al,ds:fdcyl	;get newly seeked cyl
	mov	ds:fdccl[bx],al	;update
	; update TG43 (reduced write current) signal on CompatiCard IV
	mov	ah,10		;set DMA enable
	cmp	al,43d		;track greater than 43?
	jbe	fdsek3		;no
	 mov	ah,11		;yes, set CCEN and PN2 (Micro Solutions docs
				;say you have to set bit 2 also but that seems
				;to actually *prevent* assertion of pin 2
				;(DB37 pin 3) under some conditions
fdsek3:	mov	ds:cc4ctl,ah	;remember what to set
	; wait for head to settle
	; (funny, I thought the HLT parameter in the SPECIFY command took care
	; of this, but BIOS worries about it)
	push	es		;save
	xor	bx,bx		;point at BIOS data
	mov	es,bx
	mov	cx,2		;wait >=1 timer tick for head to settle
fdsek4:	mov	bx,es:timer_low	;get time
fdsek5:	cmp	bx,es:timer_low	;has it changed?
	je	fdsek5		;spin until it does
	loop	fdsek4		;then count the tick
	pop	es		;restore
fdsek6:	clc			;happy
fdsek7:	sbb	ah,ah		;save CF
	; update CompatiCard IV TG43 signal
	test	byte ptr ds:cc4fdc,-1 ;is it a CC4?
	jz	fdsek8		;no
	ioport	fdccc4		;point at CC4 control reg
	mov	al,ds:cc4ctl	;get current value
	out	dx,al
fdsek8:	shr	ah,1		;restore CF
	ret
;+
;
; Send a position (seek/recal) or reset command, and sense int status.
;
; Enter with ds:si, cx set up for SFDC.
;
; CF=1 on error, AL=error code.
;
;-
fdpos:	call	sfdc		;send command
	jc	fdpos1		;timeout
	call	fdcwt		;wait for completion
	jc	fdpos1		;timeout
	mov	si,offset necbuf ;pt at buffer
	mov	byte ptr [si],10 ;cmd=sense int status
	mov	cx,1		;length
	call	sfdc		;send
	jc	fdpos1		;timeout
	call	rfdc		;get result
	jc	fdpos1
	test	byte ptr ds:necbuf,300 ;happy termination?
	jz	fdpos1
	mov	al,1		;no, say seek error
	stc
fdpos1:	ret
;+
;
; Read next ID field.
;
; ch	cylinder
; dh	head
;
; si	points at DB C,H,R,N on successful return
;
; CF=1 on error, AL=error code.
;
;-
fdrid:	mov	byte ptr ds:fdspn,-1 ;spin up before reading
	mov	ds:fdcyl,ch	;save cyl
	mov	ds:fdhd,dh	;and head
	call	fdmon		;turn on motor if not already on
	call	fdsek		;seek if needed
	jc	fdrid2
	mov	al,12		;cmd=READ ID
	or	al,ds:fdden	;get density flag
	mov	si,offset necbuf ;point at where string goes
	mov	ah,ds:fdhd	;get head
	sal	ah,1		;left 2
	sal	ah,1
	or	ah,ds:fddrv	;OR in drive #
	mov	[si],ax		;head/drive,,cmd
	mov	cx,2		;len=2
	call	sfdc		;send command
	jc	fdrid2		;timeout
	call	fdcwt		;wait for completion
	jc	fdrid2		;timeout
	call	rfdc		;get result
	jc	fdrid2		;timeout
	test	byte ptr ds:necbuf,300 ;happy completion?  (CF=0)
	jnz	fdrid1
	mov	si,offset necbuf+3 ;[yes, point at C/H/R/N]
	ret			;CF=0 from TEST
fdrid1:	stc			;error return
fdrid2:	ret
;+
;
; Turn on floppy motor if not already on.
;
;-
fdmon:	push	es		;save
	xor	bx,bx		;load 0 into ES
	mov	es,bx
	mov	es:motor_count,377 ;don't time out yet
	mov	cl,ds:fddrv	;get drive #
	mov	al,1		;1 bit
	sal	al,cl		;shift into place
	mov	cl,es:motor_status ;get bits
	test	cl,al		;already on?
	jnz	fdmon4		;yes, skip this whole bit
	and	cl,not 17	;turn off other bits
	or	cl,al		;set this one
	mov	es:motor_status,cl ;save
	mov	cl,4		;need to shift 4 more bits
	sal	al,cl
	or	al,14		;set DMAEN, /DSELEN, clear SRST
	or	al,ds:fddrv	;OR in drive #
	ioport	fdcdor		;digital output register
	out	dx,al		;turn on motor
	ioport	fdccc4,fdcdor	;switch to CompatiCard IV control reg
	mov	al,ds:cc4ctl	;reset current value
	test	byte ptr ds:cc4fdc,-1 ;is it a CC4?
	jz	fdmon1		;no
	 out	dx,al		;(got overwritten when we wrote FDCDOR)
fdmon1:	; wait for spin-up if writing
	cmp	byte ptr ds:fdspn,0 ;need to spin up?
	jz	fdmon4		;no
	mov	cx,ds:fdmtr	;get spin-up time
fdmon2:	mov	bx,es:timer_low	;get time
fdmon3:	cmp	bx,es:timer_low	;has it changed?
	je	fdmon3		;spin until it does
	loop	fdmon2		;then count the tick
fdmon4:	mov	es:motor_count,18d*2+1 ;2 sec motor timeout
	pop	es		;restore
	ret
;+
;
; Set up DMA controller.
;
; al	mode (see 8237 (or NEC uPD71037) data sheet)
; cx	byte count
;
; We don't check for spanning 64KB boundaries here because we checked our
; buffer when we allocated it.
;
;-
dmaset:	cli			;ints off
	out	0Bh,al		;;set mode reg
	out	0Ch,al		;;say low byte coming next
	; compute 20-bit absolute address
	mov	dx,ds		;;get addr
	mov	ah,cl		;;save cl
	mov	cl,4		;;bit count
	rol	dx,cl		;;left 4 bits, catch high 4 in low 4
	mov	cl,ah		;;restore cl
	mov	al,dl		;;get them
	and	dl,360		;;zero them out
	and	al,17		;;isolate (not really needed in 20-bit sys)
	add	dx,ds:dbuf	;;find base addr
	adc	al,0		;;add them in
	out	81h,al		;;set high 4 bits
	mov	al,dl		;;write low byte of addr
	out	04h,al		;;for channel 2
	mov	al,dh		;;high byte
	out	04h,al
	; write 16-bit byte count
	dec	cx		;;length -1
	mov	al,cl		;;write low byte of length
	out	05h,al		;;for channel 2
	mov	al,ch		;;get high byte
	out	05h,al
	mov	al,2		;;init DMA channel 2
	out	0Ah,al
	sti			;;ints back on
	ret
;+
;
; Send a string to the floppy disk controller.
;
; si,cx	addr, length of string
;
; Returns CF=1 on timeout.
;
;-
sfdc:	push	es		;save ES
	xor	ax,ax		;pt at BIOS data with es
	mov	es,ax
	and	es:seek_status,7Fh ;clear int bit
	ioport	fdcmsr		;main status register
	mov	ah,2		;timeout loop count (.GE. 1 timer tick)
sfdc1:	mov	bx,es:timer_low	;get time
sfdc2:	in	al,dx		;check it
	and	al,300		;isolate high 2 bits
	jns	sfdc3		;skip if not ready for xfr
	test	al,100		;ready for us to write?
	jnz	sfdc4		;no, it has something to say first
	ioport	fdcdat,fdcmsr	;data port
	lodsb			;get a byte
	out	dx,al
	ioport	fdcmsr,fdcdat	;restore
	loop	sfdc2		;loop
	pop	es		;restore
	clc			;happy
	ret
sfdc3:	; not ready, check for timeout
	cmp	bx,es:timer_low	;has time changed?
	je	sfdc2		;loop if not
	dec	ah		;-1
	jnz	sfdc1		;loop if not done (get new bx)
	pop	es		;restore
	xor	al,al		;error=timeout
	stc
	ret
sfdc4:	; FDC has something to say
	; (won't let us write anything until we've read it)
	ioport	fdcdat,fdcmsr	;data port
	in	al,dx		;that's nice dear
	ioport	fdcmsr,fdcdat	;status reg
	jmp	short sfdc2	;as I was saying...
;+
;
; Read FDC result data into NECBUF.
;
; CF=1 on timeout.
;
;-
rfdc:	mov	cx,7		;should be only 7 bytes
rfdcn:	; enter here with length in cx
	push	es		;save
	xor	bx,bx		;pt at BIOS data
	mov	es,bx
	mov	di,offset necbuf ;pt at buf
	ioport	fdcmsr		;main status reg
	mov	ah,2		;timeout tick counter
rfdc1:	mov	bx,es:timer_low	;get time
rfdc2:	in	al,dx		;get status bits
	and	al,300		;isolate request, direction
	jns	rfdc4		;not ready, see if timeout
	test	al,100		;is it ready to squeal?
	jz	rfdc3		;no, guess it thinks we're done
	ioport	fdcdat,fdcmsr	;point at data port
	in	al,dx		;get data
	mov	[di],al		;save it
	inc	di
	ioport	fdcmsr,fdcdat	;back to status port
	loop	rfdc2		;loop
rfdc3:	pop	es		;restore
	ret			;CF=0 from TEST above (either way)
rfdc4:	; not ready, see if timeout
	cmp	bx,es:timer_low	;has clock ticked
	je	rfdc2		;keep trying until it does
	dec	ah		;give up yet?
	jnz	rfdc1		;no, update bx and continue
	pop	es		;restore
	xor	al,al		;error=timeout
	stc
	ret
;+
;
; Wait for FDC completion interrupt.
;
; This is SOOO stupid, why not just poll the FDC?
;
; Return CF=1 if it takes more than 2 seconds.
;
; This depends on the BIOS being IBM-compatible enough to use the same stupid
; polling/int structure (ISR sets a flag, mainline polls the flag) and the same
; flag (high bit of SEEK_STATUS).
;
;-
fdcwt:	push	es		;save
	xor	cx,cx		;load 0 into ES
	mov	es,cx
	mov	cl,18d*2+1	;tick count (2 sec)
fdcwt1:	mov	ax,es:timer_low	;get timer
fdcwt2:	test	es:seek_status,80h ;has the int happened?
	jnz	fdcwt3		;yes
	cmp	ax,es:timer_low	;has time changed?
	je	fdcwt2
	loop	fdcwt1		;yes, count the tick
	xor	al,al		;error=timeout
	stc
fdcwt3:	pop	es		;[restore]
	ret
;+
;
; Print error message for FDC error.
;
; al	error code
;
;-
fderr:	test	al,al		;write protect?
	js	wrperr
	jz	timerr		;timeout
	cmp	al,1		;seek error?
	je	sekerr
	cram	'?General failure',error
wrperr:	cram	'?Write protect error',error
timerr:	cram	'?Timeout error',error
sekerr:	cram	'?Seek error',error
;
	subttl	ASPI SCSI I/O
;+
;
; Parse SCSI parameters.
;
; ss:bp	log dev rec
; si	pts at 'SCSIht_l:' string
; bx	length of " "
;
;-
gscsi:	mov	ax,ds:aspi	;does ASPI driver exist?
	or	ax,ds:aspi+2
	jnz	gscs1		;yes
	cram	'?No ASPI driver',error
gscs1:	xor	dl,dl		;init host #
	xor	cl,cl		;init target #
	xor	ch,ch		;init LUN #
	add	si,4		;skip 'SCSI'
	sub	bx,4+1		;count off 'SCSI' and ':'
	jz	gscs4
	lodsb			;get letter or whatever
	cmp	al,'A'		;letter?
	jb	gscs2
	cmp	al,'Z'
	ja	gscs2
	sub	al,'A'		;yes, convert to host index
	mov	dl,al		;save
	dec	bx		;is that it?
	jz	gscs4		;yes
	lodsb			;get next char
gscs2:	cmp	al,'0'		;0-7?
	jb	gscs3
	cmp	al,'7'
	ja	gscs3
;;; N.B. can go higher with wide SCSI!
	sub	al,'0'		;yes, convert to target #
	mov	cl,al		;save
	dec	bx		;is that it?
	jz	gscs4		;yes
	lodsb			;get next char
gscs3:	cmp	al,'_'		;_?
	jne	gscs5		;no, error
	dec	bx		;is that it?
	jz	gscs4		;yes
	lodsb			;get next char
	cmp	al,'0'		;0-7?
	jb	gscs5
	cmp	al,'7'
	ja	gscs5
	sub	al,'0'		;yes, convert to target #
	mov	ch,al		;save
	dec	bx		;should have been last char
	jnz	gscs5		;no
gscs4:	mov	ss:host[bp],dl	;save
	mov	ss:drive[bp],cl
	mov	ss:lun[bp],ch
	mov	ss:hwtype[bp],hwaspi ;set type
	mov	al,byte ptr ds:tdrv+1 ;see if any set
	or	al,byte ptr ds:tbpart+1
	or	al,byte ptr ds:ttype+1
	jnz	gscs6		;switch conflict if so
	; determine device type
	mov	si,offset dvtyp	;cmd
	mov	cx,ldvtyp	;length
	call	aspcmd		;send it
	jc	gscs7
	mov	al,ds:srb+0Ah	;get device type
	and	al,1Fh		;trim off peripheral qualifier
	; 00h disk
	; 01h tape
	; 04h WORM disk
	; 05h CD-ROM
	; 07h optical disk
	; 08h jukebox
	cmp	al,01h		;tape?
	jne	gscs10		;no, assume it's 1 of the above kinds of disks
	mov	ss:tapflg[bp],al ;set "tape" flag (AL=01h)

 cram '?Tape',error

;;; see if variable or fixed record size

	ret
gscs5:	jmp	synerr
gscs6:	jmp	swtcon
gscs7:	cmp	al,82h		;error=no such drive?
	je	gscs9
gscs8:	call	serr		;print msg
	jmp	mloop		;give up
gscs9:	jmp	baddrv		;no such drive
gscs10:	; get total disk size and sector size
	mov	ds:rdcap1,ds	;set seg addr of BUF
	mov	cx,5		;retry count
gscs11:	push	cx		;save
	mov	si,offset rdcap	;pt at cmd to read capacity into BUF
	mov	cx,lrdcap
	call	aspcmd		;send cmd
	pop	cx		;[restore]
	jnc	gscs12		;success
	loop	gscs11		;keep trying
	cram	'?Error sizing disk',error
gscs12:	mov	dx,word ptr ds:buf+4 ;get sector length in bytes
	mov	ax,word ptr ds:buf+6
	xchg	dl,dh		;reverse order (result in DX:AX)
	xchg	al,ah
	mov	ss:secsz[bp],ax	;save
	mov	ss:secsz+2[bp],dx
	mov	cx,word ptr ds:buf+0 ;get highest sector # on disk
	mov	bx,word ptr ds:buf+2
	xchg	cl,ch		;reverse order (result in CX:BX)
	xchg	bl,bh
	call	mul32		;multiply to get byte # of last sector
	add	ax,ss:secsz[bp]	;add final sector to get dev size
	adc	bx,ss:secsz+2[bp]
	adc	cx,0
	adc	dx,0
	sbb	si,si		;all ones if overflowed (!!!), otherwise 0
	or	ax,si		;change to max 64-bit int if wrapped
	or	bx,si
	or	cx,si
	or	dx,si
	mov	ss:totsiz[bp],ax ;save
	mov	ss:totsiz+2[bp],bx
	mov	ss:totsiz+4[bp],cx
	mov	ss:totsiz+6[bp],dx
	mov	si,512d		;DEC block size
	xor	di,di
	call	div32		;find total # blocks in dev
	mov	ss:totblk[bp],ax ;save total block count
	mov	ss:totblk+2[bp],bx
	mov	ss:totblk+4[bp],cx
	mov	ss:totblk+6[bp],dx
	mov	ss:devsiz[bp],ax ;save usable block count
	mov	ss:devsiz+2[bp],bx
	mov	ss:devsiz+4[bp],cx
	mov	ss:devsiz+6[bp],dx
	mov	ss:dsrini[bp],offset cret ;no DSR init
	mov	ss:rdblk[bp],offset rdadk ;read from ASPI SCSI disk
	mov	ss:wrblk[bp],offset wradk ;write to ASPI SCSI disk
	ret
;+
;
; Read from ASPI SCSI disk.
;
; On entry:
; bp	dev record
; dx:ax	block number to read
; cx	number of blocks to read
; es:di	ptr to buf
;
; On return, CF=0 and:
; es:si	ptr to data read
; cx	count of bytes read
;
; Or CF=1 on read error (or cluster out of range).
;
;-
rdadk:	mov	bx,ss:devsiz+4[bp] ;if >4G blocks, guaranteed to fit
	or	bx,ss:devsiz+6[bp]
	jnz	radk2
	mov	bx,ax		;copy starting block #
	mov	si,dx
	add	bx,cx		;add count
	adc	si,0		;carry
	jc	radk1		;whoops
	cmp	si,ss:devsiz+2[bp] ;off end of disk?  (exact hit is OK)
	ja	radk1		;whoops
	jb	radk2		;OK
	cmp	bx,ss:devsiz[bp] ;check low word
	jbe	radk2		;OK
radk1:	stc			;error
	ret
radk2:	; convert starting block # to starting sector # + offset
	push	di		;save ptr
	push	cx		;save block count
	mov	cl,9d		;bit count
	rol	ax,cl		;left 9 bits
	rol	dx,cl
	mov	bx,ax		;copy low order
	and	bh,1		;isolate 9 bits shifted out of AX
	xor	ax,bx		;isolate high 7 in AX
	mov	cx,dx		;copy high order
	and	ch,1		;isolate 9 bits shifted out of DX
	xor	dx,cx		;isolate high 7 in DX
	or	bx,dx		;compose middle word
	xor	dx,dx		;clear highest order
	; DX:CX:BX:AX = starting byte address
	mov	si,ss:secsz[bp]	;get sector size
	mov	di,ss:secsz+2[bp]
	call	div32		;find starting disk addr
	mov	ds:secnum,ax	;save starting sector #
	mov	ds:secnum+2,bx
	mov	ds:secoff,si	;save offset into first sector
	mov	ds:secoff+2,di
	; convert block count to sector count and byte count
	pop	ax		;get # blocks
	mov	cl,9d		;bit count
	rol	ax,cl		;left 9 bits
	mov	bx,ax		;copy
	and	bh,1		;isolate 9 bits shifted out of AX
	xor	ax,bx		;isolate high 7 in AX (so BX:AX=byte count)
	xor	cx,cx		;clear high order
	xor	dx,dx
	mov	si,ss:secsz[bp]	;get sector size
	mov	di,ss:secsz+2[bp]
	call	div32		;DX:CX:BX:AX = sector count (DX:CX known 0)
	test	bx,bx		;BX must be 0 too, to fit in cmd
	jz	radk3
	 mov	ax,0FFFFh	;try to do a zillion of the tiny sectors
radk3:	push	ax		;save
	xor	dx,dx		;zero-extend
	mov	bx,ss:secsz[bp]	;get sector size yet again
	mov	cx,ss:secsz+2[bp]
	call	mul32		;BX:AX=byte count (BX known 0 because of FCOPY)
	pop	cx		;restore sector count
	pop	di		;restore starting offset
	; BX:AX=byte count, CX=sector count, DS:SECNUM=starting sector, DI=offs
	; decide whether to do short (6-byte) or long (10-byte) request
	; (theoretically could use 10-byte version all the time but this way
	; we have some chance of working with ancient disks that only do 6)
	test	ch,ch		;sector count too big for 8 bits?
	jnz	radk4		;yes
	test	word ptr ds:secnum+2,177740 ;sec # too big for 21 bits?
	jnz	radk4		;yes
	; use READ(6)
	mov	byte ptr ds:ioshtc,08h ;cmd=READ(6)
	mov	ds:ioshtl,ax	;set byte count
	mov	ds:ioshtl+2,bx
	mov	ds:ioshta,di	;set addr
	mov	ds:ioshta+2,es
	mov	ds:ioshtc+4,cl	;set sector count
	mov	dx,ds:secnum	;get sector #
	xchg	dl,dh		;(byte swapped)
	mov	word ptr ds:ioshtc+2,dx ;save low 16 bits
	mov	dl,byte ptr ds:secnum+2 ;get high 5 bits
	mov	ds:ioshtc+1,dl
	mov	si,offset iosht	;pt at cmd
	mov	cx,liosht	;length
	jmp	short radk5
radk4:	; use READ(10)
	mov	byte ptr ds:iolngc,28h ;cmd=READ(10)
	mov	ds:iolngl,ax	;set byte count
	mov	ds:iolngl+2,bx
	mov	ds:iolnga,di	;set addr
	mov	ds:iolnga+2,es
	xchg	cl,ch		;(byte swap sector count)
	mov	word ptr ds:iolngc+7,cx ;save
	mov	cx,ds:secnum	;get sector #
	mov	dx,ds:secnum+2
	xchg	cl,ch		;byte swap
	xchg	dl,dh
	mov	word ptr ds:iolngc+2,dx ;save
	mov	word ptr ds:iolngc+4,cx
	mov	si,offset iolng	;pt at cmd
	mov	cx,liolng	;length
radk5:	push	es		;save
	push	di
	push	ax		;save byte count
	push	ds		;copy DS to ES
	pop	es
	call	aspcmd		;send command
	pop	cx		;[restore byte count]
	pop	di		;[restore ptr]
	pop	es
	jc	radk7		;error
	mov	si,di		;copy
	mov	ax,ds:secoff	;get offset into first sector
	test	ax,ax		;anything?
	jz	radk6		;no
	sub	cx,ax		;remove wasted part
	push	si		;save starting addr
	push	cx		;and actual count
	add	si,ax		;index out to data we really want
	push	ds		;save
	push	es		;copy ES to DS
	pop	ds
	shr	cx,1		;/2 (CF=odd byte)
	rep	movsw		;[copy words]
	rcl	cl,1		;=1 if odd
	rep	movsb		;copy odd byte if any
	pop	ds		;restore
	pop	cx		;get back count used
	pop	si		;and starting addr
radk6:	clc			;happy
	ret
radk7:	stc			;error
	ret
;+
;
; Write to ASPI SCSI disk.
;
; On entry:
; bp	dev record
; ax:dx	block number to write
; cx	number of blocks to write
; es:si	ptr to buf
;
; On return, CF=0 on success.
;
;-
wradk:	mov	bx,ss:devsiz+4[bp] ;if >4G blocks, guaranteed to fit
	or	bx,ss:devsiz+6[bp]
	jnz	wadk2
	mov	bx,ax		;copy starting block #
	mov	di,dx
	add	bx,cx		;add count
	adc	di,0		;carry
	jc	wadk1		;whoops
	cmp	di,ss:devsiz+2[bp] ;off end of disk?  (exact hit is OK)
	ja	wadk1		;whoops
	jb	wadk2		;OK
	cmp	bx,ss:devsiz[bp] ;check low word
	jbe	wadk2		;OK
wadk1:	stc			;error
	ret
wadk2:	; convert starting block # to starting sector # + offset
	push	si		;save ptr
	push	cx		;save block count
	mov	cl,9d		;bit count
	rol	ax,cl		;left 9 bits
	rol	dx,cl
	mov	bx,ax		;copy low order
	and	bh,1		;isolate 9 bits shifted out of AX
	xor	ax,bx		;isolate high 7 in AX
	mov	cx,dx		;copy high order
	and	ch,1		;isolate 9 bits shifted out of DX
	xor	dx,cx		;isolate high 7 in DX
	or	bx,dx		;compose middle word
	xor	dx,dx		;clear highest order
	; DX:CX:BX:AX = starting byte address
	mov	si,ss:secsz[bp]	;get sector size
	mov	di,ss:secsz+2[bp]
	call	div32		;find starting disk addr
	mov	ds:secnum,ax	;save starting sector #
	mov	ds:secnum+2,bx
	mov	ds:secoff,si	;save offset into first sector
	mov	ds:secoff+2,di
	; convert block count to sector count and byte count
	pop	ax		;get # blocks
	mov	cl,9d		;bit count
	rol	ax,cl		;left 9 bits
	mov	bx,ax		;copy
	and	bh,1		;isolate 9 bits shifted out of AX
	xor	ax,bx		;isolate high 7 in AX (so BX:AX=byte count)
	; (if SECOFF is non-zero, stop and mess with just the one sector)
	mov	cx,ds:secoff	;get low word
	or	cx,ds:secoff+2	;either non-zero?
;;	jnz	...		;yes, read/modify/write
	xor	cx,cx		;clear high order
	xor	dx,dx
	mov	si,ss:secsz[bp]	;get sector size
	mov	di,ss:secsz+2[bp]
	call	div32		;DX:CX:BX:AX = sector count (DX:CX known 0)
	test	bx,bx		;BX must be 0 too, to fit in cmd
	jz	wadk3
	 mov	ax,0FFFFh	;try to do a zillion of the tiny sectors
wadk3:	push	ax		;save
	xor	dx,dx		;zero-extend
	mov	bx,ss:secsz[bp]	;get sector size yet again
	mov	cx,ss:secsz+2[bp]
	call	mul32		;BX:AX=byte count (BX known 0 because of FCOPY)
	pop	cx		;restore sector count
	pop	si		;restore starting offset
	; BX:AX=byte count, CX=sector count, DS:SECNUM=starting sector, DI=offs
	; decide whether to do short (6-byte) or long (10-byte) request
	; (theoretically could use 10-byte version all the time but this way
	; we have some chance of working with ancient disks that only do 6)
	test	ch,ch		;sector count too big for 8 bits?
	jnz	wadk4		;yes
	test	word ptr ds:secnum+2,177740 ;sec # too big for 21 bits?
	jnz	wadk4		;yes
	; use WRITE(6)
	mov	byte ptr ds:ioshtc,0Ah ;cmd=WRITE(6)
	mov	ds:ioshtl,ax	;set byte count
	mov	ds:ioshtl+2,bx
	mov	ds:ioshta,si	;set addr
	mov	ds:ioshta+2,es
	mov	ds:ioshtc+4,cl	;set sector count
	mov	dx,ds:secnum	;get sector #
	xchg	dl,dh		;(byte swapped)
	mov	word ptr ds:ioshtc+2,dx ;save low 16 bits
	mov	dl,byte ptr ds:secnum+2 ;get high 5 bits
	mov	ds:ioshtc+1,dl
	mov	si,offset iosht	;pt at cmd
	mov	cx,liosht	;length
	jmp	short wadk5
wadk4:	; use WRITE(10)
	mov	byte ptr ds:iolngc,2Ah ;cmd=WRITE(10)
	mov	ds:iolngl,ax	;set byte count
	mov	ds:iolngl+2,bx
	mov	ds:iolnga,si	;set addr
	mov	ds:iolnga+2,es
	xchg	cl,ch		;(byte swap sector count)
	mov	word ptr ds:iolngc+7,cx ;save
	mov	cx,ds:secnum	;get sector #
	mov	dx,ds:secnum+2
	xchg	cl,ch		;byte swap
	xchg	dl,dh
	mov	word ptr ds:iolngc+2,dx ;save
	mov	word ptr ds:iolngc+4,cx
	mov	si,offset iolng	;pt at cmd
	mov	cx,liolng	;length
wadk5:	push	es		;save
	push	si
	push	ax		;save byte count
	push	ds		;copy DS to ES
	pop	es
	call	aspcmd		;send command
	pop	cx		;[restore byte count]
	pop	si		;[restore ptr]
	pop	es
	jc	wadk6		;error
	ret
wadk6:	stc			;error
	ret
;+
;
; Execute ASPI cmd, CF=1 on error.
;
; ds:si	ptr to cmd
; cx	length
; ss:bp	dev rec (preserved)
;
;-
aspcmd:	mov	di,offset srb	;ES:DI=SRB buf
	mov	bx,di		;copy ptr
	rep	movsb		;copy cmd
	; set up parms that are always the same
	mov	al,ss:host[bp]	;set host adapter #
	mov	[bx+2],al
	mov	al,ss:drive[bp]	;set SCSI target ID
	mov	[bx+08h],al
	mov	al,ss:lun[bp]	;set LUN (within that SCSI target)
	mov	[bx+09h],al	;almost always 0 (except Adaptec ACB-4000 etc.)
	mov	cl,5		;shift count
	sal	al,cl
	and	byte ptr [bx+41h],37 ;mask out old LUN
	or	[bx+41h],al	;OR it in
if 0
;;;	set buffer addr
;;	mov	[bx+0Fh], offset
;;	mov	[bx+11h], segment
endif
	push	bp		;save
	push	es		;set up call args
	push	bx
	call	dword ptr ds:aspi ;call driver
	pop	ax		;flush stack
	pop	ax
	pop	bp		;restore
	;callr	<short aspwt>	;poll for completion or ^C
;
aspwt:	; wait for ASPI completion, CF=1 on error
	mov	al,ds:srb+1	;get status
	test	al,al		;done (or error)?
	jnz	aspwt1		;got it
	mov	ah,0Bh		;func=test for input
	int	21h		;(actually just looking for ^C)
	jmp	short aspwt	;survived the call, loop
aspwt1:	cmp	al,1		;happy?
	je	aspwt2		;yes, CF=0 from CMP
	 stc			;no
aspwt2:	ret
;+
;
; Sort out ASPI errors and print message.
;
; SRB	set up from ASPI call.
;
;-
asperr:	mov	dl,ds:srb+18h	;get HA status
	mov	si,offset hasts	;pt at table
	test	dl,dl		;error?
	jnz	aerr1		;yes, get msg
	or	dl,ds:srb+19h	;get target status (DL=0)
	jz	aerr2		;=0, why are we here?
	mov	si,offset tgtsts ;pt at table
	cmp	dl,2		;error=check condition?
	jne	aerr1		;no
	mov	dl,ds:srb+46h+2	;get sense key
	and	dl,0Fh		;trim to size
	mov	si,offset snskey ;pt at table
aerr1:	call	aspmsg		;look up msg
	mov	bx,0001h	;handle=STDOUT
	mov	ah,40h		;func=write
	int	21h
	mov	dx,offset crlfs	;pt at <CRLF>
	mov	cx,2		;length=2
	mov	ah,40h		;func=write (handle still set)
	int	21h
aerr2:	ret
;
hasts	label	byte
	amsg	11h,'?Sel timeout'
	amsg	12h,'?Data over/underrun'
	amsg	13h,'?Unexpected bus free'
	amsg	14h,'?Bus protocol error'
	dw	-1
;
tgtsts	label	byte
	amsg	08h,'?Device busy'
	amsg	18h,'?Reservation conflict'
	dw	-1
;
snskey	label	byte
	amsg	00h,'?No sense'
	amsg	01h,'?Soft error'
	amsg	02h,'?Not ready'
	amsg	03h,'?Medium error'
	amsg	04h,'?Hardware error'
	amsg	05h,'?Illegal request'
	amsg	06h,'?Unit attention'
	amsg	07h,'?Write protect error'
	amsg	08h,'?Blank check'
	amsg	09h,'?Data underflow'
	amsg	0Bh,'?Aborted command'
	amsg	0Dh,'?Volume overflow'
	amsg	0Eh,'?Miscompare'
	dw	-1
;+
;
; Look up error message.
;
; dl	byte to look up
; si	pointer to MSG table terminated by "DW -1"
;
; On return, DS:DX=ptr to msg (or IOERR if not found), CX=length
;
;-
aspmsg:	lodsw			;get word
	test	ah,ah		;end of table?
	js	amsg2		;yes
	cmp	al,dl		;match?
	lodsb			;[get length]
	cbw			;[0-extend]
	je	amsg1		;yes
	add	si,ax		;skip text
	jmp	short aspmsg	;loop
amsg1:	mov	dx,si		;copy ptr
	mov	cx,ax		;copy length
	ret
amsg2:	mov	dx,offset ioerr	;pt at default msg
	mov	cx,10d		;LEN('?I/O error')
	ret
;
ioerr	db	'?I/O error'
;+
;
; Check AL for error.
;
;-
serr:	cmp	al,1		;error?
	jne	serr1
	ret
serr1:	callr	asperr
;
	subttl	TU58 I/O
;+
;
; Init TU58 controller.
;
; ss:bp	log dev rec
;
;-
ddinit:	mov	ds:ddtry,3	;retry count
ddini1:	; send break
	mov	dx,ss:port[bp]	;get port
	add	dx,3		;line control reg
	mov	al,103		;BREAK=1, 8 data, 1 stop, no parity
	out	dx,al
	mov	cx,2		;wait for 2 clock edges
	push	ds		;save DS
	xor	ax,ax		;pt at BIOS data
	mov	ds,ax		;with DS
ddini2:	mov	ax,ds:timer_low	;get time
ddini3:	cmp	ax,ds:timer_low	;has it changed?
	je	ddini3		;loop if not
	loop	ddini2		;count it if so
	; wait one more tick so UART has settled down
	mov	ax,ds:timer_low	;get new value
ddini4:	cmp	ax,ds:timer_low	;has it changed?
	je	ddini4		;loop until it does
	pop	ds		;restore
	mov	al,3		;BREAK=0, 8 data, 1 stop, no parity
	out	dx,al
	call	ddflsh		;flush input buf
	; send two INIT commands
	push	es		;save ES
	push	cs		;copy CS to ES
	pop	es
	mov	si,offset initdd ;pt at string
	mov	cx,2		;two bytes long
	call	sdd		;send to TU58
	mov	di,ds:dbuf
	inc	cx		;CX=1
	mov	ds:ddtime,9d	;allow 1/2 second
	call	rdd		;receive the cmd
	pop	es		;[restore]
	jc	ddini7		;timeout, try again
	mov	al,[di-1]	;get the byte
	and	al,37		;isolate low 5 bits
	cmp	al,20		;CONTINUE?
	je	ddini8
ddini7:	dec	ds:ddtry	;retry
	jnz	ddini1
	cram	'?TU58 init failure',error
ddini8:	ret
;
initdd	db	4,4		;INIT, INIT (first is ignored)
;+
;
; Flush COM input buffer.
;
;-
ddflsh:	mov	dx,ss:port[bp]	;get base port addr
ddfls1:	add	dx,5		;pt at status reg
	in	al,dx		;read it
	test	al,1		;input char ready?
	jz	ddfls2		;no, do the init
	sub	dx,5		;yes, pt at data port
	in	al,dx		;eat the char
	jmp	short ddfls1
ddfls2:	ret
;+
;
; Read block(s) from a TU58.
;
; dx:ax	starting block #
; cx	number of blocks to read
; es:di	buffer
; ss:bp	log dev rec
;
;-
rddd:	add	ax,cx		;add blk count
	adc	dx,0		;carry
	jnz	rddd1		;shouldn't be any
	cmp	ax,512d		;in range?  (exact hit on 512. OK)
	ja	rddd1		;no
	mov	ds:ddblk,ax	;save blk # after end
	mov	ds:ddptr,di	;and ptr to begn of block
	mov	ds:ddptr+2,es
	sal	cl,1		;*512=byte count
	xchg	cl,ch
	mov	ds:ddctr,cx	;save byte count
	push	di		;save ptr
	push	cx		;and byte count
	mov	ds:dderr,0	;invalid remaining byte count
	jmp	short rddd2
rddd1:	stc			;error return
	ret
rddd2:	mov	ds:ddtry,3	;3 tries per starting block #
rddd3:	; request all of the remaining blocks
	push	ds		;copy DS to ES
	pop	es
	mov	si,ds:dbuf	;pt at buffer
	mov	di,si		;copy
	mov	ax,0A02h	;flag=02 (cmd), length=10.
	stosw
	cbw			;cmd=02 (read), modifier=0
	stosw
	mov	al,ss:drive[bp]	;unit #, switches=0
	stosw
	xor	al,al		;sequence #
	stosw
	mov	ax,ds:ddctr	;get # bytes to go
	stosw
	mov	bl,ah		;get high byte
	shr	bl,1		;make block count
	xor	bh,bh
	mov	ax,ds:ddblk	;ending block #
	sub	ax,bx		;find starting block # of this xfr
	stosw
	mov	cx,12d		;byte count
	xor	ah,ah		;even byte
	xor	bx,bx		;init checksum
	call	sdd		;send to DD:
	mov	es:[si],bx	;save checksum
	mov	cl,2		;byte count
	call	sdd		;send
rddd4:	; wait for a data packet (ES=DS)
	mov	di,ds:dbuf	;pt at buffer
	mov	cx,1		;read one byte
	xor	ah,ah		;it's an even one
	xor	bx,bx		;init checksum
	mov	ds:ddtime,38d*91d/5 ;wait up to 38 seconds (worst seek is 28)
	call	rdd		;get the mark character
	jc	rddd8
	mov	al,[di-1]	;get the char read
	and	al,37		;trim to 5 bits
	cmp	al,1		;data?
	jne	rddd5		;no, go deal
	inc	cx		;yes
	mov	ds:ddtime,18d	;timeout down to 1 sec
	call	rdd		;get the length byte
	jc	rddd8
	mov	cl,[di-1]
	xor	ch,ch		;CH=0
	mov	dx,ds:ddctr	;get # bytes to go
	sub	dx,cx		;would this overrun the buffer?
	jc	rddd8		;yes
	push	cx		;save
	les	di,dword ptr ds:ddptr ;get ptr
	call	rdd		;read the data
	jc	rddd7		;timeout, flush cx and deal
	push	ds		;copy DS to ES
	pop	es
	mov	di,ds:dbuf	;pt at buffer
	mov	cl,2		;get checksum
	push	bx		;(save it)
	call	rdd
	pop	ax		;[restore]
	jc	rddd7
	cmp	ax,[di-2]	;do checksums match?
	jne	rddd7		;no
	pop	ax		;restore count
	add	ds:ddptr,ax	;update addr
	sub	ds:ddctr,ax	;and count
	jnz	rddd4
	call	ddend		;get end packet
	jc	rddd8		;whoops
	cmp	al,2		;0 or 1?  (OK endings)
	cmc			;CF=0 if so
	pop	cx		;restore
	pop	si
	mov	es,ds:ddptr+2	;get seg
	ret			;CF is already set
rddd5:	; flag is something other than data mark
	cmp	al,2		;control?
	jne	rddd8		;no, reset and retry
	call	ddend1		;presumably end packet
	jc	rddd8		;bad end packet, maybe it wasn't bad news
rddd6:	add	sp,4		;flush stack
	stc			;CF=1
	ret
rddd7:	pop	cx		;flush stack
rddd8:	; timeout, bad checksum, or protocol error -- retry
	call	ddinit		;reinit
	mov	ax,ds:ddctr	;get # bytes to go
	mov	bx,ax		;copy
	add	ax,777		;round up to next block boundary
	and	ax,not 777
	mov	ds:ddctr,ax	;update
	mov	cx,ax		;copy
	sub	ax,bx		;find # bytes already transferred in this blk
	sub	ds:ddptr,ax	;back up
	cmp	cx,ds:dderr	;same place we started at last time?
	jne	rddd9
	dec	ds:ddtry	;yes, count this try
	jz	rddd6		;the hell with this
	jmp	rddd3		;try again
rddd9:	mov	ds:dderr,cx	;remember where we are
	jmp	rddd2		;give it another try
;+
;
; Write block(s) to a TU58.
;
; dx:ax	starting block #
; cx	number of blocks to write
; es:si	buffer
; ss:bp	log dev rec
;
;-
wrdd:	add	ax,cx		;add blk count
	adc	dx,0		;carry
	jnz	wrdd1		;shouldn't be any
	cmp	ax,512d		;in range?  (exact hit on 512. OK)
	ja	wrdd1		;no
	mov	ds:ddblk,ax	;save blk # after end
	mov	ds:ddptr,si	;and ptr to begn of block
	mov	ds:ddptr+2,es
	sal	cl,1		;*512=byte count
	xchg	cl,ch
	mov	ds:ddctr,cx	;save byte count
	mov	ds:dderr,0	;invalid remaining byte count
	jmp	short wrdd2
wrdd1:	stc			;error return
	ret
wrdd2:	mov	ds:ddtry,3	;3 tries per starting block #
wrdd3:	; write all of the remaining blocks
	push	ds		;copy DS to ES
	pop	es
	mov	si,ds:dbuf	;pt at buffer
	mov	di,si		;copy
	mov	ax,0A02h	;flag=02 (cmd), length=10.
	stosw
	mov	ax,3		;cmd=03 (write), modifier=0
	stosw
	mov	al,ss:drive[bp]	;unit #, switches=0
	stosw
	xor	al,al		;sequence #
	stosw
	mov	ax,ds:ddctr	;get # bytes to go
	stosw
	mov	bl,ah		;get high byte
	shr	bl,1		;make block count
	xor	bh,bh
	mov	ax,ds:ddblk	;ending block #
	sub	ax,bx		;find starting block # of this xfr
	stosw
	mov	cx,12d		;byte count
	xor	ah,ah		;even byte
	xor	bx,bx		;init checksum
	call	sdd		;send to DD:
	mov	es:[si],bx	;save checksum
	mov	cl,2		;byte count
	call	sdd		;send
	mov	ax,ds:ddptr	;get curr offset
	mov	ds:ddsav,ax	;save
wrdd4:	; wait for a CONTINUE flag (es=ds)
	mov	di,ds:dbuf	;pt at buffer
	mov	cx,1		;read one byte
	xor	ah,ah		;it's an even one
	xor	bx,bx		;init checksum
	mov	ds:ddtime,38d*91d/5 ;wait up to 38 seconds (worst seek is 28)
	call	rdd		;get the mark character
	jc	wrdd7
	mov	al,[di-1]	;get the char read
	and	al,37		;trim to 5 bits
	cmp	al,20		;CONTINUE?
	jne	wrdd5		;no, go deal
	; write next data packet
	mov	si,offset dddata ;pt at header
	xor	bx,bx		;init checksum
	xor	ah,ah		;even byte
	mov	cl,2		;length=2
	call	sdd		;send first two bytes
	les	si,dword ptr ds:ddptr ;get ptr
	mov	cl,128d		;length
	call	sdd		;send data portion
	push	ds		;copy DS to ES
	pop	es
	mov	si,ds:dbuf	;pt at buffer
	mov	[si],bx		;save checksum
	mov	cl,2		;write 2 bytes
	call	sdd
	add	ds:ddptr,128d	;update ptr
	sub	ds:ddctr,128d	;done yet?
	jnz	wrdd4
	call	ddend		;get end packet
	jc	wrdd7		;whoops
	cmp	al,-17d		;data check error?
	je	wrdd7		;yes (the only recoverable one)
	cmp	al,2		;0 or 1?  (OK endings)
	cmc			;CF=0 if so
	mov	es,ds:ddptr+2	;get seg
	ret			;CF is already set
wrdd5:	; flag is something other than CONTINUE
	cmp	al,2		;control?
	jne	wrdd7		;no, reset and retry
	call	ddend1		;presumably end packet
	jc	wrdd7		;bad end packet, maybe it wasn't bad news
	cmp	al,-17d		;data check error?
	je	wrdd7		;yes, retry
wrdd6:	stc			;CF=1
	ret
wrdd7:	; timeout, error, or protocol error -- retry
	call	ddinit		;reinit
	mov	ax,ds:ddptr	;get curr ptr
	cmp	ax,ds:ddsav	;same as starting posn?
	mov	ax,ds:ddctr	;[get # bytes to go]
	mov	bx,ax		;[copy]
	je	$+5		;yes, there's no prev block to resend
	 add	ax,128d		;include prev data packet
	add	ax,777		;round to prev blk boundary
	and	ax,not 777
	mov	ds:ddctr,ax	;update
	mov	cx,ax		;save
	sub	ax,bx		;find # bytes already transferred in this blk
	sub	ds:ddptr,ax	;back up
	cmp	cx,ds:dderr	;same place we started at last time?
	jne	wrdd8
	dec	ds:ddtry	;yes, count this try
	jz	wrdd6		;the hell with this
	jmp	wrdd3		;try again
wrdd8:	mov	ds:dderr,cx	;remember where we are
	jmp	wrdd2		;give it another try
;
dddata	db	1,128d		;data packet header
;+
;
; Get end packet, return CF=1 if timeout (or not end).
; Otherwise return success code in al.
;
;-
ddend:	mov	ds:ddtime,9d	;1/2 sec timeout
	push	ds		;copy DS to ES
	pop	es
	mov	di,ds:dbuf	;pt at data buf
	mov	cx,1		;count
	xor	bx,bx		;init checksum
	xor	ah,ah		;even byte
	call	rdd		;get command byte
	jc	ddend2
	and	al,37		;trim to 5 bits
	cmp	al,2		;control?
	jne	ddend2		;no
ddend1:	; enter here if above was already done
	mov	ds:ddtime,9d	;1/2 sec timeout (again)
	inc	cx		;get length byte
	call	rdd
	jc	ddend2		;timeout
	mov	cl,[di-1]	;get length
	cmp	cl,10d		;must be 10.
	jne	ddend2
	call	rdd		;get the rest of the packet
	jc	ddend2
	push	bx		;save checksum
	mov	cl,2		;get checksum
	call	rdd
	pop	ax		;restore
	jc	ddend2
	cmp	ax,[di-2]	;does it match?
	jne	ddend2
	mov	al,[di-11d]	;yes, get success code
	cmp	al,-8d		;bad unit #?
	je	ddend3
	cmp	al,-9d		;missing cartridge?
	je	ddend4
	cmp	al,-11d		;write protected?
	je	ddend5
	cmp	al,-32d		;seek error?
	je	ddend6
	clc
	ret
ddend2:	stc			;error return
	ret
ddend3:	jmp	baddrv
ddend4:	jmp	notrdy
ddend5:	jmp	wrperr
ddend6:	jmp	sekerr
;+
;
; Send a string to a TU58.
;
; ah	low bit=0 if starting byte is even (updated on return)
; bx	checksum (updated one byte at a time depending on ah)
; es:si	string
; cx	length
; ss:bp	log dev rec
;
;-
sdd:	mov	dx,ss:port[bp]	;get port
sdd1:	add	dx,5
sdd2:	in	al,dx		;read port
	test	al,40		;can we write a byte?
	jz	sdd2		;spin if not
	sub	dx,5		;pt at data port
	lods	byte ptr es:[si] ;get a byte
	out	dx,al
	test	ah,1		;even or odd?
	jnz	sdd3
	add	bl,al		;even, add to low byte
	adc	bh,0
	jmp	short sdd4
sdd3:	add	bh,al		;odd, add to high byte
sdd4:	adc	bx,0		;end-around
	inc	ah		;flip low bit
	loop	sdd1		;around for next
	ret
;+
;
; Receive a string from a TU58.
;
; ah	low bit=0 if starting byte is even (updated on return)
; bx	checksum (updated one byte at a time depending on ah)
; es:di	buffer addr (updated on return)
; cx	# bytes to receive
; ss:bp	log dev rec
; CS:DDTIME  # clock ticks to wait before timing out.
;
; CF=1 on timeout.
;
;-
rdd:	push	ds		;save
	push	bp
	xor	si,si		;point at BIOS data
	mov	ds,si
	mov	dx,ss:port[bp]	;get port
rdd1:	add	dx,5
	mov	bp,cs:ddtime	;get timeout in clock ticks
rdd2:	mov	si,ds:timer_low	;read timer
rdd3:	in	al,dx		;read port
	test	al,1		;is a byte ready?
	jz	rdd6		;skip if not
	sub	dx,5		;pt at data port
	in	al,dx		;get the byte
	stosb			;save it
	test	ah,1		;even or odd?
	jnz	rdd4
	add	bl,al		;even, add to low byte
	adc	bh,0
	jmp	short rdd5
rdd4:	add	bh,al		;odd, add to high byte
rdd5:	adc	bx,0		;end-around
	inc	ah		;flip low bit
	loop	rdd1		;around for next
	pop	bp		;restore
	pop	ds
	clc			;no error
	ret
rdd6:	; see if it's time to time out
	cmp	si,ds:timer_low	;has timer changed?
	je	rdd3		;spin if not
	dec	bp		;timed out yet?
	jnz	rdd2
	pop	bp
	pop	ds
	stc			;timeout
	ret
;
	subttl	pure data
;
crlfs	db	cr,lf
r50	db	' ABCDEFGHIJKLMNOPQRSTUVWXYZ$.?0123456789:' ;radix 50
months	db	'XXXJanFebMarAprMayJunJulAugSepOctNovDecXXXXXXXXX'
inifil	db	'PUTR.INI',0	;name of init file
dotcmd	db	'.CMD',0	;default extension for "@"
dotdsk	db	'.DSK',0	;default extension for disk image files
scsimg	db	'SCSIMGR$',0	;name of ASPI handler
badprm	db	'invalid drive'	;use this prompt prompt after errors
;
sgnrt	db	'DECRT11A    '	;signature in RT-11 disks, blk 1, offset 760
sgnvex	db	'DECVMSEXCHNG'	;signature in VMS EXCHANGE RT-11 disks, " " " "
				;(thanks to Tim Shoppa <shoppa@triumf.ca>)
sgnods	db	'DECFILE11A  '	;signature in ODS-1 disks, blk 1, offset 760
;
; Sector interleave tables:
ilv11	db	01d,02d,03d,04d,05d,06d,07d,08d,09d,10d ;1:1 table
	db	11d,12d,13d,14d,15d,16d,17d,18d,19d,20d
	db	21d,22d,23d,24d,25d,26d,27d,28d,29d,30d
	db	31d,32d,33d,34d,35d,36d
;
; Table to translate floppy drive types from AT CMOS memory to our numbers
;
fdcmos	db	0	;0 no drive
	db	rx31	;1 360KB 300 RPM
	db	rx33	;2 1.2MB 360 RPM (maybe 300 RPM too, FDC's problem)
	db	rx24	;3 720KB 3.5" 300 RPM
	db	rx23	;4 1.44MB 300 RPM
	db	rx26	;5 2.88MB 300 RPM
	db	10d dup(0) ;6-F unknown
;
; disk parameter table for RX50 floppies in 1.2MB drive (INT 1Eh)
;
if 0 ;; not used (we don't use BIOS, except for its ISR)
dparm	db	0DFh,02h	;specify bytes
	db	25h		;motor turn-on time
	db	2,10d		;512 b/s, 10 sec/tk
	db	20d		;gap length
	db	-1		;max transfer
	db	24d		;gap length (format)
	db	0E5h		;fill byte (format)
	db	15d		;head settle (ms)
	db	8d		;motor start time (1/8 sec)
endif
;
dosvec	label	word		;file I/O vectors for DOS
_=iovecs
	disp	defset,dosds
	disp	savcwd,dossav
	disp	rstcwd,dosrst
	disp	volnam,dosvn
	disp	gdir,dosgd
	disp	dirhdr,dosdh
	disp	dirinp,dosdi
	disp	dirget,dosdg
	disp	dirdis,dosdd
	disp	diremp,dosdd	;subdirectories are reported as empty blocks
	disp	dirnam,dosdn
	disp	dirfin,cret
	disp	dirsum,dossum
	disp	open,dosop
	disp	read,dosrd
	disp	reset,dosrs
	disp	dirout,cret
	disp	create,doscr
	disp	write,doswr
	disp	wlast,cret
	disp	close,doscl
	disp	delfil,dosdl
	disp	chdir,doscd
	disp	wboot,noboot
	disp	wipout,nowipe
;
frvecs	label	word		;file I/O vectors for FOREIGN volumes
_=iovecs
	disp	defset,cret
	disp	savcwd,cret
	disp	rstcwd,cret
	disp	volnam,nolbl
	disp	gdir,cret
	disp	dirhdr,ilfunc
	disp	dirinp,cret
	disp	dirget,ilfunc
	disp	dirdis,ilfunc
	disp	diremp,ilfunc
	disp	dirnam,cret
	disp	dirfin,cret
	disp	dirsum,ilfunc
	disp	open,ilfunc
	disp	read,ilfunc
	disp	reset,ilfunc
	disp	dirout,cret
	disp	create,ilfunc
	disp	write,ilfunc
	disp	wlast,ilfunc
	disp	close,ilfunc
	disp	delfil,ilfunc
	disp	chdir,ilfunc
	disp	wboot,ilfunc
	disp	wipout,ilfunc
;
osvecs	label	word		;file I/O vectors for OS/8
_=iovecs
	disp	defset,osds
	disp	savcwd,ossav
	disp	rstcwd,osrst
	disp	volnam,nolbl
	disp	gdir,cret
	disp	dirhdr,osdh
	disp	dirinp,osdi
	disp	dirget,osdg
	disp	dirdis,osdd
	disp	diremp,osde
	disp	dirnam,cret
	disp	dirfin,osdf
	disp	dirsum,ossum
	disp	open,osop
	disp	read,osrd
	disp	reset,cret
	disp	dirout,osdo
	disp	create,oscr
	disp	write,oswr
	disp	wlast,oswl
	disp	close,oscl
	disp	delfil,osdl
	disp	chdir,cret ;;; actually should be error
	disp	wboot,noboot ;;;
	disp	wipout,rtwp
;
rsvecs	label	word		;file I/O vectors for RSTS/E
_=iovecs
	disp	defset,rsds
	disp	savcwd,rssav
	disp	rstcwd,rsrst
	disp	volnam,rsvn
	disp	gdir,rsgd
	disp	dirhdr,rsdh
	disp	dirinp,rsdi
	disp	dirget,rsdg
	disp	dirdis,rsdd
	disp	diremp,cret
	disp	dirnam,rsdn
	disp	dirfin,rsdf
	disp	dirsum,rssum
	disp	open,rsop
	disp	read,rsrd
	disp	reset,cret
	disp	dirout,rsdo
	disp	create,cret ;;;;
	disp	write,cret ;;;;
	disp	wlast,cret ;;;;
	disp	close,cret ;;;;
	disp	delfil,cret ;;;;
	disp	chdir,rscd
	disp	wboot,noboot ;;;;;
	disp	wipout,nowipe ;;;;
;
rtvecs	label	word		;file I/O vectors for RT-11
_=iovecs
	disp	defset,rtds
	disp	savcwd,rtsav
	disp	rstcwd,rtrst
	disp	volnam,rtvn
	disp	gdir,rtgd
	disp	dirhdr,rtdh
	disp	dirinp,rtdi
	disp	dirget,rtdg
	disp	dirdis,rtdd
	disp	diremp,rtde
	disp	dirnam,rtdn
	disp	dirfin,rtdf
	disp	dirsum,rtsum
	disp	open,rtop
	disp	read,rtrd
	disp	reset,cret
	disp	dirout,rtdo
	disp	create,rtcr
	disp	write,rtwr
	disp	wlast,rtwl
	disp	close,rtcl
	disp	delfil,rtdl
	disp	chdir,rtcd
	disp	wboot,rtboot
	disp	wipout,rtwp
;
; ASPI cmd to get dev type
dvtyp	db	1		;cmd=1 (get device type)
	db	0		;(status byte)
	db	0		;HA #
	db	0		;SCSI req flags
	dd	0		;rsvd
	db	0		;target ID
	db	0		;LUN
	db	0		;type byte returned here
ldvtyp=	$-dvtyp
;
	subttl	impure data -- initialized but will change
;
fdtype	db	4 dup(0)	;drive types of floppies A-D (0 if unknown)
				;possibilities:  RX31 RX33 RX24 RX23 RX26
;
dosroo	db	?,':\'		;root dir wildcard (for VOLSER)
wldcrd	db	'*.*',0		;wildcard
;
jan	db	31d
feb	db	?		;poked by DOSDAT
	db	31d,30d,31d,30d,31d,31d,30d,31d,30d,31d
;
logdev	dw	0		;ptr to linked list of logical dev records
tmpdev	dw	0		;temporarily alloced dev rec (may become perm)
frerec	dw	0		;ptr to list of freed logical dev records
fremem	dw	mem		;start of free memory
kepmem	dw	mem		;FREMEM value to keep between cmds
;
dbuf	dw	dbuf1		;ptr to begn of disk sector buffer
;
bindef	dw	text		;default BINFLG value for COPY
;
more	db	1		;NZ => MORE processing enabled
;
dsmunl	db	0		;NZ => DISMOUNT/UNLOAD is default
				;0 => DISMOUNT/NOUNLOAD is default
;
nprmpt	db	0		;NZ => no valid prompt
				;(don't loop forever on error retrieving CWD)
;
cc4fdc	db	1		;NZ => FDC is CompatiCard IV
				;(normally it's OK to write the CC4 ctrl reg
				;since it doesn't exist on generic FDCs, so the
				;default is NZ, but you can SET FDC GENERIC if
				;you've got something that doesn't like writes
				;to I/O port 3F0h
;
; Parameters for COPY/DEV/FILE/BIN.  Patchable, or I'll add SET commands if
; more than a couple of people ever care.
	db	'COPILV'	;(for searching with DEBUG or SYMDEB)
copilv	db	2		;sector-to-sector interleave, >=1
copskw	db	2,0		;track-to-track skew, with a 0 for MUL WORD PTR
;
aspi	dw	0,0		;ptr to ASPI driver entry point, or 0:0 if none
;
; ASPI host adapter inquiry command:
hainq	db	0		;cmd=0 (host adapter inquiry)
	db	0		;(status byte, overwritten)
	db	0		;HA #
	db	0		;SCSI req flags
	dw	0AA55h		;horrible hack to allow add'l length
	dw	2		;# add'l flag bytes to return
lhainq=	$-hainq
;
; ASPI cmd to get dev capacity
rdcap	db	2		;cmd=2
	db	0		;(status byte)
	db	0		;HA #
	db	14		;SCSI req flags (read, residual)
	dd	0		;rsvd
	db	0		;target ID
	db	0		;LUN
	dw	8d,0		;data allocation length (two longwords)
	db	14d		;sense allocation length
	dw	buf		;data buffer offset
rdcap1	dw	?		;data buffer segment (filled in later)
	dd	0		;SRB link ptr
	db	10d		;CDB length (long form cmd)
	db	0		;(host adapter status returned)
	db	0		;(target status returned)
	dd	0		;post routine addr (not used)
	db	22h dup(0)	;rsvd for workspace
	; SCSI command descriptor block
	db	25h		;cmd=read capacity
	db	0		;LUN, RelAdr=0
	dd	0		;starting blk # of logical unit
	db	0,0,0		;reserved, PMI=0
	db	0		;control:  1=FLAG, 0=LINK
	; sense data
;	db	14d dup(?)	;sense data
lrdcap=	$-rdcap
;
; ASPI cmd to start/stop unit
ssunt	db	2		;cmd=2
	db	0		;(status byte)
	db	0		;HA #
	db	0		;SCSI req flags
	dd	0		;rsvd
	db	0		;target ID
	db	0		;LUN
	dw	0,0		;data allocation length (none)
	db	14d		;sense allocation length
	dw	buf		;data buffer offset
ssunt1	dw	?		;data buffer segment (filled in later)
	dd	0		;SRB link ptr
	db	6d		;CDB length (short form cmd)
	db	0		;(host adapter status returned)
	db	0		;(target status returned)
	dd	0		;post routine addr (not used)
	db	22h dup(0)	;rsvd for workspace
	; SCSI command descriptor block
	db	1Bh		;cmd=start/stop unit
	db	0		;LUN, Immed=0
	db	0
	db	0
	db	2		;LoEj=1, Start=0
	db	0		;control:  1=FLAG, 0=LINK
	; sense data
;	db	14d dup(?)	;sense data
lssunt=	$-ssunt
;
if 1
;
; This might be an ASPI cmd to write prot/enable a Zip disk.
; But who knows!
wpzip	db	2		;cmd=2
	db	0		;(status byte)
	db	0		;HA #
	db	0		;SCSI req flags
	dd	0		;rsvd
	db	0		;target ID
	db	0		;LUN
wpzipl	dw	0,0		;data allocation length
	db	14d		;sense allocation length
	dw	buf		;data buffer offset
wpzip1	dw	?		;data buffer segment (filled in later)
	dd	0		;SRB link ptr
	db	6d		;CDB length (short form cmd)
	db	0		;(host adapter status returned)
	db	0		;(target status returned)
	dd	0		;post routine addr (not used)
	db	22h dup(0)	;rsvd for workspace
	; SCSI command descriptor block
	db	0Ch		;cmd=vendor unique
	db	0		;LUN, Immed=0
	db	0
	db	0
wpzips	db	0		;string length
	db	0		;control:  1=FLAG, 0=LINK
	; sense data
;	db	14d dup(?)	;sense data
lwpzip=	$-wpzip
endif
;
; Short (6-byte) I/O cmd SCSI req block
iosht	db	2		;cmd=2
	db	0		;(status byte)
	db	0		;HA #
	db	0;10		;SCSI req flags (read)
	dd	0		;rsvd
	db	0		;target ID
	db	0		;LUN
ioshtl	dw	0,0		;data allocation length
	db	14d		;sense allocation length
ioshta	dw	?		;data buffer offset
	dw	?		;data buffer segment (filled in later)
	dd	0		;SRB link ptr
	db	6		;CDB length (short form cmd)
	db	0		;(host adapter status returned)
	db	0		;(target status returned)
	dd	0		;post routine addr (not used)
	db	22h dup(0)	;rsvd for workspace
	; SCSI command descriptor block
ioshtc	db	?		;cmd=read(6) (08h) or write(6) (0Ah)
	db	0		;<7:5>=LUN <4:0>=MSB of sector #
	db	0		;middle byte of sector #
	db	0		;LSB of sector #
	db	0		;# sectors
	db	0		;control:  1=FLAG, 0=LINK
	; sense data
;	db	14d dup(?)	;sense data
liosht=	$-iosht
;
; Long (10-byte) I/O cmd SCSI req block
iolng	db	2		;cmd=2
	db	0		;(status byte)
	db	0		;HA #
	db	0;10		;SCSI req flags (read)
	dd	0		;rsvd
	db	0		;target ID
	db	0		;LUN
iolngl	dw	0,0		;data allocation length
	db	14d		;sense allocation length
iolnga	dw	?		;data buffer offset
	dw	?		;data buffer segment (filled in later)
	dd	0		;SRB link ptr
	db	10d		;CDB length (long form cmd)
	db	0		;(host adapter status returned)
	db	0		;(target status returned)
	dd	0		;post routine addr (not used)
	db	22h dup(0)	;rsvd for workspace
	; SCSI command descriptor block
iolngc	db	?		;cmd=read(10) (28h) or write(10) (2Ah)
	db	0		;<7:5>=LUN, DPO=0, FUA=0, RelAdr=0
	dd	0		;sector # (MSB first)
	db	0		;reserved
	db	0		;MSB of # sectors
	db	0		;LSB of # sectors
	db	0		;control:  1=FLAG, 0=LINK
	; sense data
;	db	14d dup(?)	;sense data
liolng=	$-iolng
;
resbc	db	0		;NZ => ASPI driver supports residual byte cnts
;
; MLOOP DIRFINs these if it finds them NZ:
indev	dw	0		;input dev rec ptr
outdev	dw	0		;output dev rec ptr
;
; MLOOP closes these if it finds them >=0:
inhnd	dw	-1		;input file handle or -1 if closed
outhnd	dw	-1		;output file handle or -1 if closed
;
indhnd	dw	-1		;indirect file handle or -1 if closed
;
fdccl	db	4 dup(-1)	;current cyl for each floppy, or -1 if unknown
;
kbbuf	db	80d,?,80d dup(?) ;INT 21(0A) record
;
	subttl	pure storage
;
; date stuff for decoding OS/8 "year" field in dir entry
year	dw	1 dup(?)	;this year
yrbase	dw	1 dup(?)	;most recent year that was 1970+mult of 8
day	db	1 dup(?)	;day within month
	db	1 dup(?)	;month (accessed with DAY as a word)
;
min	db	1 dup(?)	;minute
hour	db	1 dup(?)	;hour (MUST FOLLOW MIN)
sec	db	1 dup(?)	;second
;
curdsk	db	1 dup(?)	;drive letter if current dev is DOS disk
				;0 if not
dosdsk	db	1 dup(?)	;logged-in DOS disk (MUST FOLLOW CURDSK)
swchar	db	1 dup(?)	;SWITCHAR
;
dirflg	db	1 dup(?)	;DIRECTORY listing flags
;
; input file stuff:
ndent	dw	1 dup(?)	;# dir entries left in this seg (OS/8)
inseg	db	1 dup(?)	;input seg #
oinseg	db	1 dup(?)	;old INSEG from previously DIRGETted file
inent	dw	1 dup(?)	;ptr to next dir entry
oinent	dw	1 dup(?)	;old INENT from previously DIRGETted file
pextra	dw	1 dup(?)	;ptr to most recent extra word(s)
stblk	dw	2 dup(?)	;absolute starting blk of current file
fsize	dw	2 dup(?)	;current file size (sys-dependent units)
fbcnt	dw	2 dup(?)	;current file size (in 8-bit bytes)
matchf	dw	1 dup(?)	;NZ if next match found, 0 if not (DOS)
iretr	dw	8d dup(?)	;RSTS retrieval window (link + 7 DCNs)
irptr	dw	1 dup(?)	;ptr into IRETR (0, 2, 4, 6, ...)
iattr	dw	1 dup(?)	;link to first attribute blkette (RSTS)
idla	dw	1 dup(?)	;date of last access (DOS-11 form)
ifcs	dw	1 dup(?)	;file cluster size
irts	dw	2 dup(?)	;RTS name
badsec	dw	2 dup(?)	;# bytes to reserve for bad sec file (FORMAT)
;
iblk	dw	2 dup(?)	;input file curr blk #
isize	dw	2 dup(?)	;input file size in blocks
ieof	db	1 dup(?)	;NZ => soft EOF reached
iseg	dw	1 dup(?)	;input dir curr seg #
optr	dw	1 dup(?)	;output ptr (into LBUF)
col	db	1 dup(?)	;column # in WTTY
;
; stuff used by RTRDIR/RTWDIR and related routines:  (and OSRDIR/OSWDIR)
dirseg	db	1 dup(?)	;temporary dir seg #
dirsiz	dw	1 dup(?)	;size of directory in BIGBUF in bytes
dirent	dw	1 dup(?)	;size in bytes of each dir entry in BIGBUF
dircnt	dw	1 dup(?)	;dir entry loop counter while handling BIGBUF
inptr	dw	1 dup(?)	;BIGBUF offset corresponding to INSEG,INENT
iptr1	dw	1 dup(?)	;updated INPTR during dir modification
outptr	dw	1 dup(?)	;BIGBUF offset corresponding to OUTSEG,OUTENT
optr1	dw	1 dup(?)	;updated OUTPTR during dir modification
;
outseg	db	1 dup(?)	;output seg #
outent	dw	1 dup(?)	;offset into seg # OUTSEG of output dir entry
oblk	dw	2 dup(?)	;curr blk # in output dev (starts at BOF)
osize	dw	2 dup(?)	;# blocks left in this < UNUSED > area
owrtn	dw	1 dup(?)	;# blocks written
;
rsblk	dw	2 dup(?)	;RSTS blk # (during MFD search in RDS 0.0)
;
rtfile	dw	4 dup(?)	;RT-11 filename (3 words .RAD50)
				;or OS/8 filename (4 words TEXT)
;
rtdnam	dw	3 dup(?)	;dir name, RADIX-50 (RT-11)
rtdsep	dw	1 dup(?)	;dir separator flag
;
; Stuff saved by SAVCWD and RSTCWD:
savdir	dw	2 dup(?)	;dir base blk # (RT-11)
svdirh	dw	2 dup(?)	;(MSW of base blk #)
savsiz	dw	2 dup(?)	;size of dir file (or partition if root)
savwnd	dw	2*8d dup(?)	;saved dir clu, retrieval pointers (RSTS)
;
notfnd	db	1 dup(?)	;NZ until a match is find in wildcard lookup
noqry	db	1 dup(?)	;NZ => don't ask before doing something
ovride	db	1 dup(?)	;NZ => override protection
devflg	db	1 dup(?)	;b0 => copy whole dev, b7 => src or dst is file
;
; File date/time info set up by the various DIRGET routines:
;
ftimf	db	1 dup(?)	;NZ => file time is valid
fdatf	db	1 dup(?)	;NZ => file date is valid (MUST FOLLOW FTIMF)
fsec	db	1 dup(?)	;file seconds,
fmin	db	1 dup(?)	;minutes,
fhour	db	1 dup(?)	;hours (0-23.) (MUST FOLLOW FMIN)
fday	db	1 dup(?)	;file day,
fmonth	db	1 dup(?)	; month, (MUST FOLLOW FDAY)
fyear	dw	1 dup(?)	;and year (all 4 digits)
fattr	db	1 dup(?)	;file attrib (DOS, RSTS)
fprot	db	1 dup(?)	;file protection code (RSTS)
.assume <fprot eq fattr+1>	;RSDG stores these as a word
;
nfile	dw	1 dup(?)	;# files printed in DIR listing
nblk	dw	2 dup(?)	;# blocks " " "
nfree	dw	1 dup(?)	;# free blocks
;
; filename buffers:
fname1	db	80d dup(?)	;#1
fname2	db	80d dup(?)	;#2
fname3	db	80d dup(?)	;#3
fname4	db	80d dup(?)	;#4
;
dosfil	db	80d dup(?)	;.ASCIZ result of DOSDG
;
; Temp area for GMOUNT (stores switches etc. from parsing MOUNT command)
;
tarea	label	word
tdev	dw	2 dup(?)	;logical device name, flag,,unit
tfsys	dw	1 dup(?)	;disk structure type (RT11, OS8 etc.)
tmed	dw	1 dup(?)	;disk medium type (RX50, etc.)
tfnam	dw	2 dup(?)	;image filename ptr, length
tdrv	dw	1 dup(?)	;drive # +100h
tbpart	dw	1 dup(?)	;BIOS partition # +100h
ttype	dw	1 dup(?)	;partition type +100h
tintlv	dw	1 dup(?)	;interleaved image file flag +100h
tpart	dw	1 dup(?)	;RT-11 MSCP partition #
tronly	dw	1 dup(?)	;read-only astatus +100h
ltarea=	($-tarea)		;length in bytes
tdnam	dw	1 dup(?)	;buf for 'A:' or whatever if drv not given
;
numfd	db	1 dup(?)	;# of floppy drives
maxfd	db	1 dup(?)	;max valid floppy drive letter (others are HDs)
numhd	db	1 dup(?)	;# of hard drives
firhd	db	1 dup(?)	;unit # (from 0) of first HD (after floppy/ies)
lethd	db	1 dup(?)	;physical drive letter of first HD
;
; Floppy formating variables:
flpvec	dw	1 dup(?)	;ptr to routine to make sector interleave table
				;in FMTFLP, or ptr to I/O routine in SECXFR
flphd	db	1 dup(?)	;curr head #
flpcyl	db	1 dup(?)	;curr cyl # (MUST FOLLOW FLPHD)
;
; Floppy data:
;
necbuf	db	9d dup(?)	;765 I/O buffer
fdden	db	1 dup(?)	;MFM for DD, FM for SD
fdcmd	dw	1 dup(?)	;FDC read/write/verify cmd,,DMA cmd
;;fdadr	dw	1 dup(?)	;offset of buffer addr
fdtry	db	1 dup(?)	;retry count
fdrst	db	1 dup(?)	;NZ => FDC has been reset since last prompt
;
fddrv	db	1 dup(?)	;drive # (0-3)
fdsec	db	1 dup(?)	;sector # (1-36.)
fdcyl	db	1 dup(?)	;cyl # (0-79.) (MUST FOLLOW FDSEC)
fdnum	db	1 dup(?)	;number of sectors to transfer (not used)
fdhd	db	1 dup(?)	;head # (0-1) (MUST FOLLOW FDNUM)
fdlen	db	1 dup(?)	;sector length (0=128., 1=256., 2=512.)
fdeot	db	1 dup(?)	;sectors/track (MUST FOLLOW FDLEN)
fdgpl	db	1 dup(?)	;gap 3 length
fddtl	db	1 dup(?)	;max transfer length (MUST FOLLOW FDGPL)
fdspc	dw	1 dup(?)	;"specify" cmd argument bytes
fdspn	db	1 dup(?)	;NZ => wait for motor to spin up before xfr
fdmtr	dw	1 dup(?)	;# ticks to wait for motor to turn on (write)
fdgpf	db	1 dup(?)	;gap 3 length for format
fdfil	db	1 dup(?)	;filler byte for format (MUST FOLLOW FDGPF)
fddcr	db	1 dup(?)	;value for disk control reg (3F7)
				;0 => 500kHz/360RPM (HD)
				;1 => 250kHz/300RPM or 300kHz/360RPM (DD in HD)
				;2 => 250kHz/300RPM (DD in DD)
				;3 => 1MHz/300RPM (ED)
fdvrt	db	1 dup(?)	;FF => vertical mode (ED), 00 => longitudinal
;
cc4ctl	db	1 dup(?)	;value to write to CompatiCard IV control port
				;at 3F0h (gets overwritten on each write to the
				;digital output reg at 3F2h)
				;b0 => controls HD34 pin 2 (DB37 pin 3)
				;b1 => controls HD34 pin 6 (DB37 pin 5)
				;      on my board, only works for the external
				;      connectors but tracing out the PCB it
				;      looks like this is due to a fried driver
				;      in one of the 7407s, it's *supposed* to
				;      drive both
				;b2 => supposedly enables b0 but
				;      experimentation suggests that pin 2 is
				;      just the OR of b0 and b2
				;b3 => either un-tristates DRQ or enables
				;      writes to an SRAM/EEPROM in the EPROM
				;      socket depending on which doc you
				;      believe, experimentation suggests the
				;      former so it should be set
;
; TU58 data:
;
ddtime	dw	1 dup(?)	;# clock ticks to wait for TU58 input
ddblk	dw	1 dup(?)	;TU58 blk #
ddptr	dw	2 dup(?)	;far ptr into TU58 data buf
ddctr	dw	1 dup(?)	;# TU58 bytes left to transfer
ddtry	dw	1 dup(?)	;retry count for this starting blk #
dderr	dw	1 dup(?)	;remaining byte count at last xfr error
ddsav	dw	1 dup(?)	;saved DDPTR on each write (for retries)
;
lnum	db	1 dup(?)	;count of lines until next **MORE**
lmax	db	1 dup(?)	;# lines between **MORE**s
;
dvsr0	dw	1 dup(?)	;LSW of divisor in DIV32
dvsr1	dw	1 dup(?)	;MSW of divisor in DIV32
;
secnum	dw	2 dup(?)	;SCSI starting sector number
secoff	dw	2 dup(?)	;starting offset into first sector of xfr
;
himem	dw	1 dup(?)	;first unusable memory loc
;
binflg	dw	1 dup(?)	;BIN or TEXT (set transfer mode)
bigbuf	dw	1 dup(?)	;seg addr of big file I/O buffer
bigsiz	dw	2 dup(?)	;length of BIGBUF in bytes
bigptr	dw	2 dup(?)	;far ptr into BIGBUF
bigctr	dw	2 dup(?)	;# bytes free in BIGBUF
aread	dw	1 dup(?)	;address of READ routine in FCOPY
awrite	dw	1 dup(?)	;address of WRITE routine in FCOPY
awlast	dw	1 dup(?)	;address of WLAST routine in FCOPY
secflg	db	1 dup(?)	;NZ => sector-by-sector copy in ICOPY
eof	db	1 dup(?)	;NZ => EOF reached
binswt	db	1 dup(?)	;NZ => /BINARY or /ASCII explicitly given
unlswt	db	1 dup(?)	;NZ => /UNLOAD given
indptr	dw	1 dup(?)	;address of next character in INDBUF
indctr	dw	1 dup(?)	;# characters remaining in INDBUF
othswt	dw	1 dup(?)	;ptr to table of "other" switches in GMOUNT
nsegs	dw	1 dup(?)	;# segs in RT-11 directory (INIT /SEGS:n)
;
indbuf	db	indsiz dup(?)	;indirect file buffer
;
lbuf	db	80d+4+1 dup(?)	;temp line buffer (+4+1 to add "/.EXT/<0>")
;
buf	db	bufsiz dup(?)	;random buffer (for RT-11 dir segs in RTDIR)
				;and other stuff
;
srb	db	(40h+10d+14d) dup(?) ;SCSI request block buffer
;
; buffer for one block of disk data, we allow almost enough space for 2 blks to
; guarantee that we can get 512. contiguous bytes w/o spanning a 64KB boundary
;
dbuf1	db	dbufl-1 dup(?)	;disk buffer is here (don't need last byte)
dbuf2	db	dbufl dup(?)	;or here if DBUF1 spans 64KB bound
;
	dw	100h dup(?)	;stack goes here
pdl	label	word
;
mem	label	byte		;free memory starts here
;
code	ends
	end	start
