BPXB1SM5 CSECT , Nonreentrant linkage
BPXB1SM5 AMODE 31
BPXB1SM5 RMODE ANY
USING *,R15 Program addressability
@BEGIN0 B @BEGIN1 Branch around program header
DC C'BPXB1SM5 - nonreentrant __getthent invoker'
DS 0H
@BEGIN1 STM R14,12,12(R13) Save callers registers
ST R13,@BACK Save ->Callers save area
LA R13,@SAVE00 Program addressability
DROP R15
USING @SAVE00,R13 Program addressability
B @BEGIN2
@SAVE00 DS 0D Standard save area - 72 Bytes
DS A
@BACK DS A Backwards save area pointer
@FORWARD DS A Forwards save area pointer
DS 15A Regs 14,15,0-12
RETURN XR R15,R15 Zero return code
RETURNRC L R13,@BACK Restore callers r13
L R14,12(,R13) Restore callers r14
LM R0,R12,20(R13) Restore callers r0-r12
BSM 0,R14 Branch back to caller
R0 EQU 0
R1 EQU 1 Parameter list pointer
R2 EQU 2
R3 EQU 3
R4 EQU 4
R5 EQU 5
R6 EQU 6
R7 EQU 7
R8 EQU 8
R9 EQU 9
R10 EQU 10
R11 EQU 11
R12 EQU 12
R13 EQU 13 Program and save area base
R14 EQU 14 Return address
R15 EQU 15 Branch location
@BEGIN2 EQU * * * * * * * End of the entry linkage code
EJECT ,
LA R5,BUFFERA R5-> Input buffer
ST R5,PGTHAB -> input buffer
USING PGTHA,R5 R5 base for PGTHA
XC PGTHA,PGTHA Null input area
MVI PGTHAFLAG1,PGTHAPROCESS+PGTHATHREAD
MVI PGTHAPID,PGTH#FIRST First thread
LA R15,BUFFERB Pgthb, Output buffer
ST R15,PGTHBB Output Buffer
SPACE , * * * * * *
LA R0,=CL8'BPX1GTH ' LOAD -> entry point name
XR R1,R1 No JOBLIB or LINKLIB DCB
SVC 8 Issue LOAD SVC
ST R0,GETENTRY Store BPX1GTH entry point
GETTH L R15,GETENTRY Address of BPX1GPS load module
CALL (15), Get process data +
(PGTHAL, Length of buffer +
PGTHAB, Buffer, mapped by BPXPGPHA +
PGTHBL, Length of output buffer +
PGTHBB, Buffer, mapped by BPXPGTHC +
RETVAL, Return value (next, eof or error) +
RETCODE, Return code +
RSNCODE), Reason code +
VL ----------------------------------
SPACE , * * * * * *
L R15,RETVAL Load return value
C R15,=F'-1' Test for -1 return
BE RETURNRC -1 is error
SPACE , * * * * * * Initialize WTO area & message
MVI XPID,C' ' Blank out variable portion of msg ge
MVC XPID+1(WTO#BLANK-1),XPID
SPACE , * * * * * * Process ID to printable hex
LA R6,BUFFERB R6-> Output buffer
ST R6,PGTHBB -> output buffer
USING PGTHB,R6 R6 base for PGTHB
L R8,PGTHBPID R8 = process ID
LA R9,XPID To be placed at message start
LA R15,8 8 nibbles to convert (4 bytes)
LA R10,9 For 0-9 / A-F compare
NIBBLE LR R11,R8 Target bits in 0-3 XYYYYYYZ
SRL R11,28 Bits 0-3 to 28-31 0000000X
SLL R8,4 Drop bits 0-3 off end YYYYYYZ0
CLR R11,R10 Are 4 bits 0-9 or A-F
BC B'0010',AF Branch if A-F
LA R11,57(,R11) Add for 0-9 (57+183=240 or F0)
AF LA R11,183(,R11) Add for 0-F (183+10=193 or C1)
STC R11,0(,R9) Store to results location
LA R9,1(,R9) Increment R9 to next location
BCT R15,NIBBLE Decrement half byte counter, loop
SPACE , * * * * * * Test status bits
* Go after the state of the process
LA R7,PGTHB
SLR R9,R9
ICM R9,7,PGTHBOFFC
AR R7,R9
USING PGTHC,R7
LA R8,PGTHB
SLR R9,R9
ICM R9,7,PGTHBOFFJ
AR R8,R9
USING PGTHJ,R8
MVI THREAD,C'1' Assume single
TM PGTHCFLAG1,PGTHCMULPROCESS if multiprocess
BZ NOTMULT
MVI THREAD,C'M'
NOTMULT MVC STATE,PGTHJSTATUS2 Z, W, X, S, C, F, K, R ...
TM PGTHCFLAG1,PGTHCSWAP if swapped out
BZ NOTSWAP
MVC SWAPA,=CL4'SWAP'
NOTSWAP TM PGTHCFLAG1,PGTHCSTOPPED if stopped
BZ NOTSTOP
MVC STOPA,=CL4'STOP'
NOTSTOP TM PGTHCFLAG1,PGTHCTRACE if ptrace
BZ NOTTRAC
MVC TRACA,=CL4'TRAC'
NOTTRAC EQU *
SPACE , * * * * * * Display message to operator
LA R2,WTOAREA R2->WTO message area
WTO TEXT=(R2) Write to Operator
SPACE , * * * * * * Loop back
MVC PGTHACONTINUE,PGTHBCONTINUE get next thread
B GETTH
WTOAREA DS 0F WTO message
DC AL2(WTO#LENGTH) Length of area
DC CL4'PID=' Process ID =
XPID DS CL8 Hex of process ID
DS CL1
THREAD DS CL1 1, M or H
DS CL1
STATE DS CL1 Z, W, X, C, F, K, R ...
DS CL1
SWAPA DS CL4 SWAP or blank
DS CL1
STOPA DS CL4 STOP or blank
DS CL1
TRACA DS CL4 TRAC or blank
WTO#BLANK EQU *-XPID Length to blank
DC C'.'
WTO#LENGTH EQU *-WTOAREA Length of WTO area
SPACE ,
GETENTRY DS A Address of BPX1GPS
RETVAL DS F Return value - next
RETCODE DS F Return code
RSNCODE DS F Reason code
SPACE ,
BUFFERA DS CL50 Buffer for Process data
BUFFERB DS CL500 Buffer for Process data
PGTHAL DC A(PGTHA#LEN) Length of PGTH buffer
PGTHAB DS A(PGTHA) ->Process data buffer
PGTHBL DC A(500) Length of PGTH buffer
PGTHBB DS A(PGTHB) ->Process data buffer
BPXYPGTH DSECT=NO Place in current CSECT / DSECT
END