ASMB,R
* 
*     NAME:   PL..
*     SOURCE: 92070-18104 
*     RELOC:  92070-1X104 
*     PGMR:   C.H.W.
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1979.  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  92070-1X104  REV.1941  790607 
* 
* 
* 
      ENT PL..
* 
      EXT O.BUF,TMP.,OPEN.,WRITF
      EXT $LIBR,$LIBX,$CVT3 
      EXT MESSS 
      EXT $IDA,$ID#,$IDSZ 
* 
      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 
* 
      LDB $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
      SZA,RSS       DO ALL? 
      JMP PL.30      YES
* 
*  LIST ONLY THOSE PROGRAMS OF REQUESTED STATUS 
      STA TEMP      SAVE STATUS TYPE
      LDB TYPES     LIST OF VALID STATI 
PL.10 LDA 1,I 
      SSA           END OF LIST?
      JMP ER56       YES, PARAMETER ERROR 
      CPA TEMP      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
      LDB $IDA      ADDR OF ID SEGMENTS 
* 
PL.40 STB IDADS 
      LDA STTUS 
      SSA           DOING ALL?
      JMP PL.50      YES
      ADB .15       POINT TO IDSEG WD 16
      XOR 1,I 
      AND B77       STATUS IN BITS 5-0
      SZA           STATUS MATCH? 
      JMP PL.60      NO 
      LDB IDADS 
* 
PL.50 ADB .12       POINT TO NAME IN IDSEG
      LDA 1,I       GET 1ST 2 CHARS 
      SZA,RSS 
      JMP PL.60     ID SEG NOT USED 
      STA MSNAM     MOVE TO BUFR
      INB 
      DLD 1,I       GET LAST 3 CHARS
      DST MSNAM+1 
      DLD PSCMD     " PS,"
      DST MSBUF     MOVE CMD
* 
      JSB MESSS     CALL MESSAGE PROCESSOR
      DEF *+3 
      DEF MSBUF 
      DEF .9
      SSA,RSS       ANY REPLY?
      JMP ER56      ERROR?? 
      ADA N2
      STA LEN 
      JSB OUTPT     WRITE RESPONSE TO LIST DEVICE 
      DEF MSBUF-1 
      DEF LEN 
* 
PL.60 LDB IDADS 
      ADB $IDSZ     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 LDB $IDA      ADDR OF ID SEGMENTS 
* 
PT.20 STB IDADS     SAVE ID SEGMENT ADDR
      ADB .17       POINT TO RES/MULT IN ID SEGMENT +17 
      STB IDADR 
      LDA 1,I       GET RES 
      ALF,SLA,RAR   RIGHT JUSTIFY IT, SKIP IF T=0 
      RSS           IN TIME LIST
      JMP PT.70     NOT IN TIME LIST, IGNORE IT 
      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
      LDA 1,I        HAS LAST CHAR OF NAME
      AND HIGH8     CLEAR RHW 
      IOR B40       FILL WITH A BLANK 
      STA M.NAM+2   STORE IN LINE 
      ADB N2        POINT TO ID+12
      DLD 1,I       GET 1ST 4 CHARS OF NAME 
      DST M.NAM 
* 
      LDA IDADR,I   GET MULT
      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 
IDADR EQU *+1 
      DLD *         GET TIME FROM ID SEGMENT
      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 LDB IDADS 
      ADB $IDSZ 
      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 
      LDB $IDA      ADDR OF ID SEGS 
* 
PB.20 STB IDADS 
      LDA MSF2A     ADDR OF MESAGE FIELDS 
      STA TEMP
      ADB .14       POINT TO NAME IN ID SEG 
      LDA 1,I       GET LAST CHAR 
      AND HIGH8     ISOLATE IT
      IOR B40       BLANK 
      STA MBF1+2    STORE IN MSG
      ADB N2        POINT TO 1ST WD OF NAME 
      DLD 1,I       GET 4 CHARS OF NAME 
      SZA,RSS 
      JMP PB.50     ID SEG NOT USED 
      DST MBF1      STORE IN MSG
      LDB IDADS 
      ADB .20       POINT TO HI CORE START
      LDA 1,I       GET IT
      RAL,CLE,ERA   CLEAR SIGN
      JSB $LIBR     LOWER FENCE 
      NOP 
      JSB CONVL     CONVERT TO ASCII
      OCT 24000     "(" 
      CCA 
      ADA 1,I       GET HI CORE LAST
      RAL,CLE,ERA 
      JSB CONVL     CONVERT TO ASCII
      OCT 26000     "," 
      ISZ TEMP
      INB           POINT TO BASE PAGE LIMITS 
      LDA 1,I       GET LOW BASE PAGE 
      AND B1777     USE BITS 9-0
      JSB CONVL     CONVERT TO ASCII
      OCT 24000     "(" 
      CCA 
      ADA 1,I       HIGH BASE PAGE
      AND B1777     USE BITS 9-0
      JSB CONVL     CONVERT TO ASCII
      OCT 26000     "," 
* 
      JSB $LIBX     RAISE FENCE 
      DEF *+1 
      DEF *+1 
* 
      JSB OUTPT     PRINT BOUNDS
      DEF MBMSG 
      DEF MBLEN 
* 
PB.50 LDB IDADS 
      ADB $IDSZ     POINT TO NEXT ID SEG
      ISZ IDCNT     MORE? 
      JMP PB.20      YES
      JMP PL.EX     DONE
* 
* 
CONVL NOP 
      CLE,INB       POINT TO NEXT ID SEG WD 
      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 
IERR  NOP 
IDADS NOP 
IDCNT NOP 
STTUS NOP 
LEN   NOP 
ZERO  DEC 0 
.9    DEC 9 
.10   DEC 10
.12   DEC 12
.14   DEC 14
.15   DEC 15
.17   DEC 17
.20   DEC 20
.24   DEC 24
.56   DEC 56
.60   DEC 60
.100  DEC 100 
.6000 DEC 6000
B20   OCT 20
B40   OCT 40
B77   OCT 77
B377  OCT 377 
B1777 OCT 1777
B7777 OCT 7777
HIGH8 OCT 177400
.01B  OCT 010000
N2    DEC -2
* 
PRS1  OCT 153000
PRS2  OCT 203 
ASCIT ASC 1,IT
ASCMB ASC 1,MB
ASC00 ASC 1,00
ASC0C ASC 1,0:
ASCCL ASC 1,::
PSCMD ASC 2, PS,
MSF2A DEF MBF1+3
* 
      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 
* 
MBMSG ASC 2,
MBF1  BSS 9 
      ASC 1,) 
      BSS 6 
      ASC 1,) 
MBLEN ABS *-MBMSG 
* 
ASRES DEF *+1       CONVERT RES CODE TO ASCII 
      ASC 5,XXMSSCMNHR
* 
TYPES DEF *+1 
      ASC 1,OF      DORMANT 
      OCT 0 
      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 26, PGM LIST: NAME (LO MAIN,HI MAIN) (LO BASE,HI BASE)
MBHLN ABS *-MBHDR 
* 
SIZE  EQU * 
      END 
                                                                                                                                        