PDP-10 Archive: 10,7/unscsp/reatta/reatta.mac from scratch

Trailing-Edge - PDP-10 Archives - scratch - 10,7/unscsp/reatta/reatta.mac

There are 6 other files named reatta.mac in the archive. Click here to see a list.

TITLE	REAT	EZCOR=LITLVL+1
	XL A NEW CONSOLE -V2
ALS
LIT
	LIST  ;JUST LITERALS ABOVE
	Y-71



;COPYRIGHT (C) 1971,1978,1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;THIS SOFTWARE IS FUAND COPIED
;ONLY  IN  ACCORDANCE  WITH  THE  TERMS  OF  SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE.  THIS SOFTWARE OR ANY  OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON.  NO TITLE TO AND OWNERSHIP OF THE  SOFTWARE  IS  HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT  NOTICE
;AND  SHOULD  NOT  BE  CONSTRUED  AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY  OF  ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.


;HOW TO USE REATTACH:
; 1.TYPE REATTACH TTYNAME - THIS WILL MOVE YOUR JOB TO THE SPECIFIED
;     TTY.
;
; EXAMPLE:
; .REATTACH TTY11
; -
; FROM JOB 17
; -----------
; .
; -
;
; ON TTY11 THE MESSAGE "NOW ATTACHED TO JOB 17" WILL BE PRINTED.
;
; 2. TYPE R REATTA - THEN ANSWER QUESTION ABOUT NEW TTY NAME
;
; EXAMPLE:
; .R REATTA
; -
; TYPE NEW TTY NAME: TTY11
; ------------------
; FROM JOB 17
; -----------
; .
; -
;
; ON TTY11 THE MESSAGE "NOW ATTACHED JOB 17" WILL BE PRINTED
;
;
; WARNING: MAKE SURE THE TTY TO WHICH YOU ARE ATTACHING YOUR JOB
; IS UP AND IN GOOD WORKING ORDER. IF YOU DO NOT MAKE THIS CHECK
; YOU MAY REATTACH TO A DOWN TTY AND HAVE YOUR JOB LOST.
;
VREATT==3
VWHO==0
VMINOR==0
VEDIT==3

	LOC	137
	BYTE	(3)VWHO(9)VREATT(6)VMINOR(18)VEDIT
	RELOC

;ACCUMULATOR ASSIGNMENTS
	F=0			;FLAG REGISTER
	T1=1			;TEMP
	T2=2			;TEMP
	T3=3			;TEMP
	M=4			;MESSAGE POINTER
	JOB=5			;JOB NUMBER
	C=6			;HOLDS A CHAR
	TTY=7			;TTY NAME OF TARGET IN SIXBIT
	LINE=10 		;LINE NUMBER OF TARGET
	P=17			;PUSH DOWN POINTER

;DEVCHR BITS
ATTY==1B4			;ATTACHED TTY
USRTTY==1B5			;USER TTY
DEVAVL==1B12			;DEVICE IS FREE
DEVTTY==1B14			;DEVICE IS A TTY

;JOBSTS BITS
JACCT==1B5			;THE PRIV BIT

;GETTABS
FSFPPN==XWD	2,16		;THE PRIV PPN
STATES==XWD	17,11		;VERSION OF MONITOR
PTYCNF==XWD	22,11		;WHERE TO FIND THE CTY
JBTPRG==3			;JOB NAMES

;FLAG BITS
FL.CMD==400000			;CUSP STARTED BY COMMAND
FL.SKP==200000			;SKIP LEADING SPACES

;UUOS
OPDEF	JOBSTS	[CALLI 61]
OPDEF	ATTACH	[CALLI 104]

;PRINT AN ERROR MESSAGE AND DIE
DEFINE	PUNT	(A)<
	XLIST
	JSP	M,PUNT. 	;;LOAD POINTER TO MESSAGE
	ASCIZ	\A\
	LIST>

;PRROR MESSAGE AND RETRY
DEFINE	PUNTR	(A)<
	XLIST
	JSP	M,PUNTR.
	ASCIZ	\A\
	LIST>

REATTA: JFCL			;IN CASE OF CCL START
	RESET			;CLEAR THE WORLD
	MOVSI	F,FL.SKP	;INITIAL FLAGS
	MOVE	P,PDP		;SET UP A PDL
	MOVE	T1,[STATES]	;STATES WORD
	GETTAB	T1,		;GET IT
	  JRST	PUNT01		;GETTAB FAILED
	TLNN	T1,(6B9)	;IS THIS 5.03 OR BETTER?
	  JRST	PUNT02		;NEED 5.3 OR LATER
	SETO	T1,		;MY JOB
	CTLJOB	T1,		;WHO IS MY MASTER
	  JRST	PUNT03		;CTLJOB UUO FAILED
	JUMPL	T1,NOTBAT	;JUMP IF I AM MY OWN MASTER
	HRLI	T1,(T1) 	;PUT INDEX IN LEFT HALF
	HRRI	T1,JBTPRG	;JOB NAME TABLE
	GETTAB	T1,		;GO GET THE NAME
	  JRST	PUNT04		;GETTAB FAILED
	CAME	T1,[SIXBIT /BATCON/]	;SEE IF MP BATCH
	CAMN	T1,[SIXBIT /BATCH/]	; OR OLD BATCH
	  JRST	PUNT05		;DO NOT LET BATCH SUBJOB BEAT LOGIN
	CAMN	T1,[SIXBIT /OBATCH/] ;OTHER NAME FOR OBATCH
	JRST	PUNT05		;CAN NOT RUN FROM HERE EITHER
NOTBAT: PJOB	JOB,		;GET THE JOB NUMBER
	MOVNI	T1,(JOB)	;GET READY FOR JOBSTS
	JOBSTS	T1,		;GET MY JOB STATUS
	  JRST	PUNT06		;JOBSTS FAILED
	TLNE	T1,(JACCT)	;JACCT SET?
	JRST	PRIVJ		;YES--GO AN TRY NEXT TEST
	GETPPN	T1,		;GET MY PPN
	JFCL			;IN CASE THE SILLY SKIP STILL LIVES
	MOVE	T2,[FSFPPN]	;FAILSAFE PPN [1,2]
	GETTAB	T2,		;GET THE WORD FORM MONITOR
	  JRST	PUNT07		;GETTAB FAILED
	CAME	T1,T2		;GODLY?
	  JRST	PUNT10		;HE IS NOT U,I OR JACCT IS OFF

PRIVJ:	MOVEI	C,12		;FLAG IN CASE NO RESCAN
	RESCAN	1		;RE-EAT LAST COMMAND
	SKPINC			;ANYTHING TO DIGEST?
	  JRST	ASK		;NO--MUST BE RUN UUO
	MOVSI	T1,770000	;INITIAL MASK
	MOVE	T2,[POINT 6,T3] ;POINT TO RESULT
	SETZ	T3,		;CLEAR OUT THE RESULT
LOOP:	PUSHJ	P,TYI		;GET A SIXBIT CHR
	  JRST	CHK		;NON ALPHEAMERIC
	TLNN	T2,770000	;ANY ROOM?
	JRST	LOOP		;NO--GO BACK AND EAT MORE
	IDPB	C,T2		;YES--STORE
	ASH	T1,-6		;SHIFT THE MASK
	JRST	LOOP		;GO EAT MORE
CHK:	ADDI	C,40		;ALLOW FOR SIXBIT INPUT
	TLNE	T2,770000	;WAS WHOLE WORD FILLED?
	LSH	T1,6		;COMPENSATE FOR MOVSI
	TLNN	T1,(77B11)	;MUST BE AT LEAST TWO CHARS
	JRST	ASK		;NOT ENOUGH--SKIP ONWARDS
	AND	T1,[SIXBIT .REATTA.]	;NAME OF THIS CUSP
	CAMN	T1,T3		;MATCH?
	TLOA	F,FL.CMD	;YES--FLAG AS BEING A COMMAND
	JRST	ASK		;NO--GO ASK FOR ARGUMENT
	JRST	GETARG		;GO GET THE ARGUMENT
ASK:	PUSHJ	P,SUCK		;KILL REST OF LINE
	OUTSTR	[ASCIZ /NEW TTY NAME: /]
GETARG: TLO	F,FL.SKP	;IGNORE LEADING BLANKS
	MOVE	T1,[POINT 6,TTY]	;RESULT
	SETZ	TTY,		;CLEAR NAME OF TTY
LOOP1:	PUSHJ	P,TYI		;READ A CHAR
	  JRST	TRYUUO		;DONE
	TLNN	T1,770000	;ROOM?
	JRST	LOOP1		;NO--PUT IN GARBAGE
	IDPB	C,T1		;YES--STORE IN TTY
	JRST	LOOP1		;;LOOP FOR MORE

TRYUUO:	ADDI	C,40		;ALLOW FOR SIXBIT INPUT
	PUSHJ	P,SUCK		;KILL REST OF LINE
	JUMPE	TTY,ASK 	;GO ASK AGAIN IF NULL TTY
	JUMPL	TTY,TRYIT	;IF SIXBIT NAME, TRY IT
	MOVSS	TTY		;ELSE, MUST BE NUMBER
	HRLI	TTY,'TTY'	; SO CHANGE TO NAME
TRYIT:	MOVE	T1,TTY		;COPY TTY NAME
	DEVCHR	T1,200000	;GET PHYSICAL ONLY CHARS
	TLNN	T1,(DEVTTY)	;CONSOLE?
	  JRST	PUNT11		;NOT A TTY
	TLNE	T1,(DEVAVL)	;IS THE TTY FREE
	JRST	GRABIT		;YES--GO INIT IT
	TLNN	T1,(USRTTY!ATTY);SOME ONE ATTACHED
	  JRST	PUNT12		;INITED BY SOME OTHER JOB
	PUNTR	<TTY ALREADY ATTACHED TO A JOB>
;INIT THE TTY SO NO ONE ELSE CAN REATTACH
GRABIT: MOVSI	C,400000	;PHYSICAL ONLY
	SETZ	LINE,		;NO BUFFERS
	OPEN	C		;TRY TO INIT
	  JRST	PUNT13		;CAN NOT INIT (TIMING PROBLEM)
	CAMN	TTY,[SIXBIT .TTY   .]	;DON'T ALLOW TTY TO WIN
	GETLIN	TTY,		;WANTS TO ATTACH TO HIS OWN LINE (?)
	MOVE	T1,TTY		;COPY TTY NAME
	CAMN	T1,[SIXBIT /CTY   /]	;IS THIS THE CTY?
	JRST	DOCTY		;YES--GO COMPUTE ANOTHER WAY
	MOVE	T2,[POINT 6,TTY,17]
CONV:	TLNN	T2,770000	;ROOM?
	JRST	LINSET		;NO--MUST BE DONE
	ILDB	C,T2		;GET A DIGIT
	JUMPE	C,LINSET	;DONE IF BLANK
	LSH	LINE,3		;MAKE ROOM
	ADDI	LINE,-20(C)	;ADD IN DIGIT
	JRST	CONV		;CONVERT ANOTER DIGIT
DOCTY:	MOVE	T1,[PTYCNF]	;GET PTY OFFSET
	GETTAB	T1,		;FROM THE MONITOR
	  JRST	PUNT14		;GETTAB FAILED
	HLRZ	LINE,T1 	;GET NUMBER OF FIRST PTY
	SOS	LINE		;LESS ONE IS CTY

LINSET:;MOVSI	T1,LINTAB	;ADDRESS OF LINTAB
;	HRR	T1,LINE 	;LINE NUMBER
;	GETTAB	T1,		;GET LINTAB ENTRY
;	PUNT	<CAN NOT GETTAB INTO LINTAB>
;	TLNE	T1,TTVSLV	;SLAVE?
;	PUNTR	<CAN NOT REATTACH TO A SLAVE LINE>



;THIS IS NOT EXACTLY RIGHT SINCE ATTACH UUO MAY STILL FAIL
; BUT THAT IS NOT LIKELY AND THIS SAVES THE BOTHER OF BUFFERED
; I/O TO THE OLD TTY
	OUTSTR	[ASCIZ /FROM JOB /]
	MOVE	T3,JOB		;SAVE JOB AROUND  PJOBN
	PUSHJ	P,PJOBN 	;PRINT THE JOB NUMBER
	MOVE	JOB,T3		;SAVE JOB AROUND  PJOBN
	OUTSTR	[ASCIZ /
./]
	HRL	T1,LINE 	;LINE IN LEFT
	HRR	T1,JOB		;JOB IN RIGHT HALF
	TLO	T1,200000	;SET TO USER MODE
	ATTACH	T1,		;DO THE ATTACH
	  JRST	PUNT15		;ATTACH UUO FAILED
;I AM NOW ON NEW TTY
	OUTSTR	[ASCIZ /NOW ATTACHED TO JOB /]
	PUSHJ	P,PJOBN 	;PRINT JOB NUMBER
	OUTSTR	[ASCIZ /
/]
	EXIT	1,		;DONE
	JRST	REATTACH	;TRY AGAIN -- JACCT IS OFF HOWEVER

;SUBROUTINE TO READ 1 SIXBIT CHAR
;CALL WITH:
;	PUSHJ	P,TYI
;	  RETURN HERE IF NOT A-Z OR 0-9
;	RETURN HERE WITH CHAR IN C
;
TYI:	INCHWL	C		;READ A CHAR
	JUMPE	C,TYI		;IGNORE NULLS
	CAIN	C,3		;CONTROL C
	JRST	CTLC		;YES--EXIT
	CAIE	C," "		;BLANK
	JRST	TESTC		;NO--GO SEE IF KOSHER
	TLNE	F,FL.SKP	;IGNORE BLANKS
	JRST	TYI		;YES--DO SO
	MOVEI	C,0		;CLEAR CHARACTER
	POPJ	P,		;NO--ERROR RETURN
TESTC:	TLZ	F,FL.SKP	;SOMETHING SEEN
	MOVEI	C,-40(C)	;CONVERT TO SIXBIT
	CAIL	C,'0'		;TRIED AND TRUE TEST
	CAILE	C,'Z'
	POPJ	P,
	CAILE	C,'9'
	CAIL	C,'A'
CPOPJ1: AOS	(P)
	POPJ	P,
;HERE ON CONTROL C
CTLC:	RESET
	EXIT	1,
	JRST	.-1


;SUBROUTINE TO SUCK UP REST OF LINE IF ANY
;CALL WITH:
;	MOVEI	C,CHARACTER
;	PUSHJ	P,SUCK
;	RETURNS WITH C=END OF LINE CHARACTER
;STOPS AT FIRST BREAK CHARACTER

SUCK:	MOVSI	T1,-SUCKTL	;SET LOOP LIMIT
	CAME	C,SUCKT(T1)	;SEE IF CHARACTER MATCHES
	AOBJN	T1,.-1		;LOOP UNTIL ALL CHECKED
	SKIPL	T1		;SEE IF IT MATCHED?
	INCHRS	C		;NO--GET ANOTHER CHAR IF WE CAN
	  POPJ	P,		;DONE--RETURN
	JRST	SUCK		;LOOP FOR NEXT CHARACTER

SUCKT:	EXP	3,7,12,13,14,17,25,32,33,175,176,177
SUCKTL==.-SUCKT

;SUBROUTINES TO BOMB OUT WITH A MESSAGE
;CALL WITH:
;	MOVEI	M,MESSAGE
;	JRST	PUNT.		;UNCONDITIONAL FAILURE
;	-OR-
;	JRST	PUNTR.		;BOMB IF COMMAND ELSE REASK
;
PUNT.:	OUTSTR	[ASCIZ /? /]
	OUTSTR	(M)
	OUTSTR	[ASCIZ /
/]
	RESET
	EXIT	1,

PUNTR.: OUTSTR	[ASCIZ /? /]
	OUTSTR	(M)
	OUTSTR	[ASCIZ /
/]
	CLRBFI			;CLEAR ANY JUNK
	TLNN	F,FL.CMD
	JRST	ASK
	RESET
	EXIT	1,

;SOME OF THE WAYS WE CAN BOMB OUT

PUNT01: PUNT	<GETTAB ON THE STATES WORD FAILED>
PUNT02: PUNT	<NEED 5.03 OR LATER FOR REATTACH COMMAND>
PUNT03: PUNT	<CTLJOB UUO FAILED>
PUNT04: PUNT	<GETTAB ON JBTPRG FAILED>
PUNT05: PUNT	<CAN NOT REATTACH FROM A BATCH SUBJOB>
PUNT06: PUNT	<JOBSTS UUO FAILED>
PUNT07: PUNT	<GETTAB ON FSFPPN FAILED>
PUNT10: PUNT	<YOU DON'T HAVE PRIVS TO REATTACH YOUR JOB>
PUNT11: PUNTR	<NOT A TTY>	;NO--BOMB
PUNT12: PUNTR	<TTY IN USE>
PUNT13: PUNTR	<CAN NOT INIT THAT TTY>
PUNT14: PUNT	<CAN NOT GETTAB PTYCNF>
PUNT15: PUNT	<ATTACH UUO FAILED!!>

;YEA OLD DECMAL OUTPUT ROUTINE
PJOBN:	IDIVI	JOB,12
	HRLM	C,(P)
	SKIPE	JOB
	PUSHJ	P,PJOBN
	HLRZ	C,(P)
	MOVEI	C,60(C)
	OUTCHR	C
	POPJ	P,

PDP:	IOWD	10,PDL
PDL:	BLOCK	10
	END	REATTA