obp/obp/pkg/netinet/queue.fth

\ ========== Copyright Header Begin ==========================================
\
\ Hypervisor Software File: queue.fth
\
\ Copyright (c) 2006 Sun Microsystems, Inc. All Rights Reserved.
\
\  - Do no alter or remove copyright notices
\
\  - Redistribution and use of this software in source and binary forms, with
\    or without modification, are permitted provided that the following
\    conditions are met:
\
\  - Redistribution of source code must retain the above copyright notice,
\    this list of conditions and the following disclaimer.
\
\  - Redistribution in binary form must reproduce the above copyright notice,
\    this list of conditions and the following disclaimer in the
\    documentation and/or other materials provided with the distribution.
\
\    Neither the name of Sun Microsystems, Inc. or the names of contributors
\ may be used to endorse or promote products derived from this software
\ without specific prior written permission.
\
\     This software is provided "AS IS," without a warranty of any kind.
\ ALL EXPRESS OR IMPLIED CONDITIONS, REPRESENTATIONS AND WARRANTIES,
\ INCLUDING ANY IMPLIED WARRANTY OF MERCHANTABILITY, FITNESS FOR A
\ PARTICULAR PURPOSE OR NON-INFRINGEMENT, ARE HEREBY EXCLUDED. SUN
\ MICROSYSTEMS, INC. ("SUN") AND ITS LICENSORS SHALL NOT BE LIABLE FOR
\ ANY DAMAGES SUFFERED BY LICENSEE AS A RESULT OF USING, MODIFYING OR
\ DISTRIBUTING THIS SOFTWARE OR ITS DERIVATIVES. IN NO EVENT WILL SUN
\ OR ITS LICENSORS BE LIABLE FOR ANY LOST REVENUE, PROFIT OR DATA, OR
\ FOR DIRECT, INDIRECT, SPECIAL, CONSEQUENTIAL, INCIDENTAL OR PUNITIVE
\ DAMAGES, HOWEVER CAUSED AND REGARDLESS OF THE THEORY OF LIABILITY,
\ ARISING OUT OF THE USE OF OR INABILITY TO USE THIS SOFTWARE, EVEN IF
\ SUN HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
\
\ You acknowledge that this software is not designed, licensed or
\ intended for use in the design, construction, operation or maintenance of
\ any nuclear facility.
\
\ ========== Copyright Header End ============================================
id: @(#)queue.fth 1.1 04/09/07
purpose: Generic queue utility functions
copyright: Copyright 2004 Sun Microsystems, Inc.  All Rights Reserved
copyright: Use is subject to license terms.

\ Generic doubly-linked list (queue) implementation. Supports a queue
\ of abstract objects. The queue is maintained within that object.

headerless

struct
    /n  field   >q-next     \ Next entry in queue
    /n  field   >q-prev     \ Previous entry in queue
constant /queue-entry

/queue-entry constant /queue-head

\ Initialize a queue
: queue-init ( qhead -- )  dup  2dup >q-next !  >q-prev ! ;

\ Get to next entry in queue
: queue-next ( qentry -- next )  >q-next @ ;

\ Get to previous entry in queue
: queue-prev ( qentry -- prev )  >q-prev @ ;

\ First entry in queue
: queue-first ( qhead -- qentry )  queue-next ;

\ Last entry in queue
: queue-last ( qhead -- qentry )  queue-prev ;

\ Check if we are at the end of the queue
: queue-end? ( qhead qentry -- flag ) = ;

\ Is the queue empty?
: queue-empty? ( qhead -- flag )  dup queue-first  queue-end? ;

\ Get number of entries in the queue
: queue-size ( qhead -- qsize )
   0  swap queue-first                          ( 0 qhead qentry )
   begin  2dup queue-end? 0=  while             ( n qhead qentry )
      rot  1+  -rot  queue-next                 ( n' qhead qentry )
   repeat  2drop                                ( qsize )
;

\ Insert entry after element "pred".
: insqueue ( pred qentry -- )
   over queue-next  over >q-next !              \ qentry.next = pred.next
   2dup >q-prev !                               \ qentry.prev = pred
   2dup swap queue-next >q-prev !               \ pred.next.prev = qentry
   swap >q-next !                               \ pred.next = qentry
;

\ Remove entry from queue
: remqueue ( qentry -- )
   dup  queue-prev  over queue-next >q-prev !
   dup  queue-next  swap queue-prev >q-next !
;

\ Insert element at tail of queue
: enqueue ( qhead qentry -- )
   swap queue-last swap insqueue
;

\ Dequeue element at head of queue
: dequeue ( qhead -- qentry | 0 )
   dup queue-empty? if  drop 0  else  queue-first dup remqueue  then
;

\ Iterate over each item in the queue, performing the desired operation.
: queue-iterate ( qhead acf -- )
   >r  dup queue-first                  ( qhead qentry ) ( r: acf )
   begin  2dup queue-end? 0=  while     ( qhead qentry )
      dup r@ execute  queue-next        ( qhead qentry' )
   repeat                               ( qhead qentry' )
   r> 3drop                             ( ) ( r: )
;

\ Find a queue entry which matches the specified criteria. "acf"
\ is executed on each queue entry to determine a match.  The match
\ routine must have a stack diagram of the form
\       ( ... qentry -- ... match? )
\ Stack items under qentry are values used by the "acf" routine to
\ determine a match.

: find-queue-entry ( ... qhead acf -- ... qentry | ... 0 )
   >r                                           ( ... qhead ) ( r: acf )
   dup queue-first                              ( ... qhead qentry )
   begin  2dup queue-end? 0=  while             ( ... qhead qentry )
      dup r@  2swap >r >r  execute  if          ( ... ) ( r: acf qentry qhead )
         r> drop  r>  r> drop exit              ( ... qentry ) ( r: )
      then                                      ( ... ) ( r: acf qentry qhead )
      r> r> queue-next                          ( ... qhead qnext ) ( r: acf )
   repeat                                       ( ... qhead qnext )
   2drop r> drop 0                              ( ... 0 ) ( r: )
;

headers