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