Google
 

Trailing-Edge - PDP-10 Archives - decus_20tap2_198111 - decus/20-0063/dial.mac
There are 2 other files named dial.mac in the archive. Click here to see a list.
	TITLE DIAL		;SUBROUTINES TO HANDLE IMAGE MODE TTY LINES
	ENTRY GETCHR,PUTCHR,PUTOUT,INITF,INITC
	entry init		;new improved all-purpose entry point
	EXTERN TABGEN		;ROUTINE TO GENERATE CRC TABLE

IFNDEF FTDEBUG,<FTDEBUG==0>	;IF NON-ZERO WRITE OUT EACH CHARACTER READ
				; AND SENT INTO "DEBUG.FIL

DEFINE SAVE(A)			;SAVE ACS MACRO
<	MOVEM A,ACSAV+A		;STORE HIGHEST NUMBERED AC
	HRRZI A,ACSAV		;SET UP BLT WORD
	BLT A,A-1>		;SAVE ACS

DEFINE RESTOR(A)		;RESTORE SAVED ACS
<	HRLZI A,ACSAV		;SET UP BLT WORD
	BLT A,A>		;RESTORE ACS

DEFINE CLRTTY(A)		;CLEAR TTY BITS USING TRMOP. UUO
<	MOVEI A			;GET TRMOP. FUNCTION TO BE EXECUTED
	MOVEM CLRBLK		;STORE IN CLEAR BLOCK
	MOVE [XWD 3,CLRBLK]	;SET UP FOR TRMOP.
	TRMOP.			;CLEAR THE DESIRED TTY BITS
	JFCL>			;NO ERRORS REPORTED

DEFINE SETTTY(A)		;SET TTY BITS MACRO
<	MOVEI A			;GET TRMOP. FUNCTION
	MOVEM SETBLK		;STORE FOR TRMOP. UUO
	MOVE [XWD 3,SETBLK]	;SET UP TRMOP. POINTER
	TRMOP.			;EXECUTE THE TRMOP. UUO
	JFCL>			;NO ERRORS REPORTED

DEFINE ERRMES(A)		;TYPE OUT ERROR MESSAGE MACRO
<	JRST [TTCALL 3,[ASCIZ/?
?A/]
;;;		JSA 16,HNGUPF	;RESTORE LINE ON FATAL ERRORS
		pushj 17,hngup	;restore line on fatal errors
		EXIT]>		;TYPE MESSAGE AND EXIT TO MONITOR

	C=1			;CHARACTER AC
	T1=3			;TEMPORARY
	T2=4			;TEMPORARY
	Q=16			;FORTRAN JSA AC
	P=17			;PUSH DOWN AC
	CNTX=30			;CONTROL-X ASCII VALUE

;;;INITF:	0			;CALL INITF(IOINDX,IERR,ITYPE)
;;;	PUSH P,Q		;STORE RETURN ADDR AND ARGUMENT POINTER
;;;	SETOM F4FLG#		;MARK THAT A FORTRAN CALLWAS USED
;;;	SKIPA
;;;INITC:	SETZM F4FLG		;MARK THAT A COBOL CALL WAS DONE
initf:				;new convention makes all entry points equal
initc:
init:	SAVE 5			;SAVE 5 ACS
;;;	HRRZ T1,(P)		;GET POINTER TO ARGUMENTS
;;;	MOVE T1,@(T1)		;PICK UP UNIVERSAL IO INDEX
	move	t1,@(q)		;pick up universal io index
	MOVEM T1,IOINDX		;STORE FOR ALL TTY OPERATIONS
	MOVEM T1,CLRBLK+1	;INITIALIZE CLEAR TRMOP.
	MOVEM T1,SETBLK+1	;AND SET TRMOP. DATA AREAS
;;;	AOS (P)			;INCREMENT ARGUMENT POINTER
	MOVSI (SIXBIT/TTY/)	;BUILD SIXBIT TTY NAME FOR INIT UUO
	MOVEM TTYNAM		;STORE PREFIX
	MOVE [POINT 6,TTYNAM,17];SET UP ILDB POINTER
	ANDI T1,777		;CLEAR 200000 BIT IN IO INDEX
	PUSHJ P,OCTCNV		;GO BUILD SIXBIT TTY NAME
	MOVE TTYNAM		;GET TTY NAME
	DEVCHR			;GET THE DEVICE CHARACTERISTICS
	TRNN 400000		;IS THIS TTY ASSIGNED?
	JRST ERROR2		;NO, IT MUST BE ASSIGNED TO DO IMAGE
				; MODE INPUT FROM IT.
	PJOB			;GET CONTROLING JOB NUMBER
	TRMNO.			;IS THE COMUNICATIONS TTY ALSO THE CONTROLING TTY
	JRST SETINT		;TRMNO. UUO FAILED ASSUME IT IS
	CAME IOINDX		;IS CONTROLING TTY THE SAME?
	JRST NOINT		;NO, DO NOT TURN ON ^C INTERCEPT
SETINT:	SKIPE .JBINT##		;SET ^C INTERCEPT TO GUARANTEE THAT
				; THE LINE WILL NOT EXIT TO MONITOR MODE
	JRST NOINT		;DO NOT RESET INTERCEPT IF ALREADY SET
	MOVEI INTBLK		;GET INTERCEPT BLOCK ADDRESS
	MOVEM .JBINT		;STORE IN INTERCEPT WORD
NOINT:				;  
IFN FTDEBUG,<			;IF DEBUGGING, INIT THE DSK FOR OUTPUT
	INIT 15,10		;INIT DSK IN IMAGE MODE
	SIXBIT/DSK/		;  
	XWD DOBUF,0		;FOR OUTPUT ONLY
	ERRMES(<DSK NOT AVAILABLE TO WRITE DEBUG FILE>)
	OUTBUF 15,2		;SET UP TWO BUFFERS
	HLLZS NAME+1		;CLEAR NAME BLOCK
	SETZM NAME+2		;  SO ENTER WILL NOT FAIL
	SETZM NAME+3		;  ...
	ENTER 15,NAME		;ENTER "DEBUG.FIL"
	ERRMES(<CANNOT ENTER DEBUG FILE>)
>				; 
	MOVE .JBFF##		;GET START OF FREE CORE
	MOVEM SAVJBF#		;SAVE IT. THIS IS WHERE TTY BUFFER WILL BE
	MOVEI IBUF		;SET UP FOR THE OPEN UUO
	MOVEM BUFHD		;STORE BUFFER HEADER
	OPEN 17,OPNBLK		;INIT THE TTY LINE FOR INPUT IN IMAGE MODE
	JRST ERROR1		;TTY NOT AVAILABLE
	INBUF 17,1		;SET UP ONE BUFFER
	MOVSI OBUF		;NOW SET UP TO INIT TTY FOR OUTPUT
	MOVEM BUFHD		; ...
	OPEN 16,OPNBLK		;OPEN THE OUTPUT CHANNEL
	JRST ERROR1		;TTY NOT AVAILABLE
	MOVE [XWD 400000,OBUF1+1]
	MOVEM OBUF		;SET UP 80 WORD BUFFER FOR OUTPUT
	MOVSI (POINT 36,0,35)	;THIS GUARANTEES THAT AN ENTIRE MESSAGE
	MOVEM OBUF+1		;WILL FIT IN THE BUFFER.  OTHERWISE A MESSAGE
	SETZM NCHAR#		;COULD BE SPLIT DURING SENDING AND CAUSE
				; THE RECEIVER TO THINK THAT
				; THE REMAINDER OF THE MESSAGE WAS LOST.
	AOS NCHAR		;INITIALIZE NCHAR TO 1 TO FORCE INITIAL OUTPUT
	PUSHJ P,INITTY		;GO INITIALIZE THE TTY FOR INPUT AND SET
				; ALL OF THE PROPER MODES
	CLRTTY(<3>)		;CLEAR INPUT BUFFER
	CLRTTY(<4>)		;CLEAR OUTPUT BUFFER
	PUSHJ P,TABGEN		;GENERATE THE CRC TABLE
;;;	HRRZ T1,(P)		;GET NEXT ARGUMENT ADDRESS
;;;	SETOM @(T1)		;MARK THAT THE INITIALIZATION WAS SUCCESSFUL
	setom	@1(q)		;mark that the initialization was successful
EXIT0:	;;;AOS (P)			;INCREMENT ARGUMENT POINTER
;;;	HRRZ T1,(P)		;GET TYPE POINTER
	MOVE ITYPE		;GET ITYPE VALUE
;;;	MOVEM @(T1)		;STORE ITYPE
;;;	AOS (P)			;INCREMENT ARGUMENT POINTER
	movem	@2(q)		;store itype
EXIT1:	RESTOR 5		;RESTORE ACS
EXIT2:	;;;SKIPN F4FLG		;WAS THIS ROUTINE CALLED BY FORTRAN
	POPJ P,			;NO, DO A POPJ RETURN
;;;EXITF4:	POP P,Q			;RESTORE RETURN ADDRESS
;;;	JRA Q,(Q)		;RETURN TO CALLER

ERROR1:	SKIPA [1]		;TTY NOT AVAILABLE ERROR
ERROR2:	MOVEI 2			;TY NOT ASSIGNED ERROR
	MOVEM ITYPE		;STORE TYPE OF ERROR
;;;	HRRZ T1,(P)		;GET ERROR ARGUMENT ADDRESS
;;;	SETZM @(T1)		;MARK THAT AN ERROR OCCURED
	setzm	@1(q)		;mark that an error occurred
	JRST EXIT0		;GO STORE TYPE OF ERROR AND RETURN

OCTCNV:	IDIVI T1,10		;CONVERT OCTAL TO SIXBIT
	HRLM T2,(P)		;STORE LOW ORDER DIGIT
	SKIPE T1		;ARE WE THROUGH
	PUSHJ P,OCTCNV		;NO GO GET HIGHER ORDER DIGITS
	HLRZ T1,(P)		;GET HIGH ORDER DIGIT
	ADDI T1,20		;MAKE IT SIXBIT
	IDPB T1,0		;STORE IN TTYNAM
	POPJ P,			;RETURN FOR OTHER DIGITS IF ANY

CLRINP:: CLRTTY(<3>)		;CLEAR THE INPUT BUFFER
	POPJ P,			;RETURN

GETCHR:	SOSGE IBUF+2		;GET CHARACTER ROUTINE RETURNS CHAR IN C
	JRST GETBF		;NO CHARACTERS IN BUFFER GO DO INPUT MAYBE

	ILDB C,IBUF+1		;GET CHARACTER FROM BUFFER
	ANDI C,377		;CLEAR BIT 9
IFN FTDEBUG,<			;IF DEBUGGING THEN WRITE OUT CHARACTER
	PUSHJ P,DEBIN		;  SET LEFT HALF WORD TO ZERO
>				;  
CPOPJ1::	AOS (P)		;SKIP RETURN
CPOPJ:	POPJ P,			;NON-SKIP RETURN

GETBF:	STATZ 17,1B22		;IS THERE AN END OF FILE ON TTY
	JRST GETBF1		;YES, GO REINIT THE TTY
	MOVEI 1			;NOW CHECK IF TTY HAS INPUT READY
	MOVEM SKPBLK		;STORE TRMOP. FUNCTION CODE
	MOVE [XWD 2,SKPBLK]	;SET UP TRMOP. UUO
	TRMOP.			;SKIP IF INPUT IS READY
	POPJ P,			;NO INPUT READY, TAKE NON-SKIP RETURN
	IN 17,			;INPUT IS THERE SO IN UUO WILL NOT 
				; GO INTO I/O WAIT
	JRST GETCHR		;INPUT UUO WAS SUCCESSFUL
	STATO 17,1B22		;INPUT UUO FAILED, CHECK END OF FILE
	ERRMES(<COMMUNICATIONS TTY LINE NO LONGER ASSIGNED TO JOB>)
GETBF1:	PUSHJ P,INITTY		;EOF - TTY MUST BE REINITED
	JRST GETBF		;GO BACK AND TRY AGAIN

INITTY:	MOVEI IBUF		;SET UP FOR AN INPUT INIT
	MOVEM BUFHD		;  
	MOVE SAVJBF		;ALLWAYS REUSE INPUT BUFFER AREA
	EXCH .JBFF		; OTHERWISE JOB WILL GROW INDEFINATELY
	OPEN 17,OPNBLK		;OPEN TTY FOR INPUT
	ERRMES (<COMMUNICATIONS TTY LINE NO LONGER AVAILABLE>)
	INBUF 17,1		;SET UP ONLY ONE BUFFER
	MOVEM .JBFF		;RESTORE ORIGINAL .JBFF
	SETTTY(<2004>)		;SLAVE
	SETTTY(<2013>)		;GAG
	SETTTY(<2007>)		;LOCAL COPY
	SETTTY(<2010>)		;NO CR-LF
	SETTTY(<2021>)		;PAGE
	POPJ P,			;RETURN

PUTCHR:	SOSG OBUF+2		;PUT CHARACTER IN C INTO BUFFER
	PUSHJ P,PUTOUT		;NO MORE ROOM - SEND OUT BUFFER
	IDPB C,OBUF+1		;STORE CHARACTER
IFN FTDEBUG,<			;IF DEBUGGING - 
	PUSHJ P,DEBOUT		; SEND OUT CHARACTER TO DISK ALSO
>				; 
	AOS NCHAR		;COUNT UP NUMBER OF CHARACTERS IN BUFFER
	POPJ P,			;RETURN

PUTOUT:	MOVE IOINDX		;SEND OUT BUFFER
	MOVEM RPAGE+1		;CHECK IF OUTPUT IS STOPPED BY XOFF
	MOVE [XWD 3,RPAGE]	;SET UP FOR TRMOP. UUO
	TRMOP.			;IS OUTPUT STOPPED?
	JFCL			;IGNORE FAILURE OF TRMOP. UUO
	SKIPE RPAGE+2		; 
	PUSHJ P,[	CLRTTY(<4>)
			CLRTTY(<2022>)
			POPJ P,];YES, CLEAR THE BIT AND CLEAR THE BUFFER
	SKIPE NCHAR		;ARE THERE ANY CHARACTERS TO BE OUTPUT
	OUTPUT 16,		;YES, OUTPUT THGEM
	SETZM NCHAR		;CLEAR COUNT
	WAIT 16,		;WAIT FOR OUTPUT TO BE DONE
CHKOBF:	MOVEI 2			;NOW CHECK IF OUTPUT BUFFER IS EMPTY
	MOVEM SKPBLK		; WITH A TRMOP. UUO
	TRMOP.			; 
	POPJ P,			;BUFFER IS EMPTY, NOW RETURN
	MOVEI 0			;BUFFER HAS CHARACTERS IN IT
	SLEEP			;SLEEP FOR 1 CLOCK TICK
	JRST CHKOBF		;THEN GO CHECK AGAIN

	ENTRY DIALF,DIALC,HNGUPC,HNGUPF
	entry dial, hngup	;new improved entry points

;;;HNGUPF:	0			;CALL HNGUPF
;;;	PUSH P,Q		;SAVE RETURN AC
;;;	SETOM F4FLG		;MARK THAT WE CAME FROM FORTRAN JOB
;;;	SKIPA
;;;HNGUPC:	SETZM F4FLG		;MARK THAT A COBOL CALL WAS DONE
hngupf:
hngupc:
hngup:	PUSH P,0		;SAVE AC 0
	CLRTTY(<2004>)		;SLAVE
	MOVEI INTLOC		;CHECK IF WE SHOULD CLEAR ^C INTERCEPT
	CAMN .JBINT		;DID WE SET IT INITIALLY
	SETZM .JBINT		;YES, THEN CLEAR IT
	CLRTTY(<14>)		;HANGUP THE MODEM
	MOVEI ^D6000		;THEN WAIT 6 SECONDS
	HIBER			; FOR LINE TO HANGUP PROPERLY
	JFCL			;IGNORE ERROR RETURN
	POP P,0			;RESTORE 0
	JRST EXIT2		;AND RETURN TO CALLER

;;;DIALF:	0		;CALL DIAL(ARRAY,N,IFLAG)
;;;	PUSH P,Q		;SAVE RETURN AC
;;;	SETOM F4FLG		;MARK THIS AS A FORTRAN CALL
;;;	SKIPA
;;;DIALC:	SETZM F4FLG		;MARK THAT A COBOL CALL WAS DONE
dialf:
dialc:
dial:	SAVE 5			;SAVE 5 ACS
	SETOM ITYPE#		;START WITH CORRECT ITYPE
;;;	HRRZ 1,(P)		;GET ADDRESS OF FIRST ARGUMENT
;;;	HRRZ 2,(1)		;GET ARRAY ADDRESS
	movei	2,@(q)		;get array address in ac2
;;;	AOS (P)			;INCREMENT POINTER
;;;	HRRZ 1,(P)		;GET ADDRESS OF SECOND ARGUMENT
;;;	SKIPN 3,@(1)		;ARE THERE ANY DIGITS TO DIAL
	skipn	3,@1(q)		;are there any digits to dial
	JRST NODIAL		;NO, THEN SKIP THE DIALING PART
	CAIL 3,17		;THERE MUST BE LESS THAN 17 DIGITS
	JRST [	MOVEI 3		;MORE THAN 17, SET ERROR BIT
		MOVEM ITYPE	;IN ITYPE
		JRST DERROR]	;GO GIVE ERROR RETURN

	MOVNS 3			;GET NEGATIVE COUNT OF DIGITS TO BE DIALED
;;;	SKIPN F4FLG		;COBOL CALL?
;;;	HRRZ 2,(2)		;YES, GET THE REAL ARRAY ADDRESS
	HRL 2,3			;SET UP AOBJN COUNTER
	SETZM NUMBER		;INITIALIZE NUMBER TO BE DIALED
	SETZM NUMBER+1		;...
	MOVE 1,[POINT 4,NUMBER]	;SET UP BYTE POINTER
	MOVE (2)		;GET NEXT DIGIT TO BE DIALED
	IDPB 1			;STORE IN DIAL BUFFER
	AOBJN 2,.-2		;LOOP THROUGH ALL DIGITS
	MOVEI 17		;END WITH A 17
	IDPB 1			;...
;;;	PUSH P,F4FLG		;SAVE F4FLG
	PUSHJ P,HNGUPC		;  THIS GUARANTEES THAT THE LINE IS AVAILABLE
;;;	POP P,F4FLG		;RESTORE F4FLG
	MOVE IOINDX		;SET UP FOR DIAL
	MOVEM DIALAD+1		;  
	MOVE [XWD 4,DIALAD]	; 
	TRMOP.			;DO THE DIALING
	JRST BADIAL		;THE DIAL FAILED, GO GIVE ERROR RETURN
NODIAL:	TTCALL 3,[ASCIZ/CONTROLLING TTY IS NOW DIRECTLY CONNECTED TO COMMUNICATIONS LINE.
TYPE ^X TO CONTINUE.
/]				;USER CAN NOW LOGIN AND START RECEIVER JOB
TLOOP:	PUSHJ P,GETTTY		;ANY CHARACTERS FROM TTY
	JRST NOTTY		;NO GO CHECK COMMUNICATIONS LINE
	CAIN C,CNTX		;YES, IS THIS A CONTROL X
	JRST DIALRT		;YES, THEN THE USER IS DONE
	PUSHJ P,PUTCHR		;NO, SEND CHARACTER OUT TO COMMUNICATIONS LINE
	JRST TLOOP		;LOOP BACK FOR MORE
NOTTY:	PUSHJ P,GETCHR		;CHECK FOR CHARACTERS FROM COMM LINE
	JRST NOACU		;NO CHARACTERS THERE
	PUSHJ P,PUTTTY		;TYPE OUT CHARACRTER
	JRST TLOOP		;LOOP BACK
NOACU:	PUSHJ P,PUTOUT		;SEND OUT BUFFER
	MOVSI -1		;SLEEP WAITING FOR TTY ACTIVITY
	HIBER			;...
	JFCL			;IGNORE ERROR RETURN
	JRST TLOOP		;LOOP BACK

GETTTY:	TTCALL 2,C		;GET A CHARACTER FROM TTY
	POPJ P,			;NONE THERE
	CAIN C,"^"		;IS THIS AN ^
	JRST	[SETOM CNTFLG#	;YES, SET FLAG
		 POPJ P,]	;AND RETURN
	SKIPE CNTFLG		;NO, IS FLAG SET
	TRZ C,100		;YES, THE MAKE THIS CHARACTER A CONTROL CHAR
	SETZM CNTFLG		;ZERO FLAG
	AOS (P)			;TAKE SKIP RETURN
	POPJ P,			;RETURN

PUTTTY:	TTCALL 1,C		;SEND OUT CHARACTER
	POPJ P,			;RETURN

BADIAL:	SUBI 3			;CHECK THE DIAL ERROR
	CAIE 1			;IS IT THAT THE LINE IS NOT A DATASET?
	CAIN 2			;OR THAT THE DIAL FAILED
	SKIPA			;YES
	MOVEI 0			;NO SET ERROR TYPE TO ZERO
	MOVEM ITYPE		;STORE ERROR TYPE
DERROR:	TDZA			;SET ERROR WORD FALSE
DIALRT:	SETO			;SET ERROR WORD TRUE
;;;	AOS (P)			;INCREMENT ARG POINTER
;;;	HRRZ 1,(P)		;GET ARG ADDRESS
;;;	MOVEM @(1)		;STORE ERROR FLAG
	movem	@2(q)		;store error flag
	JRST EXIT0		;GO STORE TYPE

INTLOC:	PUSH P,INTBLK+2		;SAVE INTERRUPT ADDRESS
	SETZM INTBLK+2		;CLEAR INTERRUPT LOCATION
	POPJ P,			;RETURN TO INTERRUPTED ADDRESS

INTBLK:	XWD 4,INTLOC		;INTERRUPT ROUTINE ADDRESS
	XWD 0,2			;^C ONLY
	0			; 
	0			; 

OBUF1:	0			;SPECIAL OUTPUT BUFFER AREA
	XWD ^D80,OBUF1+1	;80 WORDS LONG
	BLOCK ^D80		;...

OPNBLK:	210			;IMAGE MODE AND NO-ECHO
TTYNAM:	SIXBIT/TTY/		;SIXBIT NAME OF COMMUNICATIONS TTY
BUFHD:	0			;BUFFER HEADER

SKPBLK:	0			;SKIP TRMOP.
IOINDX:	200000			;IO INDEX OF COMMUNICATIONS LINE

CLRBLK:	0			;CLEAR TRMOP. BLOCK
	0			;...
	0			;...
SETBLK:	0			;SET TRMOP. BLOCK
	0
	1			;SET THE BIT TO 1

DIALAD:	13			;DIAL TRMOP. BLOCK
	200000			;IO INDEX
NUMBER:	0			;NUMBER TO DIAL
	0			;...


IBUF:	BLOCK 3			;INPUT BUFFER HEADER
OBUF:	BLOCK 3			;OUTPUT BUFFER HEADER

PDLEN=10			;PUSH DOWN BLOCK LENGTH
PDLST:	BLOCK PDLEN		;PUSH DOWN LIST AREA

RPAGE:	1022			;CHECK PAGE BIT
	200000			;...
	0			;...


IFN FTDEBUG,<
DEBIN:	TDZA
DEBOUT:	MOVSI -1		;MARK THAT THIS WAS A CHAR SENT OUT
	HRR C			;GET CHAR
DEBPNT::	SOSG DOBUF+2	;PUT IT INTO BUFFER
	OUTPUT 15,		;BUFFER WAS FULL
	IDPB DOBUF+1		;NOW STORE CHAR
	POPJ P,			;RETURN

DOBUF:	BLOCK 3			;DEBUG BUFFER HEADER

NAME:	SIXBIT/DEBUG/		;NAME OF DEBUG FILE
	SIXBIT/FIL/		;EXT
	0			;...
	0			;...
>

ACSAV:	BLOCK 5			;AREA TO SAVE ACS

	END			;END OF DIAL