1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-02 01:30:40 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

568 lines
13 KiB
Plaintext
Raw Permalink 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.
TITLE LNM - TYPE CURRENT LOG NAMES FOR JOBS
; ---------------------------------------------------
;
SEARCH MACTEN,UUOSYM ; SEARCH STANDARD CUSP PARAMETERS
SALL ; CLEAN UP THE LISTING
;
; REGISTER DEFINITIONS
;
F= 0 ; SOME FLAGS
C= 1 ; FOR CHARACTERS
M= 2 ; JOB NUMBER MAXIMUM
T1= 3 ; T TYPE REGISTERS
T2= T1+1
T3= T2+1
Q1= T3+1 ; Q TYPE REGISTERS
Q2= Q1+1
Q3= Q2+1
P1=11
P2=12
P== 17 ; THE STACK POINTER
; MORE DEFINITIONS
;
F.EOL== 1B35 ; ON IF SAW END-OF-LINE
F.NOP== 1B34 ; ON IF SUPPRESSING OPERATOR JOBS
SWP==2000
JLOG== 4 ; JOB LOGGED IN STATUS BIT
STKSIZ==^D20 ; OUR STACK SIZE
X.EOL==1B<.CHLFD>!1B<.CHESC>!1B<.CHFFD>!1B<.CHBEL>!1B<.CHVTB>
; END OF LINE CHARACTERS
;DEF'NS FOR PAGE.
UPTPAG==376
UPT==376000
SPYPAG==377
SPY==377000
LNMPAG==375
LNM==375000
; HERE WE GO!
;
WHO:: JFCL ; ALLOW CCL ENTRY
MOVE [27,,113]
GETTAB ;FIND RELATIVE LOC ON .UPLNM
MOVEI 774 ;PRE 332 LOAD
ADDI 376000 ; +UPMP LOC
MOVEM LNMLOC
MOVE P,[IOWD STKSIZ,STACK] ; INITIALIZE A STACK POINTER
CLEAR F, ; CLEAR THE FLAGS
MOVE T1,[POINT 7,TTYBUF] ; INITIALIZE TTY BUFFER
MOVEM T1,TTYPTR ; POINTER AND...
MOVEI T1,^D80 ; THE COUNT
MOVEM T1,TTYCNT
;
PJOB T1, ; GET THIS JOB NUMBER
MOVEM T1,MYJOB ; SAVE IT FOR DOT REFERENCE
;
MOVX M,%CNSJN ; GET THE NUMBER OF...
GETTAB M, ; JOBS ALLOWED ON THE SYSTEM
JRST BADERR ; OOPS!
HRRE M,M ; ISOLATE JOB COUNT AND EXTEND SIGN
JUMPLE M,DONE ; FOR VERY SMALL SYSTEMS!
SUBI M,1 ; DECR. COUNT TO EXCLUDE NULL JOB...
;
MOVX T1,%CNPTY ; GET THE PTY...
GETTAB T1, ; OFFSET
JRST BADERR ; SHOULD NOT HAPPEN
HLRZM T1,PTYOFF ; SAVE OFFSET
;
MOVX Q1,%CNLNM ; GET THE NUMBER...
GETTAB Q1, ; OF JOBS LOGGED IN
JRST BADERR ; SHOULD NOT HAPPEN
PUSHJ P,DPRNT ; PRINT IN DECIMAL
;
MOVEI Q1,[ASCIZ/ jobs in use out of /]
PUSHJ P,PSTRG ; PRINT MESSAGE
HRRZ Q1,M ; TELL HOW MANY THERE ARE
PUSHJ P,DPRNT ; ...
;
MOVNS M ; GET NEGATIVE MAX NUMBER OF JOBS
HRLS M ; PUT IN LH
HRRI M,1 ; NOW WE HAVE -M,,1
TXO F,F.NOP ; WE DON'T WANT OPERATOR JOBS
MOVEI Q1,[ASCIZ/.
Job Who Program Line PPN
/]
PUSHJ P,PSTRG ; FINISH FIRST MESSAGE & PRINT HEADER
;
LOOP2: HRRZ T1,M ; NEXT JOB NUMBER TO T1
PUSHJ P,PWHO ; PRINT THIS WHO LINE
AOBJN M,LOOP2 ; LOOP TILL DONE
; HERE WHEN DONE
;
DONE: PUSHJ P,FORCE ; DUMP THE TTY BUFFER
HRROI T1,.GTSTS
GETTAB T1,
SETO T1,
TLNN T1,JLOG ; IS THIS JOB LOGGED IN?
JRST DONE1 ; NOPE--NEED TO EXIT WITH LOGOUT
MONRT. ; YES--EXIT QUIETLY
JRST WHO ; DO IT AGAIN IT CONT IS TYPED
;
DONE1: OUTSTR [ASCIZ/
.KJOB
./]
SETZM .JBREN## ; CAN'T REEENTER ANYMORE
LOGOUT ; EXIT
; HERE FOR ERRORS
;
BADERR: MOVEI Q1,[ASCIZ/
? Unexpected error
/] ; BAD ERROR
JRST ERR1 ; MERGE BELOW
ERROR: MOVEI C,"?" ; START MESSAGE
PUSHJ P,PCHAR
MOVEI C,0 ; MAKE A STRING OUT OF INPUT...
IDPB C,LINPTR ; WE USED SO FAR
MOVEI Q1,LINBUF ; POINT TO THAT STRING
PUSHJ P,PSTRG ; OUTPUT IT
MOVEI Q1,[BYTE(7)"?",15,12] ; GET REST AND MERGE
;
ERR1: PUSHJ P,PSTRG ; PUBLISH THE SURPRISE
CLEAR Q2, ; MAKE SURE JACCT IS CLEAR
SETNAM Q2, ; BY CLEARING THE NAME
JRST DONE ; FINISH UP
SUBTTL SUBROUTINE TO PRINT WHO LINE
; ----------------------------
; WHO -- ROUTINE TO PRINT A LINE OF WHO INFORMATION. CALLING
; SEQUENCE IS
;
; MOVE T1,JOB#
; PUSHJ P,PWHO
; RETURN
;
; OPERATOR JOBS ARE SUPPRESSED IF F.NOP IS ON.
;
PWHO: HRLZ Q1,T1 ; JOB# IN LH OF Q1 FOR GETTAB
HRRI Q1,.GTSTS ; JOB STATUS TABLE
GETTAB Q1, ; SUCK IN TABLE ENTRY
JRST BADERR ; YIPE!
;
TLNN Q1,SWP
TLNN Q1,JLOG ; IS JOB LOGGED IN ?
POPJ P, ; NOPE, JUST RETURN
CAMN T1,MYJOB
POPJ P,
;
HRLZ T2,T1 ; JOB # IN T2 AND...
HRRI T2,.GTPPN ; TABLE # FOR PPN'S
GETTAB T2, ; GET-UM
JRST BADERR ; WHY ME?
;
HRLZ Q1,T1
HRRI Q1,.GTUPM
GETTAB Q1,
JRST BADERR
HRRZS Q1
JUMPE Q1,CPOPJ
HRLM Q1,UPTBLK+1
MOVE T3,[11,,DELUPT]
PAGE. T3,
JFCL
MOVE T3,[11,,UPTBLK]
PAGE. T3,200000
HALT
SKIPN P1,@LNMLOC
POPJ P,
PWHO1: MOVE Q1,T1 ; START WITH THE JOB NUMBER
MOVE C,[2,," "] ; PAD WITH SPACES
PUSHJ P,DPRNT ; PRINT THE JOB NUMBER
;
PUSHJ P,PSPAC ; SEPARATE WITH A SPACE
PUSHJ P,PSPAC ; AND ANOTHER ONE
;
HRLZ Q1,T1 ; AGAIN WE SET..
HRRI Q1,.GTNM1 ; UP Q1 FOR GETTAB
GETTAB Q1, ; GET FIRST PART OF USER'S NAME
JRST BADERR ; GAK!
PUSHJ P,SPRNT ; PRINT IT
;
HRLZ Q1,T1 ; THE SAME OLD...
HRRI Q1,.GTNM2 ; STUFF FOR THE...
GETTAB Q1, ; SECOND PART OF THE NAME
JRST BADERR ; GAK! (AGAIN)
PUSHJ P,SPRNT ; PRINT
;
PUSHJ P,PSPAC ; ANOTHER SPACE
;
HRLZ Q1,T1 ; GET JOB NUMBER AGAIN
HRRI Q1,.GTPRG ; GETTAB FOR PROGRAM NAME
GETTAB Q1, ; GET NAME OF PROGRAM HE'S RUNNING
JRST BADERR ; OOPS
PUSHJ P,SPRNT ; PRINT IT
;
PUSHJ P,PSPAC ; PRINT A SPACE
PUSHJ P,PSPAC ; AND ANOTHER
;
MOVE Q1,T1 ; JOB NUMBER TO Q1...
TRMNO. Q1, ; AND GET THE TERMINAL NUMBER
JRST TDET ; MUST BE DETACHED JOB
GETLCH Q1 ; GET LINE CHARACTERISTICS
TXNE Q1,GL.CTY ; IS IT THE CTY?
JRST TCTY ; YES!
MOVE C,[4,," "] ; NO--ASSUME A TTY
TXNN Q1,GL.ITY ; IS THIS A PTY?
JRST PWHO2 ; NOPE--WE WERE RIGHT
;
ANDI Q1,777 ; YES--CLEAN UP AND
SUB Q1,PTYOFF ; MAKE A PTY NUMBER
CAIGE Q1,100 ; PAD THE...
PUSHJ P,PCHAR ; PTY NUMBER...
CAIGE Q1,10 ; JUST A...
PUSHJ P,PCHAR ; LITTLE BIT
MOVEI C,"P" ; GET A "P"
PUSHJ P,PCHAR ; PRINT IT
CLEAR C, ; NO MORE PADDING
JRST PWHO2 ; GO PRINT PTY NUMBER
;
TDET: MOVEI Q1,[ASCIZ/ DET/]; HERE IF JOB IS DETACHED
SKIPA
TCTY: MOVEI Q1,[ASCIZ/ CTY/]; HERE IF JOB IS AT THE CTY
PUSHJ P,PSTRG ; PRINT INDICATOR
JRST PWHO3 ; MERGE BELOW
PWHO2: ANDI Q1,777 ; INSURE CLEAN TERMINAL NUMBER
PUSHJ P,OPRNT ; TERMINAL # IS OCTAL
PWHO3: PUSHJ P,PSPAC ; SPIT OUT A BLANK
;
HLRZ Q1,T2 ; PROJECT NUMBER TO Q1
MOVE C,[6,," "] ; PAD WITH SPACES
PUSHJ P,OPRNT ; PRINT IT IN OCTAL
MOVEI C,"," ; SEPARATE WITH...
PUSHJ P,PCHAR ; A COMMA
HRRZ Q1,T2 ; DITTO FOR PROGRAMMER NUMBER
CLEAR C, ; NO PADDING
PUSHJ P,OPRNT ; ...
;
MOVE T3,[11,,DELLNM]
PAGE. T3,
JFCL
MOVE T3,P1
PUSHJ P,VRT2PH
HRLM T3,LNMBLK+1
MOVE T3,[11,,LNMBLK]
PAGE. T3,200000
HALT
ANDI P1,777
ADDI P1,LNM
PUSHJ P,PCRLF
PWHO4: SKIPN P2,(P1)
POPJ P,
MOVE T3,P2
PUSHJ P,VRT2PH
HRLM T3,FUNBLK+1
MOVE T3,[11,,DELSPY]
PAGE. T3,
JFCL
MOVE T3,[11,,FUNBLK]
PAGE. T3,200000
HALT
MOVE T3,P2
ANDI P2,777
ADDI P2,SPY
SKIPGE T3
SKIPA C,[5,," "]
MOVE C,[6,," "]
PUSHJ P,PRPAD
JFCL
MOVEI C,"*"
SKIPGE T3
PUSHJ P,PCHAR
MOVE Q1,(P2)
CAMN Q1,[-1]
MOVE Q1,[SIXBIT /LIB*/]
PUSHJ P,SPRNT
MOVEI Q1,[ASCIZ /:=/]
PUSHJ P,PSTRG
PWHO5: MOVE Q2,1(P2)
PUSHJ P,LPRNT
MOVEI Q1,[ASCIZ /:[/]
PUSHJ P,PSTRG
SETO C,
HLRZ Q1,2(P2)
PUSHJ P,OPRNT
MOVEI C,","
PUSHJ P,PCHAR
HRRZ Q1,2(P2)
SETO C,
PUSHJ P,OPRNT
ADDI P2,3
PWHO6: SKIPN Q2,(P2)
JRST PWHO7
MOVEI C,","
PUSHJ P,PCHAR
PUSHJ P,LPRNT
AOJA P2,PWHO6
PWHO7: MOVEI C,"]"
PUSHJ P,PCHAR
SKIPN 1(P2)
JRST PWHO8
MOVEI C,","
PUSHJ P,PCHAR
JRST PWHO5
PWHO8: PUSHJ P,PCRLF
AOJA P1,PWHO4
PCRLF: MOVEI Q1,[BYTE(7)15,12]; FINALLY, CRLF...
PJRST PSTRG ; OUTPUT IT AND RETURN
VRT2PH: HRRZS T3
LSH T3,-11
ADDI T3,440
ROT T3,-1
TLZE T3,400000
TLOA T3,001500
TLO T3,221500
ADDI T3,UPT
LDB T3,T3
POPJ P,
SUBTTL OUTPUT ROUTINES
; ---------------
; DPRNT -- PRINT DECIMAL NUMBER WITH LEFT PADDING.
; OPRNT -- PRINT OCTAL NUMBER WITH LEFT PADDING.
; CALLING SEQUENCE FOR THE ABOVE IS:
;
; MOVE Q1,NUMBER
; MOVE C,[FIELD SIZE,,PAD CHARACTER]
; PUSHJ P,-PRNT
; RETURN
;
OPRNT: SKIPA Q3,[^D8] ; OCTAL
DPRNT: MOVEI Q3,^D10 ; DECIMAL
PRNT1: SUB C,[1,,0] ; DECREMENT FIELD WIDTH
IDIV Q1,Q3 ; DIVIDE BY PROPER BASE
HRLM Q2,(P) ; STASH REMAINDER
SKIPN Q1 ; DONE YET ?
PUSHJ P,PRPAD ; YES--PRINT PADDING AND SKIP
PUSHJ P,PRNT1 ; NO, CONTINUE RECURSIVELY
HLRZ C,0(P) ; RETRIEVE A CHARACTER
ADDI C,"0" ; CONVERT TO ASCII
PJRST PCHAR ; OUTPUT IT AND UNWIND
; PRPAD -- PRINT PADDING CHARACTER. CALLING SEQUENCE IS
;
; MOVE C,[NUMBER OF CHARACTERS,,PAD CHARACTER]
; PUSHJ P,PRPAD
; NEVER RETURNS HERE
; ALWAYS GIVES SKIP RETURN
;
PRPAD: HLRE Q1,C ; GET NUMBER OF CHARACTERS
SOJL Q1,CPOPJ1 ; QUIT WHEN DONE
PUSHJ P,PCHAR ; PRINT CHARACTER
JRST .-2 ; CONTINUE
CPOPJ1: AOS (P) ; SET TO GIVE SKIP RETURN
POPJ P, ; RETURN
; SPRNT -- PRINTS THE 6 SIXBIT CHARACTERS IN Q1. CALLING
; SEQUENCE IS
;
; MOVE Q1,WORD OF SIXBIT
; PUSHJ P,SPRNT
; RETURN
;
SPRNT: MOVEI Q3,6 ; THERE ARE 6 CHARACTERS
SPRNT1: ROTC Q1,6 ; ROTATE A SIXBIT CHAR TO Q2
ANDI Q2,77 ; CLEAN IT UP
MOVEI C," "(Q2) ; CONVERT TO ASCII AND PUT IN C
; CAIL C,"A" ; FOLD TO LOWER CASE OF COURSE!
; CAILE C,"Z"
; SKIPA ; DAMN IT
; ADDI C,40 ; MAKE IT PRETTY
PUSHJ P,PCHAR ; OUTPUT IT
SOJG Q3,SPRNT1 ; CONTINUE FOR 6 CHARACTERS
POPJ P, ; RETURN
LPRNT: SETZ Q1,
LSHC Q1,6
SKIPN C,Q1
POPJ P,
ADDI C," "
PUSHJ P,PCHAR
JRST LPRNT
; PSTRG -- PRINT AN ASCIZ STRING. CALLING SEQUENCE IS
;
; MOVEI Q1,ADDR OF STRING
; PUSHJ P,PSTRG
; RETURN
;
; USES C.
;
PSTRG: HRLI Q1,(POINT 7) ; MAKE A BYTE POINTER
PSTRG1: ILDB C,Q1 ; GET A CHARACTER
JUMPE C,CPOPJ ; RETURN IF DONE
PUSHJ P,PCHAR ; OTHERWISE OUTPUT IT
JRST PSTRG1 ; AND CONTINUE
; PSPAC -- PRINT A SPACE. CALLING SEQUENCE IS
;
; PUSHJ P,PSPAC
; RETURN
;
PSPAC: MOVEI C," " ; GET A SPACE
; PJRST PCHAR ; FALL INTO PCHAR
; PCHAR -- PRINT A CHARACTER. CALLING SEQUENCE IS
;
; MOVE C,CHARACTER
; PUSHJ P,PCHAR
; RETURN
;
; PRESERVES ALL AC'S.
;
PCHAR: SOSG TTYCNT ; DECREMENT AND TEST COUNT
PUSHJ P,FORCE ; DUMP BUFFER
IDPB C,TTYPTR ; STASH CHARACTER
POPJ P, ; RETURN
; FORCE -- DUMP TTY BUFFER. CALLING SEQUENCE IS
;
; PUSHJ P,FORCE
; RETURN
;
; PRESERVES ALL AC'S.
;
FORCE: PUSH P,C ; SAVE C
MOVEI C,0 ; GET A ZERO CHARACTER
IDPB C,TTYPTR ; DEPOSIT IT
OUTSTR TTYBUF ; DUMP STRING
MOVE C,[POINT 7,TTYBUF] ; GET NEW POINTER
MOVEM C,TTYPTR ; INSERT IT
MOVEI C,^D80 ; GET NEW COUNT...
MOVEM C,TTYCNT ; AND INSERT IT
POP P,C ; RESTORE C
CPOPJ: POPJ P, ; RETURN
SUBTTL INPUT ROUTINES
; --------------
; GETLIN -- READ A LINE OF INPUT INTO THE LINE BUFFER AND SET UP LINPTR
; AND LINCNT. GETS EVERYTHING UP TO A VERTICAL MOTION CHARACTER.
; CALLING SEQUENCE IS
;
; PUSHJ P,GETLIN
;
GETLIN: MOVE Q1,[POINT 7,LINBUF] ; SET UP POINTER
MOVEM Q1,LINPTR
CLEARM LINCNT ; CLEAR COUNT
;
GETLN1: INCHWL C ; GET A CHARACTER
IDPB C,Q1 ; STUFF IT INTO LINE BUFFER
AOS LINCNT ; BUMP COUNT
PUSHJ P,CHKTR1 ; CHECK FOR TERMINATOR
POPJ P, ; GOT ONE!
JRST GETLN1 ; KEEP TRYING
; GETSIX -- INPUT NEXT SIXBIT IDENTIFIER OR NUMBER. CALLING
; SEQUENCE IS
;
; PUSHJ P,GETSIX
; RETURN--Q1 CONTAINS SIXBIT ID AND BREAK CHAR. IS IN C
;
GETSIX: MOVE Q3,[POINT 6,Q1] ; SET UP FOR CONSTRUCTING ID
SETZ Q1,
;
PUSHJ P,GTNBLK ; GET FIRST NONBLANK CHARCTER
CAIA ; CHARACTER IN C ON FIRST PASS
GTSX1: PUSHJ P,GETCHR ; GET A CHARACTER
MOVE Q2,[042360,,001400] ; LOAD BREAK TABLE
LSH Q2,(C) ; CHECK FOR A BREAK
JUMPL Q2,CPOPJ ; RETURN NOW IF A BREAK
;
MOVE Q2,C ; COPY CHARACTER
CAIGE Q2,140 ; CONVERT TO SIXBIT
SUBI Q2,40
TRZ Q2,777700
;
CAIL Q2,'0' ; SKIP IF TOO SMALL
CAILE Q2,'Z' ; IF IN PERMITTED RANGE
POPJ P, ; RETURN NOW
CAILE Q2,'9' ; SKIP IF A NUMBER
CAIL Q2,'A'
SKIPA
POPJ P, ; NOT ALPHANUMERIC
;
TRNN Q1,77 ; DO WE ALREADY HAVE 6?
IDPB Q2,Q3 ; NOPE--STASH CHARACTER
JRST GTSX1 ; LOOP FOR MORE
; GTNBLK -- GET NEXT NONBLANK CHARACTER.
; GNBLK1 -- GET NEXT NONBLANK CHARACTER ASSUMING FIRST CHARACTER IS
; IN C. CALLING SEQUENCE IS
;
; PUSHJ P,GTNBLK OR GNBLK1
; RETURN--C CONTAINS CHARACTER
;
GTNBLK: PUSHJ P,GETCHR ; GET A CHARACTER
GNBLK1: CAIE C,.CHTAB ; TABS AND...
CAIN C," " ; BLANKS ARE IGNORED
JRST GTNBLK
POPJ P,
; GETCHR -- GET A CHARACTER FROM THE LINE BUFFER. CALLING SEQUENCE IS
;
; PUSHJ P,GETCHR
; RETURN--C CONTAINS CHARACTER
;
; IGNORES CARRAIGE RETURN.
;
GETCHR: SOSGE LINCNT ; DECREMENT COUNT AND TEST
SKIPA C,[.CHLFD] ; END OF LINE, KEEP RETURNING LINE FEEDS
ILDB C,LINPTR ; GET A CHARACTER FROM LINE BUFFER
CAIN C,.CHCRT ; CARRIAGE RETURN?
JRST GETCHR ; YES--IGNORE IT
POPJ P, ; NO--RETURN
; CHKTRM -- CHECK FOR A TERMINATOR, A END OF LINE CHARACTER OR A SEMI-
; COLON. CHKTR1 OMITS THE SEMICOLON. CALLING SEQUENCE IS
;
; MOVE C,CHARACTER
; PUSHJ P,CHKTRM OR CHKTR1
; RETURN--C CONTAINS A TERMINATOR
; SKIP RETURN--C DOES NOT CONTAIN A TERMINATOR
;
; PRESERVES ALL AC'S.
;
CHKTRM: CAIN C,";" ; SEMICOLON?
POPJ P, ; YES
CHKTR1: PUSH P,Q1 ; SAVE A REGISTER
MOVX Q1,X.EOL ; GET END OF LINE BITS
LSH Q1,(C) ; SHIFT TO SIGN BIT
SKIPL Q1 ; IF ONE, WE GOT ONE
AOS -1(P) ; NOPE, BUMP RETURN POINT
POP P,Q1 ; RESTORE Q1
POPJ P, ; RETURN
SUBTTL DATA
; ----
UPTBLK: 1
UPTPAG
FUNBLK: 1
SPYPAG
LNMBLK: 1
LNMPAG
DELLNM: 1
SETZ LNMPAG
DELSPY: 1
SETZ SPYPAG
DELUPT: 1
SETZ UPTPAG
LNMLOC: BLOCK 1
MYJOB: BLOCK 1 ; JOB NUMBER
PTYOFF: BLOCK 1 ; PTY OFFSET
STACK: BLOCK STKSIZ ; THE STACK
TTYPTR: BLOCK 1 ; TTY BUFFER POINTER
TTYCNT: BLOCK 1 ; CHARACTER COUNT
TTYBUF: BLOCK ^D80/5+1 ; THE TTY BUFFER
LINCNT: BLOCK 1 ; THE INPUT COUNT
LINPTR: BLOCK 1 ; INPUT LINE POINTER
LINBUF: BLOCK ^D140/5+1 ; INPUT LINE BUFFER
END WHO