TriOS-alt/zubehör/sphinx/spinx100225-ori/sphinx2/bintree.spn

238 lines
8.9 KiB
Plaintext
Raw Normal View History

2010-11-26 23:58:06 +01:00
obj
str: "stringx"
dat
cog long 0
pub Init( p0, p1 )
pFree := p0 ' leave some room for the stack, then free space.
pLimit := p1
Stop
sync~~
cog := cognew( @LookerUpper, @input ) + 1
ifnot cog
abort string("Couldn't start bintree cog")
repeat while sync
pub Stop
if cog
cogstop( cog~ - 1 )
pub FindInTable( s, p ) | d
{{
Finds string s in table pointed to by p.
Returns pointer to s's data area if s is found, 0 otherwise.
}}
input[0] := s
input[1] := p
sync~~
repeat while sync
return output
{
ifnot p
return 0
d := str.Compare( s, p+4 )
ifnot d
return p + 4 + strsize(s) + 1
if d < 0
return FindInTable( s, Peekw(p) )
' else
return FindInTable( s, Peekw(p+2) )
}
pub AddToTable( s, pP ) | p, d
{{
Adds string s to table. Note: pP is a pointer-to-pointer to table.
Returns a pointer to s's data area (actually pFree, so if you add
any data, increment pFree past it).
}}
ifnot p := PeekW( pP )
PokeW( pP, pFree )
PokeW( pFree, 0 )
pFree += 2
PokeW( pFree, 0 )
pFree += 2
str.Copy( pFree, s )
pFree += strsize(s) + 1
return pFree
d := str.Compare( s, p+4 )
{
term.dec(d)
term.out(13)
waitcnt( clkfreq + cnt )
}
ifnot d
abort string("Symbol already defined")
if d < 0
return AddToTable( s, @word[p][0] )
' else
return AddToTable( s, @word[p][1] )
pub PeekW( p )
return byte[p++] + byte[p] << 8
pub PokeW( p, w )
byte[p++] := w
byte[p] := w >> 8
pub PeekL( p ) : t
repeat 4
t := (t | byte[p++]) -> 8
pub PokeL( p, l )
repeat 4
byte[p++] := l
l >>= 8
dat
pFree long 0
pLimit long 0
pub Alloc( n )
result := pFree
if (pFree += n) > pLimit
abort string("Out of symbol table space")
dat
input long 0 ' rendezvous variables for LookerUpper
output long 0
sync long 1
{
This PASM routine is equivalent to the following:
pub FindInTable( s, p ) | d
{{
Finds string s in table pointed to by p.
Returns pointer to s's data area if s is found, 0 otherwise.
}}
ifnot p
return 0
d := str.Compare( s, p+4 )
ifnot d
return p + 4 + strsize(s) + 1
if d < 0
return FindInTable( s, Peekw(p) )
' else
return FindInTable( s, Peekw(p+2) )
}
dat org 0
LookerUpper
mov pInput, par ' Enter with par pointing to rendezvous area,
mov pOutput, par ' sync = 1
add pOutput, #4
mov pSync, par
add pSync, #8
rdlong pTable, pInput ' Save @tableStart
' and ack to inform Spin program that the cog is running.
Ack
wrlong retval, pOutput
mov temp, #0
wrlong temp, pSync
:wait ' Wait for caller to set sync to indicate that input is ready.
rdlong temp, pSync wz
if_z jmp #:wait
rdlong pString, pInput ' input[0] points to string to look up.
rdlong ptr, pOutput ' input[1] points to table. (input[1] = output)
mov retval, #0
:loop
tjz ptr, #Ack
mov pLeft, pString ' Compare string
mov pRight, ptr ' to string at current position in table
add pRight, #4 ' (bump up ptr by 4 to skip two link words).
call #StringCompare
if_e jmp #:equal
if_b jmp #:less
:greater ' If left > right,
add ptr, #2 ' use the 2nd link.
:less ' If left < right, use 1st link.
rdbyte temp, ptr ' Follow the link
add ptr, #1 ' It would be nice to just "rdword ptr, ptr" here
rdbyte ptr, ptr ' but ptr might be odd so we have to go through
shl ptr, #8 ' some extra gyrations.
add ptr, temp
jmp #:loop ' and recurse (well, just iterate).
:equal ' If left = right, return ptr + 4 + strsize(pString) + 1
mov retval, ptr
add retval, #5
:x
rdbyte temp, pString wz ' add strsize(pString)
if_z jmp #:y
add retval, #1
add pString, #1
jmp #:x
:y
jmp #Ack
StringCompare
' Compares zero-terminated strings pointed to by pLeft and pRight.
' On return, Z and C are set appropriately.
rdbyte temp, pLeft wz
add pLeft, #1
if_z jmp #:leftEnd
rdbyte temp1, pRight wz
add pRight, #1
if_z jmp #:rightEnd
cmp temp, temp1 wc, wz
if_e jmp #StringCompare ' If they match, try the next pair.
jmp #StringCompare_ret ' Otherwise, we're done.
:leftEnd rdbyte temp1, pRight wz ' If we're at the end of both strings,
if_z jmp #StringCompare_ret ' leave (with Z set).
' Otherwise, left string is shorter than the right
' and therefore less.
neg temp, #1
mov temp, temp wc, wz ' Set C=1 and Z=0 for "less than"
jmp #StringCompare_ret
:rightEnd ' Here we've reached the end of the right string.
' The left string is longer than the right
' and therefore greater.
mov temp, #1 wc, wz ' Set C=0 and Z=0 for "greater than"
StringCompare_ret
ret
temp res 1
temp1 res 1
ptr res 1
pLeft res 1
pRight res 1
pString res 1
pTable res 1
pInput res 1
pOutput res 1
pSync res 1
retval res 1
{{
Copyright (c) 2009 Michael Park
+------------------------------------------------------------------------------------------------------------------------------+
| TERMS OF USE: MIT License |
+------------------------------------------------------------------------------------------------------------------------------+
|Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation |
|files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use, copy, |
|modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software|
|is furnished to do so, subject to the following conditions: |
| |
|The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.|
| |
|THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE |
|WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR |
|COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, |
|ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. |
+------------------------------------------------------------------------------------------------------------------------------+
}}