Google
 

Trailing-Edge - PDP-10 Archives - decuslib10-01 - 43,50034/macio.m13
There are no other files named macio.m13 in the archive.
;
	TITLE 	IO SERVICE FOR FORTRAN CALLING PROGRAMS
	SUBTTL	GCI-GENERAL CHANNEL INITIALIZATION
	ENTRY	GCI
	EXTERNAL	JOBFF
Q=16
GSACS=6
NOCH=4				;HIGHEST LEGAL CHANNEL NUMBER.
;GENERAL CHANNEL INITIALIZER
;CALL     GCI(N1,N2,N3,N4,N5,N6)
;INPUT  - N1 = DEVICE NAME IN ASCII
;	  N2 = CHANNEL NUMBER
;	  N3 = 0 - INPUT ONLY
;	       1 - OUTPUT ONLY
;	       2 - BOTH
;	  N4 = NOT USED
;	  N5 = 0 - ASCII MODE
;	       1 - IMAGE BINARY MODE
;OUTPUT - N6 = 0 - NO ERROR
;	       1 - N2 OUT OF RANGE
;	       2 - ILLEGAL DEVICE
;	       3 - N3 OUT OF RANGE



GCI:	0
	MOVE	1,JOBFF		;SAVE JOBFF
	MOVEM	1,SJOBFF	;FOR MONITOR
	MOVE	1,@(Q)		;N1-DEV NAME
	MOVEM	1,N1
	SETZM	N6		;SET ERROR RET.
	MOVE	1,@1(Q)		;N2-CHAN NO.
	JUMPL	1,GCI11		;TEST IF LEGAL
	CAILE	1,NOCH
	JRST	GCI11
	MOVEM	1,N2
GCI1:	SETZM	M1		;CLEAR DEV NAME
	SETZM	M2		;AND BUF HEAD NAME.
	MOVE	2,PBF(1)	;GET ADR OF BUF RING
	MOVEM	2,JOBFF		;SET JOBFF
	MOVE	1,[JUMP]
	MOVEM	1,M5		;NOP THE INBUF AND
	MOVEM	1,M6		;OUTBUF OPS
	MOVE	1,[POINT 7,N1]
	MOVE	2,[POINT 6,M1]
GCI3:	ILDB	3,1		;CONVERT DEV NAME
	JUMPE	3,GCI2
	SUBI	3,40		;TO SIXBIT
	JUMPE	3,GCI2
	IDPB	3,2		;STOP ON BLANK OR NULL.
	JRST	GCI3
GCI2:	MOVE	1,@2(Q)		;N3-IN OR OUT SIDES
	JUMPL	1,GCI12
	CAILE	1,2
	JRST	GCI12
	MOVE	2,N2		;GET CHAN#
	HRLZ	4,N2
	LSH	4,5
GCI4:	JUMPG	1,GCI5		;JUMP IF NOT INPUT ONLY.
	HRR	3,PIO(2)	;GET BUF HEAD ADR
	HRRM	3,M2		;SET FOR INIT OP
	MOVE	3,4
	ADD	3,[INBUF 0,2]	;FORM INBUF OP
	MOVEM	3,M5
	JRST	GCI6		;GO FORM INIT
GCI5:	CAIE	1,1		;TEST N3
	JRST	GCI7		;GO IF BOTH IN AND OUT.
	HLL	3,PIO(2)	;OUT ONLY, GET BUF HEAD
	HLLM	3,M2		;SET FOR INIT OP.
GCI13:	MOVE	3,4
	ADD	3,[OUTBUF 0,2]	;FORM OUTBUF
	MOVEM	3,M6
	JRST	GCI6		;GO FORM INIT.
GCI7:	SKIPE	2		;COME HERE IF BOTH IN AND OUT.
	JRST	GCI12
	MOVE	3,PIO(2)
	MOVEM	3,M2		;GET BOTH BUF HEADS
	MOVE	3,4
	ADD	3,[INBUF 0,2]	;FORM INBUF
	MOVEM	3,M5
	JRST	GCI13		;GO FORM OUTBUF
GCI6:	MOVE	3,4		;FORM INIT
	ADD	3,[INIT 0,1]
	SKIPE	@4(Q)		;TEST N5 FOR DATA MODE.
	ADDI	3,7		;SET TO IMAGE IF NOT ASCII
	MOVEM	3,M0
M0:	0			;INIT
M1:	0			;DEV NAME
M2:	0			;BUF HEAD ADR.
	JRST	GCI10		;ERROR ON INIT.
M5:	JUMP			;INBUF OPERATOR
M6:	JUMP			;OUTBUF OPERATOR
GCI14:	MOVE	1,N6
GCI15:	MOVEM	1,@5(Q)		;SET N6 IN USER AREA.
	MOVE	1,SJOBFF	;RESTORE JOBFF
	MOVEM	1,JOBFF
	JRA	Q,6(Q)		;RETURN
GCI10:	MOVEI	1,2		;N6=2. BAD DEVICE
	JRST	GCI15
GCI11:	MOVEI	1,33		;N6=1. ILLEGAL CHAN#
	JRST	GCI15
GCI12:	MOVEI	1,3		;N6=3 N3 BAD.
	JRST	GCI15
STAT:	0	;STATUS
GSAC:	BLOCK	7		;AC STORAGE
N1:	0			;TEMP
N2:	0
N3:	0
N4:	0
N5:	0
N6:	0
PIO:	XWD	OB0,IB0		;POINTERS TO BUFF HEADS
	XWD	OB1,OB1
	XWD	OB2,OB2
	XWD	OB3,OB3
	XWD	OB4,OB4
OB0:	BLOCK	3		;OUT BUF HEADS FOR
OB1:	BLOCK	3		; EACH CHANNEL.
OB2:	BLOCK	3
OB3:	BLOCK	3
OB4:	BLOCK	3
IB0:	BLOCK	3		;BUF HEAD FOR CHANNEL 0.
				;IN BUF HEADS FOR
IB1=OB1				;EACH CHANNEL. SAME AS
IB2=OB2				;OUTPUT SINCE ONLY ONE SIDE OF
IB3=OB3				;CALL CHANNEL CAN BE OPEN.
BF0:	BLOCK	25*4+1		;IO BUFFERS FOR EACH
BF1:	BLOCK	204*2		; CHANNEL.
BF2:	BLOCK	204*2
BF3:	BLOCK	204*2
BF4:	BLOCK	204*2
PBF:	EXP	BF0		;POINTERS TO BUFFERS FOR
	EXP	BF1		; SETTING JOBFF.
	EXP	BF2
	EXP	BF3
	EXP	BF4
SJOBFF:	0			;STORE FOR JOBFF
	SUBTTL	OFIN
	ENTRY	OFIN
;OPEN FILE FOR INPUT
;CALL     OFIN(N1,N2,N3)
;INPUT  - N1 = CHANNEL NUMBER
;	  N2 = FILE NAME UP TO 4 ASCII CHARACTERS
;OUTPUT - N3 = 0 - NO ERROR
;	       1 - N1 OUT OF RANGE
;	       2 - NO DEVICE ON CHANNEL
;	       3 - FILE READ PROTECTED
;	       4 - NO SUCH FILE
;	       5 - GENERAL ERROR

OFIN:	0
	MOVE	4,@(Q)		;N1 - CHAN#
	MOVEM	4,N1
	MOVE	5,@1(Q)		;N2 - FILENAME
	MOVEM	5,N2
	SETZM	N3		;INIT ERROR RET.
	JUMPL	4,OFI6		;TEST FOR OK CHAN#
	CAILE	4,NOCH
	JRST	OFI6
OFI1:	MOVE	3,PLU(4)	;GET ADR OF LOOKUP OPERANDS
	SETZM	(3)		;CLEAR FIRST TWO OPS
	SETZM	1(3)		; OF LOOKUP
	MOVE	1,[POINT 6,0(3)]
	MOVE	6,[POINT 7,N2]
OFI2:	ILDB	2,6		;CONVRT FILENAME
	JUMPE	2,OFI3
	SUBI	2,40		; TO SIXBIT
	JUMPE	2,OFI3
	IDPB	2,1
	JRST	OFI2
OFI3:	LSH	4,5
	MOVSS	4		;GET CHAN #
	ADD	4,[LOOKUP 0,0]	;FORM LOOKUP
	ADD	4,3
	MOVEM	4,OFI4
OFI4:	0			;EXECUTE LOOKUP
	JRST	OFI5		;ERROR
	MOVE	1,N3
OFI7:	MOVEM	1,@2(Q)		;SET N3
OFI9:	JRA	Q,3(Q)		;RETURN
OFI5:	LDB	2,[POINT 3,1(3),35]	;GET ERROR INDICATOR
	SETZ	1,		;FROM LOOKUP AND SET
	CAIN	2,7		;N3 ACCORDINGLY
	MOVEI	1,2		;N3=2. NO DEV ON CHAN
	CAIN	2,1
	MOVEI	1,4		;N3=4. NO SUCH FILE.
	CAIN	2,0
	MOVEI	1,4
	CAIN	2,2
	MOVEI	1,3		;N3=3. FILE READ PROTECTED
OFI8:	CAIN	1,0
	MOVEI	1,5		;SOFTWARE ERROR. AC1 MUST BE
	JRST	OFI7		; SET BY THIS TIME.
OFI6:	MOVEI	1,1		;N3=1. BAD CHAN#
	JRST	OFI7
;DATA
PLU:	EXP	LU0,LU1,LU2,LU3,LU4	;ADRS OF LOOKUP OPERANDS.
LU0:	EXP	0,0,0,0
LU1:	EXP	0,0,0,0
LU2:	EXP	0,0,0,0
LU3:	EXP	0,0,0,0
LU4:	EXP	0,0,0,0
	SUBTTL	OFOUT
	ENTRY	OFOUT
;OPEN FILE FOR OUTPUT
;CALL     OFOUT(N1,N2,N3)
;INPUT  - N1 = CHANNEL NUMBER
;	  N2 = FILE NAME
;OUTPUT - N3 = 0 - NO ERROR
;	       1 - N1 OUT OF RANGE
;	       2 - NO DEVICE ON CHANNEL
;	       3 - FILE WRITE PROTECTED
;	       4 - BAD FILE NAME
;	       5 - GENERAL ERROR
;	       6 - FILE IS ACTIVE.

OFOUT:	0
	MOVE	4,@(Q)		;N1 - CHAN#
	MOVEM	4,N1
	MOVE	5,@1(Q)		;N2 - FILENAME
	MOVEM	5,N2
	SETZM	N3		;INIT ERROR RET
	JUMPL	4,OFI6		;TEST FOR OK CHAN #
	CAILE	4,NOCH
	JRST	OFI6
OFO1:	MOVE	3,PEN(4)	;GET ADR OF ENTER OPS.
	SETZM	(3)
	SETZM	1(3)
	MOVE	1,[POINT 6,0(3)]
	MOVE	6,[POINT 7,N2]
OFO2:	ILDB	2,6		;CONVRT FILENAME TO SIXBIT.
	JUMPE	2,OFO3
	SUBI	2,40
	JUMPE	2,OFO3
	IDPB	2,1
	JRST	OFO2
OFO3:	LSH	4,5
	MOVSS	4		;CHAN #
	ADD	4,[ENTER 0,0]	;FORM ENTER
	ADD	4,3
	MOVEM	4,OFO4
OFO4:	0			;EXECUTE ENTER
	JRST	OFO5		;ERROR
	MOVE	1,N3		;GO EXIT
	JRST	OFI7
OFO5:	LDB	2,[POINT 3,1(3),35]	;GET ERROR RET FROM ENTER
	SETZ	1,		;AND SET N3
	CAIN	2,7
	MOVEI	1,2
	CAIN	2,1
	MOVEI	1,4
	CAIN	2,3
	MOVEI	1,6
	CAIN	2,2
	MOVEI	1,3
	CAIN	2,0
	MOVEI	1,4
	JRST	OFI8
;DATA
PEN:	EXP	EN0,EN1,EN2,EN3,EN4	;ADRS OF ENTER OPS.
EN0:	EXP	0,0,0,0
EN1:	EXP	0,0,0,0
EN2:	EXP	0,0,0,0
EN3:	EXP	0,0,0,0
EN4:	EXP	0,0,0,0
	SUBTTL	CLO
	ENTRY	CLO
;CLOSE A CHANNEL
;CALL     CLO(N1,N2,N3)
;INPUT  - N1 = CHANNEL NUMBER
;	  N2 = 0 - INPUT SIDE
;	       1 - OUTPUT SIDE
;	       2 - BOTH SIDES
;OUTPUT - N3 = 0 - NO ERROR
;	       1 - N1 OUT OF RANGE
;	       2 - DATA ERROR
;	       3 - N2 OUT OF RANGE
CLO:	0
	SETZ	4,		;INIT ERROR RET.
	MOVE	1,@(Q)		;N1-CHAN#
	JUMPL	1,OFI6		; TEST IF OK.
	CAILE	1,NOCH
	JRST	OFI6
CLO1:	SETO	3,
	MOVE	2,@1(Q)		;N2 - WHICH SIDE TO CLOSE
	CAIN	2,0
	MOVEI	3,1		;INPUT ONLY
	CAIN	2,1
	MOVEI	3,2		;OUTPUT ONLY
	CAIN	2,2
	SETZ	3,		;BOTH
	JUMPL	3,CLO2		;ERROR IF AC3 STILL NEG.
CLO3:	LSH	1,5
	MOVSS	1
	MOVEM	1,N1
	ADD	1,[CLOSE 0,0]	;FORM CLOSE
	ADD	1,3
	XCT	1		;EXECUTE IT.
CLO4:	MOVE	1,N1
	ADD	1,[STATZ 0,740000]	;FORM STATZ
	XCT	1		;TEST FOR ERRORS
	MOVEI	4,2		;N3=2. DATA ERROR.
	MOVE	1,N1
	ADD	1,[GETSTS 0,6]
	XCT	1
	MOVEM	6,STAT
CLO5:	MOVEM	4,@2(Q)		;SET N3
	JRST	OFI9		;EXIT
CLO2:	MOVEI	4,3		;N3=3. N2 BAD.
	JRST	CLO5
	SUBTTL	FIN
	ENTRY	FIN
;FINISH A CHANNEL
;CALL     FIN(N1,N2)
;INPUT  - N1 = CHANNEL NUMBER
;OUTPUT - N2 = 0 - NO ERROR
;	       1 - N1 OUT OF RANGE
;	       2 - DATA ERROR
FIN:	0
	MOVEM	1,N6		;SAVE AC1
	MOVE	1,@(Q)		;N1 - CHAN#
	MOVEM	1,N4
	JSA	Q,CLO		;CLOSE
	EXP	N4		;CHAN N1
	EXP	[2]		; BOTH SIDES
	EXP	N5		; RET ERROR IN N5.
	SKIPE	N5
	JRST	FIN1		;EXIT IF ERROR IN CLOSE.
	MOVE	1,@(Q)		;GET CHAN#
	XCT	REL(1)		;EXECUTE A RELEASE
FIN1:	MOVE	1,N5
	MOVEM	1,@1(Q)		;SET ERROR RET
	MOVE	1,N6		;RESTORE AC1
	JRA	Q,2(Q)		;EXIT
;DATA
REL:	RELEAS	0,
	RELEAS	1,
	RELEAS	2,
	RELEAS	3,
	RELEAS	4,
	SUBTTL	CRC
	ENTRY	CRC
;CONSOLE-READ A CHARACTER
;CALL     CRC(N1)
;OUTPUT - N1 HOLDS A CHARACTER, RIGHT ADJUSTED
CRC:	0
	SOSG	IB0+2		;DEC BYTE CT
	INPUT	0,		;INPUT IF NO DATA.
	ILDB	0,IB0+1		;GET DATA
	MOVEM	0,@(Q)		;STORE
	JRA	Q,@1(Q)		;EXIT
	SUBTTL	CWC
	ENTRY	CWC
;CONSOLE-WRITE A CHARACTER
;CALL     CWC(N1,N2)
;INPUT  - N1 = CHARACTER, RIGHT ADJUSTED
;	  N2 - NOT USED.

CWC:	0
	SOSG	OB0+2		;DEC BYTE CT.
	OUTPUT	0,		;OUTPUT IF NO ROOM
	MOVEI	1,1
	MOVEM	1,@1(Q)		;SET RET - OUTPUT DONE.
CWC1:	MOVE	1,@(Q)		;FETCH USER DATA
	IDPB	1,OB0+1		;STORE IN BUFF.
	OUTPUT	0,
	JRA	Q,2(Q)
;GENERAL OUTPUT ROUTINE.
;CALLED BY PRT,WDA,PUN.
OUTDO:	SETZM	@1(Q)		;SET NO OUTPUT
	XCT	OSOS(5)		;DEC BYTE CT.
	JRST	PRT1		;ROOM AVIL.
	XCT	OUT(5)		;NO ROOM, OUTPUT

	MOVEI	1,1
	MOVEM	1,@1(Q)		;SET OUTPUT DONE
	XCT	GET(4)
	MOVEM	6,STAT
	XCT	STATA(4)	;TEST FOR ERRORS.
	JRST	PRT2		;ERROR.
PRT1:	MOVE	1,@(Q)		;GET DATA
	XCT	IDP(5)		;PUT IN BUFF.
	JRST	GSR4	;EXIT
PRT2:	MOVEI	1,2
	MOVEM	1,@1(Q)		;INDICATE DATA ERROR.
	JRST	PRT1
;GENERAL INPUT ROUTINE.
;CALLED BY GSR,GDA
INDO:	SETZM	@1(Q)		;NO INPUT DONE.
	XCT	ISOS(5)		;ANY DATA?
	JRST	GSR1		;YES.
	XCT	IN(5)		;NO, INPUT
	MOVEI	1,1
	MOVEM	1,@1(Q)		;SET INPUT DONE
	XCT	GET(4)
	MOVEM	6,STAT
	XCT	STATA(4)
	JRST	GSR2		;DATA ERROR
	XCT	STATB(5)
	JRST	GSR3		;END OF FILE
GSR1:	XCT	ILD(5)		;GET DATA
	ANDI	0,377		;REDUCE TO 8 BITS
	MOVEM	0,@(Q)
GSR4:	JRA	Q,2(Q)
GSR2:	SKIPA	1,[3]		;N2=3. EOF SEEN.
GSR3:	MOVEI	1,2		;N2=2. DATA ERROR.
	MOVEM	1,@1(Q)
	JRST	GSR4
;THE FOLLOWING 5 ROUTINES CALL THE GENERAL
;INPUT (INDO) AND OUTPUT (OUTDO) ROUTINES AFTER
;SETTING THE PROPER INDEX REGISTERS.
;
;CALL     PRT(N1,N2)
;CALL     WDA(N1,N2)
;CALL     PUN(N1,N2)
;INPUT  - N1 = CHARACTER TO OUTPUT, RIGHT ADJUSTED
;OUTPUT - N2 = 0 - NO OUTPUT PERFORMED.
;	       1 - OUTPUT PERFORMED, NO ERRORS.
;	       2 - OUTPUT PERFORMED, DATA ERROR
;
;
;CALL     GSR(N1,N2)
;CALL     GDA(N1,N2)
;OUTPUT - N1 = CHARACTER READ, RIGHT ADJUSTED
;	  N2 = 0 - NO INPUT PERFORMED.
;	       1 - INPUT PERFORMED, NO ERROR.
;	       2 - INPUT PERFORMED, EOF
;	       3 - INPUT PERFORMED, DATA ERROR
	ENTRY	PRT
;OUTPUT TO CHANNEL 2
PRT:	0
	MOVEI	5,1
	MOVEI	4,1
	JRST	OUTDO
	ENTRY	WDA

;OUTPUT TO CHANNEL 1
WDA:	0
	MOVEI	5,0
	MOVEI	4,0
	JRST	OUTDO
	ENTRY	PUN

;OUTPUT TO CHANNEL 4
PUN:	0
	MOVEI	5,3
	MOVEI	4,3
	JRST	OUTDO
	ENTRY	GSR

;INPUT FROM CHANNEL 3
GSR:	0
	MOVEI	5,2
	MOVEI	4,2
	JRST	INDO
	ENTRY	GDA

;INPUT FROM CHANNEL 1
GDA:	0
	MOVEI	5,0
	MOVEI	4,0
	JRST	INDO

;THESE TABLES CONTROL ROUTINES OUTDO AND INDO
OSOS:	SOSLE	OB1+2
	SOSLE	OB2+2
	SOSLE	OB3+2
	SOSLE	OB4+2
ISOS:	SOSLE	OB1+2
	SOSLE	OB2+2
	SOSLE	OB3+2
	SOSLE	OB4+2

OUT:	OUTPUT	1,
	OUTPUT	2,
	OUTPUT	3,
	OUTPUT	4,

IN:	INPUT	1,
	INPUT	2,
	INPUT	3,
	INPUT	4,

GET:	GETSTS	1,6
	GETSTS	2,6
	GETSTS	3,6
	GETSTS	4,6

STATA:	STATZ	1,740000
	STATZ	2,740000
	STATZ	3,740000
	STATZ	4,740000

STATB:	STATZ	1,20000
	STATZ	2,20000
	STATZ	3,20000
	STATZ	4,20000

IDP:	IDPB	1,OB1+1
	IDPB	1,OB2+1
	IDPB	1,OB3+1
	IDPB	1,OB4+1

ILD:	ILDB	0,OB1+1
	ILDB	0,OB2+1
	ILDB	0,OB3+1
	ILDB	0,OB4+1
	ENTRY	STATUS
;RETURN THE STATUS REGISTER FROM LAST DEVICE.
;CALL     STATUS(N1)
;OUTPUT - N1 = STATUS REGISTER
STATUS:	0
	MOVE	0,STAT	;RETURN LATEST
	MOVEM	0,@(Q)	;STATUS.
	JRA	Q,1(Q)
;	REENTRY PROCEDURE FOR DETECTING ^C
	ENTRY	SREENT,DREENT
	EXTERNAL	CNTRLC,JOBREN,JOBOPC,NOTYOA
	SUBTTL	REENTRY PROCEDURE
;SET UP REENTER PROCESS WITH FORTRAN -- CALL SREENT

SREENT:	0
	MOVEI	0,DREENT	;PUT ADDRESS OF REENTER
	MOVEM	0,JOBREN	;ROUTINE INTO JOBREN
	SETZM	CNTRLC		;CLEAR ^C FLAG.
	JRA	16,(16)		;EXIT
;DO REENTRY PROCESS
DREENT:	SETOM	CNTRLC		;SET ^C FLAG.
	JRST	2,@JOBOPC	;RETURN TO PROGRAM
;
;INITIALIZE SINGLE CHARACTER CONSOLE IO
;
;CALL ICRWCS
	SUBTTL	SINGLE CHARACTER IO
	ENTRY	ICRWCS

ICRWCS:	0

	SKIPE	0,NOTYOA	;IS CHAN 2 BEING USED?
	OUTPUT	2,		;YES - FORCE AN OUTPUT.
	OUTPUT	0,		;FORCE OUTPUT TO CONSOLE.
	MOVEI	0,^D80	
	MOVEM	OBC		;SET OUTPUT BYTE COUNT
	MOVE	0,[POINT 7,SINB]	;POINTER
	MOVEM	0,SINPT		;FOR INPUT
	MOVE	0,[POINT 7,SOTB]	;POINTER
	MOVEM	0,SOTPT		;FOR OUTPUT
	SETZM	SINB		;CLEAR FIRST INPUT BUF WORD
	JRA	16,(16)
OBC:	0			;OUTPUT BYTE COUNT
SINPT:	0			;INPUT POINTER
SOTPT:	0			;OUTPUT POINTER
SINB:	BLOCK	21		;IN BUF
SOTB:	BLOCK	21		;OUT BUF

;READ A SINGLE CHARACTER FROM CONSOLE IN DDT SUBMODE
	ENTRY	CRCS
;CALL     CRCS(N1)
;OUTPUT - N1 = CHARACTER, RIGHT ADJUSTED.

CRCS:	0
CRCS2:	ILDB	0,SINPT		;GET NEXT CHAR
	JUMPN	0,CRCS1		;IF NOT NULL, GO EXIT.
	MOVEI	0,SINB		;NULL, PERFORM
	CALL	0,[SIXBIT /DDTIN/]	;UNBUFFERED INPUT
	MOVE	0,[POINT 7,SINB]	;RESET
	MOVEM	0,SINPT		;BYTE POINTER
	JRST	CRCS2		;GO START OVER
CRCS1:	MOVEM	0,@(16)		;SET RETURN VAL
	JRA	16,1(16)	;EXIT

	ENTRY	CWCS

;WRITE A CHARACTER TO CONSOLE IN DDT SUBMODE.
;CALL     CWCS(N1,N2)
;INPUT  - N1 = CHARACTER TO PRINT, RIGHT ADJUSTED
;OUTPUT - N2 = 0 - NO OUTPUT DONE,
;	       1 - OUTPUT DONE

CWCS:	0

	SETZM	@1(16)		;CLEAR RETURN VALUE.
	SOSGE	OBC		;ROOM IN BUFFER?
	JRST	CWCS1		;NO - GO OUTPUT
CWCS2:	MOVE	0,@(16)		;YES - GET CHARACTER.
	IDPB	0,SOTPT		;PUT IN BUFFER.
	JUMPE	0,CWCS3		;IF NULL, GO OUTPUT
	JRA	16,2(16)	;RETURN
CWCS1:	SETZ	0,		;TERMINATE BUFFER
	IDPB	0,SOTPT		;WITH NULL.
CWCS3:	MOVEI	0,SOTB		;GET BUFF ADR.
	CALL	0,[SIXBIT/DDTOUT/]	;DO OUTPUT.
	MOVEI	0,^D80		;RESET
	MOVEM	0,OBC		;COUNTER
	MOVE	0,[POINT 7,SOTB]	;AND POINTER
	MOVEM	0,SOTPT		;
	AOS	@1(16)		;SET RETURN VAL.
	MOVE	0,@(16)		;GET CHARACTER TO OUTPUT
	JUMPN	0,CWCS2+1	;GO IF NOT NULL.
	JRA	16,2(16)
	ENTRY	CCK
;
;	CHECK FOR INPUT FROM KBD.  SET RET=0 IF NONE,
;		RET=1 IF SOME.
;
	OPDEF TTCALL [51B8]
	OPDEF SKPINL [TTCALL 14,0]
CCK:	0
	SETZM	@(Q)		;SET RETURN VAL.
	MOVE	0,IB0+2		;GET CURRENT BUFF BC.
	SOSG	0		;ANY DATA LEFT?
	JRST	CCK1		;NO - TRY NEXT BUFFER IN RING.
	MOVE	1,IB0+1		;YES - GET BYTE PTR FOR BUFFER.
	ILDB	0,1		;IS NEXT CHAR = 0?
	JUMPE	0,CCK1		;YES - TRY NEXT BUFFER.
CCK2:	AOS	@(Q)		;SET RETURN VALUE
CCK3:	JRA	Q,1(Q)
CCK1:	HRRZ	1,IB0		;TEST NEXT BUFFER. GET PTR TO CURRENT BUFFER.
	HRRZ	0,@1		;GET PTR TO NEXT BUFFER.
	SKIPGE	@0		;TEST "USE" BIT. IF 0, NO INPUT AVAILABLE.
	JRST CCK4		;DATA AVAILABLE. GO CLEAR BC IN CURRENT BUFFER.
	SKPINL			;DOES THE MONITOR HAVE ANY CHARACTERS?
	JRST	CCK3		;NO - EXIT
CCK4:	SETZM	IB0+2		;YES - CLEAR CURRENT BC AND GO EXIT.
	JRST CCK2
;
;	DUMMY FORSE. KEEPS THE REAL FORSE. FROM LOADING.
;
	ENTRY	FORSE.
FORSE.:	0			;LH=FLAGS, RH=PC
	CALLI	0		;RESET ALL IO
	MOVE	17,PDLST	;SET PUSH LIST
	JRSTF	@FORSE.		;EXIT.
	LEN=24
PDLST:	XWD	-LEN,.		;PUSH LIST HEADER
	BLOCK	LEN
	ENTRY DUMMY.

;THIS DUMMY ROUTINE IS REQUIRED BY THE COMPILER.

DUMMY.:	0
	HALT
;
;	UUO HANDLER -- DOES A RESET
;
	LOC 41
	JSR	FORSE.		;CALL DUMMY FORSE.
	RELOC
	END