z80dasm2tidySamForth
Description of the page content
Tool for postprocessing the SamForth disassembly.
This Vim program post-process the SamForth disassembly. The details and the usage are in the code.
Source code
" z80dasm2tidysamforth.vim
"
" z80dasm2tidySamForth
" Version A-00-201301222330
"
" This file is part of the
" "SamForth disassembled" project
" (<http://programandala.net/en.program.samforth>).
"
" This program tidies the SamForth Z80 code disassembled by z80dasm.
"
" Copyright (C) 2013 Marcos Cruz (programandala.net)
"
" z80dasm2tidySamForth is free software; you can redistribute
" it and/or modify it under the terms of the GNU General
" Public License as published by the Free Software
" Foundation; either version 2 of the License, or (at your
" option) any later version.
"
" z80dasm2tidySamForth is distributed in the hope that it will be useful,
" but WITHOUT ANY WARRANTY; without even the implied
" warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
" PURPOSE. See the GNU General Public License for more
" details.
"
" You should have received a copy of the GNU General Public
" License along with this program; if not, see
" <http://gnu.org/licenses>.
"
" z80dasm2tidySamForth is written in the programming language
" of the Vim editor (<http://vim.org>).
"
" ==============================================================
" Development history
" See at the end of this file.
" ==============================================================
" Usage
"
" This program can be used from Vim or from the command line.
"
" From Vim:
" :edit samforth-a.raw.z80s
" :source z80dasm2tidysamforth.vim
" :w! samforth-a.z80s
" :edit samforth-b.raw.z80s
" :source z80dasm2tidysamforth.vim
" :w! samforth-b.z80s
"
" From the command line:
" vim -S "z80dasm2tidysamforth" -c "wq! samforth-a.z80s" samforth-a.raw.z80s
" vim -S "z80dasm2tidysamforth" -c "wq! samforth-b.z80s" samforth-b.raw.z80s
" ==============================================================
" Todo:
"
" tib_end --> pad_start , etc.
" tib_end --> tib_start ?
" stack_end --> stack_top ?
" stack_start --> stack_bottom ?
"
" Put ROM routines comment above the symbol.
" Mark the missing byte at SamForth-A's 0x0860 and SamForth-B's 0x477b.
" Convert nops to defs.
" Before every RST, convert nops to org.
"
" SamForth-A 'l103dh:'
"
" ==============================================================
" Config
" There are two notations compatible with pyz80 and Pasmo:
" '0x' prefix and '&' prefix.
let s:hexPrefix='0x'
" ==============================================================
" Constants
let s:errorMessages=11 " Number of SamForth error messages
" ==============================================================
" SamForth variant
let s:SamForthVariant = search('samforth-b','wc') ? 'B' : 'A'
echo 'Tiding SamForth-'.s:SamForthVariant
" ==============================================================
" Debug
function! Z80Halt()
redraw
call input('Press Enter to continue')
endfunction
" ==============================================================
" Convert Forth data zones to 'defs' notation
function! Z80ZoneToDefs(prefix,bytesPerLine)
let l:startLine=search('^'.a:prefix.'_start:$','wc')
let l:endLine=search('^'.a:prefix.'_end:$','wc')
if l:startLine && l:endLine
call cursor(l:startLine+1,1)
normal ms
call cursor(l:endLine-1,1)
normal me
's,'ed
let l:length=(l:endLine-l:startLine-1)*a:bytesPerLine
normal O
call setline('.',"\tdefs ".length)
endif
endfunction
function! Z80DefbToDefs(prefix)
call Z80ZoneToDefs(a:prefix,1)
endfunction
function! Z80NopToDefs(prefix)
call Z80ZoneToDefs(a:prefix,1)
endfunction
function! Z80DefwToDefs(prefix)
call Z80ZoneToDefs(a:prefix,2)
endfunction
function! Z80ZonesToDefs()
call Z80NopToDefs('xxx_unknown_zone_00b')
call Z80NopToDefs('xxx_unknown_zone_01b')
call Z80DefbToDefs('tib')
call Z80DefbToDefs('pad')
call Z80DefwToDefs('data_stack')
call Z80DefwToDefs('return_stack')
endfunction
function! Z80BranchsToSymbols()
if s:SamForthVariant=="A"
silent! %s@defw 0x\(1d3b\)@defw branch_\1@e
silent! %s@defw 0x\(1d4b\)@defw branch_\1@e
silent! %s@defw 0x\(1da3\)@defw branch_\1@e
silent! %s@defw 0x\(1db2\)@defw branch_\1@e
else
silent! %s@defw 0x\(5e39\)@defw branch_\1@e
silent! %s@defw 0x\(5e4b\)@defw branch_\1@e
silent! %s@defw 0x\(5ea9\)@defw branch_\1@e
silent! %s@defw 0x\(5eb8\)@defw branch_\1@e
endif
endfunction
" ==============================================================
" Convert Forth word names to 'defm' notation
function! Z80NamesToDefm()
" Go to the top of the file:
normal gg
while search('^\S\+_name:$','Wc') " Search for a start of a name
" Set the 's' mark:
normal ms
" Keep only the last but one char of every comment (the
" actual char):
silent! :+1,/name_field_end:/-1substitute@^.\+\(.\).@{\1}@e
" Join all chars:
silent! :'s+1,.substitute@}\n{@@e
silent! :substitute@{\(.\+\)}@\1@e
" Add the 'defm':
silent! :substitute@\S\+@\tdefm "&"@e
" Delete the previous line:
" silent! :-1substitute@^.*\n@@e
" Delete the next line:
silent! :+1substitute@^.*\n@@e
endwhile
" Exception. Change the notation of '."':
silent :%substitute@defm ".""$@defb 0x2e,0x22 ; '."' string -- notation compatible with Pasmo and pyz80@e
endfunction
" ==============================================================
" Convert error messages to 'defm' notation
function! Z80ErrorsToDefm()
let l:startLine=search('^errors_start:$','w')
let l:endLine=search('^errors_end:$','w')
if l:startLine==0
call Z80NotFoundError('errors_start:')
elseif l:endLine==0
call Z80NotFoundError('errors_end:')
else
call cursor(l:startLine,1)
" while search('^\s\+defb 0[^8].h','W') && (line('.')<l:endLine)
let l:errorMessages=s:errorMessages
while l:errorMessages
let l:messageStart=search('^\s\+defb 0[^8].h','W')
" Set the 's' mark:
normal ms
" Keep only the last but one char of every comment (the
" actual char):
" echo line('.').' < '.l:endLine
" call input ('more')
silent! :.,/^\s*defb 08.h/-1substitute@^.\+\(.\).$@{\1}@e
" Join all chars:
" call Z80Halt()
silent! :'s,.substitute@}\n{@@e
" call Z80Halt()
silent! :substitute@{\(.\+\)}@\1@e
" Add the 'defm':
" call Z80Halt()
silent! :substitute@^.\+$@\tdefm "&"@e
" Delete the previous line:
" silent! :-1substitute@^.*\n@@e
" Delete the next line:
" silent! :+1substitute@^.*\n@@e
let l:errorMessages-=1
endwhile
endif
endfunction
" ==============================================================
" Clear the unwanted symbols and comments
function! Z80ClearUnwanted()
" Remove the block comments:
silent! :%substitute@^; BLOCK .\+\n@@e
" Remove unnecessary symbols:
silent! :%substitute@^.\+_link_field_end:\n\n@@e
silent! :%substitute@\nvariables_start:\n@@e
silent! :%substitute@variables_end:\n@@e
silent! :%substitute@^errors_end:$@@e
silent! :%substitute@^xxx_unknown_zone_[0-9]\{2}[ab]\?_end:$@@e
silent! :%substitute@\nbranch_[0-9a-f]\{4}_start:\n@@e
silent! :%substitute@^branch_[0-9a-f]\{4}_end:\n@@e
" Change the block start symbols:
silent! :%substitute@_name_field_start@_name_field@e
silent! :%substitute@_link_field_start@_link_field@e
silent! :%substitute@\<errors_start\>@error_messages@e
silent! :%substitute@^\(xxx_unknown_zone_[0-9]\{2}[ab]?\)_start:$@\1:@e
" Remove all address comments:
silent! :%substitute@\s\+;[0-9a-f]\{4}\s.\+$@@e
" Change tabs in the middle of the text to spaces:
" xxx -- not used any more
" silent! :%substitute@\(\S\)\t\+\(\S\)@\1 \2@ge
" Remove the symbols of JSVIN's arguments:
silent! :%substitute@\nJSVIN_parameter_....h_start:\n@@e
silent! :%substitute@^JSVIN_parameter_....h_end:\n@@e
" Fix symbols that z80dasm changed because there was a block end at the same
" address:
silent! :%substitute@\<\(.\+\)_name_field_end@\1_code_field@e
silent! :%substitute@\<variables_end\>@tib_start@e
silent! :%substitute@\<errors_end\>@init@e
silent! :%substitute@\<xxx_unknown_zone_00_end\>@dir@e
silent! :%substitute@\<xxx_unknown_zone_00b_end\>@flags_fvar@e
silent! :%substitute@\<xxx_unknown_zone_01b_end\>@print_a@e
" The disassambler converted some ROM addresses or simple numbers to
" SamForth address symbols. That must be fixed.
if s:SamForthVariant==?'A'
" xxx todo -- use s:hexPrefix
" Fix special cases in SamForth-A.
silent! :%substitute@\<ld bc,jp_at\>@ld bc,0x00ff@e
silent! :%substitute@\<ld hl,l0000h\>@ld hl,0x0000@e
silent! :%substitute@^l0000h:\n@@e
silent! :%substitute@\<ld hl,l0001h+1$@ld hl,0x0002@e
silent! :%substitute@\<ld hl,l0001h+2$@ld hl,0x0003@e
silent! :%substitute@\<ld \(hl\|de\),l0001h+3$@ld \1,0x0004@e
silent! :%substitute@\<ld hl,l0001h$@ld hl,0x0001@e
silent! :%substitute@^l0001h:\n@@e
silent! :%substitute@\<ld hl,l002dh\>@ld hl,0x002d@e
silent! :%substitute@^l002dh:\n@@e
silent! :%substitute@\<l2710h\>@0x2710@e
silent! :%substitute@^l2710h:\n@@e
silent! :%substitute@\<ld de,l00a8h\>@ld de,0x00a8@e
silent! :%substitute@^l00a8h:\n@@e
" Restore all 'ld iy,some-rom-address' ruined by the disassembler:
silent! :%substitute@\<ld iy,jp_dload+1\>@ld iy,0x014e@e
silent! :%substitute@\<ld iy,jp_bload+1\>@ld iy,0x0148@e
silent! :%substitute@\<ld iy,rst10\>@ld iy,0x0010@e
silent! :%substitute@\<ld iy,jp_editor_command_l+1\>@ld iy,0x0160@e
silent! :%substitute@\<ld iy,jp_editor_command_p+1\>@ld iy,0x0154@e
silent! :%substitute@\<ld iy,sub_0183h+1\>@ld iy,0x0184@e
silent! :%substitute@\<ld iy,jp_pen+1\>@ld iy,0x0112@e
silent! :%substitute@\<ld iy,jp_screen+1\>@ld iy,0x0139@e
silent! :%substitute@\<ld iy,jp_tab+1\>@ld iy,0x013f@e
silent! :%substitute@\<ld iy,jp_dsave+1\>@ld iy,0x0151@e
silent! :%substitute@\<ld iy,jp_udgdef+1\>@ld iy,0x0136@e
silent! :%substitute@\<ld iy,jp_csize+1\>@ld iy,0x0133@e
silent! :%substitute@\<ld iy,jp_inverse+1\>@ld iy,0x0145@e
silent! :%substitute@\<ld iy,jp_edit+1\>@ld iy,0x0169@e
" Beside, there's typo in this case:
silent! :%substitute@\<ld ix,jp_bsave+1\>@ld iy,0x014b ; xxx fixed -- 'ld ix' in the original@e
else
" Fix special cases in SamForth-B.
silent! :%substitute@^l4000h:\n@@e
silent! :%substitute@l4000h@0x4000@e
" The JSVIN definition will be remaked later:
silent! :%substitute@^jsvin_rom_routine:\s\+equ\s\+.\+\n@@e
endif
endfunction
" ==============================================================
" Remove all final 'nop'
function! Z80NoNops()
" Goto to the end of the file:
normal G
" Seach backwards for the first line that doesn't contain 'nop':
call search('^\(\s\+nop\>\)\@!','bWc')
" Delete everything from the next line to the end of the file:
silent! :+1,$substitute@.\+\n@@e
endfunction
" ==============================================================
" Change the format of hexadecimal numbers
function! Z80ProperHex()
" xxx todo make simpler, use the prefix in the commands
if s:hexPrefix=='0x'
" 0ddddh -> 0xdddd
silent! :%substitute@\<0\([0-9a-f]\{4}\)h@0x\1@ge
" 0ddh -> 0xdd
silent! :%substitute@\<0\([0-9a-f]\{2}\)h@0x\1@ge
" rst ddh -> rst 0xdd
silent! :%substitute@^\s\+rst \([0-9]\{2}\)h@\trst 0x\1@e
elseif s:hexPrefix=='&'
" 0x -> &
silent! :%substitute@\<0x\([0-9a-f]\+\)@\&\1@ge
" 0ddddh -> &dddd
silent! :%substitute@\<0\([0-9a-f]\{4}\)h@\&\1@ge
" 0ddh -> &dd
silent! :%substitute@\<0\([0-9a-f]\{2}\)h@\&\1@ge
" rst ddh -> rst &dd
silent! :%substitute@^\s\+rst \([0-9]\{2}\)h@\trst \&\1@e
endif
endfunction
" ==============================================================
" Change double variables from 'defb' to 'defw'
function! Z80DefbToDefw()
" First, a fix is needed in SamForth-A:
if s:SamForthVariant==?'A'
silent! :%s@\nl01ffh:@@e
" xxx old
" if s:Z80HexNotation0x
" silent! :%s@l01ffh@0x01ff@e
" else
" silent! :%s@l01ffh@&01ff@e
" endif
silent! :%s@\<l01ffh\>@\=s:hexPrefix.'01ff'@e
endif
if s:hexPrefix=='0x'
silent! :%s@^\(\S\+_fvar:\n\s\+def\)b 0x\([0-9a-f]\{2}\)\n\s\+defb \(0x[0-9a-f]\{2}\)@\1w \3\2@e
elseif s:hexPrefix='&'
silent! :%s@^\(\S\+_fvar:\n\s\+def\)b &\([0-9a-f]\{2}\)\n\s\+defb \(&[0-9a-f]\{2}\)@\1w \3\2@e
endif
endfunction
" ==============================================================
" Convert link addresses to their corresponding symbols
function! Z80LinkFields()
" Go to the bottom of the file:
normal G
while 1
" Search backwards for the link field of the previos Forth word:
call search('link_field:','Wb')
" Copy the content of the field (an hex address) into the 'l' register:
normal www"lyw
" Bottom of dictionary?
if getreg('l')==?'0xFFFF'
break
endif
" Keep the currrent line number:
let s:link_line=line('.')
" Search backwards for the name address of the previous word:
call search('name:','Wb')
" Get the name address symbol in register 'n':
normal ^"nyw
" Substitute the old address with the symbol:
call cursor(s:link_line,1)
normal wwdw"np
" Pass the link field of the current word:
call cursor(s:link_line-2,1)
endwhile
endfunction
" ==============================================================
" Errors
function! Z80NotFoundError(searchedFor)
echo 'Error: "'.a:searchedFor.'" not found in SamForth-'.s:SamForthVariant
endfunction
" ==============================================================
" Conversion of variable's literal contents
function! Z80FvarConversion(variable,symbol)
" Convert a variable's literal contents to a symbol.
if search('^'.a:variable.'_fvar:','wc')
let l:lineNumber=search(s:hexPrefix,'Wc')
let l:line=getline(l:lineNumber)
let l:line=substitute(l:line,s:hexPrefix.'[0-9a-fA-F]\+',a:symbol,'')
call setline(l:lineNumber,l:line)
endif
endfunction
function! Z80FvarConversions()
" Convert variables' literal contents to symbols.
call Z80FvarConversion('stp','data_stack_end')
call Z80FvarConversion('stack','data_stack_end')
call Z80FvarConversion('stkend','data_stack_start')
call Z80FvarConversion('clate','expand_name')
call Z80FvarConversion('chere','cold_here')
call Z80FvarConversion('latest','expand_name')
call Z80FvarConversion('here','cold_here')
call Z80FvarConversion('fence','cold_here')
call Z80FvarConversion('tib','tib_start')
call Z80FvarConversion('pad','pad_start')
call Z80FvarConversion('rstack','return_stack_end')
call Z80FvarConversion('errsp','return_stack_end')
call Z80FvarConversion('etib','tib_end')
endfunction
" ==============================================================
" Comments
function! Z80CommentAboveLine(lineNumber,comment)
" Add a comment line above the given line.
call cursor(a:lineNumber,1)
normal O
call setline(a:lineNumber,'; '.a:comment)
endfunction
function! Z80CommentBelowLine(lineNumber,comment)
" Add a comment line below the given line.
call cursor(a:lineNumber,1)
normal o
call setline(a:lineNumber+1,'; '.a:comment)
endfunction
function! Z80CommentAtLine(lineNumber,comment)
" Add a comment at the end of the given line.
let l:lineContents=getline(a:lineNumber)
call setline(a:lineNumber,l:lineContents.' ; '.a:comment)
endfunction
function! Z80ErrorComment(errorMessage,errorNumber)
" errorNumber = two hex digits without prefix
if search(a:errorMessage,'wc')
call Z80CommentAtLine('.','Error number '.s:hexPrefix.a:errorNumber)
endif
endfunction
function! Z80ErrorComments()
call Z80ErrorComment('Stack empty','01')
call Z80ErrorComment('Stack full','02')
call Z80ErrorComment('Undefined word','03')
call Z80ErrorComment('Colon definitions only','04')
call Z80ErrorComment('Division by zero','05')
call Z80ErrorComment('Return stack full','06')
call Z80ErrorComment('Inside fence','07')
call Z80ErrorComment('Break','08')
call Z80ErrorComment('Incomplete form','09')
call Z80ErrorComment('Not found','0a')
call Z80ErrorComment('Editor error','0b')
endfunction
function! Z80FvarComment(variable,comment)
" Add a comment (copied from the original documentation)
" to a SamForth variable.
let l:line=search('^'.a:variable.'_fvar:','wc')
if l:line
call Z80CommentBelowLine(l:line,a:comment)
endif
endfunction
function! Z80FvarComments()
" Add comments (copied from the original documentation)
" to all SamForth variables.
call Z80FvarComment('flags','Various flags to control the system.')
call Z80FvarComment('lastk','ASCII code of last key pressed.')
call Z80FvarComment('bord','Current border colour.')
call Z80FvarComment('frames1','Counts television picture frames into a double number. Not used by SamForth-B.')
call Z80FvarComment('frames2','Counts television picture frames into a double number. Not used by SamForth-B.')
call Z80FvarComment('ycord','Last Y position plotted or drawn.')
call Z80FvarComment('xcord','Last X position plotted or drawn.')
call Z80FvarComment('rstack','Address of return stack (Z80 stack).')
call Z80FvarComment('stp','Stack pointer to Forth stack.')
call Z80FvarComment('stack','Start of Forth stack.')
call Z80FvarComment('stkend','End of Forth stack.')
call Z80FvarComment('samerr','Holds SAM error number. Not used by SamForth-B, but used by the error trapping code of its BASIC loader.')
call Z80FvarComment('nmi','Address to jump to when NMI button pressed. Not used by SamForth-B.')
call Z80FvarComment('clate','Address of last Forth word in dictionary at cold start.')
call Z80FvarComment('chere','Next vacant address in dictionary at cold start.')
call Z80FvarComment('latest','Address of last Forth word in dictionary.')
call Z80FvarComment('here','Next vacant address in dictionary.')
call Z80FvarComment('base','Current number base.')
call Z80FvarComment('fence','Address below which FORGET will not operate. It is by hold in the variable FENCE.')
call Z80FvarComment('tib','Start address of the Terminal Input Buffer.')
call Z80FvarComment('pad','Start address of the temporary data holding area.')
call Z80FvarComment('st','Start address of source, usually 32768. The page holding the source file is paged in at C & D.')
call Z80FvarComment('tempstk','Used as temporary stack store.')
call Z80FvarComment('rampage','Page number where source file will be held. Defaults to page 7.')
call Z80FvarComment('errsp','Address at which return stack is set upon an error.')
call Z80FvarComment('corestore','Next vacant address in dictionary at cold start.')
call Z80FvarComment('state','Flag showing compile or immediate mode.')
call Z80FvarComment('length','Used to test for the length of a word being looked for in the dictionary.')
call Z80FvarComment('leng','Used to test for the length of a word being looked for in the dictionary.')
call Z80FvarComment('ip','Address of interpreter pointer within source being compiled.')
call Z80FvarComment('dubflag','Flag indicating double number.')
call Z80FvarComment('bastack','Holds stack pointer from SAM BASIC.')
call Z80FvarComment('edits','Start address of source to be edited.')
call Z80FvarComment('numbit','Temporary store used during number output.')
call Z80FvarComment('part1','Temporary addresses used during number input.')
call Z80FvarComment('part2','Temporary addresses used during number input.')
call Z80FvarComment('endf','Temporary store used during number output.')
call Z80FvarComment('nega','Flag for negative number during number output.')
call Z80FvarComment('temp1','Temporary store for HERE during compiling.')
call Z80FvarComment('temp2','Temporary store for LATEST during compiling.')
call Z80FvarComment('il1','Length of input line before cursor.')
call Z80FvarComment('il2','Length of input line after cursor.')
call Z80FvarComment('etib','End address of Terminal Input Buffer.')
call Z80FvarComment('iflag','Flag indicating that characters may be inserted into the input line and existing input is not over written.')
call Z80FvarComment('ldflg','Flag showing that source is being compiled.')
call Z80FvarComment('errhld','Address of interpreter pointer position when an error occurred during source compilation.')
call Z80FvarComment('svblk','Flag used during LOAD, SAVE and DIR commands.')
call Z80FvarComment('slen','Length of source to be saved.')
call Z80FvarComment('se','End address of source.')
call Z80FvarComment('sadd','Address from where source will be LOADed or SAVEd.')
call Z80FvarComment('hlds','Temporary store during number formatting.')
call Z80FvarComment('pairs','Flags to indicate whether pairs such as DO-LOOP match up during compilation.')
call Z80FvarComment('pageno','Holds number of page paged in at 32768 in sections C & D.')
call Z80FvarComment('cur','Address of cursor in input buffer.')
call Z80FvarComment('smode','Indicates SAM screen mode 1, 2, 3 or 4.')
call Z80FvarComment('len2','Used to increase or decrease length of source during editing.')
call Z80FvarComment('len1','Used to increase or decrease length of source during editing.')
call Z80FvarComment('lists','Start address of source list on screen, or of source to be SAVEd. Changed with T, N, FROM.')
call Z80FvarComment('elist','End address of source list on screen or source to be SAVEd. Changed with N or ES.')
call Z80FvarComment('blong','Used during source editing.')
call Z80FvarComment('endline','Used during source editing.')
endfunction
function! Z80Comments()
" Add comments to the source.
while search('^\s\+jp l_name$','w')
call Z80CommentAtLine(line('.'),'xxx fixme -- wrong jump')
endwhile
let l:line=search('^\tret\nrols:$','w')
if l:line
call Z80CommentAtLine(l:line,'xxx -- useless')
endif
let l:line=search('^\tjp jp_link\njp jp_link_l$','w')
if l:line
call Z80CommentAtLine(l:line+1,'xxx -- useless')
endif
let l:line=search('^\tpop de\nudgdef:$','w')
if l:line
call Z80CommentAtLine(l:line-1,'xxx -- useless')
endif
let l:line=search('^\print_cr:$','w')
call Z80CommentAtLine(l:line,'xxx -- duplicated code; already in the CR word')
let l:line=search('^\udgdef:','w')
let l:line=search('\<tempstk_fvar\>','w')
call Z80CommentAtLine(l:line,'xxx -- warning: this variable is used as temporary storage')
let l:line=search('\<tempstk_fvar\>','w')
call Z80CommentAtLine(l:line,'xxx -- warning: this variable is used as temporary storage')
let l:line=search('\<corestore_fvar\>','w')
call Z80CommentAtLine(l:line,'xxx -- not used: chere_fvar does its function')
call Z80ErrorComments()
if s:SamForthVariant==?'A'
" SamForth-A only
let l:line=search('^\s\+jp l006ah$','wc')
call Z80CommentAtLine(l:line,'xxx -- this looks unfinished or debugging code')
call search('^nmi_routine:$','wc')
let l:line=search('^\s\+jp l006ah','wc')
" xxx fixme -- unfinished? check
let l:line=search('\<sub_0aaeh$','w')
call Z80CommentAtLine(line('.'),'xxx -- why?')
let l:line=search('^sub_0aaeh:$','w')
call Z80CommentAtLine(line('.'),'xxx -- why?')
else
" SamForth-B only
let l:line=search('^jp_push_hl_de:$','w')
if l:line
call Z80CommentAtLine(l:line,'xxx -- not used; the calls are direct')
else
call Z80NotFoundError('jp_push_hl_de:')
endif
let l:line=search('^jp_print_a_xxx_duplicated:$','w')
if l:line
call Z80CommentAtLine(l:line,'xxx -- not used; the calls are direct')
else
call Z80NotFoundError('jp_print_a_xxx_duplicated:')
endif
let l:line=search('^set_palette_l_to_e:$','w')
if l:line
call Z80CommentAtLine(l:line,'xxx -- not used')
else
call Z80NotFoundError('set_palette_l_to_e')
endif
let l:line=search('^call_rom_address_in_iy:$','w')
if l:line
call Z80CommentAtLine(l:line,'xxx -- not used')
endif
let l:line=search('\<sub_49e2h$','w')
call Z80CommentAtLine(line('.'),'xxx -- why?')
let l:line=search('^sub_49e2h:$','w')
call Z80CommentAtLine(line('.'),'xxx -- why?')
let l:line=search('\<jp l59bah$','w')
call Z80CommentAtLine(line('.')-1,'xxx -- not used')
call Z80CommentAtLine(line('.'),'xxx -- not used; it looks forgotten code of SamForth-A')
let l:line=search('^l59bah:','w')
call Z80CommentAtLine(line('.'),'xxx -- not used; it looks forgotten code of SamForth-A')
endif
call Z80FvarComments()
endfunction
" ==============================================================
" SAM Coupé symbols
function! Z80AtOrg()
call cursor(1,1)
call search('^\s\+org\s','W')
endfunction
function! Z80EquHere(symbol,value,comment)
" Create a new line, below the current cursor position, with a symbol definition.
normal o
call setline('.',a:symbol.':'.nr2char(9).'equ '.a:value.' ; '.a:comment)
endfunction
function! Z80EquAtOrg(symbol,value,comment)
" Create a new line, below the ORG, with a symbol definition.
call Z80AtOrg()
call Z80EquHere(a:symbol,a:value,a:comment)
endfunction
function! Z80JsvinCall(symbol,address,lineNumber)
" Translate the parameter of a JSVIN call.
" address = four hex digits with the configured prefix
let l:parameter=getline(a:lineNumber+1)
if match(l:parameter,'\<'.a:address.'$')!=-1
let l:parameter=substitute(l:parameter,a:address.'$',a:symbol,'')
call setline(a:lineNumber+1,l:parameter)
endif
endfunction
function! Z80IYCall(symbol,address,lineNumber)
" Translate the parameter of a JSVIN call.
" address = four hex digits with the configured prefix
let l:parameter=getline(a:lineNumber)
if match(l:parameter,'\<'.a:address.'$')!=-1
let l:parameter=substitute(l:parameter,a:address.'$',a:symbol,'')
call setline(a:lineNumber,l:parameter)
endif
endfunction
function! Z80RomRoutine(variantPattern,name,address,description)
" Do all changes required to label the calls to a ROM routine.
" variantPattern= 'A' or 'B' or '.'
" name = the routine name, as of the Technical Manual, but lowercase
" address = four hex digits only, no prefix
if match(s:SamForthVariant,a:variantPattern)!=-1
let l:symbol = a:name.'_rom_routine'
let l:value = s:hexPrefix.a:address
if s:SamForthVariant==?'A'
let l:line=search('ld iy,'.l:value,'wc')
call Z80IYCall(l:symbol,l:value,l:line)
else
%global@call jsvin_rom_routine\n\s\+defw@call Z80JsvinCall(l:symbol,l:value,line('.'))
endif
call Z80EquAtOrg(l:symbol,l:value,a:description)
endif
endfunction
function! Z80OrgAbove(lineNumber,address)
" Create an 'org' above the given line.
" address = four hex digits, without prefix
normal O
call setline(a:lineNumber,nr2char(9).'org '.s:hexPrefix.a:address)
normal O
endfunction
function! Z80OrgAboveRst(rstNumber)
" Remove all padding 'nop' above an 'rst' address and put an 'org' instead.
" RstNumber = two hex digits without prefix
call cursor(1,1)
let l:lineNumber=search('^rst'.a:rstNumber.':$','Wc')
if l:lineNumber
call Z80OrgAbove(l:lineNumber,'00'.a:rstNumber)
" Remove all possible 'nop' above:
while match(getline(line('.')-1),'^\s\+nop$')!=-1
call cursor(line('.')-1,1)
normal dd
endwhile
endif
endfunction
function! Z80OrgAboveEveryRst()
" Remove all padding 'nop' above every 'rst' address and put 'org' instead.
" Put rstXX symbols above possible synonyms:
silent! %substitute@^\(\S\+:\)\n\(rst[0-9]\{2}:\)$@\2\r\1@e
call Z80OrgAboveRst('08')
call Z80OrgAboveRst('10')
call Z80OrgAboveRst('18')
call Z80OrgAboveRst('20')
call Z80OrgAboveRst('28')
call Z80OrgAboveRst('30')
call Z80OrgAboveRst('38')
endfunction
function! Z80SamSymbols()
call Z80EquAtOrg('hmpr',s:hexPrefix.'fb','High Memory Page Register')
silent! %substitute@out (0xfb)@out (hmpr)@ei
call Z80EquAtOrg('lmpr',s:hexPrefix.'fa','Low Memory Page Register')
silent! %substitute@out (0xfa)@out (lmpr)@ei
call Z80RomRoutine('.','jnchar','0184','Try to match the char at line D, column E; CY=found?, A=char')
call Z80RomRoutine('B','jwaitkey','016c','Read next key into A from keyboard buffer; wait for a key if needed')
call Z80RomRoutine('.','jreadkey','0169','Read keyboard; NZ/CY if pressed, A=key')
call Z80RomRoutine('B','jkbflush','0166','Flush keyboard buffer')
call Z80RomRoutine('A','jgdump','0160','Do a graphic screen dump')
call Z80RomRoutine('B','jmode','015a','Set screen mode (0-3)')
call Z80RomRoutine('.','jpalet','0154','Put colours BC for palette colour E; A=y')
call Z80RomRoutine('.','jclslower','0151','Clear lower screen and select channel K')
call Z80RomRoutine('.','jclsbl','014e','Clear entire screen if A=0, else clear upper screen')
call Z80RomRoutine('.','jroll','014b','Move part of the screen (A=wrap/roll, B=pixels, C=direction, D=length, E=width, L=x, H=y')
call Z80RomRoutine('.','jblitz','0148','Execute a string of graphics commands BC long at DE')
call Z80RomRoutine('.','jfill','0145','Fills an area at coordinates C,B with the pattern at DE')
call Z80RomRoutine('.','jplot','0139','Plot pixel at x coordinate in C and y coordinate in B')
call Z80RomRoutine('.','jgrab','0136','Store a block of screen data from given coordinates to a buffer')
call Z80RomRoutine('.','jput','0133','Place a block of data on the screen at given coordinates')
call Z80RomRoutine('.','jdrawto','013f','Draw a line from the current position C pixel horizontally and B pixels vertically')
call Z80RomRoutine('.','jsetstrm','0112','Set the stream specified by the A register')
call Z80RomRoutine('B','jsvin','0103','Call parameter word with system variables page switched in')
call Z80RomRoutine('.','rst_10','0010','Print char in A register to current stream')
if s:SamForthVariant==?'A'
call Z80OrgAboveEveryRst()
normal gg
let l:lineNumber=search('^nmi_routine:$','Wc')
call Z80OrgAbove(l:lineNumber,'0066')
endif
endfunction
" ==============================================================
" Add a header
function! Z80Now()
return strftime('%Y-%m-%dT%H:%M:%S %Z')
endfunction
function! Z80FileHeader()
let s:SamForthName='SamForth'.(s:SamForthVariant==?'B'?'-B':'')
let l:year=s:SamForthVariant==?'A'?'1991':'1995'
normal gg13O
call setline(01,'; '.s:SamForthName.' for the SAM Coupé')
call setline(02,'; Copyright (C) '.l:year.' John A. Avis')
call setline(03,';')
call setline(04,'; This file is part of the')
call setline(05,'; "SamForth disassembled" project (2012-2013)')
call setline(06,'; (<http://programandala.net/en.program.samforth>),')
call setline(07,'; by Marcos Cruz (programandala.net).')
call setline(08,';')
call setline(09,'; This file was created on '.Z80Now().'.')
call setline(10,';')
call setline(11,'; First, the binaries were searched for data with:')
call setline(12,'; SamForth2z80dasm, a Gforth program.')
call setline(13,'; Second, they were disassembled with:')
call cursor(15,1)
normal 2o
call setline(16,'; And third, the assembly was postprocessed with:')
call setline(17,'; z80dasm2tidySamForth, a Vim program.')
endfunction
" ==============================================================
" Special cases
function! Z80SpecialCases()
" I don't know why, z80dasm does't disassemble the following three bytes,
" the end of the 'out' word, but creates a 'defb' instead:
silent! %substitute@defb 0xed,0x59,0xc9@out (c),e\r\tret@e
endfunction
" ==============================================================
" Main
function! Z80Main()
call Z80NamesToDefm()
call Z80ErrorsToDefm()
call Z80ZonesToDefs()
call Z80ClearUnwanted()
call Z80NoNops()
call Z80ProperHex()
call Z80DefbToDefw()
call Z80BranchsToSymbols()
call Z80LinkFields()
call Z80SamSymbols()
call Z80SpecialCases()
call Z80Comments()
call Z80FvarConversions()
call Z80FileHeader()
endfunction
call Z80Main()
" ============================================================== Development
" history
"
" 2013-01-02:
"
" First version.
"
" 2013-01-04:
"
" Typo fixed. Headers finished. Bug fixed: the defb->defw byte order was
" wrong. The '_name:' symbols are not removed anymore, because they are
" needed to translate the links. The symbols of JVSIN's arguments are
" removed. The link field addresses are converted to their corresponding
" symbols. Symbols for SAM's memory page registers. Some special cases fixed
" in the assembly. Word names are converted to 'defm'.
"
" 2013-01-05:
"
" Code divided into functions. New functions to add comments to the final
" source. Error messages are converted to 'defm'. Special cases fixed.
"
" 2013-01-06:
"
" All ROM routines are translated to symbols. All SamForth variables are
" commented with the descriptions found in the original documentation. All
" data zones (tib, pad and stacks) are converted to 'defs'.
"
" 2013-01-07:
"
" Finished the comments of ROM routines. The contents of SamForth's variables
" are converted to symbols if needed: rstack, stack, stp, stackend, clate,
" chere, latest, here, fence, tib, pad, errsp... Every variant now defines
" only the required ROM routines.
"
" 2013-01-08:
"
" Two 'nop' unknown zones in SamForth-B, marked during the preprocessing, are
" converted to 'defs'. All padding 'nop' above the 'rst' addresses are
" removed; an 'org' is put instead. The format of the 'rst' values is changed
" with the prefered hex prefix.
"
" 2013-01-20:
"
" Now double quotes are used to surround 'defm' strings; single quotes are
" accepted by Pasmo but not by pyz80. Type fixed in Z80Comments. The
" notation of the '."' word name is changed to be compatible with both pyz80
" and Pasmo.
"
" 2013-01-21:
"
" New comments, on an useless 'ret' after a 'jp'. New comments, on an useless
" 'jp jp_link_l' after a 'jp jp_link'. New comment in SamForth-B, on the
" useless 'call_rom_address_in_iy' routine (a remain from SamForth-A). New
" comments on 'sub_49e2h' (SamForth-B) and 'sub_0aaeh' (SamForth-A). New
" comments on useless 'pop de' before 'udgdef:'. Fixed comment:
" 'tempstk_fvar' is used by SamForth-B. Removed comments on the words that
" return the address of stack manipulation code in SamForth-B (e.g.
" 'push-hl'). Fixed: regex that removes the first definition of
" 'jsvin_rom_routine'. New comment on the new 'return_from_basic' label. New
" comments on the 'l59bah' label in SamForth-B. New comment on the new
" 'print_cr' label. New comments on the usage of 'tempstk_fvar' in 'udgdef'.
"
" 2013-01-22:
"
" New comment on 'corestore_fvar'. New: Z80BranchsToSymbols().
;
" 2013-01-24:
"
" Improved: comment on 'samerr_fvar'.
"
" 2013-01-25:
"
" Fixed: contents of 'tib_fvar', 'pad_fvar' and 'etib_fvar' were wrong: start
" and end addresses were exchanged (it worked fine anyway).
"
" Fixed: comment of 'fence_fvar'.
"
" 2013-02-01:
"
" Fixed: typo in comment.
" Fixed: the end of the 'out' word was not disassembled by z80dasm. Now a
" substitution is done here instead (in the Z80SpecialCases function).