ASMB,R,L,C
* 
*     NAME:   PL..
*     SOURCE: 92071-18104 
*     RELOC:  92071-1X104 
*     PGMR:   C.H.W.,DJN
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1980.  ALL RIGHTS      * 
*  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,       * 
*  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT * 
*  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.        * 
*  **************************************************************** 
* 
* 
      NAM PL..,7  92071-1X104  REV.2041  800808 
* 
* 
* 
      ENT PL..
* 
      EXT O.BUF,TMP.,OPEN.,WRITF
      EXT .XLA,.XLB,$CVT3 
      EXT MESSS,$LIBR,$LIBX,.MVW
      EXT $IDA,$ID#,$IDSZ,$MATA,$MATV 
* 
      SUP 
* 
* 
PL..  NOP 
      JSB OPEN.     OPEN LIST FILE
      DEF *+5 
      DEF O.BUF 
      DEF TMP.
      DEF TMP.+3
      DEF ZERO
* 
      CLA 
      STA IERR      INITIALIZE ERROR FLAG 
* 
      JSB .XLB
      DEF $ID#
      CMB,INB       NEG # OF ID SEGS
      STB IDCNT 
      LDA PL..
      ADA .2
      LDA 0,I       ADDRESS OF PARAMETER BUFFER 
      INA 
      LDA 0,I       GET TYPE OF LIST
      CPA ASCMB     MEMORY BOUNDS ("MB")? 
      JMP PB.00      YES
      CPA ASCIT     TIME LIST ("IT")? 
      JMP PT.00      YES
      CPA ASCPT     PARTITION TABLE ("PT")? 
      JMP PP.00      YES
      SZA,RSS       DO ALL? 
      JMP PL.30      YES
* 
*  LIST ONLY THOSE PROGRAMS OF REQUESTED STATUS 
      STA STTYP     SAVE STATUS TYPE
      LDB TYPES     LIST OF VALID STATI 
PL.10 LDA 1,I 
      SSA           END OF LIST?
      JMP ER56       YES, PARAMETER ERROR 
      CPA STTYP     FOUND?
      JMP PL.20      YES
      ADB .2
      JMP PL.10     ITERATE 
* 
PL.20 INB 
      LDB 1,I       GET NUMERIC EQUIVALENT
* 
PL.30 STB STTUS     SAVE LIST TYPE
      JSB .XLB      ADDR OF ID SEGMENTS 
      DEF $IDA
* 
PL.40 STB IDADS 
      LDA STTUS 
      JSB $LIBR     NO PROGRAM STATE CHANGES CAN OCCUR
      NOP 
      SSA           DOING ALL?
      JMP PL.50      YES
      ADB .15       POINT TO IDSEG WD 16
      STA TEMP
      JSB .XLA
      DEF 1,I 
      XOR TEMP
      AND B77       STATUS IN BITS 5-0
      SZA,RSS       STATUS MATCH? 
      JMP PL.45      YES
PL.42 JSB $LIBX     RAISE FENCE 
      DEF *+1 
      DEF *+1 
      JMP PL.60     CHECK NEXT ID 
* 
PL.45 LDB IDADS 
* 
PL.50 ADB .12       POINT TO NAME IN IDSEG
      JSB .XLA      GET 1ST 2 CHARS 
      DEF 1,I 
      SZA,RSS 
      JMP PL.42     ID SEG NOT USED 
      STA MSNAM     MOVE TO BUFR
      INB 
      JSB .XLA      GET LAST 3 CHARS
      DEF 1,I 
      INB 
      JSB .XLB
      DEF 1,I 
      DST MSNAM+1 
      DLD PSCMD     " PS,"
      DST MSBUF     MOVE CMD
* 
      JSB $LIBX     RAISE FENCE FOR MESSS 
      DEF *+1       THE SMALL WINDOW WHICH REMAINS
      DEF *+1       REQUIRES A DOUBLE CHECK AFTER THE CALL
      JSB MESSS     CALL MESSAGE PROCESSOR
      DEF *+3 
      DEF MSBUF 
      DEF .9
      SSA,RSS       ANY REPLY?
      JMP ER56      ERROR?? 
      ADA N2
      STA LEN 
      LDA STTUS     DOING ALL?
      SSA           NEG IF DOING ALL
      JMP OUT       DOING ALL-DON'T CHECK RETURN
      LDA MSNAM+13  PICK UP STATUS FROM MESS RETURN 
      CPA STTYP     STILL OF CORRECT STATUS?
      RSS           YES, OUTPUT THE RETURNED BUFFER 
      JMP PL.60     NO, GO CHECK THE NEXT ID
* 
OUT   JSB OUTPT     WRITE RESPONSE TO LIST DEVICE 
      DEF MSBUF-1 
      DEF LEN 
* 
PL.60 JSB .XLB
      DEF $IDSZ 
      ADB IDADS     POINT TO NEXT ID SEGMENT
      ISZ IDCNT     MORE? 
      JMP PL.40      YES
* 
PL.EX LDA PL..,I
      JMP 0,I       EXIT
      SKP 
* 
*  LIST ALL PROGRAMS IN TIME LIST 
* 
PT.00 JSB .XLB      ADDR OF ID SEGMENTS 
      DEF $IDA
* 
PT.20 STB IDADS     SAVE ID SEGMENT ADDR
      ADB .17       POINT TO RES/MULT IN ID SEGMENT +17 
      STB IDADR 
      JSB $LIBR     MUST HAVE A STATIC PICTURE OF THE ID
      NOP 
      JSB .XLA      GET RES 
      DEF 1,I 
      ALF,SLA,RAR   RIGHT JUSTIFY IT, SKIP IF T=0 
      JMP INLST     IN TIME LIST
* 
      JSB $LIBX     NOT IN TIME LIST, IGNORE
      DEF *+1 
      DEF *+1 
      JMP PT.70     CHECK NEXT ID 
* 
INLST AND .7        ISOLATE IT
      ADA ASRES     ADDR INTO ASCII CONV.TABLE
      LDA 0,I       GET MS,SC,MN, OR HR 
      STA M.RES     STORE IN MSG
* 
      LDB IDADS 
      ADB .14       ID SEG WORD 15
      JSB .XLA       HAS LAST CHAR OF NAME
      DEF 1,I 
      AND HIGH8     CLEAR RHW 
      IOR B40       FILL WITH A BLANK 
      STA M.NAM+2   STORE IN LINE 
      ADB N2        POINT TO ID+12
      JSB .XLA      GET 1ST 4 CHARS OF NAME 
      DEF 1,I 
      INB 
      JSB .XLB
      DEF 1,I 
      DST M.NAM 
* 
      JSB .XLA      GET MULT
      DEF IDADR,I 
      AND B7777     ISOLATE IT
      CLB 
      DIV .100      SEPARATE HIGH TWO DIGITS
      SZA,RSS       ARE HIGH 2 DIGITS ZERO? 
      JMP PT.40      YES
      STB M.MUL+1   SAVE LOW
      JSB DECIM     CONVERT HIGH TO ASCII 
      STA M.MUL     STORE IN MSG
      LDA M.MUL+1   GET LOW 
      JSB DECIM     CONVERT TO ASCII
      IOR .01B      ENSURE NUMERIC
      JMP PT.45 
* 
PT.40 LDA BLANK 
      STA M.MUL     BLANK-OUT HIGH 2 DIGITS 
      LDA 1         GET LOW DIGITS
      JSB DECIM     CONVERT TO ASCII
PT.45 STA M.MUL+1   STORE LOW ORDER DIGITS IN MSG 
      ISZ IDADR     POINT TO TIME FIELD 
      LDB IDADR 
      JSB .XLA      GET TIME FROM ID SEGMENT
      DEF 1,I 
      INB 
      JSB .XLB
      DEF 1,I 
      JSB $LIBX     NOW HAVE STATIC PICTURE 
      DEF *+1 
      DEF *+1 
      ADA PRS1      ADD POSITIVE 24 HRS.
      SEZ           TO GET A POSITIVE 
      INB           TIME
      ADB PRS2
      DIV .6000     DIVIDE BY 6000
      STA TEMP      SAVE MIN/HR 
      ASR 16        POSITION B (SEC/10MS) FOR DIVIDE
      DIV .100      DIVIDE BY 100 TO GET SEC/10MS 
      STB M.MSC     SAVE 10'S OF MSECS
      JSB DECIM     CONVERT SECONDS TO ASCII
      STA M.SEC      & STORE IN MSG 
      LDA M.MSC 
      JSB DECIM     CONVERT 10'S OF MSECS TO ASCII
      LDB ASC0C     "0:"
      RRR 8         FORM ":MM0" 
      DST M.MSC     STORE MILLISECS IN ASCII
      CLB           SET UP FOR DIVIDE 
      LDA TEMP      FETCH MIN/HR
      DIV .60       SEPERATE
      STB M.MIN     SAVE MINUTES
      CPA .24       HOUR ROLL-OVER? 
      CLA            YES
      JSB DECIM     CONVERT HOURS TO ASCII
      STA M.HR       & SAVE IN MESSAGE
      LDA M.MIN     GET MINUTES 
      JSB DECIM     CONVERT TO ASCII
      LDB ASCCL     GET "::"
      RRR 8         FORMAT ":XX:" 
      DST M.MIN     STORE INTO MSG
* 
      JSB OUTPT     WRITE RESPONSE LINE 
      DEF MSGBF 
      DEF MSGLN 
* 
PT.70 JSB .XLB
      DEF $IDSZ 
      ADB IDADS 
      ISZ IDCNT     MORE ID SEGMENTS? 
      JMP PT.20      YES
      JMP PL.EX      NO, DONE 
      SKP 
* 
*  LIST PROGRAM MEMORY BOUNDS 
* 
* 
PB.00 JSB OUTPT     WRITE HEADER
      DEF MBHDR 
      DEF MBHLN 
      JSB .XLB      ADDR OF ID SEGS 
      DEF $IDA
* 
PB.20 STB IDADS 
      LDA PRGSA     ADDR OF PROG SIZE FIELD 
      STA TEMP
      ADB .14       POINT TO LAST NAME CHAR IN ID SEG 
* 
* GO PRIVILEDGED TO TAKE PICTURE OF ID
* 
      JSB $LIBR 
      NOP 
      JSB .XLA      GET LAST CHAR 
      DEF 1,I 
      AND HIGH8     ISOLATE IT
      IOR B40       BLANK 
      STA MBPNF+2   STORE IN PROG NAME FIELD
      ADB N2        POINT TO 1ST WD OF NAME 
      JSB .XLA      GET 4 CHARS OF NAME 
      DEF 1,I 
      INB 
      JSB .XLB
      DEF 1,I 
      SZA,RSS 
      JMP PB.45     ID SEG NOT USED 
      DST MBPNF     STORE IN MSG
      LDB IDADS 
      ADB .25       POINT TO PARTITION WORD 
      JSB .XLA      GET IT
      DEF 1,I 
      STA PART      SAVE LOCAL COPY 
      ADB N1        POINT TO ID WORD 25 
      JSB .XLA      GET ID WORD 25
      DEF 1,I 
      AND SZMSK     MASK PROGRAM SIZE 
      ALF,RAL       MOVE TO LOW BYTE
      RAL 
      INA           ACCOUNT FOR BASE PAGE 
      JSB CONVL     MOVE OCTAL EQUIV OF A TO OUTBUFF
      OCT 20000     FIRST CHAR WILL BE A SPACE
      ISZ TEMP      SKIP 4 SPACES FOR COSMETIC REASONS
      ISZ TEMP
      LDA PART      GET PARTITION WORD AGAIN
      AND B377
      JSB CONVL     MOVE PART # TO OUTPUT BUFF
      OCT 20000 
* 
      JSB $LIBX     RAISE FENCE 
      DEF *+1 
      DEF *+1 
* 
      JSB OUTPT     PRINT BOUNDS
      DEF MBMSG 
      DEF MBLEN 
      JMP PB.50 
* 
PB.45 JSB $LIBX     RAISE FENCE FOR EXIT CASE 
      DEF *+1 
      DEF *+1 
* 
PB.50 JSB .XLB      POINT TO NEXT ID SEG
      DEF $IDSZ 
      ADB IDADS 
      ISZ IDCNT     MORE? 
      JMP PB.20      YES
      JMP PL.EX     DONE
      SKP 
* 
* LIST PARTITION OCCUPANTS
* 
PP.00 JSB OUTPT     OUTPUT HEADER 
      DEF PTHDR 
      DEF PTHLN 
      JSB .XLB
      DEF $MATA 
      JSB .XLA      GET NUMBER OF DEFINED MATS
      DEF $MATV 
      STA MAT#      SAVE LOCALLY
      CLA,INA       INITIALIZE CURRENT PARTITION #
      STA PRTN# 
PP.20 STB MATA      SAVE LOCAL COPY OF CURRENT MAT ADDRESS
      LDA PTNUA     ADDRESS OF PARTITION NUMBER IN OUTPUT BUFFER
      STA TEMP      CONVL USES TEMP AS AN ADDRESS POINTER 
      LDA PRTN#     GET CURRENT PARTITION NUMBER
      JSB CONVL     MOVE DECIMAL EQUIV TO OUTPUT BUFFER 
      OCT 20000     PAD WITH SPACE
      ISZ TEMP      SKIP FOUR SPACES
      ISZ TEMP
      JSB $LIBR     WANT TO TAKE A STATIC PICTURE 
      NOP 
      ADB .2        POINT TO STARTING PAGE NUMBER 
      JSB .XLA      GET STARTING PAGE NUMBER
      DEF 1,I 
      JSB CONVL     MOVE IT TO OUTPUT BUFFER
      OCT 20000 
      ISZ TEMP      SKIP TWO SPACES IN THE BUFFER 
      ADB N1        POINT TO LENGTH WORD LESS 1 
      JSB .XLA      GET LENGTH WORD LESS 1
      DEF 1,I 
      INA           NOW A HAS THE ACTUAL LENGTH 
      JSB CONVL     PUT LENGTH IN OUTPUT BUFFER 
      OCT 20000 
      ADB N1        POINT TO ID ADDRESS WORD
      JSB .XLB      GET ID SEG ADDRESS
      DEF 1,I 
      SSB           IF NEGATIVE, PARTITION IS DOWN
      JMP PP.40     YES, PARTITION IS DOWN, TELL CALLER 
* 
      SZB,RSS       IF ZERO, NO PROGRAM IS IN THE PARTITION 
      JMP PP.50     YES, PARTITION IS EMPTY 
* 
      ADB .12       POINT TO NAME FIELD IN ID 
      JSB .XLA      GET FIRST 2 CHARS OF NAME 
      DEF 1,I 
      CPA ZERO      IF ZERO, PROGRAM HAS BEEN OFFED 
      JMP PP.50     YES ITS ZERO, OUTPUT <NONE> 
* 
      STA PTNAF     STORE IN NAME FIELD 
      INB           POINT TO NEXT TWO CHARS 
      JSB .XLA      GET THEM
      DEF 1,I 
      STA PTNAF+1   PUT THEM IN OUTPUT BUFFER 
      INB 
      JSB .XLA      GET LAST CHAR 
      DEF 1,I 
      AND HIGH8     MASK HIGH BYTE
      IOR B40       PAD WITH SPACE
      STA PTNAF+2 
      JMP PP.70 
* 
* JUMP TO HERE WHEN THE PARTITION IS DOWN 
* 
PP.40 LDA DOWNA     GET SOURCE ADDRESS OF DOWN MESSAGE
      JMP PP.55     JUMP TO MOVE THE WORDS
* 
* JUMP TO HERE WHEN THE ID, HENCE THE PARTITION 
* IS NOT IN USE 
* 
PP.50 LDA NONEA     GET ADDRESS OF BUFFER 
PP.55 LDB PTNAA     GET NAME FIELD ADDRESS OF OUTPUT BUFFER 
      JSB .MVW      MOVE THE NAME 
      DEF .3
      NOP 
PP.70 JSB $LIBX     RAISE FENCE 
      DEF *+1 
      DEF *+1 
      JSB OUTPT     OUTPUT BUFFER 
      DEF PTMSG 
      DEF PTLEN 
      LDA PRTN# 
      CPA MAT#      LAST MAT CHECKED? 
      JMP PL.EX     YES, SO EXIT
      ISZ PRTN#     NO, SO INCRIMENT PARTITION NUMBER 
      LDB MATA      GET ADDRESS OF PREVIOUS MAT 
      ADB .3        POINT TO NEXT MAT 
      JMP PP.20     TAKE ITS PICTURE
* 
CONVL NOP 
      CCE           CONVERT TO ASCII DECIMAL
      JSB $CVT3     CONVERT A REG TO ASCII
      STA TEMP2     SAVE ADDR OF RESULT 
      LDA 0,I       GET 1ST 2 CHARS 
      AND B377      1ST MUST BE ZERO
      CPA B60       IS 2ND ZERO?
      LDA B40        YES, USE A SPACE 
      IOR CONVL,I   FILL 1ST CHAR 
      STA TEMP,I    STORE IN MSG
      ISZ TEMP2     POINT TO 3RD & 4TH CHARS
      ISZ TEMP
      LDA TEMP2,I   MOVE ASCII VALUE
      STA TEMP,I     INTO MESSAGE 
      ISZ TEMP2 
      ISZ TEMP
      LDA TEMP2,I 
      STA TEMP,I
      ISZ TEMP
      ISZ CONVL 
      JMP CONVL,I   RETURN
* 
* 
* 
* 
DECIM NOP 
      CLB 
      DIV .10 
      SZA,RSS 
      LDA B20       SUPPRESS LEADING ZERO 
      ALF,CLE,ALF 
      IOR 1         MERGE 2 DIGITS
      XOR ASC00     FORM ASCII NUMERICS 
      JMP DECIM,I 
      SPC 3 
* 
ER56  LDA .56 
* 
ERR   LDB PL..
      ADB .3
      LDB 1,I       GET ADDR FOR ERROR PRAM 
      STA 1,I       RETURN ERROR
      JMP PL.EX     EXIT
      SPC 3 
* 
*  ROUTINE TO WRITE LINE TO LIST FILE 
* 
OUTPT NOP 
      DLD OUTPT,I   GET ADDR OF BUFFER & ADDR OF LENGTH 
      DST OUTP5     STORE IN-LINE OF CALL 
      JSB WRITF     WRITE LINE
      DEF *+5 
      DEF O.BUF 
      DEF IERR
OUTP5 BSS 2 
      LDA IERR      GET FMGR ERROR CODE 
      SSA           ERROR?
      JMP ERR        YES
      ISZ OUTPT 
      ISZ OUTPT 
      JMP OUTPT,I   RETURN
      SPC 3 
* 
*  DATA AREA
* 
TEMP  NOP 
TEMP2 NOP 
STTYP NOP 
IERR  NOP 
IDADS NOP 
IDADR NOP 
IDCNT NOP 
PRTN# NOP 
MAT#  NOP 
MATA  NOP 
STTUS NOP 
LEN   NOP 
PART  NOP 
ZERO  DEC 0 
N1    DEC -1
.9    DEC 9 
.10   DEC 10
.12   DEC 12
.14   DEC 14
.15   DEC 15
.17   DEC 17
.24   DEC 24
.25   DEC 25
.56   DEC 56
.60   DEC 60
.100  DEC 100 
.6000 DEC 6000
B20   OCT 20
B40   OCT 40
B77   OCT 77
B377  OCT 377 
B7777 OCT 7777
HIGH8 OCT 177400
SZMSK OCT 76000 
.01B  OCT 010000
N2    DEC -2
* 
PRS1  OCT 153000
PRS2  OCT 203 
ASCIT ASC 1,IT
ASCMB ASC 1,MB
ASCPT ASC 1,PT
ASC00 ASC 1,00
ASC0C ASC 1,0:
ASCCL ASC 1,::
PSCMD ASC 2, PS,
PTNAA DEF PTNAF     ADDRESS OF PROGRAM NAME FIELD FOR PL,PT 
PTNUA DEF PTNUF     ADDRESS OF PARTITION NUMBER FIELD 
PRGSA DEF PRGSZ     ADDRESS OF PROGRAM SIZE FIELD 
* 
      ASC 1,
MSBUF BSS 2 
MSNAM BSS 3 
      BSS 16
* 
MSGBF EQU * 
      ASC 1,
M.NAM BSS 3 
      ASC 2, R= 
M.RES NOP 
BLANK ASC 2,  M=
M.MUL DEC 0,0 
      ASC 1,
M.HR  NOP 
M.MIN DEC 0,0 
M.SEC NOP 
M.MSC DEC 0,0 
MSGLN ABS *-MSGBF 
* 
* THIS BUFFER IS USED FOR PL,MB RESPONSE
* 
MBMSG ASC 1,
MBPNF ASC 3,
PRGSZ ASC 8,
MBLEN ABS *-MBMSG 
* 
* THIS BUFFER IS USED FOR THE PL,PT RESPONSE
* 
PTMSG ASC 1,
PTNUF ASC 13, 
PTNAF ASC 3,
PTLEN ABS *-PTMSG 
* 
ASRES DEF *+1       CONVERT RES CODE TO ASCII 
      ASC 5,XXMSSCMNHR
* 
TYPES DEF *+1 
      ASC 1,OF      DORMANT 
      OCT 0 
      ASC 1,AB      BEING ABORTED 
      OCT 1 
      ASC 1,IO      I/O SUSPEND 
.2    OCT 2 
      ASC 1,WT      PROGRAM WAIT SUSPEND
.3    OCT 3 
      ASC 1,SS      OPERATOR SUSPEND
      OCT 6 
      ASC 1,PA      PAUSE 
.7    OCT 7 
      ASC 1,TM      TIME SUSPEND
      OCT 47
      ASC 1,LK      LOCKED DEVICE SUSPEND 
      OCT 50
      ASC 1,RN      RESOURCE NUMBER SUSPEND 
      OCT 51
      ASC 1,CL      CLASS GET OR CLASS # SUSPEND
      OCT 52
      ASC 1,QU      QUEUE SUSPEND 
      OCT 53
      ASC 1,DN      DOWN DEVICE SUSPEND 
      OCT 54
      ASC 1,BL      BUFFER LIMIT SUSPEND
      OCT 55
      ASC 1,LD      LOAD SUSPEND
      OCT 56
      ASC 1,SR      SHARED SUBROUTINE SUSPEND 
      OCT 57
      ASC 1,SC      SCHEDULED 
B60   OCT 60
      ASC 1,XQ      EXECUTING 
      OCT 60
      ASC 1,MM      MEMORY SUSPEND
      OCT 61
      OCT 100000    END OF TABLE
* 
MBHDR ASC 12,  NAME    SIZE  PRTN NUM 
MBHLN ABS *-MBHDR 
PTHDR ASC 18,PRTN NUM  LOW PAGE  LENGTH  OCCUPANT 
PTHLN ABS *-PTHDR 
NONEA DEF NONE
DOWNA DEF DOWN
NONE  ASC 3,<NONE>
DOWN  ASC 3,<DOWN>
* 
SIZE  EQU * 
      END 
                                                                                                                              