********************************* Start regular words 2********************************** Word "abs" - return absolute value of top stack item*WORD63 ASC 'abs ' DW ABSABS JSR POPDATA TXA BPL GLOB_PUSHNEGATSUB TYA EOR #$FF CLC ADC #01 TAY TXA EOR #$FF ADC #00 TAXGLOB_PUSH JMP PUSHDATA** Word "negate" - negate top value on stack*WORD64 ASC 'negate ' DW NEGATENEGATE JSR POPDATA BRA NEGATSUB** Word "<" - comparison operator*WORD65 ASC '< ' DW LESSTHANLESSTHAN JSR POPDATA ; Fetch first signed integer STY PNTR STX PNTR+1 JSR POPDATA ; Fetch second signed integer TXA ; Actual comparison done here EOR PNTR+1 AND #$80 BEQ :SAMESGN TXA BMI :TRUE BRA :FALSE:SAMESGN CPX PNTR+1 BNE :NOCHKLO CPY PNTR:NOCHKLO BCC :TRUE:FALSE LDY #$00 LDX #$00 JMP PUSHDATA:TRUE LDY #$FF LDX #$FF JMP PUSHDATA** Word ">" - comparison operator*WORD66 ASC '> ' DW MORETHANMORETHAN JSR POPDATA ; Fetch first signed integer STY PNTR STX PNTR+1 JSR POPDATA ; Fetch second signed integer TXA ; Actual comparison done here EOR PNTR+1 AND #$80 BEQ :SAME TXA BPL :TRUE BRA :FALSE:SAME CPX PNTR+1 BNE :NOCHKLO CPY PNTR:NOCHKLO BCC :FALSE BEQ :FALSE:TRUE LDY #$FF LDX #$FF JMP PUSHDATA:FALSE LDY #$00 LDX #$00 JMP PUSHDATA** Word "=" - comparison operator** Note: bypasses POPDATA, PUSHDATA for speed*WORD67 ASC '= ' DW EQUALEQUAL LDA DATITEMS ; Make sure there's at least CMP #02 ;   two items on stack BCC :ERROR LDY DATSTACK LDA DATAAREA+1,Y CMP DATAAREA+3,Y BNE :FALSE LDA DATAAREA+2,Y CMP DATAAREA+4,Y BNE :FALSE LDA #$FF HEX 2C:FALSE LDA #00 STA DATAAREA+3,Y STA DATAAREA+4,Y INY ; Adjust data stack pointer INY STY DATSTACK:SKIPINC DEC DATITEMS ; Adjust data items pointer RTS:ERROR LDA #04 ; "Data stack underflow" JMP PRTERR** Word "<>" - comparison operator** Note: bypasses POPDATA, PUSHDATA for speed*WORD68 ASC '<> ' DW NOTEQUALNOTEQUAL LDA DATITEMS ; Make sure there's at least CMP #02 ;   two items on stack BCC :ERROR LDY DATSTACK LDA DATAAREA+1,Y CMP DATAAREA+3,Y BNE :TRUE LDA DATAAREA+2,Y CMP DATAAREA+4,Y BNE :TRUE LDA #00 HEX 2C:TRUE LDA #$FF STA DATAAREA+3,Y STA DATAAREA+4,Y INY ; Adjust data stack pointer INY STY DATSTACK:SKIPINC DEC DATITEMS ; Adjust data items pointer RTS:ERROR LDA #04 ; "Data stack underflow" JMP PRTERR** Word "U<" - unsigned compare*WORD69 ASC 'u< ' DW ULESSULESS JSR POPDATA STY PNTR STX PNTR+1 JSR POPDATA CPX PNTR+1 BCC :TRUE BEQ :CHKLOW BCS :FALSE:CHKLOW CPY PNTR BCC :TRUE:FALSE LDY #00 LDX #00 JMP PUSHDATA:TRUE LDY #$FF LDX #$FF JMP PUSHDATA** Word "0=" - compare to zero*WORD70 ASC '0= ' DW ZEROEQUAZEROEQUA JSR POPDATA TXA BNE :FALSE TYA BNE :FALSE LDA #$FF HEX 2C ; BIT trick:FALSE LDA #00 TAX TAY JMP PUSHDATA** Word "0<" - compare negative*WORD71 ASC '0< ' DW NEGATIVENEGATIVE JSR POPDATA TXA BPL :FALSE LDA #$FF HEX 2C ; BIT trick:FALSE LDA #00 TAX TAY JMP PUSHDATA** Word "0>" - check positive*WORD72 ASC '0> ' DW POSITIVEPOSITIVE JSR POPDATA TXA BNE :NOTZERO TYA BNE :NOTZERO BRA :FALSE:NOTZERO TXA BMI :FALSE LDA #$FF HEX 2C ; BIT trick:FALSE LDA #00 TAX TAY JMP PUSHDATA** Word "false" - push 0 on stack*WORD73 ASC 'false ' DW FALSEFALSE LDY #$00 LDX #$00 JMP PUSHDATA** Word "true" - push -1 on stack*WORD74 ASC 'true ' DW TRUETRUE LDY #$FF LDX #$FF JMP PUSHDATA** Word "1+" - increment top item on stack** Note: bypasses POPDATA, PUSHDATA for speed*WORD75 ASC '1+ ' DW ONEPLUSONEPLUS LDA DATITEMS ; Make sure there's something on stack BEQ :ERROR ;   to increment LDX DATSTACK INC DATAAREA+1,X BNE :SKIPINC INC DATAAREA+2,X:SKIPINC RTS:ERROR LDA #04 ; "Data stack underflow" JMP PRTERR** Word "1-" - decrement top item on stack** Note: bypasses POPDATA, PUSHDATA for speed*WORD76 ASC '1- ' DW ONEMINUSONEMINUS LDA DATITEMS ; Make sure there's something on stack BEQ :ERROR ;   to decrement LDX DATSTACK LDA DATAAREA+1,X BNE :SKIPDEC DEC DATAAREA+2,X:SKIPDEC DEC DATAAREA+1,X RTS:ERROR LDA #04 ; "Data stack underflow" JMP PRTERR** Word "2+" - increment top item on stack by 2** Note: bypasses POPDATA, PUSHDATA for speed*WORD77 ASC '2+ ' DW TWOPLUSTWOPLUS LDA DATITEMS ; Make sure there's something on stack BEQ :ERROR ;   to increment LDX DATSTACK LDA DATAAREA+1,X INC INC STA DATAAREA+1,X BNE :SKIPINC INC DATAAREA+2,X:SKIPINC RTS:ERROR LDA #04 ; "Data stack underflow" JMP PRTERR** Word "2-" - decrement top item on stack by 2** Note: bypasses POPDATA, PUSHDATA for speed*WORD78 ASC '2- ' DW TWOMINUSTWOMINUS LDA DATITEMS ; Make sure there's something on stack BEQ :ERROR ;   to decrement LDX DATSTACK LDA DATAAREA+1,X SEC SBC #02 STA DATAAREA+1,X BCS :SKIPDEC DEC DATAAREA+2,X:SKIPDEC RTS:ERROR LDA #04 ; "Data stack underflow" JMP PRTERR** Word "2*" - do arithmetic shift left on top stack item** Note: bypasses POPDATA, PUSHDATA for speed*WORD79 ASC '2* ' DW TWOMULTTWOMULT LDA DATITEMS ; Make sure there's something on stack BEQ :ERROR ;   to multiply LDX DATSTACK ASL DATAAREA+1,X ROL DATAAREA+2,X RTS:ERROR LDA #04 ; "Data stack underflow" JMP PRTERR** Word "2/" - do logical shift right on top stack item** Note: bypasses POPDATA, PUSHDATA for speed*WORD80 ASC '2/ ' DW TWODIVTWODIV LDA DATITEMS ; Make sure there's something on stack BEQ :ERROR ;   to multiply LDX DATSTACK LSR DATAAREA+2,X ROR DATAAREA+1,X RTS:ERROR LDA #04 ; "Data stack underflow" JMP PRTERR** Word "b.and" - performs binary AND*WORD81 ASC 'b.and ' DW B_ANDB_AND JSR POPDATA STY PNTR STX PNTR+1 JSR POPDATA TYA AND PNTR TAY TXA AND PNTR+1 TAX JMP PUSHDATA** Word "b.or" - performs binary OR*WORD82 ASC 'b.or ' DW B_ORB_OR JSR POPDATA STY PNTR STX PNTR+1 JSR POPDATA TYA ORA PNTR TAY TXA ORA PNTR+1 TAX JMP PUSHDATA** Word "b.clr" - performs twos complement then AND*WORD83 ASC 'b.clr ' DW B_CLRB_CLR JSR POPDATA TYA EOR #$FF STA PNTR TXA EOR #$FF STA PNTR+1 JSR POPDATA TYA AND PNTR TAY TXA AND PNTR+1 TAX JMP PUSHDATA** Word "page" - Clears screen*WORD84 ASC 'page ' DW HOMEHOME LDA #" " ; Damn $C300 outputs whatever JSR $C300 ;  is in accumulator STZ CH RTS** Word "cv" - Sets cursor vertical position*WORD85 ASC 'cv ' DW SETCVSETCV JSR POPDATA STY CV TYA JMP BASCALC** Word "ch" - Sets cursor horizontal position*WORD86 ASC 'ch ' DW SETCHSETCH JSR POPDATA STY CH RTS** Word "key" - Wait for a key*WORD87 ASC 'key ' DW KEYKEY JSR GETKEY TAY LDX #00 JMP PUSHDATA** Word "key?" - Check for keypress*WORD88 ASC 'key? ' DW KEY?KEY? BIT KYBD BMI :TRUE LDA #00 ; Speed not crucial here HEX 2C ; BIT trick:TRUE LDA #$FF TAY TAX JMP PUSHDATA** Word "expect" - awaits characters from keyboard*WORD89 ASC 'expect ' DW EXPECTEXPECT JSR POPDATA ; Get number of characters max STY PNTR2 STX PNTR2+1 JSR POPDATA ; Get address to store characters STY PNTR STX PNTR+1 STZ SPANVAL ; Current number of keys STZ SPANVAL+1:LOOP JSR GETKEY ; Get a key CMP #$08 BEQ :BACK CMP #$7F BNE :NOTBACK:BACK LDA SPANVAL ; Make sure we have characters to erase ORA SPANVAL+1 BEQ :LOOP LDA SPANVAL ; Decrement number of characters BNE :SKIPDEC DEC SPANVAL+1:SKIPDEC DEC SPANVAL LDA #$08 ; Erase previous character on screen JSR COUT LDA #' ' JSR COUT LDA #$08 JSR COUT BRA :LOOP:NOTBACK CMP #$0D BNE :NOTRETN RTS:NOTRETN LDY SPANVAL ; Make sure we haven't reached CPY PNTR2 ;   maximum # of characters yet BNE :OK LDY SPANVAL+1 CPY PNTR2+1 BEQ :LOOP:OK TAY ; Store character at address LDA PNTR CLC ADC SPANVAL STA PNTR3 LDA PNTR+1 ADC SPANVAL+1 STA PNTR3+1 TYA STA (PNTR3) JSR COUT ; Echo key to screen INC SPANVAL ; Increment character count BNE :SKIPINC INC SPANVAL+1:SKIPINC BRA :LOOP** Word "span" - returns number of characters received by expect*WORD90 ASC 'span ' DW SPANSPAN LDY SPANVAL LDX SPANVAL+1 JMP PUSHDATASPANVAL HEX 0000** Word "emit" - outputs character value on stack, low byte*WORD91 ASC 'emit ' DW EMITEMIT JSR POPDATA TYA JMP COUT** Word "space" - outputs space*WORD92 ASC 'space ' DW SPACESPACE LDA #' 'PRT JMP COUT** Word "spaces" - outputs multiples spaces*WORD93 ASC 'spaces ' DW SPACESSPACES JSR POPDATA STY PNTR STX PNTR+1 LDA #" ":LOOP LDX PNTR BNE :SKIPDEC DEC PNTR+1 LDX PNTR+1 CPX #$FF BEQ :FINIS:SKIPDEC DEC PNTR JSR COUT BRA :LOOP:FINIS RTS** Word "cr" - outputs return*WORD94 ASC 'cr ' DW CRCR LDA #$8D BRA PRT** Word "fill" - fills memory with value*WORD95 ASC 'fill ' DW FILLFILL JSR POPDATA ; Fetch fill value STY TEMPFILL2 JSR POPDATA ; Fetch fill counter PHY PHX JSR POPDATA ; Fetch fill address STY PNTR STX PNTR+1 LDA TEMP ; Set up fill value PLX ; Check if any pages BEQ :NOPAGE LDY #00 ; Fill in pages:LOOP STA (PNTR),Y INY BNE :LOOP INC PNTR+1 DEX BNE :LOOP:NOPAGE PLX ; Fill in fractional pages BEQ :FINIS LDY #00:LOOP2 STA (PNTR),Y INY DEX BNE :LOOP2:FINIS RTS** Word "erase" - fills memory with zeros*WORD96 ASC 'erase ' DW ERASEERASE LDA #00 STA TEMP JMP FILL2** Word "close" - closes all open files*WORD97 ASC 'close ' DW CLOSECLOSE JMP CLOSFILE** Word "bye" - exits Qforth*WORD98 ASC 'bye ' DW BYEBYE JSR MLI DFB $65 DW :PARMS:PARMS DFB 4 HEX 00 HEX 0000 HEX 00 HEX 0000********************************* End regular words 2********************************