/******* MULTI8 LINEPRINTER EMULATOR *******
/LAST EDIT: 30-SEP-1975, ES
/LAST EDIT: 11-JAN-1975, JFA
/LAST EDIT 2-JANUARI-75, ELC
/CREATED 30-DECEMBER-74, ELC
/FUNCTION: TO EMULATE THE LINEPRINTER IOTS AND TO SEND 
/	CHARACTERS FROM THE USER  ACCUMULATOR TO THE LINEPRINTER.
/CONCEPT:THE LINEPRINTER IS ALSO A BUSILY SHARED
/	DEVICE. IT WOULD BE CONVENIENT IF THE CLAIM FOR IT
/	COULD BE HANDLED AUTOMATICALLY WITHOUT CONFLICTS.
/	THIS COULD BE ACHIEVED BY USING THE LINEPRINTER
/	BLOCKDRIVER AS OUTPUT MEDIUM: FOREGROUND PROGRAMS
/	USE IT TOO. SO WHOEVER HAS CLAIMED THE LINEPRINTER
/	BLOCKDRIVER, HAS CLAIMED THE LINEPRINTER TOO.
/	TWO BUFFERS ARE USED FOR SMOOTH OPERATION BETWEEN
/	BACKGROUND SWAPS.
/	CHARACTERS FROM THE BACKGROUND ARE PACKED (LIKE OS8) INTO
/	A BUFFER AS THEY ARE. WHEN THE BUFFER IS FULL, THE
/	BACKGROUND IS MADE INACTIVE AND THE BGSCHEDULER INFOR-
/	MED OF THIS. THEN THE LINEPRINTER BLOCKDRIVER IS CALLED
/	WHEN  RETRY. BEFORE 
/	AWAITE TRANSFER, A NEW BUFFERNECESSARY OVERLAP. THE VRMINATED WITH A CTRL/Z AND PADDED WITH BLANKS.
/	THIS IS INITIALISED BY THE AUTOMATIC 'CLOSE'
/	FEATURE WHEN CALLING THE KEYBOARD MONITOR. THE LINEPRINTER
/	EMULATOR THEN ALSO SWAPS OUT OF CORE.
/	NOTE THAT LE CA OWN BODY AND
/	IS THUSHE INITIALISING CODE
/	NCE ONLY CODE).

/	THIFIC ABOUT THE GROUP NUMBER
/	OF THE IOTS: IT CAN WORK FOR ANY DEVICE CODE.
/	IOTS ARE EMULATED AS FOLLOWS:
/	6XY0	:OVERLAID BY A PERMANENT SKIP
/	6XY1	:OVERLAID BY A PERMANENT SKIP
/	6XY4	:SEND CHARACTER
/	6XY6	:SEND CHARACTER
/	6000	:SEND ONE BUFFER (USED BY FAKE HANDLER)

/THIS TASK WILL PROBABLY WORK INCORRECT FOR OLDER PDP8'S.

S=1	/SINGLE BUFFER
/D=1	/DOUBLE BUFFERED
	*200

LEBUFMAX=1000	/LENGTH OF BUFFER(S) , MUST BE 1 PAGE OR 2,4,8,ETC.

LEUPC,	"L^100+"E&3777	/"LE"
LEUINST,
IFDEF D<200+LEBUFMAX+LEBUFMAX /ONE PAGE CODE PLUS TWO BUFFERS>
IFDEF S<200+LEBUFMAX	/ONE PAGE PLUS BUFFER>
LEBUFI,	LEBUF		/START OF BUFFER
LETVI,	LETV		/POINTER TO TRANSFER VECTOR
LECA,	0
LE,	JMS I LEBUFI	/DO INITIALISATION. OVERLAYD WITH:
/	SNA CLA
	 JMP LECLR	/'6000': CLOSE THIS OUTPUT AND SWPOUT
	TAD I LEUINST	/FETCH INSTRUCTION
	RAR		/6666 OR 6661 ?
	SZL CLA
	 JMP LE2	/6661
	TAD I LEUAC	/6666 (I HOPE)
	TAD LE7546	/-232
	SNA		/A ^Z IS CONSIDERRED END OF INPUEDITOR VIEW COMMAND MAY JMS LEPACK	/PACK CHARACT MONITOR	/RETURN TO CENT

LECLR,	DCA LEPAT1	/DISABLE LEFLIP CALLS
	DCA LEPAT2
	TAD LE232	/ADD A CONTROL-Z
	JMS LEPACK
	ISZ LEPCNT	/ONCE-ONLY COUNTER
	 JMP .-2	/BE SURE TO WRITE THE BUFFER
IFDEF D<JMS LEWT	/WAIT FOR COMPLETION OF LAS
	   EXIT SWPOUT

/PATFOR FAST EMULATION.
LE2LY GET 6661'S
	TAD I LE LINK !!
	ISZ I LEUPC	/LET HIM SKIP RIGHT NOW
	DCA ZTEM1	/ADDRESS OF INSTRUCTION
	TAD I LEUFLDS
	AND C70
	TAD C6201
	DCA .+1
	CDF		/CDF TO USERS INSTRUCTION FIELD
	TAD LESKP	/
	DCA I ZTEM1
	JMP LERET
LEPACK,	0		/ROUTINE TO PACK CHAR'S  IN OS/8 FORMAT
	AND K377	/TAKE 8 BITS ONLY
LMYCDF,	  HLT		/BUFFER IS IN THIS FIELD
	JMP I LEP	/COROUTINES !
LEP,	0		/ROUTINE TO GET NEXT CHAR FROM THE USER
	JMP I LEPACK

LEP0,	JMS LEP		/GET FIRST CHAR
LEP1,	DCA I LECA	/STORE IN BUFFER
	JMS LEP		/GET SECOND CHAR
	DCA LETMP	/SET ASIDE FOR A WILE
	JMS LEP		/GET THIRD CHAR
	RTL
	RTL
	DCA ZTEM1	/8 BITS LEFT JUSTIFIED
	TAD ZTEM1
	AND C7400	/TAKE FOUR HIGH ORDER BITS
	TAD I LECA	/ADD INTO FIRST BUFFER WORD
	DCA I LECA	/THATS ONE
	ISZ LECA	/BUMP POINTER TO NEXT BUFFER WORD
	TAD ZTEM1
	RTL
	RTL
	AND C7400	/FOR LOW ORDER BITS
	TAD LETMP	/ADD SECOND CHAR
	DCA I LECA	/STORE IN SECOND BUFFER WORD
	ISZ LECA	/BUMP POINTER FOR NEXT TIME
	ISZ LEWC	/INCREMENT DOUBLE-	/BUFFER NOT FULL YET, G	/DEACTIVATE THE BG
IFDCOMPLETION OF PREVIOUS XBUFP	/-LEBUFMAX: START OF FULL BUFFER
	DCA LETV+1	/DROP INTO TRANSFER VECTOR
	TAD LEBUFI
	CIA
	TAD LECA
K377,	AND LEBUFL	/-LEBUFMAX-LEBUFMAX-1 WRAP AROUND >
	TAD LEBUFI
	DCA LECA
	TAD LELENG	/-LEBUFMAX%2!4000OUNT
LECALL,	TAD LETVIR VECTOR
	JMS MONITOR
3777
	 JMP LEWAIT	/PRINREGROUND, WAIT
	DCA LESLOT	/THIS IS THE EVENT #
IFDEF S<JMS LEWT >
LEPAT2,	JMS LEFLIP	/ACTIVATE THE BG
	JMP LEP0	/AND CONTINUE

LEFLIP,	0		/ACTIVAT/DEACTIVATE BG
	CDF MONFLD
	TAD I LEUSTAT
	RAL
	CML RAL		/COMPLEMENT INACTIVE BIT
	CML RTR		/COMPLEMENT EMULATE BIT
	DCA I LEUSTAT
IFNZRO BGMAX-1 <
	JMS MONITOR	/KICK THE BG-SCHEDULER SO HE KNOWS
	   SIGNAL
	   BSSLOT >
	CDTOIF
	JMP I LEFLIP

LETMP,			/SHARED LOCATION
LEWT,	.-.		/WAIT FOR COMPLETION
	JMS MONITOR
	   WAIT
LESLOT,	   -1		/MAKES 'WAIT' BEHAVE LIKE 'NOP'
	CLA		/IGNORE ERRORS AND COMPLETION
	JMP I LEWT

LEWAIT,	JMS MONITOR
	   STALL
	   DGNTICK	/
	CLA
	JMP LECALL

LETV,	ZBLOCK 3	/THIS IS THE ACTUAL TRANSFER VECTOR
	*.-1		/SHARED LOCATION, BLOCK NUMBER NOT USED
LEUSTAT,0
LEUAC,	0
LEUFLDS,0
LEPCNT,	-LEBUFMAX^3%2!4000
LEWC,	-LEBUFMAX%2!4000
LESKP,	SKP
LELNG1,	-LONG-1
LELENG,	-LEBUFMAX%2!4000
LE232,	232
LE7546,	-232
IFDEF D <
IFZERO .-377&4000 <?>
*376
LEBUFP,	-LEBUFMAXFMAX-1 >
IFDEF S <
K37/THIS IS THE FIRST PAGE NS
/A LOT OF INITIALISABUFI
LEBUF1,	LETV
LEBUF2,	LETV+1
LEBUF3,	LE
LEBUF4,	LEUPC
LEBUF5,	LEUSTAT
LEBUF6,	LEUINST
LEBUF7,	LEUAC
LEBUF8,	LEP
LEBUF9,	LEP1
LBUF10,	LEUFLDS
LBUF11,	.&7600		/START ADDRESS OF THIS PAGE
LBUF12,	LECA
LBUF13,	LMYCDF
LBUF14, LE&7600+400
LBUF15, 200
LBUF16, LE
LBUF17, L2UAC
LBUF18, L2UPC
LBUF19, L2UDTV
LBUF20, L2UDT2
LBUF21, L2USLT
LBUF22,	L2UINST
LBUF23,	L2USTAT
LBUF24,	L2CAO
LBUF25,	L2TV

LEBUF,	0		/INITIALISATION SUBROUTINE
	SZA
	 JMP .+3
	JMS MONITOR	/JUST A '6000'
	   EXIT RELEASE
	ISZ LEBUF	/ADJUST RETURN ADDRESS
	DCA ZTEM1	/POINTER TO BG-AREA
	TAD ZTEM1
	TAD (UINST
	JMS DEFER	/GET UINST
	TAD (-6000	/IS IT 6000
	SNA CLA		/NO
	JMP LEFAK	/Y:MOVE FAKE EMULATOR
	CDTOIF
	TAD ZTEM1
	DCA I LEBUF5	/SET UP LEUSTAT
	TAD ZTEM1
	TAD (UPC
	DCA I LEBUF4	/SET UP LEUPC
	TAD ZTEM1
	TAD (UFLDS
	DCA I LBUF10	/SET UP LEUFLDS
	TAD ZTEM1
	TAD (UAC
	DCA I LEBUF7	/SET UP LEUAC
	TAD ZTEM1
	TAD (UINST
	DCA I LEBUF6	/SET UP LEUINST
	TAD 	DCA I LEBUF1	/FIRST WRDD LBUF11
	DCA I LEBUF2	FER VECTOR
	TAD LBUF11OINTER
	TAD (SNA CLA
	DCA I LEBUF3	/PATCH INITIALISATION CALL
	TAD LEBUF9
	DCA I LEBUF8	/INITILAISE COROUTINES
	TAD LBUF11
	DCA I LBUF12	/INITIALISE  BUFFER POINTER
	TAD MYCDF
	DCA I LBUF13
	CDF MONFLD
	JMP
	TAD I LBUF14	/MOVE FAA I LBUF15
	ISZ LBUF14/READY?
	JMP LEFAK+1	/NF23	/SET L2USTAT
	TAD ZTEM1
	TAD (UAC
	DCA I LBUF17	/SET L2UAC
	TAD ZTEM1
	TAD (UPC
	DCA I LBUF18	/SET L2UPC
	TAD ZTEM1
	TAD (UDTV
	DCA I LBUF19	/SET L2UDTV
	CLA IAC
	TAD I LBUF19	/SET L2UDTV+1
	DCA I LBUF20
	TAD ZTEM1
	TAD (USLOT
	CDF MONFLD
	JMS DEFER
	CDTOIF
	DCA I LBUF21	/SET L2USLT
	TAD ZTEM1
	TAD (UINST
	DCA I LBUF22	/SET UINST
	TAD LBUF11
	DCA I LBUF24	/SET BUFFER POINTER
	TAD (L2BUFMAX+4000
	RDF
	DCA I LBUF25	/SET FUNCTION WORD FOR LINEPRINTER CALL
	TAD ZTEM1	/GET ORIG. AC CONTENTS
	CDF MONFLD	/+ ORIG. DF
	JMP I LBUF16	/START TASK

LEFT,	-200		/FOR ONE PAGE

PAGE
/THIS IS THE EMULATOR FOR THE FAKE LPT HANDLER
/THE PROGRAM IS MOVED BY THE INITIALIZE ROUTINE
/AT THE FIRST CALL TROUGH THE FAKE HANDLER
/IT COPIES THE BG-DATA TO THE BUFFER
/AND CALLS "LP"
/
IFDEF D <L2BUFMAX=LEBUFMAX>
IFDEF S <L2BUFMAX=LEBUFMAX%2>
	RELOC 200

L2TV,	.		/XFER WORDS
L2BUFI,	400		/----------
L2TVI,	L2TV
L2CAI,	0
L2CAO,	0
/NOTE: LE MUST BAS LE
LE,	SNA CLA		/AC=MP L2CLR	/AC=0 : JUST A IS REALY 6000 ?
	TAD I  JMP L2ERR	/N:ERROR
	DCA I L2UAC	/CLEAR UAC
	TAD I L2UDTV	/GET FUNCTION
	SMA		/WRITE IS OK
	 JMP L2ERR1	/READ IS BAD
	CLL RTR
	RTR
	RTR
	AND C37
	SNA
	 JMP L2CLR	/WC=0 : RELEASE (CLOSE OPERATION)
	CIA
	DCES
	TAD I L2UDTV	/GET F	/FLD BITS
	TAD C6201	/TAD I L2UDT2	/GET CA
	DCA L2CDFO	/FASTER THEN CDTOIF
L2LP1,	TAD C7600	/SET TALLY FOR ONE PAGE
	DCA L2PGCT
L2LP2,
L2CDFI,	CDF		/'CDF INPUT FLD
	TAD I L2CAI	/GET A WORD FROM BG
	ISZ L2CAI	/UPD. PNTR
	NOP
L2CDFO,	CDF		/'CDF OUTPUT FLD
	DCA I L2CAO	/TO BUFFER
	ISZ L2CAO
	NOP		/MAY SKIP
	ISZ L2PGCT	/DONE 200 WORDS ?
	 JMP L2LP2	/N
	ISZ L2CNTO	/OUTPUT BUFFER FULL?
	 JMP L2CONT	/NO
	TAD CIEN	/INACTIVE-EMULATE+NOBOOT
	JMS L2FLIP	/SET BG INACTIVE
	JMS L2OUT	/CALL LP TO OUTPUT BUFFER
	TAD CEIIN	/EMULATE+INCORE-INACTIVE-NOBOOT
	JMS L2FLIP	/SET BG EMULATE AND IN CORE
	JMS MONITOR	/WAIT FOR BG IN CORE
	  WAIT
L2USLT,	  0		/' INITIALIZED TO USLOT
L2CONT,	JMS MONITOR
	   PRECEDE
	ISZ L2CNTI	/DONE ALL INPUT ?
	JMP L2LP1	/N: CONTINE
L2RTN,	JMS MONITOR	/Y: RETURN
	  RETURN

L2WAIT,	JMS MONITOR
	  STALL
	  DGNTICK
	CLA
	JMP L2CALL
L2OUT,	0		/OUTPUT BUFFER
	CDTOIF
	TAD L2TVI
L2CALL,	JMS MONITOR	/OUTPUT BUFFER
	  CALL
	  "L^100+"P&3777
	 JMP L2WAIT	/LP IS BUSY
	DCA L2SONITOR
	  WAIT
L2SLOT,ORS
	TAD L2BUFI
	DCA LD L2LENG
	DCA L2CNTO	/AUT	/RETURN

L2PGCT,
L2FLIP,	0		/ACTIVATE/DEACTIVATE BG
	CDF MONFLD
	TAD I L2USTAT
IFNZRO BGMAX-1 <
	AND CLONG	/CLEAR LONG SO WE GET PRIORITY >
	DCA I L2USTAT
IFNZRO BGMAX-1 <
	JMS MONITOR	/KICK BS
	  SIGNA2FLIP	/RETURN

L2ERR,	R1,	AC4000
	DCA I L2UACAD L2CNTO
	CIA
	TAD L2NG WRONG ?
	 JMS L2OUT	/OUTPUT LAST BUFFER
	CDTOIF
	TAD C232	/OUTPUT A CNTRL Z
	DCA I L2BUFI
	JMS L2OUT	/CALL LP
L2RDY,	JMS MONITOR	/EXIT
	  EXIT SWPOUT

L2CNTO,	-L2BUFMAX-L2BUFMAX%200!7740
L2CNTI,	0
L2LENG,	-L2BUFMAX-L2BUFMAX%200!7740
L2LNG2,	L2BUFMAX+L2BUFMAX%200
L2USTAT,0
L2UPC,	0
L2UAC,	0
L2UDTV,	0
L2UDT2,	0
L2UINST, 0
CIEN,	INACTIVE-EMULATE+NOBOOT
C2201,	-6201+4000
CEIIN,	EMULATE+INCORE-INACTIVE-NOBOOT
CLONG,	-LONG-1
C232,	232

	PAGE
RELOC

IFDEF D<ZBLOCK LEBUFMAX^2-400   /THE REST OF THE BUFFER >
IFDEF S<ZBLOCK LEBUFMAX-400     /THE REST OF THE BUFFER >

BUFEND=.-1
$