\ ========== Copyright Header Begin ==========================================
\ Hypervisor Software File: cirstack.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
\ - 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
\ ========== Copyright Header End ============================================
id: @(#)cirstack.fth 1.6 03/12/08 13:22:21
copyright: Copyright 1990-2003 Sun Microsystems, Inc. All Rights Reserved
copyright: Use is subject to license terms.
\ Circular stack defining words
\ 10 circular-stack: foo Create a new stack named foo
\ with space for 10 numbers
\ 123 foo push Push the number 123 on the stack foo
\ foo pop Pop the top element from the stack foo
\ foo top@ Copy the top element from the stack foo
\ onto the data stack, but do not
\ remove it from the stack foo
\ Advantages of a circular stack:
\ does not have to be cleared
\ cannot overflow or underflow
\ + Useful for implementing user interfaces where you want to remember
\ a limited amount of "history", such as the last n commands, or the
\ last n directories "visited", but it is not necessary to guarantee
\ unlimited backtracking.
\ + Can easily be adapted, by adding functions pushc and type-circ ,
\ for keeping a history of characters, for such uses as shadowing and
\ logging console output.
\ The circular stack parameter field is intentionally the same as
\ the parameter field of a word defined by buffer: . This allows
\ us to use the buffer: mechanism to automatically allocate the
\ necessary storage space.
\ The parameter field elements are located and sized as follows:
\ pfa: user# ( /user# , which is either /l )
\ ( or, in the \t16 model, /w )
\ pfa+/user#: buffer-size ( might be /n, which was /l in )
\ ( the 32-bit model, but might. )
\ ( with the introduction of the )
\ ( 64-bit model, have become /x )
\ ( because the code remained /n. )
\ ( Or it might explicitly be /l, )
\ ( which is plenty large enough. )
\ ( Holds the size of the data )
\ ( area plus one cell. )
\ pfa+/user#+/n: buffer-link ( /a , which is either /l )
\ ( or, in the \t16 model, /w )
\ As with a buffer: , user# is the offset of a user area location
\ containing the address of an allocated memory buffer that contains
\ the circular stack data structure.
\ The circular stack data structure consists of the following elements:
\ current Offset into stack data of the next element to pop,
\ which is equivalent to the last element that was pushed;
\ occupies one cell at the start of the structure.
\ (Note: Although /l would be sufficient for this, we
\ allocate a cell to keep the data area cell-aligned.)
\ stack data Space to store the stacked numbers. It occupies the
\ remainder of the structure.
\ The "limit", i.e., the size of the stack data area, is obtained
\ from the buffer-size minus one cell.
\ Invoking the circular stack by name returns one item on the stack,
\ the Parameter Field Address, referred to as stack-pfa in stack
\ Every operator that acts on a stack-pfa needs to convert it
\ to three items: the buffer-address, the limit, and the current
\ pointer; that's done via the cir-stack-params function. That
\ step could have been put into a does> clause of the defining
\ word, but it was felt that doing so would create an unwieldy
\ Implementation factors:
\ Common arrangement of necessary params
: cir-stack-params ( stack-pfa -- buff-adr limit current )
dup /buffer ( stack-pfa size )
/n - swap ( limit stack-pfa )
do-buffer ( limit buff-adr )
tuck @ ( buff-adr limit current )
\ Store adjusted "current" offset.
\ Return addresses of both the old and the new "current" items.
: cir-stack-ptr! ( buff-adr old-current new-current -- ... )
( ... -- old-item-adr new-item-adr )
rot 2dup ! ( old new buff-adr ) \ Store adjusted "current"
na1+ ( old new data-adr ) \ Bump to data-area
dup d+ ( old-item-ptr new-item-ptr )
\ Create a new circular-stack;
\ when executed, it will return its PFA.
: circular-stack: ( #entries -- ) \ name
\ Add a number to the stack
: push ( n stack-pfa -- )
cir-stack-params ( n buff-adr limit current )
dup na1+ ( n buff-adr limit current next? )
\ Adjust overflow of incremented "current"
rot over = if drop 0 then ( n buff-adr current next )
cir-stack-ptr! ( n old-item-adr new-item-adr )
\ Store into "new" item address
\ Remove a number from the stack
cir-stack-params ( buff-adr limit current )
\ Adjust imminent underflow of "current", then decrement
tuck ( buff-adr current limit current )
if drop dup then /n - ( buff-adr current next )
cir-stack-ptr! ( old-item-adr new-item-adr )
\ Fetch from "current" (now "old") item address
\ Return, without popping, the number on top of the stack
: top@ ( stack-pfa -- n )
cir-stack-params ( buff-adr limit current )
\ Fetch from "current" item address. Bump to data-area
projects / OpenSPARC-T2-SAM / blob