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

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

%include "INet: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 ! 1;  ! *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)
   %record(buffer fm)%name b
      %cycle
         b == dequeue buffer(q)
         %return %if b == nil
         release buffer(b)
      %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)))
!N!   net order short(shortinteger(addr(protocol)))
      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
      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


! 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


! Dump packet (hex & ASCII)

%systemroutinespec phexx2 %alias "phex2" (%integer i)

%externalroutine dump(%bytename buffer, %integer bytes)
   %integer i, j, k
      %return %if bytes <= 0
      newline
      i = 0
      %while i < bytes %cycle
         print symbol('[')
         write(i, -4)
         printstring("]  ")
         %for j = 0, 1, 15 %cycle
            %if i + j >= bytes %then space %and space %c
                               %else phexx2(byteinteger(addr(buffer) + j))
            space %if j & 3 = 3
         %repeat
         printstring(" |")
         %for j = 0, 1, 15 %cycle
            %if j + i < bytes %start
               k = byteinteger(addr(buffer) + j) & 127
               %if k = 0 %start
                  k = '.'
               %else %unless ' ' <= k <= '~'
                  k = '_'
               %finish
               printsymbol(k)
            %else
               space
            %finish
         %repeat
         printsymbol('|')
         newline
         i = i + 16;  buffer == buffer [16]
      %repeat
      newline
%end

%end %of %file