Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap5_198111 - decus/20-0137/bcd/bcd.mac
There are 2 other files named bcd.mac in the archive. Click here to see a list.
00100	;THIS PROGRAM WAS WRITTEN AT WESTERN MICHIGAN UNIVERSITY
00200		TITLE BCD TAPE CONVERSION PROGRAM 
00300		SUBTTL	WESTERN MICHIGAN UNIVERSITY COMPUTER CENTER
00400	
00500		SEARCH	UUOSYM
00600	
00700		VBCD==03
00800		VEDIT==24
00900		VMINOR==00
01000		VWHO=4
01100	
01200		JOBVER=137
01300		LOC JOBVER
01400			BYTE	(3)VWHO(9)VBCD(6)VMINOR(18)VEDIT
01500		RELOC
01600	
01700		;ACCUMULATOR DEFINITIONS
01800	
01900		F=0		;FLAGS
02000		A=1
02100		B=2
02200		C=3
02300		D=4
02400		OPNT=6
02500		CNT=7
02600		LINPNT=10
02700		CHR=11
02800		RCNT=14
02900		MATCH=15
03000		P=17
03100	
03200		; I/O CHANNELS
03300		ICH==16
03400		OCH==17
03500		SCH==15
03600	
03700		DEFINE TEXT (A),<
03800		XLIST
03900		ASCIZ@A@
04000		LIST
04100	>
     
00100		;LH FLAG BITS
00200	DMPFLG==400000		;DUMP MODE FLAG - MUST BE SIGN BIT
00300	IGNORE==200000		;IGNORE ERROR FLAG
00400	ASW==100000		;LINE BLOCK SWITCH
00500	NSW==40000		;PROCESS N RECORDS ONLY
00600	WSW==20000		;REWIND TAPE
00700	SOMESW==10000		;SOME VALID SWITCH TYPED AFTER /
00800	NUM==4000		;NUMBER SEEN IN INPUT ROUTINE
00900	NEGS==2000		;NEGATIVE SIGN SEEN
01000	PLUS==1000		;PLUS SIGN SEEN
01100	DSW==200		;TAPE DUMP
01200	OSW==100		;OCTAL TAPE DUMP ALSO
01300	SSW==40			;USE ASCII SPACE(40 OCTAL) WHEN TRANSLATING EBCDIC(0)
01400	PSW==20			;POSITION INPUT TAPE
01500	BSW==10			;CHANGE INPUT BLOCKING
01600	EOFSEN==1		;EOF SEEN ON SPECIAL CHR SET OPTION
01700	
01800		;RH FLAG BITS
01900	
02000	NOSWTH==400000		;1 IF SWITCHES NOT ALLOWED IN GTSPEC
02100	UNBLKD==200000		;1 IF TAPE IS NOT BLOCKED
02200	SNGBUF==100000		;1 IF SINGLE TAPE BUFFER
02300	DINFLG==40000		;1 IF MUST DO DUMP INPUT BECAUSE OF RECORD SIZE
02400	
02500	;MISC. MEMORY LOCS.
02600	LINCNT:	0
02700	PAGCNT:	0
02800	CNTFLG:	0
02900	RECS:	0
03000	TAPLEG:	BLOCK	1
03100	TAPDEN:	BLOCK	1
03200	TAPBLK:	BLOCK	4
     
00100		SUBTTL	STARTUP AND DIALOGUE
00200	START:	JFCL			;BEWARE CCL START
00300		RESET
00400		OUTSTR	[ASCIZ/
00500	WMU - TAPE CONVERSION PROGRAM
00600	
00700	/]
00800		MOVE	P,[IOWD 40,PDL]
00900		SETZ	F,		;CLEAR ALL FLAGS
01000		MOVSI	A,'BCD'
01100		DEVCHR	A,
01200		JUMPE	A,NTAVL		;BCD DOESN'T EXIST
01300		TLNN	A,(1B13)	;IS BCD A MAGTAPE
01400		JRST	NOTAPE		;NO
01500	;	MOVSI	A,'BCD'		;CALL USAGE
01600	;	CALLI	A,-2		;DO IT
01700		 JFCL			;IGNORE IT
01800		SETZM	TAPDEN		;ASSUME 800 BPI/NO TAPOPS.
01900		MOVEI	A,.TFPDN	;FIND LEGAL DENSITIES
02000		MOVEM	A,TAPBLK
02100		MOVSI	A,'BCD'		;FOR DEVICE BCD
02200		MOVEM	A,TAPBLK+1
02300		MOVEI	A,.TFD80
02400		MOVEM	A,TAPDEN
02500		MOVE	A,[XWD 3,TAPBLK]
02600		TAPOP.	A,
02700		  JRST	GETCNV		;WON'T TELL. MUST BE 800
02800		MOVEM	A,TAPLEG	;SAVE LEGAL DENSITIES
02900		TRNN	A,TF.DN4!TF.DN5	;1600 OR 6250 POSSIBLE?
03000		 JRST	GETCNV		;NO. FORCE 800
03100	GETDEN:	OUTSTR	[ASCIZ/Tape density: /]
03200		PUSHJ	P,IN		;GET DENSITY
03300		CAIGE	A,^D800		;800 OR MORE?
03400		 JRST	ILLDEN		;NO. ILLEGAL
03500		SETZ	B,		;ASSUME NOT LEGAL
03600		CAIN	A,^D800
03700		MOVEI	B,.TFD80
03800		CAIN	A,^D1600
03900		MOVEI	B,.TFD16
04000		CAIN	A,^D6250
04100		MOVEI	B,.TFD62
04200		JUMPE	B,ILLDEN	;ILLEGAL IF NONE OF ABOVE
04300		MOVEM	B,TAPDEN	;STORE DESIRED DENSITY
04400		MOVEI	A,1
04500		LSH	A,-1(B)		;POSITION BIT
04600		TDNN	A,TAPLEG	;IS IT LEGAL ON THIS DRIVE?
04700		 JRST	BADDEN		;NO. SAY SO
04800	GETCNV:	OUTSTR	LIT0		;ASK FOR INPUT CODE
04900		PUSHJ	P,GETLIN
05000		ILDB	A,LINPNT
05100		SKIPN	A
05200		MOVEI	A,"E"		;ASSUME EBCDIC
05300		MOVSI	B,-CNVNUM	;NEGATIVE NUMBER OF CONVERSIONS
05400		CAME	A,CNVTAB(B)	;MATCH?
05500		AOBJN	B,.-1		;NO. LOOK AT NEXT
05600		JUMPGE	B,CNVERR	;GIVE ERROR IF NONE MATCHES
05700		MOVE	C,CNVLST(B)	;GET THE RIGHT CONVERT INST.
05800		MOVEM	C,CNVRT		;SAVE IT
05900		MOVE	C,CNVLIM(B)	;GET LIMIT FOR CONVERSION TYPE
06000		JUMPE	C,SPCSET	;JUMP IF USER DIALOGUE REQUIRED
06100	GOTCNV:	MOVEM	C,CNVMAX#	;STORE IT
06200		CAIE	A,"D"
06300		JRST	ASKBLK
06400		TRZ	F,SNGBUF!UNBLKD!DINFLG	;NOT SINGLE BUFFER OR UNBLOCKED NOW
06500		TLO	F,DMPFLG	;SET DUMP FLAG
06600		OUTSTR	DMPWRN
06700		MOVEI	A,1
06800		JRST	ASKBK1		;GO STORE BLOCKING FACTOR
     
00100	SPCSET:	OUTSTR	[ASCIZ/
00200	 NAME OF CONVERSION TABLE FILE? /]
00300		TRO	F,NOSWTH	;NO SWITCHES ALLOWED
00400		SETZM	DEV
00500		SETZM	NAME
00600		SETZM	EXT
00700		SETZM	EXT+1
00800		SETZM	EXT+2
00900		PUSHJ	P,GTSPEC	;GET THE FILE NAME
01000		OUTSTR	LIT11		;NUMBER OF CHRS IN SET
01100		PUSHJ	P,IN
01200		SUBI	A,1		;HIGHEST LEGAL VALUE
01300		CAILE	A,^D255		;> MAX LIMIT?
01400		JRST	[OUTSTR	[ASCIZ/
01500	?BCDMSX - Max size of character set exceeded/]
01600			EXIT]
01700		CAIG	A,0		;POSITIVE?
01800		MOVEI	A,^D255		;NO - ASSUME MAX
01900		MOVEM	A,CNVMAX	;STORE IT
02000		PUSHJ	P,SPCINS	;GET NEW CHR SET(NO RETRN IF ERROR
02100	ASKBLK:	TRZ	F,SNGBUF!UNBLKD!DINFLG	;NOT SINGLE BUFFER OR UNBLOCKED NOW
02200		JUMPL	F,ASKREC	;NOT BLOCKING IF DUMPING
02300		OUTSTR	LIT1		;ASK ABOUT BLOCKING FACTOR
02400		PUSHJ	P,IN
02500		JUMPG	A,ASKBK1	;MUST BE POSITIVE
02600		JUMPE	A,WHTSIZ	;USER WANTS SIZE SNOOPED OUT
02700		OUTSTR	BADNEG		;COMPLAIN
02800		JRST	ASKBLK		;AND TRY AGAIN
02900	ASKBK1:	MOVEM	A,BLKFAC
03000		JUMPL	F,ASKREC	;DUMP TAPES ARE BLOCKED
03100		CAIN	A,1		;UNBLOCKED?
03200		TRO	F,UNBLKD	;YES.
03300	ASKREC:	OUTSTR	LIT2		;ASK ABOUT RECORD SIZE
03400		PUSHJ	P,IN
03500		JUMPG	A,ASKRC1	;MUST BE POSITIVE
03600		OUTSTR	BADNEG		;COMPLAIN
03700		JRST	ASKREC		;AND TRY AGAIN
03800	ASKRC1:	MOVEM	A,RECSIZ
     
00100		IMUL	A,BLKFAC
00200		MOVEM	A,BUFN		;# OF CHARS IN 1 BUFFER = RECSIZ*BLKFAC
00300		MOVEM	A,BUFSIZ
00400		JUMPL	F,GETBUF	;DUMP MODE?
00500		ADDI	A,3
00600		IDIVI	A,4
00700		MOVEM	A,BUFSIZ	;# OF WORDS IN BUFFER IS AN EVEN MULTIPLE OF 4
00800	GETBUF:	ADDI	A,3+^D10	;ACTUAL SIZE OF BUFFER REQUIRED
00900		MOVEM	A,BUFWDS#	;STORE IT
01000		CAILE	A,^D4096	;MORE THAN FOUR K?
01100		TRO	F,DINFLG	;YES. CAN NOT DO BUFFERED IO
01200		MOVEI	B,^D3000	;USE ABOUT THREE K BUFFERS
01300		EXCH	A,B
01400		IDIV	A,B
01500		SKIPE	B
01600		ADDI	A,1		;OR ONE IF THATS BIGGER
01700		MOVEM	A,MBUFN#	;STORE NUMBER
01800		TRNN	F,DINFLG	;DUMP INPUT?
01900		 JRST	SETBUF		;NO
02000		MOVE	A,BUFSIZ	;GET BUFFER SIZE AGAIN
02100		ADDI	A,^D10		;TOTAL WORDS REQUIRED TO INPUT
02200		MOVN	A,A		;NEGATE
02300		HRLM	A,DIOWD		;BUILD IOWD
     
00100		TRNE	F,UNBLKD	;UNBLOCKED TAPE?
00200		JRST	SETBUF		;YES. ANY LINE BLOCKING WILL BE DIFFERENT WAY
00300			;THIS IS FOR COMPUTATION OF NULL FILL FOR END OF WORD IF LINE-BLOCKED
00400		MOVE	A,RECSIZ
00500		ADDI	A,2
00600		IDIVI	A,5
00700		SUBI	B,5
00800		ADDI	A,1		;GET NUMBER OF WORDS FOR RECORD
00900		IMULI	A,5		;NOW NUMBER OF CHARACTERS INCLUDING FILL
01000		MOVEM	A,ARECSZ#	;ACTUAL RECSIZ = RECSIZ+<CRLF>+NULLFILL
01100		CAIG	A,^D640		;NUMBER OF CHARACTER PER DISK BLOCK
01200		 JRST	SETBUF		;OK IF RECORD .LE.
01300		TLZ	F,ASW		;BAD. CAN'T LINE BLOCK
01400		OUTSTR	[ASCIZ/%BCDCLB Cannot line block output. record too long.
01500	/]
01600			; END OF LINE-BLOCK STUFF
01700	SETBUF:	MOVE	A,BUFWDS	;GET SIZE OF A BUFFER
01800		IMUL	A,MBUFN		;TIMES NUMBER
01900		ADDI	A,BUF1		;PLUS BASE ADDRESS
02000		MOVE	B,A
02100		CAMGE	A,.JBREL##	;DO WE NEED MORE CORE
02200		JRST	OK		;NO
02300		CORE	A,		;YES GET IT
02400		 JRST	.+2		;TRY LESS BUFFERS
02500		JRST	OK		;ALL OK
02600		SOSG	MBUFN		;IS LESS BUFFERS LEGAL?
02700		JRST	NOCORE		;NO. NOT ENOUGH FOR EVEN ONE
02800		JRST	SETBUF		;YES. TRY ONE LESS
02900	OK:	HRRM	B,.JBFF##	;SAVE NEW TOP TWICE
03000		MOVE	A,MBUFN		;ACTUAL NUMBER OF BUFFERS
03100		CAIG	A,1		; GREATER THAN ONE?
03200		TRO	F,SNGBUF	;NO. SINGLE BUFFERED
03300		PUSHJ	P,TINIT		;INITIALIZE TAPE
03400	POSIT:	OUTSTR	LIT3		;ASK ABOUT REWIND
03500		PUSHJ	P,YESNO		;SKIP UNLESS 'Y'
03600		PUSHJ	P,REWIND
03700		OUTSTR	LIT4		;ASK ABOUT FILE POSITION
03800		PUSHJ	P,IN
03900		JUMPGE	A,SKF
04000		PUSHJ	P,BACKSP
04100		AOJLE	A,.-1		;MUST DO N+1 BACKSPACE COMMANDS
04200		STATO	ICH,1B24	;AT LOAD POINT?
04300					;IF NOT, MUST DO ONE SKIP FILE
04400		PUSHJ	P,SKIPFL
04500	SKF:	SOJG	A,.-1
     
00100	ASKNAM:	OUTSTR	[ASCIZ\
00200	 Output ? \]
00300		TLZ	F,IGNORE!ASW!NSW!WSW!DSW!OSW!SSW!PSW!BSW ;TURN OFF IGNORE, SWITCHES
00400		TRZ	F,NOSWTH	;SWITCHES ALLOWED
00500		SETZM	EBCTAB		;PRESET NULL AT EBCTAB+0
00600		PUSHJ	P,GTSPEC	;GET FILE SPECS
00700		MOVE	B,NAME
00800		CAMN	B,[SIXBIT/FINISH/]
00900		EXIT
01000		TLZE	F,BSW		;/B/P IS /B SINCE FALLS TO /P
01100		 JRST	ASKBLK		;GO REDO BLOCKING
01200		TLZE	F,PSW		;REWIND TAPE(/P)
01300		 JRST	POSIT		;YES. DO IT
     
00100	OINIT:	TLNE	F,DMPFLG	;DUMPING?
00200		TLZ	F,DSW!OSW!SSW!ASW	;YES. CLEAR INCOMPATIBLE SWITCHES
00300		MOVEI	A," "		;ASCII SPACE
00400		TLZE	F,SSW		;SPACE TO REPLACE NULL IN EBCDIC(0)?
00500		MOVEM	A,EBCTAB	;YES
00600		MOVEI	A,1		;ASCII LINE
00700		TLNE	F,DMPFLG
00800		MOVEI	A,10		;IMAGE MODE
00900		MOVE	B,DEV
01000		MOVSI	C,OB		;OUTPUT ONLY
01100		OPEN	OCH,A		;OPEN OUTPUT DEVICE
01200		 JRST	NODSK
01300		ENTER	OCH,OUTFIL	;SET UP FILENAME IF ANY
01400		 JRST	NOROOM
01500		MOVEI	B,OCH		;SET UP B FOR DEVCHR
01600		DEVCHR	B,		;DO IT
01700		TLNE	B,(1B13)	;IS IT A MAGTAPE FOR OUTPUT
01800		TLNN	F,WSW		;YES, DO THEY WANT REWIND(/W)
01900		SKIPA			;NO, NO, NO
02000		MTREW.	OCH,		;YES, YES, YES
02100		MTWAT.	OCH,		;MUST WAIT
02200		SETZM	LNGCNT#		;CLEAR NUMBER OF OVERSIZE RECORDS
02300		SETZM	SMLCNT#		;CLEAR NUMBER OF SHORT RECORDS
02400		SETZB	RCNT,ILLCNT#	;ZERO RECORD COUNT AND ILLEGAL CHAR COUNT
02500		SETZM	PHYCNT#		;ZERO NUMBER OF PHYSICAL RECORDS READ
02600		HRLOI	B,377777
02700		MOVEM	B,NCNT		;MAKE NCNT A HUGE NUMBER
02800		TLNN	F,DSW		;TAPE DUMP?
02900		JRST	RNREC		;NO
03000		OUTSTR	[ASCIZ/
03100	OCTAL DUMP ALSO? /]
03200		PUSHJ	P,YESNO		;SKIP UNLESS 'Y'
03300		TLO	F,OSW		;SET OCTAL DUMP SWTCH
03400	RNREC:	TLNN	F,NSW		;IS NSW SET(/D DOES IMPLICIT /N)
03500		JRST	RDREC2		;NO
     
00100	RDREC0:	OUTSTR	[ASCIZ/
00200	# Records ? /]
00300		PUSHJ	P,IN		;GET # OF RECORDS TO PROCESS
00400		TLNE	F,DSW		;TAPE DUMP?
00500		JUMPLE	A,RDREC2	;YES , 0<= MEANS ALL OF TAPE
00600		JUMPG	A,RDREC1	;MUST BE POSITIVE
00700		OUTSTR	BADNEG		;COMPLAIN
00800		JRST	RDREC0		;AND TRY AGAIN
00900	RDREC1:	MOVEM	A,NCNT		;STASH IN NCNT
01000	RDREC2:	TLNN	F,DSW		;TAPE DUMP?
01100		JRST	LOOP		;NO
01200		MOVEI	A,PHD1		;PRINT 1ST HEADER
01300		PUSHJ	P,PSTRIN
01400		MOVE	A,BLKFAC	;PRINT BLOCKING FACTOR
01500		PUSHJ	P,PDEC
01600		MOVEI	A,PHD2
01700		PUSHJ	P,PSTRIN
01800		MOVE	A,RECSIZ	;PRINT RECORD SIZE
01900		PUSHJ	P,PDEC
02000		PUSHJ	P,PCRLFX
02100		MOVEI	A,PHD3		;RECORD HEADER
02200		PUSHJ	P,PSTRIN
02300		PUSHJ	P,PCRLFX
02400		MOVEI	A,^D45		;# OF LINES PER PAGE
02500		MOVEM	A,PAGCNT	;INIT COUNTER
02600		MOVEI	A,^D100		;# OF CHARACTERS PER LINE
02700		MOVEM	A,LINCNT	;INIT COUNTER
02800		SETZM	RECS		;SET RECORD COUNTER
02900		SETOM	CNTFLG		;FORCE FIRST LABEL
03000		TLNN	F,OSW		;OCTAL DUMP?
03100		JRST	LOOP		;NO
03200		MOVE	OPNT,NOPNT	;POINTER TO OCBUF
     
00100		SUBTTL	FILE READ AND CONVERT
00200	LOOP:	TLNN	F,NSW		;IS NSW SET
00300		JRST	LOOP1		;NO
00400		CAMGE	RCNT,NCNT	;IS RECORD-COUNT => # REQUESTED
00500		JRST	LOOP1		;NO, KEEP ON TRUCKIN'
00600		OUTSTR	[BYTE (7)15,12]
00700		MOVE	A,NCNT		;GET THE NUMBER
00800		PUSHJ	P,DECPRT	;PRINT IT
00900		OUTSTR	[ASCIZ/ records processed.
01000	/]
01100		TLNN	F,DSW		;TAPE DUMP?
01200		JRST	CLOSIT		;NO
01300		SOSL	PAGCNT		;YES, DECRIMENT COUNTER, PAGE FULL?
01400		PUSHJ	P,PTAIL1	;YES, LAST PAGE
01500	CLOSIT:	CLOSE	OCH,0
01600		GETSTS	ICH,A		;GET TAPE STATUS,MODE,ETC.
01700		ANDI	A,617		;RETAIN DENSITY,MODE
01800		SETSTS	ICH,(A)		;CLEAR OTHER BITS
01900		JRST	ASKNAM		;DO IT AGAIN
02000	LOOP1:	MOVE	CNT,RECSIZ	;SET UP CHAR COUNT
02100	LOOP1A:	PUSHJ	P,GETCHR	;GET A CHAR
02200		JUMPL	F,CNVRT		;JUST MOVE WORD IF DUMPING
02300		TLNE	F,OSW		;OCTAL DUMP?
02400		IDPB	MATCH,OPNT	;YES, STORE A BYTE
02500		CAMG	MATCH,CNVMAX	;MAKE SURE VALID CHARACTER
02600		JUMPGE	MATCH,CNVRT	;IT IS LEGAL IF POSITIVE. GO AHEAD
02700		SKIPG	ILLCNT		;FIRST ILLEGAL CHARACTER?
02800		OUTSTR	ILLCHR		;YES. SAY SO
02900		MOVEI	CHR,"\"		;CHARACTER FOR ILLEGALS
03000		AOSA	ILLCNT		;COUNT ILLEGAL CHARACTERS
03100	CNVRT:	0			;TO BE FILLED BY PROPER TRANSLATER INSTRUCTION
03200		TLNN	F,DSW		;TAPE DUMP?
03300		JRST	OUTPIT		;NO
03400		MOVE	A,LINCNT	;GET LINE SIZE
03500		CAIN	A,^D100		;BEGINING OF LINE?
03600		PUSHJ	P,RECNUM	;YES, GET PROPER MARGIN SPACING
03700		CAIGE	CHR,40		;PRINTABLE CHARACTER?
03800		MOVEI	CHR,"\"		;NO, SUBSTITUTE BACKSLASH
03900	OUTPIT:	PUSHJ	P,PUTCHR	;PUT A CHAR
04000		TLNN	F,DSW		;TAPE DUMP?
04100		JRST	RWLUP		;NO
04200		SOSG	LINCNT		;DECRIMENT CHARACTER COUNTER, LINE FULL?
04300		PUSHJ	P,LINBRK	;YES
04400	RWLUP:	SOJG	CNT,LOOP1A	;IF NOT DONE WITH RECORD JUMP BACK
04500	CRLF:	AOJ	RCNT,		;ADD 1 TO RECORD COUNT
04600		JUMPL	F,LOOP		;DONT IF DUMP MODE
04700		PUSHJ	P,PCRLFX	;PUT OUT CRLF
04800		TLNE	F,OSW		;OCTAL DUMP?
04900		PUSHJ	P,OCDUMP	;YES
05000		TLNN	F,DSW		;DUMP TAPE?
05100		JRST	LBFILL		;NO
05200		SETOM	CNTFLG		;START NEXT LINE WITH "RECORD #"
05300		MOVEI	A,^D100		;START COUNTING NEW LINE
05400		MOVEM	A,LINCNT
05500		SOSG	PAGCNT		;INRC. COUNTER, PAGE FULL?
05600		PUSHJ	P,PTAIL		;YES
05700	LBFILL:	TLNN	F,ASW		;IS IT LINE-BLOCKED (/A)
05800		JRST	LOOP		;NO, DO ANOTHER RECORD
05900		SETZ	CHR,		;YES, DO FILLERS
06000		MOVSI	A,760000	;MASK TO TEST POINTER
06100	LBFIL1:	TDNN	A,OB+1		;ALREADY EXACT WORD?
06200		 JRST	LBFIL2		;YES.
06300		PUSHJ	P,PUTCHR	;NO. NULL FILL
06400		JRST	LBFIL1		;UNTIL WORD FULL
06500	LBFIL2:	TRNN	F,UNBLKD	;UNBLOCKED TAPE?
06600		 JRST	LOOP		;YES. GETNEW WILL CHECK FOR FIT
06700		MOVE	A,OB+2		;NO. WILL ANOTHER RECORD FIT?
06800		CAMGE	A,ARECSZ	;...?
06900	CRLFX:	SETZM	OB+2		;NO. MAKE PUTCHR USE NEXT BUFFER
07000		JRST	LOOP
     
00100		SUBTTL	I/O SUBROUTINES
00200	
00300	GETSML:	MOVE	CNT,IBUF+2	;HERE IF SINGLE BLOCKED SHORT RECORDS
00400		JUMPL	F,GETCHR	;NOT LINE BLOCKED IF DUMP
00500		TLNN	F,ASW		;LINE BLOCKING?
00600		 JRST	GETCHR		;NO. GO AHEAD
00700		MOVEI	A,2(CNT)	;GET LINE SIZE
00800		CAMLE	A,OB+2		;WILL IT FIT?
00900		SETZM	OB+2		;NO. DO BEST CAN
01000	GETCHR:	SOSGE	IBUF+2		;ANY MORE CHARACTERS?
01100		 JRST	GETNEW		;NO. GET A BUFFER
01200		ILDB	MATCH,IBUF+1	;YES GET IT AND GET BACK
01300		POPJ	P,0
01400	GETNEW:	TRNE	F,DINFLG	;DOING DUMP MODE INPUT?
01500		 JRST	GETNWD		;YES. DIFFERENT
01600		IN	ICH,		;NOW INPUT
01700		JRST	GETNWA		;OK
01800		 JRST	CHKSTA		;ERROR?, FIND OUT WHY
01900	GETNWD:	IN	ICH,DIOWD	;DO THE DUMP MODE INPUT
02000		 JRST	.+2		;OK. CALC BUFFER SIZE
02100		  JRST	CHKSTA		;ERROR?, FIND OUT WHY
02200	GTNWD0:	MOVEI	A,ICH		;FIND RECORD SIZE IN MONITOR
02300		MTCHR.	A,		;...
02400		 HRLZ	A,BUFSIZ	;WON'T TELL. ASSUME OK
02500		HLRZ	CHR,A		;GET WORD COUNT
02600		JUMPL	F,GTNWD2	;DUMP OUTPUT?
02700		IMULI	CHR,4		;NO. CHARACTERS
02800		LDB	A,[POINT 3,A,29];GET CHARACTERS IN LAST WORD
02900		CAIGE	A,4		;BEWARE PRE-603 BUG
03000		 JRST	GTNWD1		;OK
03100		TRCE	A,5		;FIX UP BUG
03200		TRCE	A,5
03300		TRC	A,5
03400	GTNWD1:	ADD	A,CHR		;GET TOTAL CHARACTERS
03500		MOVEM	A,IBUF+2	;STORE
03600		MOVE	A,[POINT 8,BUF1+1,35]
03700		MOVEM	A,IBUF+1	;SIMULATE BUFFERED MODE
03800		JRST	GETNWA		;CONTINUE
03900	GTNWD2:	TRNE	A,7B29		;ANY CHARS IN LAST WORD?
04000		ADDI	CHR,1		;YES. ADD ONE TO WORDS
04100		MOVEM	CHR,IBUF+2	;STORE WORDS
04200		MOVE	A,[POINT 36,BUF1+1,35]
04300		MOVEM	A,IBUF+1	;SIMULATE BUFFERED MODE
04400	GETNWA:	AOS	PHYCNT		;ONE MORE PHYSICAL RECORD
04500		SKIPE	SHORT#		;WAS LAST RECORD SHORT?
04600		 JRST	SHORTR		;YES. SHOULD HAVE GOTTEN EOF
04700	GETNW1:	JUMPL	F,GTNW1B	;SKIP SOME IF DUMP
04800		TRNN	F,SNGBUF	;SINGLE BUFFERED?
04900		 JRST	GTNW1B		;NO. MTCHR. WOULD TELL ABOUT WRONG BUFFER
05000		MOVEI	A,ICH		;GET ACTUAL CHARACTER COUNT FROM TAPSER
05100		MTCHR.	A,		;IF POSSIBLE
05200		 JRST	GTNW1B		;OH WELL
05300		HLRZ	CHR,A		;GET WORD COUNT
05400		IMULI	CHR,4		;MAKE CHARACTERS
05500		LDB	A,[POINT 3,A,29];CHARACTERS IN FINAL WORD
05600		CAIGE	A,4		;BEWARE PRE 603 MONITOR BUG
05700		 JRST	GTNW1A		;OK. GO AHEAD
05800		TRCE	A,5		;FIX MONITR BUG
05900		TRCE	A,5
06000		TRC	A,5
06100	GTNW1A:	ADD	A,CHR		;TOTAL CHARACTERS
06200		MOVEM	A,IBUF+2	;STORE AS BUFFER COUNT
06300	GTNW1B:	MOVE	A,IBUF+2	;GET NUMBER OF CHARACTERS
06400		CAMN	A,BUFN		;CORRECT NUMBER OF CHARACTERS?
06500		 JRST	GETCHR		;YES. OK
06600		JUMPL	F,GETNW0	;SKIP SOME IF DUMP
06700		ADDI	A,3		;ROUND
06800		ASH	A,-2		;NUMBER OF WORDS
06900	GETNW0:	CAMN	A,BUFSIZ	;PROPER NUMBER?
07000		 JRST	GETNW2		;YES. SET NUMBER OF CHARACTERS
07100		CAML	A,BUFSIZ	;SHORT RECORD?
07200		 JRST	LNGERR		;NO. MODERATELY LONG
07300		TRNE	F,UNBLKD	;UNBLOCKED TAPE?
07400		 JRST	GETSML		;YES. SUPPORT VARIABLE LENGTH RECORDS,
07500					;AND RECORD .LT. SPECIFIED WITHOUT COMPLAINT
07600		MOVE	A,IBUF+2	;CALCULATE NUMBER OF CHARACTERS CAN PROCESS
07700		MOVEM	A,LASBLK#	;REMEMBER SIZE OF LAST BUFFER
07800		JUMPL	F,[		;USE WHAT IS THERE IF DUMPING
07900			   SETOM SHORT	;SET SHORT FLAG
08000			   JRST	GETSML	;AND USE ACTUAL RECORD SIZE
08100			]
08200		IDIV	A,RECSIZ
08300		CAIG	A,0		;ANY RECORDS AT ALL?
08400		MOVEI	A,1		;STRANGE. MUST BE ONE.
08500		IMUL	A,RECSIZ
08600		SETOM	SHORT#		;SET SHORT RECORD FLAG
08700		JRST	GETNW3
08800	GETNW2:	MOVE	A,BUFN		;SET BUFFER COUNT TO RECORD LENGTH
08900	GETNW3:	MOVEM	A,IBUF+2
09000		JRST	GETCHR		;AND GO RETURN A CHARACTER
     
00100	OCDUMP:	MOVE	A,PAGCNT
00200		CAIGE	A,5		;ROOM FOR 3 LINES OF OCTAL?
00300		PUSHJ	P,PTAIL		;NO
00400		MOVEI	5,3		;3 ROWS OF OCTAL DIGITS
00500		MOVE	D,[POINT 3,A,26]	;FOR SPLITTING 3 DIGIT #S
00600	OC1:	MOVEI	A,PHD4		;MARGIN SPACING
00700		PUSHJ	P,PSTRIN
00800		MOVEI	C,^D100		;MAX LINE LENGTH
00900		SUB	C,LINCNT	;C IS # OF A IN LINE
01000		MOVE	OPNT,NOPNT	;POINTER TO LINE
01100		IBP	D		;SET FOR DESIRED A
01200	OC2:	SOJL	C,OC3
01300		ILDB	A,OPNT		;GET #(3DIGITS)
01400		LDB	CHR,D		;GET DESIRED SINGLE DIGIT
01500		ADDI	CHR,"0"		;MAKE IT ASCII
01600		PUSHJ	P,PUTCHR	;OUTPUT IT
01700		JRST	OC2
01800	OC3:	PUSHJ	P,PCRLFX	;PUT OUT CRLF
01900		SOS	PAGCNT
02000		SOJG	5,OC1		;DIGITS PER LINE
02100		PUSHJ	P,PCRLFX	;PUT OUT CRLF
02200		SOS	PAGCNT
02300		PUSHJ	P,PCRLFX	;PUT OUT CRLF
02400		SOSG	PAGCNT
02500		PUSHJ	P,PTAIL
02600		MOVE	OPNT,NOPNT	;RESET BYTE POINTER
02700		POPJ	P,
     
00100	CHKSTA:	STATO	ICH,20000	;IS IT EOF
00200		 JRST	DERR		;NO SOME ERROR
00300		SKIPE	SMLCNT		;ANY SHORT RECORDS?
00400		SKIPN	SHORT		;YES. IS THIS ONE?
00500		 JRST	.+2		;NO. OK
00600		AOS	SMLCNT		;YES. COUNT THIS ONE
00700		SETZM	SHORT
00800		TLNN	F,DSW		;DUMP TAPE?
00900		JRST	CLOSIU		;NO
01000		SOSL	PAGCNT		;YES,INCR. PAGCNT, PAGE FULL?
01100		PUSHJ	P,PTAIL1	;YES, LAST PAGE
01200	CLOSIU:	CLOSE	ICH,0
01300		CLOSE	OCH,0		;YES, TELL USER AND GET OUT
01400		OUTSTR	LIT5
01500		JUMPG	RCNT,CHKST1	;WERE ANY RECORDS PROCESSED
01600		OUTSTR	NORECS		;NO TELL USER
01700		JRST	CHKST3		;AND GO TO NEXT FILE
01800	CHKST1:	OUTSTR	[BYTE (7)15,12]	;START NEW LINE
01900		MOVE	A,RCNT		;GET NUMBER OF RECORDS PROCESSED
02000		PUSHJ	P,DECPRT	;PRINT THE NUMBER
02100		OUTSTR	RECPRC		;AND ASSOCIATED MESSAGE
02200		SKIPG	A,LNGCNT	;ANY OVERSIZE RECORDS?
02300		 JRST	CHKST2		;NO
02400		CAME	A,PHYCNT	;ONLY PRINT NUMBER IF DIFFERENT
02500		PUSHJ	P,DECPRT	;PRINT NUMBER
02600		MOVE	A,LNGCNT
02700		CAMN	A,PHYCNT	;PRINT "ALL" IF SAME
02800		OUTSTR	[ASCIZ/All/]	;ALL
02900		OUTSTR	OVRSIZ		;AND ASSOCIATED MESSAGE
03000	CHKST2:	SKIPG	A,SMLCNT	;GET COUNT OF SHORT RECORDS
03100		JRST	CHKST3		;NONE
03200		CAME	A,PHYCNT	;ONLY PRINT NUMBER IF DIFFERENT
03300		PUSHJ	P,DECPRT	;PRINT THE COUNT
03400		MOVE	A,SMLCNT
03500		CAMN	A,PHYCNT	;PRINT "ALL" IF SAME
03600		OUTSTR	[ASCIZ/All/]
03700		OUTSTR	SMLSIZ		;AND ASSOCIATED MESSAGE
03800	CHKST3:	SKIPG	A,ILLCNT	;GET COUNT OF ILLEGAL CHARACTERS
03900		 JRST	CHKST4		;NONE
04000		PUSHJ	P,DECPRT	;PRINT THE COUNT
04100		OUTSTR	TOTILL		;AND ASSOCIATED MESSAGE
04200	CHKST4:	POP	P,(P)		;RESTORE LIST
04300		PUSHJ	P,TINIT
04400		JRST	ASKNAM
     
00100	LNGERR:	SKIPE	LNGCNT		;FIRST LONG RECORD?
00200		JRST	LNGER3		;NO
00300		JUMPG	RCNT,LNGER1	;YES. FIRST RECORD?
00400		OUTSTR	FRTOBG		;YES. TELL ABOUT ERROR
00500		JRST	LNGER2		;GO AHEAD
00600	LNGER1:	OUTSTR	TOOBIG		;TELL ABOUT BIG RECORD
00700	LNGER2:	OUTSTR	CHGBLK		;WANT TO CHANGE BLOCKING?
00800		PUSHJ	P,YESNO		;???
00900		 JRST	ASKBLK		;YES. DO IT
01000	LNGER3:	AOS	LNGCNT		;COUNT LONG RECORDS
01100		STATO	ICH,40000	;BLOCK TOO LARGE ERROR?
01200		 JRST	LNGER4		;NO. MINOR OVERFLOW
01300		GETSTS	ICH,A		;CLEAR BLOCK TOO LARGE
01400		TRZ	A,40000		;...
01500		TRO	A,100		;SKIP ERROR RETRY
01600		SETSTS	ICH,(A)		;SET STATUS BACK
01700	LNGER4:	JRST	GETNW2		;GO AHEAD (SET NUMBER OF CHARACTERS)
01800	
01900	SHORTR:	SETZM	SHORT		;FORGET THAT PREVIOUS RECORD WAS SHORT
02000		SKIPE	SMLCNT#		;FIRST SHORT RECORD?
02100		JRST	SHORT3		;NO
02200		CAML	RCNT,BLKFAC	;ON FIRST RECORD?
02300		JRST	SHORT1		;NO.
02400		OUTSTR	FRTOSM		;YES. TELL ABOUT ERROR
02500		JRST	SHORT2		;GO AHEAD
02600	SHORT1:	OUTSTR	TOOSML		;TELL ABOUT SMALL RECORD
02700	SHORT2:	OUTSTR	ACTBLK		;ACTUAL BLOCK SIZE IS
02800		MOVE	A,LASBLK	;N CHARACTERS
02900		PUSHJ	P,DECPRT
03000		MOVEI	A,CHARS		;CHARACTERS
03100		JUMPGE	F,.+2		;DUMPING?
03200		MOVEI	A,WORDS		;YES. WORDS
03300		OUTSTR	(A)
03400		OUTSTR	CHGBLK		;WANT TO CHANGE BLOCKING?
03500		PUSHJ	P,YESNO		;???
03600		 JRST	ASKBLK		;YES. DO IT
03700	SHORT3:	AOS	SMLCNT		;COUNT SHORT RECORDS
03800		JRST	GETNW1		;GO ON WITH RECORD
     
00100	DERR:	STATZ	ICH,1B25	;PHYSICAL END OF TAPE?
00200		 JRST	FNDEOT		;YES
00300		STATZ	ICH,700000	;ANY REAL ERRORS?
00400		 JRST	DERR1		;YES. DON'T TREAT AS LONG RECORD
00500		STATZ	ICH,40000	;BLOCK TOO LARGE?
00600		 JRST	LNGERR		;YES
00700	DERR1:	TLNE	F,IGNORE	;IGNORE ERRORS?
00800		JRST	RESETS		;YES
00900		OUTSTR	LIT7A		;TELL ABOUT ERROR
01000		GETSTS	ICH,A		;GET STATUS
01100		PUSHJ	P,OCTPRT	;AND PRINT THAT TOO
01200		OUTSTR	LIT7B		;ASK ABOUT SKIPPING BLOCK
01300		PUSHJ	P,GETLIN
01400		ILDB	A,LINPNT
01500		CAIN	A,"C"		;IS IT A C
01600		JRST	RESETS		;YES
01700		CAIE	A,"I"		;IS IT AN I
01800		EXIT			;NO, EXIT
01900		TLO	F,IGNORE
02000	RESETS:	GETSTS	ICH,A		;YES, SET STATUS BACK AND CONTINUE
02100		TRZ	A,700000
02200		TLNE	F,IGNORE	;IF IGNORE ERROR FLAG ON
02300		TRO	A,100		;SET IONRCK
02400		SETSTS	ICH,(A)
02500		STATZ	ICH,40000	;ALSO BLOCK TO LARGE?
02600		JRST	LNGERR		;YES. GIVE THAT ERROR TOO
02700		TRNE	F,DINFLG	;DUMP INPUT ?
02800		 JRST	GTNWD0		;YES
02900		  JRST	GETNWA		;NO
03000	
03100	FNDEOT:	OUTSTR	ATEOT		;SAY AT END OF TAPE
03200		EXIT			;EXIT
03300	
03400	PUTCHR:	SOSG	OB+2		;STANDARD DEC OUTPUT PROCEDURE
03500		JRST	PUTBUF
03600	PUTNXT:	IDPB	CHR,OB+1
03700		POPJ	P,0
03800	PUTBUF:	OUT	OCH,0
03900		JRST	PUTNXT
04000		 OUTSTR	LIT8		;TELL USER ABOUT ERROR ON OUTPUT
04100		GETSTS	OCH,A		;GET THE STATUS BITS
04200		PUSHJ	P,OCTPRT	;TELL HIM ABOUT THEM
04300		OUTSTR	[BYTE (7) ")",15,12]
04400		EXIT
     
00100	PSTRIN:	MOVE	B,[POINT 7,(A)]	;POINTER TO SUBJECT STRING
00200	PSTRI1:	ILDB	CHR,B		;GET CHR
00300		JUMPE	CHR,CPOPJ	;NUL?
00400		PUSHJ	P,PUTCHR	;NO, PRINT IT
00500		JRST	PSTRI1		;GO FOR ANOTHER
00600	
00700	PDEC:	IDIVI	A,^D10		;BREAKING DOWN DEC. NUMBER FOR PRINTING
00800		PUSH	P,B		;STORE A+1
00900		CAIE	A,0		;MORE?
01000		PUSHJ	P,PDEC		;BREAK OFF ANOTHER DIGIT
01100		POP	P,CHR		;GET A DIGIT
01200		ADDI	CHR,"0"		;ASCII IT
01300		PUSHJ	P,PUTCHR	;PUBLISH IT
01400		POPJ	P,		;GET ANOTHER OR RETURN
01500	
01600	PTAIL:	MOVEI	A,^D40		;# OF LINES PER PAGE
01700		MOVEM	A,PAGCNT	;SET COUNTER
01800		MOVEI	A,PHD3		;PAGE TRAILER
01900		PUSHJ	P,PSTRIN	;PRINT IT
02000		MOVEI	CHR,14		;FORM FEED
02100		PUSHJ	P,PUTCHR
02200	PTAIL1:	MOVEI	A,PHD3		;PAGE HEADER
02300		PUSHJ	P,PSTRIN	;PUBLISH IT
02400	PCRLFX:	MOVEI	CHR,15		;CR
02500		PUSHJ	P,PUTCHR
02600		MOVEI	CHR,12		;LF
02700		JRST	PUTCHR
02800	
02900	LINBRK:	PUSHJ	P,PCRLFX	;PUT OUT CRLF
03000		SOSG	PAGCNT		;DECR. PAGE COUNTER, PAGE FULL?
03100		PUSHJ	P,PTAIL		;YES
03200		TLNE	F,OSW		;OCTAL DUMP?
03300		PUSHJ	P,OCDUMP	;YES
03400		MOVEI	A,^D100		;# OF CHR PER LINE
03500		MOVEM	A,LINCNT	;SET COUNTER
03600		POPJ	P,
     
00100	RECNUM:	PUSH	P,CHR
00200		AOSE	CNTFLG		;SKIP IF AT RECORD START
00300		JRST	RECNU1		;NOT AT RECORD START
00400		MOVEI	A,PHD5		;RECORD # LABEL
00500		PUSHJ	P,PSTRIN
00600		AOS	RECS
00700		MOVE	A,RECS
00800		PUSHJ	P,PDEC		;PUBLISH # OF RECORDS
00900		MOVEI	CHR,11		;TAB
01000		PUSHJ	P,PUTCHR
01100		MOVEI	CHR,40		;SPACE
01200		PUSHJ	P,PUTCHR
01300	CHPOPJ:	POP	P,CHR
01400		POPJ	P,
01500	RECNU1:	MOVEI	A,PHD4		;MARGIN SPACING
01600		PUSHJ	P,PSTRIN
01700		JRST	CHPOPJ
     
00100			;THIS ROUTINE BUILDS A DECIMAL # FROM TTY:
00200	IN:	SETZ	A,
00300		TLZ	F,NUM!NEGS	;CLEAR FLAGS
00400		PUSHJ	P,GETLIN
00500	LOOPA:	ILDB	B,LINPNT
00600		JUMPE	B,ENDNUM
00700		CAIN	B,"-"
00800		JRST	[TLNN	F,PLUS!NUM	;ALREADY GOT PART OF NUMBER?
00900			 TLOE	F,NEGS	;SET FLAG AND ERROR IF TWICE
01000			 JRST	ERRORB	;GIVE ERROR. BAD ORDER
01100			 JRST	LOOPA ]
01200		CAIN	B,"+"		;PLUS SIGN TYPED?
01300		JRST	[TLNE	F,NEGS!NUM	;ALREADY GOT PART OF NUMBER?
01400			 TLOE	F,PLUS	;SAY PLUS SEEN AND ERROR IF TWICE
01500			 JRST	ERRORB	;ERROR
01600			 JRST	LOOPA ]
01700		CAIL	B,"0"
01800		CAILE	B,"9"
01900		JRST	ERRORB
02000		TLO	F,NUM		;NUMBER SEEN
02100		IMULI	A,^D10
02200		ADDI	A,-60(B)
02300		JRST	LOOPA
02400	ENDNUM:	TLNE	F,NEGS		;NEGATIVE?
02500		MOVN	A,A		;YES. CHANGE SIGN
02600		TLNE	F,NUM		;ANY NUMBER TYPED
02700		POPJ	P,
02800	ERRORB:	OUTSTR	[ASCIZ\
02900	?BCDBNT Bad number. Try again!
03000	\]
03100		CLRBFI
03200		JRST	IN
     
00100			;THIS ROUTINE GATHERS A LINE IN FROM TTY:
00200			;SUPPRESSING ALL BLANKS AND FINISHING WITH A NULL
00300	GETLIN:	MOVE	LINPNT,[POINT 7,LIN]
00400	GETC:	INCHWL	B
00500		CAIE	B," "
00600		CAIN	B,15
00700		JRST	GETC		;THROW AWAY <CR> AND SPACES
00800		CAIN	B,177		;RUBOUT?
00900		JRST	GETC		;IGNORE
01000		CAIL	B,140		;LOWER CASE?
01100		SUBI	B,40		;YES. MAKE IT UPPER
01200		CAIN	B,32		;CONTROL-Z?
01300		EXIT			;YES. JUST EXIT
01400		CAIE	B,33		;ALTMODE?
01500		CAIN	B,12		;OR LINE FEED?
01600		JRST	ENDLIN
01700		IDPB	B,LINPNT
01800		JRST	GETC
01900	ENDLIN:	SETZ	B,
02000		IDPB	B,LINPNT
02100		MOVE	LINPNT,[POINT 7,LIN]
02200		POPJ	P,
02300	
02400	REWIND:	MTREW.	ICH,		;REWIND TAPE
02500		JRST	MTWAIT		;WAIT AND INVALIDATE BUFFERS
02600	
02700	BACKSP:	MTBSF.	ICH,		;BACKSPACE TAPE
02800		JRST	MTWAIT		;WAIT AND INVALIDATE BUFFERS
02900	
03000	SKIPFL:	MTSKF.	ICH,		;SKIP FILE
03100	MTWAIT:	MTWAT.	ICH,
03200		PUSH	P,A		;SAVE COUNT
03300		PUSHJ	P,NEWBUF	;AND INVALIDATE BUFFERS
03400		POP	P,A		;RESTORE COUNT
03500		POPJ	P,		;RETURN
     
00100	TINIT:	MOVSI	B,'BCD'		;OPEN DEVICE BCD
00200		MOVEI	C,IBUF		;FOR INPUT
00300		MOVEI	A,14		;IN BINARY MODE
00400		TRNE	F,DINFLG	;DUMP FLAG?
00500		MOVEI	A,17		;YES. USE DUMP MODE
00600		SKIPN	TAPDEN		;TAPOPS?
00700		TRO	A,<.TFD80>B28	;NO. 800 IN OPEN
00800		OPEN	ICH,A		;DO OPEN
00900		 JRST	NTAVL
01000		MTIND.	ICH,		;INDUSTRY COMPATIBLE
01100		SKIPG	A,TAPDEN	;TAPOPS?
01200		 JRST	NEWBUF		;NO. DONE
01300		MOVEM	A,TAPBLK+2	;YES. SET DENSITY
01400		MOVEI	A,ICH		;SET UP TAPOP.
01500		MOVEM	A,TAPBLK+1
01600		MOVEI	A,.TFDEN+1000
01700		MOVEM	A,TAPBLK
01800		MOVE	A,[XWD 3,TAPBLK]
01900		TAPOP.	A,
02000		 JRST	ERRDEN		;OOPS?
02100	NEWBUF:	MOVE	A,[XWD 400000,BUF1+1]	;SET UP BUFFER RING
02200		MOVEM	A,IBUF
02300		MOVE	A,[POINT 8,0,35]
02400		TLNE	F,DMPFLG		;DUMP TYPE?
02500		MOVE	A,[POINT 36,0,35]
02600		MOVEM	A,IBUF+1
02700		MOVE	A,MBUFN		;GET NUMBER OF BUFFERS
02800		MOVE	B,BUFWDS	;GET WORDS PER BUFFER
02900		SUBI	B,2		;DATA WORDS PLUS ONE
03000		HRLZ	B,B		;IN LEFT
03100		HRR	B,BUFWDS	;POINT RH AT NEXT
03200		ADDI	B,BUF1+1	;...
03300		MOVEI	C,BUF1		;POINT C AT FIRST BUFFER
03400	NEWBF1:	SETZM	(C)		;CLEAR FIRST WORD
03500		MOVEM	B,1(C)		;SET SECOND WORD
03600		SOJLE	A,NEWBF2	;IF LAST BUFFER, DON'T INCREMENT
03700		ADD	B,BUFWDS	;MOVE TO NEXT BUFFER
03800		ADD	C,BUFWDS	;...
03900		JRST	NEWBF1		;SET NEXT BUFFER
04000	NEWBF2:	MOVEI	B,BUF1+1	;MAKE LAST BUFFER POINT TO FIRST
04100		HRRM	B,1(C)		;...
04200		POPJ	P,
     
00100	; SUBROUTINE TO SNOOP OUT SIZE OF BLOCK
00200	WHTSIZ:	MOVSI	B,'BCD'		;OPEN DEVICE BCD
00300		MOVEI	C,IBUF		;FOR INPUT
00400		MOVEI	A,117		;USE DUMP MODE/NO ERROR RETRY
00500		SKIPN	TAPDEN		;TAPOPS?
00600		TRO	A,<.TFD80>B28	;NO. 800 IN OPEN
00700		OPEN	ICH,A		;DO OPEN
00800		 JRST	NTAVL
00900		MTIND.	ICH,		;INDUSTRY COMPATIBLE
01000		SKIPG	A,TAPDEN	;TAPOPS?
01100		 JRST	WHTSZI		;NO. DONE
01200		MOVEM	A,TAPBLK+2	;YES. SET DENSITY
01300		MOVEI	A,ICH		;SET UP TAPOP.
01400		MOVEM	A,TAPBLK+1
01500		MOVEI	A,.TFDEN+1000
01600		MOVEM	A,TAPBLK
01700		MOVE	A,[XWD 3,TAPBLK]
01800		TAPOP.	A,
01900		 JRST	ERRDEN		;OOPS?
02000	WHTSZI:	MOVEI	A,3*^D1024	;ASSUME UNDER THREE K
02100	WHTSZ0:	MOVE	B,A
02200		ADDI	B,BUF1+3	;GET ENOUGH CORE
02300		CAMG	B,.JBREL##
02400		 JRST	WHTSZ1		;GO IT
02500		CORE	B,
02600		 JRST	WHTSZE		;CAN'T. OH WELL
02700	WHTSZ1:	MOVN	B,A		;SET IOWD
02800		HRLM	B,DIOWD
02900		SETOM	BUF1+3		;MAKE BUFFER -1 INCASE NO MTCHR.
03000		MOVE	B,[XWD BUF1+3,BUF1+4]
03100		BLT	B,BUF1+2(A)
03200		IN	ICH,DIOWD	;GET THE BUFFER
03300		 JRST	WHTSZ2		;OK
03400		GETSTS	ICH,B		;GET ERROR STATUS
03500		MTBSR.	ICH,		;BACK UP
03600		MTWAT.	ICH,		;WAIT FOR IT
03700		TRNE	B,40000		;BLOCK TOO LARGE?
03800		TRNE	B,722000	;MAYBE. HOW ABOUT EOT, EOF, ERRORS?
03900		 JRST	WHTSZE		;GIVE ERROR.
04000		JRST	WHSZM2		;JUST BLOCK TOO LARGE. TRY LARGER BUFFER
04100	WHTSZ2:	MTBSR.	ICH,		;BACK OVER RECORD
04200		MTWAT.	ICH,		;WAIT FOR IT
04300		MOVEI	B,ICH		;GET CHARACTER COUNT FROM MONITOR
04400		MTCHR.	B,
04500		 JRST	WHTSZM		;DO IT THE HARD WAY
04600		HLRZ	C,B
04700		TRNE	B,7B29		;ANY CHARACTERS OVER?
04800		ADDI	C,1		;YES. COUNT
04900		CAMGE	C,A		;DID WE HAVE ENOUGH CORE TO READ THAT?
05000		 JRST	WHTSZ3		;YES. KNOW SIZE
05100	WHSZM2:	ADDI	A,^D1024	;DON'T KNOW FOR SURE YET
05200		JRST	WHTSZ0		;TRY A LARGER BUFFER
05300	WHTSZ3:	HLRZ	A,B		;NOW CALCULATE REAL CHARACTER COUNT
05400		IMULI	A,4		;NOT WORD COUNT
05500		LDB	B,[POINT 3,B,29];EXTRA CHARACTERS
05600		CAIGE	B,4		;BEWARE PRE 603 BUG
05700		 JRST	WHTSZ4		;OK
05800		TRCE	B,5
05900		TRCE	B,5
06000		TRC	B,5
06100	WHTSZ4:	ADD	A,B
06200	WHTSZ5:	OUTSTR	[ASCIZ/The length of the current record is /]
06300		PUSHJ	P,DECPRT	;N
06400		OUTSTR	CHARS		;CHARACTERS
06500	WHTSZR:	RELEAS	ICH,
06600		MOVEI	A,BUF1
06700		CORE	A,		;SHRINK CORE
06800		 JFCL			;DON'T CARE
06900		JRST	ASKBLK
07000	WHTSZE:	OUTSTR	[ASCIZ/?BCDCDS Cannot determine size of current record.
07100	/]
07200		JRST	WHTSZR		;RETURN
07300	WHTSZM:	MOVNI	B,1		;SEE WHICH WORDS GOT READ
07400		MOVE	C,A		;WORDS TO LOOK AT
07500		CAME	B,BUF1+2(C)	;MATCH?
07600		 JRST	WHSZM1		;NO. FOUND DATA
07700		SOJG	C,.-2		;KEEP LOOKING
07800		SETZ	A,		;ZERO LENGTH BUFFER?
07900		JRST	WHTSZ5		;SAY SO
08000	WHSZM1:	CAMN	A,C		;FILLED WHOLE BLOCK?
08100		 JRST	WHSZM2		;YES. TRY A BIGGER ONE
08200		MOVE	A,C		;NO. CALCULATE APPROXIMATE CHARACTERS
08300		IMULI	A,4
08400		JRST	WHTSZ5		;AND PRINT IT
     
00100	DECPRT:	JUMPGE	A,DECPRL	;POSITIVE NUMBER?
00200		OUTCHR	["-"]		;NO. PRINT - SIGN
00300		MOVM	A,A
00400	DECPRL:	IDIVI	A,^D10		;GET A DIGIT
00500		HRLM	B,(P)		;STORE IT
00600		JUMPE	A,.+2		;NUMBER GONE TO ZERO?
00700		PUSHJ	P,DECPRL	;NO. GET ANOTHER
00800	RADPR1:	HLRZ	A,(P)		;GET FIRST DIGIT TO PRINT
00900		ADDI	A,"0"		;CONVERT TO ASCII
01000		OUTCHR	A		;PRINT IT
01100		POPJ	P,		;RETURN
01200	
01300	OCTPRT:	SETZ	B,		;CLEAR WORD TWO
01400		LSHC	A,-3		;GET DIGIT
01500		ROT	B,3		;RIGHT JUSTIFIED
01600		HRLM	B,(P)		;STORE IT
01700		JUMPE	A,RADPR1	;GONE TO ZERO?
01800		PUSHJ	P,OCTPRT	;GET NEXT DIGIT
01900		JRST	RADPR1		;PRINT THE DIGIT
02000	
02100	ASKYN:	OUTSTR	YORN		;INSIST ON PROPER RESPONSE
02200	YESNO:	PUSHJ	P,GETLIN	;GET A LINE
02300		ILDB	B,LINPNT	;GET FIRST CHARACTER
02400		JUMPE	B,CPOPJ1	;CARRIAGE RETURN IS NO
02500		CAIE	B,"Y"		;OTHERWISE, MUST BE Y
02600		CAIN	B,"N"		;OR N
02700		 CAIA			;FINE
02800		JRST	ASKYN		;NEITHER
02900		CAIE	B,"Y"		;NOW DECIDE WHICH
03000	CPOPJ1:	AOS	(P)		;NO
03100	CPOPJ:	POPJ	P,		;YES
     
00100			;THIS ROUTINE READS A FILE SPECIFICATION FROM
00200			;THE TELETYPE INCLUDING SWITCHES IF NOSWTH=0
00300	GTSPEC:	SETZM	NAME
00400		SETZM	DEV
00500		SETZB	D,EXT
00600		SETZM	EXT+1
00700		SETZM	EXT+2
00800		PUSHJ	P,GETLIN
00900	LOOPB1:	MOVEI	A,6
01000		MOVE	C,[POINT 6,BUF1]
01100		SETZM	BUF1
01200		SKIPE	DEV		;HAVE WE ALREADY GOT DEVICE
01300		JRST	GETNAM		;YES, DONT DO NEXT
01400		ILDB	B,LINPNT	;GET FIRST CHARACTER
01500		JUMPN	B,GTNAM1	;CHECK FOR NUL INPUT
01600		EXIT			;YES, EXIT
01700	GETNAM:	ILDB	B,LINPNT	;GET A CHARACTER
01800	GTNAM1:	CAIN	B,":"		;IS IT A COLON
01900		JRST	GOTDEV		;YES WE GOT A DEVICE
02000		CAIN	B,"/"		;IS IT A SLASH
02100		JRST	GOTSW		;YES, MUST BE A SWITCH
02200		SKIPE	B		;NULL IS EOL CHAR
02300		CAIN	B,"."		;STARTING EXT?
02400		JRST	GOTFIL		;YES
02500		CAIL	B,"0"
02600		CAILE	B,"Z"		;CHECK LEGAL NAME
02700		JRST	BADNAM
02800		CAILE	B,"9"
02900		CAIL	B,"A"
03000		JRST	.+2
03100		JRST	BADNAM
03200		JUMPLE	A,GETNAM	;SKIP IF ALREADY GOT LEGAL NUMBER
03300		TRC	B,40
03400		IDPB	B,C		;NO, DEPOSIT IT
03500		SOJA	A,GETNAM
03600	GOTDEV:	SKIPE	DEV		;DO WE HAVE A DEVICE ALREADY
03700		JRST	BADNAM		;YES, KILL
03800		MOVE	B,BUF1
03900		JUMPE	B,BADNAM	;INSIST ON VALID DEVICE
04000		MOVEM	B,DEV		;STASH DEVICE
04100		JRST	LOOPB1
     
00100	GOTSW:	TRZE	F,NOSWTH	;SWITCHES ALLOWED?
00200		JRST	BADSW		;NO
00300		TLZ	F,SOMESW	;HAVEN'T SEEN THE SWITCH YET
00400		ILDB	B,LINPNT
00500		CAIN	B,"W"		;IS IT W
00600		TLO	F,WSW!SOMESW	;YES SET WSW
00700		CAIN	B,"A"		;IS IT A
00800		TLO	F,ASW!SOMESW	;YES SET ASW
00900		CAIN	B,"N"		;IS IT N
01000		TLO	F,NSW!SOMESW	;YES SET NCNT SWITCH
01100		CAIN	B,"P"		;IS IT A P
01200		TLO	F,PSW!SOMESW	;SET POSITION TAPE
01300		CAIN	B,"B"		;RESET BLOCKING FACTOR?
01400		TLO	F,BSW!SOMESW	;YES
01500		CAIN	B,"S"		;IS IT S
01600		TLO	F,SSW!SOMESW	;SET SSW
01700		CAIN	B,"D"		;IS IT A D
01800		TLO	F,DSW!NSW!SOMESW	;YES SET DSW AND NSW
01900		TLZN	F,SOMESW	;DID HE TYPE A VALID SWITCH?
02000		 JRST	BADSW		;NO
02100	GOTSWX:	ILDB	B,LINPNT	;GET NEXT CHARACTER
02200		CAIN	B,"/"		;ANOTHER SWITCH?
02300		JRST	GOTSW		;YES. THAT'S OK
02400		JUMPN	B,BADNAM	;TO ENSURE HE DOESN'T EMBED THE SWITCH
02500		TLNE	F,PSW!BSW	;/P AND /B ARE ACTION SWITCHES. NO NAME NEEDED
02600		 POPJ	P,		;NO JUST RETURN
02700		JRST	GTNAM1
02800	BADSW:	OUTSTR	BADSWM		;BAD SWITCH MESSAGE
02900		OUTCHR	B
03000		OUTSTR	BDSWM1		;REST OF BAD SWITCH MESSAGE
03100		JRST	GOTSWX		;EXIT SWITCH ROUTINE
03200	
03300	GOTFIL:	SKIPN	B		;I CANT EXPLAIN HOW THIS ROUTINE WORKS
03400		SKIPN	NAME		;BUT IT DOES
03500		JRST	.+2
03600		JRST	ENDNAM
03700		SKIPE	NAME
03800		JRST	BADNAM
03900		MOVE	C,BUF1
04000		MOVEM	C,NAME
04100		SETZM	BUF1
04200		JUMPE	B,ENDNAM
04300		MOVEI	A,3
04400		MOVE	C,[POINT 6,EXT]
04500		JUMPN	D,BADNAM	;SECOND EXT ILLEGAL
04600		SOJA	D,GETNAM
04700	ENDNAM:	SKIPN	B,DEV		;DO WE HAVE A DEVICE
04800		MOVSI	B,'DSK'		;NO, DEFAULT TO DSK
04900		MOVEM	B,DEV
05000		CAMN	B,[SIXBIT/NUL/]	;IS IT NUL: DEVICE?
05100		POPJ	P,		;YES, SKIP REST
05200		DEVCHR	B,
05300		TLNN	B,(1B15)	;DOES IT HAVE A DIRECTORY
05400		POPJ	P,		;NO
05500		SKIPN	NAME		;YES, DID WE GET ONE
05600		JRST	BADNAM		;NO, KILL
05700		POPJ	P,
     
00100			;THIS ROUTINE READS A SPECIAL CHARACTER SET
00200			;WITH SINGLE SPACES,COMMAS OR CRLFS AS SEPARATORS
00300	SPCINS:	MOVEI	B,1		;ASCII LINE
00400		MOVE	C,DEV		;INPUT DEVICE
00500		MOVEI	D,SBF		;INPUT BUFFER
00600		OPEN	SCH,B
00700		JRST	[OUTSTR	[ASCIZ/
00800	?BCDCID - Can't init DSK/]
00900			EXIT]
01000		LOOKUP	SCH,NAME
01100		JRST	[OUTSTR	[ASCIZ/
01200	?BCDXNF - Special character set file not found/]
01300	 		EXIT]
01400		SETZ	D,		;TABLE INDEX
01500	SPCIN0:	PUSHJ	P,SNUMIN	;GET AN OCTAL NUMBER
01600		CAIL	C,0		;WAS A NUMBER ASSEMBLED?
01700		MOVEM	C,SPCTAB(D)	;YES - STORE IT
01800		TLZE	F,EOFSEN	;EOF?
01900		POPJ	P,		;YES
02000		CAMGE	D,A		;DATA SET TOO LARGE?
02100		JUMPL	C,SPCIN0	;DON'T INCR IF NO CHR ASSEMBLED
02200		AOJA	D,SPCIN0	;NO
02300		OUTSTR	[ASCIZ/
02400	?BCDMCX - More character codes from file than specified
02500	in dialogue/]
02600		EXIT
02700	
02800	SNUMIN:	SETO	C,		;SET TO ZERO WHEN 1ST DIGIT ENCOUNTERED
02900	SNUMI0:	SOSGE	SBF+2
03000		JRST	SNUMGT
03100	SNUMI1:	ILDB	B,SBF+1
03200		JUMPE	B,SNUMI0	;NO NULLS
03300		CAIE	B," "		;BLANK?
03400		CAIN	B,","		;COMMA?
03500		POPJ	P,
03600		CAIN	B,15		;<CR>?
03700		JRST	SNUMI0		;YES
03800		CAIN	B,12		;<LF>
03900		POPJ	P,		;YES
04000		CAIL	B,"0"		;ILL CHR?
04100		CAILE	B,"7"		;ILL CHR?
04200		JRST	[OUTSTR	LIT12
04300			OUTCHR	B
04400			OUTSTR	[ASCIZ/)/]
04500			EXIT]
04600		SUBI	B,"0"		;NO - MAKE IT OCTAL DIGIT
04700		CAIGE	C,0		;SEEN ANY DIGITS PREVIOUSLY?
04800		SETZ	C,		;NO - START NUMBER ASSEMBLY
04900		IMULI	C,^D8
05000		ADD	C,B		;ASSEMBLE THE NUMBER
05100		JRST	SNUMI0
05200	SNUMGT:	IN	SCH,
05300		JRST	SNUMI1
05400		STATZ	SCH,740000	;ERROR OR EOF?
05500		JRST	[OUTSTR	[ASCIZ/
05600	?BCDEOX - Error on input from conversion table file/]
05700			EXIT]
05800		TLO	F,EOFSEN	;EOF
05900		POPJ	P,
     
00100		SUBTTL	ERROR AND OTHER MESSAGES
00200	
00300	NOCORE:	OUTSTR	[ASCIZ/
00400	? BCDICA Insufficient core available.  Cannot convert tape.
00500	/]
00600		EXIT
00700	
00800	BADNAM:	CLRBFI
00900		OUTSTR	[ASCIZ\
01000	?BCDOSI Output specification is illegal! Try again.
01100	\]
01200		JRST	ASKNAM		;TRY IT AGAIN
01300	
01400	NOTAPE:	OUTSTR	[ASCIZ\
01500	?BCDDBM Device BCD must be a magtape!
01600	\]
01700		EXIT
01800	
01900	NTAVL:	OUTSTR	LIT6
02000		EXIT
02100	
02200	NODSK:	OUTSTR	LIT9
02300		EXIT
02400	
02500	NOROOM:	OUTSTR	LIT10
02600		EXIT
02700	
02800	CNVERR:	OUTSTR	LIT13
02900		CLRBFI
03000		JRST	GETCNV
03100	
03200	DMPWRN:	TEXT <
03300	 DUMP mode output is in the form of a binary file.
03400	 To print the file use the /PRINT:OCTAL switch.
03500	>
03600	
03700	LIT0:	TEXT <
03800	 Input code ? >
03900	LIT1:	TEXT <
04000	 Physical blocking factor ? >
04100	LIT2:	TEXT <
04200	 Logical record size ? >
04300	LIT3:	TEXT <
04400	 Rewind tape (Y or N) ? >
04500	LIT4:	TEXT <
04600	 Relative file position ? >
04700	LIT5:	TEXT <
04800	 End of file.
04900	>
05000	NORECS:	TEXT <
05100	%BCDNRP No records processed.
05200	>
05300	LIT6:	TEXT <
05400	?BCDDNA Device BCD is not available or not assigned.
05500	>
05600	LIT7A:	TEXT <
05700	%BCDIDE Input data error (>
05800	LIT7B:	TEXT <)
05900	 Type C to continue, X to exit, I to ignore errors ? >
06000	LIT8:	TEXT <
06100	?BCDEOO Error on output (>
06200	LIT9:	TEXT <
06300	?BCDONA Output device is not available or not assigned.
06400	>
06500	LIT10:	TEXT <
06600	?BCDNRF No room for file on output device.
06700	>
06800	
06900	LIT11:	TEXT <
07000	 NUMBER OF CHARACTERS IN CHARACTER SET?(DECIMAL) >
07100	LIT12:	TEXT <
07200	?BCDICX - Illegal character in conversion table file(>
07300	LIT13:	TEXT <
07400	?BCDICC Invalid conversion code! Options are:
07500	  EBCDIC, UCLABCD, BCDIC, ASCII, CDCBCD, GEBCD, DUMP, or SPECIAL.
07600	SPECIAL requires file,  with each character represented
07700	as an octal number, sepArated by spaces, commas or <CRLF>.
07800	>
07900	
08000	RECPRC:	TEXT < records were processed.
08100	>
08200	ILLCHR:	TEXT <
08300	% BCDICE Illegal characters encountered. Being replaced by \
08400	>
08500	TOTILL:	TEXT < illegal characters were encountered.
08600	>
08700	BADNEG:	TEXT <?BCDNMP - Number must be positive.
08800	>
08900	ATEOT:	TEXT <
09000	?BCDEOT End of tape encountered.
09100	>
09200	YORN:	TEXT < Please respond Y or N : >
09300	BADSWM:	TEXT <%BCDURS Unrecognized switch ">
09400	BDSWM1:	TEXT <" ignored
09500	>
09600	FRTOBG:	TEXT <
09700	?BCDFRT First physical record too long - blocking factor and/or
09800		logical record size probably wrong
09900	>
10000	TOOBIG:	TEXT <
10100	?BCDRTL Physical record too long.
10200	>
10300	OVRSIZ:	TEXT < physical records were longer than specified.
10400	>
10500	FRTOSM:	TEXT <
10600	?BCDFRS First physical record too short - blocking factor and/or
10700		logical record size probably wrong
10800	>
10900	TOOSML:	TEXT <
11000	?BCDRTS Physical record too short.
11100	>
11200	SMLSIZ:	TEXT < physical records were shorter than specified.
11300	>
11400	ILLDEN:	OUTSTR	[ASCIZ/?BCDIDS Illegal density specified.
11500	/]
11600		JRST	GETDEN
11700	BADDEN:	OUTSTR	[ASCIZ/?BCDDCR Drive cannot read at that density.
11800	/]
11900		JRST	GETDEN
12000	ERRDEN:	OUTSTR	[ASCIZ/?BCDSDF Set density failed.
12100	/]
12200		EXIT
12300	CHGBLK:	TEXT <
12400	Do you want to change the blocking factor or logical record size? >
12500	actblk:	TEXT <The actual physical block size is >
12600	CHARS:	TEXT < characters.
12700	>
12800	WORDS:	TEXT < words.
12900	>
13000	PHD1:	TEXT <                                ASCII DUMP  ---   PHYSICAL BLOCKING FACTOR=>
13100	PHD2:	TEXT <   LOGICAL RECORD SIZE=>
13200	PHD3:	TEXT <
13300	                 ----------------------------------------------------------------------------------------------------
13400	                          1111111111222222222233333333334444444444555555555566666666667777777777888888888899999999990
13500	                 1234567890123456789012345678901234567890123456789012345678901234567890123456789012345678901234567890
13600	                 ----------------------------------------------------------------------------------------------------
13700	>
13800	PHD4:	TEXT <                 >
13900	PHD5:	TEXT < RECORD >
     
00100		SUBTTL	EBCDIC CONVERSION
00200	
00300	EBCTAB:							;OCTAL		DECIMAL
00400	EXP 0,1,2,3,4,11,40,177,40,40,40,13,14,15		;0-15		0-13
00500	EXP 16,17,20,21,22,40,40,40,10,40,30,31,40,40,40	;16-34		14-28
00600	EXP 40,40,40,40,40,34,40,40,12,27,33,40			;35-50		29-40
00700	EXP 40,40,40,40,5,6,7,40,40,26,40,40,36,40		;51-66		41-54
00800	EXP 4,40,40,40,40,24,25,40,32,40,40,40,40,40		;67-104		55-68
00900	EXP 40,40,40,40,40,"[",".","<","(","+","^","&",40,40,40	;105-123	69-83
01000	EXP 40,40,40,40,40,40,"!","$","*",")",";","\","-","/"	;124-141	84-97
01100	EXP 40,40,40,40,40,40,40,40,40,",","%","_",">","?"	;142-157	98-111
01200	EXP 40,40,40,40,40,40,40,40,40,40,":","#","@","'"	;160-175	112-125
01300	EXP "=",42,40,141,142,143,144,145,146,147,150,151	;176-211	126-137
01400	EXP 40,40,40,40,40,40,40,152,153,154,155,156,157	;212-226	138-150
01500	EXP 160,161,162,40,40,40,40,40,40,40,40,163,164		;227-243	151-163
01600	EXP 165,166,167,170,171,172,40,40,40,40,40,40,40,40	;244-261	164-177
01700	EXP 40,40,40,40,40,40,40,40,40,40,40,40,40,40,"?"	;262-300	178-192
01800	EXP "A","B","C","D","E","F","G","H","I",40,40		;301-313	193-203
01900	EXP 40,40,40,40,"!","J","K","L","M","N","O","P","Q","R"	;314-331	204-217
02000	EXP 40,40,40,40,40,40,"]",40,"S","T","U","V","W","X","Y","Z" ;332-351	218-233
02100	EXP 40,40,40,40,40,40,"0","1","2","3","4","5","6","7","8","9" ;352-371	234-249
02200	EXP 40,40,40,40,40,40					;372-377	250-255
     
00100		SUBTTL	UCLABCD CONVERSION
00200	
00300	UCLTAB:							;OCTAL		DECIMAL
00400	EXP 0,1,2,3,4,11,40,177,40,40,40,13,14,15		;0-15		0-13
00500	EXP 16,17,20,21,22,40,40,40,10,40,30,31,40,40,40	;16-34		14-28
00600	EXP 40,40,40,40,40,34,40,40,12,27,33,40			;35-50		29-40
00700	EXP 40,40,40,40,5,6,7,40,40,26,40,40,36,40		;51-66		41-54
00800	EXP 4,40,40,40,40,24,25,40,32,40,40,40,40,40		;67-104		55-68
00900	EXP 40,40,40,40,40,"[",".",")","(","+","^","+",40,40,40	;105-123	69-83
01000	EXP 40,40,40,40,40,40,"!","$","*",")",";","\","-","/"	;124-141	84-97
01100	EXP 40,40,40,40,40,40,40,40,40,",","(","_",">","?"	;142-157	98-111
01200	EXP 40,40,40,40,40,40,40,40,40,40,":","=","'","'"	;160-175	112-125
01300	EXP "=",42,40,141,142,143,144,145,146,147,150,151	;176-211	126-137
01400	EXP 40,40,40,40,40,40,40,152,153,154,155,156,157	;212-226	138-150
01500	EXP 160,161,162,40,40,40,40,40,40,40,40,163,164		;227-243	151-163
01600	EXP 165,166,167,170,171,172,40,40,40,40,40,40,40,40	;244-261	164-177
01700	EXP 40,40,40,40,40,40,40,40,40,40,40,40,40,40,"?"	;262-300	178-192
01800	EXP "A","B","C","D","E","F","G","H","I",40,40		;301-313	193-203
01900	EXP 40,40,40,40,"!","J","K","L","M","N","O","P","Q","R"	;314-331	204-217
02000	EXP 40,40,40,40,40,40,"]",40,"S","T","U","V","W","X","Y","Z" ;332-351	218-233
02100	EXP 40,40,40,40,40,40,"0","1","2","3","4","5","6","7","8","9" ;352-371	234-249
02200	EXP 40,40,40,40,40,40					;372-377	250-255
     
00100		SUBTTL	GEBCD CONVERSION
00200	
00300	;SYMBOLS NOT FOUND BELOW ^,\
00400	GETAB:							;OCTAL	DECIMAL
00500		EXP "0","1","2","3","4","5","6","7","8","9"	;0-11	0-9
00600		EXP "\","#","@",":",">","?"," "			;12-20	10-16
00700		EXP "A","B","C","D","E","F","G","H","I"		;21-31	17-25
00800		EXP "&",".","\","(","<","\","\"			;32-40	26-32
00900		EXP "J","K","L","M","N","O","P","Q","R"		;41-51	33-41
01000		EXP "-","$","*",")",";","'","+","/"		;52-61	42-49
01100		EXP "S","T","U","V","W","X","Y","Z"		;62-71	50-57
01200		EXP "_",",","%","=",42,"!"			;72-77	58-63
     
00100		SUBTTL	BCD CONVERSION
00200	
00300	BCDTAB:							;OCTAL	DECIMAL
00400		EXP 0,"1","2","3","4","5","6","7","8","9","0"	;0-12	0-10
00500		EXP "=","'",":",">",42," ","/"		;13-21	11-17
00600		EXP "S","T","U","V","W","X","Y","Z"		;22-31	18-25
00700		EXP "#",",","(","&","\","_","-"			;32-40	26-32
00800		EXP "J","K","L","M","N","O","P","Q","R"		;41-51	33-41
00900		EXP "!","$","*","]",";","@","+"			;52-60	42-48
01000		EXP "A","B","C","D","E","F","G","H","I"		;61-71	49-57
01100		EXP "?",".",")","[","<","%"			;72-77	58-63
     
00100		SUBTTL	CDCBCD CONVERSION
00200	
00300	CDCTAB:							;OCTAL	DECIMAL
00400		EXP ":","1","2","3","4","5","6","7","8","9","0"	;0-12	0-10
00500		EXP "=","\","\","%","["," ","/"			;13-21	11-17
00600		EXP "S","T","U","V","W","X","Y","Z"		;22-31	18-25
00700		EXP "]",",","(","\","\","\","-"			;32-40	26-32
00800		EXP "J","K","L","M","N","O","P","Q","R"		;41-51	33-41
00900		EXP "\","$","*","^","\",">","+"			;52-60	42-48
01000		EXP "A","B","C","D","E","F","G","H","I"		;61-71	49-57
01100		EXP "<",".",")","\","\",";"			;72-77	58-63
     
00100		SUBTTL	DATA LOCATIONS
00200	
00300	LIN:	BLOCK	20
00400	PDL:	BLOCK	40
00500	CNVTAB:	EXP "E","U","G","B","A","C","D","S"
00600	CNVNUM==.-CNVTAB
00700	
00800	CNVLST:	MOVE	CHR,EBCTAB(MATCH)	;EBCDIC TO ASCII
00900		MOVE	CHR,UCLTAB(MATCH)	;UCLABCD TO ASCII
01000		MOVE	CHR,GETAB(MATCH)	;GEBCD TO ASCII
01100		MOVE	CHR,BCDTAB(MATCH)	;BCD TO ASCII
01200		MOVE	CHR,MATCH		;ASCII TO ASCII
01300		MOVE	CHR,CDCTAB(MATCH)	;CDCBCD TO ASCII
01400		MOVE	CHR,MATCH		;BINARY TO BINARY
01500		MOVE	CHR,SPCTAB(MATCH)	;SPECIAL TO ASCII
01600	
01700	CNVLIM:	DEC 255,255,63,63,127,63,255,0	;MAXIMUM LEGAL CHARACTER FOR CONVERSION TYPE
01800	
01900	SPCTAB:	BLOCK	^D256
02000	
02100	SBF:	BLOCK 3
02200	
02300	OUTFIL:
02400	NAME:	Z
02500	EXT:	Z
02600		Z
02700		Z
02800	DEV:	Z
02900	NCNT:	0
03000	
03100	DIOWD:	IOWD	0,BUF1+3	;DUMP I/O WORD
03200		0
03300	IBUF:	BLOCK	3
03400	OB:	BLOCK	3
03500	BUFN:	Z
03600	BUFSIZ:	Z
03700	BLKFAC:	Z
03800	RECSIZ:	Z
03900	NOPNT:	POINT 9,OCBUF
04000	OCBUF:	BLOCK ^D25
04100	
04200	XLIST	;LIT XLISTED
04300	LIT
04400	LIST
04500	VAR
04600	
04700	BUF1:	Z
04800		END	START