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

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

#PROGRAM

#              read a line from the file.

#              ERR = READLN(FD)

#              CALL  1  READLN
#              LDN   3  FD 

#              return in X6 is +ve, or
#                   0 for EOF
#                   -ve for error

#              When reading from *FR we read block at a time

#SET           ARGS=0

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

#SET           STFRAME=SXFRAME

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


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

      ADN   1  ARGS

#              Pascal callable entry point

#CUE           GPREADLN

      BEGIN 2  3,1,STFRAME

#              Check if FD is open

      LDX   0  STFD(2)
      STO   0  SXPAR1(3)
      STOZ     SXPAR2(3)            [ read mode
      CALL  1  GPIOCHECK
 
      BNG   6  OUT                  [ fd is not open

      STO   6  3                    [ get fdesc to X3

      LDN   4  #7777-FLAGPART
      ANDS  4  FDFLAGS(3)            [ unset partial record flag

      LDX   7  FDTYPE(3)            [ get device type
      BZE   7  READ                 [ *TR, just do read

      LDX   4  FDPERI(3)
      ANDN  4  #77                  [ get I/O mode
      SBN   4  #22                  [ mode #22 = block read
      
      BNZ   4  READ                 [ jump if not block reads

      LDX   1  FDRECORD(3)          [ get next rec

      BRN      NXREC

READ  LDX   6  FDBUFLEN(3)
      BZE   7  *+2
      SRL   6  2                    [ FH read len is in words
      STO   6  FDCOUNT(3)           [ set read count
      LDX   5  FDUNIT(3)

      PERI  5  FDPERI(3)            [ read a new block/rec

      LDXC  6  FDREPLY(3)
      BCC      *+4
      LDX   1  7                    [ get type to index reg
      SUSBY 5  256(1)
      LDX   6  FDREPLY(3)

      LDX   5  6                    [ get reply
      SLA   5  3                    [ get B3 to overflow

      BVCR     OK                   [ jump if no error

      SLA   5  2                    [ get B5 to overflow
      BVCR     *+3                  [ jump if not eof
      STOZ     6                    [ it's EOF
      BRN      OUT                  [ and go

      NGN   6  EIO                  [ set error
      BRN      OUT                  [ byee

OK    LDX   1  FDADDR(3)            [ get buffer address

      BNZ   7  FH                   [ jif read from *FR/FH

#              From *TR reply is unexpired character count

      ANDN  6  #177                 [ ignore high bits
      LDX   7  FDCOUNT(3)           [ get count
      SBX   7  6                    [ subtract left
      STO   7  6                    [ which we want in X6

      LDX   7  FDPERI(3)            [ what mode PERI did we do?
      STO   7  0
      ANDN  7  #4                   [ read in prev shift
      BZE   7  ALFA                 [ jump if was alfa shift

      ERN   0  #4                   [ turn off "prev shift"
      STO   0  FDPERI(3)
      BRN      DONE                 [ and don't change initial

ALFA  LDN   0  #74                  [ get initial shift
      STO   0  FDSHIFT(3)

      LDN   0  SMODALPHA
      STO   0  FDSHIFTMOD(3)        [ set input shift

      BRN      DONE                 [ all done

#              After read from FR,FH bits 6..23 contain address
#              of word  after last word read

FH    SBX   6  1                    [ subtract buffer address
      ANDN  6  #7777                [ ignore high bits

      BZE   6  OUT                  [ Jump if EOF

      BNZ   4  INREC                [ jump if not block mode

#              Extract info from *FR, *FH buffer

NXREC LDX   6  0(1)                 [ get length
      BZE   6  READ                 [ jump if block finished

      LDX   7  6                    [ get rec len
      ADX   7  1                    [ work out start of next rec
      STO   7  FDRECORD(3)
      SBN   6  1                    [ hide length field
      ADN   1  1

INREC SLL   6  2                    [ Calculate #chars
      LDXC  5  FDSHIFT(3)           [ shift, graphic, amorph?

      BCS      DONE                 [ jump if amorphous

      LDX   0  0(1)                 [ get red tape word

      ADN   1  1                    [ don't count red tape in len
      SBN   6  4

#              If record is exactly 2000 chars long then we need to
#              set partial record flag.

      LDX   4  2000
      BXU   4  6,*+3
      LDN   4  FLAGPART
      ORS   4  FDFLAGS(3)           [ this is partial record

#              Work out initial shift

      BZE   5  GRAP                 [ don't change shift if graphic
      
      LDX   4  0                    [ get red tape to X0
      SRL   4  6                    [ get initial shift
      ANDN  4  1
      ADN   4  #74                  [ deal with broken files
      STO   4  FDSHIFT(3)           [ and save it
      LDN   7  SMODALPHA            [ assume alpha
      SBNC  4  #75
      BCS      *+2                  [ it was
      LDN   7  SMODBETA             [ or not
      STO   7  FDSHIFTMOD(3)

GRAP  SLC   0  2                    [ get chars used in last word
      ANDN  0  3                    [ mask rubbish
      BZE   0  DONE                 [ jif whole word used
      LDN   4  4
      SBX   4  0                    [ chars unused in last word
      SBX   6  4                    [ chars in rec

DONE  STO   1  FDNEXT(3)            [ save pointer to next char
      STO   6  FDCHARS(3)           [ and rec length

      ADN   6  1                    [ pretend 0 len rec = 1 char

OUT   END   2  1,0

#END
#FINISH