ASMB,R,L,C,Z
* 
*  **************************************************************** 
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976.  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.        * 
*  **************************************************************** 
* 
      IFZ 
      HED WHZAT FOR RTE-III  <B>
      NAM WHZAT,1,1 92060-16006 REV.1726 770520 
* 
*     NAME:    WHZAT
*     SOURCE:  92060-16006
*     RELOC:   92060-18006
*     PRGMR:   J.F.B.,E.J.W.,D.L.S. 
* 
      XIF 
      IFN 
      HED WHZAT FOR RTE-II  <B> 
      NAM WHZAT,1,1 92001-16030 REV.1726 770520 
* 
* NAME:        WHZAT
* RELOCATABLE: 92001-16030
* SOURCE:      92001-18030
* PRGM:        J.F.B.,E.J.W.,D.L.S. 
* 
      XIF 
      SUP PRESS ALL EXTRANEOUS LISTING
      EXT EXEC,$TIME,$RNTB,$CLAS,TMVAL
      IFZ 
      EXT $MATA 
      XIF 
* 
A     EQU 0 
B     EQU 1 
* 
EQTA  EQU 1650B 
EQT#  EQU 1651B 
DRT   EQU 1652B 
LUMAX EQU 1653B 
KEYWD EQU 1657B 
* 
* 
*THE FOLLOWING IS A SAMPLE OUTPUT OF THIS PROGRAM:
*              ON,WHZAT,LU
* 
* <TOP-OF-CRT>09:51:50:710
* **********************************************************************
* PT SZ PRGRM,T,PRIOR*DRMT*SCHD*I/O *WAIT*MEMY*DISC*OPER * NEXT TIME   *
* **********************************************************************
*  0 ** MEM  *1*09000 ***** 1 
*  2 ** R$PN$*1*00010 *************** 3, CL  032
*  3 ** PROGA*3*00097 ******************************* 6 
*  4 ** PROGB*3*00097B*************** 3,LULK040,LKPRG=PROGA 
*  5 ** PROGC*3*00097***************  3,RN  031,LKPRG=PROGD 
*  3 ** PROGD*3*00097 *************** 3,RESOURCE
*  5 ** PROGE*3*00097 *************** 3,CLASS 
*  2 ** QUIKR*3*00099  0 *********************************00:00:00:000**
*  6 ** FMGR *3*00090 *************** 3, EDITR'S QUEUE
*  3 ** EDITR*3*00050 ************************* 5 
*  6 ** ASMB *3*00099 *************** 3, LU,EQ DN 
*  7 ** FMG07*3*00050 *************** 3, BL,EQT 7 
*  2 ** WHZAT*3*00001 ***** 1 
*  6 ** ED26 *3*00050 ********** 2, 16(2[00000010]) 
* **********************************************************************
* DOWN LU'S,  14
************************************************************************
* DOWN EQT'S,  6
* **********************************************************************
* 09:51:50:710
* <BOTTOM-OF-CRT> 
* 
* 
* BRIEF EXPLANATION OF SOME OF THE ABOVE. 
* 
* PT SZ    COLUMN HEADING (PARTITION NUMBER AND PARTITION SIZE) 
*  0  **   IN RTE-III MEANS MEMORY RESIDENT PROGRAM 
*          IN RTE-II ALL PROGRAMS ARE LISTED IN THIS FASHION
*  5   8   IN RTE-III MEANS PARTITION #5 IS USED AND HAS 8 PAGES
* 
*          'B' FOLLOWING THE PROGRAM'S PRIORITY MEANS RUNNING UNDER BATCH 
* WHEN A PROGRAM IS IN STATE 3[WAIT],THE REASON FOR BEING IN THAT 
* STATE WILL BE SPECIFIED ACCORDING TO THE FOLLOWING RULES :
* IDSEG(2) ::= $RNTB                 => 'RN ALLOCATION' 
*          ::= DRT(#[6:10])=RN#      => 'LU # LOCKED' 
*          ::= >$RNTB,<$RNTB+[$RNTB] => 'RN LOCKED' 
*          ::= $CLAS                 => 'CLASS ALLOCATION'
*          ::= >$CLAS,<$CLAS+[$CLAS] => 'CLASS GET' 
*          ::= 4                     => 'DEVICE(LU OR EQT) DOWN'
*          ::= SON'S IDSEG ADDRESS   => 'SON'S NAME'
*          ::= EQT ADDRESS           => 'BL,EQT#NN' 
* 
* 
* 
* FORMAT IF THE PARTITION LIST OPTION IS CHOSEN IN RTE-III
*            ON,WHZAT,LU,1
* 
* <TOP-OF-CRT>09:00:21:250
* **********************************************************************
* PTN# SIZE   PAGES   BG/RT PRGRM 
* **********************************************************************
*  1     7    19-  25 BG    FMG11 
*  2     7    26-  32 BG    EDITR 
*  3    15    33-  47 BG    <NONE>
*  4     4    48-  51    RT WHZAT 
*  5     5    52-  56    RT R$PN$ 
*  6     7    89-  95 BG    GASP
*  7  <UNDEFINED> 
*  8  <UNDEFINED> 
*  9  <UNDEFINED> 
* 10  <UNDEFINED> 
* **********************************************************************
* 09:00:21:310
* <BOTTOM-OF-CRT> 
* 
* 
      SKP 
WHAT  LDA B,I 
      CLE,SZA,RSS   SCHED W PRAM ?
      CLA,CCE,INA   NO-DEFAULT TO LU 1
      STA CRTLU     SAVE LU FOR OUTPUT
      INB 
      LDA B,I 
      STA PARM2     SAVE SECOND PARAMETER 
      INB 
      LDA B,I       GET SPECIAL LU PARAM
      SZA,RSS        IN CASE OF PREV RUN
      LDA CRTLU 
      SEZ           DEFAULT NEEDED? 
      STA CRTLU      YES
      SPC 2 
      LDA .RNTB     DEFINE RESOURCE TABLE 
      JSB .IND.     CHASE DOWN INDIRECT LINKS 
      STA RNTBL     SAVE ADDRESS OF RN TABLE
      LDA .CLAS     DEFINE CLASS TABLE
      JSB .IND.     CHASE DOWN INDIRECT LINKS 
      STA CLASS     SAVE ADDRESS OF CLASS TABLE 
      SPC 2 
      LDA .HOMU     HOME UP CRT 
      LDB DM4       FOUR TIMES FOR 2400 BAUD
      JSB PRINT     USE STD PRINT SUB 
      JSB TOD       PRINT TIME-OF-DAY AS NEXT LINE
      JSB STARS     ERASE EOL + A LINE OF ASTERISKS 
* 
      IFZ 
      LDA PARM2 
      SZA           WAS SECOND PARAMETER GIVEN? 
      JMP WHATP      YES, SHOW PARTITIONS 
      XIF 
* 
      SPC 2 
      LDA .HEAD     ERASE EOL + COLUMN HEADER 
      LDB DM74
      JSB PRINT 
      JSB STARS     ERASE EOL + A LINE OF ASTERISKS 
      CLA           ZERO IDSEG #
      STA IDCNT     AND AWAY WE GO !
      SPC 2 
      SKP 
MAIN  JSB SETPT     BEGIN MAIN CODE.  INIT STACK
      LDA KEYWD     GET ADDRESS OF KEYWORD BLOCK
      ADA IDCNT     ADD ON IDSEG # TO INDEX 
      LDA A,I        TO THIS LOOP'S WORK
      STA IDPNT     IDSEG(1)
* 
      SZA,RSS       IF ZERO,
      JMP FINIS     THEN WE'RE THRU WITH ID SEG'S 
* 
      LDB D15       ELSE VERIFY 
      JSB IDWRD      THAT THIS
      AND B17         IDSEG(16[4-0])=PROG STATUS
      STA STATS        PROGRAM IS 
      SZA                NOT DORMANT ?
      JMP PROCS     ACTIVE SO PROCESS IT !
* 
      LDB D17       VERIFY
      JSB IDWRD     THAT THIS 
      ALF,SLA         IDSEG(18[12])=TIME LIST INDICATOR 
      JMP PROCS        PROG IS IN TIME LIST ! 
      JMP BUMP0     ELSE NEXT INDEX(IDSEG #)
* 
D2    DEC 2 
D3    DEC 3 
D5    DEC 5 
D6    DEC 6 
D12   DEC 12
D14   DEC 14
D15   DEC 15
D17   DEC 17
D21   DEC 21
B77   OCT 77
B17   EQU D15 
CRTLU NOP 
PARM2 NOP 
IDCNT NOP 
IDPNT NOP 
STATS NOP 
STACK OCT 17036,17036 
      BSS 35
.STAK DEF STACK 
STKPT NOP 
.TM.  DEF STACK+31
ASTER OCT 17036,17036 
      UNL 
       REP 35 
      ASC 1,**
      LST 
.ASTE DEF ASTER 
.STAR DEF ASTER+2 
DM4   DEC -4
D7    DEC 7 
      SPC 4 
PROCS EQU * 
      IFZ 
      LDB D14 
      JSB IDWRD     GET PROG TYPE 
      AND D7
      CPA D1        RESIDENT PROGRAM? 
      RSS 
      CPA D4
      RSS 
      JMP PRLNG      NO, PROCESS DISC RESIDENT
      XIF 
* 
      LDA .RSDT      YES, RESIDENT PROGRAM
      JSB MVBYT     PRINT IT IS IN PARTITION 0
       DEF D6 
* 
      IFZ 
      JMP NAME      GO GET PROGRAM NAME 
* 
PRLNG LDB D21       GET CONTENTS
      JSB IDWRD      OF WORD 22 
      STA NUM        (PARTITION #)
      AND B77 
      INA           CONVERT TO ASCII
      JSB .ASC2      AND ADD TO STACK 
      LDA .SPAC 
      JSB MVBYT     PUT A SPACE IN
       DEF D1         OUTPUT LINE 
* 
      LDA NUM 
      ALF,RAL       GET NUMBER OF PAGES 
      RAL            IN PARTITION 
      AND B37 
      INA           ADD 1 FOR BASE PAGE 
      JSB .ASC2     CONVERT TO ASCII
      LDA .SPAC 
      JSB MVBYT     PUT A SPACE 
       DEF D1 
      XIF 
* 
* 
NAME  LDA IDPNT     CALC 'FROM' 
      ADA D12        BYTE ADDRESS 
      JSB MVBYT     MOVE NAME TO OUTPUT STACK 
       DEF D5        SPEC 5 BYTES 
* 
      JSB PSTAR     PUSH AN ASTERISK
      SPC 2 
TYPE  LDB D14       GET PROGRAM TYPE
      JSB IDWRD 
      ALF,ALF       CHECK FOR SHORT ID
      ALF,SLA,ALF    SHORT ?
      JMP FINIS       YES,STOP ID CHECK 
      AND D7        MASK OFF IDSEG(15[2-0]) 
      JSB .ASC1      & STORE BYTE 
      JSB PSTAR     PUSH AN ASTERISK
* 
PRIOR LDB D6        GET PROG PRIORITY 
      JSB IDWRD      IN 'A'REG
      JSB ZASC5     CONVERT TO ASCII & ADD TO STACK 
* 
      LDB D20 
      JSB IDWRD 
      LDB .SPAC 
      SSA           IF RUNNING UNDER BATCH, 
      LDB .B         PRINT 'B'
      LDA B         ELSE PRINT SPACE
      JSB MVBYT 
       DEF D1 
      SPC 2 
      LDA STATS     CALC STATUS COLUMN
      SZA,RSS       DORMANT ? 
      JMP M         NO ASTERISKS NECESSARY
      MPY D5        5 CHARS PER COLUMN
      STA NUM       SET UP MOVE 
      LDA .STAR     'A'REG=SOURCE 
      JSB MVBYT     MOVE BYTES,R/L
       DEF NUM BER OF BYTES 
* 
M     LDA STATS     CONVERT STATUS TO ASCII 
      JSB .ASC2      & PUSH ONTO STACK
* 
      LDA STATS     GET STATUS
      CPA D2        I O SUSPEND ? 
      JMP EQT       YES-PROCESS EQT#
      CPA D3        WAIT LIST ? 
      JMP WAIT      YES-PROCESS WAIT
      LDA .SPAC     ADD ONE MORE SPACE
      JSB MVBYT 
       DEF D1 
      JMP TLIST     CHECK TLIST 
      SPC 2 
EQTPT NOP 
#EQTS NOP 
.RSDT DEF *+1 
      ASC 3, 0 ** 
.B    DEF *+1 
      ASC 1,BB
      SKP 
EQT   CLA           PROG'S IN I/O SUSPEND 
      STA #EQTS      SET UP EQT INDEX 
* 
EQTLP LDA #EQTS     GET EQT INDEX 
      MPY D15       (15 WORDS EQT)
      ADA EQTA      ADD ON EQT AREA BASE
      STA EQTPT     SAVE THIS EQT'S ADDRESS 
      IFZ 
      XLA A,I       GET CONTENTS OF EQT'S FIRST WORD
      XIF 
      IFN 
      LDA A,I 
      XIF 
* 
IDSLP SZA,RSS       SCAN SUSPEND LIST.  NULL LIST?
      JMP NXTEQ      YES-GO TO NEXT EQT 
      CPA IDPNT      NO-POINTS TO OUR ID SEG ?
      JMP FNDEQ     YES-GO PROCESS. 
      IFZ 
      XLA A,I       NO-NEXT LIST ELEMENT
      XIF 
      IFN 
      LDA A,I 
      XIF 
      JMP IDSLP      & CONTINUE THE SEARCH
* 
NXTEQ ISZ #EQTS     STEP EQT CNTR FOR NEXT EQT ENTRY
      LDA #EQTS     ARE WE THRU ? 
      CPA EQT#      COMPARE WITH BASE PAGE COUNT
      JMP OSCAR     YES-MUST BE OSCAR 
      JMP EQTLP     NO- GOTO EQT LOOP 
* 
OSCAR LDA .EXEC     MOVE " ,EXEC" ONTO STACK
      JSB MVBYT 
       DEF D6 
      JMP TLIST     & CHECK TIME LIST 
      SPC 2 
.EXEC DEF *+1 
      ASC 3,, EXEC
.CMBL EQU .EXEC     COMMA, BLANK
B140K ABS 140000B 
.LPAR DEF *+1 
      ASC 1,( 
.LBRK DEF *+1 
      ASC 1,[ 
.IOBE DEF *+1 
      ASC 3,])  * 
      SPC 2 
FNDEQ EQU *         PUSH ", EQ(L[DEV.STAT])  *" 
      LDA .CMBL     MOVE COMMA AND BLANK
      JSB MVBYT 
       DEF D2 
      LDA #EQTS     CALC EQT #
      INA 
      JSB .ASC2     CONVERT TO ASCII
      LDA .LPAR     PUSH "(" ONTO STACK 
      JSB MVBYT 
       DEF D1 
* 
      LDB EQTPT     GET DEV.LOG.STATUS
      ADB D4
      IFZ 
      XLA B,I 
      XIF 
      IFN 
      LDA B,I 
      XIF 
      ALF,ALF 
      STA EQST      SET UP FOR BINARY STATUS
      ALF,ALF 
      AND B140K     MASK OFF LOGICAL STATUS 
      RAL,RAL       RIGHT JUSTIFY IN WORD 
      JSB .ASC1     CONV TO ASCII & STORE 
      LDA .LBRK     PUSH "[" ONTO STACK 
      JSB MVBYT 
       DEF D1 
* 
      LDA DM8       SET UP LOGICAL STATUS 
      STA CNT       COUNTER 
BINLP LDA EQST      CONVERT STATUS WORD TO BINARY 
      RAL           ROTATE CCW
      STA EQST      SAVE IT 
      AND D1        MASK OFF LSB(IT)
      JSB .ASC1     CONV TO ASCII & STORE 
      ISZ CNT       DONE 8 ?
      JMP BINLP     NO-LOOP 
* 
      LDA .IOBE     MOVE LAST PART OF MESSAGE 
      JSB MVBYT     PUSH
       DEF D5 
      JMP TLIST     CHECK TLIST 
      SPC 2 
DM8   DEC -8
D20   DEC 20
REASN NOP 
TEST  EQU REASN 
EQST  NOP 
      SKP 
WAIT  LDA .EXEC     PUSH ", "ONTO STACK 
      JSB MVBYT      FOR EXPLANATION
       DEF D2 
* 
      CLB,INB       GET IDSEG(2)
      JSB IDWRD 
      STA REASN 
      CPA RNTBL     RESOURCES LOCK ?
      JMP RESLK     YES-PUSH "RN ?" ONTO STACK
      CPA CLASS     NO-CLASS LOCK ? 
      JMP CLSLK     YES-PUSH "CLASS ?" ONTO STACK 
      CPA D4        NO-DEVICE DOWN ?
      JMP DEVDN     YES-PUSH "DEVICE DOWN" ONTO STACK 
* 
      JSB TSTWD     RNTBL<=IDSEG(2)<=[RNTBL] ?
.RNTB  DEF $RNTB
      JMP RNLCK     YES-PUSH "RN LOCK" ONTO STACK 
* 
      JSB TSTWD     CLASS<=IDSEG(2)<=[CLASS] ?
.CLAS  DEF $CLAS
      JMP CLGET     YES-PUSH "CLASS GET" ONTO STACK 
* 
      LDA 1650B     EQT <= IDSEG(2) <= #EQTS
      CMA,INA       - S.A. OF EQT 
      ADA REASN     + POINTER 
      SSA           IF -, THEN POINTER < EQT S.A. 
      JMP SONID     FORGET IT 
      CLB           RESULT IS ADD REL S.A.EQT 
      DIV D15        MOD 15 
      INA             + 1 
      STA TEMP         = EQT #
      CMA,INA       -EQT# 
      ADA 1651B     + # EQT'S 
      SSA,RSS       IF POS,THEN VALID EQT # 
      JMP BL        SO PROCESS IT 
* 
SONID LDA REASN     GET SON'S IDSEG ADDRESS 
      ADA  D12      INDEX TO NAME 
      JSB MVBYT      MOVE SON'S NAME ONTO STACK 
       DEF D5 
      LDB D15 
      JSB IDWRD 
      ALF,SLA 
      JMP TLIST     BIT 12 SET, HAVE SON
      LDA .QUE      BIT 12 CLEAR, SON YET TO BE 
      JMP PUSH8 
      SPC 2 
.BLIM DEF *+1 
      ASC 3,BL,EQT00
* 
BL    LDA .BLIM     SET UP BUFFER LIMIT MESSAGE 
      JSB MVBYT 
       DEF D6 
      LDA TEMP
      JSB .ASC2     CONVERT EQT# & PUSH 
      JMP TLIST 
TEMP  NOP 
      SPC 2 
.QUE  DEF *+1 
      ASC 4,'S QUEUE
.RN?? DEF *+1 
      ASC 4,RESOURCE
RESLK LDA .RN??     PUSH "RN ??" ONTO STACK 
      JMP PUSH8 
      SPC 2 
.CL?? DEF *+1 
      ASC 4,CLASS # 
CLSLK LDA .CL??     PUSH "CL ??" ONTO STACK 
      JMP PUSH8 
      SPC 2 
.EQDN DEF *+1 
      ASC 5,LU/EQ DN
DEVDN LDA .EQDN     PUSH "LU,EQ DN" ONTO STACK
* 
PUSH8 JSB MVBYT     PUSH 8 CHARS ONTO STACK 
       DEF D8 
      JMP TLIST 
      SPC 2 
B37   OCT 37
@DRT  EQU 1652B 
@LUMX EQU 1653B 
.RNLK DEF *+1 
      ASC 2,RN  00,LKPRG=PROGA .
.LKPR DEF *+1 
      ASC 4,,LKPRG= 
* 
RNLCK STA RN        SAVE RN# TEMP 
      LDA @DRT      GET DRT ADDRESS 
      STA PTR       SET UP POINTER
      LDA @LUMX     GET MAX # OF LU'S 
      CMA,INA       SET UP COUNTER
      STA CNT 
LLOOP EQU *         SEARCH FOR LU LOCK
      LDA PTR,I     GET DRT ENTRY 
      RRR 6         POSITION LU LOCK RN 
      AND B37        & MASK IT
      CPA RN        LU LOCK ? 
      JMP LULCK     YES-PROCESS IT
      ISZ PTR       NO LOOP 
      ISZ CNT 
      JMP LLOOP 
      LDA .RNLK     PUSH "RN LK" ONTO STACK 
      JSB MVBYT 
       DEF D4 
      LDA RN        PROCESS RNLCK 
      JSB ZASC3 
      JSB PLOCK     PUT PROG NAME INTO MESSAGE
      JMP TLIST 
      SPC 2 
.LULK DEF *+1 
      ASC 3,LULK 00,LKPRG=PROGA . 
* 
LULCK LDA .LULK     PUT "LULK" ONTO STACK 
      JSB MVBYT 
       DEF D5 
      LDA CNT       PROCESS LU LOCK - FIND
      ADA @LUMX      OWNER'S NAME 
      INA 
      JSB .ASC2     PUT LU# IN MESSAGE
      JSB PLOCK     PUT PROG NAME IN MESSAGE
      JMP TLIST 
      SPC 2 
PLOCK NOP 
      LDA .LKPR     PUSH ",LKPRG=" ONTO STACK 
      JSB MVBYT 
       DEF D7 
      LDA RNTBL 
      ADA RN
      LDA A,I 
      AND B377      GET RESOURCE LOCKER'S ID SEG #
      CPA B377      IS IT GLOBAL? 
      JMP PLCK9      YES. 
      ADA M1
      ADA KEYWD 
      LDA A,I 
      ADA D12       (A) = ADDR OF LOCKER'S PROG NAME
PLCK5 JSB MVBYT     MOVE NAME 
       DEF D5 
      JMP PLOCK,I 
* 
PLCK9 LDA .GLBL 
      JMP PLCK5 
* 
.GLBL DEF *+1 
      ASC 3,GLOBL 
M1    DEC -1
RN    NOP 
PTR   NOP 
CNT   NOP 
.CLGT DEF *+1 
      ASC 2,CL  000 
.SPAC DEF .CLGT+2 
CL#   NOP 
* 
CLGET STA CL# 
      LDA .CLGT     PUSH "CL  " ONTO STACK
      JSB MVBYT 
       DEF D4 
      LDA CL# 
      JSB ZASC3 
      JMP TLIST 
* 
* 
TLIST LDB D17       IDSEG(18[12])=TIME LIST INDICATOR 
      JSB IDWRD 
      ALF,SLA   SET ? 
      JMP NXTTM     YES-CONV NEXT TIME
      JMP DUMP      NO-PRINT WHAT WE'VE GOT.
      SPC 2 
D8    DEC 8 
      SPC 2 
NXTTM LDA .TM.      CALC # OF STARS TO FILL LINE
      CLE,ELA 
      CMA,INA 
      ADA STKPT 
      CMA,INA        PLUS 1 
      STA NUM        & SAVE IT
      LDA .STAR     SET UP FOR MOVE 
      JSB MVBYT 
       DEF NUM
* 
      LDA IDPNT 
      ADA  D18
      JSB CNVTM 
* 
DUMP  JSB OUTPT     DISPLAY STACK 
BUMP0 ISZ IDCNT 
      JMP MAIN
      SPC 2 
FINIS JSB STARS     EOL + 70 ASTERISKS
* 
DNDEV JSB SETPT     RESET STACK FOR DOWN LU'S.
      LDA .DNLU     PRINT LINE HEAD.
      JSB MVBYT 
      DEF D9
* 
      LDA DRT       GET LU TABLE AREA ADDRESS,
      ADA LUMAX      POSITION TO WORD TWO 
      STA EQTPT       TABLE AND SAVE. 
      CLA           INITIALIZE
      STA #EQTS      COUNTER. 
* 
DNLU1 LDA EQTPT,I   GET LU'S STATUS.
      ISZ #EQTS 
      SSA,RSS       IS IT DOWN? 
      JMP NXTLU     NO--GET NEXT LU.
      LDA .CMBL     YES--PROCESS IT.
      JSB MVBYT     PUSH A ', '.
      DEF D2
      LDA #EQTS     CONVERT LU# 
      JSB .ASC2      TO ASCII.
NXTLU ISZ EQTPT     INCREMENT DRT WORD 2 POINTER. 
      LDA #EQTS     IF LAST,
      CPA LUMAX      THEN GO
      RSS             DUMP LINE.
      JMP DNLU1     ELSE CONTINUE.
* 
      JSB OUTPT     PRINT STACK.
      JSB STARS     E0L + LINE OF ASERISKS. 
* 
      JSB SETPT     RESET STACK FOR DOWN EQTS 
      LDA .DNEQ     PRINT LINE HEAD 
      JSB MVBYT 
       DEF D10
* 
      LDA EQTA      GET EQT TABLE AREA ADDRESS
      ADA D4        INDEX TO STATUS 
      STA EQTPT     PUSH POINTER
      CLA           INIT
      STA #EQTS      EQT COUNTER
DEVLP LDA EQTPT,I   FIND EQT'S. GET STATUS
      ISZ #EQTS 
      RAL,RAL       POSITION
      AND D3         & MASK 
      CPA D1        IS IT DOWN
      RSS           YES-PROCESS 
      JMP NXTDV     NO-NEXT EQT 
      LDA .CMBL     PUSH ", " 
      JSB MVBYT 
       DEF D2 
      LDA #EQTS     CONV EQT# TO ASCII
      JSB .ASC2 
NXTDV LDA EQTPT     BUMP
      ADA D15        TO NEXT
      STA EQTPT       EQT STATUS WORD 
      LDA #EQTS     WAS THIS THE LAST 
      CPA EQT#
      RSS           YES-DUMP IT 
      JMP DEVLP     NO-CONTINUE 
      SPC 2 
DONE  JSB OUTPT     PRINT STACK 
DONE1 JSB STARS     EOL + LINE OF ASTERISKS 
EXIT  JSB TOD       FINALLY TIME OF DAY 
      LDA .EOF      BOTTOM OF PAGE FOR OPERATOR 
      LDB DM10
      JSB PRINT 
      SPC 2 
      JSB EXEC      I AM SERIALLY REUSABLE
       DEF RSTRT
       DEF D6 
       DEF ZERO 
       DEF M1 
       DEF ZERO 
       DEF PARM2
       DEF CRTLU
RSTRT JMP WHAT      RESTART 
      SPC 2 
ZERO  OCT 0 
D18   DEC 18
DM10  DEC -10 
RNTBL NOP 
CLASS NOP 
NUM   NOP 
D4    DEC 4 
.DNEQ DEF *+1 
      ASC 5,DOWN EQT'S
.DNLU DEF *+1 
      ASC 5,DOWN LU'S 
D9    DEC 9 
* 
@TIME DEF $TIME 
.HOMU DEF *+1 
      OCT 016435,016537 
.EOF  DEF *+1 
      OCT 017036,017036,16034,16034,16137 
.HEAD DEF *+1 
      OCT 17036,17036 
      ASC 25,PT SZ PRGRM,T,PRIOR*DRMT*SCHD*I/O *WAIT*MEMY*DISC* 
      ASC 10,OPER * NEXT TIME   * 
      SKP 
      IFN 
*LOAD BYTE
* ('B'REG = BYTE ADDRESS) 
*     JSB LBT 
* ('A'REG = BYTE) 
* ('B'REG = UPDATED TO NEXT BYTE ADDRESS) 
LBT   NOP 
      CLE,ERB 
      LDA B,I 
      SEZ,RSS 
      ALF,ALF 
      AND B377
      ELB 
      INB 
      JMP LBT,I 
      SPC 2 
*STORE BYTE 
* ('A'REG = BYTE) 
* ('B'REG = BYTE ADDRESS) 
*     JSB SBT 
* ('B'REG = UPDATED TO NEXT BYTE ADDRESS) 
SBT   NOP 
      AND B377
      STA CHAR
      CLE,ERB 
      LDA B,I 
      SEZ,RSS 
      ALF,ALF 
      AND BM377 
      IOR CHAR
      SEZ,RSS 
      ALF,ALF 
      STA B,I 
      ELB 
      INB 
      JMP SBT,I 
* 
CHAR  NOP 
BM377 OCT 177400
COUNT NOP 
      SPC 2 
      SPC 2 
*MOVE BYTES,R/L 
* ('A'REG = 'FROM' BYTE ADDRESS)
* ('B'REG = 'TO' BYTE ADDRESS)
*     JSB MBT 
*     DEF NUM BER OF BYTES TO MOVE
*     NOP 
* ('A'REG = UPDATED 'FROM' BYTE ADDRESS)
* ('B'REG = UPDATED 'TO' BYTE ADDRESS)
MBT   NOP 
      DST FROM
      LDA MBT,I 
      ISZ MBT 
      LDA A,I 
      ISZ MBT 
      CMA,INA,SZA,RSS 
      JMP MBT,I 
      STA COUNT 
MBTLP LDB FROM
      JSB LBT 
      STB FROM
      JSB STBYT 
      ISZ COUNT 
      JMP MBTLP 
      DLD FROM
      JMP MBT,I 
      XIF 
      SPC 2 
FROM  BSS 2 
TO    EQU FROM+1
B377  OCT 377 
      SPC 2 
STBYT NOP 
      LDB TO
      IFN 
      JSB SBT 
      XIF 
      IFZ 
      OCT 105764     JSB SBT
      XIF 
      STB TO
      JMP STBYT,I 
      SPC 2 
* ('A'REG = WORD ADDRESS OF FROM) 
*     JSB MVBYT 
*      DEF COUNT
* 
MVBYT NOP 
      CLE,ELA 
      LDB STKPT 
      DST FROM
      LDA MVBYT,I 
      ISZ MVBYT 
      STA .MVBY 
      DLD FROM
      IFN 
      JSB MBT 
      XIF 
      IFZ 
      OCT 105765     JSB MBT
      XIF 
.MVBY  NOP
       NOP
      STB STKPT 
      JMP MVBYT,I 
      SPC 2 
PSTAR NOP 
      LDA .STAR 
      JSB MVBYT 
       DEF D1 
      JMP PSTAR,I 
      SPC 2 
SETPT NOP 
      LDA .STAK 
      ADA D2
      CLE,ELA 
      STA STKPT 
      JMP SETPT,I 
      SPC 2 
OUTPT NOP 
      LDA .STAK 
      LDB .STAK 
      CLE,ELB       CONV TO BYTES 
      CMB,INB 
      ADB STKPT     ADD ON CURRENT BYTE POSITION
      CMB,INB 
      JSB PRINT 
      JMP OUTPT,I 
      SPC 2 
STARS NOP 
      LDA .ASTE 
      LDB DM74
      JSB PRINT 
      JMP STARS,I 
* 
DM74  DEC -74 
      SPC 2 
* 'A'REG = UPPER LIMIT
* 'B'REG = LOWER LIMIT
* TEST   = ???????????
*        JSB TESTR
* RETURN -'A'REG : POS => FALSE   NEG => TRUE . 
TESTR NOP 
      CMB,CLE,INB 
      ADB TEST
      LDB TEST
      CMB,SEZ,CLE,INB 
      ADB A 
      ERA           SIGN = E. E=0 FALSE  E=1 TRUE 
      JMP TESTR,I 
      SPC 2 
TSTWD NOP 
      LDA TSTWD,I 
      JSB .IND. 
      LDB A 
      ISZ TSTWD 
      ADA B,I 
      STB SAVEB 
      JSB TESTR 
      SSA,RSS 
      ISZ TSTWD 
      LDA SAVEB 
      CMA,INA 
      ADA TEST
      JMP TSTWD,I 
      SPC 2 
.IND. NOP 
      RSS 
N     LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP N 
      JMP .IND.,I 
      SPC 2 
PRINT NOP 
      STA .BUFF 
      STB CNT 
      JSB EXEC
       DEF *+1+4
       DEF D2 
       DEF CRTLU
.BUFF  DEF STACK
       DEF CNT
      JMP PRINT,I 
* 
TOD   NOP 
      JSB SETPT 
      LDA @TIME 
      JSB CNVTM 
      JSB OUTPT 
      JMP TOD,I 
      SPC 2 
MS    NOP 
SEC   NOP 
MIN   NOP 
HOURS NOP 
DAY   NOP 
.HOUR DEF HOURS 
.COLN DEF *+1 
      ASC 1,::
.ZERO DEF *+1 
      ASC 1,00
      SPC 2 
CNVTM NOP 
      STA ..        SAVE ADDRESS OF TIME VALUE
      JSB TMVAL     CONVERT INTO COMPONENTS 
       DEF *+1+2
..     DEF $TIME
       DEF MS 
      LDA .HOUR 
      STA PTR 
      LDA DM4 
      STA CNT 
      JMP TLOOR 
* 
TLOOP LDA .COLN     PUSH A ":" OUT
      JSB MVBYT 
       DEF D1 
TLOOR LDA PTR,I 
      JSB .ASC2     CONVERT TIME TO ASCII 
      CCA 
      ADA PTR 
      STA PTR 
      ISZ CNT 
      JMP TLOOP 
* 
      LDA .ZERO     ADD "0" FOR LAST NUMBER 
      JSB MVBYT      TO MULTIPLY BY 10 FOR MS 
       DEF D1 
      JMP CNVTM,I   RETURN WITH ASCII VALUES IN ARRAY TIME
      SPC 2 
IDWRD NOP 
      ADB IDPNT 
      LDA B,I 
      JMP IDWRD,I 
      SPC 2 
* 'A'REG = BINARY VALUE 
* 'B'REG = DESTINATION BYTE ADDRESS 
* 'E'REG = 0 FOR NO ZEROES, 1 FOR LEADING ZEROES
*       JSB ASCII 
* 'A'REG = LAST BYTE
* 'B'REG = BYTE ADDRESS UPDATED 
* 
ASCII NOP 
      STA VAL 
      CLA 
      ELA 
      STA FILL
      LDA STKPT 
      STA TO
      LDA B         (A)=(B)=DIGIT COUNT CODE
      ADB DM4 
      STB CCNTR 
      SZB,RSS       IF ONLY ONE DIGIT 
      JMP LSTDG      GO TO LAST DIGIT CODE
      ADA .N10K     ADJUST POWERS OF TEN TO 
      STA QPNTR      NUMBER OF DIGITS DESIRED 
LOOP  LDA VAL 
      CLB 
      DIV QPNTR,I   DIVIDE BY POWER OF TEN
      STB VAL       SAVE REMAINDER (LOWER DIGITS) 
      SZA 
      JMP ASCNV 
      CPA FILL      LEADING ZEROES WANTED?
      JMP LZERO      NO, BLANK OUT IF E#0 ORIGINALLY
ASCNV IOR B60       NOT 0 OR LEADING 0 WANTED 
      STA FILL       SO INSURE NO 0 GETS LOST 
ASCST JSB STBYT 
      ISZ QPNTR     INCRE TO NEXT POWER OF TEN
      ISZ CCNTR     BUMP DIGIT COUNTER
      JMP LOOP       MORE THAN 1 DIGIT LEFT 
LSTDG LDA VAL 
      IOR  B60      DO LAST DIGIT EVEN IF ZERO
      JSB STBYT 
      STB STKPT     (B) IS STILL NEXT BYTE ADDR 
      JMP ASCII,I 
* 
LZERO LDA B40       REPLACE LEADING ZEROES
      JMP ASCST      WITH BLANKS
      SPC 2 
.ASC1 NOP           CONVERT 1 DIGIT TO ASCII
      CLE 
      LDB D4
      JSB ASCII 
      JMP .ASC1,I 
      SPC 2 
.ASC2 NOP           CONVERT BINARY TO ASCII 
      CLE 
      LDB D3
      JSB ASCII 
      JMP .ASC2,I 
      SPC 2 
ZASC3 NOP           CONVERT 3 DIGITS, LEADING ZEROES
      CCE 
      LDB D2
      JSB ASCII 
      JMP ZASC3,I 
      SPC 2 
.ASC4 NOP           CONVERT 4 DIGITS, LEADING BLANKS
      CLB,CLE,INB 
      JSB ASCII 
      JMP .ASC4,I 
      SPC 2 
ZASC5 NOP           CONVERT 5 DIGITS, LEADING ZEROES
      CLB,CCE 
      JSB ASCII 
      JMP ZASC5,I 
      SPC 2 
VAL   NOP 
.N10K DEF N10K
N10K  DEC 10000,1000,100,10 
D1    DEC 1 
D10   EQU N10K+3
QPNTR NOP 
CCNTR NOP 
FILL  NOP 
SAVEB EQU VAL 
B40   OCT 40
B60   OCT 60
      SKP 
      IFZ 
WHATP LDA .PHED 
      LDB DM36
      JSB PRINT     PRINT HEADING FOR PARTITION STUFF 
      JSB STARS     '**********'
* 
      CLA,INA 
      STA PTN#      INIT PARTITION NUMBER 
      LDA $MATA 
      STA PTNAD     INIT PARTITION ADDR 
      ADA M1
      LDA A,I       GET # OF PARTITIONS 
      SZA,RSS 
      JMP DONE      IN CASE BOO-BOO 
      MPY D6
      ADA $MATA     CALCULATE ADDR OF 
      STA LPTAD      LAST PARTITION 
* 
NXPTN JSB SETPT 
      LDA PTN#      BEGIN PARTITION LINE
      JSB .ASC2     CONVERT # TO ASCII
* 
      LDA PTNAD,I   GET LINK WORD 
      SSA,RSS       PARTITION DEFINED?
      JMP CKRES      YES, CHECK STUFF 
* 
      LDA .UNDF      NO, PRINT 'NOT DEFINED'
      JSB MVBYT 
       DEF D14
      JMP DMPTN     DUMP LINE, PROCESS NEXT 
* 
CKRES LDB PTNAD 
      ADB D4        CALC ADDR OF RES/SIZE 
      LDA B,I 
      CLE,ELA 
      RAR           KEEP ONLY 10 BITS 
      AND B1777      (STATUS JUNK IN HIGH BITS) 
      STA PTSIZ     SAVE SIZE OF PART.
      LDA .SPAC     OUTPUT SPACE IF NOT RESERVED
      SEZ            ELSE 
      LDA .RSPC     USE 'R ' IF RESERVED
      JSB MVBYT 
       DEF D2 
* 
      LDA .SPAC 
      JSB MVBYT     OUTPUT 2 SPACES 
       DEF D2 
* 
      LDA PTSIZ     GET PART. SIZE (MAX=32) 
      INA            ADD 1 FOR BASE PAGE
      JSB .ASC2     CONVERT TO ASCII + OUTPUT 
* 
      LDA .SPAC 
      JSB MVBYT     2 MORE SPACES 
       DEF D2 
* 
      LDB PTNAD 
      ADB D3        ADDR OF START PAGE #
      LDA B,I 
      AND B1777     PAGE # IN LOW 10 BITS ONLY
      STA PAGE# 
      JSB .ASC4     CONVERT + OUTPUT 4 DIGITS 
* 
      LDA .DASH 
      JSB MVBYT     PUT "-" ON OUTPUT STACK 
       DEF D1 
* 
      LDA PAGE# 
      ADA PTSIZ     CALCULATE LAST PAGE # 
      JSB .ASC4     CONVERT + OUTPUT 4 DIGITS 
* 
      LDB PTNAD 
      ADB D5
      LDB B,I 
      LDA .BG       'BG   " IF BACKGROUND 
      SSB             ELSE
      LDA .RT       '   RT' IF REAL-TIME
      JSB MVBYT      CLASS PARTITION
       DEF D7 
* 
      LDB PTNAD 
      ADB D2
      LDA B,I 
      SZA,RSS       EMPTY?
      JMP NOPRG      YES, PRINT '<NONE>'
      ADA D12 
      JSB MVBYT     MOVE NAME TO OUTPUT 
       DEF D5 
* 
DMPTN JSB OUTPT     DUMP OUTPUT STACK 
      ISZ PTN#      INCRE PARTITION # 
      LDA PTNAD 
      ADA D6        INCRE TO NEXT PARTITION ADDR
      STA PTNAD 
      CPA LPTAD     DONE YET? 
      JMP DONE1      YES. PRINT TIME, EXIT
      JMP NXPTN      NO. DO NEXT PARTITION
* 
NOPRG LDA .NONE 
      JSB MVBYT 
       DEF D6 
      JMP DMPTN 
      SPC 2 
.PHED DEF *+1 
      OCT 17036,17036 
      ASC 16,PTN# SIZE   PAGES   BG/RT PRGRM
* 
.UNDF DEF *+1 
      ASC 7,  <UNDEFINED> 
* 
.RSPC DEF *+1 
      ASC 1,R 
* 
.DASH DEF *+1 
      ASC 1,- 
* 
.BG   DEF *+1 
      ASC 4, BG 
* 
.NONE DEF *+1 
      ASC 3,<NONE>
.RT   DEF *+1 
      ASC 4,    RT
* 
B1777 OCT 1777
DM36  DEC -36 
PTSIZ EQU STATS 
PTNAD EQU EQTPT 
PTN#  EQU IDCNT 
LPTAD EQU IDPNT 
PAGE# EQU #EQTS 
      XIF 
      UNS 
      END WHAT