URL
https://opencores.org/ocsvn/rf68000/rf68000/trunk
Subversion Repositories rf68000
[/] [rf68000/] [trunk/] [software/] [examples/] [TinyBasic.asm] - Rev 4
Go to most recent revision | Compare with Previous | Blame | View Log
******************************************************************
* *
* Tiny BASIC for the Motorola MC68000 *
* *
* Derived from Palo Alto Tiny BASIC as published in the May 1976 *
* issue of Dr. Dobb's Journal. Adapted to the 68000 by: *
* Gordon Brandly *
* 12147 - 51 Street *
* Edmonton AB T5W 3G8 *
* Canada *
* (updated mailing address for 1996) *
* *
* This version is for MEX68KECB Educational Computer Board I/O. *
* *
******************************************************************
* Copyright (C) 1984 by Gordon Brandly. This program may be *
* freely distributed for personal use only. All commercial *
* rights are reserved. *
******************************************************************
* Vers. 1.0 1984/7/17 - Original version by Gordon Brandly
* 1.1 1984/12/9 - Addition of '$' print term by Marvin Lipford
* 1.2 1985/4/9 - Bug fix in multiply routine by Rick Murray
* OPT FRS,BRS forward ref.'s & branches default to short
;CR EQU $0D ASCII equates
;LF EQU $0A
;TAB EQU $09
;CTRLC EQU $03
;CTRLH EQU $08
;CTRLS EQU $13
;CTRLX EQU $18
BUFLEN EQU 80 length of keyboard input buffer
CODE
* ORG $10000 first free address using Tutor
*
* Standard jump table. You can change these addresses if you are
* customizing this interpreter for a different environment.
*
START BRA CSTART Cold Start entry point
GOWARM BRA WSTART Warm Start entry point
GOOUT BRA OUTC Jump to character-out routine
GOIN BRA INC Jump to character-in routine
GOAUXO BRA AUXOUT Jump to auxiliary-out routine
GOAUXI BRA AUXIN Jump to auxiliary-in routine
GOBYE BRA BYEBYE Jump to monitor, DOS, etc.
*
* Modifiable system constants:
*
TXTBGN DC.L $41000 beginning of program memory
ENDMEM DC.L $41FF0 end of available memory
*
* The main interpreter starts here:
*
CSTART MOVE.L ENDMEM,SP initialize stack pointer
move.l #OUTC1,OUTPTR
move.l #INC1,INPPTR
LEA INITMSG,A6 tell who we are
BSR PRMESG
MOVE.L TXTBGN,TXTUNF init. end-of-program pointer
MOVE.L ENDMEM,D0 get address of end of memory
SUB.L #2048,D0 reserve 2K for the stack
MOVE.L D0,STKLMT
SUB.L #108,D0 reserve variable area (27 long words)
MOVE.L D0,VARBGN
WSTART CLR.L D0 initialize internal variables
MOVE.L D0,LOPVAR
MOVE.L D0,STKGOS
MOVE.L D0,CURRNT current line number pointer = 0
MOVE.L ENDMEM,SP init S.P. again, just in case
LEA OKMSG,A6 display "OK"
bsr PRMESG
ST3 MOVE.B #'>',D0 Prompt with a '>' and
bsr GETLN read a line.
bsr TOUPBUF convert to upper case
MOVE.L A0,A4 save pointer to end of line
LEA BUFFER,A0 point to the beginning of line
bsr TSTNUM is there a number there?
bsr IGNBLK skip trailing blanks
TST D1 does line no. exist? (or nonzero?)
BEQ DIRECT if not, it's a direct statement
CMP.L #$FFFF,D1 see if line no. is <= 16 bits
BCC QHOW if not, we've overflowed
MOVE.B D1,-(A0) store the binary line no.
ROR #8,D1 (Kludge to store a word on a
MOVE.B D1,-(A0) possible byte boundary)
ROL #8,D1
bsr FNDLN find this line in save area
MOVE.L A1,A5 save possible line pointer
BNE ST4 if not found, insert
bsr FNDNXT find the next line (into A1)
MOVE.L A5,A2 pointer to line to be deleted
MOVE.L TXTUNF,A3 points to top of save area
bsr MVUP move up to delete
MOVE.L A2,TXTUNF update the end pointer
ST4 MOVE.L A4,D0 calculate the length of new line
SUB.L A0,D0
CMP.L #3,D0 is it just a line no. & CR?
BEQ ST3 if so, it was just a delete
MOVE.L TXTUNF,A3 compute new end
MOVE.L A3,A6
ADD.L D0,A3
MOVE.L VARBGN,D0 see if there's enough room
CMP.L A3,D0
BLS QSORRY if not, say so
MOVE.L A3,TXTUNF if so, store new end position
MOVE.L A6,A1 points to old unfilled area
MOVE.L A5,A2 points to beginning of move area
bsr MVDOWN move things out of the way
MOVE.L A0,A1 set up to do the insertion
MOVE.L A5,A2
MOVE.L A4,A3
bsr MVUP do it
BRA ST3 go back and get another line
*
*******************************************************************
*
* *** Tables *** DIRECT *** EXEC ***
*
* This section of the code tests a string against a table. When
* a match is found, control is transferred to the section of
* code according to the table.
*
* At 'EXEC', A0 should point to the string, A1 should point to
* the character table, and A2 should point to the execution
* table. At 'DIRECT', A0 should point to the string, A1 and
* A2 will be set up to point to TAB1 and TAB1_1, which are
* the tables of all direct and statement commands.
*
* A '.' in the string will terminate the test and the partial
* match will be considered as a match, e.g. 'P.', 'PR.','PRI.',
* 'PRIN.', or 'PRINT' will all match 'PRINT'.
*
* There are two tables: the character table and the execution
* table. The character table consists of any number of text items.
* Each item is a string of characters with the last character's
* high bit set to one. The execution table holds a 16-bit
* execution addresses that correspond to each entry in the
* character table.
*
* The end of the character table is a 0 byte which corresponds
* to the default routine in the execution table, which is
* executed if none of the other table items are matched.
*
* Character-matching tables:
TAB1
DC.B '<CO',('M'+$80)
DC.B '<CO',('N'+$80)
DC.B '>CO',('M'+$80)
DC.B '>CO',('N'+$80)
DC.B '<>CO',('M'+$80)
DC.B '<>CO',('N'+$80)
DC.B 'LIS',('T'+$80) Direct commands
DC.B 'LOA',('D'+$80)
DC.B 'NE',('W'+$80)
DC.B 'RU',('N'+$80)
DC.B 'SAV',('E'+$80)
TAB2 DC.B 'NEX',('T'+$80) Direct / statement
DC.B 'LE',('T'+$80)
DC.B 'I',('F'+$80)
DC.B 'GOT',('O'+$80)
DC.B 'GOSU',('B'+$80)
DC.B 'RETUR',('N'+$80)
DC.B 'RE',('M'+$80)
DC.B 'FO',('R'+$80)
DC.B 'INPU',('T'+$80)
DC.B 'PRIN',('T'+$80)
DC.B 'POK',('E'+$80)
DC.B 'STO',('P'+$80)
DC.B 'BY',('E'+$80)
DC.B 'CAL',('L'+$80)
DC.B 0
TAB4 DC.B 'PEE',('K'+$80) Functions
DC.B 'RN',('D'+$80)
DC.B 'AB',('S'+$80)
DC.B 'SIZ',('E'+$80)
DC.B 0
TAB5 DC.B 'T',('O'+$80) "TO" in "FOR"
DC.B 0
TAB6 DC.B 'STE',('P'+$80) "STEP" in "FOR"
DC.B 0
TAB8 DC.B '>',('='+$80) Relational operators
DC.B '<',('>'+$80)
DC.B ('>'+$80)
DC.B ('='+$80)
DC.B '<',('='+$80)
DC.B ('<'+$80)
DC.B 0
DC.B 0 <- for aligning on a word boundary
* Execution address tables:
TAB1_1
DC.L INCOM
DC.L INCON
DC.L OUTCOM
DC.L OUTCON
DC.L IOCOM
DC.L IOCON
DC.L LIST Direct commands
DC.L LOAD
DC.L NEW
DC.L RUN
DC.L SAVE
TAB2_1 DC.L NEXT Direct / statement
DC.L LET
DC.L IF
DC.L GOTO
DC.L GOSUB
DC.L RETURN
DC.L REM
DC.L FOR
DC.L INPUT
DC.L PRINT
DC.L POKE
DC.L STOP
DC.L GOBYE
DC.L CALL
DC.L DEFLT
TAB4_1 DC.L PEEK Functions
DC.L RND
DC.L ABS
DC.L SIZE
DC.L XP40
TAB5_1 DC.L FR1 "TO" in "FOR"
DC.L QWHAT
TAB6_1 DC.L FR2 "STEP" in "FOR"
DC.L FR3
TAB8_1 DC.L XP11 >= Relational operators
DC.L XP12 <>
DC.L XP13 >
DC.L XP15 =
DC.L XP14 <=
DC.L XP16 <
DC.L XP17
*
DIRECT LEA TAB1,A1
LEA TAB1_1,A2
EXEC bsr IGNBLK ignore leading blanks
MOVE.L A0,A3 save the pointer
CLR.B D2 clear match flag
EXLP MOVE.B (A0)+,D0 get the program character
MOVE.B (A1),D1 get the table character
BNE EXNGO If end of table,
MOVE.L A3,A0 restore the text pointer and...
BRA EXGO execute the default.
EXNGO MOVE.B D0,D3 Else check for period...
AND.B D2,D3 and a match.
CMP.B #'.',D3
BEQ EXGO if so, execute
AND.B #$7F,D1 ignore the table's high bit
CMP.B D0,D1 is there a match?
BEQ EXMAT
ADDQ.L #4,A2 if not, try the next entry
MOVE.L A3,A0 reset the program pointer
CLR.B D2 sorry, no match
EX1 TST.B (A1)+ get to the end of the entry
BPL EX1
BRA EXLP back for more matching
EXMAT MOVEQ #-1,D2 we've got a match so far
TST.B (A1)+ end of table entry?
BPL EXLP if not, go back for more
EXGO LEA 0,A3 execute the appropriate routine
MOVE.L (A2),A3
JMP (A3)
*
*******************************************************************
* Console redirection
* <COM will redirect input to the COM port
* >COM will redirect output to the COM port
* <CON will redirect input to the console
* >CON will redirect output to the console
* <>COM will redirect input and output to the COM port
* <>CON will redirect input and output to the console
*******************************************************************
INCON
move.l #INC1,INPPTR
bra FINISH
INCOM
move.l #AUXIN,INPPTR
bra FINISH
IOCOM
move.l #AUXIN,INPPTR
OUTCOM
move.l #AUXOUT,OUTPTR
bra FINISH
IOCON
move.l #INC1,INPPTR
OUTCON
move.l #OUTC1,OUTPTR
bra FINISH
*******************************************************************
*
* What follows is the code to execute direct and statement
* commands. Control is transferred to these points via the command
* table lookup code of 'DIRECT' and 'EXEC' in the last section.
* After the command is executed, control is transferred to other
* sections as follows:
*
* For 'LIST', 'NEW', and 'STOP': go back to the warm start point.
* For 'RUN': go execute the first stored line if any; else go
* back to the warm start point.
* For 'GOTO' and 'GOSUB': go execute the target line.
* For 'RETURN' and 'NEXT'; go back to saved return line.
* For all others: if 'CURRNT' is 0, go to warm start; else go
* execute next command. (This is done in 'FINISH'.)
*
*******************************************************************
*
* *** NEW *** STOP *** RUN (& friends) *** GOTO ***
*
* 'NEW<CR>' sets TXTUNF to point to TXTBGN
*
* 'STOP<CR>' goes back to WSTART
*
* 'RUN<CR>' finds the first stored line, stores its address
* in CURRNT, and starts executing it. Note that only those
* commands in TAB2 are legal for a stored program.
*
* There are 3 more entries in 'RUN':
* 'RUNNXL' finds next line, stores it's address and executes it.
* 'RUNTSL' stores the address of this line and executes it.
* 'RUNSML' continues the execution on same line.
*
* 'GOTO expr<CR>' evaluates the expression, finds the target
* line, and jumps to 'RUNTSL' to do it.
*
NEW bsr ENDCHK
MOVE.L TXTBGN,TXTUNF set the end pointer
STOP bsr ENDCHK
BRA WSTART
RUN bsr ENDCHK
MOVE.L TXTBGN,A0 set pointer to beginning
MOVE.L A0,CURRNT
RUNNXL TST.L CURRNT executing a program?
beq WSTART if not, we've finished a direct stat.
CLR.L D1 else find the next line number
MOVE.L A0,A1
bsr FNDLNP
BCS WSTART if we've fallen off the end, stop
RUNTSL MOVE.L A1,CURRNT set CURRNT to point to the line no.
MOVE.L A1,A0 set the text pointer to
ADDQ.L #2,A0 the start of the line text
RUNSML bsr CHKIO see if a control-C was pressed
LEA TAB2,A1 find command in TAB2
LEA TAB2_1,A2
BRA EXEC and execute it
GOTO bsr EXPR evaluate the following expression
bsr ENDCHK must find end of line
MOVE.L D0,D1
bsr FNDLN find the target line
bne QHOW no such line no.
BRA RUNTSL go do it
*
*******************************************************************
*
* *** LIST *** PRINT ***
*
* LIST has two forms:
* 'LIST<CR>' lists all saved lines
* 'LIST #<CR>' starts listing at the line #
* Control-S pauses the listing, control-C stops it.
*
* PRINT command is 'PRINT ....:' or 'PRINT ....<CR>'
* where '....' is a list of expressions, formats, back-arrows,
* and strings. These items a separated by commas.
*
* A format is a pound sign followed by a number. It controls
* the number of spaces the value of an expression is going to
* be printed in. It stays effective for the rest of the print
* command unless changed by another format. If no format is
* specified, 11 positions will be used.
*
* A string is quoted in a pair of single- or double-quotes.
*
* An underline (back-arrow) means generate a <CR> without a <LF>
*
* A <CR LF> is generated after the entire list has been printed
* or if the list is empty. If the list ends with a semicolon,
* however, no <CR LF> is generated.
*
LIST bsr TSTNUM see if there's a line no.
bsr ENDCHK if not, we get a zero
bsr FNDLN find this or next line
LS1 BCS FINISH warm start if we passed the end
bsr PRTLN print the line
bsr CHKIO check for listing halt request
BEQ LS3
CMP.B #CTRLS,D0 pause the listing?
BNE LS3
LS2 bsr CHKIO if so, wait for another keypress
BEQ LS2
LS3 bsr FNDLNP find the next line
BRA LS1
PRINT MOVE #11,D4 D4 = number of print spaces
bsr TSTC if null list and ":"
DC.B ':',PR2-*
bsr CRLF give CR-LF and continue
BRA RUNSML execution on the same line
PR2 bsr TSTC if null list and <CR>
DC.B CR,PR0-*
bsr CRLF also give CR-LF and
BRA RUNNXL execute the next line
PR0 bsr TSTC else is it a format?
DC.B '#',PR1-*
bsr EXPR yes, evaluate expression
MOVE D0,D4 and save it as print width
BRA PR3 look for more to print
PR1 bsr TSTC is character expression? (MRL)
DC.B '$',PR4-*
bsr EXPR yep. Evaluate expression (MRL)
BSR GOOUT print low byte (MRL)
BRA PR3 look for more. (MRL)
PR4 bsr QTSTG is it a string?
BRA.S PR8 if not, must be an expression
PR3 bsr TSTC if ",", go find next
DC.B ',',PR6-*
bsr FIN in the list.
BRA PR0
PR6 bsr CRLF list ends here
BRA FINISH
PR8 MOVE D4,-(SP) save the width value
bsr EXPR evaluate the expression
MOVE (SP)+,D4 restore the width
MOVE.L D0,D1
bsr PRTNUM print its value
BRA PR3 more to print?
FINISH bsr FIN Check end of command
BRA QWHAT print "What?" if wrong
*
*******************************************************************
*
* *** GOSUB *** & RETURN ***
*
* 'GOSUB expr:' or 'GOSUB expr<CR>' is like the 'GOTO' command,
* except that the current text pointer, stack pointer, etc. are
* saved so that execution can be continued after the subroutine
* 'RETURN's. In order that 'GOSUB' can be nested (and even
* recursive), the save area must be stacked. The stack pointer
* is saved in 'STKGOS'. The old 'STKGOS' is saved on the stack.
* If we are in the main routine, 'STKGOS' is zero (this was done
* in the initialization section of the interpreter), but we still
* save it as a flag for no further 'RETURN's.
*
* 'RETURN<CR>' undoes everything that 'GOSUB' did, and thus
* returns the execution to the command after the most recent
* 'GOSUB'. If 'STKGOS' is zero, it indicates that we never had
* a 'GOSUB' and is thus an error.
*
GOSUB bsr PUSHA save the current 'FOR' parameters
bsr EXPR get line number
MOVE.L A0,-(SP) save text pointer
MOVE.L D0,D1
bsr FNDLN find the target line
BNE AHOW if not there, say "How?"
MOVE.L CURRNT,-(SP) found it, save old 'CURRNT'...
MOVE.L STKGOS,-(SP) and 'STKGOS'
CLR.L LOPVAR load new values
MOVE.L SP,STKGOS
BRA RUNTSL
RETURN bsr ENDCHK there should be just a <CR>
MOVE.L STKGOS,D1 get old stack pointer
BEQ QWHAT if zero, it doesn't exist
MOVE.L D1,SP else restore it
MOVE.L (SP)+,STKGOS and the old 'STKGOS'
MOVE.L (SP)+,CURRNT and the old 'CURRNT'
MOVE.L (SP)+,A0 and the old text pointer
bsr POPA and the old 'FOR' parameters
BRA FINISH and we are back home
*
*******************************************************************
*
* *** FOR *** & NEXT ***
*
* 'FOR' has two forms:
* 'FOR var=exp1 TO exp2 STEP exp1' and 'FOR var=exp1 TO exp2'
* The second form means the same thing as the first form with a
* STEP of positive 1. The interpreter will find the variable 'var'
* and set its value to the current value of 'exp1'. It also
* evaluates 'exp2' and 'exp1' and saves all these together with
* the text pointer, etc. in the 'FOR' save area, which consisits of
* 'LOPVAR', 'LOPINC', 'LOPLMT', 'LOPLN', and 'LOPPT'. If there is
* already something in the save area (indicated by a non-zero
* 'LOPVAR'), then the old save area is saved on the stack before
* the new values are stored. The interpreter will then dig in the
* stack and find out if this same variable was used in another
* currently active 'FOR' loop. If that is the case, then the old
* 'FOR' loop is deactivated. (i.e. purged from the stack)
*
* 'NEXT var' serves as the logical (not necessarily physical) end
* of the 'FOR' loop. The control variable 'var' is checked with
* the 'LOPVAR'. If they are not the same, the interpreter digs in
* the stack to find the right one and purges all those that didn't
* match. Either way, it then adds the 'STEP' to that variable and
* checks the result with against the limit value. If it is within
* the limit, control loops back to the command following the
* 'FOR'. If it's outside the limit, the save area is purged and
* execution continues.
*
FOR bsr PUSHA save the old 'FOR' save area
bsr SETVAL set the control variable
MOVE.L A6,LOPVAR save its address
LEA TAB5,A1 use 'EXEC' to test for 'TO'
LEA TAB5_1,A2
BRA EXEC
FR1 bsr EXPR evaluate the limit
MOVE.L D0,LOPLMT save that
LEA TAB6,A1 use 'EXEC' to look for the
LEA TAB6_1,A2 word 'STEP'
BRA EXEC
FR2 bsr EXPR found it, get the step value
BRA FR4
FR3 MOVEQ #1,D0 not found, step defaults to 1
FR4 MOVE.L D0,LOPINC save that too
FR5 MOVE.L CURRNT,LOPLN save address of current line number
MOVE.L A0,LOPPT and text pointer
MOVE.L SP,A6 dig into the stack to find 'LOPVAR'
BRA FR7
FR6 ADD.L #20,A6 look at next stack frame
FR7 MOVE.L (A6),D0 is it zero?
BEQ FR8 if so, we're done
CMP.L LOPVAR,D0 same as current LOPVAR?
BNE FR6 nope, look some more
MOVE.L SP,A2 Else remove 5 long words from...
MOVE.L A6,A1 inside the stack.
LEA 20,A3
ADD.L A1,A3
bsr MVDOWN
MOVE.L A3,SP set the SP 5 long words up
FR8 BRA FINISH and continue execution
NEXT bsr TSTV get address of variable
BCS QWHAT if no variable, say "What?"
MOVE.L D0,A1 save variable's address
NX0 MOVE.L LOPVAR,D0 If 'LOPVAR' is zero, we never...
BEQ QWHAT had a FOR loop, so say "What?"
CMP.L D0,A1 else we check them
BEQ NX3 OK, they agree
bsr POPA nope, let's see the next frame
BRA NX0
NX3 MOVE.L (A1),D0 get control variable's value
ADD.L LOPINC,D0 add in loop increment
BVS QHOW say "How?" for 32-bit overflow
MOVE.L D0,(A1) save control variable's new value
MOVE.L LOPLMT,D1 get loop's limit value
TST.L LOPINC
BPL NX1 branch if loop increment is positive
EXG D0,D1
NX1 CMP.L D0,D1 test against limit
BLT NX2 branch if outside limit
MOVE.L LOPLN,CURRNT Within limit, go back to the...
MOVE.L LOPPT,A0 saved 'CURRNT' and text pointer.
BRA FINISH
NX2 bsr POPA purge this loop
BRA FINISH
*
*******************************************************************
*
* *** REM *** IF *** INPUT *** LET (& DEFLT) ***
*
* 'REM' can be followed by anything and is ignored by the
* interpreter.
*
* 'IF' is followed by an expression, as a condition and one or
* more commands (including other 'IF's) separated by colons.
* Note that the word 'THEN' is not used. The interpreter evaluates
* the expression. If it is non-zero, execution continues. If it
* is zero, the commands that follow are ignored and execution
* continues on the next line.
*
* 'INPUT' is like the 'PRINT' command, and is followed by a list
* of items. If the item is a string in single or double quotes,
* or is an underline (back arrow), it has the same effect as in
* 'PRINT'. If an item is a variable, this variable name is
* printed out followed by a colon, then the interpreter waits for
* an expression to be typed in. The variable is then set to the
* value of this expression. If the variable is preceeded by a
* string (again in single or double quotes), the string will be
* displayed followed by a colon. The interpreter the waits for an
* expression to be entered and sets the variable equal to the
* expression's value. If the input expression is invalid, the
* interpreter will print "What?", "How?", or "Sorry" and reprint
* the prompt and redo the input. The execution will not terminate
* unless you press control-C. This is handled in 'INPERR'.
*
* 'LET' is followed by a list of items separated by commas.
* Each item consists of a variable, an equals sign, and an
* expression. The interpreter evaluates the expression and sets
* the variable to that value. The interpreter will also handle
* 'LET' commands without the word 'LET'. This is done by 'DEFLT'.
*
REM BRA IF2 skip the rest of the line
IF bsr EXPR evaluate the expression
IF1 TST.L D0 is it zero?
BNE RUNSML if not, continue
IF2 MOVE.L A0,A1
CLR.L D1
bsr FNDSKP if so, skip the rest of the line
BCC RUNTSL and run the next line
BRA WSTART if no next line, do a warm start
INPERR MOVE.L STKINP,SP restore the old stack pointer
MOVE.L (SP)+,CURRNT and old 'CURRNT'
ADDQ.L #4,SP
MOVE.L (SP)+,A0 and old text pointer
INPUT MOVE.L A0,-(SP) save in case of error
bsr QTSTG is next item a string?
BRA.S IP2 nope
bsr TSTV yes, but is it followed by a variable?
BCS IP4 if not, branch
MOVE.L D0,A2 put away the variable's address
BRA IP3 if so, input to variable
IP2 MOVE.L A0,-(SP) save for 'PRTSTG'
bsr TSTV must be a variable now
BCS QWHAT "What?" it isn't?
MOVE.L D0,A2 put away the variable's address
MOVE.B (A0),D2 get ready for 'PRTSTG'
CLR.B D0
MOVE.B D0,(A0)
MOVE.L (SP)+,A1
bsr PRTSTG print string as prompt
MOVE.B D2,(A0) restore text
IP3 MOVE.L A0,-(SP) save in case of error
MOVE.L CURRNT,-(SP) also save 'CURRNT'
MOVE.L #-1,CURRNT flag that we are in INPUT
MOVE.L SP,STKINP save the stack pointer too
MOVE.L A2,-(SP) save the variable address
MOVE.B #':',D0 print a colon first
bsr GETLN then get an input line
LEA BUFFER,A0 point to the buffer
bsr EXPR evaluate the input
MOVE.L (SP)+,A2 restore the variable address
MOVE.L D0,(A2) save value in variable
MOVE.L (SP)+,CURRNT restore old 'CURRNT'
MOVE.L (SP)+,A0 and the old text pointer
IP4 ADDQ.L #4,SP clean up the stack
bsr TSTC is the next thing a comma?
DC.B ',',IP5-*
BRA INPUT yes, more items
IP5 BRA FINISH
DEFLT CMP.B #CR,(A0) empty line is OK
BEQ LT1 else it is 'LET'
LET bsr SETVAL do the assignment
bsr TSTC check for more 'LET' items
DC.B ',',LT1-*
BRA LET
LT1 BRA FINISH until we are finished.
*
*******************************************************************
*
* *** LOAD *** & SAVE ***
*
* These two commands transfer a program to/from an auxiliary
* device such as a cassette, another computer, etc. The program
* is converted to an easily-stored format: each line starts with
* a colon, the line no. as 4 hex digits, and the rest of the line.
* At the end, a line starting with an '@' sign is sent. This
* format can be read back with a minimum of processing time by
* the 68000.
*
LOAD MOVE.L TXTBGN,A0 set pointer to start of prog. area
MOVE.B #CR,D0 For a CP/M host, tell it we're ready...
BSR GOAUXO by sending a CR to finish PIP command.
LOD1
BSR GOAUXI look for start of line
BEQ LOD1
CMP.B #'@',D0 end of program?
BEQ LODEND
CMP.B #':',D0 if not, is it start of line?
BNE LOD1 if not, wait for it
BSR GBYTE get first byte of line no.
MOVE.B D1,(A0)+ store it
BSR GBYTE get 2nd bye of line no.
MOVE.B D1,(A0)+ store that, too
LOD2
BSR GOAUXI get another text char.
BEQ LOD2
MOVE.B D0,(A0)+ store it
CMP.B #CR,D0 is it the end of the line?
BNE LOD2 if not, go back for more
BRA LOD1 if so, start a new line
LODEND
MOVE.L A0,TXTUNF set end-of program pointer
BRA WSTART back to direct mode
GBYTE
MOVEQ #1,D2 get two hex characters from auxiliary
CLR.L D1 and store them as a byte in D1
GBYTE1
BSR GOAUXI get a char.
BEQ GBYTE1
CMP.B #'A',D0
BCS GBYTE2
SUBQ.B #7,D0 if greater than 9, adjust
GBYTE2
AND.B #$F,D0 strip ASCII
LSL.B #4,D1 put nybble into the result
OR.B D0,D1
DBRA D2,GBYTE1 get another char.
RTS
SAVE
MOVE.L TXTBGN,A0 set pointer to start of prog. area
MOVE.L TXTUNF,A1 set pointer to end of prog. area
SAVE1
MOVE.B #CR,D0 send out a CR & LF (CP/M likes this)
BSR GOAUXO
MOVE.B #LF,D0
BSR GOAUXO
CMP.L A0,A1 are we finished?
BLS SAVEND
MOVE.B #':',D0 if not, start a line
BSR GOAUXO
MOVE.B (A0)+,D1 send first half of line no.
BSR PBYTE
MOVE.B (A0)+,D1 and send 2nd half
BSR PBYTE
SAVE2
MOVE.B (A0)+,D0 get a text char.
CMP.B #CR,D0 is it the end of the line?
BEQ SAVE1 if so, send CR & LF and start new line
BSR GOAUXO send it out
BRA SAVE2 go back for more text
SAVEND
MOVE.B #'@',D0 send end-of-program indicator
BSR GOAUXO
MOVE.B #CR,D0 followed by a CR & LF
BSR GOAUXO
MOVE.B #LF,D0
BSR GOAUXO
MOVE.B #$1A,D0 and a control-Z to end the CP/M file
BSR GOAUXO
BRA WSTART then go do a warm start
PBYTE MOVEQ #1,D2 send two hex characters from D1's low byte
PBYTE1 ROL.B #4,D1 get the next nybble
MOVE.B D1,D0
AND.B #$F,D0 strip off garbage
ADD.B #'0',D0 make it into ASCII
CMP.B #'9',D0
BLS PBYTE2
ADDQ.B #7,D0 adjust if greater than 9
PBYTE2 BSR GOAUXO send it out
DBRA D2,PBYTE1 then send the next nybble
RTS
*
*******************************************************************
*
* *** POKE *** & CALL ***
*
* 'POKE expr1,expr2' stores the byte from 'expr2' into the memory
* address specified by 'expr1'.
*
* 'CALL expr' jumps to the machine language subroutine whose
* starting address is specified by 'expr'. The subroutine can use
* all registers but must leave the stack the way it found it.
* The subroutine returns to the interpreter by executing an RTS.
*
POKE BSR EXPR get the memory address
bsr TSTC it must be followed by a comma
DC.B ',',PKER-*
MOVE.L D0,-(SP) save the address
BSR EXPR get the byte to be POKE'd
MOVE.L (SP)+,A1 get the address back
MOVE.B D0,(A1) store the byte in memory
BRA FINISH
PKER BRA QWHAT if no comma, say "What?"
CALL BSR EXPR get the subroutine's address
TST.L D0 make sure we got a valid address
BEQ QHOW if not, say "How?"
MOVE.L A0,-(SP) save the text pointer
MOVE.L D0,A1
JSR (A1) jump to the subroutine
MOVE.L (SP)+,A0 restore the text pointer
BRA FINISH
*
*******************************************************************
*
* *** EXPR ***
*
* 'EXPR' evaluates arithmetical or logical expressions.
* <EXPR>::=<EXPR2>
* <EXPR2><rel.op.><EXPR2>
* where <rel.op.> is one of the operators in TAB8 and the result
* of these operations is 1 if true and 0 if false.
* <EXPR2>::=(+ or -)<EXPR3>(+ or -)<EXPR3>(...
* where () are optional and (... are optional repeats.
* <EXPR3>::=<EXPR4>( <* or /><EXPR4> )(...
* <EXPR4>::=<variable>
* <function>
* (<EXPR>)
* <EXPR> is recursive so that the variable '@' can have an <EXPR>
* as an index, functions can have an <EXPR> as arguments, and
* <EXPR4> can be an <EXPR> in parenthesis.
*
EXPR BSR EXPR2
MOVE.L D0,-(SP) save <EXPR2> value
LEA TAB8,A1 look up a relational operator
LEA TAB8_1,A2
BRA EXEC go do it
XP11 BSR XP18 is it ">="?
BLT XPRT0 no, return D0=0
BRA XPRT1 else return D0=1
XP12 BSR XP18 is it "<>"?
BEQ XPRT0 no, return D0=0
BRA XPRT1 else return D0=1
XP13 BSR XP18 is it ">"?
BLE XPRT0 no, return D0=0
BRA XPRT1 else return D0=1
XP14 BSR XP18 is it "<="?
BGT XPRT0 no, return D0=0
BRA XPRT1 else return D0=1
XP15 BSR XP18 is it "="?
BNE XPRT0 if not, return D0=0
BRA XPRT1 else return D0=1
XP15RT RTS
XP16 BSR XP18 is it "<"?
BGE XPRT0 if not, return D0=0
BRA XPRT1 else return D0=1
XP16RT RTS
XPRT0 CLR.L D0 return D0=0 (false)
RTS
XPRT1 MOVEQ #1,D0 return D0=1 (true)
RTS
XP17 MOVE.L (SP)+,D0 it's not a rel. operator
RTS return D0=<EXPR2>
XP18 MOVE.L (SP)+,D0 reverse the top two stack items
MOVE.L (SP)+,D1
MOVE.L D0,-(SP)
MOVE.L D1,-(SP)
BSR EXPR2 do second <EXPR2>
MOVE.L (SP)+,D1
CMP.L D0,D1 compare with the first result
RTS return the result
EXPR2 bsr TSTC negative sign?
DC.B '-',XP21-*
CLR.L D0 yes, fake '0-'
BRA XP26
XP21 bsr TSTC positive sign? ignore it
DC.B '+',XP22-*
XP22 BSR EXPR3 first <EXPR3>
XP23 bsr TSTC add?
DC.B '+',XP25-*
MOVE.L D0,-(SP) yes, save the value
BSR EXPR3 get the second <EXPR3>
XP24 MOVE.L (SP)+,D1
ADD.L D1,D0 add it to the first <EXPR3>
BVS QHOW branch if there's an overflow
BRA XP23 else go back for more operations
XP25 bsr TSTC subtract?
DC.B '-',XP42-*
XP26 MOVE.L D0,-(SP) yes, save the result of 1st <EXPR3>
BSR EXPR3 get second <EXPR3>
NEG.L D0 change its sign
JMP XP24 and do an addition
EXPR3 BSR EXPR4 get first <EXPR4>
XP31 bsr TSTC multiply?
DC.B '*',XP34-*
MOVE.L D0,-(SP) yes, save that first result
BSR EXPR4 get second <EXPR4>
MOVE.L (SP)+,D1
bsr MULT32 multiply the two
BRA XP31 then look for more terms
XP34 bsr TSTC divide?
DC.B '/',XP42-*
MOVE.L D0,-(SP) save result of 1st <EXPR4>
BSR EXPR4 get second <EXPR4>
MOVE.L (SP)+,D1
EXG D0,D1
bsr DIV32 do the division
BRA XP31 go back for any more terms
EXPR4 LEA TAB4,A1 find possible function
LEA TAB4_1,A2
BRA EXEC
XP40 BSR TSTV nope, not a function
BCS XP41 nor a variable
MOVE.L D0,A1
CLR.L D0
MOVE.L (A1),D0 if a variable, return its value in D0
EXP4RT RTS
XP41 bsr TSTNUM or is it a number?
MOVE.L D1,D0
TST D2 (if not, # of digits will be zero)
BNE EXP4RT if so, return it in D0
PARN bsr TSTC else look for ( EXPR )
DC.B '(',XP43-*
BSR EXPR
bsr TSTC
DC.B ')',XP43-*
XP42 RTS
XP43 BRA QWHAT else say "What?"
*
* ===== Test for a valid variable name. Returns Carry=1 if not
* found, else returns Carry=0 and the address of the
* variable in D0.
TSTV bsr IGNBLK
CLR.L D0
MOVE.B (A0),D0 look at the program text
SUB.B #'@',D0
BCS TSTVRT C=1: not a variable
BNE TV1 branch if not "@" array
ADDQ #1,A0 If it is, it should be
BSR PARN followed by (EXPR) as its index.
ADD.L D0,D0
BCS QHOW say "How?" if index is too big
ADD.L D0,D0
BCS QHOW
MOVE.L D0,-(SP) save the index
bsr SIZE get amount of free memory
MOVE.L (SP)+,D1 get back the index
CMP.L D1,D0 see if there's enough memory
BLS QSORRY if not, say "Sorry"
MOVE.L VARBGN,D0 put address of array element...
SUB.L D1,D0 into D0
RTS
TV1 CMP.B #27,D0 if not @, is it A through Z?
EOR #1,CCR
BCS TSTVRT if not, set Carry and return
ADDQ #1,A0 else bump the text pointer
ADD D0,D0 compute the variable's address
ADD D0,D0
MOVE.L VARBGN,D1
ADD D1,D0 and return it in D0 with Carry=0
TSTVRT RTS
*
* ===== Multiplies the 32 bit values in D0 and D1, returning
* the 32 bit result in D0.
*
MULT32 MOVE.L D1,D4
EOR.L D0,D4 see if the signs are the same
TST.L D0 take absolute value of D0
BPL MLT1
NEG.L D0
MLT1 TST.L D1 take absolute value of D1
BPL MLT2
NEG.L D1
MLT2 CMP.L #$FFFF,D1 is second argument <= 16 bits?
BLS MLT3 OK, let it through
EXG D0,D1 else swap the two arguments
CMP.L #$FFFF,D1 and check 2nd argument again
BHI QHOW one of them MUST be 16 bits
MLT3 MOVE D0,D2 prepare for 32 bit X 16 bit multiply
MULU D1,D2 multiply low word
SWAP D0
MULU D1,D0 multiply high word
SWAP D0
*** Rick Murray's bug correction follows:
TST D0 if lower word not 0, then overflow
BNE QHOW if overflow, say "How?"
ADD.L D2,D0 D0 now holds the product
BMI QHOW if sign bit set, it's an overflow
TST.L D4 were the signs the same?
BPL MLTRET
NEG.L D0 if not, make the result negative
MLTRET RTS
*
* ===== Divide the 32 bit value in D0 by the 32 bit value in D1.
* Returns the 32 bit quotient in D0, remainder in D1.
*
DIV32 TST.L D1 check for divide-by-zero
BEQ QHOW if so, say "How?"
MOVE.L D1,D2
MOVE.L D1,D4
EOR.L D0,D4 see if the signs are the same
TST.L D0 take absolute value of D0
BPL DIV1
NEG.L D0
DIV1 TST.L D1 take absolute value of D1
BPL DIV2
NEG.L D1
DIV2 MOVEQ #31,D3 iteration count for 32 bits
MOVE.L D0,D1
CLR.L D0
DIV3 ADD.L D1,D1 (This algorithm was translated from
ADDX.L D0,D0 the divide routine in Ron Cain's
BEQ DIV4 Small-C run time library.)
CMP.L D2,D0
BMI DIV4
ADDQ.L #1,D1
SUB.L D2,D0
DIV4 DBRA D3,DIV3
EXG D0,D1 put rem. & quot. in proper registers
TST.L D4 were the signs the same?
BPL DIVRT
NEG.L D0 if not, results are negative
NEG.L D1
DIVRT RTS
*
* ===== The PEEK function returns the byte stored at the address
* contained in the following expression.
*
PEEK BSR PARN get the memory address
MOVE.L D0,A1
CLR.L D0 upper 3 bytes will be zero
MOVE.B (A1),D0 get the addressed byte
RTS and return it
*
* ===== The RND function returns a random number from 1 to
* the value of the following expression in D0.
*
RND BSR PARN get the upper limit
TST.L D0 it must be positive and non-zero
BEQ QHOW
BMI QHOW
MOVE.L D0,D1
MOVE.L RANPNT,A1 get memory as a random number
CMP.L #LSTROM,A1
BCS RA1
LEA START,A1 wrap around if end of program
RA1 MOVE.L (A1)+,D0 get the slightly random number
BCLR #31,D0 make sure it's positive
MOVE.L A1,RANPNT (even I can do better than this!)
BSR DIV32 RND(n)=MOD(number,n)+1
MOVE.L D1,D0 MOD is the remainder of the div.
ADDQ.L #1,D0
RTS
*
* ===== The ABS function returns an absolute value in D0.
*
ABS BSR PARN get the following expr.'s value
TST.L D0
BPL ABSRT
NEG.L D0 if negative, complement it
BMI QHOW if still negative, it was too big
ABSRT RTS
*
* ===== The SIZE function returns the size of free memory in D0.
*
SIZE MOVE.L VARBGN,D0 get the number of free bytes...
SUB.L TXTUNF,D0 between 'TXTUNF' and 'VARBGN'
RTS return the number in D0
*
*******************************************************************
*
* *** SETVAL *** FIN *** ENDCHK *** ERROR (& friends) ***
*
* 'SETVAL' expects a variable, followed by an equal sign and then
* an expression. It evaluates the expression and sets the variable
* to that value.
*
* 'FIN' checks the end of a command. If it ended with ":",
* execution continues. If it ended with a CR, it finds the
* the next line and continues from there.
*
* 'ENDCHK' checks if a command is ended with a CR. This is
* required in certain commands, such as GOTO, RETURN, STOP, etc.
*
* 'ERROR' prints the string pointed to by A0. It then prints the
* line pointed to by CURRNT with a "?" inserted at where the
* old text pointer (should be on top of the stack) points to.
* Execution of Tiny BASIC is stopped and a warm start is done.
* If CURRNT is zero (indicating a direct command), the direct
* command is not printed. If CURRNT is -1 (indicating
* 'INPUT' command in progress), the input line is not printed
* and execution is not terminated but continues at 'INPERR'.
*
* Related to 'ERROR' are the following:
* 'QWHAT' saves text pointer on stack and gets "What?" message.
* 'AWHAT' just gets the "What?" message and jumps to 'ERROR'.
* 'QSORRY' and 'ASORRY' do the same kind of thing.
* 'QHOW' and 'AHOW' also do this for "How?".
*
SETVAL BSR TSTV variable name?
BCS QWHAT if not, say "What?"
MOVE.L D0,-(SP) save the variable's address
bsr TSTC get past the "=" sign
DC.B '=',SV1-*
BSR EXPR evaluate the expression
MOVE.L (SP)+,A6
MOVE.L D0,(A6) and save its value in the variable
RTS
SV1 BRA QWHAT if no "=" sign
FIN bsr TSTC *** FIN ***
DC.B ':',FI1-*
ADDQ.L #4,SP if ":", discard return address
BRA RUNSML continue on the same line
FI1 bsr TSTC not ":", is it a CR?
DC.B CR,FI2-*
ADDQ.L #4,SP yes, purge return address
BRA RUNNXL execute the next line
FI2 RTS else return to the caller
ENDCHK bsr IGNBLK
CMP.B #':',(a0)
BEQ ENDCHK1
CMP.B #CR,(A0) does it end with a CR?
BNE QWHAT if not, say "WHAT?"
ENDCHK1:
RTS
QWHAT MOVE.L A0,-(SP)
AWHAT LEA WHTMSG,A6
ERROR bsr PRMESG display the error message
MOVE.L (SP)+,A0 restore the text pointer
MOVE.L CURRNT,D0 get the current line number
BEQ WSTART if zero, do a warm start
CMP.L #-1,D0 is the line no. pointer = -1?
BEQ INPERR if so, redo input
MOVE.B (A0),-(SP) save the char. pointed to
CLR.B (A0) put a zero where the error is
MOVE.L CURRNT,A1 point to start of current line
bsr PRTLN display the line in error up to the 0
MOVE.B (SP)+,(A0) restore the character
MOVE.B #'?',D0 display a "?"
BSR GOOUT
CLR D0
SUBQ.L #1,A1 point back to the error char.
bsr PRTSTG display the rest of the line
BRA WSTART and do a warm start
QSORRY MOVE.L A0,-(SP)
ASORRY LEA SRYMSG,A6
BRA ERROR
QHOW MOVE.L A0,-(SP) Error: "How?"
AHOW LEA HOWMSG,A6
BRA ERROR
*
*******************************************************************
*
* *** GETLN *** FNDLN (& friends) ***
*
* 'GETLN' reads in input line into 'BUFFER'. It first prompts with
* the character in D0 (given by the caller), then it fills the
* buffer and echos. It ignores LF's but still echos
* them back. Control-H is used to delete the last character
* entered (if there is one), and control-X is used to delete the
* whole line and start over again. CR signals the end of a line,
* and causes 'GETLN' to return.
*
* 'FNDLN' finds a line with a given line no. (in D1) in the
* text save area. A1 is used as the text pointer. If the line
* is found, A1 will point to the beginning of that line
* (i.e. the high byte of the line no.), and flags are NC & Z.
* If that line is not there and a line with a higher line no.
* is found, A1 points there and flags are NC & NZ. If we reached
* the end of the text save area and cannot find the line, flags
* are C & NZ.
* 'FNDLN' will initialize A1 to the beginning of the text save
* area to start the search. Some other entries of this routine
* will not initialize A1 and do the search.
* 'FNDLNP' will start with A1 and search for the line no.
* 'FNDNXT' will bump A1 by 2, find a CR and then start search.
* 'FNDSKP' uses A1 to find a CR, and then starts the search.
*
GETLN BSR GOOUT display the prompt
MOVE.B #' ',D0 and a space
BSR GOOUT
LEA BUFFER,A0 A0 is the buffer pointer
GL1 bsr CHKIO check keyboard
BEQ GL1 wait for a char. to come in
CMP.B #CTRLH,D0 delete last character?
BEQ GL3 if so
CMP.B #CTRLX,D0 delete the whole line?
BEQ GL4 if so
CMP.B #CR,D0 accept a CR
BEQ GL2
CMP.B #' ',D0 if other control char., discard it
BCS GL1
GL2 MOVE.B D0,(A0)+ save the char.
BSR GOOUT echo the char back out
CMP.B #CR,D0 if it's a CR, end the line
BEQ GL7
CMP.L #(BUFFER+BUFLEN-1),A0 any more room?
BCS GL1 yes: get some more, else delete last char.
GL3 MOVE.B #CTRLH,D0 delete a char. if possible
BSR GOOUT
MOVE.B #' ',D0
BSR GOOUT
CMP.L #BUFFER,A0 any char.'s left?
BLS GL1 if not
MOVE.B #CTRLH,D0 if so, finish the BS-space-BS sequence
BSR GOOUT
SUBQ.L #1,A0 decrement the text pointer
BRA GL1 back for more
GL4 MOVE.L A0,D1 delete the whole line
SUB.L #BUFFER,D1 figure out how many backspaces we need
BEQ GL6 if none needed, branch
SUBQ #1,D1 adjust for DBRA
GL5 MOVE.B #CTRLH,D0 and display BS-space-BS sequences
BSR GOOUT
MOVE.B #' ',D0
BSR GOOUT
MOVE.B #CTRLH,D0
BSR GOOUT
DBRA D1,GL5
GL6 LEA BUFFER,A0 reinitialize the text pointer
BRA GL1 and go back for more
GL7 MOVE.B #LF,D0 echo a LF for the CR
BRA GOOUT
FNDLN CMP.L #$FFFF,D1 line no. must be < 65535
BCC QHOW
MOVE.L TXTBGN,A1 init. the text save pointer
FNDLNP MOVE.L TXTUNF,A2 check if we passed the end
SUBQ.L #1,A2
CMP.L A1,A2
BCS FNDRET if so, return with Z=0 & C=1
MOVE.B (A1),D2 if not, get a line no.
LSL #8,D2
MOVE.B 1(A1),D2
CMP.W D1,D2 is this the line we want?
BCS FNDNXT no, not there yet
FNDRET RTS return the cond. codes
FNDNXT ADDQ.L #2,A1 find the next line
FNDSKP
CMP.B #CR,(A1)+ try to find a CR
BEQ FNDLNP
CMP.L TXTUNF,A1
BLO FNDSKP
BRA FNDLNP check if end of text
*
*******************************************************************
*
* *** MVUP *** MVDOWN *** POPA *** PUSHA ***
*
* 'MVUP' moves a block up from where A1 points to where A2 points
* until A1=A3
*
* 'MVDOWN' moves a block down from where A1 points to where A3
* points until A1=A2
*
* 'POPA' restores the 'FOR' loop variable save area from the stack
*
* 'PUSHA' stacks for 'FOR' loop variable save area onto the stack
*
MVUP CMP.L A1,A3 see the above description
BEQ MVRET
MOVE.B (A1)+,(A2)+
BRA MVUP
MVRET RTS
MVDOWN CMP.L A1,A2 see the above description
BEQ MVRET
MOVE.B -(A1),-(A3)
BRA MVDOWN
POPA MOVE.L (SP)+,A6 A6 = return address
MOVE.L (SP)+,LOPVAR restore LOPVAR, but zero means no more
BEQ PP1
MOVE.L (SP)+,LOPINC if not zero, restore the rest
MOVE.L (SP)+,LOPLMT
MOVE.L (SP)+,LOPLN
MOVE.L (SP)+,LOPPT
PP1 JMP (A6) return
PUSHA MOVE.L STKLMT,D1 Are we running out of stack room?
SUB.L SP,D1
BCC QSORRY if so, say we're sorry
MOVE.L (SP)+,A6 else get the return address
MOVE.L LOPVAR,D1 save loop variables
BEQ PU1 if LOPVAR is zero, that's all
MOVE.L LOPPT,-(SP) else save all the others
MOVE.L LOPLN,-(SP)
MOVE.L LOPLMT,-(SP)
MOVE.L LOPINC,-(SP)
PU1 MOVE.L D1,-(SP)
JMP (A6) return
*
*******************************************************************
*
* *** PRTSTG *** QTSTG *** PRTNUM *** PRTLN ***
*
* 'PRTSTG' prints a string pointed to by A1. It stops printing
* and returns to the caller when either a CR is printed or when
* the next byte is the same as what was passed in D0 by the
* caller.
*
* 'QTSTG' looks for an underline (back-arrow on some systems),
* single-quote, or double-quote. If none of these are found, returns
* to the caller. If underline, outputs a CR without a LF. If single
* or double quote, prints the quoted string and demands a matching
* end quote. After the printing, the next 2 bytes of the caller are
* skipped over (usually a short branch instruction).
*
* 'PRTNUM' prints the 32 bit number in D1, leading blanks are added if
* needed to pad the number of spaces to the number in D4.
* However, if the number of digits is larger than the no. in
* D4, all digits are printed anyway. Negative sign is also
* printed and counted in, positive sign is not.
*
* 'PRTLN' prints the saved text line pointed to by A1
* with line no. and all.
*
PRTSTG MOVE.B D0,D1 save the stop character
PS1 MOVE.B (A1)+,D0 get a text character
CMP.B D0,D1 same as stop character?
BEQ PRTRET if so, return
BSR GOOUT display the char.
CMP.B #CR,D0 is it a C.R.?
BNE PS1 no, go back for more
MOVE.B #LF,D0 yes, add a L.F.
BSR GOOUT
PRTRET RTS then return
QTSTG bsr TSTC *** QTSTG ***
DC.B '"',QT3-*
MOVE.B #'"',D0 it is a "
QT1 MOVE.L A0,A1
BSR PRTSTG print until another
MOVE.L A1,A0
MOVE.L (SP)+,A1 pop return address
CMP.B #LF,D0 was last one a CR?
BEQ RUNNXL if so, run next line
QT2 ADDQ.L #2,A1 skip 2 bytes on return
JMP (A1) return
QT3 bsr TSTC is it a single quote?
DC.B '''',QT4-*
MOVE.B #'''',D0 if so, do same as above
BRA QT1
QT4 bsr TSTC is it an underline?
DC.B '_',QT5-*
MOVE.B #CR,D0 if so, output a CR without LF
bsr GOOUT
MOVE.L (SP)+,A1 pop return address
BRA QT2
QT5 RTS none of the above
PRTNUM MOVE.L D1,D3 save the number for later
MOVE D4,-(SP) save the width value
MOVE.B #$FF,-(SP) flag for end of digit string
TST.L D1 is it negative?
BPL PN1 if not
NEG.L D1 else make it positive
SUBQ #1,D4 one less for width count
PN1 DIVU #10,D1 get the next digit
BVS PNOV overflow flag set?
MOVE.L D1,D0 if not, save remainder
AND.L #$FFFF,D1 strip the remainder
BRA TOASCII skip the overflow stuff
PNOV MOVE D1,D0 prepare for long word division
CLR.W D1 zero out low word
SWAP D1 high word into low
DIVU #10,D1 divide high word
MOVE D1,D2 save quotient
MOVE D0,D1 low word into low
DIVU #10,D1 divide low word
MOVE.L D1,D0 D0 = remainder
SWAP D1 R/Q becomes Q/R
MOVE D2,D1 D1 is low/high
SWAP D1 D1 is finally high/low
TOASCII SWAP D0 get remainder
MOVE.B D0,-(SP) stack it as a digit
SWAP D0
SUBQ #1,D4 decrement width count
TST.L D1 if quotient is zero, we're done
BNE PN1
SUBQ #1,D4 adjust padding count for DBRA
BMI PN4 skip padding if not needed
PN3 MOVE.B #' ',D0 display the required leading spaces
BSR GOOUT
DBRA D4,PN3
PN4 TST.L D3 is number negative?
BPL PN5
MOVE.B #'-',D0 if so, display the sign
BSR GOOUT
PN5 MOVE.B (SP)+,D0 now unstack the digits and display
BMI PNRET until the flag code is reached
ADD.B #'0',D0 make into ASCII
BSR GOOUT
BRA PN5
PNRET MOVE (SP)+,D4 restore width value
RTS
PRTLN CLR.L D1
MOVE.B (A1)+,D1 get the binary line number
LSL #8,D1
MOVE.B (A1)+,D1
MOVEQ #5,D4 display a 5 digit line no.
BSR PRTNUM
MOVE.B #' ',D0 followed by a blank
BSR GOOUT
CLR D0 stop char. is a zero
BRA PRTSTG display the rest of the line
*
* ===== Test text byte following the call to this subroutine. If it
* equals the byte pointed to by A0, return to the code following
* the call. If they are not equal, branch to the point
* indicated by the offset byte following the text byte.
*
TSTC BSR IGNBLK ignore leading blanks
MOVE.L (SP)+,A1 get the return address
MOVE.B (A1)+,D1 get the byte to compare
CMP.B (A0),D1 is it = to what A0 points to?
BEQ TC1 if so
CLR.L D1 If not, add the second
MOVE.B (A1),D1 byte following the call to
ADD.L D1,A1 the return address.
JMP (A1) jump to the routine
TC1 ADDQ.L #1,A0 if equal, bump text pointer
ADDQ.L #1,A1 Skip the 2 bytes following
JMP (A1) the call and continue.
*
* ===== See if the text pointed to by A0 is a number. If so,
* return the number in D1 and the number of digits in D2,
* else return zero in D1 and D2.
*
TSTNUM CLR.L D1 initialize return parameters
CLR D2
BSR IGNBLK skip over blanks
TN1 CMP.B #'0',(A0) is it less than zero?
BCS TSNMRET if so, that's all
CMP.B #'9',(A0) is it greater than nine?
BHI TSNMRET if so, return
CMP.L #214748364,D1 see if there's room for new digit
BCC QHOW if not, we've overflowd
MOVE.L D1,D0 quickly multiply result by 10
ADD.L D1,D1
ADD.L D1,D1
ADD.L D0,D1
ADD.L D1,D1
MOVE.B (A0)+,D0 add in the new digit
AND.L #$F,D0
ADD.L D0,D1
ADDQ #1,D2 increment the no. of digits
BRA TN1
TSNMRET RTS
*
* ===== Skip over blanks in the text pointed to by A0.
*
IGNBLK CMP.B #' ',(A0) see if it's a space
BNE IGBRET if so, swallow it
IGB1 ADDQ.L #1,A0 increment the text pointer
BRA IGNBLK
IGBRET RTS
*
* ===== Convert the line of text in the input buffer to upper
* case (except for stuff between quotes).
*
TOUPBUF LEA BUFFER,A0 set up text pointer
CLR.B D1 clear quote flag
TOUPB1
MOVE.B (A0)+,D0 get the next text char.
CMP.B #CR,D0 is it end of line?
BEQ TOUPBRT if so, return
CMP.B #'"',D0 a double quote?
BEQ DOQUO
CMP.B #'''',D0 or a single quote?
BEQ DOQUO
TST.B D1 inside quotes?
BNE TOUPB1 if so, do the next one
BSR TOUPPER convert to upper case
MOVE.B D0,-(A0) store it
ADDQ.L #1,A0
BRA TOUPB1 and go back for more
TOUPBRT
RTS
DOQUO TST.B D1 are we inside quotes?
BNE DOQUO1
MOVE.B D0,D1 if not, toggle inside-quotes flag
BRA TOUPB1
DOQUO1 CMP.B D0,D1 make sure we're ending proper quote
BNE TOUPB1 if not, ignore it
CLR.B D1 else clear quote flag
BRA TOUPB1
*
* ===== Convert the character in D0 to upper case
*
TOUPPER CMP.B #'a',D0 is it < 'a'?
BCS TOUPRET
CMP.B #'z',D0 or > 'z'?
BHI TOUPRET
SUB.B #32,D0 if not, make it upper case
TOUPRET RTS
*
* 'CHKIO' checks the input. If there's no input, it will return
* to the caller with the Z flag set. If there is input, the Z
* flag is cleared and the input byte is in D0. However, if a
* control-C is read, 'CHKIO' will warm-start BASIC and will not
* return to the caller.
*
CHKIO bsr GOIN get input if possible
BEQ CHKRET if Zero, no input
CMP.B #CTRLC,D0 is it control-C?
BNE CHKRET if not
BRA WSTART if so, do a warm start
CHKRET RTS
*
* ===== Display a CR-LF sequence
*
;CRLF LEA CLMSG,A6
*
* ===== Display a zero-ended string pointed to by register A6
*
PRMESG MOVE.B (A6)+,D0 get the char.
BEQ PRMRET if it's zero, we're done
BSR GOOUT else display it
BRA PRMESG
PRMRET RTS
******************************************************
* The following routines are the only ones that need *
* to be changed for a different I/O environment. *
******************************************************
*
* ===== Output character to the console (Port 1) from register D0
* (Preserves all registers.)
*
OUTC
move.l a6,-(a7)
move.l OUTPTR,a6
jsr (a6)
move.l (a7)+,a6
rts
OUTC1
movem.l d0/d1,-(a7)
move.l d0,d1
moveq.l #6,d0
trap #15
movem.l (a7)+,d0/d1
rts
*OUTC BTST #1,$10040 is port 1 ready for a character?
* BEQ OUTC if not, wait for it
* MOVE.B D0,$10042 out it goes.
* RTS
*
* ===== Input a character from the console into register D0 (or
* return Zero status if there's no character available).
*
INC
move.l a6,-(a7)
move.l INPPTR,a6
jsr (a6)
move.l (a7)+,a6
rts
INC1
move.l d1,-(a7)
moveq.l #5,d0 * function 5 GetKey
trap #15
move.l d1,d0
move.l (a7)+,d1
cmpi.b #-1,d0
bne .0001
clr.b d0
.0001:
rts
*INC BTST #0,$10040 is character ready?
* BEQ INCRET if not, return Zero status
* MOVE.B $10042,D0 else get the character
* AND.B #$7F,D0 zero out the high bit
*INCRET RTS
*
* ===== Output character to the host (Port 2) from register D0
* (Preserves all registers.)
*
AUXOUT:
movem.l d0/d1,-(a7)
move.l d0,d1
moveq #34,d0
trap #15
movem.l (a7)+,d0/d1
rts
*AUXOUT BTST #1,$10041 is port 2 ready for a character?
* BEQ AUXOUT if not, wait for it
* MOVE.B D0,$10043 out it goes.
* RTS
*
* ===== Input a character from the host into register D0 (or
* return Zero status if there's no character available).
*
AUXIN:
move.l d1,-(a7)
moveq #36,d0 ; serial get char from buffer
trap #15
move.l d1,d0
move.l (a7)+,d1
cmpi.w #-1,d0
beq .0001
andi.b #$7F,d0 ; clear high bit
ext.w d0 ; return character in d0
ext.l d0
rts
.0001:
moveq #0,d0 ; return zf=1 if no character available
rts
;AUXIN
*AUXIN BTST #0,$10041 is character ready?
* BEQ AXIRET if not, return Zero status
* MOVE.B $10043,D0 else get the character
* AND.B #$7F,D0 zero out the high bit
AXIRET RTS
*
* ===== Return to the resident monitor, operating system, etc.
*
BYEBYE
bra Monitor
; MOVE.B #228,D7 return to Tutor
; TRAP #14
INITMSG DC.B CR,LF,'Gordo''s MC68000 Tiny BASIC, v1.2',CR,LF,LF,0
OKMSG DC.B CR,LF,'OK',CR,LF,0
HOWMSG DC.B 'How?',CR,LF,0
WHTMSG DC.B 'What?',CR,LF,0
SRYMSG DC.B 'Sorry.'
CLMSG DC.B CR,LF,0
DC.B 0 <- for aligning on a word boundary
LSTROM EQU * end of possible ROM area
*
* Internal variables follow:
*
RANPNT DC.L START random number pointer
INPPTR DS.L 1 input pointer
OUTPTR DS.L 1 output pointer
CURRNT DS.L 1 Current line pointer
STKGOS DS.L 1 Saves stack pointer in 'GOSUB'
STKINP DS.L 1 Saves stack pointer during 'INPUT'
LOPVAR DS.L 1 'FOR' loop save area
LOPINC DS.L 1 increment
LOPLMT DS.L 1 limit
LOPLN DS.L 1 line number
LOPPT DS.L 1 text pointer
TXTUNF DS.L 1 points to unfilled text area
VARBGN DS.L 1 points to variable area
STKLMT DS.L 1 holds lower limit for stack growth
BUFFER DS.B BUFLEN Keyboard input buffer
TXT EQU * Beginning of program area
; END
Go to most recent revision | Compare with Previous | Blame | View Log