{  2/9/87  21:41   utils}

%include "sm:consts.inc"
%include "sm:formats.inc"

%externalstring(255)%fnspec date
%externalroutinespec delete(%string(255) s)
%externalpredicatespec exists(%string(63) s)
{!  If Vax.}
{%systemroutinespec gettim(%integername a)}
!

%recordformat linkf(%record(linkf)%name next,prev)
%recordformat listf(%record(linkf)%name head,tail)
%externalstring(255) eventloc
%conststring(11) master="master.com"
%routinespec message(%string(255) s,%string(15) mon)
%externalroutinespec rename(%string(255) old,new)
%conststring(12) tempmaster="amaster.com"
%externalrealarray tentothe(-38:38)= %c
  1@-38,1@-37,1@-36,1@-35,1@-34,1@-33,1@-32,1@-31,1@-30,
  1@-29,1@-28,1@-27,1@-26,1@-25,1@-24,1@-23,1@-22,1@-21,1@-20,
  1@-19,1@-18,1@-17,1@-16,1@-15,1@-14,1@-13,1@-12,1@-11,1@-10,
  1@-9,1@-8,1@-7,1@-6,1@-5,1@-4,1@-3,1@-2,1@-1,1,
  1@1,1@2,1@3,1@4,1@5,1@6,1@7,1@8,1@9,1@10,
  1@11,1@12,1@13,1@14,1@15,1@16,1@17,1@18,1@19,1@20,
  1@21,1@22,1@23,1@24,1@25,1@26,1@27,1@28,1@29,1@30,
  1@31,1@32,1@33,1@34,1@35,1@36,1@37,1@38
{!  If Vax.}
{%constinteger tracechan=7}
{%externalstring(255)%fnspec translate(%string(*)%name s)}
!
!  If APM.
%constinteger tracechan=1
!
%externalintegerarray twotothe(0:31)= %c
          1,          2,          4,          8,
      16_10,      16_20,      16_40,      16_80,
     16_100,     16_200,     16_400,     16_800,
    16_1000,    16_2000,    16_4000,    16_8000,
   16_10000,   16_20000,   16_40000,   16_80000,
  16_100000,  16_200000,  16_400000,  16_800000,
  16_1000000, 16_2000000, 16_4000000, 16_8000000,
 16_10000000,16_20000000,16_40000000,16_80000000

%constinteger maxname=127
%recordformat EDFILE(%integer START1,LIM1, {part 1}
                              START2,LIM2, {part 2}
                              LIM, {VMLIM}
                              LBEG,FP,CHANGE,FLAG,
                              LINE  {line number of current pos},
                              DIFF  {diff between LINE and ROW},
                     %byte    TOP  {top row of sub_window},
                              WIN  {floating top},
                              BOT  {bottom row of sub_window},
                              MIN  {minimum window size},
                              ROW  {last row position},
                              COL  {last col position},
             %string(maxname) NAME)
%externalroutinespec EDI(%record(edfile)%name main,sec,%string(255) message)
%externalroutinespec CONNECT EDFILE(%record(edfile)%name f)
%externalroutinespec DISCONNECT EDFILE(%record(edfile)%name f)

@16_117c %integerfn defname(%string(255)s,%record(dictf)%name d,%integer size)
@16_1180 %integerfn refname(%string(255)s,%record(dictf)%name d)
@16_1184 %routine transname(%integer tag,%string(255)%name s)
@16_3fb0 %record(dictf)comdict,fildict,extdict,sysdict

%externalroutine trace(%string(255) s)
%integer oldout
%owninteger first=yes
  %if first=yes %thenstart
    first=no
    open output(tracechan,"trace")
  %finish
  oldout=outstream
  select output(tracechan)
  write(instream,1); write(oldout, 3); print string(" ".s)
  newline
  select output(oldout)
%end

%routine phex(%integer n)
%integer i,j
  %for i=28,-4,0 %cycle
    j=(n>>i)&16_ff
    %if 0<=j<=9 %then j=j+'0' %else j=j+'a'-10
    space %if i=12
    print symbol(j)
  %repeat
%end

%externalroutine purge string(%string(*)%name a,%byteinteger char)
%integer i,j
  %return %if a=""
  j=0
  %for i=1,1,length(a) %cycle
    %unless charno(a,i)=char %start
      j=j+1
      charno(a,j)=charno(a,i)
    %finish
  %repeat
  length(a)=j
%end

%externalroutine lower(%string(*)%name s)
%integer i
  %return %if s=""
  charno(s,i)=lowercase(charno(s,i)) %for i=1,1,length(s)
%end

%externalroutine upper(%string(*)%name s)
%integer i
  %return %if s=""
  charno(s,i)=uppercase(charno(s,i)) %for i=1,1,length(s)
%end

%string(255)%fn translate command symbol(%string(255)s)
! Acquire the value of symbol S.  If not defined, return itself.
%integer t
  %result = "" %if s=""
  upper(s)
  t = refname(s,comdict); %result = s %if t=0
  t = integer(t); %result = s %if t=0
  transname(t,s)
  %result = s
%end

%externalpredicate belongs(%string(80) s,%record(line80listf)%name l)
%record(line80f)%name p
  %false %if l==nil
  p==l_head
  %while p##nil %cycle
    %true %if s=p_line
    p==p_next
  %repeat
  %false
%end

%externalroutine set up(%string(*)%name a,%string(31) lvar,var,
%string(255) errmess,%record(line80listf)%name values)
%string(255) x
  a=""
  %return %if lvar=""
{!  If Vax.}
{  upper(lvar)}
{  a=translate(lvar)}
!
!  If APM.
  a=translate command symbol(lvar)
!
  x=a
  lower(x); lower(lvar)
  a="" %and %return %if x=lvar
  %if values_head##nil %and errmess#"" %and %not belongs(x,values) %thenstart
    errmess="Inappropriate value from command variable ".lvar %if errmess=""
    message("Collecting ".var."=".a.snl." ".errmess,"stop")
  %finish
%end

!  This expects the default directory to have the standard form, i.e. to
!  have [ and ] for Vax or : for APMs.

%externalstring(255)%fn fix file(%string(255) f,%string(15) dir,%string(3) ext)
%string(255) w,x
  %result="" %if f=""
{!  If Vax.}
{  %if f->w.("]").f %then w=w."]" %else w=""}
{  %if w="" %then w=dir."]"}
!
!  If APM.
  %if f->w.(":").f %then w=w.":" %else w=""
  %if w="" %and dir#"" %and charno(dir,length(dir))#':' %then w=dir.":"
!
  x=ext %unless f->f.(".").x
  x=".".x %unless x=""
  %result=w.f.x
%end

%externalroutine message(%string(255) s,%string(15) mon)
%integer oldout
  oldout=outstream
  select output(0)
  lower(mon)
  newline
  print string(s)
  newline
  %monitor %if mon="mon"
  %stop %unless "stop"#mon#"mon"
  select output(oldout)
%end

%externalroutine get line(%string(*)%name a)
%integer j
  skip symbol %while next symbol=sp
  a=""
  %while next symbol#nl %cycle
    read symbol(j)
    a=a.tostring(j)
  %repeat
%end

%externalroutine listout(%record(*)%name b,%string(255) s)
%integer n,oldout
%record(listf)%name a
  a==b
  oldout=outstream
  select output(0)
  print string(s)
  newline
  n=addr(a)
  phex(n)
  spaces(2)
  n=addr(a_head)
  phex(n)
  space
  n=addr(a_tail)
  phex(n)
  newline
  select output(oldout)
%end

%routine prepare name(%string(*)%name file)
{!  If Vax.}
{%string(31) dir,y}
{  dir="" %unless file->dir.("]").file}
{  y="" %unless file->file.(".").y}
{  %return %if file=""}
{  y="lay" %if y=""}
{  file=file.".".y}
{  file=dir."]".file %unless dir=""}
!
%end

%externalroutine memed(%string(255) s)
%string(255) outname,z
%record(edfile) main,sec
  outname="" %unless s->s.("/").outname
  select input(0); select output(0)
  main=0; sec=0
  sec_name="" %unless s->s.(",").sec_name
{!  IF Vax.}
{  sec_name=fix file(sec_name,"","lay")}
{  main_name=fix file(s,"","lay")}
{  %if outname="" %then outname=main_name %else outname=fix file(outname,"","lay")
!
!  If APM.
  sec_name=fix file(sec_name,"","")
  main_name=fix file(s,"","")
  %if outname="" %then outname=main_name %else outname=fix file(outname,"","")
  message("No name for document.","stop") %if outname=""
  main_flag=16_8000
  main_line=0
  main_name="" %unless main_name="" %or exists(main_name)
  main_start1=0
  connect edfile(main)
  message("Cannot connect ".main_name." for editing","mon") %if main_flag#0
  %if main_name#"" %then z="Editing ".main_name." " %else z=""
  main_change=16_7FFFFFFF; main_lim1=main_start1
!  Set fp to start2 to begin at top of file, to lim2 to begin at bottom of file.
  main_fp=main_start2
  %if sec_name#"" %thenstart
    connect edfile(sec)
    message("Cannot connect secondary file ".sec_name,"mon") %c
    %if sec_flag#0
    %if z#"" %then z=z." with " %else z="Editing "
    z=z.sec_name
  %finish
  z=z." to create ".outname %unless main_name=""=sec_name %c
  %or main_name=outname
  edi(main,sec,z)
!
!  MAIN_FLAG is negative if edit abandoned
!  MAIN_CHANGE is untouched (neg or inf) if no changes
  %if main_flag < 0 %or main_change=16_7FFFFFFF %thenstart
    %if main_flag<0 %then message("Editing ".main_name." abandoned","stop") %c
    %else message(" File ".main_name." unchanged","")
    main_change=-1
  %finish
  main_name=outname
  disconnect edfile(main)
  %if main_change>=0 %start;  !  file written
    print string("Document created in ".main_name)
    newline
  %finish
  %if sec_start1#0 %start
    sec_change=-1
    disconnect edfile(sec)
  %finish
%end

%externalroutine decincr(%string(*)%name a)
%integer i,j
  a="1" %and %return %if a=""
  j=length(a)
  %for i=j,-1,1 %cycle
    charno(a,i)=charno(a,i)+1
    %exit %if charno(a,i)<='9'
    charno(a,i)='0'
    a="1".a %and %exit %if i=1
  %repeat
%end

{!  If Vax.}
{%externalstring(255)%fn seqno}
{%integer a}
{%ownstring(5) b=""}
{%byteinteger c}
{%integer j,k,l}
{%string(5) s="     "}
{  a=0}
{  %cycle}
{    gettim(a)}
{    k<-a>>13}
{    %for j=5,-1,1 %cycle}
{      l=k//36}
{      c=k-36*l}
{      k=l}
{      %if c<10 %then c=c+'0' %else c=c+'a'-10}
{      charno(s,j)=c}
{    %repeat}
{    length(s)=5}
{  %repeat %until s#b}
{  b=s}
{  %result=s}
{%end}
!
!  If APM.
%routine deal with trap(%string(80)%name seqno)
  %on %event 9 %start
    message("Recursive signal 9","mon")
  %finish
  decincr(seqno)
  print string("seqno=".seqno)
  newlines(2)
  close output
  select output(0)
  close input
  select input(0)
  delete(master) %if exists(master)
  rename(tempmaster,master)
%end

%externalstring(255)%fn seqno
%integer j
%string(80) seqno,z
  %on %event 9,15 %start
    deal with trap(seqno)
    %result=seqno
  %finish
  open output(1,tempmaster); select output(1)
  seqno="0000"
  %if exists(master) %thenstart
    open input(1,master); select input(1)
    %cycle
      skip symbol %while next symbol=sp
      z=""
      %cycle
        read symbol(j)
        %exit %if j=nl
        z=z.tostring(j)
      %repeat
      print string(z) %and newline %unless z->("seqno=").seqno %or z=""
    %repeat
  %finish
  %signal %event 15
%end
!

%externalstring(255)%fn tos(%byteintegerarray(1)%name b, %c
  %integer max,%integername p)
%byteintegerarray c(0:255)
%byteintegername i
  i==c(0)
  i=0
  p=p+1 %while p<max %and (b(p)=' ' %or b(p)=nl)
  message("Start of string out of reach","mon") %unless p<max
  message("Symbol '".tostring(b(p))."' instead of '""'", %c
  "stop") %unless b(p)='"'
  p=p+1    ;!  skip '"' at start of string.
  i=1
  %while p<max %and b(p)#'"' %cycle
  c(i)=b(p)
  i=i+1
  p=p+1
  i=i-1 %and %c
  message("String '".string(addr(i))."' too long","stop") %if i>255
  %repeat
  message("End of string out of reach","stop") %unless p<max
  p=p+1    ;!  skip '"' at end of string.
  c(0)=i-1
  %result=string(addr(c(0)))
%end

%externalstring(255)%fn itod(%integer l)
%string(255) s
%integer i,m,sign
  s=""
  %if l<0 %then sign='-' %and l=-l %else sign=0
  %for i=255,-1,1 %cycle
  m=l//10
  s=tostring(l-10*m+'0').s
  %exit %if m=0
  l=m
  %repeat
  %result="-".s %if sign='-'
  %result=s
%end

%externalstring(255)%fn itoh(%integer l)
%string(255) s
%integer i,j
  s=""
  %for i=255,-1,1 %cycle
  j=l&16_f
  %if j<=9 %then j=j+'0' %else j=j-10+'a'
  s=tostring(j).s
  l=l>>4
  %exit %if l=0
  %repeat
  %result=s
%end

%externalintegerfn toih(%byteintegerarray(1)%name b, %c
  %integer max,%integername p)
%ownbyteintegerarray hex(0:255)=no(48),0,1,2,3,4,5,6,7,8,9,no(7),
 10,11,12,13,14,15,no(185)
%integer l
  p=p+1 %while p<max %and (b(p)=' ' %or b(p)=nl)
  message("Number out of reach","stop") %unless p<max
  message("Non-hex '".tostring(b(p))."' instead of digit", %c
  "stop") %if hex(b(p))=no
  l=hex(b(p)); p=p+1
  %while p<max %and hex(b(p))#no %cycle
  l=l<<4+hex(b(p))
  p=p+1
  %repeat
  %result=l
%end

%externalintegerfn htoi(%string(255) s)
%integer i
%byteintegerarray b(0:255)
  %result=0 %if s=""
  b(i)=charno(s,i) %for i=1,1,length(s)
  i=1
  %result=toih(b,b(0)+1,i)
%end

%externalintegerfn toid(%byteintegerarray(1)%name b, %c
%integer max,%integername p)
%ownbyteintegerarray dec(0:255)=no(48),0,1,2,3,4,5,6,7,8,9,no(198)
%integer j,l
  p=p+1 %while p<max %and (b(p)=' ' %or b(p)=nl)
  %result=0 %if p=max
  j=0
  j='-' %and p=p+1 %if b(p)='-'
  %result=0 %if p=max
  message("Non-digit '".tostring(b(p))."' at start of number", %c
  "stop") %if dec(b(p))=no
  l=dec(b(p)); p=p+1
  %while p<max %and dec(b(p))#no %cycle
  l=10*l+dec(b(p))
  p=p+1
  %repeat
  %if j='-' %then %result=-l %else %result=l
%end

%externalintegerfn dtoi(%string(255) s)
%integer i
%byteintegerarray b(0:255)
  %result=0 %if s=""
  b(i)=charno(s,i) %for i=1,1,length(s)
  i=1
  %result=toid(b,b(0)+1,i)
%end

%externalintegerfn tois(%byteintegerarray(1)%name b, %c
%integer max,rad,%integername p)
%integer j,val
  %if '0'<=b(p)<='9' %then j=b(p)-'0' %else j=b(p)-'a'+10
  message(tostring(b(p))." is not a digit in radix ".itod(rad), %c
  "stop") %unless 0<=j<rad
  %while p<max %cycle
    %if '0'<=b(p)<='9' %then j=b(p)-'0' %else j=b(p)-'a'+10
    %exit %unless 0<=j<rad
    val=rad*val+j
    p=p+1
  %repeat
  %result=val
%end

!  If APM.
%externalintegerfn sm stoi(%string(255) s,%string(2) radix)
%byteintegerarray b(0:255)
%integer i,rad
  rad=dtoi(radix)
  b(i)=charno(s,i) %for i=1,1,length(s)
  i=1
  %result=tois(b,b(0)+1,rad,i)
%end
!

%externalstring(255)%fn tow(%byteintegerarray(1)%name b, %c
  %integer max,%integername p)
%integer i
%byteintegerarray c(0:255)
  string(addr(c(0)))=""
  p=p+1 %while p<=max %and (b(p)=' ' %or b(p)=nl)
  i=0
  i=i+1 %and c(i)=b(p) %and p=p+1 %while p<=max %c
    %and i<255 %and 'a'<=b(p)!32<='z'
  c(0)=i
  %result=string(addr(c(0)))
%end

%externalrealfn tor(%byteintegerarray(1)%name b,  %c
%integer max,%integername p)
%integer sign,exp,esign,l,presenti,presentf,presente
%real int,fr
  presenti=no; presentf=no; presente=no
  p=p+1 %while p<max %and (b(p)=' ' %or b(p)=nl)
  %if p<max %and (b(p)='+' %or b(p)='-') %thenstart
    %if b(p)='+' %then sign=1 %else sign=-1
    p=p+1
    p=p+1 %while p<max %and b(p)=' '
  %finishelse sign=0
  %if p<max %and ('0'<=b(p)<='9') %thenstart
    presenti=yes
    int=b(p)-'0'
    p=p+1
    int=10*int+b(p)-'0' %and p=p+1 %while p<max %and '0'<=b(p)<='9'
    p=p+1 %while p<max %and b(p)=' '
  %finishelse int=0
  %if p<max %and b(p)='.' %thenstart
    p=p+1
    p=p+1 %while p<max %and b(p)=' '
    %if p<max %and '0'<=b(p)<='9' %thenstart
      presentf=yes
      fr=b(p)-'0'
      p=p+1
      l=1
      fr=10*fr+b(p)-'0' %and l=l+1 %and p=p+1 %c
      %while p<max %and '0'<=b(p)<='9'
      fr=fr*tentothe(-l)
      p=p+1 %while p<max %and b(p)=' '
    %finishelse message("Incomplete fractional part","stop")
  %finishelse fr=0
  %if p<max %and b(p)='@' %thenstart
    p=p+1
    p=p+1 %while b(p)=' '
    %if p<max %and (b(p)='+' %or b(p)='-') %thenstart
      %if b(p)='+' %then esign=1 %else esign=-1
      p=p+1
      p=p+1 %while p<max %and b(p)=' '
    %finishelse esign=0
    %if p<max %and '0'<=b(p)<='9' %thenstart
      presente=yes
      exp=b(p)-'0'
      p=p+1
      exp=10*exp+b(p)-'0' %and p=p+1 %while p<max %and '0'<=b(p)<='9'
    %finishelse message("Incomplete exponent","stop")
  %finishelse esign=0 %and exp=0
  message("Incomplete number","stop") %if presenti=no=presentf %c
  %and presente=no
  %if presenti=no=presentf %then int=1 %else int=int+fr
  %if presente=yes %thenstart
    exp=-exp %if esign=-1
    int=int*tentothe(exp)
  %finish
  int=-int %if sign=-1
  %result=int
%end

%externalstring(255)%fn pad(%string(255) s,%integer leng,pad)
%byteintegerarray b(0:255)
%integer i,j
  %if leng<0 %then j=-leng %else j=leng
  %result=s %if length(s)>=j
  %if leng<0 %thenstart
  b(i)=charno(s,i) %for i=1,1,length(s)
  %for i=length(s)+1,1,j %cycle
   b(i)=pad
  %repeat
  %finishelsestart
  j=leng-length(s)
  %for i=1,1,j %cycle
   b(i)=pad
  %repeat
  b(i+j)=charno(s,i) %for i=1,1,length(s)
  %finish
  b(0)=j
  %result=string(addr(b(0)))
%end

%externalstring(255)%fn rtod(%real x,%integer intgr,frac)
%integer i,j
%string(1) sign
%string(15) f
  %if x<0 %then sign="-" %and x=-x %and intgr=intgr+1 %else sign=""
  i=intpt(x)
  x=x-i
  x=x*tentothe(frac)
  j=int(x)
  f=itod(j)
  %if length(f)>frac %thenstart
    i=i+1
    j=0
  %finish
  %result=pad(sign.itod(i),intgr,' ').".".pad(itod(j),frac,'0')
%end

%externalstring(255)%fn rtofl(%real x,%integer p)
%integer exp,i,j,k
%real vaxbug
%string(1) sign
%string(63) s
  exp=0
  %if x<0 %then x=-x %and sign="-" %else sign=""
  %if x>=1 %thenstart
  %for exp=0,1,74 %cycle
   %exit %if tentothe(exp)<=x<tentothe(exp+1)
  %repeat
  x=x/tentothe(exp)
  %finishelsestart
  exp=0
  exp=exp-1 %and x=10*x %while exp<74 %and x<1
  %finish
  i=intpt(x)
  j=int((x-i)*tentothe(p))
  vaxbug=tentothe(p)
  j=j-int(vaxbug) %and i=i+1 %if j>=vaxbug
  %if i>=10 %thenstart
  k=i//10
  j=int((j+i-10*k)/10)
  i=k
  s=itod(j)
  exp=exp+1
  %finish
  s=itod(j)
  %result=sign.itod(i).".".pad(s,p,'0')."@".itod(exp)
%end

%externalstring(255)%fn ddate
%string(31) dd,u,x,y,z
%integer i
%conststring(11)%array month(1:12)="January","February","March","April","May",
 "June","July","August","September","October","November","December"
{!  If Vax.}
{%conststring(4)%array mth(1:12)="jan","feb","mar","apr","may","jun",}
{ "jul","aug","sep","oct","nov","dec"}
{  dd=date}
{  x="" %while dd->(" ").dd}
{  dd->x.("-").y}
{  y->y.("-").z}
{  lower(y)}
{  %for i=1,1,12 %cycle}
{    %exit %if y=mth(i)}
{  %repeat}
!
!  If APM.
  dd=date
  x="" %while dd->(" ").dd
  dd->x.("/").y
  y->y.("/").z
  z="19".z %if length(z)=2
  i=dtoi(y)
!
  %if x->u.("0").x %thenstart
    x=u."0".x %unless u=""
  %finish
  %if x="1" %or x="21" %or x="31" %then x=x."st" %else %c
  %if x="2" %or x="22" %then x=x."nd" %else %c
  %if x="3" %or x="23" %then x=x."rd" %else x=x."th"
  dd=x." ".month(i)." ".z
  %result=dd
%end

%externalrecord(*)%map newlisthead
%record(listf) listpattern
%record(listf)%name p
  p==new(listpattern)
  p_head==nil; p_tail==nil
  %result==p
%end

%externalroutine prefix cell(%record(*)%name a,b)
%record(linkf)%name r
%record(listf)%name l
  r==a; l==b
  %return %if r==nil %or l==nil
  %if l_head==nil %thenstart
    l_head==r; l_tail==r
    %return
  %finish
  r_next==l_head; r_prev==nil
  l_head_prev==r
  l_head==r
%end

%routine print cell(%integer from,to,%record(*)%name a,%string(255) s)
%integer i,j
  print string(s)
  newline
  from=4*int(from//4); to=4*int(to//4)
  j=0
  %for i=from,4,to %cycle
    spaces(2)
    phex(integer(addr(a)+i))
    j=j+11
    j=0 %and newline %if j>69
  %repeat
  newline
%end

%externalroutine append cell(%record(*)%name a,b)
%record(linkf)%name r
%record(listf)%name l
  r==a; l==b
  %return %if r==nil
  message("Nill list in Append Cell.","mon") %if l==nil
  %if l_head==nil %thenstart
    l_head==r; l_tail==r
    %return
  %finish
  l_tail_next==r
  r_next==nil; r_prev==l_tail
  l_tail==r
%end

%externalroutine insert cell after(%record(*)%name a,b,c)
%record(linkf)%name p,q
%record(listf)%name l
  p==b; q==a; l==c
  %return %if q==nil
  %if l_tail==nil %thenstart
    message("Cannot insert after non-nil location in an empty list.","mon") %c
    %if p##nil
    l_head==q; l_tail==q
  %finishelse %if p==nil %thenstart
    q_prev==l_tail; q_next==nil
    l_tail_next==q; l_tail==q
  %finishelse %if p_next==nil %thenstart
    q_next==nil; q_prev==p
    p_next==q; l_tail==q
  %finishelsestart
    q_next==p_next; q_prev==p
    p_next_prev==q; p_next==q
  %finish
%end

%externalroutine insert cell before(%record(*)%name a,b,c)
%record(linkf)%name p,q
%record(listf)%name l
  p==b; q==a; l==c
  %return %if q==nil
  %if l_head==nil %thenstart
    message("Cannot insert before non-nil location in an empty list.","mon") %c
    %if p##nil
    l_head==q; l_tail==q
  %finishelse %if p==nil %thenstart
    q_prev==l_tail; q_next==nil
    l_tail_next==q; l_tail==q
  %finishelse %if p_prev==nil %thenstart
    q_next==l_head; q_prev==nil
    l_head_prev==q; l_head==q
  %finishelsestart
    q_next==p; q_prev==p_prev
    p_prev_next==q; p_prev==q
  %finish
%end

%externalintegerfn list length(%record(*)%name a)
%record(listf)%name l
%integer i
%record(linkf)%name p
  l==a
  %result=0 %if l_head==nil
  i=0
  p==l_head
  i=i+1 %and p==p_next %while p##nil
  %result=i
%end

%externalroutine excise cell(%record(*)%name a,b)
%record(linkf)%name q
%record(listf)%name l
  q==a; l==b
  %return %if l==nil %or q==nil
  %if q_prev==nil %thenstart
    l_head==q_next
    %if l_head==nil %then l_tail==nil %else l_head_prev==nil
  %finishelse %if q_next==nil %thenstart
    l_tail==q_prev
    %if l_tail==nil %then l_head==nil %else l_tail_next==nil
  %finishelsestart
    q_next_prev==q_prev
    q_prev_next==q_next
  %finish
  q_next==nil; q_prev==nil
  %return
%end

%externalroutine concat lists(%record(*)%name a,b)
%record(listf)%name l,m
  l==a; m==b
  %return %if m_head==nil
  %if l_head==nil %thenstart
    l=m
    %return
  %finish
  l_tail_next==m_head
  m_head_prev==l_tail
  l_tail==m_tail
%end

%externalroutine delete list(%record(*)%name a)
%record(linkf)%name b,c
%record(listf)%name l
  l==a
  b==l_head
  %while b##nil %cycle
    c==b; b==b_next
    dispose(c)
  %repeat
  l_head==nil; l_tail==nil
%end



%endoffile