Google
 

Trailing-Edge - PDP-10 Archives - BB-M080H-SM - monitor-sources/cdpsrv.mac
There are 43 other files named cdpsrv.mac in the archive. Click here to see a list.
; UPD ID= 600, SNARK:<5.MONITOR>CDPSRV.MAC.2,   4-Jun-80 15:20:52 by KONEN
;Put storage section into RSDAT PSECT
;<4.MONITOR>CDPSRV.MAC.2,  4-Mar-79 14:41:54, Edit by KONEN
;UPDATE COPYRIGHT FOR RELEASE 4

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG
	TTITLE (CDPSRV,,< - CARD PUNCH SERVICE, K. T. PRUYN>)

;LOCAL STORAGE DECLARED IN STG.MAC


;SPECIAL AC DEFINITIONS USED HEREIN

DEFAC (IOS,Q2)			;DEVICE STATUS BITS
DEFAC (STS,P1)			;SEE GTJFN FOR FUNCTIONS
DEFAC (JFN,P2)


; Parameters

CDP=110				; CDP device code
CDPLVL==5			; CDP INTERRUPT LEVEL
RETRY==3			; PUNCH RETRY COUNT
CPTIMV==^D5000		; VALUE OF CHECKING INTERVAL, MS.
; CONO/CONI BITS
CO.INI==1B20		;MANUAL TO THE CONTRARY NOTWITHSTANDING
			;THIS BIT REALLY IS NEEDED TO CLEAR PUNCH
CO.RJT==1B21		;REJECT/OFFSET CARD
CO.EJT==1B23		;EJECT A CARD
CO.PID==1B24		;DISABLE PI INTERRUPTS ON TROUBLE
CO.PIE==1B25		;ENABLE PI INTERRUPTS ON TROUBLE
CO.CLR==1B26		;CLEAR ERROR FLOP
CO.DIE==1B27		;DISABLE END OF CARD INTERRUPTS
CO.EIE==1B28		;ENABLE END OF CARD INTERRUPTS
CO.CEO==1B29		;CLEAR END OF CARD FLOP
CO.PON==1B30		;TURN ON PUNCH MOTOR
CO.CDR==1B31		;CLEAR DATA REQUEST FLOP
CO.SDR==1B32		;SET DATA REQUEST FLOP

CO.GO==CO.PIE!CO.EIE!CO.CLR!CO.CEO!CO.PON+CDPLVL

CI.OFL==1B18		;OFF LINE
CI.HSC==1B21		;HOPPER/STACKER OR CHAD BOX FULL
CI.PIK==1B22		;PICK FAILURE
CI.JAM==1B23		;EJECT FAILURE
CI.TRB==1B24		;TROUBLE
CI.TIE==1B25		;TROUBLE INTERRUPTS ENABLED
CI.ERR==1B26		;DATA OR TIMING ERROR
CI.CIP==1B27		;CARD IN PUNCH
CI.ECI==1B28		;END-OF-CARD INTERRUPTS ENABLED
CI.EOC==1B29		;END OF CARD
CI.PON==1B30		;PUNCH IS ON
CI.BSY==1B31		;PUNCH IS BUSY
CI.DRQ==1B32		;DATA REQUEST

CI.NDE==CI.OFL!CI.HSC!CI.PIK!CI.JAM!CI.TRB		;NON DATA ERROR
CI.BAD==CI.OFL!CI.HSC!CI.PIK!CI.JAM!CI.TRB!CI.ERR	;TROUBLE CHECKING BITS
CI.HRD==CI.PIK!CI.JAM!CI.ERR	;PROBLEMS THAT CAN'T WAIT TILL END OF CARD
CDPINT==CI.TRB!CI.ERR!CI.EOC!CI.DRQ			;ACTIVE INTERRUPT MASK
;DATA BUFFER HAS ITEM COUNT AND OUTPUT POINTER SET UP BY DMPBUF
;FOR USE DIRECTLY BY INTERRUPT SERVICE. THESE ARE OFFSETS.

CNTOFS==0			;OFFSET TO ITEM COUNT
PNTOFS==1			;OFFSET TO POINTER
DATOFS==2			;OFFSET TO DATA
; Flags in CDPsts and ios

FLG(ALTP,L,IOS,400000)		; Buffer 2 for prog
FLG(ALTI,L,IOS,200000)		; Buffer 1 for int
FLG(OPN,L,IOS,040000)		; CDP is open
FLG(ASCII,L,IOS,020000)		; ASCII MODE, 7-BIT BYTE
FLG(IMAGE,L,IOS,010000)		; IMAGE MODE, 12-BIT BYTE
FLG(NOMSG,L,IOS,004000)		; NO ERROR MESSAGE WANTED
FLG(CDPERR,L,IOS,002000)	; ERROR HAS HAPPENED
FLG(STOP,L,IOS,001000)		; CLOSE WAS DONE, EOF BUFF SET UP IF NEEDED
FLG(EJECT,L,IOS,000400)		; CARD WAS EJECTED
FLG(CDPDUN,L,IOS,000200)	;OUTPUT COMPLETE
FLG(COL80,L,IOS,100)		;CARD WITH FULL 80 COLUMNS, SPECIAL EOC INTERRUPT HANDLING
FLG(START,L,IOS,40)		;OK TO START NEW CARD(IN CASE EOC INT LOST)
FLG(FULL,L,IOS,20)		;NO BLANK CARD FROM LF AFTER FULL 80 COLS
FLG(MOOL,L,IOS,10)		;OPERATOR INTERVENTION NEEEDED
FLG(MOFER,L,IOS,4)		;FATAL ERROR HAPPENED
FLG(MOCOL,L,IOS,2)		;PUNCH IS ON-LINE
FLG(PSION,L,IOS,1)		;SOFTWARE INTERRUPT REQUESTED BY USER

; CDP dispatch table

	SWAPCD

CDPDTB::DTBBAD(DESX9)		; Set directory
	DTBBAD(DESX9)		; Name lookup
	DTBBAD(DESX9)		; Extension lookup
	DTBBAD(DESX9)		; Version lookup
	DTBBAD(DESX9)		; Protection insertion
	DTBBAD(DESX9)		; Account insertion
	DTBBAD(DESX9)		; Status insertion
	DTBDSP(CDPOPN)		; CDP open
	DTBBAD(DESX9)		; Input
	DTBDSP(CDPSQO)		; Output
	DTBDSP(CDPCLZ)		; Close
	DTBBAD(DESX9)		; Rename
	DTBBAD(DESX9)		; Delete
	DTBBAD(DUMPX6)		;DUMPI
	DTBBAD(DUMPX6)		;DUMPO
	DTBBAD(DESX9)		; Mount
	DTBBAD(DESX9)		; Dismount
	DTBBAD(DESX9)		; Init directory
	DTBDSP(CDPMTO)		; MTOPR
	DTBBAD(DESX9)		; Get status
	DTBBAD(DESX9)		; Set status
	DTBDSP(CDPROT)		; RECORD OUT
	DTBDSP(RFTADN)		; READ TAD
	DTBDSP(SFTADN)		; SET TAD
	DTBDSP (BIOINP)		;SET JFN FOR INPUT
	DTBDSP (BIOOUT)		;SET JFN FOR OUTPUT
	DTBBAD (GJFX49)		;CHECK ATTRIBUTE

	DTBLEN==:.-CDPDTB	;GLOBAL LENGTH OF DISPATCH TABLE
; Initialize punch
; Call:	CALL CDPINI
; Returns
;	+1	; Always (called at system initialization time

	RESCD

CDPINI::CONO CDP,CO.INI	;CLEAR PHYSICAL PUNCH
	SETZM CDPSTS	;CLEAR STATUS WORD
	SETOM CDPLCK	;INITIALIZE LOCK
	SETOM CDPCNT	;CLEAR BUFFER COUNT
	RET

CDPRST::CONO CDP,CO.INI
	RET
;SECTION TO PROCESS MTOPR CALLS

	SWAPCD
CDPMTO:	TQNN <OPNF>		;SEE IF OPENED
	RETBAD (CLSX1)		;NOT OPEN, ERROR
	MOVE IOS,CDPSTS		;GET STATUS
	CAIN B,.MOPSI		;CHECK FUNCTION REQUESTED
	JRST CDPPSI		;ENABLE PSI
	CAIN B,.MORST
	JRST CPRSTS		;READ STATUS
	RETBAD (MTOX1)		;ILLEGAL FUNCTION

; .MOPSI - ENABLE FOR PSI INTERRUPTS ON OPERATOR-ATTENTION CONDITIONS

CDPPSI:	MOVEI A,1		;GET OFFSET TO PSI CHANNEL IN ARG BLOCK
	CALL GETWRD		;GET PSI CHANNEL TO ENABLE
	 RETBAD (MTOX13)	;ARGUMENT BLOCK TOO SMALL
	CAIL B,0		;CHECK THAT GIVEN PSI CHANNEL IS A VALID
	CAILE B,5		; ASSIGNABLE CHANNEL
	JRST [	CAIL B,^D24	;CHECK THAT GIVEN PSI CHANNEL IS A VALID
		CAILE B,^D35	; ASSIGNABLE CHANNEL
		RETBAD (MTOX14)	;BAD PSI CHANNEL NUMBER GIVEN
		JRST .+1 ]	;PSI CHANNEL OK, RETURN
	MOVEM B,CDPSIC		;SAVE PSI CHANNEL TO INTERRUPT ON
	TQO <PSION>		;SET INTERRUPT DESIRED FLAG
	MOVEI A,2		;GET OFFSET TO FLAG WORD
	CALL GETWRD		;GET FLAGS FROM USER
	JRST MTORET			;NO FLAG WORD, RETURN
	TXNE B,MO%MSG		;USER WANT TO SUPPRESS MESSAGES ?
	TQO <NOMSG>		;YES, MARK THAT "PROBLEM ON DEVICE" ISN'T WANTED

; CDPPSI COMMON RETURN

MTORET:	MOVEM IOS,CDPSTS	;SAVE STATUS
	RETSKP			;RETURN TO USER
;.MORST -- READ STATUS

CPRSTS:	MOVE IOS,CDPSTS		;GET STATUS
	SETZB A,B		;CLEAR BITS

;DOES PUNCH EXIST?
	CONSO CDP,-1		;IT'S THERE IF IT GIVES US ANYTHING
	JRST [	CONO CDP,5		;TRY TO SET PRIORITY
		TXO B,MO%FNX		;SET FLAG IN CASE
		CONSO CDP,5		;IF NOT SET THERE IS NOBODY THERE
		JRST CPRS		;NON-EXISTANT
		CONO CDP,0		;RESTORE 0 PRIORITY
		TXZ B,MO%FNX		;CLEAR NON-EX BIT
		JRST .+1]		;CONTINUE WITH STATUS

;	TQNE <MOCOL>
;	TXO B,MO%COL		;PUNCH IS ON-LINE
;*********FOR SOME REASON MO%COL IS NOT IN MONSYM???
	TQNE <MOFER>
	TXO B,MO%FER!MO%HE	;FATAL HARDWARE ERROR
	TQNE <CDPDUN>
	TXO B,MO%EOF		;NO OUTPUT PENDING
	TQNN <CDPDUN>
	TXO B,MO%IOP		;OUTPUT IN PROCESS
	TQNE <MOOL>
	TXO B,MO%OL		;WAITING FOR OPERATOR ACTION
	MOVE A,CDPCON		;GET DEVICE STATUS
	TXNE A,CI.PIK
	TXO B,MO%PCK		;PICK OR STACK FAILURE
	TXNE A,CI.HSC
	TXO B,MO%SFL!MO%HEM	;STACKER FULL OR HOPPER EMPTY
CPRS:	MOVEI A,1		;SET OFFSET
	CALL PUTWRD		;RETURN STATUS
	RETBAD (MTOX13)		;USER BLOCK TOO SMALL
	RETSKP			;OK
;RECORD OUT -- USED TO HANDLE SOUTR

	SWAPCD
CDPROT:	TQNN <WNDF>		;ANY BUFFER SET UP?
	CALL DMPBUF		;IF SO, SEND IT OUT
	RETSKP
;THIS SECTION WILL BE MOVED TO STG, ETC. *******
	.PSECT RSDAT

CDPSIC:	0			;SOFTWARE INTERRUPT CHANNEL
CDPTRY:	0			;ERROR RETRY COUNT
CDPBYT:	0			;BYTE PASSED ON FROM USER, BEING CONVERTED
CDPNBR:	0			;# BYTES TO BE OUTPUT FROM ONE USER BYTE
CDPNNB:	0			;NUMBER OF COLUMNS TO LAST NON-BLANK IN BUFFER
CDPWBP:	0			;WORKING POINTER TO FILL BUFFER
CDPWBC:	0			;DOWN COUNTER FOR FILLING ACTIVE BUFFER
CDPCON:	0			;CDP CONI BITS
CDPWPC:	0			;WORKING POSITION COUNTER
CDPFRK:	0			;FORK OF USER

CONHST:	BLOCK	20		;CONI HISTORY, SAVED IN RING
CNHCNT:	0			;CONI COUNTER, CONTROLS RING
; Open CDP
; Call:	JFN	; Jfn
;	CALL CDPOPN
; Returns
;	+1	; Error, error number in 1
;	+2	; Ok,

	SWAPCD

CDPOPN:	LOCK CDPLCK,<CALL LCKTST>

	MOVE IOS,CDPSTS
	TQNE <WRTF>		;MUST WANT WRITE,
	TQNE <READF>		; BUT NOT READ
	RETBAD(OPNX13,<UNLOCK CDPLCK>) ;CDP NOT OPEN THAT WAY!
	CONI CDP,CDPCON		;GET CDP STATUS BITS
	TQO <MOCOL>		;PUNCH ON-LINE(MAY CHANGE BELOW)
	CONSZ CDP,CI.NDE	;PUNCH OK?
	JRST [	TQO <MOOL>	;PUNCH NOT-OK, SET OFF-LINE
		TQZ <MOCOL>	;CLEAR ON-LINE
		CALL CHKOFL	;USER WANT OPEN ANYWAY?
		RETBAD (OPNX8,<UNLOCK CDPLCK>)	;NO, TAKE ERROR RETURN
		CONI CDP,CDPCON	;SAVE STATUS FOR LATER CHECKING
		JRST .+1]	;CONTINUE WITH OPEN
	TQOE <OPN>		; Test and set opn flag
	RETBAD(OPNX9,<UNLOCK CDPLCK>) ;ALREADY OPN, GIVE BUSY RETURN
	TXZ IOS,ALTP!ALTI!IMAGE!ASCII!EJECT!STOP!CDPERR
	LDB A,[POINT 4,STS,35]	; Get mode
	JUMPE A,CDPOP1		; NORMAL mode only
	RETBAD(OPNX14,<UNLOCK,CDPLCK>)
CDPOP1:	LDB A,PBYTSZ		; GET BYTE SIZE TO DETERMINE MODE
	CAIN A,7
	TQO <ASCII>		; IF 7 BIT SET ASCII MODE
	CAIN A,^D12
	TQO <IMAGE>		; IF 12 BIT SET IMAGE MODE
	TQNN <IMAGE,ASCII>	; MAKE SURE SOME MODE WAS SET
	RETBAD(OPNX14,<UNLOCK,CDPLCK>)	; NONE WAS, ERROR
	SETOM CDPCNT		; No full buffers
	SETZM CDPITC		; No items in current buffer
	SETZM CDPSIC		;CLEAR SOFTWARE INTERRUPT CHANNEL
	SETZM FILBYN(JFN)	; CLEAR MONITOR'S BYTE NUMBER
	SETZM FILLEN(JFN)	; CLEAR MONITOR'S COUNTER
 	SETZM FILBYT(JFN)	; CLEAR MONITOR'S POINTER
	SETZM FILCNT(JFN)	; CLEAR MONITOR'S UP-COUNTER
	TQO <WNDF>		; NO BUFFER SET UP
	TQO <CDPDUN>		; NO OUTPUT PENDING
	MOVEM IOS,CDPSTS	; Store CDP status word
	MOVE A,FORKX		;SAVE USER FORK
	MOVEM A,CDPFRK
	UNLOCK CDPLCK
	RETSKP
; Close CDP
; Call:	JFN	; Jfn
;	CALL CDPCLZ
; Returns
;	+2	; Always

CDPCLZ:	TXNE A,CZ%ABT		; IS THIS AN ABORT TYPE OF CLOSE?
	JRST CDPCL2		; YES, DONT FINISH OUT WITH EOF CARD
	MOVE IOS,CDPSTS		;RESTORE STATUS
	TQNN <WNDF>		; IS THERE A BUFFER SET UP?
	JRST [	SKIPLE CDPWPC	;YES, ANYTHING IN IT?
		CALL DMPBUF		; YES,Dump partial buffer
		JRST .+1]
	TQNN <ASCII>		;ASCII MODE NEEDS EOF CARD
	JRST CDPCLF		;NONE REQUIRED
; SET UP EOF CARD OUTPUT
	TQNN <STOP>		;EOF ALREADY SET UP?
	JRST [	CALL SETBUF		;NO, SET UP EOF CARD OUTPUT
		JRST [	CALLRET CDPSBF]	;CAN'T GET BUFFER NOW, WAIT.
		CALL EOFSET		;HAVE BUFFER SET UP EOF.
		CALL DMPBUF		;SEND IT OUT
		JRST .+1]
CDPCLF:	SKIPL CDPCNT		;CHECK FOR ALL BUFFERS DONE
	JRST [	MOVE A,[XWD CDPCNT,CDPFIN]
		TQO <BLKF>	;DISMISS TILL LAST BUFFER OUT
		MOVEM IOS,CDPSTS
		RET]
	TQZN <CDPERR>		;ERROR BIT ON?
	JRST CDPCL2		;NO,JUMP
	TQO <ERRF>		;RETURN ERROR FLAG

CDPCL2:	CALL CDPINI		; CLEAN UP
	RETSKP

;LOCAL SUBROUTINE TO SET UP EOF CARD OUPUT BUFFER

EOFSET:	MOVEI A,7417		;EOF CODE
EOF1:	IDPB A,CDPWBP		;SAVE BYTE
	SOSLE CDPWBC		;COUNT IT
	JRST EOF1		;DO SOME MORE
	MOVEI A,^D80		;SET COUNT FOR OUTPUT
	MOVEM A,CDPNNB
	TQO <STOP>		;MARK THAT STOPPING HAS BEEN STARTED
	RET			;RETURN +1 ALWAYS

CDPSBF:	MOVEM IOS,CDPSTS	;SAVE IOS
	MOVE A,[XWD CDPCNT,CDPTST]
	TQO <BLKF>		;SET FLAG TO CAUSE DISMIS TO BE DONE
	RET			;AND RETURN
; CDP sequential output
; Call:	A	; Byte
;	JFN	; Jfn
;	CALL CDPSQO
; Returns
;	+1	; Always


;SEQUENTIAL OUTPUT
;
;ACCEPTS BYTE BY BYTE FROM THE USER, CONVERTS TO CARD COLUMN(S),
;AND PLACES OUTPUT BYTE(S) IN BUFFER. WHEN BUFFER IS FULL OUTPUT IS
;INITIATED. ONE USER BYTE MAY PRODUCE ONE OR MORE OR NO OUTPUT BYTES
;WHEN OPERATING IN 7 BIT MODE.

CDPSQO: MOVE IOS,CDPSTS		;FETCH STATUS WORD
	MOVEM A,CDPBYT		;SAVE USERS BYTE
	SETOM CDPNBR		;CDPNBR=-1 MEANS NEW BYTE BEING PROCESSED
CDPS01:	TQNE <WNDF>		;IS A BUFFER SET UP?
	JRST [	CALL SETBUF		;NO, GO SET UP A BUFFER
		JRST [	CALLRET CDPSBF]	; CAN'T SET ONE UP, GO BLOCK
		JRST .+1]
	CALL PRCBYT		;TRANSLATE USER BYTE TO CARD COLUMN(S)
	SKIPG CDPNBR		;SKIPS IF AN OUTPUT BYTE WAS RETURNED
	JRST SQORET			;USER BYTE WAS IGNORED
	IDPB A,CDPWBP		;PUT OUTPUT BYTE IN BUFFER
	AOS CDPWPC		;COUNT CURRENT CARD POSITION
	JUMPN A,[MOVE A,CDPWPC	; IF BYTE IS NOT BLANK SAVE CURRENT POSITION
		MOVEM A,CDPNNB	; AS LAST NON-BLANK POSITION FOR OUTPUT
		JRST .+1]
	SOSG CDPWBC		;BUFFER FULL?
	JRST [	CALL DMPBUF	;YES, SEND IT OUT
		TQO <FULL>	;SET FLAG TO PREVENT BLANK IF NEXT NON-
				; IGNORED CHARACTER IS LF
		JRST .+1]
	SOSLE CDPNBR		;ANY MORE OUTPUT BYTES FROM THIS USER BYTE?
	JRST CDPS01		;MORE OUTPUT
SQORET:	MOVEM IOS,CDPSTS	;SAVE STATUS
	RET
;THIS SECTION PROCESSES THE BYTE INPUT FROM USER. IT PRODUCES
;SOME NUMBER OF OUTPUT BYTES FOR EACH INPUT BYTE.
;
;IF THE MODE IS 12 BIT THE INPUT BYTE IS RETURNED AS IS.
;
;IF THE MODE IS 7 BIT AN ASCII TO CARD CODE CONVERSION IS DONE.
;
;CARD CODE CONVERSION IS DONE AS FOLLOWS:
;	ALL 128 POSSIBLE CODES HAVE A 12 BIT COLUMN CODE INCLUDING
;	CONTROL CODES AND NULL AND RUBOUT AS DEFINED BY THE ANSII
;	STANDARD BUT WITH FIVE EXCEPTIONS AS DEFINED BY THE DEC
;	STANDARD. THE EXCEPTIONS ARE --
;		CARRIAGE RETURN IS ALWAYS IGNORED,
;		LINE FEED, FORM FEED, AND VERTICAL TAB ARE NEVER PUNCHED,
;		  BUT ALL CAUSE A "SKIP TO THE NEXT CARD",
;		TAB RETURNS ENOUGH BLANKS TO MOVE TO NEXT 8TH POSITION.

PRCBYT:
	TQNE <ASCII>
	JRST PRCASC		;PROCESS ASCII CONVERSION

;12 BIT MODE IS DEFAULT

	MOVEI A,1		;ONE BYTE IS RETURNED
	MOVEM A,CDPNBR
	MOVE A,CDPBYT		;RETURN USER BYTE AS IS.
	RET
PRCASC:	SKIPLE CDPNBR		;SEE IF WE ARE COUNTING SPACES FOR A TAB
	JRST [SETZ A		;WE ARE TABBING
		RET]		;JUST RETURN A BLANK
	SETZM CDPNBR		;CLEAR RETURN COUNT IN CASE CHAR IGNORED
	MOVE A,CDPBYT		;GET THE BYTE
	CAIN A,15		;CARRIAGE RETURN?
	RET			; YES, IGNORE CR

; FF,VT,LF ALL CAUSE SKIP TO NEXT  CARD UNLESS ONE WAS JUST COMPLETED
; BY PUNCHING IN COLUMN 80

	CAIGE A,12		;LOOKING FOR 12,13,14
	JRST PRC2		;TOO LOW
	CAILE A,14
	JRST PRC2		;TOO HIGH

;JUST RIGHT -- START NEW CARD

PRC1:	TQZN <FULL>		;NO BLANK FROM LF AFTER 80 CHARACTERS
	CALL DMPBUF		; YES, START CARD OUT
	RET			; AND OTHERWISE IGNORE BYTE
PRC2:	TQZ <FULL>		;ANY NON-IGNORED CHARACTER STARTS NEW CARD
	CAIN A,11		;TAB?
	JRST [	MOVE A,CDPWPC		;TAB. GET NUMBER OF BLANKS TO SEND
		ANDI A,7		;REMAINDER OF CDPWPC/8 GIVES 
		MOVNS A			;NUMBER OF POSITIONS PAST LAST
		ADDI A,8		;STOP. TAKE FROM 8 TO GET NUMBER
		MOVEM A,CDPNBR		;OF BLANK BYTES TO RETURN.
		SETZ A			;BLANK BYTE TO RETURN.
		RET]

;CONVERT CHARACTER TO CARD COLUMN FROM TABLE

ASCNV:	IDIVI A,3		;3 CHARACTERS PER TABLE WORD
	LDB A,CRDPTR(B)		;GET 12 BIT BYTE FROM TABLE
	AOS CDPNBR		;INCR BYTE CNT FROM 0 TO 1
	RET
CRDPTR:	POINT 12,CODE(T1),11
	POINT 12,CODE(T1),23
	POINT 12,CODE(T1),35

CODE:	BYTE (12) 5403,4401,4201	;NUL	SOH	STX
	BYTE (12) 4101,0005,1023	;ETX	EOT	ENQ
	BYTE (12) 1013,1007,2011	;ACK	BEL	BS
	BYTE (12) 4021,1021,4103	;HT	LF	VT
	BYTE (12) 4043,4023,4013	;FF	CR	SO
	BYTE (12) 4007,6403,2401	;SI	DLE	DC1
	BYTE (12) 2201,2101,0043	;DC2	DC3	DC4
	BYTE (12) 0023,0201,1011	;NAK	SYN	ETB
	BYTE (12) 2003,2403,0007	;CAN	EM	SUB
	BYTE (12) 1005,2043,2023	;ESC	FS	GS
	BYTE (12) 2013,2007,0000	;RS	US	SPACE
	BYTE (12) 4006,0006,0102	;!	"	#
	BYTE (12) 2102,1042,4000	;$	%	&
	BYTE (12) 0022,4022,2022	;'	(	)
	BYTE (12) 2042,4012,1102	;*	+	,
	BYTE (12) 2000,4102,1400	;-	.	/
	BYTE (12) 1000,0400,0200	;0	1	2
	BYTE (12) 0100,0040,0020	;3	4	5
	BYTE (12) 0010,0004,0002	;6	7	8
	BYTE (12) 0001,0202,2012	;9	:	;
	BYTE (12) 4042,0012,1012	;<	=	>
	BYTE (12) 1006,0042,4400	;?	@	A
	BYTE (12) 4200,4100,4040	;B	C	D
	BYTE (12) 4020,4010,4004	;E	F	G
	BYTE (12) 4002,4001,2400	;H	I	J
	BYTE (12) 2200,2100,2040	;K	L	M
	BYTE (12) 2020,2010,2004	;N	O	P
	BYTE (12) 2002,2001,1200	;Q	R	S
	BYTE (12) 1100,1040,1020	;T	U	V
	BYTE (12) 1010,1004,1002	;W	X	Y
	BYTE (12) 1001,4202,1202	;Z	[	\
	BYTE (12) 2202,2006,1022	;]	^	_
	BYTE (12) 0402,5400,5200	;`	a	b
	BYTE (12) 5100,5040,5020	;c	d	e
	BYTE (12) 5010,5004,5002	;f	g	h
	BYTE (12) 5001,6400,6200	;i	j	k
	BYTE (12) 6100,6040,6020	;l	m	n
	BYTE (12) 6010,6004,6002	;o	p	q
	BYTE (12) 6001,3200,3100	;r	s	t
	BYTE (12) 3040,3020,3010	;u	v	w
	BYTE (12) 3004,3002,3001	;x	y	z
	BYTE (12) 5000,6000,3000	;{	|	}
	BYTE (12) 3400,4005,0000	;~	DEL	UNUSED
;THIS SECTION STARTS A BUFFER OUT TO THE PUNCH.
;IF A BUFFER IS ALREADY ON ITS WAY OUT A FLAG IS SET
;SO INTERRUPT SERVICE JUST KEEPS GOING AT THE END
;OF THE PRESENT BUFFER.

DMPBUF:	TQC <ALTP>		;COMPLEMENT BUFFER
	MOVEM IOS,CDPSTS	;IT PROBABLY ISN'T NECESSARY TO SAVE THIS NOW
	MOVEI A,CDPBF1		; GET BUFFER ADDRESS
	TQNN <ALTP>
	MOVEI A,CDPBF2
	SKIPG B,CDPNNB		;GET COUNT TO LAST NON-BLANK
	MOVEI B,1		;ALWAYS AT LEAST ONE COLUMN OUT
	MOVEM B,CNTOFS(A)	;SAVE IN BUFFER HEADER
	MOVE B,[POINT 12,0]	;FORM OUTPUT POINTER
	HRRI B,DATOFS(A)	;DATA ADDRESS
	MOVEM B,PNTOFS(A)	;SAVE POINTER IN HEADER
	AOSN CDPCNT		;COUNT FULL BUFFER
	JRST [	TQO <START>		; TELL INT SVC THAT IT'S OK TO START
		CONO CDP,CO.GO		; IF FIRST BUFFER AND START PUNCH
		JRST .+1]
	TQO <WNDF>		; MARK THAT A BUFFER IS NOT SET UP
	RET
;SETBUF -- SETS UP A BUFFER TO ACCEPT OUTPUT BYTES
;	IF BOTH BUFFERS ARE BUSY SETBUF WAITS FOR ONE

SETBUF:	SKIPLE CDPCNT		;BOTH BUFFERS IN USE?
	RET			;ERROR RETURN, BUFFERS BUSY
	MOVEI A,CDPBF1+DATOFS	;GET ADDRESS OF FIRST OR SECOND BUFFER
	TQNE <ALTP>		;  DETERMINED BY SETTING OF ALTP
	MOVEI A,CDPBF2+DATOFS
	SETZM (A)		;BLANK CARD GETS ONE BLANK COLUMN OUT
	HRRM A,CDPWBP		;SAVE ADDRESS IN WObKING BYTE POINTER
	MOVE A,[POINT 12,0]	;SET UP REST OF BYTE POINTER
	HLLM A,CDPWBP
	MOVEI A,^D80		;SET DOWN COUNTER FOR 80 COLUMN CARD
	MOVEM A,CDPWBC
	SETZM CDPNNB		;CLEAR POINTER TO LAST NON-BLANK
	SETZM CDPWPC		;CLEAR WORKING POSITION COUNTER
	TQZ <WNDF>		;MARK THAT BUFFER IS READY
	TQO <CDPDUN>		;SOME OUTPUT IS PENDING
	RETSKP			;OK RETURN
; CDP interrupt routine

	RESCD

CDPSV::CONSO CDP,CDPINT	; CDP interrupt?
	RET			;NO
	MOVEM IOS,CDPSIO	; Save ios
	MOVE IOS,CDPSTS		; Get status word
	CONI CDP,CDPCON		;SAVE CDP CONDITION

;SAVE CONI BITS IN A RING TO PROVIDE SOME HISTORY IN CASE U NEED IT

	MOVE A,CNHCNT		;GET COUNT
	ANDI A,17		;EXTRACT ENOUGH TO INDEX RING
	AOS CNHCNT		;COUNT CONI
	MOVE B,CDPCON		;GET BITS
	MOVEM B,CONHST(A)	;SAVE THEM

	CONSZ CDP,CI.BAD	; ANY PROBLEMS?
	JRST SVERP		; YES, PROCESS ERROR
	CONSZ CDP,CI.EOC	;END OF CARD?
	JRST SVEOC		;YES
	SKIPG CDPITC		;ITEMS IN BUFFER?
	JRST CDPSV2		;BUFFER EMPTY, LOOK FOR ANOTHER
CDPSV1:	ILDB A,CDPPTR		;GET BYTE FROM BUFFER
	DATAO CDP,A		; SEND IT OUT
	SOSG CDPITC		; COUNT IT
	TQO <EJECT>		;SET EJECT FLAG AFTER LAST ITEM OUT

CDPXIT:	MOVEM IOS,CDPSTS
	MOVE IOS,CDPSIO
	JRST CDPCHR

;MADE IT TOO END OF CARD UNLESS ERROR FLAG IS ON.
;IF CARD OK COUNT DOWN THE BUFFER AND PRIME PUNCH FOR ANOTHER

SVEOC:	TQO <START>		;CARD FINISHED OK. START CARD ON NEXT DATA REQ.
	TQZE <CDPERR>		;WAS CARD BAD?
	JRST SVEOC1		;WAS BAD, JUST RESTART PUNCH
	SOS CDPCNT		;COUNT BUFFER
	MOVEI A,RETRY
	MOVEM A,CDPTRY		;REINITIALIZE RETRY COUNT
SVEOC1:	CONO CDP,CO.CDR!CO.CEO!CO.PON+CDPLVL
	JRST CDPXIT
;WE HAVE HAD A DATA REQUEST WITH NO DATA IN AN OUTPUT BUFFER.
;IF <EJECT> IS ON WE SHOULD JUST EJECT THE CARD WE JUST FINISHED.
;	IF WE ARE EJECTING A CARD WITH ALL 80 COLUMNS PUNCHED WE
;	MUST GO DIRECTLY TO THE E-O-C PROCESSING BECAUSE WE WILL
;	GET NO END OF CARD INTERRUPT.
;IF THERE IS NO BUFFER READY TO GO JUST SHUT DOWN THE PUNCH. WHEN DMPBUF
;	HAS ANOTHER READY IT WILL RESTART THE PUNCH AND SET <START>.
;<START> IS SET BY DMPBUF WHEN IT IS STARTING THINGS GOING AND BY THE
;	END OF CARD PROCESSING. IF WE HAVE AN EMPTY BUFFER AND A DATA
;	REQUEST INTERRUPT BUT <START> IS NOT SET WE HAVE A PROBLEM. 
;	WHEN PUNCHING THE LAST CARD IN THE HOPPER THE EJECT IS SOME
;	(BUT NOT ALL!) TIMES IGNORED AND DATA REQUESTS CONTINUE. IT
;	IS NOT KNOWN BY THIS WRITER (KTP) IF THIS IS A CP20 BUG OR
;	FEATURE. THE <START> FLAG ATTEMPTS TO PROCEED WITH A REFILLED
;	HOPPER REGARDLESS.

CDPSV2:	TQZ <CDPERR>		;WE HAVE NO ERROR AND ARE STARTING A NEW CARD
				;CDPERR SET BY SVERP, USED BY CDPCHK&SVEOC
	TQNE <EJECT>		;WAS A CARD JUST COMPLETED?
	JRST [	TQZ <EJECT>	;YES, EJECT IT
		CONO CDP,CO.EJT!CO.CEO!CO.CDR+CDPLVL
		TQZE <COL80>	;CARDS WITH ALL 80 COLUMNS PUNCHED
		JRST SVEOC	;ARE NOT THE SAME AS OTHERS!
		JRST CDPXIT]	;DON'T START NEW CARD YET
	SKIPGE CDPCNT	;ANY FULL BUFFERS?
	JRST [	CONO CDP,CO.INI		;NONE NOW, STOP PUNCH
		TQNE <WNDF>		;BUFFER SET UP?
		TQZ <CDPDUN>		;NO BUFFER, NO OUTPUT PENDING
		JRST CDPXIT]
	TQZN <START>		;DON'T START ANOTHER CARD UNTIL ONE IS FINISHED
	JRST [	CONO CDP,CO.EJT!CO.CDR+CDPLVL
		JRST CDPXIT]
	MOVEI A,CDPBF1	; GET PROPER BUFFER ADDRESS
	TQCE <ALTI>
	MOVEI A,CDPBF2
CDPSV3:	MOVE B,CNTOFS(A)	;GET ITEM COUNT
	CAIN B,^D80		;CARDS WITH ALL 80 PUNCHED ARE
	TQO <COL80>		; NOT THE SAME
	MOVEM B,CDPITC
	MOVE B,PNTOFS(A)	;GET BYTE POINTER
	MOVEM B,CDPPTR
	JRST CDPSV1		;START BUFFER OUT

;HOPPER EMPTY/ STACKER FULL BIT COMES UP BEFORE LAST CARD IS FINISHED.
;SO IF THERE IS NO HARD ERROR WE WAIT FOR THE ITEM COUNT TO GO TO ZERO.

SVERP:	SKIPLE CDPITC			;PRESENT BUFFER DONE?
	JRST [	CONSZ CDP,CI.HRD	;NO, SEE IF ANY ERROR CAN'T WAIT
		JRST .+1		;TREAT ERROR NOW.
		JRST CDPSV1]		;NO HARD ERROR, FINISH CARD
	TQO <CDPERR>		;SET ERROR FLAG
	CONO CDP,CO.RJT!CO.EJT!CO.CEO!CO.CDR	;REJECT BAD CARD AND CLEAR THINGS
	SETZM CDPTIM		;ALERT CDPCHK. IT HANDLES ERROR ACTIONS
	JRST CDPXIT
CDPCHK::MOVEM IOS,CDPSIO	;SAVE IOS
	MOVE IOS,CDPSTS		;GET STATUS
	MOVEI A,CPTIMV		;RESET CHECKING INTERVAL
	MOVEM A,CDPTIM
	TQNE <MOOL>		;ARE WE WAITING FOR OPR?
	JRST [	CONSZ CDP,CI.NDE	;YES, STILL PROBLEMS?
		JRST CHKXIT		;SOMETHING IS STILL WRONG
		TQZ <MOOL>		;CLEAR HANDLER FLAG
		TQO <MOCOL>		;UNIT ON-LINE
		CALL PSICHK		;INTERRUPT REQUEST IF WANTED
		TQNE <CDPERR>		;WAS THERE ALSO A DATA ERROR?
		JRST DATERR		;YES, GO SEE ABOUT RETRIES
		SOS CDPCNT		;COUNT LAST CARD
		MOVEI A,RETRY		;RESET RETRY COUNT
		MOVEM A,CDPTRY
		TQZ <COL80,EJECT>	;WHAT THE LAST CARD WAS NO MORE MATTERS
		TQO <START>		;TELL INT SERVICE TO ACT ON DATA REQUEST
		CONO CDP,CO.GO		;GET PUNCH GOING AGAIN
		JRST CHKXIT]
	TQNN <CDPERR>		;WAS THERE AN ERROR DETECTED?
	JRST CHKCPS		;NO ERROR, JUST DO STATUS CHECK
;ERROR SEEN BY INTERRUPT SERVICE, RETRY ON DATA ERROR

	MOVE A,CDPCON		;GET HARDWARE BITS
	TRNE A,CI.NDE		;ANY NON-DATA ERROR?
	JRST CHKNDE		;PROCESS NON-DATA ERROR
DATERR:	SOSL CDPTRY		;COUNT DOWN RETRIES
	JRST [	CONSZ CDP,CI.CIP	;HAS BAD CARD CLEARED?
		JRST CHKXIT		;NO, WAIT FOR NEXT CHECK TIME
		TQC <ALTI>		;RECOMPLEMENT TO REUSE LAST BUFFER
		SETZM CDPITC		;CLEAR ITEM COUNT FROM BAD CARD
		TQZ <COL80,EJECT>	;DON'T WORRY ABOUT THE LAST CARD
		TQO <START>		;TELL INT SERVICE TO ACT ON DATA REQ.
		CONO CDP,CO.GO		;FIRE UP THE PUNCH
		JRST CHKXIT]		;CLEAN UP AND GO

;FATAL ERROR WHEN RETRY COUNT EXHAUSTED

CPFERR:	TQNN <NOMSG>		;NEED MESSAGE?
	CALL CPMSG		;MESSAGE NEEDED
	TQO <MOFER>		;REMEMBER FATAL ERROR IN CASE ASKED
	MOVX A,.ICDAE		;SET INTERRUPT CHANNEL
	MOVE B,CDPFRK		;GET FORK
	CALL PSIRQ		;REQUEST INTERRUPT

CHKXIT:	MOVEM IOS,CDPSTS	;SAVE STATUS
	MOVE IOS,CDPSIO		;RESTORE IOS
	RET

CHKNDE:	TRNE A,CI.JAM		;JAMMED?
	JRST CPFERR		;YES, CALL THAT FATAL
	TRNN A,CI.ERR		;WAS THERE ALSO A DATA ERROR?
	TQZ <CDPERR>		;NO, SO CLEAR FLAG SO THERE ARE NO RETRIES

;OPERATOR INTERVENTION NEEDED TO CONTINUE

	TQNN <NOMSG>		;USER WANT MESSAGE?
	CALL CPMSG		;YES
	TQO <MOOL>		;FLAG OPERATOR WAIT
	TQZ <MOCOL>		;CLEAR ON-LINE FLAG
	CALL PSICHK		;REQUEST INTERRUPT IF NEEDED
	JRST CHKXIT
;PUNCH STATUS TESTING, ONLINE/OFFLINE TRANSITIONS

CHKCPS:	CONSZ CDP,CI.OFL		;OFF LINE NOW?
	JRST [	TQNN <MOCOL>		;YES, WAS IT BEFORE?
		JRST CHKXIT		;WAS OFF AND STILL IS.
		TQZ <MOCOL>		;IT WAS ON, NOW OFF, CLEAR ON-LINE
		TQO <MOOL>		;AND SET OFF-LINE
		CALL PSICHK		;CHECK FOR INTERRUPT REQUESTED
		JRST CHKXIT]

;NOW ON LINE
	TQNE <MOCOL>		;WAS IT ON BEFORE?
	JRST CHKXIT		;IT WAS ON AND STILL IS.
	TQO <MOCOL>		;IT HAS GONE FROM OFF TO ON, SET ON-LINE
	TQZ <MOOL>		;AND CLEAR OFF-LINE
	CALL PSICHK		;GEN INTERRUPT IF REQUESTED
	JRST CHKXIT

;GENERATE SOFTWARE INTERRUPT REQUEST IF USER WANTS IT
PSICHK:	TQNN <PSION>		;DID USER ASK FOR INTERRUPTS?
	RET			;NONE REQUESTED
	MOVE A,CDPSIC		;GET SOFTWARE CHANNEL
	MOVE B,CDPFRK		;USER FORK
	CALL PSIRQ		;REQUEST INTERRUPT
	RET
;TROUBLE MESSAGE OUTPUT

CPMSG:	HRROI	A,[ASCIZ/PCDP0/]		;DEVICE NAME
	CALL DEVMSG				;TROUBLE MESSAGE OUT
	RET


;ROUTINE TO CHECK FOR A FREE BUFFER

CDPTST:	SKIPLE CDPCNT	;ANY BUFFER FREE YET?
	JRST 0(4)	;NO
	JRST 1(4)	;YES, WAKE PROCESS

;ROUTINE TO WAIT FOR LAST BUFFER
CDPFIN:	SKIPL CDPCNT	;ALL BUFFERS FREE?
	JRST 0(4)	;NO
	JRST 1(4)	;YES, WAKE UP
	TNXEND
	END