ASMB,R,Q,C
*     NAME:   STAT
*     SOURCE: 92070-18154 
*     RELOC:  92070-16154 
*     PGMR:   HLC 
* 
* 
*  **************************************************************** 
*  * (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 STAT,0  92070-16154  REV.1941  800124 
      ENT $DSRQ,$PSRQ,$$STA,$.STA 
* 
      EXT $PB,$XQT,$MSEX
      EXT $LUDV,$DV2,$DV3,$DV6
      EXT $DV7,$DV15,$XS1,$LDRS 
      EXT $NOID,$DVLU,$RNTA 
      EXT $IDSZ,$IDA,$ID#,$INER 
      EXT $PNAM,$NAME,$CVT3 
      EXT $CVT,$WRKS,$WORK
* 
A     EQU 0 
B     EQU 1 
* 
* 
$DSRQ EQU * 
      JSB $LUDV     SET UP POINTERS TO DVT
      LDB "UP"      DEVICE UP?
      LDA $DV6,I
      RAL 
      CLE,SSA 
      LDB "DN"      DEVICE IS DOWN
      STB UP.DN 
* 
      RAR 
      AND =B377 
      JSB $CVT3     CONVERT STATUS TO OCTAL 
      DLD $CVT+1
      IOR .LP 
      DST DEVST     THREE DIGITS OF STATUS
* 
      LDA BLANK     CLEAR USER NAME 
      STA LP. 
      STA PROGA 
      STA PROGA+1 
      STA PROGA+2 
      STA RP. 
      LDA $DV6,I
      SSA 
      JMP BUSY      DEVICE IS BUSY
      LDB =AAV      AVAILABLE?
      LDA $DV3
NODE? LDA A,I 
      RAL,CLE,SLA,ERA   TEST 'NODE BUSY' BIT
      LDB =AND      NODE BUSY 
      CPA $DV3      END OF CIRCULAR LIST? 
      RSS           YES 
      JMP NODE? 
* 
LOCK? STB AVAIL 
      LDA $DV7,I
      RRR 3 
      AND =B377     LOCK FLAG 
      LDB =D-24 
      SZA,RSS 
      JMP SIZE      NOT LOCKED
* 
      JSB IDAD      CONVERT ID NO. TO ID ADDRESS
      JSB $PNAM     MOVE PROGRAM NAME TO BUFFER 
      DEF PROGB 
      LDB =D-36 
SIZE  STB *+2 
* 
      JSB $MSEX     PRINT MESSAGE 
      NOP 
UP.DN ASC 1,XX      'UP  DS(000) BZ( PROGA ) LK( PROGB )' 
BLANK ASC 2,  DS
DEVST ASC 3,XXXX) 
AVAIL ASC 1,XX
LP.   ASC 1,XX
PROGA ASC 3,XXXXXX
RP.   ASC 2,XXLK
.LP   ASC 1,( 
PROGB ASC 3,XXXXXX
.RP   ASC 1,) 
* 
* 
* 
BUSY  LDA $DV15,I 
      RAL,SLA 
      JMP SY.CL     SYSTEM OR CLASS REQUEST 
      LDB $DV2,I
      RBL,CLE,ERB 
      SSA 
      JMP BUFF      BUFFERED REQUEST
NAMA  JSB $PNAM     MOVE USER'S NAME TO BUFFER
      DEF PROGA 
      LDA .LP       ADD PARENTHESIS 
      STA LP. 
      LDA .RP 
      STA RP. 
* 
BZ.   LDB =ABZ
AB?   LDA $DV7,I
      RAR,RAR 
      SLA 
      LDB "AB"      PROCESSING ABORT REQUEST
      JMP LOCK? 
* 
* 
* 
BUFF  ADB =D8 
      LDA B,I       ID SEGMENT IDENTIFIER 
      STA PROGB 
      JSB IDAD      CONVERT ID NO. TO ID ADDRESS
      ADA =D28
      LDA A,I       CHECK CURRENT SEQUENCE NO.
      XOR PROGB 
      AND =B170000  UPPER FOUR BITS 
      SZA 
      JMP BZ.       NOT CURRENT, DO NOT PRINT NAME
      JMP NAMA      PRINT THE NAME
* 
* 
* 
SY.CL LDB =ASY      SYSTEM REQUEST? 
      SSA 
      LDB "CL"      NO, CLASS REQUEST 
      JMP AB? 
* 
* 
* 
IDAD  NOP           CONVERT ID NO. TO ID ADDRESS
      AND =B377 
      ADA =D-1
      MPY $IDSZ 
      ADA $IDA
      STA B 
      JMP IDAD,I
* 
* 
* 
* 
DP1   DEF $PB+5-12
DSTAT DEF "OF"
DNONE DEF NONE-12 
DGLOB DEF GLOB-12 
GLOB  ASC 3,-GLOB 
* 
* 
* 
* 
* 
* 
$PSRQ EQU * 
      LDA $PB+4     PARAMETER TYPE
      SZA,RSS 
      JMP DFLT      NULL
      LDB DP1 
      SLA,RSS 
      JMP MOVE      ASCII 
* 
      LDA $PB+5     ID SEGMENT NUMBER 
      CMA,INA,SZA,RSS 
      JMP DFLT
      SSA,RSS 
      JMP $INER     ILLEGAL VALUE 
      ADA $ID#
      SSA 
      JMP $INER     ILLEGAL VALUE 
      LDA $PB+5 
      JSB IDAD      COMPUTE ID SEGMENT ADDRESS
* 
MOVE  JSB $PNAM     MOVE NAME TO BUFFER 
      DEF PNAM
      JSB $NAME     FIND ID SEGMENT 
      DEF PNAM
      SZB,RSS 
      JMP $NOID     NOT FOUND 
      STA STAT      SAVE STATUS 
      ADB =D6 
      LDA B,I 
      CCE 
      JSB $CVT3     CONVERT PRIORITY TO DECIMAL 
      LDA $CVT
      IOR .LP 
      STA PR
      DLD $CVT+1
      DST PR+1      MOVE REMAINING CHARS
      LDB $WRKS 
      ADB =D2 
      LDA B,I       RES, T, MULT
      LDB BLANK 
      ALF,CLE,SLA 
      LDB T 
      STB TLIST 
* 
* 
      LDB =AS       S=SWAPPING
      LDA $XS1+4
      SLA           READ=1, WRITE=2 
      LDB =AL       L=LOADING 
      LDA $WORK 
      CPA $LDRS 
      JMP STM       DISC REQUEST ACTIVE 
      LDA $WRKS,I 
      LDB BLANK     BLANK= NOT LOADED, OR SWAPPED OUT 
      SSA           CHECK 'MR' BIT
      LDB =AM       M= IN MEMORY
STM   STB MRES
      LDB $WORK 
      ADB =D8 
      LDA B,I       POINT OF SUSPENSION 
      JSB $CVT3     CONVERT TO OCTAL
      LDA $CVT
      IOR .LP 
      STA PC
      DLD $CVT+1
      DST PC+1
      LDA STAT
      ADA =B-37 
      CCE,SSA 
      LDA STAT
      ADA DSTAT 
      LDA A,I       2-CHARACTER STATUS MNEMONIC 
      LDB $WORK 
      CPB $XQT
      LDA =AXQ      CURRENTLY EXECUTING PROGRAM 
      STA STAT
* 
* 
      CPA "IO"
      JMP IO
      CPA "WT"
      JMP WT
      CPA "LK"
      JMP LK
      CPA "RN"
      JMP RN
      CPA "QU"
      JMP QU
      CPA "DN"
      JMP DN
      CPA "BL"
      JMP BL
* 
SHORT LDA =D-32 
EXIT  STA *+2 
      JSB $MSEX 
      NOP 
PNAM  ASC 4,XXXXX PR
PR    ASC 5,(XXXXX) PC
PC    ASC 4,(XXXXX) 
MRES  ASC 1,M 
TLIST ASC 1,T 
STAT  ASC 1,XX
      ASC 1,( 
XSTAT ASC 4,XXXXXX) 
* 
* 
"OF"  ASC 1,OF      0 
"AB"  ASC 1,AB      1 
"IO"  ASC 1,IO      2 
"WT"  ASC 1,WT      3 
"UP"  ASC 1,UP
T     ASC 1,T 
      ASC 1,SS      6 
      ASC 1,PA      7 
      ASC 1,TM      47
"LK"  ASC 1,LK      50
"RN"  ASC 1,RN      51
"CL"  ASC 1,CL      52
"QU"  ASC 1,QU      53
"DN"  ASC 1,DN      54
"BL"  ASC 1,BL      55
      ASC 1,LD      56
      ASC 1,SR      57
      ASC 1,SC      60
      ASC 1,MM      61
* 
* 
* 
IO    EQU * 
      ADB =D10      INDEX TO SAVED A-REG
      LDA B,I 
CVT   JSB $CVT3     CONVERT TO ASCII
      LDA $CVT
      STA XSTAT     STORE RESULT
      DLD $CVT+1
      DST XSTAT+1 
LONG  LDA =D-42 
      JMP EXIT
* 
* 
* 
QU    EQU * 
      INB           INDEX TO TMP1 
WT    EQU * 
      LDB B,I 
NAMO  JSB $PNAM     MOVE PROGRAM NAME 
      DEF XSTAT 
      JMP LONG      LONG MESSAGE
* 
* 
* 
LK    EQU * 
DN    EQU * 
BL    EQU * 
      INB           INDEX TO TMP1 
      LDB B,I 
      JSB $DVLU     CONVERT DVT ADDRESS TO LU 
      CCE 
      JMP CVT       CONVERT TO DECIMAL
* 
* 
* 
RN    EQU * 
      INB           INDEX TO TMP1 
      LDA B,I 
      LDB DNONE 
      CPA $RNTA 
      JMP NAMO      NO RESOURCE NUMBERS AVAILABLE 
      LDA A,I 
      AND =B377 
      LDB DGLOB 
      CPA =B377 
      JMP NAMO      RESOURCE LOCKED GLOBALLY
      JSB IDAD      COMPUTE ID SEG ADDRESS
      JMP NAMO
* 
* 
DFLT  LDB $XQT      NO NAME SPECIFIED 
      SZB 
      JMP MOVE      DISPLAY CURRENTLY EXECUTING PROGRAM 
* 
      JSB $MSEX     NONE
      DEC -6
NONE  ASC 3,-NONE 
* 
$$STA EQU *         STANDARD MODULE 
$.STA DEC 0         STANDARD MODULE 
* 
      END 
                                                