# 4
( ERROR MESSAGES                  ) 
EMPTY STACK
DICTIONARY FULL
HAS INCORRECT ADDRESS MODE
ISN'T UNIQUE

DISC RANGE ?
FULL STACK
DISC ERROR ! (READ ERROR ?)
DISC DOOR OPEN/NO DISC
DISC IS WRITE PROTECTED
DISC ISN'T FORMATTED
NO DISC !


ABC80 kassettversion   (1982.11.10)
# 5
( ERROR MESSAGES                  ) 
COMPILATION ONLY, USE IN DEFINITION 
EXECUTION ONLY
CONDITIONALS NOT PAIRED
DEFINITION NOT FINISHED
IN PROTECTED DICTIONARY
USE ONLY WHEN LOADING
OFF CURRENT EDITING SCREEN
DECLARE VOCABULARY
# 6
( print&DUMP load, WHERE, ASCII   ) 
DECIMAL
 8 LOAD 12 LOAD



: WHERE ( PRINT SCR# AND IMAGE OF
          ERROR )
  DUP B/SCR / DUP SCR !
  ." SCR # " DECIMAL . SWAP C/L
  /MOD C/L * ROT BLOCK + CR C/L
  TYPE CR HERE C@ - SPACES 127 EMIT 
  QUIT ;

: ASCII ( transform ascii char to
           its number equivalent  ) 
  BL WORD HERE 1+ C@ /COMPILE/
  LITERAL ; IMMEDIATE
  ( FD III/3 page 72 )
-->
# 7
( LOADED-BY ASM                   ) 
FORTH DEFINITIONS DECIMAL

: LOADED-BY
  <BUILDS , DOES> @ LOAD ;

42 LOADED-BY ASM ( ASSEMBLER)

PAGE
." ASM    for 8080-Z80 assembler" 
CR CR
 ;S
# 8
(  print screen                  ) 
FORTH DEFINITIONS DECIMAL
: LINEADDR ( N -- SCRADR-2,MEM-1)
  >R 0 R CURADDR R> 40 * HERE + ;
: 
  XCUR C@ YCUR C@ ( SAVE CURSOR)
( SAVE COPY OF SCREEN )
  24 0 DO ( TRANSFER LINE-BY-LINE)
        I LINEADDR 40 CMOVE
        LOOP ( TRANSFER FINISHED)
   PR-ON
   24 0 DO ( PRINT OUT SCREEN)
        10 SPACES
        I LINEADDR SWAP DROP
        40 TYPE CR
        LOOP ( PRINTING FINISHED)
   PR-OFF
   24 0 DO ( RESTORE SCREEN)
        I LINEADDR SWAP 40 CMOVE
        LOOP ( SCREEN RESTORED)
    YCUR C! XCUR C! ;      ;S
# 12
( DUMP 1 of 3                     ) 
FORTH DEFINITIONS DECIMAL
: CARRAY <BUILDS 32 C, 33 C, ALLOT
  DOES> 2 + ;
8 CARRAY DMPTXT
: BLANKTXT DMPTXT 8 BLANKS ;
0 VARIABLE TXTCOUNT
16 VARIABLE OLDBASE
: ASCIIS  ( N -- N or BLANK )
  DUP 32 <
  IF ( NO-PRINTING )
    DROP 46 ( REPLACE WITH BLANK )
  ELSE DUP 127 >
    IF ( NON-PRINTING )
       DROP 46 ( REPLACE WITH BL )
    THEN
  THEN ;
: ADDR ( N -- )
  0 OUT ! U. 5 OUT @ - SPACES ;
: TXT  ( -- )   DMPTXT 2 - 10
  TYPE BLANKTXT CR ; -->
# 13
( DUMP 2 of 3                     ) 
FORTH DEFINITIONS DECIMAL
: DUMPA  ( START-ADDR-2,#-1 -- )
  PAGE OVER + SWAP BASE @ OLDBASE ! 
  DUP 8 MOD DUP 0< IF 8 + THEN DUP
  IF ( NOT START OF LINE )
    OVER ADDR  DUP
    3 * SPACES
  THEN TXTCOUNT ! HEX
  DO
    TXTCOUNT @ 0=
    IF OLDBASE @ BASE ! I ADDR HEX
  THEN
    I C@ DUP 3 .R ASCIIS DMPTXT
    TXTCOUNT @ + C! TXTCOUNT DUP
    @ 1+ 8 MOD DUP 0=
    IF TXT
    THEN SWAP !
  LOOP TXTCOUNT @ -DUP IF 8 SWAP - 3
  * SPACES TXT
 THEN OLDBASE @ BASE !  ;   -->
# 14
( DUMP 3 of 3                     ) 
FORTH DEFINITIONS DECIMAL
: DUMP  ( START-ADDR-2,#-1 -- )
  PAGE OVER + SWAP BASE @ OLDBASE ! 
  0 TXTCOUNT ! HEX
  DO
    TXTCOUNT @ 0=
    IF OLDBASE @ BASE ! I ADDR HEX
  THEN
    I C@ DUP 3 .R ASCIIS DMPTXT
    TXTCOUNT @ + C! TXTCOUNT DUP
    @ 1+ 8 MOD DUP 0=
    IF TXT
    THEN SWAP !
  LOOP TXTCOUNT @ -DUP IF 8 SWAP - 3
  * SPACES TXT
 THEN OLDBASE @ BASE !  ;   ;S
DUMP presents a memory dump directly
as requested.  DUMPA adjusts the
dump so that the starting address is
evenly divisible by 8. Bob 82.06.07
# 33
( DOUBLE#IN, SINGLE#IN            ) 
FORTH DEFINITIONS DECIMAL
: DOUBLE#IN
CR ." Input number "
QUERY        ( get # in TIB       ) 
HERE BL WORD ( transfer to HERE   ) 
NUMBER  ;    ( change to number   ) 
             ( and put on stack   ) 
: SINGLE#IN
  DOUBLE#IN DROP ;
;S
# 34
( NON-DESTRUCTIVE STACK PRINT     ) 
FORTH DEFINITIONS
: DEPTH
SP@ S0 @ - ;
: .S  CR DEPTH IF
 SP@ 2 - S0 @ 2 - DO I @ . -2 +LOOP 
  ELSE ." EMPTY " THEN ;
;S
# 42
( LOADING BLOCK FOR ASSEMBLER     ) 
DECIMAL
: ASM ;
43 LOAD 44 LOAD 45 LOAD 46 LOAD
66 LOAD 67 LOAD ( Z80-addition )
FORTH DEFINITIONS DECIMAL
;S
# 43
( ASSEMBLER 1                     ) 
HEX VOCABULARY ASSEMBLER IMMEDIATE
' ASSEMBLER CFA ' ;CODE 08 + !
: CODE ?EXEC CREATE /COMPILE/
  ASSEMBLER !CSP ; IMMEDIATE
: C; CURRENT @ CONTEXT ! ?EXEC
  ?CSP SMUDGE ; IMMEDIATE
: LABEL ?EXEC 0 VARIABLE SMUDGE -2
  ALLOT /COMPILE/ ASSEMBLER !CSP ;
  IMMEDIATE
: 8* DUP + DUP + DUP + ;
ASSEMBLER DEFINITIONS
4 CONSTANT H   5 CONSTANT L
2 CONSTANT D   3 CONSTANT E
6 CONSTANT M   6 CONSTANT SP
7 CONSTANT A   6 CONSTANT PSW
0 CONSTANT B   1 CONSTANT C
: 1MI <BUILDS C, DOES> C@ C, ;
: 2MI <BUILDS C, DOES> C@ + C, ;
DECIMAL             ;S
# 44
( ASSEMBLER 2                     ) 
ASSEMBLER DEFINITIONS HEX
: 3MI <BUILDS C, DOES> C@ SWAP
  8* + C, ;
: 4MI <BUILDS C, DOES> C@ C, C, ;
: 5MI <BUILDS C, DOES> C@ C, , ;
00 1MI NOP  76 1MI HLT  F3 1MI DI
FB 1MI EI   07 1MI RLC  0F 1MI RRC
17 1MI RAL  1F 1MI RAR  E9 1MI PCHL 
F9 1MI SPHL E3 1MI XTHL EB 1MI XCHG 
27 1MI DAA  2F 1MI CMA  37 1MI STC
3F 1MI CMC  80 2MI ADD  88 2MI ADC
90 2MI SUB  98 2MI SBB  A0 2MI ANA
A8 2MI XRA  B0 2MI ORA  B8 2MI CMP
09 3MI DAD  C1 3MI POP  C5 3MI PUSH 
02 3MI STAX 0A 3MI LDAX 04 3MI INR
05 3MI DCR  03 3MI INX  0B 3MI DCX
C7 3MI RST  D3 4MI OUT  DB 4MI IN
C6 4MI ADI  CE 4MI ACI  D6 4MI SUI
DE 4MI SBI  E6 4MI ANI  EE 4MI XRI
DECIMAL  ;S
# 45
( ASSEMBLER 3                     ) 
ASSEMBLER DEFINITIONS HEX
F6 4MI ORI  FE 4MI CPI  22 5MI SHLD 
2A 5MI LHLD 32 5MI STA  3A 5MI LDA
C4 5MI CNZ  CC 5MI CZ   D4 5MI CNC
DC 5MI CC   E4 5MI CPO  EC 5MI CPE
F4 5MI CP   FC 5MI CM   CD 5MI CALL 
C0 1MI RNZ  C8 1MI RZ   D0 1MI RNC
D8 1MI RC   E0 1MI RPO  E8 1MI RPE
F8 1MI RM   C9 1MI RET  C3 5MI JMP
F0 1MI RP
C2 CONSTANT 0=   D2 CONSTANT CS
E2 CONSTANT PE   F2 CONSTANT 0<
: NOT 8 + ; : MOV 8* 40 + + C, ;
: MVI 8* 6 + C, C, ;
: LXI 8* 1+ C, , ;
: ENDIF 2 ?PAIRS HERE SWAP ! ;
: THEN /COMPILE/ ENDIF ;
: IF C, HERE 0 , 2 ;
: ELSE 2 ?PAIRS C3 IF ROT SWAP
  ENDIF 2 ; DECIMAL  ;S
# 46
( ASSEMBLER 4                     ) 
ASSEMBLER DEFINITIONS HEX
: BEGIN   HERE 1 ;
: UNTIL   SWAP 1 ?PAIRS C, , ;
: AGAIN   1 ?PAIRS C3 C, , ;
: WHILE   IF 2+ ;
: REPEAT  >R >R AGAIN R> R> 2 -
  ENDIF ;
FORTH DEFINITIONS DECIMAL
;S
# 54
( CLOCK ROUTINES SCREEN 1 OF 2    ) 
FORTH DEFINITIONS DECIMAL
0 VARIABLE MYCLOCK 0 ,
: INVERT.CLOCK
  ( ADDR.-1 --                    ) 
  DUP DUP C@ 1 - 255 XOR SWAP C!
  1+ DUP @ 65535 XOR SWAP ! ;



: SET.TIME ( hr-3, min-2, sec-1 --) 
  SWAP 60 * + ( sec )
  50 U* ( units)
  ROT 60 * ( min ) 3000 U* ( units)
  D+
  SWAP MYCLOCK !
  MYCLOCK 2+ C!
  MYCLOCK INVERT.CLOCK
  MYCLOCK CLOCK 3 CMOVE ;
-->
# 55
( CLOCK 2 OF 2                    ) 
 FORTH DEFINITIONS DECIMAL
 : CHECK.CLOCK  ( -- T/F          ) 
   ( FALSE IF IDENTICAL           ) 
   3 0 DO
       MYCLOCK I + C@ PAD I + C@
       XOR LOOP + + ;

 : READ.CLOCK  ( -- )
   BEGIN CLOCK PAD 3 CLOCK MYCLOCK
   3 CMOVE CMOVE CHECK.CLOCK 0=
     UNTIL
   MYCLOCK INVERT.CLOCK ;

 : READ.TIME
   ( -- 50 msec-4,SEC-3,MIN-2,H-1 ) 
   READ.CLOCK MYCLOCK DUP @ SWAP 2+ 
   C@ 3000 U/ SWAP  50 /MOD
   ROT 60 /MOD 24 MOD ;
;S
# 60
( grafics                         ) 
FORTH DEFINITIONS DECIMAL
1 CVARIABLE PATTERN 2 C, 4 C, 8 C,
16 C, 64 C,
: GRAFIK.LINE  ( line# --         ) 
  0 SWAP CURADDR 151 SWAP C! ;
: GRAFIK.SCR   ( -- )
  PAGE 24 0 DO I GRAFIK.LINE LOOP ; 
: DOT.ADDR  ( X, Y -- pattern, addr)
  0 MAX 71 MIN SWAP 0 MAX 77 MIN
  SWAP ( keep X,Y within bounds   ) 
  3 /MOD SWAP DUP + ROT 2 /MOD 1+
  ROT  ROT + >R SWAP CURADDR R>
  PATTERN + C@ SWAP ;
: SET.DOT      ( X, Y --          ) 
  DOT.ADDR DUP C@ ROT OR SWAP C! ;
: CLEAR.DOT    ( X, Y --          ) 
  DOT.ADDR SWAP 255 XOR SWAP DUP C@ 
  ROT AND SWAP C! ;
: ?DOT         ( X, Y -- true/false)
  DOT.ADDR C@ AND ;
# 63
( Y/N                             ) 
FORTH DEFINITIONS DECIMAL
: Y/N
  ( wait for Y or N and return with 
    1 for Y and 0 for N           ) 
  ( --T/F)
  ." (Y/N) "
  BEGIN
    KEY 127 32 - AND ( small to cap)
    DUP 89      = IF DROP 2
       ELSE 78      = IF 1
          ELSE 0
          THEN
       THEN -DUP
    UNTIL
  1 - DUP IF ." Y"
          ELSE ." N"
  THEN CR
;
;S
# 66
( ASSEMBLER 5                     ) 
ASSEMBLER DEFINITIONS HEX
NEXT 1 - CONSTANT HPUSH
NEXT 2 - CONSTANT DPUSH
: END-CODE  /COMPILE/ C; ;
 D9 1MI EXX
: BITAD <BUILDS C, DOES> CB C, C@
  SWAP 8* + + C, ;
 40 BITAD BIT
 80 BITAD RES
 C0 BITAD SET
: 2BYTE <BUILDS C, DOES> ED C, C@
  C, ;
 67 2BYTE RRD    6F 2BYTE RLD
 A0 2BYTE LDI    A1 2BYTE CPII
 A2 2BYTE INI    A3 2BYTE OUTI
 A8 2BYTE LDD    A9 2BYTE CPD
 AA 2BYTE IND    AB 2BYTE OUTD
 B0 2BYTE LDIR   B1 2BYTE CPIR
 FORTH DEFINITIONS DECIMAL
 ;S
# 67
( ASSEMBLER 6                     ) 
ASSEMBLER DEFINITIONS HEX
 B2 2BYTE INIR    B3 2BYTE OTIR
 B8 2BYTE LDDR    B9 2BYTE CPDR
 BA 2BYTE INDR    BB 2BYTE OTDR
: 2BZ80 <BUILDS C, DOES>
 CB C, C@ + C, ;
 00 2BZ80 RLCZ    08 2BZ80 RRCZ
 10 2BZ80 RL      18 2BZ80 RR
 20 2BZ80 SLA     28 2BZ80 SRA
                  38 2BZ80 SRL
 FORTH DEFINITIONS DECIMAL ;S
 Z80 mnemonics   FORTH mnemonics
     CPI               CPII
     RLC               RLCZ
     RRC               RRCZ
# 68
( FORTH-79 DEFINITIONS            ) 
 FORTH DEFINITIONS DECIMAL
: 1- 1 - ;
: 2- 2 - ;
: <> = 0= ;
: DEPTH ( -- n )
  SP@ S0 @ SWAP - 2 / ;
: PICK ( n1 -- n2 )
( If n1 >0, get the n1th. number  ) 
( from the stack, and return it on) 
( top of the stack )
  DEPTH 1- OVER < OVER 1 < OR
( check for bad index: leave true
  if bad, false if OK )
  IF ." INDEX OUTSIDE LIMITS"
     7 EMIT QUIT
  ELSE DUP + SP@ + @
  THEN ;
: ROLL ( n -- re-arranged stack )
  >R R PICK SP@ DUP 2+ R> DUP +
  <CMOVE DROP ;         -->
# 69
( FORTH-79 DEFINITIONS            ) 
 FORTH DEFINITIONS DECIMAL
: >< ( swap bytes )  ( FORTH DEF. ) 
  DUP 256 / SWAP 255 AND 256 * + ;
VOCABULARY FORTH-79 IMMEDIATE
FORTH-79 DEFINITIONS DECIMAL
: CREATE ( agrees with Brodie )
  0 VARIABLE -2 ALLOT ;
: WORD ( -- address )
  WORD HERE ;
 ;S