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ÆÏÒÔÈ 4OF4 26OCT87RE . 0 .. 0 Ã16-ÔAPE-ÄEMO 2 Ã64-ÇRAFIC-ÄEMO 6 CLOAD/CSAVE &13 ÔAPE-ÖERSION:ÌOADÓCREEN &16 ÒAMDISK &21 ÓUPERTAPE &32 AUTO-ÄECOMPILER &51 ÓCREENSWITCH &61 ÇRAFIC &64 ÍATH &90 ÓIEVE ÂENCHMARK &138 ÇRAFIC-ÄEMO &144 ÓPRITE-ÄEMO &160 ÓPRITE-ÄATA &165 ÓPRITE-ÅDITOR &166 \\ ÃONTENT VOLKSÆÏÒÔÈ 4OF4 26OCT87RE ÄIRECTORY 0 ÃONTENT 1 Ã16-ÔAPE -ÄEMO &2- &5 Ã64-ÇRAFIC-ÄEMO &6- &12 CLOAD CSAVE &13- &15 ÔAPE-ÖERSION:ÌOADÓCREEN &16- &20 ÒAMDISK &21- &30 &31 FREE ÓUPERTAPE &32- &50 AUTOMATIC ÄECOMPILER &51- &60 ÓCREENS VIA ÕSERÐORT Ã64 &61- &63 ÇRAFIC Ã64 ONLY!! &64- &88 &89 FREE ÍATH &90- &96 &97-&100 FREE ÔAPE ÒAMDISK ÓUPERTAPE &101-&135 SHADOW ÓIEVE ÂENCHMARK &138 ÇRAFIC-ÄEMO Ã64 ONLY!! &144-&155 ÓPRITE-ÄEMO Ã64 ONLY!! &160-&164 ÓPRITE-ÄATA &165 ÓPRITE ÅDITOR &166-&168 \ ÄEMOÌ:Ã16ÔAPE-ÄEMO ?DLOAD CLV10OCT87 \ ÄEMO: 80 ÓCREENS IN TOTAL !!! \ CHECKS IF A WORD IS DEFINED: Ü : EXISTS? ( STRING--FLAG) CR CAPITALIZE DUP FIND NIP UNDER 0= ÉÆ ." NOT " ÔÈÅÎ ." FOUND: " COUNT TYPE ; \ LAST ACCESSED DISKF: Ü ÖARIABLE ÌASTÄISK -1 ÌASTÄISK ! \ LOAD ÓÃÒ FROM ÄÉÓË, IF ×ÏÒÄ NAMED \ ÓÔÒÉÎÇ IS NOT IN ÆORTH ÄICTIONARY Ü : ?DLOAD ( STRING SCR DISK--) 2 PICK EXISTS? ÉÆ DROP DROP DROP EXIT ÔÈÅÎ DUP ÌASTÄISK @ - ÉÆ FLUSH ." ÉNSERT #" DUP . KEY DROP DUP ÌASTÄISK ! ÔÈÅÎ DROP ." SCR#" DUP . CR LOAD EXISTS? 0= ERROR" ???" ; --> \ ÄEMOÌ:?RELOC CLV10OCT87 \ RELOCATES SYSTEM CALL ÃÏÌÄ IF NECCES. Ü : ?RELOC ( S0 R0 LIMIT --) DUP LIMIT = 2 PICK ORIGIN $A + @ = AND 3 PICK ORIGIN 8 + @ = AND ÉÆ DROP DROP DROP EXIT ÔÈÅÎ ['] LIMIT >BODY ! \ LIMIT ORIGIN $Á + ! \ R0 DUP 6 + ORIGIN 1+ ! \ TASK ORIGIN 8 + ! \ S0 COLD ; \ COMPILES FORWARD REFERENCES THAT WILL \ BE LOADED LATER Ü : (FORWARD" "LIT CAPITALIZE FIND ÉÆ EXECUTE ÅÌÓÅ COUNT TYPE ." UNSATISFIED" QUIT ÔÈÅÎ ; RESTRICT Ü : FORWARD" COMPILE (FORWARD" ," ; IMMEDIATE RESTRICT --> \ ÄEMOÌ:64KB Ã16ÄEMO CLV10OCT87 \ CONFIGURES SYSTEM FOR 64Ë IF POSSIBLE : 64KB $533 @ $FD00 - ?DUP ÉÆ CR U. ." TOO SMALL" EXIT ÔÈÅÎ LIMIT $FD00 - ÉÆ $8000 $8400 $FD00 ?RELOC ÔÈÅÎ ; \ WILL BE INSTALLED AS 'ÒÅÓÔÁÒÔ: : C16DEMO CR ." C16-ÄEMO" FORWARD" TAPEINIT" 0 DRIVE FORWARD" FLOPPY" CR ." ÔYPE 'HELP' TO GET HELP" CR ." ÔYPE '64KB' TO USE 64KB" ; --> \ ÄEMOÌ:Ã16ÄEMOÌOAD CCLV14OCT87 \ ÔHIS WORD LOAD THE COMPLETE \ ÄEMO-ÖERSION. ×ILL BE INSTALLED AS \ 'ÃÏÌÄ AND LATER AS Ã16ÄÅÍÏ Ü : C16ÄEMOÌOAD $9000 $9400 $C000 ?RELOC ÆORTH " ÃODE" 5 3 ?DLOAD ÆORTH " ÅDITOR" $13 3 ?DLOAD ÆORTH " DEBUG" $2F 3 ?DLOAD ÆORTH " HELP" $A 1 ?DLOAD ÆORTH " ÔAPEINIT" $10 4 ?DLOAD ['] NOOP ÉS 'COLD ['] C16DEMO ÉS 'RESTART FORWARD" ÅDITOR" FORWARD" ÅDIBOARD" 1 SCR ! 0 R# ! SAVE $7A00 $7BF0 $8000 ?RELOC ; ' C16ÄEMOÌOAD ÉS 'COLD SAVE CR .( ÔYPE : COLD) CR .( AFTER ALL: SAVESYSTEM!!!) \ ÇRAPHIC-ÄEMO FOR Ã64 23OCT87RE (16 .( ÎOT FOR Ã16!) \\ Ã) ÏNLYFORTH \NEEDS BUFFERS .( ÂUFFERS?!) \\ \NEEDS DEMOSTART .( ÄEMOSTART?!) \\ \NEEDS TASKS .( ÔASKER??!) \\ \NEEDS HELP .( HELP??!) \\ \NEEDS GRAPHIC &58 +LOAD \NEEDS .MESSAGE2 1 2 +THRU ÇRAPHIC ALSO \NEEDS MOIRE 6 +LOAD \NEEDS SLIDE &154 +LOAD \ THE ÄEMO 3 5 +THRU 1 ÓCR ! 0 Ò# ! SAVE \ DEMO-VERSION 06NOV87RE Ü : (CENTER." "LIT COUNT Ã/Ì OVER - 2/ SPACES TYPE CR ; RESTRICT Ü : C." COMPILE (CENTER." ," ; IMMEDIATE RESTRICT Ü : .ÆÇES C." ÆORTH ÇESELLSCHAFT E.Ö." ; Ü : .VÆ83 C." *** VOLKSÆÏÒÔÈ-83 ***" ; Ü : .(C) C." (C) 1985-2006" C." ÂERND ÐENNEMANN ËLAUS ÓCHLEISIEK" C." ÇEORG ÒEHFELD ÄIETRICH ×EINECK" C." ÃLAUS ÖOGT ÅWALD ÒIEGER " C." ÃARSTEN ÓTROTMANN " ; Ü : .SOURCE C." WWW.FORTH-EV.DE" CR C." VOLKSFORTH.SF.NET" ; Ü : WAIT ÂÅÇÉÎ KEY 3 - ÕÎÔÉÌ ; \ DEMO-VERSION 20OCT87RE : .MESSAGE1 ( -- ) SINGLETASK PAGE .VÆ83 CR .(C) CR C." VOLKSÆORTH IS FREE SOFTWARE" C." SEE FILE ÃÏÐÙÉÎÇ IN THE" C." DISTRIBUTION PACKAGE" MULTITASK WAIT ; : .MESSAGE2 ( -- ) PAGE C." ÙOU NOW HAVE CREATED A" C." WORKSYSTEM WITH ÅDITOR," C." ÄEBUGGER AND ÁSSEMBLER!" C." ÐLEASE INSERT AN EMPTY, FORMATTED" C." ÄISK AND SAVE THE NEW SYSTEM WITH" C." ÓÁÖÅÓÙÓÔÅÍ <NAME> (EG. ÆÏÒÔÈ)" C." AS A LOADABLE PROGRAM FILE" CR .VÆ83 CR C." ÉNFORMATION ON VOLKSÆORTH FROM" .ÆÇES C." ON:" CR .SOURCE WAIT ; \ DEMO-VERSION 20OCT87RE GRAPHIC ALSO Ü ÖARIABLE END? : KILLDEMO ( -) KILLSPRITES ENDSLIDE SINGLETASK .MESSAGE2 ['] 1541R/W ÉS R/W ['] NOOP ÉS 'COLD ['] NOOP ÉS 'RESTART ['] (QUIT ÉS 'QUIT NOGRAPHIC [ ' DEMOSTART >NAME 4 - ] ÌITERAL (FORGET SAVE &16 BUFFERS ; \ DEMO-VERSION 06NOV87RE Ü : DEMOR/W ( ADR BLK R/WF - F) END? @ 0 MAX DUP SMALL RED COLORED -1 END? +! SPRITE PUSH KILLSPRITES 1541R/W ; Ü : DEMOQUIT ÂÅÇÉÎ .STATUS CR QUERY INTERPRET STATE @ ÉÆ ." COMPILING" ÅÌÓÅ ." VÆ83" ÔÈÅÎ END? @ 0< DUP ÉÆ DROP CR ." ËILL THE ÄEMO? N/Y " KEY CAPITAL ÁSCII Ù = DUP NOT ÉÆ DEL DEL DEL ÔÈÅÎ ÔÈÅÎ ÕÎÔÉÌ KILLDEMO ; \ DEMO-VERSION 20OCT87RE : DEMONSTRATION ÏNLYFORTH GRAPHIC ['] DEMOR/W ÉS R/W ['] KILLDEMO ÉS 'COLD SLIDE MULTITASK PAUSE 4 END? ! ['] DEMOQUIT ÉS 'QUIT ['] (ERROR ERRORHANDLER ! ['] NOOP ÉS 'ABORT .MESSAGE1 LINIEN TEXT KEY DROP MOIRE TEXT KEY DROP ." HELP" ROW 1- 0 AT ABORT ; ' DEMONSTRATION ÉS 'COLD ' KILLDEMO ÉS 'RESTART \ HIRES DEMO WORDS 06NOV87RE : LINIEN CLRSCREEN YEL BLU COLORS HIRES &320 0 ÄÏ &320 0 ÄÏ É &198 Ê 0 LINE &35 +ÌÏÏÐ &35 +ÌÏÏÐ ; : MOIRE CLRSCREEN ORA RED COLORS HIRES &320 0 ÄÏ É &198 &319 É - 0 LINE 3 +ÌÏÏÐ &199 0 ÄÏ &319 &198 É - 0 É LINE 2 +ÌÏÏÐ ; \ CÓAVE CÌOAD.. CLV10OCT87 ÏNLYFORTH \NEEDS ÃODE .( NEED ÁSSEMBLER!) QUIT $FF90 >LABEL SETÍSG $90 >LABEL STATUS $FFBA >LABEL SETLFS $FFBD >LABEL SETÎAM $ÆÆÄ8 >LABEL ÂÓÁÖÅ $ÆÆÄ5 >LABEL ÂÌÏÁÄ ÌABEL SLÐARS SETUP JSR (16 ROM Ã) $80 # LDA SETÍSG JSR 0 # LDA STATUS STA Î LDA SEC 8 # SBC (DRV STA Ãà ?[ DEX ]? (DRV 1+ STX Î LDX Î 1+ LDY 1 # LDA SETLFS JSR Î 4 + LDX Î 5 + LDY Î 2+ LDA SETNAM JSR Î 6 + LDX Î 7 + LDY RTS END-CODE ÌABEL SLÅRR \ ÁÒ=ËERNALERROR Ãà ?[ 0 # LDA ]? PHA STATUS LDA $BF # AND (16 RAM Ã) PUSH JMP END-CODE --> ÆÏÒÔÈ-ÇÅÓÅÌÌÓÃÈÁÆÔ (C) BP/KS/RE/WE/CLV \ ..CÓAVE CÌOAD CLV10OCT87 ÃODE CÓAVE ( F T+1 ÎAME ÎLEN DEV--ERR) 5 # LDA ÓÌÐARS JSR Î 8 + # LDA BSAVE JSR SLÅRR JMP END-CODE ÃODE CÌOAD ( F ÎAME ÎLEN DEV--T+1 ERR) 4 # LDA ÓÌÐARS JSR 0 # LDA BLOAD JSR PHP PHA TYA PHA TXA PHA 0 # LDY ÓÐ 2DEC PLA ÓÐ )Y STA INY PLA ÓÐ )Ù STA PLA PLP SLÅRR JMP END-CODE --> \\ POSSIBLE ERRORS ÁÒ ÃÆ ÓÔ ÂASIC ÆORTH XX Ì 00 NO ERROR 0 0 00 È 00 STOP-KEY 1E 1E 00 Ì 60 END-OF-TAPE 04 00 00 Ì 10 LOAD/VERIFY-ERROR 1D/1C 1D 00 Ì 60 ÃHECKSUMERROR 1D 1D 0-8 È 00 ËERNAL-ÅRROR 0-8 0-8 ÆÏÒÔÈ-ÇÅÓÅÌÌÓÃÈÁÆÔ (C) BP/KS/RE/WE/CLV \ ..CÓAVE CÌOAD ÌUXUS CLV10OCT87 ÃODE .ERR ( ERR#-ERR# ) \ PRINTS MESSAGE ÓÐ X) LDA 0>= ?[ (16 TAX DEX ROM $8654 JSR Ã) (64 .Á ASL TAX ROM $A326 ,X LDA $24 STA $A327 ,X LDA $25 STA DEY Ã) DEY [[ INY $24 )Y LDA PHP $7F # AND $FFD2 JSR PLP 0< ?] (16 RAM Ã) (64 RAM Ã) ]? XYÎEXT JMP END-CODE : DERR? ( ERR# -- FLAG) DUP ÉÆ CR DUP U. .ERR ." ERROR" ÔÈÅÎ DUP $FF AND 5 = NOT (DRV @ -1 > AND ÉÆ DERROR? OR ÔÈÅÎ (DRV @ 0 MAX (DRV ! ; \\ FOR USAGE AFTER ÃÓÁÖÅ AND ÃÌÏÁÄ. ÔHE LAST LINE IS ONLY FOR ÃOMPATIBILITY WITH OLD VERSION. \ ÔAPEÖERSION:ÌOADÓCREEN CLV12OCT87 ÏNLYFORTH \NEEDS ÃODE .( ?! ÃODE !?) QUIT 5 +LOAD \ ÒAMDISK -3 +LOAD \ CSAVE/LOAD 1 3 +THRU \ ÔAPE (16 $10 +LOAD Ã) \ SUPERÔAPE 4 +LOAD \ SAVESYS ÏNLYFORTH ÖARIABLE AUTOLOAD AUTOLOAD OFF : TAPEÉNIT CR CR ." ÔAPE2.00 " \IF SUPERTAPE SUPERTAPE ['] RAMR/W ÉS R/W 1 DRIVE AUTOLOAD @ ÉÆ AUTOLOAD OFF LOADRAMDISK ÔÈÅÎ ; SAVE ' TAPEÉNIT ÉS 'RESTART \ RESTART \ STORE RESTORE CLV24JUL87 \ WIE PUSH PULL ABORT" Ü ÃREATE RESTORE 0 ] R> R> ! ; : STORE ( ADDR -- ) R> SWAP DUP >R @ >R RESTORE >R >R ; RESTRICT \ RSTACK: RESTORE DATE ADDRESS .... Ü : BACK \ -- \ REWINDS RSTACK R> ÂÅÇÉÎ RDEPTH ×ÈÉÌÅ R> RESTORE = ÉÆ R> R> ! ÔÈÅÎ ÒÅÐÅÁÔ >R ; : (RESTORE" "LIT SWAP ÉÆ >R CLEARSTACK R> BACK ERRORHANDLER PERFORM EXIT ÔÈÅÎ DROP ; RESTRICT : RESTORE" COMPILE (RESTORE" ," ; IMMEDIATE RESTRICT \ TAPE-INTERFACE CLV01AUG87 \NEEDS CLOAD .( ?! CLOAD ?!) QUIT \NEEDS RESTORE .( ?! RESTORE ?!) QUIT ÖARIABLE DEVICE 0 DEVICE ! : COMMODORE 1 DEVICE ! ; \ DEVICE.. : FLOPPY 8 DEVICE ! ; : BLOAD ( [FROM NAME COUNT -- ]TO) DEVICE @ CLOAD DERR? RESTORE" LOAD" ; : BSAVE ( [FROM ]TO NAME COUNT--) DEVICE @ CSAVE DERR? RESTORE" SAVE" ; : N" ( -- ADR COUNT) ÁSCII " PARSE ; \ ÒAMDISK ÔAPEÉNTERFACE CLV29JUL87 ÏNLYFORTH ÒAMDISK ALSO : SAVEÒAMÄISK RD BEHIND ID COUNT BSAVE ; : LOADÒAMÄISK RD? 0= ÉÆ RANGE MEMTOP RDNEW RD ÔÈÅÎ " ÒÄ." COUNT BLOAD DROP ; \ \IF SAVESYSTEM" CLV01AUG87 \NEEDS RESTORE" .( ?! RESTORE" ?!) QUIT ÏNLYFORTH : \IF NAME FIND 0= ÉÆ [COMPILE] \ ÔÈÅÎ DROP ; IMMEDIATE : SAVESYSTEM \ -- NAME MUST FOLLOW \ ÆORTH-ËERNAL A LA BOOT: SCR STORE 1 SCR ! R# STORE 0 R# ! \ ÅDITOR A LA BOOT \IF ÅDITOR [ ÅDITOR ] \IF ÅDITOR STAMP$ STORE STAMP$ OFF \IF ÅDITOR (PAD STORE (PAD OFF SAVE \ ÓUPERTAPE? IF THEN OTHER ROUTINE \IF SUPERTAPE DEVICE @ 7 = \IF SUPERTAPE ÉÆ STÓAVÓYS EXIT ÔÈÅÎ \ NOW WE SAVE ORIGIN $17 - HERE N" BSAVE ; \ ÒÄ: LOADSCREEN CLV01AUG87 ÏNLYFORTH (16 $FD00 Ã) (64 $C000 Ã) ÃONSTANT MEMTOP ÖOCABULARY ÒAMDISK ÒAMDISK ALSO DEFINITIONS 1 9 +THRU ÏNLYFORTH \ ÒÄ: BASICS CLV01AUG87 ÖARIABLE (RD (RD OFF $31 CONSTANT PLEN : ADR> ( ADR--OFS) (RD @ - ; : >ADR ( OFS--ADR) (RD @ + ; : ADR@ ( OFS--ADR) >ADR @ >ADR ; : RD? ( -- ADR FLAG ) (RD @ DUP DUP @ PLEN = AND ; : RD ( -- ADR) RD? 0= ABORT" NO ÒAMDISK" ; Ü : TAKE ( ADR-- ) ADR> 2 >ADR ! ; : ADR ( --ADR ) 2 ADR@ ; : DATA ( --ADR ) ADR 4 + ; Ü : END ( --ADR ) 4 ADR@ ; : BEHIND ( --ADR ) END 4 + ; Ü : END+ ( LEN-- ) 4 >ADR +! ; : BLK# ( --ADR ) 8 >ADR ; : ID ( --ADR ) $10 >ADR ; \ ÒÄ: NEW DELETE LEN@ LEN! CLV01AUG87 Ü : ?FULL END 6 ADR@ B/BLK - 4 - U> ABORT" ÒAMDISK FULL" ; Ü : NEW ( --) END TAKE ?FULL ; Ü : LEN! ( LEN--) \ END NEW BLOCK ?DUP 0= ?EXIT BLK# @ END 2+ ! 4 + DUP END ! END+ END OFF ; Ü : LEN@ ( --LEN) \ GEN LENGTH ADR @ DUP 0= ?EXIT 4 - ; : DELETE ( --) ADR DUP @ UNDER + ADR BEHIND OVER - CMOVE NEGATE END+ ; \ ÒÄ: SEARCH BINARY CLV01AUG87 : SEARCH ( BLK --) \ SET CURRENT ÂLOCK RD ÂÅÇÉÎ DUP @ + DUP @ ×ÈÉÌÅ ( BLK ADR ) 2DUP 2+ @ = ÕÎÔÉÌ TAKE BLK# ! ; Ü : NOTÒÄ? ( BLK--FLAG) BLK/DRV U< ; ÏNLYFORTH ÒAMDISK ALSO : BINARY ( BLK--BLK) \ NO ÃOMÐAND DUP OFFSET @ + NOTÒÄ? ?EXIT DUP BLOCK DROP UPDATE DELETE NEW B/BLK LEN! ; \ ÒÄ: CBM>7BIT 7BIT>CBM CLV01AUG87 ÌABEL CBM>7B \ ÁÒ=CHAR -- 7BITÃHAR $80 # CMP 0< ?[ RTS ]? $C0 # CMP ÃÓ ?[ $E0 # CMP Ãà ?[ $A0 # ADC RTS ]? ]? $1F # AND RTS END-CODE ÌABEL 7B>CBM \ ÁÒ=7BITÃHAR -- CHAR $60 # CMP Ãà ?[ RTS ]? $A0 # SBC RTS END-CODE ÃODE C>7 SP X) LDA CBM>7B JSR PUTÁ JMP ÃODE 7>C SP X) LDA 7B>CBM JSR PUTÁ JMP END-CODE \ ÒÄ: CP1 CP2 CLV01AUG87 ÌABEL CP1 ( FROM TO COUNT--TOCOUNT) 3 # LDA SETUP JSR Î 2+ LDA Î 6 + STA Î 3+ LDA Î 7 + STA DEY $7F # LDX Î LDA 0= ?[ Î 1+ LDA 0= ?[ PLA PLA 0 # LDA PUSH0A JMP ]? ][ Î 1+ INC ]? RTS ÌABEL CP2 SEC Î 2+ LDA Î 6 + SBC PHA Î 3+ LDA Î 7 + SBC PUSH JMP \ ÒÄ: EXPAND COMPRESS CLV01AUG87 ÃODE EXPAND CP1 JSR [[ [[ Î 4 + )Y LDA 0< ?[ $7F # AND TAY TAX BL # LDA [[ Î 2+ )Y STA DEY 0< ?] INY SEC TXA Î 2+ ADC Î 2+ STA ÃÓ ?[ Î 3+ INC ]? ][ 7B>CBM JSR Î 2+ )Y STA Î 2+ WINC ]? Î 4 + WINC Î DEC 0= ?] Î 1+ DEC 0= ?] CP2 JMP END-CODE ÃODE COMPRESS CP1 JSR [[ [[ Î 4 + )Y LDA BL # CMP 0= ?[ INX 0= ?[ DEX TXA Î 2+ )Y STA Î 2+ WINC $80 # LDX ]? ][ $80 # CPX 0>= ?[ PHA TXA Î 2+ )Y STA Î 2+ WINC $7F # LDX PLA ]? CBM>7B JSR Î 2+ )Y STA Î 2+ WINC ]? Î 4 + WINC Î DEC 0= ?] Î 1+ DEC 0= ?] $80 # CPX 0>= ?[ TXA Î 2+ )Y STA Î 2+ WINC ]? CP2 JMP END-CODE \ ÒÄ: RAMÒ/× CLV01AUG87 Ü : ENDWRITE ( COMPÌEN--) DATA UNDER + ( [FROM ]TO ) ÂÅÇÉÎ 1- DUP C@ $7F U> ×ÈÉÌÅ 2DUP U> ÕÎÔÉÌ 1+ SWAP - LEN! ; Ü : ENDREAD ( TOÁDR EXPÌEN--) UNDER + B/BLK ROT - BL FILL ; : RAMÒ/× ( ADR BLK FILE Ò/ÎOT× -- ERROR) 2 PICK NOTÒÄ? ÉÆ 1541R/W ÅÌÓÅ SWAP ABORT" NO FILE" SWAP SEARCH LEN@ B/BLK = ( ADR R? B?) ÉÆ 0= ÉÆ DATA ÅÌÓÅ DATA SWAP ÔÈÅÎ B/BLK CMOVE ÅÌÓÅ 0= ÉÆ DELETE NEW DATA B/BLK COMPRESS ENDWRITE ÅÌÓÅ DUP DATA SWAP LEN@ EXPAND ENDREAD ÔÈÅÎ ÔÈÅÎ FALSE ÔÈÅÎ ; \ ÒÄ: ID RDUSE/DEL/NEW CLV01AUG87 : .RD ( --) (RD @ U. RD DROP END U. 6 ADR@ U. ID COUNT TYPE ; : ID! ( ADR COUNT--) $20 ID C! ID COUNT BL FILL $1A UMIN ID 3 + PLACE " ÒÄ." COUNT ID 1+ SWAP CMOVE ; : ID" ÁSCII " PARSE ID! ; \ ID" NAME : RDUSE ( FROM --) (RD ! ; : RDDEL ( --) RD @ DUP 2 >ADR ! 4 >ADR ! END OFF ; Ü : RANGE ( ADR--ADR) LIMIT UMAX MEMTOP UMIN ; : RDNEW ( FROM TO--) RANGE SWAP RANGE SWAP 2DUP $500 - U> ABORT" RANGE!" OVER PLEN OVER ! RDUSE SWAP - 6 >ADR ! RDDEL 0 0 ID! ; \ ÒÄ: RDCHECK CLV01AUG87 Ü : ?ERROR ÉÆ ." ERROR " ÔÈÅÎ ; : RDCHECK .RD RD ÂÅÇÉÎ DUP @ DUP 0 B/BLK 5 + UWITHIN NOT ?ERROR + DUP CR U. DUP @ DUP 3 U.R SPACE ×ÈÉÌÅ DUP 2+ @ BLK/DRV U/MOD 1 U.R ." :" 2 U.R DUP 4 + &26 TYPE STOP? ?EXIT ÒÅÐÅÁÔ END - ?ERROR ; \ ÓÔ:ÓUPERTAPE ÌOADÓCREEN CLV01AUG87 (64 .( NOT FOR Ã64!! ) QUIT Ã) \NEEDS ÃODE .( NEEDS ÁSSEMBLER!) QUIT ÁSSEMBLER \NEEDS ROM .( ??! ROM !??) QUIT ÏNLYFORTH 1 $12 +THRU \ LOAD SUPERTAPE \\ ÓUPERTAPE WAS DEVELOPED BY GERMAN MAGAZIN C'T ( WWW.HEISE.DE ) ×E THANK THE PUBLISHER FOR PERMISSION TO ADAPT ÓUPERÔAPE FOR VOLKSÆORTH \ ÓÔ:ÌABELS.. CLV16JUN87 \ ------ HARDWARE-ÁDDRESSES ----------- $0001 >ÌABEL PÃASS $FF02 >ÌABEL PÔIMER $FF09 >ÌABEL PÔIMERÂÃTRL $FF3F >ÌABEL PÒAMÏN $FF3E >ÌABEL PÒAMÏFF \ ------ ÓYSTEM-ÖECTORS -------------- $0330 >ÌABEL VÓAVE $032E >ÌABEL VÌOAD \ --- ÉNPUT-ÐARAMS ÌOAD/ÓAVE --------- $AE >ÌABEL ZÄEVICEÎR $AD >ÌABEL ZÓECADD $AF >ÌABEL ZÆILENAMEÚ $AB >ÌABEL ZÆILEÎAMEà $B4 >ÌABEL ZÂASÌOADÁDD $B2 >ÌABEL ZÉÏÓTARTÚ $9D >ÌABEL ZÐROGÅNDÚ \ --- ÏUTPUT ÐARAMS FOR ÌOAD/ÓAVE ---- $90 >ÌABEL ZÓTATUS \ ÓÔ:..ÌABELS CLV16JUN87 \ ------ USED ÓYSTEM ÒOUTINES --------- $E38D >ÌABEL XÃASSÍOTORÏN $E3B0 >ÌABEL XÃASSÍOTORÏFF $E364 >ÌABEL XÃASSÐRTÏN $E378 >ÌABEL XÃASSÐRTÏFF $F050 >ÌABEL XÌOAD $F1A4 >ÌABEL XÓAVE $F189 >ÌABEL XÍSGÌOADÖERIFY $E31B >ÌABEL XÐRESSPLAY $E319 >ÌABEL XÐRESSÒEC $EBCA >ÌABEL XÆOUNDÆILE $F160 >ÌABEL XÓEARCHING $FFD2 >ÌABEL KÏUTPUT \ ------ USED ÚEROPAGE ÁDDRESSES ------ $5F >ÌABEL ZÂEGINÚ $61 >ÌABEL ZÅNDÚ $93 >ÌABEL ZÖERIFYÆLAG $59 >ÌABEL ÚÂLOCKËIND $58 >ÌABEL ZÂIT $57 >ÌABEL ZÂYTE $FF >ÌABEL ZÔMP \ ÓÔ:..ÌABELS CLV16JUN87 $D8 >ÌABEL ZÒESERVÁÁ $5D >ÌABEL ZÃHECKÓUM $63 >ÌABEL ZÃHECKÓUM $DA >ÌABEL ZÔMPÓÐ \ --- OTHER ÓYSTEMADRESSEN ---------- $07C8 >ÌABEL SÔIME $0332 DUP >ÌABEL SÃASSÂUFFER $19 + $100 MOD >ÌABEL CÃASSÂUFFERÅND \ --------- ËONSTANTEN -------------- $07 >ÌABEL CÄEVICEÓÔ $2A >ÌABEL CÈEADERÍARK $C5 >ÌABEL CÄATAÍARK $4F >ÌABEL CHSL $B5 >ÌABEL CLSL $78 >ÌABEL CHSSH $34 >ÌABEL CHSSL $FF >ÌABEL CLSSH $78 >ÌABEL CLSSL $16 >ÌABEL CÓYNCÂYTE $0B >ÌABEL CÓYNCÂYTESÌOAD $40 >ÌABEL CÓYNCÂYTEÃOUNT \ ÓÔ:VERSCHIEDENES CLV28JUL87 ÌABEL BTLÂEG ÌABEL PUFFINIT \ ÌOAD ÐOINTER TO ÂUFFER SÃASSBUFFER $100 U/MOD # LDA ZÂEGINÚ 1+ STA ZÅNDÚ 1+ STA # LDA ZÂEGINÚ STA CÃASSBUFFERÅND # LDA ZÅNDÚ STA RTS END-CODE ÌABEL TIMERÂÓTART SÔIME LDA PÔIMER STA 0 # LDA PÔIMER 1+ STA $10 # LDA PÔIMERÂÃTRL STA RTS END-CODE ÌABEL DELAYÍOTOR \ ÍOTOR START ÄELAY 0 # LDX 0 # LDY [[ [[ DEX 0= ?] DEY 0= ?] RTS END-CODE \ ÓÔ:STÅNDE ETC. CLV23JUL87 ÌABEL STÅND 0 # LDA $2C C, ÌABEL LOADÅRROR $1D # LDA $2C C, ÌABEL EOT $04 # LDA $2C C, ÌABEL VERÅRROR $1C # LDA $2C C, ÌABEL BRKÅRROR $1E # LDA PÒAMÏFF STA PHA XÃASSÍOTORÏFF JSR XÃASSÐRTÏFF JSR ZÔMPÓÐ LDX PLA TXS ZÂEGINÚ LDX ZÂEGINÚ 1+ LDY 01 # CMP CLI RTS END-CODE \\ CBM: STOP: AR=0 CF=1 NORMAL AR=0 CF=0 ST=0 EOT $80 LOAD/VERERR $10 CHECKSUM $60 ... KERNAL-ERRORS AR=0..8 CF=1 S.ÒÏÍ:$A803 \ ÓÔ:BITÒEAD CLV18JUN87 ÌABEL BITÒEAD \ CUR.ÂYTE IN ÁÒ $10 # LDA [[ PTIMERÂCTRL BIT 0<> ?] PÃASS LDA $10 # AND ZÂIT CMP 0<> ?[ CLC ]? ZÂIT STA ZÂYTE ROR ZÂYTE LDA 0< ?[ ZÃHECKÓUM WÉNC ]? [[ PÃASS LDA $10 # AND ZÂIT CMP 0<> ?] ZÂIT STA TIMERÂÓTART JSR ZÂYTE LDA RTS END-CODE \ ÓÔ:STÒEAD.. CLV05AUG87 ÌABEL STÒEAD \ READS A BLOCK ZÂLOCKËIND STA 0 # LDX ÌABEL SYNCRON [[ BITÒEAD JSR CÓYNCÂYTE # CMP 0= ?] CÓYNCÂYTESÌOAD # LDX [[ $08 # LDY [[ BITÒEAD JSR DEY 0= ?] CÓYNCÂYTE # CMP SYNCRON BNE DEX 0= ?] [[ $08 # LDY [[ BITÒEAD JSR DEY 0= ?] CÓYNCÂYTE # CMP 0<> ?] ZÂLOCKËIND CMP 0<> ?[ CÄATAÍARK # CMP SYNCRON BEQ $10 # LDA ZÓTATUS STA LOADÅRROR JMP ]? 0 # LDA ZÃHECKÓUM STA ZÃHECKÓUM 1+ STA $08 # LDY [[ BITÒEAD JSR DEY 0= ?] ZÔMP STA \ ÓÔ:..STÒEAD CLV28JUL87 [[ [[ ZÃHECKÓUM LDA ZÃHECKÓUM STA ZÃHECKÓUM 1+ LDA ZÃHECKÓUM 1+ STA BITÒEAD JSR BITÒEAD JSR ZÖERIFYÆLAG LDA 0= ?[ ZÔMP LDA ZÂEGINÚ )Ù STA ]? BITÒEAD JSR BITÒEAD JSR ZÔMP LDA ZÂEGINÚ )Ù CMP 0<> ?[ INX ]? BITÒEAD JSR BITÒEAD JSR ZÂEGINÚ WÉNC BITÒEAD JSR BITÒEAD JSR ZÔMP STA ZÂEGINÚ 1+ LDA ZÅNDÚ 1+ CMP 0= ?] ZBEGINÚ LDA ZÅNDÚ CMP 0= ?] \ ÓÔ:..STÒEAD CLV05AUG87 ZÔMP LDA ÚÃHECKÓUM CMP 0<> ?[ ÌABEL ÓÅRROR ZÓTATUS LDA $60 # ORA ZÓTATUS STA LOADÅRROR JMP ]? $08 # LDY [[ ÂITÒEAD ÊSR DEY 0= ?] ZÃHECKÓUM 1+ CMP ÓÅRROR BNE 0 # CPX 0<> ?[ $10 # LDA ZÓTATUS STA VERÅRROR JMP ]? ÌABEL LDÒÔÓ RTS END-CODE \ ÓÔ:STÌOAD.. CLV23JUL87 ÌABEL STÌOAD ZÖERIFYÆLAG STA 0 # LDA ZÓTATUS STA ZÄEVICEÎR LDA CÄEVICEÓÔ # CMP 0<> ?[ XÌOAD JMP ]? \ ÃÂÍ-ÒOUTINE ÌABEL LOADÎEXT TSX ZÔMPÓÐ STX XÐRESSPLAY JSR LDÒÔÓ BCS SEI ZÖERIFYÆLAG LDA PHA 0 # LDA ZÖERIFYÆLAG STA XÓEARCHING JSR ÌABEL LD×RONGÆILE XÃASSÍOTORÏN JSR DELAYÍOTOR JSR XÃASSÐRTÏN JSR PUFFÉNIT JSR CLSL # LDA SÔIME STA CÈEADERÍARK # LDA STÒEAD JSR $63 # LDY XÆOUNDÆILE JSR 0 # LDY [[ SÃASSÂUFFER ,Ù LDA KÏUTPUT JSR INY $10 # CPY 0= ?] $FF # LDY \ ÓÔ:..STÌOAD CLV23JUL87 ÌABEL LDÃOMP [[ INY ZÆILEÎAMEà CPY 0<> ?[[ PÒAMÏN STA ZÆILENAMEÚ )Ù LDA PÒAMÏFF STA SÃASSÂUFFER ,Ù CMP LDÃOMP BEQ ÁSCII ? # CMP LDÃOMP BEQ SÃASSÂUFFER $10 + LDA $02 # AND 0<> ?[ $80 # LDA ZÓTATUS STA EOT JMP ]? XÃASSÐRTÏFF JSR LD×RONGÆILE JMP ]]? PLA ZÖERIFYÆLAG STA XÍSGÌOADÖERIFY JSR ZÂASÌOADÁDD LDA ZÂEGINÚ STA ZÂASÌOADÁDD 1+ LDA ZÂEGINÚ 1+ STA ZÓECÁDD LDA 0<> ?[ SÃASSÂUFFER $11 + LDA ZÂEGINÚ STA SÃASSÂUFFER $12 + LDA ZÂEGINÚ 1+ STA ]? CLC SÃASSÂUFFER $13 + LDA ZÂEGINÚ ADC ZÅNDÚ STA SÃASSÂUFFER $14 + LDA ZÂEGINÚ 1+ ADC ZÅNDÚ 1+ STA \ ÓÔ:..STÌOAD CLV14OCT87 CHSL # LDA SÔIME STA SÃASSÂUFFER $10 + LDA 0>= ?[ CLSL # LDA SÔIME STA ]? PÒAMÏN STA CÄATAÍARK # LDA STÒEAD JSR STÅND JMP END-CODE ÌABEL LOADSYS \ LOAD AND START LOADNEXT JSR ÃÓ ?[ BRK ]? LOADNEXT JSR ÃÓ ?[ BRK ]? ORIGIN 8 - JMP \ ÆORTH-ÃOLD VECTOR ÌABEL BTLÅND BASE @ HEX ÃREATE G---- 7 ALLOT LOADSYS 0 <# #S ÁSCII G HOLD #CR HOLD #> G---- PLACE BASE ! : >LOWER ( STR--) COUNT BOUNDS ÄÏ É C@ $7F AND É C! ÌÏÏÐ ; G---- >LOWER FORGET >LOWER \ ÓÔ:WÂYTE W4BITS CLV16JUN87 ÌABEL WÂYTE HERE 3 + ÊSR \ WRITE BYTE ÌABEL W4BITS \ UPPER 4 ÂITS $04 # LDY [[ ZÂYTE LSR ÃÓ ?[ ZÒESERVÁÁ 1+ LDA SÔIME STA ]? $10 # LDA [[ PÔIMERÂÃTRL BIT 0<> ?] TIMERÂÓTART JSR PÃASS LDA $02 # EOR PÃASS STA Ãà ?[ $10 # LDA [[ PÔIMERÂÃTRL BIT 0<> ?] TIMERÂÓTART JSR PÃASS LDA $02 # EOR PÃASS STA ][ ZÃHECKÓUM LDA 0 # ADC ZÃHECKÓUM STA ZÃHECKÓUM 1+ LDA 0 # ADC ZÃHECKÓUM 1+ STA ZÒESERVÁÁ LDA SÔIME STA ]? DEY 0= ?] RTS END-CODE \ ÓÔ:ST×RITE CLV18JUN87 ÌABEL ST×RITE \ WRITES A BLOCK PHA CÓYNCÂYTEÃOUNT # LDX [[ CÓYNCÂYTE # LDA ZÂYTE STA WÂYTE ÊSR DEX 0= ?] PLA ZBYTE STA WÂYTE ÊSR 0 # LDY ZÃHECKÓUM STY ZÃHECKÓUM 1+ STY [[ [[ ZÂEGINÚ )Ù LDA ZÂYTE STA W4BITS JSR ZÂEGINÚ WÉNC W4BITS JSR ZÂEGINÚ LDA ZÅNDÚ CMP 0= ?] ZÂEGINÚ 1+ LDA ZÅNDÚ 1+ CMP 0= ?] ZÃHECKÓUM LDA ZÃHECKÓUM 1+ LDX ZÂYTE STA WÂYTE JSR TXA ZÂYTE STA WÂYTE JSR WÂYTE JMP END-CODE \ ÓÔ:SAVEÎAME CLV26JUL87 ÌABEL SAVEÎAME \ NO ERROR CHECKING! BL # LDA $0F # LDY [[ SÃASSÂUFFER ,Ù STA DEY 0= ?] ZÆILEÎAMEà LDY RAM [[ DEY 0>= ?[[ ZÆILEÎAMEÚ )Ù LDA SÃASSÂUFFER ,Ù STA ]]? ROM ÌABEL RSÒÔÓ RTS END-CODE \ ÓÔ:STÓAVE.. CLV16JUN87 ÌABEL STÓAVE ZÄEVICEÎR LDA CÄEVICEÓÔ # CMP 0<> ?[ SEC $0E # AND 0= ?[ CLC ]? XÓAVE JMP ]? TSX ZÔMPÓÐ STX SAVEÎAME JSR CLC XÐRESSÒEC JSR RSÒÔÓ BCS SEI XÃASSÐRTÏN JSR XÃASSÍOTORÏN JSR DELAYÍOTOR JSR ZÓECÁDD LDA SÃASSBUFFER &16 + STA ZÉÏÓTARTÚ LDA SÃASSÂUFFER &17 + STA ZÉÏÓTARTÚ 1+ LDA SÃASSÂUFFER &18 + STA SEC ZÐROGÅNDÚ LDA ZÉÏÓTARTÚ SBC SÃASSÂUFFER &19 + STA ZÐROGÅNDÚ 1+ LDA ZÉÏÓTARTÚ 1+ SBC SÃASSÂUFFER &20 + STA 0 # LDA SÃASSÂUFFER &21 + DUP STA 1+ DUP STA 1+ DUP STA 1+ STA PÔIMER 1+ STA SÃASSÂUFFER $100 U/MOD # LDA ZÂEGINÚ 1+ STA ZÅNDÚ 1+ STA # LDA ZÂEGINÚ STA CÃASSÂUFFERÅND # LDA ZÅNDÚ STA \ ÓÔ:..STÓAVE CLV16JUN87 CLSSH # LDA ZÒESERVÁÁ 1+ STA CLSSL # LDA ZÒESERVÁÁ STA PÔIMER STA $10 # LDA PÔIMERÂÃTRL STA CÈEADERÍARK # LDA ST×RITE JSR DELAYÍOTOR JSR ZÓECÁDD BIT 0< ?[ CHSSH # LDA ZÒESERVÁÁ 1+ STA CHSSL # LDA ZÒESERVÁÁ STA PÔIMER STA ]? ZÉÏÓTARTÚ LDA ZÂEGINÚ STA ZÉÏÓTARTÚ 1+ LDA ZÂEGINÚ 1+ STA ZÐROGÅNDÚ LDA ZÅNDÚ STA ZÐROGÅNDÚ 1+ LDA ZÅNDÚ 1+ STA PÒAMÏN STA CÄATAÍARK # LDA ST×RITE JSR DELAYÍOTOR JSR STÅND JMP END-CODE \ ÓÔ:SUPERTAPE SAVEBOOTER CLV10OCT87 : SUPERTAPE \ -- 7 DEVICE ! STÌOAD VÌOAD ! STÓAVE VÓAVE ! ." ÓÔ2.20 " ; Ü : (N" >IN STORE N" ; : BTL ( --[FROM ]TO ) [ ÂTLÂEG ] ÌITERAL [ ÂTLÅND ] ÌITERAL ; Ü : BTLÎAME ( --ADR COUNT) PAD $16 BL FILL (N" $10 UMIN PAD SWAP CMOVE G---- COUNT PAD $A + SWAP CMOVE PAD $10 ; : STÓAVÓYS ( --) \ ÎAME" FOLLOWS DEVICE STORE 1 DEVICE ! BTL BTLÎAME BSAVE 7 DEVICE ! ORIGIN $17 - BTL DROP (N" BSAVE BTL NIP HERE N" BSAVE ; \ ÌOADSCREEN FOR ÄECOMPILER 20OCT87RE \ BASED ON Æ83 BY È. ÌAXEN / Í. ÐERRY \NEEDS ÔOOLS ÖOCABULARY ÔOOLS .( ÄECOMPILER LOADING...) ÏNLYFORTH ÔOOLS ALSO DEFINITIONS \NEEDS DIS ' DROP Ü ÁLIAS DIS \ ÄISASSEMBLE IF POSSIBLE &1 &9 +THRU \\ CLEAR \ CASE DEFINING WORDS 20AUG85MAWE Ü : CASE: ( N -) ÃREATE , 0 ] ÄOES> 2+ SWAP 2* + PERFORM ; Ü : ASSOCIATIVE: ÃREATE , ( N -) ÄOES> ( N - INDEX) DUP @ -ROT DUP @ 0 ÄÏ 2+ 2DUP @ = ÉÆ 2DROP DROP É 0 0 ÌÅÁÖÅ ÔÈÅÎ ÌÏÏÐ 2DROP ; ÄEFER (SEE Ü ÖARIABLE MAXBRANCH Ü ÖARIABLE THENBRANCH \ DECOMPILE EACH TYPE OF WORD 29NOV85RE Ü : .WORD ( ÉÐ - ÉÐ') DUP @ >NAME .NAME 2+ ; Ü : .LIT ( ÉÐ - ÉÐ') .WORD DUP @ . 2+ ; Ü : .CLIT ( ÉÐ - ÉÐ') .WORD DUP C@ . 1+ ; Ü : .STRING ( ÉÐ - ÉÐ') CR .WORD COUNT 2DUP TYPE ASCII " EMIT SPACE + ; Ü : .DO ( ÉÐ - ÉÐ') ." ÄÏ " 4 + ; Ü : .LOOP ( ÉÐ - ÉÐ') ." ÌÏÏÐ " 4 + ; Ü : .EXIT ( ÉÐ - ÉÐ' F) DUP MAXBRANCH @ U< ÉÆ .WORD EXIT ÔÈÅÎ DUP @ [ ÆORTH ] ['] UNNEST = ÉÆ ." ; " ÅÌÓÅ .WORD ." ; -2 ALLOT " ÔÈÅÎ 0= ; \ BRANCH, ?BRANCH 29NOV85RE Ü : .TO ." BACK TO " .WORD DROP ; Ü : .BRANCH ( ÉÐ - ÉÐ') 2+ DUP @ 2DUP + SWAP 0< ÉÆ CR ." ÒÅÐÅÁÔ TO " .EXIT 0<> SWAP 2+ AND EXIT ÔÈÅÎ CR ." ÅÌÓÅ " DUP THENBRANCH ! DUP MAXBRANCH @ U> ÉÆ MAXBRANCH ! ÅÌÓÅ DROP ÔÈÅÎ 2+ ; Ü : .?BRANCH ( ÉÐ - ÉÐ') 2+ DUP @ 2DUP + SWAP 0< ÉÆ CR ." ÕÎÔÉÌ " .TO 2+ EXIT ÔÈÅÎ CR DUP 4 - @ [ ' BRANCH ] LITERAL = OVER 2- @ 0< AND ÉÆ ." ×ÈÉÌÅ " ÅÌÓÅ ." ÉÆ " DUP THENBRANCH ! ÔÈÅÎ DUP MAXBRANCH @ U> ÉÆ MAXBRANCH ! ÅÌÓÅ DROP ÔÈÅÎ 2+ ; \ DECOMPILE DOES> ;CODE ; 20OCT87RE Ü : DOES? ( ÉÐ - ÉÐ' F) DUP 3 + SWAP DUP C@ $4à = SWAP \ JMP-OPCODE 1+ @ ['] ÆORTH @ 1+ @ = \ (DODOES> AND ; Ü : .(;CODE ( ÉÐ - ÉÐ' F) 2+ DOES? ÉÆ CR ." ÄOES> " ÅÌÓÅ ." ;ÃODE " 3 - DIS 0 ÔÈÅÎ ; Ü : .COMPILE ( ÉÐ -- ÉÐ' ) .WORD .WORD ; \ CLASSIFY EACH WORD 20OCT87RE &18 ASSOCIATIVE: EXECUTION-CLASS ÆORTH ' LIT , ' CLIT , ' ?BRANCH , ' BRANCH , ' (ÄÏ , ' (." , ' (ABORT" , ' ÄOES> 4 + @ , \ (;CODE ' EXIT , ' ABORT , ' QUIT , ' 'QUIT , ' (QUIT , ' UNNEST , ' (" , ' (?ÄÏ , ' (ÌÏÏÐ , ' COMPILE , &19 CASE: .EXECUTION-CLASS .LIT .CLIT .?BRANCH .BRANCH .DO .STRING .STRING .(;CODE .EXIT .EXIT .EXIT .EXIT .EXIT .EXIT .STRING .DO .LOOP .COMPILE .WORD ; \ DECOMPILE A :-DEFINITION 20AUG85MAWE : .PFA ( CFA -) >BODY ÂÅÇÉÎ ?CR DUP DUP THENBRANCH @ = ÉÆ ." ÔÈÅÎ " ?CR ÔÈÅÎ @ EXECUTION-CLASS .EXECUTION-CLASS DUP 0= STOP? OR ÕÎÔÉÌ DROP ; : .IMMEDIATE ( CFA -) >NAME C@ DUP ?CR $40 AND ÉÆ ." ÉMMEDIATE " ÔÈÅÎ ?CR $80 AND ÉÆ ." RESTRICT" ÔÈÅÎ ; : .CONSTANT ( CFA -) DUP >BODY @ . ." ÃONSTANT " >NAME .NAME ; : .VARIABLE ( CFA -) DUP >BODY . ." ÖARIABLE " DUP >NAME .NAME CR ." ÖALUE = " >BODY @ . ; \ DISPLAY CATEGORY OF WORD 20OCT87RE : .: ( CFA -) ." : " DUP >NAME .NAME CR .PFA ; : .DOES> ( CFA -) CR ." ÄOES> " 2- .PFA ; : .USER-VARIABLE ( CFA -) DUP >BODY C@ . ." ÕSER-ÖARIABLE " DUP >NAME .NAME CR ." ÖALUE = " EXECUTE @ . ; : .DEFER ( CFA -) ." DEFERRED " DUP >NAME .NAME ." ÉS " >BODY @ (SEE ; : .OTHER ( CFA -) DUP >NAME .NAME DUP @ OVER >BODY = ÉÆ ." IS ÃODE" @ DIS EXIT ÔÈÅÎ DUP @ DOES? ÉÆ .DOES> DROP EXIT ÔÈÅÎ DROP ." MAYBE ÃODE" @ DIS ; \ ÃLASSIFY A WORD 22JUL85WE 5 ASSOCIATIVE: DEFINITION-CLASS ' QUIT @ , ' 0 @ , ' SCR @ , ' BASE @ , ' 'COLD @ , 6 CASE: .DEFINITION-CLASS .: .CONSTANT .VARIABLE .USER-VARIABLE .DEFER .OTHER ; \ ÔOP LEVEL OF ÄECOMPILER 20AUG85MAWE : ((SEE ( CFA -) MAXBRANCH OFF THENBRANCH OFF CR DUP DUP @ DEFINITION-CLASS .DEFINITION-CLASS .IMMEDIATE ; ' ((SEE ÉS (SEE ÆORTH DEFINITIONS : SEE ' (SEE ; \ ÃOMMODORE HOLE ÓCREENS 20OCT87RE ÏNLYFORTH : <INIT 0 $ÄÄ03 C! ; : GET ( -- 8B) ÂÅÇÉÎ $ÄÄ0Ä C@ $10 AND ÕÎÔÉÌ $ÄÄ01 C@ DUP $ÄÄ01 C! ; : <SYNC ( --) <INIT ÂÅÇÉÎ GET $55 = ÕÎÔÉÌ ÂÅÇÉÎ GET DUP $55 = ×ÈÉÌÅ DROP ÒÅÐÅÁÔ ABORT" ÓYNCÅRR" ; : SUM ( OLDSUM N -- NEWSUM N) SWAP OVER + SWAP ; : CHECK ( SUM.INT 8B.SUM.READ --) SWAP $ÆÆ AND - ABORT" ÃHÓUMÅRROR" ; --> \ ÃOMMODORE HOLE ÓCREENS 20OCT87RE : DOWNLOAD ( N --) <SYNC 0 SWAP BUFFER B/BLK BOUNDS ÄÏ GET SUM É C! ÌÏÏÐ GET CHECK UPDATE ; : DOWNTHRU ( START COUNT --) BOUNDS ÄÏ É DOWNLOAD ÌÏÏÐ ; --> \\ SYNC NEEDS: XX $55 $55 00 DATA \ ÃOMMODORE SENDSCREENS 20OCT87RE : >INIT $ÆÆ $ÄÄ03 C! ; : PUT ( 8B -) $ÄÄ01 C! ÂÅÇÉÎ STOP? ÉÆ <INIT TRUE ABORT" TERMINATED" ÔÈÅÎ $ÄÄ0Ä C@ $10 AND ÕÎÔÉÌ ; : >SYNC ( --) >INIT $10 0 ÄÏ $55 PUT ÌÏÏÐ 0 PUT ; : UPLOAD ( N --) >SYNC 0 SWAP BLOCK B/BLK BOUNDS ÄÏ É C@ SUM PUT ÌÏÏÐ $ÆÆ AND PUT <INIT ; : UPTHRU ( FROM TO -- ) 1+ SWAP ÄÏ É . CR É UPLOAD ÌÏÏÐ ; \ ÇRAPHIC ÌOAD-ÓCREEN 20OCT87RE (16 .( Ã64 ÏNLY ) \\ Ã) ÏNLYFORTH \NEEDS ÃODE .( ÁSSEMBLER??!) \\ \NEEDS LBYTE 1 +LOAD \NEEDS 100U/ &26 +LOAD ÖOCABULARY GRAPHIC ' GRAPHIC Ü ÁLIAS ÇRAPHICS ÇRAPHICS ALSO DEFINITIONS 2 &15 +THRU \ HIRES GRAPHIC &16 &20 +THRU \ SPRITES &21 &23 +THRU \ TURTLE GRAPHIC ÏNLYFORTH \ >BYTE HBYTE LBYTE 20OCT87RE ÃODE >BYTE ( 16B - 8BL 8BH) ÓÐ )Ù LDA PHA TXA ÓÐ )Ù STA ÓÐ 2DEC TXA ÓÐ )Ù STA PLA ÐUTA JMP END-CODE : HBYTE >BYTE NIP ; : LBYTE >BYTE DROP ; \ ÇRAPHICS CONSTANTS 20OCT87RE Ü $0288 ÃONSTANT SCRPAGE Ü $Å000 ÃONSTANT BITMAP Ü $Ä800 ÃONSTANT CHARSET Ü $Ã400 ÃONSTANT COLRAM Ü $Ã000 ÃONSTANT VIDRAM \ $Ã800 ÃONSTANT SPRBUF BITMAP HBYTE $40 /MOD 3 SWAP - Ü ÃONSTANT BANK $20 / 8 * COLRAM HBYTE $3Æ AND 4 / $10 * OR Ü ÃONSTANT BMOFFS VIDRAM HBYTE $3Æ AND 4 / $10 * CHARSET HBYTE $3Æ AND 4 / OR Ü ÃONSTANT TMOFFS $0314 Ü ÃONSTANT IRQVEC $ÅÁ31 >LABEL OLDIRQ $ÅÁ81 >LABEL IRQEND $ÆÆ6Å >LABEL SETTIMER \ ÇR MOVECHARSET CLRSCREEN 20OCT87RE Ü ÃODE MOVECHARSET SEI $32 # LDA 1 STA DEY 8 # LDX Î STY Î 2+ STY $Ä8 # LDA Î 1+ STA CHARSET HBYTE # LDA Î 3 + STA [[ [[ Î )Ù LDA Î 2+ )Ù STA INY 0= ?] Î 1+ INC Î 3 + INC DEX 0= ?] $36 # LDA 1 STA CLI INY ÎEXT JMP END-CODE : CLRSCREEN ( -- ) BITMAP &8000 ERASE ; \ ÇR ÖARIABLES (TEXT (HIRES 20OCT87RE Ü ÖARIABLE CBMKEY Ü ÖARIABLE SWITCHFLAG Ü ÖARIABLE TEXTBORDER Ü ÖARIABLE HIRESBORDER Ü ÖARIABLE SWITCHLINE Ü ÖARIABLE CHFLAG ÌABEL (TEXT $1 # LDA $Ä011 STA TMOFFS # LDA $Ä018 STA TEXTBORDER LDA $Ä020 STA RTS ÌABEL (HIRES $3 # LDA $Ä011 STA BMOFFS # LDA $Ä018 STA HIRESBORDER LDA $Ä020 STA RTS \ ÇR RASTERIRQ GRAPHICIRQ 20OCT87RE ÌABEL WINDOWHOME SWITCHLINE LDA SEC $30 # SBC .Á LSR .Á LSR .Á LSR SEC 1 # SBC $Ä6 CMP Ãà ?[ RTS ]? TAX INX 2 # LDY $Ãà STY $ÃÄ STY $ÃÅ LDA $Ä3 LDY $Ä1 )Ù STA 0 # LDY $ÃÆ STY CLC $ÆÆÆ0 JSR 0 # LDY $Ä1 )Y LDA $ÃÅ STA $Ãà STY RTS ÌABEL GRAPHICIRQ $28Ä LDA 2 # AND 0= ?[ OLDIRQ JMP ]? [[ $ÆÆ9Æ JSR $28Ä LDA 0= ?] CBMKEY ) JMP ÌABEL RASTERIRQ $Ä019 LDA $Ä019 STA $15 # LDX [[ DEX 0= ?] Î LDA ( ÂLIND!!) CHFLAG LDA 1 # EOR CHFLAG STA TAX 0= ?[ (HIRES JSR ][ (TEXT JSR ]? SWITCHLINE ,X LDA $Ä012 STA WINDOWHOME JSR $ÄÃ0Ä LDA 1 # AND GRAPHICIRQ BNE IRQEND JMP \ ÇR ÉÒÑ-HANDLING (WINDOW 20OCT87RE ÌABEL SETIRQ SEI GRAPHICIRQ >BYTE # LDA IRQVEC 1+ STA # LDA IRQVEC STA $Æ0 # LDA $Ä01Á STA $81 # LDA $ÄÃ0Ä STA CLI RTS Ü ÃODE RESETIRQ SEI OLDIRQ >BYTE # LDA IRQVEC 1+ STA # LDA IRQVEC STA $Æ0 # LDA $Ä01Á STA $81 # LDA $ÄÃ0Ä STA CLI ÎEXT JMP END-CODE ÌABEL (WINDOW RASTERIRQ >BYTE # LDA IRQVEC 1+ STA # LDA IRQVEC STA $7Æ # LDA $ÄÃ0Ä STA $Æ1 # LDA $Ä01Á STA SWITCHFLAG STX CHFLAG STX WINDOWHOME JMP \ ÇR TEXT HIRES WINDOW SWITCH 20OCT87RE ÃODE TEXT 1 # LDA SWITCHFLAG STA SETIRQ JSR (TEXT JSR ÎEXT JMP END-CODE ÃODE HIRES 2 # LDA SWITCHFLAG STA SETIRQ JSR (HIRES JSR ÎEXT JMP END-CODE Ü ÃODE SETWINDOW ( ROW -) SEI (WINDOW JSR CLI XYÎEXT JMP END-CODE : WINDOW ( ROW -) 8 * $30 + SWITCHLINE C! SETWINDOW ; ÌABEL SWITCH SWITCH CBMKEY ! SWITCHFLAG LDX 0= ?[ INX SWITCHFLAG STX SETIRQ JSR (TEXT JSR OLDIRQ JMP ]? 1 # CPX 0= ?[ INX SWITCHFLAG STX SETIRQ JSR (HIRES JSR OLDIRQ JMP ]? 0 # LDX SWITCHFLAG STX (WINDOW JSR OLDIRQ JMP END-CODE \ ÇR GRAPHIC FORTH 20OCT87RE ÆORTH DEFINITIONS : GRAPHIC ÇRAPHICS MOVECHARSET $ÄÄ00 C@ $Æà AND BANK OR $ÄÄ00 C! VIDRAM HBYTE SCRPAGE C! COLRAM C@ HIRESBORDER C! $Ä020 C@ TEXTBORDER C! $10Ä0 SWITCHLINE ! TEXT ; : NOGRAPHIC ÏNLYFORTH RESETIRQ $1 $Ä011 C! $17 $Ä018 C! 4 SCRPAGE C! TEXTBORDER C@ $Ä020 C! $ÄÄ00 C@ 3 OR $ÄÄ00 C! ; ÇRAPHICS DEFINITIONS \ ÇR ÃOLORS 20OCT87RE 0 ÃONSTANT BLK 1 ÃONSTANT WHT 2 ÃONSTANT RED 3 ÃONSTANT CYN 4 ÃONSTANT PUR 5 ÃONSTANT GRN 6 ÃONSTANT BLU 7 ÃONSTANT YEL 8 ÃONSTANT ORA 9 ÃONSTANT BRN $Á ÃONSTANT LRE $ ÃONSTANT GR1 $à ÃONSTANT GR2 $Ä ÃONSTANT LGR $Å ÃONSTANT LBL $Æ ÃONSTANT GR3 : BORDER ( COLOR -) DUP TEXTBORDER C! $Ä020 C! ; : SCREEN ( COLOR -) $Ä021 C! ; : COLORS ( BKGRND FOREGRND -) OVER HIRESBORDER C! $10 * OR COLRAM $03Æ8 ROT FILL ; : BACKGROUND ( COLOR -) COLRAM C@ $10 / COLORS ; : PENCOLOR ( COLOR -) COLRAM C@ $Æ AND SWAP COLORS ; \ ÇR ÂITTAB ÌABELS 20OCT87RE ÌABEL BITTAB $80 C, $40 C, $20 C, $10 C, $08 C, $04 C, $02 C, $01 C, Ü : >LABALLOT ( ADR N - ADR+N) OVER >LABEL + ; $60 ÃONSTANT POINTY $62 ÃONSTANT POINTX ÁSSEMBLER Î 2 >LABALLOT Y0 2 >LABALLOT X0 2 >LABALLOT Y1 2 >LABALLOT X1 2 >LABALLOT OFFSET 2 >LABALLOT DY 2 >LABALLOT DX 2 >LABALLOT CT 1 >LABALLOT IY 1 >LABALLOT IX 1 >LABALLOT AY 1 >LABALLOT AX 2 >LABALLOT BYTNR DROP \ ÇR (PLOT COMPUTE 20OCT87RE ÌABEL (PLOT ( X Y -) 2 # LDA SETUP JSR 3 # LDX [[ Y0 ,Ø LDA POINTY ,Ø STA DEX 0< ?] $Ã7 # LDA SEC Y0 SBC Y0 STA ÌABEL COMPUTE SEI 1 DEC Y0 LDA $Æ8 # AND PHA BYTNR STA 0 # LDA BYTNR 1+ STA CLC BYTNR ASL BYTNR 1+ ROL BYTNR ASL BYTNR 1+ ROL PLA BYTNR ADC BYTNR STA ÃÓ ?[ BYTNR 1+ INC ]? BYTNR ASL BYTNR 1+ ROL BYTNR ASL BYTNR 1+ ROL BYTNR ASL BYTNR 1+ ROL Y0 LDA 7 # AND BYTNR ORA BYTNR STA CLC X0 LDA $Æ8 # AND BYTNR ADC BYTNR STA X0 1+ LDA BYTNR 1+ ADC BYTNR 1+ STA BITMAP HBYTE # LDA BYTNR 1+ ORA BYTNR 1+ STA X0 LDA 7 # AND TAX BITTAB ,Ø LDA 0 # LDY CLC RTS \ ÇR PLOT FLIP CLPX 20OCT87RE ÃODE PLOT ( X Y -) (PLOT JSR BYTNR 1+ LDX BITMAP HBYTE # CPX CS ?[ BYTNR )Ù ORA BYTNR )Ù STA ]? ÌABEL ROMON 1 INC CLI XYÎEXT JMP END-CODE ÃODE FLIP ( X Y -) (PLOT JSR BYTNR 1+ LDX BITMAP HBYTE # CPX CS ?[ BYTNR )Ù EOR BYTNR )Ù STA ]? ROMON JMP END-CODE ÃODE UNPLOT ( X Y -) (PLOT JSR BYTNR 1+ LDX BITMAP HBYTE # CPX CS ?[ $ÆÆ # EOR BYTNR )Ù AND BYTNR )Ù STA ]? ROMON JMP END-CODE \\ COMPUTE DISABLES ÉÒÑ, THE WORDS PLOT, FLIP, UNPLOT AND LINE ENABLE THE ÉÒÑ AGAIN. ÎOT NICE, BUT THE ONLY WAS BECAUSE OF THE BRANCH IN 'LINE'. \ ÇR LINE 1 20OCT87RE ÃODE LINE ( X1 Y1 X0 Y0 -) 4 # LDA SETUP JSR ÌABEL (DRAWTO 3 # LDX [[ Y0 ,Ø LDA POINTY ,Ø STA DEX 0< ?] $Ã7 # LDA SEC Y1 SBC Y1 STA $Ã7 # LDA SEC Y0 SBC Y0 STA IX STY IY STY CT STY DEY AX STY AY STY CT 1+ STY DEY X1 LDA X0 CMP X1 1+ LDA X0 1+ SBC Ãà ?[ SEC X0 LDA X1 SBC DX STA X0 1+ LDA X1 1+ SBC DX 1+ STA IX STY ][ X1 LDA X0 SBC DX STA X1 1+ LDA X0 1+ SBC DX 1+ STA ]? Y1 LDA Y0 CMP Ãà ?[ SEC Y0 LDA Y1 SBC DY STA IY STY ][ Y0 SBC DY STA ]? DX 1+ LDA \ ÇR LINE 2 20OCT87RE 0= ?[ DX LDA DY CMP Ãà ?[ DY LDX DY STA DX STX IX LDA AY STA IY LDA AX STA INY IX STY IY STY ]? ]? DX 1+ LDA .Á LSR OFFSET 1+ STA DX LDA .Á ROR OFFSET STA SEC Ãà ?[ .( ÔRICK!! ) [[ IX LDA 0<> ?[ 0>= ?[ X0 WINC ][ X0 WDEC ]? ]? CLC Y0 LDA AX ADC Y0 STA CLC OFFSET LDA DY ADC OFFSET STA ÃÓ ?[ OFFSET 1+ INC ]? CT WINC DX LDA OFFSET CMP DX 1+ LDA OFFSET 1+ SBC Ãà ?[ SEC OFFSET LDA DX SBC OFFSET STA OFFSET 1+ LDA DX 1+ SBC OFFSET 1+ STA AY LDA 0<> ?[ 0>= ?[ X0 WINC ][ X0 WDEC ]? ]? CLC Y0 LDA IY ADC Y0 STA ]? \ ÇR LINE 3 FLIPLINE 20OCT87RE SWAP ]? .( ÐART 2 OF TRICK! ) COMPUTE JSR BYTNR 1+ LDX BITMAP HBYTE # CPX CS ?[ ÌABEL MODE BYTNR )Ù ORA BYTNR )Ù STA ]? 1 INC CLI DX LDA CT CMP DX 1+ LDA CT 1+ SBC Ãà ?] XYÎEXT JMP END-CODE ÃODE DRAWTO ( X1 Y1 -) 3 # LDY [[ POINTY ,Ù LDA Y1 ,Ù STA DEY 0< ?] 2 # LDA SETUP JSR (DRAWTO JMP END-CODE : FLIPLINE ( X1 Y1 X0 Y0 -) $51 ( EOR ) MODE C! LINE $11 ( ORA ) MODE C! ; \ BAD SELF-MODIFYING CODE \ ÓPRITE CONSTANTS 20OCT87RE $Ã800 ÃONSTANT SPRBUF Ü $Ä000 ÃONSTANT SPRBASE Ü $Ä010 ÃONSTANT XPOSHI $Ä015 ÃONSTANT SPRITE Ü $Ä017 ÃONSTANT YEXPAND $Ä01à ÃONSTANT 3COLORED Ü $Ä01Ä ÃONSTANT XEXPAND Ü $Ä025 ÃONSTANT SPRMCOL Ü $Ä027 ÃONSTANT SPRCOL Ü ÃREATE SBITTAB $01 C, $02 C, $04 C, $08 C, $10 C, $20 C, $40 C, $80 C, \ ÓPR SETBIT SET FORMSPRITE 20OCT87RE Ü ÃODE SETBIT ( BITNR ADR FL -) 3 # LDA SETUP JSR DEY Î 4 + LDX SBITTAB ,Ø LDA Î LDX 0= ?[ $ÆÆ # EOR Î 2+ )Ù AND ][ Î 2+ )Ù ORA ]? Î 2+ )Ù STA XYÎEXT JMP END-CODE : SET ( BITNR ADR -) ÔRUE SETBIT ; : RESET ( BITNR ADR -) ÆALSE SETBIT ; : GETFORM ( ADR MEM# -) $40 * SPRBUF + $40 CMOVE ; Ü : SPRITE! ( MEM# SPR# ADR -) $3Æ8 + + C! ; : FORMSPRITE ( MEM# SPR# -) >R SPRBUF $3Æ00 AND $40 / + DUP R@ VIDRAM SPRITE! R> COLRAM SPRITE! ; \ ÓPR MOVE SPRPOS 20OCT87RE : XMOVE ( X SPR# -) 2DUP 2* SPRBASE + C! XPOSHI ROT $ÆÆ > SETBIT ; : YMOVE ( Y SPR# -) 2* 1+ SPRBASE + C! ; : MOVE ( Y X SPR# -) UNDER XMOVE YMOVE ; : SPRPOS ( SPR# - Y X) DUP >R 2* 1+ SPRBASE + C@ R@ 2* SPRBASE + C@ R> SBITTAB + C@ XPOSHI C@ AND ÉÆ $100 + ÔÈÅÎ ; \ ÓPRITE ÑUALITIES 20OCT87RE : HIGH ( SPR# -) YEXPAND SET ; : LOW ( SPR# -) YEXPAND RESET ; : WIDE ( SPR# -) XEXPAND SET ; : SLIM ( SPR# -) XEXPAND RESET ; : BIG ( SPR# -) DUP HIGH WIDE ; : SMALL ( SPR# -) DUP LOW SLIM ; : BEHIND ( SPR# -) $Ä01 SET ; : INFRONT ( SPR# -) $Ä01 RESET ; : COLORED ( SPR# COL -) SWAP SPRCOL + C! ; \ ÓPR SPRCOLORS SETSPRITE 20OCT87RE : SPRCOLORS ( COL# COL# -) SPRMCOL 1+ C! SPRMCOL C! ; : SETSPRITE ( MEM# Y X COLOR SPR# -) UNDER >R COLORED R@ MOVE R@ UNDER FORMSPRITE SMALL R@ 3COLORED RESET R> SPRITE SET ; \ ÔU HEADING LEFT RIGHT 20OCT87RE Ü ÖARIABLE XPOS Ü ÖARIABLE YPOS Ü ÖARIABLE DEG Ü ÖARIABLE PEN Ü : 100*/ ( N1 N2 N3 - N4) &100 */ ; : HEADING ( - DEG) DEG @ ; : SETHEADING ( DEG -) DEG ! ; : RIGHT ( DEG -) DEG @ SWAP - &360 MOD DEG ! ; : LEFT ( DEG -) DEG @ + &360 MOD DEG ! ; ' CLRSCREEN ÁLIAS CS ' PENCOLOR ÁLIAS PC ' BACKGROUND ÁLIAS BG ' HIRES ÁLIAS FULLSCREEN ' WINDOW ÁLIAS SPLITSCREEN \ ÔU POSITIONS PEN HOME 20OCT87RE : XCOR ( - X) XPOS @ 100U/ ; : YCOR ( - Y) YPOS @ 100U/ ; : SETX ( X -) 100* XPOS ! ; : SETY ( Y -) 100* YPOS ! ; : SETXY ( X Y -) SETY SETX ; : PENDOWN PEN ON ; : PENUP PEN OFF ; : HOME &160 &96 SETXY &90 SETHEADING PENDOWN ; : DRAW CLRSCREEN HOME &20 WINDOW ; : NODRAW TEXT PAGE ; ' LEFT ÁLIAS LT ' RIGHT ÁLIAS RT ' SETHEADING ÁLIAS SETH ' PENDOWN ÁLIAS PD ' PENUP ÁLIAS PU \ ÔU FORWARD BACK 20OCT87RE : TLINE ( X1 Y1 X2 Y2 -) >R >R >R 100U/ R> 100U/ R> 100U/ R> 100U/ LINE ; : FORWARD ( DISTANCE -) >R XPOS @ YPOS @ OVER DEG @ COS R@ 100*/ + DUP XPOS ! OVER DEG @ SIN R> 100*/ + DUP YPOS ! PEN @ ÉÆ TLINE ÅÌÓÅ 2DROP 2DROP ÔÈÅÎ ; : BACK ( DISTANCE -) NEGATE FORWARD ; : TURTLESTATE ( - PEN BG PC) PEN C@ COLRAM C@ DUP &15 AND SWAP &16 / ; ' FORWARD ÁLIAS FD ' BACK ÁLIAS BK ' TURTLESTATE ÁLIAS TS \ ÇR ARC ELLIPSE CIRCLE 20OCT87RE : ARC ( HR VR STRT END -) >R >R 2DUP MAX &360 SWAP / R> 2* 2* R> 1+ 2* 2* SWAP ROT >R ÄÏ OVER É 2/ 2/ COS &10005 */ OVER É 2/ 2/ SIN &10005 */ PLOT R@ +ÌÏÏÐ R> 2DROP DROP ; : ELLIPSE ( X Y HR VR -) 2SWAP C-Y ! C-X ! M-FLAG ON 0 &90 ARC M-FLAG OFF ; : CIRCLE ( X Y R -) DUP 3 4 */ ELLIPSE ; A |