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

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

#PERMANENT     GFWRITE6   [ consolidator doesn't have a #CUE
#PERMANENT     GFWRITESP

#PROGRAM

#              Write an integer.

#              ERR = WRITEINT(FD, VAL, LEN)

#              CALL  1  WRITEINT
#              LDN   3  FD             
#              LDN   3  VAL           [ value to write
#              LDN   3  LEN           [ field width

#              If field width is -v left justify in field

#              If field width is too small we will use
#              minimum space necessary.

#SET           ARGS=0

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

#DEFINE        ARGVAL=ARGS
#SET           ARGS=ARGS+1

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

#              Define stack frame

#SET           STFRAME=SXFRAME

#              First the arguments

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

#DEFINE        STVAL=SXPAR2          [ value to output
#SET           STFRAME=STFRAME+1

#DEFINE        STLEN=SXPAR3          [ Field width
#SET           STFRAME=STFRAME+1

#              Amd now the local variables

#DEFINE        STBUF=STFRAME         [ Buffer to hold text
#SET           STFRAME=STFRAME+2     [ two words (8 chars) long

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

#              Fortran entry point, save args to the stack

      STACK 2

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

      OBEY     ARGVAL(1)
      LDX   0  0(3)                  [ get val
      STO   0  STVAL(2)
      
      OBEY     ARGLEN(1)             [ get len
      LDX   0  0(3)
      STO   0  STLEN(2)

      ADN   1  ARGS

#              Pascal style entry point

#CUE           GPWRITEINT

      BEGIN 2  3,1,STFRAME

      LDX   0  STFD(2)
      STO   0  SXPAR1(3)             [ is FD open?
      LDN   0  1                     [ in write mode
      STO   0  SXPAR2(3)
      CALL  1  GPIOCHECK

      BNG   6  DONE
      STO   6  STDESC(2)

#              Crazy algorithm modified from George
#
#              Comments indicate that +7036875 is
#              2**46/10**7, which it is if you
#              round up.

      LDX   4  STVAL(2)            [ get value to output
      LDN   3  STBUF(2)            [ get pointer to buffer

      MPY   4  '+7036875'          [ TIMES CONVERSION FACTOR
      BPZ   4  POS                 [ ok if +ve
      NGXC  5  5                   [ negate low word, setting carry
      NGX   4  4                   [ negate high word, + carry
      LDN   0  #35                 [ set output char to "-"
      DCH   0  0(3)                [ output "-"
      BCHX  3  *+1                 [ bump output pointer
POS   MODE     0                   [ no zero supression please
      LDN   7  7                   [ up to 7 digits

      CBD   4  0                   [ convert digit to X0
      BNZ   0  TRAIL               [ jump if not leading zero
      BCT   7  *-2                 [ loop back for more leading zero

      LDN   7  1                   [ output last, zero, digit

TRAIL DCH   0  0(3)                [ save digit
      BCHX  3  *+1                 [ bump pointer
      BRN      REST                [ enter trailing digit loop

      CBD   4  0(3)                [ CONVERT LAST DIGITS
      BCHX  3  *+1                 [ STEP POINTER
REST  BCT   7  *-2                 [ and back for more

#              Ok, now X3 pointing at char after last used
#              work out how long this is

#              In 15AM the character counter/modifier is
#              NNCCCCCCCAAAAAAAAAAAAAAA
#              2 bit char pos
#              7 bit count
#              15 bit word addr.

FILL  SBN   3  STBUF(2)            [ as a char pointer
      SLC   3  2                   [ as #chars
      ANDN  3  #7777               [ Zap the 15AM count field

      STO   3  STVAL(2)            [ set true field length
      LDX   4  STLEN(2)            [ get wanted field width

      SBX   4  3                   [ subtract actual length
      BNG   4  OUT                 [ jump if number > field
      BZE   4  OUT 

#              Output number of spaces held in X4

RIGHT STACK 3
      LDX   0  STFD(2)
      STO   0  SXPAR1(3)
      STO   4  SXPAR2(3)
      CALL  1  GPWRITESP           [ write spaces
      BNG   6  BYE

OUT   STACK 3
      LDX   0  STFD(2)
      STO   0  SXPAR1(3)
      LDN   0  STBUF(2)
      STO   0  SXPAR2(3)
      STOZ     SXPAR3(3)
      LDX   0  STVAL(2)
      STO   0  SXPAR4(3)
      CALL  1  GPWRITE6
      BNG   6  BYE

LEFT  NGX   4  STLEN(2)            [ get back wanted field width
      SBX   4  STVAL(2)            [ subtract actual width
      BNG   4  DONE
      BZE   4  DONE                [ quit if no spaces
      STACK 3
      LDX   0  STFD(2)
      STO   0  SXPAR1(3)
      STO   4  SXPAR2(3)
      CALL  1  GPWRITESP
      BNG   6  BYE

DONE  LDN   6  0              [ zero = success

BYE   END   2  1,0

#END
#FINISH