;;; -*-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: ; ;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 ) RETURNS A LIST OF NUMBERS CONCERNING THE TTY: ;;; FOR ITS: ( ) ;;; FOR D10: ( ) ;;; FOR SAIL: ( ;;; ;;; ) ;;; FOR D20: ( ;;; ;;; ;;; ;for VTS systems ;;; ) ;;; RETURNS NIL IF 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 ... ) SETS THE ;;; TTY STATUS WORDS FOR (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 = <*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>*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 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 MOVEI T,TOFLOK UNLOCKI CAIE B,TRUTH JRST SSTC2 HRRZ B,V%TYI ;FOR SECOND ARG OF T, USE TTY TLNN TT,TTS ; 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 ( . ) 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 ( . ) 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+ 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