ASMB,R,L,C
      HED CLOSE 
*     NAME:   CLOSE 
*     SOURCE: 92064-18064 
*     RELOC:  92064-16061 
*     PGMR:   G.L.M.
* 
*  ***************************************************************
*  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977.  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 CLOSE,7  92064-16061  REV.1650  761010
* 
      ENT CLOSE 
      EXT EXEC,.ENTR,CLD.R,.P1,.P2
      SUP 
* 
*  THIS IS THE CLOSE SUBROUTINE--A PART OF THE
*  REAL-TIME FILE MANAGEMENT PACKAGE
* 
*  THE ASSEMBLY CALL TO CLOSE A FILE IS:
* 
*     JSB CLOSE 
*     DEF RTN       RETURN ADDRESS
*     DEF IDCB      DATA CONTROL BLOCK ADDRESS
*     DEF IERR      (OPTIONAL) ERROR CODE RETURNED HERE AND IN A REG
*     DEF IRX       (OPTIONAL) NO. OF 128 WORD DOUBLE 
*RTN                SECTORS TO BE DELETED FROM THE FILE 
* 
*     ERRORS ARE: 
*     0       NONE
*    -1       DISC DOWN 
*    -10      NOT ENOUGH PARAMETERS 
*    -11      FILE NOT OPEN 
*    -13      DISC LOCKED 
* 
* 
* 
      SKP 
* 
CLOSE NOP 
      LDA DZ        RESET PARMS 
      STA IDCB
      STA IERR
      STA IRX 
      LDA CLOSE 
      STA DLOSE     SET PARM ADDR IN DUMMY ENT
      JMP DLOSE+1 
* 
IDCB  DEF CLOSE     DCB ADDRESS 
IERR  DEF CLOSE     ERROR CODE ADDRESS
IRX   DEF CLOSE     TRUNICATE CODE ADDRESS
      SPC 1 
DLOSE NOP           ENTRY POINT 
      JSB .ENTR     TRANSFER THE ADDRESSES
DM    DEF IDCB
      LDA IDCB      IF NO PARAMETERS
      CPA DZ        THEN
      JMP ER10      ERROR EXIT
      ADA .9        ADD 9 TO GET THE THE OPEN FLAG
      STA OPNFL     SAVE THE OPEN FLAG ADDRESS
      LDB A,I       GET THE OPEN FLAG 
      CPB XEQT      FILE OPEN?
      CLE,RSS       YES SKIP
      JMP ER11      NO; ERROR EXIT
* 
* 
* 
      CLB           SET FUNCTION
      STB .P1           CODE FOR CLOSE
      LDA IDCB,I    SET LU/TYPE 
      SSA           IF DEVICE--DON'T
      JMP SKIP            CALL D.R
      CMA,INA           SET NEGATIVE
      STA .P2          FOR D.R
      JSB CLD.R     GO CALL D.R 
* 
      CLA 
      STA OPNFL,I   CLEAR THE OPEN FLAG 
      STB IDCB,I    CLEAR M FLAG
      LDA B,I       FETCH ERROR CODE
EXIT STA IERR,I     SET ERROR CODE
      JMP DLOSE,I 
* 
SKIP  LDA IDCB
      INA 
      LDB A,I       FETCH DEVICE TYPE 
      CPB B1000     PUNCH?? 
      RSS           YEP 
      JMP SSCC
      ADA .3        ADVANCE TO EOF CODE 
      STA CNT 
* 
      JSB EXEC      GO
      DEF SSCC         DO 
      DEF .3             IT 
CNT   NOP 
      SPC 2 
* 
SSCC  CLA           0 FOR ERROR RETURN
      JMP EXIT
      SPC 3 
ER11  CCA           FILE NOT OPEN - ERROR 11
ER10  ADA N10       NOT ENOUGH PRAMS - ERROR 10 
      JMP EXIT      GO EXIT 
      SPC 3 
N10   DEC -10 
.3    OCT 3 
B1000 OCT 1000
.9    DEC 9 
OPNFL NOP 
DZ    DEF CLOSE 
      SPC 2 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      SPC 1 
END   EQU * 
      SPC 1 
      END 
                                                                              