Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/bcd.mac
There are 2 other files named bcd.mac in the archive. Click here to see a list.
;THIS PROGRAM WAS WRITTEN AT WESTERN MICHIGAN UNIVERSITY
	TITLE BCD TAPE CONVERSION PROGRAM 
	SUBTTL	WESTERN MICHIGAN UNIVERSITY COMPUTER CENTER

	SEARCH	UUOSYM

	VBCD==03
	VEDIT==24
	VMINOR==00
	VWHO=4

	JOBVER=137
	LOC JOBVER
		BYTE	(3)VWHO(9)VBCD(6)VMINOR(18)VEDIT
	RELOC

	;ACCUMULATOR DEFINITIONS

	F=0		;FLAGS
	A=1
	B=2
	C=3
	D=4
	OPNT=6
	CNT=7
	LINPNT=10
	CHR=11
	RCNT=14
	MATCH=15
	P=17

	; I/O CHANNELS
	ICH==16
	OCH==17
	SCH==15

	DEFINE TEXT (A),<
	XLIST
	ASCIZ@A@
	LIST
>
	;LH FLAG BITS
DMPFLG==400000		;DUMP MODE FLAG - MUST BE SIGN BIT
IGNORE==200000		;IGNORE ERROR FLAG
ASW==100000		;LINE BLOCK SWITCH
NSW==40000		;PROCESS N RECORDS ONLY
WSW==20000		;REWIND TAPE
SOMESW==10000		;SOME VALID SWITCH TYPED AFTER /
NUM==4000		;NUMBER SEEN IN INPUT ROUTINE
NEGS==2000		;NEGATIVE SIGN SEEN
PLUS==1000		;PLUS SIGN SEEN
DSW==200		;TAPE DUMP
OSW==100		;OCTAL TAPE DUMP ALSO
SSW==40			;USE ASCII SPACE(40 OCTAL) WHEN TRANSLATING EBCDIC(0)
PSW==20			;POSITION INPUT TAPE
BSW==10			;CHANGE INPUT BLOCKING
EOFSEN==1		;EOF SEEN ON SPECIAL CHR SET OPTION

	;RH FLAG BITS

NOSWTH==400000		;1 IF SWITCHES NOT ALLOWED IN GTSPEC
UNBLKD==200000		;1 IF TAPE IS NOT BLOCKED
SNGBUF==100000		;1 IF SINGLE TAPE BUFFER
DINFLG==40000		;1 IF MUST DO DUMP INPUT BECAUSE OF RECORD SIZE

;MISC. MEMORY LOCS.
LINCNT:	0
PAGCNT:	0
CNTFLG:	0
RECS:	0
TAPLEG:	BLOCK	1
TAPDEN:	BLOCK	1
TAPBLK:	BLOCK	4
	SUBTTL	STARTUP AND DIALOGUE
START:	JFCL			;BEWARE CCL START
	RESET
	OUTSTR	[ASCIZ/
WMU - TAPE CONVERSION PROGRAM

/]
	MOVE	P,[IOWD 40,PDL]
	SETZ	F,		;CLEAR ALL FLAGS
	MOVSI	A,'BCD'
	DEVCHR	A,
	JUMPE	A,NTAVL		;BCD DOESN'T EXIST
	TLNN	A,(1B13)	;IS BCD A MAGTAPE
	JRST	NOTAPE		;NO
;	MOVSI	A,'BCD'		;CALL USAGE
;	CALLI	A,-2		;DO IT
	 JFCL			;IGNORE IT
	SETZM	TAPDEN		;ASSUME 800 BPI/NO TAPOPS.
	MOVEI	A,.TFPDN	;FIND LEGAL DENSITIES
	MOVEM	A,TAPBLK
	MOVSI	A,'BCD'		;FOR DEVICE BCD
	MOVEM	A,TAPBLK+1
	MOVEI	A,.TFD80
	MOVEM	A,TAPDEN
	MOVE	A,[XWD 3,TAPBLK]
	TAPOP.	A,
	  JRST	GETCNV		;WON'T TELL. MUST BE 800
	MOVEM	A,TAPLEG	;SAVE LEGAL DENSITIES
	TRNN	A,TF.DN4!TF.DN5	;1600 OR 6250 POSSIBLE?
	 JRST	GETCNV		;NO. FORCE 800
GETDEN:	OUTSTR	[ASCIZ/Tape density: /]
	PUSHJ	P,IN		;GET DENSITY
	CAIGE	A,^D800		;800 OR MORE?
	 JRST	ILLDEN		;NO. ILLEGAL
	SETZ	B,		;ASSUME NOT LEGAL
	CAIN	A,^D800
	MOVEI	B,.TFD80
	CAIN	A,^D1600
	MOVEI	B,.TFD16
	CAIN	A,^D6250
	MOVEI	B,.TFD62
	JUMPE	B,ILLDEN	;ILLEGAL IF NONE OF ABOVE
	MOVEM	B,TAPDEN	;STORE DESIRED DENSITY
	MOVEI	A,1
	LSH	A,-1(B)		;POSITION BIT
	TDNN	A,TAPLEG	;IS IT LEGAL ON THIS DRIVE?
	 JRST	BADDEN		;NO. SAY SO
GETCNV:	OUTSTR	LIT0		;ASK FOR INPUT CODE
	PUSHJ	P,GETLIN
	ILDB	A,LINPNT
	SKIPN	A
	MOVEI	A,"E"		;ASSUME EBCDIC
	MOVSI	B,-CNVNUM	;NEGATIVE NUMBER OF CONVERSIONS
	CAME	A,CNVTAB(B)	;MATCH?
	AOBJN	B,.-1		;NO. LOOK AT NEXT
	JUMPGE	B,CNVERR	;GIVE ERROR IF NONE MATCHES
	MOVE	C,CNVLST(B)	;GET THE RIGHT CONVERT INST.
	MOVEM	C,CNVRT		;SAVE IT
	MOVE	C,CNVLIM(B)	;GET LIMIT FOR CONVERSION TYPE
	JUMPE	C,SPCSET	;JUMP IF USER DIALOGUE REQUIRED
GOTCNV:	MOVEM	C,CNVMAX#	;STORE IT
	CAIE	A,"D"
	JRST	ASKBLK
	TRZ	F,SNGBUF!UNBLKD!DINFLG	;NOT SINGLE BUFFER OR UNBLOCKED NOW
	TLO	F,DMPFLG	;SET DUMP FLAG
	OUTSTR	DMPWRN
	MOVEI	A,1
	JRST	ASKBK1		;GO STORE BLOCKING FACTOR
SPCSET:	OUTSTR	[ASCIZ/
 NAME OF CONVERSION TABLE FILE? /]
	TRO	F,NOSWTH	;NO SWITCHES ALLOWED
	SETZM	DEV
	SETZM	NAME
	SETZM	EXT
	SETZM	EXT+1
	SETZM	EXT+2
	PUSHJ	P,GTSPEC	;GET THE FILE NAME
	OUTSTR	LIT11		;NUMBER OF CHRS IN SET
	PUSHJ	P,IN
	SUBI	A,1		;HIGHEST LEGAL VALUE
	CAILE	A,^D255		;> MAX LIMIT?
	JRST	[OUTSTR	[ASCIZ/
?BCDMSX - Max size of character set exceeded/]
		EXIT]
	CAIG	A,0		;POSITIVE?
	MOVEI	A,^D255		;NO - ASSUME MAX
	MOVEM	A,CNVMAX	;STORE IT
	PUSHJ	P,SPCINS	;GET NEW CHR SET(NO RETRN IF ERROR
ASKBLK:	TRZ	F,SNGBUF!UNBLKD!DINFLG	;NOT SINGLE BUFFER OR UNBLOCKED NOW
	JUMPL	F,ASKREC	;NOT BLOCKING IF DUMPING
	OUTSTR	LIT1		;ASK ABOUT BLOCKING FACTOR
	PUSHJ	P,IN
	JUMPG	A,ASKBK1	;MUST BE POSITIVE
	JUMPE	A,WHTSIZ	;USER WANTS SIZE SNOOPED OUT
	OUTSTR	BADNEG		;COMPLAIN
	JRST	ASKBLK		;AND TRY AGAIN
ASKBK1:	MOVEM	A,BLKFAC
	JUMPL	F,ASKREC	;DUMP TAPES ARE BLOCKED
	CAIN	A,1		;UNBLOCKED?
	TRO	F,UNBLKD	;YES.
ASKREC:	OUTSTR	LIT2		;ASK ABOUT RECORD SIZE
	PUSHJ	P,IN
	JUMPG	A,ASKRC1	;MUST BE POSITIVE
	OUTSTR	BADNEG		;COMPLAIN
	JRST	ASKREC		;AND TRY AGAIN
ASKRC1:	MOVEM	A,RECSIZ
	IMUL	A,BLKFAC
	MOVEM	A,BUFN		;# OF CHARS IN 1 BUFFER = RECSIZ*BLKFAC
	MOVEM	A,BUFSIZ
	JUMPL	F,GETBUF	;DUMP MODE?
	ADDI	A,3
	IDIVI	A,4
	MOVEM	A,BUFSIZ	;# OF WORDS IN BUFFER IS AN EVEN MULTIPLE OF 4
GETBUF:	ADDI	A,3+^D10	;ACTUAL SIZE OF BUFFER REQUIRED
	MOVEM	A,BUFWDS#	;STORE IT
	CAILE	A,^D4096	;MORE THAN FOUR K?
	TRO	F,DINFLG	;YES. CAN NOT DO BUFFERED IO
	MOVEI	B,^D3000	;USE ABOUT THREE K BUFFERS
	EXCH	A,B
	IDIV	A,B
	SKIPE	B
	ADDI	A,1		;OR ONE IF THATS BIGGER
	MOVEM	A,MBUFN#	;STORE NUMBER
	TRNN	F,DINFLG	;DUMP INPUT?
	 JRST	SETBUF		;NO
	MOVE	A,BUFSIZ	;GET BUFFER SIZE AGAIN
	ADDI	A,^D10		;TOTAL WORDS REQUIRED TO INPUT
	MOVN	A,A		;NEGATE
	HRLM	A,DIOWD		;BUILD IOWD
	TRNE	F,UNBLKD	;UNBLOCKED TAPE?
	JRST	SETBUF		;YES. ANY LINE BLOCKING WILL BE DIFFERENT WAY
		;THIS IS FOR COMPUTATION OF NULL FILL FOR END OF WORD IF LINE-BLOCKED
	MOVE	A,RECSIZ
	ADDI	A,2
	IDIVI	A,5
	SUBI	B,5
	ADDI	A,1		;GET NUMBER OF WORDS FOR RECORD
	IMULI	A,5		;NOW NUMBER OF CHARACTERS INCLUDING FILL
	MOVEM	A,ARECSZ#	;ACTUAL RECSIZ = RECSIZ+<CRLF>+NULLFILL
	CAIG	A,^D640		;NUMBER OF CHARACTER PER DISK BLOCK
	 JRST	SETBUF		;OK IF RECORD .LE.
	TLZ	F,ASW		;BAD. CAN'T LINE BLOCK
	OUTSTR	[ASCIZ/%BCDCLB Cannot line block output. record too long.
/]
		; END OF LINE-BLOCK STUFF
SETBUF:	MOVE	A,BUFWDS	;GET SIZE OF A BUFFER
	IMUL	A,MBUFN		;TIMES NUMBER
	ADDI	A,BUF1		;PLUS BASE ADDRESS
	MOVE	B,A
	CAMGE	A,.JBREL##	;DO WE NEED MORE CORE
	JRST	OK		;NO
	CORE	A,		;YES GET IT
	 JRST	.+2		;TRY LESS BUFFERS
	JRST	OK		;ALL OK
	SOSG	MBUFN		;IS LESS BUFFERS LEGAL?
	JRST	NOCORE		;NO. NOT ENOUGH FOR EVEN ONE
	JRST	SETBUF		;YES. TRY ONE LESS
OK:	HRRM	B,.JBFF##	;SAVE NEW TOP TWICE
	MOVE	A,MBUFN		;ACTUAL NUMBER OF BUFFERS
	CAIG	A,1		; GREATER THAN ONE?
	TRO	F,SNGBUF	;NO. SINGLE BUFFERED
	PUSHJ	P,TINIT		;INITIALIZE TAPE
POSIT:	OUTSTR	LIT3		;ASK ABOUT REWIND
	PUSHJ	P,YESNO		;SKIP UNLESS 'Y'
	PUSHJ	P,REWIND
	OUTSTR	LIT4		;ASK ABOUT FILE POSITION
	PUSHJ	P,IN
	JUMPGE	A,SKF
	PUSHJ	P,BACKSP
	AOJLE	A,.-1		;MUST DO N+1 BACKSPACE COMMANDS
	STATO	ICH,1B24	;AT LOAD POINT?
				;IF NOT, MUST DO ONE SKIP FILE
	PUSHJ	P,SKIPFL
SKF:	SOJG	A,.-1
ASKNAM:	OUTSTR	[ASCIZ\
 Output ? \]
	TLZ	F,IGNORE!ASW!NSW!WSW!DSW!OSW!SSW!PSW!BSW ;TURN OFF IGNORE, SWITCHES
	TRZ	F,NOSWTH	;SWITCHES ALLOWED
	SETZM	EBCTAB		;PRESET NULL AT EBCTAB+0
	PUSHJ	P,GTSPEC	;GET FILE SPECS
	MOVE	B,NAME
	CAMN	B,[SIXBIT/FINISH/]
	EXIT
	TLZE	F,BSW		;/B/P IS /B SINCE FALLS TO /P
	 JRST	ASKBLK		;GO REDO BLOCKING
	TLZE	F,PSW		;REWIND TAPE(/P)
	 JRST	POSIT		;YES. DO IT
OINIT:	TLNE	F,DMPFLG	;DUMPING?
	TLZ	F,DSW!OSW!SSW!ASW	;YES. CLEAR INCOMPATIBLE SWITCHES
	MOVEI	A," "		;ASCII SPACE
	TLZE	F,SSW		;SPACE TO REPLACE NULL IN EBCDIC(0)?
	MOVEM	A,EBCTAB	;YES
	MOVEI	A,1		;ASCII LINE
	TLNE	F,DMPFLG
	MOVEI	A,10		;IMAGE MODE
	MOVE	B,DEV
	MOVSI	C,OB		;OUTPUT ONLY
	OPEN	OCH,A		;OPEN OUTPUT DEVICE
	 JRST	NODSK
	ENTER	OCH,OUTFIL	;SET UP FILENAME IF ANY
	 JRST	NOROOM
	MOVEI	B,OCH		;SET UP B FOR DEVCHR
	DEVCHR	B,		;DO IT
	TLNE	B,(1B13)	;IS IT A MAGTAPE FOR OUTPUT
	TLNN	F,WSW		;YES, DO THEY WANT REWIND(/W)
	SKIPA			;NO, NO, NO
	MTREW.	OCH,		;YES, YES, YES
	MTWAT.	OCH,		;MUST WAIT
	SETZM	LNGCNT#		;CLEAR NUMBER OF OVERSIZE RECORDS
	SETZM	SMLCNT#		;CLEAR NUMBER OF SHORT RECORDS
	SETZB	RCNT,ILLCNT#	;ZERO RECORD COUNT AND ILLEGAL CHAR COUNT
	SETZM	PHYCNT#		;ZERO NUMBER OF PHYSICAL RECORDS READ
	HRLOI	B,377777
	MOVEM	B,NCNT		;MAKE NCNT A HUGE NUMBER
	TLNN	F,DSW		;TAPE DUMP?
	JRST	RNREC		;NO
	OUTSTR	[ASCIZ/
OCTAL DUMP ALSO? /]
	PUSHJ	P,YESNO		;SKIP UNLESS 'Y'
	TLO	F,OSW		;SET OCTAL DUMP SWTCH
RNREC:	TLNN	F,NSW		;IS NSW SET(/D DOES IMPLICIT /N)
	JRST	RDREC2		;NO
RDREC0:	OUTSTR	[ASCIZ/
# Records ? /]
	PUSHJ	P,IN		;GET # OF RECORDS TO PROCESS
	TLNE	F,DSW		;TAPE DUMP?
	JUMPLE	A,RDREC2	;YES , 0<= MEANS ALL OF TAPE
	JUMPG	A,RDREC1	;MUST BE POSITIVE
	OUTSTR	BADNEG		;COMPLAIN
	JRST	RDREC0		;AND TRY AGAIN
RDREC1:	MOVEM	A,NCNT		;STASH IN NCNT
RDREC2:	TLNN	F,DSW		;TAPE DUMP?
	JRST	LOOP		;NO
	MOVEI	A,PHD1		;PRINT 1ST HEADER
	PUSHJ	P,PSTRIN
	MOVE	A,BLKFAC	;PRINT BLOCKING FACTOR
	PUSHJ	P,PDEC
	MOVEI	A,PHD2
	PUSHJ	P,PSTRIN
	MOVE	A,RECSIZ	;PRINT RECORD SIZE
	PUSHJ	P,PDEC
	PUSHJ	P,PCRLFX
	MOVEI	A,PHD3		;RECORD HEADER
	PUSHJ	P,PSTRIN
	PUSHJ	P,PCRLFX
	MOVEI	A,^D45		;# OF LINES PER PAGE
	MOVEM	A,PAGCNT	;INIT COUNTER
	MOVEI	A,^D100		;# OF CHARACTERS PER LINE
	MOVEM	A,LINCNT	;INIT COUNTER
	SETZM	RECS		;SET RECORD COUNTER
	SETOM	CNTFLG		;FORCE FIRST LABEL
	TLNN	F,OSW		;OCTAL DUMP?
	JRST	LOOP		;NO
	MOVE	OPNT,NOPNT	;POINTER TO OCBUF
	SUBTTL	FILE READ AND CONVERT
LOOP:	TLNN	F,NSW		;IS NSW SET
	JRST	LOOP1		;NO
	CAMGE	RCNT,NCNT	;IS RECORD-COUNT => # REQUESTED
	JRST	LOOP1		;NO, KEEP ON TRUCKIN'
	OUTSTR	[BYTE (7)15,12]
	MOVE	A,NCNT		;GET THE NUMBER
	PUSHJ	P,DECPRT	;PRINT IT
	OUTSTR	[ASCIZ/ records processed.
/]
	TLNN	F,DSW		;TAPE DUMP?
	JRST	CLOSIT		;NO
	SOSL	PAGCNT		;YES, DECRIMENT COUNTER, PAGE FULL?
	PUSHJ	P,PTAIL1	;YES, LAST PAGE
CLOSIT:	CLOSE	OCH,0
	GETSTS	ICH,A		;GET TAPE STATUS,MODE,ETC.
	ANDI	A,617		;RETAIN DENSITY,MODE
	SETSTS	ICH,(A)		;CLEAR OTHER BITS
	JRST	ASKNAM		;DO IT AGAIN
LOOP1:	MOVE	CNT,RECSIZ	;SET UP CHAR COUNT
LOOP1A:	PUSHJ	P,GETCHR	;GET A CHAR
	JUMPL	F,CNVRT		;JUST MOVE WORD IF DUMPING
	TLNE	F,OSW		;OCTAL DUMP?
	IDPB	MATCH,OPNT	;YES, STORE A BYTE
	CAMG	MATCH,CNVMAX	;MAKE SURE VALID CHARACTER
	JUMPGE	MATCH,CNVRT	;IT IS LEGAL IF POSITIVE. GO AHEAD
	SKIPG	ILLCNT		;FIRST ILLEGAL CHARACTER?
	OUTSTR	ILLCHR		;YES. SAY SO
	MOVEI	CHR,"\"		;CHARACTER FOR ILLEGALS
	AOSA	ILLCNT		;COUNT ILLEGAL CHARACTERS
CNVRT:	0			;TO BE FILLED BY PROPER TRANSLATER INSTRUCTION
	TLNN	F,DSW		;TAPE DUMP?
	JRST	OUTPIT		;NO
	MOVE	A,LINCNT	;GET LINE SIZE
	CAIN	A,^D100		;BEGINING OF LINE?
	PUSHJ	P,RECNUM	;YES, GET PROPER MARGIN SPACING
	CAIGE	CHR,40		;PRINTABLE CHARACTER?
	MOVEI	CHR,"\"		;NO, SUBSTITUTE BACKSLASH
OUTPIT:	PUSHJ	P,PUTCHR	;PUT A CHAR
	TLNN	F,DSW		;TAPE DUMP?
	JRST	RWLUP		;NO
	SOSG	LINCNT		;DECRIMENT CHARACTER COUNTER, LINE FULL?
	PUSHJ	P,LINBRK	;YES
RWLUP:	SOJG	CNT,LOOP1A	;IF NOT DONE WITH RECORD JUMP BACK
CRLF:	AOJ	RCNT,		;ADD 1 TO RECORD COUNT
	JUMPL	F,LOOP		;DONT IF DUMP MODE
	PUSHJ	P,PCRLFX	;PUT OUT CRLF
	TLNE	F,OSW		;OCTAL DUMP?
	PUSHJ	P,OCDUMP	;YES
	TLNN	F,DSW		;DUMP TAPE?
	JRST	LBFILL		;NO
	SETOM	CNTFLG		;START NEXT LINE WITH "RECORD #"
	MOVEI	A,^D100		;START COUNTING NEW LINE
	MOVEM	A,LINCNT
	SOSG	PAGCNT		;INRC. COUNTER, PAGE FULL?
	PUSHJ	P,PTAIL		;YES
LBFILL:	TLNN	F,ASW		;IS IT LINE-BLOCKED (/A)
	JRST	LOOP		;NO, DO ANOTHER RECORD
	SETZ	CHR,		;YES, DO FILLERS
	MOVSI	A,760000	;MASK TO TEST POINTER
LBFIL1:	TDNN	A,OB+1		;ALREADY EXACT WORD?
	 JRST	LBFIL2		;YES.
	PUSHJ	P,PUTCHR	;NO. NULL FILL
	JRST	LBFIL1		;UNTIL WORD FULL
LBFIL2:	TRNN	F,UNBLKD	;UNBLOCKED TAPE?
	 JRST	LOOP		;YES. GETNEW WILL CHECK FOR FIT
	MOVE	A,OB+2		;NO. WILL ANOTHER RECORD FIT?
	CAMGE	A,ARECSZ	;...?
CRLFX:	SETZM	OB+2		;NO. MAKE PUTCHR USE NEXT BUFFER
	JRST	LOOP
	SUBTTL	I/O SUBROUTINES

GETSML:	MOVE	CNT,IBUF+2	;HERE IF SINGLE BLOCKED SHORT RECORDS
	JUMPL	F,GETCHR	;NOT LINE BLOCKED IF DUMP
	TLNN	F,ASW		;LINE BLOCKING?
	 JRST	GETCHR		;NO. GO AHEAD
	MOVEI	A,2(CNT)	;GET LINE SIZE
	CAMLE	A,OB+2		;WILL IT FIT?
	SETZM	OB+2		;NO. DO BEST CAN
GETCHR:	SOSGE	IBUF+2		;ANY MORE CHARACTERS?
	 JRST	GETNEW		;NO. GET A BUFFER
	ILDB	MATCH,IBUF+1	;YES GET IT AND GET BACK
	POPJ	P,0
GETNEW:	TRNE	F,DINFLG	;DOING DUMP MODE INPUT?
	 JRST	GETNWD		;YES. DIFFERENT
	IN	ICH,		;NOW INPUT
	JRST	GETNWA		;OK
	 JRST	CHKSTA		;ERROR?, FIND OUT WHY
GETNWD:	IN	ICH,DIOWD	;DO THE DUMP MODE INPUT
	 JRST	.+2		;OK. CALC BUFFER SIZE
	  JRST	CHKSTA		;ERROR?, FIND OUT WHY
GTNWD0:	MOVEI	A,ICH		;FIND RECORD SIZE IN MONITOR
	MTCHR.	A,		;...
	 HRLZ	A,BUFSIZ	;WON'T TELL. ASSUME OK
	HLRZ	CHR,A		;GET WORD COUNT
	JUMPL	F,GTNWD2	;DUMP OUTPUT?
	IMULI	CHR,4		;NO. CHARACTERS
	LDB	A,[POINT 3,A,29];GET CHARACTERS IN LAST WORD
	CAIGE	A,4		;BEWARE PRE-603 BUG
	 JRST	GTNWD1		;OK
	TRCE	A,5		;FIX UP BUG
	TRCE	A,5
	TRC	A,5
GTNWD1:	ADD	A,CHR		;GET TOTAL CHARACTERS
	MOVEM	A,IBUF+2	;STORE
	MOVE	A,[POINT 8,BUF1+1,35]
	MOVEM	A,IBUF+1	;SIMULATE BUFFERED MODE
	JRST	GETNWA		;CONTINUE
GTNWD2:	TRNE	A,7B29		;ANY CHARS IN LAST WORD?
	ADDI	CHR,1		;YES. ADD ONE TO WORDS
	MOVEM	CHR,IBUF+2	;STORE WORDS
	MOVE	A,[POINT 36,BUF1+1,35]
	MOVEM	A,IBUF+1	;SIMULATE BUFFERED MODE
GETNWA:	AOS	PHYCNT		;ONE MORE PHYSICAL RECORD
	SKIPE	SHORT#		;WAS LAST RECORD SHORT?
	 JRST	SHORTR		;YES. SHOULD HAVE GOTTEN EOF
GETNW1:	JUMPL	F,GTNW1B	;SKIP SOME IF DUMP
	TRNN	F,SNGBUF	;SINGLE BUFFERED?
	 JRST	GTNW1B		;NO. MTCHR. WOULD TELL ABOUT WRONG BUFFER
	MOVEI	A,ICH		;GET ACTUAL CHARACTER COUNT FROM TAPSER
	MTCHR.	A,		;IF POSSIBLE
	 JRST	GTNW1B		;OH WELL
	HLRZ	CHR,A		;GET WORD COUNT
	IMULI	CHR,4		;MAKE CHARACTERS
	LDB	A,[POINT 3,A,29];CHARACTERS IN FINAL WORD
	CAIGE	A,4		;BEWARE PRE 603 MONITOR BUG
	 JRST	GTNW1A		;OK. GO AHEAD
	TRCE	A,5		;FIX MONITR BUG
	TRCE	A,5
	TRC	A,5
GTNW1A:	ADD	A,CHR		;TOTAL CHARACTERS
	MOVEM	A,IBUF+2	;STORE AS BUFFER COUNT
GTNW1B:	MOVE	A,IBUF+2	;GET NUMBER OF CHARACTERS
	CAMN	A,BUFN		;CORRECT NUMBER OF CHARACTERS?
	 JRST	GETCHR		;YES. OK
	JUMPL	F,GETNW0	;SKIP SOME IF DUMP
	ADDI	A,3		;ROUND
	ASH	A,-2		;NUMBER OF WORDS
GETNW0:	CAMN	A,BUFSIZ	;PROPER NUMBER?
	 JRST	GETNW2		;YES. SET NUMBER OF CHARACTERS
	CAML	A,BUFSIZ	;SHORT RECORD?
	 JRST	LNGERR		;NO. MODERATELY LONG
	TRNE	F,UNBLKD	;UNBLOCKED TAPE?
	 JRST	GETSML		;YES. SUPPORT VARIABLE LENGTH RECORDS,
				;AND RECORD .LT. SPECIFIED WITHOUT COMPLAINT
	MOVE	A,IBUF+2	;CALCULATE NUMBER OF CHARACTERS CAN PROCESS
	MOVEM	A,LASBLK#	;REMEMBER SIZE OF LAST BUFFER
	JUMPL	F,[		;USE WHAT IS THERE IF DUMPING
		   SETOM SHORT	;SET SHORT FLAG
		   JRST	GETSML	;AND USE ACTUAL RECORD SIZE
		]
	IDIV	A,RECSIZ
	CAIG	A,0		;ANY RECORDS AT ALL?
	MOVEI	A,1		;STRANGE. MUST BE ONE.
	IMUL	A,RECSIZ
	SETOM	SHORT#		;SET SHORT RECORD FLAG
	JRST	GETNW3
GETNW2:	MOVE	A,BUFN		;SET BUFFER COUNT TO RECORD LENGTH
GETNW3:	MOVEM	A,IBUF+2
	JRST	GETCHR		;AND GO RETURN A CHARACTER
OCDUMP:	MOVE	A,PAGCNT
	CAIGE	A,5		;ROOM FOR 3 LINES OF OCTAL?
	PUSHJ	P,PTAIL		;NO
	MOVEI	5,3		;3 ROWS OF OCTAL DIGITS
	MOVE	D,[POINT 3,A,26]	;FOR SPLITTING 3 DIGIT #S
OC1:	MOVEI	A,PHD4		;MARGIN SPACING
	PUSHJ	P,PSTRIN
	MOVEI	C,^D100		;MAX LINE LENGTH
	SUB	C,LINCNT	;C IS # OF A IN LINE
	MOVE	OPNT,NOPNT	;POINTER TO LINE
	IBP	D		;SET FOR DESIRED A
OC2:	SOJL	C,OC3
	ILDB	A,OPNT		;GET #(3DIGITS)
	LDB	CHR,D		;GET DESIRED SINGLE DIGIT
	ADDI	CHR,"0"		;MAKE IT ASCII
	PUSHJ	P,PUTCHR	;OUTPUT IT
	JRST	OC2
OC3:	PUSHJ	P,PCRLFX	;PUT OUT CRLF
	SOS	PAGCNT
	SOJG	5,OC1		;DIGITS PER LINE
	PUSHJ	P,PCRLFX	;PUT OUT CRLF
	SOS	PAGCNT
	PUSHJ	P,PCRLFX	;PUT OUT CRLF
	SOSG	PAGCNT
	PUSHJ	P,PTAIL
	MOVE	OPNT,NOPNT	;RESET BYTE POINTER
	POPJ	P,
CHKSTA:	STATO	ICH,20000	;IS IT EOF
	 JRST	DERR		;NO SOME ERROR
	SKIPE	SMLCNT		;ANY SHORT RECORDS?
	SKIPN	SHORT		;YES. IS THIS ONE?
	 JRST	.+2		;NO. OK
	AOS	SMLCNT		;YES. COUNT THIS ONE
	SETZM	SHORT
	TLNN	F,DSW		;DUMP TAPE?
	JRST	CLOSIU		;NO
	SOSL	PAGCNT		;YES,INCR. PAGCNT, PAGE FULL?
	PUSHJ	P,PTAIL1	;YES, LAST PAGE
CLOSIU:	CLOSE	ICH,0
	CLOSE	OCH,0		;YES, TELL USER AND GET OUT
	OUTSTR	LIT5
	JUMPG	RCNT,CHKST1	;WERE ANY RECORDS PROCESSED
	OUTSTR	NORECS		;NO TELL USER
	JRST	CHKST3		;AND GO TO NEXT FILE
CHKST1:	OUTSTR	[BYTE (7)15,12]	;START NEW LINE
	MOVE	A,RCNT		;GET NUMBER OF RECORDS PROCESSED
	PUSHJ	P,DECPRT	;PRINT THE NUMBER
	OUTSTR	RECPRC		;AND ASSOCIATED MESSAGE
	SKIPG	A,LNGCNT	;ANY OVERSIZE RECORDS?
	 JRST	CHKST2		;NO
	CAME	A,PHYCNT	;ONLY PRINT NUMBER IF DIFFERENT
	PUSHJ	P,DECPRT	;PRINT NUMBER
	MOVE	A,LNGCNT
	CAMN	A,PHYCNT	;PRINT "ALL" IF SAME
	OUTSTR	[ASCIZ/All/]	;ALL
	OUTSTR	OVRSIZ		;AND ASSOCIATED MESSAGE
CHKST2:	SKIPG	A,SMLCNT	;GET COUNT OF SHORT RECORDS
	JRST	CHKST3		;NONE
	CAME	A,PHYCNT	;ONLY PRINT NUMBER IF DIFFERENT
	PUSHJ	P,DECPRT	;PRINT THE COUNT
	MOVE	A,SMLCNT
	CAMN	A,PHYCNT	;PRINT "ALL" IF SAME
	OUTSTR	[ASCIZ/All/]
	OUTSTR	SMLSIZ		;AND ASSOCIATED MESSAGE
CHKST3:	SKIPG	A,ILLCNT	;GET COUNT OF ILLEGAL CHARACTERS
	 JRST	CHKST4		;NONE
	PUSHJ	P,DECPRT	;PRINT THE COUNT
	OUTSTR	TOTILL		;AND ASSOCIATED MESSAGE
CHKST4:	POP	P,(P)		;RESTORE LIST
	PUSHJ	P,TINIT
	JRST	ASKNAM
LNGERR:	SKIPE	LNGCNT		;FIRST LONG RECORD?
	JRST	LNGER3		;NO
	JUMPG	RCNT,LNGER1	;YES. FIRST RECORD?
	OUTSTR	FRTOBG		;YES. TELL ABOUT ERROR
	JRST	LNGER2		;GO AHEAD
LNGER1:	OUTSTR	TOOBIG		;TELL ABOUT BIG RECORD
LNGER2:	OUTSTR	CHGBLK		;WANT TO CHANGE BLOCKING?
	PUSHJ	P,YESNO		;???
	 JRST	ASKBLK		;YES. DO IT
LNGER3:	AOS	LNGCNT		;COUNT LONG RECORDS
	STATO	ICH,40000	;BLOCK TOO LARGE ERROR?
	 JRST	LNGER4		;NO. MINOR OVERFLOW
	GETSTS	ICH,A		;CLEAR BLOCK TOO LARGE
	TRZ	A,40000		;...
	TRO	A,100		;SKIP ERROR RETRY
	SETSTS	ICH,(A)		;SET STATUS BACK
LNGER4:	JRST	GETNW2		;GO AHEAD (SET NUMBER OF CHARACTERS)

SHORTR:	SETZM	SHORT		;FORGET THAT PREVIOUS RECORD WAS SHORT
	SKIPE	SMLCNT#		;FIRST SHORT RECORD?
	JRST	SHORT3		;NO
	CAML	RCNT,BLKFAC	;ON FIRST RECORD?
	JRST	SHORT1		;NO.
	OUTSTR	FRTOSM		;YES. TELL ABOUT ERROR
	JRST	SHORT2		;GO AHEAD
SHORT1:	OUTSTR	TOOSML		;TELL ABOUT SMALL RECORD
SHORT2:	OUTSTR	ACTBLK		;ACTUAL BLOCK SIZE IS
	MOVE	A,LASBLK	;N CHARACTERS
	PUSHJ	P,DECPRT
	MOVEI	A,CHARS		;CHARACTERS
	JUMPGE	F,.+2		;DUMPING?
	MOVEI	A,WORDS		;YES. WORDS
	OUTSTR	(A)
	OUTSTR	CHGBLK		;WANT TO CHANGE BLOCKING?
	PUSHJ	P,YESNO		;???
	 JRST	ASKBLK		;YES. DO IT
SHORT3:	AOS	SMLCNT		;COUNT SHORT RECORDS
	JRST	GETNW1		;GO ON WITH RECORD
DERR:	STATZ	ICH,1B25	;PHYSICAL END OF TAPE?
	 JRST	FNDEOT		;YES
	STATZ	ICH,700000	;ANY REAL ERRORS?
	 JRST	DERR1		;YES. DON'T TREAT AS LONG RECORD
	STATZ	ICH,40000	;BLOCK TOO LARGE?
	 JRST	LNGERR		;YES
DERR1:	TLNE	F,IGNORE	;IGNORE ERRORS?
	JRST	RESETS		;YES
	OUTSTR	LIT7A		;TELL ABOUT ERROR
	GETSTS	ICH,A		;GET STATUS
	PUSHJ	P,OCTPRT	;AND PRINT THAT TOO
	OUTSTR	LIT7B		;ASK ABOUT SKIPPING BLOCK
	PUSHJ	P,GETLIN
	ILDB	A,LINPNT
	CAIN	A,"C"		;IS IT A C
	JRST	RESETS		;YES
	CAIE	A,"I"		;IS IT AN I
	EXIT			;NO, EXIT
	TLO	F,IGNORE
RESETS:	GETSTS	ICH,A		;YES, SET STATUS BACK AND CONTINUE
	TRZ	A,700000
	TLNE	F,IGNORE	;IF IGNORE ERROR FLAG ON
	TRO	A,100		;SET IONRCK
	SETSTS	ICH,(A)
	STATZ	ICH,40000	;ALSO BLOCK TO LARGE?
	JRST	LNGERR		;YES. GIVE THAT ERROR TOO
	TRNE	F,DINFLG	;DUMP INPUT ?
	 JRST	GTNWD0		;YES
	  JRST	GETNWA		;NO

FNDEOT:	OUTSTR	ATEOT		;SAY AT END OF TAPE
	EXIT			;EXIT

PUTCHR:	SOSG	OB+2		;STANDARD DEC OUTPUT PROCEDURE
	JRST	PUTBUF
PUTNXT:	IDPB	CHR,OB+1
	POPJ	P,0
PUTBUF:	OUT	OCH,0
	JRST	PUTNXT
	 OUTSTR	LIT8		;TELL USER ABOUT ERROR ON OUTPUT
	GETSTS	OCH,A		;GET THE STATUS BITS
	PUSHJ	P,OCTPRT	;TELL HIM ABOUT THEM
	OUTSTR	[BYTE (7) ")",15,12]
	EXIT
PSTRIN:	MOVE	B,[POINT 7,(A)]	;POINTER TO SUBJECT STRING
PSTRI1:	ILDB	CHR,B		;GET CHR
	JUMPE	CHR,CPOPJ	;NUL?
	PUSHJ	P,PUTCHR	;NO, PRINT IT
	JRST	PSTRI1		;GO FOR ANOTHER

PDEC:	IDIVI	A,^D10		;BREAKING DOWN DEC. NUMBER FOR PRINTING
	PUSH	P,B		;STORE A+1
	CAIE	A,0		;MORE?
	PUSHJ	P,PDEC		;BREAK OFF ANOTHER DIGIT
	POP	P,CHR		;GET A DIGIT
	ADDI	CHR,"0"		;ASCII IT
	PUSHJ	P,PUTCHR	;PUBLISH IT
	POPJ	P,		;GET ANOTHER OR RETURN

PTAIL:	MOVEI	A,^D40		;# OF LINES PER PAGE
	MOVEM	A,PAGCNT	;SET COUNTER
	MOVEI	A,PHD3		;PAGE TRAILER
	PUSHJ	P,PSTRIN	;PRINT IT
	MOVEI	CHR,14		;FORM FEED
	PUSHJ	P,PUTCHR
PTAIL1:	MOVEI	A,PHD3		;PAGE HEADER
	PUSHJ	P,PSTRIN	;PUBLISH IT
PCRLFX:	MOVEI	CHR,15		;CR
	PUSHJ	P,PUTCHR
	MOVEI	CHR,12		;LF
	JRST	PUTCHR

LINBRK:	PUSHJ	P,PCRLFX	;PUT OUT CRLF
	SOSG	PAGCNT		;DECR. PAGE COUNTER, PAGE FULL?
	PUSHJ	P,PTAIL		;YES
	TLNE	F,OSW		;OCTAL DUMP?
	PUSHJ	P,OCDUMP	;YES
	MOVEI	A,^D100		;# OF CHR PER LINE
	MOVEM	A,LINCNT	;SET COUNTER
	POPJ	P,
RECNUM:	PUSH	P,CHR
	AOSE	CNTFLG		;SKIP IF AT RECORD START
	JRST	RECNU1		;NOT AT RECORD START
	MOVEI	A,PHD5		;RECORD # LABEL
	PUSHJ	P,PSTRIN
	AOS	RECS
	MOVE	A,RECS
	PUSHJ	P,PDEC		;PUBLISH # OF RECORDS
	MOVEI	CHR,11		;TAB
	PUSHJ	P,PUTCHR
	MOVEI	CHR,40		;SPACE
	PUSHJ	P,PUTCHR
CHPOPJ:	POP	P,CHR
	POPJ	P,
RECNU1:	MOVEI	A,PHD4		;MARGIN SPACING
	PUSHJ	P,PSTRIN
	JRST	CHPOPJ
		;THIS ROUTINE BUILDS A DECIMAL # FROM TTY:
IN:	SETZ	A,
	TLZ	F,NUM!NEGS	;CLEAR FLAGS
	PUSHJ	P,GETLIN
LOOPA:	ILDB	B,LINPNT
	JUMPE	B,ENDNUM
	CAIN	B,"-"
	JRST	[TLNN	F,PLUS!NUM	;ALREADY GOT PART OF NUMBER?
		 TLOE	F,NEGS	;SET FLAG AND ERROR IF TWICE
		 JRST	ERRORB	;GIVE ERROR. BAD ORDER
		 JRST	LOOPA ]
	CAIN	B,"+"		;PLUS SIGN TYPED?
	JRST	[TLNE	F,NEGS!NUM	;ALREADY GOT PART OF NUMBER?
		 TLOE	F,PLUS	;SAY PLUS SEEN AND ERROR IF TWICE
		 JRST	ERRORB	;ERROR
		 JRST	LOOPA ]
	CAIL	B,"0"
	CAILE	B,"9"
	JRST	ERRORB
	TLO	F,NUM		;NUMBER SEEN
	IMULI	A,^D10
	ADDI	A,-60(B)
	JRST	LOOPA
ENDNUM:	TLNE	F,NEGS		;NEGATIVE?
	MOVN	A,A		;YES. CHANGE SIGN
	TLNE	F,NUM		;ANY NUMBER TYPED
	POPJ	P,
ERRORB:	OUTSTR	[ASCIZ\
?BCDBNT Bad number. Try again!
\]
	CLRBFI
	JRST	IN
		;THIS ROUTINE GATHERS A LINE IN FROM TTY:
		;SUPPRESSING ALL BLANKS AND FINISHING WITH A NULL
GETLIN:	MOVE	LINPNT,[POINT 7,LIN]
GETC:	INCHWL	B
	CAIE	B," "
	CAIN	B,15
	JRST	GETC		;THROW AWAY <CR> AND SPACES
	CAIN	B,177		;RUBOUT?
	JRST	GETC		;IGNORE
	CAIL	B,140		;LOWER CASE?
	SUBI	B,40		;YES. MAKE IT UPPER
	CAIN	B,32		;CONTROL-Z?
	EXIT			;YES. JUST EXIT
	CAIE	B,33		;ALTMODE?
	CAIN	B,12		;OR LINE FEED?
	JRST	ENDLIN
	IDPB	B,LINPNT
	JRST	GETC
ENDLIN:	SETZ	B,
	IDPB	B,LINPNT
	MOVE	LINPNT,[POINT 7,LIN]
	POPJ	P,

REWIND:	MTREW.	ICH,		;REWIND TAPE
	JRST	MTWAIT		;WAIT AND INVALIDATE BUFFERS

BACKSP:	MTBSF.	ICH,		;BACKSPACE TAPE
	JRST	MTWAIT		;WAIT AND INVALIDATE BUFFERS

SKIPFL:	MTSKF.	ICH,		;SKIP FILE
MTWAIT:	MTWAT.	ICH,
	PUSH	P,A		;SAVE COUNT
	PUSHJ	P,NEWBUF	;AND INVALIDATE BUFFERS
	POP	P,A		;RESTORE COUNT
	POPJ	P,		;RETURN
TINIT:	MOVSI	B,'BCD'		;OPEN DEVICE BCD
	MOVEI	C,IBUF		;FOR INPUT
	MOVEI	A,14		;IN BINARY MODE
	TRNE	F,DINFLG	;DUMP FLAG?
	MOVEI	A,17		;YES. USE DUMP MODE
	SKIPN	TAPDEN		;TAPOPS?
	TRO	A,<.TFD80>B28	;NO. 800 IN OPEN
	OPEN	ICH,A		;DO OPEN
	 JRST	NTAVL
	MTIND.	ICH,		;INDUSTRY COMPATIBLE
	SKIPG	A,TAPDEN	;TAPOPS?
	 JRST	NEWBUF		;NO. DONE
	MOVEM	A,TAPBLK+2	;YES. SET DENSITY
	MOVEI	A,ICH		;SET UP TAPOP.
	MOVEM	A,TAPBLK+1
	MOVEI	A,.TFDEN+1000
	MOVEM	A,TAPBLK
	MOVE	A,[XWD 3,TAPBLK]
	TAPOP.	A,
	 JRST	ERRDEN		;OOPS?
NEWBUF:	MOVE	A,[XWD 400000,BUF1+1]	;SET UP BUFFER RING
	MOVEM	A,IBUF
	MOVE	A,[POINT 8,0,35]
	TLNE	F,DMPFLG		;DUMP TYPE?
	MOVE	A,[POINT 36,0,35]
	MOVEM	A,IBUF+1
	MOVE	A,MBUFN		;GET NUMBER OF BUFFERS
	MOVE	B,BUFWDS	;GET WORDS PER BUFFER
	SUBI	B,2		;DATA WORDS PLUS ONE
	HRLZ	B,B		;IN LEFT
	HRR	B,BUFWDS	;POINT RH AT NEXT
	ADDI	B,BUF1+1	;...
	MOVEI	C,BUF1		;POINT C AT FIRST BUFFER
NEWBF1:	SETZM	(C)		;CLEAR FIRST WORD
	MOVEM	B,1(C)		;SET SECOND WORD
	SOJLE	A,NEWBF2	;IF LAST BUFFER, DON'T INCREMENT
	ADD	B,BUFWDS	;MOVE TO NEXT BUFFER
	ADD	C,BUFWDS	;...
	JRST	NEWBF1		;SET NEXT BUFFER
NEWBF2:	MOVEI	B,BUF1+1	;MAKE LAST BUFFER POINT TO FIRST
	HRRM	B,1(C)		;...
	POPJ	P,
; SUBROUTINE TO SNOOP OUT SIZE OF BLOCK
WHTSIZ:	MOVSI	B,'BCD'		;OPEN DEVICE BCD
	MOVEI	C,IBUF		;FOR INPUT
	MOVEI	A,117		;USE DUMP MODE/NO ERROR RETRY
	SKIPN	TAPDEN		;TAPOPS?
	TRO	A,<.TFD80>B28	;NO. 800 IN OPEN
	OPEN	ICH,A		;DO OPEN
	 JRST	NTAVL
	MTIND.	ICH,		;INDUSTRY COMPATIBLE
	SKIPG	A,TAPDEN	;TAPOPS?
	 JRST	WHTSZI		;NO. DONE
	MOVEM	A,TAPBLK+2	;YES. SET DENSITY
	MOVEI	A,ICH		;SET UP TAPOP.
	MOVEM	A,TAPBLK+1
	MOVEI	A,.TFDEN+1000
	MOVEM	A,TAPBLK
	MOVE	A,[XWD 3,TAPBLK]
	TAPOP.	A,
	 JRST	ERRDEN		;OOPS?
WHTSZI:	MOVEI	A,3*^D1024	;ASSUME UNDER THREE K
WHTSZ0:	MOVE	B,A
	ADDI	B,BUF1+3	;GET ENOUGH CORE
	CAMG	B,.JBREL##
	 JRST	WHTSZ1		;GO IT
	CORE	B,
	 JRST	WHTSZE		;CAN'T. OH WELL
WHTSZ1:	MOVN	B,A		;SET IOWD
	HRLM	B,DIOWD
	SETOM	BUF1+3		;MAKE BUFFER -1 INCASE NO MTCHR.
	MOVE	B,[XWD BUF1+3,BUF1+4]
	BLT	B,BUF1+2(A)
	IN	ICH,DIOWD	;GET THE BUFFER
	 JRST	WHTSZ2		;OK
	GETSTS	ICH,B		;GET ERROR STATUS
	MTBSR.	ICH,		;BACK UP
	MTWAT.	ICH,		;WAIT FOR IT
	TRNE	B,40000		;BLOCK TOO LARGE?
	TRNE	B,722000	;MAYBE. HOW ABOUT EOT, EOF, ERRORS?
	 JRST	WHTSZE		;GIVE ERROR.
	JRST	WHSZM2		;JUST BLOCK TOO LARGE. TRY LARGER BUFFER
WHTSZ2:	MTBSR.	ICH,		;BACK OVER RECORD
	MTWAT.	ICH,		;WAIT FOR IT
	MOVEI	B,ICH		;GET CHARACTER COUNT FROM MONITOR
	MTCHR.	B,
	 JRST	WHTSZM		;DO IT THE HARD WAY
	HLRZ	C,B
	TRNE	B,7B29		;ANY CHARACTERS OVER?
	ADDI	C,1		;YES. COUNT
	CAMGE	C,A		;DID WE HAVE ENOUGH CORE TO READ THAT?
	 JRST	WHTSZ3		;YES. KNOW SIZE
WHSZM2:	ADDI	A,^D1024	;DON'T KNOW FOR SURE YET
	JRST	WHTSZ0		;TRY A LARGER BUFFER
WHTSZ3:	HLRZ	A,B		;NOW CALCULATE REAL CHARACTER COUNT
	IMULI	A,4		;NOT WORD COUNT
	LDB	B,[POINT 3,B,29];EXTRA CHARACTERS
	CAIGE	B,4		;BEWARE PRE 603 BUG
	 JRST	WHTSZ4		;OK
	TRCE	B,5
	TRCE	B,5
	TRC	B,5
WHTSZ4:	ADD	A,B
WHTSZ5:	OUTSTR	[ASCIZ/The length of the current record is /]
	PUSHJ	P,DECPRT	;N
	OUTSTR	CHARS		;CHARACTERS
WHTSZR:	RELEAS	ICH,
	MOVEI	A,BUF1
	CORE	A,		;SHRINK CORE
	 JFCL			;DON'T CARE
	JRST	ASKBLK
WHTSZE:	OUTSTR	[ASCIZ/?BCDCDS Cannot determine size of current record.
/]
	JRST	WHTSZR		;RETURN
WHTSZM:	MOVNI	B,1		;SEE WHICH WORDS GOT READ
	MOVE	C,A		;WORDS TO LOOK AT
	CAME	B,BUF1+2(C)	;MATCH?
	 JRST	WHSZM1		;NO. FOUND DATA
	SOJG	C,.-2		;KEEP LOOKING
	SETZ	A,		;ZERO LENGTH BUFFER?
	JRST	WHTSZ5		;SAY SO
WHSZM1:	CAMN	A,C		;FILLED WHOLE BLOCK?
	 JRST	WHSZM2		;YES. TRY A BIGGER ONE
	MOVE	A,C		;NO. CALCULATE APPROXIMATE CHARACTERS
	IMULI	A,4
	JRST	WHTSZ5		;AND PRINT IT
DECPRT:	JUMPGE	A,DECPRL	;POSITIVE NUMBER?
	OUTCHR	["-"]		;NO. PRINT - SIGN
	MOVM	A,A
DECPRL:	IDIVI	A,^D10		;GET A DIGIT
	HRLM	B,(P)		;STORE IT
	JUMPE	A,.+2		;NUMBER GONE TO ZERO?
	PUSHJ	P,DECPRL	;NO. GET ANOTHER
RADPR1:	HLRZ	A,(P)		;GET FIRST DIGIT TO PRINT
	ADDI	A,"0"		;CONVERT TO ASCII
	OUTCHR	A		;PRINT IT
	POPJ	P,		;RETURN

OCTPRT:	SETZ	B,		;CLEAR WORD TWO
	LSHC	A,-3		;GET DIGIT
	ROT	B,3		;RIGHT JUSTIFIED
	HRLM	B,(P)		;STORE IT
	JUMPE	A,RADPR1	;GONE TO ZERO?
	PUSHJ	P,OCTPRT	;GET NEXT DIGIT
	JRST	RADPR1		;PRINT THE DIGIT

ASKYN:	OUTSTR	YORN		;INSIST ON PROPER RESPONSE
YESNO:	PUSHJ	P,GETLIN	;GET A LINE
	ILDB	B,LINPNT	;GET FIRST CHARACTER
	JUMPE	B,CPOPJ1	;CARRIAGE RETURN IS NO
	CAIE	B,"Y"		;OTHERWISE, MUST BE Y
	CAIN	B,"N"		;OR N
	 CAIA			;FINE
	JRST	ASKYN		;NEITHER
	CAIE	B,"Y"		;NOW DECIDE WHICH
CPOPJ1:	AOS	(P)		;NO
CPOPJ:	POPJ	P,		;YES
		;THIS ROUTINE READS A FILE SPECIFICATION FROM
		;THE TELETYPE INCLUDING SWITCHES IF NOSWTH=0
GTSPEC:	SETZM	NAME
	SETZM	DEV
	SETZB	D,EXT
	SETZM	EXT+1
	SETZM	EXT+2
	PUSHJ	P,GETLIN
LOOPB1:	MOVEI	A,6
	MOVE	C,[POINT 6,BUF1]
	SETZM	BUF1
	SKIPE	DEV		;HAVE WE ALREADY GOT DEVICE
	JRST	GETNAM		;YES, DONT DO NEXT
	ILDB	B,LINPNT	;GET FIRST CHARACTER
	JUMPN	B,GTNAM1	;CHECK FOR NUL INPUT
	EXIT			;YES, EXIT
GETNAM:	ILDB	B,LINPNT	;GET A CHARACTER
GTNAM1:	CAIN	B,":"		;IS IT A COLON
	JRST	GOTDEV		;YES WE GOT A DEVICE
	CAIN	B,"/"		;IS IT A SLASH
	JRST	GOTSW		;YES, MUST BE A SWITCH
	SKIPE	B		;NULL IS EOL CHAR
	CAIN	B,"."		;STARTING EXT?
	JRST	GOTFIL		;YES
	CAIL	B,"0"
	CAILE	B,"Z"		;CHECK LEGAL NAME
	JRST	BADNAM
	CAILE	B,"9"
	CAIL	B,"A"
	JRST	.+2
	JRST	BADNAM
	JUMPLE	A,GETNAM	;SKIP IF ALREADY GOT LEGAL NUMBER
	TRC	B,40
	IDPB	B,C		;NO, DEPOSIT IT
	SOJA	A,GETNAM
GOTDEV:	SKIPE	DEV		;DO WE HAVE A DEVICE ALREADY
	JRST	BADNAM		;YES, KILL
	MOVE	B,BUF1
	JUMPE	B,BADNAM	;INSIST ON VALID DEVICE
	MOVEM	B,DEV		;STASH DEVICE
	JRST	LOOPB1
GOTSW:	TRZE	F,NOSWTH	;SWITCHES ALLOWED?
	JRST	BADSW		;NO
	TLZ	F,SOMESW	;HAVEN'T SEEN THE SWITCH YET
	ILDB	B,LINPNT
	CAIN	B,"W"		;IS IT W
	TLO	F,WSW!SOMESW	;YES SET WSW
	CAIN	B,"A"		;IS IT A
	TLO	F,ASW!SOMESW	;YES SET ASW
	CAIN	B,"N"		;IS IT N
	TLO	F,NSW!SOMESW	;YES SET NCNT SWITCH
	CAIN	B,"P"		;IS IT A P
	TLO	F,PSW!SOMESW	;SET POSITION TAPE
	CAIN	B,"B"		;RESET BLOCKING FACTOR?
	TLO	F,BSW!SOMESW	;YES
	CAIN	B,"S"		;IS IT S
	TLO	F,SSW!SOMESW	;SET SSW
	CAIN	B,"D"		;IS IT A D
	TLO	F,DSW!NSW!SOMESW	;YES SET DSW AND NSW
	TLZN	F,SOMESW	;DID HE TYPE A VALID SWITCH?
	 JRST	BADSW		;NO
GOTSWX:	ILDB	B,LINPNT	;GET NEXT CHARACTER
	CAIN	B,"/"		;ANOTHER SWITCH?
	JRST	GOTSW		;YES. THAT'S OK
	JUMPN	B,BADNAM	;TO ENSURE HE DOESN'T EMBED THE SWITCH
	TLNE	F,PSW!BSW	;/P AND /B ARE ACTION SWITCHES. NO NAME NEEDED
	 POPJ	P,		;NO JUST RETURN
	JRST	GTNAM1
BADSW:	OUTSTR	BADSWM		;BAD SWITCH MESSAGE
	OUTCHR	B
	OUTSTR	BDSWM1		;REST OF BAD SWITCH MESSAGE
	JRST	GOTSWX		;EXIT SWITCH ROUTINE

GOTFIL:	SKIPN	B		;I CANT EXPLAIN HOW THIS ROUTINE WORKS
	SKIPN	NAME		;BUT IT DOES
	JRST	.+2
	JRST	ENDNAM
	SKIPE	NAME
	JRST	BADNAM
	MOVE	C,BUF1
	MOVEM	C,NAME
	SETZM	BUF1
	JUMPE	B,ENDNAM
	MOVEI	A,3
	MOVE	C,[POINT 6,EXT]
	JUMPN	D,BADNAM	;SECOND EXT ILLEGAL
	SOJA	D,GETNAM
ENDNAM:	SKIPN	B,DEV		;DO WE HAVE A DEVICE
	MOVSI	B,'DSK'		;NO, DEFAULT TO DSK
	MOVEM	B,DEV
	CAMN	B,[SIXBIT/NUL/]	;IS IT NUL: DEVICE?
	POPJ	P,		;YES, SKIP REST
	DEVCHR	B,
	TLNN	B,(1B15)	;DOES IT HAVE A DIRECTORY
	POPJ	P,		;NO
	SKIPN	NAME		;YES, DID WE GET ONE
	JRST	BADNAM		;NO, KILL
	POPJ	P,
		;THIS ROUTINE READS A SPECIAL CHARACTER SET
		;WITH SINGLE SPACES,COMMAS OR CRLFS AS SEPARATORS
SPCINS:	MOVEI	B,1		;ASCII LINE
	MOVE	C,DEV		;INPUT DEVICE
	MOVEI	D,SBF		;INPUT BUFFER
	OPEN	SCH,B
	JRST	[OUTSTR	[ASCIZ/
?BCDCID - Can't init DSK/]
		EXIT]
	LOOKUP	SCH,NAME
	JRST	[OUTSTR	[ASCIZ/
?BCDXNF - Special character set file not found/]
 		EXIT]
	SETZ	D,		;TABLE INDEX
SPCIN0:	PUSHJ	P,SNUMIN	;GET AN OCTAL NUMBER
	CAIL	C,0		;WAS A NUMBER ASSEMBLED?
	MOVEM	C,SPCTAB(D)	;YES - STORE IT
	TLZE	F,EOFSEN	;EOF?
	POPJ	P,		;YES
	CAMGE	D,A		;DATA SET TOO LARGE?
	JUMPL	C,SPCIN0	;DON'T INCR IF NO CHR ASSEMBLED
	AOJA	D,SPCIN0	;NO
	OUTSTR	[ASCIZ/
?BCDMCX - More character codes from file than specified
in dialogue/]
	EXIT

SNUMIN:	SETO	C,		;SET TO ZERO WHEN 1ST DIGIT ENCOUNTERED
SNUMI0:	SOSGE	SBF+2
	JRST	SNUMGT
SNUMI1:	ILDB	B,SBF+1
	JUMPE	B,SNUMI0	;NO NULLS
	CAIE	B," "		;BLANK?
	CAIN	B,","		;COMMA?
	POPJ	P,
	CAIN	B,15		;<CR>?
	JRST	SNUMI0		;YES
	CAIN	B,12		;<LF>
	POPJ	P,		;YES
	CAIL	B,"0"		;ILL CHR?
	CAILE	B,"7"		;ILL CHR?
	JRST	[OUTSTR	LIT12
		OUTCHR	B
		OUTSTR	[ASCIZ/)/]
		EXIT]
	SUBI	B,"0"		;NO - MAKE IT OCTAL DIGIT
	CAIGE	C,0		;SEEN ANY DIGITS PREVIOUSLY?
	SETZ	C,		;NO - START NUMBER ASSEMBLY
	IMULI	C,^D8
	ADD	C,B		;ASSEMBLE THE NUMBER
	JRST	SNUMI0
SNUMGT:	IN	SCH,
	JRST	SNUMI1
	STATZ	SCH,740000	;ERROR OR EOF?
	JRST	[OUTSTR	[ASCIZ/
?BCDEOX - Error on input from conversion table file/]
		EXIT]
	TLO	F,EOFSEN	;EOF
	POPJ	P,
	SUBTTL	ERROR AND OTHER MESSAGES

NOCORE:	OUTSTR	[ASCIZ/
? BCDICA Insufficient core available.  Cannot convert tape.
/]
	EXIT

BADNAM:	CLRBFI
	OUTSTR	[ASCIZ\
?BCDOSI Output specification is illegal! Try again.
\]
	JRST	ASKNAM		;TRY IT AGAIN

NOTAPE:	OUTSTR	[ASCIZ\
?BCDDBM Device BCD must be a magtape!
\]
	EXIT

NTAVL:	OUTSTR	LIT6
	EXIT

NODSK:	OUTSTR	LIT9
	EXIT

NOROOM:	OUTSTR	LIT10
	EXIT

CNVERR:	OUTSTR	LIT13
	CLRBFI
	JRST	GETCNV

DMPWRN:	TEXT <
 DUMP mode output is in the form of a binary file.
 To print the file use the /PRINT:OCTAL switch.
>

LIT0:	TEXT <
 Input code ? >
LIT1:	TEXT <
 Physical blocking factor ? >
LIT2:	TEXT <
 Logical record size ? >
LIT3:	TEXT <
 Rewind tape (Y or N) ? >
LIT4:	TEXT <
 Relative file position ? >
LIT5:	TEXT <
 End of file.
>
NORECS:	TEXT <
%BCDNRP No records processed.
>
LIT6:	TEXT <
?BCDDNA Device BCD is not available or not assigned.
>
LIT7A:	TEXT <
%BCDIDE Input data error (>
LIT7B:	TEXT <)
 Type C to continue, X to exit, I to ignore errors ? >
LIT8:	TEXT <
?BCDEOO Error on output (>
LIT9:	TEXT <
?BCDONA Output device is not available or not assigned.
>
LIT10:	TEXT <
?BCDNRF No room for file on output device.
>

LIT11:	TEXT <
 NUMBER OF CHARACTERS IN CHARACTER SET?(DECIMAL) >
LIT12:	TEXT <
?BCDICX - Illegal character in conversion table file(>
LIT13:	TEXT <
?BCDICC Invalid conversion code! Options are:
  EBCDIC, UCLABCD, BCDIC, ASCII, CDCBCD, GEBCD, DUMP, or SPECIAL.
SPECIAL requires file,  with each character represented
as an octal number, sepArated by spaces, commas or <CRLF>.
>

RECPRC:	TEXT < records were processed.
>
ILLCHR:	TEXT <
% BCDICE Illegal characters encountered. Being replaced by \
>
TOTILL:	TEXT < illegal characters were encountered.
>
BADNEG:	TEXT <?BCDNMP - Number must be positive.
>
ATEOT:	TEXT <
?BCDEOT End of tape encountered.
>
YORN:	TEXT < Please respond Y or N : >
BADSWM:	TEXT <%BCDURS Unrecognized switch ">
BDSWM1:	TEXT <" ignored
>
FRTOBG:	TEXT <
?BCDFRT First physical record too long - blocking factor and/or
	logical record size probably wrong
>
TOOBIG:	TEXT <
?BCDRTL Physical record too long.
>
OVRSIZ:	TEXT < physical records were longer than specified.
>
FRTOSM:	TEXT <
?BCDFRS First physical record too short - blocking factor and/or
	logical record size probably wrong
>
TOOSML:	TEXT <
?BCDRTS Physical record too short.
>
SMLSIZ:	TEXT < physical records were shorter than specified.
>
ILLDEN:	OUTSTR	[ASCIZ/?BCDIDS Illegal density specified.
/]
	JRST	GETDEN
BADDEN:	OUTSTR	[ASCIZ/?BCDDCR Drive cannot read at that density.
/]
	JRST	GETDEN
ERRDEN:	OUTSTR	[ASCIZ/?BCDSDF Set density failed.
/]
	EXIT
CHGBLK:	TEXT <
Do you want to change the blocking factor or logical record size? >
actblk:	TEXT <The actual physical block size is >
CHARS:	TEXT < characters.
>
WORDS:	TEXT < words.
>
PHD1:	TEXT <                                ASCII DUMP  ---   PHYSICAL BLOCKING FACTOR=>
PHD2:	TEXT <   LOGICAL RECORD SIZE=>
PHD3:	TEXT <
                 ----------------------------------------------------------------------------------------------------
                          1111111111222222222233333333334444444444555555555566666666667777777777888888888899999999990
                 1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
                 ----------------------------------------------------------------------------------------------------
>
PHD4:	TEXT <                 >
PHD5:	TEXT < RECORD >
	SUBTTL	EBCDIC CONVERSION

EBCTAB:							;OCTAL		DECIMAL
EXP 0,1,2,3,4,11,40,177,40,40,40,13,14,15		;0-15		0-13
EXP 16,17,20,21,22,40,40,40,10,40,30,31,40,40,40	;16-34		14-28
EXP 40,40,40,40,40,34,40,40,12,27,33,40			;35-50		29-40
EXP 40,40,40,40,5,6,7,40,40,26,40,40,36,40		;51-66		41-54
EXP 4,40,40,40,40,24,25,40,32,40,40,40,40,40		;67-104		55-68
EXP 40,40,40,40,40,"[",".","<","(","+","^","&",40,40,40	;105-123	69-83
EXP 40,40,40,40,40,40,"!","$","*",")",";","\","-","/"	;124-141	84-97
EXP 40,40,40,40,40,40,40,40,40,",","%","_",">","?"	;142-157	98-111
EXP 40,40,40,40,40,40,40,40,40,40,":","#","@","'"	;160-175	112-125
EXP "=",42,40,141,142,143,144,145,146,147,150,151	;176-211	126-137
EXP 40,40,40,40,40,40,40,152,153,154,155,156,157	;212-226	138-150
EXP 160,161,162,40,40,40,40,40,40,40,40,163,164		;227-243	151-163
EXP 165,166,167,170,171,172,40,40,40,40,40,40,40,40	;244-261	164-177
EXP 40,40,40,40,40,40,40,40,40,40,40,40,40,40,"?"	;262-300	178-192
EXP "A","B","C","D","E","F","G","H","I",40,40		;301-313	193-203
EXP 40,40,40,40,"!","J","K","L","M","N","O","P","Q","R"	;314-331	204-217
EXP 40,40,40,40,40,40,"]",40,"S","T","U","V","W","X","Y","Z" ;332-351	218-233
EXP 40,40,40,40,40,40,"0","1","2","3","4","5","6","7","8","9" ;352-371	234-249
EXP 40,40,40,40,40,40					;372-377	250-255
	SUBTTL	UCLABCD CONVERSION

UCLTAB:							;OCTAL		DECIMAL
EXP 0,1,2,3,4,11,40,177,40,40,40,13,14,15		;0-15		0-13
EXP 16,17,20,21,22,40,40,40,10,40,30,31,40,40,40	;16-34		14-28
EXP 40,40,40,40,40,34,40,40,12,27,33,40			;35-50		29-40
EXP 40,40,40,40,5,6,7,40,40,26,40,40,36,40		;51-66		41-54
EXP 4,40,40,40,40,24,25,40,32,40,40,40,40,40		;67-104		55-68
EXP 40,40,40,40,40,"[",".",")","(","+","^","+",40,40,40	;105-123	69-83
EXP 40,40,40,40,40,40,"!","$","*",")",";","\","-","/"	;124-141	84-97
EXP 40,40,40,40,40,40,40,40,40,",","(","_",">","?"	;142-157	98-111
EXP 40,40,40,40,40,40,40,40,40,40,":","=","'","'"	;160-175	112-125
EXP "=",42,40,141,142,143,144,145,146,147,150,151	;176-211	126-137
EXP 40,40,40,40,40,40,40,152,153,154,155,156,157	;212-226	138-150
EXP 160,161,162,40,40,40,40,40,40,40,40,163,164		;227-243	151-163
EXP 165,166,167,170,171,172,40,40,40,40,40,40,40,40	;244-261	164-177
EXP 40,40,40,40,40,40,40,40,40,40,40,40,40,40,"?"	;262-300	178-192
EXP "A","B","C","D","E","F","G","H","I",40,40		;301-313	193-203
EXP 40,40,40,40,"!","J","K","L","M","N","O","P","Q","R"	;314-331	204-217
EXP 40,40,40,40,40,40,"]",40,"S","T","U","V","W","X","Y","Z" ;332-351	218-233
EXP 40,40,40,40,40,40,"0","1","2","3","4","5","6","7","8","9" ;352-371	234-249
EXP 40,40,40,40,40,40					;372-377	250-255
	SUBTTL	GEBCD CONVERSION

;SYMBOLS NOT FOUND BELOW ^,\
GETAB:							;OCTAL	DECIMAL
	EXP "0","1","2","3","4","5","6","7","8","9"	;0-11	0-9
	EXP "\","#","@",":",">","?"," "			;12-20	10-16
	EXP "A","B","C","D","E","F","G","H","I"		;21-31	17-25
	EXP "&",".","\","(","<","\","\"			;32-40	26-32
	EXP "J","K","L","M","N","O","P","Q","R"		;41-51	33-41
	EXP "-","$","*",")",";","'","+","/"		;52-61	42-49
	EXP "S","T","U","V","W","X","Y","Z"		;62-71	50-57
	EXP "_",",","%","=",42,"!"			;72-77	58-63
	SUBTTL	BCD CONVERSION

BCDTAB:							;OCTAL	DECIMAL
	EXP 0,"1","2","3","4","5","6","7","8","9","0"	;0-12	0-10
	EXP "=","'",":",">",42," ","/"		;13-21	11-17
	EXP "S","T","U","V","W","X","Y","Z"		;22-31	18-25
	EXP "#",",","(","&","\","_","-"			;32-40	26-32
	EXP "J","K","L","M","N","O","P","Q","R"		;41-51	33-41
	EXP "!","$","*","]",";","@","+"			;52-60	42-48
	EXP "A","B","C","D","E","F","G","H","I"		;61-71	49-57
	EXP "?",".",")","[","<","%"			;72-77	58-63
	SUBTTL	CDCBCD CONVERSION

CDCTAB:							;OCTAL	DECIMAL
	EXP ":","1","2","3","4","5","6","7","8","9","0"	;0-12	0-10
	EXP "=","\","\","%","["," ","/"			;13-21	11-17
	EXP "S","T","U","V","W","X","Y","Z"		;22-31	18-25
	EXP "]",",","(","\","\","\","-"			;32-40	26-32
	EXP "J","K","L","M","N","O","P","Q","R"		;41-51	33-41
	EXP "\","$","*","^","\",">","+"			;52-60	42-48
	EXP "A","B","C","D","E","F","G","H","I"		;61-71	49-57
	EXP "<",".",")","\","\",";"			;72-77	58-63
	SUBTTL	DATA LOCATIONS

LIN:	BLOCK	20
PDL:	BLOCK	40
CNVTAB:	EXP "E","U","G","B","A","C","D","S"
CNVNUM==.-CNVTAB

CNVLST:	MOVE	CHR,EBCTAB(MATCH)	;EBCDIC TO ASCII
	MOVE	CHR,UCLTAB(MATCH)	;UCLABCD TO ASCII
	MOVE	CHR,GETAB(MATCH)	;GEBCD TO ASCII
	MOVE	CHR,BCDTAB(MATCH)	;BCD TO ASCII
	MOVE	CHR,MATCH		;ASCII TO ASCII
	MOVE	CHR,CDCTAB(MATCH)	;CDCBCD TO ASCII
	MOVE	CHR,MATCH		;BINARY TO BINARY
	MOVE	CHR,SPCTAB(MATCH)	;SPECIAL TO ASCII

CNVLIM:	DEC 255,255,63,63,127,63,255,0	;MAXIMUM LEGAL CHARACTER FOR CONVERSION TYPE

SPCTAB:	BLOCK	^D256

SBF:	BLOCK 3

OUTFIL:
NAME:	Z
EXT:	Z
	Z
	Z
DEV:	Z
NCNT:	0

DIOWD:	IOWD	0,BUF1+3	;DUMP I/O WORD
	0
IBUF:	BLOCK	3
OB:	BLOCK	3
BUFN:	Z
BUFSIZ:	Z
BLKFAC:	Z
RECSIZ:	Z
NOPNT:	POINT 9,OCBUF
OCBUF:	BLOCK ^D25

XLIST	;LIT XLISTED
LIT
LIST
VAR

BUF1:	Z
	END	START