.TITLE	.IOERR
/
/   1 AUG 78 (006; PDH) MUST USE SIGNED SHIFT
/   1 AUG 78 (005; PDH) REVAMP TO USE '.PCK' AND TO ANNOUNCE 6-DIGIT
/			VALUE WHEN EV .GT. 777
/  25 OCT 77 (004; PDH) CHANGE FROM 'MCR=3' TO 'TTY=4' FOR MULTIACCESS
/  14 JUL 77 (003; PDH) ANNOUNCE CALLING ADDRESS ALSO
/  21 APR 77 - PAUL HENDERSON
/
/  THIS ROUTINE, CALLABLE ONLY FROM ASSEMBLY LANGUAGE PROGRAMS, IS
/  USED TO OUTPUT THE NAME OF THE  TASK  AND THE OCTAL VALUE OF AN
/  I/O ERROR, AND THE ADDRESS FROM WHICH IT IS CALLED.   THIS IS A
/  FATAL ERROR ANNOUNCEMENT,  AS THE ROUTINE EXITS AFTER THE ERROR
/  ANNOUNCEMENT.
/
/  CALLING SEQUENCE:
/
/	LAC	EV
/	JMS*	.IOERR		/ NECESSARY TO ESTABLISH CALLING ADDRESS
/
ECLA=641000		/ EAE CLEAR AC INSTRUCTION
	.DEC
TTY=4			/ LUN ON WHICH ERROR MESSAGE IS ISSUED
	.OCT
/
	.GLOBL	.IOERR
	.GLOBL	PCK.IN,.PCK					/(005)
/
.IOERR	NOP
	DAC	VALUE		/ SAVE BAD EVENT VARIABLE	/(005)
	CAL	TSKNAM		/ GET NAME OF CALLING TASK	/(005)
	LAW	-6						/(005)
	DAC	COUNT		/ ASSUME NON-STANDARD VALUE	/(005)
	LAC	(ERRB						/(005)
	JMS*	PCK.IN		/ SET UP PACKING ROUTINE	/(005)
	LAC	VALUE		/ RETRIEVE EVENT VARIABLE	/(005)
	SMA!TCA			/ PROBABLY NEGATIVE ON ENTRY,
	TCA			/ BUT MAY NOT BE.  MAKE POSITIVE.
	CLQ!LRSS 11		/ SHIFT BAD EV TO UPPER HALF OF CLEARED MQ /(006)
	SZA							/(005)
	JMP	STRANGE		/ EV .GT. 777 - STRANGE THINGS	/(005)
	LAW	-3		/ NORMALLY, BAD EV'S ARE 3 DIGITS /(005)
	DAC	COUNT						/(005)
	LACQ			/ GET 3-DIGIT VALUE FROM MQ	/(005)
	DAC	VALUE		/ AND PLACE IT IN CORRECT PLACE	/(005)
 
	.EJECT
STRANGE	JMS	OCT2AS		/ CONVERT OCTAL 'VALUE' TO ASCII /(005)
	LAW	40
	JMS*	.PCK		/ FOLLOW EV WITH SPACE		/(005)
 
	LAC	.IOERR		/ GET CALLING ADDRESS
	SAD	(NOP		/ IF ENTERED BY 'JMS',
	JMP	ENDADR		/ CALLING ADDRESS IS UNAVAILABLE /(005)
	ALS	3						/(005)
	DAC	VALUE		/ SAVE 15-BIT ADDRESS		/(005)
	LAW	-5						/(005)
	DAC	COUNT		/ 5 DIGITS			/(005)
	JMS	OCT2AS		/ PACK THEM UP			/(005)
ENDADR	LAW	15		/ FINISH WITH CARRIAGE RETURN	/(005)
	JMS*	.PCK						/(005)
 
	.EJECT
/  WE HAVE NOW PACKED UP THE EVENT VARIABLE AND CALLING ADDRESS.  GET
/  THE TASK NAME AND PREPARE IT FOR OUTPUT.
 
	LAC	(TASKNM						/(005)
	JMS*	PCK.IN		/ SET UP PACKING ROUTINE AGAIN	/(005)
	LAC	TSKNAM+2					/(005)
	LMQ			/ PUT 1ST CHARACTER IN MQ	/(005)
	JMS	SIXTO7		/ CONVERT TO 7-BITS AND STORE	/(005)
	LAC	TSKNAM+2					/(005)
	LRS	14		/ 2ND CHARACTER			/(005)
	JMS	SIXTO7						/(005)
	LAC	TSKNAM+2					/(005)
	LRS	6		/ 3RD CHARACTER			/(005)
	JMS	SIXTO7						/(005)
	LAC	TSKNAM+3					/(005)
	LMQ			/ 4TH CHARACTER			/(005)
	JMS	SIXTO7						/(005)
	LAC	TSKNAM+3					/(005)
	LRS	14		/ 5TH CHARACTER			/(005)
	JMS	SIXTO7						/(005)
	LAC	TSKNAM+3					/(005)
	LRS	6		/ 6TH CHARACTER			/(005)
	JMS	SIXTO7						/(005)
 
/  MESSAGE BUFFER HAS BEEN PREPARED.  ANNOUNCE IT ON TTY.
 
ENDNAME	CAL	WRERR		/ ANNOUNCE ERROR		/(005)
	CAL	WAITFR		/ WAIT FOR IT
	CAL	(10		/ THEN EXIT
 
	.EJECT
/  SUBROUTINE TO CONVERT 'COUNT' DIGITS FROM 'VALUE' TO ASCII AND
/  PACK THEM, USING ROUTINE '.PCK'.
/    BEFORE CALLING, THE NUMBER OF DIGITS MUST BE SPECIFIED (2'S COMP)
/  IN 'COUNT', AND THE '.PCK' ROUTINE MUST HAVE BEEN SET UP.
 
OCT2AS	XX							/(005)
OCT2.1	LAC	VALUE						/(005)
	LMQ			/ PUT NEW VALUE IN MQ		/(005)
	ECLA!LLS 3		/ SHIFT IN NEXT OCTAL DIGIT	/(005)
	DAC	EV		/ SAVE TEMPORARILY		/(005)
	LACQ							/(005)
	DAC	VALUE		/ SAVE NEW VALUE		/(005)
	LAC	EV		/ RETRIEVE DIGIT		/(005)
	XOR	(60						/(005)
	JMS*	.PCK		/ PACK ASCII CHARACTER		/(005)
	ISZ	COUNT						/(005)
	JMP	OCT2.1		/ PACK ANOTHER IF NOT DONE	/(005)
	JMP*	OCT2AS						/(005)
 
 
/  SUBROUTINE TO EXTRACT A 6-BIT CHARACTER FROM THE MQ AND CONVERT IT
/  TO A 7-BIT IMAGE ASCII CHARACTER IN THE AC.
 
SIXTO7	XX
	ECLA!LLS 1		/ SHIFT IN HIGH-ORDER BIT OF CHARACTER
	SNA
	XOR	(2		/ CONVERT FROM 6- TO 7-BIT, AS APPROPRIATE
	LLS	5		/ SHIFT IN REST OF CHARACTER
	SAD	(100		/ '@' MEANS END OF TASK NAME
	JMP	ENDNAME
	JMS*	.PCK		/ PACK THE CHARACTER		/(005)
	JMP*	SIXTO7
 
	.EJECT
ERRL	EL-.*400+2;EV
	.ASCII	'***'
TASKNM	0; 0
	.ASCII	<0><0><0>': I/O ERROR '
ERRB	.BLOCK	6;EL=.;VALUE					/(006)
TSKNAM	25;COUNT 0;	.BLOCK 2
WRERR	2700;	EV;	TTY; 2; ERRL
WAITFR	20;	EV
	.END