! file 'down4m'
!@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
!
! this program is supposed to call do load with
!  argument the physical device handler routine.
!  until imp77 allows routines to have routine arguments
!  it has been kludged.  to change it delete the
! sequence !**** and delete lines containing ;!$$$.
!  nb this has not been tested

!**********************************************
!*                                            *
!*   down line loader v1.3                    *
!* date: 04.feb.82                            *
!*                                            *
!*   b gilmore march 1980                     *
!*   w d hay  november 1979                   *
!*                                            *
!**********************************************
!
! stack = 1000, streams = 1

%begin
%control 1
%include "deimosperm"

%conststring (13) vsn = "down:vsn001m
"

!    record for call to dqs11e

%recordformat xxf(%integer dummy)
      %recordformat parf(%integer type, %c
       (%record (xxf) %name b %or %integer address), %c
        %integer len)
%ownrecord(parf) par

%routinespec         test  (%record(parf)%name p)
%routinespec dqs11e(%record(parf)%name p)
%routinespec umc1e (%record(parf)%name p)
%routinespec par11e(%record (parf) %name p)


!     record for pon/poff

%recordformat ff(%byteintegerarray fn(0:5))
%recordformat fnamef(%integer a, b, c, d, %byteinteger unit, fsys, %c
  %record (ff) fname)

! file manipulation formats

%record %format strpf(%record (fnamef) %name strd)
%constrecord (strpf) %name strm1 == k'160034'

%recordformat pf(%byte ser, reply, %c
  (%byte a1, a2, %record (xxf) %name b, %byte c1, c2 %or %c
      %record (ff) fname))

      %record (pf) p

!     important locations


!      functions for physical device handler

%constinteger initialise     =0,   %c
              line input     =1,   %c
              line output    =2,   %c
              input here     =3,   %c
              output done    =4,   %c
              modem status   =5,   %c
              clear          =6
!important bits on modem interface status. these are for dqs11e
! and this may need changeing for other devices.

%constinteger modem rfs = k'20',   %c
              modem cd  = k'40',   %c
              modem dsr = k'400'

! ************************************************************
!
!     change the next few items when the loader is generalised
!      to load down any line

! device type
%owninteger devtype=-1;     !test
%owninteger line no = -1

!       service numbers

%owninteger rx int=-7,tx int=-6

!        dqs11e hardware address

%ownrecord(xxf)%name handler address == k'067700'
!*********************************************************

!        data buffer and local variables

%recordformat d(%byteinteger address,control,console,sequence,  %c
                loaddr,hiaddr,%byteintegerarray dd(1:240))
%ownrecord(d) data
%owninteger size,address

!physical device types

%constinteger devdqs=0,   %c
              devkmc=1,   %c
              devpar = 3,     %c
              devtst=-1

%owninteger checksum=0;            !accumulate checksum here
%owninteger ticks=0;               ! timeout count
%ownbyteinteger bsize,ch,ch1,sequence,finish


%routinespec get symbol(%byteintegername ch)
%routinespec tell(%string(255)s)
%routinespec warn(%string(255) s)
%routinespec error(%string(255)s)
%routinespec do load;!$$$
!***%routinespec do load(%routine device(%record(parf)%name p))

!    ***********    program starts here     ************


      p_ser = 0; poff(p);               ! wait for instructions

      printstring(vsn)
      dev type = p_a1&7
      line no = p_a1>>3
      strm1_strd_fsys = p_a2; ! set file sys
      rxint = p_c1!x'ff00'; txint = p_c2!x'ff00'

      handler address == p_b

      p_ser = 0; poff(p)
      strm1_strd_fname = p_fname;      ! copy 6 byte name accross

  select input(1)
  linkin(rx int);  linkin(tx int)

!do the load, selecting appropriate device driver

!***  %if devtype=devdqs %start
!***    do load(dqs11e)
!***  %finish %else %if devtype=devkmc %start
!***    do load(umc1e)
!***  %finish
  do load;!$$$


!now clear up

   p_ser = 0; poff(p);  ! catch the clock tick
  tell("load done")
  %stop

!      ***********     routines          **************

%routine get symbol(%byteintegername ch)
!===================================

!this routine just returns next symbol, but
!might later on keep track of checksums.
%integer i
  read symbol(i)
   error("eof on input file") %if i<0
  checksum=checksum+i
  ch=i
%end

%routine tell(%string(255) s)
!============================

!this routine effectively doesprintstring,
!but might be changed later on

  printstring("%down - ")
  printstring(s)
  newline
%end

%routine warn(%string(255) s)
!============================
!
! warn operators

  printstring("!down -")
  printstring(s)
  newline
%end


%routine error(%string(255) s)
!=============================

!this routine does printstring followed by
!stop. will be changed later

  printstring("?down - ")
  printstring(s)
  newline
   p_ser = 0; poff(p);    ! wait for the timer tick
  %stop
%end

%routine check checksum
!======================
!
      %integer i, j
      i = checksum
      j = nextsymbol;  ! temp
  getsymbol(ch);      !skip the checksum
%if checksum&x'ff' # 0 %start
printstring("exp ="); write(i&x'ff', 1); printstring(" act =")
write(j&x'ff', 1); printstring(" result ="); write(checksum&x'ff', 1)
newline
%finish
  %if checksum&k'377'#0 %then error("checksum failure on input file")

%end

!***%routine do load(%routine device(%record(parf)%name p))
%routine do load;!$$$
!===============;!$$$
!======================================================


!this routine does the actual load. it is called with
!argument the routine to handle the particular device
!down which we are loading. the loader converts from
!dec absolute binary format to ercc down line load format
!the dec format is :
!
!   1,0,lo size,hi size,lo addr, hi addr, .. data ..,checksum
!
!the ercc format is:

!    0,0,k'377',sequence no,lo addr,hi addr,data
!
!the maximum size of the ercc data block is 240 bytes.
!

  %routine device(%record(parf)%name p);!$$$
  !====================================;!$$$
  !;!$$$
  ! routine to call correct device until ;!$$$
  !routines can take routine parameters;!$$$
;!$$$
    %if devtype=devdqs %start;!$$$
      dqs11e(p);!$$$
    %finish %else %if devtype=devkmc %start;!$$$
      umc1e(p);!$$$
    %finish %else %if devtype = devpar %start;!$$$
        par11e(p); !$$$$
    %finish %else %if devtype=devtst %start;!$$$
      test(p);!$$$
    %finish;!$$$
  %end;!$$$

  %routine send block
  !====================
  
  !send next frame to device and waits for
  !interrupt. will add watchdog timer later.
  
    par_type=line output
    par_b==data
    par_len=bsize+5
    device(par)
  
  !now wait for interrupt
  
again:
    p_ser=0
    poff(p)
     %if p_ser = id %and p_reply=0 %start; ! clock
        ticks = ticks+1
        alarm(50);    ! error will catch it
        %if ticks = 5 %then error("tx timeout")
        -> again
     %finish
    %if p_ser=tx int&x'ff' %start
      par_type=output done
      device(par)
      %if par_len#0 %then error("tx error")
      ticks = 0
    %finish %else error("unexpected message")
  
  %end

!initialise device

  par_type=initialise
  par_b==handler address
      par_len = line no
  device(par)

!wait for modem to settle

  alarm(1*50);   !wait 1 second
  %cycle
    p_ser=id; p_reply = 0
    poff(p)
  %repeat %until p_ser=id %and p_reply=0

!now check modem ok, cause if it isnt much confusion might result

   alarm(50);       ! 1 sec timeout
  par_type=modem status
  device(par)
  %if par_len&modem dsr=0 %start
    warn("modem no dsr")
  %finish %else %if par_len&modem cd=0 %start
    warn("modem no cd")
  %finish %else %if par_len&modemrfs=0 %start
    warn("modem no rfs")
  %finish


  sequence=0; !initialise sequence for first frame
  %cycle;   !over all input blocks
    error(" aborted") %if int='a'
    getsymbol(ch) %until ch=1
    checksum=1;          !initialise checksum
    getsymbol(ch); error("corrupt data file") %if ch#0
    getsymbol(ch); getsymbol(ch1); size=ch1<<8+ch-6
    getsymbol(ch); getsymbol(ch1); address=ch1<<8+ch
    %if size=0 %then finish=1 %else finish=0

!now we cycle over output blocks until this input block all done

    %cycle
      data_address=0;  data_control=0; data_console=k'377'
      data_sequence=sequence;  sequence=(sequence+1)&k'377'
      data_lo addr=address&k'377'
      data_hi addr=address>>8

!if we read the address just send it and exit

      %if finish=1 %start
        bsize=1
        send block
        check checksum
        %return
      %finish

      bsize=1
      %while size>0 %and bsize<=240 %cycle

        getsymbol(ch)
        data_dd(bsize)=ch
        size=size-1;  bsize=bsize+1; address=address+1

      %repeat
      send block;  ;!send this hdlc frame
      check checksum
    %repeat  %until size <= 0


  %repeat;    !carry on until all absolute loader blocks complete

%end; !of do load


%routine test(%record(parf)%name par)
!==================================

! test routine for debugging. prints
!  output records on terminal

%recordformat ppp(%byteintegerarray dd(1:246))
%record(ppp)%name q
%integer i,lc

%routine write octal(%byteinteger n)
!==================================

  print symbol((n>>6)&7+'0')
  print symbol((n>>3)&7+'0')
  print symbol(n&7+'0')
%end

  %if par_type=line output %start
    q==par_b
    lc=1
    %for i=1,1,par_len %cycle
      write octal(q_dd(i))
      spaces(2)
      lc=lc+1
      %if lc=26 %then lc=1 %and newline
    %repeat
    newline
  ! now simulate transmit doen interrupt
  
    p_ser=tx int; p_reply=0
    pon(p)
  %finish %else %if par_type=modem status %start
    par_len=k'20';  !set all bits on
%finish
%end



      !  * * * now the 'external' routines - same as node_prt9us routines * * *

     %routine octal(%integer n)
        %integer i
        printsymbol((n >> i)&7+'0') %for i = 15, -3, 0
     %end
%routine umc1e(%record (parf) %name p)


     %recordformat pf(%byteinteger ser, reply, %integer a, b, c)

      %ownrecord (pf) px

     %recordformat umc11f(%integer csr, %integerarray spare(0:2), bit(0:7), %c
        %byteinteger fn, ext, %integer addr, len)

      %constrecord (umc11f) %name umc == k'006740'

      %constinteger umc control = 18

      %recordformat parmf(%byteinteger err, ext, %integer addr, len)
      %ownrecord (parmf) ipar, opar;         ! one for each channel

      %recordformat conf(%byteinteger int vect, ext, %integer parm addr)
      %record (conf) %name con
      %ownrecord (conf) %array cona(0:31);          ! will go in initialise

      %constinteger initialise = 0
     %constinteger line input = 1
     %constinteger line output = 2
      %constinteger input here = 3
      %constinteger output done = 4
      %constinteger modem status = 5


     %constinteger txgo = k'111'
     %constinteger rxgo = k'111'

     %owninteger tx reply, rx reply, line no
      %owninteger x, rx bit, tx bit, bit wordp
      %ownintegername umc word


      %switch typesw(initialise:modem status)


     %owninteger type, f, cad, oseg, i, ext bits
     %owninteger par, pad

      %ownintegerarray raddr(0:7)

      -> type sw(p_type)

type sw(initialise):
     %cycle i = 1, 1, 7;       ! find absolute addresses
        raddr(i) = map abs(i<<13, 256, id); ! my addresses
        f = map abs(i<<13, 0, id);   ! and off again
     %repeat
      map hwr(0)


      line no = p_len
      px_ser = umc control; px_reply = id
      px_a = line no
      px_b = addr(i par); px_c = addr(o par)
      ponoff(px)
      %if px_a # 0 %then -> abort

      ! now work out where the pair of bits are !
      ! one rx bit and one tx bit, 8 lines per word, alternate words

      x = line no&7
      rx bit = 1<<(x<<1)
      tx bit = rx bit << 1
      bit wordp = (line no>>3)*2
      umc word == umc_bit(bit wordp)
      rx reply = 0; tx reply = 0
      %return

type sw(output done):
                                       ! transmitter
              type = line output
              %if o par_err # 0 %or txreply = 0 %start
                 !! transmitter error
                 printstring("tx error"); write(o par_err, 1)
                 write(tx reply, 1); newline
                 p_len = 1
              %else
                 p_len = 0
              %finish
            p_type = line output
              txreply = 0
              %return

type sw(input here):
              !! receiver interrupt
              %if i par_err # 0 %or rx reply = 0 %start
                 f = -2;          ! frame error
                  printstring("rx error"); write(i par_err, 1)
                  write(rx reply, 1); newline
              %else
                 f = i par_len-2;                   ! number of bytes trans
                  %if f> 252 %start
                      printstring("umc nasty:")
                     octal(umc_addr); space; octal(cad); space; octal(f); newline
                  %finish
               %finish
               p_type = line input
                p_address = pad;         ! pass block address back
               p_len = f
               rx reply = 0
            %return

type sw(line input):
           !! user call
              !! read request
              %if rx reply # 0 %then -> abort
              rxreply = id
              pad = p_address
!              par = map abs(pad, p_len, rxreply)
              par = raddr(pad>>13)
              %if par = 0 %then -> abort
              par = par+(pad&k'17700')>>6; ! ensure actual block
              ext bits = (par&k'176000')>>10
              i par_ext = ext bits
              cad = par << 6+pad&k'77'
              i par_addr = cad
              i par_len = p_len
              i = 1
!              umc_bit(0) = umc_bit(0)!!i;    ! channel 1 (ie rx on line 0)
               umc word = umc word!!rx bit
         %return

type sw(line output):
              !! output request
              %if tx reply # 0 %then -> abort
              tx reply = id
              oseg = p_address
!              par = map abs(oseg, p_len, tx reply)
              par = raddr(oseg>>13)
              %if par = 0 %then -> abort
              par = par+(oseg&k'17700')>>6;  ! ensure actual block
              ext bits = (par&k'176000')>>10
              o par_ext = ext bits
              o par_addr = par << 6+p_address&k'77'
              f = 0
              o par_len = p_len
              umc word = umc word!!tx bit
         %return

type sw(modem status):
      p_type = umc_bit(1)
      p_type = k'460'
      %return

abort:
      set prio(0)
     printstring("umc fail");write(rx reply, 1); write(tx reply, 1)
      write(p_type,1); newline
     %cycle;  %repeat


%end
!
! file 'fep_dqs12e'
!**************
!*  dqs12e    *
!*da:04.jun.80*
!**************

! %recordformat parf(%integer type, address, len)

%routine dqs11e(%record (parf) %name p)

     %recordformat pf(%byteinteger ser, reply, %integer a, b, c)

     %recordformat dqs11f(%integer mcsr, tcsr, rsr, rcr, twcr, tcar, %c
       rwcr, rcar)

     %ownrecord (dqs11f) %name dqs == 1;    ! set up by prot on initialise

      %constinteger initialise = 0
     %constinteger line input = 1
     %constinteger line output = 2
      %constinteger input here = 3
      %constinteger output done = 4
      %constinteger modem status = 5


     %constinteger txgo = k'111'
     %constinteger rxgo = k'111'

     %owninteger tx reply, rx reply


      %switch typesw(initialise:modem status)


     %owninteger type, f, cad, oseg, i, ext bits
     %owninteger par, mid, pad

      %ownintegerarray raddr(0:7)

      -> type sw(p_type)

type sw(initialise):
     mid = get id
     %cycle i = 1, 1, 7;       ! find absolute addresses
        raddr(i) = map abs(i<<13, 256, mid); ! my addresses
        f = map abs(i<<13, 0, mid);   ! and off again
     %repeat

     maphwr(0)
     dqs == record(p_address&k'17777');  ! ensure in seg 0
     dqs = 0;                          ! tidy it up first
     dqs_mcsr = k'40003';              ! don't transfer the crc
     dqs_rcr = k'10';                  ! enable receiver
     dqs_tcsr = k'10';                 ! enable transmitter
      rx reply = 0; tx reply = 0
      %return

type sw(output done):
                                       ! transmitter
              type = line output
              %if dqs_tcsr < 0 %or txreply = 0 %start
                 !! transmitter error
                 printstring("tx error
")
                 p_len = 1
              %else
                 p_len = 0
              %finish
            p_type = line output
              txreply = 0
              %return

type sw(input here):
              !! receiver interrupt
              %if dqs_rsr&k'34067' # 0 %or rx reply = 0 %start
                 f = -2;          ! frame error
                 %if dqs_rsr&k'20' # 0 %then f = -3;  ! silo full
flt:             dqs_rcr = 0;          ! clear down
                 dqs_rcr = k'10';      ! and up again
              %else
                 %if dqs_rsr&k'1000' # 0 %then f = -1 %and -> flt
                                       ! wc overflow
                 f = dqs_rcar-cad-2 
                                       ! number of bytes trans
                 %if dqs_rsr&k'074000' # 0 %then f = f-1
                  %if f> 252 %start
                      printstring("dqs nasty:")
                      octal(dqs_rcar); space; octal(cad); space; octal(f);newline

                  %finish
               %finish
               p_type = line input
              p_address = pad;         ! pass block address back
               p_len = f
              rx reply = 0
            %return

type sw(line input):
           !! user call
              !! read request
              %if rx reply # 0 %then -> abort
              rxreply = mid
              pad = p_address
!              par = map abs(pad, p_len, rxreply)
              par = raddr(pad>>13)
              %if par = 0 %then -> abort
              par = par+(pad&k'17700')>>6; ! ensure actual block
              ext bits = (par&k'176000')>>6
              cad = par << 6+pad&k'77'
              dqs_rcar = cad
              dqs_rwcr =- (p_len >> 1)
              dqs_rcr = rxgo!ext bits
         %return

type sw(line output):
              !! output request
              %if tx reply # 0 %then -> abort
              tx reply = mid
              oseg = p_address
!              par = map abs(oseg, p_len, tx reply)
              par = raddr(oseg>>13)
              %if par = 0 %then -> abort
              par = par+(oseg&k'17700')>>6;  ! ensure actual block
              ext bits = (par&k'176000')>>6
              dqs_tcar = par << 6+p_address&k'77'
              f = 0
              dqs_twcr =- ((p_len+1) >> 1)
              %if p_len&1 # 0 %start
                 f = k'040000';        ! 8 in remaining bit field
              %finish
              dqs_tcsr = tx go!f!ext bits
         %return

type sw(modem status):
      p_len = dqs_mcsr
      p_type = 0;         ! for now
      %return

abort:
     printstring("dqs fail
")
     %cycle;  %repeat


%end
! file 'fep_parr1e'
!**************
!*  par11e    *
!*da:12.feb.80*
!**************

%routine par11e(%record (parf) %name p)

     %recordformat pf(%byteinteger ser, reply, %integer a1, a2, a3)

      %recordformat parrf(%integer rcsr, rbc, rba, rvec, %c
        tcsr, tbc, tba, tvec)

     %ownrecord (parrf) %name pa == 1;    ! set up by prot on initialise

      %constinteger initialise = 0
     %constinteger line input = 1
     %constinteger line output = 2
      %constinteger input here = 3
      %constinteger output done = 4
      %constinteger modem status = 5



     %owninteger tx reply, rx reply

      %switch typesw(initialise:modem status)


     %owninteger type, f, cad, oseg, i, ext bits
     %owninteger par, mid, pad

      %ownintegerarray raddr(0:7)

      -> type sw(p_type)

type sw(initialise):
      mid = id
     maphwr(3)
     pa == record(p_address)
     %cycle i = 1, 1, 7;              ! find absolute addresses
        raddr(i) = map abs(i<<13, 256, mid); ! my addresses
        f = map abs(i<<13, 0, mid);      ! and off again
      %repeat
      rx reply = 0; tx reply = 0
      %return
type sw(modem status):
      p_len = k'460'
      %return


type sw(output done):
                                       ! transmitter
              type = line output
               %if pa_tcsr < 0 %start;  ! error
                 !! transmitter error
                  printstring("tx error
")
                 p_len = 1
              %else
                 p_len = 0
              %finish
            p_type = line output
              txreply = 0
              %return

type sw(input here):
              !! receiver interrupt
           f = pa_rbc+252
           %if pa_rcsr < 0 %or f = 0 %start
                 f = -2;          ! frame error
              %else
            %finish
            p_type = line input
           p_address = pad;         ! pass block address back
            p_len = f
           rx reply = 0
         %return

type sw(line input):
           !! user call
              !! read request
              %if rx reply # 0 %then -> abort
              rxreply = mid
              pad = p_address
!              par = map abs(pad, p_len, rxreply)
              par = raddr(pad>>13)
              %if par = 0 %then -> abort
              par = par+(pad&k'17700')>>6; ! ensure actual block
              ext bits = (par&k'176000')>>6
              cad = par << 6+pad&k'77'
               pa_rbc = -252
               pa_rcsr = ext bits
               pa_rba = cad;            ! ext bits ********************
         pa_rcsr = pa_rcsr!k'100'
         %return

type sw(line output):
              !! output request
              %if tx reply # 0 %then -> abort
              tx reply = mid
              oseg = p_address
!              par = map abs(oseg, p_len, tx reply)
              par = raddr(oseg>>13)
              %if par = 0 %then -> abort
              par = par+(oseg&k'17700')>>6;  ! ensure actual block
              ext bits = (par&k'176000')>>6
              f = 0
         pa_tbc = -(p_len);       ! +1 ??   length
              pa_tcsr = ext bits
              pa_tba = par << 6+oseg&k'77'
               !! nb: ext bits ***************************************
           pa_tcsr = pa_tcsr!k'100'
         %return

abort:
     printstring("dqs fail
")
     %cycle;  %repeat


%end
%endofprogram