! prep options
!  n - nsi
!  r - ring
!  k - kent
!  x - transport service interface
!  g - more general ftp
! if k is not set, ercc format is assumed
#options
#if ~(n!r!x) ! ~(e!g) ! (n&r) ! (n&x) ! (r&x) ! (e&g)
  #report must specify one of (n,r,x) and one of (e,g)
  #abort
#fi

#if r
  #report Preparing ring version
#fi
#if n
  #report Preparing NSI version
#fi
#if x
  #report Preparing transport service interface version
#fi
!
!
!     *** ftpd1s
!
!     *** Ftp package to send deimos files
!
!     ***   Stream 1 is the file to be sent. It prompts for
!           the remote file name.
!
!     ***   INT A will cause the file to abort.
!
!     Sequence of messages
!
!     sft   ->
!           <-   rpos/rneg
!     Go    ->
!     ss(0) ->
!     Data  ->
!     ....  ->
!     Es    ->
!           <-  Er(0)
!     Stop  ->
!           <-  Stopack
!

%control 1
#if k
%include "deimosperm"
#else
%include "b_deimosspecs"
#fi

%conststring (9) vsn = "FTP..4b "

%begin
#if k
%externalstring (255) %fnspec cli string
#else
%externalstring (255) %fnspec cli param
#fi

#datestring
#timestring
%recordformat qf(%record(qf)%name q);   !not used
#if n
     %recordformat lev3f(%byteinteger fn,sufl,st,ss, (%byteinteger flag,uflag, %c
           (%byteintegerarray data(0:237) %or %string(200) dst) %or %c
           (%byteinteger sn,dn,dt,ds,mflg,ufl,%string(200) s)))
#fi
#if r
#if ~k
      %recordformat lev3f(%integer st,ds,rc,tc,uflag,     %c
        (%byteintegerarray data(0:241) %or %c
        %string (200) dst))
#else
      %recordformat lev3f(%integer st,ds,rc,tc,     %c
        (%byteintegerarray data(0:241) %or %c
        %string (200) dst))
#fi
#fi
#if x
      %recordformat lev3f(%string(7) dummy,    %c
         (%byteintegerarray data(0:241) %or %string (200) dst) %orc
         %byteintegerarray params(0:250) )
#fi


%recordformat mef(%record(mef)%name link,%byteinteger len,type, %c
      %record(lev3f) lev3)

#if n
      %recordformat pef(%byteinteger ser,reply,fn,port, %c
            (%record(mef)%name mes, %byteinteger len,s1 %or %c
            %byteinteger facility,flag,node,term))
#fi

#if r
      %recordformat pef(%byteinteger ser,reply,fn,port, %c
            (%record(mef)%name mes, %byteinteger len,s1 %or %c
            %byteinteger node, flag, term, facility))
#fi

#if x
      %recordformat pef(%byteinteger ser,reply,fn,s1,   %c
             (%record (mef) %name mes, %byteinteger gate port, task port) %orc
             %string (3) facility)
#fi

%ownrecord(pef) p
%ownrecord(lev3f) %name lev3

%recordformat parmf(%integer type, int, %string (255) s)
%record (parmf) par

%owninteger total param = 0, this param = 0, split pt = 0, curr len, last ind
%owninteger new pt = 0
%owninteger port,ksent,csent,state,clock,i,cc,tim,tim2
%owninteger direction = 0
%owninteger fails = 0, quiet = 0
#if k
!globals to handle 'real' eof - even for binary files.
%owninteger neot,holdc;  !number of real eot chars to be sent
#fi
!
!     constants
!
%constinteger eot=4
!
#if ~x
!           gate to task functions
!
%constinteger incomming call=2
%constinteger input here=3
%constinteger output txd=4
%constinteger call closed=5
%constinteger call aborted=6
%constinteger open reply a=7
%constinteger open reply b=8
%constinteger open message=9
!
!           task to gate functions
!
%constinteger enable facility=1
%constinteger disable facility=2
%constinteger call reply=3
%constinteger enable input=4
%constinteger put output=5
%constinteger close call=6
%constinteger abort call=7
%constinteger open call=8
%constinteger message reply=10
#else
%include "b_ygatecalls"
#fi
!
!           service numbers
!
#if x
%constinteger gate ser = 24
#else
%constinteger gate ser=16
#fi
%constinteger buffer manager=17
!
%constinteger request buffer=0
%constinteger release buffer=1
!
!           general variables
!
%owninteger give up = 5
!
!     strings and things
!
%constrecord (*) %name null==0

#if k
%ownstring(16) bpass="...."
#else
%ownstring(16) bpass="XXXX"
#fi
%ownstring(63) us = ""
%ownstring(33) fname=""
%ownstring (63) cli, add, cli2, qual, call frig
%owninteger fac ad = 0
%ownbyteintegerarray sfta(0:200) = %c
     18, 4, 7, 0, 34, 1, 0, 2, 34, 0, 1,
     1, 34, 0, 3, 3, 34, 0, x'80', 0(*)
!
%ownbyteintegerarray ss0(0:3) = 3, 0, 64, 0
!
!     states
!
%constinteger send sft=1
%constinteger send ss=2
%constinteger send data=3
%constinteger await data=4
%constinteger send es = 5
%constinteger wait er = 6
%constinteger send stop = 7
%constinteger stop sent = 8
%constinteger closing=9
%constinteger aborting=10
%constinteger wait rep b=11
%constinteger connecting = 12
!
!       ftp command values
!
%constinteger stop = 0, go = 1, rpos = 2, rneg = 3, sft = 4, stopack = 5
%constinteger ss = x'40', es = x'43', rr = x'44', qr = x'46', er = x'47'
!
      %ownbytearray stop m(0:6) = 6, stop, 1, x'0f', 34, x'20', 0

%owninteger binary = 0
%owninteger mon = 0

#if n
      %constinteger header len = 6;     ! nsi
#fi
#if r
#if ~k
      %constinteger header len = 2;     ! ring
#else
      %constinteger header len = 0
#fi
#fi
#if x
     %constinteger header len = 0
#fi

      %on 9 %start;   ! disc full etc.
         selectoutput(0)
         printstring("Disc/directory is full!
")
         -> abo
      %finish

!
!************************************************************************
!
!        *****    Routines start here
!
!************************************************************************
!
!     string to integer
!
      %integer %fn stoi(%string (*)%name s)
         %integer x,y,sum
         sum = 0
         %result = 0 %if s = ""
         %cycle x = 1, 1, length(s)
            sum = sum*10+(charno(s, x)-'0')
         %repeat
         %result = sum
      %end
!
!     RELEASE BLOCK
!
%ROUTINE FREE BUFFER
#if k
      P_SER=BUFFER MANAGER; P_REPLY=OWN ID
#else
      P_SER=BUFFER MANAGER; P_REPLY=id
#fi
      P_FN=RELEASE BUFFER
      PON(P)
%END
!
!     ASK FOR BUFFER
!
%ROUTINE ASK FOR BUFFER
#if k
      P_SER=BUFFER MANAGER; P_REPLY=OWN ID
#else
      P_SER=BUFFER MANAGER; P_REPLY=id
#fi
      P_FN=REQUEST BUFFER
#if x
      P_GATE PORT=0;    !long buffer
#else
      P_LEN=0
#fi
      PON(P)
%END

      %routine time it
         %integer x, c
         %if ksent = 0 %then %return
                     printstring("In"); write((tim2-tim)//60, 2)
                     printstring(" secs   =")
                     x = (tim2-tim)//6;    ! 1/10 of a sec
                     c = ksent
                     %while c > 64 %cycle; c=c//2; x=x//2;%repeat
                     x = (c*512)//x
                     write(x*20, 2); printstring(" bytes/sec
")
      %end

!
!        dump mes
!
      %routine dump mes(%record (mef) %name mes)
      %integer i, x
      %record (lev3f) %name lev3

         lev3 == p_mes_lev3
         printstring(" Gate:")
         x = mes_len-header len
         write(x, 1); printstring("> ")
         %if x<1 %then x = 1
         %cycle i = 0, 1, x-1
            write(lev3_data(i), 3); newline %if i&15=15
         %repeat
         newline
      %end
!
!     TO GATE
!
%routine to gate(%integer fn)
#if k
      p_ser=gate ser; p_reply=own id
#else
      p_ser=gate ser; p_reply=id
#fi
      %if mon < 0 %and fn = put output %start
         printstring("To")
         dump mes(p_mes)
      %finish
#if x
      p_task port = 1
      p_gate port = port
#fi

      p_fn=fn; pon(p)
%end
!
!     dump chars
!
%routine dump chars
      printstring("Chars")
      %if direction = 0 %then printstring(" sent=") %else %c
      printstring(" rec'd=")
      write(ksent,0); printstring("K+")
      write(csent,0); newline
%end
!
!     dump status
!
%routine dump status
      %conststring(20)%array ss(0:12)= %c
      "Not used !!", "send sft", "send ss", "send data", "await data",
      "send es", "wait er", "send stop", "stop sent", "closing", "aborting",
      "wait rep b", "connecting"
      printstring("State :"); write(state,0)
      %if state>0 %and state<=12 %then space %and printstring(ss(state))
      newline
      tim2 = time
      dump chars
      time it
%end
!
!    ***  add string
!
!   add the string s, into the array a, in ftp  parameter format
!
%routine add string(%integer param, %string (*) %name s, %bytearrayname a)
      %integer i, x
      x = a(0)+1
      a(x) = param
      a(x+1) = x'32';                   ! string param, op = EQ
      string(addr(a(x+2))) = s;         ! add in string
      a(0) = x+2+length(s)
%end
!
!     read string
!
%routine read string(%string (*) %name s)
      %integer i
         s = ""
         %cycle
               readsymbol(i)
               %exit %if i=nl
               s=s.tostring(i)
         %repeat
%end
!
!     fault
!
%routine fault(%string(255) s)
      %integer i, n
      printstring("Fault : ")
      n=9
      %cycle i = 1, 1, length(s)
         printsymbol(charno(s, i))
         n=n+1
         newline %and n = 1 %if n = 72
      %repeat
      newline
      dump status
%end
!
!   tidy and quit
!
%routine tidyup
      clock=-1
%end
!
!     connect
!
%routine do connect
#if ~x
      %integer node, term
      %string (15) ns, ts, fs
#if k
      node = 0; term = 15
#else
      node = 72; term = 9;   !fe1
#fi
      %if add -> ts.("N").ns %start
         %if ns -> ns.("T").ts %start
            %if ts -> ts.(".F").fs %start
               fac ad = stoi(fs)
            %finish %else fac ad = 0
            node = stoi(ns); term = stoi(ts)
            -> ok
         %finish
         printstring("Address:"); printstring(add); printstring(" not understood
")
         %stop
      %finish
ok:
#fi
      %if cc=give up %or int = 'S'  %thenstart
         printstring("I give up!")
         newline
         tidyup
      %finishelsestart
        printstring("Connecting to ")
#if k
        %if add # "" %then printstring(add) %else printstring("emas")
#else
        %if add # "" %then printstring(add) %else printstring("2972 - fe1")
#fi
        newline
#if n
      p_port = 1; p_facility = 16
      p_flag = x'48'
      p_node = node
      p_term = term; to gate(open call)
      state = connecting
#fi

#if r

 #if k
      !use kent 16 bit facility number
      p_port = 1; p_facility = 255
      p_flag = fac ad; p_node = 16;   !2 bytes of facility code
 #else
      p_port = 1; p_facility = 16
      %if fac ad # 0 %then p_flag = x'80'!fac ad %else p_flag = 0
      p_node = node
 #fi
      p_term = term; to gate(open call)
      state = connecting
#fi

#if x
        state=connecting
        ask for buffer
#fi
        cc=cc+1
      %finish
%end
!
!
!        signal dot
!
      %routine signal dot
               csent=csent-1024; ksent=ksent+1
               %if quiet = 0 %start
               printsymbol('.')
#if k
               %if (ksent//50)*50=ksent %then newline %else printsymbol(k'100000')
#else
               %if (ksent//50)*50=ksent %then newline %else terminate
#fi
               %finish
      %end
!
!     ***   Handle Buffer
!
#if x
%routine set ts param(%record (mef) b, %string (63) s)
!pack ts parameter string into the buffer
%integer l
   l=p_mes_len
   string(addr(p_mes_lev3_params(l)))=s
   p_mes_len=l+length(s)+1
%end
#fi

#if x
      %routine print hex(%integer n)
         %ownbytearray hd(0:15) = '0', '1', '2', '3', '4', '5','6','7',
            '8','9','A','B','C','D','E','F'

         space
         printsymbol(hd(n>>4&15))
         printsymbol(hd(n&15))
      %end
#fi

#if k
%routine getchar(%integername c)
!-------------------------------
   %on %event 9 %start
      neot=-1
      c=-1;   %return
   %finish
   %if neot>0 %then neot=neot-1 %and c=eot %and %return

   %if neot=0 %then neot=-1 %and c=holdc %and %return

   readsymbol(c)
   %if c=eot %start;  !find how many eots, set neot to that minus 1
      %while c=eot %cycle
         neot=neot+1
         readsymbol(c)
      %repeat
      holdc=c
      c=eot
   %finish

%end
#fi

%routine handle buffer
      %string (63) p1, p2, tadd
      %string(3) d
      %integer i,j,more,type,k,n,x,pos
      %record (lev3f) %name lev3
      %switch sw(0:connecting)

      %on 9 %start;       ! eot
         i = i-1; more = 0
         -> do eof
      %finish

      %if fails # 0 %then free buffer %and %return
      lev3==p_mes_lev3
      %if state<1 %or state>connecting %then fault("Illeg buf state") %andreturn
      ->sw(state)
!
sw(0):
         %return
!
sw(send sft):
         add string(x'42', us, sfta)
         %if direction = 0 %and fname -> (".").p1 %start;    ! device type
           add string(x'50', p1, sfta)
           sfta(13) = x'40'; sfta(14) = 1
         %else
            add string(x'40', fname, sfta)
         %finish
         add string(x'44', bpass, sfta)
#if e
         %if direction = 1 %then sfta(25) = x'80' %and sfta(26) = 2
#else
         %if direction = 1 %start
            sfta(13) = x'80'; sfta(14) = 2
         %else
            x = sfta(0)+1;                 ! add file size (integer param)
            sfta(x) = x'60';               ! file size
            sfta(x+1) = x'22';             ! type:integer, "="
            sfta(x+2) = 0;                 ! high order
            sfta(x+3) = 20;                ! try 20kb for now
            sfta(0) = x+3
            sfta(2) = sfta(2)+1;        ! extra param now
         %finish
#fi
         lev3_dst=string(addr(sfta(0)))
         p_mes_len = sfta(0)+1+header len
         length(lev3_dst) = length(lev3_dst)!128;  ! add in end-of-record marker
#if ~x
         p_port=port
#if n
         lev3_uflag = 5
#else
#if ~k
         lev3_uflag = x'0100'
#fi
#fi
#else
         p_s1=0
#fi
         to gate(put output)
         printstring("Sending SFT  "); terminate
         %return
!
!
sw(send ss):                                  ! send ss(0)
         printstring("Sending ss(0)
")
         tim = time
         type = ss
         state = send data
send short:
         lev3_data(0) = 0
         lev3_data(1) = type; lev3_data(2) = 0
#if ~x
         p_port = port
#else
         p_s1=0
#fi
         p_mes_len = 3+header len
         to gate(put output)
         %return


!
sw(send data):   more=1;                        !send block of data
         k = 0
#if k
         %cycle x = 1, 1, 4
#else
         %cycle x = 1, 1, 2;  !temp frig for John
#fi
            pos = k; k = k+1
            %if x = 4 %then n = 41 %else n = 63
            %cycle i=1,1,n
#if k
               getchar(j)
               %if j<0 %then i=i-1 %and more=0 %and %exit
#else
               readsymbol(j)
               %if j=eot %and binary = 0 %then i = i-1 %and more=0 %andexit
#fi
               lev3_data(k)=j; k = k+1
               csent=csent+1
               %if csent=1024 %start
                  signal dot
               %finish
            %repeat
do eof:
            lev3_data(pos)=i!128;      ! + record marker
            %exit %if more = 0
         %repeat
#if ~x
         p_port=port
#if ~k
         lev3_uflag=5
#fi
#else
         p_s1=0
#fi
         p_mes_len=k+header len
         %if k=1 %and more=0 %then ->swses
         to gate(put output)
         %if more=0 %thenstart
            state=send es
         %finish
         %return
!
swses:
sw(send es):
      tim2 = time
      printstring("Sending es
")
      state = wait er
      type = es
      -> send short
!
sw(send stop):
      state = stop sent
      lev3_dst = string(addr(stop m(0)))
      lev3_data(0) = lev3_data(0)!128;       ! len byte of lev3_dst
      p_s1 = 0
      p_mes_len = 7+header len
      to gate(put output)
      %return

#if x
sw(connecting):
         p_mes_len=0;  !set up transport service parameters
         tadd = add
         %if qual = "" %then Qual = "W=4/4"
         set ts param(p_mes, add.".FTP")
         set ts param(p_mes, call frig)
         set ts param(p_mes, qual)
         set ts param(p_mes, "Deimos ftp")
         port=0;  !value not known yet
         p_s1 = 0
         %if mon < 0 %start
            printstring("Con: To Gate:"); write(p_mes_len, 1); printsymbol('>')
            %cycle i = 0, 1, p_mes_len
               write(p_mes_lev3_params(i), 3); newline %if i&15=15
            %repeat
            newline
         %finish
         to gate(connect)
         %return
#fi

sw(*):
         fault("Illegal buffer state");  %return

%end
!
!        set up global param counts  (needed for split blocks)
!
      %routine set param count(%bytearrayname a)
         total param = a(1)
         this param = 0
         split pt = 2
      %end
!
!
%integerfn byte(%bytearrayname a)
      %if split pt >= p_mes_len - header len %then %result = -1; !no more here
      %if curr len = 0 %start;     !eor
         curr len = a(split pt)&63
         last ind = a(split pt)&128
         split pt = split pt + 1
      %finish
      curr len = curr len - 1
      split pt = split pt + 1
      %result = a(split pt - 1)
%end

!
!     get param(into a record)
!
      %routine get param(%record (parmf) %name par, %bytearrayname a)
         %integer i, j, k, n, x

         %integerfn byte
            split pt = split pt + 1
            %result = a(split pt - 1)
         %end

         par = 0; par_type = -1
         %return %if this param = total param; ! no more
         this param = this param+1
         par_type = byte
         n = 2; k = byte
         %if k&x'30'=x'30' %start;      ! string param
            par_s = ""
            j = byte;      !get the length
            %cycle i=1, 1, j
               x = byte
               %exit %if x < 0;      !no more in this packet
               par_s = par_s.to string(x)
            %repeat
         %else
            %if k&x'20'=x'20' %start;   ! integer param
               par_int = byte<<8!byte
            %finish
         %finish
      %end
!
!   ******   do input  - read input and put in file
!
      %integer %fn do input(%record (mef) %name mes)
        %owninteger n, binflag = 0
         %integer max, l, k, i
         %record (lev3f) %name lev3
         lev3 == mes_lev3
         max = mes_len-header len
         k = 0
         select output(1)
         %cycle
            %if n = 0 %start
               n = lev3_data(k); k = k+1
               %if n = 0 %start;           ! transfer command
                  select output(0)
                  %result = lev3_data(k); ! send back type
               %finish
               %exit %if k >= max
               n = n&63;                   ! reduce to simple length
            %finish
            l = lev3_data(k); k= k+1; n= n-1
            %if binflag = 0 %and l < 10 %then binflag = 1 %else binflag = 2
            %if binflag = 1 %or l # 13 %then printsymbol(l)
            %exit %if k >= max
            csent = csent+n
            %exit %if k>=max
         %repeat
         select output(0)
         %if csent >= 1024 %start
            signal dot
         %finish
         %result = 0
      %end

#if x
%routine send disc(%integer type)
!--------------------------------
   p_s1=type
   p_mes==null
   to gate(disconnect)
%end
#fi

        %integerfn do interpret message(%record (mef) %name mes)
           %bytearrayname a
           %integer x

            a == mes_lev3_data
            %if curr len = 0 %start
               curr len = a(0)&63
               last ind = a(0)&128
               split pt = 1
            %finish
            %cycle
               x = byte(a); %exit %if x<0;   ! at end
               sfta(newpt) = x;  newpt = newpt+1
            %repeat
            %if curr len = 0 %and last ind # 0 %start
               set param count(sfta)
               %cycle
                  get param(par, sfta)
                  %exit %if par_type = -1;  ! no more
                  %if par_type = x'71' %start
                     printstring("message:"); printstring(par_s); newline
                  %else
                     %if par_type = x'0f' %start;  ! state of trf
                         %if par_int = x'2000' %then printstring("State = ok
")                       %else %start
                            printstring("Trf fails "); write(par_int, 1)
                            newline
                         %finish
                     %else
                        %if par_s # "" %start
                           printstring("param?"); printstring(par_s); newline
                        %finish
                     %finish
                  %finish
               %repeat
            %finish
            split pt = 0
            %if last ind = 0 %then free buffer %and %result = 1
                                 ! there was more coming
            split pt = 0;         !dummy code (compiler bug)
           %result = 0;             ! no more coming
        %end

!
!     *****    Handle Gate
!
%routine handle gate
      %integer type, x, d1, d2
      %record (lev3f) %name lev3
      %bytearrayname a
#if ~x
      %switch f(input here:message reply)
#else
      %switch f(connect:datagram reply)

      %routine reason out
         printstring(", Reason ="); write(p_s1, 2)
         print hex(d1); print hex(d2); newline
      %end

#fi
      ->f(p_fn)
!
#if ~x
f(open reply a):  %if state=connecting %thenstart
#if n
                     port=p_s1
#else
                     port = p_node
#fi
                     state=wait rep b
                  %finishelse fault("Illeg open rep a")
                  %return
!
f(open reply b):  %if p_s1#0 %start
                     printstring("Connect fails,reason=")
                     write(p_s1,0); newline
                     clock=1
                  %finishelsestart
                     %if state=wait rep b %thenstart
                        printstring("Connected....")
                        newline
                        state=send sft
                        ask for buffer
                     %finishelse fault("Illeg open reply b")
                  %finish
                  %return
#else
f(accept call):
      %if state=connecting %start
         port=p_gate port
         printstring("Connected..."); newline
#if k
         p_s1=1
         to gate(enable input)
#fi
         state=send sft
         ask for buffer
      %finishelse fault("Illeg accept")
      %unless p_mes==null %then free buffer
      %return
#fi
!
f(input here):
      lev3 == p_mes_lev3
      type = lev3_data(1)

#if x
      p_s1=1;     !number of enables
#fi
      %if mon < 0 %then printstring("from ") %and dump mes(p_mes)
      to gate(enable input)
      %if state = await data %start
         type = do input(p_mes)
         %if type = es %start
            tim2 = time
            printstring("Eof seen
")
            state = send stop
            ask for buffer
            type = er
            -> send type
         %finish
         -> free
      %finish

      %if state = send sft %start;      ! should be rpos/rneg
         %if type = rneg %or new pt # 0 %start
            fails = 1
            printstring("Rneg received!
")
            dump mes(p_mes) %if mon > 0
             %if do interpret message(p_mes) # 0 %then %return
            -> send stop;               ! may be second packet !!
         %finish
         %if type = rpos %start
            lev3_data(1) = go
            %if direction = 0 %then state = send ss %else state = await data
#if x
            p_s1=0
#fi
            p_mes_len = 3+header len
            lev3_data(0) = 130; lev3_data(2) = 0
            to gate(put output)
            printstring("Go sent
")
            tim = time
            %return
         %finish

         fault("invalid reply to sft")
         ! ????
         -> end
      %finish

      %if state = wait er %or type = qr %start
         ! should be er(0)
         %if type = qr %start
            fault("Quit rec'd")
            lev3_data(0) = 0; lev3_data(1) = es
#if x
            p_s1=0
#fi
            to gate(put output); %return
         %else
            %if type = er %start
               %if lev3_data(2) = 0 %start
                  printstring("er(0) - recd
")
               %else
                  printstring("er("); write(lev3_data(2), 1)
                  printstring(") - recd
")
               %finish
            %finish
send stop:
            state = stop sent
            lev3_dst = string(addr(stop m(0)))
            lev3_data(0) = lev3_data(0)!128;       ! len byte of lev3_dst
            p_s1 = 0
            p_mes_len = 7+header len
            to gate(put output)
            %return

send type:
            lev3_data(0)=0
            lev3_data(1) = type; lev3_data(2) = 0
            p_mes_len = 3+header len
#if ~x
            p_port = port
#else
            p_s1=0
#fi
            to gate(put output)
         %return
         %finish
      %finish

      %if state = stop sent %start
         %if type # stopack %and new pt = 0 %start
            fault("Not Stopack")
            -> end
         %finish
         %if do interpret message(p_mes) # 0 %then %return; ! more coming
         state = closing
#if x
#if k
         p_mes_len=0;     !send null data with push - acts as close req
         p_s1=1
         to gate(put output)
        free buffer
        p_mes == null
        p_s1 = 0
#else
        free buffer
        Send Disc(0)
#fi
#else
         free buffer
         to gate(abort call)
#fi
         %return
      %finish

      %if state = aborting %then -> free

      fault("Invalid Data In")
end:  printstring("value = "); write(type, 1); write(lev3_data(2),1)
      newline
      dump mes(p_mes)
      int = 'A';        !abort the call now
free: free buffer
      %return

!
#if x
f(enable output):
#else
f(output txd):
#fi
         %if state=send data %or state = send ss %or state = send es %c
           %then ask for buffer
#if ~x
                       %if state=closing %thenstart
                          p_port=port
                          to gate(close call)
                       %finish
#fi
                       %return
!
#if ~x
f(call closed):
      fault("Unexpected call closed!")
      to gate(close call)
      tidyup

      %return

!
f(call aborted):
      %if state = aborting %start
         printstring("Abort acknowledged"); newline
         tidy up
         %return
      %finish

   %if state=closing %start
#else
f(reset):
      %unless p_mes == null %start
         %if mon # 0 %start
            printstring("Disc:")
            %cycle i = 0, 1, p_mes_len
               write(p_mes_lev3_params(i), 3); newline %if i&15=15
            %repeat
            newline
         %finish
         d1 = p_mes_lev3_params(2); d2 = p_mes_lev3_params(3)
         free buffer
      %finish
         printstring("Reset recd")
         reason out; newline
         send disc(99)
         state = aborting
         %return

f(disconnect):
      %unless p_mes == null %start
         %if mon # 0 %start
            printstring("Disc:")
            %cycle i = 0, 1, p_mes_len
               write(p_mes_lev3_params(i), 3); newline %if i&15=15
            %repeat
            newline
         %finish
         d1 = p_mes_lev3_params(2); d2 = p_mes_lev3_params(3)
         free buffer
      %finish

      %if state=connecting %start;    !connect failed
         printstring("Connect fails"); reason out
         clock=1
         %return
      %finish
      %if state=closing %start
#fi
                     newline
                     %if fails = 0 %then %c
                     printstring("End of file...") %else %c
                     printstring("Attempt aborted, ")
                     dump chars
                     time it
                     tidyup
                     %return
                  %finish
!
                  printstring("Call aborted by other end")
#if x
                  reason out
#else
                  newline
#fi
                  fails = 1
#if x
                  send disc(1) %unless state = aborting
#else
                  to gate(abort call)
#fi
                  tidyup
                  %return
!
f(*):
               printstring("Illegal fn from gate");  write(p_fn,1);  newline
               %return
%end
!
!*************************************************************************
!
!     *****    Main program starts here
!
!*************************************************************************
!
#if k
cli = cli string;                         ! pick up parameters
#else
cli = cli param;                          ! pick up parameters
#fi
                                        ! format: in file/out file,address
#if k
%unless cli -> cli.(",").add %then add = ""
#else
%unless cli -> cli.("=").qual %then qual = ""
%unless cli -> cli.("%C").callfrig %then call frig = "FTP"
%unless cli -> cli.(":").add %then add = ""
#fi
%if cli -> cli.("/").cli2 %and cli = "" %then direction = 1
printstring(vsn)
#if r
      printstring("Ring ")
#fi
#if n
      printstring("NSI ")
#fi
#if x
      printstring("TSI ")
#fi
      printstring(datestring); newline
i=mapvirt(buffer manager,4,3)
i=mapvirt(buffer manager,5,4)
i=mapvirt(buffer manager,6,5)
      %if add -> add.("/B").fname %then binary = 1;  ! set binary mode
      %if add = "" %start;              ! nb: change to default !!
         prompt("Address?"); readstring(add)
      %finish
      %if charno(add, 1) = 'L' %and add -> fname.("L").add %start
         %if length(add) = 1 %then add = fname."1500000".add %else %c
            add = fname."150000".add
         %finish
repr:
prompt("Remote file?")
      readstring(fname)
      us = ""
       %if fname = "" %then -> repr
#if k
      %unless fname -> us.(".").fname %then us = ""
      %if us = "" %start
         us = "CUR051"
      %else
#else
      %unless fname -> us.(",").fname %start
         %if fname -> us.(".").fname %start
            %if us = "" %then fname = ".".fname
         %finish
      %finish
      %if us = "" %start
         us = "ERCM09"
      %else
#fi
         prompt("Background Pass?")
         readstring(bpass)
      %finish
select input(1)
#if k
neot=-1;   !for handling 'real' eof
#fi
alarm(25)
clock=0; cc=0
do connect;                                ! send a connect
%cycle
      p_ser=0; poff(p)

         %if 'M' <= int <= 'P' %then mon = int-'O' %and int = 0

     %if p_reply = 0 %start;          ! clock
         %if int='L' %then give up = 30000
         %if int = 'Q' %then quiet = quiet!!1

         %if int='A' %thenstart
abo:
            %if clock > 0 %then %stop;  ! remove 'S' when this works !!
            %if state< closing %start
#if x
               send disc(42)
#else
               p_port = port
               to gate(abort call)
#fi
               state=aborting
               printstring("Aborting call"); newline
            %finishelsestart
               int = 'S'
            %finish
         %finishelseif int='?' %then dump status
         int=0 %unless int = 'S'
         %if clock=-1 %thenstop
         alarm(25)
         %if clock=8 %then clock=0 %and do connect
         %if clock > 0 %then clock = clock+1
      %finishelseif p_reply=buffer manager %thenstart
         handle buffer
      %finishelseif p_reply=gate ser %thenstart
         handle gate
      %finish
%repeat
%endofprogram