Trailing-Edge
-
PDP-10 Archives
-
SRI_NIC_PERM_SRC_3_19910112
-
utilities/tapelabel.fai
There are no other files named tapelabel.fai in the archive.
;<ADMIN.JQJ>TAPLBL.FAI.18, 3-Mar-81 13:30:43, Edit by ADMIN.JQJ
; write a "3" in char 80 of ascii tapes -- standard level.
;<ADMIN.JQJ>TAPELA.FAI.3, 11-Feb-81 18:25:58, Edit by ADMIN.JQJ
; Implement UNIT
; I typed MOVEI instead of MOVE -- turkey!
;<ADMIN.JQJ>TAPELA.FAI.2, 11-Feb-81 17:49:27, Edit by ADMIN.JQJ
; Typeo at WRITE+n -- wrong register. Suppress literals & macros
; Set UNIT at beginning of program, for later expansion.
; Rewind before writing
;<ADMIN.JQJ>TAPELA.FAI.1, 19-Jan-81 14:50:06, Edit by ADMIN.JQJ
; start cleaning up style
TITLE TAPELABEL -- LABEL A TAPE
SEARCH MONSYM
ASUPPRESS ;don't output unused symbols
XALL ;no macro bodies in listing
NOLIT ;no literals in listing
OPDEF CALL [PUSHJ 17,]
OPDEF RET [POPJ 17,]
; REGISTER USAGE
AC1= 1 ;JSYS AC'S
AC2= 2
AC3= 3
AC4= 4
AC5= 5
TJFN= 15 ;TAPE JFN
P= 17
SUBTTL DATA AREA
; OUTPUT BUFFER
BUFFER: BYTE (8) "V","O","L","1" ; 126,117,114,61
REPEAT <BUFFER+24-.>,<
BYTE (8) 40,40,40,40 ; 20. words total buffer all
>;REPEAT
; variables
STKL= 5
STACK: BLOCK STKL
UNIT: 0 ;UNIT NUMBER OF TAPE DRIVE
DEVNAM: ASCIZ /MTA0:/
IOLIST: IOWD =20,BUFFER
0
DEN: .SJD16 ;DEFAULT= 1600
TYPE: 1 ;DEFAULT= SL
USRNAM: BLOCK 10 ;DEFAULT FOR OWNER= USER NAME
CMIBUF: BLOCK =16
CMABUF: BLOCK =16
CSB: 0 ;TO BE FILLED IN
.PRIIN,,.PRIOU
0 ;TO BE FILLED IN
POINT 7,CMIBUF
POINT 7,CMIBUF
=80
0
POINT 7,CMABUF
=80
0
UNIHLP: ASCIZ!
Please supply the UNIT number of the tape drive you are using [e.g., for
MTA0:, use 0]. At LOTS, there is only one tape drive, so you must use
unit 0.
!
VOLHLP: ASCIZ!
Please supply the VOLUME SERIAL NUMBER for your tape. It can be any 1-6
characters, but unless the tape is on temporary checkout from CIT (in
which special case it should match the reel number on the tape), you
should avoid serial numbers starting with "AX", "AU", or "EU". You do
not have to supply this field, it will be "000001" if you do not.
!
OWNHLP: ASCIZ!
Please supply from 1-10 characters that will be written into the owner /
user name field of the volume label. It can be, for example, your CIT
account. You do not have to specify this field; it will be the first 10
characters of your user name if you do not.
!
TYPHLP: ASCIZ/
Please specify whether this is to be a IBM STANDARD (SL) or an ANSI (AL)
label. Use "SL" unless you are sure that you want "AL". You do not
have to answer this question; "SL" is assumed if you do not.
/
DENHLP: ASCIZ/
If your tape must be 800 BPI, answer "800" to this question. Do not write at
800 BPI unless you are sure that you must. If you do not answer this question,
"1600" is assumed.
/
TYPTAB: 2,,2
[ASCIZ/AL/],,0
[ASCIZ/SL/],,1
DENTAB: 2,,2
[ASCIZ/1600/],,.SJD16
[ASCIZ/800/],,.SJDN8
FDBCFM: <.CMCFM>*1B8
FDBUNI: <.CMNUM>*1B8+CM%FIX+CM%HPP+CM%SDH+CM%DPP
10
POINT 7,UNIHLP
POINT 7,[ASCIZ/0/] ;DEFAULT
FDBVOL: <.CMTXT>*1B8+CM%FIX+CM%HPP+CM%SDH+CM%DPP
0
POINT 7,VOLHLP
POINT 7,[ASCIZ/000001/] ;DEFAULT
FDBOWN: <.CMTXT>*1B8+CM%FIX+CM%HPP+CM%SDH+CM%DPP
0
POINT 7,OWNHLP
POINT 7,USRNAM ;DEFAULT TO USER NAME
FDBTYP: <.CMKEY>*1B8+CM%FIX+CM%HPP+CM%SDH+CM%DPP
TYPTAB
POINT 7,TYPHLP
POINT 7,[ASCIZ/SL/] ;DEFAULT TO SL
FDBDEN: <.CMKEY>*1B8+CM%FIX+CM%HPP+CM%SDH+CM%DPP
DENTAB
POINT 7,DENHLP
POINT 7,[ASCIZ/1600/] ;DEFAULT TO HIGH DENSITY
SUBTTL TRANSLATION TABLE
; TRANSLATION TABLE: ASCII->EBCDIC,,EBCDIC->ASCII
; NON-TRANSLATABLES ARE TRANSLATED TO SUB'S
; BELIEVED TO BE THE SAME AS OPTCD=Q, EXCEPT:
; ASCII->EBCDIC: ! -> ! (INSTEAD OF VERT BAR)
; EBCDIC->ASCII: CENT -> ^Z ([)
; ! -> ! (])
; [ -> [ (^Z)
; ] -> ] (^Z)
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,,32 ; 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 ; ],,)
137,,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 ; },,'
241,,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 SUBROUTINES
;ASSIGN AND GET JFN ON TAPE DRIVE
ASSIGN: MOVE AC1,UNIT
HRLI AC1,.DVDES+.DVMTA ;DEVICE DESIGNATOR FOR MTA0:
ASND ;ASSIGN TAPE DRIVE
ERJMP $INUSE
MOVE AC1,UNIT
LSH AC1,8
ADDM AC1,DEVNAM
MOVSI AC1,(GJ%FOU+GJ%SHT)
HRROI AC2,DEVNAM
GTJFN ;GET JFN
ERJMP $ERROR
MOVEM AC1,TJFN
RET
$INUSE: HRROI AC1,[ASCIZ/
The tape drive is being used by someone else, try again later.../]
PSOUT
HALTF
JRST START
$ERROR: HRROI AC1,[ASCIZ/JSYS Error: /]
ESOUT
MOVEI AC1,.PRIOU
HRLOI AC2,.FHSLF
MOVEI AC3,0
ERSTR
JFCL
JFCL
JUMPE TJFN,EXIT1
JRST EXIT
; COPY -- MOVE BYTES TILL NULL
; INPUT: AC1=DESTINATION, AC2=SOURCE, AC3=RAISE FLAG, AC4=MAX LENGTH
COPY:
COPY1: ILDB AC5,AC2
JUMPE AC5,COPY3 ;END OF SOURCE
JUMPE AC3,COPY2
CAIL AC5,"a"
CAILE AC5,"z"
SKIPA
TRZ AC5,40
COPY2: IDPB AC5,AC1
SOJG AC4,COPY1 ;STOP IF TOO LONG
RET
COPY3: MOVEI AC5," " ;USE SPACE TO PAD
IDPB AC5,AC1
SOJG AC4,COPY3 ;AND LOOP UNTIL DONE
RET
; PARSE A CONFIRMATION.
;CALL: AC1/ CSB
;RET: +1 ERROR, +2 NORMALLY
; PRINTS ERROR MESSAGE ON ERROR
DOCFM: MOVEI AC2,FDBCFM
CALL DOCMND
JRST CFMBAD
CPOPJ1: AOS (17)
CPOPJ: RET
CFMBAD: HRROI AC1,[ASCIZ/Not confirmed/]
ESOUT
RET
; PARSE A COMND BLOCK
;CALL: AC1/ CSB, AC2/ FDB
;RET: +1 ERROR, +2 NORMALLY
DOCMND: COMND
ERJMP $ERROR ;SERIOUS ERROR
TLNN AC1,CM%NOP ;PARSING ERROR
AOS (P) ;NO. SKIP RETURN
RET
;INITIALIZE FOR COMND.
;CALL: AC1/ PROMPT POINTER
DOINI: MOVEM AC1,CSB+2 ;PROMPT STRING
MOVEI AC1,CSB
MOVEI AC2,[<.CMINI>*1B8]
COMND
RET
SUBTTL MAIN ROUTINE
START: RESET
MOVE P,[IOWD STKL,STACK]
SETZM TJFN ;NO JFN YET
GJINF ;GET USER NUMBER IN 1
MOVE AC2,AC1
HRROI AC1,USRNAM ;USE IT AS DEFAULT FOR OWNER NAME
DIRST
ERJMP $ERROR
HRROI AC1,[ASCIZ/
TAPELABEL (version 1.03)
This program labels a tape. The previous contents of the tape are
destroyed! Type "?" for help if you don't understand the questions you
are asked.
/]
PSOUT
; FALL THROUGH TO PARSING
SUBTTL CRUFTY PARSING
; PARSE THE UNIT NUMBER
UNIPAR: MOVEI AC1,UNIREP
MOVEM AC1,CSB+0
HRROI AC1,[ASCIZ/Tape UNIT number? /]
CALL DOINI
UNIREP: MOVE P,[IOWD STKL,STACK]
MOVEI AC2,FDBUNI
CALL DOCMND
JRST [ HRROI AC1,[ASCIZ/Invalid UNIT number/]
ESOUT
JRST UNIPAR ] ;IF BAD PARSE, TRY AGAIN
MOVEM AC2,UNIT
CALL DOCFM
JRST UNIPAR
CALL ASSIGN ;WE CAN NOW ASSIGN THE DRIVE
; PARSE THE VOLUME LABEL
VOLPAR: MOVEI AC1,VOLREP
MOVEM AC1,CSB+0
HRROI AC1,[ASCIZ/Volume serial number? /]
CALL DOINI
VOLREP: MOVE P,[IOWD STKL,STACK]
MOVEI AC2,FDBVOL
CALL DOCMND
JRST [ HRROI AC1,[ASCIZ/Invalid VOLUME SERIAL NUMBER/]
ESOUT
JRST VOLPAR ] ;IF BAD PARSE, TRY AGAIN
MOVE AC1,[POINT 8,BUFFER+1]
MOVE AC2,[POINT 7,CMABUF]
MOVEI AC3,1 ;RAISE
MOVEI AC4,6 ;MAXIMUM 6 CHARS
CALL COPY
MOVEI AC1,CSB
CALL DOCFM
JRST VOLPAR
; PARSE THE OWNER FIELD, DEFAULTING TO LOGIN USER NAME
OWNPAR: MOVEI AC1,OWNREP
MOVEM AC1,CSB+0
HRROI AC1,[ASCIZ/Owner name? /]
CALL DOINI
OWNREP: MOVE P,[IOWD STKL,STACK]
MOVEI AC2,FDBOWN
CALL DOCMND
JRST [ HRROI AC1,[ASCIZ/Invalid owner string/]
ESOUT
JRST OWNPAR ] ;IF BAD PARSE, TRY AGAIN
MOVE AC1,[POINT 8,BUFFER+=10,7]
MOVE AC2,[POINT 7,CMABUF]
MOVEI AC3,0
MOVEI AC4,=10 ;MAXIMUM 10 CHARS
CALL COPY
MOVEI AC1,CSB
CALL DOCFM
JRST OWNPAR
; PARSE THE LABEL TYPE
TYPPAR: MOVEI AC1,TYPREP
MOVEM AC1,CSB+0
HRROI AC1,[ASCIZ/SL or AL label? /]
CALL DOINI
TYPREP: MOVE P,[IOWD STKL,STACK]
MOVEI AC2,FDBTYP
CALL DOCMND
JRST [ HRROI AC1,[ASCIZ/Label type must be "SL" or "AL"/]
ESOUT
JRST TYPPAR ]
HRRZ AC2,(AC2)
MOVEM AC2,TYPE
CALL DOCFM
JRST TYPPAR
; PARSE THE DENSITY SPECIFICATION
DENPAR: MOVEI AC1,DENREP
MOVEM AC1,CSB+0
HRROI AC1,[ASCIZ/Tape density? /]
CALL DOINI
DENREP: MOVE P,[IOWD STKL,STACK]
MOVEI AC2,FDBDEN
CALL DOCMND
JRST [ HRROI AC1,[ASCIZ/Density must be 800 or 1600/]
ESOUT
JRST DENPAR ]
HRRZ AC2,(AC2)
MOVEM AC2,DEN ;SAVE DENSITY SPECIFIED
CALL DOCFM
JRST DENPAR
SUBTTL WRITE THE LABEL
; FINALLY, WRITE THE LABEL
SKIPN TYPE ;SL?
JRST ASCLBL ;NO. AL
MOVE AC1,[POINT 8,BUFFER] ;TRANSLATE TO EBCDIC
MOVEI AC4,=80 ; IN PLACE
EBCLP: ILDB AC3,AC1
HLRZ AC3,TRNTAB(AC3)
DPB AC3,AC1
SOJG AC4,EBCLP
JRST WRITE
ASCLBL: MOVEI AC3,"3" ;SAY WE'RE STANDARD
DPB AC3,[POINT 8,BUFFER+=17,31]
WRITE: HRRZ AC1,TJFN ;WRITE VOLUME LABEL
MOVE AC2,[17B9+OF%WR]
OPENF ;OPEN TAPE FILE
ERJMP $ERROR ;WILL RETURN VIA EXIT
MOVEI AC2,.MOREW
MTOPR ;MAKE SURE WE'RE AT BEGINNING
MOVEI AC2,.MOSDM
MOVEI AC3,.SJDM8 ;INDUSTRY COMPATIBLE MODE
MTOPR
MOVEI AC2,.MOSPR
MOVEI AC3,.SJPRO ;ODD PARITY
MTOPR
MOVEI AC2,.MOSDN
MOVE AC3,DEN ;THE SPECIFIED DENSITY
MTOPR
MOVEI AC2,IOLIST
DUMPO
ERJMP $ERROR ;OOPS!
HRLI AC1,(CO%NRJ) ;DON'T RELEASE YET
CLOSF ;WRITE EOT
ERJMP $ERROR
HRRZ AC1,TJFN
MOVE AC2,[17B9+OF%WR] ;REOPEN IT FOR REWIND
OPENF
ERJMP $ERROR
EXIT: HRRZ AC1,TJFN
MOVEI AC2,.MOREW
MTOPR
ERJMP .+1
CLOSF
ERJMP EXIT1
EXIT1: HRLZI AC1,.DVDES+.DVMTA
HRRI AC1,UNIT
RELD
ERJMP .+1
HALTF
JRST START
END START