Trailing-Edge
-
PDP-10 Archives
-
LCG_Integration_Tools_Clearinghouse_T20_v7_30Apr86
-
tools/tape11/tape11.mac
There are 3 other files named tape11.mac in the archive. Click here to see a list.
Title Tape11 - Files-11 (ANSI) tape writer
Subttl Berk Shands @ EE for ASW
search monsym,macsym
sall
comment &
This program writes ANSI format tapes (Compatable with RFIL11)
for transportability to RSX-11, VAX/VMS, Tops-10/20 or just about any
nerdy system that supports ANSI tape labels. The default density is 1600 BPI.
See Appendix G rsx-11 i/o operations manual (aa-2515d-tc)&
;note: does not require TM02 controller
if2 <Printx [TAPE11: Start of pass two]>
subttl Table of nitwits
; Table of Contents for Labeled tape facility
;
;
; Section Page
;
; 1. Berk Shands @ EE for ASW . . . . . . . . . . . . . . . 1
; 2. Table of nitwits . . . . . . . . . . . . . . . . . . . 2
; 3. Revision history . . . . . . . . . . . . . . . . . . . 4
; 4. definitions . . . . . . . . . . . . . . . . . . . . . 5
; 5. entry vector address . . . . . . . . . . . . . . . . . 6
; 6. label fields
; 6.1 Volume 1 . . . . . . . . . . . . . . . . . . . 7
; 6.2 Header 1 . . . . . . . . . . . . . . . . . . . 8
; 6.3 Header 2 . . . . . . . . . . . . . . . . . . . 9
; 6.4 Header 3 and beyond . . . . . . . . . . . . . 10
; 7. macros . . . . . . . . . . . . . . . . . . . . . . . . 11
; 8. Command tables . . . . . . . . . . . . . . . . . . . . 12
; 9. starting address - entry vector . . . . . . . . . . . 17
; 10. fix command errors . . . . . . . . . . . . . . . . . . 19
; 11. reparse and confirm . . . . . . . . . . . . . . . . . 20
; 12. Parsing
; 12.1 Ascii character set (default) . . . . . . . . 21
; 12.2 Blocksize of physical record . . . . . . . . . 22
; 12.3 DDT pull out the raid . . . . . . . . . . . . 23
; 12.4 Density of output device . . . . . . . . . . . 24
; 12.5 Device for output . . . . . . . . . . . . . . 25
; 12.6 EBCDIC character set (non-default) . . . . . . 26
; 12.7 EOT skip to end of tape . . . . . . . . . . . 27
; 12.8 Exit to monitor . . . . . . . . . . . . . . . 28
; 12.9 File list . . . . . . . . . . . . . . . . . . 29
; 12.10 Format of tape data . . . . . . . . . . . . . 30
; 12.11 Help the forgetful user . . . . . . . . . . . 32
; 12.12 Headers to write tape with . . . . . . . . . . 33
; 12.13 Information on status of parameters . . . . . 34
; 12.14 Labels on tape . . . . . . . . . . . . . . . . 35
; 12.15 Padding character . . . . . . . . . . . . . . 36
; 12.16 Parity of data on tape . . . . . . . . . . . . 37
; 12.17 Push to new exec . . . . . . . . . . . . . . . 38
; 12.18 Record size (logical block) . . . . . . . . . 39
; 12.19 Volume label . . . . . . . . . . . . . . . . . 40
; 13. Execution
; 13.1 Ascii character set . . . . . . . . . . . . . 41
; 13.2 Blocksize physical record . . . . . . . . . . 42
; 13.3 DDT enter debugerer . . . . . . . . . . . . . 43
; 13.4 Density of output . . . . . . . . . . . . . . 44
; 13.5 Device for output . . . . . . . . . . . . . . 45
; 13.6 Ebcdic character set . . . . . . . . . . . . . 48
; 13.7 EOT tape skip . . . . . . . . . . . . . . . . 49
;[ C o n t i n u e d o n n e x t p a g e ]
;[ C o n t i n u e d f r o m l a s t p a g e]
; 13.8 Exit to monitor . . . . . . . . . . . . . . . 50
; 13.9 Format of written data . . . . . . . . . . . . 51
; 13.10 Help the user . . . . . . . . . . . . . . . . 52
; 13.11 Headers set header counts . . . . . . . . . . 53
; 13.12 Information on status . . . . . . . . . . . . 54
; 13.13 Labels on tape . . . . . . . . . . . . . . . . 57
; 13.14 Padding character . . . . . . . . . . . . . . 58
; 13.15 Parity of tape . . . . . . . . . . . . . . . . 59
; 13.16 Push to new exec . . . . . . . . . . . . . . . 60
; 13.17 Record size (logical block length) . . . . . . 62
; 13.18 Volume labels . . . . . . . . . . . . . . . . 63
; 13.19 File processing . . . . . . . . . . . . . . . 64
; 14. Subroutines
; 14.1 maknam make file name into string . . . . . . 67
; 14.2 Pfile process file data . . . . . . . . . . . 70
; 14.3 PFILE - pfflr fixed len records . . . . . . . 72
; 14.4 PFILE - pfuft image mode (N bit) . . . . . . . 75
; 14.5 PFILE - pfvlr variable length records . . . . 77
; 14.6 mtaerr recover from tape errors . . . . . . . 80
; 14.7 wrteof/wrtbot . . . . . . . . . . . . . . . . 83
; 14.8 filbot/fileot . . . . . . . . . . . . . . . . 84
; 14.9 filxhd write extra HDR labels . . . . . . . . 87
; 14.10 opnmta open magtape device . . . . . . . . . . 88
; 14.11 cvtebc convert string to EBCDIC . . . . . . . 89
; 14.12 Ascii to Ebcdic translation table . . . . . . 90
; 15. Fatal errors here . . . . . . . . . . . . . . . . . . 91
; 16. literals . . . . . . . . . . . . . . . . . . . . . . . 92
; 17. impure storage . . . . . . . . . . . . . . . . . . . . 93
subttl Revision history
vmajor== 1
vminor== 0
vedit== 3 ;21-nov-83
vwho== 5 ;efbs 31-oct-82
;[1] New to support the 11 and IBM community
;[2] 13-jul-83 add HDR3 to HDRn support
; since rsx11 (4.0) uses funny headers
;[3] Zero length files ruin rsx11 tapes. check for null size
; on the tape first
;
;[***] end of revision history
subttl definitions
f== 0 ;flag register
t1== 1 ;jsys 1
t2== 2 ;jsys 2
t3== 3 ;jsys 3
t4== 4 ;jsys and string
t5== 5 ;string
t6== 6 ;string
a== 10 ;preserved acs
b== 11
c== 12
d== 13
e== 14
p== 17 ;the stack as usual
pdlen== 200 ;size of stack
MAXNUM==^d32768 ;biggest block size
MINNUM==^d8 ;one card block
MAXWRD== MAXNUM/4 ;8 bit bytes/buffer in words
dftpad== "^" ;DEC's padding character
DDTSTR== 770000 ;ddt's start address
kno== -1 ;symbol for NO
kyes== 0 ;symbol for YES
minhdr==2 ;[2] min # headers
maxhdr==9 ;[2] max headers
dfthdr==3 ;[2] default headers to use
;flags in f
f.den== 1b0 ;density was set
f.vol== 1b1 ;volume id was written
f.blk== 1b2 ;blocksize was set
f.rec== 1b3 ;recordsize was set
f.dev== 1b4 ;device is assigned
f.vol1==1b5 ;volume command given
f.nul== 1b6 ;output is nul device
f.wvl== 1b7 ;on file header write, add vol1 lbl
f.ebc== 1b8 ;convert all data to ebcdic on wrt
f.eof== 1b9 ;file EOF reached
f.bin== 1b10 ;8 bit i/o if set
f.nlb== 1b11 ;don't write labels
f.exe== 1b12 ;exec is initialized
subttl entry vector address
twoseg 400000
reloc 400000 ;[2] use dual segments
entvec::
jrst start
jrst start
byte(3)vwho(9)vmajor(6)vminor(18)vedit
skpret::
rskp::
cpopj1::aos (p) ;incr stack addr
cpopj:: popj p,
subttl label fields -- Volume 1
vol1c:
exp "V","O","L","1"
;Volume label id
exp "A","n","y","l","b","l"
;accessibility
exp " "
;reserved
repeat ^d26,<exp " ">
;owner field
;protection
exp "D","%","K" ;tops20
exp " "," "," "," " ;access field
;owner uic
exp " "," "," "," "," "," " ;system depenent
exp "1"
;reserved
repeat ^d28,<exp " ">
;label version
exp "1"
subttl Label fields -- Header 1
hdr1c:
;label id
exp "H","D","R","1"
;file name (17 characters)
exp "I","l","l","e","g","a","l",".","N","a","m","e"
repeat 5,<exp " ">
;file set id (copy of volume id label)
repeat 6,<exp " ">
;file section number (multi-volume file)
exp "0","0","0","1"
;file sequence #
exp "0","0","0","1"
;generation of file
exp "0","0","0","1"
;generation version
exp "0","0"
;creation date
exp " ","8","2","0","0","1" ;jan 01, 1982
;expiration date
exp " ","0","0","0","0","0" ;No date set
;accessibility
exp " "
;block count
exp "0","0","0","0","0","0"
;system code
exp "D","E","C","S","y","s","t","e","m","-","2","0"," "
;reserved
repeat ^d7,<exp " ">
subttl label fields -- Header 2
hdr2c:
;label id
exp "H","D","R","2"
;record format F,D,S,U
exp "D"
;physical block length
exp "0","0","5","1","2" ;512. bytes/block
;record length
exp "0","0","5","1","2" ;512. bytes/record
;system dependent info (append the crlf) or (contains Crlf)
repeat ^d35,<exp " ">
;buffer offset
exp "0","0"
;reserved
repeat ^d28,<exp " ">
subttl label fields -- Header 3 and beyond
hdr3c:
exp "H","D","R","3",
exp "0","0","0","0","0","2","0","2"
repeat ^d11,<exp "0">
exp "1",
repeat ^d44,<exp "0">
repeat ^d12,<exp " "> ;reserved fields
subttl macros
define nd(a,b),<
ifndef a,<a=b>
>;end nd macro
define $table(addr,flags,text),<
;;addr if not defined, is set to cpopj
;;flags are comnd jsys flags (cm%inv)
;;text is text of command name
if2 <
ND addr,cpopj
>;;end if2
[cm%fw!flags
asciz/text/],,addr>;end $table
define $tible(addr,flags,text),<
;;addr is a constant or a literal
;;flags are comnd jsys flags (cm%inv)
;;text is text of command name
[cm%fw!flags
asciz/text/],,addr>;end $table
define gword(text),<
xlist
<.cmnoi>b8
point 7,[asciz/text/]
list
>;end gword
define ehalt(text),<
ercal [tmsg <?'text
>
jrst fatal]
>;end ehalt
define jhalt(text),<
call [tmsg <?'text
>
jrst fatal]
>;end jhalt
define etype(text),<
ercal [push p,t1 ;;save the ac
tmsg <%'text
>
call lsterr ;;type last error
pop p,t1 ;;restore ac
RET] ;;return from macro
>;end etype
define text(arg) <
xlist
asciz/arg/
list
>;end text
subttl Command tables
cmnd:
cm%rai!rparse ;addr of reparse
.priin,,.priou ;in and out jfns
point 7,[asciz/T11>/]
point 7,bigbuf ;text buffer
point 7,bigbuf ;parsed pointer
200*5 ;bytes in buffer
z
point 7,atom
30*5 ;bytes in atom
jfnblk ;jfn long form addr
jfnb: ;dummy jfn long form block
gj%ifg!.gjall ;use all generations
.priin,,.priou ;jfns to use
z ;use connected directory
z ;and structure
point 7,[asciz/*/] ;all file names
point 7,[asciz/*/] ;all file types
z ;no protection
z ;accounts dont matter
z ;no special jfn
z ;no special argument block
cmdev:
<.cmdev>b8!cm%hpp!cm%dpp!confrm ;parse a device
z ;no data
point 7,[asciz/Tape drive that output is to be done on/]
point 7,[asciz/Mta0:/]
z ;no break mask
cmvol:
<.cmtxt>b8!cm%hpp!cm%dpp!confrm ;parse the volume id
z
point 7,[asciz/Volume label to identify tape by/]
point 7,[asciz/TAPE11/]
z ;no break mask
cmfil:
<.cmfil>b8!cm%hpp!cm%dpp!confrm ;parse file list
z
point 7,[asciz/File to be written to tape/]
point 7,[asciz/*.*.*/] ;default name
z
cmfmt:
<.cmkey>b8!cm%hpp!cm%dpp!confrm ;parse the format to write with
exp fmtkey ;data is format table
point 7,[asciz/Format to write tape in/]
point 7,[asciz/Default/] ;default is 512/512 compressed
z
fmtkey:
5,,5 ;length of block
$table xbinr,,<Binary>
$table xdflt,,<Default>
$table xfxd,,<Fixed>
$table ximg,,<Image>
$table xvar,,<Variable>
cmcmd:
<.cmkey>b8!cm%hpp!confrm ;parse a regular command
cmdkey
point 7,[asciz/Directive for TAPE11/]
z
z
cmdkey:
cmk1,,cmk1 ;size of table
$table xasc,,<Ascii>
$table xblk,,<Blocksize>
$table xddt,cm%inv,<DDt>
$table xden,,<Density>
$table xebc,,<Ebcdic>
$table xeot,,<Eot>
$table xexit,,<Exit>
$table xfile,,<File>
$table xfmt,,<Format>
$table xhdrs,,<Headers>
$table xhelp,,<Help>
$table xinfo,,<Information>
$table xlab,,<Labels>
$table xpad,,<Padding>
$table xpar,,<Parity>
$table xpush,,<Push>
$table xrec,,<Recordsize>
$table xdev,,<Tape>
$table xvol,,<Volume>
cmk1==.-cmdkey-1
confrm:
<.cmcfm>b8
z
z
z
cmini:
<.cmini>b8
z
z
z
parkey:
3,,3
$tible .sjpre,cm%inv,<Bad-parity>
$tible .sjpre,,<Even-parity>
$tible .sjpro,,<Odd-parity>
cmprty:
<.cmkey>b8!cm%hpp!cm%dpp!confrm
exp parkey
point 7,[asciz/Setting of 9th bit on tape, normally ODD/]
point 7,[asciz/Odd-parity/]
z
cmden:
<.cmkey>b8!cm%hpp!cm%dpp!confrm ;parse the density keywords
denkey
point 7,[asciz/
Bits per inch to write the tape with. This command may only be given
once for each tape to be written./]
point 7,[asciz/Default/]
z ;no break mask
denkey:
6,,6
$tible .sjd16,,<1600>
$tible .sjdn2,,<200>
$tible .sjdn5,,<556>
$tible .sjd62,,<6250>
$tible .sjdn8,,<800>
$tible .sjddn,,<Default>
cmnumd:
<.cmnux>b8!cm%hpp!cm%dpp!confrm ;decimal number parse
exp ^d10
point 7,[asciz/Count of bytes to use/]
point 7,[asciz/512/]
z
cmnumo:
<.cmnux>b8!cm%hpp!cm%dpp!confrm ;octal input (pad character)
exp ^d8 ;octal input
point 7,[asciz/
Octal value of pad character to use if blocksize is not a multiple
of the recordsize. Useful only for the FIXED format./]
point 7,[asciz/136/] ;padd with "^"
z
cmlab:
<.cmkey>b8!cm%hpp!cm%dpp!confrm ;label status
exp labkey ;two word table
point 7,[asciz/Labels are required for ANSI
standard tapes. This option is provided to remove them if desired.
"YES" will write the labels (default). "NO" inhibits labels.
/]
point 7,[asciz/Yes/]
z
labkey:
2,,2
$tible kno,,<No>
$tible kyes,,<Yes>
hdruno:
<.cmnux>b8!cm%hpp!cm%dpp!confrm ;number input
exp ^d10 ;decimal
point 7,[asciz/Number of HDR records in label 2 to 9/]
point 7,[asciz/3/] ;[2] default dfthdr
z
gwblk:
GWORD <In decimal bytes>
gwden:
GWORD <In BPI>
gwdev:
GWORD <For output>
gwexi:
GWORD <To monitor>
gwfil:
GWORD <To write on tape>
gwfor:
GWORD <Of written data>
gwpad:
GWORD <Character in octal>
gwrec:
GWORD <In decimal bytes>
gwvol:
GWORD <Label>
gwdef:
GWORD <To previous setting>
gwfix:
GWORD <Length records>
gwimg:
GWORD <No translation>
gwvar:
GWORD <Length records>
gweot:
GWORD <Postion tape at EOT>
gwasc:
GWORD <Character set>
gwebc:
GWORD <Character set>
gwddt:
GWORD <Bug repellent>
gwhel:
GWORD <For TAPE11>
gwinf:
GWORD <On current settings>
gwpar:
GWORD <Of data on tape>
gwlab:
GWORD <On tape>
gwpus:
GWORD <To new EXEC>
gwhdr:
GWORD <Contained in label field>
subttl starting address - entry vector
start:
RESET% ;clear the world
move p,[iowd pdlen,pdlst] ;set up the regular stack
tmsg <
Tape11 ANSI Substandard tape writer Version 1(3) 26-Jan-84
>
setz f, ;clear all flags
;clear memory
move t1,[.lowa,,.lowa+1] ;blt word for clearing
setzm .lowa ;clear first word
blt t1,.higha ;to last word
;set up defaults
movx t1,.sjddn ;default density
movem t1,dens ;save density
movei t1,^d512 ;default record size
movem t1,recl ;set record len
movem t1,pblk ;and blocksize
move t1,["U",,"M"] ;set up default format
movem t1,fmt ;save format
movei t1,dftpad ;get default pad char
movem t1,pad ;save character
move t1,[byte (8)dftpad,dftpad,dftpad,dftpad]
movem t1,padwrd ;save 4 of them
movx t1,dfthdr ;[2] set up counts
movem t1,numhdr ;[2] save count
;here after successful command
top:
dmove t1,[bigbuf,,bigbuf+1 ;clear text buffer
atom,,atom+1] ;and clear atom too
setzm bigbuf ;start clear
blt t1,bigbuf+177 ;clear to end
setzm atom ;clear atom
blt t2,atom+27 ;to the end
;copy read only tables down
move t1,[cmnd,,comand] ;set up comand state block
blt t1,comand+.cmgjb ;move to writable store
;here to reparse after error
top1:
movei t1,comand ;point to state block
movei t2,cmini ;reset system
COMND% ;do the jsys
EHALT <?Failed to INIT comand jsys>
txne t1,cm%nop ;total failure ?
JHALT <?INIT function failed>
;here for next keyword (after ^H)
top2:
movei t1,comand ;point to state block
movei t2,cmcmd ;and top of chain
COMND% ;parse a command
EHALT <?Failed to parse keyword>
txne t1,cm%nop ;failure ?
jrst fixerr ;yes, analyse and report
;dispatch the command
movei t3,(t3) ;isolate state word
cain t3,confrm ;lone confirm ?
jrst top ;yes, ignore it
hrrz t2,(t2) ;get addr of next parse
call (t2) ;continue parsing
jrst fixerr ;some form of parsing error
call (a) ;execute the function
jrst fixerr ;error, type out string
jrst top ;done
subttl fix command errors
lsterr:
push p,t1 ;save acs
push p,t2
push p,t3
tmsg <%Last error was: >
hrloi t2,.fhslf ;last error in this process
movei t1,.priou ;output to tty
setz t3, ;no limit
ERSTR% ;type error string
ERJMP .+1
ERJMP .+1 ;ignore error returns
tmsg <
>
pop p,t3
pop p,t2
pop p,t1 ;restore acs
RET ;return to caller
fixerr:
call lsterr ;type last error
jrst top1 ;just do init
subttl reparse and confirm
rparse:
skipe t1,filjfn ;any jfn there ?
RLJFN% ;yes, bu no longer
ETYPE <Failed to release JFN on reparse>
setzm filjfn ;clear old stuff
move p,[iowd pdlen,pdlst] ;reset stack
jrst top2 ;try again
firmup:
movei t1,comand ;comand block
movei t2,confrm ;confirm only
COMND% ;ask user ok
txne t1,cm%nop ;given
RET ;no - give ip
RETSKP ;give good return
subttl Parsing -- Ascii character set (default)
xasc:
movei t1,comand ;point to state block
movei t2,gwasc ;and to (xxx)
COMND% ;parse guide word
txne t1,cm%nop ;error ?
RET ;yes, lose
movei a,dasc ;dispatch to ascii
jrst firmup ;confirm it
subttl Parsing -- Blocksize of physical record
xblk:
movei t1,comand ;point to state block
movei t2,gwblk ;do guide word
COMND% ;parse guideword
txne t1,cm%nop ;error ?
RET ;yes, turkey cant type
;parse a decimal number for bytes per physical record
movei t1,comand ;reset to state block
movei t2,cmnumd ;decimal #
COMND% ;parse it
txne t1,cm%nop ;error ?
RET ;yes, you lose
;test number, MINNUM .le. X .le. MAXNUM
caml t2,[MINNUM] ;too small ?
camle t2,[MAXNUM] ;too big ?
jrst xblkne ;number error
;save the number and confirm
movem t2,pblkt ;save temporary block size
movei a,dblk ;mark dispatch address
jrst firmup ;confirm request
;here on error in number
xblkne:
tmsg <%Number is out of allowed range (8 - 32768)
>
RET ;abort the request
subttl Parsing -- DDT pull out the raid
xddt:
movei t1,comand ;point to state block
movei t2,gwddt ;(bug spray)
COMND% ;type guide word
txne t1,cm%nop ;error ?
RET ;you lose
movei a,dddt ;dispatch to ddt
jrst firmup ;confirm it
subttl Parsing -- Density of output device
xden:
movei t1,comand ;state block
movei t2,gwden ;guide word
COMND% ;parse guide word
txne t1,cm%nop ;error ?
RET ;yes, return
;look in table for density to set drive to
movei t1,comand ;state block
movei t2,cmden ;density lookup
COMND% ;parse keywords
txne t1,cm%nop ;failed ?
RET ;yes, give up
;save density (check it later)
hrrz t2,(t2) ;get value
movem t2,denst ;save temporary
movei a,dden ;mark dispatch address
jrst firmup ;done
subttl Parsing -- Device for output
xdev:
movei t1,comand ;state block
movei t2,gwdev ;guide word
COMND% ;parse it
txne t1,cm%nop ;error ?
RET ;yes, lose
;parse the device name (mta0: or mtxxx)
movei t1,comand ;state block
movei t2,cmdev ;get the device
COMND% ;parse the name
txne t1,cm%nop ;error ?
RET ;yes, lose
;save the device id (6xxxxxx,,xxxxxx)
movem t2,devdt ;save temp
movei a,ddev ;set up dispatch address
jrst firmup ;and leave (for confirm)
subttl Parsing -- EBCDIC character set (non-default)
xebc:
movei t1,comand ;point to state block
movei t2,gwebc ;and to (xxx)
COMND% ;parse guide word
txne t1,cm%nop ;error ?
RET ;yes, lose
movei a,debc ;dispatch to ebcdic
jrst firmup ;confirm it
subttl Parsing -- EOT skip to end of tape
xeot:
movei t1,comand ;state block
movei t2,gweot ;guide word
COMND% ;parse guide word if any
txne t1,cm%nop ;error ?
RET ;yes, lose
;confirm and dispatch
movei a,deot ;dispatch here
jrst firmup ;confirm it
subttl Parsing -- Exit to monitor
xexit:
movei t1,comand ;point to state block
movei t2,gwexi ;guide word
COMND% ;parse it
txne t1,cm%nop ;error ?
RET ;yes, lose
;hit the confirm
movei a,dexi ;dispatch to exit
jrst firmup ;confirm it
subttl Parsing -- File list
xfile:
movei t1,comand ;state block
movei t2,gwfil ;guide words
COMND% ;(or a wildcard)
txne t1,cm%nop ;error ?
RET ;lose
;init the jfn arg block
move t1,[jfnb,,jfnblk] ;move it down
blt t1,jfnblk+.gjf2 ;set up block
;parse the file spec
movei t1,comand ;state block back
movei t2,cmfil ;parse the file
COMND% ;or wildcard spec
txne t1,cm%nop ;error ?
RET ;they lose
;save the jfn for later
movem t2,filjfn ;save it temp
movei a,dfile ;dispatch address
jrst firmup ;confirm it
subttl Parsing -- Format of tape data
xfmt:
movei t1,comand ;state block
movei t2,gwfor ;guide word
COMND% ;parse guide word
txne t1,cm%nop ;error ?
RET ;yes, quit now
;parse the keyword for the format to use
movei t1,comand ;state block
movei t2,cmfmt ;parse the keyword
COMND% ;find it in table
txne t1,cm%nop ;couldnt ?
RET ;yes, give up
;save the format and then confirm
hrrz t2,(t2) ;get next parse addr
movei a,dfmt ;dispatch addr
jrst (t2) ;continue parse later
;more of format parsing
xdflt:
movei t2,gwdef ;guide word set up
move b,["F",," "] ;format word
jrst xfmt0 ;continue
xfxd:
movei t2,gwfix ;guide word setup
move b,["F",," "] ;format word
jrst xfmt0 ;continue
xbinr:
setom bit8 ;set parse flag
trna ;skip next one
ximg:
setzm bit8 ;use 7 bits
movei t2,gwimg ;image guide word
move b,["U",,"M"] ;no format needed
jrst xfmt0 ;continue
xvar:
movei t2,gwvar ;variable guide word
move b,["D",," "] ;variable
xfmt0:
movei t1,comand ;set up state block
COMND% ;parse guide word
txne t1,cm%nop ;error ?
RET ;yes, lose
movei a,dfmt ;set up dispatch address
movem b,fmtt ;save format descriptor
jrst firmup ;go confirm command
subttl Parsing -- Help the forgetful user
xhelp:
movei t1,comand ;point to state block
movei t2,gwhel ;point to guide word
COMND% ;parse it
txne t1,cm%nop ;error ?
RET ;yes, lose
movei a,dhelp ;dispatch to help
jrst firmup
subttl Parsing -- Headers to write tape with
xhdrs:
movei t1,comand ;point to state block
movei t2,gwhdr ;point to guide word
COMND% ;parse it
txne t1,cm%nop ;error ?
RET ;yes, lose
movei t1,comand ;reset to block
movei t2,hdruno ;parse number of headers
COMND% ;check it
txne t1,cm%nop ;error ?
RET ;[2] you lose
cail t2,minhdr ;[2] too small ?
caile t2,maxhdr ;[2] too big?
jrst xhdrs1 ;[2] you lose idiot
movem t2,hdrnmt ;[2] save temp
movei a,dhdrs ;[2] dispatch addr
jrst firmup ;[2] continue
xhdrs1:
tmsg <?Number of headers is out of range 2 to 9
>
RET ;[2] lose
subttl Parsing -- Information on status of parameters
xinfo:
movei t1,comand ;state block
movei t2,gwinf ;guide word
COMND% ;parse guide word
txne t1,cm%nop ;error ?
RET ;yes, you lose
movei a,dinfo ;dispatch address to a
jrst firmup ;and continue
subttl Parsing -- Labels on tape
xlab:
movei t1,comand ;point to state block
movei t2,gwlab ;and to guide block
COMND% ;parse it
txne t1,cm%nop ;error ?
RET ;yes, you lose
;parse the answer
movei t1,comand ;state block again
movei t2,cmlab ;ask for label status
COMND% ;which one ?
txne t1,cm%nop ;error ?
RET ;yes, you lose
;get the answer back
hrrz t2,(t2) ;get (-1,0)
hrrem t2,labtmp ;save label status
movei a,dlab ;set up dispatch address
jrst firmup ;and continue
subttl Parsing -- Padding character
xpad:
movei t1,comand ;command state block
movei t2,gwpad ;guide word for pad
COMND% ;parse it if any there
txne t1,cm%nop ;failure ?
RET ;yes, cant type
;parse the octal character
movei t1,comand ;state block
movei t2,cmnumo ;octal number input
COMND% ;read number
txne t1,cm%nop ;error ?
RET ;yes, lose
;save the number if it looks good
cail t2,0 ;negative ?
caile t2,377 ;too big (parity allowed)
jrst xpadbn ;bad number
movem t2,padt ;save pad character
movei a,dpad ;set execution address
jrst firmup ;and confirm it
;here if number flunks
xpadbn:
tmsg <%Number is not an ASCII character
>
RET
subttl Parsing -- Parity of data on tape
xpar:
movei t1,comand ;point to state block
movei t2,gwpar ;guide word for parity
COMND% ;parse word
txne t1,cm%nop ;error ?
RET ;yes, die
;parse the type of parity
movei t1,comand ;state block again
movei t2,cmprty ;parity block
COMND% ;parse odd/even
txne t1,cm%nop ;error ?
RET ;yes, lose
hrrz t2,(t2) ;get setting
movem t2,party ;save it
movei a,dpar ;set dispatch addr
jrst firmup ;confirm it
subttl Parsing -- Push to new exec
xpush:
movei t1,comand ;state block
movei t2,gwpus ;guide word
COMND% ;parse it
txne t1,cm%nop ;error ?
RET ;die if not right
movei a,dpush ;dispatch address
jrst firmup ;and confirm the request
subttl Parsing -- Record size (logical block)
xrec:
movei t1,comand ;state block
movei t2,gwrec ;guide word if escape
COMND% ;parse it
txne t1,cm%nop ;error ?
RET ;yes, you lose
;input the length of a logical record
movei t1,comand ;restore state block
movei t2,cmnumd ;decimal number
COMND% ;read logical size
txne t1,cm%nop ;error ?
RET ;yes, lose
;range check: must be in limits and smaller than phys limit
caml t2,[MINNUM] ;too small ?
camle t2,[MAXNUM] ;too big ?
jrst xrecbn ;bad number
movem t2,reclt ;save record length
movei a,drec ;dispatch to record addr
jrst firmup ;confirm it
;here on number error
xrecbn:
jrst xblkne ;use error routine
subttl Parsing -- Volume label
xvol:
movei t1,comand ;state block
movei t2,gwvol ;guide word for this ftn
COMND% ;parse it
txne t1,cm%nop ;error ?
RET ;yes, lose
;parse the rest of the line (6 characters)
movei t1,comand ;return to state block
movei t2,cmvol ;get volume id
COMND% ;read id
txne t1,cm%nop ;error ?
RET ;you lose
;copy first 6 chars if any
setzm volx ;clear old if any
setzm volx+1 ;and more too
movei t1,6 ;count
dmove t2,[point 7,atom ;from
point 7,volx] ;get byte pointers
ildb t4,t2 ;get byte from atom
jumpe t4,xvol1 ;but stop on null
idpb t4,t3 ;save byte
sojg t1,.-3 ;loop for all 6
;here after all 6
xvol1:
movei a,dvol ;set dispatch addr
jrst firmup ;and go confirm
subttl Execution -- Ascii character set
dasc:
;volume labels defined yet ?
txne f,f.vol ;if labels written, forget it
jrst dascvw ;volumes written
txz f,f.ebc ;clear ebc flag
RETSKP ;done
;here if labels applied
dascvw:
tmsg <%Labels written: can't change character set
>
RET ;done
subttl Execution -- Blocksize physical record
dblk:
;check to see if the logical record size is too big
;if so, clear record length and require a new entry
txo f,f.blk ;blocksize was set
move t1,pblkt ;get phys length
movem t1,pblk ;set as current
caml t1,recl ;new size smaller ?
RETSKP ;no. still ok
movem t1,recl ;clear it
;oops, better issue a message about that
txz f,f.rec ;clear record length flag
tmsg <%Recordsize exceeds Blocksize resetting recordsize
>
RET ;and return to caller
subttl Execution -- DDT enter debugerer
dddt:
;find ddt
;look at x,,770000
aos (p) ;give skip return later
move t1,[.fhslf,,770] ;get ddt's page
RMAP% ;is page there ?
ERJMP .+1
txne t2,rm%pex ;page exist ?
jrst DDTSTR ;yes, must be ddt
tmsg <% No DDT, try a fly swatter
>
RET ;done
subttl Execution -- Density of output
dden:
;density may only be given once per tape
;tape command resets the flag (and unloads if needed)
txoe f,f.den ;set density yet ?
jrst dden1 ;yes. check more
dden0:
move t1,denst ;get density
movem t1,dens ;save it
RETSKP ;done
;here if the density was set already
dden1:
txnn f,f.vol ;done writing yet ?
jrst dden0 ;no, maybe density was wrong
;issue error message
tmsg <%Volume labels written: can't change density
>
RET ;give up
subttl Execution -- Device for output
ddev:
;see if we have a device already if so, (and its different)
;then dump current one (close if needed).
;if device is the same, query about restarting
txne f,f.dev ;device selected yet ?
jrst ddevgd ;got device already
;no device, try to assign
ddev0:
move t1,devdt ;get designator
ldb t2,[point 6,t1,17] ;get device type
cain t2,.dvnul ;null device ?
jrst [txo f,f.nul ;null device flag on
jrst ddev1] ;and skip next
caie t2,.dvmta ;or magtape ?
jrst ddevnm ;not a magtape
txz f,f.nul ;clear null flag now
ASND% ;assign device
ERJMP ddevna ;not assigned
;set flags and return
ddev1:
txo f,f.dev ;ok, got device
move t1,devdt ;get it back
movem t1,devd ;and save for later
;now get jfn on device and set up for industry mode
setzm dxdev ;clear space holder
setzm dxdev+1 ;and another word
move t2,t1 ;get word from ac
hrroi t1,dxdev ;buffer area
DEVST% ;convert to string
ETYPE <Device designator would not convert to string>
movei t2,":" ;add the colon
idpb t2,t1 ;save byte
movx t1,gj%sht!gj%fou ;short form gtjfn
hrroi t2,dxdev ;point to string
GTJFN% ;get jfn
ETYPE <Failed to assign a JFN to device>
movem t1,mtajfn ;save jfn for later
;set mode to industry and density to current default
movx t2,8b5!17b9!of%wr ;open drive for i/o
OPENF% ;open
ERJMP ddevco ;couldnt open
move t1,mtajfn ;restore jfn
movx t2,.mosdm ;set data mode function
movx t3,.sjdm8 ;industry mode
MTOPR% ;set mode
ETYPE <Couldn't set industry mode for tape drive>
move t1,mtajfn ;restore jfn
movx t2,.mosdn ;set density
move t3,dens ;get density
MTOPR% ;set density
ETYPE <Couldn't set density in tape command>
move t1,mtajfn ;get jfn of tape
movei t2,.mospr ;set parity
move t3,parity ;get setting
MTOPR% ;set parity
ETYPE <Couldn't set parity in tape command>
movx t1,co%nrj ;do not give up jfn
hrr t1,mtajfn ;put jfn in rh
CLOSF% ;dump device
ERJMP .+1
RETSKP ;done
;here if device is not a magtape or null device
ddevnm:
tmsg <%Device is not a magtape
>
RET ;error out
;here if assign failed
ddevna:
tmsg <%Could not assign that device
>
RET ;error out with message
;here if device was assigned
ddevgd:
move t1,devd ;get device id
camn t1,devdt ;assigning same device ?
jrst ddevsd ;yes, take care of it
;device is new, but we still have old device
txze f,f.vol ;written volume id yet ?
call wrteof ;yes, write eof
txz f,f.dev!f.den ;clear device flag
move t1,mtajfn ;get old jfn
RLJFN% ;dump jfn
ETYPE <Failed to release JFN>
move t1,devd ;get old device id
RELD% ;release old device
ETYPE <Failed to deassign device>
jrst ddev0 ;continue normally
;here if same device
ddevsd:
txze f,f.vol ;written labels yet ?
call wrteof ;yes, write close labels
jrst ddev1 ;continue
;here if open failed
ddevco:
tmsg <%Open failure on device
>
call lsterr ;give reason
move t1,mtajfn ;get jfn
RLJFN% ;dump jfn
ERJMP .+1
move t1,devd ;get designator
RELD% ;and dump it too
ERJMP .+1
setzm devd ;clear remainder
setzm mtajfn ;no jfn still
txz f,f.dev ;no device anymore
RETSKP ;failure (no err rtn)
subttl Execution -- Ebcdic character set
debc:
;volume labels defined yet ?
txne f,f.vol ;if labels written, forget it
jrst dascvw ;volumes written
txo f,f.ebc ;set ebcdic flag
RETSKP ;done
subttl Execution -- EOT tape skip
deot:
;must have device specified
txnn f,f.dev ;device assigned ?
jrst deotnd ;no, error out
;openf the device and go for eot
txoe f,f.vol!f.vol1 ;no need for label
jrst deot2x ;but if done already...
txne f,f.nul ;nul device ?
RETSKP ;yes, ignore this
;grab drive
movei b,^d512 ;set big records
call opnmta ;and open the tape drive
;now move to double tape mark
move t1,mtajfn ;put jfn back
movx t2,.moeot ;eot function
setz t3, ;clear just in case
MTOPR% ;skip to eot
ETYPE <Failed to hit EOT abort program NOW>
movx t1,co%nrj ;save jfn
hrr t1,mtajfn ;put jfn in rh
CLOSF% ;close file
ETYPE <Failed to save JFN on close>
RETSKP ;ok.
;here on no device
deotnd:
tmsg <%No tape specified
>
RET ;die
;here if done once (or more)
deot2x:
tmsg <%Volume ID set or tape at EOT
>
RET
subttl Execution -- Exit to monitor
dexi:
txze f,f.vol ;volume labels written ?
call wrteof ;yes, close out drive
skipe t1,mtajfn ;any open jfn ?
RLJFN% ;yes, close it
ETYPE <Failed to release JFN of tape>
move t1,devd ;get device id
txze f,f.dev ;still assigned ?
RELD% ;yes, let go of it
ETYPE <Failed to deassign device>
HALTF% ;stop process
tmsg <[What if I don't want to?]
>
RETSKP ;continue if needed
subttl Execution -- Format of written data
dfmt:
txz f,f.bin ;clear setting
move t1,fmtt ;get temp format
movem t1,fmt ;save data format
skipe bit8 ;use 8 bit ?
txo f,f.bin ;yes, use 8 bit
RETSKP ;done
subttl Execution -- Help the user
dhelp:
hrroi t1,hlpmsg ;point to text
PSOUT% ;write it
RETSKP ;and quit
hlpmsg:
TEXT <
Tape11 commands:
ASCII Sets data mode to be ASCII characters (default)
BLOCKSIZE Sets physical record length of data records (512. default)
DENSITY Sets the bits per inch for writing (defaults to system)
EBCDIC Sets IBM compatable character set, affects labels too
EOT Positions tape after last file on tape (double tape mark)
EXIT Returns user to TOPS20 command level
FILE Specifies files to write to tape (defaults to *.*.*)
FORMAT Sets the type of logical record to be written (defaults to image)
HEADERS Sets the number of HDR records in tape labels
HELP Types this text
INFORMATION Lists status of current settings
LABELS Turns on or off the write labels flag (NO to inhibit labels)
PADDING Sets the ASCII character to be used to fill partial blocks
PARITY Sets the parity to use for output on tape (defaults to ODD)
PUSH Gets and starts another EXEC. POP to return to TAPE11
RECORDSIZE Sets the logical record length (defaults to 512. bytes)
TAPE Identifies the tape drive to use
VOLUME Sets the volume label
>
subttl Execution -- Headers set header counts
dhdrs:
txne f,f.vol ;[2] started labels yet?
jrst dhdrs1 ;[2] yes, you lose
move t1,hdrnmt ;get count
movem t1,numhdr ;[2] save count
RETSKP ;[2] thats all
dhdrs1:
tmsg <%Volume labels written - can not change HDR count
>
RET ;[2] you lose
subttl Execution -- Information on status
dinfo:
tmsg <Character set is: >
hrroi t1,[asciz/Ascii/]
txne f,f.ebc ;check ebc flag
hrroi t1,[asciz/Ebcdic/] ;was ebcdic
PSOUT% ;write it
tmsg <
Physical blocksize is: >
movei t1,.priou ;write to tty
move t2,pblk ;get blocksize
movei t3,^d10 ;base 10
NOUT%
ERJMP .+1
hrroi t1,[asciz/ not set!/] ;see if user set it
txnn f,f.blk ;set blocksize ?
PSOUT% ;no, complain
tmsg <
Logical record size is: >
movei t1,.priou ;out to tty
move t2,recl ;get record length
movei t3,^d10 ;base 10
NOUT% ;type number
ERJMP .+1
hrroi t1,[asciz/ not set!/] ;set yet ?
txnn f,f.rec ;check and see
PSOUT% ;no set, complain
tmsg <
Density is: >
hrroi t1,[asciz/Default/] ;assume the worst
move t2,dens ;get density
cain t2,.sjdn2 ;200 bpi ?
hrroi t1,[asciz/200/] ;yes
cain t2,.sjdn5 ;556 ?
hrroi t1,[asciz/556/] ;yes
cain t2,.sjdn8 ;800 ?
hrroi t1,[asciz/800/] ;yes
cain t2,.sjd16 ;1600 PE ?
hrroi t1,[asciz/1600/] ;yes
cain t2,.sjd62 ;6250 ?
hrroi t1,[asciz/6250/] ;yes
PSOUT% ;type it
tmsg <
Format is: >
move t2,fmt ;get format
hrroi t1,[asciz/ERROR/] ;assume image
camn t2,["F",," "] ;fixed length ?
hrroi t1,[asciz/Fixed length/] ;yes
camn t2,["U",,"M"] ;image ?
hrroi t1,[asciz/Image/] ;yes
camn t2,["D",," "] ;variable length
hrroi t1,[asciz/Variable - RSX11/] ;yes
PSOUT% ;write it
hrroi t1,[asciz/ 8 bit binary/] ;for binary mode
txne f,f.bin ;using it ?
PSOUT% ;yes, say so
tmsg <
Parity is: >
hrroi t1,[asciz/Odd/] ;assume odd
movei t2,.sjpro ;test format
came t2,parity ;check parity
hrroi t1,[asciz/Even/] ;other bad parity
PSOUT% ;type it
tmsg <
Pad character is: >
movei t1,.priou ;out to tty
move t2,pad ;get it
movei t3,^d8 ;octal
NOUT% ;write number
ERJMP .+1
tmsg <
Number of HDR records in label field is: >
movei t1,.priou ;out to tty
move t2,numhdr ;get it
movei t3,^d10 ;octal
NOUT% ;write number
ERJMP .+1
hrroi t1,[asciz/
No tape identified yet/]
txnn f,f.dev ;tape command given ?
PSOUT% ;no, inform user
hrroi t1,[asciz/
Tape output goes into the bit bucket!!/]
txne f,f.nul ;using bit bucket ?
PSOUT% ;yes, say so
hrroi t1,[asciz/
No volume label set yet/]
txnn f,f.vol1 ;labels identified ?
PSOUT% ;no, complain
hrroi t1,[asciz/
Labels are written/]
txne f,f.vol ;labels applied ?
PSOUT% ;yes, say so
tmsg <
>
hrroi t1,[asciz/Tape label writing is inhibited!!!
/]
txne f,f.nlb ;labels being output ?
PSOUT% ;no, say so
hrroi t1,[asciz/EXEC is initialized
/]
txne f,f.exe ;exec started ?
PSOUT% ;yes, say so
RETSKP ;done
subttl Execution -- Labels on tape
dlab:
txne f,f.vol ;lables applied ?
jrst dlabla ;yes, too late
txz f,f.nlb ;assume cleared
skipe labtmp ;test for "NO" (0)
txo f,f.nlb ;set flag
RETSKP ;done
;here if labels written
dlabla:
tmsg <% Tape output already in progress, can't change label status
>
RET
subttl Execution -- Padding character
dpad:
move t1,padt ;get character
movem t1,pad ;save it
move t2,[point 8,padwrd] ;make 4 copies
idpb t1,t2 ;save it
idpb t1,t2 ;save it
idpb t1,t2 ;save it
idpb t1,t2 ;save it
RETSKP ;done
subttl Execution -- Parity of tape
dpar:
move t1,party ;get parity id
movem t1,parity ;save it
RETSKP ;done
subttl Execution -- Push to new exec
dpush:
txoe f,f.exe ;exec set up yet ?
jrst dpushe ;yes, skip init code
;find exec, and get it
movx t1,gj%sht!gj%old ;file must exist
hrroi t2,[asciz/ps:<system>exec.exe/] ;hard code name
GTJFN% ;get a jfn
ERJMP dpshnj ;you lose
;create fork
movem t1,execjf ;save jfn
movx t1,cr%cap ;same privs
setz t2, ;no pc
CFORK% ;create it
ERJMP dpshnf ;no fork
movem t1,execfh ;save handle
movss t1 ;swap handle
hrr t1,execjf ;add jfn (no flags)
setz t2, ;use all pages
GET% ;get the program
ERJMP dpshgf ;get failure
;start wait and return
hrrz t1,execfh ;get fork handle back
setz t2, ;no offset
SFRKV% ;start at entry vector
ETYPE <Couldn't start EXEC>
hrrz t1,execfh ;recover handle
WFORK% ;wait for it
RETSKP ;done for now
;here to continue
dpushe:
movx t1,sf%con ;continue exec
hrr t1,execfh ;get fork handle
setz t2, ;no pc, use old one
SFORK% ;start over
ETYPE <Couldn't continue EXEC>
hrrz t1,execfh ;get handle again
WFORK% ;wait for it
RETSKP ;and then return
;here for gtjfn failure
dpshnj:
tmsg <? GTJFN failed for ps:<system>exec.exe
>
txz f,f.exe ;clear flag
RET
;here for cfork failure
dpshnf:
move t1,execjf ;dump jfn
RLJFN% ;let go
ETYPE <Failed to release EXEC JFN>
tmsg <? Couldn't create EXEC fork
>
txz f,f.exe ;clear flag
RET
;here for GET failure
dpshgf:
tmsg <? Couldn't GET EXEC core image
>
move t1,execfh ;dump fork
KFORK% ;lose the fork
ETYPE <Couldn't kill EXEC fork>
move t1,execjf ;clean up
RLJFN% ;dump jfn
ETYPE <Failed to release EXEC JFN>
txz f,f.exe ;no exec
RET ;and stop
subttl Execution -- Record size (logical block length)
drec:
;see if block size set yet
txnn f,f.blk ;blocksize set ?
jrst drecnb ;no blocksize
;recordsize exceed blocksize ?
move t1,reclt ;get size specified
camle t1,pblk ;oversize ?
jrst drecbb ;bad blocksize
;good recordsize, check for modularity
txo f,f.rec ;recordsize given
movem t1,recl ;save it
move t2,pblk ;get blocksize
idiv t2,t1 ;reduce and check
skipn t3 ;remainder non-zero
RETSKP ;works ok
;issue message about padding characters
tmsg <%Padding is needed to fill blocksize gap
>
RETSKP ;still ok though
;here if no blocksize set
drecnb:
tmsg <%Blocksize not set yet
>
RET
;here if recorsize exceeds blocksize
drecbb:
tmsg <%Recordsize exceeds blocksize
>
RET
subttl Execution -- Volume labels
dvol:
;see if labels written yet
txne f,f.vol ;writen labels yet ?
jrst dvolvw ;yes, cant change
;no label yet, copy the header VOL1 data down and insert
;the label info
movei t1,1 ;reset count
movem t1,seqnum ;for files on tape
txo f,f.vol1 ;volume command given
move t1,[vol1c,,vol1] ;copy
blt t1,vol1+^d79 ;into writable memory
dmove t1,[-6,,volid ;make aobjn pointer
point 7,volx] ;and byte pointer available
ildb t3,t2 ;get a byte
cain t3,0 ;null ?
movei t3," " ;yes, substitute space
movem t3,(t1) ;save character
aobjn t1,.-4 ;loop for more
dvol1:
RETSKP ;done
;here if labels written already
dvolvw:
tmsg <%Labels already written to tape, can't change Volume ID
>
RET
subttl Execution -- File processing
dfile:
;first things first, make sure all parameters are set up
txnn f,f.dev ;got a device ?
jrst dfilnd ;no device
txnn f,f.blk ;blocksize ?
jrst dfilnb ;no blocksize
txnn f,f.rec ;recordsize ?
jrst dfilnr ;no recordsize
txnn f,f.vol1 ;volume identified ?
jrst dfilnv ;no volume
hrroi t1,[asciz/%Default density assumed
/]
txnn f,f.den ;density set ?
PSOUT% ;no, not fatal though
jrst dfil1 ;continue processing
;here on an error
dfilnd:
tmsg <%Tape not specified
>
RET
dfilnb:
tmsg <%Blocksize not set
>
RET
dfilnr:
tmsg <%Recordsize not set
>
RET
dfilnv:
tmsg <%Volume ID not set
>
RET
;here to process tapes
dfil1:
txon f,f.vol ;labels applied yet ?
call wrtbot ;no, do it first
;initialize headers
dfiltp:
dmove t1,[hdr1c,,hdr1 ;init low memory
hdr2c,,hdr2] ;for both labels
blt t1,hdr1+^d79 ;clear all
blt t2,hdr2+^d79 ;labels
;put in record junk
call maknam ;make the name fit
hrroi t1,numstr ;convert numbers
setzm (t1) ;clear scratch
setzm 1(t1) ;area
hrrz t2,seqnum ;get number to write
movx t3,no%lfl!no%zro!4b17!^d10 ;leading 0, base 10
NOUT% ;write into scratch area
ERJMP .+1 ;no need for message
dmove t1,[-4,,filseq ;aobjn ptr
point 7,numstr] ;and get byte ptr
ildb t3,t2 ;get a byte
movem t3,(t1) ;save byte
aobjn t1,.-2 ;loop for more
;do same for phys block and logical block
hrroi t1,numstr ;convert numbers
setzm (t1) ;clear scratch
setzm 1(t1) ;area
hrrz t2,pblk ;get number to write
movx t3,no%lfl!no%zro!5b17!^d10 ;leading 0, base 10
NOUT% ;write into scratch area
ERJMP .+1 ;no need for message
dmove t1,[-5,,pblkx ;aobjn ptr
point 7,numstr] ;and get byte ptr
ildb t3,t2 ;get a byte
movem t3,(t1) ;save byte
aobjn t1,.-2 ;loop for more
aos seqnum ;incr seq number
;do logical block size
hrroi t1,numstr ;convert numbers
setzm (t1) ;clear scratch
setzm 1(t1) ;area
hrrz t2,recl ;get number to write
movx t3,no%lfl!no%zro!5b17!^d10 ;leading 0, base 10
NOUT% ;write into scratch area
ERJMP .+1 ;no need for message
dmove t1,[-5,,lblk ;aobjn ptr
point 7,numstr] ;and get byte ptr
ildb t3,t2 ;get a byte
movem t3,(t1) ;save byte
aobjn t1,.-2 ;loop for more
;copy volume id into hdr1
dmove t1,[-6,,volid ;aobjn ptr
filset] ;output to file seq id
move t3,(t1) ;get a byte
movem t3,(t2) ;save the byte
aos t2 ;incr ptr
aobjn t1,.-3 ;loop for more
;write the headers
call filbot ;write the file header
call pfile ;process data portion
call fileot ;process trailers
;try for next file
move t1,filjfn ;get file jfn
GNJFN% ;get next jfn
ERJMP dfildn ;done!
jrst dfiltp ;do next file
;clean up and leave
dfildn:
tmsg <[No more files in this specification]
>
move t1,filjfn ;get jfn
CLOSF% ;dump file
ERJMP .+1 ;clear error if any
setzm filjfn ;and destroy old jfn
RETSKP ;bye
subttl Subroutines -- maknam make file name into string
maknam:
;process name, ext, gen and creation date
tmsg <[Working on: >
movei t1,.priou ;tell user the file name
hrrz t2,filjfn ;from current jfn
move t3,[111110,,js%paf] ;type full name
setz t4, ;no attribute
JFNS% ;type file name
ETYPE <Failed to type file name>
;do individual parts of name
dmove t1,[" " ;char to clear with
filnam,,filnam+1] ;get blt word
movem t1,filnam ;save blank
blt t2,filnam+^d16 ;save name
hrrz t2,filjfn ;get file id for more work
move t1,[name,,name+1] ;clear name string
setzm name ;get force null
blt t1,years+2 ;clean whole block
hrroi t1,name ;name first
movx t3,1b8 ;name only
JFNS% ;string out
ETYPE <Failed to string name>
hrroi t1,ext ;ext next
movx t3,1b11 ;type only
JFNS% ;string it
ETYPE <Failed to string type>
hrroi t1,gen ;generation next
movx t3,1b14 ;gen only
JFNS% ;string it
ETYPE <Failed to string generation>
;do creation date
hrrz t1,filjfn ;get file jfn again
move t2,[1,,.fbcrv] ;creation date
movei t3,cdate ;place to stick it
GTFDB% ;get date
ETYPE <Couldn't get creation date of file>
setzb t1,t3 ;clear unused acs
move t2,cdate ;get creation date
movx t4,ic%jud ;use julian date
ODCNV% ;convert to yy,ddd
ETYPE <Illegal date from .fbcrv>
push p,t2 ;save days (rh)
hlrz t2,t2 ;get year
idivi t2,^d100 ;make a two digit field
move t2,t3 ;recover remainder
hrroi t1,years ;point to string area
movx t3,no%lfl!no%zro!2b17!^d10 ;base 10 with leading 0
NOUT% ;write number
ERJMP .+1
pop p,t2 ;recover days
hrrzs t2 ;clear years, leave days
tlo t3,1 ;set for 3 cols
NOUT% ;write at end of string
ERJMP .+1
;set format
move t1,fmt ;get write format
hlrzm t1,rfmt ;save format
hrrzm t1,cctl ;save carriage ctl
;convert string to word address
dmove t1,[-5,,filcdt+1 ;aobjn ptr
point 7,years] ;byte ptr to data
ildb t3,t2 ;get a byte
movem t3,(t1) ;save byte
aobjn t1,.-2 ;loop for all
dmove t1,[-^d13,,filnam ;at most 13 chars in name
point 7,name] ;start lj on name
ildb t3,t2 ;get a name byte
jumpe t3,mknam1 ;stop on nul
movem t3,(t1) ;save byte
aobjn t1,.-3 ;loop over name
;name too long
push p,t1 ;save pointer
tmsg < [truncating name] >
pop p,t1 ;restore pointer
mknam1:
sub t1,[4,,0] ;allow at least 4 more chars
movei t3,"." ;dot the name
movem t3,(t1) ;save next byte
aobjn t1,.+1 ;and account for it
;do extension
move t2,[point 7,ext] ;reset pointer
ildb t3,t2 ;get a byte of type
jumpe t3,mknam2 ;stop on null
movem t3,(t1) ;save byte
aobjn t1,.-3 ;loop for more
;ext too long
ildb t3,t2 ;maybe ok, check again
jumpe t3,mknam2 ;was, dont panic
tmsg < [truncating type] >
mknam2:
;do generation
hrroi t1,gen ;take care of x.x.100000
setz t2, ;no number yet
movx t3,^d10 ;decimal generation
NIN% ;read and convert to #
ETYPE <Generation not converted to number>
andi t2,7777 ;reduce to 4 max
skipe t2 ;don't use null
movei t2,1 ;use one if was null
setzm gen ;clear gen again
setzm gen+1 ;and next word too
movx t3,no%lfl!no%zro!4b17!^d8 ;octal too
hrroi t1,gen ;reset pointer
NOUT% ;write string
ERJMP .+1
dmove t1,[-4,,filgen ;aobjn for generation
point 7,gen] ;source for loop
ildb t3,t2 ;get byte
movem t3,(t1) ;save it
aobjn t1,.-2 ;loop for all
RET ;done
subttl Subroutines -- Pfile process file data
pfile:
txz f,f.eof ;[3] force eof off
;open the device, and set correct mode
txnn f,f.nul ;null device ?
jrst pfilot ;no, continue on
pfilok:
tmsg < - OK]
[Blocks written: >
movei t1,.priou ;out to tty
move t2,blkcnt ;get blocks
movei t3,^d10 ;base 10
NOUT% ;write number
ERJMP .+1
tmsg <. Records written: >
movei t1,.priou ;to tty
skipe t2,reccnt ;get record count
sos t2 ;decr for EOF record
movei t3,^d10 ;base 10
NOUT%
ERJMP .+1
tmsg <.]
>
RET
pfilot:
;open file
hrrz t1,filjfn ;get jfn
movx t2,of%rd!7b5 ;and identify mode
txne f,f.bin ;binary mode ?
txc t2,17b5 ;change to 8 bit if so
OPENF% ;open file for read
ERJMP pfilff ;failed.. find why
move b,pblk ;get next phys block size
call opnmta ;open mag tape drive
;check for nul files
hrrz t1,filjfn ;[3] get jfn of new file
dmove t2,[1,,.fbsiz ;[3] get file size in bytes
t4] ;[3] and put it into t4
setz t4, ;[3] clear size
GTFDB% ;[3] get file size
ETYPE <File size is unknown assumed as zero length>
jumple t4,flrclz ;[3] stop if null file
;dispatch on format for writing
move t1,rfmt ;get format
cain t1,"F" ;fixed length records ?
jrst pfflr ;yes, go there
cain t1,"U" ;unformatted (image) ?
jrst pfuft ;yes, go there
cain t1,"D" ;variable length (packed) ?
jrst pfvlr ;yes, go there
;error, format is unknown
JHALT <Format never setup in PFILE>
;here on open failure
pfilff:
tmsg <? OPENF failed for named file
>
jrst lsterr ;return after call
subttl Subroutines -- PFILE - pfflr fixed len records
;here for fixed length records... pack output buffer with
;the records until full then add padding chars
;fill each record with padchar if not correct... eat CRLF
pfflr:
;compute records per block
move t1,pblk ;get phys len
idiv t1,recl ;divide by size of record
movei a,(t1) ;get recs/blk
setzm reccnt ;clear record count
setzm blkcnt ;clear block count
flr000:
move t1,padwrd ;get padding word
move t2,[outrec,,outrec+1] ;set up blt
movem t1,outrec ;clear first word
blt t2,outrec+MAXWRD-1 ;and then all the rest
move t1,[point 8,outrec] ;set up output counter
movem t1,outptr ;and save for data
movei b,(a) ;copy count
;enter read loop
flr001:
setzb c,inrec ;have nulls put to buffer
move t2,[inrec,,inrec+1] ;in case of short records
blt t2,inrec+MAXWRD-1 ;and clear the rest
hrrz t1,filjfn ;get input jfn
hrroi t2,inrec ;point to buffer
move t3,recl ;get bytes to read
addi t3,2 ;for stop bytes
movei t4,12 ;stop on <LF>
SIN% ;read string
ERCAL flreof ;check eof
;copy to output buffer
move t1,[point 7,inrec] ;get input pointer
move t2,outptr ;get output pointer
movn t3,recl ;get count expected
flr002:
aosle t3 ;test count left
jrst flr003 ;done
ildb t4,t1 ;read byte from input
caie t4,0 ;null ?
cain t4,15 ;<CR> ?
jrst flr002 ;ignore it
cain t4,12 ;lf ?
jrst flr003 ;yes, end of record
idpb t4,t2 ;save byte
aos c ;keep count
jrst flr002 ;do next
;here if input is complete
flr003:
caml c,recl ;full count ?
jrst flr005 ;yes, stop
ibp t2 ;no, boost counter
aos c ;keep track
jrst flr003 ;loop
flr005:
;full record... read next
movem t2,outptr ;save pointer again
aos t1,reccnt ;incr record count
txne f,f.eof ;eof ?
jrst flr006 ;yes, stop
sosle b ;count records/blk
jrst flr001 ;no, continue
;write record
flr006:
hrrz t1,mtajfn ;get jfn for drive
move t2,[point 8,outrec] ;get source addr
movn t3,pblk ;get exact record size
setz t4, ;no stop byte
txne f,f.ebc ;convert to ebcdic ?
call cvtebc ;yes, do conversion
SOUTR% ;write record
ERCAL mtaerr ;error, retry
aos blkcnt ;add one for each block
txzn f,f.eof ;done ?
jrst flr000 ;continue with next record
flrcz0: ;[3] here on null or done
;done with file, closef and close mta
movx t1,co%nrj ;never kill jfn
hrr t1,filjfn ;get file jfn
CLOSF% ;close file
ETYPE <Failed to close file after reading>
movx t1,co%nrj ;never kill this one either
hrr t1,mtajfn ;write tape marks
CLOSF% ;close tape drive
ETYPE <Failed to close tape drive after data write>
jrst pfilok ;done. say so
;here on error reading file
flreof:
push p,t1
push p,t2
movx t1,.fhslf ;this process
GETER% ;get my error
ERJMP .+1 ;ignore error return
hrrzs t2 ;clear lh
cain t2,IOX4 ;eof ?
jrst flr004 ;yes, continue
tmsg <% Error reading data file
>
call lsterr ;describe error
;assume eof
flr004:
txo f,f.eof ;set eof bit
pop p,t2
pop p,t1
RET ;and continue
flrclz: ;[3] here on nul file
hrrz t1,mtajfn ;[3] get device
movx t2,.moeof ;[3] write tape mark
setz t3, ;[3] no extra data
MTOPR% ;[3] force eof mark
ETYPE <MTOPR% failed to write a tape mark>
jrst flrcz0 ;[3] continue
subttl Subroutines -- PFILE - pfuft image mode (N bit)
pfuft:
;this routine writes PBLK length records in image
; reading RECL bytes and padding
setzm reccnt ;clear record counter
setzm blkcnt ;clear block counter
uft000:
setzm inrec ;clear input buffer
move t1,padwrd ;get padding
movem t1,outrec ;force buffer clean
dmove t1,[inrec,,inrec+1 ;get blt words
outrec,,outrec+1] ;for buffer clear
blt t1,inrec+MAXWRD-1 ;clear input
blt t2,outrec+MAXWRD-1 ;clear output
;read a record
hrrz t1,filjfn ;get jfn of file for input
move t2,[point 7,inrec] ;point to input area
txne f,f.bin ;unless 8 bit set
hrli t2,(point 8,) ;then use 8 bit bytes
movn t3,recl ;read exactly recl worth
setz t4, ;no stop byte
SIN% ;read it
ERCAL ufteof ;check eof
aos blkcnt ;incr counter
aos reccnt ;incr counter
;convert string to 8 bit and write to tape
move t1,recl ;get string length
move t4,t1 ;copy
setzb t3,t6 ;no two word ptrs
move t2,[point 7,inrec] ;source
txne f,f.bin ;using 8 bits already ?
hrli t2,(point 8,) ;yes, don't stop now
move t5,[point 8,outrec] ;destination
extend t1,[movslj ;move string
z] ;no fill
trn ;nop in case of skip
;write string
hrrz t1,mtajfn ;point to tape drive
move t2,[point 8,outrec] ;and to the source
movn t3,pblk ;write exact count
setz t4, ;clear stop byte
txne f,f.bin ;don't convert binary data
jrst .+3 ;avoid trashing 8 bit data
txne f,f.ebc ;ebcdic ?
call cvtebc ;convert to IBM format
SOUTR% ;write to tape
ERCAL mtaerr ;try recovery
;do next record if any
txzn f,f.eof ;eof ?
jrst uft000 ;no, continue
;close devices
movx t1,co%nrj ;never kill jfn
hrr t1,filjfn ;let go of file
CLOSF% ;but keep jfn
ETYPE <Failed to close file in image write>
movx t1,co%nrj ;keep jfn
hrr t1,mtajfn ;on tape drive
CLOSF% ;too
ETYPE <Failed to close tape drive in image write>
jrst pfilok ;done... say so
;here on possible eof
ufteof:
call flreof ;re-use eof routine
RET ;try again
subttl Subroutines -- PFILE - pfvlr variable length records
;this routine writes compressed pdp-11 style records
;in the format of
;NNNN( NNNN bytes of text)NNNN( NNNN bytes of text) Padding....
;0014this is xx0024This is abcdefghijkl00040011no crlf
;translates to
;this is xx
;this is abcdefghijkl
; <null line>
;no crlf
pfvlr:
move t1,padwrd ;clear write buffer
movem t1,outrec ;to padd chars
move t1,[outrec,,outrec+1] ;get blt word
blt t1,outrec+MAXWRD-1 ;clear buffer
move a,[point 8,outrec] ;master pointer
move b,pblk ;master count of space left
setzm reccnt ;clear counts
setzm blkcnt ;for later
;here for next line
vlr000:
txne f,f.eof ;eof ?
jrst vlr006 ;yes, check more
setzm inrec ;clear buffer to null
move t1,[inrec,,inrec+1] ;get blt word
blt t1,inrec+MAXWRD-1 ;clear buffer
hrrz t1,filjfn ;source
hrroi t2,inrec ;destination
move t3,recl ;get max bytes to read
movei t4,12 ;stop on lf
SIN% ;read the string
ERCAL flreof ;handle data error
aos reccnt ;count records read
;count bytes really in string
movei t1,1(t2) ;clear lh, get stop addr
setz t2, ;clear count to zero
move t3,[point 7,inrec] ;ptr to data
vlr001:
caige t1,(t3) ;out of data ?
jrst vlr002 ;yes, end of counting
ildb t4,t3 ;get the byte
cain t4,0 ;null ?
jrst vlr001 ;ignore it
cain t4,15 ;<CR> ?
jrst vlr001 ;ignore it
cain t4,12 ;lf ? (not in buffer)
jrst vlr002 ;yes, stop there
aos t2 ;incr counter
jrst vlr001 ;continue
;here after count done
vlr002:
cail b,4(t2) ;enough room ?
jrst vlr004 ;yes, plenty
;must write record to tape
vlr003:
push p,t2 ;save count
hrrz t1,mtajfn ;output device
move t2,[point 8,outrec] ;string ptr to data
movn t3,pblk ;exact len record
setz t4, ;no stop byte
txne f,f.ebc ;convert to ebc ?
call cvtebc ;yes, do it
SOUTR% ;write it
ERCAL mtaerr ;try to recover on error
;clean up
aos blkcnt ;keep track of blocks written
move t1,padwrd ;get padding
movem t1,outrec ;save in buffer
move t1,[outrec,,outrec+1] ;get blt word
blt t1,outrec+MAXWRD-1 ;clear buffer
move a,[point 8,outrec] ;restore pointer
move b,pblk ;restore count
pop p,t2 ;restore t2
txze f,f.eof ;done ?
jrst vlr007 ;yes
;here to add record to block
vlr004:
txnn f,f.eof ;eof ?
jrst .+3 ;no, skip ahead
skipn t2 ;eof and zero count ?
jrst vlr000 ;yes, quit
subi b,4(t2) ;decr count left
move t1,a ;get byte pointer
push p,t2 ;save count again
addi t2,4 ;count counter too
movx t3,no%lfl!no%zro!4b17!^d10 ;write 4 chars with zeros
NOUT% ;write it
ETYPE <Illegal byte count internal to record>
move t2,t1 ;[2] KLUDGE!
move t3,pad ;[2] KLUDGE
idpb t3,t2 ;[2] KLUDGE
pop p,t2 ;restore count
move a,t1 ;recover pointer
;copy data bytes in
move t1,[point 7,inrec] ;source
skipn t2 ;null record ?
jrst vlr000 ;read next line
vlr005:
ildb t3,t1 ;get a byte
caie t3,0 ;null ?
cain t3,15 ;or cr ?
jrst vlr005 ;either, ignore it
cain t3,12 ;lf ?
jrst vlr005 ;never should happen
idpb t3,a ;save byte
sosle t2 ;decr count
jrst vlr005 ;and continue if more
jrst vlr000 ;read next line
;here on eof
vlr006:
came b,pblk ;empty buffer ?
jrst vlr003 ;no, empty it
vlr007:
movx t1,co%nrj ;keep jfn
hrr t1,filjfn ;for file
CLOSF% ;close file
ETYPE <Failed to close file in var len record>
movx t1,co%nrj ;keep jfn
hrr t1,mtajfn ;for tape drive too
CLOSF% ;close tape
ETYPE <Failed to close tape in var len record>
jrst pfilok ;give ok
subttl Subroutines -- mtaerr recover from tape errors
;this routine tries to recover from a tape error
;it assumes monitor retry has failed, so it clears the error bits
;and writes a long tape mark
;then retrys the write
;if it still fails, yell and scream, then clear error and continue
;if error was write passed phys EOT, scream
mtaerr:
dmovem t1,acs ;save acs
dmovem t3,acs+2 ;for later
dmovem t5,acs+4 ;restoring
;get type of error
movei t1,.fhslf ;get self
GETER% ;get error
ERJMP .+1 ;ignore this erro
movei t2,(t2) ;clear lh
caie t2,IOX5 ;data error ?
cain t2,IOX6 ;write too far ?
jrst mtaerd ;device (recoverable)
;I dont recognize the error
tmsg <?Strange error while writing tape
>
call lsterr ;type error
;here to return
mtaedn:
dmove t1,acs
dmove t3,acs+2
dmove t5,acs+4
RET
;here for a bonifide error
mtaerd:
tmsg <%Error writing tape
>
push p,t2 ;save error
call lsterr ;explain it
tmsg <% Error at record: >
movei t1,.priou ;out to tty
move t2,reccnt ;this number
movei t3,^d10 ;base ten
NOUT% ;type number
ERJMP .+1
tmsg <. block: >
movei t1,.priou ;out to tty
move t2,blkcnt ;get block id
movei t3,^d10 ;in base 10
NOUT%
ERJMP .+1 ;ignore error
tmsg <.
>
pop p,t2 ;restore error
caie t2,IOX5 ;was it data error ?
jrst mtaere ;no, eot mark
;get device status bits
hrrz t1,mtajfn ;get device
GDSTS% ;read status bits
ERJMP .+1
txne t2,mt%eot ;eot ?
jrst mtaere ;handle it
txne t2,mt%ilw ;write locked ?
jrst mtawlk ;handle it
txne t2,mt%dae!mt%dve ;data error ?
jrst mtadat ;data error
;who knows... tape offline ?
mtaask:
tmsg <% Type a return to retry >
movei t1,comand ;use comnd%
movei t2,confrm ;to confirm
COMND% ;ask user
txne t1,cm%nop ;error ?
jrst mtaedn ;yes, give up though
;here to retry
mtatry:
hrrz t1,mtajfn ;get tape id
move t2,[point 8,outrec] ;and ptr to data
movn t3,pblk ;len to write
setz t4, ;clear stop byte
SOUTR% ;write it
ERJMP mtaafu ;you lose
jrst mtaedn ;return, successful
;here if AFU
mtaafu:
tmsg <%Error on retry - I give up
>
call lsterr
jrst mtaedn ;quit
;here for data error
mtadat:
;backspace, write blank tape, retry
hrrz t1,mtajfn ;jfn of tape
movx t2,.mobkr ;back up record
setz t3, ;no funny stuff
MTOPR% ;back up ?
ETYPE <Failed to back up a record>
;write blank tape
hrrz t1,mtajfn ;restore jfn
movx t2,.moers ;erase 3 inches
setz t3,
MTOPR% ;do it
ETYPE <Failed to erase tape>
jrst mtatry ;retry operation
;here for eof reached
mtaere:
tmsg <?Write past end of tape not supported
>
HALTF%
jrst mtaask
;here for write locked
mtawlk:
tmsg <%Tape is write locked
>
jrst mtaask
subttl Subroutines -- wrteof/wrtbot
wrtbot:
;no special processing, just set flag to force vol1 to be written
txo f,f.wvl ;write volume flag on
RET ;thats it
wrteof:
RET ;nothing to do yet
subttl Subroutines -- filbot/fileot
filbot:
;called to write a hdr1/hdr2 label (and a vol1 label if needed)
txne f,f.nul!f.nlb ;nul device or no labels?
RET ;yes, ignore all
movei b,^d80 ;80. char records
call opnmta ;open mta
;check for vol1 request
txzn f,f.wvl ;need to write vol1 ?
jrst filnvl ;no volume 1 needed
;compress vol1 into a string format and then write it
dmove t1,[-^d80,,vol1 ;aobjn ptr
point 8,outlbl] ;string area
move t3,(t1) ;get a byte
idpb t3,t2 ;save byte
aobjn t1,.-2 ;loop for all
move t1,mtajfn ;get jfn again
move t2,[point 8,outlbl] ;set up string ptr
movni t3,^d80 ;exactly 80. bytes
setz t4, ;no stop byte
txne f,f.ebc ;ebcdic ?
call cvtebc ;yes, convert it first
SOUTR% ;write the record
ETYPE <Failed to write VOL1 label>
;here for hdr1
filnvl:
;compress hdr1,hdr2 (all fields set up)
dmove t1,[-^d80,,hdr1 ;aobjn ptr
point 8,outlbl] ;string area
move t3,(t1) ;get a byte
idpb t3,t2 ;save byte
aobjn t1,.-2 ;loop for all
move t1,mtajfn ;get jfn again
move t2,[point 8,outlbl] ;set up string ptr
movni t3,^d80 ;exactly 80. bytes
setz t4, ;no stop byte
txne f,f.ebc ;ebcdic ?
call cvtebc ;yes, convert it first
SOUTR% ;write the record
ETYPE <Failed to write HDR1 label>
dmove t1,[-^d80,,hdr2 ;aobjn ptr
point 8,outlbl] ;string area
move t3,(t1) ;get a byte
idpb t3,t2 ;save byte
aobjn t1,.-2 ;loop for all
move t1,mtajfn ;get jfn again
move t2,[point 8,outlbl] ;set up string ptr
movni t3,^d80 ;exactly 80. bytes
setz t4, ;no stop byte
txne f,f.ebc ;ebcdic ?
call cvtebc ;yes, convert it first
SOUTR% ;write the record
ETYPE <Failed to write HDR2 label>
;[2] more HDR records ?
move t4,numhdr ;[2] get count needed
caile t4,minhdr ;[2] min done ?
call filxhd ;[2] yes, add extra headers
;close device to get eof tape mark
movx t1,co%nrj ;don't kill jfn
hrr t1,mtajfn ;add jfn to arg
CLOSF% ;close device
ETYPE <Failed to close device after headers>
txo f,f.vol ;volume labels written
RET ;done
;here for eof labels (re-use hdr1,hdr2)
fileot:
movei t1,"E" ;EOF
movei t2,"O" ;EOF
dmovem t1,hdr1 ;reset data
dmovem t1,hdr2 ;reset data
movei t1,"F"
movem t1,hdr1+2 ;set up
movem t1,hdr2+2 ;for eof write
;fill in the block count
hrroi t1,numstr ;convert numbers
setzm (t1) ;clear scratch
setzm 1(t1) ;area
hrrz t2,blkcnt ;get number to write
movx t3,no%lfl!no%zro!6b17!^d10 ;leading 0, base 10
NOUT% ;write into scratch area
ERJMP .+1 ;no need for message
dmove t1,[-6,,filblk ;aobjn ptr
point 7,numstr] ;and get byte ptr
ildb t3,t2 ;get a byte
movem t3,(t1) ;save byte
aobjn t1,.-2 ;loop for more
setzm blkcnt ;clean up for later
setzm reccnt ;and for nul files
jrst filbot ;re-use write stuff
subttl Subroutines -- filxhd write extra HDR labels
filxhd: ;[2] all below under this edit
subi t4,minhdr ;compute use count
push p,t4 ;and save it
move t1,hdr1 ;EOF or HDR ?
move t2,[hdr3c,,hdrn] ;init header rec
blt t2,hdrn+^d79 ;80. char rec
cain t2,"H" ;"HDR1" ?
jrst filxh1 ;yes, skip
movem t1,hdrn ;make it EOF
dmove t2,hdr1+1 ;get the rest
dmovem t2,hdrn+1 ;save them
filxh1:
dmove t1,[-^d80,,hdrn ;aobjn ptr
point 8,outlbl] ;string area
move t3,(t1) ;get a byte
idpb t3,t2 ;save byte
aobjn t1,.-2 ;loop for all
filxh2:
move t1,mtajfn ;get jfn again
move t2,[point 8,outlbl] ;set up string ptr
movni t3,^d80 ;exactly 80. bytes
setz t4, ;no stop byte
txne f,f.ebc ;ebcdic ?
call cvtebc ;yes, convert it first
SOUTR% ;write the record
ETYPE <Failed to write HDRN label>
sosg (p) ;more to do ?
jrst filxh3 ;no done
ldb t1,[point 8,outlbl,31] ;get char
aos t1 ;make it larger
dpb t1,[point 8,outlbl,31] ;set for next hdr
jrst filxh2 ;loop for more
filxh3:
pop p,(p) ;clear stack
RET ;done
subttl Subroutines -- opnmta open magtape device
;b contains record size
opnmta:
move t1,mtajfn ;get jfn on tape
movx t2,10b5!of%wr ;and set up i/o mode
OPENF% ;open device
ETYPE <Failed to open tape for writing HDR1>
move t1,mtajfn ;restore jfn
movx t2,.mosdm ;set data mode function
movx t3,.sjdm8 ;industry mode
MTOPR% ;set mode
ETYPE <Couldn't set industry mode for tape drive>
move t1,mtajfn ;restore jfn
movx t2,.mosdn ;set density
move t3,dens ;get density
MTOPR% ;set density
ETYPE <Couldn't set density in tape command>
;set xxx char records
move t1,mtajfn ;restore jfn
movx t2,.mosrs ;set record size ftn
movei t3,(b) ;ansi label size
MTOPR% ;set size
ETYPE <Failed to set record size in OPNMTA>
;set parity
move t1,mtajfn ;get jfn for tape
movx t2,.mospr ;set parity
move t3,parity ;get parity flag
MTOPR% ;set parity please
ETYPE <Failed to set required parity>
RET ;done
subttl Subroutines -- cvtebc convert string to EBCDIC
cvtebc:
;save 6 acs
dmovem a,acs ;save them
dmovem c,acs+2
dmovem e,acs+4 ;for later
;get count of bytes to move
movn a,t3 ;get count from soutr
move d,a ;copy length
tlo a,400000 ;set S bit
movei c,(t2) ;get source address
tlo c,(1b0) ;set local flag
; movsi b,(<point 8,0>!1b12) ;make glbl ptr
; move e,b ;identical pointer
; movx e+1,1b0!xlbuf ;make destination ptr
movsi b,(point 8,) ;use local pointer
hrri b,(t2) ;real pointer
move e,[point 8,xlbuf] ;no 2 word in tops20
EXTEND a,[movst xltbl ;do move string translated
z] ;no fill chars
jfcl ;ignore skip ?
;copy string back to source
movn a,t3 ;get count back
lsh a,-2 ;divide by 4
movsi b,xlbuf ;source for blt
hrri b,(t2) ;get destination
addi a,-1(t2) ;and compute length
blt b,(a) ;copy back
dmove a,acs ;restore acs
dmove c,acs+2
dmove e,acs+4 ;to starting point
RET ;and return
subttl Subroutines -- Ascii to Ebcdic translation table
xltbl:
;format is even,,odd
000,,001 ;null to null, etc
002,,003
067,,055
056,,057 ;bell to ?
026,,005
045,,013
014,,025
006,,066
044,,024
064,,065
004,,075
027,,046
052,,031
032,,047
023,,041
040,,042
100,,132 ;space to space
177,,173
133,,154
120,,175
115,,135
134,,116
153,,140
113,,141
360,,361 ;digits to digits
362,,363
364,,365
366,,367
370,,371
172,,136
114,,176
156,,157
174,,301 ;@a
302,,303
304,,305
306,,307
310,,311
321,,322
323,,324
325,,326
327,,330
331,,342 ;rs
343,,344
345,,346
347,,350
351,,255 ;[
340,,275
137,,155
171,,201
202,,203
204,,205
206,,207
210,,211
221,,222
223,,224
225,,226
227,,230
231,,242
243,,244
245,,246
247,,250
251,,300
117,,320
241,,007 ;note that this table
;is ^d64 words long
;parity will give bizare
;results
subttl Fatal errors here
fatal::
call lsterr ;type an error
RESET% ;clear everything
HALTF% ;die
jrst .-1 ;never recover
subttl literals
xlist
lit
list
subttl impure storage
reloc 0 ;low segment
.lowa: block 1 ;start of cleared area
vol1:
block 4 ;"VOL1"
volid: block 6 ;volume label
block 1 ;accessibility
block ^d26 ;reserved
ownid: block ^d14 ;owner info [uic]
block ^d28 ;reserved
block 1 ;label version
hdr1:
block 4 ;"HDR1"
filnam: block ^d17 ;file name
filset: block 6 ;copy of volume id
block ^d4 ;unused file section
filseq: block 4 ;number of file on tape
filgen: block 4 ;file generation #
block 2 ;generation type
filcdt: block 6 ;creation date
block 6 ;expires (never)
block 1
filblk: block 6 ;block count
block ^d13 ;system code (dec20)
block 7 ;reserved
hdr2:
block 4 ;"HDR2"
rfmt: block 1 ;format F,D,S,U
pblkx: block 5 ;block length physical
lblk: block 5 ;record length (logical)
block ^d21 ;system dependent info
cctl: block 1 ;" " or "M"
block ^d13 ;blank
block 2
block ^d28 ;reserved
hdrn: block 3 ;[2] multi record HDR label
hdrnct: block 1 ;[2] lab #
block ^d76 ;[2] filler
outlbl: block <^d80/^d4> ;80. bytes at 4 bytes per word
outrec: block MAXWRD ;max size of data record
block 10
comand: block .cmgjb+1 ;comand state block
bigbuf: block 200 ;text buffer
atom: block 30 ;atom buffer
jfnblk: block .gjatr+1 ;jfn long form block
;more
pblk: block 1 ;physical blocksize
pblkt: block 1 ;parse temp
dens: block 1 ;density value
denst: block 1 ;temp parse
devd: block 1 ;device designator
devdt: block 1 ;parse temp
filjfn: block 1 ;wildcard jfn from file command
pad: block 1 ;padding character
padt: block 1 ;temp for parse
padwrd: block 1 ;4 bytes of pad char
recl: block 1 ;record length (logical)
reclt: block 1 ;parse temp
reccnt: block 1 ;counter of records
blkcnt: block 1 ;counter of blocks
volx: block 3 ;buffer for volume string
numhdr: block 1 ;[2] number of headers
hdrnmt: block 1 ;[2] temp headers
fmt: block 1 ;format to write tape with
fmtt: block 1 ;parse temp
bit8: block 1 ;set if binary mode
party: block 1 ;parityltempifor parse
dxdev: block 3 ;temp string area
mtajfn: block 1 ;jfn of magtape unit
seqnum: block 1 ;sequence # of file on tape
labtmp: block 1 ;label writting temp for parse
execfh: block 1 ;exec fork handle
execjf: block 1 ;jfn of exec
numstr: block 3 ;string number work area
;more
outptr: block 1 ;pointer to outrec
inrec: block MAXWRD ;buffer for reading raw data (7bit)
;*** do not change order
name: block 10 ;string file name
ext: block 10 ;string file type
gen: block 10 ;string file generation
cdate: block 1 ;file creation time
years: block 3 ;string area for date
;*** do not change order
xlbuf: block MAXWRD ;string translation area
acs: block 6 ;ac save area for translation
pdlst: block pdlen ;the stack area
.higha::
block 1 ;end of cleared area
end <3,,entvec> ;start address