!!Misc Imp Library
!
!%option "-low-nocheck-nodiag-noline"
!
!%systemintegerfn freestore
!  *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
!  %cycle
!    k = next symbol
!    %exit %if k > ' '
!    skip symbol
!  %repeat
!  sign = 0
!  %if k = '-' %start
!    sign = 1
!    skip symbol;  k = next symbol
!  %finish
!  %signal 4,1,k,"Non-numeric character to READ" %unless '0' <= k <= '9'
!  i = k-'0'
!  %cycle
!    skip symbol
!    k = next symbol
!    %exit %unless '0' <= k <= '9'
!    i = i*10-'0'+k
!  %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
!  x = openandshut(file)
!  %true
!%end
!
!%systemintegerfn filesize(%string(255)file)
!  %result = openandshut(file)
!%end

%routine 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