perm filename STATUS[NEW,LSP] blob sn#575434 filedate 1981-03-24 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00036 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	   -*-MIDAS-*-
C00006 00003
C00008 00004
C00010 00005
C00011 00006
C00016 00007
C00023 00008
C00024 00009
C00028 00010
C00031 00011
C00035 00012
C00038 00013
C00040 00014
C00042 00015
C00043 00016
C00045 00017
C00047 00018
C00048 00019
C00049 00020
C00052 00021
C00054 00022
C00057 00023
C00061 00024
C00064 00025
C00067 00026
C00070 00027
C00072 00028
C00075 00029
C00077 00030
C00079 00031
C00082 00032
C00085 00033
C00087 00034
C00090 00035
C00093 00036
C00097 ENDMK
C⊗;
;;;   -*-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
λ`"∩%α∩bNR
_h(&6⎇2∃α⊃bBI$$KZ≡⊗Q¬"ε
2*α⊗:R∃H4(&e~!α⊃c	L4(L
N!α"a5EHhP&R2zα⊃1DhP&"J∀Iα⊃1D1$4(Lj>Z⊗jα⊃2N<rε∞,HIn"ε≤Yα~>∩αεJ≡~α∞"⊗≤Z&:≤hP&6>4*%α¬bBεIJ
H4(&lzZ⊗%¬"Q2N<rε∞,hP&*J≥!α~↑t
∞,4SZJ⊗R-∩9α"-∩∃α~∀z5α~<rε∞-∧J→αε∀:Mα>\
d4*≥"εQEPJ"JJRα¬1"
H$%n≤"Iαε∀:Mα2M~P4(LBJ2%¬⊃1QEβ⊃A@4PJBVNBα~bAe⊂$%n∃JR∃α∧z&:R-⊃αR=∧
J≡M∧"⊗N∞∀JBR>∃_4(&¬*N!α5BA2I;$%n≤zV:R-⊃α~>∩αεJ≡_h*NR
!Ih&U*6B∃∧	2NR
!X$%\RV6A∧J→α:zα6>J*αεJ≡_h(&B-~!αAdλ4(&DbJiα
a"¬$HIn⊗2≤)α≡⊗"α:⊗b"αεJ≤hP&&2$⊃αQ1k	"~bαH$%n<*Qαε∀9α∩⊗≤~J&B$zH4(LRJNQαq-E""H4(%∧RJNQ¬~RεQ0H%mAαα⊗:⊃∧z→αε∀:L4(Jα*JN"αNRε#_$%m
↓αFV⎇"⊗⊃α
∩≤4(Jα*JN"αNRε#@$%m∩↓αFV⎇"⊗⊃αdJNQα|1αJ⊗≥ 4(&¬*N")¬↓2⊗Z`$%m~↓α⊗ZbVεR,!αεJ8h*NR
!Mh&-B∞!α
a"A$HIn2⊗
2∃αε∀9α>9¬α∩04PJ"JJRα¬1"
H4(&≤zMαQbB~bAHH%n∞⎇*:Qα
∩≡L4PJ∞ε6bαQ2b~iP$%\r=α6⎇∩∃αRD
9α~⎇*Iαεdb>↑⊗ h(%αU∩NQα≥"εQHHIm↓",r2⊗N~α&QαM→αε9∧bNV
∩H4(&lzZN%¬"Q1A∪↓AA@HIn~>∩αε9αe~V
IbαεJJr≡∃α4zH4(L
∩∩	¬"Q15
B~bAHH%mα$B∃α2
~Qαε∀9αNB,→αR=∧∩∃αJ-*N⊗⊂hP&2∩∩αRQ2[!EAMβ↓11"%!&t%]~⊗∃α<B⊗R"-⊃α&Q=→αJ⊗b2eαqα2N,∩H4(L~ε&∃¬"Q1DhP%α∞J9αR"aL4(J↓α*J≥!αNR
!H4*≥"εQYPJB>A∧2bA2 H%m5b→α>→∧
J≡Mph(&B⎇↓α~bαb_$%]∩!α&~αε∩∩∀*NMα|1αRε∀b∃α⊗u"Jd4PJ2∩	¬"Q2m#	AMAαa1"→Mh%n≡-!αNR
"VMα≥*
Iα$JNBε$~!αRMα∀4*≥"εQZP&"J∃Qα⊃1D1$4(LRJNQ¬~RεQ:BRQ$hP4*N$
Q]hLRNAα∩bB∩2⊃"Q$HImA↓¬~V
Im"fB∃∧2V:∞$J>84PJ*JN"↓"⊃$HImE↓∧bNV
∩jRfB*α~V:≥"&>8hP&*J≥!αNR≤~ $%[⊃↓αN,∩I6RMα∃α↑M"!α∞D
Iαε∀84(&U∩NQα≥"N∞ HImM↓∧bNV
∩jRfB*α↑&RBα∞"ε∩αεJ≤hP&*J≥!αNR≤:Zε0HImQ↓∧:⊗QαdJNAα4
2V∀hP&*J≥!αNR≥~Zε0HImU↓¬~⊗QαdJNAα4
2V∀hP&*J≥!αNR≥~R:&`H%mYααN⊗Q¬"=αQlzI6:L`4(&lzZ∃α%!1"⊃HH%m]αα≡⊗Q∧2&b:,iαZεe*∀4(LRJNQ∧2&aDhP4*N$
QahLj>Z∃∧	1"AHh(&N-"j5↓E↓$4(LRJNQ¬~RεQ_h(04*≥"N≡Zah&"∃∩iα¬bB⊃$4T~FNN$
RVMPJB>BRαA2F≥~RεR-_4(4U~RNN4
1h&∧zAαAdλ4(&U~AαQeα∩2:lX4*N%~NYEPJ6>Z,iα¬1D!$4(Mα>B)¬↓04(hRNRN≥":&1PJB>A¬↓2∧4PJBVNDQαA2tzR:> h(&*∃~QαN%~NYDhP4*N$b>>-PJBVNDQαA2∧r≡⊗PHIn2>|YαVAβ)α∞"
∩Mα&rαRε
d(4(&DbJiα
a"¬$HIn→α≤
fMα<B⊗R"-⊃αNR
"VMα⎇⊃αNN$
RVLhP&6>4)αRQbB¬$$KZN.&αα>9α≥*∞∞⊗≥→1α2,
Z&::αB>&u"⊗IαLqαH4PJ6>Z≤IαI1lbNR
λh(&∞J∃α→e
NRε%*L4(Jα6>Z≤IαI1lbNNR∀λ4*N$b-EhL~ε69¬"Q2N$∩¬"IHh(%αU∩NQα∧zB)DhP&ε>∀R9αIe~R2-λh(&B⎇α)αA`h(4*≥"N∞!PJBVNBα~bAd04(&¬*N!α5BA2PhP&ε∩$IαQ1
BA$4PJ"JJRα¬1""H4(&U~AαQe~BεR|h4(%∧RJNQ¬~RN∞Cλ4(&¬*N")¬↓2B:<*P4(LB2Ji∧	1"¬Hh(&6⎇2∃αR"a"¬$hP&2NBαRQ1k→T4(LRNAα"b~b∞|rL4(LRJNQ¬~RN∞C⊂4(4U~RN∞C	h&B-~")ααb⊗Zε`h(&*≥↓αQ25B:YDhRNRN≤AIh&lzZ∃α"a"~bαH4(&"∩%α"aE"AHh(&"∃∩5α¬bBQ$4PJB>A∧2bA2 h(&B⎇↓α~bαb_4(Lb∩	α%!2mQ↓MAAba"→&hh(&N,∩%αR"aH4(LRJNQ¬~RεQ4λ4(04*≥*
RRbαNRε%*Mα~,
RVJ-→α~⊗
"VJ∃∧r>~⊗
"VJ∃bαNNR
"VM1∧
JJεHh(4*≤r>~⊗
"VJ∃Ph(&B-~!αAd~:>PhRN~⊗
"VJ∃Ph(&"∃∩iα	d2⊗εR-∩⊗L4PJ*V6∧)α¬2∃∩⊗R(hP&"2∃Qα¬1D	$4(MαVN"RαA26,jED4PJ*JN"α:>RtzP4(hRNN~,
RVJ+P4(&¬*N!ααb∧4(LBJJi∧⊃2~⊗
"VJ⊗_h(&B-~")ααb6⊗6λ4(&U*6B9∧	2NN4*¬H4PJ"JJRα¬1"αH4(&E∩Jiα∩b~⊗ε%*J⊗LhP&BV≤B)αAd~>:LhRNN~,	Eh&lzZ⊗5∧	2~⊗
"VJ⊗_h*NN4*¬IhLRJNQ¬α>BεPh(4*≥~:>~,
RVJ+P4(&¬*N!ααb∧4(LBJJi∧⊃2~⊗
"VJ⊗_h(&B-~")ααa:∩⊗eλ4(&U∩NQα≥~~⊗¬λh(4*≥~NN2+P&B>ααA2∧hP&BV≤B)αAe~R2>|X4(%∧RJNQ∧2ε2N(h(&*∃~QαR∃*∀4(hRNNN≥→h&N\JB¬α2b∞FN≥"εRV_h*NN≥→h%αlzZ⊗%∧12FN$
RVLhP&*Vmα9αQe~NNNe(4(&¬*N!ααbI]@hP&∞εLqα→2
~RεR-_4(%¬~.&B
α→2mlbNR

a2t4PI↓α6⎇2N%α2a62N≥"
∧4U~NNN≠	h&6⎇2∃αQe~R
¬D1$4(Lj>Z⊗jαQ2Bt∩V_4PJN⊗R|iα2Bt04(&lzZ⊗%∧→2B:∃*_4(MαVN"RαA2JLrR⊗Jph(&6⎇2∃α	bBA$4PJBVNDQαA2≤z:L4PJ6>Z,iα	1E↓$4(L
>
*rα→2N≥~NMDhP&*J≥!αB>∧
(4(hQnNR
"VMα
∩Jεe¬∩⊗RV∀rMα¬∧b&NQ∧z→α~⎇*Iα:,j
⊗J≠P4)mα↓r6&r↓
α>2α∩&6≠q↓r6
A↓
α|1α∩&m→y↓rlJ9αεDJMα2,r≡R!r↓r6εBαεb&~α2⊗:="!x4SZR"∃∧b&NQ∧JMα~∀*N"2Jα∞>:≤*⊃α>rα⊗ε∞Bα∞ε2baαε:"α6εe∧∩∃α∩-~RJV≥"&Z2Jα6>∩L2&⊗⊂hRNεJ∀
eh&≤*Riα∩`$$%]~RεJ"α↑&RBα:&0hP&6>4*%αR"a]]];9\$%\
BBJ⎇B&6ε$J>9α|1α6εDJ6V5∧
b&M∧b⊗:≡$@4(&U~AαQd2b∞>u_4(&U~AαQb*∞>:_h(&6⎇2⊗%α∩b&9DhP&*NααQ1⊗D~>:LhP&6>4*%α	dJ9T4PJ*NA¬!1⊗b≤z:L4PJ6>Z,Iα	2LqD4(LRJNQ¬B∞>:_H%n∞|rMαVαα~&:aα:Vl∩⊗Iα$B⊗9α∀*RVJph(04*≥*
RR`JNRε%*M↓-bαNRε%*Mα∞E"Jε9bαNRε%*MαNLrRε`hP4(4U~NB2≥→h&6⎇2⊗%α~bJ⊃bph(&N\JB∃αλh(%αlzZ⊗%∧→2J⊃E84(&lzZ⊗5∧→2J∩|∩)`4U~B2N≠P&6>4)α¬2∀">
)@h(&N,∩%α¬e∩⊃b8hP&*J≥!α:>$r>P4Ph*N∞E"Jε9Ph(&N\JB¬α2bnN.Mα¬αR"a"RQMh4*N≥J:RεCP4*::(%α6⎇2N%α2a""2∃QαRQbBRQ%Hh*:] Iα6>4)α→2\b∩	α%!2mE→MAA]"Q11¬jt4(MαVN!¬↓2∞~MAD4(M~⊗Ri∧
IE0HIn∞J|~,4(LRJNQ¬~NNfsλ4(
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
	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
	SKIPE 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:	HRRZ AR1,(P)		;LSUBR
	CAIN AR1,TRUTH		;LAST ARG T => DEFAULT TTY
	 HRRZ 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
	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
	 SFMOD			;UPDATE JFN MODE WORD
	 MOVEM D,TI.ST3(TT)
	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 SRCDIR	
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,V%TYI
	  POP P,AR1
	POP P,A
	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 R,[XACTW]
	 SKIPA R,[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,[
	MOVEI D,770000		;BITS 18.-23. ARE FOR WAKE-UP CONTROL
	ANDCAM D,TI.ST3(TT)
	IORM R,TI.ST3(TT)
]	;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 A,[440600,,[LVRNO]]
	JRST READ6C

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,


SLINMODE:	MOVSI F,FBT<LN>
	SKIPN T
	 SKIPA AR1,V%TYI
	  POP P,AR1
	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 .+3
	 JRST .+2
	JRST FALSE
]	;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 .+4
	 JRST .+3
	POP P,A
	JRST FALSE
]	;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:	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

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

IFN ITS\D20,[

STTYTYPE:
	TDZA F,F
STTYSIZE:
	 MOVEI F,1
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
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
STTYS2:	UNLOCKI
	JRST FIX1

STTYS1:
20$	MOVE D,FO.LNL(TT)	;TERMINAL LENGTH
20$	MOVE TT,FO.RPL(TT)	;TERMINAL WIDTH
	UNLOCKI
	JSP T,FXCONS
	MOVEI B,(A)
	MOVE TT,D
	JRST CONSFX

]		;END OF IFN ITS\D20

;OSPEED - RETURNS TTY OUPUT SPEED VARIABLE
SOSPEED:
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	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


;TTYCOM, TTYOPT, TTYTYP NOT RETRIEVED



;; D10 version OF STTYTYPE and STTYSIZE

IFN D10,[
STTYTYPE:
IFE SAIL,[
	SKIPE T
	 POPI P,1
	JRST 0POPJ		;ALWAYS ZERO (?)
]		;END OF IFE SAIL
IFN SAIL,[
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
	PUSHJ P,D10TNM		;GET TTY NUMBER IN D
	GETLIN D		;GET LINE CHARACTERISTICS
	UNLOCKI
	HLRZ T,D
	TRZ T,150777		;MASK OUT ALL NON-TTY-TYPE BITS
	JFFO T,.+2
	 SETZ TT,
	JRST FIX1
]		;END OF IFN SAIL

STTYSIZE:
	SKIPN T
	 SKIPA AR1,V%TYO
	  POP P,AR1
	PUSHJ P,TOFLOK
IFN SAIL,[
;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
STTYS1:	UNLOCKI
	JSP T,FXCONS
	MOVEI B,(A)
	MOVE TT,R
	JRST CONSFX

;;; 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 A,(AR1)
	MOVEI B,QTTYSCAN
	MOVEI C,NIL		;special signal to read-out the "ttyscan"
	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
	POP P,A			;GET THE ARG
	JSP T,%NCONS		;TURN IT INTO A LIST
	MOVEI C,(A)		;AS THE ARG TO THE SFA
	MOVEI B,QTTYSCAN
	MOVEI A,(AR1)
	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
	 HRRZ AR1,V%TYI		;PREFER INPUT TTY
IFN SFA,[
	JSP TT,XFOSP
	 JRST STCON1
	 JRST STCON1
	MOVEI TT,SR.CNS		;IF SFA, THEN GET THE TTYCONS SLOT 
	HLRZ A,@TTSAR(AR1)
	UNLKPOPJ
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)
	UNLKPOPJ
	JRST ISTCSH
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
	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
	JSP T,CHNV1
	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,26.		;TOPS-20 ONLY SUPPORTS TO ↑Z
	  JRST UNLKTRUE		;RETURN TRUE, BUT DON'T DO TELL THE OP SYS
	MOVE T,V%TYI		;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)!]
]	;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
	JUMPLE R,SSRAN0
	CAILE R,LRBLOCK+1
	 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 \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)
IT$	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
	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
	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)	;HOMEDIR
20$ 	0,0000,SRCDIR 		(FA0) 	;
	1,3300,SHSNAME		(FA012)	;HSNAME
	0,0000,SLVRNO		(FA0)	;LISPVERSION
	0,0000,SJCL		(FA0)	;JCL
IT$	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
IT$	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
ββ