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 * 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, DOWN ASC 3, * SIZE EQU * END