OpenCores
URL https://opencores.org/ocsvn/rtf68ksys/rtf68ksys/trunk

Subversion Repositories rtf68ksys

Compare Revisions

  • This comparison shows the changes necessary to convert path 
    /rtf68ksys
    from Rev 6 to Rev 7
    ↔ Reverse comparison
  •

Rev 6 → Rev 7

/trunk/Software/TinyBasic.x68
0,0 → 1,2040
;*****************************************************************
; *
; 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. *
;*****************************************************************
; *
; Some Modifications by: Robert Finch *
; This version running on a Diligent Nexys2 board XC3S1200e *
; Running TG68 for a processor *
; - two character variable names *
; - TICK variable *
; - *
; *
;*****************************************************************
; 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
RANDOM EQU 0xFFDC0C00 ; Hardware random# gen. address
GRAPHICS EQU 0xFFDAE000 ; graphics (line draw) acceelerator address
SPRCTRL EQU 0xFFDAD000 ; sprite controller address
 
BUFLEN EQU 80 ; length of keyboard input buffer
 
;*
;* Internal variables follow:
;*
BSS
ORG 0x600
RANPNT:
DC.L START ; random number pointer
CURRNT:
DC.L 1 ;Current line pointer
STKGOS:
DC.L 1 ;Saves stack pointer in 'GOSUB'
STKINP:
DC.L 1 ;Saves stack pointer during 'INPUT'
LOPVAR:
DC.L 1 ;'FOR' loop save area
LOPINC:
DC.L 1 ;increment
LOPLMT:
DC.L 1 ;limit
LOPLN:
DC.L 1 ;line number
LOPPT:
DC.L 1 ;text pointer
TXTUNF:
DC.L 1 ;points to unfilled text area
VARBGN:
DC.L 1 ;points to variable area
STKLMT:
DC.L 1 ;holds lower limit for stack growth
BUFFER:
FILL.B BUFLEN,0x00 ; Keyboard input buffer
 
TXT EQU $ ;Beginning of program area
 
CODE
even
ORG 0xFFFF2400
 
; Tell the outside world about these symbols
; only needed for the assembler, since this file is included from another file
public START
public ENDMEM
public PRTNUM
public AUXIN
 
;*
;* Standard jump table. You can change these addresses if you are
;* customizing this interpreter for a different environment.
;*
START:
BRA.L CSTART ;Cold Start entry point
GOWARM: BRA.L WSTART ;Warm Start entry point
GOOUT: BRA.L OUTC ;Jump to character-out routine
GOIN: BRA.L INC ;Jump to character-in routine
GOAUXO: BRA.L AUXOUT ;Jump to auxiliary-out routine
GOAUXI: BRA.L AUXIN ;Jump to auxiliary-in routine
GOBYE: BRA.L BYEBYE ;Jump to monitor, DOS, etc.
;*
;* Modifiable system constants:
;*
; Give Tiny Basic 3MB
TXTBGN DC.L 0xC00000 ;beginning of program memory
ENDMEM DC.L 0xF00000 ; end of available memory
;*
;* The main interpreter starts here:
;*
CSTART:
LEA START,A0
MOVE.L A0,RANPNT
MOVE.L ENDMEM,SP ;initialize stack pointer
LEA INITMSG,A6 ;tell who we are
BSR.L 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 #4104,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.L PRMESG
ST3:
MOVE.B #'>',D0 ; Monitor with a '>' and
BSR.L GETLN ; read a line.
BSR.L 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.L TSTNUM ; is there a number there?
BSR.L IGNBLK ; skip trailing blanks
TST D1 ;does line no. exist? (or nonzero?)
BEQ.L DIRECT ; if not, it's a direct statement
CMP.L #0xFFFF,D1 ;see if line no. is <= 16 bits
BCC.L 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.L FNDLN ; find this line in save area
MOVE.L A1,A5 ; save possible line pointer
BNE ST4 ; if not found, insert
BSR.L 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.L 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.L 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.L 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.L 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 'LIS',('T'+0x80) ; Direct commands
DC.B 'LOA',('D'+0x80)
DC.B 'NE',('W'+0x80)
DC.B 'RU',('N'+0x80)
DC.B 'SAV',('E'+0x80)
DC.B 'CL',('S'+0x80)
TAB2:
DC.B 'NEX',('T'+0x80) ; Direct / statement
DC.B 'LE',('T'+0x80)
DC.B 'I',('F'+0x80)
DC.B 'GOT',('O'+0x80)
DC.B 'GOSU',('B'+0x80)
DC.B 'RETUR',('N'+0x80)
DC.B 'RE',('M'+0x80)
DC.B 'FO',('R'+0x80)
DC.B 'INPU',('T'+0x80)
DC.B 'PRIN',('T'+0x80)
DC.B 'POK',('E'+0x80)
DC.B 'STO',('P'+0x80)
DC.B 'BY',('E'+0x80)
DC.B 'CAL',('L'+0x80)
DC.B 'LIN',('E'+0x80)
DC.B 'POIN',('T'+0x80)
DC.B 'PENCOLO',('R'+0x80)
DC.B 'FILLCOLO',('R'+0x80)
DC.B 'SPRPO',('S'+0x80)
DC.B 0
TAB4:
DC.B 'PEE',('K'+0x80) ; Functions
DC.B 'RN',('D'+0x80)
DC.B 'AB',('S'+0x80)
DC.B 'SIZ',('E'+0x80)
DC.B 'TIC',('K'+0x80)
DC.B 'TEM',('P'+0x80)
DC.B 'SG',('N'+0x80)
DC.B 0
TAB5:
DC.B 'T',('O'+0x80) ; "TO" in "FOR"
DC.B 0
TAB6:
DC.B 'STE',('P'+0x80) ; "STEP" in "FOR"
DC.B 0
TAB8:
DC.B '>',('='+0x80) ; Relational operators
DC.B '<',('>'+0x80)
DC.B ('>'+0x80)
DC.B ('='+0x80)
DC.B '<',('='+0x80)
DC.B ('<'+0x80)
DC.B 0
; DC.B 0 ;<- for aligning on a word boundary
even
;* Execution address tables:
TAB1_1:
DC.W LIST_ ;Direct commands
DC.W LOAD
DC.W NEW
DC.W RUN
DC.W SAVE
DC.W CLS
TAB2_1:
DC.W NEXT ;Direct / statement
DC.W LET
DC.W IF
DC.W GOTO
DC.W GOSUB
DC.W RETURN
DC.W REM
DC.W FOR
DC.W INPUT
DC.W PRINT
DC.W POKE
DC.W STOP_
DC.W GOBYE
DC.W CALL
DC.W LINE
DC.W POINT
DC.W PENCOLOR
DC.W FILLCOLOR
DC.W SPRPOS
DC.W DEFLT
TAB4_1:
DC.W PEEK ;Functions
DC.W RND
DC.W ABS
DC.W SIZE_
DC.W TICK
DC.W TEMP
DC.W SGN
DC.W XP40
TAB5_1:
DC.W FR1 ; "TO" in "FOR"
DC.W QWHAT
TAB6_1:
DC.W FR2 ; "STEP" in "FOR"
DC.W FR3
TAB8_1:
DC.W XP11; >= Relational operators
DC.W XP12 ;<>
DC.W XP13 ;>
DC.W XP15 ;=
DC.W XP14 ;<=
DC.W XP16 ;<
DC.W XP17
;*
DIRECT:
LEA TAB1,A1
LEA TAB1_1,A2
EXEC:
BSR.L 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 #0x7F,D1 ; ignore the table's high bit
CMP.B D0,D1 ; is there a match?
BEQ EXMAT
ADDQ.L #2,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 0xFFFF0000,A3 ; execute the appropriate routine
move.w (a2),a2
JMP (A3,A2.W)
 
CLS:
jsr ClearScreen
clr.w CursorRow
clr.w CursorCol
bra WSTART
;*
;*******************************************************************
;*
;* 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.L ENDCHK
MOVE.L TXTBGN,TXTUNF ;set the end pointer
 
STOP_:
BSR.L ENDCHK
BRA WSTART
 
RUN:
BSR.L ENDCHK
MOVE.L TXTBGN,A0 ;set pointer to beginning
MOVE.L A0,CURRNT
 
RUNNXL:
TST.L CURRNT ; executing a program?
BEQ.L WSTART ;if not, we've finished a direct stat.
CLR.L D1 ;else find the next line number
MOVE.L A0,A1
BSR.L 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.L 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.L EXPR ; evaluate the following expression
BSR.L ENDCHK ;must find end of line
MOVE.L D0,D1
BSR.L FNDLN ;find the target line
BNE.L 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.L TSTNUM ; see if there's a line no.
BSR.L ENDCHK ;if not, we get a zero
BSR.L FNDLN ;find this or next line
LS1:
BCS WSTART ;warm start if we passed the end
BSR.L PRTLN ; print the line
BSR.L CHKIO ; check for listing halt request
BEQ LS3
CMP.B #CTRLS,D0 ;pause the listing?
BNE LS3
LS2:
BSR.L CHKIO ;if so, wait for another keypress
BEQ LS2
LS3:
BSR.L FNDLNP ;find the next line
BRA LS1
 
PRINT:
MOVE #11,D4 ; D4 = number of print spaces
BSR.L TSTC ;if null list and ":"
DC.B ':',PR2-$
BSR.L CRLF1 ;give CR-LF and continue
BRA RUNSML ;execution on the same line
PR2:
BSR.L TSTC ;if null list and <CR>
DC.B CR,PR0-$
BSR.L CRLF1 ;also give CR-LF and
BRA RUNNXL ;execute the next line
PR0:
BSR.L TSTC ;else is it a format?
DC.B '#',PR1-$
BSR.L EXPR ;yes, evaluate expression
MOVE D0,D4 ;and save it as print width
BRA PR3 ;look for more to print
PR1:
BSR.L TSTC ;is character expression? (MRL)
DC.B '$',PR4-$
BSR.L EXPR ;yep. Evaluate expression (MRL)
BSR GOOUT ;print low byte (MRL)
BRA PR3 ;look for more. (MRL)
PR4:
BSR.L QTSTG ; is it a string?
BRA.S PR8 ;if not, must be an expression
PR3:
BSR.L TSTC ; if ",", go find next
DC.B ',',PR6-$
BSR.L FIN ;in the list.
BRA PR0
PR6:
BSR.L CRLF1 ; list ends here
BRA FINISH
PR8:
MOVE D4,-(SP) ;save the width value
BSR.L EXPR ;evaluate the expression
MOVE (SP)+,D4 ;restore the width
MOVE.L D0,D1
BSR.L PRTNUM ;print its value
BRA PR3 ;more to print?
 
FINISH:
BSR.L FIN ; Check end of command
BRA.L 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.L PUSHA ; save the current 'FOR' parameters
BSR.L EXPR ;get line number
MOVE.L A0,-(SP) ;save text pointer
MOVE.L D0,D1
BSR.L FNDLN ;find the target line
BNE.L 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.L ENDCHK ; there should be just a <CR>
MOVE.L STKGOS,D1 ;get old stack pointer
BEQ.L 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.L 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.L PUSHA ;save the old 'FOR' save area
BSR.L 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.L 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.L 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.L MVDOWN
MOVE.L A3,SP ; set the SP 5 long words up
FR8:
BRA FINISH ;and continue execution
 
NEXT:
BSR.L TSTV; get address of variable
BCS.L 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.L QWHAT ; had a FOR loop, so say "What?"
CMP.L D0,A1 ;; else we check them
BEQ NX3 ; OK, they agree
BSR.L 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.L 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.L 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.L 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.L FNDSKP ; if so, skip the rest of the line
BCC RUNTSL ;and run the next line
BRA.L 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.L QTSTG ;is next item a string?
BRA.S IP2 ;nope
BSR.L 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.L TSTV ; must be a variable now
BCS.L 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.L 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.L GETLN ;then get an input line
LEA BUFFER,A0 ;point to the buffer
BSR.L 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.L 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.L SETVAL ;do the assignment
BSR.L 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 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 #0xF,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 #0x1A,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 #0xF,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.L 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.L QWHAT ; if no comma, say "What?"
 
;*
;*******************************************************************
;* Graphics Commands added R. Finch
 
POINT:
BSR EXPR
BSR TSTC
DC.B ',',PKER-$
MOVE.L D0,-(SP)
BSR EXPR
MOVE.L (SP)+,D1
MOVE.L D0,D2
BSR DrawPixel
BRA FINISH
 
PENCOLOR:
BSR EXPR
MOVE.L d0,GRAPHICS
BRA FINISH
FILLCOLOR:
BSR EXPR
MOVE.L d0,GRAPHICS+4
BRA FINISH
 
SPRPOS:
BSR EXPR
BSR TSTC
DC.B ',',LINEERR1-$
MOVE.L D0,-(SP)
BSR EXPR
BSR TSTC
DC.B ',',LINEERR2-$
MOVE.L D0,-(SP)
BSR EXPR
MOVE.L D1,-(SP)
MOVE.L 8(SP),D1 ; D1 = sprite number
ANDI.L #7,D1
ASL.L #4,D1 ; D1 * 16
ADD.L #SPRCTRL,D1 ; D1 = register base
MOVE.L A1,-(SP) ; save off A1
MOVE.L D1,A1 ; A1 = register base
MOVE.W D0,2(A1) ; set Y position
MOVE.L 8(SP),D0
MOVE.W D0,0(A1) ; set X position
MOVE.L (SP)+,A1 ; get back A1
MOVE.L (SP)+,D1 ; get D1 back
ADD.L #8,SP ; pop stack
BRA FINISH
 
LINE:
BSR EXPR
BSR TSTC
DC.B ',',LINEERR1-$
MOVE.L D0,-(SP)
BSR EXPR
BSR TSTC
DC.B ',',LINEERR2-$
MOVE.L D0,-(SP)
BSR EXPR
BSR TSTC
DC.B ',',LINEERR3-$
MOVE.L D0,-(SP)
BSR EXPR
MOVE.W d0,GRAPHICS+14
MOVE.L (SP)+,d0
MOVE.W d0,GRAPHICS+12
MOVE.L (SP)+,d0
MOVE.W d0,GRAPHICS+10
MOVE.L (SP)+,d0
MOVE.W d0,GRAPHICS+8
MOVE.W #G_DRAWLINE,GRAPHICS+30
BRA FINISH
LINEERR1:
BRA.L QWHAT
LINEERR2:
ADDQ #4,SP
BRA.L QWHAT
LINEERR3:
ADD.L #8,SP
BRA.L QWHAT
 
;*
;*******************************************************************
;*
CALL:
BSR EXPR ;get the subroutine's address
TST.L D0 ;make sure we got a valid address
BEQ.L 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>::=(+,-,&,|)<EXPR3>(+,-,&,|)<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.L TSTC ;negative sign?
DC.B '-',XP20-$
CLR.L D0 ; yes, fake '0-'
BRA XP26
XP20:
BSR.L TSTC
DC.B '!',XP21-$
CLR.L D0
MOVE.L D0,-(SP)
BSR EXPR3
NOT.L D0
JMP XP24
XP21:
BSR.L TSTC ; positive sign? ignore it
DC.B '+',XP22-$
XP22:
BSR EXPR3 ;first <EXPR3>
XP23:
BSR.L 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.L QHOW ; branch if there's an overflow
BRA XP23 ; else go back for more operations
XP25:
BSR.L TSTC ;subtract?
DC.B '-',XP27-$ ; was 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
XP27:
BSR.L TSTC
DC.B '&',XP28-$
MOVE.L D0,-(SP)
BSR EXPR3
MOVE.L (SP)+,D1
AND.L D1,D0
BRA XP23
XP28:
BSR.L TSTC
DC.B '|',XP42-$
MOVE.L D0,-(SP)
BSR EXPR3
MOVE.L (SP)+,D1
OR.L D1,D0
BRA XP23
 
EXPR3:
BSR EXPR4 ;get first <EXPR4>
XP31:
BSR.L TSTC ; multiply?
DC.B '*',XP34-$
MOVE.L D0,-(SP); yes, save that first result
BSR EXPR4 ;get second <EXPR4>
MOVE.L (SP)+,D1
BSR.L MULT32 ; multiply the two
BRA XP31 ;then look for more terms
XP34:
BSR.L 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.L 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.L 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.L TSTC ; else look for ( EXPR )
DC.B '(',XP43-$
BSR EXPR
BSR.L TSTC
DC.B ')',XP43-$
XP42:
RTS
XP43:
BRA.L 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.L 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.L QHOW ; say "How?" if index is too big
ADD.L D0,D0
BCS.L QHOW
MOVE.L D0,-(SP) ;save the index
BSR.L 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.L 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
;
CLR.L D1
MOVE.B (a0),D1
BSR CVT26
cmpi.b #0xff,d1
beq tv2
ADDQ #1,A0 ; bump text pointer
asl.l #5,D1
ADD.L D1,D0
tv2:
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
 
CVT26:
cmpi.b #'A',d1
blo CVT26a
cmpi.b #'Z',d1
bhi CVT26a
subi.b #'A',d1
rts
CVT26a:
moveq #-1,d1
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 #0xFFFF,D1 ;is second argument <= 16 bits?
BLS MLT3 ; OK, let it through
EXG D0,D1 ; else swap the two arguments
CMP.L #0xFFFF,D1 ;and check 2nd argument again
BHI.L 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.L QHOW ; if overflow, say "How?"
ADD.L D2,D0 ; D0 now holds the product
BMI.L 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.L 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.
;* Uses hardware rand# generator R. Finch
RND:
BSR PARN ; get the upper limit
TST.L D0 ; it must be positive and non-zero
BEQ.L QHOW
BMI.L QHOW
MOVE.L D0,D1
MOVE.W RANDOM+2,D0
SWAP D0
MOVE.W RANDOM,D0
BCLR #31,D0 ; make sure it's positive
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.L QHOW ; if still negative, it was too big
ABSRT:
RTS
 
;* RTF
;* ===== The SGN function returns the sign value in D0.
;*
SGN:
BSR PARN ;get the following expr.'s value
TST.L D0
BEQ SGNRT
BMI SGNMI
MOVEQ #1,d0
SGNRT:
RTS
SGNMI:
MOVEQ #-1,d0
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
 
;* RTF
;* ===== return the millisecond time value
;*
TICK:
move.l Milliseconds,d0
rts
TEMP:
bsr ReadTemp
andi.l #0xffff,d0
rts
 
;*
;*******************************************************************
;*
;* *** 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.L 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.L TSTC ; *** FIN ***
DC.B ':',FI1-$
ADDQ.L #4,SP ; if ":", discard return address
BRA RUNSML ; continue on the same line
FI1:
BSR.L 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.L IGNBLK
CMP.B #CR,(A0); does it end with a CR?
BNE QWHAT ; if not, say "WHAT?"
RTS
 
QWHAT:
MOVE.L A0,-(SP)
AWHAT:
LEA WHTMSG,A6
ERROR:
BSR.L 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.L 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.L 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.
;*
GETLN:
BSR GOOUT ;display the prompt
MOVE.B #' ',D0 ; and a space
BSR GOOUT
LEA BUFFER,A0; A0 is the buffer pointer
GL1:
BSR.L 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
BSR GOOUT
RTS
 
;*
;*******************************************************************
;*
;* *** FNDLN (& friends) ***
;*
;* '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.
;*
FNDLN:
CMP.L #0xFFFF,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
CMPA.L A1,A2
BCS FNDRET ; if so, return with Z=0 & C=1
MOVE.B (A1),D2 ;if not, get a line no.
LSL.W #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
BNE FNDSKP ;keep looking
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.L 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.L TSTC ; is it a single quote?
DC.B '\'',QT4-$
MOVE.B #'''',D0 ; if so, do same as above
BRA QT1
QT4:
BSR.L TSTC ;is it an underline?
DC.B '_',QT5-$
MOVE.B #CR,D0 ;if so, output a CR without LF
BSR.L GOOUT
MOVE.L (SP)+,A1 ;pop return address
BRA QT2
QT5:
RTS ;none of the above
 
PRTNUM:
movem.l d0/d1/d4/a1/a5,-(a7)
lea scratch1,a5
move.l d1,d0
jsr HEX2DEC
lea scratch1,a5
PN8:
move.b (a5)+,d0
beq PN7
dbra d4,PN8
PN7:
tst.w d4
bmi PN9
MOVE.B #' ',D0 ; display the required leading spaces
BSR GOOUT
DBRA D4,PN7
PN9:
lea scratch1,a1
jsr DisplayString
movem.l (a7)+,d0/d1/d4/a1/a5
rts
 
;PRTNUM
; MOVE.L D1,D3 ; save the number for later
; MOVE.L D4,-(SP) ;save the width value
; MOVE.W #0xFFFF,-(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 #0xFFFF,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.W 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.W (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.L (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 #0xF,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.L GOIN ; get input if possible
BEQ CHKRET ;if Zero, no input
CMP.B #CTRLC,D0 ;is it control-C?
BNE CHKRET ;if not
BRA.L WSTART ;if so, do a warm start
CHKRET:
RTS
 
;*
;* ===== Display a CR-LF sequence
;*
CRLF1:
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. *
;******************************************************
 
;UART EQU 0xFFDC0A00
;UART_LS EQU UART+1
;UART_CTRL EQU UART+7
;KEYBD EQU 0xFFDC0000
 
 
;*
;* ===== Output character to the console (Port 1) from register D0
;* (Preserves all registers.)
;*
OUTC:
MOVEM.L D0/D1,-(SP)
MOVE.L D0,D1
JSR DisplayChar
MOVEM.L (SP)+,D0/D1
RTS
 
;*
;* ===== Input a character from the console into register D0 (or
;* return Zero status if there's no character available).
;*
INC:
MOVE.W KEYBD,D0 ;is character ready?
BPL INCRET0 ;if not, return Zero status
CLR.W KEYBD+2 ; clear keyboard strobe line
AND.W #0xFF,D0 ;zero out the high bit
RTS
INCRET0
MOVEQ #0,D0
RTS
 
;*
;* ===== Output character to the host (Port 2) from register D0
;* (Preserves all registers.)
;*
AUXOUT:
BTST #5,UART_LS ;is port ready for a character?
BEQ AUXOUT ;if not, wait for it
MOVE.B D0,UART ;out it goes.
RTS
 
;*
;* ===== Input a character from the host into register D0 (or
;* return Zero status if there's no character available).
;*
AUXIN:
BTST #0,UART_LS ;is character ready?
BEQ AXIRET ;if not, return Zero status
MOVE.B UART,D0 ;else get the character
AND.B #0x7F,D0 ;zero out the high bit
AXIRET:
RTS
 
;*
;* ===== Return to the resident monitor, operating system, etc.
;*
BYEBYE:
JMP Monitor
; MOVE.B #228,D7 ;return to Tutor
; TRAP #14
 
INITMSG:
DC.B CR,LF,'Gordo\'s MC68000 Tiny BASIC, v1.3',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
even
LSTROM EQU $
; end of possible ROM area
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.