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

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

#PROGRAM

#              Open a string for input

#              FD = OPENSTR (SHIFT, STR, POS, LEN)

#              STR must be array element or var
#              SHIFT is -ve if data unshifted, 0 to start in
#              alpha or 1 to start in beta

#SET           ARGS=0

#DEFINE        ARGSHIFT=ARGS
#SET           ARGS=ARGS+1

#DEFINE        ARGBUF=ARGS
#SET           ARGS=ARGS+1

#DEFINE        ARGPOS=ARGS
#SET           ARGS=ARGS+1

#DEFINE        ARGLEN=ARGS
#SET           ARGS=ARGS+1

#              Define stack frame

#SET           STFRAME=SXFRAME

#              Arguments

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

#DEFINE        STBUF=SXPAR2
#SET           STFRAME=STFRAME+1

#DEFINE        STPOS=SXPAR3
#SET           STFRAME=STFRAME+1

#DEFINE        STLEN=SXPAR4
#SET           STFRAME=STFRAME+1

#              Fortran compatible entry point

      STACK 2
      OBEY     ARGSHIFT(1)
      LDX   0  0(3)             [ get initial shift
      STO   0  STSHIFT(2)

      OBEY     ARGPOS(1)
      LDX   3  0(3)             [ get pos in buf
      STO   3  STPOS(2)

      OBEY     ARGLEN(1)
      LDX   3  0(3)             [ get buffer len
      STO   3  STLEN(2)         [ save across call to FHALLOC

#              This may be a call by name arg:

      OBEY     ARGBUF(1)        [ get buffer
      STACK 2                   [ restore stack top
      SLL   3  2                [ clear top two bits
      SRL   3  2
      STO   3  STBUF(2)         [ save for a tick

      ADN   1  ARGS

#              Pascal entry point

#CUE           GPOPENSTR

      BEGIN 2  3,1,STFRAME

      LDX   4  STSHIFT(2)       [ get initial shift
      BNG   4  *+3
      ANDN  4  1                [ odd or even?
      ADN   4  #74              [ who cares

      NGN   0  1                [ no fixed FD
      STO   0  SXPAR1(3)
      STO   4  SXPAR2(3)        [ Shift flag
      STO   0  SXPAR3(3)        [ no device
      STO   0  SXPAR4(3)        [ no unit
      STOZ     SXPAR5(3)        [ fake read command
      STOZ     SXPAR6(3)        [ fake write command
      STOZ     SXPAR7(3)        [ no buffer
      CALL  1  GPFDALLOC

      BNG   6  BYE

#              FDALLOC returns FDESC in X3        

      LDX   5  STPOS(2)         [ get offset in buf
      SRC   5  2                [ convert to char addr
      ADX   5  STBUF(2)         [ and add to buff addr
      STO   5  FDADDR(3)        [ save in FDESC
      STO   5  FDNEXT(3)        [ and set next char to read
      LDX   5  STLEN(2)         [ get buf len
      STO   5  FDBUFLEN(3)      [ save in FDESC
      STO   5  FDCHARS(3)       [ and set number of chars avail

      LDN   0  FLAGNOCLOSE      [ set no release on close flag
      ORS   0  FDFLAGS(3)

BYE   END   2  1,0

#END
#FINISH