This page (revision-9) was last changed on 03-Jan-2024 15:28 by bartgo 

This page was created on 05-Apr-2010 20:16 by Carsten Strotmann

Only authorized users are allowed to rename pages.

Only authorized users are allowed to delete pages.

Page revision history

Version Date Modified Size Author Changes ... Change note
9 03-Jan-2024 15:28 29 KB bartgo to previous
8 03-Feb-2023 15:21 29 KB Roland B. Wassenberg to previous | to last
7 31-Mar-2021 17:29 29 KB Roland B. Wassenberg to previous | to last
6 11-Nov-2020 11:23 29 KB Carsten Strotmann to previous | to last
5 11-Nov-2020 11:21 28 KB Carsten Strotmann to previous | to last
4 24-Jul-2014 14:05 30 KB Roland B. Wassenberg to previous | to last
3 18-Jan-2013 17:22 29 KB Carsten Strotmann to previous | to last
2 05-Apr-2010 20:24 29 KB Carsten Strotmann to previous | to last
1 05-Apr-2010 20:16 29 KB Carsten Strotmann to last

Page References

Incoming links Outgoing links
Extended Atari FIG-Forth APX20029
Extended Atari FIG-Forth APX20029

Version management

Difference between version and

At line 1 removed one line
!!! EXTENDED Atari fig-FORTH, Cassette: APX-10029, Diskette: APX-20029 (Atari Program Exchange)
At line 2 added 2 lines
!!! Extended Atari FIG-Forth APX20029 (Atari Program Exchange)
At line 5 removed 31 lines
!! Disks
[Extended Atari FIG-Forth APX20029/APX Extended Fig Forth.atr]
!! Earlier versions
Earlier versions of this Forth were sold or otherwise distributed by the Author:
* "NMV Forth" (or: "NWV Forth"); lost
* "S*P*A*C*E Forth" ("s*p*a*c*e fig4th 1.1") ''(files to be amended)''
!! Official add-ons:
* fun-FORTH (APX-20146) - with manual ''(files to be amended / linked)''
* FORTH Turtle Graphics Plus (APX-20157) - with manual ''(files to be amended / linked)''
!! Manuals
[Extended Atari FIG-Forth APX20029/Extended fig-FORTH - APX APX-20029.pdf] size: 7.7 MB ; EXTENDED fig-FORTH, Rev. 1, 1981 by Patrick L. Mullarky\\
[EXTENDED fig-FORTH, Rev.2.pdf] size: 7.7 MB ; EXTENDED fig-FORTH, Rev. 2, Edition B, 1982 by Patrick L. Mullarky ; donated by Allan Bushman, thank you so much Allen in the name of the Atari community! :-)
!! Making APX Extended fig-FORTH Turn-key
It is possible to make APX Extended fig-FORTH (and most fig-FORTH implementations) execute a word upon boot.\\
For example, to make the interpreter execute the word MYPROGRAM, enter the following:\\
```\\
' MYPROGRAM CFA ' ABORT 4 + !\\
```\\
Followed by a\\
```\\
SAVE\\
```\\
At line 38 removed 17 lines
SCR # 14
0 ( ERROR MESSAGES )
1 Stack empty
2 Dictionary full
3 Wrong address mode
4 Isn't unique
5 Value error
6 Disk address error
7 Stack full
8 Disk Error!
9
10
11
12
13
14
15
At line 56 removed 36 lines
SCR # 15
0 ( ERROR MESSAGES )
1 Use only in Definitions
2 Execution only
3 Conditionals not paired
4 Definition not finished
5 In protected dictionary
6 Use only when loading
7 Off current screen
8 Declare VOCABULARY
9
10
11
12
13
14
15
SCR # 16
0
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
At line 111 changed 2 lines
0 ( FULL LOAD )
1
0 ( FULL LOAD ))))))))))))))))))))))))))))))))))))))))))))))))))))
1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
At line 179 changed 2 lines
14 -->
15
14 -->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
15 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
At line 262 changed one line
7 : .SETUP [COMPILE] ' ?DOCOL .WORD ! ;
7 : .SETUP ~[COMPILE] ' ?DOCOL .WORD ! ;
At line 295 changed one line
4 C@ - SPACES 1 2FE C! 1C EMIT 0 2FE C! [COMPILE] EDITOR QUIT ;
4 C@ - SPACES 1 2FE C! 1C EMIT 0 2FE C! ~[COMPILE] EDITOR QUIT ;
At line 319 changed 2 lines
10 -->
11
10 -->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
11 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
At line 327 changed 2 lines
0 ( EDITOR )
1
0 ( EDITOR )))))))))))))))))))))))))))))))))))))))))))))))))))))))
1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
At line 345 changed 2 lines
0 ( EDITOR )
1
0 ( EDITOR )))))))))))))))))))))))))))))))))))))))))))))))))))))))
1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
At line 383 changed 4 lines
2 : N FIND 0 M ;
3
4 : F 1 TEXT N ;
5
2 : N FIND 0 M ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4 : F 1 TEXT NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN
5 NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN
At line 513 changed one line
6 : CODE [COMPILE] ASSEMBLER
6 : CODE ~[COMPILE] ASSEMBLER
At line 557 changed one line
14 : ENDIF, [COMPILE] THEN, ; IMMEDIATE
14 : ENDIF, ~[COMPILE] THEN, ; IMMEDIATE
At line 576 changed one line
15 : UNTIL, [COMPILE] END, ; IMMEDIATE -->
15 : UNTIL, ~[COMPILE] END, ; IMMEDIATE -->
At line 597 changed 2 lines
0 BjDISKNAMEDAT
1
0 B jDISKNAMEDAT
1
At line 600 changed one line
3 J
3 J
At line 617 changed one line
2 : X) 01 MODE ! ; ( [ADDR,X] )
2 : X) 01 MODE ! ; ( ~[ADDR,X] )
At line 619 changed one line
4 : )Y 11 MODE ! ; ( [ADDR],Y )
4 : )Y 11 MODE ! ; ( ~[ADDR],Y )
At line 643 changed 6 lines
10 : OPCODE C@ ZPAGE XYMODE IF 10
11 OR THEN ;
12 : M2 <BUILDS C, DOES> OPCODE
13 MODE @ 9 = IF 4 - THEN
14 STOREADD ;
15
10 1D = IF 10 ELSE 0 THEN OR
11 ZPAGE STOREADD ;
12
13 0E M1 ASL, 2E M1 ROL, 4E M1 LSR,
14 6E M1 ROR, CE M1 DEC, EE M1 INC,
15 -->
At line 651 changed 16 lines
0 AC M2 LDY, AE M2 LDX,
1 CC M2 CPY, EC M2 CPX,
2
3 : M3 <BUILDS C, DOES> OPCODE
4 STOREADD ;
5
6 8C M3 STY, 8E M3 STX,
7 -->
8 ( END OF ASSEMBLER )
9
10 FORTH DEFINITIONS
11
12
13 LATEST 0C +ORIGIN ! ( NTOP )
14
15 HERE 1C +ORIGIN ! ( FENCE )
0 ( ASSEMBLER )
1
2 : OPCODE C@ ZPAGE XYMODE IF 10
3 OR THEN ;
4 : M2 <BUILDS C, DOES> OPCODE
5 MODE @ 9 = IF 4 - THEN
6 STOREADD ;
7
8 AC M2 LDY, AE M2 LDX,
9 CC M2 CPY, EC M2 CPX,
10
11 : M3 <BUILDS C, DOES> OPCODE
12 STOREADD ;
13
14 8C M3 STY, 8E M3 STX,
15 -->
At line 669 changed 3 lines
0
1 HERE 1E +ORIGIN ! ( DP )
2
0 ( END OF ASSEMBLER )
1
2 FORTH DEFINITIONS
At line 674 changed one line
5
5 LATEST 0C +ORIGIN ! ( NTOP )
At line 676 changed 6 lines
7 BASE ! ;S
8 ( COLOR COMMANDS )
9 BASE @ HEX
10 : SETCOLOR 2 * SWAP 10 * OR SWAP
11 02C4 ( COLPF0 ) + C! ;
12 : SE. SETCOLOR ; ( ALIAS )
7 HERE 1C +ORIGIN ! ( FENCE )
8
9 HERE 1E +ORIGIN ! ( DP )
10
11
12
At line 683 changed 2 lines
14 ( REGISTER#-3, COLOR-2, LUM-1
15
14
15 BASE ! ;S
At line 687 changed 5 lines
0 ( 0-3 0-F 0-7
1
2 -->
3
4
0 ( COLOR COMMANDS )
1 BASE @ HEX
2 : SETCOLOR 2 * SWAP 10 * OR SWAP
3 02C4 ( COLPF0 ) + C! ;
4 : SE. SETCOLOR ; ( ALIAS )
At line 693 changed one line
6
6 ( REGISTER#-3, COLOR-2, LUM-1
At line 695 changed 5 lines
8 ( GRAPHICS COMMANDS )
9 E456 CONSTANT CIO
10 1C VARIABLE MASK
11 340 CONSTANT IOCX
12 53 VARIABLE SNAME
8 ( 0-3 0-F 0-7
9
10 -->
11
12
At line 701 changed 2 lines
14 CODE GR. 1 # LDA, GFLAG STA,
15 XSAVE STX, 0 ,X LDA,
14
15
At line 705 changed 16 lines
0 # 30 LDX, IOCX 0B + ,X STA,
1 # 3 LDA, IOCX 2 + ,X STA,
2 SNAME FF AND # LDA, IOCX 4 + ,X
3 STA, SNAME 100 / # LDA,
4 IOCX 5 + ,X STA, MASK LDA,
5 IOCX 0A + ,X STA, CIO JSR,
6 XSAVE LDX, 0 # LDY, POP JMP,
7 -->
8 ( GRAPHICS COMMANDS )
9
10 CODE &GR XSAVE STX, # 30 LDX,
11 # C LDA, IOCX 2 +
12 ,X STA, CIO JSR,
13 XSAVE LDX, 0 # LDA,
14 GFLAG STA, NEXT JMP,
15
0 ( GRAPHICS COMMANDS )
1 E456 CONSTANT CIO
2 1C VARIABLE MASK
3 340 CONSTANT IOCX
4 53 VARIABLE SNAME
5
6 CODE GR. 1 # LDA, GFLAG STA,
7 XSAVE STX, 0 ,X LDA,
8 # 30 LDX, IOCX 0B + ,X STA,
9 # 3 LDA, IOCX 2 + ,X STA,
10 SNAME FF AND # LDA, IOCX 4 + ,X
11 STA, SNAME 100 / # LDA,
12 IOCX 5 + ,X STA, MASK LDA,
13 IOCX 0A + ,X STA, CIO JSR,
14 XSAVE LDX, 0 # LDY, POP JMP,
15 -->
At line 723 changed 7 lines
0 : XGR &GR 0 GR. &GR ;
1 ( EXIT GRAPHICS MODE )
2
3 -->
4
5
6
0 ( GRAPHICS COMMANDS )
1
2 CODE &GR XSAVE STX, # 30 LDX,
3 # C LDA, IOCX 2 +
4 ,X STA, CIO JSR,
5 XSAVE LDX, 0 # LDA,
6 GFLAG STA, NEXT JMP,
At line 731 changed 8 lines
8 ( GRAPHICS I/O )
9
10 CODE CPUT 0 ,X LDA, PHA,
11 XSAVE STX, # 30 LDX,
12 # B LDA, IOCX 2 + ,X STA, TYA,
13 IOCX 8 + ,X STA, IOCX 9 + ,X
14 STA, PLA, CIO JSR, XSAVE LDX,
15 POP JMP,
8 : XGR &GR 0 GR. &GR ;
9 ( EXIT GRAPHICS MODE )
10
11 -->
12
13
14
15
At line 741 changed 16 lines
0
1 54 CONSTANT ROWCRS
2 55 CONSTANT COLCRS
3
4 : POS ROWCRS C! COLCRS ! ;
5 : PLOT POS CPUT ;
6
7 -->
8 ( GRAPHICS I/O )
9
10 : GTYPE -DUP IF OVER + SWAP
11 DO I C@ CPUT LOOP ELSE
12 DROP ENDIF ;
13
14 : (G") R COUNT DUP 1+ R> + >R
15 GTYPE ;
0 ( GRAPHICS I/O )))))))))))))))))))))))))))))))))))))))))))))))))
1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
2 CODE CPUT 0 ,X LDA, PHA,
3 XSAVE STX, # 30 LDX,
4 # B LDA, IOCX 2 + ,X STA, TYA,
5 IOCX 8 + ,X STA, IOCX 9 + ,X
6 STA, PLA, CIO JSR, XSAVE LDX,
7 POP JMP,
8
9 54 CONSTANT ROWCRS
10 55 CONSTANT COLCRS
11
12 : POS ROWCRS C! COLCRS ! ;
13 : PLOT POS CPUT ;
14
15 -->
At line 759 changed 5 lines
0
1 : G" 22 STATE @ IF COMPILE (G")
2 WORD HERE C@ 1+ ALLOT
3 ELSE WORD HERE COUNT GTYPE
4 ENDIF ; IMMEDIATE
0 ( GRAPHICS I/O )
1
2 : GTYPE -DUP IF OVER + SWAP
3 DO I C@ CPUT LOOP ELSE
4 DROP ENDIF ;
At line 765 changed 10 lines
6
7 -->
8 ( DRAW, FIL )
9
10 2FB CONSTANT ATACHR
11 2FD CONSTANT FILDAT
12
13 CODE GCOM XSAVE STX, 0 ,X LDA,
14 # 30 LDX, IOCX 2 + ,X STA,
15 CIO JSR, XSAVE LDX, POP JMP,
6 : (G") R COUNT DUP 1+ R> + >R
7 GTYPE ;
8
9 : G" 22 STATE @ IF COMPILE (G")
10 WORD HERE C@ 1+ ALLOT
11 ELSE WORD HERE COUNT GTYPE
12 ENDIF ; IMMEDIATE
13
14
15 -->
At line 777 changed 4 lines
0
1 : DRAW POS ATACHR C! 11 GCOM ;
2
3 : FIL FILDAT C! 12 GCOM ;
0 ( DRAW, FIL )
1
2 2FB CONSTANT ATACHR
3 2FD CONSTANT FILDAT
At line 782 changed 5 lines
5
6 BASE ! ;S
7
8 ( SOUND COMMANDS )
9 BASE @ HEX
5 CODE GCOM XSAVE STX, 0 ,X LDA,
6 # 30 LDX, IOCX 2 + ,X STA,
7 CIO JSR, XSAVE LDX, POP JMP,
8
9 : DRAW POS ATACHR C! 11 GCOM ;
At line 788 changed 2 lines
11 D208 CONSTANT AUDCTL
12 D200 CONSTANT AUDBASE
11 : FIL FILDAT C! 12 GCOM ;
12
At line 791 changed 2 lines
14 : SOUND ( CH# FREQ DIST VOL --- )
15 3 DUP 0D20F C! 232 C!
14 BASE ! ;SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
15 SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
At line 795 changed 2 lines
0 SWAP 16 * + ROT DUP + AUDBASE +
1 ROT OVER C! 1+ C! ;
0 ( SOUND COMMANDS )
1 BASE @ HEX
At line 798 changed 2 lines
3 : FILTER! AUDCTL C! ;
4 ( N --- )
3 D208 CONSTANT AUDCTL
4 D200 CONSTANT AUDBASE
At line 801 changed 7 lines
6
7 BASE ! ;S
8 ( GRAPHICS TESTS )
9
10 : BOX 0 10 10 PLOT 1 50 10 DRAW
11 1 50 25 DRAW 1 10 25 DRAW
12 1 10 10 DRAW ;
6 : SOUND ( CH# FREQ DIST VOL --- )
7 3 DUP 0D20F C! 232 C!
8 SWAP 16 * + ROT DUP + AUDBASE +
9 ROT OVER C! 1+ C! ;
10
11 : FILTER! AUDCTL C! ;
12 ( N --- )
At line 809 changed 2 lines
14 : FBOX XGR 5 GR. BOX
15 10 25 POS 2 FIL ;
14
15 BASE ! ;S
At line 813 changed one line
0
0 ( GRAPHICS TESTS )
At line 815 changed 3 lines
2
3
4
2 : BOX 0 10 10 PLOT 1 50 10 DRAW
3 1 50 25 DRAW 1 10 25 DRAW
4 1 10 10 DRAW ;
At line 819 changed 3 lines
6
7
8 ( DOS OBJECT READER )
6 : FBOX XGR 5 GR. BOX
7 10 25 POS 2 FIL ;
8
At line 823 changed one line
10 BASE @ HEX
10
At line 825 changed 4 lines
12 0 VARIABLE BLOCK# 0 VARIABLE BYTES 0 VARIABLE BYTPTR
13 0 VARIABLE ADDRSS 0 VARIABLE #BYTES
14 : GETCOUNT 7F + C@ 7F AND BYTES ! 0 BYTPTR ! ;
15 : FNEXTBLK 7D + DUP C@ 100 * SWAP 1+ C@ + 3FF AND 1 - ;
12
13
14
15
At line 831 changed 16 lines
0 : LINKBLOCK FNEXTBLK
1 DUP BLOCK# ! DUP 0 > IF BLOCK THEN ;
2 : BLK-CK BYTES @ 0= IF BLOCK# @ BLOCK LINKBLOCK
3 GETCOUNT THEN ;
4 : NEXTBYTE BLK-CK -1 BYTES +! BYTPTR @ 1 BYTPTR +!
5 BLOCK# @ BLOCK + C@ ;
6 : NEXTWORD NEXTBYTE NEXTBYTE 100 * + ;
7 -->
8 ( DOS OBJECT READER )
9
10 : ADRCALC NEXTWORD DUP ADDRSS ! NEXTWORD SWAP - 1+ #BYTES ! ;
11
12 : BLOCKSET DUP BLOCK# ! BLOCK GETCOUNT ;
13
14 : LOADOBJ BLOCKSET NEXTWORD 1+ IF CR ." Not an Object file"
15 CR QUIT THEN
0 ( DOS OBJECT READER )
1
2 BASE @ HEX
3
4 0 VARIABLE BLOCK# 0 VARIABLE BYTES 0 VARIABLE BYTPTR
5 0 VARIABLE ADDRSS 0 VARIABLE #BYTES
6 : GETCOUNT 7F + C@ 7F AND BYTES ! 0 BYTPTR ! ;
7 : FNEXTBLK 7D + DUP C@ 100 * SWAP 1+ C@ + 3FF AND 1 - ;
8 : LINKBLOCK FNEXTBLK
9 DUP BLOCK# ! DUP 0 > IF BLOCK THEN ;
10 : BLK-CK BYTES @ 0= IF BLOCK# @ BLOCK LINKBLOCK
11 GETCOUNT THEN ;
12 : NEXTBYTE BLK-CK -1 BYTES +! BYTPTR @ 1 BYTPTR +!
13 BLOCK# @ BLOCK + C@ ;
14 : NEXTWORD NEXTBYTE NEXTBYTE 100 * + ;
15 -->
At line 849 changed 5 lines
0 BEGIN
1 ADRCALC
2 #BYTES @ 0 DO NEXTBYTE ADDRSS @ C! 1 ADDRSS +! LOOP
3 BLOCK# @ BLOCK FNEXTBLK
4 1+ 0= BYTES @ 0= AND END ;
0 ( DOS OBJECT READER )
1
2 : ADRCALC NEXTWORD DUP ADDRSS ! NEXTWORD SWAP - 1+ #BYTES ! ;
3
4 : BLOCKSET DUP BLOCK# ! BLOCK GETCOUNT ;
At line 855 changed 10 lines
6
7 BASE ! ;S
8 ( FLOATING POINT WORDS )
9 BASE @ HEX
10 : FDROP DROP DROP DROP ;
11 : FDUP >R >R DUP R> DUP ROT
12 SWAP R ROT ROT R> ;
13 CODE FSWAP
14 XSAVE STX, # 6 LDY,
15 BEGIN, 0 ,X LDA, PHA, INX, DEY,
6 : LOADOBJ BLOCKSET NEXTWORD 1+ IF CR ." Not an Object file"
7 CR QUIT THEN
8 BEGIN
9 ADRCALC
10 #BYTES @ 0 DO NEXTBYTE ADDRSS @ C! 1 ADDRSS +! LOOP
11 BLOCK# @ BLOCK FNEXTBLK
12 1+ 0= BYTES @ 0= AND END ;
13
14
15 BASE ! ;S
At line 867 changed 16 lines
0 0= END, XSAVE LDX, # 6 LDY,
1 BEGIN, 6 ,X LDA, 0 ,X STA, INX,
2 DEY, 0= END, XSAVE LDX, # 6 LDY,
3 BEGIN, PLA, 0B ,X STA, DEX, DEY,
4 0= END, XSAVE LDX, NEXT JMP,
5
6 XSAVE 100 * 86 + CONSTANT XSAV
7 : XS, XSAV , ; -->
8 ( FLOATING POINT WORDS )
9 CODE FOVER DEX, DEX, DEX,
10 DEX, DEX, DEX, XSAVE STX,
11 # 6 LDY, BEGIN, 0C ,X LDA,
12 0 ,X STA, INX, DEY, 0= END,
13 XSAVE LDX, NEXT JMP,
14
15 XSAVE 100 * A6 + CONSTANT XLD
0 ( FLOATING POINT WORDS )
1 BASE @ HEX
2 : FDROP DROP DROP DROP ;
3 : FDUP >R >R DUP R> DUP ROT
4 SWAP R ROT ROT R> ;
5 CODE FSWAP
6 XSAVE STX, # 6 LDY,
7 BEGIN, 0 ,X LDA, PHA, INX, DEY,
8 0= END, XSAVE LDX, # 6 LDY,
9 BEGIN, 6 ,X LDA, 0 ,X STA, INX,
10 DEY, 0= END, XSAVE LDX, # 6 LDY,
11 BEGIN, PLA, 0B ,X STA, DEX, DEY,
12 0= END, XSAVE LDX, NEXT JMP,
13
14 XSAVE 100 * 86 + CONSTANT XSAV
15 : XS, XSAV , ; -->
At line 885 changed 6 lines
0 : XL, XLD , ;
1
2 CODE AFP XS, D800 JSR, XL, NEXT JMP,
3 CODE FASC XS, D8E6 JSR, XL, NEXT JMP,
4 CODE IFP XS, D9AA JSR, XL, NEXT JMP, -->
5
0 ( FLOATING POINT WORDS )
1 CODE FOVER DEX, DEX, DEX,
2 DEX, DEX, DEX, XSAVE STX,
3 # 6 LDY, BEGIN, 0C ,X LDA,
4 0 ,X STA, INX, DEY, 0= END,
5 XSAVE LDX, NEXT JMP,
At line 892 changed 2 lines
7
8 ( FLOATING POINT WORDS )
7 XSAVE 100 * A6 + CONSTANT XLD
8 : XL, XLD , ;
At line 895 changed 6 lines
10 CODE FPI XS, D9D2 JSR, XL, NEXT JMP,
11 CODE FADD XS, DA66 JSR, XL, NEXT JMP,
12 CODE FSUB XS, DA60 JSR, XL, NEXT JMP,
13 CODE FMUL XS, DADB JSR, XL, NEXT JMP,
14 CODE FDIV XS, DB28 JSR, XL, NEXT JMP,
15 CODE FLG XS, DECD JSR, XL, NEXT JMP,
10 CODE AFP XS, D800 JSR, XL, NEXT JMP,
11 CODE FASC XS, D8E6 JSR, XL, NEXT JMP,
12 CODE IFP XS, D9AA JSR, XL, NEXT JMP, -->
13
14
15
At line 903 changed 15 lines
0 CODE FLG10 XS, DED1 JSR, XL, NEXT JMP,
1 CODE FEX XS, DDC0 JSR, XL, NEXT JMP,
2 CODE FEX10 XS, DDCC JSR, XL, NEXT JMP,
3 CODE FPOLY XS, DD40 JSR, XL, NEXT JMP,
4 -->
5
6
7
8 ( FLOATING POINT WORDS )
9
10 D4 CONSTANT FR0
11 E0 CONSTANT FR1
12 FC CONSTANT FLPTR
13 F3 CONSTANT INBUF
14 F2 CONSTANT CIX
0 ( FLOATING POINT WORDS )
1
2 CODE FPI XS, D9D2 JSR, XL, NEXT JMP,
3 CODE FADD XS, DA66 JSR, XL, NEXT JMP,
4 CODE FSUB XS, DA60 JSR, XL, NEXT JMP,
5 CODE FMUL XS, DADB JSR, XL, NEXT JMP,
6 CODE FDIV XS, DB28 JSR, XL, NEXT JMP,
7 CODE FLG XS, DECD JSR, XL, NEXT JMP,
8 CODE FLG10 XS, DED1 JSR, XL, NEXT JMP,
9 CODE FEX XS, DDC0 JSR, XL, NEXT JMP,
10 CODE FEX10 XS, DDCC JSR, XL, NEXT JMP,
11 CODE FPOLY XS, DD40 JSR, XL, NEXT JMP,
12 -->
13
14
At line 921 changed one line
0 -->
0 ( FLOATING POINT WORDS )
At line 923 changed 5 lines
2
3
4
5
6
2 D4 CONSTANT FR0
3 E0 CONSTANT FR1
4 FC CONSTANT FLPTR
5 F3 CONSTANT INBUF
6 F2 CONSTANT CIX
At line 929 changed one line
8 ( FLOATING POINT )
8 -->
At line 931 changed 2 lines
10 : F@ >R R @ R 2+ @ R> 4 + @ ;
11 : F! >R R 4 + ! R 2+ ! R> ! ;
10
11
At line 934 changed 3 lines
13 : F.TY BEGIN INBUF @ C@ DUP
14 7F AND EMIT 1 INBUF +!
15 80 > UNTIL ;
13
14
15
At line 939 changed one line
0
0 ( FLOATING POINT )
At line 941 changed 7 lines
2 : F. FR0 F@ FSWAP FR0 F! FASC
3 F.TY SPACE FR0 F! ;
4 : F? F@ F. ;
5
6 -->
7
8 ( FLOATING POINT )
2 : F@ >R R @ R 2+ @ R> 4 + @ ;
3 : F! >R R 4 + ! R 2+ ! R> ! ;
4
5 : F.TY BEGIN INBUF @ C@ DUP
6 7F AND EMIT 1 INBUF +!
7 80 > UNTIL ;
8
At line 949 changed 3 lines
10 : <F FR1 F! FR0 F! ;
11 : F> FR0 F@ ;
12 : FS FR0 F! ;
10 : F. FR0 F@ FSWAP FR0 F! FASC
11 F.TY SPACE FR0 F! ;
12 : F? F@ F. ;
At line 953 changed 2 lines
14 : F+ <F FADD F> ;
15 : F- <F FSUB F> ;
14 -->
15
At line 957 changed 16 lines
0 : F* <F FMUL F> ;
1 : F/ <F FDIV F> ;
2 : FLOAT FR0 ! IFP F> ;
3 : FIX FS FPI FR0 @ ;
4 : FLOG FS FLG F> ;
5 : FLOG10 FS FLG10 F> ;
6 : FEXP FS FEX F> ;
7 : FEXP10 FS FEX10 F> ; -->
8 ( FLOATING POINT )
9
10 : ASCF 0 CIX ! INBUF ! AFP F> ;
11
12 : FLIT R> DUP 6 + >R F@ ;
13 : FLITERAL STATE @ IF
14 COMPILE FLIT HERE F! 6 ALLOT
15 ENDIF ;
0 ( FLOATING POINT )
1
2 : <F FR1 F! FR0 F! ;
3 : F> FR0 F@ ;
4 : FS FR0 F! ;
5
6 : F+ <F FADD F> ;
7 : F- <F FSUB F> ;
8 : F* <F FMUL F> ;
9 : F/ <F FDIV F> ;
10 : FLOAT FR0 ! IFP F> ;
11 : FIX FS FPI FR0 @ ;
12 : FLOG FS FLG F> ;
13 : FLOG10 FS FLG10 F> ;
14 : FEXP FS FEX F> ;
15 : FEXP10 FS FEX10 F> ; -->
At line 975 changed 16 lines
0 : FLOATING ( FLOAT FOLLOWING CONSTANT )
1 BL WORD HERE 1+ ASCF
2 FLITERAL ; IMMEDIATE
3 ( EX: FLOATING 1.2345 )
4 ( OR FLOATING -1.67E-13 )
5
6 : FP [COMPILE] FLOATING ;
7 IMMEDIATE -->
8 ( FLOATING POINT )
9
10 : FVARIABLE
11 <BUILDS HERE F! 6 ALLOT DOES> ;
12
13 : FCONSTANT
14 <BUILDS HERE F! 6 ALLOT DOES>
15 F@ ;
0 ( FLOATING POINT )
1
2 : ASCF 0 CIX ! INBUF ! AFP F> ;
3
4 : FLIT R> DUP 6 + >R F@ ;
5 : FLITERAL STATE @ IF
6 COMPILE FLIT HERE F! 6 ALLOT
7 ENDIF ;
8 : FLOATING ( FLOAT FOLLOWING CONSTANT )
9 BL WORD HERE 1+ ASCF
10 FLITERAL ; IMMEDIATE
11 ( EX: FLOATING 1.2345 )
12 ( OR FLOATING -1.67E-13 )
13
14 : FP ~[COMPILE] FLOATING ;
15 IMMEDIATE -->
At line 993 changed 4 lines
0
1 : F0= OR OR 0= ;
2 : F= F- F0= ;
3 : F< F- DROP DROP 80 AND 0 > ;
0 ( FLOATING POINT )
1
2 : FVARIABLE
3 <BUILDS HERE F! 6 ALLOT DOES> ;
At line 998 changed 3 lines
5
6
7 BASE ! ;S
5 : FCONSTANT
6 <BUILDS HERE F! 6 ALLOT DOES>
7 F@ ;
At line 1,002 changed 3 lines
9
10
11
9 : F0= OR OR 0= ;
10 : F= F- F0= ;
11 : F< F- DROP DROP 80 AND 0 > ;
At line 1,008 changed one line
15
15 BASE ! ;S
At line 1,019 changed one line
8 ( FORTH INC.'S EDITOR )
8
At line 1,021 changed 2 lines
10 ( This editor was written by S.H. Daniel, in FORTH DIMENSIONS,
11 ( Volume III, number 3.
10
11
At line 1,024 changed 2 lines
13 ( The only change was to make the cursor a "block" for higher
14 ( visibility. P. Mullarky 9/29/81
13
14
At line 1,029 changed one line
0 -->
0 ( FORTH INC.'S EDITOR )
At line 1,031 changed 2 lines
2
3
2 ( This editor was written by S.H. Daniel, in FORTH DIMENSIONS,
3 ( Volume III, number 3.
At line 1,034 changed 2 lines
5
6
5 ( The only change was to make the cursor a "block" for higher
6 ( visibility. P. Mullarky 9/29/81
At line 1,037 changed one line
8 ( FORTH INC.'S EDITOR )
8 -->
At line 1,039 changed one line
10 BASE @ FORTH DEFINITIONS HEX
10
At line 1,041 changed 4 lines
12 : TEXT HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ;
13 : LINE DUP FFF0 AND 17 ?ERROR SCR @ (LINE) DROP ;
14 VOCABULARY EDITOR IMMEDIATE
15 : WHERE DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL . SWAP
12
13
14
15
At line 1,047 changed 16 lines
0 C/L /MOD C/L * ROT BLOCK + CR C/L TYPE [COMPILE] EDITOR QUIT ;
1 EDITOR DEFINITIONS
2 : #LOCATE R# @ C/L /MOD ;
3 : #LEAD #LOCATE LINE SWAP ;
4 : #LAG #LEAD DUP >R + C/L R> - ;
5 : -MOVE LINE C/L CMOVE UPDATE ;
6 : BUF-MOVE PAD 1+ C@ IF PAD SWAP C/L 1+ CMOVE ELSE DROP THEN ;
7 : >LINE# #LOCATE SWAP DROP ; -->
8 ( FORTH INC.'S EDITOR )
9
10 : FIND-BUF PAD 50 + ;
11 : INSERT-BUF FIND-BUF 50 + ;
12 : (HOLD) LINE INSERT-BUF 1+ C/L DUP INSERT-BUF C! CMOVE ;
13 : (KILL) LINE C/L BLANKS UPDATE ;
14 : (SPREAD) >LINE# DUP 1 - E DO I LINE I 1+ -MOVE -1
15 +LOOP (KILL) ;
0 ( FORTH INC.'S EDITOR )
1
2 BASE @ FORTH DEFINITIONS HEX
3
4 : TEXT HERE C/L 1+ BLANKS WORD HERE PAD C/L 1+ CMOVE ;
5 : LINE DUP FFF0 AND 17 ?ERROR SCR @ (LINE) DROP ;
6 VOCABULARY EDITOR IMMEDIATE
7 : WHERE DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL . SWAP
8 C/L /MOD C/L * ROT BLOCK + CR C/L TYPE ~[COMPILE] EDITOR QUIT ;
9 EDITOR DEFINITIONS
10 : #LOCATE R# @ C/L /MOD ;
11 : #LEAD #LOCATE LINE SWAP ;
12 : #LAG #LEAD DUP >R + C/L R> - ;
13 : -MOVE LINE C/L CMOVE UPDATE ;
14 : BUF-MOVE PAD 1+ C@ IF PAD SWAP C/L 1+ CMOVE ELSE DROP THEN ;
15 : >LINE# #LOCATE SWAP DROP ; -->
At line 1,065 changed 16 lines
0 : X >LINE# DUP (HOLD) F DUP ROT DO I 1+ LINE I -MOVE
1 LOOP (KILL) ;
2 : DISPLAY-CURSOR CR SPACE #LEAD TYPE A0 EMIT #LAG TYPE
3 #LOCATE . DROP ;
4 : T C/L * R# ! 0 DISPLAY-CURSOR ;
5 : L SCR @ LIST ;
6 : N 1 SCR +! ;
7 : B -1 SCR +! ; -->
8 ( FORTH INC.'S EDITOR )
9
10 : (TOP) 0 R# ! ;
11 : SEEK-ERROR (TOP) FIND-BUF HERE C/L 1+ CMOVE HERE COUNT TYPE
12 ." None" QUIT ;
13 : (R) >LINE# INSERT-BUF 1+ SWAP -MOVE ;
14 : P 5E TEXT INSERT-BUF BUF-MOVE (R) ;
15 : WIPE 10 0 DO I (KILL) LOOP ;
0 ( FORTH INC.'S EDITOR )
1
2 : FIND-BUF PAD 50 + ;
3 : INSERT-BUF FIND-BUF 50 + ;
4 : (HOLD) LINE INSERT-BUF 1+ C/L DUP INSERT-BUF C! CMOVE ;
5 : (KILL) LINE C/L BLANKS UPDATE ;
6 : (SPREAD) >LINE# DUP 1 - E DO I LINE I 1+ -MOVE -1
7 +LOOP (KILL) ;
8 : X >LINE# DUP (HOLD) F DUP ROT DO I 1+ LINE I -MOVE
9 LOOP (KILL) ;
10 : DISPLAY-CURSOR CR SPACE #LEAD TYPE A0 EMIT #LAG TYPE
11 #LOCATE . DROP ;
12 : T C/L * R# ! 0 DISPLAY-CURSOR ;
13 : L SCR @ LIST ;
14 : N 1 SCR +! ;
15 : B -1 SCR +! ; -->
At line 1,083 changed 16 lines
0 : COPY B/SCR * OFFSET @ + SWAP B/SCR * B/SCR OVER + SWAP DO DUP
1 FORTH I BLOCK 2 - ! 1+ UPDATE LOOP DROP FLUSH ;
2 : 1LINE #LAG FIND-BUF COUNT MATCH R# +! ;
3 : (SEEK) BEGIN 3FF R# @ < IF SEEK-ERROR THEN 1LINE UNTIL ;
4 : (DELETE) >R #LAG + R - #LAG R MINUS R# +! #LEAD + SWAP
5 CMOVE R> BLANKS UPDATE ;
6 : (F) 5E TEXT FIND-BUF BUF-MOVE (SEEK) ;
7 : F (F) DISPLAY-CURSOR ; -->
8 ( FORTH INC.'S EDITOR )
9 : (E) FIND-BUF C@ (DELETE) ;
10 : E (E) DISPLAY-CURSOR ;
11 : D (F) E ;
12 : TILL #LEAD + 5E TEXT FIND-BUF BUF-MOVE 1LINE 0= IF
13 SEEK-ERROR THEN #LEAD + SWAP - (DELETE) DISPLAY-CURSOR ;
14 0 VARIABLE COUNTER
15 : BUMP 1 COUNTER 1+ COUNTER @ 38 > IF 0 COUNTER ! CR CR
0 ( FORTH INC.'S EDITOR )
1
2 : (TOP) 0 R# ! ;
3 : SEEK-ERROR (TOP) FIND-BUF HERE C/L 1+ CMOVE HERE COUNT TYPE
4 ." None" QUIT ;
5 : (R) >LINE# INSERT-BUF 1+ SWAP -MOVE ;
6 : P 5E TEXT INSERT-BUF BUF-MOVE (R) ;
7 : WIPE 10 0 DO I (KILL) LOOP ;
8 : COPY B/SCR * OFFSET @ + SWAP B/SCR * B/SCR OVER + SWAP DO DUP
9 FORTH I BLOCK 2 - ! 1+ UPDATE LOOP DROP FLUSH ;
10 : 1LINE #LAG FIND-BUF COUNT MATCH R# +! ;
11 : (SEEK) BEGIN 3FF R# @ < IF SEEK-ERROR THEN 1LINE UNTIL ;
12 : (DELETE) >R #LAG + R - #LAG R MINUS R# +! #LEAD + SWAP
13 CMOVE R> BLANKS UPDATE ;
14 : (F) 5E TEXT FIND-BUF BUF-MOVE (SEEK) ;
15 : F (F) DISPLAY-CURSOR ; -->
At line 1,101 changed 16 lines
0 F MESSAGE C EMIT THEN ;
1 : S C EMIT 5E TEXT 0 COUNTER ! FIND-BUF BUF-MOVE SCR @ DUP
2 >R DO I SCR ! (TOP) BEGIN 1LINE IF DISPLAY-CURSOR SCR ? BUMP
3 THEN 3FF R# @ < UNTIL LOOP R> SCR ! ;
4 : I 5E TEXT INSERT-BUF BUF-MOVE INSERT-BUF COUNT #LAG ROT
5 OVER MIN >R R R# +! R - >R DUP HERE R CMOVE HERE #LEAD + R>
6 CMOVE R> CMOVE UPDATE
7 DISPLAY-CURSOR ; -->
8 ( FORTH INC.'S EDITOR )
9
10 : U C/L R# +! (SPREAD) P ;
11 : R (E) I ;
12 : M SCR @ >R R# @ >R >LINE# (HOLD) SWAP SCR ! 1+ C/L * R#
13 (SPREAD) (R) R> C/L + R# R> SCR ! ;
14
15
0 ( FORTH INC.'S EDITOR )
1 : (E) FIND-BUF C@ (DELETE) ;
2 : E (E) DISPLAY-CURSOR ;
3 : D (F) E ;
4 : TILL #LEAD + 5E TEXT FIND-BUF BUF-MOVE 1LINE 0= IF
5 SEEK-ERROR THEN #LEAD + SWAP - (DELETE) DISPLAY-CURSOR ;
6 0 VARIABLE COUNTER
7 : BUMP 1 COUNTER 1+ COUNTER @ 38 > IF 0 COUNTER ! CR CR
8 F MESSAGE C EMIT THEN ;
9 : S C EMIT 5E TEXT 0 COUNTER ! FIND-BUF BUF-MOVE SCR @ DUP
10 >R DO I SCR ! (TOP) BEGIN 1LINE IF DISPLAY-CURSOR SCR ? BUMP
11 THEN 3FF R# @ < UNTIL LOOP R> SCR ! ;
12 : I 5E TEXT INSERT-BUF BUF-MOVE INSERT-BUF COUNT #LAG ROT
13 OVER MIN >R R R# +! R - >R DUP HERE R CMOVE HERE #LEAD + R>
14 CMOVE R> CMOVE UPDATE
15 DISPLAY-CURSOR ; -->
At line 1,119 changed 7 lines
0 DECIMAL
1 LATEST 12 +ORIGIN !
2 HERE 28 +ORIGIN !
3 HERE 30 +ORIGIN !
4 ' EDITOR 6 + 32 +ORIGIN !
5 HERE FENCE !
6 FORTH DEFINITIONS BASE ! FORTH ;S
0 ( FORTH INC.'S EDITOR )
1
2 : U C/L R# +! (SPREAD) P ;
3 : R (E) I ;
4 : M SCR @ >R R# @ >R >LINE# (HOLD) SWAP SCR ! 1+ C/L * R#
5 (SPREAD) (R) R> C/L + R# R> SCR ! ;
6
At line 1,127 changed 7 lines
8 ( RAGSDALE ASSEMBLER )
9
10 ( This assembler was published in Dr. Dobbs Journal V.6 N.9
11 ( Sept. '81 )
12 ( ... and is the assembler used in the fig "Installation Guide."
13
14
8 DECIMAL
9 LATEST 12 +ORIGIN !
10 HERE 28 +ORIGIN !
11 HERE 30 +ORIGIN !
12 ' EDITOR 6 + 32 +ORIGIN !
13 HERE FENCE !
14 FORTH DEFINITIONS BASE ! FORTH ;S
At line 1,137 changed one line
0
0 ( RAGSDALE ASSEMBLER )
At line 1,139 changed 3 lines
2 -->
3
4
2 ( This assembler was published in Dr. Dobbs Journal V.6 N.9
3 ( Sept. '81 )
4 ( ... and is the assembler used in the fig "Installation Guide."
At line 1,145 changed 8 lines
8 ( RAGSDALE ASSEMBLER )
9 VOCABULARY ASSEMBLER IMMEDIATE ASSEMBLER DEFINITIONS BASE @ HEX
10
11 0 VARIABLE INDEX -2 ALLOT 0909 , 1505 , 0115 , 8011 , 8009 ,
12 1D0D , 8019 , 8080 , 0080 , 1404 , 8014 , 8080 , 8080 ,
13 1C0C , 801C , 2C80 ,
14 2 VARIABLE MODE : .A 0 MODE ! ; : # 1 MODE ! ; : MEM 2 MODE ! ;
15 : ,X 3 MODE ! ; : ,Y 4 MODE ! ; : X) 5 MODE ! ; : )Y 6 MODE ! ;
8
9
10 -->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
11 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
12
13
14
15
At line 1,155 changed 16 lines
0 : ) F MODE ! ; : BOT ,X 0 ; : SEC ,X 2 ; : RP) ,X 101 ;
1 : UPMODE IF MODE @ 8 AND 0= IF 8 MODE +! THEN THEN
2 1 MODE @ F AND -DUP IF 0 DO DUP + LOOP THEN OVER 1+ @ AND 0= ;
3 : CPU <BUILDS C, DOES> C@ C, MEM ;
4 00 CPU BRK, 18 CPU CLC, D8 CPU CLD, 58 CPU CLI, B8 CPU CLV,
5 CA CPU DEX, 88 CPU DEY, E8 CPU INX, C8 CPU INY, EA CPU NOP,
6 48 CPU PHA, 08 CPU PHP, 68 CPU PLA, 28 CPU PLP, 40 CPU RTI,
7 60 CPU RTS, 38 CPU SEC, F8 CPU SED, 78 CPU SEI, AA CPU TAX, -->
8 ( RAGSDALE ASSEMBLER )
9 A8 CPU TAY, BA CPU TSX, 8A CPU TXA, 9A CPU TXS, 98 CPU TYA,
10 : MCP <BUILDS C, , DOES> DUP 1+ @ 80 AND IF 10 MODE +! THEN
11 OVER FF00 AND UPMODE UPMODE IF MEM CR LATEST ID. 3 ERROR THEN
12 C@ MODE C@ INDEX + C@ + C, MODE C@ 7 AND IF MODE C@ F AND 7 <
13 IF C, ELSE , THEN THEN MEM ;
14 1C6E 60 MCP ADC, 1C6E 20 MCP AND, 1C6E C0 MCP CMP,
15 1C6E 40 MCP EOR, 1C6E A0 MCP LDA, 1C6E 00 MCP ORA,
0 ( RAGSDALE ASSEMBLER )
1 VOCABULARY ASSEMBLER IMMEDIATE ASSEMBLER DEFINITIONS BASE @ HEX
2
3 0 VARIABLE INDEX -2 ALLOT 0909 , 1505 , 0115 , 8011 , 8009 ,
4 1D0D , 8019 , 8080 , 0080 , 1404 , 8014 , 8080 , 8080 ,
5 1C0C , 801C , 2C80 ,
6 2 VARIABLE MODE : .A 0 MODE ! ; : # 1 MODE ! ; : MEM 2 MODE ! ;
7 : ,X 3 MODE ! ; : ,Y 4 MODE ! ; : X) 5 MODE ! ; : )Y 6 MODE ! ;
8 : ) F MODE ! ; : BOT ,X 0 ; : SEC ,X 2 ; : RP) ,X 101 ;
9 : UPMODE IF MODE @ 8 AND 0= IF 8 MODE +! THEN THEN
10 1 MODE @ F AND -DUP IF 0 DO DUP + LOOP THEN OVER 1+ @ AND 0= ;
11 : CPU <BUILDS C, DOES> C@ C, MEM ;
12 00 CPU BRK, 18 CPU CLC, D8 CPU CLD, 58 CPU CLI, B8 CPU CLV,
13 CA CPU DEX, 88 CPU DEY, E8 CPU INX, C8 CPU INY, EA CPU NOP,
14 48 CPU PHA, 08 CPU PHP, 68 CPU PLA, 28 CPU PLP, 40 CPU RTI,
15 60 CPU RTS, 38 CPU SEC, F8 CPU SED, 78 CPU SEI, AA CPU TAX, -->
At line 1,173 changed 16 lines
0 1C6E E0 MCP SBC, 1C6C 80 MCP STA, 0D0D 01 MCP ASL,
1 0C0C C1 MCP DEC, 0C0C E1 MCP INC, 0D0D 41 MCP LSR,
2 0D0D 21 MCP ROL, 0D0D 61 MCP ROR, 0414 81 MCP STX,
3 0486 E0 MCP CPX, 0486 C0 MCP CPY, 1496 A2 MCP LDX,
4 0C8E A0 MCP LDY, 048C 80 MCP STY, 0480 14 MCP JSR,
5 8480 40 MCP JMP, 0484 20 MCP BIT,
6 : BEGIN, HERE 1 ; IMMEDIATE
7 : UNTIL, ?EXEC >R 1 ?PAIRS R> C, HERE 1+ - C, ; IMMEDIATE -->
8 ( RAGSDALE ASSEMBLER )
9 : IF, C, HERE 0 C, 2 ; IMMEDIATE
10 : THEN, ?EXEC 2 ?PAIRS HERE OVER C@ IF SWAP ! ELSE OVER 1+
11 - SWAP C! THEN ; IMMEDIATE
12 : ELSE, 2 ?PAIRS HERE 1+ 1 JMP, SWAP HERE OVER 1+ - SWAP C!
13 2 ; IMMEDIATE
14 : NOT 20 + ;
15 90 CONSTANT CS D0 CONSTANT 0= 10 CONSTANT 0< 90 CONSTANT >=
0 ( RAGSDALE ASSEMBLER )
1 A8 CPU TAY, BA CPU TSX, 8A CPU TXA, 9A CPU TXS, 98 CPU TYA,
2 : MCP <BUILDS C, , DOES> DUP 1+ @ 80 AND IF 10 MODE +! THEN
3 OVER FF00 AND UPMODE UPMODE IF MEM CR LATEST ID. 3 ERROR THEN
4 C@ MODE C@ INDEX + C@ + C, MODE C@ 7 AND IF MODE C@ F AND 7 <
5 IF C, ELSE , THEN THEN MEM ;
6 1C6E 60 MCP ADC, 1C6E 20 MCP AND, 1C6E C0 MCP CMP,
7 1C6E 40 MCP EOR, 1C6E A0 MCP LDA, 1C6E 00 MCP ORA,
8 1C6E E0 MCP SBC, 1C6C 80 MCP STA, 0D0D 01 MCP ASL,
9 0C0C C1 MCP DEC, 0C0C E1 MCP INC, 0D0D 41 MCP LSR,
10 0D0D 21 MCP ROL, 0D0D 61 MCP ROR, 0414 81 MCP STX,
11 0486 E0 MCP CPX, 0486 C0 MCP CPY, 1496 A2 MCP LDX,
12 0C8E A0 MCP LDY, 048C 80 MCP STY, 0480 14 MCP JSR,
13 8480 40 MCP JMP, 0484 20 MCP BIT,
14 : BEGIN, HERE 1 ; IMMEDIATE
15 : UNTIL, ?EXEC >R 1 ?PAIRS R> C, HERE 1+ - C, ; IMMEDIATE -->
At line 1,191 changed 8 lines
0
1 : END-CODE CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE ; IMMEDIATE
2 FORTH DEFINITIONS DECIMAL
3 : CODE ?EXEC CREATE [COMPILE] ASSEMBLER ASSEMBLER MEM !CSP ;
4 IMMEDIATE
5 ' ASSEMBLER CFA ' ;CODE 8 + ! LATEST 12 +ORIGIN !
6 HERE 28 +ORIGIN ! HERE 30 +ORIGIN ! HERE FENCE !
7 ' ASSEMBLER 6 + 32 +ORIGIN ! BASE ! FORTH ;S
0 ( RAGSDALE ASSEMBLER )
1 : IF, C, HERE 0 C, 2 ; IMMEDIATE
2 : THEN, ?EXEC 2 ?PAIRS HERE OVER C@ IF SWAP ! ELSE OVER 1+
3 - SWAP C! THEN ; IMMEDIATE
4 : ELSE, 2 ?PAIRS HERE 1+ 1 JMP, SWAP HERE OVER 1+ - SWAP C!
5 2 ; IMMEDIATE
6 : NOT 20 + ;
7 90 CONSTANT CS D0 CONSTANT 0= 10 CONSTANT 0< 90 CONSTANT >=
At line 1,200 changed 7 lines
9
10
11
12
13
14
15
9 : END-CODE CURRENT @ CONTEXT ! ?EXEC ?CSP SMUDGE ; IMMEDIATE
10 FORTH DEFINITIONS DECIMAL
11 : CODE ?EXEC CREATE ~[COMPILE] ASSEMBLER ASSEMBLER MEM !CSP ;
12 IMMEDIATE
13 ' ASSEMBLER CFA ' ;CODE 8 + ! LATEST 12 +ORIGIN !
14 HERE 28 +ORIGIN ! HERE 30 +ORIGIN ! HERE FENCE !
15 ' ASSEMBLER 6 + 32 +ORIGIN ! BASE ! FORTH ;S
At line 1,217 changed one line
8 ( TEST SCREEN )
8
At line 1,219 changed one line
10 123 456 XXX 789 123
10
At line 1,227 changed 3 lines
0
1
2
0 ( TEST SCREEN ))))))))))))))))))))))))))))))))))))))))))))))))))
1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
2 123 456 XXX 789 123
At line 1,235 changed 8 lines
8 ( DOS I/O )
9 BASE @ HEX
10 340 VARIABLE IOCB 0 VARIABLE IO.X 0 VARIABLE IO.CH
11 : IOCC 10 * 70 MIN DUP IO.X C! 340 + IOCB ! ;
12 : <IO> <BUILDS , DOES> @ IOCB @ + ;
13 2 <IO> ICCOM 3 <IO> ICSTA 4 <IO> ICBAL 8 <IO> ICBLL
14 A <IO> ICAX1 B <IO> ICAX2 C <IO> ICAX3 D <IO> ICAX4
15 E <IO> ICAX5 F <IO> ICAX6
8
9
10
11
12
13
14
15
At line 1,245 changed 16 lines
0
1 CODE XCIO XSAVE STX, IO.X LDX, IO.CH LDA, E456 JSR,
2 XSAVE LDX, IO.CH STA, TYA, PUSH0A JMP,
3
4 : OPEN IOCC ICAX2 C! ICAX1 C! ICBAL ! 03 ICCOM C! XCIO ;
5 : CLOSE IOCC 0C ICCOM C! XCIO ;
6 : PUTC IOCC IO.CH C! 0B ICCOM C! XCIO ;
7 : GETC IOCC 7 ICCOM C! XCIO IO.CH C@ SWAP ; -->
8 ( DOS I/O )
9 : GETREC IOCC 5 ICCOM C! ICBLL ! ICBAL ! XCIO ;
10 : PUTREC IOCC 9 ICCOM C! ICBLL ! ICBAL ! XCIO ;
11 : STATUS IOCC ICSTA C@ ;
12 : DEVSTAT IOCC 0D ICCOM C! XCIO >R 2EA @ 2EC @ R> ;
13 : SPECIAL IOCC ICCOM C! ICAX6 C! ICAX5 C! ICAX4 C! ICAX3 C!
14 ICAX2 C! ICAX1 C! XCIO ;
15 : FORMAT CR CR ." Input Drive # " KEY DUP EMIT 30 -
0 ( DOS I/O )
1 BASE @ HEX
2 340 VARIABLE IOCB 0 VARIABLE IO.X 0 VARIABLE IO.CH
3 : IOCC 10 * 70 MIN DUP IO.X C! 340 + IOCB ! ;
4 : <IO> <BUILDS , DOES> @ IOCB @ + ;
5 2 <IO> ICCOM 3 <IO> ICSTA 4 <IO> ICBAL 8 <IO> ICBLL
6 A <IO> ICAX1 B <IO> ICAX2 C <IO> ICAX3 D <IO> ICAX4
7 E <IO> ICAX5 F <IO> ICAX6
8
9 CODE XCIO XSAVE STX, IO.X LDX, IO.CH LDA, E456 JSR,
10 XSAVE LDX, IO.CH STA, TYA, PUSH0A JMP,
11
12 : OPEN IOCC ICAX2 C! ICAX1 C! ICBAL ! 03 ICCOM C! XCIO ;
13 : CLOSE IOCC 0C ICCOM C! XCIO ;
14 : PUTC IOCC IO.CH C! 0B ICCOM C! XCIO ;
15 : GETC IOCC 7 ICCOM C! XCIO IO.CH C@ SWAP ; -->
At line 1,263 changed 15 lines
0 1 MAX 4 MIN
1 CR CR ." When you hit RETURN I'm going to" CR ." FORMAT Drive "
2 DUP . CR CR ." Hit any other key to abort " BEEP KEY
3 9B = IF (FMT) 1 = CR CR ." Format " IF ." OK" ELSE ." ERROR"
4 THEN ELSE DROP THEN CR CR ;
5 BASE ! ;S
6
7
8 ( ATARI-850 DOWNLOAD )
9 BASE @ HEX
10 CODE DO-SIO
11 XSAVE STX, 0 # LDA, E459 JSR,
12 XSAVE LDX, NEXT JMP,
13 : SET-DCB 50 300 C! 1 301 C! 3F 302 C! 40 303 C! 500 304 !
14 5 306 C! 0 307 C! C 308 C! 0 309 ! 0 30B C! ;
0 ( DOS I/O )
1 : GETREC IOCC 5 ICCOM C! ICBLL ! ICBAL ! XCIO ;
2 : PUTREC IOCC 9 ICCOM C! ICBLL ! ICBAL ! XCIO ;
3 : STATUS IOCC ICSTA C@ ;
4 : DEVSTAT IOCC 0D ICCOM C! XCIO >R 2EA @ 2EC @ R> ;
5 : SPECIAL IOCC ICCOM C! ICAX6 C! ICAX5 C! ICAX4 C! ICAX3 C!
6 ICAX2 C! ICAX1 C! XCIO ;
7 : FORMAT CR CR ." Input Drive # " KEY DUP EMIT 30 -
8 1 MAX 4 MIN
9 CR CR ." When you hit RETURN I'm going to" CR ." FORMAT Drive "
10 DUP . CR CR ." Hit any other key to abort " BEEP KEY
11 9B = IF (FMT) 1 = CR CR ." Format " IF ." OK" ELSE ." ERROR"
12 THEN ELSE DROP THEN CR CR ;
13 BASE ! ;S
14
At line 1,281 changed 7 lines
0 CODE RELOCATE XSAVE STX, 506 JSR, HERE 8 + JSR, XSAVE LDX,
1 NEXT JMP, 0C JMP(),
2
3 : BOOT850 HERE 2E7 ! SET-DCB DO-SIO
4 500 300 0C CMOVE DO-SIO RELOCATE
5 2E7 @ HERE - ALLOT HERE FENCE ! ;
6 BASE ! ;S
0 ( ATARI-850 DOWNLOAD )
1 BASE @ HEX
2 CODE DO-SIO
3 XSAVE STX, 0 # LDA, E459 JSR,
4 XSAVE LDX, NEXT JMP,
5 : SET-DCB 50 300 C! 1 301 C! 3F 302 C! 40 303 C! 500 304 !
6 5 306 C! 0 307 C! C 308 C! 0 309 ! 0 30B C! ;
At line 1,289 changed 2 lines
8
9
8 CODE RELOCATE XSAVE STX, 506 JSR, HERE 8 + JSR, XSAVE LDX,
9 NEXT JMP, 0C JMP(),
At line 1,292 changed 4 lines
11
12
13
14
11 : BOOT850 HERE 2E7 ! SET-DCB DO-SIO
12 500 300 0C CMOVE DO-SIO RELOCATE
13 2E7 @ HERE - ALLOT HERE FENCE ! ;
14 BASE ! ;S
At line 1,307 changed 19 lines
8 ( "STARTING FORTH" CHANGES )
9 BASE @ DECIMAL
10 : VARIABLE 0 VARIABLE ;
11 : 'S SP@ ; : S0 18 +ORIGIN @ ;
12 : 1- 1 - ; : 2- 2 - ; : 2* DUP + ; : 2/ 2 / ; : NOT 0= ;
13 : I' R> R> R ROT ROT >R >R ;
14 : J R> R> R> R R# ! >R >R >R R# @ ;
15 : PAGE 125 EMIT ;
SCR # 85
0 : 2VARIABLE VARIABLE 0 , ; : EXIT R> ; : H DP ;
1 : 2CONSTANT <BUILDS HERE D! 4 ALLOT DOES> D@ ;
2 : CREATE VARIABLE -2 ALLOT ; : 2@ D@ ; : 2! D! ;
3 : >IN IN ; : /LOOP [COMPILE] LOOP ; IMMEDIATE
4 : ['] [COMPILE] ' ; : WITHIN >R 1- OVER < SWAP R> < AND ;
5 : NUMPATCH DROP 58 OVER = SWAP 44 48 WITHIN OR NOT ;
6 : NUMFIX ' NUMPATCH CFA ' NUMBER 52 + ! ; NUMFIX
7 -->
8 ( "STARTING FORTH" CHANGES )
8
At line 1,327 changed 2 lines
10 : ABORT" STATE @ IF COMPILE 0BRANCH HERE 0 ,
11 COMPILE (.") ASCII " WORD HERE C@ 1+
10
11
At line 1,330 changed 3 lines
13 ALLOT COMPILE QUIT HERE OVER - SWAP !
14 ELSE IF ASCII " WORD HERE COUNT TYPE
15 QUIT THEN THEN ; IMMEDIATE
13
14
15
At line 1,233 added 18 lines
SCR # 85
0 ( "STARTING FORTH" CHANGES )
1 BASE @ DECIMAL
2 : VARIABLE 0 VARIABLE ;
3 : 'S SP@ ; : S0 18 +ORIGIN @ ;
4 : 1- 1 - ; : 2- 2 - ; : 2* DUP + ; : 2/ 2 / ; : NOT 0= ;
5 : I' R> R> R ROT ROT >R >R ;
6 : J R> R> R> R R# ! >R >R >R R# @ ;
7 : PAGE 125 EMIT ;
8 : 2VARIABLE VARIABLE 0 , ; : EXIT R> ; : H DP ;
9 : 2CONSTANT <BUILDS HERE D! 4 ALLOT DOES> D@ ;
10 : CREATE VARIABLE -2 ALLOT ; : 2@ D@ ; : 2! D! ;
11 : >IN IN ; : /LOOP ~[COMPILE] LOOP ; IMMEDIATE
12 : ~['] ~[COMPILE] ' ; : WITHIN >R 1- OVER < SWAP R> < AND ;
13 : NUMPATCH DROP 58 OVER = SWAP 44 48 WITHIN OR NOT ;
14 : NUMFIX ' NUMPATCH CFA ' NUMBER 52 + ! ; NUMFIX
15 -->
At line 1,335 changed 4 lines
0
1 BASE ! ;S
2
3
0 ( "STARTING FORTH" CHANGES )
1
2 : ABORT" STATE @ IF COMPILE 0BRANCH HERE 0 ,
3 COMPILE (.") ASCII " WORD HERE C@ 1+
At line 1,340 changed 10 lines
5
6
7
8 ( DDISK )
9 BASE @ HEX
10 0 VARIABLE CBLOCK 0 VARIABLE BUFF
11 : .HEAD 7D EMIT ." Enter BLOCK number in hex: " QUERY
12 BL WORD HERE NUMBER DROP CR ;
13 : GBLK .HEAD CR CR CBLOCK ! ;
14 : RBLOCK CBLOCK @ BLOCK DUP BUFF ! ;
5 ALLOT COMPILE QUIT HERE OVER - SWAP !
6 ELSE IF ASCII " WORD HERE COUNT TYPE
7 QUIT THEN THEN ; IMMEDIATE
8
9 BASE ! ;S
10
11
12
13
14
At line 1,353 changed 16 lines
0 : .H 0 <# # # #> TYPE SPACE ;
1 : DLINE 8 0 DO DUP I + C@ .H LOOP ;
2 : C.ON 1 2FE C! ; : C.OFF 0 2FE C! ;
3 : DCHAR C.ON 8 0 DO DUP I + C@ DUP 9B = IF DROP BL THEN
4 EMIT LOOP C.OFF ;
5
6 : FQUIT DROP 7D EMIT ." ALL DONE" CR DECIMAL PROMPT QUIT ;
7 -->
8 ( DDISK )
9 HEX : D.LINE DLINE SPACE DCHAR ;
10 : D.BLOCK 3 54 C! 2 55 ! ." BLOCK " CBLOCK @ . CR RBLOCK
11 80 0 DO I .H DUP I + D.LINE DROP CR 8 +LOOP DROP ;
12 : PBLK CBLOCK +! D.BLOCK ;
13 : +BLOCK 1 PBLK ;
14 : -BLOCK -1 PBLK ;
15
0 ( DDISK )
1 BASE @ HEX
2 0 VARIABLE CBLOCK 0 VARIABLE BUFF
3 : .HEAD 7D EMIT ." Enter BLOCK number in hex: " QUERY
4 BL WORD HERE NUMBER DROP CR ;
5 : GBLK .HEAD CR CR CBLOCK ! ;
6 : RBLOCK CBLOCK @ BLOCK DUP BUFF ! ;
7
8 : .H 0 <# # # #> TYPE SPACE ;
9 : DLINE 8 0 DO DUP I + C@ .H LOOP ;
10 : C.ON 1 2FE C! ; : C.OFF 0 2FE C! ;
11 : DCHAR C.ON 8 0 DO DUP I + C@ DUP 9B = IF DROP BL THEN
12 EMIT LOOP C.OFF ;
13
14 : FQUIT DROP 7D EMIT ." ALL DONE" CR DECIMAL PROMPT QUIT ;
15 -->
At line 1,287 added 17 lines
SCR # 88
0 ( DDISK )
1 HEX : D.LINE DLINE SPACE DCHAR ;
2 : D.BLOCK 3 54 C! 2 55 ! ." BLOCK " CBLOCK @ . CR RBLOCK
3 80 0 DO I .H DUP I + D.LINE DROP CR 8 +LOOP DROP ;
4 : PBLK CBLOCK +! D.BLOCK ;
5 : +BLOCK 1 PBLK ;
6 : -BLOCK -1 PBLK ;
7
8
9 : PICK SP@ SWAP 2 * + 2+ @ ;
10 : CKEY KEY DUP 1B = IF FQUIT ELSE DUP 4E = IF +BLOCK ELSE
11 DUP 42 = IF -BLOCK ELSE DUP 9B = IF GBLK D.BLOCK
12 THEN THEN THEN THEN ;
13 : DDISK HEX GBLK D.BLOCK BEGIN CKEY DROP AGAIN ;
14
15 BASE ! ;S
This page (revision-9) was last changed on 03-Jan-2024 15:28 by bartgo  Top