mirror of
https://github.com/forth-ev/VolksForth.git
synced 2024-05-31 15:41:34 +00:00
1 line
171 KiB
Plaintext
1 line
171 KiB
Plaintext
\\ ÄIRECTORY VOLKSÆÏÒÔÈ 2OF4 26OCT87RE . 0 .. 0 MISC $08 Ã64/Ã16 $09 ÓYSTEM $0Æ Ã64INTERFACE $7D Ã16INIT $94 \\ ÃONTENT VOLKSÆÏÒÔÈ 2OF4 26OCT87RE ÄIRECTORY 0 ÃONTENT 1 MISC $08 Ã64 OR Ã16 $09 ÓYSTEM $0Æ Ã64/Ã16INTERFACE $7D $95-A9 FREE \ RAM ROM JSR ÎORMÊSR F.Ã16+ CLV12.4.87) ÁSSEMBLER ALSO DEFINITIONS (C16+ \ Ã16+ÍACROS FOR ÂANKSWITCHING : RAM $FF3F STA ; : ROM $FF3E STA ; ' ÊSR ÁLIAS ÎORMÊSR ÄEFER ÊSR : Ã16+ÊSR DUP $C000 U> ÉÆ ROM ÎORMÊSR RAM ÅÌÓÅ ÎORMÊSR ÔÈÅÎ ; ' Ã16+ÊSR ÉS ÊSR ) \ ÔARGET-ÍACHINE CLV06DEC88 ÏNLYFORTH CR .( ÈOST IS: ) (64 .( Ã64) Ã) (16 .( Ã16) Ã) : ) ; IMMEDIATE : (à ; IMMEDIATE : (Ã64 ; IMMEDIATE \ : (Ã16 ; IMMEDIATE \ : (Ã16+ ; IMMEDIATE \ : (Ã16- ; IMMEDIATE \ : (Ã64 [COMPILE] ( ; IMMEDIATE : (Ã16 [COMPILE] ( ; IMMEDIATE : (Ã16+ [COMPILE] ( ; IMMEDIATE : (Ã16- [COMPILE] ( ; IMMEDIATE \ LOAD/REMOVE ÊÓÒ-ÍACROS CLV14.4.87) ÁSSEMBLER ALSO DEFINITIONS (Ã16+ \NEEDS Ã16+ÊSR -2 +LOAD ) (Ã16+ ' Ã16+ÊSR ÉS ÊSR .( ÊÓÒ ÉS:Ã16+ ) (Ã16+ \\ SKIPS REST OF SCREEN \ ALL OTHER PLATFORMS DON'T NEED \ MACROS, SO WE SKIP THE REST: \ \NEEDS Ã16+ÊSR \\ \ IF MACRO EXIST, REDEFINE IT: ' ÎORMÊSR ÉS ÊSR .( ÊÓÒ ÉS:ÎORM ) CR .( ÔARGET IS: ) \ CLV14.4.87) (à .( ÃÂÍ ) (Ã64 .( Ã64 ) (Ã16 .( Ã16 WITH ) (Ã16+ .( 64KB ) (Ã16- .( 32KB ) CR .( ÔARGET IS NOT: ) (à \ ) .( ÃÂÍ, ) (Ã64 \ ) .( Ã64, ) (Ã16 \ ) .( Ã16, ) (Ã16+ \ ) .( Ã16+64KB, ) (Ã16- \ ) .( Ã16-32KB, ) \ RAMFILL 3: ÏNLYFORTH ÃODE RAMFILL ( ADR N 8B -) SEI 34 # LDA 1 STA 3 # LDA SETUP JSR Î 3 + LDX TXA Î 2+ ORA 0<> ?[ Î LDA 0 # LDY [[ 0 # CPX 0<> ?[[ [[ Î 4 + )Ù STA INY 0= ?] Î 5 + INC DEX ]]? Î 2+ LDX 0<> ?[ [[ Î 4 + )Ù STA INY Î 2+ CPY ÃÓ ?] ]? ]? 36 # LDA 1 STA CLI 0 # LDX 1 # LDY ÎEXT JMP END-CODE $Ã000 $4000 (16 $300 - Ã) 0 RAMFILL FORGET RAMFILL ( ÄELETING ÁSSEMBLER ÌABELS BP27JUN85WE) : DELETE ÁSSEMBLER NAME FIND ÉÆ >NAME COUNT $1Æ AND BOUNDS ?ÄÏ $1Æ É C! ÌÏÏÐ ÅÌÓÅ COUNT TYPE SPACE ÔÈÅÎ ; DELETE SETUP DELETE XYÎEXT DELETE ÐUTA DELETE ÓÐ DELETE ÐOP DELETE ÎEXT DELETE Î DELETE ÕÐ DELETE ÐOPTWO DELETE × DELETE ÉÐ DELETE ÒÐ DELETE ÐUSH DELETE ÐUSH0Á DELETE ÐUSHÁ DELETE ;C: FORGET DELETE ÏNLYFORTH ( ÄEFINITION FOR .STATUS 28JUN85WE) : STATUS BLK @ ?DUP ÉÆ ." BLK " U. ." HERE " HERE U. ." THERE " THERE U. ." HEAP " HEAP U. CR ÔÈÅÎ ; ' STATUS IS .STATUS \ Ã64 ÆORTH LOADSCREEN CLV14OCT87 ÏNLYFORTH HEX -3 +LOAD \ CLEAR MEMORY AND -2 -1 +THRU \ CLR LABELS .STATUS -6 -4 +THRU \ ÔARGET-ÍACHINE ÏNLYFORTH (Ã64 $801 ) (Ã16 $1001 ) DUP DISPLACE ! ÔARGET DEFINITIONS HERE! $1 $6Å +THRU ÁSSEMBLER NONRELOCATE .UNRESOLVED ' .BLK IS .STATUS -4 +LOAD \ ÐRINT ÔARGET-ÍACHINE CR .( SAVE-TARGET VOLKSFORTH83) 91 CON! ( ÃURSOR UP) QUIT \ ÆÏÒÔÈ ÐREAMBLE AND ÉÄ CLV06AUG87 (Ã64 $Ä C, $8 C, $Á C, 00 C, 9Å C, 28 C, 32 C, 30 C, 36 C, 34 C, 29 C, 00 C, 00 C, 00 C, 00 C, ) \ ÓÙÓ(2064) (Ã16 $Ä C, 10 C, $Á C, 00 C, 9Å C, 28 C, 34 C, 31 C, 31 C, 32 C, 29 C, 00 C, 00 C, 00 C, 00 C, ) \ ÓÙÓ(4112) ÁSSEMBLER NOP 0 JMP HERE 2- >LABEL >COLD NOP 0 JMP HERE 2- >LABEL >RESTART HERE DUP ORIGIN! \ ÈERE ARE COLDSTART- AND ÕSERVARIABLES \ 0 JMP 0 JSR HERE 2- >LABEL >WAKE END-CODE $100 ALLOT ÃREATE LOGO (Ã64 ," VOLKSÆÏÒÔÈ-83 3.80.1-Ã64 " ) (Ã16+ ," VOLKSÆÏÒÔÈ-83 3.80.1-Ã16+ " ) (Ã16- ," VOLKSÆÏÒÔÈ-83 3.80.1-Ã16- " ) ( ÚERO PAGE ÖARIABLES & ÎEXT 03APR85BP) 02 DUP >LABEL ÒÐ 2+ DUP >LABEL ÕÐ 2+ DUP >LABEL ÐUTA 1+ DUP >LABEL ÓÐ 2+ DUP >LABEL ÎEXT DUP 5 + >LABEL ÉÐ 13 + >LABEL × × 8 + >LABEL Î ( ÎEXT, MOVED INTO ÚERO PAGE 08APR85BP) ÌABEL ÂOOTNEXT -1 STA \ -1 IS DUMMY ÓÐ ÉÐ )Ù LDA × 1+ STA -1 LDA × STA \ -1 IS DUMMY ÉÐ CLC ÉÐ LDA 2 # ADC ÉÐ STA ÃÓ NOT ?[ ÌABEL ×JMP -1 ) JMP ]? ÉÐ 1+ INC ×JMP BCS END-CODE HERE ÂOOTNEXT - >LABEL ÂOOTNEXTLEN ÃODE END-TRACE ( ÐATCH ÎEXT FOR TRACE ) $Á5 # LDA ÎEXT $Á + STA ÉÐ # LDA ÎEXT $ + STA $69 # LDA ÎEXT $à + STA 2 # LDA ÎEXT $Ä + STA ÎEXT JMP END-CODE \ ;C: NOOP 02NOV87RE ÃREATE RECOVER ( -- ADR ) ÁSSEMBLER PLA × STA PLA × 1+ STA × WDEC 0 JMP END-CODE HERE 2- >LABEL >RECOVER \ HANDCRAFTED FORWARD REFERENCE FOR \ JMP COMMAND ÃOMPILER ÁSSEMBLER ALSO DEFINITIONS È : ;C: 0 Ô RECOVER JSR END-CODE ] È ; ÔARGET ÃODE NOOP ÎEXT HERE 2- ! END-CODE \ ÕSER VARIABLES CLV14OCT87 ÃONSTANT ORIGIN 8 UALLOT DROP \ ÆOR MULTITASKER ÕSER S0 $7ÃÆÁ S0 ! ÕSER R0 $7ÆÆÅ R0 ! ÕSER DP ÕSER OFFSET 0 OFFSET ! ÕSER BASE &10 BASE ! ÕSER OUTPUT ÕSER INPUT ÕSER ERRORHANDLER \ POINTER FOR ÁBORT" -CODE ÕSER VOC-LINK ÕSER UDP \ POINTS TO NEXT FREE ADDR IN ÕSER ( MANIPULATE SYSTEM POINTERS 29JAN85BP) ÃODE SP@ ( -- ADDR) ÓÐ LDA Î STA ÓÐ 1+ LDA Î 1+ STA Î # LDX ÌABEL ØPUSH ÓÐ 2DEC 1 ,Ø LDA ÓÐ )Ù STA 0 ,Ø LDA 0 # LDX ÐUTA JMP END-CODE ÃODE SP! ( ADDR --) ÓÐ Ø) LDA TAX ÓÐ )Ù LDA ÓÐ 1+ STA ÓÐ STX 0 # LDX ÎEXT JMP END-CODE ÃODE UP@ ( -- ADDR) ÕÐ # LDX ØPUSH JMP END-CODE ÃODE UP! ( ADDR --) ÕÐ # LDX ÌABEL ØPULL ÓÐ )Ù LDA 1 ,Ø STA DEY ÓÐ )Ù LDA 0 ,Ø STA ÌABEL (XYDROP 0 # LDX 1 # LDY ÌABEL (DROP ÓÐ 2INC ÎEXT JMP END-CODE RESTRICT ( MANIPULATE RETURNSTACK 16FEB85BP/KS) ÃODE RP@ ( -- ADDR ) ÒÐ # LDX ØPUSH JMP END-CODE ÃODE RP! ( ADDR -- ) ÒÐ # LDX ØPULL JMP END-CODE RESTRICT ÃODE >R ( 16B -- ) ÒÐ 2DEC ÓÐ Ø) LDA ÒÐ Ø) STA ÓÐ )Ù LDA ÒÐ )Ù STA (DROP JMP END-CODE RESTRICT ÃODE R> ( -- 16B) ÓÐ 2DEC ÒÐ Ø) LDA ÓÐ Ø) STA ÒÐ )Ù LDA ÓÐ )Ù STA ÌABEL (RDROP 2 # LDA ÌABEL (NRDROP CLC ÒÐ ADC ÒÐ STA ÃÓ ?[ ÒÐ 1+ INC ]? ÎEXT JMP END-CODE RESTRICT \ R@ RDROP EXIT ?EXIT CLV12JUL87 ÃODE R@ ( -- 16B) ÓÐ 2DEC ÒÐ )Ù LDA ÓÐ )Ù STA ÒÐ Ø) LDA ÐUTA JMP END-CODE ÃODE RDROP (RDROP HERE 2- ! END-CODE RESTRICT ÃODE EXIT ÒÐ Ø) LDA ÉÐ STA ÒÐ )Ù LDA ÉÐ 1+ STA (RDROP JMP END-CODE ÃODE UNNEST ÒÐ Ø) LDA ÉÐ STA ÒÐ )Ù LDA ÉÐ 1+ STA (RDROP JMP END-CODE ÃODE ?EXIT ( FLAG -- ) ÓÐ Ø) LDA ÓÐ )Ù ORA PHP ÓÐ 2INC PLP ' EXIT @ BNE ÎEXT JMP END-CODE ( EXECUTE PERFORM 08APR85BP) ÃODE EXECUTE ( ADDR --) ÓÐ Ø) LDA × STA ÓÐ )Ù LDA × 1+ STA ÓÐ 2INC × 1- JMP END-CODE : PERFORM ( ADDR -- ) @ EXECUTE ; ( C@ C! CTOGGLE 10JAN85BP) ÃODE C@ ( ADDR -- 8B) ÓÐ Ø) LDA Î STA ÓÐ )Ù LDA Î 1+ STA ÌABEL (C@ 0 # LDA ÓÐ )Ù STA Î Ø) LDA ÐUTA JMP END-CODE ÃODE C! ( 16B ADDR --) ÓÐ Ø) LDA Î STA ÓÐ )Ù LDA Î 1+ STA INY ÓÐ )Ù LDA Î Ø) STA DEY ÌABEL (2DROP ÓÐ LDA CLC 4 # ADC ÓÐ STA ÃÓ ?[ ÓÐ 1+ INC ]? ÎEXT JMP END-CODE : CTOGGLE ( 8B ADDR --) UNDER C@ XOR SWAP C! ; ( @ ! +! 08APR85BP) ÃODE @ ( ADDR -- 16B) ÓÐ Ø) LDA Î STA ÓÐ )Ù LDA Î 1+ STA Î )Ù LDA ÓÐ )Ù STA Î Ø) LDA ÐUTA JMP END-CODE ÃODE ! ( 16B ADDR --) ÓÐ Ø) LDA Î STA ÓÐ )Ù LDA Î 1+ STA INY ÓÐ )Ù LDA Î Ø) STA INY ÓÐ )Ù LDA 1 # LDY ÌABEL (! Î )Ù STA (2DROP JMP END-CODE ÃODE +! ( N ADDR --) ÓÐ Ø) LDA Î STA ÓÐ )Ù LDA Î 1+ STA INY ÓÐ )Ù LDA CLC Î Ø) ADC Î Ø) STA INY ÓÐ )Ù LDA 1 # LDY Î )Ù ADC (! JMP END-CODE ( DROP SWAP 24MAY84KS) ÃODE DROP ( 16B --) (DROP HERE 2- ! END-CODE ÃODE SWAP ( 16B1 16B2 -- 16B2 16B1 ) ÓÐ )Ù LDA TAX 3 # LDY ÓÐ )Ù LDA Î STA TXA ÓÐ )Ù STA Î LDA 1 # LDY ÓÐ )Ù STA INY 0 # LDX ÓÐ )Ù LDA Î STA ÓÐ Ø) LDA ÓÐ )Ù STA DEY Î LDA ÐUTA JMP END-CODE ( DUP ?DUP 08MAY85BP) ÃODE DUP ( 16B -- 16B 16B) ÓÐ 2DEC 3 # LDY ÓÐ )Ù LDA 1 # LDY ÓÐ )Ù STA INY ÓÐ )Ù LDA DEY ÐUTA JMP END-CODE ÃODE ?DUP ( 16B -- 16B 16B / FALSE) ÓÐ Ø) LDA ÓÐ )Ù ORA 0= ?[ ÎEXT JMP ]? ' DUP @ JMP END-CODE \\ : ?DUP ( 16B -- 16B 16B / FALSE) DUP ÉÆ DUP ÔÈÅÎ ; : DUP ÓP@ @ ; ( OVER ROT 13JUN84KS) ÃODE OVER ( 16B1 16B2 - 16B1 16B3 16B1) ÓÐ 2DEC 4 # LDY ÓÐ )Ù LDA ÓÐ Ø) STA INY ÓÐ )Ù LDA 1 # LDY ÓÐ )Ù STA ÎEXT JMP END-CODE ÃODE ROT ( 16B1 16B2 16B3 -- 16B2 16B3 16B1) 3 # LDY ÓÐ )Ù LDA Î 1+ STA 1 # LDY ÓÐ )Ù LDA 3 # LDY ÓÐ )Ù STA 5 # LDY ÓÐ )Ù LDA Î STA Î 1+ LDA ÓÐ )Ù STA 1 # LDY Î LDA ÓÐ )Ù STA INY ÓÐ )Ù LDA Î 1+ STA ÓÐ Ø) LDA ÓÐ )Ù STA 4 # LDY ÓÐ )Ù LDA ÓÐ Ø) STA Î 1+ LDA ÓÐ )Ù STA 1 # LDY ÎEXT JMP END-CODE \\ : ROT >R SWAP R> SWAP ; : OVER >R DUP R> SWAP ; ( -ROT NIP UNDER PICK ROLL 24DEC83KS) : -ROT ( 16B1 16B2 16B3 -- 16B3 16B1 16B2) ROT ROT ; : NIP ( 16B1 16B2 -- 16B2) SWAP DROP ; : UNDER ( 16B1 16B2 -- 16B2 16B1 16B2) SWAP OVER ; : PICK ( N -- 16B.N ) 1+ 2* SP@ + @ ; : ROLL ( N --) DUP >R PICK SP@ DUP 2+ R> 1+ 2* CMOVE> DROP ; \\ : -ROLL ( N --) >R DUP SP@ DUP 2+ DUP 2+ SWAP R@ 2* CMOVE R> 1+ 2* + ! ; ( DOUBLE WORD STACK MANIP. 21APR83KS) : 2SWAP ( 32B1 32B2 -- 32B2 32B1) ROT >R ROT R> ; ÃODE 2DROP ( 32B -- ) (2DROP HERE 2- ! END-CODE \ : 2DROP ( 32B -- ) DROP DROP ; : 2DUP ( 32B -- 32B 32B) OVER OVER ; ( + AND OR XOR 08APR85BP) ÃOMPILER ÁSSEMBLER ALSO DEFINITIONS È : ÄYADOP ( OPCODE --) Ô INY ÓÐ Ø) LDA DUP C, ÓÐ C, ÓÐ )Ù STA DEY ÓÐ )Ù LDA 3 # LDY C, ÓÐ C, ÓÐ )Ù STA (XYDROP JMP È ; ÔARGET ÃODE + ( N1 N2 -- N3) CLC $71 ÄYADOP END-CODE ÃODE OR ( 16B1 16B2 -- 16B3) $11 ÄYADOP END-CODE ÃODE AND ( 16B1 16B2 -- 16B3) $31 ÄYADOP END-CODE ÃODE XOR ( 16B1 16B2 -- 16B3) $51 ÄYADOP END-CODE ( - NOT NEGATE 24DEC83KS) ÃODE - ( N1 N2 -- N3) INY ÓÐ )Ù LDA SEC ÓÐ Ø) SBC ÓÐ )Ù STA INY ÓÐ )Ù LDA 1 # LDY ÓÐ )Ù SBC 3 # LDY ÓÐ )Ù STA (XYDROP JMP END-CODE ÃODE NOT ( 16B1 -- 16B2) CLC ÌABEL (NOT TXA ÓÐ Ø) SBC ÓÐ Ø) STA TXA ÓÐ )Ù SBC ÓÐ )Ù STA ÎEXT JMP END-CODE ÃODE NEGATE ( N1 -- N2 ) SEC (NOT BCS END-CODE \ : - NEGATE + ; ( DNEGATE SETUP D+ 14JUN84KS) ÃODE DNEGATE ( D1 -- -D1) INY SEC TXA ÓÐ )Ù SBC ÓÐ )Ù STA INY TXA ÓÐ )Ù SBC ÓÐ )Ù STA TXA ÓÐ Ø) SBC ÓÐ Ø) STA 1 # LDY TXA ÓÐ )Ù SBC ÓÐ )Ù STA ÎEXT JMP END-CODE ÌABEL ÓETUP ( QUAN IN Á) .Á ASL TAX TAY DEY [[ ÓÐ )Ù LDA Î ,Ù STA DEY 0< ?] TXA CLC ÓÐ ADC ÓÐ STA ÃÓ ?[ ÓÐ 1+ INC ]? 0 # LDX 1 # LDY RTS END-CODE ÃODE D+ ( D1 D2 -- D3) 2 # LDA ÓETUP JSR INY ÓÐ )Ù LDA CLC Î 2+ ADC ÓÐ )Ù STA INY ÓÐ )Ù LDA Î 3 + ADC ÓÐ )Ù STA ÓÐ Ø) LDA Î ADC ÓÐ Ø) STA 1 # LDY ÓÐ )Ù LDA Î 1+ ADC ÓÐ )Ù STA ÎEXT JMP END-CODE ( 1+ 2+ 3+ 1- 2- 08APR85BP) ÃODE 1+ ( N1 -- N2) 1 # LDA ÌABEL N+ CLC ÓÐ Ø) ADC ÃÓ NOT ?[ ÐUTA JMP ]? ÓÐ Ø) STA ÓÐ )Ù LDA 0 # ADC ÓÐ )Ù STA ÎEXT JMP END-CODE ÃODE 2+ ( N1 -- N2) 2 # LDA N+ BNE END-CODE ÃODE 3+ ( N1 -- N2) 3 # LDA N+ BNE END-CODE Ü ÃODE 4+ ( N1 -- N2) 4 # LDA N+ BNE END-CODE Ü ÃODE 6+ ( N1 -- N2) 6 # LDA N+ BNE END-CODE ÃODE 1- ( N1 -- N2) SEC ÌABEL (1- ÓÐ Ø) LDA 1 # SBC ÃÓ ?[ ÐUTA JMP ]? ÓÐ Ø) STA ÓÐ )Ù LDA 0 # SBC ÓÐ )Ù STA ÎEXT JMP END-CODE ÃODE 2- ( N1 -- N2) CLC (1- BCC END-CODE ( NUMBER ÃONSTANTS 24DEC83KS) -1 ÃONSTANT TRUE 0 ÃONSTANT FALSE ' TRUE ÁLIAS -1 ' FALSE ÁLIAS 0 1 ÃONSTANT 1 2 ÃONSTANT 2 3 ÃONSTANT 3 4 ÃONSTANT 4 : ON ( ADDR -- ) TRUE SWAP ! ; : OFF ( ADDR -- ) FALSE SWAP ! ; ( WORDS FOR NUMBER LITERALS 24MAY84KS) ÃODE CLIT ( -- 8B) ÓÐ 2DEC ÉÐ Ø) LDA ÓÐ Ø) STA TXA ÓÐ )Ù STA ÉÐ WINC ÎEXT JMP END-CODE RESTRICT ÃODE LIT ( -- 16B) ÓÐ 2DEC ÉÐ )Ù LDA ÓÐ )Ù STA ÉÐ Ø) LDA ÓÐ Ø) STA ÌABEL (BUMP ÉÐ 2INC ÎEXT JMP END-CODE RESTRICT : ÌITERAL ( 16B --) DUP $ÆÆ00 AND ÉÆ COMPILE LIT , EXIT ÔÈÅÎ COMPILE CLIT C, ; IMMEDIATE RESTRICT \\ : LIT R> DUP 2+ >R @ ; : CLIT R> DUP 1+ >R C@ ; ( COMPARISION CODE WORDS 13JUN84KS) ÃODE 0< ( N -- FLAG) ÓÐ )Ù LDA 0< ?[ ÌABEL PUTÔRUE $ÆÆ # LDA $24 C, ]? ÌABEL PUTÆALSE TXA ÓÐ )Ù STA ÐUTA JMP END-CODE ÃODE 0= ( 16B -- FLAG) ÓÐ Ø) LDA ÓÐ )Ù ORA PUTÔRUE BEQ PUTÆALSE BNE END-CODE ÃODE UWITHIN ( U1 [LOW UP[ -- FLAG) 2 # LDA ÓETUP JSR 1 # LDY ÓÐ Ø) LDA Î CMP ÓÐ )Ù LDA Î 1+ SBC ÃÓ NOT ?[ ( Î>ÓÐ) ÓÐ Ø) LDA Î 2+ CMP ÓÐ )Ù LDA Î 3 + SBC PUTÔRUE BCS ]? PUTÆALSE JMP END-CODE ( COMPARISION CODE WORDS 13JUN84KS) ÃODE < ( N1 N2 -- FLAG) ÓÐ Ø) LDA Î STA ÓÐ )Ù LDA Î 1+ STA ÓÐ 2INC Î 1+ LDA ÓÐ )Ù EOR ' 0< @ BMI ÓÐ Ø) LDA Î CMP ÓÐ )Ù LDA Î 1+ SBC ' 0< @ 2+ JMP END-CODE ÃODE U< ( U1 U2 -- FLAG) ÓÐ Ø) LDA Î STA ÓÐ )Ù LDA Î 1+ STA ÓÐ 2INC ÓÐ Ø) LDA Î CMP ÓÐ )Ù LDA Î 1+ SBC ÃÓ NOT ?[ PUTÔRUE JMP ]? PUTÆALSE JMP END-CODE ( COMPARISION WORDS 24DEC83KS) \ : 0< $8000 AND 0<> ; : > ( N1 N2 -- FLAG) SWAP < ; : 0> ( N -- FLAG) NEGATE 0< ; : 0<> ( N -- FLAG) 0= NOT ; : U> ( U1 U2 -- FLAG) SWAP U< ; : = ( N1 N2 -- FLAG) - 0= ; : D0= ( D -- FLAG) OR 0= ; : D= ( D1 D2 -- FLAG) DNEGATE D+ D0= ; : D< ( D1 D2 -- FLAG) ROT 2DUP - ÉÆ > NIP NIP ÅÌÓÅ 2DROP U< ÔÈÅÎ ; ( MIN MAX UMAX UMIN EXTEND DABS ABS KS) Ü : MINIMAX ( N1 N2 FLAG -- N3) RDROP ÉÆ SWAP ÔÈÅÎ DROP ; : MIN ( N1 N2 -- N3) 2DUP > MINIMAX ; : MAX ( N1 N2 -- N3) 2DUP < MINIMAX ; : UMAX ( U1 U2 -- U3) 2DUP U< MINIMAX ; : UMIN ( U1 U2 -- U3) 2DUP U> MINIMAX ; : EXTEND ( N -- D) DUP 0< ; : DABS ( D -- UD) EXTEND ÉÆ DNEGATE ÔÈÅÎ ; : ABS ( N -- U) EXTEND ÉÆ NEGATE ÔÈÅÎ ; \ LOOP PRIMITIVES 02NOV87RE Ü : DODO RDROP R> 2+ DUP >R ROT >R SWAP >R >R ; : (DO ( LIMIT STAR -- ) OVER - DODO ; RESTRICT : (?DO ( LIMIT START -- ) OVER - ?DUP ÉÆ DODO ÔÈÅÎ R> DUP @ + >R DROP ; RESTRICT : BOUNDS ( START COUNT -- LIMIT START ) OVER + SWAP ; ÃODE ENDLOOP ( -- ) 6 # LDA (NRDROP JMP END-CODE RESTRICT \\ DODO PUTS "INDEX Ü LIMIT Ü ADR.OF.ÄÏ" ON RETURN-STACK \ (LOOP (+LOOP 02NOV87RE ÃODE (LOOP CLC 1 # LDA ÒÐ Ø) ADC ÒÐ Ø) STA ÃÓ ?[ ÒÐ )Ù LDA 0 # ADC ÒÐ )Ù STA ÃÓ ?[ ÎEXT JMP ]? ]? ÌABEL DOLOOP 5 # LDY ÒÐ )Ù LDA ÉÐ 1+ STA DEY ÒÐ )Ù LDA ÉÐ STA 1 # LDY ÎEXT JMP END-CODE RESTRICT ÃODE (+LOOP ( N -- ) CLC ÓÐ Ø) LDA ÒÐ Ø) ADC ÒÐ Ø) STA ÓÐ )Ù LDA ÒÐ )Ù ADC ÒÐ )Ù STA .Á ROR ÓÐ )Ù EOR PHP ÓÐ 2INC PLP DOLOOP BPL ÎEXT JMP END-CODE RESTRICT ( LOOP INDICES 08APR85BP) ÃODE É ( -- N) 0 # LDY ÌABEL LOOPINDEX ÓÐ 2DEC CLC ÒÐ )Ù LDA INY INY ÒÐ )Ù ADC ÓÐ Ø) STA DEY ÒÐ )Ù LDA INY INY ÒÐ )Ù ADC 1 # LDY ÓÐ )Ù STA ÎEXT JMP END-CODE RESTRICT ÃODE Ê ( -- N) 6 # LDY LOOPINDEX BNE END-CODE RESTRICT \ BRANCHING 02NOV87RE ÃODE BRANCH CLC ÉÐ LDA ÉÐ Ø) ADC Î STA ÉÐ 1+ LDA ÉÐ )Ù ADC ÉÐ 1+ STA Î LDA ÉÐ STA ÎEXT JMP END-CODE RESTRICT ÃODE ?BRANCH ( FLAG -- ) ÓÐ Ø) LDA ÓÐ )Ù ORA PHP ÓÐ 2INC PLP ' BRANCH @ BEQ (BUMP JMP END-CODE RESTRICT \\ : BRANCH R> DUP @ + >R ; RESTRICT : ?BRANCH ( FLAG -- ) 0= R> OVER NOT OVER 2+ AND -ROT DUP @ + AND OR >R ; RESTRICT ( RESOLVE LOOPS AND BRANCHES 03FEB85BP) : >MARK ( -- ADDR) HERE 0 , ; : >RESOLVE ( ADDR --) HERE OVER - SWAP ! ; : <MARK ( -- ADDR) HERE ; : <RESOLVE ( ADDR --) HERE - , ; : ?PAIRS ( N1 N2 -- ) - ÁBORT" UNSTRUCTURED" ; ( CASE? 04MAY85BP) ÌABEL ÐUSHÁ 0 # CMP 0< ?[ PHA $ÆÆ # LDA ][ ÌABEL ÐUSH0Á PHA 0 # LDA ]? ÌABEL ÐUSH TAX ÓÐ 2DEC TXA 1 # LDY ÓÐ )Ù STA PLA 0 # LDX ÐUTA JMP ÃODE CASE? ( 16B1 16B2 -- 16B1 FALSE / TRUE ) 1 # LDA ÓETUP JSR Î LDA ÓÐ Ø) CMP 0= ?[ Î 1+ LDA ÓÐ )Ù CMP 0= ?[ PUTÔRUE JMP ]? ]? TXA ÐUSH0Á JMP END-CODE \\ : CASE? ( 16B1 16B2 -- 16B1 FALSE / TRUE ) OVER = DUP ÉÆ NIP ÔÈÅÎ ; ( ÂRANCHING 03FEB85BP) : ÉÆ COMPILE ?BRANCH >MARK 1 ; IMMEDIATE RESTRICT : ÔÈÅÎ ABS 1 ?PAIRS >RESOLVE ; IMMEDIATE RESTRICT : ÅÌÓÅ 1 ?PAIRS COMPILE BRANCH >MARK SWAP >RESOLVE -1 ; IMMEDIATE RESTRICT : ÂÅÇÉÎ <MARK 2 ; IMMEDIATE RESTRICT : ×ÈÉÌÅ 2 ?PAIRS 2 COMPILE ?BRANCH >MARK -2 2SWAP ; IMMEDIATE RESTRICT Ü : (REPTIL <RESOLVE ÂÅÇÉÎ DUP -2 = ×ÈÉÌÅ DROP >RESOLVE ÒÅÐÅÁÔ ; : ÒÅÐÅÁÔ 2 ?PAIRS COMPILE BRANCH (REPTIL ; IMMEDIATE RESTRICT : ÕÎÔÉÌ 2 ?PAIRS COMPILE ?BRANCH (REPTIL ; IMMEDIATE RESTRICT ( ÌOOPS 29JAN85KS/BP) : ÄÏ COMPILE (DO >MARK 3 ; IMMEDIATE RESTRICT : ?ÄÏ COMPILE (?DO >MARK 3 ; IMMEDIATE RESTRICT : ÌÏÏÐ 3 ?PAIRS COMPILE (LOOP COMPILE ENDLOOP >RESOLVE ; IMMEDIATE RESTRICT : +ÌÏÏÐ 3 ?PAIRS COMPILE (+LOOP COMPILE ENDLOOP >RESOLVE ; IMMEDIATE RESTRICT : ÌÅÁÖÅ ENDLOOP R> 2- DUP @ + >R ; RESTRICT \\ ÒETURNSTACK: CALLADR Ü INDEX LIMIT Ü ADR OF ÄÏ ( UM* BP/KS13.2.85) ÃODE UM* ( U1 U2 -- UD) ÓÐ )Ù LDA Î STA ÓÐ Ø) LDA Î 1+ STA INY Î 2 + STX Î 3 + STX $10 # LDX [[ Î 3 + ASL Î 2+ ROL Î 1+ ROL Î ROL ÃÓ ?[ CLC ÓÐ )Ù LDA Î 3 + ADC Î 3 + STA INY ÓÐ )Ù LDA DEY Î 2 + ADC Î 2 + STA ÃÓ ?[ Î 1+ INC 0= ?[ Î INC ]? ]? ]? DEX 0= ?] Î 3 + LDA ÓÐ )Ù STA INY Î 2 + LDA ÓÐ )Ù STA 1 # LDY Î LDA ÓÐ )Ù STA Î 1+ LDA ÓÐ Ø) STA ÎEXT JMP END-CODE \\ : UM* ( U1 U2 -- UD3) >R 0 0 0 R> $10 0 ÄÏ DUP 2/ >R 1 AND ÉÆ 2OVER D+ ÔÈÅÎ >R >R 2DUP D+ R> R> R> ÌÏÏÐ DROP 2SWAP 2DROP ; ( M* 2* 04JUL84KS) : M* ( N1 N2 -- D) DUP 0< DUP >R ÉÆ NEGATE ÔÈÅÎ SWAP DUP 0< ÉÆ NEGATE R> NOT >R ÔÈÅÎ UM* R> ÉÆ DNEGATE ÔÈÅÎ ; : * ( N N -- PROD) UM* DROP ; ÃODE 2* ( N1 -- N2) ÓÐ Ø) LDA .Á ASL ÓÐ Ø) STA ÓÐ )Ù LDA .Á ROL ÓÐ )Ù STA ÎEXT JMP END-CODE \ : 2* DUP + ; ( UM/MOD 04JUL84KS) Ü : DIVOVL TRUE ÁBORT" DIVISION OVERFLOW" ; ÃODE UM/MOD ( UD U -- UREM UQUOT) ÓÐ Ø) LDA Î 5 + STA ÓÐ )Ù LDA Î 4 + STA ÓÐ 2INC ÓÐ Ø) LDA Î 1+ STA ÓÐ )Ù LDA Î STA INY ÓÐ )Ù LDA Î 3 + STA INY ÓÐ )Ù LDA Î 2+ STA $11 # LDX CLC [[ Î 6 + ROR SEC Î 1+ LDA Î 5 + SBC TAY Î LDA Î 4 + SBC ÃÓ NOT ?[ Î 6 + ROL ]? ÃÓ ?[ Î STA Î 1+ STY ]? Î 3 + ROL Î 2+ ROL Î 1+ ROL Î ROL DEX 0= ?] 1 # LDY Î ROR Î 1+ ROR ÃÓ ?[ ;C: DIVOVL ; ÁSSEMBLER ]? Î 2+ LDA ÓÐ )Ù STA INY Î 1+ LDA ÓÐ )Ù STA INY Î LDA ÓÐ )Ù STA 1 # LDY Î 3 + LDA ÐUTA JMP END-CODE ( 2/ M/MOD 24DEC83KS) : M/MOD ( D N -- MOD QUOT) DUP >R ABS OVER 0< ÉÆ UNDER + SWAP ÔÈÅÎ UM/MOD R@ 0< ÉÆ NEGATE OVER ÉÆ SWAP R@ + SWAP 1- ÔÈÅÎ ÔÈÅÎ RDROP ; ÃODE 2/ ( N1 -- N2) ÓÐ )Ù LDA .Á ASL ÓÐ )Ù LDA .Á ROR ÓÐ )Ù STA ÓÐ Ø) LDA .Á ROR ÐUTA JMP END-CODE ( /MOD / MOD */MOD */ U/MOD UD/MOD KS) : /MOD ( N1 N2 -- REM QUOT) >R EXTEND R> M/MOD ; : / ( N1 N2 -- QUOT) /MOD NIP ; : MOD ( N1 N2 -- REM) /MOD DROP ; : */MOD ( N1 N2 N3 -- REM QUOT) >R M* R> M/MOD ; : */ ( N1 N2 N3 -- QUOT) */MOD NIP ; : U/MOD ( U1 U2 -- UREM UQUOT) 0 SWAP UM/MOD ; : UD/MOD ( UD1 U2 -- UREM UDQUOT) >R 0 R@ UM/MOD R> SWAP >R UM/MOD R> ; ( CMOVE CMOVE> (CMOVE> BP 08APR85) ÃODE CMOVE ( FROM TO QUAN --) 3 # LDA ÓETUP JSR DEY [[ [[ Î CPY 0= ?[ Î 1+ DEC 0< ?[ 1 # LDY ÎEXT JMP ]? ]? Î 4 + )Ù LDA Î 2+ )Ù STA INY 0= ?] Î 5 + INC Î 3 + INC ]] END-CODE ÃODE CMOVE> ( FROM TO QUAN --) 3 # LDA ÓETUP JSR CLC Î 1+ LDA Î 3 + ADC Î 3 + STA CLC Î 1+ LDA Î 5 + ADC Î 5 + STA Î 1+ INC Î LDY CLC ÃÓ ?[ ÌABEL (CMOVE> DEY Î 4 + )Ù LDA Î 2+ )Ù STA ]? TYA (CMOVE> BNE Î 3 + DEC Î 5 + DEC Î 1+ DEC (CMOVE> BNE 1 # LDY ÎEXT JMP END-CODE : MOVE ( FROM TO QUAN --) >R 2DUP U< ÉÆ R> CMOVE> EXIT ÔÈÅÎ R> CMOVE ; ( PLACE COUNT ERASE 16FEB85BP/KS) : PLACE ( ADDR LEN TO --) OVER >R ROT OVER 1+ R> MOVE C! ; ÃODE COUNT ( ADDR -- ADDR+1 LEN) ÓÐ Ø) LDA Î STA CLC 1 # ADC ÓÐ Ø) STA ÓÐ )Ù LDA Î 1+ STA 0 # ADC ÓÐ )Ù STA ÓÐ 2DEC (C@ JMP END-CODE \ : COUNT ( ADR -- ADR+1 LEN ) \ DUP 1+ SWAP C@ ; : ERASE ( ADDR QUAN --) 0 FILL ; ( FILL 11JUN85BP) ÃODE FILL ( ADDR QUAN 8B -- ) 3 # LDA ÓETUP JSR DEY Î LDA Î 3 + LDX 0<> ?[ [[ [[ Î 4 + )Ù STA INY 0= ?] Î 5 + INC DEX 0= ?] ]? Î 2+ LDX 0<> ?[ [[ Î 4 + )Ù STA INY DEX 0= ?] ]? 1 # LDY ÎEXT JMP END-CODE \\ : FILL ( ADDR QUAN 8B --) SWAP ?DUP ÉÆ >R OVER C! DUP 1+ R> 1- CMOVE EXIT ÔÈÅÎ 2DROP ; ( HERE ÐAD ALLOT , C, COMPILE 24DEC83KS) : HERE ( -- ADDR) DP @ ; : PAD ( -- ADDR) HERE $42 + ; : ALLOT ( N --) DP +! ; : , ( 16B --) HERE ! 2 ALLOT ; : C, ( 8B --) HERE C! 1 ALLOT ; : COMPILE R> DUP 2+ >R @ , ; RESTRICT ( INPUT STRINGS 24DEC83KS) ÖARIABLE #TIB 0 #TIB ! ÖARIABLE >TIB HERE >TIB ! $50 ALLOT ÖARIABLE >IN 0 >IN ! ÖARIABLE BLK 0 BLK ! ÖARIABLE SPAN 0 SPAN ! : TIB ( -- ADDR ) >TIB @ ; : QUERY TIB $50 EXPECT SPAN @ #TIB ! >IN OFF BLK OFF ; ( SCAN SKIP /STRING 12OCT84BP) : SCAN ( ADDR0 LEN0 CHAR -- ADDR1 LEN1) >R ÂÅÇÉÎ DUP ×ÈÉÌÅ OVER C@ R@ - ×ÈÉÌÅ 1- SWAP 1+ SWAP ÒÅÐÅÁÔ RDROP ; : SKIP ( ADDR LEN DEL -- ADDR1 LEN1) >R ÂÅÇÉÎ DUP ×ÈÉÌÅ OVER C@ R@ = ×ÈÉÌÅ 1- SWAP 1+ SWAP ÒÅÐÅÁÔ RDROP ; : /STRING ( ADDR0 LEN0 +N - ADDR1 LEN1) OVER UMIN ROT OVER + -ROT - ; \ CAPITAL CLV06AUG87 ÌABEL (CAPITAL \ FOR COMMODORE ONLY \ FOR ÁSCII: NEXT SCR ÁSCII A # CMP ÃÓ ?[ ÁSCII Z $21 + # CMP Ãà ?[ ÁSCII A $21 + # CMP ÃÓ ?[ $DF # AND ]? \ 2ND UP TO LOW ÁSCII Z 1+ # CMP Ãà ?[ $80 # ORA \ LOW TO UP ]? ]? ]? RTS END-CODE ÃODE CAPITAL ( CHAR -- CHAR' ) ÓÐ Ø) LDA (CAPITAL JSR ÓÐ Ø) STA ÎEXT JMP END-CODE \\ ÔHE NEW (CAPITAL DOES: ÎO 00-40,5B-60,7B-C1-DA-DC-FF NO CHANGE == -@ , [-À , -Á -Ú -| - .. ÎO 41-5A,61-7A CHANGES TO:C1-DA == A-Z , Á-Ú Á-Ú \ CAPITALIZE CLV06AUG87 ÃODE CAPITALIZE ( STRING -- STRING ) ÓÐ Ø) LDA Î STA ÓÐ )Ù LDA Î 1+ STA Î Ø) LDA Î 2+ STA DEY [[ Î 2+ CPY 0= ?[ 1 # LDY ÎEXT JMP ]? INY Î )Ù LDA (CAPITAL JSR Î )Ù STA ]] END-CODE \\ : CAPITALIZE ( STRING -- STRING ) DUP COUNT BOUNDS ?ÄÏ É C@ CAPITAL É C! ÔÈÅÎ ÌÏÏÐ ; \\ CAPITAL ( CHAR -- CHAR ) ÁSCII A ÁSCII Z 1+ UWITHIN ÉÆ É C@ [ ÁSCII A ÁSCII Á - ] ÌITERAL - ; \\ ÌABEL (CAPITAL \ FOR ÁSCII ONLY ÁSCII A # CMP ÃÓ ?[ ÁSCII Z 1+ # CMP Ãà ?[ SEC ÁSCII A ÁSCII Á - # SBC ]? ]? RTS END-CODE ( (WORD 08APR85BP) Ü ÃODE (WORD ( CHAR ADR0 LEN0 -- ADR) \ Î : LENGTH OF SOURCE \ Î+2 : PTR IN SOURCE / NEXT CHAR \ Î+4 : STRING START ADRESS \ Î+6 : STRING LENGTH Î 6 + STX \ 0 =: STRING_LENGTH 3 # LDY [[ ÓÐ )Ù LDA Î ,Ù STA DEY 0< ?] 1 # LDY CLC >IN LDA Î 2+ ADC Î 2+ STA \ >IN+ADR0 =: Î+2 >IN 1+ LDA Î 3 + ADC Î 3 + STA SEC Î LDA >IN SBC Î STA \ LEN0->IN =: Î Î 1+ LDA >IN 1+ SBC Î 1+ STA Ãà ?[ ÓÐ Ø) LDA >IN STA \ STREAM EXHAUSTED ÓÐ )Ù LDA >IN 1+ STA ( (WORD 08APR85BP) ][ 4 # LDY [[ Î LDA Î 1+ ORA \ SKIP CHAR'S 0= NOT ?[[ Î 2+ Ø) LDA ÓÐ )Ù CMP \ WHILE COUNT <>0 0= ?[[ Î 2+ WINC Î WDEC ]]? Î 2+ LDA Î 4 + STA \ SAVE STRING_START_ADRESS Î 3 + LDA Î 5 + STA [[ Î 2+ Ø) LDA ÓÐ )Ù CMP PHP \ SCAN FOR CHAR Î 2+ WINC Î WDEC PLP 0= NOT ?[[ Î 6 + INC \ COUNT STRING_LENGTH Î LDA Î 1+ ORA 0= ?] ]? ]? \ FROM COUNT = 0 IN SKIP) SEC 2 # LDY \ ADR_AFTER_STRING - ADR0 =: >IN) Î 2+ LDA ÓÐ )Ù SBC >IN STA INY Î 3 + LDA ÓÐ )Ù SBC >IN 1+ STA ( (WORD 08APR85BP) ]? \ FROM 1ST ][, STREAM WAS EXHAUSTED \ WHEN WORD CALLED) CLC 4 # LDA ÓÐ ADC ÓÐ STA ÃÓ ?[ ÓÐ 1+ INC ]? \ 2DROP USER' DP # LDY ÕÐ )Ù LDA ÓÐ Ø) STA Î STA INY ÕÐ )Ù LDA 1 # LDY ÓÐ )Ù STA Î 1+ STA \ DP @ DEY Î 6 + LDA \ STORE COUNT BYTE FIRST [[ Î )Ù STA Î 4 + )Ù LDA INY Î 6 + DEC 0< ?] $20 # LDA Î )Ù STA \ ADD A BLANK 1 # LDY ÎEXT JMP END-CODE ( SOURCE WORD PARSE NAME 08APR85BP) : SOURCE ( -- ADDR LEN) BLK @ ?DUP ÉÆ BLOCK B/BLK EXIT ÔÈÅÎ TIB #TIB @ ; : WORD ( CHAR -- ADDR) SOURCE (WORD ; : PARSE ( CHAR -- ADDR LEN) >R SOURCE >IN @ /STRING OVER SWAP R> SCAN >R OVER - DUP R> 0<> - >IN +! ; : NAME ( -- ADDR) BL WORD CAPITALIZE EXIT ; \\ : WORD ( CHAR -- ADDR) >R SOURCE OVER SWAP >IN @ /STRING R@ SKIP OVER SWAP R> SCAN >R ROT OVER SWAP - R> 0<> - >IN ! OVER - HERE PLACE BL HERE COUNT + C! HERE ; \ STATE ÁSCII ," (" " 02NOV87RE ÖARIABLE STATE 0 STATE ! : ÁSCII ( -- CHAR ) ( -- ) BL WORD 1+ C@ STATE @ ÉÆ [COMPILE] ÌITERAL ÔÈÅÎ ; IMMEDIATE : ," ÁSCII " PARSE HERE OVER 1+ ALLOT PLACE ; : "LIT ( -- ADR ) R> R> UNDER COUNT + >R >R ; RESTRICT : (" ( -- ADR ) "LIT ; RESTRICT : " COMPILE (" ," ; IMMEDIATE RESTRICT ( ." ( .( \ \\ HEX DECIMAL 08SEP84KS) : (." "LIT COUNT TYPE ; RESTRICT : ." COMPILE (." ," ; IMMEDIATE RESTRICT : ( ÁSCII ) PARSE 2DROP ; IMMEDIATE : .( ÁSCII ) PARSE TYPE ; IMMEDIATE : \ >IN @ C/L / 1+ C/L * >IN ! ; IMMEDIATE : \\ B/BLK >IN ! ; IMMEDIATE : \NEEDS NAME FIND NIP ÉÆ [COMPILE] \ ÔÈÅÎ ; : HEX $10 BASE ! ; : DECIMAL $Á BASE ! ; ( NUMBER CONV.: DIGIT? ACCUMULATE KS) : DIGIT? ( CHAR -- DIGIT TRUE/ FALSE ) ÁSCII 0 - DUP 9 U> ÉÆ [ ÁSCII Á ÁSCII 9 - 1- ] ÌITERAL - DUP 9 U> ÉÆ [ 2SWAP ( UNSTRUCTURED ) ] ÔÈÅÎ BASE @ OVER U> ?DUP ?EXIT ÔÈÅÎ DROP FALSE ; : ACCUMULATE ( +D0 ADR DIGIT - +D1 ADR) SWAP >R SWAP BASE @ UM* DROP ROT BASE @ UM* D+ R> ; : CONVERT ( +D1 ADDR0 -- +D2 ADDR2) 1+ ÂÅÇÉÎ COUNT DIGIT? ×ÈÉÌÅ ACCUMULATE ÒÅÐÅÁÔ 1- ; : END? ( -- FLAG ) PTR @ 0= ; : CHAR ( ADDR0 -- ADDR1 CHAR ) COUNT -1 PTR +! ; : PREVIOUS ( ADDR0 -- ADDR0 CHAR) 1- COUNT ; ( ?NONUM ?NUM FIXBASE? 13FEB85KS) ÖARIABLE DPL -1 DPL ! Ü : ?NONUM ( FLAG -- EXIT IF TRUE ) ÉÆ RDROP 2DROP DROP RDROP FALSE ÔÈÅÎ ; Ü : ?NUM ( FLAG -- EXIT IF TRUE ) ÉÆ RDROP DROP R> ÉÆ DNEGATE ÔÈÅÎ ROT DROP DPL @ 1+ ?DUP ?EXIT DROP TRUE ÔÈÅÎ ; Ü : FIXBASE? ( CHAR - CHAR FALSE / NEWBASE TRUE ) ÁSCII & CASE? ÉÆ $Á TRUE EXIT ÔÈÅÎ ÁSCII $ CASE? ÉÆ 10 TRUE EXIT ÔÈÅÎ ÁSCII È CASE? ÉÆ 10 TRUE EXIT ÔÈÅÎ ÁSCII % CASE? ÉÆ 2 TRUE EXIT ÔÈÅÎ FALSE ; Ü : PUNCTUATION? ( CHAR -- FLAG) ÁSCII , OVER = SWAP ÁSCII . = OR ; Ü : ?DPL DPL @ -1 = ?EXIT 1 DPL +! ; ( NUMBER? NUMBER 'NUMBER 01OCT87CLV/RE) Ü ÖARIABLE PTR \ POINTS INTO STRING : NUMBER? ( STRING - STRING FALSE / N 0< / D 0> ) BASE PUSH DUP COUNT PTR ! DPL ON 0 >R ( +SIGN) 0 0 ROT END? ?NONUM CHAR ÁSCII - CASE? ÉÆ RDROP TRUE >R END? ?NONUM CHAR ÔÈÅÎ FIXBASE? ÉÆ BASE ! END? ?NONUM CHAR ÔÈÅÎ ÂÅÇÉÎ DIGIT? 0= ?NONUM ÂÅÇÉÎ ACCUMULATE ?DPL END? ?NUM CHAR DIGIT? 0= ÕÎÔÉÌ PREVIOUS PUNCTUATION? 0= ?NONUM DPL OFF END? ?NUM CHAR ÒÅÐÅÁÔ ; ÄEFER 'NUMBER? ' NUMBER? ÉS 'NUMBER? : NUMBER ( STRING -- D ) 'NUMBER? ?DUP 0= ÁBORT" ?" 0< ÉÆ EXTEND ÔÈÅÎ ; ( HIDE REVEAL IMMEDIATE RESTRICT KS) ÖARIABLE LAST 0 LAST ! Ü : LAST? ( -- FALSE / ACF TRUE) LAST @ ?DUP ; : HIDE LAST? ÉÆ 2- @ CURRENT @ ! ÔÈÅÎ ; : REVEAL LAST? ÉÆ 2- CURRENT @ ! ÔÈÅÎ ; : ÒECURSIVE REVEAL ; IMMEDIATE RESTRICT Ü : FLAG! ( 8B --) LAST? ÉÆ UNDER C@ OR OVER C! ÔÈÅÎ DROP ; : IMMEDIATE $40 FLAG! ; : RESTRICT $80 FLAG! ; ( CLEARSTACK HALLOT HEAP HEAP?11FEB85BP) ÃODE CLEARSTACK USER' S0 # LDY ÕÐ )Ù LDA ÓÐ STA INY ÕÐ )Ù LDA ÓÐ 1+ STA 1 # LDY ÎEXT JMP END-CODE : HALLOT ( QUAN -- ) S0 @ OVER - SWAP SP@ 2+ DUP ROT - DUP S0 ! 2 PICK OVER - MOVE CLEARSTACK S0 ! ; : HEAP ( -- ADDR) S0 @ 6+ ; : HEAP? ( ADDR -- FLAG) HEAP UP@ UWITHIN ; Ü : HEAPMOVE ( FROM -- FROM) DUP HERE OVER - DUP HALLOT HEAP SWAP CMOVE HEAP OVER - LAST +! REVEAL ; ( ÄOES> ; 30DEC84KS/BP) ÌABEL (DODOES> ÒÐ 2DEC ÉÐ 1+ LDA ÒÐ )Ù STA ÉÐ LDA ÒÐ Ø) STA \ PUT ÉÐ ON ÒÐ CLC × Ø) LDA 3 # ADC ÉÐ STA TXA × )Ù ADC ÉÐ 1+ STA \ ×@ + 3 -> ÉÐ ÌABEL DOCREATE 2 # LDA CLC × ADC PHA TXA × 1+ ADC ÐUSH JMP END-CODE Ü : (;CODE R> LAST @ NAME> ! ; : ÄOES> COMPILE (;CODE $4à C, COMPILE (DODOES> ; IMMEDIATE RESTRICT ( 6502-ALIGN ?HEAD Ü 08SEP84BP) Ü : 6502-ALIGN/1 ( ADR -- ADR' ) DUP $ÆÆ AND $ÆÆ = - ; Ü : 6502-ALIGN/2 ( LFA -- LFA ) HERE $ÆÆ AND $ÆÆ = ÉÆ DUP DUP 1+ HERE OVER - 1+ CMOVE> \ LFA NOW INVALID 1 LAST +! 1 ALLOT ÔÈÅÎ ; ÖARIABLE ?HEAD 0 ?HEAD ! : Ü ?HEAD @ ?EXIT -1 ?HEAD ! ; ( WARNING ÃREATE 30DEC84BP) ÖARIABLE WARNING 0 WARNING ! Ü : EXISTS? WARNING @ ?EXIT LAST @ CURRENT @ (FIND NIP ÉÆ SPACE LAST @ .NAME ." EXISTS " ?CR ÔÈÅÎ ; : ÃREATE HERE BLK @ , CURRENT @ @ , NAME C@ DUP 1 $20 UWITHIN NOT ÁBORT" INVALID NAME" HERE LAST ! 1+ ALLOT EXISTS? ?HEAD @ ÉÆ 1 ?HEAD +! DUP 6502-ALIGN/1 , \ ÐOINTER TO CODE HEAPMOVE $20 FLAG! 6502-ALIGN/1 DP ! ÅÌÓÅ 6502-ALIGN/2 DROP ÔÈÅÎ REVEAL 0 , ;ÃODE DOCREATE JMP END-CODE ( NFA? 30DEC84BP) ÃODE NFA? ( VOCABTHREAD CFA -- NFA / FALSE) ÓÐ Ø) LDA Î 4 + STA ÓÐ )Ù LDA Î 5 + STA ÓÐ 2INC [[ [[ ÓÐ Ø) LDA Î 2+ STA ÓÐ )Ù LDA Î 3 + STA Î 2+ ORA 0= ?[ PUTÆALSE JMP ]? Î 2+ )Ù LDA ÓÐ )Ù STA Î 1+ STA Î 2+ Ø) LDA ÓÐ Ø) STA Î STA Î 1+ ORA 0= ?[ ÎEXT JMP ]? \ Î=LINK Î 2INC Î Ø) LDA PHA SEC $1Æ # AND Î ADC Î STA ÃÓ ?[ Î 1+ INC ]? PLA $20 # AND 0= NOT ?[ Î )Ù LDA PHA Î Ø) LDA Î STA PLA Î 1+ STA ]? Î LDA Î 4 + CMP 0= ?] Î 1+ LDA Î 5 + CMP 0= ?] ' 2+ @ JMP END-CODE \\ VOCABTHREAD=0 THAT IS EMPTY ÖOCABUL- ARY IN NFA? IS NOT ALLOWED ( >NAME NAME> >BODY .NAME 03FEB85BP) : >NAME ( CFA -- NFA / FALSE) VOC-LINK ÂÅÇÉÎ @ DUP ×ÈÉÌÅ 2DUP 4 - SWAP NFA? ?DUP ÉÆ -ROT 2DROP EXIT ÔÈÅÎ ÒÅÐÅÁÔ NIP ; Ü : (NAME> ( NFA -- CFA) COUNT $1Æ AND + ; : NAME> ( NFA -- CFA) DUP (NAME> SWAP C@ $20 AND ÉÆ @ ÔÈÅÎ ; : >BODY ( CFA -- PFA) 2+ ; : .NAME ( NFA --) ?DUP ÉÆ DUP HEAP? ÉÆ ." |" ÔÈÅÎ COUNT $1Æ AND TYPE ÅÌÓÅ ." ???" ÔÈÅÎ SPACE ; \ : ; ÃONSTANT ÖARIABLE CLV16JUL87 : ÃREATE: ÃREATE HIDE CURRENT @ CONTEXT ! ] 0 ; : : ÃREATE: ;ÃODE HERE >RECOVER ! \ RESOLVE FWD. REFERENCE ÒÐ 2DEC ÉÐ LDA ÒÐ Ø) STA ÉÐ 1+ LDA ÒÐ )Ù STA × LDA CLC 2 # ADC ÉÐ STA TXA × 1+ ADC ÉÐ 1+ STA ÎEXT JMP END-CODE : ; 0 ?PAIRS COMPILE UNNEST [COMPILE] [ REVEAL ; IMMEDIATE RESTRICT : ÃONSTANT ( 16B --) ÃREATE , ;ÃODE ÓÐ 2DEC 2 # LDY × )Ù LDA ÓÐ Ø) STA INY × )Ù LDA 1 # LDY ÓÐ )Ù STA ÎEXT JMP END-CODE : ÖARIABLE ÃREATE 2 ALLOT ; ( UALLOT ÕSER ÁLIAS 10JAN85KS/BP) : UALLOT ( QUAN -- OFFSET) DUP UDP @ + $ÆÆ U> ÁBORT" ÕSERAREA FULL" UDP @ SWAP UDP +! ; : ÕSER ÃREATE 2 UALLOT C, ;ÃODE ÓÐ 2DEC 2 # LDY × )Ù LDA CLC ÕÐ ADC ÓÐ Ø) STA TXA INY ÕÐ 1+ ADC 1 # LDY ÓÐ )Ù STA ÎEXT JMP END-CODE : ÁLIAS ( CFA --) ÃREATE LAST @ DUP C@ $20 AND ÉÆ -2 ALLOT ÅÌÓÅ $20 FLAG! ÔÈÅÎ (NAME> ! ; ( VOC-LINK VP CURRENT CONTEXT ALSO BP) ÃREATE VP $10 ALLOT ÖARIABLE CURRENT : CONTEXT ( -- ADR ) VP DUP @ + 2+ ; Ü : THRU.VOCSTACK ( -- FROM TO ) VP 2+ CONTEXT ; \ "ÏNLY ÆORTH ALSO ÁSSEMBLER" GIVES VP : \ COUNTWORD = 6 |ÏNLY|ÆORTH|ÁSSEMBLER : ALSO VP @ $Á > ÅRROR" ÖOCABULARY STACK FULL" CONTEXT @ 2 VP +! CONTEXT ! ; : TOSS -2 VP +! ; ( ÖOCABULARY ÆORTH ÏNLY ÆORTH-83 KS/BP) : ÖOCABULARY ÃREATE 0 , 0 , HERE VOC-LINK @ , VOC-LINK ! ÄOES> CONTEXT ! ; \ ÎAME Ü ÃODE Ü ÔHREAD Ü ÃOLDTHREAD Ü \ ÖOC-LINK ÖOCABULARY ÆORTH ÖOCABULARY ÏNLY ] ÄOES> [ ÏNLYPATCH ] 0 VP ! CONTEXT ! ALSO ; ' ÏNLY ! : ÏNLYFORTH ÏNLY ÆORTH ALSO DEFINITIONS ; ( DEFINITIONS ORDER WORDS 13JAN84BP/KS) : DEFINITIONS CONTEXT @ CURRENT ! ; Ü : .VOC ( ADR -- ) @ 2- >NAME .NAME ; : ORDER THRU.VOCSTACK ÄÏ É .VOC -2 +ÌÏÏÐ 2 SPACES CURRENT .VOC ; : WORDS CONTEXT @ ÂÅÇÉÎ @ DUP STOP? 0= AND ×ÈÉÌÅ ?CR DUP 2+ .NAME SPACE ÒÅÐÅÁÔ DROP ; ( (FIND 08APR85BP) ÃODE (FIND ( STRING THREAD -- STRING FALSE / NAMEFIELD TRUE) 3 # LDY [[ ÓÐ )Ù LDA Î ,Ù STA DEY 0< ?] Î 2+ Ø) LDA $1Æ # AND Î 4 + STA ÌABEL FINDLOOP 0 # LDY Î )Ù LDA TAX INY Î )Ù LDA Î 1+ STA Î STX Î ORA 0= ?[ 1 # LDY 0 # LDX PUTÆALSE JMP ]? INY Î )Ù LDA $1Æ # AND Î 4 + CMP FINDLOOP BNE \ COUNTBYTE MATCH CLC 2 # LDA Î ADC Î 5 + STA 0 # LDA Î 1+ ADC Î 6 + STA Î 4 + LDY [[ Î 2+ )Ù LDA Î 5 + )Ù CMP FINDLOOP BNE DEY 0= ?] 3 # LDY Î 6 + LDA ÓÐ )Ù STA DEY Î 5 + LDA ÓÐ )Ù STA DEY 0 # LDX PUTÔRUE JMP END-CODE ( FOUND 29JAN85BP) Ü ÃODE FOUND ( NFA -- CFA N ) ÓÐ Ø) LDA Î STA ÓÐ )Ù LDA Î 1+ STA Î Ø) LDA Î 2+ STA $1Æ # AND SEC Î ADC Î STA ÃÓ ?[ Î 1+ INC ]? Î 2+ LDA $20 # AND 0= ?[ Î LDA ÓÐ Ø) STA Î 1+ LDA ][ Î Ø) LDA ÓÐ Ø) STA Î )Ù LDA ]? ÓÐ )Ù STA ÓÐ 2DEC Î 2+ LDA 0< ?[ INY ]? .Á ASL 0< NOT ?[ TYA $ÆÆ # EOR TAY INY ]? TYA ÓÐ Ø) STA 0< ?[ $ÆÆ # LDA 24 C, ]? TXA 1 # LDY ÓÐ )Ù STA ÎEXT JMP END-CODE \\ Ü : FOUND ( NFA -- CFA N ) DUP C@ >R (NAME> R@ $20 AND ÉÆ @ ÔÈÅÎ -1 R@ $80 AND ÉÆ 1- ÔÈÅÎ R> $40 AND ÉÆ NEGATE ÔÈÅÎ ; ( FIND ' ['] 13JAN85BP) : FIND ( STRING -- CFA N / STRING FALSE) CONTEXT DUP @ OVER 2- @ = ÉÆ 2- ÔÈÅÎ ÂÅÇÉÎ UNDER @ (FIND ÉÆ NIP FOUND EXIT ÔÈÅÎ OVER VP 2+ U> ×ÈÉÌÅ SWAP 2- ÒÅÐÅÁÔ NIP FALSE ; : ' ( -- CFA ) NAME FIND 0= ÁBORT" ×HAT?" ; : [COMPILE] ' , ; IMMEDIATE RESTRICT : ['] ' [COMPILE] ÌITERAL ; IMMEDIATE RESTRICT : NULLSTRING? ( STRING -- STRING FALSE / TRUE) DUP C@ 0= DUP ÉÆ NIP ÔÈÅÎ ; ( >INTERPRET 28FEB85BP) ÌABEL JUMP INY CLC × )Ù LDA 2 # ADC ÉÐ STA INY × )Ù LDA 0 # ADC ÉÐ 1+ STA 1 # LDY ÎEXT JMP END-CODE ÖARIABLE >INTERPRET JUMP ' >INTERPRET ! \\ MAKE ÖARIABLE >INTERPRET TO SPECIAL ÄEFER ( INTERPRET INTERACTIVE 01OCT87CLV/RE) ÄEFER NOTFOUND : NO.EXTENSIONS ( STRING -- ) ÅRROR" ÈAEH?" ; \ STRING NOT 0 ' NO.EXTENSIONS ÉS NOTFOUND : INTERPRET >INTERPRET ; Ü : INTERACTIVE ?STACK NAME FIND ?DUP ÉÆ 1 AND ÉÆ EXECUTE >INTERPRET ÔÈÅÎ ÁBORT" COMPILE ONLY" ÔÈÅÎ NULLSTRING? ?EXIT 'NUMBER? 0= ÉÆ NOTFOUND ÔÈÅÎ >INTERPRET ; ' INTERACTIVE >INTERPRET ! ( COMPILING [ ] 01OCT87CLV/RE) Ü : COMPILING ?STACK NAME FIND ?DUP ÉÆ 0> ÉÆ EXECUTE >INTERPRET ÔÈÅÎ , >INTERPRET ÔÈÅÎ NULLSTRINA VOLKSFORTH 3.8-2 U3 2A ÿ G? ?EXIT 'NUMBER? ?DUP ÉÆ 0> ÉÆ SWAP [COMPILE] ÌITERAL ÔÈÅÎ [COMPILE] ÌITERAL ÅÌÓÅ NOTFOUND ÔÈÅÎ >INTERPRET ; : [ ['] INTERACTIVE ÉS >INTERPRET STATE OFF ; IMMEDIATE : ] ['] COMPILING ÉS >INTERPRET STATE ON ; \ PERFOM ÄEFER ÉS 02NOV87RE Ü : CRASH TRUE ÁBORT" ÃRASH" ; : ÄEFER ÃREATE ['] CRASH , ;ÃODE 2 # LDY × )Ù LDA PHA INY × )Ù LDA × 1+ STA PLA × STA 1 # LDY × 1- JMP END-CODE : (IS ( CFA -- ) R> DUP 2+ >R @ ! ; Ü : DEF? ( CFA -- ) @ ['] NOTFOUND @ OVER = SWAP ['] >INTERPRET @ = OR NOT ÁBORT" NOT DEFERRED" ; : ÉS ( CFA -- ) ( -- ) ' DUP DEF? >BODY STATE @ ÉÆ COMPILE (IS , EXIT ÔÈÅÎ ! ; IMMEDIATE ( ?STACK 01OCT87CLV/RE) Ü ÃREATE ALARM 1 ALLOT 0 ALARM C! Ü : STACKFULL ( -- ) DEPTH $20 > ABORT" TIGHT STACK" ALARM C@ 0= ÉÆ -1 ALARM C! TRUE ABORT" DICTIONARY FULL" ÔÈÅÎ ." STILL FULL " ; ÃODE ?STACK USER' DP # LDY SEC ÓÐ LDA ÕÐ )Ù SBC INY ÓÐ 1+ LDA ÕÐ )Ù SBC 0= ?[ 1 # LDY ;C: STACKFULL ; ÁSSEMBLER ]? ALARM STX USER' S0 # LDY ÕÐ )Ù LDA ÓÐ CMP INY ÕÐ )Ù LDA ÓÐ 1+ SBC 1 # LDY ÃÓ ?[ ÎEXT JMP ]? ;C: TRUE ÁBORT" STACK EMPTY" ; \\ : ?STACK SP@ HERE - $100 U< ÉÆ STACKFULL ÔÈÅÎ SP@ S0 @ U> ÁBORT" STACK EMPTY" ; ( .STATUS PUSH LOAD 08SEP84KS) ÄEFER .STATUS ' NOOP ÉS .STATUS Ü ÃREATE PULL 0 ] R> R> ! ; : PUSH ( ADDR -- ) R> SWAP DUP >R @ >R PULL >R >R ; RESTRICT : LOAD ( BLK --) ?DUP 0= ?EXIT BLK PUSH BLK ! >IN PUSH >IN OFF .STATUS INTERPRET ; ( +LOAD THRU +THRU --> RDEPTH DEPTH KS) : +LOAD ( OFFSET --) BLK @ + LOAD ; : THRU ( FROM TO --) 1+ SWAP ÄÏ É LOAD ÌÏÏÐ ; : +THRU ( OFF0 OFF1 --) 1+ SWAP ÄÏ É +LOAD ÌÏÏÐ ; : --> 1 BLK +! >IN OFF .STATUS ; IMMEDIATE : RDEPTH ( -- +N) R0 @ RP@ 2+ - 2/ ; : DEPTH ( -- +N) SP@ S0 @ SWAP - 2/ ; ( QUIT (QUIT ABORT 07JUN85BP) Ü : PROMPT STATE @ ÉÆ ." COMPILING" EXIT ÔÈÅÎ ." OK" ; : (QUIT ÂÅÇÉÎ .STATUS CR QUERY INTERPRET PROMPT ÒÅÐÅÁÔ ; ÄEFER 'QUIT ' (QUIT ÉS 'QUIT : QUIT R0 @ RP! [COMPILE] [ 'QUIT ; : STANDARDI/O [ OUTPUT ] ÌITERAL OUTPUT 4 CMOVE ; ÄEFER 'ABORT ' NOOP ÉS 'ABORT : ABORT CLEARSTACK END-TRACE 'ABORT STANDARDI/O QUIT ; \ (ERROR ÁBORT" ÅRROR" 02NOV87RE ÖARIABLE SCR 1 SCR ! ÖARIABLE R# 0 R# ! : (ERROR ( STRING -- ) STANDARDI/O SPACE HERE .NAME COUNT TYPE SPACE ?CR BLK @ ?DUP ÉÆ SCR ! >IN @ R# ! ÔÈÅÎ QUIT ; ' (ERROR ERRORHANDLER ! : (ABORT" ( FLAG -- ) "LIT SWAP ÉÆ >R CLEARSTACK R> ERRORHANDLER PERFORM EXIT ÔÈÅÎ DROP ; RESTRICT Ü : (ERR" ( FLAG -- ) "LIT SWAP ÉÆ ERRORHANDLER PERFORM EXIT ÔÈÅÎ DROP ; RESTRICT : ÁBORT" ( FLAG -- ) COMPILE (ABORT" ," ; IMMEDIATE RESTRICT : ÅRROR" ( FLAG -- ) COMPILE (ERR" ," ; IMMEDIATE RESTRICT ( -TRAILING 08APR85BP) 020 ÃONSTANT BL ÃODE -TRAILING ( ADDR N1 -- ADR N2 ) TYA ÓETUP JSR ÓÐ Ø) LDA Î 2+ STA CLC ÓÐ )Ù LDA Î 1+ ADC Î 3 + STA Î LDY CLC ÃÓ ?[ ÌABEL (-TRAIL DEY Î 2+ )Ù LDA BL # CMP 0<> ?[ INY 0= ?[ Î 1+ INC ]? TYA PHA Î 1+ LDA ÐUSH JMP ]? ]? TYA (-TRAIL BNE Î 3 + DEC Î 1 + DEC (-TRAIL BPL TYA ÐUSH0Á JMP END-CODE ( SPACE SPACES 29JAN85KS/BP) : SPACE BL EMIT ; : SPACES ( U --) 0 ?ÄÏ SPACE ÌÏÏÐ ; \\ : -TRAILING ( ADDR N1 -- ADDR N2) 2DUP BOUNDS ?ÄÏ 2DUP + 1- C@ BL - ÉÆ ÌÅÁÖÅ ÔÈÅÎ 1- ÌÏÏÐ ; ( HOLD <# #> SIGN # #S 24DEC83KS) Ü : HLD ( -- ADDR) PAD 2- ; : HOLD ( CHAR -- ) -1 HLD +! HLD @ C! ; : <# HLD HLD ! ; : #> ( 32B -- ADDR +N ) 2DROP HLD @ HLD OVER - ; : SIGN ( N -- ) 0< ÉÆ ÁSCII - HOLD ÔÈÅÎ ; : # ( +D1 -- +D2) BASE @ UD/MOD ROT 09 OVER < ÉÆ [ ÁSCII Á ÁSCII 9 - 1- ] ÌITERAL + ÔÈÅÎ ÁSCII 0 + HOLD ; : #S ( +D -- 0 0 ) ÂÅÇÉÎ # 2DUP D0= ÕÎÔÉÌ ; ( PRINT NUMBERS 24DEC83KS) : D.R -ROT UNDER DABS <# #S ROT SIGN #> ROT OVER MAX OVER - SPACES TYPE ; : .R SWAP EXTEND ROT D.R ; : U.R 0 SWAP D.R ; : D. 0 D.R SPACE ; : . EXTEND D. ; : U. 0 D. ; \ .S LIST C/L L/S CLV4:JUL87 : .S SP@ S0 @ OVER - 020 UMIN BOUNDS ?ÄÏ É @ U. 2 +ÌÏÏÐ ; 40 (à DROP 29 ) ÃONSTANT C/L \ ÓCREEN LINE LENGTH 10 (à DROP 19 ) ÃONSTANT L/S \ LINES PER SCREEN : LIST ( BLK --) SCR ! ." ÓCR " SCR @ DUP BLK/DRV MOD U. ." ÄR " DRV? . L/S 0 ÄÏ STOP? ÉÆ LEAVE ÔÈÅÎ CR É 2 .R SPACE SCR @ BLOCK É C/L * + C/L (à 1- ) -TRAILING TYPE ÌÏÏÐ CR ; ( MULTITASKER PRIMITIVES BP03NOV85) ÃODE PAUSE ÎEXT HERE 2- ! END-CODE : LOCK ( ADDR --) DUP @ UP@ = ÉÆ DROP EXIT ÔÈÅÎ ÂÅÇÉÎ DUP @ ×ÈÉÌÅ PAUSE ÒÅÐÅÁÔ UP@ SWAP ! ; : UNLOCK ( ADDR --) DUP LOCK OFF ; ÌABEL WAKE WAKE >WAKE ! PLA SEC 5 # SBC ÕÐ STA PLA 0 # SBC ÕÐ 1+ STA 04à # LDA ÕÐ Ø) STA 6 # LDY ÕÐ )Ù LDA ÓÐ STA INY ÕÐ )Ù LDA ÓÐ 1+ STA 1 # LDY ÓÐ Ø) LDA ÒÐ STA ÓÐ )Ù LDA ÒÐ 1+ STA ÓÐ 2INC ÉÐ # LDX ØPULL JMP END-CODE ( BUFFER MECHANISM 15DEC83KS) ÕSER FILE 0 FILE ! \ ADR OF FILE CONTROL BLOCK ÖARIABLE PREV 0 PREV ! \ ÌISTHEAD ÖARIABLE BUFFERS 0 BUFFERS ! \ ÓEMAPHORE 0408 ÃONSTANT B/BUF \ ÐHYSICAL ÓIZE \\ ÓTRUCTURE OF ÂUFFER: 0 : LINK 2 : FILE 4 : BLOCKNR 6 : STATUSFLAGS 8 : ÄATA .. 1 Ë .. ÓTATUSFLAG BITS: 15 1 -> UPDATED FILE = -1 EMPTY BUFFER = 0 NO FCB , DIRECT ACCESS = ELSE ADR OF FCB ( SYSTEM DEPENDENT ) ( SEARCH FOR BLOCKS IN MEMORY 11JUN85BP) ÌABEL THISBUFFER? 2 # LDY [[ Î 4 + )Ù LDA Î 2- ,Ù CMP 0= ?[[ INY 6 # CPY 0= ?] ]? RTS \ ZERO IF THIS BUFFER ) Ü ÃODE (CORE? ( BLK FILE -- ADDR / BLK FILE ) \ Î-ÁREA : 0 BLK 2 FILE 4 BUFFER \ 6 PREDECESSOR 3 # LDY [[ ÓÐ )Ù LDA Î ,Ù STA DEY 0< ?] USER' OFFSET # LDY CLC ÕÐ )Ù LDA Î 2+ ADC Î 2+ STA INY ÕÐ )Ù LDA Î 3 + ADC Î 3 + STA PREV LDA Î 4 + STA PREV 1+ LDA Î 5 + STA THISBUFFER? JSR 0= ?[ ( " 11JUN85BP) ÌABEL BLOCKFOUND ÓÐ 2INC 1 # LDY 8 # LDA CLC Î 4 + ADC ÓÐ Ø) STA Î 5 + LDA 0 # ADC ÓÐ )Ù STA ' EXIT @ JMP ]? [[ Î 4 + LDA Î 6 + STA Î 5 + LDA Î 7 + STA Î 6 + Ø) LDA Î 4 + STA 1 # LDY Î 6 + )Ù LDA Î 5 + STA Î 4 + ORA 0= ?[ ( LIST EMPTY ) ÎEXT JMP ]? THISBUFFER? JSR 0= ?] \ FOUND, RELINK Î 4 + Ø) LDA Î 6 + Ø) STA 1 # LDY Î 4 + )Ù LDA Î 6 + )Ù STA PREV LDA Î 4 + Ø) STA PREV 1+ LDA Î 4 + )Ù STA Î 4 + LDA PREV STA Î 5 + LDA PREV 1+ STA BLOCKFOUND JMP END-CODE \ (CORE? 23SEP85BP \\ Ü : THIS? ( BLK FILE BUFADR -- FLAG ) DUP 4+ @ SWAP 2+ @ D= ; Ü : (CORE? ( BLK FILE -- DATAADDR / BLK FILE ) ÂÅÇÉÎ OVER OFFSET @ + OVER PREV @ THIS? ÉÆ RDROP 2DROP PREV @ 8 + EXIT ÔÈÅÎ 2DUP >R OFFSET @ + >R PREV @ ÂÅÇÉÎ DUP @ ?DUP 0= ÉÆ RDROP RDROP DROP EXIT ÔÈÅÎ DUP R> R> 2DUP >R >R ROT THIS? 0= ×ÈÉÌÅ NIP ÒÅÐÅÁÔ DUP @ ROT ! PREV @ OVER ! PREV ! RDROP RDROP ÒÅÐÅÁÔ ; ( (DISKERR 11JUN85BP) : (DISKERR ." ERROR ! R TO RETRY " KEY DUP ÁSCII R = SWAP ÁSCII Ò = OR NOT ÁBORT" ABORTED" ; ÄEFER DISKERR ' (DISKERR ÉS DISKERR ÄEFER R/W ( BACKUP EMPTYBUF READBLK 11JUN85BP) Ü : BACKUP ( BUFADDR --) DUP 6+ @ 0< ÉÆ 2+ DUP @ 1+ \ BUFFER EMPTY IF FILE = -1 ÉÆ INPUT PUSH OUTPUT PUSH STANDARDI/O ÂÅÇÉÎ DUP 6+ OVER 2+ @ 2 PICK @ 0 R/W ×ÈÉÌÅ ." WRITE " DISKERR ÒÅÐÅÁÔ ÔÈÅÎ 080 OVER 4+ 1+ CTOGGLE ÔÈÅÎ DROP ; Ü : EMPTYBUF ( BUFADDR --) 2+ DUP ON 4+ OFF ; Ü : READBLK ( BLK FILE ADDR -- BLK FILE ADDR) DUP EMPTYBUF INPUT PUSH OUTPUT PUSH STANDARDI/O >R ÂÅÇÉÎ OVER OFFSET @ + OVER R@ 8 + -ROT 1 R/W ×ÈÉÌÅ ." READ " DISKERR ÒÅÐÅÁÔ R> ; ( TAKE MARK UPDATES? FULL? CORE? BP) Ü : TAKE ( -- BUFADDR) PREV ÂÅÇÉÎ DUP @ ×ÈÉÌÅ @ DUP 2+ @ -1 = ÕÎÔÉÌ BUFFERS LOCK DUP BACKUP ; Ü : MARK ( BLK FILE BUFADDR -- BLK FILE ) 2+ >R 2DUP R@ ! OFFSET @ + R@ 2+ ! R> 4+ OFF BUFFERS UNLOCK ; Ü : UPDATES? ( -- BUFADDR / FLAG) PREV ÂÅÇÉÎ @ DUP ×ÈÉÌÅ DUP 6+ @ 0< ÕÎÔÉÌ ; Ü : FULL? ( -- FLAG) PREV ÂÅÇÉÎ @ DUP @ 0= ÕÎÔÉÌ 6+ @ 0< ; : CORE? ( BLK FILE -- ADDR /FALSE) (CORE? 2DROP FALSE ; ( BLOCK & BUFFER MANIPULATION 11JUN85BP) : (BUFFER ( BLK FILE -- ADDR) ÂÅÇÉÎ (CORE? TAKE MARK ÒÅÐÅÁÔ ; : (BLOCK ( BLK FILE -- ADDR) ÂÅÇÉÎ (CORE? TAKE READBLK MARK ÒÅÐÅÁÔ ; Ü ÃODE FILE@ ( -- N ) USER' FILE # LDY ÕÐ )Ù LDA PHA INY ÕÐ )Ù LDA ÐUSH JMP END-CODE : BUFFER ( BLK -- ADDR ) FILE@ (BUFFER ; : BLOCK ( BLK -- ADDR ) FILE@ (BLOCK ; ( BLOCK & BUFFER MANIPULATION 09SEP84KS) : UPDATE 080 PREV @ 6+ 1+ C! ; : SAVE-BUFFERS BUFFERS LOCK ÂÅÇÉÎ UPDATES? ?DUP ×ÈÉÌÅ BACKUP ÒÅÐÅÁÔ BUFFERS UNLOCK ; : EMPTY-BUFFERS BUFFERS LOCK PREV ÂÅÇÉÎ @ ?DUP ×ÈÉÌÅ DUP EMPTYBUF ÒÅÐÅÁÔ BUFFERS UNLOCK ; : FLUSH SAVE-BUFFERS EMPTY-BUFFERS ; ( MOVING BLOCKS 15DEC83KS) : (COPY ( FROM TO --) DUP FILE@ CORE? ÉÆ PREV @ EMPTYBUF ÔÈÅÎ FULL? ÉÆ SAVE-BUFFERS ÔÈÅÎ OFFSET @ + SWAP BLOCK 2- 2- ! UPDATE ; : BLKMOVE ( FROM TO QUAN --) SAVE-BUFFERS >R OVER R@ + OVER U> >R 2DUP U< R> AND ÉÆ R@ R@ D+ R> 0 ?ÄÏ -1 -2 D+ 2DUP (COPY ÌÏÏÐ ÅÌÓÅ R> 0 ?ÄÏ 2DUP (COPY 1 1 D+ ÌÏÏÐ ÔÈÅÎ SAVE-BUFFERS 2DROP ; : COPY ( FROM TO --) 1 BLKMOVE ; : CONVEY ( [BLK1 BLK2] [TO.BLK --) SWAP 1+ 2 PICK - DUP 0> NOT ÁBORT" NO!!" BLKMOVE ; \ ÁLLOCATING BUFFERS CLV12JUL87 Å400 ÃONSTANT LIMIT ÖARIABLE FIRST : ALLOTBUFFER ( -- ) FIRST @ R0 @ - B/BUF 2+ U< ?EXIT B/BUF NEGATE FIRST +! FIRST @ DUP EMPTYBUF PREV @ OVER ! PREV ! ; : FREEBUFFER ( -- ) FIRST @ LIMIT B/BUF - U< ÉÆ FIRST @ BACKUP PREV ÂÅÇÉÎ DUP @ FIRST @ - ×ÈÉÌÅ @ ÒÅÐÅÁÔ FIRST @ @ SWAP ! B/BUF FIRST +! ÔÈÅÎ ; : ALL-BUFFERS ÂÅÇÉÎ FIRST @ ALLOTBUFFER FIRST @ = ÕÎÔÉÌ ; ( ENDPOINTS OF FORGET 04JAN85BP/KS) Ü : |? ( NFA -- FLAG ) C@ 020 AND ; Ü : FORGET? ( ADR NFA -- FLAG ) \ CODE IN HEAP OR ABOVE ADR ? NAME> UNDER 1+ U< SWAP HEAP? OR ; Ü : ENDPOINTS ( ADDR -- ADDR SYMB) HEAP VOC-LINK @ >R ÂÅÇÉÎ R> @ ?DUP \ THROUGH ALL ÖOCABS ×ÈÉÌÅ DUP >R 4 - >R \ LINK ON RETURNST. ÂÅÇÉÎ R> @ >R OVER 1- DUP R@ U< \ UNTIL LINK OR SWAP R@ 2+ NAME> U< AND \ CODE UNDER ADR ×ÈÉÌÅ R@ HEAP? [ 2DUP ] ÕÎÔÉÌ \ SEARCH FOR A NAME IN HEAP R@ 2+ |? ÉÆ OVER R@ 2+ FORGET? ÉÆ R@ 2+ (NAME> 2+ UMAX ÔÈÅÎ \ THEN UPDATE SYMB ÔÈÅÎ ÒÅÐÅÁÔ RDROP ÒÅÐÅÁÔ ; \ REMOVE 23JUL85WE Ü ÃODE REMOVE ( DIC SYMB THR - DIC SYMB) 5 # LDY [[ ÓÐ )Ù LDA Î ,Ù STA DEY 0< ?] USER' S0 # LDY CLC ÕÐ )Ù LDA 6 # ADC Î 6 + STA INY ÕÐ )Ù LDA 0 # ADC Î 7 + STA 1 # LDY [[ Î Ø) LDA Î 8 + STA Î )Ù LDA Î 9 + STA Î 8 + ORA 0<> ?[[ Î 8 + LDA Î 6 + CMP Î 9 + LDA Î 7 + SBC ÃÓ ?[ Î 8 + LDA Î 2 + CMP Î 9 + LDA Î 3 + SBC ][ Î 4 + LDA Î 8 + CMP Î 5 + LDA Î 9 + SBC ]? Ãà ?[ Î 8 + Ø) LDA Î Ø) STA Î 8 + )Ù LDA Î )Ù STA ][ Î 8 + LDA Î STA Î 9 + LDA Î 1+ STA ]? ]]? (DROP JMP END-CODE ( REMOVE- FORGET-WORDS 29APR85BP) Ü : REMOVE-WORDS ( DIC SYMB -- DIC SYMB) VOC-LINK ÂÅÇÉÎ @ ?DUP ×ÈÉÌÅ DUP >R 4 - REMOVE R> ÒÅÐÅÁÔ ; Ü : REMOVE-TASKS ( DIC --) UP@ ÂÅÇÉÎ 1+ DUP @ UP@ - ×ÈÉÌÅ 2DUP @ SWAP HERE UWITHIN ÉÆ DUP @ 1+ @ OVER ! 1- ÅÌÓÅ @ ÔÈÅÎ ÒÅÐÅÁÔ 2DROP ; Ü : REMOVE-VOCS ( DIC SYMB -- DIC SYMB) VOC-LINK REMOVE THRU.VOCSTACK ÄÏ 2DUP É @ -ROT UWITHIN ÉÆ [ ' ÆORTH 2+ ] ÌITERAL É ! ÔÈÅÎ -2 +ÌÏÏÐ 2DUP CURRENT @ -ROT UWITHIN ÉÆ [ ' ÆORTH 2+ ] ÌITERAL CURRENT ! ÔÈÅÎ ; ÄEFER CUSTOM-REMOVE ' NOOP ÉS CUSTOM-REMOVE ( DELETING WORDS FROM DICT. 13JAN83KS) Ü : FORGET-WORDS ( DIC SYMB --) OVER REMOVE-TASKS REMOVE-VOCS REMOVE-WORDS CUSTOM-REMOVE HEAP SWAP - HALLOT DP ! 0 LAST ! ; : CLEAR HERE DUP UP@ FORGET-WORDS DP ! ; : (FORGET ( ADR --) DUP HEAP? ÁBORT" IS SYMBOL" ENDPOINTS FORGET-WORDS ; : FORGET ' DUP [ DP ] ÌITERAL @ U< ÁBORT" PROTECTED" >NAME DUP HEAP? ÉÆ NAME> ÅÌÓÅ 2- 2- ÔÈÅÎ (FORGET ; : EMPTY [ DP ] ÌITERAL @ UP@ FORGET-WORDS [ UDP ] ÌITERAL @ UDP ! ; \ SAVE BYE STOP? ?CR CLV2:JULL87 : SAVE HERE UP@ FORGET-WORDS VOC-LINK @ ÂÅÇÉÎ DUP 2- 2- @ OVER 2- ! @ ?DUP 0= ÕÎÔÉÌ UP@ ORIGIN $100 CMOVE ; : BYE SAVE-BUFFERS (BYE ; \ : BYE FLUSH EMPTY (BYE ; Ü : END? KEY ( #CR ) (à 3 ) = ÉÆ TRUE RDROP ÔÈÅÎ ; : STOP? ( -- FLAG) KEY? ÉÆ END? END? ÔÈÅÎ FALSE ; : ?CR COL C/L $Á - U> ÉÆ CR ÔÈÅÎ ; ( IN/OUTPUT STRUCTURE 02MAR85BP) Ü : ÏUT: ÃREATE DUP C, 2+ ÄOES> C@ OUTPUT @ + PERFORM ; : ÏUTPUT: ÃREATE: ÄOES> OUTPUT ! ; 0 ÏUT: EMIT ÏUT: CR ÏUT: TYPE ÏUT: DEL ÏUT: PAGE ÏUT: AT ÏUT: AT? DROP : ROW ( -- ROW) AT? DROP ; : COL ( -- COL) AT? NIP ; Ü : ÉN: ÃREATE DUP C, 2+ ÄOES> C@ INPUT @ + PERFORM ; : ÉNPUT: ÃREATE: ÄOES> INPUT ! ; 0 ÉN: KEY ÉN: KEY? ÉN: DECODE ÉN: EXPECT DROP ( ÁLIAS ONLY DEFINITIONEN 29JAN85BP) ÏNLY DEFINITIONS ÆORTH : SEAL 0 ['] ÏNLY >BODY ! ; \ KILL ALL WORDS IN ÏNLY) ' ÏNLY ÁLIAS ÏNLY ' ÆORTH ÁLIAS ÆORTH ' WORDS ÁLIAS WORDS ' ALSO ÁLIAS ALSO ' DEFINITIONS ÁLIAS DEFINITIONS ÈOST ÔARGET \ 'COLD 01OCT87CLV/RE) Ü : INIT-VOCABULARYS VOC-LINK @ ÂÅÇÉÎ DUP 2- @ OVER 4 - ! @ ?DUP 0= ÕÎÔÉÌ ; Ü : INIT-BUFFERS 0 PREV ! LIMIT FIRST ! ALL-BUFFERS ; ÄEFER 'COLD ' NOOP ÉS 'COLD Ü : (COLD INIT-VOCABULARYS INIT-BUFFERS ÏNLYFORTH 'COLD PAGE LOGO COUNT TYPE CR (RESTART ; ÄEFER 'RESTART ' NOOP ÉS 'RESTART Ü : (RESTART ['] (QUIT ÉS 'QUIT DRVINIT 'RESTART [ ERRORHANDLER ] ÌITERAL @ ERRORHANDLER ! ['] NOOP ÉS 'ABORT ABORT ; \ FORTH-INIT 01OCT87CLV/RE) ÌABEL FORTH-INIT ÂOOTNEXTLEN 1- # LDY [[ ÂOOTNEXT ,Ù LDA ÐUTÁ ,Ù STA DEY 0< ?] CLC S0 LDA 6 # ADC ÕÐ STA S0 1+ LDA 0 # ADC ÕÐ 1+ STA USER' S0 # LDY ÕÐ )Ù LDA ÓÐ STA INY ÕÐ )Ù LDA ÓÐ 1+ STA USER' R0 # LDY ÕÐ )Ù LDA ÒÐ STA INY ÕÐ )Ù LDA ÒÐ 1+ STA 0 # LDX 1 # LDY TXA ÒÐ Ø) STA ÒÐ )Ù STA ÌABEL DONOTHING RTS \ COLD RESTART 06NOV87RE ÃODE COLD HERE >COLD ! $ÆÆ # LDX TXS ÌABEL BOOTSYSTEM DONOTHING JSR \ PATCH FOR FIRST-INIT CLC S0 LDA 6 # ADC Î STA S0 1+ LDA 0 # ADC Î 1+ STA 0 # LDY [[ ORIGIN ,Ù LDA Î )Ù STA INY 0= ?] FORTH-INIT JSR ;C: INIT-SYSTEM (COLD ; ÃODE RESTART HERE >RESTART ! $ÆÆ # LDX TXS ÌABEL WARMBOOT DONOTHING JSR \ PATCH FOR FIRST-INIT FORTH-INIT JSR ;C: INIT-SYSTEM (RESTART ; ÌABEL XYÎEXT 0 # LDX 1 # LDY ÎEXT JMP END-CODE \ ÓYSTEM-ÌOADSCREEN 01OCT87CLV/RE) 3 $18 +THRU \ ÃÂÍ-ÉNTERFACE (C16+ 19 +LOAD ) \ C16INIT ÒAMÉÒÑ ÈOST ' ÔRANSIENT 8 + @ ÔRANSIENT ÆORTH ÃONTEXT @ 6 + ! ÔARGET ÆORTH ALSO DEFINITIONS (Ã16 : (64 ) \ JUMPS BELHIND Ã) (Ã64 : (16 ) ÂÅÇÉÎ NAME COUNT 0= ABORT" Ã) MISSING" @ [ ÁSCII à ÁSCII ) $100 * + ] ÌITERAL = ÕÎÔÉÌ ; IMMEDIATE : Ã) ; IMMEDIATE (Ã16 : (16 ) (Ã64 : (64 ) ; IMMEDIATE : FORTH-83 ; \ LAST WORD IN ÄICTIONARY ( ÓYSTEM DEPENDENT ÃONSTANTS BP/KS) ÖOCABULARY ÁSSEMBLER ÁSSEMBLER DEFINITIONS ÔRANSIENT ÁSSEMBLER ÐUSHÁ ÃONSTANT ÐUSHÁ \ PUT Á SIGN-EXTENDED ON STACK ÐUSH0Á ÃONSTANT ÐUSH0Á \ PUT Á ON STACK ÐUSH ÃONSTANT ÐUSH \ ÍÓ IN Á AND ÌÓ ON JSR-STACK ÒÐ ÃONSTANT ÒÐ ÕÐ ÃONSTANT ÕÐ ÓÐ ÃONSTANT ÓÐ ÉÐ ÃONSTANT ÉÐ Î ÃONSTANT Î ÐUTA ÃONSTANT ÐUTA × ÃONSTANT × ÓETUP ÃONSTANT ÓETUP ÎEXT ÃONSTANT ÎEXT XYÎEXT ÃONSTANT XYÎEXT (2DROP ÃONSTANT ÐOPTWO (DROP ÃONSTANT ÐOP \ ÓYSTEM PATCHUP CLV06AUG87 ÆORTH DEFINITIONS (Ã64 Ã000 ' LIMIT >BODY ! 7Â00 S0 ! 7Æ00 R0 ! ) (Ã16 8000 ' LIMIT >BODY ! 7700 S0 ! 7B00 R0 ! ) \ (Ã16+ FD00 ' LIMIT >BODY ! \ 7Â00 S0 ! 7Æ00 R0 ! ) S0 @ DUP S0 2- ! 6 + S0 7 - ! HERE DP ! ÈOST ÔUDP @ ÔARGET UDP ! ÈOST ÔVOC-LINK @ ÔARGET VOC-LINK ! ÈOST MOVE-THREADS \ ÃÂÍ-ÌABELS 05NOV87RE $ÆÆÁ5 >LABEL ÁÃÐÔÒ $ÆÆÃ6 >LABEL ÃÈËÉÎ $ÆÆÃ9 >LABEL ÃÈËÏÕÔ $ÆÆÄ2 >LABEL ÃÈÒÏÕÔ $ÆÆ81 >LABEL ÃÉÎÔ $ÆÆÁ8 >LABEL ÃÉÏÕÔ $ÆÆÃ3 >LABEL ÃÌÏÓÅ $ÆÆÃà >LABEL ÃÌÒÃÈÎ $ÆÆÅ4 >LABEL ÇÅÔÉÎ $ÆÆ84 >LABEL ÉÏÉÎÉÔ $ÆÆÂ1 >LABEL ÌÉÓÔÅÎ $ÆÆÃ0 >LABEL ÏÐÅÎ $ÆÆÆ0 >LABEL ÐÌÏÔ $ÆÆ8Á >LABEL ÒÅÓÔÏÒ $ÆÆ93 >LABEL ÓÅÃÏÎÄ $ÆÆÅ1 >LABEL ÓÔÏÐ $ÆÆÂ4 >LABEL ÔÁÌË $ÆÆ96 >LABEL ÔËÓÁ $ÆÆÅÁ >LABEL ÕÄÔÉÍ $ÆÆÁÅ >LABEL ÕÎÌÓÎ $ÆÆÁ >LABEL ÕÎÔÌË $ÆÆÃÆ >LABEL ÃÈÒÉÎ $ÆÆ99 >LABEL ÍÅÍÔÏÐ \ Ã64-ÌABELS CLV13.4.87) (Ã64 0Å716 >LABEL ÃONÏUT 09D >LABEL ÍSGÆLG 09A >LABEL ÏUTÄEV 099 >LABEL ÉNÄEV 0D020 >LABEL ÂRDÃOL 0D021 >LABEL ÂKGÃOL 0286 >LABEL ÐENÃOL 0AE >LABEL ÐRGÅND 0C1 >LABEL ÉÏÂEG 0D4 >LABEL ÃURÆLG 0D8 >LABEL ÉNSÃNT 028A >LABEL ËEYÒEP ) \ Ã16-ÌABELS CLV13.4.87) (Ã16 0FF4C >LABEL ÃONÏUT 09A >LABEL ÍSGÆLG 099 >LABEL ÏUTÄEV 098 >LABEL ÉNÄEV 0FF19 >LABEL ÂRDÃOL 0FF15 >LABEL ÂKGÃOL 0540 >LABEL ÐENÃOL 09D >LABEL ÐRGÅND 0B2 >LABEL ÉÏÂEG 0CB >LABEL ÃURÆLG 0CF >LABEL ÉNSÃNT 0540 >LABEL ËEYÒEP 055D >LABEL ÐËEYS ) \ C64KEY? GETKEY CLV12JUL87 ÃODE C64KEY? ( -- FLAG) (Ã64 0Ã6 LDA ( ) (C16 0EF LDA 055D ORA ( ) 0<> ?[ 0ÆÆ # LDA ]? PHA ÐUSH JMP END-CODE ÃODE GETKEY ( -- 8B) (Ã64 0Ã6 LDA 0<> ?[ SEI 0277 LDY [[ 0277 1+ ,Ø LDA 0277 ,Ø STA INX 0Ã6 CPX 0= ?] 0Ã6 DEC TYA CLI 0Á0 # CMP 0= ?[ BL # LDA ]? ]? ( ) (Ã16 0EBDD JSR 0Á0 # CMP 0= ?[ BL # LDA ]? ( ) ÐUSH0Á JMP END-CODE ( CURON CUROFF CLV12.4.87) (Ã16 ÃODE CURON \ -- 0CA LDA CLC 0C8 ADC 0FF0D STA 0C9 LDA 0 # ADC 0B # SBC 0FF0C STA NEXT JMP END-CODE ÃODE CUROFF \ -- 0FF # LDA FF0C STA 0FF0D STA ÎEXT JMP END-CODE ) (Ã16 \\ ) ÃODE CURON ( --) 0Ä3 LDY 0Ä1 )Ù LDA 0ÃÅ STA 0Ãà STX XYÎEXT JMP END-CODE ÃODE CUROFF ( --) INY 0Ãà STY 0ÃÄ STY 0ÃÆ STX 0ÃÅ LDA 0Ä3 LDY 0Ä1 )Ù STA 1 # LDY ÎEXT JMP END-CODE ( #BS #CR ..KEYBOARD CLV12.4.87) : C64KEY ( -- 8B) CURON ÂÅÇÉÎ PAUSE C64KEY? ÕÎÔÉÌ CUROFF GETKEY ; 14 ÃONSTANT #BS 0Ä ÃONSTANT #CR : C64DECODE ( ADDR CNT1 KEY -- ADDR CNT2) #BS CASE? ÉÆ DUP ÉÆ DEL 1- ÔÈÅÎ EXIT ÔÈÅÎ #CR CASE? ÉÆ DUP SPAN ! EXIT ÔÈÅÎ >R 2DUP + R@ SWAP C! R> EMIT 1+ ; : C64EXPECT ( ADDR LEN1 -- ) SPAN ! 0 ÂÅÇÉÎ DUP SPAN @ U< ×ÈÉÌÅ KEY DECODE ÒÅÐÅÁÔ 2DROP SPACE ; ÉNPUT: KEYBOARD [ HERE INPUT ! ] C64KEY C64KEY? C64DECODE C64EXPECT ; ( CON! PRINTABLE? CLV11.4.87) ÃODE CON! ( 8B --) ÓÐ Ø) LDA ÌABEL (CON! ÃONÏUT JSR ÓÐ 2INC ÌABEL (CON!END ÃURÆLG STX ÉNSÃNT STX 1 # LDY ;C: PAUSE ; ÌABEL (PRINTABLE? \ FOR ÃÂÍ-ÃODE ! \ ÃÓ IS PRINTABLE 80 # CMP Ãà ?[ BL # CMP RTS ]? 0Å0 # CMP Ãà ?[ 0Ã0 # CMP RTS ]? CLC RTS END-CODE ÃODE PRINTABLE? ( 8B -- 8B FLAG) ÓÐ Ø) LDA (PRINTABLE? JSR ÃÓ ?[ DEX ]? TXA ÐUSHÁ JMP END-CODE ( EMIT CR DEL PAGE AT AT? CLV11.4.87) ÃODE C64EMIT ( 8B -- ) ÓÐ Ø) LDA (PRINTABLE? JSR Ãà ?[ ÁSCII . # LDA ]? (CON! JMP END-CODE : C64CR #CR CON! ; : C64DEL 9Ä CON! SPACE 9Ä CON! ; : C64PAGE 93 CON! ; ÃODE C64AT ( ROW COL --) 2 # LDA ÓETUP JSR Î 2+ LDX Î LDY CLC ÐÌÏÔ JSR (Ã16 \ ) 0Ä3 LDY 0Ä1 )Ù LDA 0ÃÅ STA XYÎEXT JMP END-CODE ÃODE C64AT? ( -- ROW COL) ÓÐ 2DEC TXA ÓÐ )Ù STA SEC ÐÌÏÔ JSR 28 # CPY TYA ÃÓ ?[ 28 # SBC ]? PHA TXA 0 # LDX ÓÐ Ø) STA PLA ÐUSH0Á JMP END-CODE ( TYPE DISPLAY (BYE CLV11.4.87) ÃODE C64TYPE ( ADR LEN -- ) 2 # LDA ÓETUP JSR 0 # LDY [[ Î CPY 0<> ?[[ Î 2+ )Ù LDA (PRINTABLE? JSR Ãà ?[ ÁSCII . # LDA ]? ÃONÏUT JSR INY ]]? (CON!END JMP END-CODE ÏUTPUT: DISPLAY [ HERE OUTPUT ! ] C64EMIT C64CR C64TYPE C64DEL C64PAGE C64AT C64AT? ; (Ã64 Ü ÃREATE (BYE $ÆÃÅ2 HERE 2- ! ) (Ã16- Ü ÃREATE (BYE $ÆÆ52 HERE 2- ! ) (Ã16+ Ü ÃÏÄÅ (BYE ROM $ÆÆ52 JMP END-CODE ) \ B/BLK DRIVE >DRIVE DRVINIT CLV14:2X87 400 ÃONSTANT B/BLK 0ÁÁ ÃONSTANT BLK/DRV ÖARIABLE (DRV 0 (DRV ! Ü : DISK ( -- DEV.NO ) (DRV @ 8 + ; : DRIVE ( DRV# -- ) BLK/DRV * OFFSET ! ; : >DRIVE ( BLOCK DRV# -- BLOCK' ) BLK/DRV * + OFFSET @ - ; : DRV? ( BLOCK -- DRV# ) OFFSET @ + BLK/DRV / ; : DRVINIT NOOP ; ( I/O BUSOFF 10MAY85WE) ÖARIABLE I/O 0 I/O ! \ ÓEMAPHORE ÃODE BUSOFF ( --) ÃÌÒÃÈÎ JSR ÌABEL UNLOCKI/O 1 # LDY 0 # LDX ;C: I/O UNLOCK ; ÌABEL NODEVICE 0 # LDX 1 # LDY ;C: BUSOFF BUFFERS UNLOCK TRUE ÁBORT" NO DEVICE" ; \ ?DEVICE CLV12JUL87 ÌABEL (?DEV 90 STX (Ã16 $AE STA ( ) ÌÉÓÔÅÎ JSR \ BECAUSE OF ERROR IN ÏÓ 60 # LDA ÓÅÃÏÎÄ JSR ÕÎÌÓÎ JSR 90 LDA 0<> ?[ PLA PLA NODEVICE JMP ]? RTS END-CODE ÃODE (?DEVICE ( DEV --) ÓÐ Ø) LDA (?DEV JSR ÓÐ 2INC UNLOCKI/O JMP END-CODE : ?DEVICE ( DEV -- ) I/O LOCK (?DEVICE ; ÃODE (BUSOUT ( DEV 2ND -- ) ÍSGÆLG STX 2 # LDA ÓETUP JSR Î 2+ LDA (?DEV JSR Î 2+ LDA ÌÉÓÔÅÎ JSR Î LDA 60 # ORA ÓÅÃÏÎÄ JSR Î 2+ LDX ÏUTÄEV STX XYÎEXT JMP END-CODE \ BUSOUT/OPEN/CLOSE/IN CLV12JUL87 : BUSOUT ( DEV 2ND -- ) I/O LOCK (BUSOUT ; : BUSOPEN ( DEV 2ND -- ) 0Æ0 OR BUSOUT ; : BUSCLOSE ( DEV 2ND -- ) 0Å0 OR BUSOUT BUSOFF ; ÃODE (BUSIN ( DEV 2ND -- ) ÍSGÆLG STX 2 # LDA ÓETUP JSR Î 2+ LDA (?DEV JSR Î 2+ LDA ÔÁÌË JSR Î LDA 60 # ORA (Ã16 $AD STA ( ) ÔËÓÁ JSR \ BECAUSE OF ERROR IN OLD Ã16 ÏÓ Î 2+ LDX ÉNÄEV STX XYÎEXT JMP END-CODE : BUSIN ( DEV 2ND -- ) I/O LOCK (BUSIN ; ( BUS-!/TYPE/@/INPUT DERROR? 24FEB85RE) ÃODE BUS! ( 8B --) ÓÐ Ø) LDA ÃÉÏÕÔ JSR (XYDROP JMP END-CODE : BUSTYPE ( ADR N --) BOUNDS ?ÄÏ É C@ BUS! ÌÏÏÐ PAUSE ; ÃODE BUS@ ( -- 8B) ÁÃÐÔÒ JSR ÐUSH0Á JMP END-CODE : BUSINPUT ( ADR N --) BOUNDS ?ÄÏ BUS@ É C! ÌÏÏÐ PAUSE ; : DERROR? ( -- FLAG ) DISK $Æ BUSIN BUS@ DUP ÁSCII 0 - ÉÆ ÂÅÇÉÎ EMIT BUS@ DUP #CR = ÕÎÔÉÌ 0= CR ÔÈÅÎ 0= BUSOFF ; ( S#>S+T X,X 28MAY85RE) 165 Ü ÃONSTANT 1.T 1ÅÁ Ü ÃONSTANT 2.T 256 Ü ÃONSTANT 3.T Ü : (S#>S+T ( SECTOR# -- SECT TRACK) DUP 1.T U< ÉÆ 15 /MOD EXIT ÔÈÅÎ 3 + DUP 2.T U< ÉÆ 1.T - 13 /MOD 11 + EXIT ÔÈÅÎ DUP 3.T U< ÉÆ 2.T - 12 /MOD 18 + EXIT ÔÈÅÎ 3.T - 11 /MOD 1Å + ; Ü : S#>T+S ( SECTOR# -- TRACK SECT ) (S#>S+T 1+ SWAP ; Ü : X,X ( SECT TRACK -- ADR COUNT) BASE PUSH DECIMAL 0 <# #S DROP ÁSCII , HOLD #S #> ; ( READSECTOR WRITESECTOR 28MAY85RE) 100 Ü ÃONSTANT B/SEK : READSECTOR ( ADR TRA# SECT# -- FLAG) DISK 0Æ BUSOUT " U1:13,0," COUNT BUSTYPE X,X BUSTYPE BUSOFF PAUSE DERROR? ?EXIT DISK 0Ä BUSIN B/SEK BUSINPUT BUSOFF FALSE ; : WRITESECTOR ( ADR TRA# SECT# -- FLAG) ROT DISK 0Æ BUSOUT " B-P:13,0" COUNT BUSTYPE BUSOFF DISK 0Ä BUSOUT B/SEK BUSTYPE BUSOFF DISK 0Æ BUSOUT " U2:13,0," COUNT BUSTYPE X,X BUSTYPE BUSOFF PAUSE DERROR? ; ( 1541R/W 28MAY85RE) : DISKOPEN ( -- FLAG) DISK 0Ä BUSOPEN ÁSCII # BUS! BUSOFF DERROR? ; : DISKCLOSE ( -- ) DISK 0Ä BUSCLOSE BUSOFF ; : 1541R/W ( ADR BLK FILE R/WF -- FLAG) SWAP ÁBORT" NO FILE" -ROT BLK/DRV /MOD DUP (DRV ! 3 U> ÉÆ . ." BEYOND CAPACITY" NIP EXIT ÔÈÅÎ DISKOPEN ÉÆ DROP NIP EXIT ÔÈÅÎ 0 SWAP 2* 2* 4 BOUNDS ÄÏ DROP 2DUP É ROT ÉÆ S#>T+S READSECTOR ÅÌÓÅ S#>T+S WRITESECTOR ÔÈÅÎ >R B/SEK + R> DUP ÉÆ ÌÅÁÖÅ ÔÈÅÎ ÌÏÏÐ -ROT 2DROP DISKCLOSE ; ' 1541R/W ÉS R/W \ INDEX FINDEX INK-POT 05NOV87RE : INDEX ( FROM TO --) 1+ SWAP ÄÏ CR É 2 .R É BLOCK 1+ 25 TYPE STOP? ÉÆ ÌÅÁÖÅ ÔÈÅÎ ÌÏÏÐ ; : FINDEX ( FROM TO --) DISKOPEN ÉÆ 2DROP EXIT ÔÈÅÎ 1+ SWAP ÄÏ CR É 2 .R PAD DUP É 2* 2* S#>T+S READSECTOR >R 1+ 25 TYPE R> STOP? OR ÉÆ ÌÅÁÖÅ ÔÈÅÎ ÌÏÏÐ DISKCLOSE ; ÃREATE INK-POT \ BORDER BKGND PEN 0 (Ã64 6 C, 6 C, 3 C, 0 C, \ ÆORTH 0Å C, 6 C, 3 C, 0 C, \ ÅDI 6 C, 6 C, 3 C, 0 C, ) \ ÕSER (Ã16 F6 C, 0F6 C, 03 C, 0 C, \ ÆORTH 0EÅ C, 0F6 C, 03 C, 0 C, \ ÅDI 0F6 C, 0F6 C, 03 C, 0 C, ) \ ÕSER \ RESTORE 05NOV87RE (Ã16 \\ ) ÌABEL ASAVE 0 C, ÌABEL 1SAVE 0 C, ÌABEL CONTINUE PHA 1SAVE LDA 1 STA PLA RTI ÌABEL RESTORE SEI ASAVE STA CONTINUE $100 /MOD # LDA PHA # LDA PHA PHP \ FOR ÒÔÉ ASAVE LDA PHA TXA PHA TYA PHA 1 LDA 1SAVE STA $36 # LDA 1 STA \ ÂASIC OFF ÒÏÍ ON $7Æ # LDA $ÄÄ0Ä STA $ÄÄ0Ä LDY 0< ?[ ÌABEL 6526-ÎÍÉ $ÆÅ72 JMP ]? ÕÄÔÉÍ JSR ÓÔÏÐ JSR \ ÒÕÎ/ÓÔÏÐ ? 6526-ÎÍÉ BNE \ NOT >>--> ' RESTART @ JMP END-CODE \ Ã64:ÉNIT 06NOV87RE (Ã16 \\ ) : INIT-SYSTEM $ÆÆ40 DUP $Ã0 CMOVE [ RESTORE ] ÌITERAL DUP $ÆÆÆÁ ! $318 ! ; \ ÎÍÉ-ÖECTOR TO ÒÁÍ ÌABEL FIRST-INIT SEI CLD ÉÏÉÎÉÔ JSR ÃÉÎÔ JSR ÒÅÓÔÏÒ JSR \ INIT. AND SET É/Ï-ÖECTORS $36 # LDA 01 STA \ ÂASIC OFF INK-POT LDA ÂRDÃOL STA \ BORDER INK-POT 1+ LDA ÂKGÃOL STA \ BACKGRND INK-POT 2+ LDA ÐENÃOL STA \ PEN $80 # LDA ËEYÒEP STA \ REPEAT ALL KEYS $17 # LDA $Ä018 STA \ LOW/UPP + 0 # LDA $Ä01Á STA \ ÖÉÃ-ÉÒÑ OFF $1 # LDA $Ä011 STA \ ÔEXTMODE ON 4 # LDA $288 STA \ LOW SCREEN CLI RTS END-CODE FIRST-INIT DUP BOOTSYSTEM 1+ ! WARMBOOT 1+ ! ÃODE C64INIT FIRST-INIT JSR XYÎEXT JMP END-CODE \ Ã16:ÉNIT 01OCT87CLV/RE) (Ã64 \\ ) ÃODE INIT-SYSTEM $Æ7 # LDX TXS XYÎEXT JMP END-CODE $FCB3 >LABEL ÉÒÑ \ NORMAL ÉÒÑ $FFFE >LABEL >ÉÒÑ \ 6502-ÐTR TO ÉÒÑ \ SELFMODIFYING CODE: ÌABEL ÒÁÍÉÒÑ \ THE NEW ÉÒÑ ROM ÒÁÍÉÒÑ $15 + STA ÒÁÍÉÒÑ $17 + STX ( +9) ÒÁÍÉÒÑ $1B + $100 U/MOD # LDA PHA # LDA PHA ( +F) TSX $103 ,X LDA PHA \ FLAGS ( +14) 0 # LDA 0 # LDX ÉÒÑ JMP ( +1B) RAM RTI END-CODE \ Ã16:..ÉNIT 01OCT87CLV/RE) (Ã64 \\ ) ÌABEL FIRST-INIT \ WILL BE CALLED IN ÒÏÍ FIRST TIME \ LATER CALLED FROM ÒÁÍ SEI ROM ÒÁÍÉÒÑ $100 U/MOD \ NEW ÉÒÑ # LDA >ÉÒÑ 1+ STA \ .. INSTALL # LDA >ÉÒÑ STA $ÆÆ84 NORMÊSR $ÆÆ8Á NORMÊSR \ ÃÉÁS INIT. AND SET É/Ï-ÖECTORS INK-POT LDA ÂRDÃOL STA \ BORDER INK-POT 1+ LDA ÂKGÃOL STA \ BACKGRND INK-POT 2+ LDA ÐENÃOL STA \ PEN $80 # LDA ËEYÒEP STA \ REPEAT ALL KEYS $ÆÆ13 LDA 04 # ORA $ÆÆ13 STA \ LOW/UPP RAM CLI RTS END-CODE FIRST-INIT DUP BOOTSYSTEM 1+ ! WARMBOOT 1+ ! ÃODE C64INIT FIRST-INIT JSR XYÎEXT JMP END-CODE \ Ã16-ÐUSHKEYS Ã64-LIKE 01OCT87CLV/RE) (Ã16 ÌABEL ÉNITÐËS \ ÐUSHKEYS: ÄATEN 00 C, 00 C, \ CURR. NUMB ÃHAR, CURRÐTR 01 C, 01 C, 01 C, 01 C, \ ÓTRÌENGTH 01 C, 01 C, 01 C, 01 C, \ " 85 C, 86 C, 87 C, 89 C, \ ÃONTENT 8A C, 8B C, 8C C, 88 C, \ " HERE ÉNITÐËS - >LABEL ÉNITÐËLEN ÃODE Ã64FKEYS \ ÐUSHKEYS A LA Ã64 ÉNITÐËLEN # LDX [[ DEX 0>= ?[[ ÉNITÐËS ,Ø LDA ÐËEYS ,X STA ]]? XYÎEXT JMP END-CODE ) ( RESTART PARAM.-PASSING CLV12.4.87) ÃODE RESTART HERE >RESTART ! ' (RESTART >BODY 100 U/MOD # LDA PHA # LDA PHA WARMBOOT JMP END-CODE \ ÃODE FOR PARAMETER-PASSING TO ÆORTH 03 18 +THRU \ ÃÂÍ-ÉNTERFACE (C16+ 19 1A +THRU ) \ C16INIT ÒAMÉÒÑ ÈOST ' ÔRANSIENT 8 + @ ÔRANSIENT ÆORTH ÃONTEXT @ 6 + ! ÔARGET \ KOTZ WUERG ! ÆORTH ALSO DEFINITIONS : ) ; IMMEDIATE (Ã64 : (Ã64 ; IMMEDIATE ) (Ã16 : (Ã16 ; IMMEDIATE ) (Ã64 \ ) : (Ã64 [COMPILE] ( ; IMMEDIATE (Ã16 \ ) : (Ã16 [COMPILE] ( ; IMMEDIATE : FORTH-83 ; \ LAST WORD IN ÄICTIONARY |