*************************************************************************************************************************************                                                      **********                                                      **********             MICHAEL STOLOWITZ                        **********                                                      **********                 CONSULTANT                           **********                                                      **********                  335 Merrilee Place                  **********                                                      **********                     Danville, CA  94526              **********                                                      **********                        (415) 837-3887                **********                                                      *************************************************************************************************************************************\ DNLD - Load Screen                                  30Jan84mcs                                                                : .VERSION ( -- ) ." 01Feb84" ;                                                                                                    1 7 +THRU                                                                                                                       256 HERE   CP/M   SAVE DNLD.COM   FORTH                                                                                         CR   .( File save as DNLD.COM)   CR                                                                                          EXIT                                                                                                                                                                                                                                                                                                                                                                                            \ DNLD - (ABORT") ABORT"                              31Jan84mcs                                                                : (ABORT") ( f -- )                                                IF  CR  R> COUNT TYPE  CR   0 GO                                ELSE  R>  COUNT  +  >R  THEN ;                                                                                               : ABORT" ( -- ) ( text" )                                          COMPILE (ABORT")   ," ; IMMEDIATE                                                                                            EXIT                                                                                                                                                                                                                                                                                                                                                                                                                                                            \ DNLD - PROG-EMIT PON POFF                           31Jan84mcs                                                                : PROG-EMIT ( c -- )                                               BEGIN   KEY?  IF   KEY 27 =  ABORT" Aborted"  THEN                 0 15 BIOS   UNTIL   5 BIOS DROP ;                                                                                         : POFF ( -- )                                                      ['] (EMIT)    IS EMIT ;                                                                                                      : PON  ( -- )                                                      ['] PROG-EMIT IS EMIT ;                                                                                                                                                                                                                                                                                                                                                                      \ DNLD - FCB BUFFER OPEN-FILE                         31Jan84mcs                                                                  92 CONSTANT FCB               \ Default CP/M FCB               128 CONSTANT BUFFER            \ Default CP/M buffer                                                                           : OPEN-FILE ( -- )                                                 FCB FILE !                                                      FILE @   1+ C@   BL = ABORT" No File Name"                      ." File Name = " FILE?   CR                                     [ CP/M ] OPEN   CPM-ERR? ABORT" File Open Error" [ FORTH ] ;                                                                 EXIT                                                                                                                                                                                                                                                                                                                            \ DNLD - CHECK SEND-LINE SEND-BUFFER                  31Jan84mcs                                                                VARIABLE CHECK                                                                                                                  : SEND-LINE ( addr -- )                                            CR   16 BOUNDS  DO  I C@   DUP CHECK +!   ##.  LOOP ;                                                                        : SEND-BUFFER ( n -- n + b/buf )                                   CR CR   ." $A"   DUP 0 .R   ASCII , EMIT   CR                   BUFFER 128 BOUNDS DO   I SEND-LINE   16 +LOOP   128 +           POFF  ASCII * EMIT  PON ;                                                                                                    EXIT                                                                                                                                                                                                                                                            \ DNLD - SUM-CHECK LEADER SEND-FILE                   31Jan84mcs                                                                : SUM-CHECK ( -- )                                                 CR CR   ." $S"  CHECK @   0 U.R   CONTROL C EMIT ;                                                                           : LEADER ( -- )                                                    50 0  DO  0 EMIT  LOOP   CONTROL B EMIT ;                                                                                    : SEND-FILE ( -- n )                                               CR   0 CHECK !   PON   LEADER                                   0   BEGIN  [ CP/M ]   BUFFER SET-DMA   READ 0= WHILE               SEND-BUFFER   [ FORTH ]  REPEAT                              SUM-CHECK   POFF ;                                                                                                                                                                                                                                           \ DNDL - .HEADING .SIGNOFF                            31Jan84mcs                                                                : .HEADING ( -- )                                                  CR CR                                                           CR   ." DOWN LOAD CP/M FILE TO PROGRAMMER"                      CR   ." JEDEC format via CP/M LIST device"                      CR   ." Copyright Michael Stolowitz " .VERSION                  CR CR ;                                                                                                                      : .SIGNOFF ( n -- )                                                CR CR   4 U.R   ."  = Bytes Transferred"                        CR CR   CHECK @  4 U.R   ."  = Check Sum"                       CR CR ;                                                                                                                                                                                                                                                      \ DNLD - DNLD                                         31Jan84mcs                                                                : DNLD ( -- )                                                      HEX   .HEADING   OPEN-FILE   SEND-FILE   .SIGNOFF   0 GO ;                                                                   ' DNLD IS BOOT                                                                                                                  CR   .( DNLD words loaded)   CR                                                                                                 EXIT