{ Extracted from FMACS:LIB }

{ Open Update, Close update, Flush Output  -  FDC, 12.2.85 }

{ Notes to rippers-off:                                              }
{  These routines allow a primitive form of update mode.             }
{  OPEN UPDATE opens an existing file for update, and CLOSE UPDATE   }
{  closes it again.  Both an input stream and an output stream are   }
{  associated with the file.  Use set input to position to a block   }
{  (512 byte) boundary, then read 512 bytes, change what you want,   }
{  set output back to the beginning of the block and write it back   }
{  again.  Anything else is likely to give a 'protocol error',       }
{  though if you want to replace a block entirely you don't have to  }
{  read it first, and the last block in the file does not have to be }
{  a full 512 bytes long.                                            }

@16_1108 %integerfn FCOMM(%integer cn,%string(255)s)
@16_110C %integerfn FCOMMW(%integer cn,%string(255) s,
               %bytename buffer,%integer size)
@16_1110 %integerfn FCOMMR(%integer c,%string(255)p,
                               %bytename b,%integer max)
@16_35c4 %short      USERNO
@16_372d %byte       FSPORT
@16_1100 %routine    ETHERWRITE(%integer port,%bytename buf,%integer size)
@16_1104 %integerfn  ETHERREAD(%integer port,%bytename buf,%integer max)
%recordformat sf(%integer ptr,lim,server,extra)
@16_35c6 %record(sf)%name curin
@16_35ca %record(sf)%name curout

%integerfn fromhdh(%integername pos,%integer lim)
%integer n=0,k
   %cycle
      %result = n %if pos>=lim
      pos = pos+1
      k = byteinteger(pos-1)-'0'
      %result = n %if k<0
      n = n<<4+k
   %repeat
%end

{---------- OPEN UPDATE ----------}
%external %integer %function open update(%integer stream,%string(255)file)
! Open the specified file for input and output on the specified stream.
! The file must already exist.
! The file is initially positioned at the beginning.
! Result is the size of the information in the file already.
!
! It is up to the user to read and write full (512 byte) blocks only.
! Always read a block before writing it back.
!
%string(255)s
%record(sf)%name cb
%integer pos,lim,xno,blocks,pad,size
! Open anything for output first - to get file driver addr into CB
   %begin
      %on %event 3 %start
         %signal 10, 9, 99, "Cannot create file in PUB:"
      %finish

      openoutput(stream,"pub:")
   %end
   selectoutput(stream)
   cb == curout
   xno = cb_extra
! Close it again - but don't use CLOSEOUTPUT as this will zap the driver
   cb_extra = 0
   s = "K".tostring(xno+'0').tostring(nl)
   etherwrite(fsport,charno(s,1),length(s))
   length(s) = etherread(fsport,charno(s,1),255)
! Open anything for input - to get file driver addr into CB
   openinput(stream,"directory")
   selectinput(stream)
   cb == curin
   xno = cb_extra
! Close it again - but don't use CLOSEOUTPUT as this will zap the driver
   cb_extra = 0
   s = "K".tostring(xno+'0').tostring(nl)
   etherwrite(fsport,charno(s,1),length(s))
   length(s) = etherread(fsport,charno(s,1),255)
! Now open-mod the file we want
   s = "A".tostring(userno+'0').file.tostring(nl)
   etherwrite(fsport,charno(s,1),length(s))
   length(s) = etherread(fsport,charno(s,1),255)
   %if charno(s,1)='-' %start;      !failed to open
      %signal 3,3,charno(s,2)-'0',substring(s,3,length(s)-1)
   %finish
   pos = addr(s)+1
   lim = pos+length(s)
   xno = fromhdh(pos,lim)
   blocks = fromhdh(pos,lim)
   pad = fromhdh(pos,lim)
   curin_extra = xno
   curout_extra = xno
   size = blocks<<9-pad
   reset output
   reset input
   %result = size
%end

{---------- CLOSE UPDATE ----------}
%external %routine close update
   close output
   curin_extra = 0
   close input
%end

{---------- FLUSH OUTPUT ----------}
%external %routine flush output
   %integer len

   len = curout_ptr - curout_lim + 512
   curout_ptr = curout_lim - 512
   %if len # 0 %start
      len = fcommw('Y0' + curout_extra, "", byteinteger(curout_ptr), {len}512)
{-------------- temporary hack because file store won't truncate right ---^^^}
   %finish
%end

{---------- ABANDON OUTPUT ----------}
%external %routine abandon output
   %integer junk

   junk = fcomm('H0' + curout_extra, "")
   curout_ptr = curout_lim - 512
   curout_extra = 0
%end

%endoffile