ASMB,R,L,C,Z
      HED (FMP) FSTAT: RETRIEVE CARTRIDGE LIST
*     NAME:   FSTAT 
*     SOURCE: 92071-18043 
*     RELOC:  92071-16043 
*     PGMR:   M.L.K.
*     MOD:    E.D.B.
* 
*  ***************************************************************
*  * (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 FSTAT,7 92071-1X043 REV.2041 800806
* 
      ENT FSTAT 
* 
      EXT .ENTR, .MWF, .XLA, .XLB, .CAX 
      IFZ           *** L/20 CODE *** 
      EXT $CDA, $CD#, $CDSZ 
      XIF 
      IFN           *** L/10 CODE *** 
      EXT $CDIR, $MDSP
      XIF 
      SUP 
      SKP 
* 
*     DESCRIPTION 
* 
*     FSTAT RETURNS THE CARTRIDGE LIST INTO A USER BUFFER 
* 
*     CALLING SEQUENCE: 
* 
*     CALL FSTAT(IBUF,LEN)
* 
*     WHERE:
* 
*     IBUF   WILL BE THE RETURNED CARTRIDGE LIST (LEN-WORD ARRAY).
* 
*     LEN    IS THE LENGTH (IN WORDS) OF THE ARRAY IBUF (OPTIONAL). 
*            IF OMITTED, 125 WORDS ARE TRANSFERRED; 
*            IF NEGATIVE OR ZERO, NO WORDS ARE TRANSFERRED. 
* 
*     SPECIAL ASSEMBLY INSTRUCTIONS:
*     THIS FILE CONTAINS SOURCE CODE FOR BOTH THE RTE-L AND RTE-L/20
*     FSTAT ROUTINES.  ASSEMBLE THE CODE WITH THE N OPTION TO CREATE
*     THE RTE-L VERSION, AND WITH THE Z OPTION TO CREATE THE RTE-L/20 
*     VERSION.
* 
*     POSSIBLE ERRORS:
* 
*      0   NO ERROR 
*     -10  NOT ENOUGH PARAMETERS
      SKP 
* 
*     ENTRY 
* 
FSTAT NOP           DUMMY ENTRY POINT 
      LDA D.125 
      STA IBUF
      STA LEN 
      LDA FSTAT 
      STA DSTAT 
      JMP DSTAT+1 
* 
IBUF  NOP 
LEN   NOP 
* 
DSTAT NOP 
      JSB .ENTR 
      DEF IBUF
* 
      LDB IBUF      CHECK FOR ARRAY ADDRESS 
      CPB D.125     SAME AS DEFAULT?
      JMP ER10       YES, TAKE ERROR EXIT 
      SKP 
* 
*     PROCESS REQUEST 
* 
      IFN           *** L/10 CODE *** 
      LDA $CDA      GET CARTRIDGE DIRECTORY START ADDRESS 
      CMA,INA        SUBTRACT FROM
      ADA $MDSP       CARTRIDGE DIRECTORY END ADDRESS 
      DIV $CDSZ        AND DIVIDE BY ENTRY SIZE 
      STA $CD#          SAVE NUMBER OF ENTRIES
      XIF 
* 
      JSB .XLA      GET CARTRIDGE DIRECTORY ENTRIES 
      DEF $CD#+0
      JSB .XLB      GET CARTRIDGE DIRECTORY ENTRY SIZE
      DEF $CDSZ+0 
      MPY B         CALCULATE CARTRIDGE DIRECTORY LENGTH
* 
      LDB LEN,I     GET USER'S BUFFER LENGTH
      SSB           IF NEGATIVE,
      JMP EXIT       THEN JUST EXIT (IGNORE CALL) 
* 
      CMB,INB       SUBTRACT BUFFER LENGTH
      ADB A          FROM CARTRIDGE DIRECTORY LENGTH
      SSB,RSS       IF USER BUFFER SMALLER, 
      LDA LEN,I      THEN USE PASSED PARAMETER
      JSB .CAX      SAVE TRANSFER LENGTH FOR .MWF 
* 
      JSB .XLA      GET CARTRIDGE DIRECTORY ADDRESS 
      DEF $CDA+0
      LDB IBUF      GET DESTINATION ADDRESS 
      JSB .MWF       AND MOVE CARTRIDGE LIST
      SKP 
* 
*     EXIT
* 
EXIT  CLA           NO ERROR
      JMP EREX
* 
ER10  LDA N10       NOT ENOUGH PARAMETERS 
* 
EREX  JMP DSTAT,I   RETURN
* 
*     STORAGE AREA
* 
N10   DEC -10 
.125  DEC 125 
* 
D.125 DEF .125
* 
      IFN           *** L/10 CODE *** 
$CDA  DEF $CDIR+0 
$CDSZ DEC 4 
$CD#  NOP 
      XIF 
* 
A     EQU 0 
B     EQU 1 
* 
END   EQU * 
* 
      END 
                                                                                                                                                                                                                                                            