Return to shex.fs CVS log

Up to [gforth] / gforth / ec

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

1.1       pazsan      1: \ shex.fs Output Routines for Motorola S-Records               16jul97jaw
                      2: 
1.10    ! anton       3: \ Copyright (C) 1998,2000,2003,2006,2007 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
1.9       anton       9: \ as published by the Free Software Foundation, either version 3
1.2       anton      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
1.9       anton      18: \ along with this program. If not, see http://www.gnu.org/licenses/.
1.2       anton      19: 
1.1       pazsan     20: \ this is a extention to cross.fs to save motorola s-records
                     21: \ the first part is generic to output s-records from and to any
                     22: \ destination
                     23: \ the second part is for the cross compiler
                     24: 
                     25: unlock >CROSS
                     26: 
                     27: decimal
                     28: 
                     29: \ only method to get information
                     30: defer @byte ' c@ IS @byte
                     31: 
                     32: \ only method to output
                     33: defer htype ' type IS htype
                     34: 
                     35: : hemit pad c! pad 1 htype ;
                     36: : hcr #lf hemit ;
                     37: 
                     38: : .## ( c -- )              base @ swap hex s>d <# # # #> htype base ! ;
                     39: \ generic checksum support
                     40: 
                     41: variable csum
                     42: : csum+ ( c -- c )   dup csum +! ;
                     43: : .b  ( c -- )              csum+ .## ;
                     44: : .w  ( w -- )              dup 8 rshift .b 255 and .b ;
                     45: : .csum ( -- )      csum @ 255 xor 255 and .b ;
                     46: 
                     47: 2 constant adrlen
                     48: 1 constant csumlen
                     49: 32 constant maxline
                     50: 
                     51: : .smem ( destadr adr len type -- )
                     52:   'S hemit hemit 0 csum !
                     53:   dup adrlen + csumlen + .b
                     54:   rot .w
                     55:   bounds ?DO I @byte .b LOOP
                     56:   .csum hcr ;
                     57: 
                     58: : 3dup >r 2dup r@ -rot r> ;
                     59: 
                     60: : .sregion ( destadr adr len -- )
                     61:   BEGIN dup
                     62:   WHILE        3dup maxline min dup >r
                     63:        '1 .smem r@ /string rot r> + -rot
                     64:   REPEAT drop 2drop ;
                     65: 
                     66: : .startaddr ( adr -- )
                     67:   'S hemit '9 hemit 0 csum !
                     68:   adrlen csumlen + .b
                     69:   .w .csum hcr ;
                     70: 
                     71: \ specific for cross-compiler
                     72: 
                     73: 0 value fd
                     74: : (htype) fd write-file throw ;
                     75: ' (htype) IS htype
                     76: 
                     77: : tc@ X c@ ;
                     78: ' tc@ IS @byte
                     79: 
                     80: variable start-addr
                     81: 
                     82: : save-region-shex ( adr len -- )
1.7       pazsan     83:     bl parse w/o create-file throw to fd
1.1       pazsan     84: \ PSC1000 trick:
1.6       pazsan     85: \  'E hemit
                     86: \  2dup over swap 200 min .sregion
1.7       pazsan     87:     0 0 0 '0 .smem
                     88:     over swap .sregion 
                     89:     start-addr @ .startaddr
                     90:     fd close-file throw ;
1.1       pazsan     91: 
                     92: >MINIMAL
                     93: 
                     94: : cpu-start start-addr ! ;
                     95: : save-region-shex save-region-shex ;
                     96: 
                     97: >CROSS
                     98: 
                     99: lock