Trailing-Edge
-
PDP-10 Archives
-
BB-M080O-SM
-
monitor-sources/ptp.mac
There are 42 other files named ptp.mac in the archive. Click here to see a list.
;------------------------- Autopatch Tape # 13 -------------------------
;------------------------- Autopatch Tape # 12 -------------------------
; 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