develooper Front page | perl.cvs.parrot | Postings from April 2002

cvs commit: parrot/languages/BASIC README.BASIC alpha.pasm basic.pasm basic.pl basicvar.pasm dumpstack.pasm expr.pasm instructions.pasm sample2.bas sample3.bas sample4.bas stackops.pasm tokenize.pasm wumpus.bas

From:
jgoff
Date:
April 10, 2002 18:26
Subject:
cvs commit: parrot/languages/BASIC README.BASIC alpha.pasm basic.pasm basic.pl basicvar.pasm dumpstack.pasm expr.pasm instructions.pasm sample2.bas sample3.bas sample4.bas stackops.pasm tokenize.pasm wumpus.bas
Message ID:
20020411012600.17650.qmail@netlabs.develooper.com
cvsuser     02/04/10 18:26:00

  Added:       languages/BASIC README.BASIC alpha.pasm basic.pasm basic.pl
                        basicvar.pasm dumpstack.pasm expr.pasm
                        instructions.pasm sample2.bas sample3.bas
                        sample4.bas stackops.pasm tokenize.pasm wumpus.bas
  Log:
  Adding clintp's BASIC interpreter.
  
  Revision  Changes    Path
  1.1                  parrot/languages/BASIC/README.BASIC
  
  Index: README.BASIC
  ===================================================================
  VERSION
  -------
  $Id: README.BASIC,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  
  DESCRIPTION
  -----------
  This is an initial release of a BASIC interpreter hand written 
  entirely in Parrot bytecode.  The NOTES below are intended for Parrot 
  developers.
  
  This README will always reflect the *current* state of things.
  
  This BASIC is of the fairly old school.  Line numbers are required, and
  the following keywords are recognized:
  
  	LIST
  	LIST expr-expr
  	RUN
  	LOAD progname [loads in progname.bas]
  	PRINT
  	PRINT expr
  	PRINT expr;   [supress newline]
  	DIM           [a no-op]
  	LET var=expr
  	INPUT var    
  	FOR var=expr TO expr
  	FOR var=expr TO expr STEP expr
  	GOSUB expr
  	RETURN
  	GOTO expr
  	GO TO expr    [syn with GOTO]
  	IF expr THEN STATEMENT
  	READ var
  	DATA val, val, val, val
  	RESTORE
  	END
  	REM
  	NEW
  	QUIT          [exits interpreter]
  
  The following functions are supported in the full expression parser:
  
  	RND(X)	Random number between 0 and X
  	ABS(X)  Absolute value of X
  	LEN(X)  Length of string in X
  	MID(X,Y,Z)
  		Return the string of X, starting at position Y (1-based),
  	        for length Z.
  	ASC(X)  Return the ASCII code for the character X
  	CHR(X)  Return the ASCII character for the code X
  
  Additionally, the expression parser understands:
  	*+/-    Operators, will perform them
  	+	Between two things that don't both look like numbers will
  		cause concatenation instead.
  	-       Unary minus
  	,       Construction of tuples.  5,I+34*2,"FOO",A$ will be
  		reduced to a 4-element list (comma-separaed) with all
  		possible evaluations done.
  	AND,OR  Logical
  	><<>=   Comparison (returns 1 or 0)
  
  
  BASIC NOTES
  -----------
     Variable name width: 12
     Multidimensional variables: Numeric--total name length w/subscripts, 12
     String delimiters: ' and ", interchangeable
     Conditionals: < > = and <> (not equal)
     Math: Integer arithmetic only
     Case sensitive: All statements and keywords
     Line numbers: Required, up to 12 digits in length
     
  * GOSUB/FOR-NEXT may be nested to arbitrary depths.  Cross-nesting loops, returning
    from within a loop, or NEXT within a subroutine will cause the stack to be cleared
    back to the appropriate point.
  * The values in DATA statements are evaluated at RUNTIME.  Thus, it's
    entirely possible to put variables in DATA statements
  * Anywhere var is indicated, a multidimensional variable (string or array) is allowed.
  * Strings do not have to be pre-DIMensioned any longer.
  * For IF statements, 0 or empty string is false everything else is true.
  * Line lookups are now fast.   Well, as reasonably fast as they can be without hashes.
  
  
  This was intended as a true interactive BASIC (see NOTES below) so that
  any of the variables and statements work from the prompt as well as in the
  body of the stored program.  Entering in a new line number overwrites the line
  in the existing program
  
  DISTRIBUTION
  ------------
  Included in this distribution are the following files, some of which may be
  of general interest, some only apply to BASIC:
  
  	alpha.pasm		Alpha/Numeric library
  	dumpstack.pasm		Diagnostic stack dumping
  	expr.pasm		Expression evaluator
  	stackops.pasm		Stack operations
  	tokenize.pasm	  	A simple string tokenizer
  
  	basic.pasm		The instruction dispatcher
  	basicvar.pasm		Storage/Retrieval of BASIC strings, numbers, 
  				code
  	instructions.pasm	BASIC instructions
  	sample.bas		Small BASIC example.
  	sample2.bas		Shows off some of the BASIC syntax and instructions
  	sample3.bas		More showing off.
  
  	basic.pl		Perl Harness for compiling, starting BASIC 
  				in interactive mode.
  	wumpus.bas		Hunt the Wumpus in BASIC
  
  NOTES
  -----
  Very large programs or very, very large expressions will expose Parrot's GC bugs
  quickly.  This will manifest itself in a SEGV (likely, hang, garbled output, 
  or "wrong type on stack" messages.
  
  The expr.pasm module contains a full expression evaluator.  It's tied to BASIC through a 
  few subroutines (to do variable and function resolution) but otherwise it's a general-purpose
  evaluator.  Of special note is the Infix to Postfix notation conversion function.
  
  TODO
  -----
  * Implement SAVE
  * Optimize variable lookups.  They're O(N) now.  If the interpreter seems
    slow, THIS is why.  
      That and it's not compiling anything ahead of time.  
      All runtime interpretation, baby!
  
  
  CONTACT
  -------
  Clinton Pierce <clintp@geeksalad.org>
  "clintp" irc.rhizomatic.net #perl or #parrot
  
  LICENSE
  -------
  Redistributable under the terms of any current version of Perl
  
  
  
  
  
  1.1                  parrot/languages/BASIC/alpha.pasm
  
  Index: alpha.pasm
  ===================================================================
  # 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!
  #
  # $Id: alpha.pasm,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  # $Log: alpha.pasm,v $
  # Revision 1.1  2002/04/11 01:25:59  jgoff
  # Adding clintp's BASIC interpreter.
  #
  # Revision 1.3  2002/03/31 05:15:31  Clinton
  # Adjusted
  #
  # Revision 1.2  2002/03/31 05:13:32  Clinton
  # Id Keywords
  #
  #
  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, any low-ASCII stuff)
  #  Input: (1-char) String on stack (will be removed)
  # Output: 0 or 1 (integer) on stack
  ISWHITE:
  	pushi
  	pushs
  	set I1, 1
  	restore S1
  	le S1, " ", LEAVEWHITE
  	eq S1, "\n", LEAVEWHITE
  	eq S1, "\t", LEAVEWHITE
  	eq S1, "\r", LEAVEWHITE
  	set I1, 0
  LEAVEWHITE:
  	save I1
  	popi
  	pops
  	ret
  
  # strnchr -- offset first occurance of X in Y
  #  Inputs: Start offset
  #          Character on stack (Y)
  #	   String on stack (X)
  # Outputs: Offset on stack, -1 if not found
  STRNCHR:
  	pushi
  	pushs
  	restore I0  # Offset
  	restore S0  # Char
  	restore S1  # String
  	set S2, ""
  	set I2, -1  # Not found
  	length I3, S1
  	set I4, I0
  	gt I4, I3, STRNCHRERR
  
  STRNLOOP:
  	eq I3, I4, ENDSTRNCHR
  	substr S3, S1, I4, 1
  	eq S3, S0, STRNGOTONE
  	inc I4
  	branch STRNLOOP
  STRNGOTONE:
  	set I2, I4
  
  ENDSTRNCHR:
  	save I2
  	popi
  	pops
  	ret
  STRNCHRERR:
  	puts "String position out of bounds.  ERR\n"
  	end
  	
  # atoi -- String to integer
  #  Inputs: String on stack
  # Outputs: Integer on top of the stack.
  # Note: Invalid characters aren't currently handled
  # TODO: Ignore spaces
  # Ha!  Turns out there's already an opcode to do this
  #  Backwards compatability only!
  ATOI:   pushi
  	pushs
  	restore S0
  	set I0, S0
  	save I0
  	popi
  	pops
  	ret
  
  # itoa  -- Integer to string
  #  Inputs: Integer on stack
  # Outputs: String on top of the stack
  # Ha!  Turns out there's already an opcode to do this
  #  Backwards compatability only!
  ITOA: 	pushi
  	pushs
  	restore I0
  	set S0, I0
  	save S0
  	popi
  	pops
  	ret
  
  # Stripspace
  #  Inputs: string on stack
  # Outputs: string on stack, less trailing spaces
  STRIPSPACE:
  	pushi
  	pushs
  	restore S0
  	length I0, S0
  	eq I0, 0, SSDONE
  	dec I0
  SSCHECK:
  	set S1, ""
  	substr S1, S0, I0, 1
  	save S1
  	bsr ISWHITE
  	restore I1
  	eq I1, 0, SSDONE
  	substr S0, S0, 0, I0
  	eq  I0, 0, SSDONE
  	dec I0
  	branch SSCHECK
  SSDONE:
  	save S0
  	popi
  	pops
  	ret
  
  STRIPLEADSPACE:
  	pushi
  	pushs
  	set S0, ""
  	set S1, ""
  	restore S0  # Edit me!
  SLSLOOP:
  	length I0, S0
  	le I0, 0, SLSEXIT
  	substr S1, S0, 0, 1
  	ne S1, " ", SLSEXIT
  	dec I0
  	substr S0, S0, 1, I0
  	branch SLSLOOP
  SLSEXIT:
  	save S0
  	popi
  	pops
  	ret
  
  
  # Stringinsert  -  Insert string X into Y at position N
  #  Inputs: Position
  #          String to Insert
  #          Target String
  # Outputs: Final String
  STRINSERT:
  	pushi
  	pushs
  	restore I0
  	restore S0  # Insert string
  	restore S1  # Insert into string
  	set S3, ""  # The first part
  	set S2, ""  # The second part
  	length I1, S1
  	ne I0, 0, STRNOTZERO
  	set S2, S1	# Inserting at 0
  	branch ENDSTRINSERT
  STRNOTZERO:
  	substr S3, S1, 0, I0
  	substr S2, S1, I0, I1
  ENDSTRINSERT:
  	set S10, ""
  	concat S10, S3
  	concat S10, S0
  	concat S10, S2
  	save S10
  	popi
  	pops
  	ret
  
  # stringreplace -- Replace Characters in a string
  #  Inputs: Position
  #	   Number of characters to replce
  #          String to Insert
  #          Target String
  # Outputs: Final String
  #
  STRREPLACE:
  	pushi
  	pushs
  	restore I0  # Offset
  	restore I1  # How many to replace
  	restore S0  # Insert String
  	restore S1  # Insert into String
  	length I3, S1
  	set S3, ""  # First part
  	set S2, ""  # Second part
  	substr S3, S1, 0, I0
  	add I0, I0, I1
  	sub I3, I3, I1
  	substr S2, S1, I0, I3
  	set S10, ""
  	concat S10, S3
  	concat S10, S0
  	concat S10, S2
  	save S10
  	popi
  	pops
  	ret
  
  # pad -- space padding (trailing)
  #  Inputs: length
  #          string
  # Outputs: string
  # NO BOUNDS CHECKING
  PAD:
  	pushi
  	pushs
  	restore I0
  	restore S0
  
  	set S1, ""
  	length I1, S0
  	concat S1, S0
  	sub I0, I0, I1
  	le I0, 0, PADE
  	repeat S9, " ", I0
  	concat S1, S9
  PADE:   save S1
  	popi
  	pops
  	ret
  
  # isnum -- is this thing a number?
  #  Inputs: string on stack
  # Outputs: 1 if it is, 0 if it is not
  # Converts to integer and back, if that worked then it's a number.
  #  (Simple view of the world  :)
  ISNUM:
  	pushi
  	pushs
  	restore S0  # The thing in question
  	save S0
  	bsr ATOI
  	bsr ITOA
  	restore S1
  	eq S1, S0, ISNUM_YES
  	save 0
  	branch ENDISNUM
  ISNUM_YES:
  	save 1
  ENDISNUM:
  	popi
  	pops
  	ret
  
  
  
  1.1                  parrot/languages/BASIC/basic.pasm
  
  Index: basic.pasm
  ===================================================================
  # Encode/Decode BASIC instructions and dispatch them
  #
  # Global Resources
  #     I20 - Immediate Mode/Run Mode flag  =1 RUN  =0 IM
  #     I22 - Please stop running flag
  #     I23 - Program counter
  #     I24 - Random number generator seed
  #     I26 - Line number for last READ
  #     I27 - Item number for last READ
  #
  # $Id: basic.pasm,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  # $Log: basic.pasm,v $
  # Revision 1.1  2002/04/11 01:25:59  jgoff
  # Adding clintp's BASIC interpreter.
  #
  # Revision 1.4  2002/04/07 04:10:07  Clinton
  # Can't remember
  #
  # Revision 1.3  2002/04/01 22:16:54  Clinton
  # Added DUMP copcode, protection for random seed
  #
  # Revision 1.2  2002/03/31 05:13:52  Clinton
  # Id Keywords
  #
  
  #
  # runline -- executes a BASIC instruction
  #  Inputs: Code line text on stack
  # Outputs: 0 everything peachy !=0 Error
  #
  RUNLINE:
  	pushi
  	pushs
  
  	set I4, -1
  	bsr TOKENIZER
  	bsr REVERSESTACK
  
  RUN_INSERT:
  	restore I5   # Depth
  	# This is the insertion point
  	#   for "IF"
  	eq I20, 0, NOLINE
  	dec I5
  	bsr ATOI
  	restore I4
  
  NOLINE: restore S0
  	save S0
  	save I5  # New Depth
  	save I4  # Line number
  	set I22, 0 # Error flag
  
  	#print "Dispatching "
  	#print I4
  	#print "\n"
  
  
  	# Table of all keywords
  	ne S0, "LOAD", NOT_LOAD
  	bsr I_LOAD
  	branch ENDLINE
  
  NOT_LOAD:
  	ne S0, "REM", NOTREM
  	bsr I_REM
  	branch ENDLINE
  
  NOTREM: ne S0, "PRINT", NOTPRINT
  	bsr I_PRINT
  	branch ENDLINE
  
  NOTPRINT: ne S0, "LET", NOTLET
  	bsr I_LET
  	branch ENDLINE
  
  NOTLET: ne S0, "DIM", NOTDIM
  	bsr I_DIM
  	branch ENDLINE
  
  NOTDIM: ne S0, "GOTO", NOTGOTO
  	bsr I_GOTO
  	branch ENDLINE
  
  NOTGOTO: ne S0, "GO", NOTGO_TO
  	bsr I_GOTO
  	branch ENDLINE
  
  NOTGO_TO: ne S0, "IF", NOTIF
  	bsr I_IF
  	branch ENDLINE
  
  NOTIF: ne S0, "FOR", NOTFOR
  	bsr I_FOR
  	branch ENDLINE
  
  NOTFOR: ne S0, "NEXT", NOTNEXT
  	bsr I_NEXT
  	branch ENDLINE
  
  NOTNEXT: ne S0, "GOSUB", NOTGOSUB
  	bsr I_GOSUB
  	branch ENDLINE
  
  NOTGOSUB: ne S0, "RETURN", NOTRETURN
  	bsr I_RETURN
  	branch ENDLINE
  
  NOTRETURN:ne S0, "LIST", NOTLIST
  	bsr I_LIST
  	branch ENDLINE
  
  NOTLIST: ne S0, "END", NOTEND
  	bsr I_END
  	branch ENDLINE
  
  NOTEND: ne S0, "RUN", NOTRUN
  	bsr I_RUN
  	branch ENDLINE
  
  NOTRUN: ne S0, "QUIT", NOT_QUIT
  	end
  
  NOT_QUIT: ne S0, "NEW", NOT_NEW
  	bsr I_NEW
  	branch ENDLINE
  
  NOT_NEW: ne S0, "INPUT", NOT_INPUT
  	bsr I_INPUT
  	branch ENDLINE
  
  NOT_INPUT: ne S0, "RESTORE", NOT_RESTORE
  	bsr I_RESTORE
  	branch ENDLINE
  
  NOT_RESTORE: ne S0, "DATA", NOT_DATA
  	bsr I_DATA
  	branch ENDLINE
  
  NOT_DATA: ne S0, "READ", NOT_READ
  	bsr I_READ
  	branch ENDLINE
  
  NOT_READ: ne S0, "DUMP", NOT_DUMP
  	bsr I_DUMP
  	branch ENDLINE
  
  NOT_DUMP:
  	
  
  RUN_ILL_INSTRUCTION:
  	restore I4
  	bsr CLEAR
  	restore I0  # Dummy
  	print "BAD KEYWORD at line "
  
  	save I4
  	bsr ITOA
  	restore S31   # Convert for puts
  	print S31
  
  	print "\n"
  	save 1
  	ret
  
  ENDLINE:ne I22, 0, LINEERR
  	save 0  # No errors
  	branch NOERR
  LINEERR:save I22
  NOERR:  save S20
  	save S21
  	save S22
  	save I23
  	save I25
  	save I26
  	save I27
  	save I20
  	save I24
  	popi
  	pops
  	restore I24
  	restore I20
  	restore I27
  	restore I26
  	restore I25
  	restore I23
  	restore S22
  	restore S21
  	restore S20
  	ret
  
  
  
  1.1                  parrot/languages/BASIC/basic.pl
  
  Index: basic.pl
  ===================================================================
  #!/usr/bin/perl -w
  # BASIC in PASM build harness program
  #
  # $Id: basic.pl,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  # $Log: basic.pl,v $
  # Revision 1.1  2002/04/11 01:25:59  jgoff
  # Adding clintp's BASIC interpreter.
  #
  # Revision 1.5  2002/04/07 04:10:07  Clinton
  # Debugging
  #
  # Revision 1.4  2002/04/01 22:16:54  Clinton
  # Seed Random Number generator with time
  #
  # Revision 1.3  2002/03/31 05:14:02  Clinton
  # Id Keywords
  #
  # Revision 1.2  2002/03/31 05:09:57  Clinton
  # *** empty log message ***
  #
  # Revision 1.1  2002/03/31 04:54:21  Clinton
  # Initial revision
  #
  # $Id: basic.pl,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  # $Log: basic.pl,v $
  # Revision 1.1  2002/04/11 01:25:59  jgoff
  # Adding clintp's BASIC interpreter.
  #
  # Revision 1.5  2002/04/07 04:10:07  Clinton
  # Debugging
  #
  # Revision 1.4  2002/04/01 22:16:54  Clinton
  # Seed Random Number generator with time
  #
  # Revision 1.3  2002/03/31 05:14:02  Clinton
  # Id Keywords
  #
  #
  
  open(T, ">test.pasm") || die;
  
  $a=<<'EOF';
  
  # I5 Stack Depth?
  
  	set S20, "#"
  	set S21, "#"
  	set S22, "#"
  	time I24      # Seed the random number generator
  
  	branch MAIN
  
  .include stackops.pasm
  .include alpha.pasm
  .include dumpstack.pasm
  .include tokenize.pasm
  .include basicvar.pasm
  .include basic.pasm
  .include instructions.pasm
  .include expr.pasm
  
  
  MAIN:
  	save 0  # Initialize the runtime stack!
  
  MAINLOOPR:
  	print "\n\nReady\n"
  	bsr CLEAR  # This should keep the runtime stack clean
  
  MAINLOOPNR:
  	set I20, 0    # Interactive mode
  	set S0, ""
  	
  	set S0, ""
  	read S0, 256
  	length I1, S0
  	eq I1, 1, MAINLOOPR
  	clone S1, S0
  	set S0, S1
  	save S0
  	bsr STRIPSPACE
  
  	restore S0  # This *should* be a no-op, it's not.  *puzzle*
  	save S0     #   without it the string retains a trailing CR
  
  	bsr TOKENIZER
  	bsr REVERSESTACK
  	restore I5
  	eq I5, 0, ENDMAINLOOPNR  # No tokens!
  	bsr ISNUM
  	restore I1
  	dec I5
  	save I5
  	bsr CLEAR
  	restore I0 # dummy
  
  	eq I1, 0, DOLINE
  	save S0
  	bsr CSTORE
  	branch ENDMAINLOOPNR
  
  DOLINE:
  	save S0
  	bsr RUNLINE
  	restore I0
  	branch ENDMAINLOOP
  	end
  
  ENDMAINLOOP:
  	branch MAINLOOPR 
  ENDMAINLOOPNR:
  	branch MAINLOOPNR
  
  EOF
  
  # Includes and constant substitutions
  $a=~s/^\.include (.*)/open(F,$1) and print STDERR "Including $1\n" and join('', <F>)/mge;
  $tab{$2}=$3 while($a=~s/^(\.const\s+([^\s]+)\s+([^\s]+))/#$1/m);
  for (keys %tab) {
  	$a=~s/\b${_}\b/$tab{$_}/g ;
  }
  $b=()=$a=~m/\n/g;
  print "  $b lines\n";
  $a=~s/\bputs\b/print/g;   # puts() breaks things.
  print T $a;
  
  close(T);
  unlink "out.pbc";
  system("perl assemble.pl test.pasm > out.pbc");
  
  system("parrot out.pbc");
  
  
  
  
  
  1.1                  parrot/languages/BASIC/basicvar.pasm
  
  Index: basicvar.pasm
  ===================================================================
  # Basic variable and code storage management
  #
  # Global Resources:
  #   S20
  #   S21
  #   S22  Numeric/String/Code variable storage formatted as:
  #         8 bytes (name).  Terminates with "#"  Line number for Code
  #	  3 bytes (width)  N=12
  #     width bytes (value)
  #
  #   I18  Cached line number
  #   I19  Cached line position
  #
  # Subscripted variables are stored independently of each other as:
  #   varname|subscr,subscr   (the subscripts will be reversed)
  #   The limit to subscripting is:
  #     (Length of variable name)[+1+subscriptlen+1+[subscriptlen+1]...
  #     So that FOO(56,1) will occupy FOO|1,56 an 8-byte slot
  #
  # $Id: basicvar.pasm,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  # $Log: basicvar.pasm,v $
  # Revision 1.1  2002/04/11 01:25:59  jgoff
  # Adding clintp's BASIC interpreter.
  #
  # Revision 1.8  2002/04/09 03:14:31  Clinton
  # Optimized line lookups by using I18 and I19 as a line number
  # cache and pointer
  #
  # Revision 1.7  2002/04/07 00:52:31  Clinton
  # Fixed accidental STRIPSPACE on string storage
  #
  # Revision 1.6  2002/04/06 21:24:53  Clinton
  # Added advanced string handling.  String vars are created automagically now
  #
  # Revision 1.5  2002/04/06 19:58:52  Clinton
  # Before allowing undimensioned strings.
  # Added VDESTROY capability
  #
  # Revision 1.4  2002/04/01 22:16:54  Clinton
  # Changed load sequence a bit
  #
  # Revision 1.3  2002/03/31 05:15:31  Clinton
  # Adjusted
  #
  # Revision 1.2  2002/03/31 05:13:48  Clinton
  # Id Keywords
  #
  
  .const NTYPE 0
  .const STYPE 1
  .const CTYPE 2
  .const NAMEWIDTH 15
  .const VARWIDTH 3
  .const TERMINATOR "-"
  .const STRINGMINW 10
  
  # (internal) Find variable
  #  Inputs: variable name (or code line number)
  #          type
  # Outputs: offset, -1 if unknown
  VFIND:  pushi
  	pushs
  	restore I5
  	restore S5
  	length I0, S5
  	gt I0, NAMEWIDTH, VFINDTOOLONG
  
  	set S15, S20  # Assume Ints
  	eq I5, NTYPE, VSEARCH
  	set S15, S21  # Strings?
  	eq I5, STYPE, VSEARCH
  	set S15, S22  # Code then
  	save S5
  	bsr ATOI
  	restore I6    # Line numbers are numeric
  
  VSEARCH:
  	set I0, -1
  	set I1, 0
  	ne I5, CTYPE, VFINDL
  	set I1, I18
  
  VFINDL:
  	set S2, ""
  	substr S2, S15, I1, NAMEWIDTH
  	save S2
  	bsr STRIPSPACE
  	restore S2	       # Var name/line #
  	eq S2, S5, VFOUND     # Exact match
  	eq S2, "#", VFINDEND  # Exhausted
  	ne I5, CTYPE, VNOTFOUND
  	save S2
  	bsr ATOI
  	restore I2
  	ge I2, I6, VFOUND
  VNOTFOUND:
  	add I1, I1, NAMEWIDTH
  	set S2, ""
  	substr S2, S15, I1, VARWIDTH
  	save S2
  	bsr STRIPSPACE
  	bsr ATOI
  	restore I2
  	add I1, I1, VARWIDTH
  	add I1, I1, I2
  	branch VFINDL
  VFOUND:
  	set I0, I1
  VFINDEND:
  	save I0
  	popi
  	pops  # Read-only no S20 restore needed
  	ret
  VFINDTOOLONG:
  	print "SYMBOL NAME TOO LONG: "
  	print S5
  	print "\n"
  	end
  
  # Create a variable  UNINITIALIZED
  #  Inputs: Variable name
  #          type
  #          width
  # Outputs: none
  VCREATE:
  	pushi
  	pushs
  	restore I6  # Width
  	restore I5  # Type
  	restore S0  # The variable name
  
  	set S15, S20  # Assume Ints
  	eq I5, NTYPE, VCSTART
  	set S15, S21  # Strings?
  	eq I5, STYPE, VCSTART
  	set S15, S22  # Code then
  VCSTART:
  	save "#"
  	save I5
  	bsr VFIND  # Find the end
  	restore I0
  
  	# Assemble the new
  	save S0
  	save NAMEWIDTH
  	bsr PAD
  	restore S9
  	concat S10, S9
  
  	save I6
  	bsr ITOA
  	save VARWIDTH
  	bsr PAD
  	restore S9
  	concat S10, S9
  
  	repeat S9, " ", I6
  	concat S10, S9
  
  	save S15
  	save S10
  	save I0
  	bsr STRINSERT  # New is on stack
  
  VCREND: save I5
  	popi
  	pops
  	restore I5
  	ne I5, NTYPE, VCNOTNUM
  	restore S20
  	branch VCBAIL
  VCNOTNUM:
  	ne I5, STYPE, VCNOTSTR
  	restore S21
  	branch VCBAIL
  VCNOTSTR:
  	restore S22 # Code
  VCBAIL: ret
  
  # Set variables
  # (We assume they exist already, a runtime error occurs otherwise)
  #  Inputs: Value is on the stack
  #	   Name is on the stack
  #          Width is on the stack
  # Outputs: (none)
  VSTORE:
  	pushi
  	pushs
  	restore S5  # Value (I will space pad)
  	restore I6  # width
  	restore I5  # type
  	restore S0  # Variable name
  
  	save S0
  	save I5
  	bsr VFIND
  	restore I0  # Location
  	eq I0, -1, VSTOREERR
  
  	set S15, S20  # Assume Ints
  	eq I5, NTYPE, VSSTART
  	set S15, S21  # Strings?
  	eq I5, STYPE, VSSTART
  	set S15, S22  # Code then
  VSSTART:
  	add I0, I0, NAMEWIDTH
  	substr S1, S15, I0, VARWIDTH
  	save S1
  	bsr STRIPSPACE
  	bsr ATOI
  	restore I1
  	ne I1, I6, VSTOREERR2
  
  	add I0, I0, VARWIDTH
  	save S5
  	save I1
  	bsr PAD
  	restore S5
  	save S15
  	save S5
  	save I1
  	save I0
  	bsr STRREPLACE
  
  	save I5
          popi
  	pops
  	restore I5
  	ne I5, NTYPE, VSNOTNUM
  	restore S20
  	branch VSBAIL
  VSNOTNUM:
  	ne I5, STYPE, VSNOTSTR
  	restore S21
  	branch VSBAIL
  VSNOTSTR:
  	restore S22 # Code
  VSBAIL: ret
  
  
  VSTOREERR:
  	print "NOVAR for STORE\n"
  	end
  VSTOREERR2:
  	print "WIDTH MISMATCH for STORE\n"
  	end
  
  # Fetch variables
  #  Inputs: Name is on the stack
  #          Type is on the stack
  # Outputs: The value on the stack (AS A STRING)
  VFETCH:
  	pushi
  	pushs
  	restore I5  # type
  	restore S0  # Variable name
  
  	save S0
  	save I5
  	bsr VFIND
  	restore I0  # Location
  	eq I0, -1, VFETCHERR
  
  	set S15, S20  # Assume Ints
  	eq I5, NTYPE, VFSTART
  	set S15, S21  # Strings?
  	eq I5, STYPE, VFSTART
  	set S15, S22  # Code then
  VFSTART:
  	add I0, I0, NAMEWIDTH
  	substr S1, S15, I0, VARWIDTH
  	save S1
  	bsr STRIPSPACE
  	bsr ATOI
  	restore I1    # Width of data
  	add I0, I0, VARWIDTH
  	substr S1, S15, I0, I1
  	save S1
  	popi
  	pops
  	ret
  
  VFETCHERR:
  	print "NOT DEFINED on FETCH\n"
  	end
  
  # Destroy a variable
  # Should only be called by the string stuff when a variable has exceeded maximum 
  # length and needs to be killed.
  #  Inputs: Name on stack
  #          Type on stack
  # Outputs: N/A
  VDESTROY:
  	pushi
  	pushs
  
  	restore I5    # Type
  	save I5
  
  	bsr VFIND
  	restore I0
  	eq I0, -1, VDESTROYEND
  
  	set S15, S20  # Assume Ints
  	eq I5, NTYPE, VDSTART
  	set S15, S21  # Strings?
  	eq I5, STYPE, VDSTART
  	set S15, S22  # Code then
  
  VDSTART:
  	add I1, I0, NAMEWIDTH
  	substr S1, S15, I1, VARWIDTH
  	save S1
  	bsr STRIPSPACE
  	bsr ATOI
  	restore I2    # Width of var storage entry
  
  	add I2, I2, NAMEWIDTH
  	add I2, I2, VARWIDTH
  
  	save S15
  	save ""
  	save I2
  	save I0
  	bsr STRREPLACE
  	restore S15
  
  	save S15
  	eq I5, NTYPE, VDNUM
  	eq I5, STYPE, VDSTRING
  	eq I5, CTYPE, VDCODE
  	branch VDFATAL
  
  VDNUM:  restore S20
  	branch VDESTROYEND
  VDSTRING:
  	restore S21
  	branch VDESTROYEND
  VDCODE:
  	restore S22
  	branch VDESTROYEND
  
  VDESTROYEND:	
  	save S20
  	save S21
  	save S22
  	popi
  	pops
  	restore S22
  	restore S21
  	restore S20
  	ret
  VDFATAL:
  	print "Unknown type in DESTROY"
  	end
  
  
  # All of these routines use, misuse and abuse I0, I1, S0, S1, S2
  #    Should be saved/restored okay though.
  
  # Numeric variable handling
  #   NCREATE (almost never needed)
  #   NSTORE
  #   NFETCH
  #
  # For all of these the general pattern is:
  #    push the name
  #    push the value (if needed)
  #    call
  #
  # Create Numeric
  .const NUMWIDTH 12
  NCREATE:
  	pushi
  	pushs
  	restore S0  # Name
  	save S0
  	save NTYPE
  	bsr VFIND
  	restore I0
  	ne I0, -1, NCREATED
  	save S0
  	save NTYPE
  	save NUMWIDTH
  	bsr VCREATE
  	save S0
  	save NTYPE
  	save NUMWIDTH
  	save "0"
  	bsr VSTORE
  NCREATED:
  	save S20
  	popi
  	pops
  	restore S20
  	ret
  
  # Store numerics
  NSTORE:
  	pushi
  	pushs
  	restore I1   # Value
  	restore S0   # Name
  
  	save S0
  	save NTYPE
  	bsr VFIND
  	restore I0
  	ne I0, -1, NSCREATED
  	save S0
  	save NTYPE
  	save NUMWIDTH
  	bsr VCREATE
  NSCREATED:
  	save I1
  	bsr ITOA
  	restore S1
  	save S0
  	save NTYPE
  	save NUMWIDTH
  	save S1
  	bsr VSTORE
  	save S20
  	popi
  	pops
  	restore S20
  	ret
  
  # Fetch Numerics
  NFETCH: pushi
  	pushs
  	restore S0
  	save S0
  	save NTYPE
  	bsr VFIND
  	restore I0
  	ne I0, -1, NFCREATED
  	save S0
  	bsr NCREATE
  NFCREATED:
  	save S0
  	save NTYPE
  	bsr VFETCH
  	bsr STRIPSPACE
  	bsr ATOI
  	save S20
  	popi
  	pops
  	restore S20
  	ret
  
  # String variable handling
  #   SCREATE (DIM)
  #   SSTORE
  #   SFETCH
  # Strings are \n terminated internally
  #
  # For all of these the general pattern is:
  #    push the name
  #    push the value (if needed)
  #    call
  #
  # Create String 
  # DIMENSION is now a no-op.
  SCREATE:
  	pushi
  	pushs
  	restore I1  # Dimensioned width
  	restore S0  # Name
  	inc I1      # Add one for the terminator
  	save S0
  	save STYPE
  	bsr VFIND
  	restore I0
  	ne I0, -1, DIMERROR
  	save S0
  	save STYPE
  	save I1
  	bsr VCREATE
  
  	save S0
  	save STYPE
  	save I1
  	save TERMINATOR
  	bsr VSTORE
  	save S21
  	popi
  	pops
  	restore S21
  	ret
  DIMERROR:
  	print "DIM FAILURE"
  	end
  
  # Strings are a little smarter now.  They work *exactly* like
  # numeric variables, except that if the store size exceeds the 
  # allocated storage we destroy the existing variable and create a new one.
  #
  SSTORE:
  	pushi
  	pushs
  	restore S1  # Value
  	restore S0  # Name
  	save S0
  	save STYPE
  	bsr VFIND
  	restore I0
  	eq I0, -1, NODIMERR
  	add I0, I0, NAMEWIDTH
  	substr S2, S21, I0, 3
  	save S2
  	bsr STRIPSPACE
  	bsr ATOI
  	restore I1   # Allowable width
  
  	#save S1
  	#bsr STRIPSPACE
  	#restore S1
  
  	length I0, S1
  	ge I0, I1, STRTOOLONG
  
  	concat S1, TERMINATOR
  STOREIT:
  	save S0
  	save STYPE
  	save I1
  	save S1
  	bsr VSTORE
  	save S21
  	popi
  	pops
  	restore S21
  	ret
  
  	# These are no longer errors.
  	# Create a new string slot
  	# Always create them for at least STRINGMINW
  NODIMERR:
  	concat S1, TERMINATOR
  	length I1, S1
  	gt I1, STRINGMINW, LENOKAY
  	set I1, STRINGMINW
  LENOKAY:save S0
  	save STYPE
  	save I1
  	bsr VCREATE
  	branch STOREIT
  
  	# Destroy the old slot, create a new one
  STRTOOLONG:
  	save S0
  	save STYPE
  	bsr VDESTROY
  	branch NODIMERR
  
  # Fetch a string
  # If the string wasn't previously dimensioned then
  # we return the empty string
  SFETCH:
  	pushi
  	pushs
  	restore S0  # Name
  	save S0
  	save STYPE
  	bsr VFIND
  	restore I0
  	ne I0, -1, GETSVAL
  	set S1, ""
  	branch RETSVAL
  
  GETSVAL:save S0
  	save STYPE
  	bsr VFETCH
  	bsr STRIPSPACE
  	restore S1
  
  	length I1, S1		# chopn S1, 1
  	dec I1
  	substr S1, S1, 0, I1
  
  RETSVAL:save S1
  	set S1, S1  # Fix bug?
  	popi
  	pops  # No state-saving needed
  	ret
  
  # Code Storage and Retrieval
  #  This...is...insane.  Takes arguments as though strings
  #
  #  CSTORE -- store a code line, overwriting existing lines.
  #  CFETCH -- fetch a code line.  NOTE: you'll get the line
  #            specified or *higher*
  
  # Fetch a line to be decoded.
  #   Inputs: Integer line number (on stack)
  #  Outputs: The line number (integer) found (-1 if none)
  # 	    The corresponding line or *the next higher*
  #
  # Line lookups now *start* where the last one left off.  For forward
  #   jumps, this means that only backwards jumps are O(n)
  #  
  #   I18 is the offset where the last line was found.
  #   I19 is the last line number found.
  #
  CFETCH: pushi
  	pushs
  	restore I1   # Line number we want
  	gt I1, I19, INCACHE
  	set I18, 0
  
  INCACHE:
  	save I1
  	bsr ITOA
  	save CTYPE
  	bsr VFIND
  	restore I0   # Offset, line that was found.
  	eq I0, -1, CNOLINE
  
  	set I18, I0  # Where to start next time
  
  	substr S3, S22, I0, NAMEWIDTH
  	save S3
  	bsr STRIPSPACE
  	bsr ATOI
  	restore I3
  
  	add I0, I0, NAMEWIDTH
  	substr S4, S22, I0, VARWIDTH
  	save S4
  	bsr STRIPSPACE
  	bsr ATOI
  	restore I1  # Length
  
  	add I0, I0, VARWIDTH
  	substr S4, S22, I0, I1
  	save S4
  	bsr STRIPSPACE
  	restore S4
  
  	length I2, S4		# chopn S4, 1
  	dec I2
  	substr S4, S4, 0, I2
  
  	save S4		# The line
  	save I3		# The line number
  
  	set I19, I3     # Remember me.
  
  
  	save I19
  	save I18
  	popi
  	pops
  	restore I18
  	restore I19
  	ret
  
  CNOLINE:
  	set I18, 0
  	set I19, 0
  	save -1
  	popi
  	pops
  	ret
  
  
  # CSTORE
  #  Inputs: A code line on the stack.  Must be formatted like this:
  #                  \d+\s
  # Outputs: Nothing
  # Trashes I0-I4, S0-S4
  CSTORE:
  	pushi
  	pushs
  	set I8, 0   # One-token-only flag
  	restore S0  # Safekeeping
  	save S0
  	bsr TOKENIZER
  	bsr REVERSESTACK
  	restore I0  # Depth
  	ne I0, 1, ONELNCK
  	set I8, 1   # Just the line number!
  ONELNCK:
  	restore S1  # Line number
  	dec I0
  	save I0
  	bsr CLEAR   # Empty the stack
  	save S1
  	bsr ATOI
  	restore I1  # Number as numeric
  	lt I1, 1, ENOTVALIDLINE
  	# This is fucking ugly.  :)
  	# Load the stack up with the lines so far, skipping the
  	#    one entry we (might be) replacing.
  	set I2, 0	# Depth
  	set I0, 0
  	eq I8, 1, CNEXT # Don't add if it's just a number
  	save S0		# The line we're adding
  	inc I2
  CNEXT:
  	set S3, ""
  	substr S3, S22, I0, NAMEWIDTH
  	save S3
  	bsr STRIPSPACE
  	restore S3
  	eq S3, "#", CEND
  
  	add I0, I0, NAMEWIDTH
  	set S4, ""
  	substr S4, S22, I0, VARWIDTH
  	save S4
  	bsr STRIPSPACE
  	bsr ATOI
  	restore I1
  
  	add I0, I0, VARWIDTH
  	set S4, ""
  	substr S4, S22, I0, I1
  	add I0, I0, I1
  	save S4
  	bsr STRIPSPACE
  	restore S4
  
  	length I3, S4
  	dec I3
  	substr S4, S4, 0, I3
  
  	eq S1, S3, CNEXT  # Skipping this line
  	save S4  # The line
  	inc I2
  	branch CNEXT
  
  	# At this point the stack is full of stuff
  	# Sort it.
  CEND:   save I2
  CENDLOAD:		# Entry point for LOAD
  	bsr REVERSESTACK
  	bsr LSORTSTACK
  	bsr REVERSESTACK
  
  	# Take the stack and re-insert it as lines
  	set S22, "#"
  	set I0, 0
  	restore I1
  	set I0, I1
  	# Stuff the lines into the storage area
  ADDLINE:
  	eq 0, I0, DONEADD
  	set S0, ""
  	restore S0	 # Whole line
  
  	save S0
  	save " "
  	save 0
  	bsr STRNCHR
  	restore I2
  	set S1, ""
  	substr S1, S0, 0, I2
  
  	concat S0, TERMINATOR
  	length I2, S0
  
  	save S1
  	save CTYPE
  	save I2
  	bsr VCREATE
  
  	save S1
  	save CTYPE
  	save I2
  	save S0
  	bsr VSTORE
  
  	dec I0
  	branch ADDLINE
  
  DONEADD:
  	save S22
  	popi
  	pops
  	restore S22	
  	ret
  
  ENOTVALIDLINE:
  	print "BAD LINE NUMBER\n"
  	end
  
  
  # Sort whatever's on the stack.
  # This is a modified version of sortstack, sorts numerically by the first field
  #
  LSORTSTACK:
  	pushi
  	pushs
  	# Assume that rotate_up as defined in the original problem
  	# statement has been defined.
  	restore I5	# local $len = pop(@stack);
      	set I6, I5	# local $bum = $len;
      			# local ($x, $y, $limit);
  LSORTMORE:
  	le I6,1,LENDSORT # while ($bum > 1) {
  	set I7, I6	#      $limit = $bum;
  LSHUFFLE:	
  	dec I7
  	eq I7, 0, LALMOSTDONE	# while (--$limit) {
  	bsr GETLINENO	
  	restore I2
  	restore S2		#     $x = pop(@stack);
  	bsr GETLINENO
  	restore I3
  	restore S3		#     $y = pop(@stack);
  
  #	le S2, S3, LSORTSWAP
  	le I2, I3, LSORTSWAP 	# if ($x gt $y) {
  
  	savec S2			#     push(@stack, $x);
  	savec S3			#     push(@stack, $y);
  	branch LROT		# }
  LSORTSWAP:			# else {
  	savec S3			#     push(@stack, $y);
  	savec S2			#     push(@stack, $x); }
  LROT:
          rotate_up I6		# rotate_up($bum);
  	branch LSHUFFLE		# }
  LALMOSTDONE:		        # At end of the $limit loop, top element is the max, and
  				# top+1 to end is semi-sorted. One more rotate_up()
  				# is needed before moving the floor up one notch.
  	rotate_up I6		# rotate_up($bum);
  	dec I6 			# $bum--; }
  	branch LSORTMORE
  LENDSORT:
  	save I5
  	popi
  	pops
  	ret
  
  #  Inputs: Code line
  # Outputs: Line number on stack as integer
  #          Code line underneath
  GETLINENO:
  	pushi
  	pushs
  	restore S2
  	save S2
  	save " "
  	save 0
  	bsr STRNCHR
  	restore I3
  	set S7, ""
  	substr S7, S2, 0, I3
  	save S7
  	bsr ATOI
  	restore I0
  	savec S2
  	save I0
  	popi
  	pops
  	ret
  
  # Vardecode
  # All-purpose variable decoder.  It's kinda blind though, so when you call it
  # had better be a varaible there or the results are... unpredictable.  
  # Deals with "A$" as one *or* two tokens!
  #   Inputs: Stopword for evaluation
  #	    Normal stack.  With what you *think* is the start of the variable
  #           on top.  A$ ...
  #  Outputs: Type (NTYPE, STYPE, CTYPE, etc...) on top then the name.
  #           Array variables will be encoded in such a way they can be looked up
  #           as-is.
  VARDECODE:
  	pushi
  	pushs
  	set S3, ""
  	restore S3  # Stopword
  	restore I5  # Depth
  	
  	restore S1	# Variable name
  	set I3, NTYPE	# Numeric (assume)
  	dec I5
  
  	set S5, ""	# Check for 1-token string vars.
  	length I2, S1
  	substr S5, S1, I2, 1
  	eq S5, "$", DECSTRING
  
  	eq I5, 0, VARDECODED  # Nothing left it has to be numeric
  
  	restore S2	# $, ( or stopword
  	dec I5
  
  	ne S2, "$", FINDEC
  
  DECSTRING:
  	set I3, STYPE
  	eq I5, 0, VARDECODED
  
  	restore S2	# There's something else...
  	dec I5
  FINDEC:			# S2's either the stop, expression, something.
  	save S2
  	inc I5
  	eq S2, "(", VARSUBSCRIPT
  	branch VARDECODED  # Nothing more to see here.
  	
  VARSUBSCRIPT:
  	save I5
  	save S3		# Stop word
  	bsr EVAL_EXPR
  	restore S0	# Subscript
  	concat S1, "|"
  	concat S1, S0   # var|expr[,expr...]
  	restore I5
  
  VARDECODED:
  	save I5		# Fix the stack
  	save S1		# Save the name
  	save I3		# Save the type
  	popi
  	pops
  	ret
  
  
  
  
  1.1                  parrot/languages/BASIC/dumpstack.pasm
  
  Index: dumpstack.pasm
  ===================================================================
  # User Stack Dump (Debugging.)
  #  Inputs: Top of stack should contain the depth
  # Outputs: Top of stack should (still) contain the depth.  :)
  # Types
  #      1 is an int
  #      2 is a  num
  #      3 is a  string
  #      4 is a  PMC
  #
  # $Id: dumpstack.pasm,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  # $Log: dumpstack.pasm,v $
  # Revision 1.1  2002/04/11 01:25:59  jgoff
  # Adding clintp's BASIC interpreter.
  #
  # Revision 1.3  2002/03/31 05:15:31  Clinton
  # Adjusted
  #
  # Revision 1.2  2002/03/31 05:13:39  Clinton
  # Id Keywords
  #
  #
  DUMPSTACK:
  	pushi
  	pushn
  	pushs
  	pushp
  	puts "Stack Dump: (top to bottom)\n"
  	restore I5
  	set I0, I5
  	gt I5, 0, DUMPLOOP
  	puts "  -empty-\n"
  	branch DUMPEND
  DUMPLOOP: 
  	entrytype I1, 0
  	puts "   "
  	sub I2, I5, I0
  
  	save I2
  	bsr ITOA
  	restore S31	 # Convert for puts
  	puts S31
  
  	puts "  "
  	ne I1, 1, DUMPNOTINT
  	puts "Int "
  	restore I1
  	save I1
  
  	save I1
  	bsr ITOA
  	restore S31	# Convert for puts
  	puts S31
  
  
  	branch DUMPANOTHER
  DUMPNOTINT:
  	ne I1, 2, DUMPNOTNUM
  	puts "Num "
  	restore N0
  	save N0
  	#print N0
  	branch DUMPANOTHER
  DUMPNOTNUM: 
  	ne I1, 3, DUMPNOTSTRING
  	puts "Str "
  	restore S1
  	save S1
  	puts S1
  	branch DUMPANOTHER
  DUMPNOTSTRING:
  	ne I1, 4, DUMPERR
  	puts "PMC "
  	restore P0
  	save P0
  	#print P0
  	branch DUMPANOTHER
  DUMPANOTHER:
  	puts "\n"
  	rotate_up I5
  	dec I0
  	eq I0, 0, DUMPEND
  	branch DUMPLOOP
  DUMPEND:
  	save I5
  	popi
  	popn
  	pops
  	popp
  	ret
  DUMPERR:
  	puts "UNKNOWN TYPE\n"
  	end
  
  
  
  1.1                  parrot/languages/BASIC/expr.pasm
  
  Index: expr.pasm
  ===================================================================
  # Expression Evaluation routines
  #
  # Global Variables:
  #    S24  -- the pseudo stack.  Set to "" to reset the stack.
  #            accessed through PUSHOPSTACK, POPOPSTACK, OPSTACKDEPTH
  #    I24  -- Random number generator seed
  #
  # There are external dependancies on stackops, basicvars, and alpha.
  #
  # TODO: A space on the op stack will be reduced to an empty expression
  #    fix PUSHOPSTACK/POPOPSTACK when not so exhausted...
  #
  # $Id: expr.pasm,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  # $Log: expr.pasm,v $
  # Revision 1.1  2002/04/11 01:25:59  jgoff
  # Adding clintp's BASIC interpreter.
  #
  # Revision 1.6  2002/04/08 02:37:40  Clinton
  # Added conditionals and logical operators to expr and tests
  #
  # Revision 1.5  2002/04/07 00:52:47  Clinton
  # The + operator now will concatenate if either arg looks non-numeric
  #
  # Revision 1.4  2002/04/06 23:33:49  Clinton
  # Added the TIME() function to return Epoch Time
  #
  # Revision 1.3  2002/04/01 22:16:54  Clinton
  # Changed RND() to be a bit more random
  # Fixed code for nested parenthetical functions/variables
  #
  # Revision 1.2  2002/03/31 05:13:59  Clinton
  # Id Keywords
  #
  
  # Width of things on the pseudo-stack
  .const STACKSIZE 80
  
  # Some stack stuff.  Allows me to move things from one stack to another, etc..
  #
  PUSHOPSTACK:
  	pushs
  	restore S0
  	#print "Pushing "
  	#print S0
  	#print "\n"
  	concat S0, TERMINATOR   # Marker
  	save S0
  	save STACKSIZE
  	bsr PAD
  	restore S0
  	concat S24, S0
  	savec S24
  	pops
  	restore S24
  	ret
  POPOPSTACK:
  	pushi
  	pushs
  	length I0, S24
  	sub I1, I0, STACKSIZE
  	substr S0, S24, I1, STACKSIZE
  	substr S24, S24, 0, I1
  	savec S0
  	bsr STRIPSPACE
  	restore S0
  	length I0, S0
  	dec I0
  	substr S0, S0, 0, I0	# Remove trailing 
  	#print "Popping "
  	#print S0
  	#print "\n"
  	save S0
  	
  	savec S24
  	popi
  	pops
  	restore S24
  	ret
  OPSTACKDEPTH:
  	pushi
  	length I0, S24
  	div I0, I0, STACKSIZE
  	save I0
  	popi
  	ret
  
  # Function Dispatcher and Test
  #  Functions are dispatched from here.  BASIC functions have a *FIXED* number of
  #  arguments.  When the function code is called one of two things will happen:
  #     * If I10 is set to 1, the function just needs to acknowledge that it exists
  #       by incrementing I10 to 2 and returning.  Don't look at the stack.
  #     * The stack is well-formed
  #       The top item on the stack is the first argument.  Next item, next arg.
  #     * Function should exhaust the stack and leave its response on TOP as a STRING
  #
  # ERRORS:
  #     When they get confused they put a "0" on the stack and issue a warning message.
  #     Things are still clean.
  #
  # entrypoint....
  # ISFUNC: Call with func name on stack, returns 1 or 0 on stack.
  ISFUNC:
  	pushi
  	pushs
  	set I10, 1   # Only test and return.
  	save 1	     # Falsify stack
  	branch FUNCDISPATCH
  
  # entrypoint....
  # STFUNCDISPATCH: Call with canonical stack, function name first entry.
  STFUNCDISPATCH:
  	pushi
  	pushs
  	set I10, 0   # Actually *DO* the function.
  
  FUNCDISPATCH:
  	restore I5
  	restore S0   # Function to call.
  	dec I5
  	save I5
  	
  	# Okay, while the function's on the stack being processed it 
  	#   might have this ! thing after it.  Remove it.
  	set S3, ""
  	length I0, S0
  	dec I0
  	substr S3, S0, I0, 1
  	ne S3, "!", FUNCJUMP
  	substr S0, S0, 0, I0
  
  # To add a function, add to this jump table.  Follow the rules above.
  #
  FUNCJUMP:
  	eq S0, "ABS", FUNC_ABS
  	eq S0, "LEN", FUNC_LEN
  	eq S0, "RND", FUNC_RND
  	eq S0, "MID", FUNC_MID	
  	eq S0, "ASC", FUNC_ASC
  	eq S0, "CHR", FUNC_CHR
  	eq S0, "TIME", FUNC_TIME
  	eq I10, 1, ENDISFUNC  # Just checking, must not have been there.
  
  	# This is bad, mmkay.  We called a function that's not a function!
  	#  It's probably *actually* a subscripted variable.  Assume that and
  	#  jump to an evaluator to go lookup the array variable.
  	branch DOSUBSCRIPT
  
  ENDFUNCDISPATCH:	# Answer's on top, remember?
  	save I24
  	popi
  	pops
  	restore I24     # Random number seed.
  	ret
  ENDISFUNC:
  	restore I0	# The fake depth we used before
  	dec I10		# 2->1  1->0
  	save I10
  	popi
  	pops
  	ret
  
  # Here's some functions!
  # Do *not* return.  
  #     Jump to ENDISFUNC for a query or ENDFUNCDISPATCH for a call.
  #
  FUNC_ABS:
  	inc I10
  	gt I10, 1, ENDISFUNC  # Only checking!
  	restore I5            # pulling ABS's arguments (strings)
  	ne I5, 1, FUNC_ERR    # Wrong number of args.
  	bsr ATOI
  	restore I0
  	save I0
  	ge I0, 0, ENDFUNCDISPATCH
  	restore I0
  	mul I0, I0, -1
  	save I0
  	bsr ITOA
  	branch ENDFUNCDISPATCH
  
  # Returns the Epoch seconds (core op TIME INT)
  FUNC_TIME:
  	inc I10
  	gt I10, 1, ENDISFUNC
  	restore I5
  	ge I5, 1 FUNC_ERR	# No arguments for time()
  	time I0
  	save I0
  	bsr ITOA
  	branch ENDFUNCDISPATCH
  
  
  FUNC_LEN:
  	inc I10
  	gt I10, 1, ENDISFUNC  # Only checking!
  	restore I5
  	ne I5, 1, FUNC_ERR
  	restore S1
  	length I0, S1
  	save I0
  	bsr ITOA
  	branch ENDFUNCDISPATCH
  # The old seed is kept in
  # Uses X[n+1]=(a*x[n]+c) mod m
  # Where, a=5, c=1, and m is the range
  # I24 is the seed.  The period is 65536
  # and probably isn't fair in the low bits.
  #
  FUNC_RND:
  	inc I10
  	gt I10, 1, ENDISFUNC  	# Only checking!
  	restore I5
  	ne I5, 1, FUNC_ERR
  	bsr ATOI
  	restore I0  		# Range for random
  	mul I24, I24, 5         # *a
  	add I24, I24, 1         # +c	
  	mod I24, I24, 65536	# % m
  	mod I0, I24, I0
  	save I0
  	bsr ITOA
  	branch ENDFUNCDISPATCH
  
  FUNC_MID:
  	inc I10
  	gt I10, 1, ENDISFUNC
  	restore I5
  	ne I5, 3, FUNC_ERR
  	restore S1		# the string
  	bsr ATOI
  	restore I0		# start 
  	dec I0			#    (1-based)
  	bsr ATOI
  	restore I1		# length
  	length I2, S1
  	gt I0, I2, FUNC_MID_ERR1
  	add I3, I0, I1
  	gt I3, I2, FUNC_MID_ERR2
  	substr S2, S1, I0, I1
  	save S2
  	branch ENDFUNCDISPATCH
  
  FUNC_CHR: 
  	inc I10
  	gt I10, 1, ENDISFUNC
  	restore I5
  	ne I5, 1, FUNC_ERR
  	bsr ATOI
  	restore I0	# The number
  	gt I0, 255, FUNC_ASCII_ERROR
  	bsr SET_S1_ASCII
  	substr S0, S1, I0, 1
  	save S0
  	branch ENDFUNCDISPATCH
  
  FUNC_ASC:
  	inc I10
  	gt I10, 1, ENDISFUNC
  	restore I5
  	ne I5, 1, FUNC_ERR
  	restore S0	# The character
  	bsr SET_S1_ASCII
  	save S1		# The set
  	save S0		# The character
  	save 0
  	bsr STRNCHR
  	restore I0
  	eq I0, -1, FUNC_ASCII_ERROR
  	save I0
  	bsr ITOA
  	branch ENDFUNCDISPATCH
  
  	# Re-used a few places.  :)
  	# Boy, is this handy.
  SET_S1_ASCII:
  	set S1, "\x0\x1\x2\x3\x4\x5\x6\x7\x8\x9\xa\xb\xc\xd\xe\xf\x10\x11\x12\x13\x14\x15\x16\x17\x18\x19\x1a\x1b\x1c\x1d\x1e\x1f\x20\x21\x22\x23\x24\x25\x26\x27\x28\x29\x2a\x2b\x2c\x2d\x2e\x2f\x30\x31\x32\x33\x34\x35\x36\x37\x38\x39\x3a\x3b\x3c\x3d\x3e\x3f\x40\x41\x42\x43\x44\x45\x46\x47\x48\x49\x4a\x4b\x4c\x4d\x4e\x4f\x50\x51\x52\x53\x54\x55\x56\x57\x58\x59\x5a\x5b\x5c\x5d\x5e\x5f\x60\x61\x62\x63\x64\x65\x66\x67\x68\x69\x6a\x6b\x6c\x6d\x6e\x6f\x70\x71\x72\x73\x74\x75\x76\x77\x78\x79\x7a\x7b\x7c\x7d\x7e\x7f\x80\x81\x82\x83\x84\x85\x86\x87\x88\x89\x8a\x8b\x8c\x8d\x8e\x8f\x90\x91\x92\x93\x94\x95\x96\x97\x98\x99\x9a\x9b\x9c\x9d\x9e\x9f\xa0\xa1\xa2\xa3\xa4\xa5\xa6\xa7\xa8\xa9\xaa\xab\xac\xad\xae\xaf\xb0\xb1\xb2\xb3\xb4\xb5\xb6\xb7\xb8\xb9\xba\xbb\xbc\xbd\xbe\xbf\xc0\xc1\xc2\xc3\xc4\xc5\xc6\xc7\xc8\xc9\xca\xcb\xcc\xcd\xce\xcf\xd0\xd1\xd2\xd3\xd4\xd5\xd6\xd7\xd8\xd9\xda\xdb\xdc\xdd\xde\xdf\xe0\xe1\xe2\xe3\xe4\xe5\xe6\xe7\xe8\xe9\xea\xeb\xec\xed\xee\xef\xf0\xf1\xf2\xf3\xf4\xf5\xf6\xf7\xf8\xf9\xfa\xfb\xfc\xfd\xfe\xff"
  	ret
  
  # Errors for the functions.
  #
  FUNC_MID_ERR1:
  	print "MID(): start bound "
  	print I0
  	print " exceeds length of "
  	print I2
  	print "\n"
  	save "0"
  	branch ENDFUNCDISPATCH
  
  FUNC_MID_ERR2:
  	print "MID(): end bound of "
  	print I3
  	print " exceeds length of "
  	print I2
  	print "\n"
  	save "0"
  	branch ENDFUNCDISPATCH
  	
  FUNC_ASCII_ERROR:
  	print "CHR/ASC: bounds error\n"
  	save "0"
  	branch ENDFUNCDISPATCH
  
  FUNC_ERR:
  	print "Improper arguments to "
  	print S0
  	print "\n"
  	save "0"
  	save I5	    # Now clear the stack!
  	bsr CLEAR
  	restore I5
  	branch ENDFUNCDISPATCH
  
  #
  # End of functions
  
  #
  # This is the subscripted variable lookup, called by the function dispatcher.
  #    We're still in its scope!  Don't forget to popi, pops, etc...
  # We've got a well-formed stack here.
  #   *** S0 WILL CONTAIN THE VARIABLE NAME ***
  DOSUBSCRIPT:
  			# S0 has the variable name.
  	set I3, NTYPE	# Numeric
  	length I0, S0
  	set S1, ""
  	dec I0
  	substr S1, S0, I0, 1  # Peel off last char
  	ne S1, "$", DOSUBNUM
  	set I3, STYPE   # String
  	substr S0, S0, 0, I0
  
  DOSUBNUM:	
  	concat S0, "|"
  	restore I5
  DOSUBSL:
  	eq I5, 0, ENDSUBS
  	restore S1
  	dec I5
  	concat S0, S1
  	eq I5, 0, ENDSUBS
  	concat S0, ","
  	branch DOSUBSL
  
  ENDSUBS:
  	save S0
  	eq I3, NTYPE, DOSUBFNUM
  	bsr SFETCH
  	branch DOSUBRET
  
  DOSUBFNUM:
  	bsr NFETCH
  	bsr ITOA
  DOSUBRET:
  	save I24    # Random number seed.
  	popi
  	pops
  	restore I24
  	ret
  
  # The expression evaluator
  #
  # Call with:
  #    Stop word on top
  #    Well-formed stack underneath
  # Returns with:
  #    The result on top
  #    The unneeded part of the stack underneath (well-formed)
  #
  # Operator Precedence:
  #           ~     (Function bind)
  #           * /
  #           + -
  #           ,
  #
  # Unresolved expressions such as:  (4,5,6) will be returned as
  #    is, reduced as far as things allow.
  #
  # The following features are allowed:
  #        Integers
  #        Unary -
  #        Binary ops: * / + -
  #        Functions: (defined above)
  #        Variables: Numeric and string
  #        Array variables: Numeric and string (strings cannot be set by LET, TODO)
  #        Numbers and Strings are silently interchangeable
  #
  EVAL_EXPR:
  	pushs
  	pushi
  	set S24, ""	  # clear the multipurpose stack
  	restore S1	  # Stop word
  	restore I5
  
  	# Split the stack into two well-formed stacks:
  	#   One before the stopword (not incl.) one after (incl.)
  EVAL_SPLIT:
  	eq I5, 0, ENDSPLIT
  	restore S0
  	save S0
  	eq S0, S1, ENDSPLIT
  	dec I5
  	bsr PUSHOPSTACK
  	branch EVAL_SPLIT
  
  ENDSPLIT:
  	save I5		  # Put what's left back
  	set I5, 0
  
  REBUILD:
  	bsr OPSTACKDEPTH
  	restore I0
  	eq I0, 0, NOWCOOK
  	bsr POPOPSTACK
  	inc I5
  	branch REBUILD
  
  NOWCOOK:
  	save I5
  	bsr COOK_EXPR     # First cook it a bit
  
  	bsr INFIXPOSTFIX  # Convert from Infix to Postfix
  
  	bsr DOCALC
  	save I24
  	pops
  	popi
  	restore I24
  	ret
  
  # First, cook the expression a bit for easy digestion
  #   * Unary - is properly joined with its argument
  #   * $'s are re-attached to their string variable names
  #   * Functions and array lookups are converted from:
  #          FUNC(x,y,z)    ARR(a,b,c)    to:
  #          FUNC!~(x,y,z)    ARR!~(a,b,c)
  #     When converted to RPN, this makes matching the func with its
  #     arguments sane again
  #
  COOK_EXPR:
  	pushi
  	pushs
  	restore I5
  	set S24, ""	# Stack thingy
  	set I6, 1	# Unary flag
  	set I7, 0	# func flag
  	set I8, 0	# Seen < flag
  
  FIXUNARY:
  	eq I5, 0, ENDFIXU
  	restore S0
  	dec I5
  	ne S0, "$", NOTDOLLAR
  	bsr POPOPSTACK
  	restore S1
  	concat S1, "$"
  	savec S1
  	bsr PUSHOPSTACK
  	branch FIXUNARY
  
  NOTDOLLAR:
  	ne S0, "(", CHECKUM    # Got a (
  	eq I7, 0, CHECKUM      #  and the funcflag is set!
  	bsr POPOPSTACK
  	restore S3
  	concat S3, "!"
  	savec S3
  	bsr PUSHOPSTACK
  	savec "~"
  	bsr PUSHOPSTACK
  	# Fall through Ok.
  
  CHECKUM:
  	ne S0, "-", GTCHECK   # Got a -
  	eq I6, 0, UNCHECK     #   and the unary flag is set!
  	restore S0
  	dec I5
  	set S1, "-"
  	concat S1, S0
  	set S0, S1
  	branch ADDUSTACK
  
  GTCHECK:
  	ne S0, ">", UNCHECK
  	ne I8, 1, UNCHECK
  	bsr POPOPSTACK
  	restore S0
  	concat S0, ">"
  	save S0
  	bsr PUSHOPSTACK
  	branch FIXUNARY
  
  	# Decide if a trailing - can or cannot be unary.
  UNCHECK:
  	set I6, 0
  	set I7, 0
  	eq S0, "/", POSSUN   # If any of these are
  	eq S0, "*", POSSUN   #  found then the next "-"
  	eq S0, "-", POSSUN   #  is syntatically a unary -
  	eq S0, "+", POSSUN
  	eq S0, "(", POSSUN
  	eq S0, "<", POSSUN
  	eq S0, ">", POSSUN
  	eq S0, "=", POSSUN
  	eq S0, ",", POSSUN
  	eq S0, "<>", POSSUN
  	eq S0, "OR", POSSUN
  	eq S0, "AND", POSSUN
  	eq S0, ")", ADDUSTACK  # Not this.  :)
  
  	# We have a variable, function, token of some kind.
  	#   if an open paren follows, this is a function call
  	set I7, 1
  	branch ADDUSTACK
  POSSUN:
  	set I6, 1	# The next thing may be a unary minus
  	set I8, 0
  	ne S0, "<", ADDUSTACK
  	set I8, 1
  ADDUSTACK:
  	savec S0
  	bsr PUSHOPSTACK
  	branch FIXUNARY
  
  ENDFIXU:		    # Stack transfer.
  	bsr OPSTACKDEPTH
  	restore I0
  	eq I0, 0, COOKEXIT
  	bsr POPOPSTACK	    
  	restore S0
  	save S0
  	inc I5	
  	branch ENDFIXU
  
  COOKEXIT:
  	save I5
  	popi
  	pops
  	ret
  
  # Infix -> Postfix conversion
  #
  #  Input: Well-formed stack leftmost on top
  # Output: Well-formed stack, first to be processed on top
  #
  # Bit-O-Magic, | is used to separate tokens on output stream
  
  .const SEPARATOR "|"
  
  INFIXPOSTFIX:
  	pushi
  	pushs
  	restore I5  # Stack depth
  
  	set S24, ""
  	set S0, ""  # The postfix stack
  	set S7, ""  # Input
  
  GETTOP:
  	le I5, 0, FINISH
  	restore S7
  	dec I5
  
  	eq S7, "-", SPECIAL
  	eq S7, "+", SPECIAL
  	eq S7, "*", SPECIAL
  	eq S7, "/", SPECIAL
  	eq S7, "(", SPECIAL
  	eq S7, ")", SPECIAL
  	eq S7, "~", SPECIAL
  	eq S7, ">", SPECIAL
  	eq S7, "<", SPECIAL
  	eq S7, "=", SPECIAL
  	eq S7, "<>", SPECIAL
  	eq S7, "AND", SPECIAL
  	eq S7, "OR", SPECIAL
  	concat S0, S7		# An identifier
  	concat S0, SEPARATOR
  	branch GETTOP
  
  SPECIAL:
  	eq S7, "(", OPENPAREN
  	branch CLOSEPARENCK
  OPENPAREN:
  	save "("
  	bsr PUSHOPSTACK
  	#print "Saved (\n"
  	branch GETTOP
  
  CLOSEPARENCK:
  	eq S7, ")", CLOSEPAREN
  	branch CANPUSH
  
  CLOSECOMMA:
  	bsr OPSTACKDEPTH
  	restore I0
  	eq I0, 0, FINISHCOMMA
  	bsr POPOPSTACK
  	restore S1
  	eq S1, "(", FINISHCOMMA
  	#print "Concatting "
  	#print S7
  	#print "\n"
  	concat S0, S7
  	concat S0, SEPARATOR
  	branch CLOSECOMMA
  
  FINISHCOMMA:
  	ne S7, "(", FC2   # Really processing a (?
  	save "("
  	bsr PUSHOPSTACK
  FC2:
  	concat S0, ",<"
  	concat S0, SEPARATOR
  	branch GETTOP
  
  CLOSEPAREN:
  	bsr OPSTACKDEPTH
  	restore I0
  	#print "In closeparen, Stack depth: "
  	#print I0
  	#print " "
  	#print S24
  	#print "\n"
  	eq I0, 0, GETTOP
  	bsr POPOPSTACK
  	set S1, ""
  	restore S1
  	eq S1, "(", TILDECK
  	#print "Adding "
  	#print S1
  	#print " because of closeparen\n"
  	concat S0, S1
  	concat S0, SEPARATOR
  	branch CLOSEPAREN
  
  	# Okay, found an ) went back to (, is the next thing a ~ ?
  TILDECK:
  	bsr OPSTACKDEPTH
  	restore I0
  	eq I0, 0, GETTOP  # Nope, apparently not.
  	bsr POPOPSTACK
  	set S1, ""
  	restore S1
  	eq S1, "~", GOTTILDE
  	save S1
  	bsr PUSHOPSTACK   # Oops, sorry.
  	branch GETTOP
  GOTTILDE:
  	concat S0, S1	  # Mash that tilde on there.
  	concat S0, SEPARATOR
  	branch GETTOP
  
  CANPUSH:
  	#print "In canpush with "
  	#print S7
  	#print "\n"
  	bsr OPSTACKDEPTH
  	restore I0
  	ne I0, 0, NOTMTSTACK
  	save S7
  	bsr PUSHOPSTACK
  	branch GETTOP
  
  NOTMTSTACK:
  	bsr POPOPSTACK
  	set S10, ""
  	restore S10	# Last op
  	ne S10, "(", NOTPAREN
  	save S10
  	bsr PUSHOPSTACK
  	save S7
  	bsr PUSHOPSTACK
  	branch GETTOP
  
  NOTPAREN:
  	set I2, 1	# Medium (default) precedence
  	set I3, 1
  	eq S7, "~", IN_10
  	eq S7, "*", IN_8
  	eq S7, "/", IN_8
  	eq S7, "+", IN_6
  	eq S7, "-", IN_6
  	eq S7, "<", IN_4
  	eq S7, ">", IN_4
  	eq S7, "<>", IN_4
  	eq S7, "=", IN_4
  	eq S7, "AND", IN_2
  	eq S7, "OR", IN_2
  	branch CKLASTOP
  
  IN_10:  inc I2
  IN_8:   inc I2
  IN_6:   inc I2
  IN_4:   inc I2
  IN_2:	inc I2
  
  CKLASTOP:
  	eq S10, "~", LT_10
  	eq S10, "*", LT_8
  	eq S10, "/", LT_8
  	eq S10, "+", LT_6
  	eq S10, "-", LT_6
  	eq S10, "<", LT_4
  	eq S10, ">", LT_4
  	eq S10, "<>", LT_4
  	eq S10, "=", LT_4
  	eq S10, "AND", LT_2
  	eq S10, "OR", LT_2
  	branch CKPREC
  LT_10:  inc I3
  LT_8:   inc I3
  LT_6:   inc I3
  LT_4:   inc I3
  LT_2:   inc I3
  
  CKPREC:
  	le I2, I3, APPOP
  	save S10
  	bsr PUSHOPSTACK
  	save S7
  	bsr PUSHOPSTACK
  	branch GETTOP
  
  APPOP:
  	concat S0, S10
  	concat S0, SEPARATOR
  	branch CANPUSH
  
  FINISH:
  	bsr OPSTACKDEPTH
  	restore I0
  	eq I0, 0, ALLDONE
  	bsr POPOPSTACK
  	restore S7
  	concat S0, S7
  	bsr OPSTACKDEPTH
  	restore I0		# Bug fix...
  	concat S0, SEPARATOR
  	eq I0, 0, ALLDONE
  	branch FINISH
  
  	# The RPN is finished here, stored in S0 as a stream.
  	#   we need to produce a valid stack from that.  DON'T 
  	#   USE TOKENIZE.  It's too smart for this.
  ALLDONE:
  	#print "RPN:"
  	#print S0
  	#print "\n"
  	set I5, 0
  	set I0, 0  # Offset
  	set I1, 0  # Oldstart
  NEXTTOK:
  	save S0
  	save SEPARATOR
  	save I0
  	bsr STRNCHR
  	set I1, I0
  	restore I0
  	eq I0, -1, ENDINFIX
  	set S1, ""
  	sub I2, I0, I1
  	substr S1, S0, I1, I2
  	save S1
  	add I0, I1, I2
  	inc I0
  	inc I5
  	branch NEXTTOK
  
  ENDINFIX:
  	save I5  # Stack's proper
  	popi
  	pops
  	ret
  
  # Calulate
  #  Input: A well-formed stack in RPN notation
  # Output: The value evaluated on top of the stack or 0 if an error occurred.
  #         (a message will be emitted separately)
  #
  DOCALC:
  	pushi
  	pushs
  	set S24, ""
  	bsr REVERSESTACK
  	restore I5
  	set S0, ""
  
  CALCLOOP:
  	le I5, 0, CALCFINISH
  	restore S0
  	dec I5
  	save S0
  	bsr ISNUM
  	restore I1
  	ne I1, 1, NOTNUM
  	save S0
  	bsr PUSHOPSTACK
  	branch CALCLOOP
  
  NOTNUM:
  	# Thing here is func, var, op, string, multidim var
  	eq S0, "*", DOOP
  	eq S0, "/", DOOP
  	eq S0, "+", DOOP
  	eq S0, "-", DOOP
  	eq S0, "<", DOOP
  	eq S0, ">", DOOP
  	eq S0, "=", DOOP
  	eq S0, "<>", DOOP
  	eq S0, "AND", DOOP
  	eq S0, "OR", DOOP
  	eq S0, "~", DOFUNC
  	eq S0, ",", PUSHVAR  # ?
  
  	# Is it a builtin?
  	save S0
  	bsr ISFUNC
  	restore I0
  	ne I0, 1, NOTBUILTIN
  
  	# Pulled a function, go take care of it
  	save S0
  	bsr PUSHOPSTACK
  	branch CALCLOOP
  
  	# Now, we've got one of
  	#   var(index[, index...])
  	#   var
          #   "string"
  NOTBUILTIN:
  	set S1, ""
  	substr S1, S0, 0, 1
  	eq S1, "'", STRING
  	eq S1, '"', STRING
  	branch NOTSTRINGLIT
  STRING:
  	length I0, S0
  	sub I0, I0, 2
  	substr S0, S0, 1, I0
  	save S0
  	bsr PUSHOPSTACK
  	branch CALCLOOP
  
  NOTSTRINGLIT:
  	# Okay, the thing here is either
  	#   1. var
  	#   2. var(....)  w/trailing !
  	set S3, ""
  	length I0, S0
  	dec I0
  	substr S3, S0, I0, 1
  	ne S3, "!", NORMVAR
  	save S0			# A var(...), resolve later.
  	bsr PUSHOPSTACK
  	branch CALCLOOP
  
  	# It's a variable.  Resolve it now, please.
  NORMVAR:
  	set S3, ""
  	length I0, S0
  	dec I0
  	substr S3, S0, I0, 1
  	eq S3, "$", RES_STRINGVAR
  	# Numeric var
  	save S0
  	bsr NFETCH	# Get the numeric value
  	bsr ITOA
  	restore S0
  	branch PUSHVAR
  
  RES_STRINGVAR:
  	substr S0, S0, 0, I0  # Now has an alpha var
  	save S0
  	bsr SFETCH
  	restore S0
  	branch PUSHVAR
  
  PUSHVAR:save S0
  	bsr PUSHOPSTACK
  	branch CALCLOOP
  
  # Actually perform a math operation
  #    strings on the stack are silently converted to numeric
  #    variables and functions should already have been resolved
  # Joy!  If either thing is *not* a number, then + should concatenate.
  #
  DOOP:   set I2, 0
  	set I3, 0
  	set I8, 0          # Perform normal addition
  	set S12, ""
  	set S13, ""
  	bsr OPSTACKDEPTH
  	restore I0
  	eq I0, 0, NOSTACK
  	bsr POPOPSTACK
  	restore S12
  	save S12
  	bsr ISNUM
  	restore I0
  	eq I0, 1, OPNUM1
  	inc I8
  OPNUM1:
  	save S12
  	bsr ATOI
  	restore I2
  
  	bsr OPSTACKDEPTH
  	restore I0
  	eq I0, 0, NOSTACK
  	bsr POPOPSTACK
  	restore S13
  	save S13
  	bsr ISNUM
  	restore I0
  	eq I0, 1, OPNUM2
  	inc I8
  OPNUM2:	
  	save S13
  	bsr ATOI
  	restore I3
  	
  	# Okay, at this point we've got either
  	#   S12  I2  (alpha/num)
  	#   S13  I3
  NOSTACK:ne S0, "+", SUB
  	eq I8, 0, NUMADD
  	set S4, ""
  	concat S13, S12
  	set S4, S13
  	branch ENDOP # Note different branch
  
  	# Numeric ops
  NUMADD: add I4, I2, I3
  	branch ENDNOP
  SUB:	ne S0, "-", MUL
  	sub I4, I3, I2
  	branch ENDNOP
  MUL:	ne S0, "*", DIV
  	mul I4, I3, I2
  	branch ENDNOP
  DIV:    ne S0, "/", EQ
  	div I4, I3, I2
  	branch ENDNOP
  
  	# Mixed ops
  	#    set to 0 or 1, branch to ENDNOP when done
  EQ:	ne S0, "=", NE
  	set I4, 1		# Assume true
  	eq I8, 0, NEQ
  	eq S12, S13, TRUE
  	set I4, 0
  	branch FALSE 
  NEQ:    eq I2, I3, TRUE
  	set I4, 0
          branch FALSE
  
  NE:	ne S0, "<>", GT
  	set I4, 1
  	eq I8, 0, NNE
  	ne S12, S13, TRUE
  	set I4, 0
  	branch FALSE
  NNE:	ne I2, I3, TRUE
  	set I4, 0
  	branch FALSE
  
  
  GT:	ne S0, "<", LT
  	set I4, 1
  	eq I8, 0, NGT
  	gt S12, S13, TRUE
  	set I4, 0
  	branch FALSE
  NGT:	gt I2, I3, TRUE
  	set I4, 0
  	branch FALSE
  
  LT:	ne S0, ">", AND
  	set I4, 1
  	eq I8, 0, NLT
  	lt S12, S13, TRUE
  	set I4, 0
  	branch FALSE
  NLT:	lt I2, I3, TRUE
  	set I4, 0
  	branch FALSE
  
  AND:	ne S0, "AND", OR
  	set I4, 1	# Assume true
  	save S12
  	bsr TRUTH
  	restore I2
  	save S13
  	bsr TRUTH
  	restore I3
  	eq I3, 0, ANDF
  	eq I2, 0, ANDF
  	branch TRUE
  ANDF:	set I4, 0
  	branch FALSE
  
  OR:	ne S0, "OR", UNKOP
  	set I4, 1
  	save S12
  	bsr TRUTH
  	restore I2
  	save S13
  	bsr TRUTH
  	restore I3
  	eq I3, 1, TRUE
  	eq I2, 1, TRUE
  ORF:	set I4, 0
  	branch FALSE
  
  UNKOP:  branch DOFUNC
  
  	# Convenience labels
  TRUE:   
  FALSE:  
  ENDNOP: save I4	    # Convert result to string again
  	bsr ITOA
  	set S4, ""
  	restore S4
  	branch ENDOP
  	
  	# Do a built-in function or multidimensional 
  	#   variable lookup
  DOFUNC: save I5   # Stack's now kosher
  	
  	# Pull things from the opstack down to the
  	#   function name.  You should get either 
  	#   values or commas until the function name is hit.
  	set I4, 0
  PULLOP: bsr OPSTACKDEPTH
  	restore I0
  	eq I0, 0, ERRFUNC
  	bsr POPOPSTACK
  	restore S1
  	eq S1, ",", PULLOP
  	length I1, S1
  	dec I1
  	substr S2, S1, I1, 1   # Last char
  	eq S2, "!", RUNFUNC
  	save S1
  	inc I4
  	branch PULLOP
  
  RUNFUNC:
  	length I1, S1
  	dec I1
  	substr S1, S1, 0, I1
  	save S1
  	inc I4
  	save I4   # Stack's proper
  	bsr STFUNCDISPATCH
  	restore S4	# The return value.
  	restore I5	# Depth
  	branch ENDOP
  
  # The only Should Not Happen function.
  ERRFUNC:print "Unexpected stack exhaustion\n"
  	end
  
  ENDOP:  save S4
  	bsr PUSHOPSTACK
  	branch CALCLOOP
  
  	# In a well-formed expression only the *last* think on the opstack
  	#  is what should be returned.  However because of tuples, we're going
  	#  do de-construct the opstack back into a single value in case.
  CALCFINISH:
  	set S0, ""
  	set I5, 0
  	
  CALCFINLOOP:
  	bsr OPSTACKDEPTH
  	restore I0
  	eq I0, 0, CALCEXIT1
  	bsr POPOPSTACK
  	inc I5
  	branch CALCFINLOOP
  
  	# But of course, the stack is *backwards* now.  
  CALCEXIT1:
  	save I5
  	bsr REVERSESTACK
  	set S1, ""
  	restore I5
  
  CALCEXITLOOP:
  	eq I5, 0, CALCEXIT2
  	restore S1
  	dec I5
  	concat S1, S0
  	set S0, S1
  	branch CALCEXITLOOP
  
  CALCEXIT2:
  	save S0
  	save I24
  	popi
  	pops
  	restore I24
  	ret
  
  # And now, for something completely different
  #
  # Truth
  #  Inputs: A string on the stack
  # Outputs: 0 or 1, numeric on the stack
  #
  #  "0" False
  #  ""  False
  #  Anything else true.
  TRUTH:	pushs
  	pushi
  	restore S0
  	eq S0, "0", LIE
  	eq S0, "", LIE
  	save 1
  	branch ENDTRUTH
  LIE:	save 0
  ENDTRUTH:
  	popi
  	pops
  	ret
   
  	
  
  
  
  
  1.1                  parrot/languages/BASIC/instructions.pasm
  
  Index: instructions.pasm
  ===================================================================
  # This is where all of the instructions are 
  # for the BASIC interpreter
  #
  #  On the way into *EVERY ONE* of these the stack looks like
  #  Line Number (integer, -1 if immediate mode)
  #  (# tokens)
  #  Tokenstack
  #  (# entries)
  #  Runtime stack (gosub/return, for/next)
  #
  #  On the way *back* just the runtime stack should be there.
  
  #  If you need to modify varaibles, see the save/restore trick for LET
  #
  # $Id: instructions.pasm,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  # $Log: instructions.pasm,v $
  # Revision 1.1  2002/04/11 01:25:59  jgoff
  # Adding clintp's BASIC interpreter.
  #
  # Revision 1.10  2002/04/09 03:14:31  Clinton
  # Optimized line lookups by using I18 and I19 as a line number
  # cache and pointer
  #
  # Revision 1.9  2002/04/08 02:37:40  Clinton
  # Added conditionals and logical operators to expr and tests
  #
  # Revision 1.8  2002/04/06 22:57:21  Clinton
  # Added multidimensional ability to INPUT and READ
  #
  # Revision 1.7  2002/04/06 21:25:20  Clinton
  # Enhanced LET a bit
  #
  # Revision 1.6  2002/04/06 20:24:44  Clinton
  # Don't recall
  #
  # Revision 1.5  2002/04/06 17:24:02  Clinton
  # Before 3rd party variable decoding for LET/READ
  #
  # Revision 1.4  2002/04/01 22:16:54  Clinton
  # Added DUMP copcode, protection for random seed
  #
  # Revision 1.3  2002/03/31 17:35:22  Clinton
  # Added ability to cross-nest loops and subroutines
  #
  # Revision 1.2  2002/03/31 05:13:56  Clinton
  # Id Keywords
  #
  #
  
  #
  I_REM:  pushi
  	pushs
  	restore I0   # Line number
  	bsr CLEAR    # Clear the token stack
  	restore I0   # Pull the 0
  END_I_REM:
  	popi
  	pops
  	ret
  
  I_END:  pushi
  	pushs
  	restore I0
  	bsr CLEAR
  	restore I0
  	popi
  	pops
  	set I22, 1   # No errors!
  	ret
  
  I_DUMP: pushi
  	pushs
  	restore I0
  	bsr CLEAR
  	restore I0
  	print S21
  	print "\n"
  	popi
  	pops
  	ret
  
  # RESTORE
  # (Resets read/data)
  I_RESTORE: 
  	restore I0   # Line number
  	bsr CLEAR
  	restore I0   # Empty pointer
  	set I26, 0
  	set I27, 0
  END_I_RESTORE:
  	ret
  
  # DATA
  # (A no-op normally)
  I_DATA: pushi
  	pushs
  	restore I0
  	bsr CLEAR
  	restore I0
  END_I_DATA:
  	popi
  	pops
  	ret
  
  
  # READ numvar
  # READ numvar(index...)
  # READ stringvar
  # READ stringvar(index...)
  #
  I_READ: pushi
  	pushs
  	restore I0   # Line number
  	restore I5
  	restore S0   # "READ"
  	dec I5
  	save I5
  	save "REM"   # No stopword
  	bsr VARDECODE
  
  	restore I3   # Type
  	restore S0   # Variable name
  	bsr CLEAR
  	restore I0
  	
  DO_READ_DATA:
  	save I26   # Current indexed line number
  	bsr CFETCH
  	restore I0 # Line Number
  	eq I0, -1, ERR_DATA_EXHAUSTED
  	restore S3 # We'll need this in a sec.
  	save S3
  	bsr TOKENIZER
  	bsr REVERSESTACK
  	restore I5
  	restore S1 # Line number
  	dec I5
  	restore S2 # Statement 
  	dec I5
  	save I5
  
  	bsr CLEAR
  	restore I6	# Dummy
  
  	set I26, I0  # Line number, exactly
  	ne S2, "DATA", DO_READ_DATA_AGAIN
  	eq I5, 0, DO_READ_DATA_AGAIN	  # Empty data statement?
  
  
  	# Woo!  Got the line.  It's in S3
  	set I0, 0
  	save S3
  	save " "
  	save I0
  	bsr STRNCHR
  	restore I0  # First space
  	inc I0
  	save S3
  	save " "
  	save I0
  	bsr STRNCHR
  	restore I0  # Next space.
  	inc I0
  	length I1, S3
  	sub I1, I1, I0
  	substr S1, S3, I0, I1
  	# S1 has the DATA "data".  Go evaluate.  Build a "token stack"
  
  	save S1
  	bsr TOKENIZER
  	bsr REVERSESTACK
  	save "REM"
  	bsr EVAL_EXPR
  	restore S1
  	bsr CLEAR
  	restore I5   # Dummy
  
  	set I4, 0    # Data things seen
  	set I0, 0    # Start place
  
  LOOP_DATA:
  	save S1     # Result
  	save ","
  	save I0
  	bsr STRNCHR
  	restore I1
  	eq I1, -1, GET_LAST
  	sub I2, I1, I0
  	substr S2, S1, I0, I2
  	ge I4, I27, GOT_DATA
  	set I0, I1
  	inc I0
  	inc I4
  	branch LOOP_DATA
  
  GET_LAST:
  	length I2, S1
  	sub I2, I2, I0
  	substr S2, S1, I0, I2
  	ge I4, I27, GOT_DATA
  	branch DO_READ_DATA_AGAIN   # Next line
  
  
  GOT_DATA:
  	# So store S2 into variable S0 type I3 (N=1 A=0)
  	inc I4
  	set I27, I4
  	save S0  # Name
  	save S2  # Value
  	eq I3, STYPE, DATA_STR
  	bsr ATOI
  	bsr NSTORE
  	branch END_I_READ
  
  DATA_STR:
  	bsr SSTORE
  	branch END_I_READ
  
  DO_READ_DATA_AGAIN:
  	inc I26
  	set I27, 0   # Index to use, reset
  	branch DO_READ_DATA
  	
  END_I_READ:
  	save S20
  	save S21
  	save I26
  	save I27
  	popi
  	pops
  	restore I27
  	restore I26
  	restore S21
  	restore S20
  	ret
  
  
  # PRINT		 (just a newline)
  # PRINT expr     (anything else)
  #   I6 is the trailing newline marker
  I_PRINT:
  	pushi
  	pushs
  	set I6, 1
  	restore I0  # Line number
  	restore I5  # Depth
  	restore S0  # The print
  	dec I5
  	eq I5, 0, PRINTNL  # Just the newline
  
  	save I5
  	bsr REVERSESTACK  # Last arg is first
  	restore I5
  	restore S0
  	save S0
  	save I5
  	bsr REVERSESTACK  # Put it back in order
  
  	ne S0, ";", FIGURETYPE
  	bsr REVERSESTACK
  	restore I5
  	dec I5
  	restore S0
  	save I5
  	bsr REVERSESTACK
  
  	set I6, 0
  
  FIGURETYPE:
  	# What we have here is an expression.
  	save ""  # No stopwords
  	bsr EVAL_EXPR
  	restore S0
  	print S0
  	bsr CLEAR
  	restore I0  # dummy
  
  PRINTNL:
  	eq I6, 0, I_PRINT_EXIT
  	print "\n"
  I_PRINT_EXIT:	
  	save I24
  	popi
  	pops
  	restore I24
  	ret
  
  # LET NUMVAR=EXPR
  # LET NUMVAR(EXPR[,EXPR]...)=EXPR
  # LET STRINGVAR$=EXPR
  # LET STRINGVAR$(EXPR[,EXPR]...)=EXPR
  #
  I_LET:  pushi
  	pushs
  	restore I0   # Line number
  	restore I5   # Depth
  	restore S0   # Keyword  "LET"
  	dec I5
  	save I5
  	save "="     # Don't pull this!
  	bsr VARDECODE
  
  	restore I3  # Type
  	restore S1  # Name
  
  	restore I5
  	restore S2   # The "="
  	dec I5
  	ne S2, "=", ERR_I_LET
  
  	save I5		
  	save "REM"    
  	bsr EVAL_EXPR
  	restore S0	
  	eq I3, NTYPE, LETNUM
  	save S1
  	save S0
  	bsr SSTORE
  	branch END_I_LET
  
  LETNUM: save S1
  	save S0
  	bsr ATOI
  	bsr NSTORE
  
  END_I_LET:
  	bsr CLEAR    # Clear the token stack
  	restore I0   # Pull the 0
  
  	save S20
  	save S21
  	save I24
  	popi
  	pops
  	restore I24
  	restore S21
  	restore S20
  	ret
  
  ERR_I_LET:
  	# Recover
  	save I5
  	bsr CLEAR
  	restore I5
  	branch SYNTAX_ERROR
  
  # DIM STRINGVAR(EXPR)
  # Dimension is now a no-op.
  I_DIM:  pushi
  	pushs
  	restore I0   # Line number
  	bsr CLEAR    # Clear the token stack
  	restore I0   # Pull the 0
  	popi
  	pops
  	ret
  
  # GOTO EXPR
  # GO TO EXPR
  I_GOTO: pushi
  	pushs
  	restore I0  # Line Number
  
  	restore I5  # Depth
  	restore S0  # Keyword "GO" or "GOTO"
  	dec I5
  	eq S0, "GOTO", I_NOTGO_TO
  	restore S0  # Hope this is a "TO"  :)
  	dec I5
  I_NOTGO_TO:
  	save I5
  	save ""	     #  Stopwords
  	bsr EVAL_EXPR
  	bsr ATOI
  	restore I23  # PROGRAM COUNTER.  :)
  	bsr CLEAR
  	restore I0
  END_I_GOTO:
  	save I23
  	popi
  	pops
  	restore I23
  	ret
  
  # IF EXPR COND EXPR THEN STATEMENT
  # (This should be a total mindfuck)
  I_IF:	pushi
  	pushs
  
  	restore I6  # Line #
  	restore I5  # Depth
  	set I0, 0
  	restore S0  # "IF"
  	dec I5
  	save I5
  	save "THEN"
  	bsr EVAL_EXPR  # True or false?
  	restore S0     # The return value...
  	restore I5
  	restore S1     # THEN
  	dec I5
  	ne S1, "THEN", ERR_SYN_CLEAR
  	save I5
  
  	save S0
  	bsr TRUTH      # Change return value to truth
  	restore I0     # Truth value
  	eq I0, 1, IF_WORKED
  
  	# The stack *is* kosher at this point
  IF_FAILED: 
  	bsr CLEAR
  	restore I0	  # BAIL!
  	branch END_I_IF   # The assertion failed
  
  IF_WORKED:
  	# The idea is, to throw the runtime into 1-line mode
  	#     temporarily.  We've got the next statement tokenized
  	#     on the stack, but we've got to jump back into the RUNLINE
  	#     logic like nothing happened.  :)
  	# This took me forever to get right.  Be careful here.
  	eq I20, 0, IF_IMM
  	restore I5      # Stack depth
  	save I6		# Fake my own line number
  	bsr ITOA
  	inc I5
  	save I5
  IF_IMM:
  	save I23
  	save I20
  	save I24
  	popi
  	pops
  	restore I24
  	restore I20
  	restore I23
  
  	pushi   # To emulate the one at the beginning of RUNLINE
  	pushs
  	bsr RUN_INSERT
  	restore I0      # Status of the statement called
  	eq I0, 0, IF_BAIL
  	branch  ERR_IF
  IF_BAIL:
  	ret
  END_I_IF:
  	save I24
  	popi
  	pops
  	restore I24
  	ret
  
  IFERR:  print "FATAL: Unexpected comparison operator mismatch\n"
  	end
  
  
  # All of these instructions deal with the runtime stack.
  # The runtime stack lives *just below* the stack used by the 
  #    program counter, tokenizer, etc..
  # Format (top to bottom, all strings)
  #
  #      "GOS"                 "FOR"
  #      LINECALLED	     LINECALLED
  #      ""                    TESTVAR
  #      ""                    FINAL
  #      ""                    STEP
  
  # With FOR you *always* get one loop for free
  I_FOR:	pushi
  	pushs
  	restore I10  # My line number.
  
  	restore I5
  	restore S1   # "FOR"
  	restore S0   # Variable Name
  	restore S1   # "="
  	sub I5, I5, 3
  	ne S1, "=", ERR_SYN_CLEAR
  
  	save I5
  	save "TO"    # Stopword
  	bsr EVAL_EXPR
  	bsr ATOI
  	restore I0
  
  	restore I5
  	save I5
  	eq I5, 0, ERR_SYN_CLEAR  # If the "TO" is missing
  
  	save S0	     # Variable name
  	save I0      # Begin value
  	bsr NSTORE  
  
  	restore I5
  	restore S1   # "TO"
  	dec I5
  
  	set S2, ""  # Accumulate
  FORFINAL:
  	le I5, 0, NOSTEPKEY
  	restore S1
  	eq S1, "STEP", PUTBACKSTEP
  	dec I5
  	concat S2, S1
  	concat S2, " "
  	branch FORFINAL
  
  NOSTEPKEY:
  
  	save I5
  	branch NOARGSFOR
  
  PUTBACKSTEP:
  
  	save "STEP"
  	save I5
  
  NOARGSFOR:
  	# Okay, what's on the stack now?  A step?
  	restore I5
  	save I5
  	set I3, 1    # Assume step 1
  	eq I5, 0, NOSTEP
  	restore I5
  	restore S1
  	dec I5
  	ne S1, "STEP", ERR_SYN_CLEAR # SNH
  
  	save I5
  	save ""
  	bsr EVAL_EXPR
  	restore S31
  	save S31
  	bsr ATOI
  	restore I3   # The step
  	eq I3, 0, FOR_SYNTAX1
  
  NOSTEP:
  	bsr CLEAR    # clear instruction stack
  	restore I1   # dummy...
  
  
  	# Meddle with runtime stack
  	restore I5   # The old depth
  
  	save I3
  	bsr ITOA   # Step
  	inc I5
  
  	save S2	   # Final (this is an expression!)
  	inc I5
  
  	save S0    # Var
  	inc I5
  
  	inc I10
  	save I10
  	bsr ITOA   # Line number +1
  	inc I5	
  
  	save "FOR"
  	inc I5
  	
  	save I5
  
  END_I_FOR:
  	save S20
  	save I24
  	popi
  	pops
  	restore I24
  	restore S20
  	ret
  
  FOR_SYNTAX1:
  	print "FOR cannot have Step of 0\n"
  	branch SYNTAX_ERROR
  
  # NEXT
  #
  I_NEXT: pushi
  	pushs
  	restore I10  # My Line #
  	restore I5
  
  	restore S0   # "NEXT"
  	dec I5
  	restore S0   # Variable Name
  	save S0
  	bsr NFETCH
  	restore I0   # Current value
  	dec I5
  	save I5      # Clear rest of INSTRUCTION stack
  	bsr CLEAR
  	restore I5   # dummy
  
  	save "FOR"
  	save S0
  	bsr STACKSEARCH
  
  	# Okay, now dip into the runtime stack
  	restore I5     
  	le I5, 0, ERR_I_UNDERFLOW
  	# Remove 5!
  
  	restore S7
  	dec I5 
  	ne S7, "FOR", ERR_I_NEXT_MS
  
  	bsr ATOI
  	restore I11  # Potential new line #
  	dec I5
  
  	restore S1   # Variable expected (sanity only)
  	dec I5
  	ne S1, S0, ERR_I_NEXT_CROSS
  
  	restore S8   # Final expression
  	save S8
  	bsr TOKENIZER	  # With the ending-expression
  	bsr REVERSESTACK
  	save ""		  # No stopwords
  	bsr EVAL_EXPR
  	bsr ATOI
  	restore I2
  	dec I5
  	bsr CLEAR
  	restore I1   # dummy
  	
  	bsr ATOI
  	restore I3   # Step
  	dec I5
  
  	# FOR LOOP CONTINUE (logic used by NEXT)
  	#     I3  - step
  	#     I2  - end value
  	#     I0  - current value
  	#     I11 - branch target (if succeed)
  	#
  	#   STEP > 0    IF I0 > I2  BAIL
  	#               IF I0 <= I2 CONTINUE
  	#   STEP < 0    IF I0 < I2  BAIL
  	#               IF I0 >= I2 CONTINUE
  	add I0, I0, I3
  
  	save S0
  	save I0
  	bsr NSTORE
  
  	lt I3, 0, FOR_BACK
  	gt I0, I2, GO_FORWARD
  	branch GO_BACK
  FOR_BACK:
  	lt I0, I2, GO_FORWARD
  	branch GO_BACK
  	
  GO_BACK:
  	save I3  # Step
  	bsr ITOA
  
  	save S8  # Final Expr
  	save S0  # Var name
  	save I11
  	bsr ITOA # Line number
  	save "FOR"
  	add I5, I5, 5
  	save I5  # Stack's back to kosher
  
  	set I23, I11  # New line #
  	save I23
  	save S20
  	save I24
  	popi
  	pops	
  	restore I24
  	restore S20
  	restore I23
  	ret
  
  GO_FORWARD:
  	save I5   # Put the runtime stack back (forget the FOR)
  	#save S20 # Uncomment to change the after-loop value of the index
  	save I24
  	popi  
  	pops
  	restore I24
  	#restore S20
  	ret       # Go to next instruction normally
  
  
  # GOSUB EXPR
  # Yes, it's a computed GOSUB.  :)
  I_GOSUB:
  	pushi
  	pushs
  	restore I10  # Line number
  	restore I5
  	restore S0   # GOSUB
  	dec I5
  	save I5
  	save ""
  	bsr EVAL_EXPR
  	bsr ATOI
  	restore I23  # Program Counter
  	bsr CLEAR
  	restore I0   # dummy
  
  	# Build the return information
  	inc I10		# Return to my followers
  	restore I5
  	save ""
  	save ""
  	save ""
  	save I10
  	bsr ITOA	# Return target
  	save "GOS"
  	add I5, I5, 5
  	save I5
  	save I23
  	popi
  	pops
  	restore I23
  	ret
  
  # RETURN
  I_RETURN:
  	pushi
  	pushs
  	restore I10	# Line number
  	bsr CLEAR
  	restore I0   # dummy
  
  	save "GOS"
  	save ""
  	bsr STACKSEARCH  # Pitches unneeded things.
  
  	restore I5
  	le I5, 0, ERR_I_UNDERFLOW
  	restore S0
  	dec I5
  	ne S0, "GOS", ERR_I_NEXT_MS
  	bsr ATOI
  	restore I23
  	restore S0
  	restore S0
  	restore S0
  	sub I5, I5, 4
  	save I5
  	save I23
  	popi
  	pops
  	restore I23
  	ret
  
  #LIST
  I_LIST:
  	pushi
  	pushs
  	restore I10    # Not important
  	restore I5
  	restore S0     # "LIST"
  	dec I5
  
  	set I2, 0   # Start
  	set I3, -1  # End
  	eq I5, 0, DO_I_LIST
  	save I5
  	save "-"
  	bsr EVAL_EXPR
  	bsr ATOI
  	restore I2
  
  	restore I5
  	eq I5, 0, LIST_ONE_LINE  # All tokens used.
  	branch LIST_RANGE
  
  LIST_ONE_LINE:
  	set I3, I2
  	branch DO_I_LIST
  
  LIST_RANGE:
  	restore S0  	# -  
  	dec I5
  	save I5
  	save ""
  	bsr EVAL_EXPR
  	bsr ATOI
  	restore I3
  	
  DO_I_LIST:
  	set I0, I2
  
  LIST_LOOP:
  	save I0
  	bsr CFETCH
  	restore I0
  	eq I0, -1, END_LIST
  	restore S0
  	print S0
  	print "\n"
  	inc I0
  	eq I3, -1 LIST_LOOP  # Go to the end
  	gt I0, I3, END_LIST
  	branch LIST_LOOP
  	
  
  END_LIST:
  	popi
  	pops
  	ret
  
  # RUN
  # Note: there's no localizations here.
  I_RUN:  restore I10   # Line number
  	bsr CLEAR
  	restore I0    # Dummy
  
  	set I20, 1    # Runline mode
          set I23, -1   # Program Counter
  	set S20, "#"  # Clear numerics
  	set S21, "#"  # Clear Alpha
  	set I26, -1   # Reset READ/DATA line number
  	set I27, 0    # And thingy.
  
  	set I18, 0    # Reset line cache
  	set I19, 0
  
  CODELOOP:
          save I23
          bsr CFETCH
          restore I23
          eq I23, -1, END
  	restore S0
  	save S0
          inc I23
          bsr RUNLINE
          restore I1    # Status
          ne I1, 0, ERROR
          branch CODELOOP
  
  	
  ERROR:  # Okay, it's not actually an error branch anymore.
  
  END:    set I20, 0   # Normal mode
  	ret
  
  # NEW
  I_NEW:  pushi
  	pushs
  	restore I10
  	bsr CLEAR
  	restore I10
  	set S22, "#"  # Initialize Codespace
  	save S22
  	popi
  	pops
  	restore S22
  	ret
  
  # LOAD
  # This isn't particularly robust until the I/O gets 
  #   more rounded out.  It's particularly strange becase there's
  #   no line-based I/O from filehandles.  Instead buffer it all and
  #   split based on \n's
  I_LOAD:
  	pushi
  	pushs
  	restore I10   # Line number
  	restore I5
  	restore S0    # "NEW"
  	dec I5
  	eq I5, 0, SYNTAX_ERROR
  	restore S0
  	dec I5
  	save I5
  	bsr CLEAR
  	restore I5	# dummy
  	concat S0, ".bas"
  	print "LOADING "
  	print S0
  	print "..."
  
  	open P0, S0, "<"
  	ne I0, 0, ERR_IO
  	set S1, ""        # Accumulator
  
  LOAD_READ:
  	read S0, P0, 256
  	length I0, S0
  	le I0, 0, LOAD_FIN
  	concat S1, S0
  	branch LOAD_READ
  
  	# Break into lines
  LOAD_FIN:
          set I0, 0
  	set I5, 0
  
  MAKELINES:
          save S1
          save "\n"
          save I0
          bsr STRNCHR
          restore I1
          eq I1, -1, ENDLINES
  
          sub I2, I1, I0
  	print ""
  	#print "<makelinesubstr>"
          substr S2, S1, I0, I2
  	#print "</makelinesubstr>"
  
          save S2		# The line
  	inc I5
          bsr STRIPSPACE  # Just leave it...
  FIN_LINES:
          set I0, I1
          inc I0
          branch MAKELINES
  
  ENDLINES:
  	close P0
  	save I5
  	bsr CENDLOAD
  	print "DONE\n"
  	ret
  
  # INPUT numvar
  # INPUT stringvar
  I_INPUT:
  	pushi
  	pushs
  	restore I10	# Line number
  	restore I5
  	restore S0	# "INPUT"
  	dec I5
  	eq I5, 0, SYNTAX_ERROR
  	save I5
  	save "REM"
  	bsr VARDECODE
  
  	restore I3	# Type
  	restore S0	# Variable
  	bsr CLEAR
  	restore I0	# Dummy
  
  	set S3, ""
  	read S3, 256
          clone S4, S3
          set S5, S4
          save S5
          bsr STRIPSPACE
  	restore S5
  
  	eq I3, STYPE, INPSTRING
  
  	save S0
  	save S5
  	bsr ATOI
  	bsr NSTORE
  	branch ENDINPUT
  
  INPSTRING:
  	savec S0
  	savec S5
  	bsr SSTORE
  	branch ENDINPUT
  
  ENDINPUT:
  	save S20
  	save S21	
  	popi
  	pops
  	restore S21
  	restore S20
  	ret
  
  # Runtime stack mgmt.
  #   Put two things on the stack.  A type FOR/GOS and 
  #   a marker (variable name/"").  This will search down
  #   through the stack.
  # Called by "RETURN" and "NEXT"
  STACKSEARCH:
  	pushi
  	pushs
  	restore S0   # Marker
  	restore S1   # TypeA
  
  KEEPLOOKING:
  	restore I5   # Stack depth
  	eq I5, 0, ENDSEARCH
  	restore S2   # Type 
  	restore S3   # Line #
  	restore S4   # Marker     (FOR)
  	restore S5   # Expression (FOR)
  	restore S6   # Step       (FOR)
  	sub I5, I5, 5
  	save I5
  	ne S2, S1, KEEPLOOKING  # Type mismatch
  	ne S0, S4, KEEPLOOKING  # Marker mismatch
  
  PUTBACK:
  	restore I5
  	save S6
  	save S5
  	save S4
  	save S3
  	save S2
  	add I5, I5, 5
  
  ENDSEARCH:
  	save I5
  	popi
  	pops
  	ret
  
  # Error messages
  #
  ERR_IO:
  	print "I/O Error "
  	err S0
  	print S0
  	print "\n"
  	branch ALL_ERR
  	
  ERR_I_NEXT_MS:	# This is a Should Not Happen error now.
  	save I5
  	bsr CLEAR
  	restore I0
  	save 0   # Initialize a new runtime stack
  	print "Unexpected FOR/GOS on stack "
  	branch ALL_ERR
  
  ERR_I_NEXT_CROSS:
  	save I5
  	bsr CLEAR
  	restore I0
  	save 0   # Initialize a new runtime stack
  	print "Crossed FOR/NEXT values "
  	branch ALL_ERR
  
  ERR_I_UNDERFLOW:
  	save 0   # Initialize a new runtime stack
  	print "GOSUB/FOR stack underflow "
  	branch ALL_ERR
  
  SYNTAX_ERROR:
  	print "Syntax error "
  	branch ALL_ERR
  
  ERR_SYN_CLEAR:
  	save I5
  	bsr CLEAR
  	restore I0
  	branch SYNTAX_ERROR
  
  ERR_I_DIM2:
  	print "Dimension size <= 0 "
  	bsr CLEAR
  	restore I0
  	branch ALL_ERR
  
  ERR_DATA_EXHAUSTED:
  	print "DATA EXHAUSTED AT READ "
  	branch ALL_ERR
  
  ERR_IF:
  	print "Error in IF statement at line "
  	dec I23
  	save I23
  	bsr ITOA
  	restore S31
  	print S31
  	print "\n"
  	set I22, 1
  	ret
  
  ALL_ERR:
  	dec I23
  	print " at line "
  	
  	save I23
  	bsr ITOA
  	restore S31	# Convert for puts
  	print S31
  
  	print "\n"
  	set I22, 1	# Stop please
  	save I22
  	popi
  	pops
  	restore I22
  	ret
  
  
  
  
  
  1.1                  parrot/languages/BASIC/sample2.bas
  
  Index: sample2.bas
  ===================================================================
  10 GOSUB 100
  20 GOSUB 300
  30 GOSUB 400
  90 END
  100 REM 
  101 REM Exercise the expression evaluator
  102 REM
  110 PRINT "Numeric and expression evaluation."
  115 PRINT "Should be 5: ";
  120 PRINT 5+2*3-6
  125 PRINT "Should be -3: ";
  130 PRINT 15/3+((3*2+2-1+1)*-1)
  135 PRINT "Should be a 4-item list: ";
  140 PRINT 5,"HELLO WORLD",67,-1
  145 PRINT "Functions, first the alphabet: ";
  150 FOR I=65 TO 90
  155 PRINT CHR(I);
  160 NEXT I
  161 PRINT
  163 PRINT "String funcs, BROAD: ";
  165 DIM SAMPLE$(30)
  170 LET SAMPLE$="EMERGENCY BROADCAST"
  175 PRINT MID(SAMPLE$,11,5)
  180 PRINT
  190 RETURN
  300 REM
  301 REM Exercise the READ/DATA/RESTORE functions
  302 REM
  305 PRINT "Testing READ/DATA Should see series 0..10 then 0..10"
  310 FOR I=0 TO 10
  315 READ F
  320 PRINT F;
  330 PRINT " ";
  340 NEXT I
  350 RESTORE
  355 PRINT
  360 FOR I=0 TO 10
  365 READ H
  370 PRINT H;
  375 PRINT " ";
  379 NEXT I
  380 PRINT
  381 DIM A$(20)
  392 PRINT "And string read (thats all folks):";
  383 READ A$
  384 PRINT A$
  385 RETURN
  390 DATA 0, 1, 2, 3, 4, 5
  395 DATA 6, 7, 8, 9, 10, "All Done w READ/DATA"
  400 REM
  401 REM Demonstrate FOR/NEXT looping
  402 REM
  405 PRINT "First count by 2s, then backwards from 10, then nested 0-3"
  410 FOR I=0 TO 10 STEP 2
  412 PRINT I;
  413 PRINT " ";
  415 NEXT I
  420 PRINT
  425 FOR I=10 TO 0 STEP -1
  430 PRINT I;
  435 PRINT " ";
  440 NEXT I
  445 PRINT
  450 FOR I=0 TO 3
  455 FOR J=0 TO 3
  460 PRINT I;
  462 PRINT " ";
  470 PRINT J;
  472 PRINT " ";
  475 NEXT J
  480 PRINT
  485 NEXT I
  490 RETURN
  
  
  
  1.1                  parrot/languages/BASIC/sample3.bas
  
  Index: sample3.bas
  ===================================================================
  10 GOSUB 100
  20 REM GOSUB 500
  90 END
  100 REM
  101 REM Conditionals and stuff
  102 REM
  104 LET I=I+1
  105 PRINT "Looping...";
  106 PRINT I
  110 IF I=5 THEN GOTO 150
  120 GOTO 104
  150 PRINT "Done"
  160 RETURN
  500 REM 
  501 REM Arrays and random numbers
  502 REM
  505 PRINT "Distribution of 100 random numbers 1-10:"
  510 FOR I=0 TO 99
  520 LET NUMBER=RND(10)
  530 LET ARR(NUMBER)=ARR(NUMBER)+1
  540 NEXT I
  545 FOR I=0 TO 9
  546 PRINT "The number ";
  547 PRINT I;
  548 PRINT " was seen ";
  560 PRINT ARR(I);
  565 PRINT " times"
  570 NEXT I
  590 RETURN
  
  
  
  1.1                  parrot/languages/BASIC/sample4.bas
  
  Index: sample4.bas
  ===================================================================
  10 GOSUB 100
  20 GOSUB 300
  99 END
  100 REM
  101 REM Test strings and stuff
  102 REM
  105 PRINT "String test.  My name and then a Tic-Tac-Toe board"
  110 LET A$="Clinton Pierce"
  120 PRINT "Parrot BASIC by: ";
  130 PRINT A$
  140 FOR I=0 TO 2
  150 FOR J=0 TO 2
  155 READ R$
  157 LET T$(I,J)=R$
  160 NEXT J
  170 NEXT I
  190 DATA "X","O"," "
  200 DATA "X","X","O"
  210 DATA "O","O","X"
  220 FOR I=0 TO 2
  230 FOR J=0 TO 2
  240 PRINT T$(I,J);
  250 PRINT " ";
  260 NEXT J
  265 PRINT
  270 NEXT I
  280 RETURN
  300 REM
  301 REM String Concatenation
  302 REM
  305 DUMP
  310 LET A$="HELLO "
  315 DUMP
  320 LET B$="WORLD"
  340 LET C$=A$+B$
  350 PRINT "Standard greeting: ";
  360 PRINT C$
  370 RETURN
  
  
  
  1.1                  parrot/languages/BASIC/stackops.pasm
  
  Index: stackops.pasm
  ===================================================================
  # Stack Library
  #  This'll get a whole lot cleaner when I can tell the
  #  depth of the stack automagically
  #
  # $Id: stackops.pasm,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  # $Log: stackops.pasm,v $
  # Revision 1.1  2002/04/11 01:25:59  jgoff
  # Adding clintp's BASIC interpreter.
  #
  # Revision 1.3  2002/03/31 05:15:31  Clinton
  # Adjusted
  #
  # Revision 1.2  2002/03/31 05:13:28  Clinton
  # Id Keywords
  #
  
  # 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
  #	    the string to leave in its place
  #  Outputs: The string removed
  #     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.
  # Does *not* test for bounds conditions
  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
  
  # Reverse the stack 
  #   Inputs: Stack depth on top of the stack
  #  Outputs: Stack depth on top of the stack
  REVERSESTACK: 
  	pushi
  	restore I5
  	set I0, I5
  REVSHIFT:
  	eq I0, 0, REVERSEEND
  	rotate_up I0
  	dec I0
  	branch REVSHIFT
  REVERSEEND:
  	save I5
  	popi
  	ret
  
  # Clear the stack
  #  Inputs: Stack depth on top of the stack
  # Outputs: 0 on top of the stack
  CLEAR:  pushi
  	pushs
          restore I5
  CLEARL: eq I5, 0, CLEAREND
          restore S0
          dec I5
          branch CLEARL
  CLEAREND:
  	save 0
  	popi
  	pops
  	ret
  
  # SORTSTACK
  #  Inputs: A well-formed stack
  # Outputs: Another well-formed stack
  # Ported from suggestions at http://www.perlmonks.org/index.pl?node_id=153974
  #   as an improvement over the bubble sort.
  SORTSTACK:
  	pushi
  	pushs
  	# Assume that rotate_up as defined in the original problem
  	# statement has been defined.
  	restore I5	# local $len = pop(@stack);
      	set I6, I5	# local $bum = $len;
      			# local ($x, $y, $limit);
  SORTMORE:
  	le I6,1,ENDSORT # while ($bum > 1) {
  	set I7, I6	#      $limit = $bum;
  SHUFFLE:	
  	dec I7
  	eq I7, 0, ALMOSTDONE	# while (--$limit) {
  	restore S2		#     $x = pop(@stack);
  	restore S3		#     $y = pop(@stack);
  	le S2, S3, SORTSWAP 	# if ($x gt $y) {
  	save S2			#     push(@stack, $x);
  	save S3			#     push(@stack, $y);
  	branch ROT		# }
  SORTSWAP:			# else {
  	save S3			#     push(@stack, $y);
  	save S2			#     push(@stack, $x); }
  ROT:
          rotate_up I6		# rotate_up($bum);
  	branch SHUFFLE		# }
  ALMOSTDONE:		        # At end of the $limit loop, top element is the max, and
  				# top+1 to end is semi-sorted. One more rotate_up()
  				# is needed before moving the floor up one notch.
  	rotate_up I6		# rotate_up($bum);
  	dec I6 			# $bum--; }
  	branch SORTMORE
  ENDSORT:
  	save I5
  	popi
  	pops
  	ret
  
  
  
  1.1                  parrot/languages/BASIC/tokenize.pasm
  
  Index: tokenize.pasm
  ===================================================================
  # 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 
  #          ** leftmost on bottom **
  # Quotes (single or double) are *preserved* so that
  #     Foo "bar hlaghalg"
  #   is two tokens, and the second is "bar hlaghalg"
  # Consecutive non-alphabetic characters are each considered a token
  #
  # $Id: tokenize.pasm,v 1.1 2002/04/11 01:25:59 jgoff Exp $
  # $Log: tokenize.pasm,v $
  # Revision 1.1  2002/04/11 01:25:59  jgoff
  # Adding clintp's BASIC interpreter.
  #
  # Revision 1.2  2002/03/31 05:13:44  Clinton
  # Id Keywords
  #
  #
  TOKENIZER:
  	pushi
  	pushs
  	set I3, 0    # Inquote
  	set I4, 0    # ALPHA
  	set S0, ""   # Playground
  	set S2, ""
  	restore S2  # String to tokenize
  	set I5, 0    # Stack pointer
  
  TOKLOOP: length I0, S2
  	eq I0, 0, ENDTOK
  	set S1, ""
  	substr S1, S2, 0, 1
  	dec I0
  	substr S2, S2, 1, I0
  	
  	eq S1, "'", QUOTE
  	eq S1, '"', QUOTE
  	branch CKQUOTED
  
  QUOTE:  ne I3, 0, EOTOK
  	length I0,S0
  	eq I0, 0, FINQUOT
  	save S0
  	inc I5
  FINQUOT:set I3, 1
  	set S0, S1
  	branch TOKLOOP
  EOTOK:  set I3, 0
  	concat S0, S1
  	save S0
  	inc I5
  	set S0, ""
  	branch TOKLOOP
  CKQUOTED:
  	eq I3, 0, NOTQUOTED
  	concat S0, S1
  	branch TOKLOOP
  NOTQUOTED:
  	save S1
  	bsr ISWHITE
  	restore I2
  	ne I2, 1, NOTSPACE  # Spaces will end a token
  	length I0, S0
  	eq I0, 0, TOKLOOP
  	save S0
  	inc I5
  	set S0, ""
  	branch TOKLOOP
  NOTSPACE:
  	save S1
  	bsr ISALPHA
  	restore I0
  	length I1, S0
  	ne I1, 0, NOTEMPTY
  	set S0, S1
  	set I4, I0
  	branch TOKLOOP
  NOTEMPTY:
  	eq I4, 0, TOKCHANGED
  	ne I0, I4, TOKCHANGED
  	concat S0, S1
  	branch TOKLOOP
  TOKCHANGED:
  	save S0
  	inc I5
  	set S0, S1
  	set I4, I0
  	branch TOKLOOP
  ENDTOK: length I0, S0
  	eq I0, 0, TOKBAIL
  	save S0
  	inc I5
  TOKBAIL:save I5
  	popi
  	pops
  	ret
  
  
  
  1.1                  parrot/languages/BASIC/wumpus.bas
  
  Index: wumpus.bas
  ===================================================================
  1 REM Taken from David Ahl's 101 BASIC Games reproduced in article
  2 REM (available on Google) 9207071854.AA21847@thep.lu.se
  3 REM      Ported to Parrot BASIC by Clinton Pierce.
  4 REM License status: Unknown
  5 REM *** HUNT THE WUMPUS ***
  11 DIM I$(20)
  15 PRINT "INSTRUCTIONS (Y-N)";
  20 INPUT I$
  25 IF I$="N" THEN GOTO 35
  30 GOSUB 375
  35 GOTO 80
  80 REM *** SET UP CAVE (DODECAHEDRAL NODE LIST) ***
  90 FOR J=1 TO 20
  95 FOR K=1 TO 3
  100 READ S(J,K)
  105 NEXT K
  110 NEXT J
  115 DATA 2,5,8,1,3,10,2,4,12,3,5,14,1,4,6
  120 DATA 5,7,15,6,8,17,1,7,9,8,10,18,2,9,11
  125 DATA 10,12,19,3,11,13,12,14,20,4,13,15,6,14,16
  130 DATA 15,17,20,7,16,18,9,17,19,11,18,20,13,16,19
  150 REM *** LOCATE L ARRAY ITEMS ***
  155 REM *** 1-YOU, 2-WUMPUS, 3&4-PITS, 5&6-BATS ***
  170 PRINT "SETTING UP MAZE.  PLEASE WAIT."
  171 FOR J=1 TO 6
  175 LET L(J)=RND(20)+1
  180 LET M(J)=L(J)
  185 NEXT J
  190 REM *** CHECK FOR CROSSOVERS (IE L(1)=L(2), ETC) ***
  195 FOR J=1 TO 6
  200 FOR K=1 TO 6
  205 IF J=K THEN GOTO 215
  210 IF L(J)=L(K) THEN GOTO 171
  215 NEXT K
  220 NEXT J
  225 REM *** SET NO. OF ARROWS ***
  230 LET A=5
  235 LET L=L(1)
  240 REM *** RUN THE GAME ***
  245 PRINT "HUNT THE WUMPUS"
  250 REM *** HAZARD WARNING AND LOCATION ***
  255 GOSUB 585
  260 REM *** MOVE OR SHOOT ***
  265 GOSUB 670
  271 IF O=1 THEN GOTO 280
  272 IF O=2 THEN GOTO 300
  273 REM 270 ON O GOTO 280,300
  275 REM *** SHOOT ***
  280 GOSUB 715
  285 IF F=0 THEN GOTO 255
  290 GOTO 310
  295 REM *** MOVE ***
  300 GOSUB 975
  305 IF F=0 THEN GOTO 255
  310 IF F>0 THEN GOTO 335
  315 REM *** LOSE ***
  320 PRINT "HA HA HA - YOU LOSE!"
  325 GOTO 340
  330 REM *** MOVE ***
  335 PRINT "HEE HEE HEE - THE WUMPUS`LL GET YOU NEXT TIME!!"
  340 FOR J=1 TO 6
  345 LET L(J)=M(J)
  350 NEXT J
  355 PRINT "SAME SETUP (Y-N)";
  360 INPUT I$
  365 IF I$ <> "Y" THEN GOTO 170
  370 GOTO 230
  375 REM *** INSTRUCTIONS ***
  380 PRINT "WELCOME TO HUNT THE WUMPUS"
  385 PRINT "  THE WUMPUS LIVES IN A CAVE OF 20 ROOMS. EACH ROOM"
  390 PRINT "HAS 3 TUNNELS LEADING TO OTHER ROOMS. (LOOK AT A"
  395 PRINT "DODECAHEDRON TO SEE HOW THIS WORKS-IF YOU DONT KNOW"
  400 PRINT "WHAT A DODECAHEDRON IS, ASK SOMEONE)"
  405 PRINT
  410 PRINT "     HAZARDS:"
  415 PRINT " BOTTOMLESS PITS - TWO ROOMS HAVE BOTTOMLESS PITS IN THEM"
  420 PRINT "     IF YOU GO THERE, YOU FALL INTO THE PIT (& LOSE!)"
  425 PRINT " SUPER BATS - TWO OTHER ROOMS HAVE SUPER BATS. IF YOU"
  430 PRINT "     GO THERE, A BAT GRABS YOU AND TAKES YOU TO SOME OTHER"
  435 PRINT "     ROOM AT RANDOM. (WHICH MAY BE TROUBLESOME)"
  439 PRINT "TYPE AN I THEN RETURN ";
  440 INPUT W9
  445 PRINT "     WUMPUS:"
  450 PRINT " THE WUMPUS IS NOT BOTHERED BY HAZARDS (HE HAS SUCKER"
  455 PRINT " FEET AND IS TOO BIG FOR A BAT TOO LIFT).  USUALLY"
  460 PRINT " HE IS ASLEEP.  TWO THINGS WAKE HIM UP:YOU SHOOTING AN"
  465 PRINT " OR YOU ENTERING HIS ROOM."
  470 PRINT "     IF THE WUMPUS WAKES HE MOVES (P=.75) ONE ROOM"
  475 PRINT " OR STAYS STILL (P=.25).  AFTER THAT, IF HE IS WHERE YOU"
  480 PRINT " ARE, HE EATS YOU UP AND YOU LOSE!"
  485 PRINT
  490 PRINT "     YOU:"
  495 PRINT " EACH TURN YOU MAY MOVE OR SHOOT A CROOKED ARROW"
  500 PRINT "   MOVING:  YOU CAN MOVE ONE ROOM (THRU ONE TUNNEL)"
  505 PRINT "   ARROWS:  YOU HAVE 5 ARROWS.  YOU LOSE WHEN YOU RUN OUT"
  510 PRINT "   EACH ARROW CAN GO FROM 1 TO 5 ROOMS. YOU AIM BY TELLIN"
  515 PRINT "   THE COMPUTER THE ROOM#S YOU WANT THE ARROW TO GO TO."
  520 PRINT "   IF THE ARROW CANT GO THAT WAY (IF NO TUNNEL) IT MOVES"
  525 PRINT "   AT RANDOM TO THE NEXT ROOM."
  530 PRINT "     IF THE ARROW HITS THE WUMPUS, YOU WIN."
  535 PRINT "     IF THE ARROW YOU, YOU LOSE."
  539 PRINT "TYPE AN E THEN RETURN ";
  540 INPUT W9
  545 PRINT "    WARNINGS:"
  550 PRINT "     WHEN YOU ARE ONE ROOM AWAY FROM A WUMPUS OR HAZARD,"
  555 PRINT "     THE COMPUTER SAYS:"
  560 PRINT " WUMPUS:  I SMELL A WUMPUS"
  565 PRINT " BAT   :  BATS NEARBY"
  570 PRINT " PIT   :  I FEEL A DRAFT"
  575 PRINT
  580 RETURN
  585 REM *** PRINT LOCATION & HAZARD WARNINGS ***
  590 PRINT
  595 FOR J=2 TO 6
  600 FOR K=1 TO 3
  605 IF S(L(1),K) <> L(J) THEN GOTO 640
  609 REM 610 ON J-1 GOTO 615,625,625,635,635
  610 IF J-1=1 THEN GOTO 615
  611 IF J-1=2 THEN GOTO 625
  612 IF J-1=3 THEN GOTO 625
  613 IF J-1=4 THEN GOTO 635
  614 IF J-1=5 THEN GOTO 635
  615 PRINT "I SMELL A WUMPUS!";
  620 GOTO 640
  625 PRINT "I FEEL A DRAFT"
  630 GOTO 640
  635 PRINT "BATS NEARBY!"
  640 NEXT K
  645 NEXT J
  650 PRINT "YOU ARE IN ROOM ";
  652 PRINT L(1)
  655 PRINT "TUNNELS LEAD TO ";
  656 PRINT S(L,1);
  657 PRINT " ";
  658 PRINT S(L,2);
  659 PRINT " ";
  660 PRINT S(L,3)
  661 PRINT
  665 RETURN
  670 REM *** CHOOSE OPTION ***
  675 PRINT "SHOOT OR MOVE (S-M) ";
  680 INPUT I$
  685 IF I$ <> "S" THEN GOTO 700
  690 LET O=1
  695 RETURN
  700 IF I$ <> "M" THEN GOTO 675
  705 LET O=2
  710 RETURN
  715 REM *** ARROW ROUTINE ***
  720 LET F=0
  725 REM *** PATH OF ARROW ***
  735 PRINT "NO. OF ROOMS (1-5)";
  740 INPUT J9
  745 IF J9<1 THEN GOTO 735
  750 IF J9>5 THEN GOTO 735
  755 FOR K=1 TO J9
  760 PRINT "ROOM #";
  765 INPUT P(K)
  770 IF K<=2 THEN GOTO 790
  775 IF P(K) <> P(K-2) THEN GOTO 790
  780 PRINT "ARROWS ARENT THAT CROOKED - TRY ANOTHER ROOM"
  785 GOTO 760
  790 NEXT K
  795 REM *** SHOOT ARROW ***
  800 LET L=L(1)
  805 FOR K=1 TO J9
  810 FOR K1=1 TO 3
  815 IF S(L,K1)=P(K) THEN GOTO 895
  820 NEXT K1
  825 REM *** NO TUNNEL FOR ARROW ***
  830 LET L=S(L,RND(3)+1)
  835 GOTO 900
  840 NEXT K
  845 PRINT "MISSED"
  850 LET L=L(1)
  855 REM *** MOVE WUMPUS ***
  860 GOSUB 935
  865 REM *** AMMO CHECK ***
  870 LET A=A-1
  875 IF A>0 THEN GOTO 885
  880 LET F=-1
  885 RETURN
  890 REM *** SEE IF ARROW IS AT L(1) OR AT L(2)
  895 LET L=P(K)
  900 IF L <> L(2) THEN GOTO 920
  905 PRINT "AHA! YOU GOT THE WUMPUS!"
  910 LET F=1
  915 RETURN
  920 IF L <> L(1) THEN GOTO 840
  925 PRINT "OUCH! ARROW GOT YOU!"
  930 GOTO 880
  935 REM *** MOVE WUMPUS ROUTINE ***
  940 LET K=RND(4)+1
  945 IF K=4 THEN GOTO 955
  950 LET L(2)=S(L(2),K)
  955 IF L(2) <> L THEN GOTO 970
  960 PRINT "TSK TSK TSK - WUMPUS GOT YOU!"
  965 LET F=-1
  970 RETURN
  975 REM *** MOVE ROUTINE ***
  980 LET F=0
  985 PRINT "WHERE TO ";
  990 INPUT L
  995 IF L<1 THEN GOTO 985
  1000 IF L>20 THEN GOTO 985
  1002 REM PRINT "Wanted ",L
  1005 FOR K=1 TO 3
  1010 REM *** CHECK IF LEGAL MOVE ***
  1017 IF S(L(1),K)=L THEN GOTO 1045
  1020 NEXT K
  1025 IF L=L(1) THEN GOTO 1045
  1030 PRINT "NOT POSSIBLE -";
  1035 GOTO 985
  1040 REM *** CHECK FOR HAZARDS ***
  1045 LET L(1)=L
  1050 REM *** WUMPUS ***
  1055 IF L <> L(2) THEN GOTO 1090
  1060 PRINT "... OOPS! BUMPED A WUMPUS!"
  1065 REM *** MOVE WUMPUS ***
  1070 GOSUB 940
  1075 IF F=0 THEN GOTO 1090
  1080 RETURN
  1085 REM *** PIT ***
  1090 IF L=L(3) THEN GOTO 1100
  1095 IF L <> L(4) THEN GOTO 1120
  1100 PRINT "YYYYIIIIEEEE . . . FELL IN PIT"
  1105 LET F=-1
  1110 RETURN
  1115 REM *** BATS ***
  1120 IF L=L(5) THEN GOTO 1130
  1125 IF L <> L(6) THEN GOTO 1145
  1130 PRINT "ZAP--SUPER BAT SNATCH! ELSEWHEREVILLE FOR YOU!"
  1135 LET L=RND(20)+1
  1140 GOTO 1045
  1145 RETURN
  1150 END
  
  
  



nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About