Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-09 - 43,50466/wbcd.mac
There are 2 other files named wbcd.mac in the archive. Click here to see a list.
	TITLE WBCD TAPE CONVERSION PROGRAM
	SUBTTL	RUSS BARR - WESTERN MICHIGAN UNIV

	SEARCH	UUOSYM

;THE ORIGINAL VERSION OF THIS PROGRAM WAS A MODIFICATION
;OF BCD.MAC. BCD.MAC WAS WRITTEN BY CHUCK LANE - WMU.

;LOAD INSTRUCTIONS:
;SHARABLE VERSION
;	.LOA WBCD,USESUB
;	.SSA WBCD
;	.PRO<166>WBCD.SHR
;	OR
;NON-SHARABLE VERSION
;	.MA PURE.MAC
;	PURE==0
;	EX$$
;	.LOA WBCD=PURE+WBCD,USAGE
;	.SAV WBCD
;	.PRO<166>WBCD.SAV

IFNDEF PURE,<PURE==1>	;REENTRENT VERSION IF PURE#0
IFN PURE,<TWOSEG>

	VWBCD==04
	VEDIT==02
	VMINOR==02	;SHARABLE VERSION(4-JUN-76)
	VWHO=4

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

	;ACCUMULATOR DEFINITIONS

	F=0		;FLAGS
	A=1
	B=2
	C=3
	D=4
	E=5
	CNVRT=6		;MUST BE PRESERVED(CONVERSION INSTRUCTION)
	CNT=7
	LINPNT=10
	CHR=11
	FPNT=12
	INCNT=13
	RCNT=14
	MATCH=15
	P=17

	; I/O CHANNELS
	ICH==16
	OCH==17
	UCH==15
	SUBTTL	FLAG DEFINITIONS

	;FLAG BITS(LH)
COMSEN==200		;COMMA SEPARATES FILE SPECS

	; FLAG BITS(RH)
IGNORE==200000		;IGNORE ERROR FLAG
NUM==4000		;NUMBER SEEN IN INPUT ROUTINE
NEGS==2000		;NEGATIVE SIGN SEEN
PLUS==1000		;PLUS SIGN SEEN
WLDFLG==400		;WILD SYMBOL '*' OR '?' SEEN

	;FLAG BITS (RH - USED ONLY IN GETNAM)
NSW==40000		;PROCESS N RECORDS ONLY
WSW==20000		;REWIND TAPE
SOMESW==10000		;SOME VALID SWITCH TYPED AFTER /
BSW==200		;TO TRANSFER BINARY FILE EXTENSIONS WITH WILD
STRSET==100		;SINGLE STR WILD SEARCH
XDEV==40
XSLASH==20
XDOT==10
EXTSEN==4
FILSEN==2
DEVSEN==1

TAPLEG:	BLOCK	1
TAPDEN:	BLOCK	1
TAPBLK:	BLOCK	4
	SUBTTL	STARTUP AND DIALOGUE

IFN PURE,<RELOC 400000>

START:	PORTAL	.+2			;BEWARE CCL START
	PORTAL	.+1
	RESET
	OUTSTR	[ASCIZ/
WMU - FILE TO TAPE TRANSLATION PROGRAM
/]
	MOVE	P,[IOWD 40,PDL]
	MOVEI	16,[EXP [ASCII/WBCD  /]]
;	PUSHJ	P,USAGEB##
	MOVE	A,[SIXBIT/WBCD  /]
	DEVCHR	A,
	JUMPE	A,NTAVL		;BCD DOESN'T EXIST
	TLNN	A,(1B13)	;IS BCD A MAGTAPE
	JRST	NOTAPE		;NO
	GETPPN	A,		;GET TRUE PPN
	JFCL			;WORRY ABOUT SKIP RETURNS
	MOVEM	A,PPNSAV#	;NO FANCY-PATHS
	SETZ	F,		;CLEAR ALL FLAGS
	MOVEI	A,5		;SET UP LOW SEG
	MOVEM	A,UFDFIL
	MOVE	A,[1,,1]
	MOVEM	A,UFDPPN
	HRLZI	A,'UFD'
	MOVEM	A,SLFPPN+1	; LOW SEG SET UP.
	MOVEI	A,16
	MOVEM	A,STRBLK
	SETZM	STRBLK+2
	SETZM	TAPDEN		;ASSUME 800 BPI/NO TAPOPS.
	MOVEI	A,.TFPDN	;SET UP FOR TAPOP.
	MOVEM	A,TAPBLK
	MOVE	A,[SIXBIT/WBCD/]
	MOVEM	A,TAPBLK+1
	MOVEI	A,.TFD80
	MOVEM	A,TAPDEN
	MOVE	A,[XWD 3,TAPBLK]
	TAPOP.	A,		;GET LEGAL DENSITIES
	 JRST	GETCNV		;ASSUME NO TAPOPS.
	MOVEM	A,TAPLEG	;SAVE LEGAL DENSITIES
	TRNN	A,TF.DN4!TF.DN5	;ANY GREATER THAN 800 POSSIBLE?
	 JRST	GETCNV		;NO. DON'T ASK
GETDEN:	OUTSTR	[ASCIZ/Tape density: /]
	PUSHJ	P,IN		;GET DENSITY
	CAIGE	A,^D800		;AT LEAST 800?
	 JRST	ILLDEN		;NO. ILLEGAL
	SETZ	B,		;ASSUME ILLEGAL
	CAIN	A,^D800
	MOVEI	B,.TFD80
	CAIN	A,^D1600
	MOVEI	B,.TFD16
	CAIN	A,^D6250
	MOVEI	B,.TFD62
	JUMPE	B,ILLDEN	;ILLEGAL?
	MOVEM	B,TAPDEN	;STORE DESIRED DENSITY
	MOVEI	A,1
	LSH	A,-1(B)		;POSITION BIT
	TDNN	A,TAPLEG	;IS IT LEGAL
	 JRST	BADDEN		;NO.
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
ASKBLK:	OUTSTR	LIT1		;ASK ABOUT BLOCKING FACTOR
	PUSHJ	P,IN
	JUMPG	A,ASKBK1	;MUST BE POSITIVE
	OUTSTR	BADNEG		;COMPLAIN
	JRST	ASKBLK		;AND TRY AGAIN
ASKBK1:	MOVEM	A,BLKFAC
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
	ADDI	A,3
	IDIVI	A,4
	MOVEM	A,BUFSIZ	;# OF WORDS IN BUFFER IS AN EVEN MULTIPLE OF 4
	MOVEI	A,BUF1		;GET LOCATION OF BUFFER
	ADD	A,BUFSIZ	;ADD SIZE OF BUFFER
	MOVE	B,A
	CAMGE	A,.JBREL##	;DO WE NEED MORE CORE
	JRST	OK		;NO
	CORE	A,		;YES GET IT
	JRST	NOCORE		;GIVE ERROR IF CANT GET ENOUGH SPACE
OK:	HRRM	B,.JBFF##	;SAVE NEW TOP TWICE
	HRRM	B,JBFFSV#
	SOJ	B,
	MOVEM	B,HIGHDT	;HIGHEST DATA LOCATION
	MOVN	B,BUFSIZ	;-# OF WORDS IN BUFFER
	HRLI	B,BUF1-1
	MOVSM	B,OUTLST	;SETUP IOWD
	SETZM	OUTLST+1
	PUSHJ	P,TINIT		;INITIALIZE TAPE
POSIT:	OUTSTR	LIT3		;ASK ABOUT REWIND
	PUSHJ	P,YESNO		;SKIP UNLESS 'Y'
	MTREW.	OCH,
	MTWAT.	OCH,
	OUTSTR	LIT4		;ASK ABOUT FILE POSITION
	PUSHJ	P,IN
	JUMPGE	A,SKF
	MTBSF.	OCH,
	MTWAT.	OCH,
	AOJLE	A,.-2		;MUST DO N+1 BACKSPACE COMMANDS
	STATO	OCH,1B24	;AT LOAD POINT?
				;IF NOT, MUST DO ONE SKIP FILE
	MTSKF.	OCH,
	MTWAT.	OCH,
SKF:	SOJG	A,.-2
	SUBTTL	"INPUT?" DIALOGUE

ASKNAM:	TLZE	F,COMSEN	;NOSKIP AND CLEAR IF COMMA SEEN
	JRST	ASKCOM		;COMMA SEEN
	OUTSTR	[ASCIZ/
 INPUT? /]
	PUSHJ	P,GETLIN	;GET NEW LINE
ASKCOM:	SETZM	NAME
	SETZM	DEV
	SETZB	B,EXT
	SETZM	EXT+1
	SETZM	EXT+2
	HLLZS	F		;CLEAR THE GETNAM(RH) SWITCHES
	SETOM	MASK
	SETOM	MASK+1
	HLLZS	MASK+1
GETWRD:	SETZM	BUF1		;CLEAN HOUSE
	SETOM	BUF1+1
	MOVEI	A,6
	MOVE	C,[POINT 6,BUF1]	;ASSEMBLE A WORD HERE
	MOVE	E,[POINT 6,BUF1+1]	;ASSEMBLE MASK HERE
GETNAM:	ILDB	B,LINPNT	;LINPNT SETUP BY GETLIN
	JUMPE	B,GTNAME	;JUMP ON EOL(0)
	CAIE	B,"/"		;SLASH?
	CAIN	B,","		;COMMA?
	CAIA			;SKIP ON EITHER
	JRST	GTNAMF		;NEITHER
GTNAME:	TRNN	F,XSLASH	;XSLASH SET?
	JRST	GTNAMB		;NO
	JRST	GTNAMJ		;YES
GTNAMF:	CAIE	B,"."		;PERIOD?
	JRST	GTNAMG		;NO
	TRON	F,XDOT		;XDOT SET?
	JRST	GTNAMC		;NO
	JRST	BADNAM		;YES
GTNAMG:	CAIE	B,":"		;COLON?
	JRST	GTNAMH		;NO
	TRNN	F,XDEV		;YES, XDEV SET?
	JRST	GTNAMD		;NO
	JRST	BADNAM		;YES, DOUBLE DEV ILLEG.
GTNAMH:	CAIE	B,"*"		;WILD SYMBOL
	JRST	GTNAM2		;NO
	JUMPLE	A,GETNAM	;LEGAL BUT NO MORE ROOM
	TRO	F,WLDFLG	;NO REMEMBER WE'RE WILD
	SETZ	B,		;SET CHR TO ZERO
	IDPB	B,C		;DEPOS IN BUF1
	IDPB	B,E		;DEPOS IN MASK
	SOJG	A,.-2		;FINISH OUT THE WORD
	JRST	GETNAM
GTNAM2:	CAIE	B,"?"		;WILD SYMBOL?
	JRST	GTNAM3		;NO
	JUMPLE	A,GETNAM	;LEGAL CHR BUT NO MORE ROOM
	TRO	F,WLDFLG	;NO, REMEMBER WE'RE WILD
	SETZ	B,		;SET CHR TO ZERO
	IDPB	B,C		;DEPOS IN BUF1
	IDPB	B,E		;DEPOS IN MASK
	SOJA	A,GETNAM	;DECR AND GET NEXT CHR
GTNAM3:	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
	IBP	E		;DON'T DISTURB THE MASK
	SOJA	A,GETNAM
;HERE IF IT LOOKS LIKE A FILE OR EXT
GTNAMB:	TRNE	F,XDOT		;SKIP IF DOT NOT SEEN BEFORE
	JRST	GTNAMI		;SEEN BEFORE
;HERE IF IT ONLY LOOKS LIKE A FILE
GTNAMC:	TROE	F,FILSEN	;SKIP IF FILE NOT SEEN BEFORE AND SET THE BIT
	JRST	BADNAM		;FILE SEEN, DOUBLE FILE ILLEG.
	MOVE	A,BUF1		;GET NAME
	MOVEM	A,NAME		;STORE IT
	MOVE	A,BUF1+1	;GET NAME MASK
	MOVEM	A,MASK		;STORE IT
	CAIE	B,"."		;DOT GOT US HERE?
	JRST	GTNAMM		;NO
	JRST	GETWRD
GTNAMI:	TROE	F,EXTSEN	;SKIP IF EXT NOT SEEN BEFORE AND SET THE BIT
	JRST	BADNAM		;DOUBLE EXT ILLEG.
	MOVE	A,BUF1		;GET EXT
	MOVEM	A,EXT		;STORE IT
	HLLZ	A,BUF1+1	;GET EXT MASK
	MOVEM	A,MASK+1	;STORE IT
GTNAMM:	CAIE	B,"/"		;SLASH GOT US HERE?
	JRST	GTNAMN		;NO
	JRST	GTNAMK		;YES
;SWITCH HANDLER
GTNAMJ:	CAIE	A,5		;CHR COUNT=1?
	JRST	BADNAM		;NO - SINGLE CHR SWITCHES ONLY
	LDB	A,[POINT 6,BUF1,5]	;RIGHT JUST THE 6BIT CHR
	TRZ	F,SOMESW	;FLAG SAYS WE SAY A SWITCH IF SET
	CAIN	A,'B'		;IS IT B?
	TRO	F,BSW!SOMESW	;YES
	CAIN	A,'W'		;IS IT W?
	TRO	F,WSW!SOMESW	;YES
	CAIN	A,'N'		;IS IT N?
	TRO	F,NSW!SOMESW	;YES
	CAIN	A,'P'		;IS IT P?
	JRST	POSIT		;YES, GO TO POSITION TAPE
	CAIN	A,'H'		;IS IT H?
	JRST	[OUTSTR	HLPMES
		JRST	ASKNAM]
	TRZN	F,SOMESW	;DID WE SEE A VALID SWITCH?
	JRST	BADNAM		;NO
GTNAMN:	JUMPE	B,GTNAMZ	;JUMP ON EOL
	CAIE	B,","		;COMMA GOT US HERE?
GTNAMK:	TROA	F,XSLASH	;NO,MUST BE SLASH,SET ITS BIT AND SKIP
	TLOA	F,COMSEN	;YES,SET ITS BIT AND SKIP
	JRST	GETWRD		;MORE TO DO
	JRST	GTNAMZ		;DONE FOR NOW
;DEVICE HANDLER
GTNAMD:	TRZE	F,FILSEN!EXTSEN!XSLASH	;OUT OF ORDER DEV?
	JRST	BADNAM		;YES
	TROE	F,DEVSEN	;SKIP IF DEV NOT SEEN BEFORE AND SET ITS BIT
	JRST	BADNAM		;DOUBLE DEV ILLEG.
	MOVE	A,BUF1		;GET DEV
	MOVEM	A,DEV		;STORE IT
	JRST	GETWRD

	;HERE WHEN END OF SPEC IS ENCOUNTERED
GTNAMZ:	MOVE	B,NAME		;GET NAME
	CAMN	B,[SIXBIT/FINISH/]
	EXIT
	SKIPN	B,DEV		;DO WE HAVE A DEVICE
	MOVSI	B,'DSK'		;NO, DEFAULT TO DSK
	MOVEM	B,DEV
	TRNN	F,WLDFLG	;WILD SET?
	JRST	OINIT		;NO
	DEVPPN	B,
	JRST	[OUTSTR	[ASCIZ/
?NO SUCH DEVICE
/]
		JRST	BADNAM]
	CAME	B,PPNSAV	;SAME?
	JRST	[OUTSTR	[ASCIZ/
?WILD CARD FILENAMES MUST BE FROM A DISK IN YOUR OWN AREA.
/]
		JRST	BADNAM]	;NO
	MOVEM	B,SLFPPN	;UFD LOOKUP BLOCK
	MOVE	B,DEV
	CAME	B,[SIXBIT/NUL/]
	CAMN	B,[SIXBIT/ALL/]
	JRST	[OUTSTR	[ASCIZ/
?DEVICE NOT ALLOWED WITH WILDCARD
/]
		JRST	BADNAM]
	MOVE	C,[5,,DEV]	;FOR DSKCHR
	DSKCHR	C,
	JRST	[OUTSTR	[ASCIZ/
?WILD CARD FROM NON-DISK IS ILLEGAL
/]
		JRST	BADNAM]
	TLNE	C,4		;FILE STRUCTURE OR GENERIC NAME?
	JRST	[OUTSTR	[ASCIZ/
?ILLEGAL FILE STRUCTURE NAME
/]
		JRST	BADNAM]	;NO
	TLNE	C,2		;GENERIC NAME?
	TRO	F,STRSET	;NO - DON'T DO WILD DEVICE
	MOVE	B,NAME		;GET WILDIZED NAME
	MOVEM	B,WILD		;STORE IT
	MOVE	B,EXT		;SAME FOR EXT
	MOVEM	B,WILD+1
	MOVE	B,DEV+4		;IN CASE OF STRSET
	TRNE	F,STRSET	;ONLY ONE STR?
	JRST	STRONC		;YES
	SETOM	STRLOC		;-1 TO GET 1ST STR.
	SUBTTL	STRUCTURE SEARCH

STRLUP:	TRZE	F,STRSET	;ONE STRUCTURE ONLY?(CLEAR STRSET ALSO)
	JRST	ASKNAM		;THIS SPEC DONE
	MOVEI	B,STRLOC	;ADR OF INFO BLOCK
	JOBSTR	B,		;GET NEXT STR
	JRST	[OUTSTR	[ASCIZ/
?JOBSTR ERROR/]
		HALT	.]
	MOVE	B,STRLOC	;GET STR NAME
	JUMPE	B,ASKNAM	;JUMP IF AT FENCE
STRONC:	MOVEM	B,STRUFD
	MOVEM	B,STRDEV
	OUTSTR	[ASCIZ/
/]
	PUSHJ	P,PDVNAM	;PRINT DEVICE IN B
	OUTSTR	[ASCIZ/:
/]
	RELEAS	UCH,
	OPEN	UCH,STRBLK
	JRST	[OUTSTR	[ASCIZ/
?CANT INIT UFD
/]
		JRST	STRLUP]
	LOOKUP	UCH,UFDFIL
	JRST	[OUTSTR	[ASCIZ/
?CANT LOOKUP UFD
/]
		JRST	STRLUP]
MOREUF:	INPUT	UCH,UFDLST
	STATZ	UCH,740000	;ERROR?
	JRST	[OUTSTR	[ASCIZ/
?ERROR READING UFD
/]
		JRST	STRLUP]	;YES
	STATZ	UCH,20000	;EOF IN UFD?
	JRST	STRLUP		;YES, GET ANOTHER
	SETZM	UFLNUM#
	SETZ	D,
	JRST	MOREF1
	SUBTTL	UFD SEARCH

SRHDIR:	TRNN	F,WLDFLG	;WILD SET?
	JRST	ASKNAM		;NO, GO BACK TO DIALOGUE
MOREFL:	MOVE	D,UFLNUM	;YES, GET POINTER INTO UFD BLOCK
	ADDI	D,2		;POINT TO NEXT FILE
	CAILE	D,177		;END OF BLOCK?
	JRST	MOREUF		;YES, GET NEXT BLOCK
	MOVEM	D,UFLNUM	;IT COULD BE A WHILE BEFORE WE GET BACK
MOREF1:	MOVE	A,UFDBLK(D)	;GET FILE NAME
	JUMPE	A,MOREFL	;JUMP ON NUL FILENAME
	MOVEM	A,NAME		;FOR OINIT
	AND	A,MASK		;WILD MASK
	CAME	A,WILD		;MATCH?
	JRST	MOREFL		;NO
	MOVE	A,UFDBLK(D)	;GET NAME BACK
	HLLZ	B,UFDBLK+1(D)	;GET EXT
	MOVE	C,MASK+1	;GET EXT MASK
	MOVEM	B,EXT		;FOR OINIT
	AND	B,MASK+1	;WILD MASK
	CAME	B,WILD+1	;MATCH?
	JRST	MOREFL		;NO
	MOVE	B,EXT		;GET BACK EXT
	CAMN	C,[-1,,0]	;ANY WILD CHRS?
	JRST	NOWILE		;NOT IN EXT
	TRNE	F,BSW		;ARE WE TRANSFERING BIN EXT WITH WILD?
	JRST	NOWILE		;YES, DON'T DISCRIMINATE
	MOVEI	C,BINSIZ	;SIZE OF LIST OF BINARY EXTENSIONS
BINLUP:	CAMN	B,BINLST(C)	;BIN TYPE EXT?
	JRST	[PUSHJ	P,NAMEOU	;BIN BUT TELL HIM FILENAME ANYWAY
		OUTSTR	[ASCIZ/ - NOT TRANSFERED, EXTENSION SIGNIFIES BINARY FILE.
/]
		JRST	MOREFL]
	SOJGE	C,BINLUP
NOWILE:	PUSHJ	P,NAMEOU	;PRINT THE FILE NAME
	SUBTTL	FILE LOOKUP/POINTER SETUP

OINIT:	MOVE	B,JBFFSV	;RECOVER BUFFER SPACE
	MOVEM	B,.JBFF##
	MOVEI	A,1		;ASCII LINE
	TRNE	F,WLDFLG	;UFD OPEN?
	JRST	.+3		;YES
	MOVE	B,DEV
	CAIA
	MOVE	B,STRDEV	;NAME OF STUCTURE NOW BEING READ
	HRRZI	C,IB		;INPUT ONLY
	MOVE	D,PPNSAV	;DON'T ALLOW FANCY-PATHS
	MOVEM	D,NAME+3	;  IN LOOKUP
	OPEN	ICH,A		;OPEN INPUT DEVICE
	 JRST	NODSK
	LOOKUP	ICH,INFIL	;SET UP FILENAME IF ANY
	 JRST	NOFIND
	MOVEI	B,OCH		;SET UP B FOR DEVCHR
	DEVCHR	B,		;DO IT
	TLNE	B,(1B13)	;IS IT A MAGTAPE FOR OUTPUT
	TRZN	F,WSW		;YES, DO THEY WANT REWIND(/W) (ONCE ONLY)
	SKIPA			;NO, NO, NO
	MTREW.	OCH,		;YES, YES, YES
	MTWAT.	OCH,		;MUST WAIT
	SETZB	RCNT,LNGCNT#	;ZERO REC CNT AND NUM OF OVRSIZ REC
	SETZM	PHYCNT#		;ZERO NUMBER OF PHYSICAL RECORDS READ
	HRLOI	B,377777
	MOVEM	B,NCNT		;MAKE NCNT A HUGE NUMBER
	TRNN	F,NSW		;IS NSW SET
	JRST	RDREC2		;NO
RDREC0:	OUTSTR	[ASCIZ/
# Records ? /]
	PUSHJ	P,IN		;GET # OF RECORDS TO PROCESS
	JUMPG	A,RDREC1	;MUST BE POSITIVE
	OUTSTR	BADNEG		;COMPLAIN
	JRST	RDREC0		;AND TRY AGAIN
RDREC1:	MOVEM	A,NCNT		;STASH IN NCNT
RDREC2:	PUSHJ	P,PNIT		;SETUP POINTERS AND COUNTERS FOR BUFFER
	SUBTTL	FILE READ AND CONVERT

LOOP:	TRNN	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.
/]
	CAME	INCNT,BLKFAC	;EMPTY BUFFER?
	PUSHJ	P,OUPART	;NO - WRITE PARTIAL BLOCK
	CLOSE	OCH,0
	CLOSE	ICH,0
	PUSHJ	P,TINIT		;INITIALIZE TAPE AGAIN
	JRST	SRHDIR		;DO IT AGAIN
LOOP1:	MOVE	CNT,RECSIZ	;SET LINE COUNT
LOOP1A:	PUSHJ	P,INCHR		;GET CHR
	JUMPE	MATCH,LOOP1A	;FOR NOW
	CAIN	MATCH,15	;CR?
	JRST	LOOP1A		;YES,IGNORIT
	CAIN	MATCH,12	;PREMATURE END OF RECORD?
	JRST	FILL		;YES
	XCT	CNVRT		;EXECUTE THE CONVERSION INSTRUCTION
	IDPB	CHR,FPNT	;STORE CHR IN OUTPUT BUFFER
	SOJG	CNT,LOOP1A	;JUMP IF RECORD NOT FULL
	AOJ	RCNT,		;#OF TOTAL RECORDS READ
	PUSHJ	P,INCHR		;GET RID OF CRLF
	CAIN	MATCH,15	;CR?
	PUSHJ	P,INCHR		;YES, GET RID OF LF
	CAIE	MATCH,12	;LF?
	JRST	RCDERR		;NO, MUST BE TOO LOG RECORD
MOREL:	SOJG	INCNT,LOOP1	;JUMP IF BLOCK NOT FULL
	PUSHJ	P,OUTING
	JRST	LOOP	

FILL:	AOJ	RCNT,		;#OF TOTAL RECORDS READ
	MOVEI	MATCH,40	;FILL CHR IS A BLANK
	XCT	CNVRT		;TRANSLATE
	JRST	FILL2
FILL1:	IDPB	CHR,FPNT	;DEPOSIT FILL CHR
FILL2:	SOJGE	CNT,FILL1	;DECR COUNT, JUMP IF MORE FILL CHR NEEDED
	JRST	MOREL		;NO MORE FILL FOR THIS RECORD

RCDERR:	AOS	LNGCNT		;COUNT LONG RECORDS
GTNWOK:	PUSHJ	P,INCHR		;CLEAN OUT REST OF TOO LONG LINE
	CAIE	MATCH,12	;LF?
	JRST	GTNWOK		;NO, GET ANOTHER
	MOVE	CNT,RECSIZ	;SETUP LINE COUNT
	JRST	MOREL		;GO BACK

;END OF MAIN READ/CONVERT LOOP
	SUBTTL	I/O SUBROUTINES

INCHR:	SOSGE	IB+2
	JRST	GETBF
	ILDB	MATCH,IB+1
	POPJ	P,
GETBF:	IN	ICH,
	JRST	INCHR

	STATO	ICH,20000	;IS IT EOF
	 JRST	INERR		;NO SOME ERROR
	CLOSE	ICH,0
	CAME	INCNT,BLKFAC	;EMPTY BUFFER
	PUSHJ	P,OUPART	;NO - WRITE PARTIAL BLOCK
	CLOSE	OCH,0		;YES, TELL USER AND GET OUT
	OUTSTR	[BYTE (7)9]	;TAB
	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
	CAMN	A,PHYCNT	;PRINT "ALL" IF SAME
	OUTSTR	[ASCIZ/All/]	;ALL
	OUTSTR	OVRSIZ		;AND ASSOCIATED MESSAGE
CHKST2:	OUTSTR	[BYTE (7)15,12]
	POP	P,(P)		;RESTORE LIST
	PUSHJ	P,TINIT
	JRST	SRHDIR

OUPART:	MOVE	A,BLKFAC	;GET BLOCKING FACTOR
	SUB	A,INCNT		;MINUS RECORDS REMAINING
	IMUL	A,RECSIZ	;NUMBER OF CHARACTERS IN RECORD
	ADDI	A,3		;ROUND AND GET WORDS
	ASH	A,-2
	JUMPLE	A,CPOPJ		;QUIT IF EMPTY
	MOVN	A,A		;NEGATE
	HRLZ	A,A		;BUILD IOWD
	HRR	A,OUTLST
	MOVEM	A,PARLST	;STORE IT
	SETZM	PARLST+1	;END IT
	OUTPUT	OCH,PARLST	;PUT IT OUT
	JRST	OUTIN1		;CHECK IT
OUTING:	OUTPUT	OCH,OUTLST	;OUTPUT THE BUFFER
;A.M. 99.30.1-1 RRB 9-OCT-78
OUTIN1:	STATZ	OCH,742000	;ERROR
	PUSHJ	P,DERR		;HANDLE ERROR
PNIT:	SETZM	BUF1		;CLEAR OUTPUT BUFFER
	MOVE	A,BWD		;BUF1,,BUF1+1
	BLT	A,@HIGHDT	;CLEAR THE BUFFER
	MOVE	FPNT,NFPNT	;BYTE POINTER FOR BUFFER
	MOVE	INCNT,BLKFAC	;RECORD COUNT
	POPJ	P,		;GET BACK

NAMEOU:	MOVEI	E,6
NAMEO1:	LDB	C,[POINT 6,A,5]
	ADDI	C,40		;MAKE IT ASCII
	OUTCHR	C		;PRINT IT
	LSH	A,6		;PRESENT NEXT CHR
	SOJG	E,NAMEO1
	OUTCHR	["."]
	MOVEI	E,3
NAMEO2:	LDB	C,[POINT 6,B,5]
	ADDI	C,40		;MAKE IT ASCII
	OUTCHR	C		;PRINT IT
	LSH	B,6		;PRESENT NEXT CHR
	SOJG	E,NAMEO2
	POPJ	P,
PDVNAM:	MOVEI	E,6
PDVNA1:	LDB	C,[POINT 6,B,5]
	CAIN	C,0		;NO IMBEDDED BLANKS OCCUR
	POPJ	P,		;MUST BE END OF DEV
	ADDI	C,40		;MAKE IT ASCII
	OUTCHR	C		;PRINT IT
	LSH	B,6		;PRESENT NEXT CHR
	SOJG	E,PDVNA1
	POPJ	P,

DERR:	STATZ	OCH,1B25	;PHYSICAL END OF TAPE?
	 JRST	FNDEOT		;YES
	TRNE	F,IGNORE	;IGNORE ERRORS?
	JRST	RESETS		;YES
	OUTSTR	LIT7A		;TELL ABOUT ERROR
	GETSTS	OCH,A		;GET STATUS
	PUSHJ	P,OCTPRT	;AND PRINT THAT TOO
	OUTSTR	LIT7B		;ASK ABOUT SKIPPING BLOCK
	PUSHJ	P,GETLIN
	ILDB	A,LINPNT
	CAIN	A,"X"		;IS IT A X
	EXIT			;YES, EXIT
	CAIN	A,"C"		;IS IT A C
	JRST	RESETS		;YES
	CAIE	A,"I"		;IS IT AN I
	EXIT			;NO, EXIT
	TRO	F,IGNORE
RESETS:	GETSTS	OCH,A		;YES, SET STATUS BACK AND CONTINUE
	TRZ	A,740000
	TRO	F,IGNORE	;IF IGNORE ERROR FLAG ON
	TRO	A,100		;SET IONRCK
	SETSTS	OCH,(A)
	POPJ	P,		;GET BACK

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

INERR:	OUTSTR	LIT8		;TELL USER ABOUT ERROR ON INPUT
	GETSTS	ICH,A		;GET STATUS BITS
	PUSHJ	P,OCTPRT	;TELL HIM ABOUT THEM
	OUTSTR	[BYTE (7) ")",15,12]
	EXIT
	;THIS ROUTINE BUILDS A BASE10 # FROM TTY:
IN:	SETZ	A,
	TRZ	NUM!NEGS	;CLEAR FLAGS
	PUSHJ	P,GETLIN
LOOPA:	ILDB	B,LINPNT
	JUMPE	B,ENDNUM
	CAIN	B,"-"
	JRST	[TLNN	F,PLUS!NUM	;ALREADY GOT SIGN OR PART OF NUMBER?
		 TLOE	F,NEGS	;SET FLAG AND ERROR IF SEEN OTHER SIGN
		 JRST	ERRORB	;GIVE ERROR. BAD ORDER
		 JRST	LOOPA ]
	CAIN	B,"+"		;PLUS SIGN TYPED?
	JRST	[TLNE	F,NEGS!NUM	;ALREADY GOT SIGN OR 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
	TRO	F,NUM		;NUMBER SEEN
	IMULI	A,^D10
	ADDI	A,-60(B)
	JRST	LOOPA
ENDNUM:	TRNE	F,NEGS		;NEGATIVE?
	MOVN	A,A		;YES. CHANGE SIGN
	TRNE	F,NUM		;ANY NUMBER TYPED
	POPJ	P,
ERRORB:	OUTSTR	[ASCIZ\
?WBCBNT 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:	CAMN	LINPNT,[POINT 7,LIN]	;BLANK LINE?
	EXIT			;YES - EXIT
	SETZ	B,
	IDPB	B,LINPNT
	MOVE	LINPNT,[POINT 7,LIN]
	POPJ	P,

TINIT:	MOVE	B,[SIXBIT/WBCD/]
	SETZ	C,
	MOVEI	A,17		;DUMP MODE
	SKIPN	TAPDEN		;TAPOPS?
	TRO	A,<.TFD80>B28	;MAKE IT 800 BPI IN OPEN
	OPEN	OCH,A		;OPEN TAPE FOR OUTPUT
	 JRST	NTAVL
	MTIND.	OCH,		;INDUSTRY COMPATIBLE
	SKIPG	A,TAPDEN	;TAPOPS?
	 POPJ	P,	 ;NO. DONE
	MOVEM	A,TAPBLK+2	;SET UP FOR SET DENSITY
	MOVEI	A,OCH
	MOVEM	A,TAPBLK+1
	MOVEI	A,.TFDEN+1000
	MOVEM	A,TAPBLK
	MOVE	A,[XWD 3,TAPBLK]
	TAPOP.	A,		;SET DENSITY
	 JRST	ERRDEN		;OOPS?
	POPJ	P,
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
	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,.+2		;GONE TO ZERO?
	PUSHJ	P,OCTPRT	;GET NEXT DIGIT
	HLRZ	A,(P)		;GET DIGIT TO PRINT
	ADDI	A,"0"		;CONVERT TO ASCII
	OUTCHR	A		;PRINT IT
	POPJ	P,		;RETURN

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
	SUBTTL	ERROR AND OTHER MESSAGES

NOCORE:	OUTSTR	[ASCIZ/
? WBCICA Insufficient core available.  Cannot WRITE tape.
/]
	EXIT

BADNAM:	CLRBFI
	OUTSTR	[ASCIZ\
?WBCISI Input specification is illegal! Try again.(/H for help)
\]
	SETZ	F,
	JRST	ASKNAM		;TRY IT AGAIN

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

NTAVL:	OUTSTR	LIT6
	EXIT

NODSK:	OUTSTR	LIT9
	EXIT

NOFIND:	OUTSTR	LIT10
	HLLZS	F
	JRST	SRHDIR

CNVERR:	OUTSTR	[ASCIZ/
?WBCICC Invalid conversion code!
  EBCDIC, BCDIC, ASCII, CDCBCD, or GEBCD are valid.
/]
	CLRBFI
	JRST	GETCNV

ILLDEN:	OUTSTR	[ASCIZ/?WBCIDS Illegal density specified.
/]
	JRST	GETDEN
BADDEN:	OUTSTR	[ASCIZ/?WBCDCR Drive cannot write at that density.
/]
	JRST	GETDEN
ERRDEN:	OUTSTR	[ASCIZ/?WBCSDF Set density failed.
/]
	EXIT
	SUBTTL	LITERAL STORAGE

LIT0:	ASCIZ/
 Output code ? /
LIT1:	ASCIZ/
 Physical blocking factor ? /
LIT2:	ASCIZ/
 Logical record size ? /
LIT3:	ASCIZ/
 Rewind tape (Y or N) ? /
LIT4:	ASCIZ/
 Relative file position ? /
LIT6:	ASCIZ/
?WBCDNA Device WBCD is not available or not assigned.
/
LIT7A:	ASCIZ/
%WBCODE Output data error (/
LIT7B:	ASCIZ/)
 Type C to continue, X to exit, I to ignore errors ? /
LIT8:	ASCIZ/
?WBCEOI Error on input (/
LIT9:	ASCIZ/
?WBCONA Output device is not available or not assigned.
/
LIT10:	ASCIZ/
?WBCFNF File not found!
/

RECPRC:	ASCIZ/ records. /
BADNEG:	ASCIZ/?WBCNMP Number must be positive.
/
ATEOT:	ASCIZ/
?WBCEOT End of tape encountered.
/
YORN:	ASCIZ/ Please respond Y or N : /
FRTOBG:	ASCIZ\
?WBCFRT First physical record too long - blocking factor and/or
	logical record size probably wrong
\
TOOBIG:	ASCIZ\
?WBCRTL Physical record too long.
\
OVRSIZ:	ASCIZ/ Longer than specified. /
HLPMES:	ASCIZ\
REPSPONSES TO INPUT? ARE SIMILAR TO THOSE IN SYSTEM PROGRAMS.
FOR EXAMPLE:
	DSKB:FILE.EXT/N
	F?LE*.??T
	MTA1:/W
	TAPE:/N/W
	/P
ETC.

AVAILABLE SWITCHES:
	/B		USING WILD EXTENSION
	/N	TO SPECIFY # OF RECORDS TO TRANSFER(LATER IN DIALOGUE)
	/P	TO POSITION THE OUTPUT MAGTAPE(INPUT? IS REASKED)
	/W	REWIND INPUT(IF MTA)

\
	SUBTTL	EBCDIC CONVERSION TABLE

EBCTAB:	EXP	0,1,2,3,67,55,56,57,26,5,45,13,14,15
	EXP	16,17,20,21,22,100,74,75,62,46,30,31,77
	EXP	47,42,100,65,100,100,132,177,173,133,154,120,175
	EXP	115,135,134,116,153,140,113,141,360,361,362,363,364
	EXP	365,366,367,370,371,172,136,114,176,156,157,174
	EXP	301,302,303,304,305,306,307,310,311
	EXP	321,322,323,324,325,326,327,330,331
	EXP	342,343,344,345,346,347,350,351
	EXP	112,137,340,117,155,100
	EXP	301,302,303,304,305,306,307,310,311
	EXP	321,322,323,324,325,326,327,330,331
	EXP	342,343,344,345,346,347,350,351
	EXP	100,100,100,100,100
	SUBTTL	GEBCD CONVERSION TABLE

GETAB:
EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP	20,77,76,13,53,74,32,57,35,55,54,60,73,52,33,61		;32-47
EXP	0,1,2,3,4,5,6,7,10,11,15,56,36,75,16,17			;48-63
EXP	14,21,22,23,24,25,26,27,30,31,41,42,43,44,45,46		;64-79
EXP	47,50,51,62,63,64,65,66,67,70,71,100,12,100,100,72		;80-95
EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
	SUBTTL	BCD CONVERSION TABLE

BCDTAB:EXP	0,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP	20,52,17,32,53,77,35,14,34,74,54,60,33,40,73,21		;32-47
EXP	12,1,2,3,4,5,6,7,10,11,15,56,76,13,16,72		;48-63
EXP	57,61,62,63,64,65,66,67,70,71,41,42,43,44,45,46		;64-79
EXP	47,50,51,22,23,24,25,26,27,30,31,75,36,55,100,37		;80-95
EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
	SUBTTL	CDCBCD CONVERSION TABLE

CDCTAB:EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP	20,100,100,100,53,16,100,100,34,74,54,60,33,40,73,21		;32-47
EXP	12,1,2,3,4,5,6,7,10,11,0,77,72,13,57,100			;48-63
EXP	100,61,62,63,64,65,66,67,70,71,41,42,43,44,45,46		;64-79
EXP	47,50,51,22,23,24,25,26,27,30,31,17,14,32,55,100		;80-95
EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
EXP	100,100,100,100,100,100,100,100,100,100,100,100,100,100,100,100
	SUBTTL	DATA LOCATIONS

CNVTAB:	EXP "E","G","B","A","C"
CNVNUM==.-CNVTAB

CNVLST:	MOVE	CHR,EBCTAB(MATCH)	;EBCDIC 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

NFPNT:	POINT 8,BUF1
BWD:	XWD	BUF1,BUF1+1

BINLST:	SIXBIT/ABS   AWT   BAC   BIN   BUG   CAL   CHN   CKP   /
	SIXBIT/CRF   DAE   DMP   DRW   EXE   HGH   LOW   MIM   /
	SIXBIT/MSB   OVL   OVR   PLO   QUE   QUF   REL   RIM   /
	SIXBIT/RMT   RTB   SAV   SFD   SHR   SVE   SYM   SYS   /
	SIXBIT/TMP   UFD   VMX   XOR   XPN   /
BINSIZ==.-BINLST-1

UFDLST:	IOWD 200,UFDBLK
	Z

XLIST	;LIT FOLLOWS
LIT
LIST
	SUBTTL	WRITABLE DATA STORAGE

IFN PURE,<RELOC>
XLIST
VAR
LIST
;VAR  XLISTED


LIN:	BLOCK	20
PDL:	BLOCK	40
INFIL:
NAME:	BLOCK 4
EXT=NAME+1
DEV:	BLOCK 5
NCNT:	BLOCK 1
HIGHDT:	BLOCK	1	;HIGHEST ACTUAL DATA LOCATION

IB:	BLOCK	3
BUFSIZ:	BLOCK 1
BLKFAC:	BLOCK 1
RECSIZ:	BLOCK 1
MASK:	BLOCK 2
WILD:	BLOCK 2
STRDEV:	BLOCK 1
STRLOC:	BLOCK 3
UFDFIL:	BLOCK 6
UFDPPN=UFDFIL+1
SLFPPN=UFDFIL+2
UFDBLK:	BLOCK 200
STRBLK:	BLOCK 3
STRUFD=STRBLK+1
OUTLST:	BLOCK 2
PARLST:	BLOCK	2
BUF1:	BLOCK 1	;BUFFER AREA(DYNAMIC)
	END	START