1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-03-06 02:58:54 +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

352 lines
11 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 GALDPY -- Program to display information from QUASAR
SUBTTL Larry Samberg 14 Feb 78
SEARCH GLXMAC ;SEARCH GALAXY SYMBOLS
PROLOG(GALDPY) ;GET NECESSARY SYMBOL DEFS
SEARCH QSRMAC ;AND SEARCH QUASAR SYMBOLS
DPRVER==1 ;MAJOR VERSION NUMBER
.REQUIRE DPYPAK ;GET DISPLAY PACKAGE
SUBTTL Local Definitions
M=13 ;MESSAGE RECEIVED
AP=16 ;ARGUMENT POINTER FOR FORTRAN SUBR
SUBTTL Local Pure and Impure Storage Definitions
IB: $BUILD IB.SZ
$SET(IB.PRG,,%%.MOD)
$SET(IB.OUT,,T%TTY)
$SET(IB.PIB,,PIB)
$EOB
PIB: $BUILD PB.MNS
$SET(PB.HDR,PB.LEN,PB.MNS)
$EOB
CM: $BUILD COU.SZ
$SET(.MSTYP,MS.TYP,.QOCOU)
$SET(.MSTYP,MS.CNT,COU.SZ)
$EOB
SAB: $BUILD SAB.SZ
$SET(SAB.LN,,COU.SZ)
$SET(SAB.MS,,CM)
$SET(SAB.SI,,<SI.FLG+SP.QSR>)
$EOB
PDL: BLOCK ^D200 ;PUSHDOWN LIST
BUFSIZ==^D200
BUFFER: BLOCK BUFSIZ ;TEXT BUFFER FOR ONE LINE
BUFPTR: BLOCK 1 ;BUFFER POINTER
JOBS: BLOCK 4 ;JOB NUMBERS OF OTHER GALAXY JOBS
LUPSEC: BLOCK 1 ;NUMBER OF SECONDS / LOOP
CNTLUP: BLOCK 1 ;NUMBER OF TIMES TO LOOP FOR BEFORE
; SENDING A COUNT MESSAGE TO QUASAR
FIRST: EXP 0 ;FIRST-TIME-THROUGH FLAG
PROGS: SIXBIT/ORION/
SIXBIT/PULSAR/
SIXBIT/BATCON/
SUBTTL Main Loop
GALDPY: MOVE P,[IOWD ^D200,PDL] ;SETUP UP PUSH DOWN LIST
SKIPN FIRST ;IS THIS THE FIRST TIME THROUGH ??
PUSHJ P,GETJOBS ;YES,,GO GET THE JOB NUMBERS
SETOM FIRST ;RESET THE FIRST TIME THROUGH FLAG
RESET ;RESET EVERYTHING
MOVEI S1,IB.SZ ;GET IB LENGTH
MOVEI S2,IB ;GET IB ADDRESS
PUSHJ P,I%INIT ;AND INIT THE WORLD
MOVEI AP,[EXP [EXP 7],[ASCII /VT52 /]]
PUSHJ P,DPYINI## ;AND INITIALIZE THE DISPLAY
PUSHJ P,DPYZAP## ;AND CLEAR THE SCREEN NOW
PUSHJ P,JOBINI ;INITIALIZE JOB STATUS AREA
MOVEI S1,4 ;DEFAULT SECONDS TO LOOP
MOVEM S1,LUPSEC ;STORE IT
MOVEI S1,4 ;NUMBER OF LOOPS / CNT MESSAGE
MOVEM S1,CNTLUP ;STORE IT
JRST DPYL.2 ;AND SKIP THE INITIAL SLEEP
DPYLUP: MOVE P1,CNTLUP ;NUMBER OF SLEEP LOOPS
DPYL.1: MOVE S1,LUPSEC ;LOAD NUMBER OF SECONDS
PUSHJ P,I%SLP ;AND SLEEP FOR A WHILE
PUSHJ P,CHKCOM ;CHECK FOR A COMMAND
SKIPF ;SKIP IF WE DIDNT PROCESS A COMMAND
SETZ P1, ;WE DID, CLEAR A REG SO WE GET A NEW SCREEN
PUSHJ P,DOJOBS ;GET JOB INFORMATION
SOJG P1,DPYL.1 ;AND LOOP
DPYL.2: MOVEI S1,SAB.SZ ;GET SAB SIZE
MOVEI S2,SAB ;AND SAB ADDRESS
PUSHJ P,C%SEND ;SEND THE COUNT MESSAGE TO QUASAR
JUMPT DPYL.3 ;AND JUMP IF ALL IS WELL
$TEXT(,<Send to QUASAR failed, error ^E/[-1]/>)
PUSHJ P,I%EXIT ;AND DIE
DPYL.3: PUSHJ P,C%BRCV ;RECEIVE THE MESSAGE FROM QUASAR
JUMPT DPYL.4 ;AND JUMP IF OK
$TEXT(,<Receive of IPCF message failed, error ^E/[-1]/>)
PUSHJ P,I%EXIT ;AND DIE
DPYL.4: LOAD M,MDB.MS(S1),MD.ADR ;GET MESSAGE ADDRESS
LOAD S1,CAN.BL+$$QJOB(M) ;GET QUASAR'S JOB NUMBER
MOVEM S1,JOBS ;SAVE IT
PUSHJ P,DODPY ;DO THE DISPLAY
PUSHJ P,C%REL ;RELEASE THE COUNTANSWER PAGE
JRST DPYLUP ;AND LOOP
SUBTTL Display the COUNTANSWER Message
DODPY: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,DOJOBS ;DO JOB INFORMATION
DMOVE S1,[EXP <1,,1>,^D80] ;(1,1) 80 CHARACTERS
PUSHJ P,NEWSEC ;SETUP THE SECTION
$TEXT(DEPSEC,<Time: ^C/[-1]/^A>) ;GENERATE THE TIME
MOVX S1,%NSUPT ;GET UPTIME GETTAB
GETTAB S1, ;GET UPTIME
SETZ S1, ;??
IDIVI S1,^D60 ;CONVERT JIFFIES TO SECONDS
IDIVI S1,^D3600 ;GET HOURS IN S1
IDIVI S2,^D60 ;GET MINUTES IN S2, SECONDS IN T1
$TEXT(DEPSEC,< System uptime: ^D2/S1/:^D2R0/S2/:^D2R0/T1/^J>)
MOVEI P1,CAN.BL(M) ;POINT TO THE BLOCK IN THE MESSAGE
$TEXT(DEPSEC,<Number of IPCF messages sent: ^D/$$SIPC(P1)/>)
$TEXT(DEPSEC,<Number of IPCF messages received: ^D/$$RIPC(P1)/>)
SKIPE $$IPCF(P1) ;ANY TO REPORT
$TEXT(DEPSEC,<Number of IPCF Send failures: ^D/$$IPCF(P1)/>)
SKIPE $$IPCU(P1) ;ANY TO REPORT
$TEXT(DEPSEC,<Number of Unrecoverable IPCF Send failures: ^D/$$IPCU(P1)/>)
MOVE S1,$$NLAP(P1) ;NUMBER OF PAGES DURING LIST
IMULI S1,^D100 ;SCALE FOR PRINTOUT
IDIV S1,$$MLST(P1) ;PER LIST REQUESTED
IDIVI S1,^D100 ;COMPUTE F4.2
$TEXT(DEPSEC,<Average number of Pages for a Queue Listing: ^D/S1/.^D2R0/S2/>)
SKIPE $$DEAD(P1) ;ANY DEADLOCK CHECKS ???
$TEXT(DEPSEC,<Number of Deadlock Avoidance Checks: ^D/$$DEAD(P1)/>)
PUSHJ P,DMPSEC ;DUMP THE SECTION
DMOVE S1,[EXP <1,,^D13>,^D80] ;( 1,13) 80 WIDE
PUSHJ P,NEWSEC ;START A NEW SECTION
$TEXT(DEPSEC,<CREA NXTJ CHKP RELE LIST REQU KILL MODI ISPL DSPL>)
$TEXT(DEPSEC,<^D4/$$SCRE(P1)/^D6/$$MNXT(P1)/^D6/$$MCHK(P1)/^D6/$$MREL(P1)/^D6/$$MLST(P1)/^D6/$$MREQ(P1)/^D6/$$MKIL(P1)/^D6/$$MMOD(P1)/^D6/$$ISPL(P1)/^D6/$$DSPL(P1)/>)
PUSHJ P,DMPSEC ;DUMP IT OUT
$RETT ;AND RETURN
DOJOBS: PUSHJ P,.SAVE1 ;SAVE P1
SETZ P1, ;AND START AT ZERO
DOJO.1: SKIPN JOBS(P1) ;CHECK A JOB NUMBER
JRST DOJO.2 ;NO JOB THERE!!
MOVE S1,JOBSEC(P1) ;GET SECTION POINTER
MOVEI S2,^D13 ;AND WIDTH
PUSHJ P,NEWSEC ;SETUP A NEW SECTION
MOVE S1,JOBS(P1) ;GET JOB NUMBER
PUSHJ P,JOBINF ;GET THE INFORMATION
PUSHJ P,DMPSEC ;DUMP THE SECTION
DOJO.2: CAIGE P1,3 ;DONE?
AOJA P1,DOJO.1 ;NO, LOOP
$RETT ;AND RETURN
JOBSEC: XWD ^D21,^D17 ;(21,17) FOR JOB1 (QUASAR ALWAYS)
XWD ^D36,^D17 ;(36,17) FOR JOB2
XWD ^D51,^D17 ;(51,17) FOR JOB3
XWD ^D66,^D17 ;(66,17) FOR JOB4
SUBTTL GETJOBS - ROUTINE TO GET ORION, BATCON, LPTSPL JOB NUMBERS
GETJOB: MOVSI T1,-^D200 ;SET UP AOBJN AC
GETJ.1: MOVX S1,.GTPRG ;GET GETTAB JOB NAME PARM
HRLM T1,S1 ;INSERT THE JOB NUMBER
GETTAB S1, ;GET THE JOB NAME
JRST GETJ.3 ;ERROR,,TRY NEXT
MOVSI T2,-3 ;SET UP ANOTHER AOBJN AC
GETJ.2: CAME S1,PROGS(T2) ;IS THIS ORION OR BATCON
JRST [AOBJN T2,GETJ.2 ; OR LPTSPL ???
JRST GETJ.3 ] ;NO,,TRY NEXT JOB
MOVX S1,.GTPPN ;GET GETTAB PPN PARM
HRL S1,T1 ;INSERT THE JOB NUMBER
GETTAB S1, ;GET THE JOBS PPN
JRST GETJ.3 ;ERROR,,TRY NEXT
CAMN S1,[1,,2] ;IS THE SYSTEM GALAXY ???
HRRZM T1,JOBS+1(T2) ;YES,,SAVE THE JOB NUMBER
GETJ.3: AOBJN T1,GETJ.1 ;GET THE NEXT JOB NUMBER AND TRY AGAIN
POPJ P, ;RETURN
SUBTTL Job Status Handlers
;JOBINI IS CALLED TO INITIALIZE THE JOB STATUS AREA OF THE SCREEN
JOBINI: DMOVE S1,[EXP <1,,^D17>,^D25] ;(1,17) 25 LONG
PUSHJ P,NEWSEC ;SETUP THE SECTION
$TEXT(DEPSEC,<Program(Job #)^J^JRuntime (secs)^JCPU Usage^JDisk Reads^JDisk Writes>)
$TEXT(DEPSEC,<Number of UUOs>)
PUSHJ P,DMPSEC ;DUMP THE SECTION
$RETT ;AND RETURN
JOBINF: MOVEM S1,G.JOBN ;SAVE JOB NUMBER
MOVS S2,S1 ;GET JOB NUMBER,,0
HRRI S2,.GTPRG ;PROGRAM NAME
GETTAB S2, ;GET IT
JFCL ;??
MOVEM S2,G.PROG ;SAVE IT
MOVE S2,G.JOBN ;GET JOB NUMBER
RUNTIM S2, ;GET THE RUNTIME
MOVEM S2,G.RUNT ;SAVE MILLSECS
IDIVI S2,^D1000 ;GET SECONDS
MOVEM S2,G.RUNS ;SAVE SECONDS
MOVEM S2+1,G.RUNR ;SAVE RESIDUE
PUSHJ P,I%NOW ;GET NOW TIME
MOVS S2,G.JOBN ;GET JOB NUMBER
HRRI S2,.GTJLT ;LOGIN TIME GETTAB
GETTAB S2, ;GET IT
SETZ S2, ;LOSE!!
SUB S1,S2 ;GET DIFFERECE IN INTERNAL FORMAT
MULI S1,^D86400 ;MULTIPLY BY SECS/DAY
ASHC S1,^D17 ;MULTIPLIED BY 2^18
MOVE S2,G.RUNT ;GET MILLISECS OF RUNTIME
IMULI S2,^D10 ;SCALE IT CORRECTLY (BELIEVE ME!!)
IDIV S2,S1 ;DIVIDE BY SECONDS LOGGED-IN
IDIVI S2,^D100 ;GET PERCENTAGE
MOVEM S2,G.CPUP ;SAVE PERCENTAGE
MOVEM T1,G.CPUR ;SAVE RESIDUE
MOVS S2,G.JOBN ;GET JOB,,0
HRRI S2,.GTRCT ;GET DISK READS
GETTAB S2, ;GET IT
JFCL
TLZ S2,777700 ;CLEAR INCREMENTAL
MOVEM S2,G.DRDS ;SAVE IT
IMULI S2,^D1000 ;GET RDS*1000
IDIV S2,G.RUNT ;DIVIDE BY SECS*1000
MOVEM S2,R.DRDS ;SAVE DISK READ RATE
MOVS S2,G.JOBN ;GET JOB,,0
HRRI S2,.GTWCT ;DISK WRITES
GETTAB S2, ;GET IT
JFCL
TLZ S2,777700 ;CLEAR INCREMENTAL
MOVEM S2,G.DWRT ;SAVE IT
IMULI S2,^D1000 ;GET WRTS*1000
IDIV S2,G.RUNT ;DIVIDE BY SECS*1000
MOVEM S2,R.DWRT ;SAVE DISK WRITE RATE
MOVS S2,G.JOBN ;GET THE JOB NUMBER
HRRI S2,.GTUUC ;UUO COUNT
GETTAB S2, ;DO IT
JFCL
MOVEM S2,G.UUO ;SAVE IT
IMULI S2,^D1000 ;GET 1000*UUOS
IDIV S2,G.RUNT ;DIVIDE BY 1000*SECONDS
MOVEM S2,R.UUO ;SAVE UUO RATE UUO/SEC
$TEXT(DEPSEC,< ^W6/G.PROG/(^D3R0/G.JOBN/)^J------------->)
$TEXT(DEPSEC,<^D9/G.RUNS/.^D3R0/G.RUNR/>)
$TEXT(DEPSEC,<^D9/G.CPUP/.^D2R0/G.CPUR/%>)
$TEXT(DEPSEC,<^D8/G.DRDS//^D4/R.DRDS/>)
$TEXT(DEPSEC,<^D8/G.DWRT//^D4/R.DWRT/>)
$TEXT(DEPSEC,<^D8/G.UUO//^D4/R.UUO/>)
$RETT ;AND RETURN
G.JOBN: BLOCK 1 ;JOB NUMBER
G.PROG: BLOCK 1 ;PROGRAM NAME
G.RUNT: BLOCK 1 ;RUNTIME IN MS
G.RUNS: BLOCK 1 ;RUNTIME SECONDS
G.RUNR: BLOCK 1 ;RUNTIME RESIDUE IN MS
G.CPUP: BLOCK 1 ;PERCENTAGE OF CPU
G.CPUR: BLOCK 1 ;RESIDUE OF CPU PERCENTAGE
G.DRDS: BLOCK 1 ;TOTAL DISK READS
R.DRDS: BLOCK 1 ;DISK READ RATE
G.DWRT: BLOCK 1 ;TOTAL DISK WRITES
R.DWRT: BLOCK 1 ;DISK WRITE RATE
G.UUO: BLOCK 1 ;TOTAL NUMBER OF UUOS EXECUTED
R.UUO: BLOCK 1 ;UUO RATE
SUBTTL Section Handling Routines
;NEWSEC IS CALLED TO PREPARE FOR A NEW SCREEN SECTION
;
; S1/ X,,Y FOR FIRST CHARACTER OF SECTION
; S2/ DELTA-X (IE MAX LINE LENGTH)
NEWSEC: SETOM SETSEC ;SECTION AVAILABLE
HLRZM S1,BEGCOL ;SAVE BEGINNING COLUMN
HRRZM S1,BEGROW ;SAVE BEGINNING ROW
HRRZM S1,CURROW ;SAVE CURRENT ROW
MOVEI S1,4(S2) ;COPY THE SECTION LENGTH AND ROUND UP
IDIVI S1,5 ;DIVIDE BY CHARS/WORD
IMULI S1,5 ;GET EXACT MULTIPLE OF 5 CHARS LENTH
MOVEM S1,SECLEN ;SAVE SECTION LENGTH
SETZM CURLEN ;ZERO CURRENT LENGTH
PUSHJ P,CLRBUF ;CLEAR OUT THE BUFFER
$RETT ;AND RETURN
;DEPSEC IS CALLED TO DEPOSIT A BYTE FOR THE CURRENT SECTION
; CALLED BY $TEXT WITH S1 CONTAINING THE CHARACTER
DEPSEC: SKIPN SETSEC ;SECTION SETUP?
$STOP(NSS,No Section Setup)
MOVE S2,CURLEN ;GET CURRENT LINE LENGTH
CAML S2,SECLEN ;STILL ROOM AVAILABLE?
JRST DEPS.1 ;NO, CHECK FOR LF ETC.
IDPB S1,BUFPTR ;DEPOSIT THE CHARACTER
AOS CURLEN ;ANOTHER BYTE DOWN
DEPS.1: CAIE S1,.CHLFD ;IS IT A LINE FEED?
$RETT ;NO, RETURN
MOVE S1,SECLEN ;GET SECTION LENGTH
SUB S1,CURLEN ;SUBTRACT NUMBER DEPOSITED
DEPS.2: SOJL S1,DEPS.3 ;JUMP IF DONE
IBP BUFPTR ;INCREMENT THE POINTER
JRST DEPS.2 ;AND LOOP
DEPS.3: SETZM CURLEN ;CLEAR CURRENT LENGTH
AOS CURROW ;AND BUMP TO THE NEXT ROW
$RETT ;AND RETURN
;DMPSEC IS CALLED TO DUMP THE CURRENT SECTION TO THE SCREEN
DMPSEC: MOVE S1,BEGCOL ;GET BEGINNING COLUMN
ADD S1,SECLEN ;ADD SECTION LENGTH
SUBI S1,1 ;GET ENDING COLUMN
MOVEM S1,ENDCOL ;SAVE IT
SKIPN CURLEN ;SKIP IF IN THE MIDDLE OF A LINE
SOS CURROW ;DECREMENT LINE COUNT
MOVEI AP,[EXP BUFFER,BEGCOL,BEGROW,ENDCOL,CURROW]
SKIPL CURROW ;SKIP IF 0 LINES (SOS'ED ABOVE)
PUSHJ P,DPYRSC## ;DUMP THE SECTION
SETZM SETSEC ;CLEAR SECTION SETUP FLAG
$RETT ;AND RETURN
BEGROW: BLOCK 1 ;BEGINNING ROW OF SECTION
BEGCOL: BLOCK 1 ;BEGINNING COLUMN OF SECTION
ENDCOL: BLOCK 1 ;ENDING COLUMN
SECLEN: BLOCK 1 ;SECTION LENGTH
CURROW: BLOCK 1 ;CURRENT ROW
CURLEN: BLOCK 1 ;CURRENT LENGTH
SETSEC: EXP 0 ;SECTION AVAILABLE
SUBTTL Buffer Handling Routines
CLRBUF: MOVE S1,[XWD BUFFER,BUFFER+1]
MOVE S2,[ASCII / /]
MOVEM S2,BUFFER
BLT S1,BUFFER+BUFSIZ-1 ;BLT THE BUFFER TO SPACES
MOVE S1,[POINT 7,BUFFER] ;SETUP A BYTE-POINTER
MOVEM S1,BUFPTR ;STORE IT
$RETT ;AND RETURN
DEPBUF: IDPB S1,BUFPTR ;DEPOSIT A BYTE IN THE BUFFER
$RETT ;AND RETURN
SUBTTL Command Routines
;HERE TO SEE IF A COMMAND HAS BEEN TYPED
CHKCOM: SKPINC
$RETF
OUTSTR [ASCIZ /WE GOT A COMMAND
/]
PUSHJ P,DPYZAP
PUSHJ P,JOBINI
$RETT
END GALDPY