EXTENDED Atari fig-FORTH, Cassette: APX-10029, Diskette: APX-20029 (Atari Program Exchange)#

Manuals#

Extended Atari FIG-Forth APX20029/Extended fig-FORTH - APX APX-20029.pdf(info) size: 7.7 MB ; EXTENDED fig-FORTH, Rev. 1, 1981 by Patrick L. Mullarky
EXTENDED fig-FORTH, Rev.2.pdf(info) 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! :-)

Screens#


SCR # 17 
  0 ( CASSETTE LOAD )
  1 
  2 
  3 
  4 ( LOAD DEBUG )
  5    21 LOAD
  6 
  7 ( LOAD ASSEMBLER )
  8    39 LOAD
  9 
 10 
 11 
 12 
 13 ;S
 14 
 15 

SCR # 18 
  0 ( FULL LOAD ))))))))))))))))))))))))))))))))))))))))))))))))))))
  1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
  2 
  3 
  4 ( LOAD DEBUG )
  5    21 LOAD
  6 
  7 ( LOAD EDITOR )
  8   27 LOAD
  9 
 10 ( LOAD ASSEMBLER )
 11    39 LOAD
 12 
 13 ;S
 14 
 15 

SCR # 19 
  0 
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

SCR # 20 
  0 ( ATARI FORTH DEFS )
  1     BASE @ HEX
  2 
  3 : PON    1 PFLAG ! ; ( PRT ON )
  4 : POFF   0 PFLAG ! ; ( PRT OFF )
  5 
  6 : BEEP  0C0 0 DO
  7    08 0D01F C! 6 0 DO LOOP
  8    00 0D01F C! 6 0 DO LOOP
  9    LOOP ;
 10 
 11 : ASCII BL WORD HERE 1+ C@
 12  STATE @ IF COMPILE CLIT C,
 13  THEN ;  IMMEDIATE
 14 
 15 BASE ! ;S

SCR # 21 
  0 ( DEBUGGER AIDS -- DUMP , CDUMP )
  1 
  2 BASE @ HEX
  3 
  4 
  5 
  6 
  7 
  8 : H. BASE @ HEX OVER U. BASE ! ;
  9 
 10 : B?   BASE @ DUP DECIMAL . BASE ! ;
 11 : FREE   2E5 @ HERE -  U. ." bytes" CR ;
 12 
 13 
 14 -->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 15 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

SCR # 22 
  0 ( DEBUGGER AIDS -- DUMP , CDUMP )
  1     DECIMAL
  2 : ?EXIT  ?TERMINAL
  3          IF LEAVE ENDIF ;
  4 : U.R    0 SWAP D.R ;
  5 : LDMP  DUP 8 + SWAP DO I C@ 4 .R
  6          LOOP ;
  7 : DUMP   OVER + SWAP DO CR I 5 U.R I
  8          LDMP ?EXIT 8 +LOOP CR ;
  9 : CDMP   DUP 16 + SWAP DO
 10          I C@ EMIT LOOP ;
 11  HEX
 12 : CDUMP   OVER + SWAP DO CR I 5 U.R I
 13       SPACE 1 2FE C! CDMP 0 2FE C!
 14        ?EXIT 10 +LOOP CR ;
 15  DECIMAL -->

SCR # 23 
  0 ( STACK PRINTER )
  1 
  2 HEX
  3 
  4 : DEPTH SP@ 12 +ORIGIN @ SWAP - 2 / ;
  5 : S.  ( PRINTS THE STACK )
  6    DEPTH -DUP IF
  7       0 DO  CR  ." TOP+" I .
  8       SP@ I 2 * + @ U. LOOP
  9    ELSE ." Stack Empty" THEN CR ;
 10 
 11 
 12 
 13 BASE !
 14 
 15 -->

SCR # 24 
  0 ( DEFINITION TRACER )
  1      BASE @ HEX
  2 0 VARIABLE .WORD
  3 ' CLIT CFA CONSTANT .CLIT
  4 ' 0BRANCH CFA CONSTANT ZBRAN
  5 ' BRANCH CFA CONSTANT BRAN
  6 ' ;S CFA CONSTANT SEMIS
  7 ' (LOOP) CFA CONSTANT PLOOP
  8 ' (+LOOP) CFA CONSTANT PPLOOP
  9 ' (.") CFA CONSTANT PDOTQ
 10 : PWORD 2+ NFA ID.  ;
 11 : 1BYTE  PWORD .WORD @ C@ . 1 .WORD +! ;
 12 : 1WORD PWORD .WORD @ @  . 2 .WORD +! ;
 13 : NP DUP SEMIS = IF PWORD CR CR
 14     PROMPT QUIT THEN ?TERMINAL IF
 15      PROMPT QUIT THEN ;    -->

SCR # 25 
  0 ( DEFINITION TRACER )
  1 
  2 : BRNCH PWORD ." to " .WORD @ .WORD @ @ + . 2 .WORD +! ;
  3 
  4 : STG  PWORD 22 EMIT .WORD @   DUP COUNT TYPE 22 EMIT
  5    C@ .WORD @ + 1+ .WORD ! ;
  6 
  7 ' LIT CFA CONSTANT .LIT
  8 
  9 : CKIT DUP ZBRAN = OVER BRAN =
 10  OR OVER PLOOP = OR OVER PPLOOP =
 11 OR IF BRNCH ELSE DUP .LIT =
 12 IF 1WORD ELSE DUP .CLIT =
 13  IF 1BYTE ELSE DUP PDOTQ = IF STG
 14  ELSE PWORD THEN THEN THEN THEN ;
 15 -->

SCR # 26 
  0 ( DEFINITION TRACER )
  1     ' : 12 + CONSTANT DOCOL
  2 
  3 : T?PR CR CR ." Primitive" CR CR ;
  4 : ?DOCOL DUP 2 - @ DOCOL -  IF
  5   T?PR PROMPT QUIT THEN ;
  6 
  7 : .SETUP ~[COMPILE] ' ?DOCOL .WORD ! ;
  8 
  9 : NXT1  .WORD @ U. 2 SPACES .WORD
 10     @ @ 2 .WORD +! ;
 11 
 12 : DECOMP .SETUP CR CR BEGIN NXT1 NP
 13       CKIT CR AGAIN ;
 14 
 15 BASE !     ;S

SCR # 27 
  0 ( ** EDITOR ** )
  1 
  2  BASE @  HEX
  3 
  4 ( THIS EDITOR IS PATTERNED AFTER
  5 ( THE EXAMPLE EDITOR IN THE fig
  6 ( "INSTALLATION MANUAL" 8/80 WFR
  7 
  8 : TEXT HERE C/L 1+ BLANKS WORD
  9        HERE PAD C/L 1+ CMOVE ;
 10 
 11 : LINE DUP FFF0 AND 17 ?ERROR SCR
 12        @ (LINE) DROP ;
 13 
 14 : MARK  10 0 DO I LINE UPDATE
 15     DROP LOOP ;        -->

SCR # 28 
  0 ( EDITOR )
  1 VOCABULARY EDITOR IMMEDIATE
  2 : WHERE DUP B/SCR / DUP SCR ! ." SCR # " DECIMAL .
  3 SWAP C/L /MOD C/L * ROT BLOCK + CR C/L -TRAILING TYPE CR HERE
  4 C@ - SPACES 1 2FE C! 1C EMIT 0 2FE C! ~[COMPILE] EDITOR QUIT ;
  5 
  6 EDITOR DEFINITIONS
  7 
  8 : #LOCATE R# @ C/L /MOD ;
  9 : #LEAD #LOCATE LINE SWAP ;
 10 : #LAG  #LEAD DUP >R + C/L R> - ;
 11 
 12 
 13 : -MOVE LINE C/L CMOVE UPDATE ;
 14 
 15 -->

SCR # 29 
  0 ( EDITOR )
  1 : H LINE PAD 1+ C/L DUP PAD C!
  2      CMOVE ;
  3 : E LINE C/L BLANKS UPDATE ;
  4 : S DUP 1 - 0E DO I LINE I 1+
  5     -MOVE -1 +LOOP E ;
  6 : D DUP H 0F DUP ROT
  7     DO I 1+ LINE I -MOVE LOOP E ;
  8 
  9 
 10    -->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 11 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 12 
 13 
 14 
 15 

SCR # 30 
  0 ( EDITOR )))))))))))))))))))))))))))))))))))))))))))))))))))))))
  1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
  2 : M   R# +! CR SPACE #LEAD TYPE
  3       17 EMIT #LAG TYPE #LOCATE
  4       . DROP ;
  5 : T   DUP C/L * R# ! DUP H 0 M ;
  6 : L   SCR @ LIST 0 M ;
  7 : R   PAD 1+ SWAP -MOVE ;
  8 : P   1 TEXT R ;
  9 : I   DUP S R ;
 10 : TOP   0 R# ! ;
 11 
 12 
 13   -->
 14 
 15 

SCR # 31 
  0 ( EDITOR )))))))))))))))))))))))))))))))))))))))))))))))))))))))
  1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
  2 
  3 : CLEAR  SCR ! 10 0 DO FORTH I
  4          EDITOR E LOOP ;
  5 
  6 
  7 
  8 
  9 
 10 : COPY   B/SCR * OFFSET @ + SWAP
 11          B/SCR * B/SCR OVER +
 12          SWAP DO DUP FORTH I
 13          BLOCK 2 - ! 1+ UPDATE
 14          LOOP DROP FLUSH ;
 15   -->

SCR # 32 
  0 ( EDITOR )
  1 
  2 : 1LINE   #LAG PAD COUNT MATCH R#
  3           +! ;
  4 
  5 
  6 : FIND   BEGIN 3FF R# @ < IF TOP
  7          PAD HERE C/L 1+ CMOVE 0
  8          ERROR ENDIF 1LINE UNTIL
  9          ;
 10 
 11 : DELETE   >R #LAG + FORTH R -
 12        #LAG R MINUS R# +! #LEAD
 13        + SWAP CMOVE R> BLANKS
 14        UPDATE ;
 15 -->

SCR # 33 
  0 ( EDITOR )
  1 
  2 : N   FIND 0 M ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  4 : F   1 TEXT NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN
  5 NNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNNN
  6 : B   PAD C@ MINUS M ;
  7 
  8 : X   1 TEXT FIND PAD C@ DELETE
  9       0 M ;
 10 
 11 : TILL   #LEAD + 1 TEXT 1LINE 0=
 12          0 ?ERROR #LEAD + SWAP -
 13          DELETE 0 M ;
 14 
 15 -->

SCR # 34 
  0 ( END OF EDITOR )
  1 
  2 : C   1 TEXT PAD COUNT #LAG ROT
  3       OVER MIN >R FORTH R R# +!
  4       R - >R DUP HERE R CMOVE
  5       HERE #LEAD + R> CMOVE R>
  6       CMOVE UPDATE 0 M ;
  7 
  8 
  9 FORTH DEFINITIONS DECIMAL
 10 
 11 LATEST 12 +ORIGIN !
 12 HERE 28 +ORIGIN !
 13 HERE 30 +ORIGIN !
 14 ' EDITOR 6 + 32 +ORIGIN !
 15 HERE FENCE !    BASE !    ;S

SCR # 35 
  0 
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

SCR # 36 
  0 ( DISK COPY ROUTINE  32K RAM )
  1 
  2    BASE @ DECIMAL
  3 16384 CONSTANT BUFHEAD
  4 0 VARIABLE BLK#  0 VARIABLE ADRS
  5 : GET   ADRS @ BLK# @ ;
  6 : RD    GET DUP 718 = IF LEAVE THEN 1 R/W ;
  7 : WRT   GET DUP 718  = IF LEAVE THEN  0 R/W ;
  8 : +BLK  1 BLK# +!  128 ADRS +! ;
  9 : DSETUP   BLK# ! BUFHEAD ADRS ! ;
 10 : GKEY ." HIT ANY KEY "  KEY CR DROP ;
 11 : RDIN  CR ." Insert SOURCE disk  "  GKEY DSETUP
 12 90 0 DO RD +BLK  LOOP ;
 13 : WRTO  CR ." Insert DESTINATION disk  "  GKEY DSETUP
 14 90 0 DO WRT +BLK  LOOP ;
 15 -->

SCR # 37 
  0 ( DISK COPY ROUTINE )
  1 
  2 ( INSERT SOURCE DISK IN DRIVE #1
  3 
  4 ( SIMPLY TYPE  "DISKCOPY" !
  5 
  6 : MS1 CR CR
  7 ." SINGLE-DRIVE DISK COPY" CR CR ;
  8 
  9 
 10 : %COPY      0 DO I 90 *
 11              DUP DUP RDIN WRTO
 12              90 +  . LOOP ;
 13 : DISKCOPY   CR MS1 CR 8 %COPY ;
 14 
 15 BASE !   ;S

SCR # 38 
  0 
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

SCR # 39 
  0 ( ** ASSEMBLER **   IN FORTH )
  1 
  2 (  ASSEMBLER COMFORMS TO THE
  3 ( fig "INSTALLATION GUIDE" WITH
  4 ( THE FOLLOWING EXCEPTIONS:
  5 
  6 (  SHIFTS ARE: "XXX.A" FOR A-REG.
  7 ( SHIFTS.
  8 (  CONDITIONAL BRANCHES ARE
  9 (  PATTERNED AFTER THE BRANCH OP-
 10 (  CODES:   "IFEQ," IS USED IN-
 11 ( STEAD OF "0= IF," FOR BETTER
 12 ( CLARITY.  SEE SCREEN 43.
 13 
 14 
 15 -->

SCR # 40 
  0 ( ASSEMBLER )
  1 
  2 VOCABULARY ASSEMBLER IMMEDIATE
  3 
  4 BASE @  HEX
  5 
  6 : CODE  ~[COMPILE] ASSEMBLER
  7         CREATE SMUDGE ;
  8 
  9 ASSEMBLER DEFINITIONS
 10 
 11 : SB  <BUILDS C, DOES> @ C, ;
 12       ( SINGLE BYTE OPERATORS)
 13 
 14 
 15 -->

SCR # 41 
  0 ( ASSEMBLER )
  1 
  2 00 SB BRK, 18 SB CLC, D8 SB CLD,
  3 58 SB CLI, B8 SB CLV, CA SB DEX,
  4 88 SB DEY, E8 SB INX, C8 SB INY,
  5 EA SB NOP, 48 SB PHA, 08 SB PHP,
  6 68 SB PLA, 28 SB PLP, 40 SB RTI,
  7 60 SB RTS, 38 SB SEC, F8 SB SED,
  8 78 SB SEI, A8 SB TAX, BA SB TSX,
  9 8A SB TXA, 9A SB TXS, 98 SB TYA,
 10 
 11 0A SB ASL.A,   2A SB ROL.A,
 12 4A SB LSR.A,   6A SB ROR.A,
 13 
 14 : NOT  0= ;  ( REVERSE LOGICAL )
 15 : 0=  1 ; ( PUSH A TRUE )  -->

SCR # 42 
  0 ( ASSEMBLER )
  1 
  2 : 3BY  <BUILDS C, DOES> @ C, , ;
  3 
  4 4C 3BY JMP,   6C 3BY JMP(),
  5 20 3BY JSR,
  6 
  7 : ?ER5    5 ?ERROR ;
  8 
  9 : IF.  <BUILDS C, DOES> C@ C, 0
 10         C, HERE ;
 11 : THEN,   DUP HERE SWAP - DUP
 12         7F > ?ER5 DUP -80 < ?ER5
 13   SWAP -1 + C! ;  IMMEDIATE
 14 : ENDIF, ~[COMPILE] THEN, ; IMMEDIATE
 15 -->

SCR # 43 
  0 ( ASSEMBLER )
  1 
  2 30 IF. IFPL,  ( BPL )
  3 10 IF. IFMI,  ( BMI )
  4 70 IF. IFVC,  ( BVC )
  5 50 IF. IFVS,  ( BVS )
  6 B0 IF. IFCC,  ( BCC )
  7 90 IF. IFCS,  ( BCS )
  8 F0 IF. IFNE,  ( BNE )
  9 D0 IF. IFEQ,  ( BEQ )
 10 
 11 : BEGIN,   HERE ; IMMEDIATE
 12 : END,   IF D0 ELSE F0 THEN  C,
 13          HERE 1+ - DUP
 14         -80 < ?ER5 C, ; IMMEDIATE
 15 : UNTIL,  ~[COMPILE]  END,  ; IMMEDIATE        -->

SCR # 44 
  0 ( ASSEMBLER )
  1 
  2 0D VARIABLE MODE ( ABS. MODE )
  3 
  4 : MODE=   MODE @ = ; ( CK MODE )
  5 : 256<   DUP 100 ( HEX) U< ;
  6 : MODEFIX  256< IF -08 MODE +!
  7            THEN ;
  8      ( MODE=MODE-8 IF ADR<256 )
  9 : CKMODE   MODE= IF MODEFIX
 10                  THEN ;
 11 : M0 <BUILDS C, DOES> SWAP
 12      0D CKMODE  1D CKMODE SWAP
 13      C@ MODE @ OR C,    256< IF
 14      C, ELSE , THEN 0D MODE ! ;
 15  DECIMAL  46 LOAD    ;S

SCR # 45 
  0 B jDISKNAMEDAT                                                
  1                                                                
  2 APX-20029fig-FORTH 1.1 Rev. 2.0Patrick L. Mullarky01/15/821
  3                                                                J
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

SCR # 46 
  0 ( ASSEMBLER )
  1     HEX
  2 : X)  01 MODE ! ;   ( ~[ADDR,X]  )
  3 : #   09 MODE ! ;   ( IMMEDIATE )
  4 : )Y  11 MODE ! ;   ( ~[ADDR],Y  )
  5 : ,X  1D MODE ! ;   ( ADDR,X    )
  6 : ,Y  19 MODE ! ;   ( ADDR,Y    )
  7 
  8 
  9 00 M0 ORA, 20 M0 AND, 40 M0 EOR,
 10 60 M0 ADC, 80 M0 STA, A0 M0 LDA,
 11 C0 M0 CMP, E0 M0 SBC,
 12 
 13 : BIT,   256< IF 24 C, C, ELSE
 14          2C C, , THEN ;
 15 -->

SCR # 47 
  0 ( ASSEMBLER )
  1 
  2 : STOREADD  C, 256<  IF C, ELSE ,
  3             THEN 0D MODE ! ;
  4 
  5 : ZPAGE      OVER 100 < IF F7 AND
  6              THEN  ;
  7 : XYMODE  MODE @ 19 = MODE @ 1D
  8           = OR ;
  9 : M1  <BUILDS C, DOES> C@ MODE @
 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 -->

SCR # 48 
  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 -->

SCR # 49 
  0 ( END OF ASSEMBLER )
  1 
  2 FORTH DEFINITIONS
  3 
  4 
  5 LATEST 0C +ORIGIN !  ( NTOP )
  6 
  7 HERE   1C +ORIGIN !  ( FENCE )
  8 
  9 HERE   1E +ORIGIN !  ( DP )
 10 
 11 
 12 
 13 
 14 
 15 BASE !      ;S

SCR # 50 
  0 ( COLOR COMMANDS )
  1 BASE @ HEX
  2 : SETCOLOR  2 * SWAP 10 * OR SWAP
  3           02C4 ( COLPF0 ) + C! ;
  4 : SE.  SETCOLOR ;  ( ALIAS )
  5 
  6 (  REGISTER#-3, COLOR-2, LUM-1
  7 
  8 (    0-3          0-F     0-7
  9 
 10 -->
 11 
 12 
 13 
 14 
 15 

SCR # 51 
  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 -->

SCR # 52 
  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,
  7 
  8 : XGR  &GR  0 GR.  &GR ;
  9   ( EXIT GRAPHICS MODE )
 10 
 11 -->
 12 
 13 
 14 
 15 

SCR # 53 
  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 -->

SCR # 54 
  0 ( GRAPHICS I/O )
  1 
  2 : GTYPE  -DUP IF OVER + SWAP
  3         DO I C@ CPUT LOOP ELSE
  4         DROP ENDIF ;
  5 
  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 -->

SCR # 55 
  0 ( DRAW, FIL )
  1 
  2 2FB CONSTANT ATACHR
  3 2FD CONSTANT FILDAT
  4 
  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 ;
 10 
 11 : FIL  FILDAT C!  12 GCOM ;
 12 
 13 
 14 BASE ! ;SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS
 15 SSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSSS

SCR # 56 
  0 ( SOUND COMMANDS )
  1     BASE @ HEX
  2 
  3 D208 CONSTANT AUDCTL
  4 D200 CONSTANT AUDBASE
  5 
  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 --- )
 13 
 14 
 15 BASE ! ;S

SCR # 57 
  0 ( GRAPHICS TESTS )
  1 
  2 : BOX  0 10 10 PLOT  1 50 10 DRAW
  3        1 50 25 DRAW  1 10 25 DRAW
  4        1 10 10 DRAW ;
  5 
  6 : FBOX  XGR   5 GR.   BOX
  7       10 25 POS  2 FIL ;
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

SCR # 58 
  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 -->

SCR # 59 
  0 ( DOS OBJECT READER )
  1 
  2 : ADRCALC  NEXTWORD DUP ADDRSS ! NEXTWORD SWAP - 1+  #BYTES ! ;
  3 
  4 : BLOCKSET  DUP BLOCK# ! BLOCK GETCOUNT ;
  5 
  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

SCR # 60 
  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 ,  ;       -->

SCR # 61 
  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,
  6 
  7 XSAVE 100 * A6 + CONSTANT XLD
  8 : XL,   XLD  ,  ;
  9 
 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 

SCR # 62 
  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 
 15 

SCR # 63 
  0 ( FLOATING POINT WORDS )
  1 
  2 D4 CONSTANT FR0
  3 E0 CONSTANT FR1
  4 FC CONSTANT FLPTR
  5 F3 CONSTANT INBUF
  6 F2 CONSTANT CIX
  7 
  8 -->
  9 
 10 
 11 
 12 
 13 
 14 
 15 

SCR # 64 
  0 ( FLOATING POINT )
  1 
  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 
  9 
 10 : F. FR0 F@ FSWAP FR0 F! FASC
 11     F.TY SPACE FR0 F! ;
 12 : F?   F@ F. ;
 13 
 14 -->
 15 

SCR # 65 
  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> ;  -->

SCR # 66 
  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     -->

SCR # 67 
  0 ( FLOATING POINT )
  1 
  2 : FVARIABLE
  3  <BUILDS HERE F! 6 ALLOT DOES> ;
  4 
  5 : FCONSTANT
  6   <BUILDS HERE F! 6 ALLOT DOES>
  7   F@ ;
  8 
  9 : F0=   OR OR 0= ;
 10 : F=    F- F0= ;
 11 : F<    F- DROP DROP 80 AND 0 > ;
 12 
 13 
 14 
 15 BASE !  ;S

SCR # 68 
  0 
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

SCR # 69 
  0 ( FORTH INC.'S EDITOR )
  1 
  2 ( This editor was written by S.H. Daniel, in FORTH DIMENSIONS,
  3 ( Volume III, number 3.
  4 
  5 ( The only change was to make the cursor a "block" for higher
  6 ( visibility.  P. Mullarky 9/29/81
  7 
  8 -->
  9 
 10 
 11 
 12 
 13 
 14 
 15 

SCR # 70 
  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 ;  -->

SCR # 71 
  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 +! ;      -->

SCR # 72 
  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 ;   -->

SCR # 73 
  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 ;     -->

SCR # 74 
  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 
  7 
  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
 15 

SCR # 75 
  0 ( RAGSDALE ASSEMBLER )
  1 
  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."
  5 
  6 
  7 
  8 
  9 
 10 -->>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 11 >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
 12 
 13 
 14 
 15 

SCR # 76 
  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, -->

SCR # 77 
  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 -->

SCR # 78 
  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 >=
  8 
  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

SCR # 79 
  0 
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

SCR # 80 
  0 ( TEST SCREEN ))))))))))))))))))))))))))))))))))))))))))))))))))
  1 ))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))))
  2 123 456 XXX 789 123
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

SCR # 81 
  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 ;   -->

SCR # 82 
  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 
 15 

SCR # 83 
  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! ;
  7 
  8 CODE RELOCATE  XSAVE STX, 506 JSR, HERE 8 + JSR,  XSAVE LDX,
  9   NEXT JMP,  0C JMP(),
 10 
 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
 15 

SCR # 84 
  0 
  1 
  2 
  3 
  4 
  5 
  6 
  7 
  8 
  9 
 10 
 11 
 12 
 13 
 14 
 15 

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 -->

SCR # 86 
  0 ( "STARTING FORTH" CHANGES )
  1 
  2 : ABORT"   STATE @ IF COMPILE 0BRANCH HERE 0 ,
  3 COMPILE (.") ASCII " WORD HERE C@ 1+
  4 
  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 
 15 

SCR # 87 
  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 -->

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

Add new attachment

Only authorized users are allowed to upload new attachments.

List of attachments

Kind Attachment Name Size Version Date Modified Author Change note
atr
APX20029.ATR 92.2 kB 1 05-Apr-2010 22:16 Carsten Strotmann
pdf
EXTENDED fig-FORTH, Rev.2.pdf 7,711.2 kB 1 24-Jul-2014 15:53 Roland B. Wassenberg EXTENDED fig-FORTH, Rev.2
pdf
Extended fig-FORTH - APX APX-2... 7,698.0 kB 1 18-Jan-2013 18:20 Carsten Strotmann
« This page (revision-4) was last changed on 24-Jul-2014 16:05 by Roland B. Wassenberg