;;;   -*-MIDAS-*-
;;;   **************************************************************
;;;   ***** MACLISP ****** HAIRY STATUS FUNCTIONS ******************
;;;   **************************************************************
;;;   ** (C) COPYRIGHT 1981 MASSACHUSETTS INSTITUTE OF TECHNOLOGY **
;;;   ****** THIS IS A READ-ONLY FILE! (ALL WRITES RESERVED) *******
;;;   **************************************************************

SUBTTL	INTERPRETER FOR STATUS SERIES

STATER:	MOVEI B,(AR2A)
	MOVEI A,(F)
	PUSHJ P,CONS
	FAC [ILLEGAL REQUEST!]

SSTATUS:
	SKIPA F,CQSSTATUS	;FEXPR
STATUS:	MOVEI F,QSTATUS		;FEXPR
	MOVEI AR2A,(A)
	JUMPE A,STATER
	HLRZ A,(A)		;FIRST ARG IS FUNCTION NAME
	PUSHJ P,STLOOK		;LOOK IT UP IN ASCII TABLE
	 JRST STATER
	CAIE F,QSTATUS		;STATUS OR SSTATUS?
	 ADDI R,STBSS-STBS
	ADDI R,STBS
	MOVE D,(R)		;GET TABLE ENTRY
	LSH D,13
	ASH D,-12
	TLO D,1
	HRRI D,(F)
	MOVEM D,SWNACK		;HACK FOR ARGS CHECKING
	MOVEI A,(AR2A)
	MOVEI TT,SWNACK
	JRST FWNACK
;RETURN HERE FROM FWNACK IF ARGS OKAY
STAT1:	HRRZ A,(A)		;CDR ARGS LIST
	HRLI R,410200
	PUSH FXP,R		;BYTE POINTER TO ARGS DESCRIPTORS
	PUSH FXP,R70		;COUNTER FOR ARGS
STAT2:	JUMPE A,STAT6		;JUMP IF NO MORE ARGS
	PUSH P,A
	HLRZ A,(A)		;ELSE GET NEXT ARG
	ILDB T,-1(FXP)		;GET ARG DESCRIPTOR
	JRST .+1(T)
	 JRST STAT6		;0  END OF ARGS
	 JRST STAT3		;1  QUOTED ARG
	 JRST STAT8		;2  QUOTED LIST OF REST
	PUSHJ P,EVAL		;3  EVALUATED ARG
STAT3:	EXCH A,(P)		;LEAVE ARG ON PDL
	HRRZ A,(A)
	SOS T,(FXP)		;COUNT ARGS
	CAML T,XC-4		;NO MORE THAN FOUR ALLOWED
	 JRST STAT2		; (UNLESS IT IS AN LSUBR)
	MOVSI TT,020000		;FOR AN LSUBR, ARRANGE FOR
	ADDB TT,-1(FXP)		; THE LAST ARG SPEC TO BE REUSED
	LDB TT,[410300,,(TT)]	;SEE WHETHER IT'S REALLY AN LSUBR
	CAIE TT,1
	 CAIN TT,3
	  JRST STAT2
STAT6:	POP FXP,T		;-<# OF ARGS>
	POP FXP,F		;RH IS ADDRESS OF TABLE ENTRY
	LDB TT,[410300,,(F)]	;GET STATUS SUBR DISPATCH TYPE
STAT6A:	HRRZ D,(F)
	JRST STAT7(TT)

STAT7:	JSP R,PDLA2(T)		;0  SUBR-TYPE FUNCTION
	JRST (D)		;1  LSUBR-TYPE FUNCTION
	JRST STSCH		;2  SUBR-TYPE WITH CHAR ARG
	JRST STSCH		;3  LSUBR-TYPE WITH CHAR ARG
	JRST STSGVAL		;4  GET LISP VALUE
	JRST STSSVAL		;5  SET LISP VALUE
	JRST STSSTNIL		;6  SET TO T-OR-NIL
	MOVE TT,(D)		;7  GET FIXNUM VALUE
	JRST FIX1

STAT8:	MOVE A,(P)
	SETZM (P)
	JRST STAT3

STSGVAL:	HRRZ A,(D)
CQSSTATUS:	POPJ P,QSSTATUS

STSSVAL:	POP P,A
	JSP T,PDLNMK
STSSV1:	MOVEM A,(D)
	POPJ P,

STSSTNIL:	POP P,A
	PUSHJ P,NOTNOT
	JRST STSSV1

STLOOK:	PUSHJ P,PNGET		;LOOK UP 5 CHARS IN TABLE
	HLRZ A,(A)		;F SAYS WHETHER STATUS OR SSTATUS
	MOVE TT,(A)		;SKIP ON SUCCESS, LEAVING POINTER IN R
	MOVSI R,-LSTBA
	CAIE F,QSTATUS
	 MOVSI R,-LSSTBA
STLK1:	CAMN TT,STBA(R)
	 JRST POPJ1
	AOBJN R,STLK1
	POPJ P,

STSCH:	PUSH FXP,F
	PUSH FXP,T
	ADDI T,1(P)
	HRRZ A,(T)
	JSP T,SPATOM
	 JRST STSCH1
	PUSHJ P,PNGET
	HLRZ A,(A)
	MOVE TT,(A)
	LSH TT,-35
	JSP T,FXCONS
	JRST STSCH2

STSCH1:	PUSHJ P,EVAL
	JSP T,FXNV1
STSCH2:	MOVE T,(FXP)
	ADDI T,1(P)
	HRRM A,(T)
	POP FXP,T
	POP FXP,F
	LDB TT,[410300,,(F)]
	SUBI TT,2
	JRST STAT6A

SUBTTL STATUS FEATURES FEATURE NOFEATURE, SSTATUS, ARRAY

SNOFEATURE:
	PUSH P,CNOT
SFEATURE:
	HRRZ B,FEATURES
	JUMPE A,BRETJ
	HLRZ A,(A)
	PUSHJ P,MEMQ1
	JRST NOTNOT

SSFEATURE:
	PUSH P,A
	HRRZ B,FEATURES
	PUSHJ P,MEMQ1
	JUMPN A,SSFEA2
	HRRZ A,(P)
	HRRZ B,FEATURES
	PUSHJ P,CONS
SSFEA1:	MOVEM A,FEATURES
SSFEA2:	JRST POPAJ

SSNOFEATURE:
	PUSH P,A
	HRRZ B,FEATURES
	PUSHJ P,.DELQ
	JRST SSFEA1

SSSSLU:	POP P,A
	PUSHJ P,STLOOK
	 JRST FALSE
	JRST TRUE

SSSSS:	SKIPA F,CQSSTATUS
SSSS:	 MOVEI F,QSTATUS
	JUMPN T,SSSSLU
	PUSH P,R70
	CAIN F,QSTATUS
	 SKIPA F,[-LSTBA,,]
	  MOVSI F,-LSSTBA
SSSSS1:	MOVE T,STBA(F)
	MOVEM T,PNBUF
	SETOM LPNF
	MOVEI C,PNBUF
	PUSHJ P,RINTERN
	MOVE B,(P)
	PUSHJ P,CONS
	MOVEM B,(P)
	AOBJN F,SSSSS1
	JRST POPAJ

;STATUS ARRAY RETURNS A LIST OF FOUR NUMBERS:
;  <MIN # OF DIMS> <MAX # OF DIMS> <MIN AXIS LENGTH> <MAX AXIS LENGTH>
;THE LIST IS FRESHLY CONSED ON EACH CALL, AND MAY BE DESTRUCTIVLY MODIFIED
SARRAY:	SETZ B,			;START WITH NIL
	MOVEI TT,777777		;APPROXIMATION OF MAXIMUM AXIS LENGTH
	JSP T,FXCONS
	JSP T,%CONS
	MOVEI B,IN1
	JSP T,%XCONS
	MOVEI B,IN5
	JSP T,%XCONS
	MOVEI B,IN1
	JRST XCONS		;CONS UP FINAL NUMBER THEN RETURN

SUBTTL	STATUS +, STATUS CHTRAN, STATUS SYNTAX


SSPLSS:	MOVEI C,RD8N
	SKIPE A
	 MOVEI C,RD8W
	MOVEM C,RDOBJ8
SPLSS:	MOVE A,RDOBJ8
	SUBI A,RD8N
	JRST NOTNOT

SCHTRAN:
	SKIPA F,[SKIPA TT,(TT)]
SSYNTAX:
NW%	 MOVSI F,(HLRZ TT,(TT))
NW$	 MOVE F,[LDB TT,[113300+TT,,0]]
	PUSH P,CFIX1
	SETZ AR1,		;CROCK
	JRST SSSYN1

SUBTTL	STATUS TTY, SSTATUS TTY


;;; (STATUS TTY <FILE>) RETURNS A LIST OF NUMBERS CONCERNING THE TTY:
;;;	FOR ITS:  (<TTYST1> <TTYST2> <TTYSTS>)
;;;	FOR D10:  (<GETLCH WORD> <FILE STATUS>)
;;;	FOR SAIL:     ( <GETLIN WORD> 
;;; 			<FILE STATUS> 
;;; 			<SETACT 1> <SETACT 2> <SETACT 3> <SETACT 4>  )
;;;	FOR D20:      ( <CCOC 1> <CCOC 2> 
;;; 			<JFN MODE WORD> 
;;; 			<DEFERRED INTERRUPT CHARS MASK>
;;;			<TERMINAL-CAPABILITIES-WORD>	;for VTS systems
;;; 			<TERMINAL-MODE-WORD> )
;;; RETURNS NIL IF <FILE> IS OMITTED AND THE JOB DOES NOT POSSESS A 
;;; 	CONTROLLING TTY.

STTY:	JUMPN T,STTY1
;TEST TO SEE WHETHER WE POSSESS A CONTROLLING TTY
IFN ITS,[
	.SUSET [.RTTY,,TT]	;FOR ITS, SEE IF THIS JOB HAS THE TTY
	JUMPL TT,FALSE		.SEE %TBNOT
]		;END OF IFN ITS
IFN D10,[
IFN SAIL,[
	GETLN D,		;RETURNS ZERO IF JOB IS DETACHED
	 JUMPN D,FALSE
]		;END OF IFN SAIL
IFE SAIL,[
	GETLIN D,		;FOR D10, LH OF GETLIN WORD ZERO
	TLNN D,-1		; MEANS JOB IS DETACHED
	 JRST FALSE
]		;END OF IFE SAIL
]		;END OF IFN D10
IFN D20,[
	LOCKI
	GJINF			;FOURTH RETURNED VALUE IS -1 FOR
	MOVE T,4
	SETZB 1,2		; A DETACHED JOB
	SETZB 3,4
	UNLOCKI
	AOJE T,FALSE
]		;END OF IFN D20
	SKIPA AR1,V%TYI
STTY1:	 POP P,AR1
IFN SFA,[
	JSP TT,XFOSP
	 JRST STTY1A
	 JRST STTY1A
	MOVEI B,QTTY
	JRST STSCN0
STTY1A:	]	;END IFN SFA
	PUSHJ P,TFILOK		;SAVES D (FOR SAIL), DOES A LOCKI, TTSAR IN TT
	POP FXP,T		;POP THE LOCKI WORD
IFN ITS,[
	.CALL TTYGET		;GET THREE VALUES IN D, R, F
	 .LOSE 1400
	PUSH FXP,D		;TTYST1
	PUSH FXP,R		;TTYST2
	PUSH FXP,F		;TTYSTS
ZZZ==3
]		;END OF IFN ITS
IFN D10,[
	PUSHJ P,D10TNM		;RETURNS APPROPRIATE TERMINAL NUMBER IN D
SA%	GETLCH D
SA$	GETLIN D
	PUSH FXP,D
	SKIPL F.MODE(TT)	.SEE FBT.CM
	 JRST STTY3
	MOVSI R,(SIXBIT \TTY\)	;FOR THE REGULAR TTY,
	SETZB D,F		; OPEN A TEMPORARY CHANNEL
	OPEN TMPC,D		; SO CAN GET THE CHANNEL STATUS
	 HALT
	GETSTS TMPC,D
	RELEASE TMPC,
	JRST STTY4

STTY3:	MOVE R,F.CHAN(TT)	;FOR ANY OTHER TTY, USE THE EXISTING CHANNEL
	LSH R,27
	IOR R,[GETSTS 0,D]
	XCT R
STTY4:	PUSH FXP,D
IFE SAIL, ZZZ==2
IFN SAIL,[
	PUSHN FXP,4
	MOVSI D,-3(FXP)
	SETACT D		;GET FOUR ACTIVATION WORDS
ZZZ==6
]		;END OF IFN SAIL
]		;END OF IFN D10
IFN D20,[
	HRRZ 1,F.JFN(TT)
	RFCOC			;READ CCOC WORDS
	PUSH FXP,2		;CCOC1
	PUSH FXP,3		;CCOC2
	RFMOD			;READ JFN MODE WORD FOR TERMINAL
	PUSH FXP,2
	MOVE 1,[RT%DIM,,.FHSLF]
	RTIW			;READ DEFERRED INTERRUPT WORD
	PUSH FXP,3
	PUSH FXP,R70
	PUSH FXP,R70
	SKIPN VTS20P
	 JRST STTY6
	HRRZ 1,F.JFN(TT)
	RTCHR
	 ERJMP STTY6
	MOVEM 2,-1(FXP)
	RTMOD
	MOVEM 2,(FXP)
STTY6:	SETZB B,C
ZZZ==6
]		;END OF IFN D20
	PUSH FXP,T		;LOCKI WORD
	UNLOCKI
	PUSHJ P,CONS1PFX
REPEAT ZZZ-2, PUSHJ P,CONSPFX
	JRST CONSPFX
EXPUNGE ZZZ


;;; (SSTATUS TTY <NUM1> <NUM2> ... <NUMN> <TTY>) SETS THE
;;; TTY STATUS WORDS FOR <TTY> (WHICH MAY BE OMITTED).
;;; ANY PARAMETERS WHICH ARE OMITTED OR NIL ARE NOT CHANGED.

SSTTY:
IFE SFA,[
	HRRZ AR1,(P)		;LSUBR
	CAIN AR1,TRUTH		;LAST ARG T => DEFAULT TTY
	 MOVE AR1,V%TYI
	JSP TT,XFILEP		;SEE IF LAST ARG IS A TTY
	 SKIPA AR1,V%TYI	;IF NOT, WE USE THE DEFAULT
	  AOSA D,T		;IN ANY CASE, PUT ADJUSTED NUMBER
	   SKIPA D,T		; OR ARGUMENTS IN D
	    POPI P,1		; AND ADJUST THE STACK
]	;END OF IFE SFA
IFN SFA,[
	POP P,AR1 		;LAST ARG T => DEFAULT TTY
	AOS D,T
	CAIN AR1,TRUTH
	 MOVE AR1,V%TYI
	JSP TT,XFOSP
	 JRST [ PUSH P,AR1	
		MOVE AR1,V%TYI	;OOPS, NOT A FILE, SO RE-CORRECT FOR LAST ARG
		SOJA D,SSTTY0 ]
	 JRST SSTTY0
	PUSHJ FXP,LISTX		;LISTIFY THE ARGS
	MOVE C,A
	MOVEI B,QTTY
	JRST STSCN2
]	;END OF IFN SFA
SSTTY0:	SKIPN F,D		;NO ARGUMENTS MEANS CHANGE NOTHING
	 JRST TRUE
	MOVE R,FXP		;SAVE CURRENT LEVEL OF FXP
SSTTY1:	POP P,A			;FOR EACH ARGUMENT
	SKIPE A			; WE PUSH TWO
	 JSP T,FXNV1		; WORDS ONTO FXP:
	PUSH FXP,TT		; THE FIRST IS THE NUMERIC VALUE, IF ANY,
	PUSH FXP,A		; AND THE SECOND IS ZERO IF THE ARG WAS NIL
	AOJL D,SSTTY1
;BECAUSE THE ARGUMENTS WERE POPPED OFF P IN REVERSE ORDER,
; THEY CAN NOW BE POPPED OFF FXP IN THE CORRECT ORDER.
;F HAS THE NEGATIVE OF THE NUMBER OF ARGUMENTS.
	PUSH P,R		;NOW SAVE OLD FXP ON STACK
IT%	PUSHJ P,TFILOK		;DOES A LOCKI, SAVES F
IT$	PUSHJ P,TIFLOK		;FOR ITS, WE ARE SETTING INPUT PARAMETERS
	POP FXP,AR2A		;POP LOCKI WORD
IFN ITS,[
	POP FXP,T
	POP FXP,D
	SKIPN T
	 SKIPA D,TI.ST1(TT)	;GET COPY OF THE OLD VALUE IF NOT SETTING NEW
	  MOVEM D,TI.ST1(TT)	;UPDATE TTYST1 WORD
	AOJE F,SSTTY3		;JUMP IF NO MORE ARGUMENTS
	POP FXP,T
	POP FXP,R
	SKIPN T
	 SKIPA R,TI.ST2(TT)
	  MOVEM R,TI.ST2(TT)	;UPDATE TTYST2 WORD
	AOJE F,SSTTY3		;JUMP IF NO MORE ARGUMENTS
	POP FXP,T
	POP FXP,F
	JUMPE T,SSTTY3		;NULL THIRD ARG, THEN NEEDN'T DO HAIRIER CALL
	.CALL TTYSAC		;THREE WORDS ARE IN D, R, F
	 .LOSE 1400
	JRST SSTTY2

SSTTY3:	.CALL TTY2ST		;SET JUST TTYST1, TTYST2
	 .LOSE 1400
]		;END OF IFN ITS
IFN D10,[
	POP FXP,D
	POP FXP,T
	JUMPE D,SSTTY7
IFE SAIL,[
	PUSHJ P,D10TNM
	CAMN D,XC-1
	 GETLCH D
	HRRI T,(D)
	SETLCH T
]		;END OF IFE SAIL
IFN SAIL,[
	SKIPL F.MODE(TT)	.SEE FBT.CM
	 SETLIN T
]		;END OF IFN SAIL
SSTTY7:	AOJE F,SSTTY2
	POP FXP,D
	POP FXP,T
	JUMPE D,SSTTY4		;FOR NULL ARG, FORGET THE FOLLOWING HAIR
	SKIPL F.MODE(TT)	.SEE FBT.CM
	 JRST SSTTY3
	PUSH FXP,F
	MOVSI R,(SIXBIT \TTY\)
	SETZB D,F
	OPEN TMPC,D		;OPEN A TEMP CHANNEL FOR THE TTY
	 HALT
	SETSTS TMPC,T		;SET THE STATUS
	RELEASE TMPC,
	POP FXP,F
	JRST SSTTY4

SSTTY3:	MOVE R,F.CHAN(TT)
	LSH R,27
	IOR R,[SETSTS 0,T]
	XCT R
SSTTY4:
IFN SAIL,[
	AOJE F,SSTTY2		;JUMP IF NO MORE ARGS
IRPC X,,[1234]
	POP FXP,D
	POP FXP,T
	SKIPE D
	 MOVEM T,TI.ST!X(TT)	;UPDATE ACTIVATION WORD X
IFSN X,4, AOJE F,SSTTY5
TERMIN
SSTTY5:	MOVEI T,TI.ST1(TT)
	SETACT T
]		;END OF IFN SAIL
]		;END OF IFN D10
IFN D20,[
	HRRZ 1,F.JFN(TT)	;GET JFN FOR SUBSEQUENT JSYS'S
	POP FXP,T
	POP FXP,D
	SKIPE T
	 MOVEM D,TI.ST1(TT)	;UPDATE CCOC1
	MOVE D,T
	AOJE F,SSTTY3		;JUMP IF NO MORE ARGUMENTS
	POP FXP,T
	POP FXP,R
	SKIPE T
	 MOVEM R,TI.ST2(TT)	;UPDATE CCOC2
	IOR D,T
SSTTY3:	JUMPE D,SSTTY4		;JUMP IF NO CHANGE TO CCOC'S
	MOVE 2,TI.ST1(TT)
	MOVE 3,TI.ST2(TT)
	SFCOC			;SET CCOC'S
SSTTY4:	AOJGE F,SSTTY2		;JUMP IF NO MORE ARGUMENTS
	POP FXP,D
	POP FXP,2
	JUMPE D,.+3
	 MOVEM 2,TI.ST3(TT)
	 SFMOD			;UPDATE JFN MODE WORD
	AOJE F,SSTTY2
	POP FXP,D
	POP FXP,3		;DEFERRED TERMINAL INTERRUPT MASK
	JUMPE D,.+5
	 MOVEM 3,TI.ST4(TT)
	 MOVE 1,[ST%DIM,,.FHSLF]
	 MOVE 2,[STDTIW]		;STANDARD TERMINAL INTERRUPT WORD
	 STIW				;SET TERMINAL INTERRUPT WORDS
	AOJGE F,SSTTY2			;JUMP IF NO MORE ARGUMENTS
	POP FXP,D
	POP FXP,2
	;; 	;; TERMINAL-CHARACTERISTICS-WORD -- CANT REALLY CHANGE IT
	AOJGE F,SSTTY2		;JUMP IF NO MORE ARGUMENTS
	POP FXP,D
	POP FXP,2
	JUMPE D,SSTTY2
	MOVEM 2,TI.ST6(TT)
	STMOD			;UPDATE TERMINAL MODE WORD
]		;END OF IFN D20
SSTTY2:	POP P,FXP		;RESTORE FXP
	PUSH FXP,AR2A		;PUSH BACK LOCKI WORD
20$	SETZB B,C		;CLEAR JUNK OUT OF AC'S
	JRST UNLKTRUE

IFN ITS,[

TTY2ST:	SETZ
	SIXBIT \TTYSET\		;SET TTY VARIABLES
	      ,,F.CHAN(TT)	;CHANNEL #
	      ,,TI.ST1(TT)	;TTYST1
	400000,,TI.ST2(TT)	;TTYST2

]		;END OF IFN ITS


SFRET:	CAIN B,QBPS		;FIGURE OUT SPACE TYPE
	 JRST 1(R)		;BPS => SKIP 1
	CAIN B,QRANDOM		;BAD SPACE TYPE => SKIP 0
	 JRST (R)		;LIST, FIXNUM, FLONUM, BIGNUM,
	CAIN B,QARRAY		; SYMBOL, SAR => SKIP 2
	 MOVEI B,QRANDOM
	CAIL B,QLIST
	 CAILE B,QRANDOM
	  JRST (R)
   2DIF [HRREI TT,(B)]-NFF,QLIST
	JRST 2(R)

SUBTTL STATUS UUOLI, SSTATUS UUOLI, STATUS IOC, STATUS CLI, SSTATUS CLI

SUUOLINKS:
IFE PAGING,[
	SKIPN T,LDXSIZ
	 JRST FALSE		;RETURN NIL IF NO XCT HACKERY HAS BEEN DONE
	SETZB TT,D		;ZERO COUNTER
	TLNE T,400000
	 MOVEI D,TRUTH		;D GETS TRUE IF PURIFIED
	MOVNS T			;MAKE UP AOBJN POINTER FOR XCT CALL AREA 2
	HLL T,LDXBLT
	MOVSS T
SUUOL1:	SKIPN (T)		;COUNT FREE CELLS IN XCT CALL AREA
	 AOS TT
	AOBJN T,SUUOL1
	JSP T,FIX1A	;RETURN LIST OF PURE FLAG AND COUNT
	PUSHJ P,NCONS
	MOVE B,D
	JRST XCONS
]		;END IFE PAGING
IFN PAGING,[
	SKIPN LDXPNT		;IF NO XCT PAGES
	 JRST FALSE		; RETURN FALSE
	MOVN TT,LDXLPC		;GET NUMBER OF FREE SLOTS IN LAST SEGMENT
	JSP T,FIX1A
	PUSHJ P,NCONS
	MOVEI B,NIL
	SKIPE LDXPFG		;PURIFIED?
	 MOVEI B,TRUTH
	JRST XCONS
]		;END IFN PAGING

SSUUOLINKS:
	MOVE A,USENDI
	PUSHJ P,SSSENDI		;Re-init SENDI hook and friends
	MOVE A,UUSRHNK
	PUSHJ P,SSUSRHUNK
	MOVE A,UCALLI
	PUSHJ P,SSCALLI
IFE PAGING,[
	SKIPN TT,LDXBLT		;ZAP CALLS FOR XCTS WITH A BLT
	  JRST FALSE
	MOVEI T,(TT)
	ADD T,LDXSM1
	BLT TT,(T)
	JRST TRUE
]		;END IFE PAGING
IFN PAGING,[
	SKIPN T,LDXPNT		;LOOP OVER ALL XCT SEGMENTS
	 JRST FALSE
SSUUL1:	JUMPE T,TRUE		;RETURN TRUE WHEN DONE
	HRRZI TT,LDXOFS(T)	;TARGET ADR
	HRL TT,LDXPSP(T)	;ADR-OFFSET TO GET DATA FROM
	ADD TT,[LDXOFS,,0]	;MAKE INTO SOURCE ADR
	BLT TT,SEGSIZ-1(T)	;RECOPY LINK AREA
	HLRZ T,LDXPSP(T)	;LINK TO NEXT PAGE
	JRST SSUUL1
]		;END IFN PAGING

IFN USELESS*ITS,[
SCLI:	MOVEI T,%PICLI		;TEST TO SEE IF THIS BIT IS ON (IN IMASK)
	TDNN T,IMASK		;IF ON, RETURN T, ELSE RETURN NIL
	 JRST FALSE
	JRST TRUE

SSCLI:	MOVEI T,%PICLI
	MOVEI TT,IMASK
	SKIPN A			;ON OR OFF?
	 TLOA TT,(ANDCAM T,)	;OFF, USE ANDCAM
	  HRLI TT,(IORM T,)	;ON, USE IORM
	XCT TT			;MODIFY LISP'S MASK
	SKIPN A
	 TLOA T,(TRZ)
	  TLO T,(TRO)
	.CALL CLIVAR
	 .LOSE 1400		;BAD NEWS....
	JUMPN A,TRUE
	POPJ P,

CLIVAR:	SETZ
	SIXBIT \USRVAR\
	MOVEI %JSELF
	MOVEI .RMASK
	MOVEI
	SETZ T
]		;END IFN USELESS*ITS

SNOINT:	SKIPN A,UNREAL		   ;Check out UNREAL
	  JRST CPOPJ		   ;  NIL
	JUMPL A,TRUE		   ;-1 = T
	POPJ P,			   ;Else QTTY, just return it


SUBTTL	STATUS TIME, DATE, UNAME, USERID, JNAME, JNUMBER, SUBSYSTEM

IFN ITS,[

STIME:	.RTIME TT,
	JRST SDATE+1

SDATE:	.RDATE TT,
	AOJE TT,FALSE
	MOVE D,TT
	SUB D,[202020202021]	;21 ADJUSTS FOR THE AOJE
	JSP F,STCVT
	JSP F,STCVT
	JSP F,STCVT
	MOVNI T,3
	JRST LIST

STCVT:	SETZB TT,R
	LSHC TT,6
	IMULI TT,10.
	ROTC D,6
	ADD TT,R
	JSP T,FXCONS
	PUSH P,A
	JRST (F)

SRCDIR:	SKIPE A,SUDIR		;STATUS FOR "READ-CONNECTED-DIRECTORY"
	 POPJ P,
	MOVE TT,IUSN
	PUSHJ P,SIXATM
	MOVEM A,SUDIR
	POPJ P,

SUNAME:	.SUSET [.RUNAME,,TT]
	JRST SIXATM

SUSERID:
	.SUSET [.RXUNAME,,TT]
	JRST SIXATM

SJNAME:	.SUSET [.RJNAME,,TT]
	JRST SIXATM

SSUBSYSTEM:
	.SUSET [.RXJNAME,,TT]
	JRST SIXATM

SJNUMBER:
	.SUSET [.RUIND,,TT]
	JRST FIX1

SHOMEDIR:
	.SUSET [.RHSNAME,,TT]
	JRST SIXATM

SHSNAME:			;NEW HAIRY READ HSNAME
	JUMPE T,SHOMEDIR	;NO ARGS, SAME AS (STATUS HOMEDIR)
	PUSH FXP,T		;SAVE NUMBER OF ARGS OVER SUPERIOR CHECK
	JSP T,SIDDTP		;IS THERE A DDT ABOVE US?
	 JRST SHSNA2		;NOPE...
	POP FXP,T
	SETZ TT,		;ASSUME NULL ITS NAME
	AOJE T,SHSNA1		;ITS ARG GIVEN?
	POP P,A			;YES, GET THE ITS NAME
	PUSHJ P,SIXMAK		;GET SIXBIT INTO TT
SHSNA1:	PUSH FXP,TT		;SAVE THE ITS NAME
	POP P,A
	PUSHJ P,SIXMAK		;CONVERT UNAME TO SIXBIT
	PUSH FXP,TT		;STORE THAT ON FXP ALSO
	MOVEI TT,-1(FXP)	;POINTER TO FIRST WORD
	HRLI TT,..RHSNAME	;FOR .BREAK 12,
	.BREAK 12,TT		;READ THE HSNAME FROM DDT
	POP FXP,TT		;NOW CONVERT TO AN ATOM
	PUSHJ P,SIXATM
	POPI FXP,1		;REMOVE EXTRA WORD FROM STACK
	POPJ P,			;THEN RETURN
SHSNA2:	POP FXP,T		;RESTORE NUMBER OF ARGS
	MOVNS T
	SUB P,R70(T)		;REMOVE THE APPROPRIATE NUMBER OF WORDS FROM P
	SETZ A,			;RETURN NIL
	POPJ P,
]	;END OF IFN ITS

IFE ITS,[
SHSNAME:			;HSNAME IS SIMPLY HOMEDIR
	MOVNS T
	SUB P,R70(T)		;REMOVE THE APPROPRIATE NUMBER OF WORDS FROM P
20$ 	JRST SUSERID
20%	MOVE A,SUDIR
20%	POPJ P,
]	;END IFE ITS
IFN D10,[
IFE SAIL,[
SDATE:	MOVE R,[%CNYER]
	MOVE D,[%CNMON]
	MOVE TT,[%CNDAY]
	GETTAB R,
	 JRST FALSE
	SUBI R,1900.
	JRST STIM2

STIME:	MOVE R,[%CNHOR]
	MOVE D,[%CNMIN]
	MOVE TT,[%CNSEC]
	GETTAB R,
	 JRST FALSE
STIM2:	GETTAB D,
	 JRST FALSE
	GETTAB TT,
	 JRST FALSE
	PUSHJ P,CONS1FX
	MOVE TT,D
	PUSHJ P,CONSFX
	MOVE TT,R
	JRST CONSFX

SSUBSYSTEM:
	HRROI TT,.GTPRG		;GET PROGRAM NAME FOR MYSELF
	GETTAB TT,
	 JRST FALSE
	JRST SIXATM
]		;END OF IFE SAIL
IFN SAIL,[
SDATE:	DATE D,			;DATE IN D = <<YEAR-1964.>*12.+MONTH-1>*31.+DAY-1
	IDIVI D,31.		;REMAINDER IN R IS DAYS-1
	AOJ R,
	MOVE T,R
	IDIVI D,12.		;REMAINDER HERE IS MONTH-1
	AOJ R,
	ADDI D,64.		;QUOTIENT IN D IS YEAR-1964.
	PUSH FXP,D
	PUSH FXP,R
	PUSH FXP,T
	JRST STIM2

STIME:	TIMER TT,		;GET TIME IN TT
	IDIVI TT,60.		;REDUCE TO SECONDS
	IDIVI TT,60.		;NOW GET SECONDS AS A REMAINDER
	MOVE R,D
	IDIVI TT,60.		;REMAINDER IS MINUTES
	PUSH FXP,TT
	PUSH FXP,D		;REST IS HOURS
	PUSH FXP,R
STIM2:	PUSHJ P,CONS1PFX	;START A LIST WITH NUMBER ON FXP
	PUSHJ P,CONSPFX		;ADD FIXNUM TO LIST
	JRST CONSPFX		;ADD THIRD FIXNUM TO LIST

SSUBSYSTEM:
	SETO TT,
	GETNAM TT,		;GET (GENERIC?) NAME OF JOB
	JRST SIXATM
]		;END OF IFN SAIL

SJNAME:	MOVE TT,D10NAM
	JRST SIXATM

SJNUMBER:	PJOB TT,	;GET JOB NUMBER
	JRST FIX1

SUSERID:
IFE SAIL,[
	HRROI TT,.GTNM1		;GET USER NAME FOR THIS JOB
	GETTAB TT,
	 JRST SUNAME
	HRROI D,.GTNM2
	GETTAB D,
	 HALT			;HOW CAN THIS LOSE?
	JUMPE TT,SUNAME
	SETOM LPNF		;CONVERT TWO WORDS OF SIXBIT
	MOVE C,PNBP		; TO ASCII IN PNBUF
SUSER1:	LDB T,[360600,,TT]
	ADDI T,40
	IDPB T,C
	LSHC TT,6
	JUMPN TT,SUSER1
	PUSHJ FXP,RDAEND
	JRST RINTERN		;MAKE IT AN ATOMIC SYMBOL
]		;END OF IFE SAIL
SUNAME:	GETPPN TT,		;PPNATM EXPECTS PPN IN TT
	JFCL
	JRST PPNATM
]		;END OF IFN D10

IFN D20,[

STIME:	PUSHJ P,SDATIM		;RETURNS TIME IN F
	MOVEI TT,(F)
	IDIVI TT,60.		;REMAINDER IS SECONDS
	MOVE R,D
	IDIVI TT,60.		;THIS YIELDS HOURS AND MINUTES
	EXCH TT,R
STIME1:	PUSHJ P,CONS1FX		;CONS R, D, TT INTO A LIST OF FIXNUMS
	MOVE TT,D
	PUSHJ P,CONSFX
	MOVE TT,R
	JRST CONSFX

SDATE:	PUSHJ P,SDATIM		;RETURNS DATE IN D AND R
	HLRZ TT,R		;DAY-1
	HLRZ R,D		;YEAR
	SUBI R,1900.		;REDUCE IT TO A YEAR MOD 100.
	MOVEI D,1(D)		;MONTH
	AOJA TT,STIME1		;INCREMENT DAY-1 TO DAY, AND GO CONS

SDATIM:	LOCKI			;PREVENT JUNK IN AC'S FROM CAUSING TROUBLE
	SETO 2,			;CURRENT TIME
	SETZ 4,
	ODCNV			;GET TIME AND DATE INFORMATION
	MOVE D,2		;RETURN INFORMATION IN D, R, F
	MOVE R,3
	MOVE F,4
	SETZB 1,2		;PREVENT TROUBLE AFTER UNLOCKI
	SETZB 3,4
	UNLKPOPJ

SJNAME:				;?
SSUBSYSTEM:
	LOCKI
	GETNM			;GET PROGRAM NAME
	MOVE TT,1
	SETZ 1,
	UNLOCKI
	JRST SIXATM

SRCDIR:	JSP T,TNXUDI
	JRST PNBFAT

SUSERID:			;?
SUNAME:	LOCKI
	MOVE TT,[PNBUF,,PNBUF+1]
	SETZM PNBUF		;CLEAR PNBUF
	BLT TT,PNBUF+LPNBUF-1
	GJINF			;GET JOB INFORMATION
	MOVE 2,1		;1 HAS LOGIN DIRECTORY NUMBER
	MOVE 1,PNBP
	DIRST			;GET EQUIVALENT ASCII STRING
	 HALT			;BETTER NOT FAIL...
	SETZB 1,2
	UNLOCKI
	JRST PNBFAT		;MAKE ASCII STRING AN ATOM

SJNUMBER:
	LOCKI
	GJINF			;GET JOB INFORMATION
	MOVE TT,3		;JOB NUMBER
	SETZB 1,2
	UNLOCKI
	JRST FIX1

]		;END OF IFN D20

SUBTTL	STATUS LINMODE


SSLINMODE:
	CAMN T,XC-1
	 SKIPA AR1,[TTYIFA]	;IF NOT, WE USE THE DEFAULT
	  POP P,AR1
	POP P,A
IFN SFA,[
	JSP TT,XFOSP
	 JRST SSLMN1
	 JRST SSLMN1
	MOVEI AR2A,QLINMO
	JRST SSTSC2
SSLMN1:	]	;END IFN SFA
	PUSHJ P,TIFLOK		;DOES A LOCKI
	MOVE T,F.MODE(TT)
	SKIPN A
IFN ITS,[
ZZX==<%TG<ACT>>*010101010101		;6 %TGACT BITS
	 SKIPA R,[STTYW1&ZZX]		;PUT APPROPRIATE ACTIVATION
	  SKIPA R,[STTYL1&ZZX]		; BITS IN R AND F
	   SKIPA F,[STTYW2&ZZX]
	    SKIPA F,[STTYL2&ZZX]
]		;END OF IFN ITS
IFN SAIL,[
	 SKIPA D,[[SACTW1 ? SACTW2 ? SACTW3 ? SACTW4],,]
	  SKIPA D,[[SACTL1 ? SACTL2 ? SACTL3 ? SACTL4],,]
]		;END OF IFN SAIL
IFN D20,[
	SKIPA 2,[XACTW]
	 SKIPA 2,[XACTL]
]	;END OF IFN D20	
	TLZA T,FBT.LN
	 TLO T,FBT.LN
	MOVEM T,F.MODE(TT)
IFN ITS,[
	MOVE D,[ZZX]
	ANDCAM D,TI.ST1(TT)
	IORM R,TI.ST1(TT)	;CLOBBER IN ONLY ACTIVATION BITS
	ANDCAM D,TI.ST2(TT)
	IORM F,TI.ST2(TT)
EXPUNGE ZZX
]		;END OF IFN ITS
IFN SAIL,[
	HRRI D,TI.ST1(TT)
	BLT D,TI.ST4(TT)	;UPDATE STATUS WORDS
	MOVEI T,TI.ST1(TT)
	SETACT T		;TELL THE SYSTEM ABOUT IT
]		;END OF IFN SAIL
IFN D20,[
	SKIPE TENEXP
	 JRST SSLMN2
	MOVEI T,TT%WAK
	ANDCAM T,TI.ST3(TT)
	IORB 2,TI.ST3(TT)
	MOVE AR2A,1		;FOO, HAVE TO SAVE THE STATE OF THE LINEMODE
	HRRZ 1,F.JFN(TT) 	; SWITCH, WHICH CURRENTLY IS IN ACC 1
	SFMOD			;CHANGES THE WAKE-UP/ACTIVATION SETTINGS
	MOVE 1,AR2A
SSLMN2:	SETZ 2,
]	;END OF IFN D20	
	UNLOCKI
	JRST NOTNOT


SUBTTL	STATUS DOW

IFN USELESS,[
IFN ITS,[

SDOW:	.RYEAR TT,
	AOJE TT,FALSE
	LSH TT,-31
	ANDI TT,16
	MOVE T,SDOWQX(TT)
	MOVEM T,PNBUF
	MOVE T,SDOWQX+1(TT)
	MOVEM T,PNBUF+1
	JRST PNBFAT

SDOWQX:
IRP DAY,,[SUNDAY,MONDAY,TUESDAY,WEDNESDAY,THURSDAY,FRIDAY,SATURDAY]
	ASCII \DAY\
TERMIN

]		;END OF IFN ITS

IFN D10,[

SDOW:
IFE SAIL,[
	MOVE T,[%CNDTM]		;INTERNAL FORMAT DATE,,TIME
	GETTAB T,
	 JRST FALSE
	HLRZS T
]		;END OF IFE SAIL
IFN SAIL,[
	DATE T,			;DATE IN T
	DAYCNT T,		;CONVERT TO NUMBER OF DAYS
]				;END OF IFN SAIL
;T NOW HAS NUMBER OF DAYS SINCE 1-JAN-64 (A WEDNESDAY)
	IDIVI T,7
	LSH TT,1
	MOVE T,SDOWQX(TT)
	MOVEM T,PNBUF
	MOVE T,SDOWQX+1(TT)
	MOVEM T,PNBUF+1
	JRST PNBFAT

SDOWQX:				;FUNNY ORDER FOR DEC-10
IRP DAY,,[WEDNESDAY,THURSDAY,FRIDAY,SATURDAY,SUNDAY,MONDAY,TUESDAY]
	ASCII \DAY\
TERMIN
]		;END OF IFN D10

IFN D20,[

SDOW:	PUSHJ P,SDATIM		;RH OF R GETS DAY OF WEEK (0 = MONDAY)
	LSH R,1
	MOVE T,SDOWQX(R)
	MOVEM T,PNBUF
	MOVE T,SDOWQX+1(R)
	MOVEM T,PNBUF+1
	JRST PNBFAT

SDOWQX:				;FUNNY ORDER FOR DEC-10
IRP DAY,,[MONDAY,TUESDAY,WEDNESDAY,THURSDAY,FRIDAY,SATURDAY,SUNDAY]
	ASCII \DAY\
TERMIN
]		;END OF IFN D20

]		;END OF IFN USELESS

SUBTTL	STATUS ABBREVIATE, STATUS MEMFREE


IFN USELESS,[
SABBREVIATE:
	MOVEI TT,LRCT-2
	HRRZ A,VREADTABLE
	HRRZ TT,@TTSAR(A)
	JRST FIX1

SSABBREVIATE:
	SKIPN TT,A
	 JRST SSABB1
	MOVEI TT,3
	CAIE A,TRUTH
	 JSP T,FXNV1
SSABB1:	MOVEI T,(TT)
	MOVEI TT,LRCT-2
	HRRZ B,VREADTABLE
	HRRM T,@TTSAR(B)
	JRST PDLNKJ
]		;END OF IFN USELESS



SMEMFREE:
PG$	MOVE TT,HINXM	;NUMBER OF WORDS IN HOLE
PG$	SUB TT,BPSH	;INTERRUPT HERE WOULD SCREW,
PG%	MOVE TT,MAXNXM
PG%	SUB TT,HIXM
	JRST FIX1	; WORRY, WORRY, WHO CARES

SUBTTL	STATUS SYSTEM
	
SSYST0:	WTA [SYMBOL REQUIRED - STATUS SYSTEM!]
SSYSTEM:			;(STATUS SYSTEM) ENTRY-POINT
	JSP T,SPATOM
	 JRST SSYST0
	JUMPE A,SSYST6
	CAIN A,TRUTH
	 JRST SSYST6
	MOVEI AR1,NIL
	MOVEI B,QSYMBOL		;CHECK FOR SYMBOL HEADER IN SYSTEM SPACE
	CAIE A,TRUTH
	  CAIN A,QUNBOUND
	    JRST SSYST2
	CAIL A,QRDQTE		;First system symbol, except for T and QUNBOUND
	 CAILE A,SYMSYL
	  JRST SSYST7		;NOT IN RANGE, CONTINUE CHECKING
SSYST2: EXCH A,AR1
	PUSHJ P,XCONS
	EXCH A,AR1
SSYST7:	MOVEI B,QVALUE
	HLRZ C,(A)
	HRRZ C,(C)
	CAIGE C,ESYSVC
	 JRST SSYST4
SSYST1:	MOVEI B,SSSBRL
	PUSHJ P,GETLA
	JUMPE A,AR1RETJ
	HLRZ B,(A)
	HRRZ A,(A)
	HLRZ C,(A)
	CAIE B,QAUTOLOAD
	JRST SSYST3
	CAIL C,BSYSAP		;IS IT A SYSTEM AUTOLOAD PROP?
	 CAIL C,ESYSAP
	  JRST SSYST1	;NOPE
	JRST SSYST4	;YUP
SSYST3:	CAIE B,QARRAY
	JRST SSYST5
	CAIL C,BSYSAR		;IS IT A SYSTEM ARRAY
	 CAIL C,ESYSAR
	  JRST SSYST1
	JRST SSYST4
SSYST5:	CAIL C,ENDFUN		;SUBR OR VC ADDRESS IN SYSTEM AREA
	 JRST SSYST1
SSYST4:	EXCH A,AR1		;A WIN, SO CONS UP THIS PROPERTY NAME
	PUSHJ P,XCONS
	EXCH A,AR1
	JRST SSYST1

SSYST6:	MOVEI A,QVALUE
	PUSHJ P,NCONS
	MOVEI B,QSYMBOL
	JRST XCONS

SUBTTL	STATUS GCTIME, LISPVERSION, TTYREAD, _, TERPRI, OPSYSTEM, SITE, FILESYSTEM

SSGCTIM:
	JSP T,FXNV1
IT$	LSH TT,-2
10$	IDIVI TT,1000.
20$	IDIVI TT,1000.
	EXCH TT,GCTIM
	JRST SGCTM1

SGCTIM:	MOVE TT,GCTIM
SGCTM1:	PUSH P,CFIX1		;FAKE OUT ENTRY INTO RUNTIME
	JRST RNTM1

SLVRNO:	MOVE TT,ALVRNO
	MOVEM TT,PNBUF
	MOVE C,[100700,,PNBUF]
	JRST RINTERN

SFILESYSTEM.TYPE: HLRZ A,FILEFT
	POPJ P,
SOPSYSTEM.TYPE: 
IT$ 	MOVEI A,QITS 
10$ SA$ MOVEI A,QSAIL 
10$ SA%	HLRZ A,OPSYFT
20$ 	HLRZ A,OPSYFT
	POPJ P,
SSITE:	HLRZ A,SITEFT
	POPJ P,

STTYREAD:	SKIPA TT,[LRCT-2]
SLAP:	HRROI TT,LRCT-1
SLAP1:	HRRZ A,VREADTABLE
	MOVE A,@TTSAR(A)
	SKIPL TT
	MOVSS A
	JRST RHAPJ


SSTTYREAD:	SKIPA R,[LRCT-2]
SSLAP:	HRROI R,LRCT-1
SSLAP1:	PUSHJ P,NOTNOT
	HRRZ D,VREADTABLE	;INTERRUPT COULD SCREW HERE (FOO)
	JSP T,.STOR0
	POPJ P,


SLINMOD:	MOVSI F,FBT<LN>
	SKIPN T
	 SKIPA AR1,[TTYIFA]	;IF NOT, WE USE THE DEFAULT
	  POP P,AR1
IFN SFA,[
	JSP TT,XFOSP
	 JRST SLMNO1
	 JRST SLMNO1
	MOVEI B,QLINMO
	JRST STSCN0
SLMNO1:	]	;END IFN SFA

	PUSHJ P,TIFLOK
	TDNN F,F.MODE(TT)
	 TDZA A,A
	  MOVEI A,TRUTH
	UNLKPOPJ


STERPRI:
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
IFN SFA,[
	JSP TT,XFOSP
	 JRST STERP2
	 JRST STERP2
	SETZ C,
STERP0:	MOVEI B,Q%TERPI
	JRST STSCN2
STERP2:]	;END IFN SFA
	PUSHJ P,TOFLOK
STERP1:	SKIPLE FO.LNL(TT)
	 TDZA A,A
	  MOVEI A,TRUTH
	UNLKPOPJ

SSTERPRI:
	CAMN T,XC-1
	 SKIPA AR1,V%TYO
	  POP P,AR1
IFN SFA,[
	JSP TT,XFOSP
	 JRST SSTER2
	 JRST SSTER2
	POP P,A
	PUSHJ P,NCONS
	MOVE C,A
	JRST STERP0
SSTER2:]	;END IFN SFA
	PUSHJ P,TOFLOK
	POP P,A
	MOVMS FO.LNL(TT)
	SKIPE A
	 MOVNS FO.LNL(TT)
	JRST STERP1


SUBTTL	STATUS CRFILE, LOSEF


SCRFUN==FALSE		;***** TEMP CROCK *****

SCRFIL:	SETZ A,
	PUSHJ P,DEFAULTF
	HRRZ A,(A)
	POPJ P,


SLOSEF:	MOVE T,LOSEF
	JFFO T,.+1
	MOVNS TT
	ADDI TT,36.
	JRST FIX1

SSLOS0:	MOVEI A,(B)
	WTA [BAD LOSEF - SSTATUS!]
SSLOSEF:
	MOVEI B,(A)
	SKIPE GCPSAR
	JRST SLOSEF
	JSP T,FXNV2
	JUMPLE D,SSLOS0
	CAILE D,16
	JRST SSLOS0
	MOVEI TT,1
	LSH TT,(D)
	SUBI TT,1
	MOVEM TT,LOSEF
BPDLNKJ:	MOVEI A,(B)
	JRST PDLNKJ

SUBTTL	STATUS JCL, HACTRN

IFE D10\D20\ITS 	SJCL:	 JRST FALSE

IFN D10\D20,[
SJCL:
20$	JSP F,SJCLSET
	SKIPN T,SJCLBUF
	 JRST FALSE
	PUSH FXP,T
	PUSH FXP,[440700,,SJCLBUF+1]
SJCL2:	ILDB TT,(FXP)
	JUMPE TT,SJCL4
	PUSHJ P,RDCH2
	PUSH P,A
	SOSLE -1(FXP)
	 JRST SJCL2
SJCL4:	POPI FXP,1
	POP FXP,T
	SUB T,SJCLBUF
	JRST LIST
]		;END OF IFN D10\D20

;;; The twenex version returns T if we are top-level, NIL if not.
ifn d20,[
sddtp:	jsp t,supep		;status hactrn
	  jrst  false		;nope, we're not top-level
	jrst true		;oh yes we are!

;; skips if we are top-level.  uses t,tt but not a-c
supep:	pushj	fxp,sav3	       ;save accs 1-3
	movei	a,.fhslf	       ;start with us.
	setz	b		       ;in case future twenex versions use other bits.
	movsi	c,-6		       ;say tree has six words
	hrri	c,1(fxp)	       ;all on FXP
	move	tt,t		       ;save return address
	jsp	t,0push-6	       ;make dummy space for tree
	gfrks			       ;try to make tree
	 aoj	tt,		       ;skip on return if top level
	sub	fxp,[6,,6]	       ;return tree space.
	pushj	fxp,rst3
	jrst    tt

]		;end of ifn d20

IFN ITS,[
SJCL:	.SUSET [.ROPTION,,TT]
	TLNN TT,%OPCMD
	 JRST FALSE		;EXIT WITH NIL IF NO COMMAND LINE
	.SUSET [.RSUPPRO,,T]
	JUMPL T,FALSE
	SETZM JCLBF
	MOVE T,[JCLBF,,JCLBF+1]
	BLT T,JCLBF+LJCLBF-1
	HLLOS JCLBF+LJCLBF-1
	.BREAK 12,[..RJCL,,JCLBF]
	MOVEI T,JCLBF		;MUST CLEAR BIT 35'S AS DDT MAY SET THEM!!
	MOVEI TT,1		;MASK
SJCL1A:	ANDCAM TT,(T)		;TURN OFF BIT 35
	CAIGE T,JCLBF+LJCLBF-1	;DO ALL WORDS IN JCLBF
	 AOJA T,SJCL1A
	PUSH FXP,R70
	PUSH FXP,[440700,,JCLBF]
SJCL1:	ILDB TT,(FXP)
	JUMPE TT,SJCL3
SJCL2:	PUSH P,TT
	PUSHJ P,RDCH2
	EXCH A,(P)
	SOS -1(FXP)
	CAIE A,^M	;CAR-RET CAUSES TERMINATION
	JRST SJCL1
SJCL4:	MOVE T,-1(FXP)
	SUB FXP,R70+2
	JRST LIST

SJCL3:	HRRZ T,(FXP)
	CAIE T,JCLBF+LJCLBF-1
	JRST SJCL4
	MOVEI A,QSJCL
	FAC [TOO MUCH JCL - STATUS!]

SDDTP:	.SUSET [.RSUPPRO,,TT]	;STATUS HACTRN
	JUMPL TT,FALSE		;NIL MEANS NO SUPERIOR
	MOVEI A,TRUTH		;T MEANS THE UNKNOWN SUPERIOR
	.SUSET [.ROPTION,,TT]
	TLNE TT,OPTDDT
	 MOVEI A,QDDT
	TLNE TT,OPTLSP
	 MOVEI A,QLISP
	POPJ P,

]		;END OF IFN ITS

SUBTTL	STATUS TTYSIZE, TTYTYPE, NEWIO OSPEED

STTYTYPE:
	TDZA F,F
STTYSIZE:
	 MOVEI F,1
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
IFN SFA,[
	JSP TT,XFOSP
	 JRST STTSZ1
	 JRST STTSZ1 
	MOVEI B,QTTYSIZE 
	SKIPN F
	 MOVEI B,QTTYTYPE	
	JRST STSCN0
STTSZ1:	]	;END IFN SFA
	PUSHJ P,TOFLOK
IFN ITS\D20,[
IFN D20,[
	JUMPN F,STTYS1
	MOVE 1,F.JFN(TT)
	GTTYP
	MOVE TT,2
	SETZB 2,3
]	;END OF IFN D20
IFN ITS,[
	.CALL [	SETZ
		SIXBIT \CNSGET\		;GET CONSOLE PARAMETERS
		      ,,F.CHAN(TT)	;CHANNEL #
		  2000,,D		;VERTICAL 	SCREEN SIZE
		  2000,,TT		;HORIZONTAL SCREEN SIZE
		402000,,R		;TCTYP
		]
	 JRST UNLKFALSE
	JUMPN F,STTYS1
	MOVE TT,R
]		;END OF IFN ITS
]		;END OF IFN ITS\D20
IFN D10,[
SA% 	MOVEI TT,0		;TTYTYPE ALWAYS ZERO (?) FOR SIMPLE D10
SA% 	JUMPE F,STTYS2
IFN SAIL,[
	JUMPE F,[ PUSHJ P,D10TNM		;GET TTY NUMBER IN D
		  GETLIN D			;GET LINE CHARACTERISTICS
		  HLRZ T,D
		  TRZ T,150777			;MASK OUT ALL NON-TTY-TYPE BITS
		  JFFO T,.+2
		   SETZ TT,
		  JRST STTYS2 ]
;R GETS SIZE, TT GETS WIDTH
	MOVE F,[-2,,R]		;COUNT OF ARGS,,ADR OF ARGS
	MOVE R,[15,,R]		;TERMINAL SIZE, -1 IF NOT DISPLAY
	MOVE D,[6,,D]		;TERMINAL WIDTH (EXCEPT IF NON-ARPA TTY)
	TTYSET F,		;DO TERMINAL OPERATIONS
	SKIPGE R		;IF USE REAL PAGE LENGTH
	 MOVE R,FO.RPL(TT)
	MOVE TT,D		;LINE LENGTH ENDS UP IN TT
]		;END OF IFN SAIL
	MOVE R,FO.RPL(TT)	;GET REAL PAGE LENGTH
IFE SAIL,[
	MOVE TT,FO.LNL(TT)	;GET LINEL
	ADDI TT,1		;WIDTH IS 1 MORE THAN LINEL
]	;END IFE SAIL
	JRST STTYS1
]		;END OF IFN D10
STTYS2:	UNLOCKI
	JRST FIX1

STTYS1:
20$	MOVE D,FO.RPL(TT)	;TERMINAL WIDTH
20$	MOVM TT,FO.LNL(TT)	;HEIGHT (OR LENGTH). Careful!  Sign bit
	UNLOCKI			; is (status terpri) for that file!
	JSP T,FXCONS
	MOVEI B,(A)
10%	MOVE TT,D
10$	MOVE TT,R
	JRST CONSFX


IFN ITS\D20,[

;OSPEED - RETURNS TTY OUPUT SPEED VARIABLE
SOSPEED:
	SKIPN T
	 SKIPA AR1,[TTYOFA]	;IF NOT, WE USE THE DEFAULT
	  POP P,AR1
IFN SFA,[
	JSP TT,XFOSP
	 JRST SOSP1
	 JRST SOSP1
	MOVEI B,QOSPEED
	JRST STSCN0
SOSP1:	]	;END IFN SFA
	PUSHJ P,TOFLOK
20$	JRST UNLKFALSE	
IFN ITS,[
	.CALL [	SETZ
		SIXBIT \TTYVAR\
		      ,,F.CHAN(TT)
		      ,,[SIXBIT \OSPEED\]
		402000,,TT	
		]
	 JRST UNLKFALSE
	JRST STTYS2
]		;END OF IFN ITS
]		;END OF IFN ITS\D20


;TTYCOM, TTYOPT, TTYTYP NOT RETRIEVED



IFN D10,[

;;; GET DEC-10 TERMINAL NUMBER INTO D (-1 FOR OWN TERMINAL).
;;; ENTER WITH TTSAR OF FILE OBJECT IN TT.

D10TNM:
IFN SAIL,[
	MOVE D,F.CHAN(TT)
	SKIPL F.MODE(TT)
	 DEVNUM D,		;GET DEVICE NUMBER
	  SETO D,		;ON FAILURE, OR FOR TTY, USE -1
]		;END OF IFN SAIL
IFE SAIL,[
	SETO D,
	SKIPGE F.MODE(TT)	.SEE FBT.CM
	 POPJ P,
	HRRZ D,F.RDEV(TT)	;CONVERT SIXBIT UNIT NUMBER TO OCTAL
REPEAT 3,[
	DPB D,[360600,,D]
	DPB D,[030300,,D]
	TLNN D,700000
	 LSH D,-3
	LSH D,-3
]		;END OF REPEAT 3
	ANDI D,777
]		;END OF IFE SAIL
	POPJ P,
]		;END OF IFN D10

SUBTTL	STATUS TTYSCAN, TTYCONS, TTYINT


STTYSCAN:
	SKIPN T			;GET TTY PRE-SCAN FUNCTION
	 SKIPA AR1,V%TYI
	  POP P,AR1
IFN SFA,[
	JSP TT,XFOSP
	 JRST STSCN1
	 JRST STSCN1
	MOVEI B,QTTYSCAN
STSCN0:	MOVEI C,NIL		;special signal to read-out the "ttyscan"
STSCN2:	MOVEI A,(AR1)
	JRST ISTCSH
STSCN1:	]	;END IFN SFA
	PUSHJ P,TIFLOK
	HRRZ A,TI.BFN(TT)
	UNLKPOPJ

SSTTYSCAN:
	CAMN T,XC-1		;SET TTY PRE-SCAN FUNCTION
	 SKIPA AR1,V%TYI
	  POP P,AR1
IFN SFA,[
	JSP TT,XFOSP		;DO WE HAVE AN SFA?
	 JRST SSTSC1		;NOPE
	 JRST SSTSC1		;DITTO
	MOVEI AR2A,QTTYSCAN 
	POP P,A			;GET THE ARG
SSTSC2:	JSP T,%NCONS		;TURN IT INTO A LIST
SSTSC0:	MOVEI C,(A)		;AS THE ARG TO THE SFA
	MOVEI A,(AR1)
	MOVE B,AR2A
	JRST ISTCSH
SSTSC1:	]	;END IFN SFA
	PUSHJ P,TIFLOK
	POP P,A
	HRRZM A,TI.BFN(TT)
	UNLKPOPJ

STTYCONS:
	MOVEI AR1,(A)		;GET ASSOCIATED TTY FILE OF
	CAIN AR1,TRUTH		; OPPOSITE DIRECTION, IF ANY
	 MOVE AR1,V%TYI
IFN SFA,[
	JSP TT,XFOSP
	 JRST STCON1
	 JRST STCON1
	MOVEI TT,SR.CNS		;IF SFA, THEN GET THE TTYCONS SLOT 
	HLRZ A,@TTSAR(AR1)
	POPJ P,
STCON1:	]	;END IFN SFA
	PUSHJ P,TFILOK		;LEAVES ITS ARGUMENT IN AR1
	HRRZ A,FT.CNS(TT)	.SEE TTYMOR
	UNLKPOPJ

SSTTYCONS:
	SKIPE A			;CONS TOGETHER TWO TTY'S INTO
	 CAIN A,TRUTH		; A SINGLE CONSOLE
	  EXCH A,B		;PREFER TO SEE NIL OR T SECOND
	CAIN A,TRUTH		;PREFER INPUT TTY FOR FIRST ARG
	 HRRZ A,V%TYI
SFA%	MOVEI AR1,(A)
IFN SFA,[
	JSP TT,AFOSP		;DO WE HAVE AN SFA?
	 JRST SSTCO1		;NOPE
	 JRST SSTCO1		;NOPE
	MOVEI TT,SR.CNS		;IF SFA, THEN GET THE TTYCONS SLOT 
	HRLM B,@TTSAR(AR1)
	POPJ P,
SSTCO1:	]	;END IFN SFA
	PUSHJ P,TFILOK
	JUMPE B,SSTC1		;SUNDER THEM IF ONE IS NIL
	MOVEI T,TIFLOK
	TLNN TT,TTS<IO>
	 MOVEI T,TOFLOK
	UNLOCKI
	CAIE B,TRUTH
	 JRST SSTC2
	HRRZ B,V%TYI		;FOR SECOND ARG OF T, USE TTY
	TLNN TT,TTS<IO>		; OF NECESSARY DIRECTION
	 HRRZ B,V%TYO
SSTC2:	MOVEI AR1,(B)
	PUSHJ P,(T)
	HRRZ C,FT.CNS(TT)
	HRRZM A,FT.CNS(TT)	;LINK THIS ONE TO THAT ONE
	MOVEI TT,FT.CNS
	SKIPE C			;IF IT WAS LINKED, UNLINK
	 SETZM @TTSAR(C)	; ITS FORMER PARTNER
	EXCH B,@TTSAR(A)	;LINK THAT ONE TO THIS ONE
	JUMPE B,UNLKTRUE	;????? THINK ABOUT ALL THIS?
	CAIE B,(A)		;IF IT WAS LINKED, UNLINK
	 SETZM @TTSAR(B)	; ITS FORMER PARTNER
	JRST UNLKTRUE

SSTC1:	HRRZ B,FT.CNS(TT)	;GET ASSOCIATED TTY
	SETZM FT.CNS(TT)	;UNLINK THAT FROM THIS
	MOVEI TT,FT.CNS
	SKIPE B			;ONLY UNCONS IF WAS PREVIOUSLY CONSED
	 SETZM @TTSAR(B)	;UNLINK THIS FROM THAT
	JRST UNLKTRUE


STTYINT:
	CAMN T,XC-1
	 SKIPA AR1,V%TYI
	  POP P,AR1
	POP P,A
IFN SFA,[
	JSP TT,XFOSP
	 JRST STINT1
	 JRST STINT1
	PUSHJ P,NCONS	 	;note that this will listify the argument
	MOVEI B,NIL		; and SSTSC2 cons's onto (), so the format
	JRST SSTTI0		; for data is (<list> . <sstatusp>)
STINT1:	]	;END IFN SFA
	JSP T,CHNV1
	MOVE F,TT
	PUSHJ P,TIFLOK
	ROT F,-1
	ADDI TT,FB.BUF(F)
	HRRZ A,(TT)
	SKIPL F
	 HLRZ A,(TT)
	UNLKPOPJ

SSTTYINT:
	CAMN T,XC-2
	 SKIPA AR1,V%TYI
	  POP P,AR1
	POP P,A
	JSP T,PDLNMK
	MOVEI B,(A)
	POP P,A
IFN SFA,[
	JSP TT,XFOSP		;DO WE HAVE AN SFA?
	 JRST SSTTI1		;NOPE
	 JRST SSTTI1		;DITTO
	EXCH A,B
	PUSHJ P,NCONS		;GET A LIST OF THE ARGS
	PUSHJ P,XCONS
	MOVEI B,TRUTH
SSTTI0:	PUSHJ P,CONS		;DATA FOR TTYINT IS (<list> . <sstatusp>)
	MOVEI AR2A,QTTYINT
	JRST SSTSC0
SSTTI1:	]	;END IFN SFA
	JSP T,CHNV1		;TT <- character #
	MOVE F,TT
	PUSHJ P,TIFLOK
	ROT F,-1
20$	PUSH P,TT		;SAVE TTSAR
	ADDI TT,FB.BUF(F)
	JUMPL F,SSTIN1
	HRLM B,(TT)
20%	JRST UNLKTRUE
20$	SKIPA
SSTIN1:	HRRM B,(TT)
20%	JRST UNLKTRUE
IFN D20,[
	POP P,TT		;RESTORE TTSAR
	ROT F,1			;RESTORE CHARACTER
	CAIE F,3		;DON'T ALLOW USE TO ASSIGN ^C
	 CAILE F,28.		;TOPS-20 ONLY SUPPORTS TO RUBOUT
	  pushj p,badchr	;perhaps we can special-case the interrupt.
	MOVEI T,TTYIFA		;ONLY DO FOLLOWING IF *THE* TTY
	CAME TT,TTSAR(T)	;CHECK FOR TTSAR OF *THE* TTY
	 JRST UNLKTRUE
	SETZB T,R		;SEARCH FOR A) FREE SLOT, B) EQUIVALENT SLOT
SSTIN2:	CAMN F,CINTAB(T)	;EQUIVALENT SLOT?
	 JRST SSTIN3		;YES, CODE ASSIGNED SO TAKE SPECIAL ACTION
	SKIPN CINTAB(T)		;EMPTY SLOT?
	 MOVEI R,400000(T)	;YES, REMEMBER WE HAVE ONE
	CAIGE T,CINTSZ-1	;DONE ALL OF TABLE?
	 AOJA T,SSTIN2		;NOPE, CONTINUE LOOPING
	JUMPE B,UNLKTRUE	;IF TURNING OFF AND DIDN'T FIND IN TAB, DONE
	SKIPN R			;FOUND A FREE SLOT?
	 JRST SSTIN4
	MOVEM F,CINTAB-400000(R) ;YES, STORE NEW CHARACTER ASSIGNMENT
	CAILE R,400005		;CONVERT TO 400000+<D20 INTERRUPT CHANNEL>
	 ADDI R,22
	HRLZI 1,(F)		;CHARACTER
	HRRI 1,-400000(R)	;INTERRUPT CHANNEL
	ATI			;ASSIGN THE CHARACTER TO THE CHANNEL
	MOVEI A,TRUTH		;RETURN TRUE
	UNLKPOPJ

SSTIN3:	JUMPN B,UNLKTRUE	;RETURN IF CHARACTER WAS ALREADY ASSIGNED
	SETZM CINTAB(T)		;CLEAR THE TABLE ENTRY
	MOVEI 1,(F)		;DEASSIGN THE TERMINAL CODE
	DTI
	JRST UNLKTRUE		;THEN RETURN TRUE

SSTIN4:	UNLOCKI
	FAC [NO FREE INTERRUPT CHANNELS  - (SSTATUS TTYINT)!]

badchr: pushj p,supep		;are we top-level? (skips if yes)
	 caie f,3		;were we talking about ^C?
	  jrst [pop p,(p)
		jrst unlktrue]	;return true, but do nothing.
	pushj fxp,sav3		;save accs 1-3
	movei a,.fhslf
	setz  c,
	setca c,
	epcap			;give us all capabilities
	 haltf			;urk!
	popj p,			;go back to do whatever operation.
]	;END IFN D20


SUBTTL	STORAGE SPACE STATUS CALLS

SPDLMAX:
IFN PAGING,[
		JSP D,SSGP1	;0 - STATUS PDLMAX
SSPDLMAX:	JSP D,SSGP1	;1 - SSTATUS PDLMAX
]			;END OF IFN PAGING
.ELSE	REPEAT 2, 0		;0, 1 UNUSED
SGCSIZE:	JSP D,SSGP1	;2 - STATUS GCSIZE
SSGCSIZE:	JSP D,SSGP1	;3 - SSTATUS GCSIZE
SGCMAX:		JSP D,SSGP1	;4 - STATUS GCMAX
SSGCMAX:	JSP D,SSGP1	;5 - SSTATUS GCMAX
SGCMIN:		JSP D,SSGP1	;6 - STATUS GCMIN
SSGCMIN:	JSP D,SSGP1	;7 - SSTATUS GCMIN
SPDLSIZE:	JSP D,SSGP1	;10 - STATUS PDLSIZE
SPURSIZE:	SKIPA B,A	;14 - STATUS PURSIZE
SSPCSIZE:	 JSP D,SSGP1	;12 - STATUS SPCSIZE
	MOVEI D,14		;FAKE OUT A JSP D,SSGP1
	CAIG B,QRANDOM		;LOSE IF BAD SPACE TYPE
	 CAIGE B,QLIST
	JRST SSGPLZ
   2DIF SKIPN (B),GTNPS8,QLIST
	 JRST SSGPLZ
	JRST SSGP1A

SPDLROOM:
	MOVEI D,20+SPDLMAX+1	;20 - STATUS PDLROOM
SSGP1:	SUBI D,SPDLMAX+1	;GET CODE NUMBER IN D
	MOVEI C,(B)		;YECH - SHUFFLE, SHUFFLE
	MOVEI B,(A)
SSGP1A:	MOVEI AR1,(B)
	CAIN B,QRANDOM		;GET LINEARIZATION BY USING
	 JRST SSGPLZ		; QRANDOM FOR QARRAY
	CAIN B,QARRAY
	 MOVEI B,QRANDOM
	TRNE D,6		;SKIP IF PDLMAX OR PDLSIZE
	 JRST SSGP1C
	CAIL B,QREGPDL
	 CAILE B,QSPECPDL
	  JRST SSGPLZ
	JRST SSGP1D

SSGP1C:	CAIG B,QRANDOM		;LOSE IF BAD SPACE TYPE
	 CAIGE B,QLIST
	JRST SSGPLZ

SSGP1D:	ROT D,-1		;LOW BIT=1 => SSTATUS
	JUMPL D,SSG3A1
	MOVE TT,@SSGPGT(D)	;ELSE GET VALUE TO RETURN
	TRNE D,3
	 JRST SSGP2A
   2DIF [SUB TT,(B)]C2,QREGPDL	;FOR PDL STUFF, CUT DOWN
	TLZ TT,-1		; QUANTITY BY PDL ORIGIN
SSGP2A:	TLNN TT,-1		;HACK SO THAT STATUS GCMIN
	 JRST FIX1		; WILL RETURN A FLONUM
	JRST FLOAT1		; IF APPROPRIATE


SSGPGT:
10%	2DIF (B),XPDL,QREGPDL	;PDLMAX
10$	0			;UNUSED
	2DIF (B),GFSSIZ,QLIST	;GCSIZE
	2DIF (B),XFFS,QLIST	;GCMAX
	2DIF (B),MFFS,QLIST	;GCMIN
	2DIF (B),P,QREGPDL	;PDLSIZE
	2DIF (B),SFSSIZ,QLIST	;SPCSIZE
	2DIF (B),PFSSIZ,QLIST	;PURSIZE
	0			;UNUSED
	2DIF (B),OC2,QREGPDL	;PDLROOM

SSGPLZ:	MOVEI T,SBADSP	;BAD SPACE TYPE (OR MAYBE PDL TYPE?)
	TRNN D,6
	 MOVEI T,[SIXBIT \BAD PDL TYPE - STATUS!\]
	MOVEI A,(AR1)
	%WTA (T)
	MOVEI B,(A)
	JRST SSGP1A

SSGP3$:	JUMPE C,TRUE		;USED BY $ALLOC
;A CHANGE IN POLICY TO ALWAYS ALLOW A FLONUM
SSG3A1:	MOVEI T,(D)
	CAIN T,3		;IF GCMIN,
	 JRST SSGP4		; USE SPECIAL CHECKING CODE
SSGP3A:	SKOTT C,FL		;ALLOW FLONUM
	 JRST SSGP3Z
	MOVE TT,(C)		;GET THE FLONUM
	PUSH FXP,D		;SAVE D OVER CALL TO IFIX
	JSP T,IFIX		;CONVERT TO A FIXNUM
	POP FXP,D
	MOVE R,TT
	JRST SSGP3Y		;THEN HANDLE AS IF FIXNUM
SSGP3Z:	SKOTT C,FX		;MUST BE FIXNUM
	 JRST FALSE
	MOVE R,(C)		;ELSE FETCH THE FIXNUM
SSGP3Y:	TLNE R,-1		;LOSE IF NEG OR TOO LARGE
	 JRST FALSE
	JRST SSGPPT(D)		;ELSE JRST TO SPECIAL ROUTINE

SSGPPT:
10%	JRST SSPM1		;PDLMAX
10$	0
	JRST SSGS1		;GCSIZE
	JRST SSGX1		;GCMAX
SSGM1:	CAIL R,40		;GCMIN
    2DIF [CAMLE D,(B)]SSGMRV,QLIST	;FIXNUM GCMIN MUST HAVE
	  JRST FALSE			; "REASONABLE" VALUE
SSGM2:
   2DIF [MOVEM R,(B)]MFFS,QLIST		;SO SAVE IT, ALREADY
	JRST TRUE

SSGMRV:	20000		;LIST
	10000		;FIXNUM
	4000		;FLONUM
BG$	4000		;BIGNUM
	4000		;SYMBOL
REPEAT HNKLOG+1, 100000	;HUNKS
	1000		;SAR

SSGP4:	MOVEI A,(C)		;(SSTATUS GCMIN ...) PERMITS
	JSP T,FLTSKP		; A FLONUM ARGUMENT
	 JRST SSGP3A
	JUMPLE TT,FALSE		;BUT MUST BE POSITIVE
	CAML TT,[.005]		; AND BETWEEN .005 AND .95
	 CAMLE TT,[.95]
	  JRST FALSE
	MOVE R,TT
	JRST SSGM2



SSGS1:	ANDI R,SEGMSK
   2DIF [MOVEM R,(B)]GFSSIZ,QLIST	;SET GCSIZE
   2DIF [CAMG R,(B)]XFFS,QLIST		;IF GREATER THAN GCMAX,
	 JRST TRUE			; MUST ALSO SET GCMAX TO MATCH
SSGX1:
   2DIF [CAMGE R,(B)]SFSSIZ,QLIST	;GCMAX MAY NOT BE LESS
	 JRST FALSE			; THAN ACTUAL SIZE
   XCTPRO
   2DIF [HRRZM R,(B)]XFFS,QLIST
   NOPRO
	JRST TRUE

IFN ITS+D20,[
SSPM1:	HRRZ T,P-QREGPDL(B)	;GET CURRENT PDL POINTER
	ADD R,C2-QREGPDL(B)	;UP USER'S VALUE BY PDL ORIGIN
	ANDI R,777760
	TRNN R,PAGKSM
	 SUBI R,20
	CAILE R,(T)		;NEW PDLMAX MUST BE ABOVE
	 CAML R,OC2-QREGPDL(B)	; CURRENT PDL POINTER, AND
	  JRST FALSE		; BELOW ABS OVERFLOW POINT
	HRRZM R,XPDL-QREGPDL(B)
	HRRZM R,ZPDL-QREGPDL(B)	;SO UPDATE CRAP
	HRROS P-QREGPDL(B)	;SET LH OF PDL POINTER TO -1
	JRST TRUE		; SO PDLOV WILL HACK IT PROPERLY
]		;END OF IFN ITS+D20


SUBTTL	STATUS RANDOM

SRANDOM:
	SETZ B,
	MOVEI F,LRBLOCK-1+2	;+2 FOR RNOWS AND RBACK
SRAND3:	MOVE TT,RNOWS(F)	;CONS UP A LIST SUMMARIZING
	PUSHJ P,CONSFX		; THE STATE OF THE RANDOM
	SOJGE F,SRAND3		; NUMBER GENERATOR
	POPJ P,

SSRAN0:	WTA [BAD ARGUMENT - STATUS RANDOM!]
SSRANDOM:
	SKOTT A,LS
	 JRST SSRAN8
	MOVEI B,(A)
	JSP TT,SSRAN6
	MOVEM R,RNOWS
	JSP TT,SSRAN6
	MOVEM R,RBACK
	MOVNI F,LRBLOCK
SSRAN3:	HLRZ C,(B)
	JSP T,FXNV3
	MOVEM R,RBLOCK+LRBLOCK(F)
	HRRZ B,(B)
	AOJL F,SSRAN3
	JRST TRUE

SSRAN6:	HLRZ C,(B)
	JSP T,FXNV3
	JUMPL R,SSRAN0
	CAIL R,LRBLOCK
	 JRST SSRAN0
	HRRZ B,(B)
	JRST (TT)

SSRAN8:	JSP T,FXNV1
	SKIPN TT		;0 IS BAD VALUE
	 MOVEI TT,1
	JSP F,IRAND0
	JRST TRUE

;;; Hooks for the EXTEND hackery

SSCALLI:
	MOVE C,A
	MOVEI B,QCALLI		   ;Look on the CALLI property for
	PUSHJ P,$GET		   ;the "SUBR" to invoke
	MOVE T,[ICALLI,,UCALLI]
	MOVSI TT,(JRST)		   ;We JRST to it, and it hacks the stack
	MOVEM C,(T)		   ;We write it, since don't have frob in A
	JRST SSSEN1

SSSENDI:			   ;Set the SEND interpreter
	MOVE T,[SENDI,,USENDI]
	MOVSI TT,(JCALL 16,)
SSSENA:	MOVEM A,(T)		   ;Remember what it is for (STATUS SENDI), GC
SSSEN1:	MOVSS T			   ;Now hack the instruction cell
	JUMPE A,SSSEN0		   ;If NIL, zero SENDI so won't be XCT'd
	HRR TT,A
	MOVEM TT,(T)		   ;Save the call instruction for it
	JRST TRUE		   ;Return truth
SSSEN0:	SETZM (T)
	JRST TRUE

SSUSRHNK:			   ;Set the USER-HUNK check
	MOVE T,[USRHNK,,UUSRHNK]
	MOVSI TT,(CALL 1,)
	JRST SSSENA


IFN USELESS,[
IFN ITS,[

SUBTTL	STATUS WHO-LINE [ETC.]

SSWHO1:	SETZ F,
	MOVE D,[441000,,F]
	JSP T,FXNV1
	IDPB TT,D
	MOVEI A,(B)
	JSP T,CHNV1X
	IDPB TT,D
	JSP T,FXNV3
	IDPB R,D
	MOVEI A,(AR1)
	JSP T,CHNV1X
	IDPB TT,D
	.SUSET [.SWHO1,,F]
	JRST TRUE

SSWHO2:	PUSHJ P,SIXNUM
	.SUSET [.SWHO2,,TT]
	JRST TRUE

SSWHO3:	PUSHJ P,SIXNUM
	.SUSET [.SWHO3,,TT]
	JRST TRUE

SWHO1:	.SUSET [.RWHO1,,F]
	MOVEI R,4
	SETZ B,
	MOVE D,[441000,,F]
SWHO1A:	ILDB TT,D
	JSP T,FXCONS
	PUSHJ P,CONS
	MOVEI B,(A)
	SOJG R,SWHO1A
	JRST NREVERSE

SWHO2:	.SUSET [.RWHO2,,TT]
	JRST FIX1

SWHO3:	.SUSET [.RWHO3,,TT]
	JRST FIX1

SIXNUM:	SKOTT A,FX
	 JRST SIXMAK
	POP P,T
	JRST FXNV1


SMAR:	MOVE T,IMASK
	TRNN T,%PIMAR		;NIL IF LISP NOT USING MAR
	 JRST FALSE		; (BUT SUPERIOR MIGHT BE)
	.SUSET [.RMARA,,D]
	HLRZ TT,D
	MOVEI A,(D)
	PUSHJ P,ACONS
	MOVEI B,(A)
	JRST CONSFX		;RETURN LIST OF (MODE, LOCATION)

SSMAR:	MOVEI F,%PIMAR
	JSP T,FXNV1
	TRZ TT,4
	JUMPE TT,SSMAR5
	IORM F,IMASK
	.SUSET [.SIMASK,,F]
	HRLI B,(TT)
	.SUSET [.SMARA,,B]
	JRST TRUE

SSMAR5:	.SUSET [.SMARA,,R70]
	ANDCAM F,IMASK
	.SUSET [.SAMASK,,F]
	JRST TRUE


;;;	IFN USELESS
;;;	IFN ITS

SSGCWHO:	JSP T,FXNV1
	ANDI TT,3
	MOVEM TT,GCWHO
	JRST TRUE


SITS:	.CALL SITS9
	 .VALUE
	PUSH FXP,T
	JSP T,IFLOAT
	FDVRI TT,(30.0)
	JSP T,FLCONS
	SETZ B,
	PUSHJ P,CONSIT
	POP FXP,TT
	PUSHJ P,CONSFX
	MOVE TT,D
	PUSHJ P,CONSFX
	MOVE TT,R
	PUSHJ P,CONSFX
	MOVE TT,F
	JSP T,IFLOAT
	SKIPL TT
	 FDVRI TT,(30.0)
	JSP T,FLCONS
	JRST CONS

SITS9:	SETZ
	SIXBIT \SSTATU\
	  2000,,F		;TIME UNTIL SYSTEM GOES DOWN
	  2000,,R		;SYSTEM BEING DEBUGGED
	  2000,,D		;NUMBER OF LOSERS
	  2000,,T		;NUMBER OF MEMORY ERRORS
	402000,,TT		;TIME SYSTEM HAS BEEN UP

]		;END OF IFN ITS
]		;END OF IFN USELESS

SUBTTL	ASCII TABLE OF STATUS FUNCTIONS

;;; ***** ASCII TABLE OF STATUS FUNCTIONS ***** PART 1 *****

STBA:	ASCII \MACRO\		;MACRO
	ASCII \DIVOV\		;DIVOV (DIVIDE OVERFLOW)
	ASCII \VECTO\ 		;VECTOR 
	ASCII \TTY\		;TTY 
	ASCII \TOPLE\		;TOPLEVEL
	ASCII \BREAK\		;BREAKLEVEL
	ASCII \UREAD\		;UREAD
	ASCII \UWRIT\		;UWRITE
	ASCII \+\		;+ (SUPRA-DECIMAL DIGITS OPTION)
	ASCII \GCMIN\		;GCMIN
	ASCII \SYNTA\		;SYNTAX
	ASCII \CHTRA\		;CHTRAN (CHARACTER TRANSLATION)
	ASCII \TTYIN\		;TTYINT
	ASCII \GCTIM\		;GCTIME
	ASCII \LOSEF\		;LOSEF (LAP OBJECT STORAGE EFFICIENCY FACTOR)
	ASCII \TERPR\		;TERPRI (SUPPRESSION OF AUTO-TERPRI)
	ASCII \_\		;_ (CAN PRIN1 USE _ FIXNUM SYNTAX)
	ASCII \TTYRE\		;TTYREAD
	ASCII \FEATU\		;FEATURE
	ASCII \NOFEA\		;NOFEATURE
IFN USELESS,	ASCII \ABBRE\	;ABBREVIATE
	ASCII \UUOLI\		;UUOLINKS
	ASCII \GCMAX\		;GCMAX
IFN PAGING,	ASCII \PDLMA\	;PDLMAX
	ASCII \GCSIZ\		;GCSIZE
	ASCII \LINMO\		;LINMODE
	ASCII \CRFIL\		;CRFILE (CURRENT FILE)
	ASCII \CRUNI\		;CRUNIT (CURRENT UNIT)
	ASCII \EVALH\		;EVALHOOK (FOR MULTICS COMPATIBILITY)
	ASCII \TTYSC\		;TTYSCAN
	ASCII \TTYCO\		;TTYCONS
	ASCII \RANDO\		;RANDOM
IFN USELESS,[
IFN ITS,[
	ASCII \WHO1\		;WHO1	;ITS WHO-LINE
	ASCII \WHO2\		;WHO2	; DISPLAY
	ASCII \WHO3\		;WHO3	; VARIABLES
	ASCII \MAR\		;MAR	;MAR BREAK FEATURE
	ASCII \GCWHO\
]		;END OF IFN ITS
]		;END OF IFN USELESS
	ASCII \PUNT\		;PUNT	;TRUE MEANS NO FUNCTIONAL VARIABLES
	ASCII \FLUSH\		;FLUSH  ;NON-NIL MEANS FLUSH PAGES UPON
					; A SUSPEND
IFN USELESS*ITS, ASCII \CLI\	;CLI 	;DISABLE/ENABLE CLI INTERRUPTS

	ASCII \NOINT\		;NOINT	;Enable/disble interrupts
	ASCII \SENDI\		;SENDI	;SEND interpreter
	ASCII \CALLI\		;CALLI	;CALL interpreter
	ASCII \USRHU\		;USRHU	;USRHUNK routine
	ASCII \SXHAS\		;OLD STYLE SXHASHING

LSSTBA==.-STBA		;END OF ENTRIES WHICH CAN BE SSTATUS'D

;;; ***** ASCII TABLE OF STATUS FUNCTIONS ***** PART 2 *****

	ASCII \FASLN\		;FASLNAMELIST
	ASCII \TTYIF\		;TTYIFA -- THE INITIAL TTY INPUT FILE ARRAY
	ASCII \TTYOF\		;TTYOFA -- THE INITIAL TTY OUTPUT FILE ARRAY
	ASCII \PURSI\		;PURSIZE
	ASCII \PDLSI\		;PDLSIZE
	ASCII \DAYTI\		;DAYTIME
	ASCII \DATE\		;DATE
IFN USELESS,	ASCII \DOW\	;DOW (DAY OF WEEK)
	ASCII \TTYSI\		;TTYSIZE (HEIGHT . WIDTH)
	ASCII \UNAME\		;UNAME (USER NAME)
	ASCII \USERI\		;USERID
	ASCII \XUNAM\		;XUNAME
	ASCII \JNAME\		;JNAME (JOB NAME)
	ASCII \SUBSY\		;SUBSYSTEM
	ASCII \JNUMB\		;JNUMBER
	ASCII \HOMED\		;HOMEDIR (HOME DIRECTORY NAME)
	ASCII \HSNAM\		;HSNAME (SMART HOME DIRECTORY NAME)
	ASCII \LISPV\		;LISPVERSION
	ASCII \JCL\		;JCL (JOB COMMAND LINE)
ifn d20\its, ASCII \HACTR\		;HACTRN
	ASCII \UDIR\		;UDIR (USER DIRECTORY NAME)
	ASCII \FXPDL\		;FXPDL (FIXNUM PDL)
	ASCII \FLPDL\		;FLPDL (FLONUM PDL)
	ASCII \PDL\		;PDL (REG PDL)
	ASCII \SPDL\		;SPDL (SPECIAL PDL)
	ASCII \BPSL\		;BPSL (BINARY PROGRAM SPACE LOW)
	ASCII \BPSH\		;BPSH (BINARY PROGRAM SPACE HIGH)
	ASCII \SEGLO\		;SEGLOG (LOG2 OF SEGMENT SIZE)
	ASCII \SYSTE\		;SYSTEM (SYSTEM ATOM)
	ASCII \TABSI\		;TABSIZE
	ASCII \FILES\		;FILESYSTEM-TYPE
	ASCII \OPSYS\		;OPSYSTEM-TYPE
	ASCII \SITE\		;SITE NAME
	ASCII \SPCNA\		;SPCNAMES (NAMES OF DATA SPACES)
	ASCII \PURSP\		;PURSPCNAMES
	ASCII \PDLNA\		;PDLNAMES
	ASCII \SPCSI\		;SPCSIZE
	ASCII \PDLRO\		;PDLROOM
	ASCII \MEMFR\		;MEMFREE
	ASCII \NEWLI\		;NEWLINE
	ASCII \FILEM\		;FILEMODE
	ASCII \TTYTY\		;TTYTYPE
IFN ITS\D20,	ASCII \OSPEE\		;OSPEED
	ASCII \FASLO\		;FASLOAD (RETURNS CURRENT LDBSAR)
IFN USELESS,[
IFN ITS,[
	ASCII \ITS\		;ITS
]		;END OF IFN ITS
]		;END OF IFN USELESS
	ASCII \STATU\		;STATUS
	ASCII \SSTAT\		;SSTATUS
	ASCII \ARRAY\		;ARRAY
LSTBA==.-STBA

SUBTTL	STATUS DISPATCH TABLES

;;; FORMAT  <4.9-4.7> , <4.6-3.8> , <2.9-1.1>
.FORMAT 37,002231104103

RADIX 4

;;; MAGIC TABLE OF STATUS OPERATIONS
;;;	4.9-4.7	OPERATION TYPE
;;;		0	SUBR-TYPE FUNCTION
;;;		1	LSUBR-TYPE FUNCTION
;;;		2	SUBR-TYPE WITH CHAR FIRST ARG
;;;		3	LSUBR-TYPE WITH CHAR FIRST ARG
;;;		4	GET LISP VALUE
;;;		5	SET LISP VALUE
;;;		6	SET TO T-OR-NIL
;;;		7	GET FIXNUM VALUE
;;;	4.6-4.5	ARGUMENT 1 TYPE
;;;		0	NO MORE ARGS
;;;		1	QUOTED ARGUMENT
;;;		2	TAKE REST AS QUOTED LIST
;;;		3	EVALUATED ARGUMENT
;;;	4.4-4.3	ARGUMENT 2 TYPE
;;;	4.2-4.1	ARGUMENT 3 TYPE
;;;	3.9-3.8	ARGUMENT 4 TYPE
;;;	3.7-3.1	ARGS INFO

;;;	.FORMAT 37,002231104103

;;;	RADIX 4


;;; ***** SSTATUS FUNCTION TABLE ***** MUST MATCH ASCII TABLE *****

STBSS:	3,1310,SSMACRO		(FA23)	;MACRO
	6,3000,RWG		(FA1)	;DIVOV
	5,3000,VCTRS		(FA1)	;VECTOR
IT$	1,3333,SSTTY		(FA1234&1333)	;TTY
20$	1,3333,SSTTY		(FA1N&1333)	;TTY
10$ SA%	1,3333,SSTTY	(FA12)		;TTY
10$ SA$	1,3333,SSTTY	(FA1N&1333)	;TTY
	5,3000,TLF		(FA1)	;TOPLEVEL
	5,3000,BLF		(FA1)	;BREAKLEVEL
	0,2000,UREAD		(FA0234);UREAD
	0,2000,UWRITE		(FA012)	;UWRITE
	0,3000,SSPLSS		(FA1)	;+
	0,3300,SSGCMIN		(FA2)	;GCMIN
	2,1300,SSSYNTA		(FA2)	;SYNTAX
	2,1300,SSCHTRA		(FA2)	;CHTRAN
	1,3330,SSTTYINT		(FA23)	;TTYINT
	0,3000,SSGCTIM		(FA1)	;GCTIME
	0,3000,SSLOSEF		(FA1)	;LOSEF
	1,3300,SSTERPRI		(FA12)	;TERPRI
	0,3000,SSLAP		(FA1)	;_
	0,3000,SSTTYREAD	(FA1)	;TTYREAD
	0,1000,SSFEATURE	(FA1)	;FEATURE
	0,1000,SSNOFEATURE	(FA1)	;NOFEATURE
IFN USELESS,	0,3000,SSABBREVIATE	(FA1)	;ABBREVIATE
	0,0000,SSUUOLINKS	(FA0)	;UUOLINKS
	0,3300,SSGCMAX		(FA2)	;GCMAX
IFN PAGING,	0,3300,SSPDLMAX	(FA2)	;PDLMAX
	0,3300,SSGCSIZE		(FA2)	;GCSIZE
	1,3300,SSLINMODE	(FA12)	;LINMODE
20%	0,2000,SSCRFIL		(FA2)	;CRFILE
20$	0,2000,SSCRFIL		(FA23)	;CRFILE
	0,2000,CRUNIT		(FA012)	;CRUNIT
	0,3000,FALSE		(FA1)	;EVALHOOK
	1,3300,SSTTYSCAN	(FA12)	;TTYSCAN
	0,3300,SSTTYCONS	(FA2)	;TTYCONS
	0,3000,SSRANDOM		(FA1)	;RANDOM
IFN USELESS,[
IFN ITS,[
	0,3333,SSWHO1		(FA4)	;WHO1
	0,3000,SSWHO2		(FA1)	;WHO2
	0,3000,SSWHO3		(FA1)	;WHO3
	0,3300,SSMAR		(FA2)	;MAR
	0,3000,SSGCWHO		(FA1)	;GCWHO
]		;END OF IFN ITS
]		;END OF IFN USELESS
	6,3000,EVPUNT		(FA1)	;PUNT
	6,3000,SUSFLS		(FA1)	;FLUSH
IFN USELESS*ITS, 0,3000,SSCLI	(FA1)	;CLI
	0,3000,NOINTERRUPT	(FA1)	;NOINTERRUPT
	0,3000,SSSENDI		(FA1)	;SENDINTERPRETER
	0,3000,SSCALLI		(FA1)	;CALLINTERPRETER
	0,3000,SSUSRHNK		(FA1)	;USRHNK
	6,3000,OLDSXHASHP	(FA1)	;SXHASH
LSST==.-STBSS

IFN LSST-LSSTBA, WARN [WRONG LENGTH SSTATUS TABLE]

;;;	.FORMAT 37,002231104103

;;;	RADIX 4

;;; ***** STATUS FUNCTION TABLE ***** PART 1 (MATCHES STBSS) *****

STBS:	2,1000,SMACRO		(FA1)	;MACRO
	4,0000,RWG		(FA0)	;DIVOV
	4,0000,VCTRS		(FA0)	;VECTOR
	1,3000,STTY		(FA01)	;TTY
	4,0000,TLF		(FA0)	;TOPLEVEL
	4,0000,BLF		(FA0)	;BREAKLEVEL
	0,0000,SUREAD		(FA0)	;UREAD
	0,0000,SUWRITE		(FA0)	;UWRITE
	0,0000,SPLSS		(FA0)	;+
	0,3000,SGCMIN		(FA1)	;GCMIN
	2,1000,SSYNTAX		(FA1)	;SYNTAX
	2,1000,SCHTRAN		(FA1)	;CHTRAN
	1,3300,STTYINT		(FA12)	;TTYINT
	0,0000,SGCTIM		(FA0)	;GCTIM
	0,0000,SLOSEF		(FA0)	;LOSEF
	1,3000,STERPRI		(FA01)	;TERPRI
	0,0000,SLAP		(FA0)	;_
	0,0000,STTYREAD		(FA0)	;TTYREAD
	0,2000,SFEATURES	(FA01)	;FEATURES
	0,2000,SNOFEATURE	(FA1)	;NOFEATURE
IFN USELESS,	0,0000,SABBREVIATE	(FA0)	;ABBREVIATE
	0,0000,SUUOLINKS	(FA0)	;UUOLINKS
	0,3000,SGCMAX		(FA1)	;GCMAX
IFN PAGING,	0,3000,SPDLMAX	(FA1)	;PDLMAX
	0,3000,SGCSIZE		(FA1)	;GCSIZE
	1,3000,SLINMODE		(FA01)	;LINMODE
	0,0000,SCRFIL		(FA0)	;CRFILE
	0,0000,SCRUNIT		(FA0)	;CRUNIT
	0,0000,FALSE		(FA0)	;EVALHOOK
	1,3000,STTYSCAN		(FA01)	;TTYSCAN
	0,3000,STTYCONS		(FA1)	;TTYCONS
	0,0000,SRANDOM		(FA0)	;RANDOM
IFN USELESS,[
IFN ITS,[
	0,0000,SWHO1		(FA0)	;WHO1
	0,0000,SWHO2		(FA0)	;WHO2
	0,0000,SWHO3		(FA0)	;WHO3
	0,0000,SMAR		(FA0)	;MAR
	7,0000,GCWHO		(FA0)	;GCWHO
]		;END OF IFN ITS
]		;END OF IFN USELESS
	4,0000,EVPUNT		(FA0)	;PUNT
	4,0000,SUSFLS		(FA0)	;FLUSH
IFN USELESS*ITS, 0,3000,SCLI	(FA0)	;CLI
	0,0000,SNOINT		(FA0)	;NOINTERRUPT
	4,0000,USENDI		(FA0)	;SENDINTERPRETER
	4,0000,UCALLI		(FA0)	;CALLINTERPRETER
	4,0000,UUSRHNK		(FA0)	;USRHNK
	4,0000,OLDSXHASHP	(FA0)	;SXHASH

IFN .-STBS-LSSTBA, WARN [WRONG LENGTH STATUS TABLE PART 1]

;;;	.FORMAT 37,002231104103

;;;	RADIX 4

;;; ***** STATUS FUNCTION TABLE ***** PART 2 (NON-SSTATUS ITEMS) *****

	4,0000,LDFNAM		(FA0)	;FASLNamelist
	4,0000,[TTYIFA]		(FA0)	;
	4,0000,[TTYOFA]		(FA0)	;
	0,3000,SPURSIZE		(FA1)	;PURSIZE
	0,3000,SPDLSIZE		(FA1)	;PDLSIZE
	0,0000,STIME		(FA0)	;DAYTIME
	0,0000,SDATE		(FA0)	;DATE
IFN USELESS,	0,0000,SDOW	(FA0)	;DOW (DAY OF WEEK)
	1,3000,STTYSIZE		(FA01)	;TTYSIZE
	0,0000,SUNAME		(FA0)	;UNAME
	0,0000,SUSERID		(FA0)	;USERID
	0,0000,SUSERID		(FA0)	;XUNAME
	0,0000,SJNAME		(FA0)	;JNAME
	0,0000,SSUBSYSTEM	(FA0)	;SUBSYSTEM
	0,0000,SJNUMBER		(FA0)	;JNUMBER
IT$	0,0000,SHOMED		(FA0)	;HOMEDIR
IT% 20%	4,0000,SUDIR		(FA0)	;"     "
20$ 	0,0000,SUSERID 		(FA0) 	;"     "
	1,3300,SHSNAME		(FA012)	;HSNAME
	0,0000,SLVRNO		(FA0)	;LISPVERSION
	0,0000,SJCL		(FA0)	;JCL
ifn d20\its, 0,0000,SDDTP	(FA0)	;HACTRN
IFE D20\ITS, 4,0000,SUDIR	(FA0)	;UDIR
IFN D20\ITS, 0,0000,SRCDIR	(FA0) 	;
	7,0000,FXC2		(FA0)	;FXPDL
	7,0000,FLC2		(FA0)	;FLPDL
	7,0000,C2		(FA0)	;PDL
	7,0000,SC2		(FA0)	;SPDL
	7,0000,BPSL		(FA0)	;BPSL (ORIGINAL BPS LOW)
	7,0000,BPSH		(FA0)	;BPS HIGH
	7,0000,[SEGLOG]		(FA0)	;SEGLOG
	0,3000,SSYSTEM		(FA1)	;SYSTEM
	7,0000,IN10		(FA0)	;TABSIZE
	0,0000,SFILES		(FA0)	;FILESYSTEM-TYPE
	0,0000,SOPSYS		(FA0)	;OPSYSTEM-TYPE
	0,0000,SSITE		(FA0)	;SITE
	4,0000,[SPCNAMES]	(FA0)	;SPCNAMES
	4,0000,[PURSPCNAMES]	(FA0)	;PURSPCNAMES
	4,0000,[PDLNAMES]	(FA0)	;PDLNAMES
	0,3000,SSPCSIZE		(FA1)	;SPCSIZE
	0,3000,SPDLROOM		(FA1)	;PDLROOM
	0,0000,SMEMFREE		(FA0)	;MEMFREE
	7,0000,IN0+^M		(FA0)	;NEWLINE
	0,3000,SFILEMODE	(FA1)	;FILEMODE
	1,3000,STTYTYPE		(FA01)	;TTYTYPE
IFN ITS\D20,	1,3000,SOSPEED		(FA01)	;OSPEED
	4,0000,LDBSAR		(FA0)	;FASLOAD
IFN USELESS,[
IFN ITS,[
	0,0000,SITS		(FA0)	;ITS
]		;END OF IFN ITS
]		;END OF IFN USELESS
	1,1000,SSSS		(FA01)	;STATUS
	1,1000,SSSSS		(FA01)	;SSTATUS
	0,0000,SARRAY		(FA0)	;ARRAY
IFN .-STBS-LSTBA, WARN [WRONG LENGTH STATUS TABLE PART 2]

RADIX 8

.FORMAT 37,0	;MAKE FORMAT 37 ILLEGAL AGAIN
