ASMB,R,L,C
      HED COMPILER LIBRARY CLOSE ROUTINE
      NAM CLO.C,7 92060-16102 790207 REV. 1913 $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 GEX.C     D.RTR REPLACEMENT ROUTINE 
      EXT ADS.C     FCB ADDRESS PASSER ROUTINE
      EXT GE#SC     WRITE OUT BUFFER ROUTINE
      EXT C.HLK     HEAD OF FCB LINKED LIST 
      EXT C.FCB     ADDRESS OF FCB
      EXT C.FID     FCB ID WORD 
      EXT C.FLU     FCB LOGICAL UNIT WORD 
      EXT C.EXT     FCB EXTENT NUMBER 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.FAD     FCB DIRECTORY ADDRESS FROM D.RTR WORDS
      EXT C.??      FCB PROMPT CHARACTERS 
      EXT C.SON     THE SON PROCESS FLAG
      EXT LURQ      THE LU LOCK GUY 
      EXT .TTY      THE INTERACTIVE TEST GUY
* 
      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.FID,I   IS THIS A LOGICAL 
      SSA,RSS         UNIT? 
      JMP FILE      NO, GO PROCESS THE FILE 
      LDA C.FLU,I 
      STA LU
      JSB .TTY      TEST FOR INTERACTIVE
      DEF *+1+1 
      DEF LU
      SSA           IF INTERACTIVE THEN 
      JMP EXIT        JUST BUG OUT
      JSB LURQ      UNLOCK THE TURKEY 
       DEF *+3+1
      DEF .40K      UNLOCK REQ
      DEF C.FLU,I 
      DEF .1
      NOP 
      JMP EXIT
* 
FILE  LDA C.FID,I 
      AND CLRFG     CLEAR OPEN FLAG 
      STA C.FID,I 
      AND =B7       DETERMINE FCB TYPE
      CPA .2        SCRATCH?
      JMP CLSSC     CLOSE SCRATCH FILE
      SZA           READ FCB
      CPA =D4       SOURCE REWIND FILE? 
      JMP CLSRD     CLOSE SOURCE TYPE FILES 
* 
      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.#SC,I   DETERMINE 
      CMA,INA 
      ADA C.RSC,I     NUMBER OF UNUSED
      INA           SECTORS 
      ALS 
      STA SECTS 
      LDA C.RSC,I   RESET C.#SC IN CASE WE CALL A SON.
      INA 
      STA C.#SC,I 
      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 LDA C.SON 
      LDB C.FAD,I 
      SSA,RSS       IF SON_PROCESS THEN 
      JMP SCRTX     TEST FOR SCRATCH
      SZB,RSS         IF SCRATCH THEN 
      JMP EXIT          JUST BUG OUT
* 
SCRTX SZB,RSS       IF SCRATCH THEN 
      JMP CLSSC     GIVE IT BACK
      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 
LU    EQU SECTS 
.40K  OCT 40000     UNLOCK - NO ABORT 
.1    DEC 1 
.2    DEC 2 
.5    DEC 5 
CLRFG OCT 177767
      END 
                                                                                                                        