ASMB,R,L,C
*     NAME:   FSTAT 
*     SOURCE: 92067-18131 
*     RELOC:  92067-16125 
*     PGMR:   N.J.S.
* 
*  ***************************************************************
*  * (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 FSTAT,7 92067-16125 REV.1903 790118 
      ENT FSTAT 
      EXT .ENTR, EXEC, $CL1, $CL2 
      EXT $SMID, $SMGP, $SMDL, $SMST, $SMLK, GTSCB
      EXT SM.BF, UT.BF
      SUP 
* 
* 
*  FSTAT READS THE CARTRIDGE DIRECTORY OF DISCS TO THE USER 
*  SPECIFIED BUFFER 
* 
*  CALLING SEQUENCE 
* 
*  CALL FSTAT (ISTAT, ILEN, IFORM, IOP, IADD) 
* 
*     PARAMETERS
* 
*  ISTAT    BUFFER INTO WHICH THE CARTRIDGE ENTRIES ARE RETURNED
* 
*  ILEN     LENGTH IN WORDS OF BUFFER ISTAT 
* 
*  IFORM    IF ZERO (OR DEFAULT) CARTRIDGE DIRECTORY ENTRIES ARE
*           RETURNED IN OLD FORMAT (LU, LAST TRACK, CRN, LOCK WORD - ID 
*           SEGMENT ADDRESS).  IF NON-ZERO, ENTRIES ARE RETURNED AS ON
*           DISC (LOCK WORD/LU, LAST TRACK, CRN, SESSION MONITOR ID)
* 
*  IOP      = 1   RETURN ALL ENTRIES IN CL REGARDLESS IF IN SESSION 
*           = 0 AND IN SESSION   RETURN PRIVATE, GROUP, AND SYSTEM DISCS
*                                IN THAT ORDER. 
*           = 0 AND NOT IN SESSION   RETURN SYSTEM AND NON-SESSION DISCS
* 
*  IADD     VARIABLE SET TO -1 IF ISTAT ISN'T BIG ENOUGH TO RETURN
*           ALL INFORMATION OR TO 0 IF EVERY THING'S OK 
* 
* 
* 
ISTAT NOP 
LEN   DEF ZERO
FORM  DEF ZERO
OP    DEF ZERO
ADD   DEF ZERO
* 
FSTAT NOP 
      JSB .ENTR     FETCH ADDRESSES OF
      DEF ISTAT      INCOMING PARAMETERS
* 
      JSB EXEC      READ CARTRIDGE DIRECTORY
      DEF *+7        INTO BUFFER BUF
      DEF .1
      DEF LU2PR 
      DEF UT.BF 
      DEF .256
      DEF $CL1
      DEF $CL2
* 
      LDA LEN,I     GET LENGTH SENT BY CALLER 
      SSA           NEGATIVE??
      CLA,INA       YES - SET TO 1
      SZA,RSS       DID HE SPECIFY A LENGTH?
      LDA .125      NO - DEFAULT IS 125 WORDS 
      LDB .253      DID CALLER SPECIFY A BUFFER 
      CMB,INB        LARGER THAN 253? 
      ADB A 
      SSB,RSS       ??
      LDA .253      YES - JUST USE 253 WORDS OF IT
      STA LEN       SAVE LENGTH TO BE USED
      CMA,INA       MAKE NEGATIVE 
      STA COUNT      TO USE AS COUNTER
      CLA             FOR ZEROING OUT USER'S
      LDB ISTAT        BUFFER 
CLEAR STA B,I 
      INB 
      ISZ COUNT 
      JMP CLEAR 
* 
      CLA           CLEAR IN-SESSION FLAG 
      STA SFLAG 
      LDA OP,I      GET THE OPTION PARAMETER
      SZA            IF TWO WE WANT 
      JMP ALLDS       ALL ENTRIES IN THE CL 
      JSB GTSCB     READ CALLER'S SESSION 
      DEF *+4        CONTROL BLOCK IF 
      DEF SM.BF       THERE IS ONE
      DEF .140
      DEF IERR
* 
      LDA IERR
      CPA N1
      JMP NTSES     NOT IN SESSION
      STA SFLAG     SET IN-SESSION FLAG 
* 
      LDB ASCB      CALCULATE POINTER 
      JSB RESLV     (JUST IN CASE THIS IS INDIRECT) 
      CMB,INB        TO SST LENGTH WORD 
      ADB $SMLK       IN SCB
      ADB $SMST 
      CMB,INB 
      STB IDSSW 
      LDA B,I       CALCULATE ADDRESS OF 1ST ENTRY
      CMA,INA        IN DISCS MOUNTED AREA OF 
      ADB .2          THE SCB USING THE POINTER TO
      ADB A            THE SST LENGTH WORD
      STB MTDSC     MTDSC = IDSSW + 2 + C(IDSSW)
* 
      LDA IDSSW     POSITION TO PRIVATE 
      ADA $SMID      ID IN SCB
      LDA A,I       GET IT
      STA ID1        AND SAVE 
      LDA IDSSW     POSITION TO GROUP 
      ADA $SMGP      ID IN SCB
      LDA A,I       GET IT
      STA ID2        AND SAVE 
      LDA B7777     USE SYSTEM DISC 
      STA ID3        ID AS THIRD ONE
      LDB N3        THREE ID'S IN TABLE 
      CPA ID1       IF THE PRIVATE ID WAS 
      LDB N2         ALREADY 7777, DON'T WANT IT TWICE
      STB #ID       SAVE # ID'S IN TABLE
* 
FST.1 LDA AID       START POINTER AT BEGINNING
      STA PTR        OF ID TABLE
      LDA ISTAT     GET ADDRESS OF USER 
      STA OUTBF      BUFFER IN OUTBF
FST.2 LDB ABUF      START AT BEGINNING OF CL
      JSB RESLV     (JUST IN CASE THIS IS INDIRECT) 
FST.3 LDA B,I 
      SZA,RSS       END OF CL?
      JMP FST.6     YES 
      ADB .3        POSITION TO ID WORD 
      LDA B,I       GET IT AND
      AND B7777      MASK TO BITS 11-0
      CPA PTR,I     MATCH ID IN ID TABLE? 
      JMP FST.4     YES - CHECK FURTHER 
      INB           NO - STEP TO BEGINNING OF NEXT
      JMP FST.3      CL ENTRY AND KEEP LOOKING
* 
FST.4 ADB N3        POSITION TO LU
      LDA B,I       GET IT, MASK TO LU NUMBER AND IF
      AND B377       UNDER SESSION CONTROL SEE IF IT'S
      JSB SCBCK       MOUNTED TO THE CALLER'S SCB 
      JMP FST.5     NOT IN SESSION OR LU IS MOUNTED TO SCB
      ADB .4        NOPE - GO TRY THE 
      JMP FST.3      NEXT CL ENTRY
* 
FST.5 LDA LEN       SEE IF ANOTHER 4-WORD 
      ADA N4         ENTRY WILL FIT 
      SSA             IN USER BUFFER
      JMP END1      NO - GO SET ADD AND RETURN
      STA LEN       YES - UPDATE COUNTER
      JSB MOVIT     MOVE THIS ENTRY (REFORMAT IF NECESSARY) 
      JMP FST.3     GO GET NEXT CL ENTRY
* 
FST.6 ISZ PTR       STEP TO NEXT ID IN ID TABLE 
      ISZ #ID       ARE WE DONE?
      JMP FST.2     NO - SCAN CL AGAIN
      JMP END       YES - NO MORE ID'S SO DONE
* 
* 
* 
NTSES LDA N2        LOOKING FOR 
      STA #ID        TWO ID'S 
      LDA B7777     USE SYSTEM DISC 
      STA ID1        ID FOR 1ST ONE 
      CLA           AND NON-SESSION 
      STA ID2        DISC ID FOR 2ND
      JMP FST.1 
* 
* 
ALLDS LDA ISTAT     GET ADDRESS OF USER 
      STA OUTBF      BUFFER AND USE AS POINTER
      LDB ABUF      GET ADDRESS OF CL 
      JSB RESLV     RESOLVE INDIRECT (JUST IN CASE) 
AL.1  LDA B,I       GET 1ST WORD OF A CL ENTRY
      SZA,RSS       ZERO? 
      JMP END       YES - FOUND THE END 
      LDA LEN       NO - SEE IF ANOTHER 4-WORD
      ADA N4         ENTRY WILL FIT IN USER 
      SSA             BUFFER
      JMP END1      NOPE - GO SET ADD AND RETURN
      STA LEN       YES - UPDATE COUNTER
      JSB MOVIT     MOVE THIS ENTRY (REFORMAT IF NECESSARY) INTO USER BUFFER
      JMP AL.1      GO BACK AND DO THE NEXT ONE 
* 
* 
END1  CCB           SET ADD TO -1 
      RSS 
END   CLB           SET ADD TO 0
      LDA ADD 
      CPA DFZER     DID CALLER SEND AN ADD? 
      RSS           NOPE - SKIP THE STORE 
      STB ADD,I     SET ADD 
      LDA DFZER     CLEAR PARAMETERS FOR NEXT TIME
      STA LEN 
      STA FORM
      STA OP
      STA ADD 
      JMP FSTAT,I 
* 
* 
*  RESLV    RESOLVES INDIRECT ADDRESS 
* 
*           ENTRY :  B-REG CONTAINS WORD TO BE RESOLVED 
* 
*           EXIT  :  B-REG CONTAINS RESOLVE VALUE 
* 
* 
RESLV NOP 
      SSB,RSS 
      JMP RESLV,I 
      RBL,CLE,ERB 
      LDB B,I 
      JMP *-4 
* 
* 
* 
*   MOVIT  MOVES 4-WORD CL ENTRY POINTED TO BY B-REG INTO USER
*          BUFFER AT LOCATION OUTBF.
*          IF FORM PARAMETER INDICATES REFORMAT, DO IT. 
* 
*          ENTRY : B-REG POINTS TO CL ENTRY TO BE MOVED 
*                  OUTBF POINTS TO LOCATION IN USER BUFFER TO MOVE IT TO
* 
*          EXIT  : B-REG AND OUTBF ARE INCREMENTED BY 4 
* 
* 
MOVIT NOP 
      LDA FORM,I    GET FORMAT PARAMETER
      CLE,SZA,RSS   IF ZERO (OLD FORMAT) SET E=1
      CCE            NONZERO (AS ON DISC) SET E=0 
      LDA B,I       GET 1ST WORD OF CL ENTRY
      STA TMP        SAVE FOR LATER 
      SEZ           OLD FORMAT? 
      AND B377      YES - MASK TO JUST LU 
      STA OUTBF,I   MOVE LU OR LU LOCK TO USER BUFFER 
      INB 
      ISZ OUTBF 
      LDA B,I       GET 2ND WORD (LAST TRACK) 
      STA OUTBF,I    AND MOVE TO USER BUFFER
      INB 
      ISZ OUTBF 
      LDA B,I       GET 3RD WORD OF CL (CRN)
      STA OUTBF,I    AND MOVE TO USER BUFFER
      INB 
      ISZ OUTBF 
      LDA B,I       GET 4TH WORD OF CL (SES MONIT ID) 
      SZA           NO LOCK OR
      SEZ,RSS        NEW FORMAT?
      JMP MV.1      YES - USE SESSION MONITOR ID FOR 4TH WORD 
      LDA TMP       NO - GET LU LOCK WORD AGAIN 
      ALF,ALF       SHIFT AND MASK TO LOCK
      AND B377       WORD (ID SEGMENT NUMBER) 
      ADA KEYWD     ADD OFFSET LESS 1 TO ADDRESS
      ADA N1         OF KEYWORD TABLE 
      XLA A,I       GET ID SEGMENT ADDRESS
MV.1  STA OUTBF,I   MOVE 4TH WORD TO USER BUFFER
      INB           STEP ADDRESS TO BEGINNING 
      ISZ OUTBF      OF NEXT CL ENTRY 
      JMP MOVIT,I     AND RETURN
* 
* 
* 
*   SCBCK   SCANS THE DISCS MOUNTED LIST IN SCB TO SEE IF DISC IN 
*           A-REG IS MOUNTED TO CALLER AND ACTIVE 
* 
*           ENTRY : A-REG CONTAINS DISC BEING SEARCHED FOR
*                   SCB CONTAINS SESSION CONTROL BLOCK BELONGING TO CALLER
*                   IDSSW CONTAINS ADDRESS OF SST LENGTH WORD 
*                   MTDSC CONTAINS ADDRESS OF 1ST ENTRY IN DISCS MOUNTED LIST 
*                   PTR,I CONTAINS THE ID TO WHICH THE DISC IS MOUNTED
* 
*           EXIT  : P+1  FOUND IT AND IT'S ACTIVE 
*                   P+2  NOT THERE OR IT IS MARKED INACTIVE 
* 
* 
SCBCK NOP 
      STB TMP       SAVE B-REG
      STA ALU       SAVE LU# WE'RE LOOKING FOR
      LDA SFLAG     GET IN-SESSION FLAG 
      LDB PTR,I     GET ID TO WHICH DISC IS MOUNTED 
      SZA           IF NOT UNDER SESSION CONTROL
      CPB B7777      OR IF THIS IS A SYSTEM DISC
      JMP SCB.2       RETURN OK - DON'T NEED TO CHECK THE SCB 
      LDB IDSSW     POSITION TO DISC
      ADB $SMDL      LIMIT IN SCB 
      LDA B,I         GET IT
      CMA,INA          MAKE IT NEGATIVE 
      STA COUNT         AND USE AS A COUNTER
      LDB MTDSC 
SCB.1 LDA B,I       GET ENTRY FROM DISCS MOUNTED LIST 
      AND ACDIS     MASK TO LU TO ACTIVE BIT (IF INACTIVE WON'T MATCH)
      CPA ALU       IS THIS THE ONE WE WANT?
      JMP SCB.2     YES - RETURN
      INB 
      ISZ COUNT 
      JMP SCB.1     KEEP LOOKING
      ISZ SCBCK     DIDN'T FIND IT SO RETURN AT P+1 
SCB.2 LDB TMP        RESTORE B-REG
      JMP SCBCK,I 
      SPC 5 
A     EQU 0 
B     EQU 1 
KEYWD EQU 1657B 
* 
ZERO  DEC 0 
DFZER DEF ZERO
.1    DEC 1 
.2    DEC 2 
.3    DEC 3 
.4    DEC 4 
.125  DEC 125 
.140  DEC 140 
.253  DEC 253 
.256  DEC 256 
* 
N1    DEC -1
N2    DEC -2
N3    DEC -3
N4    DEC -4
* 
B7777 OCT 7777
B377  OCT 377 
ACDIS OCT 20377 
LU2PR OCT 74002 
* 
ASCB  DEF SM.BF 
ABUF  DEF UT.BF 
* 
ID1   NOP 
ID2   NOP 
ID3   NOP 
AID   DEF ID1 
#ID NOP 
* 
SFLAG NOP 
IERR  NOP 
IDSSW NOP 
MTDSC NOP 
OUTBF NOP 
ALU   NOP 
PTR   NOP 
TMP   NOP 
COUNT NOP 
* 
      END 
                                                                                                                                                                                                                                                        