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 changed one line
!!! Extended Atari FIG-Forth APX20029 (Atari Program Exchange)
!!! EXTENDED Atari fig-FORTH, Cassette: APX-10029, Diskette: APX-20029 (Atari Program Exchange)
At line 5 changed one line
!! Manual
!! Disks
At line 7 changed one line
[Extended Atari FIG-Forth APX20029/Extended fig-FORTH - APX APX-20029.pdf]
[Extended Atari FIG-Forth APX20029/APX Extended Fig Forth.atr]
At line 9 added 16 lines
!! 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 27 added 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 45 added 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 31 changed 2 lines
0 ( FULL LOAD ))))))))))))))))))))))))))))))))))))))))))))))))))))
1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
0 ( FULL LOAD )
1
At line 99 changed 2 lines
14 -->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
15 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
14 -->
15
At line 182 changed one line
7 : .SETUP ~[COMPILE] ' ?DOCOL .WORD ! ;
7 : .SETUP [COMPILE] ' ?DOCOL .WORD ! ;
At line 215 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 239 changed 2 lines
10 -->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
11 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
10 -->
11
At line 247 changed 2 lines
0 ( EDITOR )))))))))))))))))))))))))))))))))))))))))))))))))))))))
1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
0 ( EDITOR )
1
At line 265 changed 2 lines
0 ( EDITOR )))))))))))))))))))))))))))))))))))))))))))))))))))))))
1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
0 ( EDITOR )
1
At line 303 changed 4 lines
2 : N FIND 0 M ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4 : F 1 TEXT NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN
5 NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN
2 : N FIND 0 M ;
3
4 : F 1 TEXT N ;
5
At line 433 changed one line
6 : CODE ~[COMPILE] ASSEMBLER
6 : CODE [COMPILE] ASSEMBLER
At line 477 changed one line
14 : ENDIF, ~[COMPILE] THEN, ; IMMEDIATE
14 : ENDIF, [COMPILE] THEN, ; IMMEDIATE
At line 496 changed one line
15 : UNTIL, ~[COMPILE] END, ; IMMEDIATE -->
15 : UNTIL, [COMPILE] END, ; IMMEDIATE -->
At line 517 changed 2 lines
0 B jDISKNAMEDAT
1
0 BjDISKNAMEDAT
1
At line 520 changed one line
3 J
3 J
At line 537 changed one line
2 : X) 01 MODE ! ; ( ~[ADDR,X] )
2 : X) 01 MODE ! ; ( [ADDR,X] )
At line 539 changed one line
4 : )Y 11 MODE ! ; ( ~[ADDR],Y )
4 : )Y 11 MODE ! ; ( [ADDR],Y )
At line 563 changed 6 lines
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 -->
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
At line 571 changed 16 lines
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 -->
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 )
At line 589 changed 3 lines
0 ( END OF ASSEMBLER )
1
2 FORTH DEFINITIONS
0
1 HERE 1E +ORIGIN ! ( DP )
2
At line 594 changed one line
5 LATEST 0C +ORIGIN ! ( NTOP )
5
At line 596 changed 6 lines
7 HERE 1C +ORIGIN ! ( FENCE )
8
9 HERE 1E +ORIGIN ! ( DP )
10
11
12
7 BASE ! ;S
8 ( COLOR COMMANDS )
9 BASE @ HEX
10 : SETCOLOR 2 * SWAP 10 * OR SWAP
11 02C4 ( COLPF0 ) + C! ;
12 : SE. SETCOLOR ; ( ALIAS )
At line 603 changed 2 lines
14
15 BASE ! ;S
14 ( REGISTER#-3, COLOR-2, LUM-1
15
At line 607 changed 5 lines
0 ( COLOR COMMANDS )
1 BASE @ HEX
2 : SETCOLOR 2 * SWAP 10 * OR SWAP
3 02C4 ( COLPF0 ) + C! ;
4 : SE. SETCOLOR ; ( ALIAS )
0 ( 0-3 0-F 0-7
1
2 -->
3
4
At line 613 changed one line
6 ( REGISTER#-3, COLOR-2, LUM-1
6
At line 615 changed 5 lines
8 ( 0-3 0-F 0-7
9
10 -->
11
12
8 ( GRAPHICS COMMANDS )
9 E456 CONSTANT CIO
10 1C VARIABLE MASK
11 340 CONSTANT IOCX
12 53 VARIABLE SNAME
At line 621 changed 2 lines
14
15
14 CODE GR. 1 # LDA, GFLAG STA,
15 XSAVE STX, 0 ,X LDA,
At line 625 changed 16 lines
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 -->
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
At line 643 changed 7 lines
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,
0 : XGR &GR 0 GR. &GR ;
1 ( EXIT GRAPHICS MODE )
2
3 -->
4
5
6
At line 651 changed 8 lines
8 : XGR &GR 0 GR. &GR ;
9 ( EXIT GRAPHICS MODE )
10
11 -->
12
13
14
15
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,
At line 661 changed 16 lines
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 -->
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 ;
At line 679 changed 5 lines
0 ( GRAPHICS I/O )
1
2 : GTYPE -DUP IF OVER + SWAP
3 DO I C@ CPUT LOOP ELSE
4 DROP ENDIF ;
0
1 : G" 22 STATE @ IF COMPILE (G")
2 WORD HERE C@ 1+ ALLOT
3 ELSE WORD HERE COUNT GTYPE
4 ENDIF ; IMMEDIATE
At line 685 changed 10 lines
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 -->
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,
At line 697 changed 4 lines
0 ( DRAW, FIL )
1
2 2FB CONSTANT ATACHR
3 2FD CONSTANT FILDAT
0
1 : DRAW POS ATACHR C! 11 GCOM ;
2
3 : FIL FILDAT C! 12 GCOM ;
At line 702 changed 5 lines
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 ;
5
6 BASE ! ;S
7
8 ( SOUND COMMANDS )
9 BASE @ HEX
At line 708 changed 2 lines
11 : FIL FILDAT C! 12 GCOM ;
12
11 D208 CONSTANT AUDCTL
12 D200 CONSTANT AUDBASE
At line 711 changed 2 lines
14 BASE ! ;SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
15 SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
14 : SOUND ( CH# FREQ DIST VOL --- )
15 3 DUP 0D20F C! 232 C!
At line 715 changed 2 lines
0 ( SOUND COMMANDS )
1 BASE @ HEX
0 SWAP 16 * + ROT DUP + AUDBASE +
1 ROT OVER C! 1+ C! ;
At line 718 changed 2 lines
3 D208 CONSTANT AUDCTL
4 D200 CONSTANT AUDBASE
3 : FILTER! AUDCTL C! ;
4 ( N --- )
At line 721 changed 7 lines
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 --- )
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 ;
At line 729 changed 2 lines
14
15 BASE ! ;S
14 : FBOX XGR 5 GR. BOX
15 10 25 POS 2 FIL ;
At line 733 changed one line
0 ( GRAPHICS TESTS )
0
At line 735 changed 3 lines
2 : BOX 0 10 10 PLOT 1 50 10 DRAW
3 1 50 25 DRAW 1 10 25 DRAW
4 1 10 10 DRAW ;
2
3
4
At line 739 changed 3 lines
6 : FBOX XGR 5 GR. BOX
7 10 25 POS 2 FIL ;
8
6
7
8 ( DOS OBJECT READER )
At line 743 changed one line
10
10 BASE @ HEX
At line 745 changed 4 lines
12
13
14
15
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 - ;
At line 751 changed 16 lines
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 -->
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
At line 769 changed 5 lines
0 ( DOS OBJECT READER )
1
2 : ADRCALC NEXTWORD DUP ADDRSS ! NEXTWORD SWAP - 1+ #BYTES ! ;
3
4 : BLOCKSET DUP BLOCK# ! BLOCK GETCOUNT ;
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 ;
At line 775 changed 10 lines
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
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,
At line 787 changed 16 lines
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 , ; -->
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
At line 805 changed 6 lines
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,
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
At line 812 changed 2 lines
7 XSAVE 100 * A6 + CONSTANT XLD
8 : XL, XLD , ;
7
8 ( FLOATING POINT WORDS )
At line 815 changed 6 lines
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
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,
At line 823 changed 15 lines
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
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
At line 841 changed one line
0 ( FLOATING POINT WORDS )
0 -->
At line 843 changed 5 lines
2 D4 CONSTANT FR0
3 E0 CONSTANT FR1
4 FC CONSTANT FLPTR
5 F3 CONSTANT INBUF
6 F2 CONSTANT CIX
2
3
4
5
6
At line 849 changed one line
8 -->
8 ( FLOATING POINT )
At line 851 changed 2 lines
10
11
10 : F@ >R R @ R 2+ @ R> 4 + @ ;
11 : F! >R R 4 + ! R 2+ ! R> ! ;
At line 854 changed 3 lines
13
14
15
13 : F.TY BEGIN INBUF @ C@ DUP
14 7F AND EMIT 1 INBUF +!
15 80 > UNTIL ;
At line 859 changed one line
0 ( FLOATING POINT )
0
At line 861 changed 7 lines
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
2 : F. FR0 F@ FSWAP FR0 F! FASC
3 F.TY SPACE FR0 F! ;
4 : F? F@ F. ;
5
6 -->
7
8 ( FLOATING POINT )
At line 869 changed 3 lines
10 : F. FR0 F@ FSWAP FR0 F! FASC
11 F.TY SPACE FR0 F! ;
12 : F? F@ F. ;
10 : <F FR1 F! FR0 F! ;
11 : F> FR0 F@ ;
12 : FS FR0 F! ;
At line 873 changed 2 lines
14 -->
15
14 : F+ <F FADD F> ;
15 : F- <F FSUB F> ;
At line 877 changed 16 lines
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> ; -->
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 ;
At line 895 changed 16 lines
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 -->
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@ ;
At line 913 changed 4 lines
0 ( FLOATING POINT )
1
2 : FVARIABLE
3 <BUILDS HERE F! 6 ALLOT DOES> ;
0
1 : F0= OR OR 0= ;
2 : F= F- F0= ;
3 : F< F- DROP DROP 80 AND 0 > ;
At line 918 changed 3 lines
5 : FCONSTANT
6 <BUILDS HERE F! 6 ALLOT DOES>
7 F@ ;
5
6
7 BASE ! ;S
At line 922 changed 3 lines
9 : F0= OR OR 0= ;
10 : F= F- F0= ;
11 : F< F- DROP DROP 80 AND 0 > ;
9
10
11
At line 928 changed one line
15 BASE ! ;S
15
At line 939 changed one line
8
8 ( FORTH INC.'S EDITOR )
At line 941 changed 2 lines
10
11
10 ( This editor was written by S.H. Daniel, in FORTH DIMENSIONS,
11 ( Volume III, number 3.
At line 944 changed 2 lines
13
14
13 ( The only change was to make the cursor a "block" for higher
14 ( visibility. P. Mullarky 9/29/81
At line 949 changed one line
0 ( FORTH INC.'S EDITOR )
0 -->
At line 951 changed 2 lines
2 ( This editor was written by S.H. Daniel, in FORTH DIMENSIONS,
3 ( Volume III, number 3.
2
3
At line 954 changed 2 lines
5 ( The only change was to make the cursor a "block" for higher
6 ( visibility. P. Mullarky 9/29/81
5
6
At line 957 changed one line
8 -->
8 ( FORTH INC.'S EDITOR )
At line 959 changed one line
10
10 BASE @ FORTH DEFINITIONS HEX
At line 961 changed 4 lines
12
13
14
15
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
At line 967 changed 16 lines
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 ; -->
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) ;
At line 985 changed 16 lines
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 +! ; -->
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 ;
At line 1,003 changed 16 lines
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 ; -->
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
At line 1,021 changed 16 lines
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 ; -->
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
At line 1,039 changed 7 lines
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
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
At line 1,047 changed 7 lines
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
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
At line 1,057 changed one line
0 ( RAGSDALE ASSEMBLER )
0
At line 1,059 changed 3 lines
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."
2 -->
3
4
At line 1,065 changed 8 lines
8
9
10 -->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
11 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
12
13
14
15
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 ! ;
At line 1,075 changed 16 lines
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, -->
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,
At line 1,093 changed 16 lines
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 -->
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 >=
At line 1,111 changed 8 lines
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 >=
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
At line 1,120 changed 7 lines
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
9
10
11
12
13
14
15
At line 1,137 changed one line
8
8 ( TEST SCREEN )
At line 1,139 changed one line
10
10 123 456 XXX 789 123
At line 1,147 changed 3 lines
0 ( TEST SCREEN ))))))))))))))))))))))))))))))))))))))))))))))))))
1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
2 123 456 XXX 789 123
0
1
2
At line 1,155 changed 8 lines
8
9
10
11
12
13
14
15
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
At line 1,165 changed 16 lines
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 ; -->
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 -
At line 1,183 changed 15 lines
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
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! ;
At line 1,201 changed 7 lines
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! ;
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
At line 1,209 changed 2 lines
8 CODE RELOCATE XSAVE STX, 506 JSR, HERE 8 + JSR, XSAVE LDX,
9 NEXT JMP, 0C JMP(),
8
9
At line 1,212 changed 4 lines
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
11
12
13
14
At line 1,227 changed one line
8
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 )
At line 1,229 changed 2 lines
10
11
10 : ABORT" STATE @ IF COMPILE 0BRANCH HERE 0 ,
11 COMPILE (.") ASCII " WORD HERE C@ 1+
At line 1,232 changed 3 lines
13
14
15
13 ALLOT COMPILE QUIT HERE OVER - SWAP !
14 ELSE IF ASCII " WORD HERE COUNT TYPE
15 QUIT THEN THEN ; IMMEDIATE
At line 1,236 removed 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,255 changed 4 lines
0 ( "STARTING FORTH" CHANGES )
1
2 : ABORT" STATE @ IF COMPILE 0BRANCH HERE 0 ,
3 COMPILE (.") ASCII " WORD HERE C@ 1+
0
1 BASE ! ;S
2
3
At line 1,260 changed 10 lines
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
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 ! ;
At line 1,273 changed 16 lines
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 -->
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
At line 1,290 removed 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