Google
 

Trailing-Edge - PDP-10 Archives - BB-Y393D-SM - monitor-sources/cdrsrv.mac
There are 49 other files named cdrsrv.mac in the archive. Click here to see a list.
;Edit 2946 by MOSER on Mon 11-Apr-83 - FIX CARD READERS
;EDIT 2496 - FIX CARD READERS
;<4-1-FIELD-IMAGE.MONITOR>CDRSRV.MAC.2, 25-Feb-82 20:13:48, EDIT BY DONAHUE
;UPDATE COPYRIGHT DATE
; UPD ID= 697, FARK:<4-WORKING-SOURCES.MONITOR>CDRSRV.MAC.2,   9-Aug-81 20:17:28 by ZIMA
;Edit 1920 - remove unneeded instruction in REQPSI.
; UPD ID= 213, SNARK:<4.1.MONITOR>CDRSRV.MAC.9,  22-Jan-80 08:42:23 by OSMAN
;tco 4.2597 - prevent CDILVT bughlt on KS
;<OSMAN.MON>CDRSRV.MAC.1, 10-Sep-79 15:19:44, EDIT BY OSMAN
;TCO 4.2412 - Move definition of BUGHLTs, BUGCHKs, and BUGINFs to BUGS.MAC
;<4.MONITOR>CDRSRV.MAC.7,  4-Mar-79 14:43:48, Edit by KONEN
;UPDATE COPYRIGHT FOR RELEASE 4
;<4.MONITOR>CDRSRV.MAC.6, 19-Dec-78 09:53:48, EDIT BY ENGEL
;FIX EOF CHECKING AT SETUP
;<4.MONITOR>CDRSRV.MAC.5,  8-Dec-78 17:27:09, EDIT BY MILLER
;<4.MONITOR>CDRSRV.MAC.4,  8-Dec-78 16:56:10, EDIT BY MILLER
;MAKE CDRBLK INTERNAL
;<4.MONITOR>CDRSRV.MAC.3, 14-Jul-78 12:49:08, Edit by MCLEAN
;<4.MONITOR>CDRSRV.MAC.2, 14-Jul-78 01:59:02, Edit by MCLEAN
;<4.MONITOR>CDRSRV.MAC.1, 14-Jul-78 01:00:35, Edit by MCLEAN
;ADD OPEN CHECK FOR MTOPR TCO 1770

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1976,1977,1978,1979,1981,1982 BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.

	SEARCH PROLOG

	DEFINE FNCALL (A,B),<
	LOAD A,CDRTYP
	MOVE A,CDRDVT(A)
	CALL @B(A)>

   IFE SMFLG,<

	TTITLE CDRSRV
   >
   IFN SMFLG,<
	TTITLE CDRSRV,CDRSM
   >

;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
;  OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1977 BY DIGITAL EQUIPMENT CORPORATION

;SPECIAL REGISTERS USED HEREIN. SEE GTJFN AND FILE SYSTEM CODE
;FOR SPECIFICS ON THE USAGE OF THESE REGISTERS

DEFAC (U,Q1)
DEFAC (STS,P1)
DEFAC (JFN,P2)
DEFAC (DEV,P4)

; DEVICE DEPENDENT OFFSETS

RDCD=0		;READ CARD
CDCLZ=1		;CLOSE
CDRST=2		;RESTART
CDINI=3		;INIT
GCDRST=4	;GET STATUS
BUFSWP=5	;SWAP BUFFER TO CORRECT FORMAT


;DATA DEFINTIONS FOR THE CDR

DEFSTR (CDERR,CDRSTS,35,16)	;LAST ERROR CONDITION
DEFSTR (CDFRK,CDRSTS,17,18)	;OWNING FORK
DEFSTR (CDBLK,CDRSTS,18,1)	;WAITING FOR A CARD
DEFSTR (CDOL,CDRSTS,19,1)	;IF ONE, CARDS IN THE READER

;OTHER STATUS WORD

DEFSTR (CDAII,CDRST1,0,1)	;READER IS OPENED IN ASCII
DEFSTR (CDATN,CDRST1,1,1)	;CDR NEEDS ATTENTION
DEFSTR (CDMSG,CDRST1,2,1)	;SUPPRESS SYSTEM MESSAGES
DEFSTR (CDOPN,CDRST1,3,1)	;CDR IS OPENED
DEFSTR (CDER,CDRST1,4,1)	;ERROR IN THIS CDR
DEFSTR (CDCNT,CDRST1,12,8)	;COUNT OF BYTES NOW IN BUFFER
DEFSTR (CDEOF,CDRST1,13,1)	;EOF BUTTON WAS PUSHED
DEFSTR (CDBUF,CDRST1,14,1)	;BUFFER FOR PROCESS LEVEL
DEFSTR (CDPIR,CDRST1,15,1)	;PROCESS NEEDS INTERRUPT
DEFSTR (CDBFI,CDRST1,16,1)	;BUFFER FOR PI LEVEL
DEFSTR (CDDON,CDRST1,17,1)	;BIT TO SAY DOING A BUFFER BY PROCESS
DEFSTR (CDWRD,CDRST1,35,18)	;CURRENT WORD FOR INT STORAGE

; THIRD STATUS WORD

CD%SHA==1B0			;STATUS HAS ARRIVED FLAG
CD%RLD==1B2			;FRONT END WAS RELOADED

DEFSTR (CDPSI,CDRST2,17,6)	;PSI CHANNEL NUMBER FOR ON-LINE TRANSITIONS
DEFSTR (CDSST,CDRST2,35,16)	;SOFTWARE STATUS WORD STORED HERE
DEFSTR (CDSHA,CDRST2,0,1)	;STATUS HAS ARRIVED FLAG
DEFSTR (CDMWS,CDRST2,1,1)	;MTOPR IS WAITING FOR STATUS TO ARRIVE
MSKSTR (CDRLD,CDRST2,CD%RLD)	;FRONT END WAS RELOADED
DEFSTR (CDOFI,CDRST2,3,1)	;OFF-LINE INTERRUPT IS PENDING
DEFSTR (CDEFI,CDRST2,4,1)	;END OF FILE INTERRUPT WAS ALREADY GIVEN
DEFSTR (CDRTYP,CDRST2,6,2)	;TYPE OF CARD READER
DEFSTR (CDEXST,CDRST2,7,1)	;EXISTANCE OF READER 

INIPSI==77			;INITIAL PSI CHANNEL VALUE, MEANS NOT ENABLED
;CDR DTB

;PROTOCOL VECTOR

	RESCD
CDRDVT::CDVTFE			;FRONT-END
   FETYP=0			;TYPE FOR FE
	CDVTKS			;KS10
   KSTYP=1			;KS10 TYPE

	SWAPCD			;SWAPPABLE

CDRDTB::DTBBAD (GJFX32)		;Set directory
	DTBBAD (DESX9)		;NAME LOOKUP
	DTBBAD (DESX9)		;EXTENSION
	DTBBAD (DESX9)		;VERSION
	DTBBAD (DESX9)		;INSERT PROTECTION
	DTBBAD (DESX9)		;INSERT ACCOUNT
	DTBBAD (DESX9)
	DTBDSP (CDROPN)
	DTBDSP (CDRSQI)		;SEQUENTIAL INPUT
	DTBBAD (DESX9)		;OUTPUT
	DTBDSP (CDRCLZ)		;CLOSE
	DTBBAD (DESX9)		;RENAME
	DTBBAD (DESX9)		;DELETE
	DTBBAD (DUMPX6)
	DTBBAD (DUMPX6)
	DTBBAD (DESX9)		;MOUNT
	DTBBAD (DESX9)		;DISMOUNT
	DTBBAD (DESX9)		;INIT DIRECTORY
	DTBDSP (CDRMTO)		;MTOPR
	DTBDSP (CDRDST)		;DEVICE STATUS
	DTBBAD (DESX9)		;SET STATUS
	DTBSKP			;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

	DTBLEN==:.-CDRDTB	;GLOBAL LENGTH OF DISPATCH TABLE
;INITIALIZATION CODE CALLED FROM PROTOCOL HANDLER

CDRINI::MOVSI U,-CDRN		;NUMBER OF CDR'S
	SETOM CDRCNT		;COUNT OF CDR'S NOW OPENED
	SETOM CDRLCK		;INITILIZE LOCK
CDRLP1:	SETZM CDRSTS(U)		;CLEAR STATUS WORD
	SETZM CDRST1(U)
	SETZM CDRST2(U)		;THIRD STATUS WORD
	AOBJN  U,CDRLP1
	MOVEI Q2,0		;UNIT NUMBER
	MOVE A,CDRDVT		;INITALIZE CARD READERS
	CALL @CDINI(A)
	MOVE A,CDRDVT+1
	CALL @CDINI(A)
	MOVSI U,-CDRN		;NUMBER OF CDR'S
CDRLOP:	JE CDEXST,(U),CDRLP2 ;FORGET IT IF NO CDR
	HRRZ T4,Q2		;SET UNIT NUMBER
	FNCALL A,GCDRST		;GET STATUS
	MOVEI A,^D60000		;MUST LOOK AT EACH ONE ONCE A MINUTE
	ADD A,TODCLK		;FROM NOW
	MOVEM A,CDRCKT(U)	;STORE IT
CDRLP2:	AOBJN U,CDRLOP		;DO ALL OF THEM
	RET			;AND DONE

;RESTART ROUTINE

CDRRST::MOVSI U,-CDRN		;DO ALL CARD READERS
CDRRLP:	FNCALL A,CDRST		;DO DEVICE RESTART
	
	AOBJN U,CDRRLP		;DO ALL
	RET
;ROUTINE TO OPEN A CDR

CDROPN:	SKIPN PROFLG		;EVER GOING TO USE PRIMARY PROTOCOL ?
	RETBAD (OPNX18)		;NO, PREVENT OPENS SINCE LOCK NOT INITIALIZED
	HLRZ U,DEV		;GET UNIT
	LOCK CDRLCK,<CALL LCKTST> ;LOCK UP THE CDR LOCK
	JN CDOPN,(U),[	UNLOCK CDRLCK
		MOVEI A,OPNX9	;ALREADY OPENED
		RET]		;GIVE ERROR
	JE CDOL,(U),[CALL CHKOFL ;SEE IF OPENS ARE ALLOWED IF OFFLINE
		 SKIPA		;NO
		JRST .+1	;YES
		UNLOCK CDRLCK
		MOVEI A,OPNX8	;ERROR CODE
		RET]
	TQNE <READF>		;WANT READ?
	TQNE <WRTF>		;YES. AND NOT WRITE?
	JRST [	UNLOCK CDRLCK	;CAN'T OPEN IT THAT WAY
		RETBAD (OPNX13)] ;BOMB IT
	SETONE CDOPN,(U)	;SAY IS NOW OPENED
	MOVE A,FORKX		;GET FORK ID OF OPENER
	STOR A,CDFRK,(U)	;REMEMBER FOR SYSERR
	MOVX A,INIPSI		;GET INITIAL PSI CHANNEL VALUE (NOT ENABLED)
	STOR A,CDPSI,(U)	;SAVE FLAG THAT NO PSI IS ENABLED
	SETZRO CDPIR,(U)	;CLEAR INTERRUPT FLAG
	SETZRO CDOFI,(U)	;FOR BOTH ONLINE AND OFFLINE INTERRUPTS
	AOSE CDRCNT		;FIRST OPENING?
	JRST CDRSET		;NO. PAGE IS ALREADY LOCKED
	MOVEI A,CDRBUF		;GET THE ADDDRESS
	MOVES (A)		;CREATE THE PAGE
	CALL FPTA		;GET PTN.PN
	CALL MLKPG		;AND LOCK IT DOWN
CDRSET:	SETZM FILCNT(JFN)	;NO COUNT
	SETZRO <CDBUF,CDBFI>,(U) ;CLEAR BUFFER POINTERS
	SETZRO <CDDON,CDER>,(U)	;CLEAR PI ACTIVE AND ERROR
	SETOM CDRCT1(U)		;NO BUFFERS AVAILABLE YET
	SETZM FILBYT(JFN)	;AND NO BUFFER POINTER
	SETZM FILBYN(JFN)	;NO BYTE NUMBER
	SETZM FILLEN(JFN)	;NO BYTES YET
	UNLOCK CDRLCK		;CLEAR LOCK
	LDB A,[POINT 6,P5,5]	;GET OPEN SIZE
	DPB A,PBYTSZ		;SAVE IT
	SETZRO CDAII,(U)	;ASSUME NOT ASCII
	TRNE STS,17		;IS IT ASCII?
	RETSKP			;NO. RETURN NOW
	SETONE CDAII,(U)	;YES. REMEMBER THIS
	RETSKP			;AND RETURN
;CLOSE A CDR

CDRCLZ:	HLRZ U,DEV		;GET UNIT
	FNCALL A,CDCLZ
	JFCL
	LOCK CDRLCK,<CALL LCKTST> ;GO GET THE LOCK
	SETZRO CDOPN,(U)	;NOT OPENED
	SETZRO CDEOF,(U)	;CLEAR EOF ALLOWING STATUS
	SETZRO CDFRK,(U)	;NO OWNER
	SETZRO CDBLK,(U)	;NOT BLOCKED
	SETZRO CDMSG,(U)	;NO SUPPRESS MESSAGES
	SOSL CDRCNT		;LAST CLOSE?
	JRST CDRCL1		;NO. ALL DONE
	MOVEI A,CDRBUF		;YES. UNLOCK THE PAGE
	CALL FPTA		;GET PTN.PN
	CALL MULKPG		;UNLOCK IT
CDRCL1:	UNLOCK CDRLCK		;FREE THE LOCK
	RETSKP

;ROUTINE TO ARRANGE A BLOCK FOR CARD ARRIVED

WAIT:	JE CDOFI,(U),WAIT1	;SEE IF INTERRUPT NEEDED
	SETZRO CDOFI,(U)	;YES, ONLY DO IT ONCE
	MOVE B,U		;GET UNIT NUMBER
	CALL REQPSI		;AND REQUEST THE INTERRUPT
WAIT1:	TQO <BLKF,HLDF>		;REQUEST BLOCK AND HOLD
	MOVEI A,0(U)		;UNIT TO LH
	HRRI A,CDRBLK		;WAIT FOR THE CARD TO ARRIVE
	RET			;AND RETURN

;ROUTINE TO CALCULATE THE STRING DATA BUFFER ADDRESS

SETBUF:	LOAD C,CDBUF,(U)	;GET BUFFER CONTROL BIT
	JRST SETBF2		;GO TO RESIDENT ROUTINE FOR COMPUTATION

	RESCD

SETBF1:	LOAD C,CDBFI,(U)	;GET INTERRUPT BUFFER CONTROL
SETBF2:	MOVEI B,0(U)		;UNIT
	IMULI B,CDRLEN		;*LENGTH OF A BUFFER
	MOVEI A,CDRBUF		;START OF ALL BUFFERS
	ADDI A,0(B)		;THE ADDRESS
	IMULI C,CDRSIZ		;SIZE OF ONE BUFFER LOAD
	ADDI A,0(C)		;THIS BUFFER
	RET
	SWAPCD
;CDR SEQUENTIAL INPUT

CDRSQI:	HLRZ U,DEV		;GET UNIT
	SETZRO CDRLD,(U)	;FORGET THAT FRONT END WAS RELOADED
CDRSQ2:	SOSL FILCNT(JFN)	;HAVE ANY BYTES?
	JRST CDRSQ1		;YES. GO GET THEM
	OPSTR <SKIPE>,CDDON,(U)	;WERE WE DOING A BUFFER?
	SOS CDRCT1(U)		;YES. WE JUST FINISHED ONE THEN
	SETZRO CDDON,(U)	;NOT DOING A BUFFER NOW
	SKIPL CDRCT1(U)		;HAVE A CARD READY TO GO?
	JRST SETUP		;YES. GO DO IT
	JN CDEOF,(U),[		;HAVE EOF AT END OF THIS CARD?
		SETZRO CDEOF,(U) ;EOF NOW CLEARED
		JN CDEFI,(U),.+1 ;IF ALREADY GIVEN INTERRUPT, DONT AGAIN
		SETONE CDEFI,(U) ;MARK THAT AN EOF WAS GIVEN
		TQO <EOFF>	;YES. RETURN THIS STATUS
		RET]		;AND DONE
	JN CDER,(U),[		;ERROR?
		TQO <ERRF>	;YES. SAY SO
		SETZRO CDER,(U)	;NO ERROR FOR THE NEXT TIME
		RET]		;AND RETURN
	JN CDBLK,(U),WAIT	;HAVE A REQUEST OUTSTANDING?
	SKIPL CDRCT1(U)		;NO. CHECK THIS AGAIN FOR THE RACE
	JRST SETUP		;HAVE A CARD AFTER ALL.
	CALL RDCARD		;NOTHING ACTIVE. GO GET A CARD
	JRST WAIT		;AND GO WAIT

;ROUTINE TO INITIALIZE THE POINTERS FOR A BUFFER

SETUP:	SETONE CDDON,(U)	;NOW WORKING ON A BUFFER
	MOVEI A,^D80		;ONE CARD OF BYTES
	MOVEM A,FILCNT(JFN)	;TO THE COUNT WORD
	CALL SETBUF		;GO FIND START OF THIS BUFFER
	HRRM A,FILBYT(JFN)	;SAVE BASE ADDRESS
	LOAD B,CDBUF,(U)	;GET BUFFER BIT
	XORI B,1		;COMPLEMENT IT
	STOR B,CDBUF,(U)	;MAKE NEXT BUFFER USED NEXT TIME
	MOVEI A,^D16		;ASSUME WE HAVE 16 BIT BYTES
	TRNE STS,17		;ASCII MODE?
	JRST [	FNCALL T2,BUFSWP	;MAKE CORRECT FORMAT BUFFER
		JRST SETUPA]
	CALL CDRAII		;YES. GO CONVERT TO ASCII
SETUPA:	OPSTR <SKIPE>,CDEOF,(U)	;IGNORE TEST IF NO END OF FILE PRESENT
	SKIPLE FILCNT(JFN)	;HAVE END OF FILE - ANY DATA WITH IT?
	SKIPA			;YES - HANDLE THE DATA
	JRST CDRSQ2		;NO - HANDLE THE EOF
	OPSTR <SKIPN>,CDBLK,(U)	;IS PI ROUTINE ACTIVE
	SKIPLE CDRCT1(U)	;NO. HAVE A PI BUFFER?
	SKIPA			;CAN'T DO READ AHEAD
	CALL RDCARD		;READ A CARD
	; ..
	; ..
;NOW COMPUTE NUMBER OF BYTES IN BUFFER. NUMBER OF BYTES IS
;GOTTEN BY:
;	NB1=NB0/(B1/B0)		IF B1>= B0
;	OR
;	NB1=NB0*(B0/B1)		;IF B0> B1

SETUP1:	LDB C,PBYTSZ		;GET B1
	CAIGE C,0(A)		;DOES USER WANT LARGER OR SMALLER
				 ; BYTES?
	JRST [	IDIVI A,0(C)	;WANTS SMALLER
		IMUL A,FILCNT(JFN) ;COMPUTE # OF USER BYTES
		JRST SETUP2]	;AND CONTINUE
	IDIVI C,0(A)		;LARGER
	MOVE A,FILCNT(JFN)	;GET  NB0
	IDIVI A,0(C)		;DO THE DIVIDE
	SKIPE B			;ANY REMAINDER?
	AOS A			;YES. MUST ROUND
SETUP2:	ADDM A,FILLEN(JFN)	;EXTEND FILE EOF
	MOVEM A,FILCNT(JFN)	;NEW COUNT
	MOVEI A,44		;BYTE POSITION
	DPB A,[POINT 6,FILBYT(JFN),5] ;MAKE A REAL BYTE POINTER
	JRST CDRSQ2		;GO DO THIS CARD


;GET A BYTE FOR THE ROUTINE

CDRSQ1:	ILDB A,FILBYT(JFN)	;GET  A BYTE
	AOS FILBYN(JFN)		;PICKED UP A BYTE
	RET			;GIVE GOOD RETURN

;GET DEVICE DEPENDENT STATUS

CDRDST:	HLRZ U,DEV		;GET UNIT
	LOAD A,CDERR,(U)	;LAST ERROR
	JE CDRLD,(U),CDRDS1	;IF NO FRONT END RELOAD, GO ON
	TXO A,MO%RLD		;MARK THAT FRONT END HAS BEEN RELOADED
CDRDS1:	JE CDOL,(U),R		;OFF-LINE
	TLO A,(1B0)		;IS ON LINE
	RET			;AND DONE
;CODE TO CONVERT IMAGE OF CARD INTO ASCII

CDRAII:	PUSH P,P3
	PUSH P,DEV
	PUSH P,P5		;SAVE SOME REGISTERS
	MOVEI D,^D80		;DO ALL COLUMNS
	HRRZ P3,FILBYT(JFN)	;GET BUFFER ADDRESS
	MOVEI A,0(P3)		;IN HERE TOO
	HRLI P3,(POINT 7,)	;FORM BYTE POINTER
	HLL A,ASCBSZ		;GET SOURCE SIZE
	ILDB C,A		;GET FIRST COLUMN
	TRNE C,360		;ANYTHING IN 2-5 ?
	JRST CDRAI3		;YES. CAN'T BE EOF THEN
	TRC C,7417		;SEE IF IT IS AN EOF
	TRCE C,17		;?
	TRCN C,7400		;?
	JRST CDREFF		;YES. IT IS
	SKIPA			;NO. PROCESS THIS CARD
CDRAI1:	ILDB C,A		;GET NEXT BYTE
CDRAI3:	TRNE C,100000		;MULTI-PUNCH?
	JRST CDRILL		;YES. ILLEGAL ASCII CHARACTER
	MOVE DEV,C		;GET COLUMN
	ANDI DEV,7003		;ISOLATE ZONES AND 8 AND 9
	TRZE DEV,2		;IS 8 PUNCHED?
	TRO DEV,400		;YES. LIGHT BIT
	TRZE DEV,1		;IS 9 PUNCHED?
	TRO DEV,200		;YES
	LSH DEV,-4		;PUT ZONES WHERE THEY BELONG
	LSH C,-^D12		;GET ENCODED ROWS 1-7
	IORI DEV,0(C)		;FORM CHARACTER
	IDIVI DEV,5		;FIND WORD NUMBER AND REMAINDER
	LDB C,[	POINT 7,ASCTBL(DEV),6 ;FIRST BYTE
		POINT 7,ASCTBL(DEV),13 ;SECOND BYTE
		POINT 7,ASCTBL(DEV),20 ;THIRD BYTE
		POINT 7,ASCTBL(DEV),27 ;FOURTH BYTE
		POINT 7,ASCTBL(DEV),34](P5) ;FIFTH BYTE
CDRAI2:	IDPB C,P3		;STASH AWAY THE BYTE
	SOJG D,CDRAI1		;GO DO ALL COLUMNS
	MOVEI A,.CHCRT		;GET A CR
	IDPB A,P3		;TO THE BUFFER
	MOVEI A,.CHLFD		;AND GET A LF
	IDPB A,P3		;TO THE BUFFER
	MOVEI A,^D82		;NEW SIZE OF BUFFER
	MOVEM A,FILCNT(JFN)	;TO THE JFN BLOCK
	MOVEI A,3		;NUMBER OF BYTES TO FILL
	SETZ B,			;A NULL
CDRAI5:	IDPB B,P3		;PUT IN A NULL
	SOJG A,CDRAI5		;DO ALL BYTES
	JRST CDRAXT		;DONE

CDRILL:	MOVEI C,.CRILC		;ILLEAGL ASCII CHARACTER
	JRST CDRAI2

CDREFF:	SETZM FILCNT(JFN)	;NO BYTES HERE
	SETONE CDEOF,(U)	;LIGHT EOF THOUGH
CDRAXT:	POP P,P5
	POP P,DEV
	POP P,P3		;RESTORE REGS
	MOVEI A,7		;HAVE SEVEN BIT BYTES INTERNALLY
	RET			;AND DONE
;ROUTINE TO PROCESS MTOPR FUNCTIONS:

CDRMTO:	TQNN <OPNF>		;CHECK FOR OPENED YET
	RETBAD (CLSX1)		;NO ERROR
	HLRZ U,DEV		;GET UNIT NUMBER
	MOVSI A,-CDMSIZ		;SET UP AOBJN POINTER TO SEARCH FOR FUNCTION
CDMT10:	HLRZ C,CDMTAB(A)	;GET FUNCTION CODE FROM TABLE
	CAMN C,B		;FOUND REQUESTED FUNCTION ?
	JRST CDMT20		;YES, GO DISPATCH
	AOBJN A,CDMT10		;NO, LOOP OVER DISPATCH TABLE
	RETBAD (MTOX1)		;NOT FOUND, RETURN INVALID FUNCTION ERROR

; HERE WITH A VALID FUNCTION CODE

CDMT20:	HRRZ C,CDMTAB(A)	;GET ROUTINE TO PROCESS REQUEST
	CALLRET (C)		;CALL PROCESSING ROUTINE AND RETURN

; DISPATCH TABLE FOR CDR MTOPR FUNCTIONS

CDMTAB:	.MOPSI ,, CDRPSI	;ENABLE PSI CHANNEL
	.MORST ,, CDRSTA	;READ STATUS

	CDMSIZ==.-CDMTAB

; .MOPSI - ENABLE FOR PSI INTERRUPTS ON OPERATOR-ATTENTION CONDITIONS

CDRPSI:	MOVEI A,1		;GET OFFSET TO PSI CHANNEL IN ARG BLOCK
	CALL GETWRD		;GET PSI CHANNEL TO ENABLE
	 RETBAD (MTOX13)	;ARGUMENT BLOCK TOO SMALL
	CAIL B,0		;CHECK THAT GIVEN PSI CHANNEL IS A VALID
	CAILE B,5		; ASSIGNABLE CHANNEL
	JRST [	CAIL B,^D24	;CHECK THAT GIVEN PSI CHANNEL IS A VALID
		CAILE B,^D35	; ASSIGNABLE CHANNEL
		RETBAD (MTOX14)	;BAD PSI CHANNEL NUMBER GIVEN
		JRST .+1 ]	;PSI CHANNEL OK, RETURN
	STOR B,CDPSI,(U)	;SAVE PSI CHANNEL TO INTERRUPT ON
	MOVEI A,2		;GET OFFSET TO FLAG WORD
	CALL GETWRD		;GET FLAGS FROM USER
	 RETSKP			;NO FLAG WORD, RETURN
	TXNN B,MO%MSG		;USER WANT TO SUPPRESS MESSAGES ?
	RETSKP			;NO, RETURN
	SETONE CDMSG,(U)	;YES, MARK THAT "PROBLEM ON DEVICE" ISN'T WANTED
	RETSKP			;SUCCESS RETURN
; .MORST - READ STATUS (WIAT FOR CURRENT STATUS FROM DEVICE)

CDRSTA:	JN CDMWS,(U),HAVSTS	;JUMP IF MTOPR WAITING FOR STATUS ALREADY
	SETZRO CDSHA,(U)	;INITIALIZE STATUS HAS ARRIVED FLAG
	SETONE CDMWS,(U)	;REMEBER WAITING FOR STATUS
	FNCALL A,GCDRST		;GO ASK -11 FOR CDR STATUS
	MOVSI A,CDRST2(U)	;GET STATUS WORD ADDRESS
	HRRI A,STSWAT		;GET ADR OF ROUTINE TO CHECK FOR STATUS ARRIVAL
	TQO <BLKF>		;TELL MTOPR TO BLOCK
	RET			;RETURN

; HERE WHEN STATUS REQUESTED BY .MORST HAS ARRIVED

HAVSTS:	SETZRO CDMWS,(U)	;MARK THAT MTOPR NOT WAITING FOR STATUS ANY MORE
	LOAD B,CDERR,(U)	;GET HARDWARE STATUS
	LOAD A,CDSST,(U)	;GET SOFTWARE STATUS
	HRL B,A			;POSITION STATUS CORRECTLY
	JE CDRLD,(U),HAVST1	;IF NO FRONT END RELOAD, GO ON
	TXO B,MO%RLD		;MARK THAT THE FRONT END HAS BEEN RELOADED
HAVST1:	MOVEI A,1		;GET OFFSET INTO USER'S ARGUMENT BLOCK
	CALL PUTWRD		;STORE STATUS IN USER ARGUMENT BLOCK
	 RETBAD (MTOX13)	;ARGUMENT BLOCK TOO SMALL
	RETSKP			;RETURN TO USER

	RESCD

; ROUTINE TO TEST FOR STATUS ARRIVAL
; CALLED FROM SCHEDULER

STSWAT:	JE CD%SHA,(1),0(4)	;RETURN NON-SKIP IF STATUS NOT HERE YET
	JRST 1(4)		;RETURN SKIP, STATUS HAS ARRIVED

	SWAPCD
	RESCD

;ROUTINE TO REQUEST THE NEXT CARD FROM THE -11
;DOES NOT CLOBBER ANY TEMPORARY REGISTERS
;ACCEPTS:
;	U/ UNIT NUMBER

RDCARD:	SAVET			;MUST NOT CLOBBER INTERUPT LEVEL'S REGS
	SETONE CDBLK,(U)	;NOW BLOCKED
	CALL SETBF1		;SET UP INTERRUPT BUFFER FIRST
	STOR A,CDWRD,(U)	;SAVE FOR PI ROUTINE
	FNCALL A,RDCD
	 JRST [	SETZRO CDBLK,(U) ;NOT WAITING FOR A CARD IF THIS FAILS
		RET]		;DONE
	RET			;AND DONE

; ROUTINE TO TAKE STATUS

CDRTLS::JSP CX,CHKCDR		;GO VERIFY ARGS
;**;[2946]DELETE 1 LINE AT CDRTLS:+1L	TAM	11-APR-83
	STKVAR <TLSPSI>		;ALLOCATE LOCAL STORAGE
	SETZM TLSPSI		;INITIALIZE PSI-NEEDED FLAG
	ILDB A,D		;GET SUMMARY STATUS
	LSH A,8			;POSITION HIGH-ORDER BITS
	ILDB C,D		;LOW 8 BITS ONLY
	IOR A,C			;FORM COMPLETE STATUS
;**;[2946]ADD 2 LINES AT CDRTLS:+8L	TAM	11-APR-83
	TXNE A,.DVCFG		;[2946]WAS THIS A CONFIGURATION MESSAGE
	RET			;[2946]YES IGNORE IT
	STOR A,CDSST,(B)	;SAVE SOFTWARE STATUS
	LOAD C,CDOL,(B)		;GET ONLINE BIT
	SETZRO CDER,(B)		;ASSUME NO ERROR
	SETZRO CDATN,(B)	;ASSUME NO ATTENTION

; SEE IF PSI INTERRUPT NEEDED BECAUSE OF ON-LINE/OFF-LINE TRANSITION

	JE CDOL,(B),CDRS05	;JUMP IF CDR WAS OFF-LINE
	TXNN A,.DVFOL!.DVFNX	;CDR WAS ON-LINE. IS IT OFF-LINE NOW ?
	JRST CDRS10		;NO
;**;[2946] ADD 2 LINES AT CDRTLS:+19L	TAM	11-APR-83
	JE CDSHA,(B),CDRS10	;[2946] IF NO STATUS YET (FIRST TIME)
	JE CDBLK,(B),CDRS10	;[2946] OR NOT BLOCKED DON'T SET CDOFI
	SETONE CDOFI,(B)	;YES, SET THE INTERRUPT PENDING FLAG
	JRST CDRS10		;GO ON

CDRS05:	TXNE A,.DVFOL!.DVFNX	;CDR WAS OFF-LINE. IS IT ON-LINE NOW ?
	JRST CDRS10		;NO
	JE CDOFI,(B),CDRS07	;YES, WAS OFFLINE INTERRUPT PENDING?
	SETZRO CDOFI,(B)	;YES, CLEAR IT
	JRST CDRS10		;AND DONT GIVE ONLINE INTERRUPT

CDRS07:	SETOM TLSPSI		;REQUEST PSI CAUSE CDR WENT ON-LINE

;**;[2946] ADD 1 LINE AT CDRS10:+0L	TAM	11-APR-83
CDRS10:	SETONE CDSHA,(B)	;[2946] MARK THAT STATUS HAS ARRIVED
	SETONE CDOL,(B)		;ASSUME ON-LINE
	TXNN A,.DVFOL!.DVFNX	;OFF-LINE
	JRST CDTTL1		;NO
	SETZRO CDOL,(B)		;SET IT OFF-LINE
CDTTL1:	TXNE A,.DVFEF		;END OF FILE?
	JRST [	JE CDOPN,(B),.+1 ;IF NOT OPENED, IGNORE THIS
		JN CDEOF,(B),CDTTL4 ;IF ALREADY SEEN EOF, DONT WAKE JOB
		SETONE CDEOF,(B) ;REMEBER EOF
		SETZRO CDBLK,(B) ;FORCE A WAKE UP
		JRST CDTTL2]	;AND GO FINSIH UP
	SETZRO CDEOF,(B)	;MARK THAT EOF IS NOT UP
	SETZRO CDEFI,(B)	;CLEAR END OF FILE INTERRUPT GIVEN FLAG
CDTTL4:	TXNN A,.DVFHE!.DVFOL!.DVFFE ;HARDWARE ERROR OF SOME SORT?
	JRST [	JUMPN C,CDTTL2	;IF PREVIOUSLY ON-LINE, IGNORE THIS
		SETZRO CDBLK,(B) ;CLEAR WAITING BIT
		JRST CDTTL2]	;AND GO ON
	TXNE A,.DVFHE!.DVFFE	;"HARDWARE" ERROR?
	AOS CARDER(B)		;YES. COUNT IT
	TXNN A,.DVFFE		;FATAL ERROR?
	JRST CDTTL3		;NO
	SETONE CDER,(B)		;YES. SAY ERROR CONDITION
CDTTL3:	JE CDOPN,(B),CDTTL2	;IF NOT OPENED, NO MESSAGE
	SETONE CDATN,(B)	;ERROR. SAY ATTENTION NEEDED
	SKIPE C			;NEED ATTENTION?
	CALL WAKSKD		;WAKE UP SCHEDULER
CDTTL2:	ILDB A,D		;GET HIGH ORDER STATUS BITS
	LSH A,8			;POSITION HIGH ORDER BITS
	ILDB C,D		;GET HARDWARE STATUS
	IOR A,C			;FORM COMPLETE STATUS
	STOR A,CDERR,(B)	;SAVE STATUS
	SKIPE TLSPSI		;PSI REQUEST NEEDED ?
	CALL REQPSI		;YES, GO REQUEST INTERRUPT IF FORK ENABLED
	RET			;AND DONE
; ROUTINE TO REQUEST A PSI INTERRUPT IF THE FORK OWNING THE CDR HAS
; ENABLED FOR INTERRUPTS
;
; CALL:	B/ UNIT NUMBER
;		CALL REQPSI
; RETURNS: +1 ALWAYS, TEMPORARY AC'S PRESERVED

REQPSI:	SAVET			;SAVE TEMPORARY AC'S
	JE CDOPN,(B),R		;RETURN IF CDR IS NOT OPEN
	LOAD A,CDPSI,(B)	;GET PI CHANNEL
	CAIN A,INIPSI		;PROCESS WANT ONE?
	RET			;NO
	SETONE CDPIR,(B)	;YES. SAY SO
;**;[1920] Change one line at REQPSI: +6L	JGZ	9-AUG-81
;	CALLRET WAKSKD		;[1920] AND GO WAKE SCHEDULER (FALL THROUGH)

;ROUTINE TO ARRANGE SCHEDULER ROUTINE TO POLL CDRS
;B/	UNIT NO TO POLL

WAKSKD:	SETZM CDRTIM		;MAKE XCLKS NOTICE US
	MOVE A,TODCLK		;GET NOW
	MOVEM A,CDRCKT(B)	;IS THE TIME TO DO THE MESSAGE
	RET			;AND DONE

;SCHEDULER WAIT

CDRBLK::JN CDOFI,(A),1(4)	;IF OFF-LINE, WAKE UP NOW
	JN CDBLK,(A),0(4)	;IF WAITING FOR A CARD DON'T UNBLOCK
	JRST 1(4)

;ROUTINE TO VERIFY THAT THE FE IS TALKING ABOUT AN EXTANT
;CARD READER. CALLED BY:
;	JSP CX,CHKCDR
;WITH:
;	B/ UNIT NUMBER

CHKCDR:	CAIL B,CDRN		;AN EXTANT READER?
	RET			;NO. GIVE IT UP THEN
	JRST 0(CX)		;YES. GO DO REQUEST
;SCHEDULER TEST ROUTINE

CDRCHK::SAVEPQ		;SAVE REGISTERS
	MOVSI U,-CDRN		;LOOK AT ALL OF THEM
	MOVSI A,(1B1)		;MAX TIME TO WAIT
	MOVEM A,CDRTIM		;SET IT
CDRCK:	MOVE A,CDRCKT(U)	;GET TIME FOR THIS ONE
	CAMLE A,TODCLK		;TIME TO DO IT?
	JRST [	SUB A,TODCLK	;NO
		CAMGE A,CDRTIM	;IS THIS ONE NEXT?
		MOVEM A,CDRTIM	;YES. SAY SO
		JRST CDRCK1]	;AND GO ON
	JN CDPIR,(U),[	LOAD B,CDFRK,(U) ;GET OWNING FORK
			LOAD A,CDPSI,(U) ;GET CHANNEL
			SETZRO CDPIR,(U) ;DONT NEED THIS NEXT TIME
			CALL PSIRQ	;REQUEST INTERRUPT
			JRST .+1]	;AND CONTINUE
	JE CDATN,(U),CDRCK2	;DOESN'T WANT ATTENTION
	JN CDMSG,(U),CDRCK2	;SUPPRESSING MESSAGE?
	MOVE A,[ASCII /PCDR/]	;GENERIC NAME
	MOVEI B,"0"(U)		;ASCII FOR UNIT
	DPB B,[POINT 7,A,34]	;FORM DEVICE NAME
	PUSH P,A		;NAME
	PUSH P,[0]		;A TERMINATOR
	HRROI A,-1(P)
	CALL DEVMSG		;GO BITCH TO THE OPERATOR
	SUB P,BHC+2		;CLEAR THE STACK
CDRCK2:	JE CDEXST,(U),R		;RETURN IF NOT SETUP YET
	FNCALL A,GCDRST		;GET STATUS
	MOVEI A,^D60000		;ONE MINUTE FROM NOW
	ADD A,TODCLK		;MUST LOOK AGAIN
	MOVEM A,CDRCKT(U)	;STORE THIS
CDRCK1:	AOBJN U,CDRCK		;LOOP FOR ALL CDR'S
	RET			;GO BACK TO SCHEDULER
	SWAPCD			;THIS IS SWAPPABLE
;MACROS AND DEFINITIONS FOR ASCII CARD TRANSLATIONS
DEFINE INIT (ENTRY)<
TAB'ENTRY==BYTE (7) .CRILC,.CRILC,.CRILC,.CRILC,.CRILC
   >

DEFINE CODE (CHAR,VALUE)<

OFFSET==<VALUE>/5		;;GET WORD OFFSET
BIT==<<VALUE>-<VALUE>/5*5>*7+7-1 ;;GET RIGHTMOST BIT OF CHARACTER
	INSERT \OFFSET,BIT,CHAR	 ;;CREATE A TABLE ENTRY
   >
DEFINE INSERT (OFFS,POS,CHAR)<
TEMP==<TAB'OFFS&<177>B<POS>>_<POS-43>
IFN TEMP-.CRILC,< PRINTT (CHAR,\TEMP) >
TAB'OFFS==TAB'OFFS!<177>B<POS>	 ;;MAKE OLD ENTRY ALL 1'S
TAB'OFFS==TAB'OFFS^!<177>B<POS>	 ;;CLEAR OLD ENTRY
TAB'OFFS==TAB'OFFS!<CHAR>B<POS> ;;MAKE TABLE ENTRY
   >
DEFINE MAKE (ENTRY) <
	TAB'ENTRY		;;MAKE TRANSLASTION TABLE ENTRY
	PURGE TAB'ENTRY		;;GET RID OF SYMBOL
   >
DEFINE PRINTT (CHAR,TEMP) <
PRINTX DUPLICATE FOR CHAR IS TEMP
   >

.B12==1B28			;ZONE PUNCH 12
.B11==1B29			;ZONE PUNCH 11
.B0==1B30			;ZONE PUNCH 0
.B8==1B31			;ZONE PUNCH 8
.B9==1B32			;ZONE PUNCH 9
.Z1==1				;ZONE 1
.Z2==2				;ZONE 2
.Z3==3				;ZONE 3
.Z4==4				;ZONE 4
.Z5==5				;ZONE 5
.Z6==6				;ZONE 6
.Z7==7				;ZONE 7
;STRUCTURE TO DEFINE ALL OF THE PUNCHES


;FIRST INIT TABLE

QQ==0
REPEAT ^D52,<
	INIT (\QQ)
	QQ==QQ+1>		;DO ALL OF THEM

;NOW DEFINE THE INIDVIDUAL CHARACTERS
	CODE (0,.B12+.B0+.B9+.B8+.Z1)
	CODE (1,.B12+.B9+.Z1)
	CODE (2,.B12+.B9+.Z2)
	CODE (3,.B12+.B9+.Z3)
	CODE (4,.B9+.Z7)
	CODE (5,.B0+.B9+.B8+.Z5)
	CODE (6,.B0+.B9+.B8+.Z6)
	CODE (7,.B0+.B9+.B8+.Z7)
	CODE (10,.B11+.B9+.Z6)
	CODE (11,.B12+.B9+.Z5)
	CODE (12,.B0+.B9+.Z5)
	CODE (13,.B12+.B9+.B8+.Z3)
	CODE (14,.B12+.B9+.B8+.Z4)
	CODE (15,.B12+.B9+.B8+.Z5)
	CODE (16,.B12+.B9+.B8+.Z6)
	CODE (17,.B12+.B9+.B8+.Z7)
	CODE (20,.B12+.B11+.B9+.B8+.Z1)
	CODE (21,.B11+.B9+.Z1)
	CODE (22,.B11+.B9+.Z2)
	CODE (23,.B11+.B9+.Z3)
	CODE (24,.B9+.B8+.Z4)
	CODE (25,.B9+.B8+.Z5)
	CODE (26,.B9+.Z2)
	CODE (27,.B0+.B9+.Z6)
	CODE (30,.B11+.B9+.B8)
	CODE (31,.B11+.B9+.B8+.Z1)
	CODE (32,.B9+.B8+.Z7)
	CODE (33,.B0+.B9+.Z7)
	CODE (34,.B11+.B9+.B8+.Z4)
	CODE (35,.B11+.B9+.B8+.Z5)
	CODE (36,.B11+.B9+.B8+.Z6)
	CODE (37,.B11+.B9+.B8+.Z7)
	CODE (40,0)
	CODE ("!",.B12+.B8+.Z7)
	CODE (42,.B8+.Z7)
	CODE ("#",.B8+.Z3)
	CODE ("$",.B11+.B8+.Z3)
	CODE ("%",.B0+.B8+.Z4)
	CODE ("&",.B12)
	CODE ("'",.B8+.Z5)
	CODE (50,.B12+.B8+.Z5)
	CODE (51,.B11+.B8+.Z5)
	CODE ("*",.B11+.B8+.Z4)
	CODE ("+",.B12+.B8+.Z6)
	CODE (54,.B0+.B8+.Z3)
	CODE ("-",.B11)
	CODE (".",.B12+.B8+.Z3)
	CODE ("/",.B0+.Z1)
	CODE ("0",.B0)
	CODE ("1",.Z1)
	CODE ("2",.Z2)
	CODE ("3",.Z3)
	CODE ("4",.Z4)
	CODE ("5",.Z5)
	CODE ("6",.Z6)
	CODE ("7",.Z7)
	CODE ("8",.B8)
	CODE ("9",.B9)
	CODE (":",.B8+.Z2)
	CODE (73,.B11+.B8+.Z6)
	CODE (74,.B12+.B8+.Z4)
	CODE ("=",.B8+.Z6)
	CODE (76,.B0+.B8+.Z6)
	CODE ("?",.B0+.B8+.Z7)
	CODE ("@",.B8+.Z4)
	CODE ("A",.B12+.Z1)
	CODE ("B",.B12+.Z2)
	CODE ("C",.B12+.Z3)
	CODE ("D",.B12+.Z4)
	CODE ("E",.B12+.Z5)
	CODE ("F",.B12+.Z6)
	CODE ("G",.B12+.Z7)
	CODE ("H",.B12+.B8)
	CODE ("I",.B12+.B9)
	CODE ("J",.B11+.Z1)
	CODE ("K",.B11+.Z2)
	CODE ("L",.B11+.Z3)
	CODE ("M",.B11+.Z4)
	CODE ("N",.B11+.Z5)
	CODE ("O",.B11+.Z6)
	CODE ("P",.B11+.Z7)
	CODE ("Q",.B11+.B8)
	CODE ("R",.B11+.B9)
	CODE ("S",.B0+.Z2)
	CODE ("T",.B0+.Z3)
	CODE ("U",.B0+.Z4)
	CODE ("V",.B0+.Z5)
	CODE ("W",.B0+.Z6)
	CODE ("X",.B0+.Z7)
	CODE ("Y",.B0+.B8)
	CODE ("Z",.B0+.B9)
	CODE (133,.B12+.B8+.Z2)
	CODE ("\",.B0+.B8+.Z2)
	CODE (135,.B11+.B8+.Z2)
	CODE ("^",.B11+.B8+.Z7)
	CODE ("_",.B0+.B8+.Z5)
	CODE (140,.B8+.Z1)
	CODE ("A"+40,.B12+.B0+.Z1)
	CODE ("B"+40,.B12+.B0+.Z2)
	CODE ("C"+40,.B12+.B0+.Z3)
	CODE ("D"+40,.B12+.B0+.Z4)
	CODE ("E"+40,.B12+.B0+.Z5)
	CODE ("F"+40,.B12+.B0+.Z6)
	CODE ("G"+40,.B12+.B0+.Z7)
	CODE ("H"+40,.B12+.B0+.B8)
	CODE ("I"+40,.B12+.B0+.B9)
	CODE ("J"+40,.B12+.B11+.Z1)
	CODE ("K"+40,.B12+.B11+.Z2)
	CODE ("L"+40,.B12+.B11+.Z3)
	CODE ("M"+40,.B12+.B11+.Z4)
	CODE ("N"+40,.B12+.B11+.Z5)
	CODE ("O"+40,.B12+.B11+.Z6)
	CODE ("P"+40,.B12+.B11+.Z7)
	CODE ("Q"+40,.B12+.B11+.B8)
	CODE ("R"+40,.B12+.B11+.B9)
	CODE ("S"+40,.B11+.B0+.Z2)
	CODE ("T"+40,.B11+.B0+.Z3)
	CODE ("U"+40,.B11+.B0+.Z4)
	CODE ("V"+40,.B11+.B0+.Z5)
	CODE ("W"+40,.B11+.B0+.Z6)
	CODE ("X"+40,.B11+.B0+.Z7)
	CODE ("Y"+40,.B11+.B0+.B8)
	CODE ("Z"+40,.B11+.B0+.B9)
	CODE (173,.B12+.B0)
	CODE (174,.B12+.B11)
	CODE (175,.B11+.B0)
	CODE (176,.B11+.B0+.Z1)
	CODE (177,.B12+.B9+.Z7)
;NOW CREATE THE TRANSLATION TABLE

QQ==0
ASCTBL:	REPEAT ^D52,<
	MAKE (\QQ)		;MAKE ONE
	QQ==QQ+1>		;DO ALL
CDVTFE==.
CDVTKS==.
	CDBHLT			;ILLEGAL VECTOR
	CDBHLT
	IFIW!R
	IFIW!R
	CDBHLT
	CDBHLT

CDBHLT:	BUG(CDILVT)