Annotation of gforth/ec/shex.fs, revision 1.5

1.1       pazsan      1: \ shex.fs Output Routines for Motorola S-Records               16jul97jaw
                      2: 
1.5     ! anton       3: \ Copyright (C) 1998,2000,2003 Free Software Foundation, Inc.
1.2       anton       4: 
                      5: \ This file is part of Gforth.
                      6: 
                      7: \ Gforth is free software; you can redistribute it and/or
                      8: \ modify it under the terms of the GNU General Public License
                      9: \ as published by the Free Software Foundation; either version 2
                     10: \ of the License, or (at your option) any later version.
                     11: 
                     12: \ This program is distributed in the hope that it will be useful,
                     13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
                     14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     15: \ GNU General Public License for more details.
                     16: 
                     17: \ You should have received a copy of the GNU General Public License
                     18: \ along with this program; if not, write to the Free Software
1.3       anton      19: \ Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111, USA.
1.2       anton      20: 
1.1       pazsan     21: \ this is a extention to cross.fs to save motorola s-records
                     22: \ the first part is generic to output s-records from and to any
                     23: \ destination
                     24: \ the second part is for the cross compiler
                     25: 
                     26: unlock >CROSS
                     27: 
                     28: decimal
                     29: 
                     30: \ only method to get information
                     31: defer @byte ' c@ IS @byte
                     32: 
                     33: \ only method to output
                     34: defer htype ' type IS htype
                     35: 
                     36: : hemit pad c! pad 1 htype ;
                     37: : hcr #lf hemit ;
                     38: 
                     39: : .## ( c -- )              base @ swap hex s>d <# # # #> htype base ! ;
                     40: \ generic checksum support
                     41: 
                     42: variable csum
                     43: : csum+ ( c -- c )   dup csum +! ;
                     44: : .b  ( c -- )              csum+ .## ;
                     45: : .w  ( w -- )              dup 8 rshift .b 255 and .b ;
                     46: : .csum ( -- )      csum @ 255 xor 255 and .b ;
                     47: 
                     48: 2 constant adrlen
                     49: 1 constant csumlen
                     50: 32 constant maxline
                     51: 
                     52: : .smem ( destadr adr len type -- )
                     53:   'S hemit hemit 0 csum !
                     54:   dup adrlen + csumlen + .b
                     55:   rot .w
                     56:   bounds ?DO I @byte .b LOOP
                     57:   .csum hcr ;
                     58: 
                     59: : 3dup >r 2dup r@ -rot r> ;
                     60: 
                     61: : .sregion ( destadr adr len -- )
                     62:   BEGIN dup
                     63:   WHILE        3dup maxline min dup >r
                     64:        '1 .smem r@ /string rot r> + -rot
                     65:   REPEAT drop 2drop ;
                     66: 
                     67: : .startaddr ( adr -- )
                     68:   'S hemit '9 hemit 0 csum !
                     69:   adrlen csumlen + .b
                     70:   .w .csum hcr ;
                     71: 
                     72: \ specific for cross-compiler
                     73: 
                     74: 0 value fd
                     75: : (htype) fd write-file throw ;
                     76: ' (htype) IS htype
                     77: 
                     78: : tc@ X c@ ;
                     79: ' tc@ IS @byte
                     80: 
                     81: variable start-addr
                     82: 
                     83: : save-region-shex ( adr len -- )
                     84:   bl parse w/o create-file throw to fd
                     85: 
                     86: \ PSC1000 trick:
                     87:   'E hemit
                     88:   2dup over swap 200 min .sregion
                     89: 
                     90:   over swap .sregion 
                     91:   start-addr @ .startaddr
                     92:   fd close-file throw ;
                     93: 
                     94: >MINIMAL
                     95: 
                     96: : cpu-start start-addr ! ;
                     97: : save-region-shex save-region-shex ;
                     98: 
                     99: >CROSS
                    100: 
                    101: lock

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>