Basic vor TFORTH und H4th..

[funkheld]

Hmmm..., habe jetzt festgestellt das dieses Forth doch nicht so bei den BASIC-Proggern ankommt.
Wahrscheinlich ist es so Lernintensive für eine BASIC-Progger und gewöhnungsbedürftig mit den Befehlen und dem anderen Procedere.
Der Austausch mit Forth ist zu Null runter wenn ich die Seiten hier von Anfang der Gründungszeit an betrachtet.
Mit dem Basic vom ZX81 wird mehr gebastelt.

Gruss

[Paul]

Das ist korrekt.
Die meisten unter uns wissen nur ein paar forth Bruchstücke.
Interessiert sind wir aber schon.
Vielleicht kann ja mal ein Sachkundiger einen kurzen Lehrgang anbieten, ggf. Analog zu unserem C Kursus?
Jetzt in der dunklen Jahreszeit wäre das toll.
Viel mehr als vList kriege ich noch nicht hin.
Gerne auch mit EightyOne als Basis.
Ich könnte mir vorstellen das Heinz dich ggf. unterstützen würde oder wenigstens zusätzlichen Support anbieten könnte.

[funkheld]

Hmm... das ist nicht so einfach, nur eben mal einen Lehrgang machen.
Das Interesse allein reicht da wohl für diese Sprache Forth nicht aus.
Man muss da schon Tief einsteigen , weil die Wörter , die etwas machen sollen wie ein Fadensytem miteinander verbunden sind.
Und dieses Fadensystem wird auch gebraucht für die Wörter die neu entstehen und sollte verstanden werden.
Und viele, viele andere Dinge zum Verstehen der Wörter und des Ablaufes erfordert eine volle Begeisterung um nicht aufzugeben.
...DUP...NIP...@...!... PICK... usw reicht da nicht aus.

Unten ist nur eine kleinere Library.fth die das Forth noch erweitern soll mit Wörtern, gemischt mit kleinen ASM-Code-Routinen.
Zieht euch die mal rein....
Also wenn von Früher her keine Begeisterung da ist, tut euch das nicht an.

Die Experimente mit dem Basic auf den ZX81 sind wunderbar und eine Herausforderung, habe ich jetzt auch mit Begeisterung
festgestellt und werde auch daran weiter festhalten. Man hat hier mit Basic mehr Unterhaltung und Austausch, das ist wichtig.

Ich habe das Forth schon einige jahre gemacht , auf den C64 (Volksforth, Durexforth) und auf den PC (WinForth).
Darum bin ich begeistert von dem FORTH.

Wenn ich jetzt ein Spiel oder ähnliches in Forth schreiben würde, könnte ein Anfänger da nichts mit anfangen obwohl es in Source-Code wäre.
Ein Spiel in Basic würde hier jeder verstehen....

Code: Alles auswählen

\ --------------------------------------------------------------------------------------------------
\                                           Compiler
\ --------------------------------------------------------------------------------------------------

\ Compile immediate words
: [COMPILE]  ( -- )
   ' ,
; IMMEDIATE

\ Find word & compile as literal
: [']  ( -- )           \ When encountered in a colon definition, the
   ' LIT LIT , ,        \ phrase  ['] xxx  will cause   LIT,xxt  to be
; IMMEDIATE             \ compiled into the colon definition 
                        \ (where xxt is the execution token of word xxx).
                        \ When the colon definition executes, xxt will
                        \ be put on the stack.  (All xt's are one cell.)


\ Postpone compile action of word
: POSTPONE  ( -- )
   BL WORD FIND
   DUP 0= IF QUESTION THEN
   0< IF  ( -- xt )    \ non immed: add code to current def'n to compile xt later.
       ['] LIT ,  ,    \ add "LIT,xt,COMMAXT"
       ['] , ,         \ to current definition
      ELSE  ,          \ immed: compile into cur. def'n
      THEN
; IMMEDIATE

\ Append numeric double literal
: DLITERAL  ( d -- )   
   STATE @
   IF SWAP LITERAL LITERAL THEN
;

\ Recurse current definition
: RECURSE  ( -- )
   LATEST CFA ,
; IMMEDIATE

\ "Reveal" latest definition
: REVEAL  ( -- )
   LATEST DUP C@ 127 AND SWAP C!
;



\ --------------------------------------------------------------------------------------------------
\                                         Word Definition
\ --------------------------------------------------------------------------------------------------


\ Create a double variable
: 2VARIABLE  ( d -- )
   CREATE SWAP , , 
;

\ Create a double constant
: 2CONSTANT
   CREATE SWAP , , DOES>
   2@ SWAP
;

\ Create value object
: VALUE ( x "<spaces>name" -- )
   CONSTANT
;

\ Set a value
: TO  ( x "<spaces>name" -- )
   '              ( get the name of the value )
   3 +            ( increment to point at the value )
   STATE @        ( compiling? )
   IF
      COMPILE LIT ( compile LIT )
      ,           ( compile the address of the value )
      COMPILE !   ( compile ! )
   ELSE           ( immediate mode )
      !           ( update it straightaway )
   THEN
; IMMEDIATE

\ define deferred word
: DEFER  ( "name" -- )
   CREATE ['] ABORT ,  \ you should not rely on initialization with noop
DOES>
   @ EXECUTE
;

\ set a deferred word
: IS ( xt "<spaces>name" -- )
   [COMPILE] TO      \ or POSTPONE TO
; IMMEDIATE

\ The JUPITER ACE's DEFINER word
: DEFINER ( -- )
   [COMPILE] : COMPILE CREATE     \ or POSTPONE : POSTPONE CREATE
;



\ --------------------------------------------------------------------------------------------------
\                                       Stack Manipulation
\ --------------------------------------------------------------------------------------------------


\ : NIP  ( x1 x2 -- x2)            ( per stack diagram )
\      SWAP DROP ;
CODE NIP  
  E1 C,          \ pop   hl
  NEXT           \ jp NEXT

\ : TUCK  ( x1 x2 -- x2 x1 x2)     ( per stack diagram )
\      SWAP OVER ;
CODE TUCK
  E1 C,          \ pop hl
  C5 C,          \ push bc	        ; insert top item
  E5 C,          \ push hl
  NEXT           \ jp NEXT

\ : PICK  ( Xn .. X1 X0 n -- Xn .. X1 X0 Xn)  ( Copy nth cell to top )
\      2* SP@ 2+ + @ ;
CODE PICK
  CB C, 21 C,    \ sla c           ;2*
  CB C, 10 C,    \ rl b            ;
  60 C,          \ ld h,b
  69 C,          \ ld l,c
  39 C,          \ add hl,sp
  4E C,          \ ld c,(hl)       ;get element to be PICK'ed
  23 C,          \ inc hl          ;
  46 C,          \ ld b,(hl)       ;
  NEXT           \ jp NEXT

\ Rotate nth cell to top
CODE ROLL ( Xn .. X1 X0 n -- Xn-1 .. X1 X0 Xn )
  C5 C,          \ push bc  
  D9 C,          \ exx             ;save IP
  C1 C,          \ pop bc
  CB C, 21 C,    \ sla c           ;2*
  CB C, 10 C,    \ rl b            ;
  03 C,          \ inc bc          ;1+
  60 C,          \ ld h,b
  69 C,          \ ld l,c
  0B C,          \ dec bc          ;bytes count to be moved
  39 C,          \ add hl,sp
  E5 C,          \ push hl         ;destination
  C5 C,          \ push bc
  56 C,          \ ld d,(hl)       ;get element to be ROLL'ed
  2B C,          \ dec hl          ;
  5E C,          \ ld e,(hl)       ;
  2B C,          \ dec hl          ;HL = origin
  C1 C,          \ pop bc
  EB C,          \ ex de,hl
  E3 C,          \ ex (sp),hl
  EB C,          \ ex de,hl
  78 C,          \ ld a,b
  B1 C,          \ or c            ; count=0?
  28 C, 02 C,    \ jr z,+2         ;
  ED C, B8 C,    \ lddr
  D9 C,          \ exx             ;restore IP
  C1 C,          \ pop bc          ;get TOS
  E1 C,          \ pop hl          ;adjust SP
  NEXT           \ jp NEXT

\ Per stack diagram
\ : 2SWAP  ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
\    ROT >R ROT R> ;
CODE 2SWAP
  E1 C,          \ pop hl          ; bc=x4, hl=x3
  D9 C,          \ exx
  C1 C,          \ pop  bc
  E1 C,          \ pop  hl         ; bc'=x2, hl'=x1
  D9 C,          \ exx
  E5 C,          \ push hl
  C5 C,          \ push bc
  D9 C,          \ exx
  E5 C,          \ push hl
  C5 C,          \ push bc
  D9 C,          \ exx
  C1 C,          \ pop  bc
  NEXT           \ jp NEXT

\ Per stack diagram
\ : 2OVER  ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 )
\    >R >R 2DUP
\    R> R> 2SWAP ;
CODE 2OVER
  D9 C,          \ exx
  E1 C,          \ pop hl
  D1 C,          \ pop de
  C1 C,          \ pop bc
  C5 C,          \ push bc
  D5 C,          \ push de
  E5 C,          \ push hl
  D9 C,          \ exx
  C5 C,          \ push bc
  D9 C,          \ exx
  C5 C,          \ push bc
  D5 C,          \ push de
  D9 C,          \ exx
  C1 C,          \ pop  bc
  NEXT           \ jp NEXT



\ --------------------------------------------------------------------------------------------------
\                                           Comparison
\ --------------------------------------------------------------------------------------------------

\ Test not eq
: <>  ( x1 x2 -- flag )
   = 0=
;

\ Leave greater of two numbers
: MAX  ( n1 n2 -- n3)
   2DUP <
   IF SWAP
   THEN DROP
;

\ Leave lesser of two numbers
: MIN  ( n1 n2 -- n3)
   2DUP >
   IF SWAP
   THEN DROP
;

\ Test u1<u2, unsigned
CODE U<  ( u1 u2 -- flag)
  E1 C,          \ pop hl
  B7 C,          \ or a
  ED C, 42 C,    \ sbc hl,bc       ; u1-u2 in HL, SZVC valid
  9F C,          \ sbc a,a         ; propagate cy through A
  47 C,          \ ld b,a          ; put 0000 or FFFF in TOS
  4F C,          \ ld c,a
  NEXT           \ jp NEXT

\ Test u1>u2, unsigned
: U>     ( u1 u2 -- flag)
   SWAP U< ;

\ Unsigned minimum
: UMIN   ( u1 u2 -- u )
   2DUP U>
   IF SWAP
   THEN DROP ;

\ Unsigned maximum
: UMAX   ( u1 u2 -- u )
   2DUP U<
   IF SWAP
   THEN DROP ;


\ n2<=n1<n3?
: WITHIN  ( n1|u1 n2|u2 n3|u3 -- f )
   OVER - >R - R> U<
;


\ --------------------------------------------------------------------------------------------------
\                                       Integer Arithmetic
\ --------------------------------------------------------------------------------------------------

\ Add double length numbers
CODE D+  ( d1 d2 -- d1+d2 )
  D9 C,         \        exx
  C1 C,         \        pop bc          ; BC'=d2lo
  D9 C,         \        exx
  E1 C,         \        pop hl          ; HL=d1hi,BC=d2hi
  D9 C,         \        exx
  E1 C,         \        pop hl          ; HL'=d1lo
  09 C,         \        add hl,bc
  E5 C,         \        push hl         ; 2OS=d1lo+d2lo
  D9 C,         \        exx
  ED C, 4A C,   \        adc hl,bc       ; HL=d1hi+d2hi+cy
  44 C,         \        ld b,h
  4D C,         \        ld c,l
  NEXT          \        jp NEXT

\  Subtract double numbers
\ : D- DNEGATE D+ ;
CODE D-  ( d1 d2 -- d1-d2 )
  D9 C,         \        exx
  C1 C,         \        pop bc          ; BC'=d2lo
  D9 C,         \        exx
  E1 C,         \        pop hl          ; HL=d1hi,BC=d2hi
  D9 C,         \        exx
  E1 C,         \        pop hl          ; HL'=d1lo
  A7 C,         \        and a
  ED C, 42 C,   \        sbc hl,bc
  E5 C,         \        push hl         ; 2OS=d1lo-d2lo
  D9 C,         \        exx
  ED C, 42 C,   \        sbc hl,bc       ; HL=d1hi-d2hi-cy
  44 C,         \        ld b,h
  4D C,         \        ld c,l
  NEXT          \        jp NEXT

\ Add single to double
CODE M+      ( d n -- d )
  EB C,         \         ex de,hl
  D1 C,         \         pop de          ; hi cell
  E3 C,         \         ex (sp),hl      ; lo cell, save IP
  09 C,         \         add hl,bc
  42 C,         \         ld b,d          ; hi result in BC (TOS)
  4B C,         \         ld c,e
  30 C, 01 C,   \         jr nc,mplus1
  03 C,         \         inc bc
  D1 C,         \ mplus1: pop de          ; restore saved IP
  E5 C,         \         push hl         ; push lo result
  NEXT          \         jp NEXT

\ Signed 16*16->32 multiply.
: M*  ( n1 n2 -- d )
   2DUP XOR >R    ( Carries sign of the result )
   SWAP ABS SWAP ABS UM*
   R> ?DNEGATE
;

\  Symmetric signed div
: SM/REM  ( d1 n1 -- n2 n3 )
   2DUP XOR >R             ( sign of quotient )
   OVER >R                 ( sign of remainder )
   ABS >R DABS R> UM/MOD
   SWAP R> ?NEGATE
   SWAP R> ?NEGATE
;

\ Floored signed div'n
: FM/MOD  ( d1 n1 -- n2 n3 )
   DUP >R             ( save divisor )
   SM/REM
   DUP 0< IF          ( if quotient negative, )
       SWAP R> +      (   add divisor to rem'dr )
       SWAP 1-        (   decrement quotient )
   ELSE R> DROP THEN
;

\ Multiply n1 by n2 producing double-cell intermediate,
\ then divide it by n3. Return single-cell remainder and
\ single-cell quotient.
\ : */MOD  ( n1 n2 n3 -- n4 n5 )
\    ROT >R R@ ABS ROT DUP R> XOR >R ABS UM* 
\    ROT DUP R@ XOR >R ABS UM/MOD              \ these two lines is part of /MOD definition and 
\    R> ?NEGATE SWAP R> ?NEGATE SWAP           \ can be replaced by:
\ ;                                            \ BRANCH [ ' /MOD 15 + , REVEAL

: */MOD  ( n1 n2 n3 -- n4 n5 )
   ROT >R R@ ABS ROT DUP R> XOR >R ABS UM* 
   BRANCH [ ' /MOD 15 + ,          \ jump into /MOD definition
   REVEAL                          \ reset the smudge bit (don't has semicolon at the end)

\ Multiply n1 by n2 producing double-cell intermediate,
\ then divide it by n3. Return single-cell quotient.
: */  ( n1 n2 n3 -- n4 )
   */MOD NIP
;

\ Signed remainder
: MOD  ( n1 n2 -- n3 )
   /MOD DROP
;

\ Single -> double prec.
: S>D  ( n -- d )
   DUP 0<
;

\ Bitwise inversion
\ : INVERT  NEGATE 1+ ;
CODE INVERT  ( x1 -- x2 )
  78 C,          \ ld a,b
  2F C,          \ cpl
  47 C,          \ ld b,a
  79 C,          \ ld a,c
  2F C,          \ cpl
  4F C,          \ ld c,a
  NEXT           \ jp NEXT

\ Negate double precision
: DNEGATE    ( d1 -- d2 )
   SWAP INVERT SWAP INVERT 1 M+
;

\ Negate d1 if n negative
: ?DNEGATE   ( d1 n -- d2 )
   0< IF DNEGATE THEN
;

\ Absolute value dbl.prec.
: DABS       ( d1 -- +d2 )
   DUP ?DNEGATE
;

\ Logical L shift u places
CODE LSHIFT  ( x1 u -- x2 )
  41 C,         \         ld b,c        ; b = loop counter
  E1 C,         \         pop hl        ;   NB: hi 8 bits ignored!
  04 C,         \         inc b         ; test for counter=0 case
  18 C, 01 C,   \         jr lsh2
  29 C,         \ .lsh1   add hl,hl     ; left shift HL, n times
  18 C, FD C,   \ .lsh2   djnz lsh1
  44 C,         \         ld b,h        ; result is new TOS
  4D C,         \         ld c,l
  NEXT          \         jp NEXT

\ Logical R shift u places
CODE RSHIFT  ( x1 u -- x2 )
  41 C,         \         ld b,c        ; b = loop counter
  E1 C,         \         pop hl        ;   NB: hi 8 bits ignored!
  04 C,         \         inc b         ; test for counter=0 case
  18 C, 04 C,   \         jr rsh2
  CB C, 3C C,   \ .rsh1   srl h         ; right shift HL, n times
  CB C, 0D C,   \         rr l
  18 C, FA C,   \ .rsh2   djnz rsh1
  44 C,         \         ld b,h        ; result is new TOS
  4D C,         \         ld c,l
  NEXT          \         jp NEXT



\ --------------------------------------------------------------------------------------------------
\                                        Memory and I/O operations
\ --------------------------------------------------------------------------------------------------


\ : 2@  DUP 2+ @ SWAP @ ;
CODE 2@  ( addr -- x1 x2 )           ( fetch 2 cells )
  60 C,          \ ld h,b
  69 C,          \ ld l,c
  4E C,          \ ld c,(hl)
  23 C,          \ inc hl
  46 C,          \ ld b,(hl)
  23 C,          \ inc hl
  7E C,          \ ld a,(hl)
  23 C,          \ inc hl
  6E C,          \ ld h,(hl)
  6F C,          \ ld l,a
  E5 C,          \ push hl
  NEXT           \ jp NEXT

\ : 2!  SWAP OVER ! 2+ ! ;
CODE 2!  ( x1 x2 addr -- )          ( store 2 cells )
  60 C,          \ ld h,b
  69 C,          \ ld l,c
  C1 C,          \ pop bc
  71 C,          \ ld (hl),c
  23 C,          \ inc hl
  70 C,          \ ld (hl),b
  23 C,          \ inc hl
  C1 C,          \ pop bc
  71 C,          \ ld (hl),c
  23 C,          \ inc hl
  70 C,          \ ld (hl),b
  C1 C,          \ pop bc
  NEXT           \ jp NEXT

\ Output char to port
CODE PC!    ( char c-addr -- )
  E1 C,          \ pop hl          ; char in L
  ED C, 69 C,    \ out (c),l       ; to port (BC)
  C1 C,          \ pop bc          ; pop new TOS
  NEXT           \ jp NEXT

\ Input char from port
CODE PC@    ( c-addr -- char )
  EB C, 48 C,    \ in c,(c)        ; read port (BC) to C
  06 C, 00 C,    \ ld b,0
  NEXT           \ jp NEXT


\ --------------------------------------------------------------------------------------------------
\                                        Control Structures
\ --------------------------------------------------------------------------------------------------


\       CASE ( as defined in Jonesforth )
\	CASE...ENDCASE is how we do switch statements in FORTH.  There is no generally
\	agreed syntax for this, so I've gone for the syntax mandated by the ISO standard
\	FORTH (ANS-FORTH).
\
\		( some value on the stack )
\		CASE
\		test1 OF ... ENDOF
\		test2 OF ... ENDOF
\		testn OF ... ENDOF
\		... ( default case )
\		ENDCASE
\
\	The CASE statement tests the value on the stack by comparing it for equality with
\	test1, test2, ..., testn and executes the matching piece of code within OF ... ENDOF.
\	If none of the test values match then the default case is executed.  Inside the ... of
\	the default case, the value is still at the top of stack (it is implicitly DROP-ed
\	by ENDCASE).  When ENDOF is executed it jumps after ENDCASE (ie. there is no "fall-through"
\	and no need for a break statement like in C).
\
\	The default case may be omitted.  In fact the tests may also be omitted so that you
\	just have a default case, although this is probably not very useful.
\

: CASE
   0           ( push 0 to mark the bottom of the stack )
; IMMEDIATE

: OF
   COMPILE OVER         ( compile OVER )
   COMPILE =            ( compile = )
   [COMPILE] IF         ( compile IF )
   COMPILE DROP         ( compile DROP )
; IMMEDIATE

: ENDOF
   [COMPILE] ELSE       ( ENDOF is the same as ELSE )
; IMMEDIATE

: ENDCASE
   COMPILE DROP	( compile DROP )

   ( keep compiling THEN until we get to our zero marker )
   BEGIN
     ?DUP
   WHILE
     [COMPILE] THEN
   REPEAT
; IMMEDIATE



\ --------------------------------------------------------------------------------------------------
\                                      Character Input/Output 
\ --------------------------------------------------------------------------------------------------


\ Reads the keyboard
CODE INKEY  ( -- ASCII code)
  C5 C,          \        push bc         ;save old TOS
  D5 C,          \        push de         ;save IP
  CD C, 02BB ,   \        call $2BB       ;KEYBOARD
  7D C,          \        ld a,l
  3C C,          \        inc a
  28 C, 0A C,    \        jr z,INK1
  44 C,          \        ld b,h
  4D C,          \        ld c,l
  CD C, 07BD ,   \        call $7BD       ;DECODE
  11 C, 4347 ,   \        ld de,$4347     ;K_UNSHIFT - $7E
  19 C,          \        add hl,de
  7E C,          \        ld a,(hl)
  06 C, 00 C,    \ INK1:  ld b,0          ;put the key code in BC
  4F C,          \        ld c,a          ;
  D1 C,          \        pop de          ;restore IP
  NEXT           \        jp NEXT

\ Output n spaces
: SPACES  ( n -- )  
   ?DUP IF 0 DO SPACE LOOP THEN ;

\ Wait for a number to be typed
: #IN
   BEGIN
    ." ?" TIB @ DUP LBP ! INPUT
    BL WORD COUNT NUMBER
   UNTIL DROP ;


\ --------------------------------------------------------------------------------------------------
\                                     Number Input/Output 
\ --------------------------------------------------------------------------------------------------


\ Convert an unsigned number to a string.
: (U.) ( u -- c-addr n )
   <# #S #>
;

\ Print a string, right padded with n1 spaces.
: (.R) ( n1 c-addr n2 -- )
   ROT OVER - 0 MAX SPACES TYPE
;

\ Convert a signed number to a string.
: (.) ( n -- c-addr n )
   <# DUP ABS 0 #S ROT SIGN #>
;

\ Convert a double number to a string.
: (D.)  ( d -- c-addr u )
   SWAP OVER DABS
   <#  #S ROT SIGN #>
;

\ Prints an unsigned number, padded to a certain width
: U.R ( u width -- )
   SWAP 0 (U.) (.R)
;

\ Prints a signed number, padded to a certain width.
: .R ( n width -- )
   SWAP (.) (.R)
;

\ Display d right-justified in field of width n.
: D.R  ( d n -- )
   >R (D.) R> OVER -
   0 MAX SPACES TYPE
;

\ Display d in free field format followed by a space.
: D.  ( d -- )
   (D.) TYPE SPACE
;

\ Display ud in free field format followed by a space.
: UD. ( ud -- )
   (U.) TYPE SPACE
;



\ --------------------------------------------------------------------------------------------------
\                                            Strings
\ --------------------------------------------------------------------------------------------------
     

\  S" string" is used in FORTH to define strings.  It leaves the address of the string and
\  its length on the stack, (length at the top of stack).
\
\  This is tricky to define because it has to do different things depending on whether
\  we are compiling or in immediate mode.  (Thus the word is marked IMMEDIATE so it can
\  detect this and do different things).
\
\  In immediate mode there isn't a particularly good place to put the string, but in this
\  case we put the string at PAD.  This is meant as a temporary location, likely to be
\  overwritten soon after.

\ Run-time code for S"
: (S")    ( -- c-addr u )
   R> COUNT 2DUP + >R
;

\  Get in-line string
: S"   ( -- ) ( -- c-addr u )
   STATE @
   IF
      COMPILE (S")               ( compile mode )
      ASCII " WORD C@ 1+ ALLOT
   ELSE
      ASCII " WORD COUNT         ( immediate mode )
      PAD 2DUP C! 1+
      SWAP 2DUP >R >R
      CMOVE R> R>
   THEN
; IMMEDIATE




\ --------------------------------------------------------------------------------------------------
\                                             Block
\ --------------------------------------------------------------------------------------------------


\ Move from bottom
CODE CMOVE ( c-addr1 c-addr2 u -- )
  E1 C,          \            pop hl            ; destination adrs
  EB C,          \            ex de,hl          ; DE = 'dst', HL = IP
  E3 C,          \            ex (sp),hl        ; HL = 'src', IP on stack
  78 C,          \            ld a,b            ; test for count=0
  B1 C,          \            or c              ;
  28 C, 02 C,    \            jr z,CMOVEDONE    ;  yes
  ED C, B0 C,    \            ldir              ; move 'n' bytes
  D1 C,          \ CMOVEDONE: pop de            ; restore IP
  C1 C,          \            pop bc            ; pop new TOS
  NEXT           \            jp NEXT

\ Move from top
CODE CMOVE>  ( c-addr1 c-addr2 u -- )
  E1 C,          \            pop hl          ; destination adrs
  11 C,          \            add hl,bc       ; last byte in destination
  2B C,          \            dec hl
  EB C,          \            ex de,hl        ; DE = 'dst', HL = IP
  E3 C,          \            ex (sp),hl      ; HL = 'src', IP on stack
  78 C,          \            ld a,b          ; test for count=0
  B1 C,          \            or c            ;
  28 C, 04 C,    \            jr z,UMOVEDONE  ;  yes
  11 C,          \            add hl,bc       ; last byte in source
  2B C,          \            dec hl
  ED C, B8 C,    \            lddr            ; move from top to bottom
  D1 C,          \ UMOVEDONE: pop de          ; restore IP
  C1 C,          \            pop bc          ; pop new TOS
  NEXT           \            jp NEXT

\ Smart move ( version for 1 address unit = 1 char )
: MOVE   ( addr1 addr2 u -- )
   >R 2DUP SWAP DUP R@ +     ( -- ... dst src src+n )
   WITHIN IF    R> CMOVE>    (  src <= dst < src+n )
          ELSE  R> CMOVE
          THEN               ( otherwise )
;

\ Fill memory at the address with the specified quantity of bytes b
CODE FILL ( addr qty b -- )
  C5 C,          \        push    bc         ;save TOS
  D9 C,          \        exx                ;/ save IP
  D1 C,          \        pop     de         ;/ (E)<--byte
  C1 C,          \        pop     bc         ;  (BC)<--quantity
  E1 C,          \        pop     hl         ;/ (HL)<--addr
  78 C,          \ FILL1: ld      a,b
  B1 C,          \        or      c          ;  QTY=0?
  28 C, 05 C,    \        jr      z,FILL2    ;  yes
  73 C,          \        ld      (hl),e     ;/ ((HL))<--byte
  23 C,          \        inc     hl         ;  inc pointer
  0B C,          \        dec     bc         ;  dec counter
  18 C, F8 C,    \        jr      FILL1      ;/
  D9 C,          \ FILL2: exx                ;/ RESTORE IP
  C1 C,          \        pop     bc         ;new TOS
  NEXT           \        jp NEXT

\ --------------------------------------------------------------------------------------------------
\                                          Miscellaneous
\ --------------------------------------------------------------------------------------------------


\ Set the SLOW mode
CODE SLOW  ( -- )
  D9 C,          \ exx
  CD C, F2B ,    \ call $f2b  ;SLOW
  D9 C,          \ exx
  NEXT           \ jp NEXT

\ Set the FAST mode
CODE FAST  ( -- )
  CD C, F23 ,    \ call $f23  ;FAST
  NEXT           \ jp NEXT

\ Set print position to row n1 and column n2
: AT  ( n1 n2 -- )
   SWAP 33 * + 16530 ( dfile)
   + 17339 ( cur_pos) ! ;

\ Set the screen coordinate to line 0 column 0.
: HOME  ( -- )
   16530 17339 !
;

\ End of parameter stack
: S0  ( -- a-addr )
   17323 @
;

\ Number of items on stack
: DEPTH  ( -- +n )
   SP@ S0 SWAP - 2/ 
;

\ Print stack contents
: .S  ( -- )
   SP@ S0 -
   IF  SP@ S0 2- 
       DO I @ U. -2 +LOOP
   THEN
;

\ Drive the ZON-X81 sound device.
CODE SND ( n1 n2 -- )            ( Write n1 to AY register n2 )
  79 C,          \ ld a,c
  D3 C, DF C,    \ out ($df),a
  E1 C,          \ pop hl
  7D C,          \ ld a,l
  D3 C, 0F C,    \ out ($0f),a
  C1 C,          \ pop bc
  NEXT           \ jp NEXT

\ Turns off all sound on all channels, A,B and C
: SNDOFF  ( -- )
   255 7 SND ;

\ "Simulate" the BEEP command of Jupiter ACE
: BEEP ( c n -- )
   SWAP 0 SND
     0 1 SND
   254 7 SND
    15 8 SND
   0 DO LOOP SNDOFF ;

\ ACE PLOT routine
\ Plots pixel (x, y) with plot mode n.
\ n = 0       unplot
\     1       plot
\     2       move
\     3       change

\ 7688 12296 56 CMOVE  \ moves graphics chars from ROM to UDG memory

CODE PLOT  ( x y n -- )
  C5 C,              \ push bc
  D9 C,              \ exx
  C1 C,              \ pop bc         ; n
  D1 C,              \ pop de         ; y
  FD C, 73 C, 36 C,  \ ld (iy+$36),e  ; YCOORD
  3E C, 2F C,        \ ld a,$2F       ; 47-y
  93 C,              \ sub e          ;
  1F C,              \ rra            ; (47-y)/2
  CB C, 11 C,        \ rl c           ; n*2+cy
  D1 C,              \ pop de         ; x
  FD C, 73 C, 37 C,  \ ld (iy+$37),e  ; XCOORD
  CB C, 3B C,        \ srl e          ; x/2
  CB C, 11 C,        \ rl c           ; (n*2)*2
  47 C,              \ ld b,a
  7B C,              \ ld a,e
  04 C,              \ inc b          ; range 1 to 24
  21 C, 4071 ,       \ ld hl,$4071    ; Dfile-33
  11 C, 21 ,         \ ld de,$21      ; (y/2)*33
  19 C,              \ add hl,de      ; 
  10 C, FD C,        \ djnz -3        ; 
  5F C,              \ ld e,a         ; (y/2)*33+x/2
  19 C,              \ add hl,de      ; 
  7E C,              \ ld a,(hl)
  07 C,              \ rlca
  FE C, 10 C,        \ cp $10
  7E C,              \ ld a,(hl)
  38 C, 01 C,        \ jr c,+1
  AF C,              \ xor a
  5F C,              \ ld e,a
  16 C, 87 C,        \ ld d,$87
  79 C,              \ ld a,c
  2F C,              \ cpl
  E6 C, 03 C,        \ and $03
  47 C,              \ ld b,a
  28 C, 07 C,        \ jr z,+7
  2F C,              \ cpl
  C6 C, 02 C,        \ add a,$02
  CE C, 03 C,        \ adc a,$03
  57 C,              \ ld d,a
  43 C,              \ ld b,e
  79 C,              \ ld a,c
  0F C,              \ rrca
  0F C,              \ rrca
  0F C,              \ rrca
  9F C,              \ sbc a,a
  CB C, 59 C,        \ bit 3,c
  20 C, 04 C,        \ jr nz,+4
  AB C,              \ xor e
  07 C,              \ rlca
  9F C,              \ sbc a,a
  A8 C,              \ xor b
  A2 C,              \ and d
  AB C,              \ xor e
  77 C,              \ ld (hl),a
  D9 C,              \ exx
  C1 C,              \ pop bc
  NEXT               \ jp NEXT

[mrtinb]

Beim Lesen über die Retro-Computer las ich über die Programmiersprache Forth. Als Softwareentwickler bin ich neugierig auf neue Sprachen, also kaufte ich die Bücher Starting Forth und Thinking Forth. Das sind großartige Bücher. Thinking Forth ist auch für Nicht-Forth-Programmierer eine gute Lektüre, da es um Software-Design geht. Also, wenn Sie Forth lernen wollen, empfehle ich diese beiden Bücher.

[Paul]

Danke Martin,
Bald ist Weihnachten, die Bücher kommen auf meine Wunschliste.

[funkheld]

Im Internet gibt es auch viele Artikel in deutsch.

Zieh dir die mal rein um das Konstrukt der Sprache kennen zulernen, ob diese Programmierweise zu dir passt.

Gruss

[ZX-Heinz]

Beim Lesen über die Retro-Computer las ich über die Programmiersprache Forth. Als Softwareentwickler bin ich neugierig auf neue Sprachen, also kaufte ich die Bücher Starting Forth und Thinking Forth.

Hello Martin,
do you frequently use the language, and if yes, on which platforms? ZX81? ZXmore? ZX-NU? It seem so that FORTH is more popular in NL than in D.
Heinz

[mrtinb]

Hello Martin,
do you frequently use the language, and if yes, on which platforms? ZX81? ZXmore? ZX-NU? It seem so that FORTH is more popular in NL than in D.

Ich halte drängen andere Hardware und ML-Projekte in vor den Forth-Projekte, so meine Erfahrung ist noch sehr begrenzt.

[funkheld]

Das stimmt.
In Deutschland wird das Forth nicht viel genutzt und meistens müde belächelt.
Im C64-Forum gibt es in den lezten 5 Jahren nur wenige Artikel.
Im ATari8Bit-Forum wurde es mehrmals von mir erwähnt , aber es wurde nichts programmiert, alle staunten nur mit ihren großen Kulleraugen..Was?...Forth..
Für den Schneider CPC6128 gibt es kein Forth mehr...

Durch dieses Desinteresse und sehr....sehr kleinen Fangemeinde zum Forth kommt auch keine schöne Kommunikation zustande.


Gruss

[bodo]

Ein Spiel in Basic würde hier jeder verstehen....

Ich fürchte, das gilt auch nicht. Speziell in ZX-BASIC gibt es ein paar Feinheiten, die insbesondere bei Spielen genutzt werden, die sich nicht jedem erschließen. Und der berüchtigte Spaghetti-Code tut sein Bestes, um eine Programmstruktur zu verschleiern. Ich weiß, wovon ich rede…

[funkheld]

Na ,da gebe ich dir recht, wer Schludert beim Programmieren , da versteht man das Basic manchmal auch nicht.
Aber ich gehe von einem vernünftigen Programmieren (Programmierer mit Sachverstand vom Programmieren) aus.

Gruss

[PokeMon]

Ich glaube Bodo spricht von sich selbst und ich würde ihm durchaus Sachverstand attestieren.
Allerdings sind seine Programme häufig sehr ambitioniert und ausgeklügelt und mit minimalstem Overhead erstellt.
Generell sind Programme ohne Kommentare sowieso schwer zu verstehen.

Das einzige was es bei BASIC rausreißt, sind klingende Variablennamen.
Ansonsten haben Zeilennummern eben nicht die Bedeutung von gut benannten (und selbsterklärenden) Labels.
Weiterhin erschwerend ist die schwierige LIST Funktion beim ZX81 wo man nur immer nur einen kleinen Ausschnitt des Programms sieht (22 Zeilen) und die fehlende Scroll Funktion. Zumindest im LIST Kontext. Das ist halt kein Texteditor, wo man vor- und zurückblättern kann.

Gott was muss das in den 80ern aufwändig gewesen sein, Programme zu erstellen und dann noch immer mit LOAD und SAVE zu speichern und wieder zu lesen ... Und hier meine ich jetzt 16k handgeschriebenen BASIC Code. Auf der Folientastatur und mit der Reaktionsgeschwindigkeit des Zeddy.

[funkheld]

Mist ist es auch, wenn die Basicprogger mehrere Befehle hintereinander bringen durch ein Doppelpunkt getrennt in eine Zeile.
Ist auch Scheiße...

Hmmm...mit welchen Namen sicherst du die denn ????

.. noch immer mit LOAD und SAVE zu speichern

16kb ist doch nicht viel mit Basic, die bekommt man noch übersichtlich zusammen. Der C64 hat über 30kb zum proggen mit Basic.
Und der PLUS4 hat über 60kb in Basic frei.

Oder hast du Schwierigkeiten damit ?

Gruss

[PokeMon]

Naja das sind immerhin rund 1000 Codezeilen wenn man das ausnutzt.
Wenn ich mir beim ZX81 LIST davon immer rund 20 Zeilen ansehen kann, sind das 50 Bildschirmseiten.
Also mit "im Kopf haben" geht da bei mir nicht mehr viel ...

Ich glaube Du arbeitest zu viel mit Emulatoren und Crossdevelopment und hast den rechten Draht zur echten Hardware noch nicht gefunden. Tipp mal die 1000 Zeilen auf einem echten ZX81 ein mit dem reaktionsträgen Keyboard. Und debugge mal ein fremdes BASIC Programm mit 16kB Code.

Am PC ist immer alles einfach aber da brauche ich ehrlich gesagt kein ZX81. Da kann ich gleich in C Anwendungsprogramme programmieren.

[funkheld]

Draht zur echten Hardware noch nicht gefunden

Den habe ich seit 1978 gefunden, habe genug damit programmiert und gebastelt.

Habe mehrere Computer gehabt und getestet 1978 bis 2005 dann bin ich auf Robotertechnik umgestiegen:
- VC20
- C64
- ATRARI800XL ausgebaut bis 512KB
- CPC6128
- CPC464
- SIRIUS
- APPLEII
- mehrere erste Comodore PC ( ohne Festplatte nur mit Disk)
- mehrere KC82-KC85

Bloss den ZX81 habe ich nicht gehabt.

Heute werden die 8-Bitter alle Verbaut und verlötet.... hat nichts mehr mit Nostalgie zu tun.

Hat mir Spass gemacht.
ich kann dir viel erzählen....
Mein gutes Gehalt im öffentlichen Dienst hat mir das Glück beschwert mir die vielen Geräte kaufen zu können
im laufe der Jahre um sie zu Testen. Ließen sich auch wieder gut verkaufen nach dem jahre 2000. Ich wollte die nicht mehr lagern.
Irgendwann machen dich die Dinger abhängig und süchtig, das wollte ich vermeiden und mir mit fast 70 Jahre nicht antun.
Ich kenne einige Leute(Freunde) die schon über 70 sind, die sehen nur noch Bits/Bytes mit den alten Geräten und bekommen das Tagesgeschehen nicht mehr mit.

Ich kann ein Buch darüber schreiben, aber das Tageslicht erblicken und die Natur mit Sport ziehe ich jetzt vor.

Gruss

[msch]

Heute werden die 8-Bitter alle Verbaut und verlötet.... hat nichts mehr mit Nostalgie zu tun.

Das musst Du erläutern, zumal ich das ganz anders sehe. Es gibt nicht wenige, die ihre Schätze möglichst im Originalzustand erhalten möchten, natürlich oft angereichert durch moderne Hardware-Erweiterungen.

[funkheld]

Das finde ich gut das einige noch die Dinger im originalen Zustand erhalten.
So muss das sein.

Ich hatte meine Geräte auch im originalen Zustand erhalten

Gruss

[bodo]

Die Sache mit "undurchschaubarem" BASIC liegt daran, dass BASIC (nicht nur, aber auch in seiner ZX-Inkarnation) eben keine gute strukturierte Programmierung erlaubt. Ein Quelltext wird für mich gut lesbar und verständlich, wenn

• Hierarchische Strukturen möglich sind ("Teile und herrsche"), mit lokalen Namensräumen,
• Strukturen durch Einrückungen (freiwillig oder gezwungenermaßen) sichtbar werden,
• Datenstrukturen mit Namen definiert und als Datentyp eingesetzt werden können,
• Unterprogramme (Funktionen, Methoden, was auch immer) und ihre Parameter mit Namen definiert und aufgerufen werden können,
• Objekte (Unterprogramme, Variablen, …) sprechende Namen haben,
• Quelltexte in handhabbaren Modulen gespeichert werden können.

Dies ist keine erschöpfende Liste, sondern nur, was mir gerade durch den Kopf geht. Es muss nicht gleich objektorientiert sein, oder funktional, oder was sonst gerade gehypt wird. FORTH und seine Derivate empfinde ich schon deshalb lesbarer als BASIC, eben weil es Namen benutzt. Die Denkweise mit dem Stack muss man nur genauso lernen wie den ALGOL-basierten Imperativ.

Triviale Programme sind von der Kritik der Unlesbarkeit selbstverständlich ausgenommen. Und dafür war BASIC gedacht, eben eine abstrakte Anfängersprache. Hut ab vor denen, die darin große Werke erstellt haben!

Die Verständlichkeit eines Quelltexts eines Programms zeigt sich dort, wo er auch ohne zusätzliche Gedanken deutlich macht, wie der implementierte Algorithmus funktioniert. Im Optimum braucht ein solcher Quelltext keinen einzigen Kommentar, aber auch moderne Sprachen realisieren nur eine bestimmte Abstraktionsstufe. Henning und ich haben das gerade durchexerziert und werden wohl bald einen Artikel im Team-Magazin-Forum veröffentlichen. Wenn du dort den Sage-Quelltext mit dem zugehörigen ZX-BASIC-Quelltext vergleichst, wirst du sicher verstehen, was ich meine. Und dann kannst du Henning vielleicht noch ein paar Tipps geben, wie er sein HRG-Programm verbessern kann.

[tofro]

Wem das originale Spectrum-Basic nicht gefällt, weil es ihm zu unstrukturiert ist, dem empfehle ich

BETA Basic

für den Spectrum - War für mich, als es Ende der Achtziger nach Deutschland kam, eine Offenbarung. Kennt Prozeduren, Funktionen, lokale Variablen, 64-Zeichen-Darstellung, alles was das Herz begehrt.

Tobias

[Joachim]

Für den ZX81 gibt es CBI von Carlo Delhez. M.E. das Beste auf diesem Gebiet. Arbeitet auch mit Prozeduren u.v.m.