#PROGRAM       /GFCLOSE(15AM,22AM,DBM,EBM)
#PAGE

#INCLUDE       IOHEAD(/DEFS)
#INCLUDE       STACK(/DEFS)

#PERMANENT     GFMALLOC    [ #XPCK to stupid to include by entrypoint

#PROGRAM

#              Close a file

#              ERR = CLOSE(FD)

#              CALL  1  CLOSE
#              LDN   3  FD             

#SET           ARGS=0

#DEFINE        ARGFD=ARGS
#SET           ARGS=ARGS+1

#SET           STFRAME=SXFRAME

#DEFINE        STFD=SXPAR1           [ FD
#SET           STFRAME=STFRAME+1


#              Pick up arguments for Fortran style entry

      OBEY     ARGFD(1)
      LDX   5  0(3)                  [ get FD

      STACK 2                        [ get SP to X2
      STO   5  STFD(2)               [ save FD in arg list

      ADN   1  ARGS                  [ skip args on return

#              Pascal style entry

#CUE           GPCLOSE

      BEGIN 2  3,1,STFRAME           [ allocate stack frame, save link

      LDX   5  STFD(2)               [ get FD
      STO   5  SXPAR1(3)             [ and save in arg list of IOCHECK

      NGN   4  1                     [ flush if data written
      STO   4  SXPAR2(3) 
      CALL  1  GPIOCHECK             [ gpiocheck (fd, -1)

      BNG   6  BYE                   [ fd is not open
      STO   6  3

      LDN   0  FLAGNOCLOSE           [ is no release on close set?
      ANDX  0  FDFLAGS(3)
      BNZ   0  ZAP

      LDX   1  FDTYPE(3)
      LDX   0  FDUNIT(3)
      REL   0  256(1)               [ close the unit

ZAP   CALL  1  GXFREE               [ GXFREE expects pointer in X3

      LDX   3  PFTABLE              [ get file table
      ADX   3  STFD(2)
      STOZ     1(3)                 [ zero file table entry

      LDN   6  0

BYE   END   2  1,0

#END
#FINISH