1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-13 19:34:12 +00:00
Files
PDP-10.stacken/files/stacken-tape-backup/dskb:10_7/galtol/typids.mac
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

263 lines
7.4 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.
TITLE TYPIDS - Type all PIDs and their associated information
SUBTTL Irwin L. Goverman/ILG/PJT/DC 18-Oct-78
SEARCH GLXMAC ;LOAD GALAXY SYSTEM SYMBOLS
PROLOG(TYPIDS) ;DECLARE NAME, ETC...
TYPVER==1 ;VERSION
TYPEDT==107 ;EDIT LEVEL
TYPWHO==0
TYPMIN==0
%%.TYP==<VRSN.(TYP)> ;MAKE INTO VERSION NUMBER
SUBTTL Definitions and Storage
ND MAXJOB,^D250 ;MAXIMUM NUMBER OF JOBS
ND STACKL,^D100 ;SIZE OF STACK
SYSPRM .JIJNO,0 ;DEFINE -10 JOB DATA OFFSETS
SYSPRM .JIUNO,1 ;FOR VARIOUS STUFF
SYSPRM .JIPNM,2
SYSPRM .JIDFS,.JIPNM ;TOTAL LENGTH NEEDED
SYSPRM NAMLOC,.IPCI2,.IPCI1 ;WHERE NAME STARTS IN INFO RESPONSE
SYSPRM OFFSET,1,2 ;WORDS PER PID IN MB
SYSPRM MBSIZ,12,^D200 ;WORDS OF JOB PID TABLE
MB: BLOCK MBSIZ ;BLOCK FOR PIDS
JB: BLOCK .JIDFS+1 ;JOB INFORMATION BLOCK
IB: $BUILD(IB.SZ)
$SET(IB.PRG,,%%.MOD) ;SET PROGRAM NAME
$SET(IB.OUT,,T%TTY) ;AND DEFAULT OUTPUT ROUTINE
$SET(IB.PIB,,PIB) ;AIM AT PID BLOCK
$EOB
PIB: $BUILD (PB.MNS) ;MINIMAL PID
$SET (PB.HDR,PB.LEN,PB.MNS) ;NOTHING SPECIAL, JUST GET A PID
$EOB
ENTVEC: JRST TYPIDS ;ENTRY VECTOR
JRST TYPIDS
EXP %%.TYP ;VERSION
LOC 137
EXP %%.TYP
RELOC
STACK: BLOCK STACKL ;PUSHDOWN LIST
INFSAB: $BUILD SAB.SZ
$SET (SAB.LN,,INFMSL) ;LENGTH OF MSG
$SET (SAB.MS,,INFMS) ;MESSAGE ADRS
$SET (SAB.SI,SI.FLG,1) ;SEND BY SPECIAL INDEX
$SET (SAB.SI,SI.IDX,SP.INF) ;SEND TO SYSTEM INFO
$EOB
INFMS: EXP .IPCIG ;GET NAME FROM PID
BLOCK ^D7 ;PLACE FOR NAME
INFMSL==.-INFMS ;SIZE OF THE MESSAGE
SUBTTL Special PID tables
DEFINE .SPID(CANNAM,T10VAL,T20VAL,SIXNAM),<
IFNB <SIXNAM>,< SIXBIT\SIXNAM\>
IFB <SIXNAM>,< SIXBIT\******\>
>
SIXBIT / / ;No match on pid, type blanks
NAMTAB: SPIDS
NAMTBL==.-NAMTAB
DEFINE .SPID(CANNAM,T10VAL,T20VAL,SIXNAM),<
CANNAM
>
;Build a table of the indicies themselves
PIDIDX: SPIDS
PIDTAB: BLOCK NAMTBL ;PIDS OF SYSTEM COMPONENTS
SUBTTL Main Program Loop
TYPIDS: RESET
MOVE P,[IOWD STACKL,STACK] ;SET UP STACK POINTER
DMOVE S1,[EXP IB.SZ,IB] ;POINT TO THE INIT BLOCK
$CALL I%INIT## ;INITIALIZE EVERTHING
$CALL RDPIDS ;READ SYSTEM PIDS
TOPS10 <
PJOB S1, ;GET OUR JOB NUMBER
$CALL GETJOB ;SEE IF WE CAN READ OUR OWN STUFF
;IF NOT, GETJOB WILL $FATAL IMMEDIATELY
>;END TOPS10
MAIN: MOVSI P1,-MAXJOB ;GET MAXIMUM JOB NUMBER AS COUNTER
$TEXT(,<Job User Program PID JWP NOA SYSPID Name>)
$TEXT(,<--- ---- ------- --- --- --- ------ ---->)
MAIN.1: HRRZ S1,P1 ;GET JOB NUMBER
$CALL GETJOB ;GET JOB DATA SET UP
JUMPF MAIN.2 ;IF NOT A JOB, SKIP DISPLAY
$CALL DISPID ;DISPLAY ALL THE PID INFORMATION
MAIN.2: AOBJN P1,MAIN.1 ;REPEAT FOR ALL THE JOBS
JRST I%EXIT ;THEN EXIT
SUBTTL DISPID - Display PID information for one job
DISPID: MOVEI T1,MB+2 ;GET ADDR OF FIRST PID
DISP.1: SKIPN 0(T1) ;A PID HERE?
$RETT ;NO, SO WE ARE DONE
MOVE S1,0(T1) ;GET THE PID
MOVEM S1,INFMS+.IPCI2 ;STORE INTO [SYSTEM]INFO BLOCK
DMOVE S1,[EXP SAB.SZ,INFSAB] ;SIZE AND LOC OF MESSAGE
$CALL C%SEND ;SEND IT TO INFO
SKIPT ;DID IT WORK?
$STOP(SIF,Send to [SYSTEM]INFO failed)
DISP.2: $CALL C%BRCV ;WAIT FOR THE ANSWER
SKIPT ;CHECK FOR ERRORS
$STOP(ERI,Error receiving from [SYSTEM]INFO)
MOVE S2,MDB.SI(S1) ;GET SPECIAL INDEX
TXZE S2,SI.FLG ;IS THIS SPECIAL
CAXE S2,SP.INF ;AND FROM INFO?
JRST [ PUSHJ P,C%REL ;NO, LET GO OF MESSAGE
JRST DISP.2 ] ;AND TRY AGAIN
LOAD T2,MDB.MS(S1),MD.ADR ;GET ADDRESS OF RESPONSE
LOAD S2,MDB.MS(S1),MD.CNT ;GET LENGTH OF MESSAGE
ADD S2,T2 ;POINT TO LAST WORD
SETZM (S2) ;AND CLEAR IT
LOAD S2,MDB.FG(S1),IP.CFE ;GET ERROR FLAGS FROM MESSAGE
SKIPE S2 ;ARE THERE ERRORS?
SETZM NAMLOC(T2) ;YES, CLEAR ANYTHING IN NAME WORD
MOVEI T3,NAMTBL-1 ;GET MAX OFFSET INTO SYS PID TBL
MOVE S1,0(T1) ;GET THE PID UNDER CONSIDERATION
CAME S1,PIDTAB(T3) ;A MATCH?
SOJGE T3,.-1 ;NO, LOOP IF MORE
MOVE S1,T1 ;GET POINTER
$CALL SETFLG ;SET UP THE FLAGS
$TEXT(,<^D3R/JB+.JIJNO/ ^U12/JB+.JIUNO/ ^W6/JB+.JIPNM/^A>)
$TEXT(,<^O13/0(T1)/ ^6/S1/ ^6/S2/ ^W6/NAMTAB(T3)/ ^T/NAMLOC(T2)/>)
ADDI T1,OFFSET ;STEP TO NEXT PID
JRST DISP.1 ;
SUBTTL System PID table routines
;RDPIDS reads the system's pid table
RDPIDS: $CALL .SAVE1 ;GET ONE AC
MOVSI P1,-NAMTBL ;GET SIZE OF TABLE SET UP
RDPI.1: LOAD S1,PIDIDX(P1) ;GET THE SP.XXX SYMBOL FOR SYS JOB
$CALL C%RPRM ;AND READ IT'S PID
SKIPT ;MONITOR MAY NOT HAVE ONE
SETZ S1, ;IF SO, CLEAR THE PID
STORE S1,PIDTAB(P1) ;REMEMBER PID GOTTEN
AOBJN P1,RDPI.1 ;LOOP FOR ALL WE KNOW ABOUT
$RETT ;AND THEN RETURN
SUBTTL GETJOB -- Set up job data and PIDs
;CALL IS: S1/ Job number
;
;TRUE RETURN: Job is existent
;FALSE RETURN: No job with this job number exists
GETJOB:
TOPS20 <
$CALL .SAVET ;NEED T1
MOVE S2,[-<.JIDFS+1>,,JB] ;PLACE TO PUT JOB INFORMATION
MOVX T1,.JIJNO ;FIRST WORD TO FETCH
GETJI ;GET THE JOB INFORMATION
$RETF
MOVX S1,.MUFJP ;FIND JOB'S PID
MOVEM S1,MB+0 ;IS THE FUNCTION
MOVE S1,JB+.JIJNO ;GET JOB NUMBER
MOVEM S1,MB+1 ;STORE IT AWAY
DMOVE S1,[EXP MBSIZ,MB] ;SIZE,LOCATION OF MUTIL BLOCK
MUTIL ;SEE IF ANY PIDS
$STOP(PQF,PID query failed)
$RETT ;AND RETURN
> ;END OF TOPS20
TOPS10 <
$CALL .SAVE2 ;SAVE TWO ACS
MOVE P1,S1 ;COPY JOB NUMBER
MOVEM S1,JB+.JIJNO ;AND STORE INTO JOB DATA BLOCK
HRLZ S1,P1 ;GET JOB NUMBER
HRRI S1,.GTPPN ;AND THEN PPN
GETTAB S1,
SETZ S1, ;IF ILLEGAL, CLEAR PPN
JUMPE S1,.RETF ;IF NO PPN, NOT LOGGED IN
MOVEM S1,JB+.JIUNO ;STORE USER NUMBER
HRLZ S1,P1 ;COPY JOB NUMBER BACK
HRRI S1,.GTPRG ;AND FIND PROGRAM NAME
GETTAB S1, ;FROM MONITOR
SETZ S1, ;CLEAR IT IF IT FAILS
MOVEM S1,JB+.JIPNM ;STORE NAME
MOVX S1,.IPCSP ;FUNCTION IS GET PIDS FOR JOB
MOVEM S1,MB+0 ;STORE IT
MOVEM P1,MB+1 ;STORE THE JOB NUMBER
SETZM MB+2 ;START WITH FIRST PID
DMOVE S1,[EXP SAB.SZ,IPCSAB] ;SEND THIS OFF TO INFO
$CALL C%SEND ;
SKIPT
$FATAL(IPCF privileges required)
GETJ.2: $CALL C%BRCV ;RECEIVE THE MESSAGE
SKIPT ;IS IT OK?
$STOP(RMF,Receive from monitor failed)
MOVE S2,MDB.SI(S1) ;GET INDEX
TXZE S2,SI.FLG ;IS IT SPECIAL?
CAXE S2,SP.IPC ;AND FROM IPCC?
JRST [ PUSHJ P,C%REL ;NO, FLUSH MSG
JRST GETJ.2 ] ;AND TRY AGAIN
LOAD S2,MDB.MS(S1),MD.ADR ;GET WHERE PACKET LIVES
HRLZS S2 ;REVERSE
HRRI S2,MB ;AND GET THE DESTINATION
BLT S2,MB+MBSIZ-1 ;TRANSFER IT
$RETT ;AND RETURN
IPCSAB: $BUILD SAB.SZ
$SET (SAB.LN,,MBSIZ) ;SIZE OF MESSAGE
$SET (SAB.MS,,MB) ;ADDR OF MESSAGE
$SET (SAB.SI,SI.FLG,1) ;SEND BY SPECIAL INDEX
$SET (SAB.SI,SI.IDX,SP.IPC) ;SEND TO IPCC
$EOB
> ;END OF TOPS10
SUBTTL SETFLG -- Set flags for display line
;CALL IS: S1/ Pointer to PID
;
;TRUE RETURN: S1/ Indicator of "permanence"
; S2/ Indicator of "no access"
SETFLG:
TOPS20 <
MOVE S2,S1 ;GET COPY OF INDEX
LOAD S1,1(S2),IP%JWP ;GET "JOB WIDE" FLAG
SKIPE S1 ;IF ITS ON,
MOVEI S1,'*' ;FLAG IT
LOAD S2,1(S2),IP%NOA ;IS THIS "NO ACCESS"
SKIPE S2 ; TO OTHER PROCESSES?
MOVEI S2,'*' ;YES, REMEMBER IT
$RETT ;AND RETURN
> ;END OF TOPS20
TOPS10 <
SKIPL 0(S1) ;IF SIGN BIT LIT, PID IS TEMP
SKIPA S1,['*'] ;ELSE IT IS PERMANENT
MOVEI S1,' '
MOVEI S2,' ' ;NO ACCESS IS NEVER ON
$RETT ;RETURN
> ;END OF TOPS10
TOPS10 < END TYPIDS>
TOPS20 < END <3,,ENTVEC>>