\ heizung.lst Datei in Assembler-Quelle zurueckfuehren. 

: .. bye ; 
: mk ; \ comment 


\ misc
: .mark   ( -- ) ." ; +++ " ;
: .header ( adr u -- ) cr cr .mark type ."  re-listing" cr ; 
: .footer ( -- ) cr .mark ." end of re-listing" ; 

\ allocate a buffer for character handling
256 Constant maxline 
Create linebuffer maxline 2 + allot 

\ file handling 
0 Value fid-in 
: open-input ( addr u -- ) r/o open-file throw to fid-in ; mk
: close-input ( -- ) fid-in close-file throw ; 
: getline ( -- adr u f )  
    linebuffer maxline fid-in read-line throw ( -- u f )
    linebuffer -rot ; 


\ check content of lines. 
: parse-bl { adr1 u1 -- adr2 u2 } \ Erstes nicht-bl-Zeichen. 
  u1 0 do 
        adr1 c@  bl <> if leave then 
        adr1 1+ to adr1 u1 1- to u1 
    loop adr1 u1 ; 
: ;line? ( adr u -- f ) \ Ist es eine Kommentarzeile? 
  parse-bl drop c@  [char] ; =  ; 

: .db? ( adr u -- f )  s"   .db" search ( -- adr u f )  >r 2drop r> ; 
: .dw? ( adr u -- f )  s"   .dw" search ( -- adr u f )  >r 2drop r> ; 

: macro? ( adr u -- f )  drop  11 + c@ [char] + = ; 
: macro  ( adr1 u1 -- adr2 u2 )  13 - swap 13 + swap ." ; macro: " ;

: C:00? ( adr u -- f ) s" C:00" search >r 2drop r> ;
: stripC:00 ( adr1 u1 -- adr2 u2 )   13 - swap 13 + swap ; 

: .inc? ( adr u -- f ) s" .include" search >r 2drop r> ; 
: .if?  ( adr u -- f ) s" .if" search >r 2drop r> ; 
: .else? ( adr u -- f ) s" .else" search >r 2drop r> ; 
: .endif? ( adr u -- f ) s" .endif" search >r 2drop r> ; 

: -type  ( adr u ) dup 5 > if 5 - swap 5 + swap then type ; 
: skipline ( -- )  getline 2drop drop ; 

variable segflag  \ Ab dem EEPROM-Segment nichts mehr skippen. 
: seg?  ( -- ) segflag @ ; 
: .eseg? ( adr u -- f )  s"    .eseg" search >r 2drop r> ; 

\ delist file 
: checktype ( adr u -- ) 
    2dup .inc?   if 2drop           exit then 
    2dup .if?    if 2drop           exit then 
    2dup .else?  if 2drop           exit then 
    2dup .endif? if 2drop           exit then 
    2dup macro?  if macro type     exit then 
    2dup C:00?   if stripC:00 -type exit then 
    2dup ;line?  if -type           exit then 
    2dup .db?    if -type  seg? if skipline then   exit then 
    2dup .dw?    if -type  seg? if skipline then   exit then 
    2dup .eseg?  if -type  false segflag !  exit then 
    -type ; 

: delist ( adr u -- ) 
  2dup open-input .header  true segflag ! 
    begin getline while ( -- adr u ) 
        checktype  
    cr repeat 
  2drop close-input .footer ;

: go  s" heizung.lst" delist bye ; 

( finis)