! Common utility procedures for (Moose) INet process, GDMR, Jan. 1988

%option "-NonStandard-Low-NoCheck-NoTrace-NoDiag"

%include "INet:Common_Formats.Inc"
%include "GDMR_H:DateTime.Inc"

%systemroutinespec phex(%integer i)

%externalroutinespec FS insert(%string(31) label, %integer value)

%externalintegerspec clock ticks

%systemintegerfnspec global heap get(%integer bytes)

%systemstring(127)%fnspec itos(%integer n, p)
%systemroutinespec phex2(%integer n)
%externalstring(15)%fnspec date
%externalstring(15)%fnspec time

%externalstring(3)%fn itos2(%integer what)
   %integer h, l
      h = what // 10;  l = what - 10 * h
      %result = to string(h + '0') . to string(l + '0')
%end

%externalstring(15)%fn xtos(%integer i)
   %string(15) s = ""
   %integer j, ch
      %for j = 1, 1, 8 %cycle
         ch = (i >> 28) & 15
         %if ch <= 9 %then s = s . to string(ch + '0') %c
                     %else s = s . to string(ch - 10 + 'A')
         i = i << 4
      %repeat
      %result = s
%end

%externalintegerfn generate timestamp
   %result = rem(get datestamp, 24 * 60 * 60) * 1000
%end

%externalstring(31)%fn convert timestamp(%integer stamp)
   %integer h, m, s, hu
      hu = stamp // 10
      s = hu // 100;  hu = hu - 100 * s
      m = s // 60;  s = s - 60 * m
      h = m // 60;  m = m - 60 * h
      %result = itos2(h) . ":" . itos2(m) . ":" . itos2(s) . "." . itos2(hu)
%end

%externalintegerfn msecs timestamp
   %result = clock ticks << 7;  ! *128, near enough...
%end


! Buffer manipulation stuff.  Only the free-list stuff is defined here, as the
! en/dequeue procedures are merely aliased to the standard system ones.

%systemroutinespec enqueue buffer %alias "enqueue" %c
                                  (%record(buffer fm)%name b,
                                   %record(queue fm)%name q)
%systemrecord(buffer fm)%mapspec dequeue buffer %alias "dequeue" %c
                                                (%record(queue fm)%name q)

%externalrecord(queue fm)%spec buffer lookaside list

! NB: claim and release may be called from several autonomous processes, so
! use the system-supplied interlocked queuing routines.

%externalrecord(buffer fm)%map claim buffer
   %record(buffer fm)%name b
   %label L
      b == dequeue buffer(buffer lookaside list)
      %result == nil %if b == nil
      D0 = copy or clear // 4
      D1 = 0;  A0 = addr(b)
   L: *move.l D1, (A0)+
      *dbra D0, L
      %result == b
%end

%externalroutine release buffer(%record(buffer fm)%name b)
   enqueue buffer(b, buffer lookaside list)
%end

%externalroutine purge queue(%record(queue fm)%name q, %integername n)
   %record(buffer fm)%name b
      n = 0
      %cycle
         b == dequeue buffer(q)
         %return %if b == nil
         release buffer(b)
         n = n + 1
      %repeat
%end

%externalroutine copy headers(%record(buffer fm)%name from, to)
   %label L
      D0 = copy or clear // 4
   L: *move.l (A0)+, (A1)+
      *dbra D0, L
      to_IP header  == record(addr(to) + (addr(from_IP header) - addr(from)))
      to_header 2   == record(addr(to) + (addr(from_header 2)  - addr(from)))
      to_data start == byteinteger(addr(to) + (addr(from_data start) - addr(from)))
%end

%externalroutine copy all(%record(buffer fm)%name from, to)
   %label L
      D0 = buffer size // 4
   L: *move.l (A0)+, (A1)+
      *dbra D0, L
      to_IP header  == record(addr(to) + (addr(from_IP header) - addr(from)))
      to_header 2   == record(addr(to) + (addr(from_header 2)  - addr(from)))
      to_data start == byteinteger(addr(to) + (addr(from_data start) - addr(from)))
%end


! "Named heap"

%externalrecord(*)%map named heap get(%integer bytes, %string(31) name)
   %integer x
   %label Z
      !! printstring("Named heap get: ");  printstring(name)
      !! space;  write(bytes, 0);  newline
      x = global heap get(bytes + 4)
      D1 = bytes // 4
      D0 = 0;  A0 = x
   Z: *move.l D0, (A0)+
      *dbra D1, Z
      FS insert(name, x)
      %result == record(x)
%end


! Network (re)ordering (not required for 680x0)
!
!%routine net order short(%shortname X)
!%end
!
!%routine net order long(%integername X)
!%end


! Checksum calculation

%externalintegerfn calculate checksum(%record(*)%name start, %integer bytes)
   %integer i, c = 0
      byteinteger(addr(start) + bytes) = 0 %if bytes & 1 # 0;  ! Odd, pad
      c = c + (shortinteger(i) & 16_FFFF) %c
         %for i = addr(start), 2, addr(start) + (bytes - 1) & (\ 1)
      c = (c & 16_FFFF) + (c >> 16);  ! Carries
      c = (c & 16_FFFF) + (c >> 16);  ! ... and again
      %result = c
%end

%externalintegerfn calculate pseudo checksum(%record(*)%name start,
                                             %integer bytes,
                                             %integer source, destination,
                                             %integer protocol, length)
   ! Calculates the pseudo-checksum for TCP & UDP, incorporating the
   ! source and destination, length and protocol type.  NOTE that this
   ! calculation must be done with the packet header and the pseudo-header
   ! fields in NETWORK order -- we switch the pseudo-header around in here.
   %integer i, c = 0
      byteinteger(addr(start) + bytes) = 0 %if bytes & 1 # 0;  ! Odd, pad
      c = c + (shortinteger(i) & 16_FFFF) %c
         %for i = addr(start), 2, addr(start) + ((bytes - 1) & (\ 1))
!N!   net order long(source);  net order long(destination)
!N!   net order short(shortinteger(addr(length)))
      length = length & 16_FFFF;  ! Zap sign-extension 
      c = c + (source      & 16_FFFF) + source      >> 16
      c = c + (destination & 16_FFFF) + destination >> 16
      c = c + length + protocol << 8
      c = (c & 16_FFFF) + (c >> 16);  ! Carries
      c = (c & 16_FFFF) + (c >> 16);  ! ... and again
      %result = c
%end


! INet address stuff

%externalroutine print INet address(%integer addr)
   write(addr >> 24 & 255, 0);  print symbol('.')
   write(addr >> 16 & 255, 0);  print symbol('.')
   write(addr >>  8 & 255, 0);  print symbol('.')
   write(addr       & 255, 0)
%end

%externalstring(15)%fn INet address to S(%integer addr)
   %result = itos(addr >> 24 & 255, 0) . "." . %c
             itos(addr >> 16 & 255, 0) . "." . %c
             itos(addr >>  8 & 255, 0) . "." . %c
             itos(addr       & 255, 0)
%end

%externalroutine split INet address(%integer address,
                                    %integername host, network, class)
   %if address & 16_80000000 = 0 %start
      ! Class A
      host = address & 16_00FFFFFF
      network = address & 16_FF000000
      class = 'A'
   %else %if address & 16_C0000000 = 16_80000000
      ! Class B
      host = address & 16_0000FFFF
      network = address & 16_FFFF0000
      class = 'B'
   %else %if address & 16_E0000000 = 16_C0000000
      ! Class C
      host = address & 16_000000FF
      network = address & 16_FFFFFF00
      class = 'C'
   %else
      ! Unknown
      host = address
      network = 0
      class = '@'
   %finish
%end

%externalintegerfn INet name to address(%string(31) name)
   %result = 193 << 24 ! 208 << 16 ! 205 << 8 ! 16_34
%end

%externalstring(127)%fn INet address to name(%integer address)
   %result = "Dummy"
%end


! Miscellaneous utility things

%externalroutine print ether address(%record(ether address fm)%name a)
   %integer i
      %for i = 0, 1, 5 %cycle
         print symbol('-') %unless i = 0
         phex2(a_x(i))
      %repeat
%end

%externalstring(23)%fn ether address to S(%record(ether address fm)%name e)
   %string(23) s
   %integer i, ch
      s = ""
      %for i = 0, 1, 5 %cycle
         s = s . "-" %if i # 0
         ch = (e_x(i) >> 4) & 15
         %if ch <= 9 %then ch = ch + '0' %else ch = ch - 10 + 'A'
         s = s . to string(ch)
         ch = (e_x(i)     ) & 15
         %if ch <= 9 %then ch = ch + '0' %else ch = ch - 10 + 'A'
         s = s . to string(ch)
      %repeat
      %result = s
%end

%externalroutine pdate
   printstring(date);  space
   printstring(time);  spaces(2)
%end

%externalintegerfn generate ISS
   %result = clock ticks << 4
%end

%externalroutine tell network operator(%string(127) message)
   pdate;  printstring("INet: ");  printstring(message);  newline
%end


! Peer tables manipulation.  Pointer array used to avoid having to 
! shuffle data records

%ownrecord(peer table fm)%name peer table == nil
%ownrecord(peer info fm)%namearray peer info table(1 : peer slots)

%externalrecord(peer info fm)%map find peer info(%integer address)
   %record(peer info fm)%name p
   %integer l, u, i
      !! printstring("Find peer info for ")
      !! print inet address(address);  newline
      peer table == named heap get(peer table size, peer table name) %c
         %if peer table == nil
      !! printstring("Peer table at ");  phex(addr(peer table));  newline
      %result == nil %if peer table_slots used = 0
      l = 1;  u = peer table_slots used
      %cycle
         !! printstring("Search: ");  write(l, 0)
         !! space;  write(u, 0);  newline
         %result == nil %if l > u
         i = (l + u) // 2
         p == peer info table(i)
         %if p_address = address %start
            ! Found it
            %result == p
         %else %if p_address > address
            ! Look in lower split
            u = i - 1
         %else {must have p_address < address
            ! Look in upper split
            l = i + 1
         %finish
      %repeat
%end

%externalrecord(peer info fm)%map new peer info(%integer address)
   %record(peer info fm)%name p
   %integer b, i, where
      !! printstring("New peer info for ")
      !! print inet address(address);  newline
      peer table == named heap get(peer table size, peer table name) %c
         %if peer table == nil
      !! printstring("Peer table at ");  phex(addr(peer table));  newline
      %if peer table_slots used = 0 %start
         ! Easy case first -- table is empty
         peer table_slots used = 1
         peer table_slot(1)_address = address
         peer info table(1) == peer table_slot(1)
         %result == peer table_slot(1)
      %else %if peer table_slots used = peer slots
         ! Another easy case -- the table is full
         %result == nil
      %finish
      ! Otherwise we'll have to find where to insert the new peer
      where = peer table_slots used + 1
      p == peer table_slot(where)
      %for b = 1, 1, peer table_slots used %cycle
         %if peer info table(b)_address > address %start
            ! Insert before the current one.  "Shuffle" up first...
            peer table_slots used = where
            !! printstring("Shuffle from ");  write(b + 1, 0)
            !! printstring(" to ");  write(peer table_slots used, 0);  newline
            peer info table(i) == peer info table(i - 1) %c
               %for i = peer table_slots used, -1, b + 1
            peer info table(b) == p
            p = 0;  p_address = address
            %result == p
         %finish
      %repeat
      ! If we get here we'll have to insert at the end
      peer table_slots used = where
      peer info table(where) == p
      p = 0;  p_address = address
      !! printstring("Inserted at end: ");  write(peer table_slots used, 0)
      !! newline
      %result == p
%end

%end %of %file
