ASMB,R,L,C
*     NAME:   CLOSE 
*     SOURCE: 92064-18181 
*     RELOC:  92064-16058 
*     PGMR:   G.A.A.
*     MOD:    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-16058  REV.1650  761019
* 
      HED CLOSE 
      ENT CLOSE 
      EXT EXEC,.ENTR,R/W$,CLD.R,.P1,.P2,.P3,.P4 
      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 DZERO 
      STA IDCB
      STA IRX 
      LDA DM
      STA IERR
      CLA 
      STA ZERO
      STA .P1       FUNCTION CODE FOR CLOSE 
      LDA CLOSE 
      STA DLOSE 
      JMP DLOSE+1 
* 
* 
* 
IDCB  DEF ZERO      DCB ADDRESS 
IERR  DEF IDCB      ERROR CODE ADDRESS
IRX   DEF ZERO      TRUNICATE CODE ADDRESS
      SPC 1 
DLOSE NOP           ENTRY POINT 
      JSB .ENTR     TRANSFER THE ADDRESSES
DM    DEF IDCB
      LDA IDCB      IF NO PARAMETERS
      CPA DZERO     THEN
      JMP ER10      ERROR EXIT
      INA           STEP TO WORD TWO
      LDB A,I       FETCH OFFSET SECTOR 
      STB .P3       SAVE FOR D.RTR CALL 
      ADA .8        ADD 8 TO GET THE THE OPEN FLAG
      STA OPNFL     SAVE THE OPEN FLAG ADDRESS
      LDB A,I       GET THE OPEN FLAG 
      ADA N2        BACK UP TO THE
      STA SC        SAVE THE SECURITY CODE ADDRESS
      CPB XEQT      FILE OPEN?
      CLE,RSS       YES SKIP
      JMP ER11      NO; ERROR EXIT
      LDB IDCB      GET THE DCB ADDRESS 
* 
      LDA B,I       IF MAGIC LU OPEN
      CPA FAKE          DON'T CALL D.RFP
      JMP DUMMY                JUST CLOSE DCB AND GET OUT 
* 
      JSB R/W$      CALL TO FLUSH THE BUFFER
      JMP EXIT      DISC ERROR EXIT 
      LDB IDCB      GET THE TYPE FLAG 
      ADB .2
      LDA B,I       A 
      SZA           IF ZERO NO TRUNCATE 
      LDA IRX,I     DISC FILE SET TRUNCATE CODE 
      ALS           ADJUST FOR 64 WORD SECTORS
      ADB .13       STEP TO EXTENT WORD 
      LDB B,I       IF NOT
      SZB           FIRST EXTENT
      CLA           DO NOT ALLOW TRUNCATION 
      LDB SC,I      GET THE SECURITY FLAG 
      SSB,RSS       IF BAD SC 
      CLA           DIS ALLOW TRUNCATION
      CMA,INA       SET NEGATIVE
      STA .P4       SAVE FOR D.RFP
* 
      LDA IDCB,I    SET DIRECTORY ADDRESS FOR D.RFP 
      STA .P2 
      JSB CLD.R      SCHED D.RFP
      RSS           SKIP MAGIC LU EXIT WORK 
* 
DUMMY CLB 
      SPC 2 
      CLA 
      STA OPNFL,I   CLEAR THE OPEN FLAG 
      LDA B,I       YES; GET ERROR RETURN 
      STA IRX       SAVE THE ERROR CODE 
* 
* 
* 
*  IF MAGIC LU OPEN AND PUNCH-- 
*                    THEN DO TRAILER----- 
* 
      LDB IDCB      FETCH  DCB ADDRESS
      LDA B,I       FETCH CONTENTS
      CPA FAKE      IF MAGIC LU OPEN--
      RSS           CONTINUE
      JMP EXI          ELSE--ALL DONE 
* 
      INB           ADVANCE TO DEVICE TYPE WORD 
      LDA B,I       FETCH IT
      ADB .3        ADVANCE TO EOF CODE 
      STB CLOSE     SAVE ITS ADDRESS
      CPA PUNCH     IS IT A PUNCH???
      RSS           YEP--GO DO TRAILER
      JMP EXI       NOPE--SO ALL DONE 
* 
* 
* 
      JSB EXEC
      DEF EXI 
      DEF .3        CONTROL CALL
      DEF CLOSE,I   EOF CODE
* 
EXI   LDA IRX       RESTORE ERROR CODE
* 
EXIT  STA IERR,I    SET THE ERROR CODE
      JMP DLOSE,I   EXIT ERROR CODE IN A
      SPC 3 
ER11  CCA           FILE NOT OPEN - ERROR 11
ER10  ADA N10       NOT ENOUGH PRAMS - ERROR 10 
      JMP EXIT      GO EXIT 
      SPC 3 
FAKE  OCT 177400
PUNCH OCT 1000
N10   DEC -10 
N2    DEC -2
.2    OCT 2 
.3    OCT 3 
.8    DEC 8 
.13   DEC 13
SC    NOP 
OPNFL NOP 
ZERO  NOP 
DZERO DEF ZERO
      SPC 2 
      SPC 3 
A     EQU 0 
B     EQU 1 
XEQT  EQU 1717B 
      SPC 1 
END   EQU * 
      SPC 1 
      END 
                                                                                                                                  