Google
 

Trailing-Edge - PDP-10 Archives - tops10_integ_tools_v4_10jan-86 - 70,6067/tentap/tenvax.mac
There are 5 other files named tenvax.mac in the archive. Click here to see a list.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;			      TENVAX
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

title	TENVAX -- read and write VAX/ANSI files11 tapes.
;	barry ferris, science applications mar 1980
;	revised by Michael Massimilla, DEC, summer 1982
;	released by Bruce Collier, Internal Special Systems,
;	Application Systems Development


;	Revision Overview
;	Numbers in square brackets [] indicate a revision.
;	See revision history for corresponding revision descriptions.
;	Revisions before [21] are part of VAXINE (barry ferris).
;	Revisions [21] - [27] are part of TENVAX (mike massimilla).
;	Revision [28] is also part of TENVAX (Ken Pruyn).
;	Sections of code labelled  ((vaxine))  have undergone virtually no
;	changes in the transition from VAXINE to TENVAX.  Little attempt has
;	been made to improve the documentation of these sections or to alter
;	these sections in any other way.




;;;;;;;;;;;;;;;;;;;;;;;;  Assembly Information  ;;;;;;;;;;;;;;;;;;;;;;

subttl	Assembly Information				; ((vaxine))

; This section contains instructions to the assembler on how to build
; the software.  In addition to the TENVAX source, the following six files
; are required:  WILD.REL, SCAN.REL, HELPER.REL, MACTEN.UNV, SCNMAC.UNV,
; and UUOSYM.UNV.  The first three files are in disk area REL: and the
; last three are in UNV:.  The compiler automatically accesses the various
; files upon being told to COMPILE TENVAX.  After compiling TENVAX, the
; next step is to LOAD TENVAX.  Finally, SAVE TENVAX.  This process generates 
; the files TENVAX.REL (object) and TENVAX.EXE (image).  To run the image,
; say RUN TENVAX.  To debug the object with ddt, say DEBUG/DDT TENVAX.

custvr==0
decver==2		; major version
decmvr==0		; minor version
decevr==27		; edit number

	sall

	search	macten,uuosym,scnmac
	.require rel:wild,rel:scan,rel:helper
	sall

if1,<	..==%%scnm
ifndefn	..,<
	printx	? .compile macten.unv,uuosym.unv,scnmac.unv,scan,helper,wild
	pass2
	end>


	purge	..>

xp %%TENVAX,custvr*1b2+decver*1b11+decmvr*1b17+decevr

	twoseg

	loc	137
	exp	%%TENVAX
;
	loc 	124
	exp	cmdlop
;
	reloc
	mlon



;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Parameters  ;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Parameters

; [25] Changes:
;      Changed initialization block size from 512 to 2048 bytes.

lablen==^d20*4		;length of a label block in bytes
iniblk==^d2048		;[25] initialization block size in bytes
maxblk==^d4094		;[16] maximum block size in words
minblk==^d5		;[16] minimum block size in words
pad==136		;record pad character:  ^
fb$vfc=3		;variable record with fixed control
fb$fix=106		;fixed length records, ASCII "F"	[28]
fb$var=104		;Variable length records, ASCII "D"	[28]

	ifndef ftkl,<ftkl==0>



;;;;;;;;;;;;;;;;;;;;;;;;;;;  Revision History  ;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Revision History (through August 1982)

;	read and write VAX/ANSI FILES11 tapes
;
;
;[1]	Fixed Blocksize/uic problems to read VAX/VMS tapes
;
;[2]	Removed the DECIDE switch for reading tapes
;
;[3]	Made binary reads work right
;
;[4]	Made sure that WRITE does not try to write out files
;	with the extension SFD
;
;[5]	Made VAXINE read/write multi volume tapes
;	Added table of binary filenames for read/write to decied
;	  which files are binary
;
;
;[6]	Added code to handle Variable records with fixed control words
;	(usually VAX SOS files)
;
;[7]	Use blocksize from HDR2 record to set blocksize for tape using
;	TAPOP command.
;
;[10]	When reading binary files output a binary byte count to disk file
;
;	Use TAPOP instead of mtwat. for waiting for spaceing operations to
;	avoid suspected SA10 tape bug...
;
;[11]	Support reading of fixed binary/ascii files
;
;
;[12]	Expanded error message on reading header labels
;
;	Allow use of AND, OR, NOT on read/write/directory specs
;
;[13]	Put in support for optional HDR3/EOF3/EOV3 labels
;
;[14]	Make sure that ascii nulls are converted to blanks when
;	writing volume labels
;
;[15]	Add check on density setting to make sure at BOT and that
;	the drive is capable of that density.
;
;[16]	Added BLOCK n switch to set the blocksize in bytes for
;	output...maximum 4098*4 bytes
;	If default density on a drive is 6250...change density to 1600
;
;[17]	added conditional assembly switch (ftkl)
;	for kl/10 processors
;
;[20]	Save P1 at uic01:
;
;
;
; Revisions made during Summer 1982, by Michael Massimilla
;
;[21]   Fixed faulty truncation error when block size is exactly 4 bytes
;       greater than record size.
;
;[22]	Fixed multivolume labelling bugs which prevented file section number
;	from being updated. 
;
;[23]	Fixed VOL1 header.  Previously the information was being written in
;	the wrong character positions.
;
;[24]	Removed all references to the tape uic.
;	PDP-10 uics don't make sense for the VAX.
;
;[25]	Installed new structured (question-driven) user interface.
;	* Replaced verb-form command line scanner (.vscan) by prompt/response
;	  scanner (.pscan/.qscan).
;	* Reorganized and revised all error and status messages.
;	* Reorganized and revised parameter defaults.
;	* Changed name of utility from VAXINE to TENVAX.
;	* Changed name of EOT command to WIND.  The term 'eot' now used only to
;	  represent the logical end-of-tape (i.e. end of volume set) mark.
;	* Added flag to prevent READ, DIR, or WIND at end of volume set.
;	* Added flag to prevent INBUF call when doing INITAP for REWIND.
;
;[26]	Fixed multivolume block count labelling bug.  Block count in eof/eov
;	label should not be cumulative over file sections.
;
;[27]	Fixed filename labelling bug.  Filename as xxxxxx.xxx must be left
;	justified in 10-char HDR1 field with no interior spaces.
;
;[28]	Fixed errors associated with fixed length record tape input.
;	Program was looking in the wrong place in the header for the
;	wrong value. Also check for end of tape block was incorrect.
;	Previously only variable length worked. Now fixed and variable
;	length records only are supported.
;
;



;;;;;;;;;;;;;;;;;;;;;;;;  Accumulator Definitions  ;;;;;;;;;;;;;;;;;;;;;

subttl	Accumulator Definitions				; ((vaxine))


;	accumulator references

f=0	; flags
t1=1	; temporary
t2=2
t3=3
t4=4
p1=5	; preserved
p2=6
n=7	; word scanning result
c=10	; current break character
bcount=11
rcount=12
;=13
;=14
;=15
;=16
p=17	; stack pointer


; note that these accumulator definitions must mesh with
; scan and wild.

p3=7
p4=10



;;;;;;;;;;;;;;;;;;;;;;;  Lowseg Storage (sec. 1)  ;;;;;;;;;;;;;;;;;;;;

subttl	Lowseg Storage (sec. 1)				; ((vaxine))


	block	1	; leave the first word free for
			; superstitious reasons
offset:	block	1	; contains starting offset (0 or 1)
inicor:	block	1	; .jbff,,.jbrel
savdev:	block	1	; device from which run
savnam:	block	1	; file name
savlow:	block	1	; low extension
savppn:	block	1	; ppn
oblksz:	block	1	; block size in 36-bit words
oblkby:	block	1	; block size in 8-bit bytes



;;;;;;;;;;;;;;;;;;;;;;  Macro Definitions  ;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Macro Definitions				; ((vaxine))

ln$pdl==100		; push down list length
pdlist:	block	ln$pdl+1
lows:!			; low area start
define s$file($loc,$mnem),<
;; this definition is used for declaring areas for file
;; parameters.  $loc is 0 if not specified, 1 if verb
;; specified by no file spec given, and other non-zero
;; if file spec is given
$loc::	block	.fxlen	;; file storage spec with max length
mx.'$mnem==.fxlen
pd.'$mnem==1		;; no default
>

;
;	asci8 generates strings of 8  bit ascii
;
define asci8 (string) <
..y==0
..z==0
..a==0
..b==0
..c==0
..d==0
irpc string,<
	     ife <..z-"string">,< ..z=0
				 stopi>
	      ife <..y-4>,<..y=0
			   byte (8) ..a,..b,..c,..d
			   ..a=0
			   ..b=0
			   ..c=0
			   ..d=0>
	      ifn ..z,<
		      ..y==..y+1
		      ife <..y-1>,<..a=="string">
		      ife <..y-2>,<..b=="string">
		      ife <..y-3>,<..c=="string">
		      ife <..y-4>,<..d=="string">>
	      ife ..z,<..z="string">>

ifn <..y>,<byte (8) ..a,..b,..c,..d>
purge ..x,..y,..a,..b,..c,..d,..z >



;;;;;;;;;;;;;;;;;;;;;;  Lowseg Storage (sec. 2)  ;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Lowseg Storage (sec. 2)

; [25] Changes:
;      Added eorflg, newfil, and newvol ([21] and [22]).
;      Deleted tapuic ([24]).
;      Added token, prompt, hlpmsg, filcnt, rewflg, evsflg and savedp ([25]).
;      Added scnerr ([25]).
;      Deleted $decid and $quiet ([25]).
;      Added kilspc ([27]).

s.dest:	block	.fxlen		; scan storage for destination
u.dest:	block	.fxlen		; storage as fixed up by upd defaulter
opnblk:	block	3		; open block
lukblk:	block	.rbtim+1	; lookup, enter, or rename block
opnbl1:	block	3		; output open block
lukbl1:	block	.rbtim+1	; output enter block or rename
pthblk:	block	.ptmax		; max length of path
pthbl1:	block	.ptmax		; max length of path
bufhd1:	block	3
bufhdr:	block	3		; buffer headers
wldblk:	block	4	; wild block
wldfst:	block	1	; address of first file spec
wldlst:	block	1	; address of last file spec
wldptr:	block	1	; wild's pointer into the file specs.
tapset:	z		; had a tape command
blkseq:	z		; this is the number of blocks in a file
filsec:	z		; file section number in HDR1
filseq:	z		; file sequence on tape
dirflg:	z		; a dir command underway
ineov:	z		;we're process End of volume
wndflg:	z		; [25] this is a wind or rewind command
eorflg: z		; [21] record full?
newfil: z		; [22] new file (indicator for labelling)
newvol: z		; [22] new volume (indicator for labelling)
f$hdsz:	z		; number of bytes in VFC record
f$rsiz:	z		;record size from HDR2
fixflg:	z		; processing a fixed record file
wldflg:	block	1	;wild spec on read command
binflg:	block	1	;file is binary
savjff:	block	1	; copy of jobff
tapblk:	block	maxblk*2	; tape block
tapbl1:	block	maxblk*2	; tape block
blksze:	z			;block size in words from tape
tapfil:	block	1	; tape file name
tapext:	block	1	; tape file extention
tapdat:	block	1	;date from tape
tapiow:	block	1	; tape iowed
	block	1	; termination
prvrcw:	block	1	;positon of previous rcw in tapblk
lasrcw:	block	1	;position of rcw in tapblk
token:	block	1	;[25] token type
prompt:	block	1	;[25] prompt literal
hlpmsg:	block	1	;[25] help message
filcnt:	block	1	;[25] file count for scnfil
rewflg:	block	1	;[25] rewind flag for initap
evsflg:	block	1	;[25] end of volume set flag
savedp:	block	1	;[25] saved stack pointer	
scnerr:	block	1	;[25] scan error flag
kilspc:	block	1	;[27] kill spaces flag
lowe==.-1	; low area zero end
lowl=lowe-lows		; low area length



;;;;;;;;;;;;;;;;;;;;;;;;;;;  Tape Labels  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Tape Labels

; [25] Changes:
;      Realigned character positions in VOL1 label ([23]).
;      Changed machine code in VOL1 label from PDP-11 to PDP-10 ([23]).
;      Removed uic information from VOL1 label ([24]).
;      Removed default values from labels ([25]).
;      Deleted v.uic ([24]), and v.prot and v.cpu ([25]).

; NOTE:  A complete description of how the VAX writes tape labels can
; be found in the VAX-11 RMS Reference Manual, appendix B.


;
;	*** VOL1 ***
;

; Offsets
v.hdr==1		;header offset
v.nam==2		;volume name

; Prototype Label
; Note "asci8" macro must be given a multiple of 4 characters.
; KEY:	      .information.	;<x>  x is first character position of line
vol1:	asci8 .VOL1.		;<1> label identifier (<1>-<4>)
	asci8 .        .	;<5> volume name (<5>-<10>)
	asci8 .            .	;<13>
	asci8 .            . 	;<25>
	asci8 . D%A.		;<37> machine code is PDP10 ([rev.23])
	asci8 .          1 .	;<41> public access ([rev.24])
	asci8 .            .	;<53>
	asci8 .            .	;<65>
	asci8 .   3.		;<77>


;
; 	*** HDR1 ***
;

; Offsets
h1.hdr==1		;header
h1.file==2		;filename
h1.nam==6		;volume name
	..h1nam=^d7	;ending bit position of rightmost byte in offset
h1.sec==7		;section number
	..h1sec=^d23
h1.seq==10		;sequence number
	..h1seq=^d23
h1.date==13		;file date
	..h1date=^d15
h1.bcnt==16		;block count
	..h1bcnt=^d15

; Prototype Label
; KEY:	      .information.		;<x>  x is cp at beginning of line
hdr1:	asci8 .HDR1.			;<1> label identifier (<1>-<4>)
	asci8 .                .	;<5> filename (<5>-<14>)
	asci8 .    .			;<21> volume name (<22>-<27>)
	asci8 .   0.			;<25>
	asci8 .0010.			;<29> section number (<28>-<31>)
	asci8 .0010.			;<33> sequence number (<32>-<35>)
	asci8 .0010.			;<37> generation number (<36>-<39>)
	asci8 .0 00.			;<41> version number (<40>-<41>)
	asci8 .000 .			;<45> date (<43>-<47>)
	asci8 .0000.			;<49>
	asci8 .0 00.			;<53>
	asci8 .0000.			;<57> block count (<55>-<60>)
	asci8 .DECF.			;<61>
	asci8 .ILE1.			;<65>
	asci8 .1A  .			;<69>
	asci8 .        .		;<73>


;
;	*** HDR2 ***
;

; Offsets
h2.hdr==1		;header
h2.type==2		;file type is in word 2.		[28]
	..h2type==7	;					[28]
h2.blks==2		;block size in bytes
	..h2blks==7
h2.recs==3		;record size in bytes
	..h2recs==^d15
h2.forg==4		;file format
	..h2forg==^d23
h2.hsz==10		;number of bytes in vfc record
	..h2hsz==^d15

; Prototype Label
; KEY:	      .information.		;<x>  x is cp at beginning of line
hdr2:	asci8 .HDR2.			;<1> label identifier (<1>-<4>)
	asci8 .D000.			;<5> file type (<5>)
	asci8 .0000.			;<9> block size (<6>-<10>)
	asci8 .000 .			;<13> record size (<11>-<15>)
	asci8 .                .	;<17>
	asci8 .                .	;<33>
	asci8 .  00            .	;<49>
	asci8 .                .	;<65>



;
;	*** Other Labels ***
;
hdr3:	asci8 .HDR3.
  h3.hdr==1
eov1:	asci8 .EOV1.
eov2:	asci8 .EOV2.
eov3:	asci8 .EOV3.
eof1:	asci8 .EOF1.
eof2:	asci8 .EOF2.
eof3:	asci8 .EOF3.



;;;;;;;;;;;;;;;;;;;;;  Relocate To High Segment  ;;;;;;;;;;;;;;;;;;;;;;;;;

reloc	400000		; standard for 2-segment program  ((vaxine))



;;;;;;;;;;;;;;;;;;;;;;;  Miscellaneous Tables  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Miscellaneous Tables				; ((vaxine))

; Month Table - Month to number of days in year (for creating YYDDD format)
	radix 10
montab:	exp 0,31,59,90,120,151,181,212,243,273,303,334,365
	radix 8

; Table of Binary File Extensions
bintab:	sixbit 'obj'
	sixbit 'tsk'
	sixbit 'exe'
	sixbit 'sav'
	sixbit 'rel'
	sixbit 'bin'
binlen=.-bintab




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
;			Start of Executable Code
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;;;  Initialization  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Initialization

; General Initialization ((vaxine))
start:	tdza	t1,t1		; normal entry
	movei	t1,1		; t1 now contains starting offset
	movem	t1,offset	; store for scan
	reset			; clear out all devices
	skipe	savdev		; see if we know where we were run from
	 jrst	start1		; yes, we know already.
	movem	.sgdev,savdev	; no. save our current device
	movem	.sgnam,savnam	; get file name
	movem	.sglow,savlow	; save low extension
	movem	.sgppn,savppn	; get ppn.  note that the path
				; from which the program is run
				; is not saved.  (monitor problem)
start1:	hrrz	t1,.jbrel##	; get first-time core size
	hrl	t1,.jbff##	; and first free
	movem	t1,inicor	; save initial core
	store	17,0,16,0	; clear acs
	store	17,lows,lowe,0	; clear low area
	move	p,[iowd ln$pdl,pdlist]	; set up push down list
	move	t1,[2,,[iowd 1,['TENVAX']
		        offset,,'vax']]
	pushj	p,.iscan##	; initialize i/o scanner

; Greetings Message
	move	t1,sta.01		;[25] get message
	pushj	p,typel			;[25] type it

; Process external switch file "switch.ini"
	move	t1,[4,,scnblk]		; set up .oscan pointer
	pushj	p,.oscan##		; scan switch.ini if set

; [25] Have user specify tape drive, and automatically rewind.
	pushj	p,p.tape		; [25] get tape drive
	pushj	p,f.rewi		; [25] rewind tape

; [25] Enter main loop
	jrst	cmdlop			; [25] jump into main loop



;;;;;;;;;;;;;;;;;;;;;;;;;  Main Loop  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Main Loop

; Perform TENVAX functions repeatedly
cmdlop:	pushj	p,dofunc		; [25] do a TENVAX function
	jrst	cmdlop			; [25] and another ...



;;;;;;;;;;;;;;;;;;;;;;;;;;  Switches  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Switches

; Switches may adjoin file specifications for WRITE only.
; The switches accepted (defined by SCAN, not by TENVAX) are:
; /BEFORE  /SINCE  /ABEFORE  /ASINCE  /LENGTH  /ERNONE  /OKNONE

; [25] Changes:
;      Removed all of the Vaxine-specific switches.  The deleted Vaxine
;      switches were used as commands with the verb-form command scanner.
;      Those commands are now handled by DOFUNC, and by follow-up questions.

; NOTE:  What remains of this section is an empty switch table.  This is
; needed for the interface with SCAN to work properly.

define swtchs,<>		; no extra switches
doscan(vswit)			; expand the "define" macro (above)

; Pointers to reference tables generated by "doscan" (above).
scnblk:	iowd	vswitl,vswitn
	xwd	vswitd,vswitm
	xwd	0,vswitp
	exp	-1



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; [25] Deleted section ("yesno") to request yes/no for DECIDE switch.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



;;;;;;;;;;;;;;;;;;;;;;;;  Exchange Blocks  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Excblk						; ((vaxine))

excblk:	; exchange opnblk through lukblk with opnbl1 and lukbl1
	movei	t1,opnblk
	movei	t2,opnbl1
excbl1:	cain	t1,lukblk+.fxlen
	 popj	p,
	move	t3,(t1)
	exch	t3,(t2)
	movem	t3,(t1)
	aos	t2
	aoja	t1,excbl1




;;;;;;;;;;;;;;;;;  Set Up Output File Specification  ;;;;;;;;;;;;;;;;;;

subttl	Set Up Output File Spec				; ((vaxine))

updblk:	; this routine takes the file described in lukblk
	; and sets up opnbl1 and lukbl1 to "match"

	; setup of opnbl1 is not done yet


	setzm	opnbl1
	setzm	opnbl1+1
	setzm	opnbl1+2
	setzm	lukbl1
	move	t1,[xwd lukbl1,lukbl1+1]
	blt	t1,lukbl1+.rbtim+1-1
	setzm	pthbl1
	move	t1,[xwd pthbl1,pthbl1+1]
	blt	t1,pthbl1+.ptmax-1

	move	t1,[xwd s.dest,u.dest]
	blt	t1,u.dest+.fxlen-1	; copy spec
					; before changing things
	move	t1,u.dest+.fxnmm	; change a wild name
	setcm	t2,t1			; make a complement copy
	and	t1,u.dest+.fxnam	; bits specified become real
	and	t2,lukblk+.rbnam	; and wilds are gotten from input
	ior	t1,t2			; put these together
	movem	t1,u.dest+.fxnam
	setom	u.dest+.fxnmm		; so much for name
	hrlo	t1,u.dest+.fxext	; now extension
	setcm	t2,t1
	and	t1,u.dest+.fxext
	and	t2,lukblk+.rbext
	ior	t1,t2
	hllom	t1,u.dest+.fxext	; put back fixed extension
	; now check up on device part
	move	t4,u.dest+.fxmod	; get modifieres
	move	t2,opnblk+1		; get old device
	txnn	t4,fx.dir		; directory specified?
	 txne	t4,fx.ndv		; device specified?
	 skipa
	  jrst	ufdbl4			; no, use device path

	; now work on directory

	setz	t3,			; start at first one
ufdbl1:	cail	t3,.fxlnd		; make sure still in range
	 jrst	ufdbl2			; no
	lsh	t3,1			; make doubleword index
	move	t1,u.dest+.fxdir(t3)	; get directory
	move	t2,u.dest+.fxdim(t3)	; and its modifier
	lsh	t3,-1			; put back t3
	jumpe	t1,[jumpe t2,ufdbl2
		    jrst .+1]
	and	t1,t2
	setcmm	t2			; complement it
	and	t2,pthblk+.ptppn(t3)	; and put in appropriate ppn or sfd
	ior	t1,t2
	move	t2,t3
	add	t2,t3
	movem	t1,u.dest+.fxdir(t2)	; and store result
	setom	u.dest+.fxdim(t2)
	aoja	t3,ufdbl1		; and do next if needed

ufdbl4:	; here when no directory was specified on output
	; use device path directory
	pushj	p,ufdgdp
	setz	t3,
ufdbl5:	cail	t3,.fxlnd
	 jrst	ufdbl2
	move	t1,pthblk+.ptppn(t3)
	jumpe	t1,ufdbl2
	lsh	t3,1
	movem	t1,u.dest+.fxdir(t3)
	setom	u.dest+.fxdim(t3)
	lsh	t3,-1
	aoja	t3,ufdbl5

ufdbl2:	; done with directory, fix up modifier word
	movx	t1,fx.ndv!fx.nul!fx.dir
	andcam	t1,u.dest+.fxmod
	iorm	t1,u.dest+.fxmom	; clear these bits
	movx	t1,fx.dir
	skipe	u.dest+.fxdim
	iorm	t1,u.dest+.fxmod

	movei	t1,u.dest		; scan block
	movei	t2,opnbl1		; open block
	movei	t3,lukbl1		; lookup block
	movei	t4,pthbl1		; path block
	pushj	p,.stopb##		; convert
	 popj	p,			; can't
	skipe	t1,lukbl1+.rbppn	; see if ppn there
	 tlnn	t1,777777		;or already path setup
	  jrst	rsupth			;already ok
	setzm	pthbl1
	setzm	pthbl1+1
	movem	t1,pthbl1+2
	setzm	pthbl1+3
	movei	t1,pthbl1
	movem	t1,lukbl1+.rbppn	;always use path block
rsupth:
	movei	t1,.rbtim+1-1
	iorm	t1,lukbl1+.rbcnt	; put in length
	jrst	.popj1##		; success return


ufdgdp:
	; if here, device was specified; use its path
	setzm	pthblk+1
	move	t1,[xwd pthblk+1,pthblk+2]
	blt	t1,pthblk+.ptmax-1	; clear out path block
	move	t1,u.dest+.fxdev
	movem	t1,pthblk		; override old path
	move	t1,[xwd .ptmax,pthblk]
	path.	t1,
	 jfcl
	popj	p,



;;;;;;;;;;;;;;;;;;;;;;;;;;;;  REWIND  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	REWIND

; Rewind the tape to its beginning.
; Called from F.REWI.

; [25] Changes:
;      Removed check for default tape drive.
;      Eliminated setting of wndflg (served no purpose).
;      Added status message.
;      Added rewind flag to tell "initap" not to do an INBUF.

$rew:	movei	t1,iniblk		;get initialization block size
	movem	t1,blksze		;and set it up
	setom	rewflg			; [25] a rewind
	pushj	p,initap		; initialize the tape
	setzm	rewflg			; [25] reset flag
	mtrew.	0,			; skip to beginning of tape
	release	0,			; finished
	setzm	filseq			;zero file sequence number
	setzm	evsflg			;clear end-of-vol-set flag
	move	t1,sta.05		;[25] status message
	pushj	p,typel			;[25]
	jrst	.popj1##		; skip return



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  WIND  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	WIND

; Wind the tape to the end of the volume set.
; Called from F.WIND.

; [25] Changes:
;      Removed check for default tape drive.
;      Added code to clear directory flag.

$eot:	setom	wndflg			; indicate performing WIND
	setzm	dirflg			; [25] indicate not performing DIRECTORY
	pjrst	reddir			; jump into READ code



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; [25] Deleted section ("tstlog") for providing a default tape drive.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  DIRECTORY  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	DIRECTORY					; ((vaxine))

; Type a directory listing of the tape.
; Note:  this always winds the tape to the end of the volume set.
; Called from F.DIRE.

$dir:	setom	dirflg		; indicate performing a DIRECTORY
	setzm	wndflg		; indicate not performing a WIND
dir02:	pjrst	reddir		; jump into READ code

; Jump here from READ code to skip the data in a file
dir01:	mtwat.	0,
	mtskf.	0,		;skip the file
	pushj	p,eof$in	;get an eof label
	 jrst	dir01		;an EOV:  skip remaining data in file
	 jrst	[release 0,	;an EOT:  all done, skip return
		 jrst	.popj1##]
	jrst	red02		;an EOF:  jump back into READ code




;;;;;;;;;;;;;;;;;;;;;;;;  Set Tape Block Size  ;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Set Tape Block Size

; Ask user for tape block size, with possible default.
; Skip return on successful input, nonskip return on failure.
; Called from P.BLOC.

; [25] Changes:
;      Substituted new input procedure (using P$INP) for old.
;      Substituted new error messages and handling for old.

; Here to input the block size.
$block:	movei	t1,tk.dec		;[25] want a decimal integer
	movem	t1,token
	move	t1,prm.04		;[25] prompt literal
	movem	t1,prompt
	move	t1,hlp.04		;[25] help literal
	movem	t1,hlpmsg
	pushj	p,p$inp			;[25] input
	 move	p3,def.04		;[25] default

; Here to check if the block size is a multiple of 4.
	idivi	p3,4			;[16] get number of words
	skipe	,p4			;[16] a remainder?
	 jrst	block1			;[25] ..yes, illegal

; Here to check if block size is in range.
block2:	cail	p3,minblk		;[16] too small?
	caile	p3,maxblk		;[16] too large?
	 jrst	block1			;[16] yes..complain
	movem	p3,oblksz		;[16] save number of words
	imuli	p3,4			;[16] number of bytes
	movem	p3,oblkby		;[16] save bytes
	jrst	.popj1##		;[16] skip return

; Here if block size is out of range or not a multiple of 4.
block1:	move	t1,err.03		;[25] error message
	pjrst	errmsg			;[25] with nonskip return



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;
; [24] Deleted section ("$uic") for setting volume set UIC.
;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;




;;;;;;;;;;;;;;;;;;;;;;;;;;;;  READ  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	READ

; Read files from VAX tape and transfer them to the PDP10 disk.
; Note:  this always winds the tape to the end of the volume set.
; Called from F.READ.

; [25] Changes:
;      Substituted new input procedure (using Q$INP) for old.
;      Substituted new error messages and handling for old.
;      Removed check for a default tape drive.
;      Added new status message and revised old ones.
;      Deleted call on "yesno" for DECIDE switch.
;      Refused to allow READ, DIRECTORY, or WIND at end of volume set.

; Here to set flags indicating we are performing a READ.
$red11:	setzm	dirflg		;indicate not performing a DIRECTORY
	setzm	wndflg		;indicate not performing a WIND

; Come here from READ, DIR, and WIND.  Flags distinguish from where we came.
reddir:	skipe	evsflg		; [25] at end of volume set?
	 jrst	redevs		; [25] ..yes
	pushj	p,.save2##	; save p1 and p2
	skipe	wndflg		; [25] wind command?
	 jrst	redst		; [25] if so, don't get file spec

; Here to input file specification.
red00:	setzm	wldflg		; wldflg=0 means read everything
	movei	t1,tk.nul	; [25] want to parse files w/scnfil
	movem	t1,token
	move	t1,prm.05	; [25] prompt
	movem	t1,prompt
	move	t1,hlp.05	; [25] help (active in scnfil, not in q$inp)
	skipe	dirflg		; [25] different help message for DIRECTORY
	 move	t1,hlp.09	; [25]
	movem	t1,hlpmsg
	pushj	p,q$inp		; [25] input
	 jrst	redst		; [25] for default leave wldflg=0
	pushj	p,scnfil	;parse file names
	 jrst	esc.1		; [25] error
	 jrst	red00		; [25] got "help", try again
	setom	wldflg		;reading only the specified files

; Here for status message.
redst:	skipe	wndflg		; [25] wind
	 move	t1,sta.07
	skipn	wndflg		; [25] directory or read
	 move	t1,sta.08
	pushj	p,typel		; [25] type the message
	jrst	red01		; [25] jump into Vaxine code

; Here if at end of volume set.
redevs:	skipe	wndflg		; [25] WIND function?
	 jrst	[move t1,sta.06	  ; [25] remind user we are at eovs
		 pushj p,typel
		 popj p,]	  ; [25] and nonskip return
	move	t1,err.44	; [25] READ or DIRECTORY -- error
	pjrst	errmsg		; [25] with nonkip return

; Here to read the files specified and write them to disk.
; ((vaxine))		((vaxine))		((vaxine))
;
red01:	movei	t1,iniblk+1	;get initialization blocksize
	movem	t1,blksze	;and store it..
	pushj	p,initap	; init tape
	hrlzi	t1,(point 8,0)	;get eightbit byte pointer
	hllm	t1,bufhdr+1	;and set it up
	move	t1,.jbff##	; copy jbff
	movem	t1,savjff
red02:	move	t1,savjff	; restore any core taken
	movem	t1,.jbff##
	pushj	p,lab$in	;go read and check the label..
	 jrst	.popj1##	; all done..label error
	skipe	wndflg		;a wind command
	 jrst	dir01		;yes..skip file
	skipn	wldflg		;looking for specific files?
	 jrst	red02a		;no go on
	move	p1,wldfst	;get name of first wild block
red02c:

; routine to look at scan blocks for a wild spec
mywild:	setzm	,t4			;flag not a not
w.new:	ldb	t3,[point 3,.fxmod(p1),8] ;get the concatenated file spec
	move	t1,.fxnam(p1)		;get name from scan block
	and	t1,.fxnmm(p1)		;mask it...
	move	t2,tapfil		;get name from tape
	and	t2,.fxnmm(p1)		;mask it..
	came	t1,t2			;ok?
	 jrst	w.fail			;test failed
	hrlz	t1,.fxext(p1)		;get mask
	and	t1,.fxext(p1)		;mask it
	hrlz	t2,.fxext(p1)		;get mask
	and	t2,tapext		;mask extention from tape
	came	t1,t2			;ok?
	 jrst	w.fail			;test failed
					;test succeded....
	jumpn	t4,w.fal1		;if a not...treat like a failure
w.succ:	xct	[jrst w.good		;not concatention..good
		 jrst w.and		;next spec is an and...
		 jrst w.good		;next spec is an or...
		 jrst w.not](t3)	;next spec is a  not...
;
;
w.not:	skipa	t4,[-1]			;flag a not test
w.and:	setzm	,t4			;not a not
	addi	p1,.fxlen		;add the length
	camg	p1,wldlst		;another spec?
	 jrst	w.new			;yes loop
	jrst	w.good			;no..then say it's good
;
;
w.fail:
	jumpn	t4,w.succ		;a not..treat like success!
w.fal1:	setzm	,t4			;clear not flag
	xct	[jrst w.next		;no concatenation
		 jrst w.skip		;an and..so skip
		 jrst w.next		;an or...so look at next
		 jrst w.skip](t3)	;a not...so skip the rest
;
w.next:	addi 	p1,.fxlen		;add the length
	camle	p1,wldlst		;another spec?
	 jrst	dir01			;a failure...
	jrst	w.new			;go check this one
;
w.skip:	addi	p1,.fxlen		;add length
	camle	p1,wldlst		;another spec?
	 jrst	dir01
	ldb	t3,[point 3,.fxmod(p1),8]
	jrst	w.fail			;go into fail code
;
w.good:


red02a:	movsi	t1,'dsk'
	movem	t1,opnbl1+1
	setzm	opnbl1
	movsi	t1,bufhd1
	setzm	bufhd1
	movem	t1,opnbl1+2
	open	1,opnbl1
	 jrst	opnfail
	movei	t1,3
	movem	t1,lukbl1
	setzm	lukbl1+1
	move	t1,sta.09	;[25] status message:  '... reading '
	skipn	dirflg		;skip if directory only
	pushj	p,typef		;[25]
	move	t1,tapfil
	movem	t1,lukbl1+2
	pushj	p,.tsixn##
	movei	t1,"."
	pushj	p,.tchar##
	skipe	dirflg		;a directory?
	 pushj	p,.ttabc##	; yes then a tab
	move	t2,tapext	;get extension
	movem	t2,lukbl1+3
	setzm	binflg		;assume a ascii file
	move	t1,[iowd binlen,bintab] ;get table pointer
	pushj	p,.lknam##	;see if this is binary file
	 jrst	red02e		;no match..not binary
	skipge	,t1		;exact match?
	 setom	binflg		;yes..flag it as binary
red02e:	move	t1,tapext		;get extension
	pushj	p,.tsixn##
	move	t1,filsec	;[25] is this file continued from last volume?
	cail	t1,2		;[25] it is if the file section is 2 or more
	 jrst	[movei t1,[asciz ' (continued)']
		 pushj p,typef
		 jrst .+1]
	pushj	p,.ttabc##	;a tab
	skipn	dirflg		;a directory?
	 jrst	red02b		;no
	move	t1,tapdat	;get date
	pushj	p,.tdate##	;and type to user
	pushj	p,.tcrlf##	;[25]
	jrst	dir01		;must be directory
;


red02b:	pushj	p,.tcrlf##	;[25]
	enter	1,lukbl1
	 jrst	[pushj p,excblk	; change blocks
		 pushj p,entfail; print failure message
		  jfcl		; foil possible skip return
		 pjrst excblk]	; put blocks back
	skipn	binflg		;a binary file?
	 jrst	red02d		;no..skip
	setsts	1,.ioimg	;make  image output
	hrlzi	t1,(point 8,0)	;with 8 bit bytes
	hllm	t1,bufhd1+1	;  into buffer pointer
red02d:	outbuf	1,6		; get some buffers
	out	1,
	 jfcl			; hope its ok

	move	t4,blksze	;get blocksize from HDR2
	caig	t4,iniblk	;greater than what we have?
	 jrst	red02f		;no..continue
	release	0,		;close channel
	pushj	p,initap	;and reinitalize
	hrlzi	t1,(point 8,0)	;get 8 bit pointer
	hllm	t1,bufhdr+1	;and set up buffer
red02f:				;continued on next page


red03:	pushj	p,redblk
	 jrst	red04		; eof, done
red05:	pushj	p,getrcw	;get a record control word
	 jrst	red03		;finished the block...
	skipe	binflg		;binary file?
	 pushj	p,rcbout	;yes..output a byte count to file
	jumpe	p1,red12	;a blank line?
red06:	pushj	p,get1		;get a byte
	 jrst	shtblk		;short block
red10:	pushj	p,wrtw		;write out the byte
	 halt	.		; i/o error
red11:	sojg	p1,red06	; loop for rest of record
red12:	skipe	binflg		;binary file?
	 jrst	red05		;yes...no crlf
	movei	t1,15		;get a <cr>
	pushj	p,wrtw		;into the file
	halt	.
	movei	t1,12		;get a <lf>
	pushj	p,wrtw		;into the file
	halt	.
	jrst	red05
;
red04:	pushj	p,eof$in	;get an eof label...
	 jrst	red03		;an EOV
	 jrst	[pushj	p,.tcrlf##  ;seen EOT, type CRLF
		 close	 1,	    ;close output channel
		 release 0,	    ;release the tape channel
		 jrst	.popj1##]   ;and back to main loop
	close	1,		; an EOF make sure buffers are empty...
	jrst	red02		;alright...
;
;
shtblk:	move	t1,err.14	; [25] error message
	jrst	escape		; [25] escape to DOFUNC
;

;
rcbout:	skipe	fixflg		;fixed length records?
	 popj	p,		;yes..skip this
	move	t1,p1		;get byte count
	pushj	p,wrtw		;write to file
	 halt	.
	setz	t1,		;a null
	pushj	p,wrtw		;write to file
	 halt	.
	popj	p,		;and return

;
;	get a record control word
;
getrcw:
	skipe	fixflg		;fixed length records?
	 jrst	[move p1,f$rsiz ; yes..get record size from the header
		  CAML P1,bufhdr+2 ; is the buffer empty?	[28]
		 popj	p,	; yes..give nonskip return
		 jrst .popj1##] ; and return
	setzm	t2		;store here
	hrlzi	t3,-4		;first 4 characters
getr.1:	pushj	p,get1		;get a byte
	 popj	p,		;must be end of block
	cain	t1,pad		;a pad character?
	 popj	p,		;yes..must be end of block
	imuli	t2,^d10		;shift
	addi	t2,-60(t1)	;convert and add in
	aobjn	t3,getr.1	;back for more
	movei	p1,-4(t2)	;get count -4 for rcw
	skipn	t2,f$hdsz	; a VFC record??
	jrst	.popj1##	; no then just return
getr.2:	pushj	p,get1		;get a byte..
	 popj	p,		;end of block
	sojg	t2,getr.2	;back for more
	sub	p1,f$hdsz	;subtact the control bytes
	jrst	.popj1		;and return



;;;;;;;;;;;;;;;;;;;;;;;;;;  Read Header Labels  ;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Read Header Labels

; Get VOL1/HDR1/HDR2/HDR3 or HDR1/HDR2/HDR3.  Note HDR3 is optional.
; Skip return if successful, nonskip return on error.
; Called from READ in "red02".

; [25] Changes:
;      Substituted new error messages and handling for old.
;      Revised status message.

; Here to read VOL1 or HDR1 label.
lab$in:	pushj	p,redblk		;read a block in
	 jrst	l$miss			;[25] label missing
	caie	p2,lablen		;right number of words?
	 jrst	l$form			;[25] no, illegal format
	move	p1,bufhdr+1		;get address of buffer
	move	t2,v.hdr(p1)		;get header
	camn	t2,vol1			;is it a volume header?

; Here to process VOL1 label.
	 jrst	[move t1,sta.10		;[25] status message:  '... volume '
		 pushj	p,typef		;[25]
		 ; Get the volume name.
		 movei	t1,6		;6 characters
		 movei	t3,v.nam(p1)	;pointer to 8 bit string
		 movei	t2,lablen(p1)	;pointer to 7 bit string
		 pushj	p,con8t7	;convert and move
		 setzm	,t1		;need a zero byte
		 idpb	t1,t2		;to end type out..
		 movei	t1,lablen(p1)	;get address
		 pushj	p,typel		;[25] type string
		 ; [24] deleted section to get the UIC
		 jrst	lab$in]		; go back for HDR1 label

; Here to process HDR1 label.
	came	t2,hdr1			;an HDR1 header?
	 jrst	l$form			;[25] no, illegal format
	; Get the filename.
	setzm	tapfil			 ;zero filename and extension
	setzm	tapext
	move	t3,[point 8,h1.file(p1)] ;get pointer to filename
	movei	n,<^d9>			;maximum nine characters
	move	t2,[point 6,tapfil]	;want 6bit filename
labi.1:	ildb	t1,t3			;get a byte
	movei	t1,-40(t1)		;convert to sixbit
	cain	t1,'.'			;a period?
	 jrst	labi.2			;yes
	idpb	t1,t2			;place in filename
	sojg	n,labi.1		;go for more
labi.2:	movei	n,3			;3 character extension
	move	t2,[point 6,tapext]	;pointer to extension
labi.3:	ildb	t1,t3			;get a character
	movei	t1,-40(t1)		;convert to sixbit
	cain	t1,'.'			;a period?
	 jrst	labi.3			;ignore...must be first character
	idpb	t1,t2			;place in extension
	sojg	n,labi.3		;back for more
	; Get the creation date.
	move	p2,[point 8,h1.date(p1),..h1date] ;pointer into header
	movei	t1,2			;2 character binary
	pushj	p,getdec		;get 2 digit year in t2
	movei	n,-<^d64>(t2)		;get year-64
	movei	t1,3			;3 characters
	pushj	p,getdec		;get days in t2
	hrlzi	t1,-^d12		;count for month table
labi.4:	camg	t2,montab(t1)		;is it this month?
	 skipa	t3,montab-1(t1)		;yes..get days to beginning
	aobjn	t1,labi.4		;no..
	subi	t2,(t3)			;t2 has days, t1 has months
	imuli	n,^d12			;now calculate DATE
	addi	n,-1(t1)
	imuli	n,^d31
	addi	n,-1(t2)
	movem	n,tapdat		;and save the date
	; Get file section number.
	move	p2,[point 8,h1.sec(p1),..h1sec] ;get pointer
	movei	t1,4			;want 4 digits
	pushj	p,getdec		;get'm
	movem	t2,filsec		;save

; Here to process HDR2 label.
	pushj	p,redblk		;get next record
	 jrst	l$miss			;[25] label missing
	move	p1,bufhdr+1		;get buffer address
	move	t2,h2.hdr(p1)		;get header
	came	t2,hdr2			;a header two label?
	 jrst	l$form			;[25] no, illegal format

	; Get record type, must be fixed, F, or variable, D.	[28]

	ldb 	t1,[point 8,h2.type(p1),..h2type] ;Get record type byte.[28]
	setom	fixflg		;Assume fixed length records.		[28]
	cain	t1,fb$fix	;Check byte in record with "F"		[28]
	 jrst	labi.5		; They are fixed length, go get size.	[28]
	setzm	fixflg		;Assume variable length records.	[28]
	caie	t1,fb$var	;Check byte in record with "D".		[28]
	 jrst	l$rtyp		; Neither fixed nor variable is an error.[28]

	; Get block size.
labi.5:	move	p2,[point 8,h2.blks(p1),..h2blks]
	movei	t1,5			;want 5 byte blocksize
	pushj	p,getdec		;get value
	idivi	t2,4			;get word value
	skipe	,t3			;a remainder
	 aos	,t2			;yes increment..
	movem	t2,blksze		;save it
	; Get record size.
	move	p2,[point 8,h2.recs(p1),..h2recs]
	movei	t1,5			;want 5 bytes of record size
	pushj	p,getdec		;get it
	movem	t2,f$rsiz		;save size
	pushj	p,redblk		;get an eof
	 jrst	.popj1##		;yes...good return

; Here to process optional HDR3 label.
	move	p1,bufhdr+1		;get buffer address
	move	t2,h3.hdr(p1)		;get header
	came	t2,hdr3			;a HDR3 label??
	 jrst	l$form			;[25] no, illegal format
	pushj	p,redblk		;yes..now look for eof
	 jrst	.popj1##		;eof...ok
	jrst	l$form			;[25] no, illegal format



;;;;;;;;;;;;;;;;;;;;;;;;;;  Read Trailer Labels  ;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Read Trailer Labels

; Get EOF1/EOF2/EOF3 or EOV1/EOV2.  Note EOF3 is optional.
; If EOV's, mount next volume and read its header labels.
; Nonskip return on EOV, skip return on EOT, double skip return on neither.
; Bad labels and eof treated like EOT.
; Called from DIRECTORY in "dir01" and from READ in "red04".

; [25] Changes:
;      Substituted new error messages and handling for old.
;      Added status messages.

; Here to read EOF1 or EOV1 label.
eof$in:	pushj	p,redblk		;get a block
	 jrst	l$mis2			;[25] label missing
	move	p1,bufhdr+1		;get buffer address
	move	t2,h1.hdr(p1)		;get header
	came	t2,eov1			;an EOV1 header?
	camn	t2,eof1			;an EOF1 header?
	 skipa	p2,[point 8,h1.seq(p1),..h1seq] ;pointer to file sequence
	  jrst	l$for2			;[25] no, illegal format
	; Get file sequence number.
	movei	t1,4			;want 4 digits
	pushj	p,getdec		;get the number
	movem	t2,filseq		;and set file sequence number

; Here to read EOF2 or EOV2 label.
	pushj	p,redblk		;get next record
	 jrst	l$mis2			;[25] label missing
	move 	p1,bufhdr+1		;get buffer address
	move	t2,h2.hdr(p1)		;get header
	came	t2,eof2			;a EOF2 label?
	 jrst	eov$in			;no..try EOV2

; Here to read optional EOF3 label.
	pushj	p,redblk		;get an eof
	 skipa				;yes an eof
	jrst	[move p1,bufhdr+1	;no..eof get buffer header
		 move t2,h3.hdr(p1)	;get header
		 came t2,eof3		;an eof3?
		  jrst l$for2		;[25] no, illegal format
		 pushj p,redblk		;get next block
		  jrst eof.1		;return to mainstream
		 jrst l$for2	]	;[25] no eof, illegal format

; Here to check for logical end of tape.
eof.1:	pushj	p,redblk		;read another
	 jrst	[mtbsf.	0,		;an eof...means logical EOT
		 move	t1,sta.06	;[25] status message:  '... at eovs'
		 pushj	p,typel		;[25]
		 setom	evsflg		;[25] set end-of-vol-set flag
		 jrst	.popj1##]	;single skip return
	mtbsr.	0,			;re-position tape
	aos	0(p)			;double skip return
	jrst	.popj1##

; Here to process EOV2 label.
eov$in:	came	t2,eov2			;is it an EOV2?
	 jrst	l$for2			;[25] no, illegal format
	move	t1,[mtunl. 0,]		;unload command
	pushj	p,newtap		;yes...go get new tape...
	 jrst	.popj1##		;error..treat like eot
	pushj	p,lab$in		;get the lables...
	 jrst	.popj1##		;error..treat like EOT
	popj	p,			;nonskip return



;;;;;;;;;;;;;;;;;;;;;;;;  Read Label Errors  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Read Label Errors

; Here from reading header labels.

; [25] Label missing or incomplete
l$miss:	move	t1,err.04		; error message
	pjrst	errmsg			; with nonskip return

; [25] Label in wrong format
l$form:	move	t1,err.05		; error message
	pjrst	errmsg			; with nonskip return

; [28] Neither fixed nor variable length tape records.
l$rtyp:	move	t1,err.45		;Do error message
	pjrst	errmsg			;  with non-skip return.

; Here from reading trailer labels.

l$mis2:	move	t1,err.04
	pushj	p,errmsg
	jrst	.popj1##		; skip return to simulate EOT

l$for2:	move	t1,err.05
	pushj	p,errmsg
	jrst	.popj1##




;;;;;;;;;;;;;;;;;;;;;  Mount New Tape Volume  ;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Mount New Tape Volume

; Reached end of tape volume.
; Ask user to mount next tape volume and give ok when ready.

; [25] Changes:
;      Substituted new input procedure (using P$INP) for old.
;      Substituted new error messages and handling for old.

; Here to rewind and unload the current tape.
newtap:	xct	,t1			;unload the tape

; Here to ask user for next tape.
newt.1:	movei	t1,tk.wrd		;[25] want a sixbit word
	movem	t1,token
	move	t1,prm.08		;[25] prompt
	movem	t1,prompt
	move	t1,hlp.08		;[25] help
	movem	t1,hlpmsg
getgo:	pushj	p,p$inp			;[25] input
	 setz	n,			;[25] no default

; Here to see what the user typed.
	camn	n,[sixbit 'GO']		;did he type go?
	 jrst	.popj1##		;yes, skip return
	move	t1,prm.09		;[25] no, complain
	movem	t1,prompt		;[25]
	jrst	getgo			;try again



;;;;;;;;;;;;;;;;;;;;;;;;;  String Conversions  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	String Conversions					; ((vaxine))

; con7t8 -- convert a 7-bit ascii string to an 8-bit ascii string.
; con8t7 -- convert an 8-bit ascii string to a 7-bit ascii string.
; con6t8 -- convert a sixbit string to an 8-bit ascii string.
;
; Parameters:
; t1 -- number of characters to convert.
; t2 -- pointer to input string buffer.
; t3 -- pointer to output string buffer.

; Convert an 8-bit ascii string to a 7-bit ascii string.
con8t7:	hrli	t2,(point 7,0)		;set up 7 bit pointer
	hrli	t3,(point 8,0)		;set up 8 bit pointer
con8.1:	ildb	0,t3			;get a byte
	jumpn	0,.+2			;null ?
	 movei	0," "			;yes..make blank
	caile	0,140			;lower case?
	andi	0,137			;make it upper case...
	idpb	0,t2			;out with it
	sojg	t1,con8.1		;loop
	popj	p,			;return

; Convert a 7-bit ascii string to an 8-bit ascii string.
con7t8:	hrli	t2,(point 7,0)
	hrli	t3,(point 8,0)
con7.1:	exch	t2,t3
	jrst	con8.1

; Convert a sixbit string to an 8-bit ascii string.
con6t8:	hrli	t2,(point 6,0)		;sixbit pointer
	hrli	t3,(point 8,0)		;8 bit pointer
con6.1:	ildb	0,t2			;get 6-bit character
	addi	0,40			;make ascii
	cain	0," "			;[27] if not a space, shove
	skipn	kilspc			;[27] if kilspc not set, shove
	idpb	0,t3			;shove
	sojg	t1,con6.1
	popj	p,



;;;;;;;;;;;;;;;;;;;;;;;;;  Read One Tape Block  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Read One Tape Block

; Transfer a block from the VAX tape to the buffer area.
; Skip return on normal success, nonskip return on eof.

; [25] Changes:
;      Substituted new error messages and handling for old.

; Here to get the block.
redblk:	move	t1,[xwd 2,t2]
	movei	t3,0		;channel zero
	movei	t2,.tfwat
	tapop.	t1,		;wait for io to be done
	 jfcl
	in	0,
	 jrst	setrht		;successful, finish up
	jrst	rbkerr		;unsuccessful, i/o error

; Here on successful block read, to finish up.
setrht:	move	p2,bufhdr+2	;get word count in p2
	jrst	.popj1##	;skip return

; Here on an i/o error
rbkerr:	getsts	0,t1			;get status bits
	pushj	p,fndt.1		;identify error
	 jrst	[close 0,
		 popj	p,]		; ..eof
	move	t1,t2			;[25] put error message in t1
	jrst	escape		 	;[25] escape to DOFUNC.



;;;;;;;;;;;;;;;;;;;;;;;;;;;  Block I/O Errors  ;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Block I/O Errors

; Figure out what went wrong during "redblk" or "wrtblk".
; Come to "fndt.1" from "redblk", to "fndter" from "wrtblk".
; On call, t1 contains error status bits retrieved by GETSTS.
; On return, t2 contains error message.
; Skip return on real errors, nonskip return on eof.

; [25] Changes:
;      Substituted new error messages and handling for old.

; Here to check the status bits.
fndt.1:	skipa	t3,[exp 0]		;set read flag
fndter:	setom	,t3			;set write flag
	movei	t2,0
	txne	t1,1b18
	move	t2,err.18		;[25] tape is write-locked
	txne	t1,1b19
	move	t2,err.19		;[25] hardware failure
	txne	t1,1b20
	move	t2,err.20		;[25] parity error
	txne	t1,1b21
	move	t2,err.21		;[25] block too large
	txne	t1,1b25
	move	t2,err.25		;[25] physical end of tape
	txne	t1,1b22
	 jumpe	t2,.popj##		;..eof
	jumpn	t2,.popj1##		;error identified, skip return

; Here if error is still unidentified.
	skipn	t3			;a read?
	 jrst	[mtbsr.	0,
		 mtwat.	0,
		 in	0,
		 jrst	[pop	p,t2		;clean up stack
		  	 jrst	redblk	]	;and try again
		 jrst	fndt.2]			;still bad...

; Report unknown error.
fndt.2:	move	t2,err.26		;[25] unknown error
	jrst	.popj1##		;skip return



;;;;;;;;;;;;;;;;;;;;;;;;;;  Byte Retrieval  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Byte Retrieval						; ((vaxine))

; Here to fetch one byte from the input buffer
get1:	sosge	bufhdr+2
	 popj	p,
	ildb	t1,bufhdr+1
	jrst	.popj1##	; return one character skip return

; [25] Get2 is never used, and I don't know what it does.
get2:	pushj	p,get1
	 popj	p,
	lsh	t1,^d9
	push	p,t1
	pushj	p,get1
	 jrst	[pop p,t1
		 popj p,]
	ior	t1,(p)
	pop	p,1(p)
	jrst	.popj1##



;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Set Tape Drive  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Set Tape Drive

; Ask user for tape drive, with no default.
; Skip return on successful input, nonskip return on failure.
; Called from P.TAPE.

; [25] Changes:
;      Substituted new input procedure (using P$INP) for old.
;      Substituted new error messages and handling for old.

; Here to input the tape drive.
$tap:	movei	t1,tk.nul	; [25] want to parse device name here
	movem	t1,token
	move	t1,prm.01	; [25] prompt
	movem	t1,prompt
	move	t1,hlp.01	; [25] help (active below, not in p$inp)
	movem	t1,hlpmsg
	pushj	p,p$inp		; [25] input
	 popj	p,		; [25] default is unsuccessful
	pushj	p,.filin##	; get file specification (SCAN call)
	movei	t1,s.dest
	movei	t2,.fxlen
	pushj	p,.gtspc##	; move to permanent buffer area
	move	t1,s.dest	; get device spec..

; Here to see if device is actually a tape drive.
$tap.2:	devchr	t1,		; get device characteristics
	txne	t1,dv.mta	; a magtape??
	 jrst	.popj1##	; [25] yes, skip return
	skipe	t1,s.dest+1	; was there a filename??
	 jrst	[movem t1,s.dest  ;yes  use it as device in case he forgot ":"
		 camn t1,help	  ;[25] but first... is it 'help'?
		  jrst $tap.h
		 camn t1,cancel	  ;[25] ... or 'cancel'?
		  pjrst f.exit
		 setzm	s.dest+1  ;so we don't try this trick again
	   	 jrst   $tap.2]	  ;use filename as device

; Here if specified device is not a magtape.
	move	t1,err.06	;[25] error message
	pjrst	errmsg		;[25] with nonskip return

; Here for help.
$tap.h:	move	t1,hlpmsg	;[25] help message
	pushj	p,dohelp	;[25] type it
	jrst	$tap		;[25] try again



;;;;;;;;;;;;;;;;;;;;;;;  Set Volume Name  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Set Volume Name

; Ask user for volume set name, with possible default.
; Skip return on successful input (impossible to have unsuccessful input).
; Called from P.VOLU.

; [25] Changes:
;      Substituted new input procedure (using P$INP) for old.

; Here to input the volume name.
$vol:	movei	t1,tk.wrd	; [25] want a sixbit word
	movem	t1,token
	move	t1,prm.06	; [25] prompt
	movem	t1,prompt
	move	t1,hlp.06	; [25] help
	movem	t1,hlpmsg
	pushj	p,p$inp		; [25] input
	 move	n,def.06	; [25] default

; Here to convert the sixbit string to 8-bit and put it in VOL1 header.
	movei	t1,6		; [25] 6 characters
	move	t2,[point 6,n]	; [25] pointer to sixbit string
	move	t3,[point 8,vol1-1+v.nam]  ; [25] pointer to VOL1 buffer
	pushj	p,con6.1	; [25] convert and move

; Here to do the same thing with the HDR1 header.
	movei	t1,6
	move	t2,[point 6,n]
	move	t3,[point 8,hdr1-1+h1.nam,..h1nam]
	pushj	p,con6.1
	jrst	.popj1##	; [25] skip return



;;;;;;;;;;;;;;;;;;;;;;;  Read Tape Initialization  ;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Read Tape Initialization

; Initialize tape before READ and DIRECTORY and after REWIND.

; [25] Changes:
;      Substituted new error messages and handling for old.
;      Added flag to prevent INBUF call when doing REWIND.

; Here for ((vaxine)) mumble.
initap:	movei	t1,s.dest
	movei	t2,opnblk
	movei	t3,lukblk
	movei	t4,pthblk
	pushj	p,.stopb##		; convert
	 jrst	itp.e1			; [25] open failure
	movei	t1,.ioimg		; use image mode
	iorm	t1,opnblk
	setz	t1,
	dpb	t1,[<pointr (opnblk,io.den)>] ; don't do density
	movei	t1,bufhdr
	movem	t1,opnblk+2	; set up buffer header
	setzm	(t1)		; wipe out first word if non-zero
	open	0,opnblk
	 jrst	itp.e1		; [25] open failure
	move	t1,[xwd 3,t2]		;get arg pointer
	movei	t2,.tfmod+.tfset	;want to set  mode
	movei	t4,.tfm8b		;   to industry
	movei	t3,0			;on channel zero
	tapop.	t1,			;do it
	 jrst	itp.e2			;[25] set-industry-mode failure
	move	t1,[xwd 3,t2]		;get arg pointer
	movei	t2,.tfbsz+.tfset	;want to set blocksize to..
	move	t4,blksze	;get block size
	aos	,t4		;need +1
	movei	t3,0			;on channel zero
	tapop.	t1,			;do it
	 jrst	itp.e3			;[25] set-block-size failure
initp4:	skipn	rewflg			;[25] no INBUF before rewind
	inbuf	0,1		;see monitor calls ch. 12 for details
	popj	p,



;;;;;;;;;;;;;;;;;;;;;;  Write Tape Initialization  ;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Write Tape Initialization

; [25] Changes:
;      Added call on P.BLOC to force input of block size parameter.
;      Replaced density handling section with call on NEWSET.
;      Substituted new error messages and handling for old.

; Here to get block size parameter.
initp1:	pushj	p,p.bloc

; Here for ((vaxine)) mumble.
	movei	t1,s.dest
	movei	t2,opnbl1
	movei	t3,lukbl1
	movei	t4,pthbl1
	pushj	p,.stopb##		; convert
	 jrst	itp.e1			;[25] open failure
	movei	t1,.iodmp
	iorm	t1,opnbl1
	movsi	t1,bufhd1
	movem	t1,opnbl1+2		; set up buffer header
	setzm	bufhd1		; wipe out first word
	setz	t1,
	dpb	t1,[<pointr (opnbl1,io.den)>]  	;don't set density here
	open	1,opnbl1
	 jrst	itp.e1			;[25] open failure
	move	t1,[xwd 3,t2]		;get arg pointer
	movei	t2,.tfmod+.tfset	;want to set  mode
	movei	t4,.tfm8b		;   to industry
	movei	t3,1			;on channel one
	tapop.	t1,			;do it
	 jrst	itp.e2			;[25] set-industry-mode failure
	move	t1,[xwd 3,t2]		;get arg pointer
	movei	t2,.tfbsz+.tfset	;want to set blocksize to..
	move	t4,oblksz		;[16] get blocksize
	aos	,t4			;[16]   .. plus 1
	movei	t3,1			;on channel one
	tapop.	t1,			;do it
	 jrst	itp.e3			;[25] set-block-size failure

; Here to see if we are at BOT.  If we are, then assume new volume set.
	movei	t2,.tfsts		;get status
	move	t1,[xwd 2,t2]		;get arg pointer
	tapop.	t1,			;
	 jfcl
	txnn	t1,tf.bot		;at BOT?
	 popj	p,			;no...then not a new vol set, return.

; Here if we are at BOT, starting a new volume set.
	pushj	p,newset		;[25] get new vol set parameters
	popj	p,			;[25] nonskip return



;;;;;;;;;;;;;;;;;;;;;  Tape Initialization Errors  ;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Tape Initialization Errors

; [25] Here on open failure.
itp.e1:	move	t1,err.07		; error message
	jrst	escape			; escape to DOFUNC

; [25] Here on set-industry-mode failure.
itp.e2:	move	t1,err.08
	jrst	escape

; [25] Here on set-block-size failure.
itp.e3:	move	t1,err.09
	jrst	escape



;;;;;;;;;;;;;;;;;;;;;;;;;;;  Set Tape Density  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Set Tape Density

; Ask user for tape density, with possible default.
; Skip return on successful input, nonskip return on failure.
; Called from P.DENS.

; [25] Changes:
;      Separated density routine from "initp1" routine.
;      Deleted section to get default density from drive.
;      Added new input procedure (using P$INP).
;      Added section to convert density value to system density code.
;      Substituted new error messages and handling for old.

; Here to input the density.
$dens:	movei	t1,tk.dec		; [25] want a decimal integer
	movem	t1,token
	move	t1,prm.07		; [25] prompt
	movem	t1,prompt
	move	t1,hlp.07		; [25] help
	movem	t1,hlpmsg
	pushj	p,p$inp			; [25] input
	 move	n,def.07		; [25] default

; Here to convert decimal density value to system code.
	setz	t1,			; [25] t1 will hold system code
	cain	n,^d200			; [25] 200 bpi?
	 movei	t1,.tfd20
	cain	n,^d556			; [25] 556 bpi?
	 movei	t1,.tfd55
	cain	n,^d800			; [25] 800 bpi?
	 movei	t1,.tfd80
	cain	n,^d1600		; [25] 1600 bpi?
	 movei	t1,.tfd16
	cain	n,^d6250		; [25] 6250 bpi?
	 movei	t1,.tfd62
	jumpe	t1,den.e1		; [25] illegal density
	dpb	t1,[<pointr (s.dest+.fxmom,fx.den)>]	; [25] store code

; Here to see if tape drive is capable of given density.
	move	t1,[xwd 3,t2]		; setup for TAPOP.
	movei	t2,.tfpdn		; want possible denisities
	movei	t3,1			; channel 1
	ldb	t4,[<pointr (s.dest+.fxmom,fx.den)>]	; density code
	tapop.	t1,
	 jrst	den.e2			; [25] can't get possible densities
	tdnn	t1,[exp 0
		 exp tf.dn1		;200
		 exp tf.dn2		;556
		 exp tf.dn3		;800
		 exp tf.dn4		;1600
		 exp tf.dn5](t4)	;6250
	 jrst	den.e3			; [25] drive not capable

; Here to set density on tape drive.
	move	t1,[xwd 3,t2]		; setup for TAPOP.
	movei	t2,.tfden+.tfset
	movei	t3,1			; channel 1
	tapop.	t1,			; set the denisty
	 jrst	den.e4			; [25] didn't work
	jrst	.popj1##		; [25] successful, skip return

; Here on illegal input
den.e1:	move	t1,err.10		; [25] error message
	pjrst	errmsg			; [25] with nonskip return

; Here when couldn't get possible densities.
den.e2:	move	t1,err.11		; [25] error message
	jrst	escape			; [25] escape to DOFUNC

; Here when drive was not capable of given denisty.
den.e3:	move	t1,err.12		; [25] error message
	pjrst	errmsg			; [25] with nonskip return

; Here when set density failed.
den.e4:	move	t1,err.13		; [25] error message
	jrst	escape			; [25] escape to DOFUNC



;;;;;;;;;;;;;;;;;;;;;;;;;;;;  WRITE  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	WRITE

; Read files from the PDP10 disk and write them to VAX tape.
; Called from F.WRIT.

; [25] Changes:
;      Substituted new input procedure (using Q$INP) for old.
;      Substituted new error messages and handling for old.
;      Added new status message and revised old one.

; Enter here.
$wrt:	pushj	p,.save2##		; save p1 and p2

; Here to input file specification
wrtspc:	movei	t1,tk.nul		; [25] want to parse files w/scnfil
	movem	t1,token
	move	t1,prm.03		; [25] prompt
	movem	t1,prompt
	move	t1,hlp.03		; [25] help (active in scnfil, not here)
	movem	t1,hlpmsg
	pushj	p,q$inp			; [25] input
	 jrst	wrtspc			; [25] no default, try again
	pushj	p,scnfil		; parse file names
	 jrst	esc.1			; [25] error
	 jrst	wrtspc			; [25] got "help", try again

; Here to initialize tape for writing.
	pushj	p,initp1	; init tape on channel 1
	move	t1,.jbff##
	movem	t1,savjff	; save jobff

; Here to write each file.
; ((vaxine))		((vaxine))		((vaxine))
;
wrtlop:	move	t1,savjff
	movem	t1,.jbff##
	setzm	opnblk		; use mode 0 (ascii line)
	move	t1,[4,,wldblk]
	setzm	,f			;fix wild bug...
	pushj	p,.lkwld##
	 jrst	wrtdon
	move	t1,.jbff##
	came	t1,savjff	; check for scan changing .jbff
	 halt	.		; scan changed .jbff -- foul
	;
	hlrz	t1,lukblk+.rbext	; get file's extension
	cain	t1,'sfd'		; is it an sfd??
	 jrst	wrtlop			; forget it then...
	movei	t1,bufhdr
	setzm	(t1)		; wipe out first word
	movem	t1,opnblk+2
	open	opnblk
	 jrst	opnfail		; [25] open failure
	movei	t1,.rbtim+1-1
	iorm	t1,lukblk+.rbcnt
	lookup	lukblk
	 jrst	lukfail		; lookup failure
	pushj	p,.chktm##
	 jrst	wrtlop
	setzm	pthblk
	move	t1,[xwd pthblk,pthblk+1]
	blt	t1,pthblk+.ptmax-1
	move	t1,[xwd .ptmax,pthblk]
	path.	t1,
	 jfcl
	move	t1,sta.11		; [25] status message:  '... writing '
	pushj	p,typef			; [25]
	movei	t1,opnblk
	movei	t2,lukblk
	pushj	p,.toleb##
	pushj	p,.tcrlf##		; [25]

;
;	skip binary files
;
	setzm	ineov			;not in end of volume processing
	setzm	binflg			;assume not binary
	hllz	t2,lukblk+.rbext	;get extension
	camn	t2,[sixbit 'sfd']	;an sfd
	 jrst	wrtlop			;don't touch
	move	t1,[iowd binlen,bintab] ;get table pointer
	pushj	p,.lknam##	;see if this is binary file
	 jrst	wrtl.3		;no match..not binary
	skipge	,t1		;exact match?
	 jrst	[move t1,err.43		;[25] error message
		 pushj p,errmsg		;[25] binary file writing not supported
		 jrst	wrtlop]		;get next file

;
;	here when everything's ok to write the file
;
wrtl.3:	inbuf				; setup input buffers
	setom	newfil			; [22] indicate new file
	pushj	p,lab$ot		;output a label
	 popj	p,			;label error

;
;	here we write the data
;
	setzb	bcount,blkseq		;zero the sequence number
	move	t1,[point 8,tapbl1]	;pointer into buffer
	movem	t1,bufhd1+1		;into header
	movem	t1,lasrcw		;and the rcw
	movei	t1,<maxblk*2*4>		;max byte count
	movem	t1,bufhd1+2

;
;	record writing loop
;
wrtit:	pushj	p,wrtrec		;get a record & RCW
	 jrst	[pushj	p,wrteof	;hit..eof..write label
		 jrst	wrtlop]		;and get next file
wrtl.1:	add	bcount,rcount		;increment block count
	camge	bcount,oblkby		;overflowed buffer?
	 jrst	wrtit			;no..get another record
	pushj	p,wrtbcw		;write out block
	 popj	p,
	jrst	wrtit

;
;	here to finish off a block and write it
;
wrtbcw:	aos	blkseq			;increment block sequence number
	camle	bcount,oblkby		;[16] even fit?
	 subi	bcount,(rcount)		;no..subtract last record
	hrrz	t1,bcount		;get byte count
	idivi	t1,4			;get word count
	skipn	,t2			;zero remainder?
	 sos	,t1			;yes..adjust pointer
	move	t2,[tapbl1,,tapblk]	;set up blt to output buffer
	blt	t2,tapblk+1(t1)		; do it
	camn	bcount,oblkby		;[16] even fit
	 jrst	wrtb.3			;yes..no need to pad
	move	t2,oblkby		;[16] get number of bytes in buffer
	subi	t2,(bcount)		;cal. number of bytes to pad
	movei	t3,pad			;get pad character
	hrri	t4,tapblk(t1)		;get address of word to fill
	hll	t4,prvrcw		;and pointer to appropriate byte
	skipn	,rcount			;was there another record?
	hll	t4,lasrcw		;no..use last rcw
wrtb.1:	idpb	t3,t4			;pad
	sojg	t2,wrtb.1		;till done
wrtb.3:	move	p1,oblksz		;[16] get number of words to output
	pushj	p,wrtblk		;write the block
	 popj	p,			;write error
	move	n,rcount		;get number of bytes in remaining record
	move	t2,[point 8,tapbl1]	;pointer to beginning
	move	t1,prvrcw		;get pointer to record
	movem	t2,prvrcw		;reset
	caml	bcount,oblkby		;[16] even fit?
	 jrst	[setzm	,rcount		;yes..zero count..
		 jrst	wrtb.4]		;      no record to copy
wrtb.2:	ildb	t3,t1			;get a byte
	idpb	t3,t2			;into staging buffer
	sojg	n,wrtb.2		;until done
wrtb.4:	movem	t2,lasrcw		;set up last rcw
	movem	t2,bufhd1+1		; and buffer header
	movei	t2,maxblk*4*2		;get max character count
	movem	t2,bufhd1+2		;and set buffer
	movei	bcount,(rcount)		;set block count to record count
	jrst	.popj1##		;and go home


;
;
;
;	here when everything is finished
;
wrtdon:	mtwat.	1,			;wait to finish
	release	1,			;finished with the channel
	move	t1,sta.06		;[25] status message
	pushj	p,typel			;[25]
	setom	evsflg			;[25] set end-of-vol-set flag
	pushj	p,.tcrlf##		;a crlf
	jrst	.popj1##		;end of all



;;;;;;;;;;;;;;;;;;;;;;;  Write Header Labels  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Write Header Labels

; Write VOL1/HDR1/HDR2 or just HDR1/HDR2.
; VOL1 written if filseq = 0 (presumably at BOT).

lab$ot:	skipe	filseq			;at BOT ?
	 jrst	lab$o1			;no...no volume header

; Here to write VOL1.
vol$ot:	movei	t1,vol1			;get address of proto VOL1 header
	pushj	p,movlab		;move to output block
	movei	p1,lablen/4		;get words to output
	pushj	p,wrtblk		;and write out the block
	 jfcl				;[25] errors trapped in wrtblk

; Here to write HDR1.
lab$o1:	movei	t1,hdr1			;get proto HDR1 header
	pushj	p,movlab		;move to output block
	pushj	p,getdat		;place date in label
	movei	t1,6			;now for 6 char of filename
	move	t2,[point 6,lukblk+.rbnam] ;pointer to filename
	move	t3,[point 8,tapblk-1+h1.file] ;pointer into HDR1 block
	setom	kilspc			;[27] remove interior spaces
	pushj	p,con6.1		;move
	movei	t1,"."			;get period
	idpb	t1,t3			;place before extension
	movei	t1,3			;3 characters for extension
	pushj	p,con6.1		;move it
	setzm	kilspc			;[27] reset kill spaces flag
	move	t1,filseq		;[22] get file sequence number
	skipe	newfil			;[22] a new file?
	jrst	[movei	t1,1		;[22] if so, set the file section
		 movem	t1,filsec	;[22] number to one and update
		 aos	t1,filseq	;[22] the file sequence number
		 jrst	.+1]
	move	p1,[point 8,tapblk-1+h1.seq,..h1seq] ;get pointer
	movei	t3,4			;want 4 digits
	pushj	p,putdec		;place in header
	move	t1,filsec		;[22] get file section number
	skipe	newvol			;[22] a new volume?
	aos	t1,filsec		;[22] if so, update file section
	move	p1,[point 8,tapblk-1+h1.sec,..h1sec]  ; [22] this line fixed
	movei	t3,4			;want 4 digits
	pushj	p,putdec		;place in header
	setzm	newfil			;[22] reset new file flag
	setzm	newvol			;[22] reset new volume flag
	movei	p1,lablen/4		;get words to output
	pushj	p,wrtblk		;and write out the block
	 jfcl				;[25] errors trapped in wrtblk

; Here to write HDR2.
	movei	t1,hdr2			;get pointer to HDR2
	pushj	p,movlab		;move it
	move	t1,oblkby		;[16] get number of bytes in block
	move	p1,[point 8,tapblk-1+h2.blks,..h2blks]  ;[16]
	movei	t3,5			;[16] store as 5 bytes
	pushj	p,putdec		;[16]  decimal number
	move	t1,oblkby		;[16] use block as record
	movei	t3,5			;[16] 5 more bytes
	pushj	p,putdec		;[16] in header
	movei	p1,lablen/4		;get words to output
	pushj	p,wrtblk		;and write out the block
	 jfcl				;[25] errors trapped in wrtblk
	mteof.	1,			;write an eof
	jrst	.popj1##		;skip return



;;;;;;;;;;;;;;;;;;;;;;;  Write Trailer Labels  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Write Trailer Labels				; ((vaxine))

; Write EOF1/EOF2 or EOV1/EOV2.
; First finish last block in file, often a short block.

wrteof:	addi	bcount,(rcount)		;add record count to block count
	jumpe	bcount,wrte.1		;nothing to write out...
	setzm	,rcount			;zero rcount so wrtbcw knows short block
	pushj	p,wrtbcw		;write out this block
	 popj	p,

; Here to write EOF1 or EOV1.
wrte.1:	mteof.	1,			;an eof
	movei	t1,hdr1			;get the header1 proto
	pushj	p,movlab		;set it up
	move	t1,eof1			;get eof1
	skipe	ineov			;are we processing an end of volume?
	move	t1,eov1			;yes..get EOV header
	movem	t1,tapblk		;and make hdr1 an eof1
	move	t1,blkseq		;get number of blocks
	move	p1,[point 8,tapblk-1+h1.bcnt,..h1bcnt] ;pointer to header
	movei	t3,6			;want 6 characters
	pushj	p,putdec		;place in header
	move	t1,filseq		;get file sequence number
	move	p1,[point 8,tapblk-1+h1.seq,..h1seq] ;get pointer
	movei	t3,4			;want 4 characters
	pushj	p,putdec		;place in header
	movei	p1,lablen/4		;number of words in header
	pushj	p,wrtblk		;write it out
	 popj	p,

; Here to write EOF2 or EOV2.
	movei	t1,hdr2			;get header two
	pushj	p,movlab		;into buffer
	move	t1,eof2			;make into an eof2
	skipe	ineov			;are we processing an end of volume?
	move	t1,eov2			;yes..get EOV header
	movem	t1,tapblk		; an eof2 header
	move	t1,oblkby		;[16] get number of bytes in block
	move	p1,[point 8,tapblk-1+h2.blks,..h2blks]  ;[16]
	movei	t3,5			;[16] store as 5 bytes
	pushj	p,putdec		;[16]  decimal number
	move	t1,oblkby		;[16] use block as record
	movei	t3,5			;[16] 5 more bytes
	pushj	p,putdec		;[16] in header
	movei	p1,lablen/4
	pushj	p,wrtblk		;and write it out
	 popj	p,
	close	1,			;an end of file
	mtwat.	1,			;wait to finish
	;[22] line deleted
	popj	p,



;;;;;;;;;;;;;;;;;;;;;;  Write Record Into Buffer  ;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Wrtrec						; ((vaxine))

; Here to set up.
wrtrec:	setzm	,rcount		;[25] zero the byte count
	movn	p1,oblkby	;[16] get negative  number of bytes
	hrlzi	p1,4(p1)	;[16]   -minus 4 for rcw
	hrrei	t1,-4		;4 bytes for counter
	addm	t1,bufhd1+2	;subtrace from counter
	movei	t1,4		;to adjust byte pointer
ifn ftkl,<
	adjbp	t1,bufhd1+1	; and from byte pointer
	movem	t1,bufhd1+1>
ife ftkl,<
	ibp	bufhd1+1	;increment pointer
	sojg	t1,.-1>		;loop
	setzm	eorflg		;[21] init end-of-record flag

; Here to fill record buffer with bytes from file.
wrtr.6:	pushj	p,redb		;get a byte...
	 jrst	wrtr.1		;eof....
	jumpe	t1,wrtr.6	; throw away nuls
	cain	t1,15		; a <CR>?
	 jrst	wrtr.6		; yes..ignore
	caie	t1,14		; a <FF> or
	cain	t1,12		;   <LF>?
	 jrst	wrtr.2		;yes...end of record
	skipe	eorflg		;[21] already past end of record?
	 jrst	wrtr.8		;[21] yes, record too long
	pushj	p,wrt1		;no, write the character
	aobjn	p1,wrtr.6	;count and go for more
	setom	eorflg		;[21] now past end of record
	jrst	wrtr.6		;[21] <cr><lf> should follow

; Here if record is too long.
; [25] Do not truncate.  Instead, fatal error.
wrtr.8:	move	t1,err.15	;[25] error message
	jrst	escape		;[25] escape to DOFUNC

; Here to finish up.
wrtr.2:	movei	t1,4(p1)		;get byte count (incl. rcw)
	movem	t1,rcount		;save in rcount
	move	p1,lasrcw		;get pointer to rcw
	movem	p1,prvrcw		;becomes previous rcw
	movei	t3,4			;a 4 character field
	pushj	p,putdec		;place in buffer
	move	t1,bufhd1+1		;get pointer
	movem	t1,lasrcw		;becomes new rcw
	jrst	.popj1##		;skip return

; Here when eof encountered.
wrtr.1:	hrrzi	p1,(p1)			;get number of characters
	skipn	,p1			;have we done anything?
	 popj	p,			;no...do an eof (nonskip) return
	pushj	p,wrtr.2		;yes..finish off normally..
	 jfcl
	popj	p,			;and an eof return

; Here to write one byte into buffer.
wrt1:	sosge	bufhd1+2		;any room?
	 jrst	[move t1,err.16		  ; [25] error message
		 jrst escape]		  ; [25] escape to DOFUNC
	idpb	t1,bufhd1+1		;put byte in
	popj	p,



;;;;;;;;;;;;;;;;;;;;;;;;;  Write One Tape Block  ;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Write One Tape Block

; Transfer a block from the buffer area to the VAX tape.
; Change tape reels if end-of-volume encountered during write.

; [25] Changes:
;      Substituted new error messages and handling for old.

wrtblk:	movni	p1,(p1)
	hrlzi	p1,(p1)
	hrri	p1,tapblk-1		;get address
	movem	p1,tapiow		;set up iowd word
	out	1,tapiow		;do the output
	 jrst	.popj1##		;skip return

; Here on error or end-of-volume.
	getsts	1,t1			;get the status
	txne	t1,io.eot		;physical end of tape?
	 jrst	eov$ot			;then need new tape
	pushj	p,fndter		;identify the error
	 jfcl
	move	t1,t2			;[25] put error message in t1
	jrst	escape			;[25] escape to DOFUNC

; Here on end-of-volume.
eov$ot:	skipe	ineov			;alread there?
	 jrst	.popj1##		;yes
	setom	ineov			;flag we've seen io.eot
	pushj	p,wrte.1		;write EOV label
	move	t1,[mtunl. 1,]		;get right unload
	pushj	p,newtap		;get next tape
	 jfcl
	setzm	ineov			;we've got a new tape now
	setom	newvol			;[22] set flag for new VOL label
	setzm	blkseq			;[26] zero the block count
	pushj	p,vol$ot		;the volume headers
	 jfcl
	jrst	.popj1##		;and away we go...




;;;;;;;;;;;;;;;;;;;;;;;  Numeric Handling Utilities  ;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Numeric Handling Utilities				; ((vaxine))

; Here to get a sixbit date in the form YYDDD.
getdat:	date t2,		;get todays date..
	idivi	t2,^d31		;have months-1 in t3
	move	t1,t2
	idivi	t1,^d12		;have months-1 in t2
	exch	t1,t3		;years-64 in t3
	add	t1,montab(t2)	;julianday-1
	caile	t2,^d1		;for feb
	trne	t3,3		;leap year?
	 skipa
	  aos	t1		;yes...
	addi	t3,^d64		;years 19xx
	move	p2,t1		;save days
	move	t1,t3		;get years
	move	p1,[point 8,tapblk-1+h1.date,..h1date]  ;pointer to file
	movei	t3,2		;want two digits
	pushj	p,putdec	;place in header
	movei	t3,3		;now 3 charatec day number
	move	t1,p2		;get days
	pushj	p,putdec	;place in header
	popj	p,		; and return

; Ascii to numeric.
; p2 points to string, t1 has number of characters.
; t2 receives numeric value.
; GETOCT for octal, GETDEC for decimal.
getoct:	skipa 	t4,[exp ^d8]		;radix 8
getdec:	movei	t4,^d10			;radix 10
	setzm	,t2			;zero
getd.1:	ildb	t3,p2			;get a character
	imuli	t2,(t4)			;make room for it
	cain	t3," "			;a blank?
	 movei	t3,"0"			;make a zero
	addi	t2,-60(t3)		;convert and add in
	sojg	t1,getd.1		;back for more
	popj	p,

; Numeric to ascii.
; t1 contains numeric value.
; p1 is buffer pointer, t3 is number of characters in field.
; PUTOCT for octal, PUTDEC for decimal.
putoct:	skipa	n,[exp ^d8]	;radix 8
putdec:	movei	n,^d10		;radix 10
putd.1:	idivi	t1,(n)		;get a digit
	hrlm	t2,(p)		;save on stack
	sosle	,t3		;enough digits?
	pushj	p,putd.1	;no..go get another
	hlrz	t2,(p)		;get digit
	movei	t2,"0"(t2)	;convert to ascii
	idpb	t2,p1		;place in string
	popj	p,

; MOVLAB
movlab:	hrli	t1,(t1)		;get address in from side
	hrri	t1,tapblk	;get to address
	blt	t1,tapblk+<lablen/4> ;copy..
	popj	p,



;;;;;;;;;;;;;;;;;;;;;;;  Data Transfer Utilities  ;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Data Transfer Utilities				; ((vaxine))

redb:	; read a word from file
	; non-skip if end of file (t1=0) or error (t1 neq 0)
	; skip if word ok in t1
	sosge	bufhdr+2		; see if any there
	 jrst	redmore		; no, get more
	ildb	t1,bufhdr+1	; yes, fetch
	jrst	.popj1##


redmore:	; get next buffer or whatever
	in
	 jrst	redb	; got some.  try again
	statz	0,io.err	; any error bits
	 jrst	[pushj	p,.psh4t##
		 getsts	0,t2
		 pushj	p,doioerr
		 pushj	p,.pop4t##
		 popj	p,]
	setz	t1,		; get t1 to be 0
	statz	0,io.eof	; end of file
	 popj	p,		; that's what i was hoping
	jrst	redb


; Data Writing On Channel 1.
wrtw:	sosge	bufhd1+2	; Is there another word in the current buffer?
	jrst	wrtmor		; No, output current buffer
	idpb	t1,bufhd1+1
	jrst	.popj1##	; Skip return

wrtmor:	out	1,
	 jrst	wrtw		; Got some.  Try again.
	statz	1,io.err	; Any error bits?
	 jrst	[pushj	p,.psh4t##
		 pushj	p,excblk
		 getsts 1,t2
		 pushj	p,doioerr
		 pushj	p,excblk
		 pushj	p,.pop4t##
		 popj	p,]
	popj	p,



;;;;;;;;;;;;;;;;;;;;;;;  Data Transmission Error  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Data Transmission Error

; [25] Changes:
;      Substituted new error messages and handling for old.

doioerr:push	p,t2		; save getsts bits
	move	t1,err.30	; [25] file i/o error
	pushj	p,errmsf	; [25] error message with no <cr><lf>
	movei	t1,opnblk
	movei	t2,lukblk
	pushj	p,.toleb##
	movei	t1,[asciz . - .]
	pushj	p,typef		; [25]
	pop	p,t2
	movei	t1,0
	txne	t2,io.imp
	 movei	t1,err.31	; [25] improper mode
	txne	t2,io.bkt
	 movei	t1,err.32	; [25] block too large
	txne	t2,io.der
	 movei	t1,err.33	; [25] device error
	txne	t2,io.dte
	 movei	t1,err.34	; [25] data error
	jumpe	t1,doioe1	; if can't find anything, give up
	pushj	p,typef		; [25]
doioe1:	pushj	p,.tcrlf##
	seto	t1,		; show error not eof
	popj	p,		; give non-skip error or eof return



;;;;;;;;;;;;;;;;;;;;;;;  Lookup/Enter Error  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Lookup/Enter Error

; [25] Changes:
;      Substituted new error messages and handling for old.
;      Removed expanded handling of protection failures.

; Lookup failure from lukblk.
lukfail:move	t1,err.40	; [25] lookup failure
	jrst	errjoin

; Enter failure
entfail:move	t1,err.41	; [25] enter failure
	jrst	errjoin

; Error message.
errjoin:pushj	p,errmsf	; [25] error message with no <cr><lf>
	movei	t1,opnblk
	movei	t2,lukblk
	pushj	p,.toleb##	; type file name
	movei	t1,[asciz . - .]
	pushj	p,typef		; [25]
	ldb	t1,[point 15,lukblk+.rbext,35]	; get error code
	caile	t1,erunn%	; known error?
	 jrst	pernum		; no..just give number
	move	t1,fermsg(t1)	; get message
	pushj	p,typel		; [25] type it with a <cr><lf>
	jrst	esc.1		; [25] escape to DOFUNC

; Unidentified error, just give number.
pernum:	movei	t1,[asciz .error code = .]
	pushj	p,.tdecw##
	pushj	p,.tcrlf##
	jrst	esc.1		; escape to DOFUNC

; Lookup/Enter Error Messages
fermsg:	[asciz	.file not found.]
	[asciz	.incorrect ppn.]
	[asciz	.protection failure.]
	[asciz	.file being modified.]
	[asciz	.file already exists.]
	[asciz	.illegal uuo sequence.]
	[asciz	.transmission error.]
	[asciz	.not a save file.]
	[asciz	.not enough core.]
	[asciz	.device not available.]
	[asciz	.no such device.]
	[asciz	.illegal uuo.]
	[asciz	.no room.]
	[asciz	.write-locked.]
	[asciz	.not enough table space.]
	[asciz	.partial allocation.]
	[asciz	.block not free at specified position.]
	[asciz	.can't supersede a directory.]
	[asciz	.can't delete non-empty directory.]
	[asciz	.sfd not found.]
	[asciz	.search list is empty.]
	[asciz	.sfds nested too deeply.]
	[asciz	.no create is on for all file structures.]
	[asciz	.segment not on swapping space.]
	[asciz	.can't update file.]
	[asciz	.low seg overlaps high seg.]
	[asciz	.not logged in.]
	[asciz	.file still has outstanding locks set.]
	[asciz	.bad exe directory.]
	[asciz	.bad extension for exe file.]
	[asciz	.exe directory too big.]
	[asciz	.exceeded network capacity.]
	[asciz	.task not available.]
	[asciz	.undefined network node.]



;;;;;;;;;;;;;;;;;;;;;;;;;  Open Error  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Open Error

opnfail:move	t1,err.42		;[25] error message
	jrst	escape			;[25] escape to DOFUNC



;;;;;;;;;;;;;;;;;;;;;;;;;;;;  EXIT  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	EXIT

; Normal Exit
$quit:	pushj	p,.monrt##		;return to monitor
	 jrst	.popj1##		;ooops

; DDT exit
$ddt:	hrrz	t1,.jbddt##		; see if loaded wth ddt
	jumpe	t1,e$$ndl
	pushj	p,(t1)			; and go to it
	jrst	.popj1##		; return with no store
gobak::	popj	p,			; gobak return

; No ddt available.
e$$ndl:	jrst	.popj1##		; ignore



;;;;;;;;;;;;;;;;;;;;;;;;;;  Filename Scanner  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Filename Scanner

; Take file names from input, parse them, and save them in memory.
; Double skip return on success, single skip on 'help', nonskip on error.

; [25] Changes:
;      Made normal completion give double skip return.
;      Added 'help' check:  print help message and issue single skip return if
;      first filename is 'help'.
;      Added 'cancel' check:  escape to DOFUNC if first filename is 'cancel'.
;      Substituted new error messages and handling for old.

;	((vaxine)):
;	this routine will scan a list of file names into
;	core about .jbff in preparation for wild.

; Here for ((vaxine)) setup.
scnfil:	; start to set up wild block
	movei	t3,0		; ask for zero core
	pushj	p,space		; returned t1 is address
	hrrzm	t1,wldfst	; store adr of first file spec
	move	t1,[wldfst,,wldlst]
	movem	t1,wldblk
	movsi	t1,opnblk	; get open block
	hrri	t1,lukblk	; and lookup block
	movem	t1,wldblk+1
	movsi	t1,.fxlen	; get scanner block length
	hrri	t1,.rbtim+1		; lookup block length
	movem	t1,wldblk+2
	movsi	t1,(1b0)	; get "do all devices" flag
	hrri	t1,wldptr
	setzm	wldptr
	movem	t1,wldblk+3
	setzm	filcnt		; [25] file counter

; Here to parse and save each file.
gfilop:	; get file loop
	jumple	c,gfild		; if terminator, done
	pushj	p,.filin##	; get file (SCAN call)
	aos	filcnt		; [25] increment count
	pushj	p,allspc
	push	p,t1		; save start
	pushj	p,.gtspc##
	pop	p,t1
	skipn	.fxnmm(t1)		; extension specified?
	 jrst	gfil.e			; ..yes

; Here if extension not specified.  First check for 'help' and 'cancel'.
	move	t4,filcnt		; [25] first file?
	cain	t4,1			; [25] if so, check 'help' and 'cancel'
	 jrst	[move t3,.fxnam(t1)	; [25] get file name
		 camn t3,help		; [25] 'help'?
		  jrst scnf.h
		 camn t3,cancel		; [25] 'cancel'?
		  jrst i$canc
		 jrst .+1]		; [25] no, continue
	movx	t2,fx.nul		; null extension
	tdne	t2,.fxmod(t1)		; if on, pretend not on
	 hllos	.fxext(t1)
	andcam	t2,.fxmod(t1)		; doesn't happen

; Here to get separator.
gfil.e:	jumple	c,gfild
	caie	c,"+"
	 cain	c,","
	  jrst	gfilop		; if valid separator, get another file
	txne	c,4000		;a guide word?
	 jrst	gfilop

; Here on an invalid separator.
	move	t1,err.17	; [25] error message
	pjrst	errmsg		; [25] with nonskip return

; Here when all filenames have been parsed, to finish up.
gfild:	move	t1,.jbff##
	subi	t1,.fxlen
	hrrzm	t1,wldlst
	aos	0(p)		; [25] double skip return
	jrst	.popj1##	; [25]

; Here for 'help'.
scnf.h:	move	t1,hlpmsg	; [25] help message
	pushj	p,dohelp	; [25] type it
	jrst	.popj1##	; [25] single skip return



;;;;;;;;;;;;;;;;;;;;;;;;;;  Core Routines  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Core Routines						; ((vaxine))

; [25] Changes:
;      Substituted new error messages and handling for old.

allspc:	; allocates .fxlen at .jbff.  returns that in t1
	movei	t3,.fxlen

space:	; enter with t3=length of area to get.  result in t1
	move	t1,.jbff##
	movei	t2,(t1);
	add	t2,t3
	movem	t2,.jbff##
	sos	t2
	camg	t2,.jbrel##	;enough room?
	 jrst	allsp1		; yes
	core	t2,		; no, try to get it
	 jrst	e$$nec		; but can't
	move	t2,t3
allsp1:	popj	p,		; amount allocated in t2 & t3

; Here when not enough core available.
e$$nec:	move	t1,err.28	; [25] error message
	jrst	escape		; [25] escape to DOFUNC

rescor:	move	t1,inicor	; restore initial core
	hlrzm	t1,.jbff##	; restore .jbff#
	tlz	t1,-1		; clear out
	came	t1,.jbrel##	; see if same as now
	 core	t1,		; if not,
	  jfcl			; release it
	popj	p,		; return



;;;;;;;;;;;;;;;;;;;;  Structured User Interface  ;;;;;;;;;;;;;;;;;;;

; [25] Structured User Interface
;      Added 23-July-1982.
;      Accompanies product name change from VAXINE to TENVAX.
;      See revision overview for further details.



;;;;;;;;;;;;;;;;;;;; Token Input Subroutines ;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Token Input

; [25] P$INP / Q$INP
; Get a token from the user.
;
; P$INP issues a prompt and gets a new token.  Unused tokens from 
;	previous input are discarded.
; Q$INP gets an unused token from previous input if one is available.
;	Otherwise, it prompts for a new token and gets one.
; Both P$INP and Q$INP type a help message if the user enters HELP, and escape
;	to top level ("DOFUNC") if the user enters CANCEL.  These features are
;	deactivated if the token type is TK.NUL.
; Both P$INP and Q$INP give a skip return on normal token input, and a nonskip
;	return if the user enters just <<cr>>.  This is useful for preparing
;	default responses.
;
; Parameters
; CALL:		token		token type (see below)
;		prompt		prompt literal, asciz
;		hlpmsg		help literal, asciz
; RETURN:	t1		token
;		n		token (note: n = p3)
;
; Token Types
; TK.WRD	sixbit word
; TK.DEC	decimal integer
; TK.NUL	no token (i.e. do the scan initialization but no more)

; Local Symbols
tk.wrd==0			; sixbit word token type
tk.dec==1			; decimal integer token type
tk.nul==2			; null token type
help: sixbit 'help'		; match for 'help' request
cancel:	sixbit 'cancel'		; match for 'cancel' request

; Here for P-type input (use .clrbf and .pscan)
p$inp:	pushj	p,.clrbf##	; clear input line
	setzm	scnerr		; clear scan error flag
	move	t1,[4,,scnblk]	; set up for pscan
	pushj	p,.pscan##	; prepare for input (SCAN call)
	skipe	scnerr		; scan error flag cleared?
	 jrst	esc.1		; ..no, we got here after a SCAN fatal error
	pushj	p,i$prmt	; issue prompt
	jrst	i$inp		; get the token

; Here for Q-type input (use .qscan)
q$inp:	setzm	scnerr		; clear scan error flag
	move	t1,[4,,scnblk]	; set up for qscan
	pushj	p,.qscan##	; prepare for next token (SCAN call)
	 pushj	p,i$prmt	; issue prompt if no pending input
	jrst	i$inp		; get the token

; Here to dispatch according to token type
i$inp:	setom	scnerr		; anticipate possible SCAN fatal error
	pushj	p,.tiauc##	; get one character (SCAN call)
	jumple	c,i$dflt	; if empty line, give nonskip return
	pushj	p,.reeat##	; put the character back (SCAN call)
	move	t1,token	; get the token type
	cain	t1,tk.wrd	; sixbit word?
	 jrst	i$wrd
	cain	t1,tk.dec	; decimal integer?
	 jrst	i$dec
	cain	t1,tk.nul	; no token?
	 jrst	i$nul

; Here to get a sixbit word
i$wrd:	pushj	p,.sixsw##	; get the word in N (SCAN call)
	camn	n,help		; 'help'?
	 jrst	i$help
	camn	n,cancel	; 'cancel'?
	 jrst	i$canc
	move	t1,n		; return also in t1
	jrst	i$end		; done

; Here to get a decimal integer
i$dec:	pushj	p,.tiauc##	; first, get one character (SCAN call)
	cain	c,"H"		; first letter of 'help'?
	 jrst	i$help		; I guess so
	cain	c,"C"		; first letter of 'cancel'?
	 jrst	i$canc		; I guess so
	pushj	p,.decnc##	; get the rest of the integer (SCAN call)
	move	t1,n		; return in t1 as well as N
	jrst	i$end		; done

; Here to get no token
i$nul:	setz	t1,		; return zeros
	setz	n,
	jrst	i$end

; Here to print a prompt
i$prmt:	move	t1,prompt	; get prompt literal
	pushj	p,typef		; type it with no <<cr>> at end of line
	popj	p,		; return

; Here for "help"
i$help:	move	t1,hlpmsg	; get help literal
	pushj	p,dohelp	; type it
	jrst	p$inp		; start over

; Here for "cancel"
i$canc:	move	t1,sta.04	; status message
	pushj	p,typel
	jrst	esc.1		; escape to DOFUNC

; Here when finished
i$end:	jrst	.popj1##	; skip return

; Here for nonskip return (input line was just <<cr>>, for default)
i$dflt:	popj	p,		; nonskip return



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Messages  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Messages

; [25] Prompts
prm.01:	[asciz	'Tape Drive:  ']
prm.02:	[asciz	'
TENVAX function:  ']
prm.03:	[asciz	'Files:  ']
prm.04:	[asciz	'Block Size <8192>:  ']
prm.05:	[asciz	'Files <*.*>:  ']
prm.06:	[asciz	'Volume Set Name <NONAME>:  ']
prm.07:	[asciz	'Volume Set Tape Density <1600>:  ']
prm.08:	[asciz	'$ End of volume reached.  Please mount next volume and type GO.
']
prm.09:	[asciz	'$ Please type GO (and nothing else) when ready.
']

; [25] Help Messages

hlp.01:	[asciz	'
Specify the logical or physical name for the tape drive you want TENVAX
to access.  You should have already mounted either a scratch tape (for
writing) or a VAX-formatted tape (for reading or writing) on this drive.']

hlp.02:	[asciz	'
Specify the function which you want TENVAX to perform.  Choose from:
DIRECTORY	list the files on the VAX-formatted tape
EXIT		return to the TOPS-10 monitor
READ		transfer files from the VAX tape to your disk directory
REWIND		rewind the VAX tape to the beginning of the reel
WIND		wind the VAX-formatted tape to the end of the volume set
WRITE		transfer files from disk to the VAX-formatted tape
Unambiguous abbreviations (e.g. DIR, WR) are accepted.']

hlp.03:	[asciz	'
Specify a list of disk files to write to the VAX tape.  Separate the files
listed by commas.  The file names may include wild cards (that is, * and ?).
TENVAX will append the given files at the current tape position.  If the tape
is positioned at the beginning-of-tape marker, TENVAX will assume a new volume
set is being created.']

hlp.04:	[asciz	'
Specify the number of ASCII characters to be written in each tape block.
This number must be a multiple of 4 between 20 and 16376.  In addition, it
must be at least 4 greater than the length of the longest record in the files
to be written.  For data to be compacted efficiently on the tape, it is a
good idea for the block size to be large compared to the record size.  The
default of 8192 characters is a common setting used by VAX/RMS.']


hlp.05:	[asciz	'
Specify a list of files to read from the VAX tape.  Separate the files listed
by commas.  The file names may include wild cards (that is, * and ?).  TENVAX
will search for the files listed from the current tape position to the end of
the volume set.  The files, once found, will be inserted into your disk
directory.  The default file specification *.* reads all files from the tape.']

hlp.06:	[asciz	'
Specify a volume name to be given to the new volume set.  Only the first six
characters of the volume name are significant.  The default "NONAME" has no
special significance.']

hlp.07:	[asciz	'
Specify the density in bits-per-inch at which TENVAX is to write data on tapes
in the volume set.  Possible values are 200, 556, 800, 1600, and 6250.  Note
that most tape drives will accept only a few of these values.  The default
density is 1600 bpi, a common setting.']

hlp.08:	[asciz	'
$ In the process of reading from or writing to the VAX-formatted tape, the end
$ of the current tape reel was reached.  The file being read or written should
$ be continued on another reel.  Mount that reel (a scratch tape if you are
$ writing) on the tape drive.  Then type GO <return>.']

hlp.09:	[asciz	'
Specify a list of files to search for on the VAX tape.  Separate the files
listed by commas.  The file names may include wild cards (that is, * and ?).
TENVAX will search for the given files from the current tape position to the
end of the volume set.  When one of the given files is found, its name and
creation date will be typed on the terminal.  The default file specification
*.* lists all files on the tape.']


; [25] Error Messages
err.00:	[asciz '? ERROR ']
err.01:	[asciz '[1] Ambiguous function.  Try HELP for assistance.']
err.02:	[asciz '[2] No such function.  Try HELP for assistance.']
err.03:	[asciz '[3] Block size must be a multiple of 4 between 20 and 16376.']
err.04:	[asciz '[4] Tape label missing or incomplete.']
err.05:	[asciz '[5] Tape label not in VAX/ANSI format.']
err.06:	[asciz '[6] Device is not a magtape drive.']
err.07:	[asciz '[7] Could not open i/o channel to tape drive.']
err.08:	[asciz '[8] Could not set industry-compatible mode for tape output.']
err.09:	[asciz '[9] Could not set block size for tape output.']
err.10:	[asciz '[10] Density must be one of 200, 556, 800, 1600, or 6250.']
err.11:	[asciz '[11] Could not get density information from tape drive.']
err.12:	[asciz '[12] Tape drive not capable of that density.  Try another value.']
err.13:	[asciz '[13] Could not set density on tape drive.']
err.14:	[asciz '[14] Tape block is incomplete.']
err.15:	[asciz '[15] Record too long for tape block.  Try a larger block size.']
err.16:	[asciz '[16] Record too long for internal buffer.']
err.17:	[asciz '[17] Invalid filename separator.']
err.18:	[asciz '[18] Tape is write-locked.']
err.19:	[asciz '[19] Tape i/o operation failed.']
err.20:	[asciz '[20] Parity error.']
err.21:	[asciz '[21] Tape block too large.']
err.25: [asciz '[25] Unexpectedly reached physical end of tape.']
err.26:	[asciz '[26] Unidentified i/o error.']
err.28:	[asciz '[28] Not enough memory available.']
err.30:	[asciz '[30] File i/o failure for ']
err.31:		[asciz 'improper mode.']
err.32:		[asciz 'block too large.']
err.33:		[asciz 'device error.']
err.34:		[asciz 'data error.']
err.40: [asciz '[40] Disk file access failure (from Lookup) for ']
err.41:	[asciz '[41] Disk file access failure (from Enter) for ']
err.42:	[asciz '[42] Could not open i/o channel to disk.']
err.43:	[asciz '[43] Binary file writing not supported.  Skipping file.']
err.44:	[asciz '[44] Cannot perform READ or DIRECTORY at end of volume set.']
; [28]
err.45:	[asciz '[45] Tape record is neither fixed nor variable.']

; [25] Status Messages
sta.01:	[asciz 'Welcome to TENVAX, version 2.1.  Type HELP for assistance.']
sta.03:	[asciz '... at beginning of volume, assuming new volume set']
sta.04:	[asciz '... function cancelled']
sta.05:	[asciz '... at beginning of volume']
sta.06:	[asciz '... at end of volume set']
sta.07: [asciz '... winding tape']
sta.08:	[asciz '... searching tape']
sta.09:	[asciz '... reading ']
sta.10:	[asciz '... volume ']
sta.11:	[asciz '... writing ']



;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Defaults  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Defaults

; [25] Defaults
def.04:	^d8192
def.06:	sixbit	'NONAME'
def.07:	^d1600



;;;;;;;;;;;;;;;;;;;;;;;;;;;;  DOFUNC  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	DOFUNC

; [25] Get a TENVAX function from the user and do it.
dofunc:	movem	p,savedp		; save stack pointer
	movei	t1,tk.wrd		; want a sixbit word
	movem	t1,token
	move	t1,prm.02		; prompt
	movem	t1,prompt
	move	t1,hlp.02		; help message
	movem	t1,hlpmsg
	pushj	p,p$inp			; input
	 jrst	dofunc			; no default, try again
	move	t1,[iowd ftblen,funtab]	; setup for .name lookup
	pushj	p,.name##		; search function table
	 jrst	badfun			; unknown or ambiguous function
	pushj	p,@distab-funtab(t1)	; dispatch
	 jfcl				; ignore error
	popj	p,			; nonskip return

; Here when the function asked for doesn't exist or is ambiguous
badfun:	jumpl	t1,nofun		; doesn't exist
	move	t1,err.01		; ambiguous
	pushj	p,errmsg		; error message
	jrst	dofunc			; try again

; Here when the function asked for doesn't exist
nofun:	move	t1,err.02		; no such function
	pushj	p,errmsg		; error message
	jrst	dofunc			; try again

; Function and dispatch tables
funtab:	sixbit	'direct'
	sixbit	'exit'
	sixbit	'read'
	sixbit	'rewind'
	sixbit	'wind'
	sixbit	'write'
	sixbit	'zzt'		; use 'zzt' instead of 'ddt' so D = DIRECTORY
ftblen==.-funtab

distab:	f.dire
	f.exit
	f.read
	f.rewi
	f.wind
	f.writ
	$ddt



;;;;;;;;;;;;;;;;;;;;;;;;;;  DOFUNC modules  ;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	DOFUNC modules

; [25] These modules, with names beginning "f.", form a front-end to
; the Vaxine 'action' modules.  They simply call the appropriate Vaxine
; modules, and ignore any error returns.

f.dire:	pushj	p,$dir			; call Vaxine module
	 jfcl				; ignore error return
	popj	p,			; nonskip return

f.wind:	pushj	p,$eot
	 jfcl
	popj	p,

f.exit:	pushj	p,$quit
	 jfcl
	popj	p,

f.read:	pushj	p,$red11
	 jfcl
	popj	p,

f.rewi:	pushj	p,$rew
	 jfcl
	popj	p,

f.writ:	pushj	p,$wrt
	 jfcl
	popj	p,



;;;;;;;;;;;;;;;;;;;;;;;;;  Parameter Modules  ;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Parameter Modules

; [25] These modules are a front-end to the Vaxine parameter-setting
; modules.  Unlike the function modules (above), however, they do not
; ignore error returns.  An error return indicates that the parameter
; was entered incorrectly.  TENVAX's parameter modules, because of
; the question interface, must continue to request input until the
; parameter is correctly entered.

p.bloc:	pushj	p,$block		; call Vaxine module
	 jrst	p.bloc			; no good -- try again
	popj	p,			; good -- nonskip return

p.dens:	pushj	p,$dens
	 jrst	p.dens
	popj	p,

p.tape:	pushj	p,$tap
	 jrst	p.tape
	popj	p,

p.volu:	pushj	p,$vol
	 jrst	p.volu
	popj	p,


;;;;;;;;;;;;;;;;;;;;;;;;;;;  NEWSET  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Newset

; [25] Get parameters for new volume set.
; Called from "initp1" (write tape initialization).

newset:	move	t1,sta.03		; status message
	pushj	p,typel
	pushj	p,p.volu		; get volume name
	pushj	p,p.dens		; get tape density
	popj	p,			; nonskip return


;;;;;;;;;;;;;;;;;;;;;;;;  Message Routines  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Message Routines

; [25] Type a message fragment passed in t1, without adding a <cr><lf>.
typef:	pushj	p,.tstrg##
	popj	p,

; [25] Type a message line passed in t1, adding a <cr><lf>.
typel:	pushj	p,.tstrg##
	pushj	p,.tcrlf##
	popj	p,

; [25] Type the error prefix ("ERROR ").
errpre:	push	p,t1			; save t1
	move	t1,err.00		; prefix
	pushj	p,typef			; type it
	pop	p,t1			; restore t1
	popj	p,

; [25] Type an error message, passed in t1.
; Can either call this code as a subroutine (with a pushj), or jump
; to this code as an error-exit (with a pjrst).  In the case of the
; error-exit, note the nonskip return.
errmsg:	pushj	p,errpre		; type error prefix
	pushj	p,typel			; type error message, with a <cr><lf>
	pushj	p,.clrbf##		; clear the input line
	popj	p,			; nonskip return

; [25] Type an error message passed in t1, with no <cr><lf> at end.
; Similar to errmsg.
errmsf:	pushj	p,errpre		; prefix
	pushj	p,typef			; no <cr><lf>
	pushj	p,.clrbf##		; clear input buffer
	popj	p,			; nonskip return

; [25] Type a help message, passed in t1.
dohelp:	pushj	p,typel			; type the message
	pushj	p,.tcrlf##		; extra blank line at end
	popj	p,



;;;;;;;;;;;;;;;;;;;;;;;;;;;;  Escape  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

subttl	Escape

; [25] Recover from a failure by escaping to top level.
; Come here when we are really in trouble.
; Pass error message in t1 if calling "escape".
; No error message if calling "esc.1".

escape:	pushj	p,errmsg		; type the error message
esc.1:	skipn	savedp			; not inside DOFUNC yet?
	 jrst	f.exit			; ..must exit
	move	p,savedp		; clean up stack
	jrst	dofunc			; jump back to DOFUNC



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
	END	start
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;