github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-18 09:12:08 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/l/status.265

2347 lines
50 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;;; -*-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
Reference in New Issue View Git Blame Copy Permalink