********************************* 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********************************