MVP-FORTH FOR THE APPLE ][ (TM) V1.0103.03 IMPLEMENTATION BY ROBERT E. KUNTZE SUNNYVALE, CA. FEBRUARY 1983 PUBLISHER: THE FORTH SOURCE (TM) MOUNTAIN VIEW PRESS MOUNTAIN VIEW, CA. ( System LOAD Screen, V1.0103.03 2/83 )2 LOAD 3 LOAD 4 LOAD 5 LOAD 6 LOAD 7 10 THRU ( for the rest of the UTILITIES ) 12 13 THRU ( for the SUPPLEMENTALS ) 15 21 THRU ( for the FORTH 6502 ASSEMBLER ) 24 37 THRU ( for the Starting FORTH EDITOR ) 39 43 THRU ( for APPLE][ UTILITIES ) ( 45 48 THRU ) ( for APPLE][ Graphics ) EXIT ( UTILITIES: 'TITLE .INDEX 9/82 )FORTH DEFINITIONS VARIABLE 'TITLE : .INDEX DUP BPDRV 2 * / 16 * BOOT-SLOT @ SWAP - IBSLOT ! DUP PAD SWAP 1 SWAP BPDRV /MOD 1+ SWAP SPBLK * SPT /MOD 1 13/16RWTS BOOT-SLOT @ IBSLOT ! CR OFFSET @ - 4 .R 2 SPACES PAD C/L -TRAILING TYPE ; ( UTILITIES: .S .SL .SR .SS 7/82 ) 0 CONSTANT .SS : .SL 0 ' .SS ! ; : .SR -1 ' .SS ! ; : .S CR DEPTH IF .SS IF SP@ S0 2- ELSE SP@ S0 SWAP THEN DO I @ 0 D. 2 .SS +- +LOOP ELSE ." EMPTY STACK " THEN CR ; ( UTILITIES: BMOVE COPY D- D0= D= D> D@ DCONSTANT DSWAP 2/83 ) : BMOVE ROT ROT DDUP U< IF ROT DSWAP D< ; : D@ DUP 2+ @ SWAP @ ; : DCONSTANT CREATE , , DOES> DUP 2+ @ SWAP @ ; ( UTILITIES: DMAX DMIN DOVER DU< DVARIABLE ID. 8/82 ): DOVER 4 PICK 4 PICK ; : DMAX DOVER DOVER D< IF DSWAP THEN DDROP ; : DMIN DOVER DOVER D> NOT IF DSWAP THEN DDROP ; HEX : DU< >R >R 8000 + R> R> 8000 + D< ; : DVARIABLE CREATE 4 ALLOT ; : ID. COUNT 1F AND TYPE ; DECIMAL ( UTILITIES: PAUSE THRU 9/82 )HEX : PAUSE ?TERMINAL IF 1000 0 DO LOOP BEGIN ?TERMINAL UNTIL 1000 0 DO LOOP THEN ; DECIMAL : THRU 1+ SWAP DO I U. I LOAD ?TERMINAL IF LEAVE THEN LOOP ; ( UTILITIES: INDEX 9/82 ) : INDEX ( FROM TO ---, ) CR OFFSET @ DUP ROT + 1+ ROT ROT + OVER MAX-BLKS 1+ > ABORT" BLK NO. ERROR" DO I .INDEX PAUSE ?TERMINAL IF LEAVE THEN 1 /LOOP ; ( UTILITIES: DUMP 8/82 )HEX : DUMP 0 BASE @ >R HEX DO CR DUP I + DUP 0 6 D.R 2 SPACES DUP 8 0 DO DUP I + C@ 3 .R LOOP DROP SPACE DUP 8 + 8 0 DO DUP I + C@ 3 .R LOOP DROP 3 SPACES 10 0 DO DUP I + C@ DUP 20 < OVER 7E > OR IF DROP 2E THEN EMIT LOOP DROP 10 PAUSE ?TERMINAL IF LEAVE THEN /LOOP DROP CR R> BASE ! ; DECIMAL ( UTILITIES: TITLE TRIAD 2/83 ) : TITLE CR 10 SPACES ." MOUNTAIN VIEW PRESS FORTH VERSION 1.0103.03 " CR ; ' TITLE CFA 'TITLE ! : TRIAD PAGE 0 3 U/MOD SWAP DROP 3 * 3 OVER + SWAP DO CR I LIST ?TERMINAL IF LEAVE THEN 1 /LOOP 'TITLE @ EXECUTE ; ( UTILITIES: VLIST 8/82 ) HEX : VLIST C/L OUT ! CONTEXT @ @ BEGIN C/L OUT @ - OVER C@ 1F AND 4 + < IF CR 0 OUT ! THEN DUP ID. SPACE SPACE PFA 4 - @ DUP NOT PAUSE ?TERMINAL OR UNTIL DROP ; DECIMAL ( SUPPLEMENTALS: 'S -TEXT "2" DOUBLE NUMBER SET 8/82 ) : 'S SP@ ; : -TEXT DDUP + SWAP DO DROP 2+ DUP 2- @ I @ - DUP IF DUP ABS / LEAVE THEN 2 /LOOP SWAP DROP ; : 2! D! ; : 2@ D@ ; : 2CONSTANT DCONSTANT ; : 2DROP DDROP ; : 2DUP DDUP ; : 2OVER DOVER ; : 2SWAP DSWAP ; : 2VARIABLE DVARIABLE ; ( SUPPLEMENTALS: >BINARY >TYPE EMPTY ERASE FLUSH H U.R ['] 8/82) : >BINARY CONVERT ; : >TYPE ." USED IN MULTIPROGRAMMED SYSTEMS ONLY. " ; : EMPTY INIT-FORTH @ ' FORTH 2+ ! INIT-USER UP @ 6 + 48 CMOVE ; : ERASE 0 FILL ; : FLUSH SAVE-BUFFERS ; : H DP ; : OCTAL 8 BASE ! ; : U.R 0 SWAP D.R ; : ['] ?COMP [COMPILE] ' ; IMMEDIATE FORTH DEFINITIONS ( ASSEMBLER: CONSTANTS INDEX 8/82 )VOCABULARY ASSEMBLER IMMEDIATE HEX ASSEMBLER DEFINITIONS ( REGISTER ASSIGNMENTS SPECIFIC TO THIS IMPLEMENTATION ) FD CONSTANT XSAVE FB CONSTANT W FE CONSTANT UAP F8 CONSTANT IP F0 CONSTANT N ( NUCLEUS LOCATIONS SPECIFIC TO THIS IMPLEMENTATION ) 106C CONSTANT POP 106A CONSTANT POPTWO 084F CONSTANT PUT 084D CONSTANT PUSH 0854 CONSTANT NEXT 083C CONSTANT SETUPN VARIABLE INDEX -2 ALLOT 0909 , 1505 , 0115 , 8011 , 8009 , 1D0D , 8019 , 8080 , 0080 , 1404 , 8014 , 8080 , 8080 , 1C0C , 801C , 2C80 , DECIMAL ( ASSEMBLER: MODE ADDRESSING MODES BOT SEC RP> UPMODE 8/82 )HEX VARIABLE MODE 2 MODE ! : .A 0 MODE ! ; : # 1 MODE ! ; : MEM 2 MODE ! ; : ,X 3 MODE ! ; : ,Y 4 MODE ! ; : X) 5 MODE ! ; : )Y 6 MODE ! ; : ) F MODE ! ; : BOT ,X 0 ; ( ADDRESS THE BOTTOM OF DATA STACK ): SEC ,X 2 ; ( ADDRESS SECOND ITEM ON DATA STACK ): RP> ,X 101 ; ( ADDRESS BOTTOM OF RETURN STACK ) : UPMODE IF MODE @ 8 AND 0= IF 8 MODE +! THEN THEN 1 MODE @ 0F AND ?DUP IF 0 DO DUP + LOOP THEN OVER 1+ @ AND 0= ; DECIMAL ( ASSEMBLER: CPU 8/82 ) HEX : CPU CREATE C, DOES> C@ C, MEM ; 00 CPU BRK, 18 CPU CLC, DE CPU CLD, 58 CPU CLI, B8 CPU CLV, CA CPU DEX, 88 CPU DEY, E8 CPU INX, C8 CPU INY, EA CPU NOP, 48 CPU PHA, 08 CPU PHP, 68 CPU PLA, 28 CPU PLP, 40 CPU RTI, 60 CPU RTS, 38 CPU SEC, F8 CPU SED, 78 CPU SEI, AA CPU TAX, A8 CPU TAY, BA CPU TSX, 8A CPU TXA, 9A CPU TXS, 98 CPU TYA, DECIMAL ( ASSEMBLER: M/CPU 8/82 )HEX : M/CPU CREATE C, , DOES> DUP 1+ @ 80 AND IF 10 MODE +! THEN OVER FF00 AND UPMODE UPMODE IF MEM CR LATEST ID. ABORT" INCORRECT ADDRESSING" THEN C@ MODE C@ INDEX + C@ + C, MODE C@ 7 AND IF MODE C@ 0F AND 7 < IF C, ELSE , THEN THEN MEM ; 1C6E 60 M/CPU ADC, 1C6E 20 M/CPU AND, 1C6E C0 M/CPU CMP, 1C6E 40 M/CPU EOR, 1C6E A0 M/CPU LDA, 1C6E 00 M/CPU ORA, 1C6E E0 M/CPU SBC, 1C6C 80 M/CPU STA, 0D0D 01 M/CPU ASL, 0C0C C1 M/CPU DEC, 0C0C E1 M/CPU INC, 0D0D 41 M/CPU LSR, 0D0D 21 M/CPU ROL, 0D0D 61 M/CPU ROR, 0414 81 M/CPU STX, 0486 E0 M/CPU CPX, 0486 C0 M/CPU CPY, 1496 A2 M/CPU LDX, 0C8E A0 M/CPU LDY, 048C 80 M/CPU STY, 0480 14 M/CPU JSR, 8480 40 M/CPU JMP, 0484 20 M/CPU BIT, DECIMAL ( ASSEMBLER: BEGIN, UNTIL, IF, THEN, ELSE, NOT BRANCHS 9/82 ): BEGIN, HERE 1 ; : UNTIL, >R 1 ?PAIRS R> C, HERE 1+ - C, ; : IF, C, HERE 0 C, 2 ; : THEN, 2 ?PAIRS HERE OVER C@ IF SWAP ! ELSE OVER 1+ - SWAP C! THEN ; : ELSE, 2 ?PAIRS HERE 1+ 1 JMP, SWAP HERE OVER 1+ - SWAP C! 2 ; HEX : NOT 20 + ; ( REVERSE ASSEMBLY TEST )90 CONSTANT CS ( ASSEMBLE TEST FOR CARRY SET )D0 CONSTANT 0= ( ASSEMBLER TEST FOR EQUAL ZERO )10 CONSTANT 0< ( ASSEMBLE TEST FOR LESS THAN ZERO )90 CONSTANT >= ( ASSEMBLE TEST FOR GREATER OR EQUAL ZERO ) ( >= IS ONLY CORRECT AFTER SUB, OR CMP, )50 CONSTANT VS DECIMAL ( TEST OVERFLOW SET ) ( ASSEMBLER: AGAIN, WHILE, REPEAT, 8/82 ) : AGAIN, 1 ?PAIRS JMP, ; : WHILE, >R DUP 1 ?PAIRS R> IF, 2+ ; : REPEAT, >R >R 1 ?PAIRS JMP, R> R> 2 - THEN, ; ( ASSEMBLER: END-CODE ENTERCODE ;CODE CODE 8/82 ): END-CODE CURRENT @ CONTEXT ! SP@ 2+ = IF SMUDGE ELSE ." CODE ERROR, STACK DEPTH CHANGE" THEN ; FORTH DEFINITIONS : ENTERCODE [COMPILE] ASSEMBLER SP@ ; : CODE CREATE SMUDGE HERE DUP 2- ! ASSEMBLER MEM ENTERCODE ; IMMEDIATE : ;CODE ?CSP COMPILE <;CODE> [COMPILE] [ ENTERCODE ; IMMEDIATE DECIMAL EXIT ( THIS 6502 FORTH ASSEMBLER WAS WRITTEN BY WILLIAM F. RAGSDALE )( IT WAS PUBLISHED IN "DR. DOBB'S JOURNAL", #59, SEPT. 1981 )( AND IN "FORTH DIMENSIONS", VOL. III, #5 ) ( EDITOR: LINE 8/82 ) FORTH DEFINITIONS HEX : LINE DUP FFF0 AND ABORT" NOT ON CURRENT EDITING SCREEN" SCR @ DROP ; DECIMAL ( EDITOR: MATCH 8/82 ) : ?DUP IF OVER + SWAP DO DUP C@ I C@ - IF 0= LEAVE ELSE 1+ THEN LOOP ELSE DROP 0= THEN ; : MATCH >R >R DDUP R> R> DSWAP OVER + SWAP DO DDUP I SWAP IF >R DDROP R> - I SWAP - 0 SWAP 0 0 LEAVE THEN LOOP DDROP SWAP 0= SWAP ; ( EDITOR: WIPE EDITOR #LOCATE #LEAD 8/82 ): WIPE SCR @ CLEAR ; VOCABULARY EDITOR IMMEDIATE EDITOR DEFINITIONS : #LOCATE R# @ C/L /MOD ; : #LEAD #LOCATE LINE SWAP ; ( EDITOR: #LAG -MOVE BUF-MOVEE 8/82 ) : #LAG #LEAD DUP >R + C/L R> - ; : -MOVE LINE C/L CMOVE UPDATE ; : BUF-MOVE HERE C@ IF PAD SWAP C/L 1+ CMOVE ELSE DROP THEN ; ( EDITOR: >LINE# FIND-BUF INSERT-BUF 8/82 ) : >LINE# #LOCATE SWAP DROP ; HEX : FIND-BUF PAD 50 + ; : INSERT-BUF FIND-BUF 50 + ; DECIMAL : LINE INSERT-BUF 1+ C/L DUP INSERT-BUF C! CMOVE ; ( EDITOR: X 8/82 ) : LINE C/L BLANK UPDATE ; HEX : >LINE# DUP 0E DO I LINE I 1+ -MOVE -1 +LOOP ; : X >LINE# DUP 0F DUP ROT DO I 1+ LINE I -MOVE LOOP ; DECIMAL ( EDITOR: DISPLAY-CURSOR T L N 8/82 )HEX : DISPLAY-CURSOR CR SPACE #LEAD TYPE 5E EMIT #LAG TYPE #LOCATE 2 .R SPACE DROP ; DECIMAL : T C/L * R# ! DISPLAY-CURSOR ; : L SCR @ LIST DISPLAY-CURSOR ; : N 1 SCR +! ; ( EDITOR: B SEEK-ERROR 8/82 ) : B -1 SCR +! ; : 0 R# ! ; : SEEK-ERROR FIND-BUF HERE C/L 1+ CMOVE HERE COUNT TYPE ." NONE" QUIT ; : >LINE# INSERT-BUF 1+ SWAP -MOVE ; ( EDITOR: P 1LINE 8/82 )HEX : P 5E TEXT INSERT-BUF BUF-MOVE ; DECIMAL : 1LINE #LAG FIND-BUF COUNT MATCH R# +! ; ( EDITOR: F 8/82 )HEX : BEGIN 3FF R# @ < IF SEEK-ERROR THEN 1LINE UNTIL ; : >R #LAG + R@ - #LAG R@ NEGATE R# +! #LEAD + SWAP CMOVE R> BLANK UPDATE ; : 5E TEXT FIND-BUF BUF-MOVE ; DECIMAL : F DISPLAY-CURSOR ; ( EDITOR: E D TILL 8/82 ) : FIND-BUF C@ ; : E DISPLAY-CURSOR ; : D E ; HEX : TILL #LEAD + 5E TEXT FIND-BUF BUF-MOVE 1LINE 0= IF SEEK-ERROR THEN #LEAD + SWAP - DISPLAY-CURSOR ; DECIMAL ( EDITOR: COUNTER BUMP S 8/82 ) VARIABLE COUNTER 0 COUNTER ! HEX : BUMP 1 COUNTER +! COUNTER @ 38 > IF 0 COUNTER ! CR CR 0C EMIT THEN ; : S 0C EMIT 5E TEXT 0 COUNTER ! FIND-BUF BUF-MOVE SCR @ DUP >R DO I SCR ! BEGIN 1LINE IF DISPLAY-CURSOR SCR ? BUMP THEN 3FF R# @ < ?TERMINAL IF I ELSE 0 THEN OR UNTIL PAUSE ?TERMINAL IF KEY DROP LEAVE THEN LOOP R> SCR ! ; DECIMAL ( EDITOR: I U R 8/82 )HEX : I 5E TEXT INSERT-BUF BUF-MOVE INSERT-BUF COUNT #LAG ROT OVER MIN >R R@ R# +! R@ - >R DUP HERE R@ CMOVE HERE #LEAD + R> CMOVE R> CMOVE UPDATE DISPLAY-CURSOR ; : U C/L R# +! P ; : R I ; DECIMAL ( EDITOR: M 8/82 ) : M SCR @ >R R# @ >R >LINE# SWAP SCR ! 1+ C/L * R# ! R> C/L + R# ! R> SCR ! ; FORTH DEFINITIONS EXIT ( THIS LINE EDITOR WAS WRITTEN BY SAM H. DANIEL ) ( AND WAS PUBLISHED IN "FORTH DIMENSIONS", VOL. III, #3 ) ( APPLE ][ UTILITIES: CALL VHTAB ? 8/82 ) HEX CODE CALL 20 # LDA, N 1 - STA, BOT LDA, N STA, BOT 1+ LDA, N 1+ STA, 60 # LDA, N 2+ STA, INX, INX, TXA, PHA, N 1 - JSR, PLA, TAX, NEXT JMP, END-CODE DECIMAL : VHTAB 39 MIN 0 MAX 36 C! 23 MIN 0 MAX 37 C! -990 CALL ; : ? ." (Y/N)? " 37 C@ 36 C@ BEGIN OVER OVER VHTAB KEY DUP EMIT DUP 89 = IF DROP DROP DROP 1 1 ELSE 78 = IF DROP DROP 0 1 ELSE 0 THEN THEN UNTIL ; ( APPLE ][ UTILITIES: INITDISK 8/82 ) : INITDISK CR CR ." BLANK DISK IN DRV1 " ? IF 1 47083 C! 1 4 1 1 1 1 SPT 13 = CR CR ." FORMATTING" CR CR IF 13RWTS ELSE 16RWTS THEN IF -348 CALL 135 EMIT ." FORMAT ERROR" -380 CALL QUIT ELSE ." ERASING" CR THEN 0 47083 C! SPT PAD 1024 BL FILL BPDRV 0 DO PAD I 0 R/W LOOP THEN ; ( APPLE ][ UTILITIES: COPYDISK 8/82 ): COPYDISK CR CR ." READS DRV1" CR CR ." WRITES ON DRV2" CR CR ." DO YOU MEAN IT " ? IF BPDRV 4 * LIMIT PAD - 0 256 U/MOD SWAP DROP DUP NEGATE BEGIN OVER + 3 PICK 3 PICK 3 PICK + < IF SWAP DROP OVER OVER - SWAP THEN PAD 0 2 4 PICK SPT /MOD 7 PICK 6 PICK 1 1 6 PICK 6 PICK 6 PICK 13/16RWTS 13/16RWTS 3 PICK 3 PICK 3 PICK + = UNTIL DROP DROP DROP THEN ; ( APPLE ][ UTILITIES: DRV1 -> DRV5 8/82 ) : DRV1 DR0 ; : DRV2 DR1 ; : DRV3 DR2 ; : DRV4 DR3 ; : DRV5 DR4 ; ( APPLE ][ UTILITIES: SAVE-FORTH 2/83 ) : SAVE-FORTH CR CR ." OPERATING SYSTEM DISK IN DRV1 " ? IF SAVE-FORTH THEN ; ( APPLE ][ Graphics, MODE Ideograms 1/83 )FORTH DEFINITIONS VOCABULARY GRAPHICS GRAPHICS DEFINITIONS HEX : GRAPHMODE C050 C@ DROP ; ( APPLE ][ Screen Soft Switches ) : TEXTMODE C051 C@ DROP ; ( Modal pairs toggled by reads ) : ALLMODE C052 C@ DROP ; : MIXMODE C053 C@ DROP ; : PAGEONE C054 C@ DROP ; : PAGETWO C055 C@ DROP ; : LORES C056 C@ DROP ; : HIRES C057 C@ DROP ; DECIMAL ( APPLE ][ Graphics, Display Ideograms 1/83 )( All these ideograms are used without effect on the stacks. )( Note that the MIXed modes will display terminal text in last )( four lines of the screen. ALLMODE requires typing blind. )HEX : LO1TXT TEXTMODE ALLMODE LORES PAGEONE ; : LO1MIX GRAPHMODE MIXMODE LORES PAGEONE ; : HI1MIX GRAPHMODE MIXMODE HIRES PAGEONE ; : HI1GRPH GRAPHMODE ALLMODE HIRES PAGEONE ; : HI1BLK 4000 2000 DO 0 I ! 2 +LOOP ; ( Clears screen to ) : HI1WHT 4000 2000 DO -1 I ! 2 +LOOP ; ( black or white. ) : HI2GRPH GRAPHMODE ALLMODE HIRES PAGETWO ; : HI2BLK 6000 4000 DO 0 I ! 2 +LOOP ; : HI2WHT 6000 4000 DO -1 I ! 2 +LOOP ; DECIMAL ( APPLE ][ Graphics, LORESADDR HIRESADDR 1/83 )HEX : LORESADDR ( col line ---, addr ) ( col = 0 -> $27, line = 0 -> $17 ) 8 /MOD ( addr = $000 -> $3F7 ) 28 * SWAP 80 * + SWAP + ; : HIRESADDR ( col line ---, bit addr ) ( col = 0 -> $117, line = 0 -> $BF) SWAP 7 /MOD ROT ( bit = 0 -> 6 ) 8 /MOD ( addr = $0000 -> $1FF7 ) SWAP 400 * ROT ROT LORESADDR + ; DECIMAL ( APPLE ][ Graphics, BITABLE BIT HIPLOT HI1PLT HI2PLT 1/83 )HEX VARIABLE BITABLE 1 BITABLE ! 2 , 4 , 8 , 10 , 20 , 40 , 80 , : BIT ( n ---, 2 exp n ) 2* BITABLE + @ ; : HIPLOT ( bit addr ---, ) DUP ROT BIT ROT C@ OR SWAP C! ; : HI1PLT ( col line ---, ) HIRESADDR 2000 + HIPLOT ; : HI2PLT ( col line ---, ) HIRESADDR 4000 + HIPLOT ; DECIMAL �z#( THE LINES 0 TO 3 ABOVE CONTAIN ) ( A VTOC FOR USE BY MOST COPY ) ( PROGRAMS TO ENABLE THEM TO COPY ) ( A SCREENS DISK LIKE THIS ONE. ) ( IT CONTAINS 00 00 00 00 FOR ALL ) ( TRACK BIT MAPS. )