File: PE.TK of Disk: Disks/MyPDP/m8-blue-rka1-rkb1
(Source file text) 

/PE.TK 10-JUN-80
/**UASEM VERSION**
/FUNCTION: TO EMULATE THE PTP-PUNCHER IOTS AND TO SEND CHAR-
/	ACTERS FROM THE USER ACCUMULATOR TO THE PTP-PUNCHER.
/CONCEPT:THE PAPERTAPE-PUNCHER IS A SHARED DEVICE.
/	IT WOULD BE CONVENIENT IF THE CLAIM FOR IT
/	COULD BE HANDLED AUTOMATICALLY WITHOUT CONFLICTS.
/	THIS COULD BE ACHIEVED BY USING THE PTP-PUNCHER
/	BLOCKDRIVER AS OUTPUT MEDIUM: FOREGROUND PROGRAMS
/	USE IT TOO. SO WHOEVER HAS CLAIMED THE PTP-PUNCHER
/	BLOCKDRIVER, HAS CLAIMED THE PTP-PUNCHER TOO.
/	TWO BUFFERS ARE USED FOR SMOOTH OPERATION BETWEEN
/	BACKGROUND SWAPS.
/	ANY BLANKS SEND BEFORE THE FIRST PSF INSTRUCTION ARE
/	IGNORED (TO SUPPRESS THE HANGING IN CASE OF PROGRAMS
/	THAT DON'T ACTUALLY USE THE PUNCHER, BUT DO A 6024
/	JUST TO RAISE THE FLAG, E.G. FORTRAN II).
/	THE 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 BG-SCHEDULER INFORMED OF THIS. THEN THE
/	PTP-PUNCHER BLOCKDRIVER IS CALLED. WHEN BUSY, THIS
/	TASK LOOPS TO RETRY. BEFORE AWAITING THE COMPLETION
/	OF THE TRANSFER, A NEW BUFFER IS PREPARED FOR THE
/	NECESSARY OVERLAP. THE VERY LAST BUFFER IS
/	PADDED WITH BLANKS.
/	ON THE "GENERAL CLEAR", THE FILE IS CLOSED
/	AND A "CLEAR SWPOUT" IS DONE.
/	NOTE THAT PE CARRIES ITS BUFFERS IN ITS OWN BODY AND
/	IS THUS RATHER LARGE. PART OF THE INITIALIZING CODE
/	RESIDES IN THE BUFFER (ONCE ONLY CODE).

/	PAPERTAPE-IOTS ARE EMULATED AS FOLLOWS:
/	6020,5&7:ERROR RETURN, RESULTING IN ERROR MESSAGE
/	6021	:OVERLAID BY A PERMANENT SKIP
/	6022&3	:NO OPERATION
/	6024&6	:PUT CHARACTER IN BUFFER

PEBUFMAX=200	/LENGTH OF BUFFERS, MUST BE 1 PAGE OR 2,4,8,ETC.
IFNZRO PEBUFMAX&177+PEBUFMAX-1&PEBUFMAX <LNGTHR,XERROR>

BUFLNG=PEBUFMAX^2
/SETUP EMTAB:
	*0
	CDF 10		/EMTAB IS IN FIELD 1
	EMTAB+02	/DEVICE CODE 02
	"P^100+"E&3777	/NAME OF THIS TASK
	*200

	"P^100+"E&3777	/"PE"
	200+BUFLNG	/ONE PAGE PLUS BUFFER(S)
PEBUFI,	PEINIT		/START OF INITIALISATION
PETVI,	PETV		/POINTER TO TRANSFER VECTOR
PECA,	0
PE,	JMP I PEBUFI	/DO INITIALISATION. OVERLAYD WITH:
/	SZL CLA
	 JMP PECLR	/'CLEAR': CLOSE OUTPUT AND SWPOUT
PESTRT,	TAD I PEUINST	/FETCH INSTRUCTION
	AND C7
	CLL RAR
	SNA
	 JMP PE2	/6020 OR 6021
	TAD M1
	SZL		/6022 AND 6023 GIVE NOP
	SNA CLA		/ERROR FOR 6020, 6025 &6027
	 JMP PERET	/AC=0 FOR 6022 & 6023, REST # 0
	TAD I PEUAC	/6024 & 6026 MEAN: PUNCH
	AND PE377	/TAKE 8 BITS ONLY
PMYCDF,	CDTOIF		/BUFFER IS IN THIS FIELD
PEJMP,	JMP I PEP	/COROUTINE !
PEP,	PEP1		/ROUTINE TO GET NEXT CHAR FROM USER
PERET,	JMS MONITOR	//RETURN TO CENTRAL EMULATOR
	   RETURN	//

PECLR,	TAD PEJMP
	DCA PERET	/FILL UP BUFFER WITH ZERO'S
	DCA PEPAT1	/DISABLE PEFLIP CALLS
	DCA PEPAT2
	TAD XJMP
	DCA PEPAT3	/LET PE DO A SWPOUT
	JMP PMYCDF	/BE SURE TO WRITE THE BUFFER
YJMP,	DCA PEPAT3	/NOW FOR THE LAST TIME
	DCA PETV	/MAKE A CLOSE CALL
	JMP PECALL
/PATCH THE USER INSTRUCTION FOR FAST EMULATION.
PE2,	SZL CLA
	 TAD PESKP
	IAC		//AC=1 GIVES EMULATION ERROR
	JMP PERET	//CENTRAL EMULATOR WILL PATCH BG

PEP0,	JMS PEP		/GET FIRST CHAR
PEP1,	DCA I PECA	/STORE IN BUFFER
	JMS PEP		/GET SECOND CHAR
	DCA PETMP	/SET ASIDE FOR A WHILE
	JMS PEP		/GET THIRD CHAR
	RTL
	RTL
	DCA ZTEM1	/8 BITS LEFT JUSTIFIED
	TAD ZTEM1
	AND C7400	/TAKE FOUR HIGH ORDER BITS
	TAD I PECA	/ADD INTO FIRST BUFFER WORD
	DCA I PECA	/THATS ONE
	ISZ PECA	/BUMP POINTER TO NEXT BUFFER WORD
	TAD ZTEM1
	RTL
	RTL
	AND C7400	/FOR LOW ORDER BITS
	TAD PETMP	/ADD SECOND CHAR
	DCA I PECA	/STORE IN SECOND BUFFER WORD
	ISZ PECA	/BUMP POINTER FOR NEXT TIME
	ISZ PEWC	/INCREMENT DOUBLE-WORD COUNTER
	 JMP PEP0	/BUFFER NOT FULL YET, GO ON
PEPAT1,	JMS PEFLIP	/DEACTIVATE THE BG
	TAD PECA
	TAD PEBUFP	/-PEBUFMAX: START OF FULL BUFFER
	DCA PETV+1	/DROP INTO TRANSFER VECTOR
	TAD PEBUFI
	CIA
	TAD PECA
PE377,	AND PEBUFL	/-PEBUFMAX-PEBUFMAX-1 WRAP AROUND
	TAD PEBUFI
	DCA PECA
	JMS PEWT	/WAIT FOR COMPL. OF PREVIOUS XFER.
PECALL,	TAD PETVI	/GET POINTER TO TRANSFER VECTOR
	JMS MONITOR
	   CALL
	   "P^100+"P&3777
	 JMP PEWAIT	/PUNCHER ALREADY IN USE BY FOREGR.
	DCA PESLOT	/THIS IS THE EVENT #
PEPAT2,	JMS PEFLIP	/ACTIVATE THE BG
	TAD PEPENG	/-PEBUFMAX%2!4000
	DCA PEWC	/RESET WORDCOUNT
PEPAT3,	JMP PEP0	/AND CONTINUE
	JMS PEWT	/WAIT FOR COMPLETION OF LAST XFER.
	CDF 10
	JMS MONITOR
	   EXIT SWPOUT
PEFLIP,			/ACTIVATE/DEACTIVATE BG
PEWC,	-PEBUFMAX%2!4000/SHARED LOCATION !
	CDF 10
	TAD I PEUSTAT
	RAL
	CML RAL		/COMPLEMENT INACTIVE BIT
	CML RTR		/COMPLEMENT EMULATE BIT
IFNZRO BGMAX-1 <
	AND PELNG1	/CLEAR LONG SO WE GET PRIORITY >
	DCA I PEUSTAT
IFNZRO BGMAX-1 <
	JMS MONITOR	/KICK THE BG-SCHEDULER SO HE KNOWS
	   SIGNAL
	   BSSLOT	/ >
	CDTOIF
	JMP I PEFLIP

PETMP,			/SHARED LOCATION
PEWT,	0		/WAIT FOR COMPLETION
	JMS MONITOR
	   WAIT
PESLOT,	   -1		/MAKES 'WAIT' BEHAVE LIKE 'NOP'
	CLA		/IGNORE ERRORS
	JMP I PEWT

PEWAIT,	JMS MONITOR
	   STALL
	   DGNTICK	/
	CLA
	JMP PECALL

PEUFLDS,0	//*
PETV,	0	//*	/THIS IS THE ACTUAL TRANSFER VECTOR
	0	//*	/2 WORDS, BLOCK NUMBER NOT USED
PEUSTAT,0	//*
PEUAC,	0	//*THESE 7 WORDS IN THIS ORDER (PECOMN)
PEUINST,0	//*
PEUPC,	0	//*
XJMP,	JMP YJMP
PESKP,	SKP-1
IFNZRO BGMAX-1 <
PELNG1,	-LONG-1		/ >
PEPENG,	-PEBUFMAX%2!4000
IFZERO .-377&4000 <?>
*376
PEBUFP,	-PEBUFMAX
PEBUFL,	-PEBUFMAX-PEBUFMAX-1

PAGE
/THIS IS THE FIRST PAGE OF THE BUFFER AND CONTAINS
/A LOT OF INITIALISATION CODE.
BUFBEG=.		/BEGIN OF BUFFER

PEBUF0, BUFBEG		/BEGIN OF THIS PAGE
PEBUF1,	PEUFLDS-1
PEBUF7, PEBUFI-1
PEBUF8, PEP
PEBUF9, PEP1
PBUF10, PESTRT
PEPAT,	0

PEINIT,	DCA ZTEM1	/POINTER TO BG-AREA
	SZL
	 JMP PEIGNR
	TAD ZTEM1
	TAD (UINST
	JMS DEFER
	TAD (-PLS
	SZA		/PLS ?
	 JMP PEGO
	TAD ZTEM1
	TAD (UAC
	JMS DEFER	/GET UAC
PEGO,	SNA CLA		/IS IT A BLANK ?
	 JMP PEIGNR     /YES, THEN IGNORE THIS TRAP
	TAD ZTEM1
	TAD (UASEM-1	/SETUP POINTER TO UASEM
	DCA PEPAT	/IN OUR BG TABLE
PEASLP,	ISZ PEPAT
	TAD I PEPAT	/LOOK AT ENTRY
	SNA		/IS IT FREE ?
	 JMP PEASFR	/YES, GO PUT IN MY NAME
	CIA
	TAD PENAME	/WAS IT ALREADY USED BY ME ?
	SZA CLA
	 JMP PEASLP	/NO, SOME OTHER TASK, LOOK FOR MORE
PEASFR,	TAD PENAME
	DCA I PEPAT	/OK, PUT MY NAME IN UASEM TABLE
	CDTOIF
	TAD PEBUF9
	DCA I PEBUF8    /INITIALISE COROUTINES
	TAD PEBUF7
	DCA AUTO10
	TAD PEBUF0
	DCA I AUTO10    /BUFFER POINTER
	ISZ AUTO10      /SKIP POINTER TO DTV
	TAD PEBUF0
	DCA I AUTO10    /INITIALISE BUFFER POINTER
	TAD (SZL CLA
	DCA I AUTO10    /PATCH INITIALISATION CALL
	TAD PEBUF1
	DCA AUTO10
	TAD ZTEM1
	TAD (UFLDS
	DCA I AUTO10    /SET UP PEUFLDS
	TAD (PEBUFMAX%2+4000/SET UP PETV
	RIF
	DCA I AUTO10
	TAD PEBUF0
	DCA I AUTO10
	TAD ZTEM1
	DCA I AUTO10
	TAD ZTEM1
	TAD (UAC
	DCA I AUTO10
	TAD ZTEM1
	TAD (UINST
	DCA I AUTO10
	TAD ZTEM1
	TAD (UPC
	DCA I AUTO10	/SETUP PEUPC
	CDF 10		/+ ORIG. DF
	CLL
	JMP I PBUF10    /START TASK
PEIGNR,	JMS MONITOR	/NOT SERIOUS
	   EXIT SWPOUT

PENAME,	"P^100+"E&3777

	PAGE
	$$$