Google
 

Trailing-Edge - PDP-10 Archives - BB-M780C-SM - monitor-sources/ptp.mac
There are 42 other files named ptp.mac in the archive. Click here to see a list.
; UPD ID= 2171, SNARK:<6.1.MONITOR>PTP.MAC.5,   5-Jun-85 10:51:44 by MCCOLLUM
;TCO 6.1.1406  - Update copyright notice.
; UPD ID= 4489, SNARK:<6.MONITOR>PTP.MAC.4,  12-Jul-84 16:42:53 by PURRETTA
; UPD ID= 1316, SNARK:<6.MONITOR>PTP.MAC.3,   9-Oct-82 20:37:12 by PAETZOLD
;TCO 6.1219 - Extend PTPDTB for RLJFD
;<6.MONITOR>PTP.MAC.2, 16-Oct-81 18:12:30, EDIT BY MURPHY
;TCO 6.1030 - Node names in filespecs; etc.
;Revise DTB format; get rid of double skips on NLUKD, etc.
;<4.MONITOR>PTP.MAC.2,  6-Mar-79 09:41:02, EDIT BY KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<HELLIWELL.PUMPKIN>PTP.MAC.7, 12-Dec-77 14:19:19, EDIT BY HELLIWELL
;<HELLIWELL.PUMPKIN>PTP.MAC.6, 11-Dec-77 18:37:57, EDIT BY HELLIWELL
;FIX BUGS IN PTPCLZ
;<HELLIWELL.PUMPKIN>PTP.MAC.5,  8-Dec-77 17:40:49, EDIT BY HELLIWELL
;<OUYANG>PTP.MAC.9, 30-Nov-77 17:01:10, Edit by OUYANG
;<HELLIWELL.1065>PTP.MAC.4,  5-Sep-77 01:30:46, EDIT BY HELLIWELL
;<HELLIWELL.1065>PTP.MAC.3, 21-Aug-77 12:44:39, EDIT BY HELLIWELL
;<HELLIWELL.1065>PTP.MAC.2, 21-Aug-77 12:33:22, EDIT BY HELLIWELL
;REL 3 CHANGES

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY  BE  USED
;OR COPIED ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT  (C)  DIGITAL  EQUIPMENT  CORPORATION  1976, 1985.
;ALL RIGHTS RESERVED.


	SEARCH PROLOG
	TTITLE (PTP,,< - PAPER TAPE PUNCH SERVICE, R. HELLIWELL>)

;LOCAL STORAGE DECLARED IN STG.MAC

EXTN <PTPCHR,PTPTIM>
EXTN <PTPBFZ,PTPBF1,PTPBF2,PTPSTS,PTPLCK,PTPCNT,PTPITC>
EXTN <PTPFDC,PTPPTR,PTPSIO>

;SPECIAL AC DEFINITIONS USED HEREIN

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

INTERN	PTPSV,PTPCHK,PTPRST

; Parameters

PTP=100				; Ptp device code
PTPDON==10			; Done coni/o bit
PTPBSY==20			; Busy coni/o bit
PTPEOT==100			; No tape coni bit

; Flags in ptpsts 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)		; Ptp is open
FLG(IMAGE,L,IOS,020000)		; Ptp is operating in image mode (10)
FLG(PTPBI,L,IOS,010000)		; Ptp is operating in binary mode (14)
FLG(PTPIB,L,IOS,004000)		; Ptp is operating in image binary mode (13)
FLG(STOP,L,IOS,002000)		; Ptp is stopped due to no tape
FLG(FEEDF,L,IOS,001000)		;PTP IS FEEDING
FLG(PTPERR,L,IOS,400)		;ERROR(DUE TO NO TAPE)
; Ptp dispatch table

	SWAPCD

PTPDTB::PTPDTL			;LENGTH
	DTBDSP PTPDIR		;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(PTPOPN)		; Ptp open
	DTBBAD(DESX9)		; Input
	DTBDSP(PTPSQO)		; Output
	DTBDSP(PTPCLZ)		; Close
	DTBBAD(DESX9)		; Rename
	DTBBAD(DESX9)		; Delete
	DTBBAD(DUMPX6)		;DUMPI
	DTBBAD(DUMPX6)		;DUMPO
	DTBBAD(DESX9)		; Mount
	DTBBAD(DESX9)		; Dismount
	DTBBAD(DESX9)		; Init directory
	DTBBAD(MTOX1)		; MTOPR
	DTBBAD(DESX9)		; Get status
	DTBBAD(DESX9)		; Set status
	DTBDSP(RSKP)		; 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
	DTBSKP			;RELEASE JFN
	PTPDTL==:.-PTPDTB	;GLOBAL LENGTH OF DISPATCH TABLE

; Initialize punch
; Call:	CALL PTPINI
; Returns
;	+1	; Always (called at system initialization time

	RESCD

PTPINI::CONO PTP,0
	SETZM PTPSTS
	SETOM PTPLCK
	SETOM PTPCNT
	SETZM PTPFDC
	RET

PTPRST:	SKIPL PTPCNT
	CONO PTP,PTPDON+PTPCHN
	RET

PTPDIR:	TQO NNAMF		;NO NAME DEVICE
	MOVEI A,DESX9
	RET
; Open ptp
; Call:	JFN	; Jfn
;	CALL PTPOPN
; Returns
;	+1	; Error, error number in 1
;	+2	; Ok, 200 lines of feed is punched

	SWAPCD

PTPOPN:	LOCK PTPLCK,<CALL LCKTST>
	MOVE IOS,PTPSTS
	TQNE <WRTF>		;MUST WANT WRITE,
	TQNE <READF>		; BUT NOT READ
	RETBAD(OPNX13,<UNLOCK PTPLCK>) ;PTP NOT OPEN THAT WAY!
	CONSZ PTP,PTPEOT	; Any tape in punch?
	RETBAD(OPNX8,<UNLOCK PTPLCK>) ;NO,GIVE ERROR RETURN
	TQOE <OPN>		; Test and set opn flag
	RETBAD(OPNX9,<UNLOCK PTPLCK>) ;ALREADY OPN, GIVE BUSY RETURN
	TXZ IOS,ALTP!ALTI!IMAGE!PTPBI!PTPIB!STOP!PTPERR
	LDB A,[POINT 4,STS,35]	; Get mode
	JUMPE A,[LDB A,PBYTSZ	; In mode 0, infer mode from byte size
		CAIN A,8
		TQO <IMAGE>
		CAIN A,^D36
		TQO <PTPBI>
		JRST PTPOP1]
	CAIN A,14		; If binary
	TQO <PTPBI>		; Set binary flag
	CAIN A,13		; If image binary
	TQO <PTPIB>		; Set image binary flag
	CAIN A,10		; If image
	TQO <IMAGE>		; Set image flag
PTPOP1:	MOVEI B,7		; Get 7 bit bytes
	TQNE <IMAGE>		; Unless image mode
	MOVEI B,8		; Then 8 bits
	TQNE <PTPBI,PTPIB>	; Unless binary or image binary
	MOVEI B,6		; Then get 6
	DPB B,[POINT 6,PTPPTR,11]
				; Store in byte pointer
	MOVEM IOS,PTPSTS	; Store status word
	SETOM PTPCNT		; No full buffers
	SETZM PTPITC		; No items left in current buffer
	UNLOCK PTPLCK
	MOVEI A,200
	MOVEM A,PTPFDC		; Feed 200 lines
	MOVEI A,PTPCHN
	CONO PTP,PTPDON(A)	; Set done flag to cause interrupt
	SETZM FILBYN(JFN)
	SETZM FILLEN(JFN)
	TQO <WNDF>
	RETSKP
; Close ptp
; Call:	JFN	; Jfn
;	CALL PTPCLZ
; Returns
;	+1	; Always

PTPCLZ:	TXNE A,CZ%ABT		; IS THIS AN ABORT TYPE OF CLOSE?
	  JRST PTPCL2		; YES, DONT FINISH OUT WITH TRAILER
	TQNN <WNDF>		; IS THERE A BUFFER SET UP
	SKIPN FILBYN(JFN)	; AND ARE THERE CHARACTERS IN THE BUFFER
	  JRST PTPCL1		; NO, THEN DONT SEND OUT BUFFER
	CALL DMPBUF		; Dump partial buffer
PTPCL1:	MOVE A,[XWD PTPCNT,DISLT]
	SKIPL PTPCNT
	  CALLRET PTPSBF	; Dismiss til last buffer being dumped
	MOVE A,[XWD PTPITC,DISLET]
	SKIPLE PTPITC
	  CALLRET PTPSBF	; Dismiss till last buffer out
	MOVEI B,400
	MOVE IOS,PTPSTS		; GET STATUS WORD
	TQON <FEEDF>		; TAPE ALREADY BEING FED?
	  MOVEM B,PTPFDC	; YES, DONT STORE COMMAND
	MOVEM IOS,PTPSTS	; STORE STATUS
	MOVEI A,PTPCHN
	CONSO PTP,PTPBSY
	CONO PTP,PTPDON(A)
	MOVE A,[XWD PTPFDC,DISLET]
	SKIPLE PTPFDC		; IS FEED DONE
	  CALLRET PTPSBF	; NO, GO WAIT FOR IT TO FINISH
	TQZN <PTPERR>		;ERROR BIT ON?
	  JRST PTPCL2		;NO,JUMP
	TQO <ERRF>		;RETURN ERROR FLAG
	MOVEM IOS,PTPSTS	;SAVE STATUS
	RETBAD(OPNX8)		;

PTPCL2:	CALL PTPINI		; CLEAN UP
	RETSKP

PTPSBF:	TQO <BLKF>		;SET FLAG TO CAUSE DISMIS TO BE DONE
	RET			;AND RETURN

; Ptp sequential output
; Call:	A	; Byte
;	JFN	; Jfn
;	CALL PTPSQO
; Returns
;	+1	; Always

PTPSQO:	MOVE IOS,PTPSTS		; Get status word
	TQZE <PTPERR>		;ERROR BIT SET?
	  JRST [TQO <ERRF>	;RETURN ERROR FLAG UP
		MOVEM IOS,PTPSTS ;SAVE STATUS
		RETBAD(OPNX8)]	;FLAG ERROR AS OFF-LINE
	PUSH P,A		; Preserve byte
	TQNE <WNDF>		; Buffers set up yet?
	  JRST [CALL SETBUF	; No, do it
		JRST [POP P,(P)	; CLEAR STACK
		CALLRET PTPSBF]	; AND LET CALLER BLOCK
		JRST .+1]	; BUFFER WAS SET UP
	SOSGE FILCNT(JFN)	; Buffer full?
	  JRST [CALL DMPBUF	; Yes, dump it
		POP P,A		; GET BACK BYTE BEING OUTPUT
		JRST PTPSQO]	; AND TRY AGAIN
	AOS FILBYN(JFN)		; Count bytes in buffer
	POP P,A
	IDPB A,FILBYT(JFN)	; Deposit in buffer
	RET
DMPBUF:	MOVX IOS,ALTP
	XORB IOS,PTPSTS		; Complement buffer
	MOVEI A,PTPBF1
	TQNN <ALTP>
	MOVEI A,PTPBF2
	PUSH P,A
	MOVEI A,^D36
	LDB B,PBYTSZ		; User's byte size
	IDIV A,B		; User bytes per word
	MOVEI B,5		; 5 punch bytes per word
	TQNE <IMAGE>		; Unless image mode
	MOVEI B,4		; Then 4
	TQNE <PTPIB,PTPBI>	; Unless a binary mode
	MOVEI B,1		; Then 1
	IMUL B,FILBYN(JFN)
	IDIV B,A		; Number of output bytes in buffer
	SKIPE C
	AOS B			; Round up
	POP P,A			; Get buffer location
	HRRZM B,(A)		; Store count in buffer word 0
	TQNN <PTPBI>
	JRST NOCHKS
	PUSH P,A
	MOVNS B			; Negate count
	HRL A,B			; Make aobjn word
	AOS A			; Start with word 1
	SETZ B,			; Clear b

CHKSML:	ADD B,(A)		; Sum words of buffer
	AOBJN A,CHKSML
	SETZ A,
	ROTC A,^D12		; High 12 bits to a
	ROT B,^D12		; Middle 12 to low end of b
	ADDI A,(B)		; Add middle to high
	ROT B,^D12
	ANDI B,7777		; Get low 12
	ADDB B,A		; Add everything together
	ANDI A,7777		; Retain low 12 in a
	LSH B,-^D12		; Get excess
	JUMPN B,.-3		; Do end around carry for 1's comp
	POP P,B			; Get back buffer loc
	HRLM A,(B)		; Store checksum
NOCHKS:	MOVEI A,PTPCHN
	AOSN PTPCNT		; Count one more full buffer
	CONO PTP,PTPDON(A)	; If this is first one, start punch
	TQO <WNDF>		; MARK THAT A BUFFER IS NOT SET UP
	RET
SETBUF:	MOVE A,[XWD PTPCNT,PTPTST]
	SKIPLE PTPCNT		; Are all buffers non-empty?
	  CALLRET PTPSBF	; Yes, wait for one to empty
	MOVEI A,PTPBF1+1	; Use buffer 1
	TQNE <ALTP>		; Unles alternate flag
	MOVEI A,PTPBF2+1	; Then use 2
	HRRM A,FILBYT(JFN)	; Point program byte pointer to buffer
	MOVEI A,^D36
	STOR A,FLBPO,(JFN)	; Position to left of first word
	MOVEI A,^D36
	LDB B,PBYTSZ		; User's byte size
	IDIV A,B		; Bytes per word
	IMULI A,PTPBFZ-1	; Bytes per buffer
	MOVEM A,FILCNT(JFN)	; Init filcnt
	SETZM FILBYN(JFN)	; No bytes written yet
	TQZ <WNDF>		; MARK THAT A BUFFER IS READY
	RETSKP

; Ptp interrupt routine

	RESCD

PTPSV:	CONSO PTP,PTPDON	; Ptp interrupt?
	RET			;NO
	MOVEM IOS,PTPSIO	; Save ios
	MOVE IOS,PTPSTS		; Get status word
	CONSZ PTP,PTPEOT	; Out of tape?
	 JRST [	TQO <STOP>
		TQO <PTPERR>
		CONO PTP,0
		SETZM PTPTIM
		JRST PTPXIT]
	SKIPGE PTPFDC		; Negative?
	JRST [	DATAO PTP,PTPFDC; Yes, has a special character to output
		SETZM PTPFDC
		JRST PTPXIT]
	SKIPG PTPFDC		; Greater than 0?
	JRST PTPSV1		; No, check for data
	DATAO PTP,[0]		; Yes, punch blank line
	SOS PTPFDC
PTPXIT:	MOVEM IOS,PTPSTS
	MOVE IOS,PTPSIO
	JRST PTPCHR
PTPSV1:	SKIPG PTPITC		; Items left in buffer?
	JRST PTPSV2		; No.
	ILDB A,PTPPTR		; Yes, get one
	TQNE <PTPBI,PTPIB>	; A binary mode?
	JRST PTPSV3		; Yes, skip the following
	TQNE <IMAGE>		; Image mode?
	JRST PTPSV4		; Yes, skip even more
	CAIE A,0
	CAIN A,177
	JRST [	SOSLE PTPITC	; Skip nulls and rubouts
		JRST PTPSV1	; Not empty, get another character
		SOS PTPCNT
		JRST PTPSV2]	; Empty, get another buffer
	MOVEI B,10
	CAIN A,14		; If form feed,
	MOVEM B,PTPFDC		; Feed 10 lines after it
	CAIE A,11		; After tab
	CAIN A,13		; Or vert tab,
	SETOM PTPFDC		; Punch rubout
	MOVE B,A
	IMULI B,200401		; Compute parity
	AND B,[11111111]
	IMUL B,[11111111]
	TLNN B,(1B14)		; If even
PTPSV3:	IORI A,200		; Set bit (here for binary too)

PTPSV4:	DATAO PTP,A		; Jump here for image mode
	SOSLE PTPITC		; Count items
	JRST PTPXIT		; Some left
	SOS PTPCNT
	MOVEI B,10
	TQNE <PTPBI>		; If binary,
	MOVEM B,PTPFDC		; Folow each buffer with blank tape
	JRST PTPXIT

PTPSV2:	SKIPGE PTPCNT
	JRST [	CONO PTP,0	; Turn off punch
		JRST PTPXIT]
	MOVEI A,PTPBF1
	TQCE <ALTI>
	MOVEI A,PTPBF2
	HRRZ B,(A)		; Get item count of buffer
	TQNE <PTPBI>		; If binary
	AOSA B			; One more to include header
	AOS A			; If not, start with word 1
	TQNE <PTPIB,PTPBI>	; If a binary mode,
	IMULI B,6		; There are six 6-bit bytes per word
	MOVEM B,PTPITC
	HRRM A,PTPPTR		; Point pointer to the first word
	MOVEI A,44
	DPB A,[POINT 6,PTPPTR,5]; Point to left of first byte
	JRST PTPSV1		; And continue with the new buffer
PTPCHK:	MOVEI A,^D5000		;CHECK EVERY 5 SEC.
	MOVEM A,PTPTIM		;SET TIMER
	CONSO PTP,PTPEOT	;END OF TAPE?
	RET			;NO,JUST RETURN
	MOVX A,OPN		;WAS PTP OPENED?
	TDNE A,PTPSTS		;TEST STATUS
	CONO PTP,PTPDON+PTPCHN	;CAUSE INTERRUPT
	RET			;DO RETURN

;ROUTINE TO DETECT OUT OF TAPE

PTPTST:	MOVX A,PTPERR		;WAS ERROR DUE TO NO TAPE
	TDNE A,PTPSTS		;TEST STATUS
	  JRST 1(4)		;YES, UNLOCK AND WAKE UP PROCESS
	MOVEI A,PTPCNT		;NO
	  JRST DISLET		;DO THE NORMAL THING***
	TNXEND
	END