ASMB,R,L,C
      HED COMPILER LIBRARY CLOSE ROUTINE
      NAM CLO.C,7 92064-18238 770515 REV. 1726 $CLIB
* 
* 
*************************************************************** 
* (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  ALL RIGHTS     * 
* RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE-  * 
* REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * 
* OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.   * 
*************************************************************** 
* 
* 
* 
*   SOURCE PART NUMBER :       92060-18055
* 
* 
*  CLOSE FILE ROUTINE 
* 
*  THIS ROUTINE WILL SEARCH THE LINKED LIST OF FCB'S AND REMOVE IT
*  FROM THE LIST. IT WILL THEN BE CLOSED. IF IT IS A SCRATCH FILE 
*  THE TRACKS WILL BE RETURNED TO THE SYSTEM. IF IT IS A READ FILE
*  IT WILL BE CLOSED. IF IT IS WRITE FILE THE 
*  FCB WILL BE CHECKED TO SEE IF THE BUFFER NEEDS TO BE WRITTEN OUT 
*  AND IF SO IT WILL BE WRITTEN OUT PRIOR TO CLOSING. 
*  ALSO IF THE FILE DOES NOT HAVE EXTENTS IT WILL BE TRUNCATED. 
* 
* 
* 
* 
* 
* 
*  CALLING SEQUENCE:
* 
*         JSB CLO.C 
*         DEF FCB 
*         ERROR RETURN
*         NO ERROR RETURN 
* 
*  ON RETURN A < 0  INDICATES ERROR 
*            A = 0  INDICATES NO ERROR
* 
* 
* 
*  ENTRY POINT: 
* 
      ENT CLO.C 
* 
*  EXTERNALS: 
* 
      EXT EXEC      SYSTEM EXEC 
      EXT GEX.C     D.RTR REPLACEMENT ROUTINE 
      EXT ADS.C     FCB ADDRESS PASSER ROUTINE
      EXT GE#SC     WRITE OUT BUFFER ROUTINE
      EXT D.RP1     ERROR PARAMETER FROM D.RTR CALL 
      EXT C.HLK     HEAD OF FCB LINKED LIST 
      EXT C.LNK     FCB LINK WORD 
      EXT C.FCB     ADDRESS OF FCB
      EXT C.FID     FCB ID WORD 
      EXT C.FLU     FCB LOGICAL UNIT WORD 
      EXT C.STR     FCB CURRENT EXTENT TRACK NUMBER WORD
      EXT C.SSC     FCB CURRENT EXTENT SECTOR NUMBER WORD 
      EXT C.EXT     FCB EXTENT NUMBER WORD
      EXT C.S/T     FCB NUMBER OF BLOCKS/TRACK WORD 
      EXT C.#SC     FCB NUMBER OF BLOCKS/EXTENT WORD
      EXT C.RSC     CURRENT OFFSET SECTOR NUMBER
      EXT C.BFF     FCB BUFFER ADDRESS WORD 
      EXT C.WRD     FCB CURRENT WORD POINTER WORD 
      EXT C.FAD     FCB DIRECTORY ADDRESS FROM D.RTR WORDS
      EXT C.HTR     FCB START OF FILE TRACK NUMBER WORD 
      EXT C.SLU     FCB SECONDARY LOGICAL UNIT NUMBER WORD
      EXT C.??      FCB PROMPT CHARACTERS 
      EXT C.GRW     FCB REWIND GUARANTEE ROUTINE ADDRESS
      EXT C.INS     FCB $INCLUDE ROUTINE ADDRESS
      EXT C.CNT     FCB CONTROL ROUTINE ADDRESS 
* 
      EXT C.FCB     ADDRESS OF FCB
* 
* 
* 
*  DETERMINE TYPE OF OPERATION
* 
*   THE FCB CONTAINS THE OPERATION TYPE AS FOLLOWS: 
* 
*      TYPE  =  0   IS READ SOURCE FILE(OR LU)
*            =  1   IS WRITE BINARY FILE(OR LU) 
*            =  2   IS WRITE SCRATCH FILE 
*            =  3   IS WRITE LIST  FILE(OR LU)
* 
* 
* 
A     EQU 0 
B     EQU 1 
* 
CLO.C NOP 
      JSB ADS.C     SET UP FILE CONTROL BLOCK ADDRESSES 
      DEC 0 
      CLA 
      STA SECTS     SET FOR NO TRUNCATION 
      LDA AHEAD     GET ADDRESS OF
NEXT  LDB A,I         PTR AND ALSO PTR
      SZA,RSS       IS IT EMPTY?
      JMP CLO.C,I   ERROR EXIT
      CPB C.FCB     IS IT THE ONE WE'RE LOOKING FOR 
      JMP FND       YES, GOT IT 
      LDA B         NO, CONTINUE ON DOWN THE LIST 
      JMP NEXT
FND   LDB B,I       REMOVE
      STB A,I         IT BY CONNECTING NEXT TO PREVIOUS FCB 
* 
      LDA C.#SC,I   IS THIS A LOGICAL 
      SZA,RSS         UNIT? 
      JMP EXIT      YES, JUST EXIT
* 
      LDA C.FID,I   DETERMINE 
      AND B17         FCB TYPE
      CPA .2        SCRATCH?
      JMP CLSSC     CLOSE SCRATCH FILE
      SZA,RSS       READ FCB
      JMP CLSRD     CLOSE READ FCB
* 
CLSWR LDA C.BFF,I   SHOULD BUFFER 
      SSA,RSS         BUFFER BE FLUSHED?
      JMP TRUN      NO! 
      CLA           CLOSE WRITE FCB 
      CLB 
      JSB GE#SC       AND FLUSH BUFFER
      JMP CLO.C,I   ERROR RETURN
* 
*  TRUNCATE IF NO EXTENTS 
* 
TRUN  LDA C.EXT,I   IS
      SZA             AND EXTENTS?
      JMP CLSRD     YES!
      LDA C.RSC,I   DETERMINE 
      CMA,INA 
      ADA C.#SC,I     NUMBER OF UNUSED
      RAL 
      ADA M2            SECTORS 
      CMA,INA       COMPLEMENT
      STA SECTS 
      JMP CLSRD     CLOSE FILE
* 
* 
*  CLOSE SCRATCH FILE 
* 
CLSSC LDA .5        CALL CLOSE GEX.C TO RETURN SCRATCH FILE 
      JSB GEX.C 
      JMP EXIT      YES!
* 
*  CLOSE READ FILE
* 
CLSRD CLA           CLOSE FILES 
      CLB 
      JSB GEX.C 
      DEF SECTS 
      JMP CLO.C,I   ERROR EXIT P+1
EXIT  ISZ CLO.C 
      JMP CLO.C,I   OK RETURN P+2 
* 
*  CONSTANTS AND BUFFERS
* 
AHEAD DEF C.HLK     ADDRESS OF HEAD OF LINKED LIST
SECTS NOP           NUMBER OF SECTORS TO TRUNCATE 
ID    BSS 5 
.1    DEC 1 
.2    DEC 2 
.5    DEC 5 
M2    DEC -2
B17   OCT 17
      END 
                                                                                                                                                                                  