!Misc Imp Library

external integer a7
option "-low-nocheck-nodiag-noline"

systemintegerfn freestore
external {@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; !68K! *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; !68K! *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
conststring(*)name null == 0
integer i

  integerfn resol(string(*)name var,match)
  !Return index position of first occurrence of MATCH within VAR
  label yes,no
    !68K! *clr.l d0
    !68K! *clr.w d1
    !68K! *move.b (a1)+,d1  {length(match)
    !68K! *beq yes          {match="" ->
    !68K! *clr.w d2
    !68K! *move.b (a0)+,d2  {length(var)
    !68K! *sub.b d1,d2
    !68K! *bcs no           {length(match)>length(var) ->  {*bug: was bmi
    !68K! *subq.w #1,d1
loop1:
    !68K! *lea 0(a0,d0),a2
    !68K! *move.l a1,a3
    !68K! *move d1,d3
loop2:
    !68K! *cmpm (a2)+,(a3)+
    !68K! *dbne d3,loop2 {*bug?was dbeq
    !68K! *beq yes
    !68K! *addq.w #1,d0
    !68K! *dbra d2,loop1
no: !68K! *moveq #-1,d0
yes:!68K! *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
result=0
  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
  !68K! *move.l d1,a0
  !68K! *move.l d2,a1
  !68K! *eor d1,d2
  !68K! *tst.l d0
  !68K! *bmi b0;       !copy backwards ->
  !68K! *beq end;      !copy nothing ->
  !68K! *btst #0,d2;   !if (from!!to)&1#0 then
  !68K! *bne f5;       !copy bytewise ->
  !68K! *btst #0,d1;   !if from&1=0 then
  !68K! *beq f1;       !go for longword loop ->
  !68K! *move.b (a0)+,(a1)+; !copy first byte to even up
  !68K! *subq.l #1,d0
f1: !68K! *moveq #3,d2
  !68K! *and d0,d2;    !remainder for byte loop
  !68K! *subq.l #4,d0
  !68K! *bmi f4;       !bytes<4 ->
  !68K! *lsr.l #2,d0;  !longwords-1
  !68K! *bra f3
f2: !68K! *swap d0;    !longword loop
f3: !68K! *move.l (a0)+,(a1)+
  !68K! *dbra d0,f3
  !68K! *swap d0
  !68K! *dbra d0,f2
f4: !68K! *move.l d2,d0
f5: !68K! *subq.l #1,d0; !bytes-1
  !68K! *bmi end
  !68K! *bra f7
f6: !68K! *swap d0;      !byte loop
f7: !68K! *move.b (a0)+,(a1)+
  !68K! *dbra d0,f7
  !68K! *swap d0
  !68K! *dbra d0,f6
  !68K! *bra end
b0: !68K! *neg.l d0;   !backwards copy
  !68K! *add.l d0,a0;  !adjust addresses for -()
  !68K! *add.l d0,a1
  !68K! *btst #0,d2
  !68K! *bne b5
  !68K! *move a0,d1;   !!
  !68K! *btst #0,d1
  !68K! *beq b1
  !68K! *move.b -(a0),-(a1)
  !68K! *subq.l #1,d0
b1: !68K! *moveq #3,d2
  !68K! *and d0,d2
  !68K! *subq.l #4,d0
  !68K! *bmi b4
  !68K! *lsr.l #2,d0
  !68K! *bra b3
b2: !68K! *swap d0
b3: !68K! *move.l -(a0),-(a1)
  !68K! *dbra d0,b3
  !68K! *swap d0
  !68K! *dbra d0,b2
b4: !68K! *move.l d2,d0
b5: !68K! *subq.l #1,d0
  !68K! *bmi end
  !68K! *bra b7
b6: !68K! *swap d0
b7: !68K! *move.b -(a0),-(a1)
  !68K! *dbra d0,b7
  !68K! *swap d0
  !68K! *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
  !68K! *tst.l d0
  !68K! *ble y
  !68K! *cmp.l d2,d1
  !68K! *bge x
  !68K! *move.l d1,d3
  !68K! *add.l d0,d3
  !68K! *cmp.l d3,d2
  !68K! *bge x
  !68K! *neg.l d0
x:!68K! *jsr smoveblock
y:
end

systemstring(31)fn DATETIME
external {@16_1110} integerfn spec 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
  !68K! *BSR DATETIME;  !ad -> A0
  !68K! *MOVE.B #8,(A0);  !alter length
result=""
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)
  !68K! *BSR DATETIME
  !68K! *LEA 10(A0),A0;  *MOVE.B #5,(A0);  !adjust start & length
result=""
end

systemintegerfn cputime
  !68K! *jsr 16_1130
result=0
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

external {@16_1108} integerfn spec FCOMM(integer cn,string(255)s)
external {@16_110C} integerfn spec FCOMMW(integer cn,string(255) s,
               bytename buffer,integer size)
external {@16_1110} integerfn spec FCOMMR(integer c,string(255)p,
                               bytename b,integer max)
external {@16_35c4} short      USERNO
external {@16_3fa8} byte       LDTE,LSAP,RDTE,RSAP
external {@16_1100} routine    spec ETHERWRITE(integer port,bytename buf,integer size)
external {@16_1104} integerfn  spec ETHERREAD(integer port,bytename buf,integer max)
recordformat sf(integer ptr,lim,server,extra)
external {@16_35c6} record(sf)name curin
external {@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
  hi = (curin_lim+511)&(¬511)
  lo = hi-512
  curin_lim = hi
  curin_ptr = hi
  x = fcomm(M'U0'+curin_extra,tohdh(pos>>9))
  returnif pos&511=0;                 !No part-block =>
  x = fcommr(M'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(M'R0'+curout_extra,block,byteinteger(curout_ptr),512)
    curout_ptr = curout_ptr+pos&511
  finish
  x = fcomm(M'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)
      !68K! *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)
  !68K! *move.l size,d0
end

systemroutine close append;  !no longer required
  closeoutput
end

endoffile