Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/tapelook.fai
There are no other files named tapelook.fai in the archive.
;<ADMIN.JQJ>TAPLK.FAI.6, 5-Mar-81 10:58:41, Edit by ADMIN.JQJ
; -make error handling reasonable even if don't have CM%FIX
; -bump version to 1.23
;<ADMIN.JQJ>TAPLK.FAI.5, 2-Mar-81 18:57:33, Edit by ADMIN.JQJ
; -for AL tapes, owner starts in a different place
; -print creation and expiration dates from label
;<ADMIN.JQJ>TAPLK.FAI.3, 16-Feb-81 13:58:05, Edit by ADMIN.JQJ
; -rework handling of DUMPER and SAVE tapes -- now very accurate
; -recognize CORE-DUMP text files
; -ask for device-name rather than unit (for labelled tape support)
; -modify EOT recognition for VAXTAP tapes.
; -restore order of density checking. Neither way works for now!
;<J.JQJOHNSON>TAPELO.FAI.16, 11-Sep-80 19:04:09, Edit by J.JQJOHNSON
; -reverse order of testing density, since trying 1600 on 800 bpi
; tapes likely gives EOT instead of error.
; -recognize 2 leading tape marks. Is this right for empty tapes???
;<J.JQJOHNSON>TAPELO.FAI.9, 11-Sep-80 18:02:20, Edit by J.JQJOHNSON
; -more cleanup, and fix bug in HDR reporting on unlabelled tapes
;<J.JQJOHNSON>TAPELO.FAI.4, 9-Aug-80 02:31:28, Edit by J.JQJOHNSON
; -fix parsing of TAPE command
;<J.JQJOHNSON>TAPELO.FAI.3, 9-Aug-80 01:47:31, Edit by J.JQJOHNSON
; -more cleanup
; -move ASND to after command parsing
; -paramaterize tape drive number
;<J.JQJOHNSON>TAPELO.FAI.2, 9-Aug-80 01:02:04, Edit by J.JQJOHNSON
; -Improve error handling if labelled tape has files with invalid HDRs.
; -Try to recognize DUMPER and SAVE files (not too smart yet).
; -Improve printing of VOL information if any.
; -Miscellaneous source cleanup.
; -Bumped version to 1.22
TITLE TAPELOOK -- PRINT INFO ABOUT A TAPE
SUBTTL PARAMETERS, VARIABLES & CONSTANTS
SEARCH MONSYM
ASUPPRESS ;don't output unused symbols
XALL ;no macro bodies in listing
NOLIT ;no literals in listing
IFNDEF CM%FIX,<CM%FIX==1B10> ;local Stanford COMND extension
; REGISTER USAGE
;
FLAGS= 0 ;FLAG BITS (SEE BELOW)
T1= 1 ;JSYS AC'S
T2= 2
T3= 3
T4= 4
Q1= 5
Q2= 6
Q3= 7
Q4= 10
TFN= 11 ;TAPE FILE COUNT
OJFN= 12 ;OUTPUT JFN
SKHDL= 13 ;SKIP FORK HANDLE
P= 17 ;STACK PTR
OPDEF CALL [PUSHJ P,]
OPDEF RET [POPJ P,]
;
; FLAGS (RH of word FLAGS) OPTIONS and TAPE CHARACTERISTICS
;
;OPTIONS SPECIFIED
%START== 1 ;START OPTION SPECIFIED
%END== 2 ;END " "
%PRINT== 4 ;PRINT " "
%OUT== 10 ;OUTPUT " "
%LEN== 20 ;LEN " "
%TAPE== 40 ;TAPE " "
;TAPE CHARACTERISTICS
%LABEL== 4000 ;LABELED TAPE
%EMAX== 10000 ;BLKSIZE EXCEEDS MAX
%SKIP== 20000 ;SKIP FORK RUNNING
%EBC== 40000 ;TAPE IS EBCDIC
%ASC== 100000 ;TAPE IS ASCII
%LTM== 200000 ;TAPE HAS LEADING TAPE MARK
%LTM1== 400000 ;TWO LEADING TAPE MARKS?
;
; FLAGS (LH of word FLAGS) FILE characteristics
;FILE CHARACTERISTICS
%LINNO== 400 ;FILE HAS EDIT LINE NUMBERS (IF CORDUMP TEXT)
%CORDM== 1000 ;FILE IS PROBABLY CORE-DUMP FORMAT
%OKLBL== 2000 ;FILE HAS A VALID LABEL
; PARAMETERS
;
MAXBLK==17000*4 ;MAXIMUM BLKSIZE (==30720)
INBUF= 10000 ;INPUT BUFFER ADDRESS
MAXCDM==17000
CDMBUF= 30000 ;BUFFER FOR DUMP-MODE CONVERSION
SKSPD== 7 ;SKIP SPEED (FT/SEC)
SUBTTL IMPURE
;
; CONSTANTS & VARIABLES
;
IOLST: IOWD MAXBLK/4,INBUF
0
CMIBUF: BLOCK =40
CMABUF: BLOCK =40
JFNBLK: BLOCK 16
CSB: 0,,REPARS ;COMND JSYS STATE BLOCK
.PRIIN,,.PRIOU
POINT 7,[ASCIZ/OPTIONS? /]
POINT 7,CMIBUF
POINT 7,CMIBUF
=200
0
POINT 7,CMABUF
=200
JFNBLK
STKL= 20
STACK: BLOCK STKL
TJFN: 0 ;TAPE JFN
DEN: 0 ;DENSITY
OWNER: ASCIZ/?????/ ;OWNER NAME IN VOL1
BLOCK 3 ;10. CHAR FIELD
VOLID: ASCIZ/?????/
BLOCK 1 ;6 CHAR FIELD
PBLKSZ: 0 ;SIZE OF PHYSICAL TAPE BLOCK
LRECL: ASCIZ/?????/ ;LRECL OF FILE
0
BLKSZ: ASCIZ/?????/ ;BLKSIZE OF FILE
0
RECFM: ASCIZ/???/ ;RECFM OF FILE
DSN: BLOCK 4 ;DSN OF FILE
CREDAT: 0 ;CREATION DATE OF FILE
EXPDAT: 0 ;EXPIRATION DATE
START: 0 ;STARTING FILE #
END: 0 ;ENDING FILE #
PRTCNT: 0 ;# OF BYTES TO PRINT
LEN: 0 ;TAPE LENGTH IN FEET
SKTIMR: 0 ;SECS LEFT TILL EOT
DEVDES: <.DVDES+.DVMTA,,0> ;TAPE DEVICE DESIGNATOR
MTANAM: ASCIZ/MTA0:/
OUTBUF: BLOCK =17 ;OUTPUT BUFFER
;POINTERS FOR LISTING DUMPS
HOUT: 0 ;HEX DUMP OUTPUT PTR
AOUT: 0 ;ASCII DUMP OUTPUT PTR
EOUT: 0 ;EBCDIC DUMP OUTPUT PTR
HIN: 0 ;HEX DUMP INPUT PTR
CIN: 0 ;CHAR DUMP INPUT PTR
PCSV1: 0 ;PC SAVE
PCSV2: 0 ;PC SAVE
LEVTAB: PCSV1 ;TASKING TABLES
PCSV2
0
CHNTAB: 1,,CTRLC ;^C TRAP
BLOCK =18
2,,TSKRET ;SKIP FORK TERMINATION
BLOCK =15
OPTTAB: OPTLEN,,OPTLEN
[ASCIZ/ENDING/],,$END
[ASCIZ/LENGTH/],,$LEN
[ASCIZ/OUTPUT/],,$OUT
[ASCIZ/PRINT/],,$PRINT
[ASCIZ/STARTING/],,$START
[ASCIZ/TAPE/],,$TAPE
OPTLEN==.-OPTTAB
SUBTTL HELP MESSAGE
; #########################################################
; ### Warning: Do not include unmatched "<" or ">" in ###
; ### any help msgs on this page! ###
; #########################################################
;The HELP text is a giant macro so we can turn off code listing.
DEFINE %HELP% ' (LABEL,TEXT) <
LABEL: XLIST
ASCIZ\TEXT\
LIST
>;%HELP%
%HELP% (HELP,<
This program allows you to look at a tape and determine, unless it is a 7
track tape or written at a density other than 800 or 1600 bpi, whether it is
labelled or not, what it's density is, how many files are on it, and the size
of the first tape block and contents of each file. In addition, for labelled
tapes, the RECFM, LRECL, BLKSIZE and data set name (DSN) is printed for each
file. N.B.: the program does not handle multi-volume tapes or user labels.
To the prompt ("OPTIONS?"), you can respond with the following:
STARTING (FILE) n (n = decimal starting file #)
ENDING (FILE) n (n = decimal ending file #)
OUTPUT (FILE) file-name (file-name = file name for output)
PRINT (# OF BYTES) n (n = # of bytes of each file to print)
LENGTH (OF TAPE) n (n = tape length in feet)
TAPE (UNIT ID) device (device = which tape drive (e.g. MTA0:)
For example:
@TAPELOOK
OPTIONS? output lpt: print 100
sends output to the line printer and prints the first 100 bytes of each file.
Defaults are START 1, END 9999, OUTPUT TTY:, PRINT 80, LENGTH 2400, & TAPE 1;
type only a RETURN if these are acceptable.
>)
SUBTTL FUNCTION DESCRIPTOR BLOCKS
FDB0: <.CMINI>*1B8
FDB1: <.CMCFM>*1B8+CM%SDH+FDB2
FDB2: <.CMKEY>*1B8+CM%FIX+CM%SDH+CM%HPP+CM%DPP
OPTTAB
POINT 7,HELP
POINT 7,[ASCIZ/START 1 END 99999 OUTPUT TTY: PRINT 80 LENGTH 2400/]
FDB3: <.CMNOI>*1B8
POINT 7,[ASCIZ/FILE/]
FDB4: <.CMNUM>*1B8+CM%FIX+CM%SDH+CM%HPP+CM%DPP
=10
POINT 7,[ASCIZ/DECIMAL FILE #/]
POINT 7,[ASCIZ/1/]
FDB5: <.CMOFI>*1B8+CM%FIX+CM%SDH+CM%HPP+CM%DPP
0
POINT 7,[ASCIZ/OUTPUT FILE NAME/]
POINT 7,[ASCIZ/TTY:/]
FDB6: <.CMNOI>*1B8
POINT 7,[ASCIZ/# OF BYTES/]
FDB7: <.CMNUM>*1B8+CM%FIX+CM%SDH+CM%HPP+CM%DPP
=10
POINT 7,[ASCIZ/DECIMAL FILE #/]
POINT 7,[ASCIZ/99999/]
FDB8: <.CMNUM>*1B8+CM%FIX+CM%SDH+CM%HPP+CM%DPP
=10
POINT 7,[ASCIZ/DECIMAL PRINT COUNT/]
POINT 7,[ASCIZ/80/]
FDB9: <.CMNOI>*1B8
POINT 7,[ASCIZ/OF TAPE/]
FDB10: <.CMNUM>*1B8+CM%FIX+CM%SDH+CM%HPP+CM%DPP
=10
POINT 7,[ASCIZ/TAPE LENGTH IN FEET/]
POINT 7,[ASCIZ/2400/]
OUTINT: ASCII/ | /
ASCII/ | /
ASCII/ |
/
SUBTTL TRANSLATION TABLE
;
; TRANSLATION TABLE: ASCII->EBCDIC,,EBCDIC->ASCII
; NON-TRANSLATABLES ARE TRANSLATED TO SUB'S
; BELIEVED TO BE THE SAME AS OPTCD=Q
;
TRNTAB: 0,,0 ; NULL,,NULL
1,,1 ; SOH,,SOH
2,,2 ; STX,,STX
3,,3 ; ETX,,ETX
67,,32 ; EOT,,PF
55,,11 ; ENQ,,HT
56,,32 ; ACK,,LC
57,,177 ; BEL,,DEL
26,,32 ; BS,,GE
5,,32 ; HT,,RLF
45,,32 ; LF,,SMM
13,,13 ; VT,,VT
14,,14 ; FF,,FF
15,,15 ; CR,,CR
16,,16 ; SO,,SO
17,,17 ; SI,,SI
20,,20 ; DLE,,DLE
21,,21 ; DC1,,DC1
22,,22 ; DC2,,DC2
23,,23 ; DC3,,TM
74,,32 ; DC4,,RES
75,,32 ; NAK,,NL
62,,10 ; SYN,,BS
46,,32 ; ETB,,IL
30,,30 ; CAN,,CAN
31,,31 ; EM,,EM
77,,32 ; SUB,,CC
47,,32 ; ESC,,CU1
34,,34 ; FS,,IFS
35,,35 ; GS,,IGS
36,,36 ; RS,,IRS
37,,37 ; US,,IUS
100,,32 ; BLANK,,DS
132,,32 ; !,,SOS
177,,32 ; ",,FS
173,,32 ; #,,
133,,32 ; $,,BYP
154,,12 ; %,,LF
120,,27 ; &,,ETB
175,,33 ; ',,ESC
115,,32 ; (,,
135,,32 ; ),,
134,,32 ; *,,SM
116,,32 ; +,,CU2
153,,32 ; ,,,
140,,5 ; -,,ENQ
113,,6 ; .,,ACK
141,,7 ; /,,BEL
360,,32 ; 0,,
361,,32 ; 1,,
362,,26 ; 2,,SYN
363,,32 ; 3,,
364,,32 ; 4,,PN
365,,32 ; 5,,RS
366,,32 ; 6,,UC
367,,4 ; 7,,EOT
370,,32 ; 8,,
371,,32 ; 9,,
172,,32 ; :,,
136,,32 ; ;,,CU3
114,,24 ; <,,DC4
176,,25 ; =,,NAK
156,,32 ; >,,
157,,32 ; ?,,SUB
174,,40 ; @,,BLANK
301,,32 ; A,,
302,,32 ; B,,
303,,32 ; C,,
304,,32 ; D,,
305,,32 ; E,,
306,,32 ; F,,
307,,32 ; G,,
310,,32 ; H,,
311,,32 ; I,,
321,,136 ; J,,CENT SIGN
322,,56 ; K,,.
323,,74 ; L,,<
324,,50 ; M,,(
325,,53 ; N,,+
326,,41 ; O,,VERTICAL BAR
327,,46 ; P,,&
330,,32 ; Q,,
331,,32 ; R,,
342,,32 ; S,,
343,,32 ; T,,
344,,32 ; U,,
345,,32 ; V,,
346,,32 ; W,,
347,,32 ; X,,
350,,32 ; Y,,
351,,41 ; Z,,!
255,,44 ; [,,$
340,,52 ; \,,*
275,,51 ; ],,)
112,,73 ; ^,,;
155,,136 ; _,,NOT SIGN
171,,55 ; GRAVE,,-
201,,57 ; a,,/
202,,32 ; b,,
203,,32 ; c,,
204,,32 ; d,,
205,,32 ; e,,
206,,32 ; f,,
207,,32 ; g,,
210,,32 ; h,,
211,,32 ; i,,
221,,174 ; j,,|
222,,54 ; k,,,
223,,45 ; l,,%
224,,137 ; m,,_
225,,76 ; n,,>
226,,77 ; o,,?
227,,32 ; p,,
230,,32 ; q,,
231,,32 ; r,,
242,,32 ; s,,
243,,32 ; t,,
244,,32 ; u,,
245,,32 ; v,,
246,,32 ; w,,
247,,32 ; x,,
250,,140 ; y,,GRAVE
251,,72 ; z,,:
300,,43 ; {,,#
152,,100 ; |,,@
320,,47 ; },,'
137,,75 ; TILDE,,=
7,,42 ; DEL,,"
77,,32 ;
77,,141 ; ,,a
77,,142 ; ,,b
77,,143 ; ,,c
77,,144 ; ,,d
77,,145 ; ,,e
77,,146 ; ,,f
77,,147 ; ,,g
77,,150 ; ,,h
77,,151 ; ,,i
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,152 ; ,,j
77,,153 ; ,,k
77,,154 ; ,,l
77,,155 ; ,,m
77,,156 ; ,,n
77,,157 ; ,,o
77,,160 ; ,,p
77,,161 ; ,,q
77,,162 ; ,,r
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,176 ; ,,TILDE
77,,163 ; ,,s
77,,164 ; ,,t
77,,165 ; ,,u
77,,166 ; ,,v
77,,167 ; ,,w
77,,170 ; ,,x
77,,171 ; ,,y
77,,172 ; ,,z
77,,32 ;
77,,32 ;
77,,32 ;
77,,133 ; ,,[
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,135 ; ,,]
77,,32 ;
77,,32 ;
77,,173 ; ,,{
77,,101 ; ,,A
77,,102 ; ,,B
77,,103 ; ,,C
77,,104 ; ,,D
77,,105 ; ,,E
77,,106 ; ,,F
77,,107 ; ,,G
77,,110 ; ,,H
77,,111 ; ,,I
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,175 ; ,,}
77,,112 ; ,,J
77,,113 ; ,,K
77,,114 ; ,,L
77,,115 ; ,,M
77,,116 ; ,,N
77,,117 ; ,,O
77,,120 ; ,,P
77,,121 ; ,,Q
77,,122 ; ,,R
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,134 ; ,,\
77,,32 ;
77,,123 ; ,,S
77,,124 ; ,,T
77,,125 ; ,,U
77,,126 ; ,,V
77,,127 ; ,,W
77,,130 ; ,,X
77,,131 ; ,,Y
77,,132 ; ,,Z
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,60 ; ,,0
77,,61 ; ,,1
77,,62 ; ,,2
77,,63 ; ,,3
77,,64 ; ,,4
77,,65 ; ,,5
77,,66 ; ,,6
77,,67 ; ,,7
77,,70 ; ,,8
77,,71 ; ,,9
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
77,,32 ;
SUBTTL MISCELLANOUS ROUTINES
;print most recent error
PNTERR: MOVEI T1,.PRIOU
HRLOI T2,.FHSLF
MOVEI T3,0
ERSTR
JFCL
JFCL
RET
;print an error message and stop the world
ERROR: HRROI T1,[ASCIZ/TAPELOOK: /] ;UNEXPECTED ERROR
ESOUT
CALL PNTERR
CTRLC: MOVE T1,SKHDL
TRNE FLAGS,%SKIP
HFORK ;HALT SKIP FORK
; JRST QUIT
;Stop the world -- returns to top of main loop
;###should only release our devices
QUIT: MOVE T1,TJFN ;REWIND TAPE
MOVEI T2,.MOREW
MTOPR
ERJMP .+1
MOVE T1,TJFN
CLOSF ;CLOSE TAPE IF NECESSARY
JFCL
MOVE T1,OJFN
CLOSF ;CLOSE OUTPUT FILE
JFCL
MOVE T1,DEVDES
RELD ;RELEASE THE MAG TAPE
JFCL
RESET ;CLEAR THE PROCESS
HALTF
JRST TAPELOOK+1
;ROUTINE TO ACTUALLY DO A COMND% JSYS
;CALL: T2/ SET UP FOR COMND
;RET: +1 NORMALLY
; ON ERR, RETURNS VIA NONLOCAL GOTO TO PARSE.
DOCMND: MOVEI T1,CSB
COMND ;THE ONLY COMND JSYS IN THE PROGRAM
ERJMP [SETO T2,
CALL PNTERR
JRST PARSE ] ;SERIOUS PARSING ERROR
TLNN T1,(CM%NOP)
RET ;GOOD RETURN
CALL PNTERR ;CAN'T GET TO HERE IF CM%FIX
HRROI T1,[ASCIZ/ - /]
PSOUT
MOVE T1,CSB+.CMPTR ;GET REST OF LINE
PSOUT
JRST PARSE ;NONLOCAL GOTO
;COPY FROM POINTER IN T1 TO POINTER IN T2, TERMINATING ON COUNT IN T3.
COPY: ILDB T4,T1
TRNE FLAGS,%EBC
HRRZ T4,TRNTAB(T4)
IDPB T4,T2
SOJG T3,COPY
RET
;DONIN -- READ A NUMBER FROM THE BUFFER, TERMINATING ON COUNT.
;CALL: T1/ SOURCE
; T3/ COUNT
;RET: T2/ INTEGER
DONIN: MOVEI T2,0
ILDB T4,T1 ;GET NEXT CHAR
TRNE FLAGS,%EBC
HRRZ T4,TRNTAB(T4) ;TRANSLATE TO ASCII
CAIG T4,"9" ;THROW OUT BAD CHARACTERS
CAIGE T4,"0"
JRST DONIN2
IMULI T2,=10
ADDI T2,-"0"(T4)
DONIN2: SOJG T3,DONIN+1
RET
SUBTTL PRINTING ROUTINES
;print a line on output file
;ret: +1 always
PRINT: MOVE T1,OJFN ;PRINT LINE ON OUTPUT FILE
MOVEI T3,0 ;T2= LINE POINTER
SOUT
RET
;print a decimal number, free format
;call: t2/ number
;ret: +1 always
PRTDEC: MOVE T1,OJFN
MOVEI T3,=10
NOUT
ERJMP ERROR
RET
;print density information for the tape
;ret: +1 always
PRTDEN: HRROI T2,[ASCIZ/, Density= /]
CALL PRINT
SKIPLE T3,DEN
CAILE T3,PRTDNL ;HIGHEST KNOWN DENSITY
MOVEI T3,0 ;USE DEFAULT
HRRO T2,PRTDNA(T3)
JRST PRINT
PRTDNA: [ASCIZ/UNKNOWN/]
[ASCIZ/200 BPI/]
[ASCIZ/556 BPI/]
[ASCIZ/800 BPI/] ;.SJDN8=3
[ASCIZ/1600 BPI/] ;.SJD16=4
[ASCIZ/6250 BPI/]
PRTDNL==.-PRTDNA
;Print the julian date (yyddd) in AC2, as 62-1981
PRTJUL: JUMPLE T2,PRTJUX
IDIVI T2,=1000 ;get year in t2, day in t3
PUSH P,T2
MOVE T2,T3
CALL PRTDEC
HRROI T2,[ASCIZ/-/]
CALL PRINT
POP P,T2 ;RECOVER DAY
ADDI T2,=1900
JRST PRTDEC
PRTJUX: HRROI T2,[ASCIZ/??-???/]
JRST PRINT
;print information in the tape label
;ret: +1 always
pntlbl: HRROI T2,[ASCIZ/
LABEL= /]
CALL PRINT
TRNN FLAGS,%LABEL ;IS THERE A LABEL?
JRST PNTLBX ;NO
HRROI T2,[ASCIZ/SL/]
TRNE FLAGS,%ASC
HRROI T2,[ASCIZ/AL/]
CALL PRINT
HRROI T2,[ASCIZ/ (bad format)/]
TLNN FLAGS,%OKLBL
CALL PRINT
HRROI T2,[ASCIZ/, RECFM= /]
CALL PRINT
HRROI T2,RECFM
CALL PRINT
HRROI T2,[ASCIZ/, LRECL= /]
CALL PRINT
HRROI T2,LRECL
CALL PRINT
HRROI T2,[ASCIZ/, BLKSIZE= /]
CALL PRINT
HRROI T2,BLKSZ
CALL PRINT
HRROI T2,[ASCIZ/, DSN= /]
CALL PRINT
HRROI T2,DSN
CALL PRINT ;END IT
HRROI T2,[ASCIZ/,
Creation date= /]
CALL PRINT
MOVE T2,CREDAT
CALL PRTJUL ;PRINT JULIAN DATE
HRROI T2,[ASCIZ/, Expiration date= /]
CALL PRINT
MOVE T2,EXPDAT
JRST PRINT
PNTLBX: HRROI T2,[ASCIZ/NL (Unlabelled)/]
JRST PRINT
;PRINT OUT INFORMATION IN THE VOLUME HEADER
PRTHDR: CALL TCLOSE
HRROI T2,[ASCIZ/Tape is /] ;PRINT HEADER
CALL PRINT
HRROI T2,[ASCIZ/unlabelled/]
TRNN FLAGS,%LABEL ;LABELLED?
JRST PRTHD1 ;NO
HRROI T2,[ASCIZ/EBCDIC /]
TRNE FLAGS,%ASC
HRROI T2,[ASCIZ/ASCII /]
CALL PRINT
HRROI T2,[ASCIZ/labelled/]
PRTHD1: CALL PRINT
CALL PRTDEN
HRROI T2,[ASCIZ/,/]
TRNE FLAGS,%LTM
HRROI T2,[ASCIZ/, with a leading tape mark,/]
TRNE FLAGS,%LTM1
HRROI T2,[ASCIZ/, with two leading tape marks,/]
CALL PRINT
TRNN FLAGS,%LABEL ;LABELLED?
JRST PRTHD2 ;NO
HRROI T2,[ASCIZ/
Volume ID = /]
CALL PRINT
HRROI T2,VOLID
CALL PRINT
HRROI T2,[ASCIZ/, Owner = /]
CALL PRINT
HRROI T2,OWNER
CALL PRINT
;...
PRTHD2: HRROI T2,[ASCIZ/
/]
JRST PRINT ;ALL DONE
SUBTTL TAPE ROUTINES
;SET UP THE TAPE JFN
;CALL WITH TJFN SET UP, OR 0 TO USE DEFAULT
SETTAP: SKIPN T1,TJFN
JRST SETTA0 ;GET DEFAULT JFN
DVCHR ;GET 1/DEVDES 2/STATUS 3/JOB,,UNITS
; TLNE T2,(DV%AV) ;AVAILABLE?
; JRST OOPS.
LDB T3,[POINT 8,T2,17] ;GET DV%TYP
CAIE T3,.DVMTA ;MUST BE MAGTAPE!
JRST [ HRROI T1,[ASCIZ/TAPELOOK: UNIT must be a magtape.
/]
ESOUT
JRST CTRLC ]
ASND ;ASSIGN DRIVE
ERJMP ERROR ;IN USE
RET
SETTA0: MOVSI T1,(GJ%OLD+GJ%SHT)
HRROI T2,[ASCIZ/MTA0:/]
GTJFN
ERJMP ERROR ;IN USE
MOVEM T1,TJFN
JRST SETTAP ;TRY AGAIN
; TCLEAR -- CLEAR MAG TAPE FLAGS
;
TCLEAR: MOVE T1,TJFN
MOVEI T2,.MOCLE
MTOPR
RET
; TREAD -- READS A TAPE BLOCK
;RET: +1 -- ERROR,
; +2 -- EOT,
; +3 -- OK
TREAD: MOVE T1,TJFN
TRZ FLAGS,%EMAX ;CLEAR > MAX BLOCK FLAG
MOVEI T2,IOLST
DUMPI
JFCL
CAIN T1,IOX4
JRST RET.2 ;EOT
MOVE T1,TJFN
GDSTS
MOVE T4,T2 ;SAVE STATUS BITS
CALL TCLEAR ;CLEAR MT FLAGS
TRNE T4,MT%EOT ; ONE WAY TO INDICATE EOT
JRST RET.2
HLRZM T3,PBLKSZ ;SAVE BLKSIZE
HLRZ T3,T3
CAIGE T3,MAXBLK ;> MAX BLOCK?
JRST TREAD1 ;NO
TRO FLAGS,%EMAX ;SET MAX BLOCK FLAG
TRNE T4,MT%IRL
JRST RET.3 ;BLOCK WAS > MAX
REPEAT 1,<
TRNE T4,MT%DAE ;HMM...APPARENTLY, A BUG. DAE WITH
JRST RET.2 ; MAX BLOCK, BUT NO DATA ACTUALLY
> ; TRANSFERRED. WE'RE AT EOT!
TREAD1: TRZ FLAGS,%EMAX ;RESET .GT. MAX BLOCK FLAG
TRNE T4,MT%DVE+MT%DAE
RET ;DEVICE OR DATA ERROR
RET.3: AOS (P)
RET.2: AOS (P)
RET.1: RET
; TSKIP -- SKIP TO NEXT FILE
;
TSKIP: MOVE T1,SKHDL ;START SKIP FORK
MOVEI T2,SKFRK
SFORK
TRO FLAGS,%SKIP ;SET SKIP FLAG
TSKWT: MOVEI T1,=1000 ;WAIT 1 SEC
DISMS
SOSLE SKTIMR ;DECR SKIP TIMER
JRST TSKWT
MOVE T1,SKHDL ;STOP SKIP
FFORK
HRROI T1,[ASCIZ/
Nearing the end of the tape; it may run off the end of the reel.
Do you wish to continue (type 'Y' or 'N')? /]
PSOUT
PBIN
MOVE T2,T1
HRROI T1,[ASCIZ/
/]
PSOUT
TRZ T2,40
CAIE T2,"Y"
RET ;DON'T PROCEED --> EOT
MOVE T1,SKHDL
RFORK ;USER SAYS TO PROCEED
WAIT
TSKRET: TRZ FLAGS,%SKIP ;TURN OFF SKIP FLAG
SOS SKTIMR ;DECR TIMER
CIS ;CLEAR INTERRUPT
RET
SKFRK: MOVE T1,TJFN ;SKIP TO NEXT TAPE FILE
MOVEI T2,.MOFWF
MTOPR
HALTF
JRST TAPELOOK
; TCLOSE -- CLOSE TAPE FILE
;
TCLOSE: MOVE T1,TJFN
TLO T1,(CO%NRJ) ;DON'T RELEASE JFN
CLOSF
ERJMP ERROR
RET
; REWIND -- REWIND TAPE
;
REWIND: MOVE T1,TJFN
MOVEI T2,.MOREW
MTOPR
MOVEI T2,.MOFWF
TRNE FLAGS,%LTM
MTOPR ;SKIP 1ST FILE IF LEADING TAPE MARK
TRNE FLAGS,%LTM1
MTOPR ;AND 2ND FILE IF TWO LTMS
RET
; TOPEN -- OPEN TAPE FILE
;
TOPEN: MOVE T1,TJFN
MOVE T2,[17B9+OF%RD]
OPENF
ERJMP ERROR
CALL TCLEAR
MOVEI T2,.MOSDM ;SET MODE=INDUSTRY COMPATIBLE
MOVEI T3,.SJDM8
MTOPR
MOVEI T2,.MOSPR ;SET PARITY=ODD
MOVEI T3,.SJPRO
MTOPR
MOVEI T2,.MOSDN
SKIPE T3,DEN ;SET DEN IF KNOWN
MTOPR
RET
;TLBLRD -- READ HDR2 LABEL FOR RECFM, LRECL, DSN ;RET: +1 -- ERROR,
; +2 -- EOT,
; +3 -- OK. Clears %OKLBL if label is bad format.
TLBLRD: CALL TOPEN
CALL TREAD ;READ HDR1
RET
JRST RET.2
TLO FLAGS,%OKLBL ;ASSUME CORRECTLY LABELLED
MOVE T1,PBLKSZ
CAIGE T1,=80
TLZ FLAGS,%OKLBL ;NOT LABELLED CORRECTLY
MOVE T1,INBUF ;CHECK FOR "HDR1"
TRZ T1,17
MOVE T2,[BYTE (8) 110,104,122,61]
TRNN FLAGS,%ASC ;ASCII?
MOVE T2,[BYTE (8) 310,304,331,361] ;NO
CAME T1,T2
TLZ FLAGS,%OKLBL ;NOT A VALID HDR1
MOVE T1,[POINT 8,INBUF+1]
MOVE T2,[POINT 7,DSN] ;SAVE DSN
MOVEI T3,=17 ;COPY 17. CHARACTERS
CALL COPY
MOVE T1,[POINT 8,INBUF+=10,7]
MOVEI T3,=6
CALL DONIN ;READ THE CREATION DATE
MOVEM T2,CREDAT
MOVEI T3,=6
CALL DONIN ;READ EXPIRATION DATE
MOVEM T2,EXPDAT
CALL TREAD ;READ HDR2
RET
JRST TLBLRX ;OOPS. NO HDR2
MOVE T1,PBLKSZ
CAIE T1,=80
TLZ FLAGS,%OKLBL ;NOT LABELLED
MOVE T1,INBUF ;CHECK FOR "HDR2"
TRZ T1,17
MOVE T2,[BYTE (8) 110,104,122,62]
TRNN FLAGS,%ASC ;ASCII?
MOVE T2,[BYTE (8) 310,304,331,362] ;NO
CAME T1,T2
TLZ FLAGS,%OKLBL ;NOT A VALID HDR2
SETZM RECFM
MOVE T1,[POINT 8,INBUF+1]
MOVE T2,[POINT 7,RECFM]
ILDB T3,T1 ;RECORD FORMAT
TRNE FLAGS,%EBC
HRRZ T3,TRNTAB(T3) ;TRANSLATE TO ASCII
IDPB T3,T2
MOVE T1,[POINT 8,INBUF+9,15]
ILDB T3,T1 ;BLOCKED
TRNE FLAGS,%EBC
HRRZ T3,TRNTAB(T3)
CAIN T3,"B"
IDPB T3,T2
MOVE T1,[POINT 8,INBUF+9]
ILDB T3,T1 ;CARRIAGE CONTROL
TRNE FLAGS,%EBC
HRRZ T3,TRNTAB(T3)
CAIE T3,"A" ;ANSI CC CHARS
CAIN T3,"M" ;EMBEDDED LINE-FORMAT CHARACTERS
IDPB T3,T2 ;VALID
CAIN T3,"X"
IDPB T3,T2 ;STREAM MODE
MOVE T1,[POINT 8,INBUF+1,7]
MOVE T2,[POINT 7,BLKSZ]
MOVEI T3,5 ;BLKSIZE
CALL COPY
MOVE T2,[POINT 7,LRECL]
MOVEI T3,5 ;LRECL
CALL COPY
JRST TLBLRT ;OK LABEL
TLBLRX: TLZ FLAGS,%OKLBL ;NO HDR2 IS AN ERROR, AT LEAST ON EBCDIC
TLBLRT: CALL TSKIP ;SKIP TM AT END OF LABELS
CALL TCLOSE
JRST RET.3
SUBTTL ROUTINES FOR IDENTIFYING DEC-FORMAT FILES
;LOOK AT BUFFER (AT CDMBUF) TO SEE IF THIS IS A DUMPER FILE.
;TYPICAL FORMAT FOR DUMPER IS A BLOCKSIZE THAT IS A MULTIPLE OF 2590.
;ret: +1 not DUMPER file
; +2 probably DUMPER file
DMPCHK: MOVE T2,PBLKSZ
IDIVI T2,=2590 ;T2:=QUOTIENT, T3:=REMAINDER
JUMPN T3,RET.1 ;NOT MULTIPLE OF 2590.
CAILE T2,0
CAILE T2,=8
RET ;BLOCKING FACTOR MUST BE 1..16
MOVEI T2,CDMBUF
CALL COMCHK ;COMPUTE CHECKSUM
JUMPN T1,RET.1 ;IS NOT DUMPER.
JRST RET.2 ;IT IS!
;COMPUTE CHECKSUM (SHOULD BE 0) OF 518. WORD BUFFER STARTING IN T1/
;CALL: T2/ BUFFER ADDRESS
;RET: T1/ 0 IF CHECKSUM CORRECT
COMCHK: HRLI T2,-1000-6 ;NHEAD = 6. I.E. 6 WORDS IN HEADER
MOVEI T1,0
COMCHA: JCRY0 COMCH1
COMCH1: ADD T1,0(T2)
JCRY0 [AOJA T1,.+1]
AOBJN T2,COMCH1
CAMN T1,[ -1]
AOS T1
RET
;LOOK AT BUFFER (AT CDMBUF) TO SEE IF THIS IS A TEXT FILE "COPY"ED TO
;TAPE IN CORE-DUMP FORMAT
;ret: +1 not text file
; +2 maybe text file
TXTCHK: MOVE T3,PBLKSZ
CAIGE T3,500 ;WE NEED AT LEAST 500 CHARS
RET ;NOT ENOUGH INFORMATION
MOVSI T3,-100 ;LOOK AT 100 WORDS
MOVEI T2,0 ;STATE=0 [LINENO,TAB,TEXT]
MOVE T1,CDMBUF+0
TLZ FLAGS,%LINNO
TRNE T1,1 ;LINE # PRESENT?
TLO FLAGS,%LINNO ;YES
;BEGINNING OF A NEW LINE
TXTCLI: JUMPE T1,TXTCH9 ;IGNORE 0 WORDS
TLNN FLAGS,%LINNO ;LINE # EXPECTED?
JRST TXTCTX ;NO. TEXT EXPECTED
MOVEI T2,1 ;EXPECT TAB IN NEXT WORD
TRNN T1,1 ;LINE NUMBER ACTUALLY THERE?
RET ;NO. BAD FORM
JRST TXTCH9 ;GO TO NEXT WORD
;TAB
TXTCTB: LDB T2,TXTTBL+0 ;PICK UP FIRST CHAR OF WORD
CAIE T2,11 ;TAB?
RET ;NO. BAD FORM.
;TEXT
TXTCTX: TRNE T1,1B35 ;BIT 35 IN THIS WORD?
RET ;YES. BAD FORM
MOVSI T4,-5 ;LOOK AT 5 CHARS
MOVEI T2,2 ;EXPECT MORE TEXT NEXT
TXTCT0: LDB T1,TXTTBL(T4) ;PICK UP NTH CHAR IN WORD
JUMPE T1,TXTCT1 ;IGNORE NULLS
CAIN T1,12 ;LF?
MOVEI T2,0 ;EXPECT LINE # NEXT
TXTCT1: AOBJN T4,TXTCT0
TXTCH9: MOVE T1,CDMBUF+1(T3) ;GET NEXT WORD
AOBJN T3,@[ ;AND LOOP TO PROPER PLACE
TXTCLI ;EXPECTING BEGINNING OF LINE
TXTCTB ;EXPECTING TAB
TXTCTX ](T2) ;EXPECTING TEXT
JRST RET.2 ;WE WIN, APPARENTLY
;TABLE OF BYTE POINTERS TO THE WORD IN QUESTION
TXTTBL: POINT 7,CDMBUF(T3),6
POINT 7,CDMBUF(T3),13
POINT 7,CDMBUF(T3),20
POINT 7,CDMBUF(T3),27
POINT 7,CDMBUF(T3),34
;LOOK AT BUFFER (AT CDMBUF) TO SEE IF THIS IS A SSAVE-FORMAT EXE FILE.
;SAVE FILES START WITH DIRECTORY PAGE
;ret: +1 not exe file
; +2 maybe exe
SAVCHK: HLRZ T1,CDMBUF ;FIRST WORD IS ALWAYS 1776,,LEN
CAIE T1,1776
RET
HRRZ T1,CDMBUF ;N.B. IF DIRECTORY IS .GE. 3 PAGES,
CAIL T1,3000 ;WE LOSE
RET
HLRZ T1,CDMBUF(T1) ;PICK UP START OF ENTRY VECTOR
CAIE T1,1775
RET ;SHOULD BE 1775,,LEN
JRST RET.2 ;PRETTY CLEARLY SAVE FORMAT
CSAFMT: -10,,17 ;CSAVE ALMOST ALWAYS STARTS THE SAME
PMAP
MOVEI 1,400000
CLZFF
MOVE 1,30
MOVE 2,31
MOVE 3,32
HALTF
CSAFML==.-CSAFMT
;LOOK AT BUFFER (AT CDMBUF) TO SEE IF THIS IS A CSAVE-FORMAT EXE FILE.
;CSAVE FILES START WITH 20/PMAP ...
;ret: +1 not exe file
; +2 maybe exe
CSACHK: MOVEI T1,CSAFMT
MOVEI T2,CDMBUF
MOVEI T3,CSAFML
; JRST CMPWRD ;FALL THROUGH
;COMPARE BUFFER SPECIFIED WITH INBUF
;CALL: T1/ ADDRESS 1
; T2/ ADDRESS 2
; T3/ LENGTH
;RET: +1 DIFFERENT
; +2 IDENTICAL
CMPWRD: MOVNS T3
HRL T1,T3
CMPWD0: MOVE T3,(T2)
CAME T3,(T1)
RET ;BUFFERS ARE DIFFERENT
ADDI T2,1
AOBJN T2,CMPWD0
JRST RET.2 ;TOO BAD...
;CONVERT TO ORDINARY FORMAT, ASSUMING TAPE WAS WRITTEN IN CORE-DUMP FORMAT.
; (THUS, IN A SENSE, THIS CONVERTS FROM INDUSTRY-FORMAT TO CORE-DUMP).
;CALL: T1/ ADDRESS OF INPUT BUFFER TO CONVERT
; T2/ ADDRESS OF OUTPUT BUFFER
; T3/ # CHARACTERS IN INPUT BUFFER TO CONVERT (MULTIPLE OF 20?)
INDCOR: HRLI T1,(<POINT 8,0>) ;CONVERT TO BYTE POINTER TO INPUT
INDCO1: MOVSI Q1,-5 ;NUMBER OF BYTES PER OUTPUT WORD
SETZM 0(T2) ;START WITH A ZERO WORD
INDCO2: ILDB T4,T1 ;PICK UP AN INPUT BYTE
DPB T4,INDCTB(Q1)
SOJLE T3,RET.1 ;STILL MORE CHARS IN INPUT?
AOBJN Q1,INDCO2 ;LOOP OVER 1 OUTPUT WORD
AOJA T2,INDCO1 ;LOOP OVER ALL OUTPUT WORDS
;TABLE OF CHUNKS OF OUTPUT WORD
INDCTB: POINT 8,0(T2),7
POINT 8,0(T2),15
POINT 8,0(T2),23
POINT 8,0(T2),31
POINT 4,0(T2),35
SUBTTL PRINT THE BUFFER
;DUMP BLOCK SIZE
DMPBLK: HRROI T2,[ASCIZ/
Actual tape block size= /]
CALL PRINT
TRNN FLAGS,%EMAX ;BLKSIZE EXCEEDED?
JRST BLKLEM ;NO
HRROI T2,[ASCIZ/> 30720/]
CALL PRINT
JRST FILBMP
BLKLEM: MOVE T2,PBLKSZ
CALL PRTDEC
FILBMP: MOVEI T1,INBUF
MOVEI T2,CDMBUF
MOVE T3,PBLKSZ
CALL INDCOR ;convert assuming "really" DUMP format
TLZ FLAGS,%CORDM ;but don't claim core-dump format yet
CALL DMPCHK ;check for DUMPER file
JRST FILBM1 ;nope
TLO FLAGS,%CORDM
HRROI T2,[ASCIZ/,
File is DUMPER format, SSN=/]
CALL PRINT
HRROI T2,CDMBUF+11 ;get (usually) pointer to SSN
JRST PRINT
FILBM1: CALL SAVCHK ;check if exe file
JRST FILBM2 ;nope
TLO FLAGS,%CORDM
HRROI T2,[ASCIZ/,
File is shareable EXE format/]
JRST PRINT
FILBM2: CALL CSACHK ;check if exe file
JRST FILBM3 ;nope
TLO FLAGS,%CORDM
HRROI T2,[ASCIZ/,
File is CSAVE-style EXE format/]
JRST PRINT
FILBM3: CALL TXTCHK ;check if DUMP-format text file
JRST FILBM4
TLO FLAGS,%CORDM
HRROI T2,[ASCIZ/,
File was probably written with COPY command, SET TAPE FORMAT CORE-DUMP/]
CALL PRINT
TLNN FLAGS,%LINNO
RET
HRROI T2,[ASCIZ/
(and has EDIT line numbers)/]
JRST PRINT
FILBM4: RET
;DUMP THE CONTENTS OF THE BEGINNING OF THE FILE IN THE BUFFER
DMPCNT: SKIPG T4,PRTCNT
RET ;NO CONTENTS REQUESTED
HRROI T2,[ASCIZ/,
Contents= /]
CALL PRINT
HRROI T2,[ASCIZ/
HEXIDECIMAL | ASCII | EBCDIC |/]
CALL PRINT
HRROI T2,[ASCIZ/
-------------------------------------------------------------------------------
/]
CALL PRINT
CAMLE T4,PBLKSZ
MOVE T4,PBLKSZ
MOVE T1,[POINT 8,INBUF] ;INITIALIZE HEX DUMP INPUT PTR
MOVEM T1,HIN
MOVE T1,[POINT 8,INBUF] ; " CHAR DUMP INPUT
MOVEM T1,CIN
NXTL: MOVE T1,[OUTINT,,OUTBUF]
BLT T1,OUTBUF+20 ;INITIALIZE OUTBUF BUFFER
MOVE T1,[POINT 7,OUTBUF] ; " HEX DUMP OUTPUT PTR
MOVEM T1,HOUT
MOVE T1,[POINT 7,OUTBUF+7,27]; " ASCII OUTPUT PTR
MOVEM T1,AOUT
MOVE T1,[POINT 7,OUTBUF+13,27]; " EBCDIC OUTPUT PTR
MOVEM T1,EOUT
MOVEI T2,=19 ; " HEX CHAR/LINE COUNT
CAMLE T2,T4
MOVE T2,T4
HEX: ILDB T1,HIN ;FORMAT HEX DUMP
MOVE T3,T1
LSH T1,-4 ;1ST 4 BITS
ADDI T1,"0" ;CONVERT TO ASCII 0-9 A-F
CAILE T1,"9"
ADDI T1,7
IDPB T1,HOUT
ANDI T3,17 ;2ND 4 BITS
ADDI T3,"0"
CAILE T3,"9"
ADDI T3,7
IDPB T3,HOUT
SOJG T2,HEX
MOVEI T2,=19 ;INIT CHAR CHAR/LINE COUNTER
CAMLE T2,T4
MOVE T2,T4
CHAR: ILDB T1,CIN ;FORMAT ASCII/EBCDIC DUMP
HRRZ T3,TRNTAB(T1) ;CONVERT EBCDIC TO ASCII
CAIL T1," "
CAILE T1,176
MOVEI T1,"." ;UNPRINTABLES PRINT AS "."
IDPB T1,AOUT
CAIL T3," "
CAILE T3,176
MOVEI T3,"."
IDPB T3,EOUT
SOJG T2,CHAR
HRROI T2,OUTBUF
CALL PRINT
SUBI T4,=19 ;REDUCE PRINT COUNTER
JUMPG T4,NXTL
RET
SUBTTL MAIN PROGRAM
TAPELOOK:
RESET
HRROI T1,[ASCIZ/
TAPELOOK (Version 1.23)
Type '?' for help
/]
PSOUT
MOVE P,[IOWD STKL,STACK] ;INIT STACK
SETZM DEN ;DEN NOT KNOWN
MOVEI OJFN,.PRIOU ;OUTPUT= TTY
MOVSI T1,(CR%MAP) ;CREATE SKIP FORK
CFORK
ERJMP ERROR
MOVE SKHDL,T1
MOVEI T1,.FHSLF ;SET UP INTERRUPTS
MOVSI T3,(SC%CTC)
EPCAP ;ENABLE CNTL-C CAPABILITY
MOVE T2,[LEVTAB,,CHNTAB]
SIR
EIR
MOVE T2,[1B0+1B<.ICIFT>] ;ACTIVATE CHNLS 0 + INF. HALTS
AIC
MOVSI T1,.TICCC ;ASSIGN ^C TO CHNL 0
ATI
PARSE: MOVEI T1,CSB ;INIT FOR PARSING OPTIONS
MOVEI T2,FDB0
CALL DOCMND
REPARS: MOVE T1,OJFN
CAIN T1,.PRIOU
RLJFN ;RELEASE OUTPUT JFN
JFCL
SKIPE T1,TJFN
RLJFN
JFCL
SETZM TJFN ;RELEASE TAPE JFN
MOVEI OJFN,.PRIOU ;INIT OUTPUT JFN
MOVEI T1,1
MOVEM T1,START ;START=1
MOVEI T1,777777
MOVEM T1,END ;END=A BIG NUMBER
MOVEI T1,=80
MOVEM T1,PRTCNT ;PRINT COUNT=80
MOVEI T1,=2400
MOVEM T1,LEN ;LEN=2400
MOVEI FLAGS,0 ;RESET FLAGS
MOVEI T1,CSB
OPTION: MOVEI T2,FDB1
CALL DOCMND ;PARSE OPTION
HRRZ T3,T3
JUMPE T3,OPTERR
CAIN T3,FDB1
JRST GO ;CR --> GO!
HRRZ T2,(T2)
CALL (T2) ;CALL PARSE ROUTINE
JRST PARSE ;ERROR
JRST OPTION
OPTERR: HRROI T1,[ASCIZ/Invalid option
/]
PSOUT
JRST PARSE
DUP: HRROI T1,[ASCIZ/Duplicate option
/]
PARERR: ESOUT
RET
$START: MOVEI T2,FDB3 ;(FILE)
CALL DOCMND
TROE FLAGS,%START
JRST DUP ;DUPLICATE
MOVEI T2,FDB4
CALL DOCMND ;PARSE #
MOVEM T2,START
NCHK: CAILE T2,0
JRST RET.2
HRROI T1,[ASCIZ/File # must be > 0
/]
JRST PARERR
$END: MOVEI T2,FDB3 ;(FILE)
CALL DOCMND
TROE FLAGS,%END
JRST DUP
MOVEI T2,FDB7
CALL DOCMND
MOVEM T2,END
JRST NCHK
$OUT: MOVEI T2,FDB3
CALL DOCMND
TROE FLAGS,%OUT
JRST DUP
MOVEI T2,FDB5 ;PARSE FILE SPEC
CALL DOCMND
HRRZ OJFN,T2 ;SAVE JFN
JRST RET.2
$TAPE: MOVEI T2,[.CMNOI*1B8
-1,,[ASCIZ/DEVICE NAME/] ]
CALL DOCMND
TROE FLAGS,%TAPE
JRST DUP
MOVEI T2,[.CMIFI*1B8+CM%HPP+CM%SDH+CM%DPP
0
-1,,[ASCIZ/DEVICE NAME, E.G. MTA0:/]
-1,,[asciz/MTA0:/] ]
CALL DOCMND
MOVEM T2,TJFN ;SAVE IT AWAY
JRST RET.2
$PRINT: MOVEI T2,FDB6 ;(# OF BYTES)
CALL DOCMND
TROE FLAGS,%PRINT
JRST DUP
MOVEI T2,FDB8
CALL DOCMND
JUMPL T2,[HRROI T1,[ASCIZ/Print count must be >= 0
/]
JRST PARERR ]
MOVEM T2,PRTCNT
JRST RET.2
$LEN: MOVEI T2,FDB9
CALL DOCMND
TROE FLAGS,%LEN
JRST DUP
MOVEI T2,FDB10 ;PARSE TAPE LENGTH
CALL DOCMND
CAIL T2,1
CAILE T2,=2400
JRST [ HRROI T1,[ASCIZ/Tape length must be 1-2400/]
JRST PARERR ]
MOVEM T2,LEN
JRST RET.2
SUBTTL ERRORS AT BEGINNING
GOERR1: HRROI T1,[ASCIZ/Starting file # > ending file #
/]
ESOUT
JRST PARSE
GOERR2: HRROI T2,[ASCIZ/Tape is empty/]
CALL PRINT
CALL PRTDEN
JRST QUIT
GOERR3: HRROI T2,[ASCIZ/Tape is 7-track or the density is not 800 or 1600 BPI/]
CALL PRINT
JRST QUIT
GOERR4: HRROI T1,[ASCIZ/END-OF-TAPE before specified starting file
/]
ESOUT
CALL REWIND
JRST PARSE
LTMCK: MOVE T1,TJFN
MOVEI T2,.MOREW
MTOPR
MOVEI T2,.MOFWF
MTOPR ;SKIP 1ST FILE IF LEADING TAPE MARK
CALL TREAD
JRST GOERR2
JRST LTMCK1 ;NOT JUST ONE LTM. MAYBE TWO?
TRO FLAGS,%LTM
JRST LBLCK
LTMCK1: CALL TREAD ;CHECK FOR LEADING TAPE MARK
JRST GOERR2
JRST GOERR2
TRO FLAGS,%LTM+%LTM1
JRST LBLCK
SUBTTL PROCESS FILE
GO: MOVE T1,START
CAMLE T1,END
JRST GOERR1 ;BAD FILE #S
CAIN OJFN,.PRIOU
JRST GO1
MOVE T1,OJFN ;OPEN OUTPUT FILE
MOVE T2,[7B5+OF%WR+OF%PLN]
OPENF
ERJMP ERROR
GO1: CALL SETTAP ;SET UP TAPE & ASSIGN
MOVE T1,LEN
ADDI T1,SKSPD-1 ;COMPUTE # OF SECS OF SKIP TIME
IDIVI T1,SKSPD
MOVEM T1,SKTIMR
CALL TOPEN
CALL REWIND
MOVE T1,TJFN
MOVEI T2,.MOSDN ;DETERMINE DENSITY
MOVEI T3,.SJD16
MOVEM T3,DEN
MTOPR ;800?
CALL TREAD
JRST DEN800 ;ERROR- NOT 800
JRST LTMCK ;EOT- LEADING TAPE MARK?
JRST LBLCK ;YES
DEN800: CALL REWIND
MOVEI T2,.MOSDN
MOVEI T3,.SJDN8
MOVEM T3,DEN
MTOPR
CALL TREAD
JRST GOERR3 ;NOT 800 EITHER
JRST LTMCK ;EOT- LEADING TAPE MARK?
LBLCK: MOVE T1,PBLKSZ
CAIGE T1,=80
JRST POSCK ;NOT LABELLED
MOVE T1,INBUF ;CHECK FOR "VOL1"
AND T1,[777777,,777760]
CAMN T1,[BYTE (8) 126,117,114,61]
TRO FLAGS,%LABEL+%ASC ;ASCII "VOL1"
CAMN T1,[BYTE (8) 345,326,323,361]
TRO FLAGS,%LABEL+%EBC ;EBCDIC "VOL1"
TRNN FLAGS,%LABEL ;DID WE FIND A LABEL?
JRST POSCK ;NO.
MOVE T1,[POINT 8,INBUF+1]
MOVE T2,[POINT 7,VOLID]
MOVEI T3,6
CALL COPY ;VOLUME ID
TRNN FLAGS,%EBC ;SL?
JRST [ MOVE T1,[POINT 8,INBUF+=9,7] ;NO. AL
MOVEI T3,=14 ;OWNER NAME STARTS EARLY
JRST LBLCK1 ]
MOVE T1,[POINT 8,INBUF+12,7]
MOVEI T3,=10 ;OWNER NAME
LBLCK1: MOVE T2,[POINT 7,OWNER]
CALL COPY ;MOVE IT
JRST POSCK
POSCK: MOVE T4,START ;POSITION TAPE?
SOJLE T4,NOSKIP
TRNE FLAGS,%LABEL
IMULI T4,3
SKIP: CALL TSKIP
CALL TCLOSE
CALL TOPEN ;YES
CALL TREAD
JRST ERROR ;UNEXPECTED ERROR
JRST GOERR4 ;EOT
SOJG T4,SKIP
MOVE T1,TJFN
MOVEI T2,.MOBKF
MTOPR
ERJMP ERROR
MOVEI T2,.MOFWF
MTOPR
JRST DOHDR
NOSKIP: TRNN FLAGS,%LABEL
CALL REWIND
DOHDR: CALL PRTHDR ;PRINT HEADER INFORMATION
MOVE TFN,START ;INIT TAPE FILE COUNT
NXTFIL: TRNN FLAGS,%LABEL ;IF LABELLED, THEN
JRST NXTFI2
CALL TLBLRD ;READ AND INTERPRET THE HEADER LABEL
JRST ERROR
JRST DONE
TLNE FLAGS,%OKLBL ;FOUND A GOOD LABEL?
JRST NXTFI2 ;YEP
HRROI T2,[ASCIZ/
HDR label file expected, but found:/]
CALL PRINT
CALL DMPBLK ;IF NOT, TREAT HDR AS DATA FILE
CALL DMPCNT
NXTFI2: CALL TOPEN ;PROCESS NEXT TAPE DATA FILE
CALL TREAD
JRST ERROR
JRST [ TRNE FLAGS,%LABEL ;IF UNLABELLED
TLNE FLAGS,%OKLBL ;OR BAD LABEL, THEN
JRST DONE ;DONE
HRROI T2,[ASCIZ/
File /]
CALL PRINT
MOVE T2,TFN
CALL PRTDEC
HRROI T2,[ASCIZ/ has HDR label but no data or EOF label!/]
CALL PRINT
JRST DONE ] ;LAST HDR IS BAD
HRROI T2,[ASCIZ/
File /] ;PRINT INFO FOR NEXT FILE
CALL PRINT
MOVE T2,TFN
CALL PRTDEC
HRROI T2,[ASCIZ/:/]
CALL PRINT
CALL PNTLBL ;print label information if any
CALL DMPBLK ;DUMP BLOCKSIZE, ETC
CALL DMPCNT ;DUMP THE CONTENTS
HRROI T2,[ASCIZ/
/]
CALL PRINT
AOJ TFN, ;INCR TAPE FILE #
CAMLE TFN,END
JRST DONE ;END FILE REACHED
CALL TSKIP ;SKIP TO NEXT FILE
CALL TCLOSE
TRNN FLAGS,%LABEL
JRST NXTFIL
CALL TOPEN
TLNE FLAGS,%OKLBL ;WAS HDR LABEL OK?
JRST NXTFI5 ;IF NOT, TREAT EOF LABEL AS DATA FILE
CALL TREAD
JRST ERROR
JRST [ HRROI T2,[ASCIZ/
File /]
CALL PRINT
MOVE T2,TFN
CALL PRTDEC
HRROI T2,[ASCIZ/ has good HDR label but no EOF label!/]
CALL PRINT
JRST DONE ] ;LAST HDR IS BAD
HRROI T2,[ASCIZ/
EOF label file expected:/]
CALL PRINT
CALL DMPBLK ;IF NOT, TREAT HDR AS DATA FILE
CALL DMPCNT ;DUMP CONTENTS
CALL TCLOSE
JRST NXTFIL
NXTFI5: CALL TSKIP ;SKIP EOF LABELS
CALL TCLOSE
JRST NXTFIL
DONE: SUBI TFN,1
HRROI T2,[ASCIZ/
There were /]
CALL PRINT ;PRINT TRAILER MSG
MOVE T2,TFN
CALL PRTDEC
HRROI T2,[ASCIZ/ file(s) processed on this tape
/]
CALL PRINT
JRST QUIT
END TAPELOOK