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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;