! INet process for VAX/VMS, GDMR, Feb/March 1987

! This file contains some basic definitions and utility routines, together
! with the dispatcher loop at the end, but all the main components are
! %included from separate files for convenience.


%owninteger our address = 0
%owninteger our network = 0

%constinteger ARP lives = 4

%constinteger slow timer efn = 38
%constinteger fast timer efn = 39


! System interface definitions

%constinteger R0 = 0, R1 = 1, R6 = 6

%recordformat desc fm(%integer l, a)
%recordformat IOSB fm(%short status, length,
                      (%integer extra %or %integer PID %or %c
                       (%byte spare1, deuna status, 
                        %byte deuna error summary, spare2) %or %c
                       (%short unit, func)))


%systemintegerfnspec assign (%record(desc fm)%name name, %integername channel,
                             %integer ui1, ui2)

%systemintegerfnspec dassgn(%integer channel)

%systemintegerfnspec cancel(%integer channel)

%systemintegerfnspec crembx (%integer prmflg,
                             %integername channel,
                             %integer maxmsg, bufquo,
                             %integer acmode, promsk,
                             %record(desc fm)%name lognam)

%constinteger temporary mailbox = 0

%recordformat ether address fm(%bytearray x(0 : 5))
%recordformat ether addresses fm(%record(ether address fm) destination,
                                 %record(ether address fm) source,
                                 %short protocol type)


%systemintegerfnspec QIO    (%integer efn, chan, func,
                             %record(IOSB fm)%name IOSB,
                             %integer astadr, astprm,
                             %integer P1, P2, P3, P4, P5, P6)
%systemintegerfnspec QIOW   (%integer efn, chan, func,
                             %record(IOSB fm)%name IOSB,
                             %integer astadr, astprm,
                             %integer P1, P2, P3, P4, P5, P6)

%constinteger IO ReadVBlk     = 16_0031
%constinteger IO WriteVBlk    = 16_0030
%constinteger IO WritePBlk    = 16_000B
%constinteger IO SetMode      = 16_0023
%constinteger IO SenseMode    = 16_0027
%constinteger IO Create       = 16_0033
%constinteger IO WritEOF      = 16_0028
%constinteger IO ReadPrompt   = 16_0037

%constinteger IOM Ctrl        = 16_0200
%constinteger IOM Startup     = 16_0040
%constinteger IOM Abort       = 16_0100
%constinteger IOM Qualified   = 16_0080
%constinteger IOM Mount       = 16_0200
%constinteger IOM DMount      = 16_0400
%constinteger IOM readCSR     = 16_8000

%constinteger NMA pcli hwa    = 16_0488
%constinteger NMA pcli pha    = 16_0B04
%constinteger NMA pcli mask   = 16_0FFF
%constinteger NMA pcli string = 16_1000
                     

%recordformat DVI item fm(%short length, code,
                          %integer buffer address,
                          %integer returned length)

%systemintegerfnspec getdviw(%integer efn, channel,
                             %record(desc fm)%name devnam,
                             %record(DVI item fm)%name itmlst,
                             %record(IOSB fm)%name IOSB,
                             %integer astadr, astprm, null)

%constinteger DVI refcount    = 16_001E

%systemintegerfnspec crelnm (%integer attr,
                             %record(desc fm)%name tabnam, lognam,
                             %integer acmode,
                             %record(DVI item fm)%name itmlst)

%constinteger LNM string = 16_0002


%recordformat OPCOM req fm((%byte code %or %integer target),
                           %integer message id,
                           %string(127) text)

%systemintegerfnspec sndopr (%record(desc fm)%name what, %integer reply)

%constinteger OPC rqst   = x'00000003'
%constinteger OPC ntwork = x'00000040'

%systemintegerfnspec setimr (%integer efn, %integername daytim,
                             %integer astadr, reqidt)

%systemroutinespec   setAST (%integer mode)
%constinteger ASTs disabled = 0
%constinteger ASTs enabled  = 1

%systemroutinespec   setrwm (%integer mode)
%constinteger rwm   wait = 0
%constinteger rwm nowait = 1


%systemroutinespec   hiber
%systemroutinespec   wake   (%integer ui1, ui2)


%recordformat exit fm(%integer forward, handler addr, n args,
                      %integername condition)
%ownrecord(exit fm) exit block = 0
%owninteger exit condition = 0

%systemintegerfnspec dclexh(%record(exit fm)%name exit block)

%systemroutinespec   exit   (%integer reason)


%recordformat addr lims fm(%integer start, finish)

%systemintegerfnspec expreg (%integer pages,
                             %record(addr lims fm)%name lims,
                             %integer ui, region)

%systemintegerfnspec crmpsc (%record(addr lims fm)%name inadr, retadr,
                             %integer ui1, flags,
                             %record(desc fm)%name section name,
                             %integer ui3, ui4, ui5,
                             %integer pagcnt, ui6, prot, pfc)

%constinteger SEC gbl         = 16_00000001
!constinteger SEC crf         = 16_00000002
%constinteger SEC dzro        = 16_00000004
%constinteger SEC wrt         = 16_00000008
!constinteger SEC perm        = 16_00004000
!constinteger SEC sysgbl      = 16_00008000
!constinteger SEC pfnmap      = 16_00010000
%constinteger SEC expreg      = 16_00020000
%constinteger SEC pagfil      = 16_00080000


%recordformat numtim fm(%short year, month, day, 
                        %short hour, minute, second, hundredth)

%systemroutinespec   numtim (%record(numtim fm)%name result, %integer time)

%systemroutinespec   gettim (%integername time)

%externalstring(127)%fnspec sysmess(%integer code)
%externalstring(127)%fnspec translate(%string(127) what)

%externalintegerfnspec INet name to address(%string(31) name)
%externalstring(127)%fnspec INet address to name(%integer address)

%externalintegerfnspec set INet;  ! Kernel mode....

%externalroutinespec dump(%bytename start, %integer bytes)


%constinteger SS nopriv    = 16_0024
%constinteger SS timeout   = 16_022A
%constinteger SS reject    = 16_0292
%constinteger SS endoffile = 16_0870
%constinteger SS lineabrt  = 16_0E04
%constinteger SS bugcheck  = 16_02A4
%constinteger SS hangup    = 16_02CC
%constinteger SS devmount  = 16_006A

%constinteger timeout   error = SS timeout
%constinteger reset     error = SS lineabrt
%constinteger bugcheck  error = SS bugcheck
%constinteger privilege error = SS nopriv
%constinteger exists    error = SS devmount


! Utility stuff

%routine phex2(%integer what)
   %integer ch
      ch = what >> 4 & 15
      %if ch <= 9 %then ch = ch + '0' %else ch = ch - 10 + 'A'
      print symbol(ch)
      ch = what & 15
      %if ch <= 9 %then ch = ch + '0' %else ch = ch - 10 + 'A'
      print symbol(ch)
%end

%string(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

%string(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

%integerfn generate timestamp
   %record(numtim fm) n
      numtim(n, 0)
      %result = n_hour * 60 * 60 * 1000 + %c
                n_minute * 60 * 1000    + %c
                n_second * 1000         + %c
                n_hundredth * 10
%end

%string(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

%integerfn msecs timestamp
   ! Note that this is only approximately in msecs, as we're dividing
   ! by 8192 instead of 10000.  It's close enough, however....
   %constinteger timestamp offset = 13
   %systemroutinespec gettim(%integername x)
   %owninteger t1, t2
      gettim(t1)
      *ExtV _ #timestamp offset, #32, t1, R0
      *Ret
      %result = 0;  ! Placate compiler
%end


! Various formats

%owninteger max TCP = 0, max UDP = 0

%recordformat queue header fm(%record(*)%name forward, backward)

%include "Non_Peer.Inc"

%include "Peer_Info.Inc"

%include "TCB.Inc"

%include "UDP_Tables.Inc"

%recordformat IP header fm(%byte IHL,                { includes version }
                           %byte type of service,
                           %short total length,
                           %short identification,
                           %short fragment offset,   { includes flags }
                           %byte TTL,
                           %byte protocol,
                           %short checksum,
                           %integer source,
                           %integer destination,
                           %bytearray options(1 : 8))
%constinteger IP header size = 20;  ! Not including options

%recordformat TCP header fm(%short source, destination,
                            %integer seq,
                            %integer ack,
                            %byte data offset,
                            %byte flags,
                            %short window,
                            %short checksum,
                            %short urgent,
                            %integer options)
%constinteger TCP header size = 20;  ! Not including options

%constinteger FIN bit = 2_000001
%constinteger SYN bit = 2_000010
%constinteger RST bit = 2_000100
%constinteger PSH bit = 2_001000
%constinteger ACK bit = 2_010000
%constinteger URG bit = 2_100000

%constinteger TCP define max segment = 2

%recordformat UDP header fm(%short source,
                            %short destination,
                            %short length,
                            %short checksum)

%recordformat ICMP header fm(%byte type,
                             %byte code,
                             %short checksum,
                             ((%short identifier,
                               %short sequence number) %c
                          %or %integer gateway address),
                             (%integer originate timestamp,
                              %integer receive timestamp,
                              %integer transmit timestamp))

%recordformat ARP fm(%short format,
                     %short protocol,
                     %byte hardware length,
                     %byte protocol length,
                     %short op,
                     %record(ether address fm) source hardware,
                     %integer source protocol,
                     %record(ether address fm) target hardware,
                     %integer target protocol,
                     %string(47) padding)

%constinteger ARP ether protocol = 1
%constinteger ARP IP type        = 16_0800
%constinteger ARP request code   = 1
%constinteger ARP reply   code   = 2

%recordformat buffer fm(%record(*)%name forward, backward,
                        %record(IOSB fm) IOSB,
                        %record(ether addresses fm) ether addrs,
                        %integer IP peer, protocol, ARP lives, seq, flags,
                        %integer stamp, life, interval,
                        %record(peer info fm)%name p,
                        %integer privilege,
                        %record(queue header fm)%name next queue,
                        (%record(TCB fm)%name TCB %c
                         %or %record(UDP entry fm)%name UDP entry),
                        %integer tag, acceptable,
                        %integer code, bytes, IP bytes, data bytes,
                        (%record(IP header fm)%name IP header %or %c
                         %record(ARP fm)%name ARP packet),
                        (%record(*)%name header2 %or %c
                         %record(TCP header fm)%name TCP header %or %c
                         %record(UDP header fm)%name UDP header %or %c
                         %record(ICMP header fm)%name ICMP header),
                        %bytename data start,
                        %bytearray data(0 : 1499))
%constinteger buffer size = 8 + 8 + 14 + 20 + 12 + 4 + 4 + 4 + 4 + 8 + %c
                            16 + 4 + 4 + 4 + 1500
%constinteger copy or clear = buffer size - 1500 + 64

%constinteger ignore seq   = 1
%constinteger ignore SYN   = 2
%constinteger ignore ACK   = 4
%constinteger requeue flag = 8


! Queue headers

%ownrecord(queue header fm) ether inbound          queue = 0
%ownrecord(queue header fm) ether outbound         queue = 0
%ownrecord(queue header fm) ether pending ARP      queue = 0
%ownrecord(queue header fm) ARP inbound            queue = 0
%ownrecord(queue header fm) IP inbound             queue = 0
%ownrecord(queue header fm) IP outbound            queue = 0
%ownrecord(queue header fm) TCP inbound            queue = 0
%ownrecord(queue header fm) TCP outbound           queue = 0
%ownrecord(queue header fm) TCP first              queue = 0
%ownrecord(queue header fm) TCP sixth              queue = 0
%ownrecord(queue header fm) TCP packet delivered   queue = 0
%ownrecord(queue header fm) UDP inbound            queue = 0
%ownrecord(queue header fm) UDP outbound           queue = 0
%ownrecord(queue header fm) ICMP inbound           queue = 0
%ownrecord(queue header fm) ICMP outbound          queue = 0
%ownrecord(queue header fm) buffer lookaside        list = 0


! Buffer manipulation stuff

%routine setup queue(%record(queue header fm)%name queue)
   queue_forward == queue
   queue_backward == queue
%end

%record(buffer fm)%map new buffer
   %record(addr lims fm) lims
   %integer status
      status = expreg(4, lims, 0, 0)
      %signal 15, status %if status & 1 = 0
      sp_buffer high water = sp_buffer high water + 1
      %result == record(lims_start)
%end

%routine enqueue buffer(%record(buffer fm)%name b,
                        %record(queue header fm)%name q)
   *MovL _ q, R0
   *InsQue _ @b, @4(R0)
%end

%routine requeue buffer(%record(buffer fm)%name b,
                        %record(queue header fm)%name q)
   *InsQue _ @b, @q
%end

%record(buffer fm)%map dequeue buffer(%record(queue header fm)%name q)
   %label empty
      *MovL _ q, R1
      *RemQue _ @(R1), R0
      *BVS _ empty
      *ClrQ _ (R0)
      *Ret
empty:
      %result == nil
%end

%record(buffer fm)%map claim buffer
   %label empty
      sp_buffers in use = sp_buffers in use + 1
      *MovAL _ buffer lookaside list, R1
      *RemQue _ @(R1), R6
      *BVS _ empty
      *MovC5 _ #0, (R6), #0, #copy or clear, (R6)
      *MovL _ R6, R0
      *Ret
empty:
      %result == new buffer
%end

%routine release buffer(%record(buffer fm)%name b)
   sp_buffers in use = sp_buffers in use - 1
   enqueue buffer(b, buffer lookaside list)
%end

%routine purge queue(%record(queue header 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

%routine copy headers(%record(buffer fm)%name from, to)
   *MovC3 _ #copy or clear, @from, @to
   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

%routine copy all(%record(buffer fm)%name from, to)
   *MovC3 _ #buffer size, @from, @to
   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"

%record(*)%map named heap get(%integer bytes, %string(31) name)
   %record(desc fm) d
   %record(addr lims fm) lims = 0
   %integer status, pages
      d_l = length(name);  d_a = addr(name) + 1
      pages = (bytes + 511) >> 9
      status = crmpsc(lims, lims, 0,
                      SEC gbl ! SEC dzro ! SEC expreg ! SEC wrt ! SEC pagfil,
                      d, 0, 0, 0, pages, 0,
                      2_1111 1110 1100 1111, 0)
                       {W:wr G:wR O:WR S:wr}
      %signal 15, status %if status & 1 = 0
      %result == record(lims_start)
%end


! Network (re)ordering

%routine net order short(%shortname X)
   *MovL _ X, R0
   *MovB _ (R0), R1
   *MovB _ 1(R0), (R0)
   *MovB _ R1, 1(R0)
%end

%routine net order long(%integername X)
   *MovL _ X, R0
   *MovB _ (R0), R1
   *MovB _ 3(R0), (R0)
   *MovB _ R1, 3(R0)
   *MovB _ 1(R0), R1
   *MovB _ 2(R0), 1(R0)
   *MovB _ R1, 2(R0)
%end


! Checksum calculation

%integerfn 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

%integerfn calculate pseudo checksum(%record(*)%name start, %integer bytes,
                                     %integer source, destination, protocol,
                                     %integer 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))
      net order long(source);  net order long(destination)
      net order short(shortinteger(addr(length)))
      shortinteger(addr(length) + 2) = 0;  ! Zap the 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

%routine 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

%string(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

%routine 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

%constintegerarray new broadcast mask('@' : 'C') =
      16_00000000, 16_00FFFFFF, 16_0000FFFF, 16_000000FF


! Miscellaneous utility things

%routine 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

%string(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

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

%integerfn generate ISS
   %systemroutinespec gettim(%integername x)
   %owninteger t1, t2
      gettim(t1)
      %result = integer(addr(t1) + 1)
%end

%routine tell network operator(%string(127) message)
   %record(desc fm) d
   %record(OPCOM req fm) r
   %integer status
      length(message) = 118 %if length(message) > 118
      string(addr(r_text) - 1) = message . to string(0)
      r_message id = 0
      r_target = OPC ntwork << 8
      r_code = OPC rqst
      d_l = length(message) + 9
      d_a = addr(r)
      status = sndopr(d, 0)
      %signal 15, status %if status & 1 = 0
%end


! Included modules come here....

%owninteger activity count = 0
%routinespec schedule fast timer

%include "Peer_Info.Imp"

%include "Interface.Imp"

%include "ICMP_Boxes.Imp"

%include "Gateway.Imp"

%include "IP.Imp"

%include "UDP.Imp"

%include "TCP_Trace.Imp"

%include "TCB.Imp"

%include "TCP.Imp"

%include "ICMP.Imp"

%include "Ether.Imp"


! Timers, exit handlers, main calling loop

%owninteger slow timer = 0

%routine schedule slow timer
   %externalintegerspec slow timer AST routine %alias "INET__SLOW_TIMER_AST"
   %owninteger t1 = 4000 * (-10 000), t2 = -1
   %integer status
      status = setimr(slow timer efn, t1,
                      addr(slow timer AST routine), addr(slow timer AST routine))
      %signal 15, status %if status & 1 = 0
%end

%externalroutine slow timer AST routine %alias "INET__SLOW_TIMER_AST"
   slow timer = 1
   wake(0, 0)
   schedule slow timer
%end

%owninteger fast timer = 0

%routine schedule fast timer
   %externalintegerspec fast timer AST routine %alias "INET__FAST_TIMER_AST"
   %owninteger t1 = 500 * (-10 000), t2 = -1
   %integer status
      status = setimr(fast timer efn, t1,
                      addr(fast timer AST routine), addr(fast timer AST routine))
      %signal 15, status %if status & 1 = 0
%end

%externalroutine fast timer AST routine %alias "INET__FAST_TIMER_AST"
   fast timer = 1
   wake(0, 0)
   schedule fast timer %if activity count > 0
%end


%routine divert mailbox names
   %record(desc fm) n, t
   %record(DVI item fm) z = 0, e
   %ownstring(31) name = "LNM$TEMPORARY_MAILBOX"
   %ownstring(31) table = "LNM$PROCESS_DIRECTORY"
   %ownstring(31) equivalence = "LNM$GROUP"
   %integer status, junk
      !! printstring("Divert mailbox names: table ");  printstring(table)
      !! printstring(", name ");  printstring(name)
      !! printstring(", equivalence ");  printstring(equivalence)
      !! newline
      n_l = length(name);  n_a = addr(name) + 1
      t_l = length(table);  t_a = addr(table) + 1
      e_length = length(equivalence)
      e_code = LNM string
      e_buffer address = addr(equivalence) + 1
      e_returned length = addr(junk)
      status = crelnm(0, t, n, 0, e)
      %signal 15, status %if status & 1 = 0
%end

%externalroutine exit handler %alias "INET__EXIT_HANDLER"
   %record(event fm)%name e
   %string(255) message
      e == event
      message = "INet manager stopping: " . sysmess(exit condition)
      %if e_event = 15 %start
         message = message . " -- " . sysmess(e_sub)
      %else %if e_event > 0
         message = message . " -- event " . itos(e_event, 0) . %c
                   ", " . itos(e_sub, 0) . ", " . itos(e_extra, 0)
         message = message . ", " . e_message %if e_message # ""
      %finish
      tell network operator(message)
%end

%begin
   %externalintegerspec exit handler %alias "INET__EXIT_HANDLER"
   %string(127) message, node name
   %record(buffer fm)%name b
   %integer status, i, k
      ! Set up exit handler first
      exit block_handler addr = addr(exit handler)
      exit block_n args = 1
      exit block_condition == exit condition
      status = dclexh(exit block)
      %signal 15, status %if status = 0 
      ! Change our username
      status = set INet
      %signal 15, status %if status & 1 = 0
      ! Find our address
      node name = translate("SYS$NODE")
      %if node name = "SYS$NODE" %or node name = "" %start
         ! No node name defined, so we'll have to look for
         ! something called "Local"
         node name = "Local"
      %else
         ! A node name (DECnet?) is defined, so we'll use it.
         node name = sub string(node name, 2, length(node name) - 2)
      %finish
      our address = INet name to address(node name)
      %if our address = 0 %start
         message = "Undefined INet address for '" . node name . "'"
         tell network operator(message)
         pdate
         printstring(message);  newline
         %stop
      %finish
      message = "INet address for '" . node name . "' is " . %c
                INet address to S(our address) . " ("
      split INet address(our address, i, our network, k)
      %if k = '@' %start
         message = message . "unknown network type)"
         tell network operator(message)
         pdate
         printstring(message);  newline
         %stop
      %finish
      message = message . to string(k) . ")";  ! Append address-class
      tell network operator(message)
      pdate;  printstring(message);  newline
      sp == named heap get(non peer size, non peer name)
      ! Initialise queues
      setup queue(ether inbound queue)
      setup queue(ether outbound queue)
      setup queue(ether pending ARP queue)
      setup queue(ARP inbound queue)
      setup queue(IP inbound queue)
      setup queue(IP outbound queue)
      setup queue(TCP inbound queue)
      setup queue(TCP outbound queue)
      setup queue(TCP first queue)
      setup queue(TCP sixth queue)
      setup queue(TCP packet delivered queue)
      setup queue(UDP inbound queue)
      setup queue(UDP outbound queue)
      setup queue(ICMP inbound queue)
      setup queue(ICMP outbound queue)
      setup queue(buffer lookaside list)
      ! Start up the user interface
      start user interfaces(max TCP, max UDP)
      %if max TCP = 0 %start
         tell network operator("TCP units not configured")
      %else
         max TCP = max TCB table %if max TCP > max TCB table
         TCB table == named heap get(TCB size * max TCP, TCB table name)
         TCP enable(i) %for i = 1, 1, max TCP
      %finish
      %if max UDP = 0 %start
         tell network operator("UDP units not configured")
      %else
         max UDP = UDP table entries %if max UDP > UDP table entries
         UDP table == named heap get(UDP entry size * max UDP, UDP table name)
         UDP enable(i) %for i = 1, 1, max UDP
      %finish
      peer table == named heap get(peer table size, peer table name)
      ! Start devices, timers
      schedule slow timer
      start ether
      setup gateways
      divert mailbox names
      start ICMP mailbox
      ! Don't wait for resources
      setrwm(rwm nowait)
      ! And off we go....  Scan the queues in turn, looking for buffers to
      ! dequeue.  If we find any we call the appropriate service routine, then
      ! go back up to the top of the loop
      %cycle
         b == dequeue buffer(ether inbound queue)
         %if b ## nil %start
            ether inbound(b)
            %continue
         %finish
         b == dequeue buffer(ARP inbound queue)
         %if b ## nil %start
            ARP inbound(b)
            %continue
         %finish
         b == dequeue buffer(ether outbound queue)
         %if b ## nil %start
            ether outbound(b)
            %continue
         %finish
         b == dequeue buffer(IP inbound queue)
         %if b ## nil %start
            IP inbound(b)
            %continue
         %finish
         b == dequeue buffer(IP outbound queue)
         %if b ## nil %start
            IP outbound(b)
            %continue
         %finish
         ! NB: TCP processing MUST come AFTER ether & IP to avoid
         ! race conditions with retransmit queues.  Note also that TCP
         ! processing must take place in such an order as to ensire that
         ! later stages have a higer precedence than earlier stages -- this
         ! helps to avoid bogus "send-aheads".
         b == dequeue buffer(TCP packet delivered queue)
         %if b ## nil %start
            TCP packet delivered(b)
            %continue
         %finish
         b == dequeue buffer(TCP sixth queue)
         %if b ## nil %start
            TCP sixth(b)
            %continue
         %finish
         b == dequeue buffer(TCP first queue)
         %if b ## nil %start
            TCP first(b)
            %continue
         %finish
         b == dequeue buffer(TCP inbound queue)
         %if b ## nil %start
            TCP inbound(b)
            %continue
         %finish
         b == dequeue buffer(TCP outbound queue)
         %if b ## nil %start
            TCP outbound(b)
            %continue
         %finish
         %continue %if TCP pending acks
         %if fast timer # 0 %start
            !! printstring("Fast timer: ");  write(activity count, 0);  newline
            fast timer = 0
            %continue %if TCP retransmit timeouts
         %finish
         b == dequeue buffer(UDP inbound queue)
         %if b ## nil %start
            UDP inbound(b)
            %continue
         %finish
         b == dequeue buffer(UDP outbound queue)
         %if b ## nil %start
            UDP outbound(b)
            %continue
         %finish
         b == dequeue buffer(ICMP inbound queue)
         %if b ## nil %start
            ICMP inbound(b)
            %continue
         %finish
         b == dequeue buffer(ICMP outbound queue)
         %if b ## nil %start
            ICMP outbound(b)
            %continue
         %finish
         %if slow timer # 0 %start
            !! printstring("Slow timer");  newline
            slow timer = 0
            TCB time wait timeouts
            !? %continue
         %finish
         hiber
      %repeat
%end %of %program