FigForth 1.1#

'Screens'

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 

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 

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 N ;
  5 
  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 ! ;S
 15 

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 


Add new attachment

Only authorized users are allowed to upload new attachments.
« This page (revision-3) was last changed on 05-Apr-2010 22:39 by Carsten Strotmann