What follows are a collection of PASM routines that I've been using while 
tinkering with the assembler and parrot.  Feel free to use, mutilate, add 
to, discuss, mock.  They are:

        a tokenizer
        isalpha and isspace
        stack routines: sort, replace, peek, reverse
           a stack dump/display

Many of the stack routines need a "magic" register set (I5) to indicate the 
depth of the stack, some do not.  Where needed, it's indicated.  This 
limitation will go away some day.

Don't make fun of the sort, it works and is reasonable for small 
sorts.  :)  If you've got a better idea, patches welcome.  There's probably 
a terribly clever way to sort a stack using only a couple of registers, 
push, pop, and rotate_up.  I'm not that clever.

As soon as the I/O routines are GC safe and readline() takes the correct 
arguments (doesn't play well with OPEN!) I might have some interesting code 
to show these off.  I should probably fix the XML pseudo-Parser to use this 
improved tokenizer.  Hrm..  Sample usage:

        set S10, "10 PRINT 'HELLO WORLD'"
        bsr TOKENIZER
        restore I5
        bsr REVERSESTACK
        restore S1  # Line number
        dec I5        # Stack depth counting.  Grrr..
        restore S2  # Keyword (print)
        dec I5
        restore S3  # Arg ('hello world')
        dec i5
        # etc...
        end

[I'm not subscribed to p6i, but catch it in archives.  CC 
[EMAIL PROTECTED] if it's important]

# tokenizer
#   Input: string to be parsed on the stack (will be removed)
#  Output: stack contains number of tokens first,
#          then the tokens as seen right to left
# Quotes (single or double) are *preserved* so that
#     Foo "bar hlaghalg"
#   is two tokens, and the second is "bar hlaghalg"
#
TOKENIZER:
        pushi
        pushs
        set I6, 0    # Inquote
        set I7, 0    # ALPHA
        restore S10  # String to tokenize
        set I5, 0    # Stack pointer
        set S9, ""   # Playground
TOKLOOP: length I0, S10
        eq I0, 0, ENDTOK
        substr S1, S10, 0, 1
        dec I0
        substr S10, S10, 1, I0

        eq S1, "'", QUOTE
        eq S1, '"', QUOTE
        branch CKQUOTED

QUOTE:  ne I6, 0, EOTOK
        set I6, 1
        set S9, S1
        branch TOKLOOP
EOTOK:  set I6, 0
        concat S9, S1
        save S9
        inc I5
        set S9, ""
        branch TOKLOOP
CKQUOTED:
        eq I6, 0, NOTQUOTED
        concat S9, S1
        branch TOKLOOP
NOTQUOTED:
        save S1
        bsr ISWHITE
        restore I2
        ne I2, 1, NOTSPACE  # Spaces will end a token
        length I0, S9
        eq I0, 0, TOKLOOP
        save S9
        inc I5
        set S9, ""
        branch TOKLOOP
NOTSPACE:
        save S1
        bsr ISALPHA
        restore I0
        length I1, S9
        ne I1, 0, NOTEMPTY
        set S9, S1
        set I7, I0
        branch TOKLOOP
NOTEMPTY:
        ne I0, I7, TOKCHANGED
        concat S9, S1
        branch TOKLOOP
TOKCHANGED:
        save S9
        inc I5
        set S9, S1
        set I7, I0
        branch TOKLOOP
ENDTOK: length I0, S9
        eq I0, 0, TOKBAIL
        save S9
        inc I5
TOKBAIL:save I5
        popi
        pops
        ret

# User Stack Dump (Debugging.)
#   ** I5 should contain the stack depth,
#   ** until I get some method of determining depth
# Types
#      1 is an int
#      2 is a  num
#      3 is a  string
#      4 is a  PMC
DUMPSTACK:
        pushi
        pushn
        pushs
        pushp
        print "Stack Dump: (top to bottom)\n"
        set I0, I5
        gt I5, 0, DUMPLOOP
        print "  -empty-\n"
        branch DUMPEND
DUMPLOOP:
        entrytype I1, 0
        print "   "
        sub I2, I5, I0
        print I2
        print "  "
        ne I1, 1, DUMPNOTINT
        print "Int "
        restore I1
        save I1
        print I1
        branch DUMPANOTHER
DUMPNOTINT:
        ne I1, 2, DUMPNOTNUM
        print "Num "
        restore N0
        save N0
        print N0
        branch DUMPANOTHER
DUMPNOTNUM:
        ne I1, 3, DUMPNOTSTRING
        print "Str "
        restore S1
        save S1
        print S1
        branch DUMPANOTHER
DUMPNOTSTRING:
        ne I1, 4, DUMPERR
        print "PMC "
        restore P0
        save P0
        print P0
        branch DUMPANOTHER
DUMPANOTHER:
        print "\n"
        rotate_up I5
        dec I0
        eq I0, 0, DUMPEND
        branch DUMPLOOP
DUMPEND:
        popi
        popn
        pops
        popp
        ret
DUMPERR:
        print "UNKNOWN TYPE\n"
        end

# Stack Library
#  This'll get a whole lot cleaner when I can tell the
#  depth of the stack automagically

# peek -- return whatever string is on the stack
#   Inputs: the offset on the stack
#  Outputs: the string
# Non-Destructive!
# Does *not* test for bounds conditions
PEEK:   pushi
        restore I0
        set I3, I0
        inc I0
        set I2 0
PLOOP:  ge I2, I3, POL
        rotate_up I0
        inc I2
        branch PLOOP
POL:
        restore S0
        save S0
        eq I0, 0, EOP
        rotate_up I0

EOP:    save S0
        popi
        ret

# REPLACE -- replace thing at stack position X
#   Inputs: the offset to remove
#  Outputs: the string to leave in its place
#     Note: Almost *identical* to PEEK above
# Does *not* test for bounds conditions
REPLACE: pushi
        pushs
        restore S1
        restore I0
        set I3, I0
        inc I0
        set I2, 0
RLOOP:  ge I2, I3, ROL
        rotate_up I0
        inc I2
        branch RLOOP
ROL:    restore S0
        save S1
        eq I0, 0, ENDOFREPLACE
        rotate_up I0
ENDOFREPLACE:
        save S0
        popi
        pops
        ret

# swap -- swap the position of two strings on the stack
#  Inputs: Offsets of the two things on the stack
# Outputs: None.
SWAP:   pushi
        pushs

        restore I0
        restore I1
        save I0
        save "-"     # Just a dummy
        bsr REPLACE

        restore S0
        save I1
        save S0

        bsr REPLACE

        restore S1
        save I0
        save S1

        bsr REPLACE
        restore S1   # dummy
        popi
        pops
        ret


# Sort whatever's on the stack.
#   Yes, this is a bubble sort.  Get over it.
#  Inputs:  I5 *must* be set to the stack depth
# Outputs:  None
#

SORTSTACK:
        pushi
        pushn
        pushs

        set I0, 0
        set I1, 0
BUBBLE: inc I1
        le I1, I0, BUB1
        set I1, 0
        inc I0
BUB1:   ge I0, I5, SORTEND
        save I1
        bsr PEEK
        restore S2
        save I0
        bsr PEEK
        restore S3
        le S2, S3, BUBBLE
        save I1
        save I0
        bsr SWAP
        branch BUBBLE

SORTEND:
        popi
        popn
        pops
        ret

# Reverse the stack
#   Inputs: I5 *must* be set to the stack depth
#  Outputs: None
REVERSESTACK:
        pushi
        set I0, I5
REVSHIFT:
        eq I0, 0, REVERSEEND
        rotate_up I0
        dec I0
        branch REVSHIFT
REVERSEEND:
        popi
        ret



# Test for alphabeticness (7-bit ASCII only)
#  Input: (1-char) String on stack (will be removed)
# Output: 0 or 1 (integer) on stack
# Ex:   save "<"
#       bsr ISALPHA
#       restore I2  # False!
#
ISALPHA:
        pushi
        pushs
        restore S1
        ge S1, "A", UPPER
        branch NONUP
UPPER:  le S1, "Z", ALPHA
NONUP:
        ge S1, "a", LOWER
        branch NONLOW
LOWER:  le S1, "z", ALPHA
NONLOW:
        ge S1, "0", NUMBER
        branch NONUM
NUMBER: le S1, "9", ALPHA
NONUM:  eq S1, "_", ALPHA
        # Not A-Z0-9_
        set I1, 0
        branch LEAVE_ISALPHA
ALPHA:  set I1, 1
LEAVE_ISALPHA:
        save I1
        popi
        pops
        ret

# Test for whitespace (tab, space, newline)
#  Input: (1-char) String on stack (will be removed)
# Output: 0 or 1 (integer) on stack
ISWHITE:
        pushi
        pushs
        set I1, 1
        restore S1
        eq S1, " ", LEAVEWHITE
        eq S1, "\n", LEAVEWHITE
        eq S1, "\t", LEAVEWHITE
        set I1, 0
LEAVEWHITE:
        save I1
        popi
        pops
        ret

Reply via email to