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

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

#PERMANENT     GFWRITEECMA

#PROGRAM

#              Write a line to the file.

#              For *TP we have to write a CRLF then do a WRITEBUF

#              For *FW/*FH we do a WRITEBUF, and if the buffer
#              was full and we are not writing to a AMORPHOUS 
#              file we do another WRITEBUF

#              ERR = WRITELN(FD)

#              CALL  1  WRITELN
#              LDN   3  FD             

#SET           ARGS=0

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

#              Define the stack frame

#SET           STFRAME=SXFRAME

#              First arguments

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

#              Then local variables

#DEFINE        STDESC=STFRAME        [ saveed FDESC
#SET           STFRAME=STFRAME+1

#DEFINE        LENCRLF=2
#DEFINE        STCRLF=STFRAME         [ 2 word buf for writeecma
#SET           STFRAME=STFRAME+LENCRLF

#              Fortran compatible entrypoint, save args to stack

      STACK 2

      OBEY     ARGFD(1)
      LDX   0  0(3)                  [ get FD
      STO   0  STFD(2)

      ADN   1  ARGS

#              Pascal style entrypoint

#CUE           GPWRITELN

      BEGIN 2  3,1,STFRAME

#              Check if FD is open

      LDX   5  STFD(2)
      STO   5  SXPAR1(3)
      LDN   4  1                     [ in write mode
      STO   4  SXPAR2(3)
      CALL  1  GPIOCHECK

      BNG   6  OUT                   [ fd is not open
      STO   6  STDESC(2)

      STO   6  3

      LDN   0  DEVTP                [ is this a *TP?
      BXU   0  FDTYPE(3),FH         [ get device type

      LDN   1  STCRLF(2)
      LDN   0  ECMACR               [ store CR
      STO   0  0(1)
      LDN   0  ECMANL               [ and LF (NL in ECMA speak)
      STO   0  1(1)    

      STACK 3
      LDX   0  STFD(2)
      STO   0  SXPAR1(3)
      STO   1  SXPAR2(3)
      LDN   0  LENCRLF
      STO   0  SXPAR3(3)

      CALL  1  GPWRITEECMA

CONT  BNG   6  OUT

WB    STACK 3
      LDX   0  STFD(2)
      STO   0  SXPAR1(3)
      CALL  1  GPWRITEBUF

OUT   END   2  1,0

FH    LDXC  0  FDSHIFT(3)           [ AMORPHOUS?
      BCS      WB                   [ if is, just do simple write

      LDN   0  2004                 [ Record full?
      BXU   0  FDCHARS(3),WB        [ if not just do a write

      STACK 3
      LDX   0  STFD(2)              [ write 1st 2000 chars
      STO   0  SXPAR1(3)
      CALL  1  GPWRITEBUF

      BRN      CONT                 [ loop to write null record

#END
#FINISH