💾 Archived View for mirrors.apple2.org.za › archive › apple2.archive.umich.edu › apple2 › 8bit › pro… captured on 2024-12-17 at 23:11:12.

View Raw

More Information

-=-=-=-=-=-=-

	
*******************************
	
Start regular words 1
	
*******************************

 

	

	
Word "execute" - call machine-language subroutine
	


 
WORD31 ASC 'execute '
 DW EXECUTE
 
EXECUTE JSR POPDATA
 STY PNTR
 STX PNTR+1
 
 LDA AREGVAL
 LDX XREGVAL
 LDY YREGVAL
 JMP (PNTR)
 

	

	
Word "areg" - push location of A-register variable
	


 
WORD32 ASC 'areg '
 DW AREG
 
AREG LDY #AREGVAL
 LDX #/AREGVAL
 JMP PUSHDATA
 
AREGVAL HEX 00
 

	

	
Word "xreg" - push location of X-register variable
	


 
WORD33 ASC 'xreg '
 DW XREG
 
XREG LDY #XREGVAL
 LDX #/XREGVAL
 JMP PUSHDATA
 
XREGVAL HEX 00
 

	

	
Word "yreg" - push location of Y-register variable
	


 
WORD34 ASC 'yreg '
 DW YREG
 
YREG LDY #YREGVAL
 LDX #/YREGVAL
 JMP PUSHDATA
 
YREGVAL HEX 00
 

	

	
Word "words" - List out all defined words
	


 
WORD35 ASC 'words '
 DW WORDS
 
WORDS JMP LISTWRDS
 

	

	
Word ".s" - dump out data stack
	


 
WORD36 ASC '.s '
 DW DOT_S
 
DOT_S LDA DATITEMS
 BEQ :EMPTY
 
 STA PNTR
 LDA #$FF
 STA PNTR+1
 
:LOOP LDY PNTR+1
 LDA DATAAREA,Y
 TAX
 DEY
 LDA DATAAREA,Y
 DEY
 STY PNTR+1
 TAY
 JSR PRTSIGND
 DEC PNTR
 BNE :LOOP
 RTS
 
:EMPTY JSR MSGOUT
 HEX 8D
 ASC "Data stack empty",8D00
 RTS
 

	

	
Subroutine to print out number in signed format
	

	
Called by: DOT_S, DOT_R, DOT
	


 
PRTSIGND TXA
 BPL :POSITIV
 
 LDA #"-"
 JSR COUT
 TYA
 EOR #$FF
 CLC
 ADC #01
 TAY
 TXA
 EOR #$FF
 ADC #00
 TAX
 
:POSITIV JMP PRTDEC
 

	

	
Word ".r" - dump out data stack
	


 
WORD37 ASC '.r '
 DW DOT_R
 
DOT_R LDA RETITEMS
 BEQ :EMPTY
 
 STA PNTR
 LDA #$FF
 STA PNTR+1
 
:LOOP LDY PNTR+1
 LDA RETNAREA,Y
 TAX
 DEY
 LDA RETNAREA,Y
 DEY
 STY PNTR+1
 TAY
 JSR PRTSIGND
 DEC PNTR
 BNE :LOOP
 RTS
 
:EMPTY JSR MSGOUT
 HEX 8D
 ASC "Return stack empty",8D00
 RTS
 

	

	
Word "!" - Store number at pointer
	


 
WORD38 ASC '! '
 DW EXCLAM
 
EXCLAM JSR POPDATA
 STY PNTR
 STX PNTR+1
 JSR POPDATA
 TYA
 STA (PNTR)
 LDY #$01
 TXA
 STA (PNTR),Y
 RTS
 

	

	
Word "@" - Fetch number at pointer
	


 
WORD39 ASC '@ '
 DW ATSIGN
 
ATSIGN JSR POPDATA
 STY PNTR
 STX PNTR+1
 LDY #$01
 LDA (PNTR),Y
 TAX
 LDA (PNTR)
 TAY
 JMP PUSHDATA
 

	

	
Word "c!" - Store byte at pointer
	


 
WORD40 ASC 'c! '
 DW CSTORE
 
CSTORE JSR POPDATA
 STY PNTR
 STX PNTR+1
 JSR POPDATA
 TYA
 STA (PNTR)
 RTS
 

	

	
Word "c@" - Fetch byte at pointer
	


 
WORD41 ASC 'c@ '
 DW CFETCH
 
CFETCH JSR POPDATA
 STY PNTR
 STX PNTR+1
 LDA (PNTR)
 TAY
 LDX #$00
 JMP PUSHDATA
 

	

	
Word "+!" - Add given value to contents of given address
	


 
WORD42 ASC '+! '
 DW PLUSQMRK
 
PLUSQMRK JSR POPDATA ; Fetch address
 STY PNTR
 STX PNTR+1
 
 JSR POPDATA ; Fetch value to add
 
 TYA
 CLC
 ADC (PNTR)
 STA (PNTR)
 TXA
 LDY #01
 ADC (PNTR),Y
 STA (PNTR),Y
 
 RTS
 

	

	
Word "?" - Print contents of address
	


 
WORD43 ASC '? '
 DW QMARK
 
QMARK JSR POPDATA
 STY PNTR
 STX PNTR+1
 LDY #$01
 LDA (PNTR),Y
 TAX
 LDA (PNTR)
 TAY
 JMP PRTSIGND
 

	

	
Word "dup" - Duplicate top number on stack
	


 
WORD44 ASC 'dup '
 DW DUP
 
DUP JSR POPDATA
 STY PNTR
 STX PNTR+1
 JSR PUSHDATA
 LDY PNTR
 LDX PNTR+1
 JMP PUSHDATA
 

	

	
Word "drop" - Discard top item on stack
	


 
WORD45 ASC 'drop '
 DW DROP
 
DROP JMP POPDATA
 

	

	
Word "swap" - Reverses top two stack items
	


 
WORD46 ASC 'swap '
 DW SWAP
 
SWAP JSR POPDATA
 STY PNTR
 STX PNTR+1
 JSR POPDATA
 STY PNTR2
 STX PNTR2+1
 LDY PNTR
 LDX PNTR+1
 JSR PUSHDATA
 LDY PNTR2
 LDX PNTR2+1
 JMP PUSHDATA
 

	

	
Word "over" - Makes a copy of the 2nd item
	
and pushes it to top
	


 
WORD47 ASC 'over '
 DW OVER
 
OVER JSR POPDATA
 STY PNTR2
 STX PNTR2+1
 JSR POPDATA
 STY PNTR
 STX PNTR+1
 JSR PUSHDATA
 LDY PNTR2
 LDX PNTR2+1
 JSR PUSHDATA
 LDY PNTR
 LDX PNTR+1
 JMP PUSHDATA
 

	

	
Word "rot" - Rotate the third item to top
	


 
WORD48 ASC 'rot '
 DW ROT
 
ROT JSR POPDATA
 STY PNTR3
 STX PNTR3+1
 JSR POPDATA
 STY PNTR2
 STX PNTR2+1
 JSR POPDATA
 STY PNTR
 STX PNTR+1
 
 LDY PNTR2
 LDX PNTR2+1
 JSR PUSHDATA
 LDY PNTR3
 LDX PNTR3+1
 JSR PUSHDATA
 LDY PNTR
 LDX PNTR+1
 JMP PUSHDATA
 

	

	
Word ">r" - Moves value from data stack to return stack
	


 
WORD49 ASC '>r '
 DW TOR
 
TOR JSR POPDATA
 JMP PUSHRETN
 

	

	
Word "r>" - Moves value from return stack to data stack
	


 
WORD50 ASC 'r> '
 DW RFROM
 
RFROM JSR POPRETN
 JMP PUSHDATA
 

	

	
Word "r@" - Copy value from return stack to data stack
	


 
WORD51 ASC 'r@ '
 DW RFETCH
 
RFETCH JSR POPRETN
 JSR PUSHRETN
 JMP PUSHDATA
 

	

	
Word "." - Print out top number on stack as signed integer
	


 
WORD52 ASC '. '
 DW DOT
 
DOT JSR POPDATA
 JMP PRTSIGND
 

	

	
Word "u." - print out top number on stack as unsigned int
	


 
WORD53 ASC 'u. '
 DW U_DOT
 
U_DOT JSR POPDATA
 JMP PRTDEC
 

	

	
Word "not" - do logical NOT on top number
	

	
Note: Bypasses POPDATA, PUSHDATA for speed
	


 
WORD54 ASC 'not '
 DW NOT
 
NOT LDA DATITEMS ; Make sure there's something on stack
 BEQ :ERROR ;   to negate
 
 LDY DATSTACK
 LDA DATAAREA+1,Y
 ORA DATAAREA+2,Y
 BNE :FALSE
 LDA #$FF
 HEX 2C ; BIT trick
:FALSE LDA #00
 STA DATAAREA+1,Y
 STA DATAAREA+2,Y
 RTS
 
:ERROR LDA #04 ; "Data stack underflow"
 JMP PRTERR
 

	

	
Word "and" - perform logical AND on top two stack items
	


 
WORD55 ASC 'and '
 DW AND
 
AND JSR POPDATA
 STY TEMP
 TXA
 ORA TEMP
 STA TEMP
 BEQ :FALSE
 
 JSR POPDATA
 STY TEMP
 TXA
 ORA TEMP
 STA TEMP
 BEQ :FALSE2
 
 LDX #$FF
 LDY #$FF
 JMP PUSHDATA
 
:FALSE JSR POPDATA
:FALSE2 LDX #$00
 LDY #$00
 JMP PUSHDATA
 

	

	
Word "or" - Perform logical OR on top two stack items
	


 
WORD56 ASC 'or '
 DW OR
 
OR JSR POPDATA
 STY TEMP
 TXA
 ORA TEMP
 STA TEMP
 JSR POPDATA
 TYA
 ORA TEMP
 STA TEMP
 TXA
 ORA TEMP
 STA TEMP
 BNE :TRUE
 LDX #$00
 LDY #$00
 JMP PUSHDATA
 
:TRUE LDX #$FF
 LDY #$FF
 JMP PUSHDATA
 

	

	
Word "xor" - Do logical XOR on top two stack items
	


 
WORD57 ASC 'xor '
 DW XOR
 
XOR JSR POPDATA
 STY TEMP
 TXA
 ORA TEMP
 BEQ :ZERO
 LDA #$FF
 HEX 2C
:ZERO LDA #$00
 STA TEMP
 
 JSR POPDATA
 STY TEMP2
 TXA
 ORA TEMP2
 BEQ :ZERO2
 LDA #$FF
 HEX 2C
:ZERO2 LDA #$00
 EOR TEMP
 TAY
 TAX
 JMP PUSHDATA
 

	

	
Word "+" - Add two numbers on stack,
	
leave result on stack
	


 
WORD58 ASC '+ '
 DW ADD
 
ADD JSR POPDATA
 STY TEMP
 STX TEMP+1
 JSR POPDATA
 TYA
 CLC
 ADC TEMP
 TAY
 TXA
 ADC TEMP+1
 TAX
 JMP PUSHDATA
 

	

	
Word "-" - Subtract top word from next-top word,
	
leave result on stack
	


 
WORD59 ASC '- '
 DW MINUS
 
MINUS JSR POPDATA
 STY TEMP
 STX TEMP+1
 JSR POPDATA
 TYA
 SEC
 SBC TEMP
 TAY
 TXA
 SBC TEMP+1
 TAX
 JMP PUSHDATA
 

	

	
Word "*" - Multiply two numbers on stack,
	
leave result on stack (signed)
	


 
WORD60 ASC '* '
 DW ASTERISK
 
ASTERISK JSR GETNUMS ; Fetch two signed integers
 
 STZ TEMP
 LDY #00
 
 LDX #16
:LOOP LSR PNTR+1
 ROR PNTR
 BCC :SKIPADD
 TYA
 CLC
 ADC PNTR2
 TAY
 LDA PNTR2+1
 ADC TEMP
 STA TEMP
:SKIPADD ASL PNTR2
 ROL PNTR2+1
 DEX
 BNE :LOOP
 
 LDX TEMP
 BIT TEMP2 ; Check for negative
 BPL :NOTNEG
 
 TYA
 EOR #$FF
 CLC
 ADC #01
 TAY
 TXA
 EOR #$FF
 ADC #00
 TAX
 
:NOTNEG JMP PUSHDATA
 

	

	
GETNUMS - subroutine for fetching two signed numbers
	
(called by ASTERISK, SLASH, MOD)
	


 
GETNUMS JSR POPDATA ; Get first number and store sign
 TXA
 BPL :POS
 
 LDA #$FF
 STA TEMP2
 TYA
 EOR #$FF
 CLC
 ADC #01
 STA PNTR
 TXA
 EOR #$FF
 ADC #00
 STA PNTR+1
 BRA :MERGE
 
:POS STZ TEMP2
 STY PNTR
 STX PNTR+1
 
:MERGE JSR POPDATA ; Get second number and store sign
 TXA
 BPL :POS2
 
 LDA TEMP2
 EOR #$FF ; Invert high bit of TEMP2
 STA TEMP2
 
 TYA
 EOR #$FF
 CLC
 ADC #01
 STA PNTR2
 TXA
 EOR #$FF
 ADC #00
 STA PNTR2+1
 RTS
 
:POS2 STY PNTR2
 STX PNTR2+1
 RTS
 

	

	
Word "/" - Divide two numbers on stack,
	
leave result on stack
	


 
WORD61 ASC '/ '
 DW SLASH
 
SLASH JSR GETNUMS
 
 JSR DIVSUB
 
 LDY PNTR2
 LDX PNTR2+1
 BIT TEMP2
 BPL :POSITIV
 
 TYA
 EOR #$FF
 CLC
 ADC #01
 TAY
 TXA
 EOR #$FF
 ADC #00
 TAX
 
:POSITIV JMP PUSHDATA
 

	

	
DIVSUB - subroutine for division
	
(called by SLASH, MOD)
	


 
DIVSUB LDA PNTR
 ORA PNTR+1
 BEQ :ERROR
 STZ PNTR3
 STZ PNTR3+1
 
 LDX #16
:LOOP ASL PNTR2
 ROL PNTR2+1
 ROL PNTR3
 ROL PNTR3+1
 LDA PNTR3
 SEC
 SBC PNTR
 TAY
 LDA PNTR3+1
 SBC PNTR+1
 BCC :NOGOOD
 STA PNTR3+1
 STY PNTR3
 LDA PNTR2
 ORA #01
 STA PNTR2
:NOGOOD DEX
 BNE :LOOP
 
 RTS
 
:ERROR LDA #$0E ; "Division by zero"
 JMP PRTERR
 

	

	
Word "mod" - Divide two numbers on stack,
	
leave modulus on stack
	


 
WORD62 ASC 'mod '
 DW MOD
 
MOD JSR POPDATA ; Get first number and ignore sign
 TXA
 BPL :POS
 
 TYA
 EOR #$FF
 CLC
 ADC #01
 STA PNTR
 TXA
 EOR #$FF
 ADC #00
 STA PNTR+1
 BRA :MERGE
 
:POS STY PNTR
 STX PNTR+1
 
:MERGE JSR POPDATA ; Get second number and store sign
 TXA
 BPL :POS2
 
 LDA #$FF
 STA TEMP2
 TYA
 EOR #$FF
 CLC
 ADC #01
 STA PNTR2
 TXA
 EOR #$FF
 ADC #00
 STA PNTR2+1
 BRA :MERGE2
 
:POS2 STZ TEMP2
 STY PNTR2
 STX PNTR2+1
 
:MERGE2 JSR DIVSUB
 
 LDY PNTR3 ; Set sign of modulus to same as dividend
 LDX PNTR3+1
 BIT TEMP2
 BPL :POSITIV
 
 TYA
 EOR #$FF
 CLC
 ADC #01
 TAY
 TXA
 EOR #$FF
 ADC #00
 TAX
 
:POSITIV JMP PUSHDATA
 

	
*******************************
	
End regular words 1
	
*******************************