!Misc Imp Library

%option "-low-nocheck-nodiag-noline"

%systemintegerfn freestore
@724(a5) %integername heapfront
  %result = a7-heapfront
! *move.l sp,d0
! *sub.l d6,d0
%end

%systemroutine newline
  printsymbol(nl)
%end

%systemroutine newlines(%integer n)
  %while n>0 %cycle
    n = n-1; printsymbol(nl)
  %repeat
%end

%systemroutine space
  printsymbol(' ')
%end

%systemroutine spaces(%integer n)
  %while n>0 %cycle
    n = n-1; printsymbol(' ')
  %repeat
%end

%systemstring(255)%fn readstring
! a STRING is deemed a sequence of non-control characters,
! hence, as for numbers, leading control characters are skipped,
! and the terminating one is not.
%string(255)s
%integer k
  s = ""
  readsymbol(k) %until k>' '
  %cycle
    s = s.tostring(k)
    %exitif nextsymbol<=' '
    readsymbol(k)
  %repeat
  %result = s
%end

%systemroutine readline(%string(255)%name s)
! a LINE is a sequence of non-NL characters and may be empty,
! hence blank lines are not skipped, and leading and trailing
! spaces are significant.  The terminating NL is skipped, to
! make it "pipe-compatible" with printline.
%integer k
  s = ""
  %cycle
    readsymbol(k); %exitif k=nl
    s = s.tostring(k)
  %repeat
%end

%systemroutine printline(%string(255)s)
  printstring(s)
  printsymbol(nl)
%end

%systemroutine to lower(%string(*)%name s)
%integer i
%bytename b
  i = length(s); %returnif i=0
  b == charno(s,1)
  %cycle
    b = b!32 %if 'A'<=b<='Z'
    b == b[1]
    i = i-1
  %repeatuntil i<=0
%end

%systemroutine to upper(%string(*)%name s)
%integer i
%bytename b
  i = length(s); %returnif i=0
  b == charno(s,1)
  %cycle
    b = b&95 %if 'a'<=b<='z'
    b == b[1]
    i = i-1
  %repeatuntil i<=0
%end

%systemroutine to mixed(%string(*)%name s)
! "Beautify" S by turning every leading letter into upper case.
! de disgustibus non est putandum
%integer case=0,i
%bytename b
  i = length(s); %returnif i=0
  b == charno(s,1)
  %cycle
    %if 'a'<=b!32<='z' %then b = b&95+case %and case = 32 %else case = 0
    b == b[1]
    i = i-1
  %repeatuntil i<=0
%end

%systemstring(9)%fn itoh(%integer n)
%string(9)s=""
%integer i,k
  %for i = 28,-4,0 %cycle
    k = n>>i&15; k = k+7 %if k>9; s = s.tostring(k+'0')
  %repeat
  %result = s
%end

%systemintegerfn htoi(%string(255)s)
%integer n=0,p=0,k
  %cycle
    p = p+1
    %result = n %if p>length(s)
    k = charno(s,p); %continueif k<=' '
    k = k-'0'
    %if k>9 %start
      k = k-7 %if k-7>9
      k = k-32 %if k>15
    %finish
    %result = n %unless 0<=k<=15
    n = n<<4+k
  %repeat
%end

%systemintegerfn stoi(%string(255) S)
%integer i,k
%integer sign=0, val=0
  i = 0
  %while i < length(s) %cycle
    i = i+1;  k = charno(s,i)
    %continue %if k <= ' '
    %if k = '-' %start
      sign = 1
    %else %if '0' <= k <= '9'
      val = val<<3+val+val+k-'0'
    %else
      %signal 4, 1, k, "Non-numeric character"
    %finish
  %repeat
  %result = val %if sign = 0
  %result = -val
%end

%systemstring(127)%fn itos(%integer v,p)
%string(127)store
%bytename l
  %routine printsymbol(%integer x)
    l = l+1; charno(store,l) = x
  %end
  %routine spaces(%integer x)
    x = x-1 %and printsymbol(' ') %while x>0
  %end
  %routine write(%integer n,p)
  %integer q,r
    %if p>0 %start
      p = \p; printsymbol(' ') %and p = p+1 %if n>=0
    %finish
    p = -120 %if p<-120
    q = n//10; *move.l d1,r
    %if q=0 %start
      p = p+1 %if n<0; spaces(-1-p); printsymbol('-') %if n<0
    %else
      p = p+1 %if p<0; write(q,p)
    %finish
    printsymbol(|r|+'0')
  %end
  store = ""; l == length(store)
  write(v,p)
  %result = store
%end

%systemstring(127)%fn rtos(%real r,%integer n,m)
  %constreal pmax = 2147483647.0
  %real y,z
  %integer i=0,l,count=0,sign
  %string(127) result = ""
  !
  sign = ' '
  sign = '-' %if r < 0
  y = |r|+0.5/10.0\{^}m;  !modulus, rounded
  %if y > pmax %start
    count = count+1 %and y = y/10.0 %until y < 10.0
  %finish
  z = 1.0
  %cycle
    i = i+1;  z = z*10.0
  %repeat %until z > y
  result = result." " %for l = 1,1,n-i;  !l not used before here
  result = result.tostring(sign) %unless sign = ' ' %and n <= 0
  %cycle
    z = z/10.0
    l = int pt(y/z)
    y = y-l*z
    result = result.tostring(l+'0')
    i = i-1
    %exit %if i+m <= 0
    result = result."." %if i = 0
  %repeat
  result = result."@".itos(count,0) %if count # 0
  %result = result
%end;  !rtos

%systemstring(127)%fn rtof(%real x, %integer n)
  %real y,round
  %integer count=-99,sign=0
  %string(127) result=""
  !
  %if x # 0 %start
    x = -x %and sign = 1 %if x < 0
   !Adjust X so that 1.0 <= rounded(X) < 10.0
    count = 0;  round = 0.5\{^}n
    y = 1.0-round
    %if x < y %start;  !ie rounded(X) < 1.0
      count = count-1 %and x = x*10.0 %until x >= y
    %finish %else %start
      y = 10.0-round
      %while x >= y %cycle;  !ie rounded(X) > 10.0
        count = count+1;  x = x/10.0
      %repeat
    %finish
    x = -x %if sign # 0
  %finish
  result = rtos(x,1,n)
  result = result."@".itos(count,0)
  %result = result
%end;  !flrtos

!Original grotty faulty version
!%systemrealfn stor(%string(255)input)
!  !reads a real from the string, assuming string starts with the real
!  !(or blank spaces followed by a real)
!  %integer sign=0,sym,pos=0
!  %real value,exp
!  !
!  input=input."!";         !check that there is a finish character
!  %cycle
!    sym = charno(input,pos+1)
!    %exit %if sym > ' '
!    pos=pos+1
!  %repeat
!  %if sym = '-' %start
!    sign = 1
!    pos=pos+1;  sym = charno(input,pos+1)
!  %finish
!  value = 0
!  %if sym # '.' %start
!    %signal 6,5,pos %unless '0' <= sym <= '9';  !charno out of range
!    %cycle
!      value = value*10.0+(sym-'0')
!      pos=pos+1;  sym = charno(input,pos+1)
!    %repeat %until %not '0' <= sym <= '9'
!  %finish
!  %if sym = '.' %start
!    exp = 10.0
!    %cycle
!      pos=pos+1;  sym = charno(input,pos+1)
!      %exit %unless '0' <= sym <= '9'
!      value = value+(sym-'0')/exp
!      exp = exp*10.0
!    %repeat
!  %finish
!  %if sym = '@' %start
!    pos = pos+1
!    sym = charno(input,pos+1); pos = pos+1
!    value = value*10.0\(sym-'0')
!  %finish
!  value = -value %if sign # 0
!  %result = value
!%end;  !stor

!Working version, courtesy of RMM (as if it wasn't obvious
!from the grotesque 'aesthetic' source layout)

%system %real %function S To R (%string (255) Input)
  %integer Sign = 0,
           Sym,
           Pos = 1
  %long %real Value,
              Exp

   %routine Next
      Pos = Pos + 1
      %if Pos > Length (Input) %start
         Sym = 0
      %else
         Sym = Char No (Input, Pos)
      %finish
   %end

   Sym = Char No (Input, Pos)
   %if Sym = '-' %start
      Sign = 1
      Next
   %finish
   Value = 0
   %if Sym # '.' %start
      %signal 6, 5, Pos %unless '0' <= Sym <= '9'           {Char No out of range}
      %cycle
         Value = Value*10.0 + (Sym - '0')
         Next
      %repeat %until %not '0' <= Sym <= '9'
   %finish
   %if Sym = '.' %start
      Exp = 10.0
      %cycle
         Next
         %exit %unless '0' <= Sym <= '9'
         Value = Value + (Sym - '0')/Exp
         Exp = Exp * 10.0
      %repeat
   %finish
   %if Sym = '@' %start
      Sym = S To I (Sub String (Input, Pos + 1, Length (Input)))
      Value = Value * 10.0\Sym
   %finish
   Value = -Value %if Sign # 0
   %result = Value
%end {S To R}

%systemrealfn ftor(%string(255)s)
  %result = stor(s)
%end

%systemstring(255)%fn infilename
  %result = "[INFILENAME]"
%end

%systemstring(255)%fn outfilename
  %result = "[OUTFILENAME]"
%end

%systemintegerfn xread %alias "read"
%integer i,k,sign,ten=10,max='9'
  %cycle
    k = next symbol
    %exit %if k > ' '
    skip symbol
  %repeat
  sign = 0
  %if k = '-' %start
    sign = 1
    skip symbol;  k = next symbol
  %finish
  %cycle
    %signal 4,1,nextsymbol,"Non-numeric character to READ" %unless '0'<=k<=max
    i = k-'0'
    %cycle
      skip symbol
      k = next symbol
      k = k-32 %if k>='a'
      %if k>'9' %start
        %exitif k<'A'
        k = k-7
      %finish
      %exit %unless '0' <= k <= max
      i = i*ten-'0'+k
    %repeat
    %exitunless k='_'-7
    ten = i; max = '0'+ten-1
    skipsymbol; k = nextsymbol
    k = k-32 %if k>='a'
    %if k>'9' %start
      k = -1 %if k<'A'
      k = k-7
    %finish
  %repeat
  i = -i %if sign # 0
  %result = i
%end

%systemrealfn readreal
%integer sign=0,sym
%real value,exp

  %routine read(%integername n)
    n = xread
  %end

  %cycle
    sym = nextsymbol
    %exit %if sym > ' '
    skipsymbol
  %repeat
  %if sym = '-' %start
    sign = 1
    skip symbol;  sym = nextsymbol
  %finish
  value = 0
  %if sym # '.' %start
    %signal 4,1,sym,"Non-numeric character to READ" %unless '0' <= sym <= '9'
    %cycle
      value = value*10.0+(sym-'0')
      skip symbol;  sym = nextsymbol
    %repeat %until %not '0' <= sym <= '9'
  %finish
  %if sym = '.' %start
    exp = 10.0
    %cycle
      skip symbol;  sym = nextsymbol
      %exit %unless '0' <= sym <= '9'
      value = value+(sym-'0')/exp
      exp = exp*10.0
    %repeat
  %finish
  %if sym = '@' %start
    skipsymbol
    read(sym)
    value = value*10.0\sym {^}
  %finish
  value = -value %if sign # 0
  %result = value
%end;  !read real

%systemroutine write(%integer n,p)
%integer q,r
  %if p>0 %start
    p = \p; printsymbol(' ') %and p = p+1 %if n>=0
  %finish
  p = -120 %if p<-120
  q = n//10; *move.l d1,r
  %if q=0 %start
    p = p+1 %if n<0; spaces(-1-p); printsymbol('-') %if n<0
  %else
    p = p+1 %if p<0; write(q,p)
  %finish
  printsymbol(|r|+'0')
%end

%systemroutine print(%real x, %integer n,m)
%constreal pmax = 2147483647.0
%real y,z
%integer i=0,l,count=0,sign
  sign = ' '
  sign = '-' %if x < 0
  y = |x|+0.5/10.0\{^}m;  !modulus, rounded
  %if y > pmax %start
    count = count+1 %and y = y/10.0 %until y < 10.0
  %finish
  z = 1.0
  %cycle
    i = i+1;  z = z*10.0
  %repeat %until z > y
  spaces(n-i)
  printsymbol(sign) %unless sign = ' ' %and n <= 0
  %cycle
    z = z/10.0
    l = int pt(y/z)
    y = y-l*z
    printsymbol(l+'0')
    i = i-1
    %exit %if i+m <= 0
    print symbol('.') %if i = 0
  %repeat
  printsymbol('@') %and write(count,0) %if count # 0
%end;  !print

%systemroutine printfl(%real x, %integer n)
%real y,round
%integer count=-99,sign=0
  %if x # 0 %start
    x = -x %and sign = 1 %if x < 0
   !Adjust X so that 1.0 <= rounded(X) < 10.0
    count = 0;  round = 0.5\{^}n
    y = 1.0-round
    %if x < y %start;  !ie rounded(X) < 1.0
      count = count-1 %and x = x*10.0 %until x >= y
    %finish %else %start
      y = 10.0-round
      %while x >= y %cycle;  !ie rounded(X) > 10.0
        count = count+1;  x = x/10.0
      %repeat
    %finish
    x = -x %if sign # 0
  %finish
  print(x,1,n)
  printsymbol('@')
  write(count,0)
%end;  !printfl

%systemroutine phex1(%integer x)
  x = x&15; x = x+7 %if x>9; printsymbol(x+'0')
%end

%systemroutine phex2(%integer x)
  phex1(x>>4); phex1(x)
%end

%systemroutine phex4(%integer x)
  phex2(x>>8); phex2(x)
%end

%systemroutine phex(%integer x)
  phex4(x>>16); phex4(x)
%end

%systemintegerfn rhex
%integer n=0,s
  %onevent 4 %start
    %signal 4,1,s,"Non-numeric character to RHEX"
  %finish
  %cycle
    s = nextsymbol; %exitif s>' '
    skipsymbol
  %repeat
  s = s&95 %if s>='a'
  %signal 4 %unless '0'<=s<='9' %or 'A'<=s<='F'
  %while '0'<=s<='9' %or 'A'<=s<='F' %cycle
    s = s-'0'; s = s-7 %if s>9
    n = n<<4+s; skipsymbol; s = nextsymbol
    s = s&95 %if s>='a'
  %repeat
  %result = n
%end

%systempredicate resolves(%string(*)%name var,match,fore,aft)
!!Resolve the string specified by VAR into FORE and AFT split by MATCH
!![FORE and/or AFT absent is conventionally represented by an address
!! of zero]
@0%string(*) null
%integer i

  %integerfn resol(%string(*)%name var,match)
  !Return index position of first occurrence of MATCH within VAR
  %label yes,no
    *clr.l d0
    *clr.w d1
    *move.b (a1)+,d1  {length(match)
    *beq yes          {match="" ->
    *clr.w d2
    *move.b (a0)+,d2  {length(var)
    *sub.b d1,d2
    *bcs no           {length(match)>length(var) ->  {*bug: was bmi
    *subq.w #1,d1
loop1:
    *lea 0(a0,d0),a2
    *move.l a1,a3
    *move d1,d3
loop2:
    *cmpm (a2)+,(a3)+
    *dbne d3,loop2 {*bug?was dbeq
    *beq yes
    *addq.w #1,d0
    *dbra d2,loop1
no: *moveq #-1,d0
yes:*addq.l #1,d0
  !** (to be) re-coded for efficiency **
!  %integer i=0,j,l
!    l = length(match)
!    %cycle
!      %result = 0 %if i > length(var)-l
!      i = i+1
!      j = 0
!      %cycle
!        %result = i %if j = l
!        j = j+1
!      %repeat %until charno(var,i+j-1) # charno(match,j)
!    %repeat
  %end

  %routine assign(%string(*)%name dest, %integer from,to)
  !! **NB use of TOSTRING is compiled in-line **
  !! **OK when DEST is also source **
    dest = ""
    %while from <= to %cycle
      dest = dest.tostring(charno(var,from));  from = from+1
    %repeat
  %end

  %routine do aft
    assign(aft,i+length(match),length(var)) %unless aft==null
  %end

  i = resol(var,match)
  %false %if i = 0
  %if fore ## null %start
    %if fore ## var %start
      assign(fore,1,i-1)
      do aft
    %finish %else %start
      do aft
      length(var) = i-1
    %finish
  %finish %else do aft
  %true
%end

! Bulk move

%systemroutine smoveblock(%integer bytes,from,to)
!"signed" move block
!if bytes>0 then move (from)+ to (to)+ but
!if bytes<0 then from:=from-bytes, to:=to-bytes, move -(from) to -(to)
%label f1,f2,f3,f4,f5,f6,f7,b0,b1,b2,b3,b4,b5,b6,b7,end
  *move.l d1,a0
  *move.l d2,a1
  *eor d1,d2
  *tst.l d0
  *bmi b0;       !copy backwards ->
  *beq end;      !copy nothing ->
  *btst #0,d2;   !if (from!!to)&1#0 then
  *bne f5;       !copy bytewise ->
  *btst #0,d1;   !if from&1=0 then
  *beq f1;       !go for longword loop ->
  *move.b (a0)+,(a1)+; !copy first byte to even up
  *subq.l #1,d0
f1: *moveq #3,d2
  *and d0,d2;    !remainder for byte loop
  *subq.l #4,d0
  *bmi f4;       !bytes<4 ->
  *lsr.l #2,d0;  !longwords-1
  *bra f3
f2: *swap d0;    !longword loop
f3: *move.l (a0)+,(a1)+
  *dbra d0,f3
  *swap d0
  *dbra d0,f2
f4: *move.l d2,d0
f5: *subq.l #1,d0; !bytes-1
  *bmi end
  *bra f7
f6: *swap d0;      !byte loop
f7: *move.b (a0)+,(a1)+
  *dbra d0,f7
  *swap d0
  *dbra d0,f6
  *bra end
b0: *neg.l d0;   !backwards copy
  *add.l d0,a0;  !adjust addresses for -()
  *add.l d0,a1
  *btst #0,d2
  *bne b5
  *move a0,d1;   !!
  *btst #0,d1
  *beq b1
  *move.b -(a0),-(a1)
  *subq.l #1,d0
b1: *moveq #3,d2
  *and d0,d2
  *subq.l #4,d0
  *bmi b4
  *lsr.l #2,d0
  *bra b3
b2: *swap d0
b3: *move.l -(a0),-(a1)
  *dbra d0,b3
  *swap d0
  *dbra d0,b2
b4: *move.l d2,d0
b5: *subq.l #1,d0
  *bmi end
  *bra b7
b6: *swap d0
b7: *move.b -(a0),-(a1)
  *dbra d0,b7
  *swap d0
  *dbra d0,b6
end:
%end

%systemroutine moveblock(%integer bytes,from,to)
!in case of overlap copy without propagating
!  %returnif bytes<=0
!  bytes = -bytes %if from<to<from+bytes
!  smoveblock(bytes,from,to)
%label x,y
  *tst.l d0
  *ble y
  *cmp.l d2,d1
  *bge x
  *move.l d1,d3
  *add.l d0,d3
  *cmp.l d3,d2
  *bge x
  *neg.l d0
x:*jsr smoveblock
y:
%end

%systemstring(31)%fn DATETIME
@16_1110 %integerfn FCOMMR(%integer c,%string(255)p,
                               %bytename b,%integer max)
%string(31)s
  length(s) = fcommr('G'<<8,"",charno(s,1),31)
  %result = s
%end

%systemstring(8)%fn DATE;                !** No owns
!%string(31)s
!  s = datetime; length(s) = 8; %result = s
  *BSR DATETIME;  !ad -> A0
  *MOVE.B #8,(A0);  !alter length
%end

%systemstring(5)%fn TIME;                !** No owns
!%string(31)s
!%integer p
!  s = datetime; p = addr(s)+length(s)-5
!  byteinteger(p) = 5; %result = string(p)
  *BSR DATETIME
  *LEA 10(A0),A0;  *MOVE.B #5,(A0);  !adjust start & length
%end

%systemintegerfn cputime
  *jsr 16_1130
%end

! PAM stuff

!Parameter records:
%recordformat INFO(%string(255) name,
                   %integer addr,%short size,flags,
                   %record(info)%name link)
!Base record
%recordformat PAMINFO(%byte groupsep,keyflag, %short allflags,
                    %record(info)%name chain)
%externalrecord(paminfo)%map PAM
!%record(paminfo)%name p
!  %if pamaddr=0 %start
!    p == new(p); pamaddr = addr(p)
!    p = 0
!    p_groupsep = '/';  p_keyflag = '-'
!  %else
!    p == record(pamaddr)
!  %finish
!  %result == p
%ownrecord(paminfo)p=paminfo('/','-',0,nil)
  %result == p
%end

%systemroutine openinput(%integer s,%string(255)f)
  *jsr 16_10f0
%end

%systemroutine openoutput(%integer s,%string(255)f)
  *jsr 16_10f4
%end

! Setinput and Setoutput

@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_3fa8 %byte       LDTE,LSAP,RDTE,RSAP
@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

%string(5)%fn tohdh(%integer n)
%string(5)h
%integer i
  h = ""
  h = h.tostring(n>>i&15+'0') %for i=12,-4,0
  %result = h
%end

%systemroutine setinput(%integer pos)
%integer x,lo,hi
  %returnif curin_extra=0;            !Not file =>
  hi = (curin_lim+511)&\511
  lo = hi-512
  curin_lim = hi
  curin_ptr = hi
  x = fcomm('U0'+curin_extra,tohdh(pos>>9))
  %returnif pos&511=0;                !No part-block =>
  x = fcommr('X0'+curin_extra,"",byteinteger(lo),512)
  %returnif x<pos&511;                !File too short =>
  curin_lim = lo+x
  curin_ptr = lo+pos&511
%end

%systemroutine resetinput
  setinput(0)
%end

%systemroutine setoutput(%integer pos)
%string(5)block
%integer x
  %returnif curout_extra=0;           !Not file =>
  curout_ptr = curout_lim-512
  block = tohdh(pos>>9)
  %if pos&511#0 %start;               !Part-block
    x = fcommr('R0'+curout_extra,block,byteinteger(curout_ptr),512)
    curout_ptr = curout_ptr+pos&511
  %finish
  x = fcomm('U0'+curout_extra,block)
%end

%systemroutine resetoutput
  setoutput(0)
%end

%integerfn open and shut(%string(255)%name file)
%string(255)s
%bytename b
%integer xno,blocks,pad
  %integerfn get
  %integer n=0,k
    %cycle
      k = b-'0'; b == b[1]
      %result = n %if k<0
      n = n<<4+k
    %repeat
  %end
  %result = 0 %if file=""
  s = "S".tostring(userno+'0').file.tostring(nl)
  etherwrite(lsap,charno(s,1),length(s))
  length(s) = etherread(lsap,charno(s,1),255)-1
  %if charno(s,1)='-' %start
    %signal 3,4,charno(s,2)-'0',substring(s,3,length(s))
  %finish
  b == charno(s,1)
  xno = get; blocks = get; pad = get
  s = "K".tostring(xno+'0').tostring(nl)
  etherwrite(lsap,charno(s,1),length(s))
  length(s) = etherread(lsap,charno(s,1),255)
  %result = blocks<<9-pad
%end

%systempredicate exists(%string(255)file)
%integer x
  %onevent 3 %start
    %false
  %finish
  toupper(file)
  %trueif file="" %or file=":N" %or file=":" %or file=":T"
  x = openandshut(file)
  %true
%end

%systemintegerfn filesize(%string(255)file)
  %result = openandshut(file)
%end

%systemroutine open append(%integer stream,%string(255)file)
! Open the specified file for output on the specified stream,
! such that information is added at the end.
! (Hidden) result is the size of the information in the file already.
%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
  openoutput(stream,"pub:"); 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(lsap,charno(s,1),length(s))
  length(s) = etherread(lsap,charno(s,1),255)
! Now open-mod the file we want
  s = "A".tostring(userno+'0').file.tostring(nl)
  etherwrite(lsap,charno(s,1),length(s))
  length(s) = etherread(lsap,charno(s,1),255)
  %if charno(s,1)='-' %start;     !failed to open
    %if charno(s,2)=';' %start;   !does not exist: use ordinary seq output
      openoutput(stream,file); selectoutput(0)
      *clr.l d0; %return
    %finish
    %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)
  cb_extra = xno
  size = blocks<<9-pad
  setoutput(size)
  *move.l size,d0
%end

%systemroutine close append; !no longer required
  closeoutput
%end

%endoffile