	.TITLE	NCT...
/
/  20 APR 78 (023; PDH) MAKE SOME CHANGES TO LUN'S
/  11 NOV 77 (022; PDH) PRINT 58 LINES PER PAGE
/  11 NOV 77 (021; PDH) CHANGE 'XSW' FLAG CHECKING IN 'PUNCH'
/  11 NOV 77 (020; PDH) CORRECT MINOR BUG AFTER 'GETCM3'
/   8 NOV 77 (019; PDH) ADD 'X' OPTION; CLEAN UP MINOR NIT WITH ERRORS
/  18 OCT 77 (017; PDH) CHANGE TO LUN 5 FROM LUN 14 FOR PACKED INPUT
/   3 OCT 77 (016; PDH) MAKE SURE WE RECOGNIZE '8' & '9' AS DIGITS
/  21 DEC 76 (015; PDH) FIX COMMAND STRING SO WE CAN DO 'BABCOCK'
/   4 NOV 76 (013; PDH) ADD SOME MORE GOODIES
/   3 NOV 76 (012; PDH) CHANGE FROM 'CODE' TO 'NCT...' FOR
/			USE WITH BATCH, FILE NAMES, ETC.
/  18 OCT 76 (010; PDH) CONVERT TO RSX
/  26 MAR 76 (PDH) CORRECT SUBROUTINE ENTRY
/  19 DEC 75 (PDH) SHUT DOWN PROPERLY AFTER ILLEGAL CHARACTER
/  16 DEC 75 (PDH) RE-ARRANGE PROGRAM LAYOUT AND MAKE
/		   A SINGLE VERSION TO BE ALTERED EXTERNALLY
/  24 NOV 75 (PDH) REMOVE 'UNICOD' CONDITIONALS
/  10 NOV 75 (PDH) PERFORM BULK STORAGE DATA VALIDITY CHECK & PREPARE FOR
/		   SPECIFIC PATCHES TO CODE CONVERSION TABLE
/   5 JUL 74 (PDH) CONDITIONALIZE FOR UNICOD & PREPARE FOR UNBUFFERED VERSION
/  14 JUN 74 (PDH) PUNCH ARROW ON LEADER PORTION OF TAPE
/   5 JUN 73 (PDH) IGNORE LEADING LINE FEEDS
/   3 APR 72 - PAUL HENDERSON
/
	.DEC
TT=13								/(023)
CD=5		/ LUN FOR PACKED DECK CARD INPUT
PP=7
BD=12		/ DEFAULT INPUT LUN IS 12 (BATCH DEVICE)
DK=15		/ OR 15 (FILE INPUT)				/(023)
LP=6		/ LUN 6 FOR LISTING				/(023)
PAGELN=58	/ 58 LINES PER PAGE WHEN LISTING		/(022)
	.OCT
X10=10				/ INPUT POINTER
X11=11				/ OUTPUT POINTER
X14=14
PCHSIZ=174	/ NUMBER OF CHARACTERS PER PUNCH BUFFER
IDX=ISZ		/ INDEX POINTER, NO SKIP INTENDED
INC=ISZ		/ INCREMENT COUNTER (ALWAYS POSITIVE)
/
	.EJECT
/  THIS IS A TDV FUNCTION TASK WHICH PRODUCES A NUMERICAL CONTROL (NC)
/  TAPE FROM SEVERAL TYPES OF INPUT CARDS OR FILES.  IN ITS DEFAULT
/  STATE, 'NCT' ASSUMES THAT IT WILL BE INVOKED FROM BATCH TO
/  PRODUCE TAPES FOR ME548.  IT CAN, HOWEVER, READ THE INPUT DATA FROM
/  ANY LUN AND ANY FILE NAME.  NOTE THAT THE EXTENSION MUST BE 'SRC'.
/  IT CAN ALSO PRODUCE TAPES FOR ME648, MARSLAND ENGINEERING, AND
/  BABCOCK-WILCOX.  IT WOULD NOT BE DIFFICULT TO EXTEND THIS FOR OTHER
/  TYPES OF INPUT AND OUTPUT.
/     'END OF DECK' IS SIGNIFIED BY A '$EOF' CARD WHEN THE INPUT LUN
/  IS 12 OR '/*' IN COLUMNS 1 & 2 WHEN INPUT LUN IS 5, AND THE PROGRAM
/  IS UNDER CONTROL BY BATCH.  WHEN THE INPUT IS FROM A FILE, THE
/  NORMAL 'EOF' (DATA MODE 5) WILL WORK, AS WILL '/*'.
/
/  USE:
/
/	[$]NCT[ O][_][N][ L]
/
/ WHERE	'$' IS REQUIRED FOR BATCH PROCESSING
/	'O' IS AN OPTION AS DESCRIBED BELOW
/	'_' IS NECESSARY ONLY IF NAME AND/OR LUN IS SPECIFIED
/	'N' IS ANY VALID FILE NAME NOT BEGINNING WITH A NUMERAL
/	'L' IS USED TO SPECIFY A NON-DEFAULT LUN.  DEFAULT VALUES ARE:
/		12 (BATCH DEVICE) FOR UNPACKED, NON-FILE-ORIENTED INPUT
/		 5 FOR PACKED, NON-FILE-ORIENTED INPUT, AND
/		15 FOR ALL FILE-ORIENTED INPUT.
/
/  PRESENTLY IMPLEMENTED OPTIONS ARE:
/
/		L - PRODUCE LISTING OF INPUT DECK		/(018)
/		X - DON'T PRODUCE PAPER TAPE			/(019)
/		6 - ME648 PACKED DECKS
/		M - MARSLAND ENGINEERING PACKED DECKS
/		B - BABCOCK-WILCOX UNPACKED DECKS, 72 CHARACTERS/RECORD
/
/  ANY OTHER CHARACTER IN THE OPTION FIELD IS IGNORED.
/  SPACES MAY BE FREELY USED IN ANY FIELD.
/
	.EJECT
	.GLOBL	PACK,UNPACK,.TABLE,.EOB,.COUNT,.LEADR
/
/  THE FOLLOWING ARE THE EXTERNALLY ALTERABLE PARAMETERS
/
.COUNT	-120			/ 80 CHARACTERS PER CARD
.EOB	200			/ END OF BLOCK CODE
.LEADR	177			/ USE 'DELETE' CODE FOR DEFAULT LEADER
/
/
/  CHARACTER FETCHING ROUTINES USED IN THE COMMAND LINE DECODING.
/
/  GETCHR -  CALLING SEQUENCE:  (RETURNS WITH CHAR IN AC)
/
/	JMS	GETCHR
/	(RETURN IF LINE TERMINATOR)
/	(NORMAL RETURN)
/
GETCHR	XX
	LAC*	X10		/ GET CHARACTER
	SNA
	JMP	.-2		/ IGNORE NULL CHARACTERS
	SAD	(175		/ CHECK FOR ALT MODE
	SKP
	SAD	(15		/ AND CARRIAGE RETURN
	JMP*	GETCHR		/ TERMINATOR EXIT
	IDX	GETCHR		/ INCREMENT TO
	JMP*	GETCHR		/ NORMAL RETURN
/
/  SUBROUTINE 'GETCH2', USED TO FETCH THE NEXT CHARACTER WHEN
/  ASSEMBLING THE SPECIFIED FILE NAME.  ON A SPACE OR LINE
/  TERMINATOR, DO NOT RETURN.
/
GETCH2	XX
	JMS	GETCHR
	SKP
	SAD	(40
	JMP	GOTNAM		/ END OF FILE NAME
	JMP*	GETCH2
/
/
	.EJECT
NCT...	CAL	XFRCMD		/ READ COMMAND STRING FROM TDV
	CAL	WTFRCD
	LAW	-1
	TAD	EVCD		/ EV=+1 FOR ALT MODE; EV=+2 FOR CR
	DAC	TERMIN		/ SAVE ALTMODE(0) OR CR(NON-ZERO) TERMINATOR
	LAC	(ILINE+2
	DAC	UNPCMD+1
	LAC	(IMAGE		/ POINTERS FOR UNPACK
	DAC	UNPCMD+2
	AAC	-1
	DAC*	(X10
UNPCMD	JMS*	UNPACK
	0; 0
	SMA
	JMP	UNPCMD
	DZM	LSTSW		/ CLEAR 'LISTING WANTED' FLAG	/(018)
	DZM	XSW		/ CLEAR 'NO TAPE WANTED' FLAG	/(019)
	LAW	-PCHSIZ
	DAC	OCNT		/ 'PCHSIZ' CHARACTERS/OUTPUT BUFFER
	LAC	(WORK-1
	DAC*	(X11
	AND	(070000
	TCA
	DAC	XADJ		/ INDEX REGISTER ADJUSTMEMT
	TAD	(.TABLE		/ PREPARE TO RESET THE
	PAX			/ TRANSLATE TABLE TO
	LAW	-1
	DAC	40,X		/ THE DEFAULT 'ME548' VALUES.
	AAC	1+112		/ SET AC=112
	DAC	43,X
	AAC	177-112		/ AC=177
	DAC	46,X
	AAC	114-177		/ AC=114
	DAC	52,X
	AAC	BD-114		/ AC='BD' FOR LUN 12 DEFAULT INPUT LUN
	DAC	CDLUN
	DZM	TMPLUN		/ VARIABLE USED FOR CONSTRUCTION OF
	LAW	-120		/ NEW 'CDLUN'
	DAC	.COUNT
	AAC	200+120		/ AC=200
	DAC	.EOB
	AAC	177-200		/ AC=177
	DAC	.LEADR
/
	.EJECT
GETCM1	JMS	GETCHR		/ FETCH A CHARACTER FROM COMMAND LINE
	JMP	BEGINU		/ RETURN IF NO OPTIONS
	SAD	(40
	SKP
	JMP	GETCM1		/ FLUSH COMMAND STRING TO THE FIRST SPACE
/
GETCM2	JMS	GETCHR		/ LOOK FOR AN OPTION OR DELIMITER
	JMP	BEGINU
	SAD	(137		/ '_' IS OPTION DELIMITER
	JMP	GETCM3
CK6	SAD	(66		/ '6'? (DEFAULT OPTION '5' NOT CHECKED)
	SKP
	JMP	CKM
ME648	AAC	20-66		/ AC=20
	DAC	40,X		/ CHANGE 'SPACE' TRANSLATION
ME648B	DZM	.EOB		/ PACKED DECK
	LAC	(CD		/ LUN 'CD' DEFAULT FOR PACKED DECKS/(017)
	DAC	CDLUN
ME648C	LAW	-110
	DAC	.COUNT		/ 72 CHAR/RECORD
	DZM	.LEADR		/ BLANK LEADER
	JMP	GETCM2
/
CKM	SAD	(115		/ 'M'?
	SKP
	JMP	CKB
MARSLD	AAC	20-115		/ AC=20
	DAC	40,X		/ CHANGE 'SPACE' TRANSLATION
	AAC	13-20		/ AC=13
	DAC	43,X		/ '#'
	AAC	160-13		/ AC=160
	DAC	46,X		/ '&'
	AAC	76-160		/ AC=76
	DAC	52,X		/ '*'
	JMP	ME648B		/ THEN DO THE USUAL THINGS FOR PACKED DECK
/
CKB	SAD	(102		/ 'B'?
	SKP
	JMP	CKL						/(018)
BABCOX	AAC	20-102		/ AC=20
	DAC	40,X		/ STANDARD 'SPACE' TRANSLATION
	JMP	ME648C		/ UNPACKED DECK, 72 CHAR/RECORD
/
CKL	SAD	(114		/ 'L'?				/(018)
	DAC	LSTSW		/ YES.  SET 'LISTING WANTED'	/(018)
CKX	SAD	(130		/ 'X'?				/(019)
	DAC	XSW		/ YES.  SET 'NO TAPE WANTED'	/(019)
	JMP	GETCM2						/(018)
/
	.EJECT
/  OPTIONS HAVE ALL BEEN SPECIFIED.  LOOK FOR FILE NAME AND/OR CDLUN.
/
GETCM3	JMS	GETCHR		/ GET NEXT CHARACTER FROM COMMAND LINE
	JMP	BEGINU
	SAD	(40
	JMP	GETCM3		/ FLUSH SPACES
	DAC	IMAGE		/ SAVE TEMPORARILY
	SAD	(70		/ CHECK FOR '8'
	SKP
	SAD	(71		/ AND '9'
	JMP	GTLUN
	AND	(170
	SAD	(60		/ IS IT A DIGIT OR A CHARACTER?
	JMP	GTLUN		/ DIGIT.  MUST BE LUN SPECIFICATION.
	LAC	(2
	PAL			/ USE INDEX REGISTER FOR STORING/(020)
	CLX			/ THE SPECIFIED FILE NAME
	DZM	SEEKNM+1	/  START WITH VIRGIN FILE NAME
	LAC	IMAGE		/ RETRIEVE CHARACTER
	JMP	FNAME2
/
FNAME	JMS	GETCH2		/ GET NEXT CHARACTER
FNAME2	ALSS	14
	DAC	SEEKNM,X	/  STORE 1ST CHARACTER IN WORD
	JMS	GETCH2
	AND	(77
	ALSS	6
	XOR	SEEKNM,X
	DAC	SEEKNM,X	/  SECOND CHARACTER
	JMS	GETCH2
	AND	(77
	XOR	SEEKNM,X
	DAC	SEEKNM,X	/ 3RD CHARACTER
	AXS	1
	JMP	FNAME		/ GO DO 2ND WORD
/
	.EJECT
GOTNAM	LAC	(DK		/ DEFAULT LUN 'DK' FOR FILE INPUT/(019)
	DAC	CDLUN
GETCM4	JMS	GETCHR
	JMP	BEGINU
	DAC	IMAGE
	SAD	(70		/ CHECK FOR '8'
	SKP
	SAD	(71		/ AND '9'
	JMP	GTLUN
	AND	(170
	SAD	(60		/ LOOK FOR A DIGIT
	SKP
	JMP	GETCM4		/ WAIT FOR A DIGIT TO BE FOUND
/
GTLUN	LAC	IMAGE
	AND	(7
	DAC	IMAGE		/ EXTRACT ONLY THE VALUE PART
	CLL
	LAC	TMPLUN
	MUL;	12		/ MULTIPLY BY 10 (DECIMAL)
	LACQ
	TAD	IMAGE		/ COMBINED NUMERICAL VALUE
	DAC	TMPLUN		/ SAVE UPDATED VALUE.
	JMP	GETCM4
/
	.EJECT
BEGINU	LAC	TMPLUN		/ HAVE WE SPECIFIED A LUN?
	SZA
	DAC	CDLUN		/ YES.  STORE IT
	LAC	CDLUN
	DAC	HINFCD+2
	DAC	ATTCD+2
	DAC	SEEKCD+2	/INSERT INTO APPROPRIATE CPB'S
	DAC	READCD+2
	DAC	CLOSCD+2
	DAC	DETCD+2
/
	CAL	HINFCD		/ FIND OUT WHAT SORT OF
	CAL	WTFRCD		/ INPUT DEVICE WE HAVE
	LAC	EVCD
	SPA!TCA
	JMP	ERRCD
	LAC	EVCD
	AND	(200000		/ IS IT REALLY AN INPUT DEVICE?
	SZA
	JMP	.+3
	LAW	776		/ NO. ERROR 776
	JMP	ERRCD
	LAC	EVCD
	AND	(040000		/ IS IT DIRECTORIED?
	SZA
	JMP	OPEN
	CAL	ATTCD		/ NO.  ATTACH THE DEVICE
	CAL	WTFRCD		/ WAIT FOR IT TO HAPPEN
/
	.EJECT
OPEN	CAL	SEEKCD
	CAL	WTFRCD
	LAC	EVCD
	SAD	(-6		/ UNIMPLEMENTED FUNCTION?
	CLA			/ UNIMPLEMENTED FUNCTIONS IGNORED
	SPA!TCA
	JMP	ERRCD
	CAL	ATTPP		/ ATTACH THE PUNCH
	JMS	WTFPP
	CAL	ATTLP		/ ATTACH PRINTER		/(018)
	JMS	WTFLP						/(018)
	LAC	LSTSW						/(022)
	SZA							/(022)
	CAL	WRFF		/ BEGIN LISTING WITH FORM FEED	/(022)
	LAW	-PAGELN		/ RESET LINES-PER-PAGE COUNTER	/(022)
	DAC	LNCNT						/(022)
	DZM	ERRCNT		/ ZERO ERROR COUNTER
	LAW	-3
	DAC	COUNT
	LAC	XSW		/ DELETE PAPER TAPE?		/(019)
	SZA							/(019)
	JMP	INITCD		/ NO ARROWS IF NO TAPE		/(019)
WRARO	CAL	WARROW		/ PUNCH 3 ARROWS
	JMS	WTFPP
	ISZ	COUNT
	JMP	WRARO
/
	CAL	WARROW		/ PUNCH THE 4TH ARROW
/
/  NOW PUNCH THE LEADER
/
	JMS	LEADER
/
	.EJECT
/  NOW BEGINS THE MAIN CODE
/
INITCD	CAL	READCD		/ READ 1ST CARD
/
WAITCD	CAL	WTFRCD		/ WAIT FOR THE CARD
	LAC	EVCD
	SPA!TCA
	JMP	ERRCD
	LAC	ILINE
	AND	(7
	SAD	(2		/CHECK FOR END OF FILE
	SKP
	JMP	DONE
	LAW	777760
	AND	ILINE+2
	SAD	SLSTAR		/ '/*' ?
	JMP	DONE1		/ YES.  END OF DECK.		/(018)
	LAC	LSTSW		/ LISTING WANTED?		/(018)
	SNA							/(022)
	JMP	W2		/ NO.  BYPASS LISTING OPERATION	/(022)
	CAL	WRLST		/ YES.  OUTPUT THE INPUT LINE	/(018)
	ISZ	LNCNT		/ END OF PAGE YET?		/(022)
	JMP	W2						/(022)
	CAL	WRFF		/ YES.  OUTPUT A FORM FEED	/(022)
	LAW	-PAGELN		/ THEN RESET PAGE LENGTH COUNTER/(022)
	DAC	LNCNT						/(022)
W2	LAC	(ILINE+2					/(022)
	DAC	UNP+1		/INITIALIZE POINTERS
	LAC	(IMAGE-1
	DAC*	(X10
	DAC	UNP+2
	IDX	UNP+2
UNP	JMS*	UNPACK
	0; 0
	SMA
	JMP	UNP
	LAC	LSTSW		/ LISTING?			/(018)
	SZA							/(018)
	JMS	WTFLP		/ MUST WAIT FOR LISTING		/(018)
	CAL	READCD		/ BEGIN READING NEXT LINE AS
	LAC	.COUNT		/ SOON AS LINE BUFFER FREE
	DAC	COUNT		/COLUMN COUNTER
	LAC*	X10
	SAD	(12		/ IGNORE LEADING LINE FEED
/
	.EJECT
TR	LAC*	X10		/PICK UP NEXT CHARACTER
	PAX
	LAC	TABLE,X		/PICK UP TRANSLATED VALUE
	SPA			/WILL BE -1 IF ILLEGAL CHARACTER
	JMP	ERROR
	JMS	PUNCH		/ STORE.  RETURN WITH CHARACTER IN AC
	SAD	.EOB		/ CONDITIONALLY TEST FOR END OF BLOCK
	JMP	BRANCH		/ BEGIN ON NEXT LINE IF TEST TRUE
	ISZ	COUNT		/ TRANSLATE ONLY '.COUNT' CHARACTERS
	JMP	TR
BRANCH	JMP	WAITCD
/
DONE1	LAC	LSTSW		/ ARE WE PRODUCING LISTING?	/(018)
	SZA							/(018)
	CAL	WRLST		/ MUST ALSO LIST '/*'		/(018)
DONE	LAC	ERRCNT
	SZA!CLA!IAC		/ IF WE HAD ANY ERRORS, SET 'ERRCNT'
	DAC	ERRCNT		/ TO NON-OVERFLOW CONDITION TO
	JMS	LEADER		/ PUNCH SOME LEADER-TRAILER
PAD	LAW	-1
	XOR	OCNT
	SNA!CLA
	JMP	PADDED		/ PAD LAST BUFFER WITH BLANKS UNTIL
	JMS	PUNCH		/ THE BUFFER IS PUNCHED OUT
	JMP	PAD
/
PADDED	JMS	PUNCH		/ THIS ONE WRITES OUT LAST BUFFER
	LAC	XSW						/(019)
	SZA							/(019)
	JMP	XIT		/ NO TRAILER IF NO TAPE		/(019)
	CAL	WARROW		/ OUTPUT FINAL ARROW,
	DZM	.LEADR
	JMS	LEADER		/ OUTPUT SOME BLANK TAPE,
	JMS	WTFPP		/ WAIT FOR IT,
	CAL	CLOSPP		/ THEN CLOSE DEVICE.
	JMS	WTFPP		/ MAKE SURE OF GOOD CLOSE
	JMP	XIT		/ THEN EXIT
/
	.EJECT
XIT	CAL	DETPP		/ DETACH THE PUNCH WHEN THROUGH.
	JMS	WTFPP
	CAL	CLOSCD		/ CLOSE INPUT DEVICE
	CAL	WTFRCD
	CAL	CLOSLP		/ CLOSE LISTING			/(018)
	CAL	DETLP		/ DETACH PRINTER		/(018)
	CAL	WTFRLP		/ WAIT UNTIL DETACHED		/(018)
	CAL	DETCD		/ DETACH INPUT DEVICE
	CAL	WTFRCD
	LAC	ERRCNT		/ CHECK IF THERE WERE ERRORS
	SZA
	CAL	WERRMT		/ TELL OPERATOR TO CHECK FOR ERRORS
	CAL	WREND
	LAC	TERMIN
	SZA
	CAL	REQTDV		/ REQUEST 'TDV' IF NOT ALT MODE TERMINATOR
	CAL	WTFRTT		/ WAIT FOR TTY
	CAL	(10
/
	.EJECT
/  SUBROUTINE 'PUNCH' OUTPUTS THE TRANSLATED BINARY IN 124 CHARACTER BUFFERS
/
PUNCH	XX
	DAC	OSAVE		/ SAVE CHARACTER FOR RESTORATION ON EXIT
	LAW	-5
	TAD	ERRCNT		/ WHEN THERE ARE MORE THAN 5 ERRORS,
	SMA			/ WE ASSUME THAT THE USER CANNOT
	JMP	SHORT		/ KEY IN HIS MISSING DATA ON-LINE.
	LAC	OSAVE		/ RETRIEVE CHARACTER
	DAC*	X11		/ STORE CHARACTER IN BUFFER
	ISZ	OCNT		/ IS BUFFER FULL?
	JMP*	PUNCH		/ NOT YET. LEAVE (CHAR STILL IN AC)
/
	JMS	WTFPP		/ WAIT FOR PREVIOUS PP I/O
	LAC	(WORK-1
	DAC*	(X14		/ BUFFER FULL. PREPARE TO MOVE BUFFER
	LAC	(LINE+1		/ TO OUTPUT BUFFER
	DAC*	(X11
	LAW	-PCHSIZ
	DAC	OCNT
MOVOUT	LAC*	X14
	DAC*	X11		/ MOVE THE BUFFER
	ISZ	OCNT
	JMP	MOVOUT
	LAC	XSW		/ NO PUNCHING IF 'XSW' SET	/(021)
	SNA							/(021)
	CAL	WRPPBF		/ WRITE IT OUT
	LAC	WCOUNT
	TAD	(PCHSIZ		/ UPDATE CHARACTERS TRANSLATED
	DAC	WCOUNT
	LAW	-PCHSIZ
	DAC	OCNT
	LAC	(WORK-1		/ RESET THE POINTER & COUNTER
	DAC*	(X11
SHORT	LAC	OSAVE		/ RETRIEVE CHARACTER AT ENTRY
	JMP*	PUNCH
/
	.EJECT
/  SUBROUTINE TO PUNCH LEADER-TRAILER
/
LEADER	XX
	LAW	-PCHSIZ-1	/ ENOUGH TO JUST OVERFLOW 'OCNT'
	DAC	COUNT		/ IF BLANK LEADER
LEAD1	LAC	.LEADR
	JMS	PUNCH		/ OUTPUT SPECIFIED LEADER-TRAILER CODE
	ISZ	COUNT
	JMP	LEAD1
	SNA
	JMP*	LEADER		/ RETURN IF BLANK LEADER
/
	LAC	EXCLAM
	JMS	PUNCH		/ DO THE MYSTERY FINISH WITH
	LAC	.LEADR		/ NON-BLANK LEADER
	JMS	PUNCH
	JMS	PUNCH
	LAC	EOB
	JMS	PUNCH
	JMP*	LEADER
/
WTFPP	XX
	CAL	WTFRPP
	LAC	EVPP
	SMA!TCA
	JMP*	WTFPP		/ LEAVE - EV OK
	JMS	TYPERR		/ OUTPUT BAD EVENT VARIABLE
	CAL	WERRPP		/ AND DEVICE
	JMP	XIT		/ TERMINAL ERROR!
/
WTFLP	XX							/(018)
	LAC	EVLP						/(018)
	SNA							/(018)
	CAL	WTFRLP		/ WAIT ONLY WHEN NECESSARY	/(018)
	LAC	EVLP						/(018)
	SMA!TCA							/(018)
	JMP*	WTFLP		/ GOOD EV.  RETURN		/(018)
	JMS	TYPERR		/ ANNOUNCE BAD EVENT VARIABLE	/(018)
	CAL	WERRLP		/ AND DEVICE			/(018)
	JMP	XIT		/ THEN EXIT			/(018)
/
	.EJECT
ERROR	INC	ERRCNT		/ INCREMENT ERROR COUNT
	LAC	(IMAGE
	DAC	PCK+1		/ PREPARE TO PACK UP LINE IN ERROR
	LAC	(ERRBUF+2
	DAC	PCK+2
PCK	JMS*	PACK
	0; 0
	SMA
	JMP	PCK
	LAC	(22002		/ LOOKS LIKE A GOOD NUMBER TO USE
	DAC	ERRBUF
	LAC	LSTSW		/ WHEN LISTING, WE ALREADY	/(019)
	SNA			/ HAVE LINE IN ERROR		/(019)
	CAL	WRERBF		/ WRITE OUT OFFENDING INPUT LINE
	CAL	WERMSL		/ OVERPRINT IT WITH ERROR MESSAGE
	JMS	WTFLP		/ DON'T PROCEED UNTIL BUFFER FREE	/(018)
	LAW	-5
	TAD	ERRCNT
	SMA
	JMP	WAITCD		/ ERROR OVERFLOW - NO MORE PUNCHING
	LAC	(7
	PAL
	CLX
ERR1	LAC	ARROW+2,X	/ WHEN AN ERROR OCCURS, PUNCH OUT AN
	JMS	PUNCH		/ ARROW TO AID IN FINDING THE OFFENDING
	AXS	1		/ BLOCK ON THE TAPE, THEN ATTEMPT TO
	JMP	ERR1		/ PROCESS THE REST OF THE DECK.
	LAC	EOB
	JMS	PUNCH		/ ALL BLOCKS MUST HAVE 'EOB' CODE
	JMP	WAITCD
/
ERRCD	JMS	TYPERR		/ ISSUE I/O ERROR MESSAGE
	CAL	WERRCD		/ AND ALSO CARD READER
	JMP	XIT		/ THEN TERMINATE
/
TYPERR	XX
	CLQ!LRS 11		/ SHIFT INTO UPPER HALF OF CLEARED MQ
	LAC	(6		/ ASCII CONVERSION
	LLSS	3		/ SHIFT IN 1ST DIGIT
	ALSS	4
	XOR	(6
	LLSS	3		/ SHIFT IN 2ND DIGIT
	ALSS	4
	XOR	(6		/ ASCII CONVERSION FOR 3RD DIGIT
	DAC	ERRNUM		/ INSERT PACKED ASCII INTO MESSAGE
	LACQ
	DAC	ERRNUM+1
	CAL	WRIOER		/ 'I/O ERROR NNN'
	JMP*	TYPERR
/
	.EJECT
/  CAL PARAMETER BLOCKS FOR VARIOUS I/O OPERATIONS.
/
REQTDV	1;	0; .SIXBT 'TDV...' ; 0
XFRCMD	37;	EVCD;	ILINE; 42
HINFCD	3600;	EVCD;	0
ATTCD	2400;	EVCD;TMPLUN
SEEKCD	3200;	EVCD;CDLUN
SEEKNM	.SIXBT	'12345 SRC'
READCD	2600;	EVCD;	0; 2; ILINE; 42
CLOSCD	3400;	EVCD;	0
DETCD	2500;	EVCD;	0
WTFRCD	20;	EVCD
ATTPP	2400;	EVPP;	PP
DETPP	2500;	EVPP;	PP
WRPPBF	2700;	EVPP;	PP; 3; LINE
WTFRPP	20;	EVPP
WARROW	2700;	EVPP;	PP; 3; ARROW
CLOSPP	3400;	EVPP;	PP
WRERBF	2700;	0;	LP; 2; ERRBUF
WERMSL	2700;	EVLP;	LP; 2; ERMSL
WERRMT	2700;	0;	TT; 2; ERMT
WREND	2700;	EVTT;	TT; 2; REND
WTFRTT	20;	EVTT
WRIOER	2700;	0;	TT; 2; IOERR
WERRCD	2700;	0;	TT; 2; ERCD
WERRPP	2700;	0;	TT; 2; ERPP
WERRLP	2700;	0;	TT; 2; ERLP				/(018)
WTFRLP	20;	EVLP						/(018)
ATTLP	2400;	EVLP;	LP					/(018)
WRLST	2700;	EVLP;	LP; 2; ILINE				/(018)
CLOSLP	3400;	0;	LP					/(018)
DETLP	2500;	EVLP;	LP					/(018)
WRFF	2700;	0;	LP; 2; FF				/(022)
	.EJECT
ERMSL	ML-.*400+2;OCNT
	.ASCII	<20><11><11><11><11><11><11><11><11><11><11>
	.ASCII	'**** ILLEGAL SYMBOL ****'<15> ;ML=.
ERMT	ET-.*400+2;EVTT
	.ASCII	<7>'ERRORS IN THIS DECK  '<7><175> ;ET=.
IOERR	5002;TERMIN
	.ASCII	'I/O ERROR '
ERRNUM	.BLOCK	2
	.ASCII	<15>
ERCD	5002;EVCD
	.ASCII	' ON INPUT DEVICE'<15>
ERPP	3002;EVPP
	.ASCII	' ON PUNCH'<15>
ERLP	4002;EVLP; .ASCII ' ON PRINTER'<15>			/(018)
REND	ND-.*400+2;ERRCNT
	.ASCII	'EXIT-CODE'<15> ;ND=.
FF	2002; 0; .ASCII <14><15>				/(022)
	.EJECT
/
ERRBUF	.BLOCK	44
ILINE	.BLOCK	42
CR	.ASCII	<15> ; .LOC .-1	/CARRIAGE RETURN FOR CARDS
SLSTAR	.ASCII	'/*' ; .LOC .-1
IMAGE	.BLOCK	125		/ ROOM FOR 85 CHARACTERS
WORK	.BLOCK	200
LINE	077003			/ CONSTANT WORD PAIR COUNT FOR IMAGE
	.BLOCK	177
IOBUF	.BLOCK	200
XADJ
LSTSW			/ SET NON-ZERO TO PRINT LISTING		/(018)
XSW			/ SET NON-ZERO TO SUPPRESS PAPER TAPE	/(019)
LNCNT			/ LINES-PER-PAGE COUNTER		/(022)
/
	.EJECT
/  TRANSLATE TABLE FOLLOWS
/
	.REPT	40		/TABLE IS 200 LOCATIONS LONG
TABLE	-1			/FILL TABLE WITH ILLEGAL CHARACTER
.TABLE=TABLE
/
	.LOC	TABLE+40
	-1		/ SPACE ILLEGAL IN 1 BLOCK/CARD (NORMALLY 020)
EXCLAM	013		/ ! -
	037		/ "
	112		/ #
EOB	200		/ $ -
	054		/ %
	177		/ & -
	015		/ '
	013		/ ( -
LEAD	177		/ ) -
	114		/ *
	160		/ + -
	073		/ ,
	100		/ - -
	153		/ . -
	061		/ / -
	040		/ 0 -
	001		/ 1 -
	002		/ 2 -
	023		/ 3 -
	004		/ 4 -
	025		/ 5 -
	026		/ 6 -
	007		/ 7 -
	010		/ 8 -
	031		/ 9 -
	174		/ :
	172		/ ;
	174		/ <
	061		/ =
	076		/ >
	-1; -1
/
	141		/ A
	142		/ B
	163		/ C
	144		/ D
	165		/ E
	166		/ F -
	147		/ G -
	150		/ H
	171		/ I -
	121		/ J -
	122		/ K -
	103		/ L
	124		/ M -
	105		/ N -
	106		/ O
	127		/ P
	130		/ Q
	111		/ R -
	062		/ S -
	043		/ T -
	064		/ U
	045		/ V
	046		/ W
	067		/ X -
	070		/ Y -
	051		/ Z -
	076		/ [
	016		/ \
	-1
/
	177		/ ^
	075		/ _
/
	.REPT	40		/ FILL OUT REST OF TABLE WITH
	-1			/ ILLEGAL CHARACTER
/
ARROW	21003; 0
	40; 160; 250; 40; 40; 40; 40; 0
	.REPT	30
	0
/
COUNT;WCOUNT;OSAVE
	.END	NCT...
