umouse

umouse.git
git clone git://git.lenczewski.org/umouse.git
Log | Files | Refs | Submodules | README

include.fth (5676B)


      1 \ include.fth - INCLUDE using AIDE as the file server.
      2 
      3 ((
      4 Copyright (c) 1991..2004, 2005, 2013
      5 MicroProcessor Engineering
      6 133 Hill Lane
      7 Southampton SO15 5AF
      8 England
      9 
     10 tel: +44 (0)23 8063 1441
     11 fax: +44 (0)23 8033 9691
     12 net: mpe@mpeforth.com
     13      tech-support@mpeforth.com
     14 web: www.mpeforth.com
     15 
     16 From North America, our telephone and fax numbers are:
     17   011 44 23 8063 1441
     18   011 44 23 8033 9691
     19 
     20 To do
     21 =====
     22 Permit file nesting.
     23 
     24 Change history
     25 ==============
     26 20131219 MPE007 Updated for Lite compiler.
     27 20051105 MPE006 Force interpretation on error.
     28 20040505 MPE005 Modified for AIDE 2.500 onwards.
     29 20021004 SFP004 Refactored to use CATCH/THROW
     30 20020917 SFP003 Refactored to reduce size
     31 20000530 SFP002 Converted to v6.1 targets
     32 19990509 SFP001 Rewritten for AIDE/PowerTerm.
     33                 Removed support for USE
     34 First Release: 29/04/91
     35 ))
     36 
     37 \ ===========
     38 \ *! includeaide
     39 \ *T Compile source code from AIDE
     40 \ ===========
     41 \ *P The file *\i{include.fth} provides support for
     42 \ ** compiling a source file from the AIDE server.
     43 
     44 decimal
     45 
     46 $01 equ START
     47 $06 equ ACK
     48 $15 equ NAK
     49 
     50 $12 equ ^R                                         \ read command code
     51 $17 equ ^W                                         \ write
     52 $15 equ ^U                                         \ $using
     53 $01 equ ^A                                         \ use
     54 $06 equ ^F                                         \ $from
     55 $05 equ ^E                                         \ error
     56 
     57 Synonym Ser-Key  key
     58 Synonym Ser-Key? key?
     59 Synonym Ser-Emit emit
     60 
     61 variable disk-error
     62 
     63 : end-load      \ -- ; switch back to keyboard input
     64 \ *G This word is automatically performed at the end of a download
     65 \ ** to tidy up the comms.
     66   xon/xoff off                  	\ turn off handshaking
     67   echoing on                    	\ turn echoing back on
     68 ;
     69 
     70 internal
     71 
     72 : WAIT-ACK  (  -- ; wait for ACK character at the end of part of a transfer  )
     73   begin
     74     ser-key                                             \ read a char from serial line
     75     ack =                                               \ until it is an ACK
     76   until
     77 ;
     78 
     79 : WAIT-ACK/NACK  (  --  flag ; wait for NACk or ACK, return true for NACK  )
     80   0
     81   begin
     82     drop                                                \ drop old flag
     83     ser-key dup nak = tuck                              \ -- t/f char t/f
     84     swap ack =  or                                      \ -- t/f t/f'
     85   until
     86 ;
     87 
     88 : SEND-BLOCK#  (  n  -- ; send block number to server as two bytes  )
     89   0 #256 um/mod swap                                    \ split into high & low bytes
     90   ser-emit ser-emit                                     \ send block no., low byte first
     91   wait-ack                                              \ wait for ack
     92 ;
     93 
     94 : SYNCH-TO-HOST  (  -- ; sync host to us  )
     95   begin                                                 \ sync.
     96     ser-key                                             \ get a char
     97     start =                                             \ receive bytes until start code
     98   until
     99   begin
    100     ser-key?                                            \ while there are keys still
    101   while
    102     ser-key                                             \ read them
    103     drop                                                \ and drop them
    104   repeat
    105   ack ser-emit                                          \ acknowledge as end of synch.
    106 ;
    107 
    108 : SEND$  (  $addr ^char -- ; send a counted string and trigger to host )
    109   ser-emit                                              \ send code
    110   synch-to-host                                         \ synchronise
    111   dup 1+ swap                                           \ addr+1 as base for reading
    112   c@ dup send-block#                                    \ send length of string
    113   0                                                     \ length - 0
    114   do
    115     dup i + c@                                          \ get char at i+$addr
    116     ser-emit                                            \ send char
    117   loop
    118   drop                                                  \ drop spare address
    119   ack ser-emit                                          \ send ack to complete transfer
    120   wait-ack/nack disk-error !                            \ get status response
    121 ;
    122 
    123 : file-error    \ n --
    124 \ *G Handle an error when a file is being *\fo{INCLUDE}d.
    125   ^e ser-emit                           \ trigger host error
    126   CR ." Error # " .  SPACE here $. CR   \ show error
    127   end-load                              \ clean up
    128 ;
    129 
    130 : $include	\ $addr -- ; compile host file, counted string
    131 \ *G Given a counted string representing a file name, compile
    132 \ ** the file from AIDE.
    133   ^f send$                      	\ send file name
    134   -1 send-block#                   	\ send last-p# - legacy
    135   1 send-block#                   	\ send first-p# - legacy
    136   synch-to-host                 	\ synchronise
    137   echoing off                   	\ not echoing
    138   xon/xoff on                   	\ initiate handshaking
    139 [ blocks? ] [if]
    140   blk off
    141 [then]
    142   0 <source> !  [compile] [		\ set up
    143   begin
    144     query				\   get user input
    145     ['] interpret catch ?dup if		\   interpret line
    146       file-error			\    display error
    147       s0 @ sp!				\    clean data stack
    148       [compile] [			\    force interpretation ; MPE006
    149     then
    150     echoing @
    151   until                                 \   do next line
    152 ;
    153 
    154 external
    155 
    156 : include       \ "<filename>" -- ; load file from host
    157 \ *G Compile a file across the serial line from the AIDE file server.
    158 \ ** Use in the form:
    159 \ *C   include <filename>
    160 \ *P The filename extension must be supplied.
    161   bl word                               \ get file name
    162   dup count upper                       \ convert to upper case
    163   $include				\ compile from file
    164 ;
    165 
    166 
    167 \ ======
    168 \ *> ###
    169 \ ======
    170 
    171 decimal
    172