File: IBMPRO.PA of Disk: Disks/Build-2007/Copy-of-m8-rka0-rkb0

(Source file text) 

---

	/HANDLER FOR IBMPRO PRINTER


	DBVERSION="M&77

	*0

	-1
	DEVICE IBPR;DEVICE LPT;1040;DBL&177+4000;ZBLOCK 2

	DEVC=	52		/DEVICE CODE
	FF=	00 		/ASCII FORMFEED	=14

	DCDIAB=DEVC^10
	DBDI=	6000+DCDIAB	/DISABLE INTERRUPTS
	DBEI=	6001+DCDIAB	/ENABLE INTERRUPTS
	DBSK=	6002+DCDIAB     /SKIP ON INPUT FLAG
	DBCI=	6003+DCDIAB	/AC CLEAR INPUT
	DBRI=	6004+DCDIAB	/READ INPUT REGISTER
	DBCO=	6005+DCDIAB	/AC CLEAR OUTPUT
	DBSO=	6006+DCDIAB	/AC SET OUTPUT
	DBRO=	6007+DCDIAB	/AC READ OUTPUT
	*200

DBLM32,	-32		/			*
DBFFSW,	00		/FORMS OR NO		*
DBLWC,	0		/			*
DBLCA,	0		/			*
DB7700,	7700		/			*
PDBLNK,	0		/GETS ADRESS OF PAGE 2	*
	TAD I	DBL	/ R/W BIT TO LINK	*	L
	AND	DB7700	/			*	I
	CMA		/TREAT 0 PG CNT AS 0 WD CNT	N
	DCA	DBLWC	/SAVE -(DBLWD COUNT+1)	*	K
DB70,	70		/			*
	DCA	DBLEOF	/INITIALIZE EOF		*
DBL177,	177		/			*
DBL214,	RDF		/DON'T MOVE THIS CODE ***
	TAD	DBLCIF	/				M
	DCA	DBLXIT	/SAVE CIF CDF RETRN FIELD	U
	TAD I	DBL	/				S
	AND	DB70	/				T
	TAD	DBCDF	/
	DCA	DBLCDF	/				N
	ISZ	DBL	/PT TO BUFFER			O
	TAD I	DBL	/GET BUFFER ADDRESS		T
	DCA	DBLCA	/SAVE BUFFER PTR
	ISZ	DBL	/PT TO BLOCK #			C
	TAD I	DBL	/GET IT				H
	ISZ	DBL	/POINT TO ERROR RETURN		G
	SNL
	JMP	DBLERR	/CAN'T READ FROM DBL
DBM140,	SZA CLA	
	JMP	DBLELP
	DBDI 		/INT DISABLE
	JMS I	PDBLNK	/INIT
	SPA		/MORE INIT?
	JMP	DBLELP	/NO
	JMS	DBPRNT	/PRINT IT
	JMP	.-4	/BACK FOR MORE
DBLELP,	JMS	DBPRNT	/PRINT 3RD CHAR OF DOUBLEWORD
	ISZ	DBLWC
	JMP	DBLLP	/GET 3 MORE CHARS
	SKP CLA
DBLCTZ,	TAD	DBFFSW	/SET TO FF BY PRINTABLES, CLEARED BY FF
	JMS	DBPRNT	/OUTPUT FORM FEED IF EOF SEEN
	ISZ	DBL	/BUMP TO NORMAL RETURN
DBLXIT,	HLT		/RESTORE FIELDS
	JMP I	DBL	/EXIT

/UNPACKING LOOP - USES A SHIFT REGISTER METHOD TO GET THE
/THIRD CHARACTER IN EACH DOUBLEWORD.

DBLLP,	STL		/GUARD BIT OF SHIFT REGISTER
DBROTL,	RTL
	RTL
	SPA		/DO WE HAVE 8 BITS SHIFTED IN?
	JMP	DBLELP
	DCA	DBLEOF	/SAVE SHIFT REGISTER
	TAD I	DBLCA
	JMS	DBPRNT	/PRINT A CHAR
	TAD I	DBLCA
	ISZ	DBLCA	/BUMP INPUT POINTER
DB7400,	7400		/PROTECT ISZ
	AND	DB7400
	CLL RAL
	TAD	DBLEOF	/SHIFT HIGH 4 BITS INTO
	JMP	DBROTL	/SHIFT REGISTER

DBLERR,	STL CLA RAR	/PUT 4000 IN AC
	JMP	DBLXIT	/AND TAKE ERROR RETURN
/CHAR PRINT ROUTINE

DBPRNT,	0		/ETX-ACK PRINT ROUTINE
	AND	DBL177
	MQL		/CHAR TO MQ TEMP
DBLCDF,	HLT
	CLA MQA		/GET AGAIN
	TAD	DBLM14	/IS IT FF?
	SNA
	DCA	DBFFSW	/YES, CLEAR FF SWITCH
	TAD	DBLM16	/IS IT AN EOF? (32)
	SNA 
	JMP	DBLCTZ	/YES, GET OUT
	TAD	DBLM7	/IS IT PRINTABLE?
	SPA CLA
	JMP	.+3	/NO
	TAD	DBL14	/YES PICK FF CODE
	DCA	DBFFSW	/PUT IN SWITCH
	DBRI		/IS PRINTER BUSY?
	SMA
	JMP	.-2	/YES, WAIT
	DBCI		/CLEAR INPUT TO BE SURE
	CLA MQA		/RESTORE
	DBCO		/PUT CHAR IN DBL BUFFER
	CMA
	AND	DBL377	/TAKE ALL 8 BITS
	DBSO		/BE SURE BIT 8 IS CLEARED
	CLA STL RAR
	DBSO		/SET STROBE
	NOP		/GIVE IT SOME TIME
	DBCO		/CLEAR STROBE
DBCTCL,	JMS	DBCCHK	/CHECK FOR CTRL C
	DBSK
	JMP	DBCTCL	/WAIT FOR FLAG
	DBRI
	DBCI
	CLA
	JMP I	DBPRNT	/NO
DBCCHK,	0		/CHECK FOR CTRL C
DB7600,	7600		/CLEAR AC
	TAD	DB7600
	KRS
	TAD	DB175	/CHECK FOR ^C FROM CONSOLE
	SNA CLA
	KSF		/WITH FLAG UP
	JMP I	DBCCHK
DBLCIF,	CDF CIF 0
	JMP I	DB7600	/YES, RETURN TO OS/8

DB175,	175		/CTRL C MASK
DBL377,	377
DBL14,	14
DBLM14,	-14
DBLM16,	-16
DBLM7,	-7

	ZBLOCK 371-.

DBL,	DBVERSION	/NORMAL ENTRY POINT
	JMP	.+4
DB32,	32
DBLEOF,	0
DBCDF,	CDF 0
	CLA STL RAR
	JMS	PDBLNK
	PAGE
DBINIT,	0
	JMP	DBARGS
DBLLIN,	14		/14: 6 LPI, 11: 8 LPI
DBLPIT,	0		/0: 12 CPI, 22: 10 CPI, 17: 17CPI
DBLQUA,	0		/0: NORMAL, 2: NLQ QUALITY
DBLSKP,	0		/NUMBER OF LINES TO SKIP
DBLPAG,	110		/NUMBER OF LINES. 110: 6 LPI, 140: 8 LPI
DBLFF,	FF		/INITIAL FF OR NOT
DBARGS,	CDF 0
	TAD	DBCORT
	SZA	CLA	/FIRST CALL?
	JMP I	DBCORT	/YES ; COROUTINIZE
	CLA STL RTR	/SET INIT BIT
	DBSO
	NOP
	DBCO		/CLEAR IT
	DBRI		/READ INPUT
	SMA		/BUSY?
	JMP	.-2	/YES, WAIT TILL READY
	DBCI		/CLEAR INPUT
	CLA
	TAD	(21	/DC1: SELECT PRINTER
	JMS	DBCORT
	TAD	(30	/CAN: CANCEL ALL PENDING DATA
	JMS	DBCORT	/CALL COROUTINE
	TAD	DBLPIT	/IF 0 THEN 12 CPI
	SNA CLA
	JMS	DBESC	/SET 12 CPI
	":		/ESC :
	TAD	DBLPIT	/GET CPI INDICATOR 10,17 CPI
	SZA		/IF 0, 12 CPI ALREADY SET
	JMS	DBCORT	/SEND IT
	JMS	DBESC	/ESC A (N)
	"A		/STORE LINE SPACING
	TAD	DBLLIN	/GET LPI
	JMS	DBCORT
	JMS	DBESC	/EXECUTE LINE SPACE
	"2
	JMS	DBESC	/SET PAGE HEIGHT
	"C		/ESC C (N)
	TAD	DBLPAG	/GET NO OF LINES
	JMS	DBCORT
	JMS	DBESC
	"I		/ESC I (N)
	TAD	DBLQUA	/GET QUALITY INDICATOR
	JMS	DBCORT
	JMS	DBESC
	"N		/ESC N (N)
	TAD	DBLSKP	/GET SKIPS
	JMS	DBCORT
	JMS	DBESC	/CLEAR TABS
	"R		/ESC R
	TAD	DBLFF
	SZA		/DID WE WANT INITIAL FF?
	JMS	DBCORT	/YES PRINT FORM FEED
	CLA STL RAR	/4000
	JMS	DBCORT	/SIGNAL END WITH -
DBESC,	0		/SUB FOR ESCAPE SEQUENCES
	TAD	(33	/ESC
	JMS	DBCORT	/SEND ESC
	TAD I	DBESC	/GET SPECIFIER
	ISZ	DBESC
	JMS	DBCORT	/SEND IT
	JMP I	DBESC

DBCORT,	0
	JMP I	DBINIT	/WHAT? IS THAT ALL?

	$$$

---