' "hllcomp" 12/29/12
' Compiler/decompiler for HLLPIC Interpreter
'
' To compile for Linux: fbc -e -lang qb hllcomp.bas
' For Windows: "c:\program files\freebasic\fbc" -e -lang qb hllcomp.bas
'
' Usage...
' hllcomp infile [outfile]     compile HLL in infile to hex in outfile
' hllcomp -d infile [outfile]  decompile hex in infile to HLL in outfile
' if outfile not specified, defaults to basename.bytes or basename.decomp
' add -debug as first parm to print additional debugging info
'
' hex file format...
' [address:] [byte] [byte] [byte] ... [END]
' When decompiling address tags and END is optional
' Example... a PIC16F program that flashes PORTA.2
' 0000: 0E AE 05 30 0B 0E 2E 05 30 0B FF 10 42 8E 01 02
' 0010: 32 11 4F 02 03 31 D5 20 14 03 30 D5 20 11 0D
' END
' ...compiled from the following source code...
' set bit 2 of porta
' gosub delay
' clear bit 2 of porta
' gosub delay
' system
' delay: a = c xor rtcc
' increment c
' delay1: b = 2
' delay2: decrement b
' if not zero goto delay2
' decrement a
' if not zero goto delay1
' return
'
' Commands can all be on one line...
' a = 0 b = c or 3 if b = 3 goto x goto y
' Returns are ignored. IF only affects the next command
' so in that example goto y is executed if b <> 3.
'
' Block structures are simulated by compiling gotos and unique labels,
' supports if/then/else/endif and do/break/loop structures...
' if [condition] then [code for true] endif
' if [condition] then [code for true] else [code for false] endif
' do if [condition] break [code to repeat] loop
' do [code to repeat] if [condition] loop
'
'License...
'The hllcomp BASIC source code and binary is Copyright 2012 Terry Newton.
'May be redistributed provided the source code is included, the copyright
'remains intact, and any changes are documented with attribution and date.
'The compiler output may be used for any purpose without restrictions.
'Provided as-is and without warranty.
'
' History...
' 12/13/99 - original BOTEDIT program
' 11/19/12 - converted to stand-alone "hllcomp" compiler for HLLPIC...
'            removed robot-specific instructions and parallel port stuff,
'            now a command-line app that compiles source to a hex bytes file.
' [various intermediate "working on it" versions for bugs and new features]
' 11/26/12 - added INCREMENT/DECREMENT commands for HLLPIC v1.03/v1.12
' 11/30/12 - comment/text/license tweaks
' 12/3/12  - added READARRAY/WRITEARRAY support for HLLPIC v1.20+
' 12/10/12 - added support for block IF/THEN/ELSE/ENDIF and DO/BREAK/LOOP
' 12/16/12 - added MSDELAY GETSERIAL SENDSERIAL FLASHLED SENDHEX and
'            vars milliseconds hexbyte xmtreg rcvreg for HLLPIC v1.22
' 12/21/12 - added ADDRESS and support for multiple extents
'            added DPAGE(label) and DADDR(label) to convert labels
'            CODE now handles "strings" and comma-separated values/symbols
'            mods to decompiler to handle multiple extents and data
' 12/24/12 - modified to work with QB64, added -pause command option
' 12/28/12 - modified help text for HLLPIC 1.23 (array index behavior)
' 12/29/12 - modified CODE decompile to use commas and quote ascii
'            added END_PROGRAM_CODE psuedo-command, compiles to 16 FF's
'            modified decompiler so if decompiling an extracted dump,
'            if 16 consecutive FF's are encountered it skips to 1000h
'            decompiler couldn't handle max ee size - fixed
'            decompiler didn't use symbols for inc/dec - fixed

PRINT: PRINT "HLLPIC Compiler  Dec 29 2012"

debug1 = 0
debug2 = 0     'these affect display when compiling
debug3 = 0
codesize = 4096 'max size of generated code
eesize = 8192   'max size of eeprom
maxlabels = 1000
maxfixups = 1000
maxuser = 1000
variablelocs = &H30 'for inc/dec must match interpreter variable locations
'for implementing block if/then/else/endif and do/break/loop...
DIM ifblock%(50), ifelse%(50), doblock%(50)
FOR i = 1 TO 50: ifblock%(i) = 0: ifelse%(i) = 0: doblock%(i) = 0: NEXT i
iflevel = 0: dolevel = 0: maxlevels = 50

'default extensions - for real QBasic make these 3 chars max
compile_ext$ = "bytes"     'default extension when compiling
decompile_ext$ = "decomp"  'default extension when decompiling

'get command line parms - comment for real QBasic to prompt for fn's
cl$ = COMMAND$

DIM eedata%(8192)
DIM oneword$(50), twoword$(50), threeword$(50) 'fixed instructions
DIM onebyte%(50), twobyte%(50), threebyte%(50) 'and their byte codes
DIM symbol$(1000), value$(1000)   'predefined and user equates
DIM label$(1000), address%(1000), fixup$(1000), fixadr%(1000)
' label$() crosses label addresses to address%()
' fixup$() crosses undefined names to address in fixadr%()
DIM extent%(500,1) '12/19/12 support for multiple extents/address spec
'extent%(x,0) = start, extent%(x,1) = end+1
extent%(0, 0) = 0: extent%(0, 1) = 0: extentnumber = 0: maxextents = 500
DIM pgadr%(1000), pgfixup$(1000), lowadr%(1000), lowfixup$(1000) '12/20/12
pgfixnum = 0: lowfixnum = 0
'supporting resolution of ee page/address of labels requires new fixups

dodecompile = 0: pauseflag = 0
GOSUB gettoken
IF token$ = "-pause" THEN pauseflag = 1: GOSUB gettoken
IF token$ = "-help" GOTO info
IF token$ = "-debug" THEN debug1 = 1: debug2 = 1: debug3 = 1: GOSUB gettoken
IF token$ = "-d" then dodecompile = 1: GOSUB gettoken
IF token$ <> "" THEN infile$ = token$: GOSUB gettoken
IF token$ <> "" THEN outfile$ = token$
IF infile$ = "" THEN 'parms not specified, prompt
 pauseflag = 1 'always pause on exit if run without parms
 PRINT "Select C) Compile HLL to hex  D) Decompile hex to HLL : ";
 LINE INPUT a$: a$ = LTRIM$(RTRIM$(UCASE$(a$)))
 IF a$ <> "C" AND a$ <> "D" THEN SYSTEM
 dodecompile = 0: IF a$ = "D" THEN dodecompile = 1
 IF dodecompile THEN PRINT "Hex"; ELSE PRINT "HLL";
 PRINT " input file  : ";
 LINE INPUT infile$: infile$ = LTRIM$(RTRIM$(infile$))
 IF infile$ = "" THEN SYSTEM
 IF dodecompile THEN PRINT "HLL"; ELSE PRINT "Hex";
 PRINT " output file : ";
 LINE INPUT outfile$: outfile$ = LTRIM$(RTRIM$(outfile$))
 IF outfile$ = "" THEN
  GOSUB getdefaultoutfile
  PRINT "(using ";outfile$;")"
 END IF
END IF

IF outfile$ = "" THEN GOSUB getdefaultoutfile
IF outfile$ = infile$ THEN
 PRINT "Input and output files can't be the same."
 GOTO systemexit
END IF
GOTO initialize

info:
PRINT "Copyright 2012 Terry Newton"
PRINT
PRINT "Compiles/decompiles programs for the HLLPIC interpreter. Usage..."
PRINT "hllcomp infile outfile     compile HLL in infile to hex in outfile"
PRINT "hllcomp -d infile outfile  decompile hex in infile to HLL in outfile"
PRINT "Add -pause before filenames to pause on exit and while printing help."
PRINT "Add -debug before filenames to print additional debugging info (messy)."
PRINT "If outfile is not specified then defaults to progname.";compile_ext$
PRINT "when compiling and progname.";decompile_ext$;" when decompiling."
PRINT "File and path names must not contain spaces."
PRINT
PRINT "Summary of the HLLPIC language..."
PRINT
PRINT "Letter case doesn't matter, returns and extra whitespace ignored."
PRINT "Numbers (num) can be from 0 to 255, append h for hex or b for binary."
PRINT "Variables (var) can be A to N for more compact encoding or (number)"
PRINT "to reference a ram location or PIC register, address number can be"
PRINT "from 0 to 255 but modifying locations 0,2,3,4,10 will likely crash"
PRINT "the interpreter, and many locations refer to PIC registers."
PRINT "The general-purpose registers in bank 1 are safe to use for extra"
IF pauseflag THEN GOSUB pause
PRINT "varables, the PIC16F684 supports using locations (A0h) to (BFh),"
PRINT "larger PICs such as the PIC16F688 support locations (A0h) to (EFh)."
PRINT
PRINT "Expressions are evaluated left to right, accumulating the result."
PRINT "Valid expression operators are: +  -  and  or  xor"
PRINT "Expressions must begin with a variable or a number."
PRINT "Assignments must begin with a variable or number followed by a"
PRINT "space followed by = and another space followed by a number,"
PRINT "variable or expression. As in: A = 2   or: (A0h) = (A1h) + 5 AND 7"
PRINT "Words ending with : are target labels for GOTO/GOSUB."
PRINT "Don't include the colon in the GOTO/GOSUB command."
PRINT
PRINT "DEFINE can be used to give descriptive names to variables, as in:"
PRINT "DEFINE variablename = (A0h)   or: DEFINE variablename = A"
PRINT "Several predefined variables are provided:"
PRINT "PORTA PORTB PORTC - port registers, bits correspond to pin states"
PRINT "TRISA TRISB TRISC - tristate registers, set bits are inputs"
PRINT "EEDATA EEADDRESS EEPAGE - for READMEMORY and WRITEMEMORY"
PRINT "ADCHANNEL ADRESULT ADRESULT_LOW ADRESULT_HIGH - for READANALOG"
PRINT "RTCC - real-time clock counter (location 1 original name)"
PRINT "ARRAYINDEX - index for READARRAY and WRITEARRAY"
PRINT "ADDAYDATA - data for READARRAY and WRITEARRAY"
IF pauseflag THEN GOSUB pause
PRINT "MILLISECONDS - delay for MSDELAY and FLASHLED"
PRINT "XMTREG HEXBYTE - data for SENDSERIAL and SENDHEX"
PRINT "RCVREG - data for GETSERIAL"
PRINT "Conditional execution..."
PRINT "IF expression operator expression command - execute the command"
PRINT " only if the condition is true. Valid operators are: = <> < <= > >="
PRINT " The command can be any valid command but cannot be another IF."
PRINT " Example: IF A AND 7 < B AND 7 INCREMENT A"
PRINT "IF BIT bitnumber OF var command - execute the command if the bit is set"
PRINT "IF NOT BIT bitnumber OF var command - execute the command if bit is clear"
PRINT " Example: IF BIT 3 OF PORTC GOTO do_something"
PRINT "After doing computations internal flags are set for ZERO MINUS and CARRY."
PRINT "IF ZERO command - execute the command if the result was 0"
PRINT "IF NOT ZERO command - execute the command if the result was not 0"
PRINT "IF MINUS command - execute the command if the result is >= 128 (bit 7 set)"
PRINT "IF NOT MINUS command - execute the command if the result is < 128"
PRINT "IF CARRY command - execute the command if the computation overflowed"
PRINT "IF NOT CARRY command - execute the command if the computation didn't overflow"
PRINT " Example: DECREMENT A  IF CARRY DECREMENT B"
PRINT " (note.. simple assignments and IF comparisons also change the flags)"
PRINT "Block IF/THEN/ELSE/ENDIF..."
PRINT "THEN - equivalent to 'goto _then_l_n  goto _else_l_n  _then_l_n:'"
IF pauseflag THEN GOSUB pause
PRINT "ELSE - equivalent to 'goto _endif_l_n  _else_l_n:'"
PRINT "ENDIF - equivalent to '_endif_l_n:' or '_else_l_n:' dep. on if ELSE used"
PRINT " l_n are generated label numbers, l=if level, n=usage number"
PRINT " Example: IF A = 2 THEN B = 1 C = 2 ELSE B = 2 C = 3 ENDIF"
PRINT "Block DO/BREAK/LOOP..."
PRINT "DO - equivalent to '_do_l_n:' - starts a new loop structure"
PRINT "BREAK - equivalent to 'goto _loopend_l_n' - exits a loop structure"
PRINT "LOOP - equivalent to 'goto _do_l_n _loopend_l_n:' - ends a loop structure"
PRINT " l=do level, n=usage number. LOOP can be part of an IF to simulate"
PRINT " conditional loops but there can be only one LOOP per DO."
PRINT " Example: A = 0  DO .... IF A < 10 LOOP"
PRINT " Example: DO IF NOT BIT 2 OF PORT A BREAK ... LOOP"
PRINT "Commands..."
PRINT "GOTO label - branches to label:"
PRINT "GOSUB label - saves address of next command and branches to label:"
PRINT "RETURN - branches back to the command after the GOSUB"
PRINT "Only a few levels of GOSUB/RETURN can be used (typically 5)."
PRINT "INCREMENT var  DECREMENT var - increment/decrement var (aliases INC and DEC)"
PRINT "INVERT var - invert all bits in var (alias NOT var but INVERT reads better)"
PRINT "LEFTSHIFT var - left-shift bits in var, 0 --> bit 0, bit 7 --> CARRY"
PRINT "RIGHTSHIFT var - right-shift bits in var, 0 --> bit 7, bit 0 --> CARRY"
PRINT "SWAPNIBBLES var - swap the low/high nibbles of var (01110011 --> 00110111)"
IF pauseflag THEN GOSUB pause
PRINT "SET BIT bit OF var - set a bit to 1"
PRINT "CLEAR BIT bit OF var - clear a bit to 0"
PRINT "SLEEP - halt the processor (watchdog must be enabled for timed sleep)"
PRINT "CLRWDT - reset the watchdog timer (only needed if watchdog enabled)"
PRINT "  change WDTCON to control watchdog, bit 0 enables, bits 1-4 set duration"
PRINT "  typ ~5 seconds for '684/688: (18h) = 1111b  for '690: (97h) = 1111b"
PRINT "NOP - no operation"
PRINT "System-specific commands... (may vary or not be implemented in some versions)"
PRINT "SYSTEM - exit interpeter to run system-specific tasks then rerun program."
PRINT "  In the default version of HLLPIC it simply loops back to the beginning"
PRINT "  unless EEPAGE is set to special values for jumping between internal and"
PRINT "  external eeprom. Other versions may do other operations before looping."
PRINT "READANALOG - reads analog input specified by the ADCHANNEL variable (the"
PRINT "  corresponding pin must already be set to input), return results in the"
PRINT "  variables ADRESULT, ADRESULT_LOW and ADRESULT_HIGH. ADRESULT_LOW is the"
PRINT "  lower 8 bits of the 10 bit result, top 2 bits in ADRESULT_HIGH."
PRINT "  ADRESULT is the result/4, 0-255 represent voltage from 0 to Vcc."
PRINT "READMEMORY - reads eeprom location specified by vars EEADDRESS and EEPAGE"
PRINT "  and returns result in var EEDATA. EEPAGE defaults to 0 and only used if"
PRINT "  the system is set up to use external eeprom. Actual eeprom location"
PRINT "  accessed is (EEPAGE + 16) * 256 + EEADDRESS to put data above 4K."
PRINT "WRITEMEMORY - writes contents of var EEDATA to the data location"
IF pauseflag THEN GOSUB pause
PRINT "  specified by vars EEADDRESS and EEPAGE."
PRINT "READARRAY - reads element ARRAYINDEX into ARRAYDATA"
PRINT "WRITEARRAY - writes ARRAYDATA to element ARRAYINDEX"
PRINT "  array capacity and ram locations are implementation-specific"
PRINT "  '684 v1.14 simply offsets by B0h, use care as all ram/regs is accessible"
PRINT "  '690 v1.23 maps 0-79 to 120h-16Fh, 80-127 to C0h-EFh, 128-255 wraps 0-127"
PRINT "SENDSERIAL - sends xmtreg to serial out"
PRINT "SENDHEX - sends hexbyte to serial out as 2 hex digits"
PRINT "GETSERIAL - reads serial in into rcvreg"
PRINT "MSDELAY - delays for period defined by milliseconds"
PRINT "FLASHLED - flashes LED on and off, each defined by milliseconds"
PRINT "Other versions of HLLPIC may provide more opcodes for specialized"
PRINT "functions, to use these without modifying the compiler use CODE."
PRINT "Defines can be added to assign opcode names to the extra codes."
PRINT
PRINT "CODE translates numbers, symbols and strings into raw bytes,"
PRINT " separate items with commas. Example: CODE ";CHR$(34);"Prompt:";CHR$(34);",13,10,0"
PRINT "ADDRESS number can be used to change the new eeprom location,"
PRINT " to initialize data use ADDRESS 1xaa where x=page and aa=byte address."
PRINT "DPAGE(label) substitutes a constant representing a label's eepage value,"
PRINT "DADDR(label) substitutes a constant representing a label's eeaddress."
PRINT
IF pauseflag THEN GOSUB pause
PRINT "END_PROGRAM_CODE - this psuedo-command compiles to 16 consecutive FF bytes,"
PRINT "not required but separates current program from previous left-over code and"
PRINT "tells the decompiler to ignore remaining code and skip to data at 1000h."
PRINT
PRINT "System setup..."
PRINT "Internal eeprom locations FEh and FFh determine if the system runs code"
PRINT "and accesses data from internal or external eeprom, if set to E4h,EEh"
PRINT "(the default) then external eeprom is used and the serial loader loads"
PRINT "programs into external eeprom by default unless told otherwise."
PRINT
PRINT "Programs run faster from internal eeprom, so a mechanism is provided"
PRINT "using EEPAGE to jump between programs in internal and external eeprom."
PRINT "EEPAGE = E0h SYSTEM sets EEPAGE to EEh and jumps to internal eeprom to"
PRINT "run the internal ee program once, the program in external eeprom can do"
PRINT "IF EEPAGE = EEh GOTO label if it needs to do additional processing."
PRINT "Programs running in internal eeprom can do EEPAGE = 0 to remain running"
PRINT "in internal ee, then do EEPAGE = EEh SYSTEM to return to external eeprom."
PRINT
GOTO systemexit

pause:
zln = CSRLIN
PRINT "--- press a key to continue --- ";
SLEEP: a$ = INKEY$
LOCATE zln, 1, 0
PRINT "                                ";
LOCATE zln, 1, 1
RETURN

getdefaultoutfile:
'replace the last extension of infile to form outfile
'ignore dots before last path marker or at the
'beginning or end of a filename
basefn$ = infile$ 'default if file has no extension
y = LEN(infile$): z = 0
IF y > 1 THEN 'don't process unless at least 2 characters
 FOR i = y TO 2 STEP -1 'ignore first character
  IF z = 0 THEN 'only process once
   prev$ = MID$(infile$, i - 1, 1) 'char before current
   IF prev$ = "/" OR prev$ = "\" THEN
    z = i 'no extension, stop searching
   ELSE
    IF MID$(infile$, i, 1) = "." THEN 'found..
     z = i: basefn$ = LEFT$(infile$, z - 1)
    END IF
   END IF
  END IF
 NEXT i
END IF
outfile$ = basefn$ + "." + compile_ext$
IF dodecompile THEN outfile$ = basefn$ + "." + decompile_ext$
RETURN

gettoken:
'returns next token from cl$ in token$
'removes from cl$
token$ = ""
cl$ = LTRIM$(RTRIM$(cl$))
zz = INSTR(cl$," ")
IF zz = 0 THEN
 token$ = cl$: cl$ = ""
ELSE
 token$ = LEFT$(cl$, zz-1)
 cl$ = LTRIM$(MID$(cl$, zz))
END IF
RETURN

' predefined symbols
DATA 20
DATA rtcc               ,(1)
DATA porta              ,(5)
DATA portb              ,(6)
DATA portc              ,(7)
DATA eedata             ,(32)
DATA eeaddress          ,(33)
DATA eepage             ,(34)
DATA trisa              ,(133)
DATA trisb              ,(134)
DATA trisc              ,(135)
DATA adchannel          ,(35)
DATA adresult           ,(36)
DATA adresult_low       ,(37)
DATA adresult_high      ,(38)
DATA arrayindex         ,(39)
DATA arraydata          ,(40)
DATA xmtreg             ,(41)
DATA rcvreg             ,(42)
DATA milliseconds       ,(43)
DATA hexbyte            ,(44)

'one word single-byte codes...
DATA 22
DATA nop                ,&h00
DATA if                 ,&h01
DATA clrwdt             ,&h05
DATA sleep              ,&h06
DATA ">"                ,&h07
DATA "<"                ,&h08
DATA "="                ,&h09
DATA ">="               ,&h0A
DATA "<="               ,&h0B
DATA "<>"               ,&h0C
DATA return             ,&h0D
DATA sendhex            ,&hF5
DATA flashled           ,&hF6
DATA getserial          ,&hF7
DATA sendserial         ,&hF8
DATA msdelay            ,&hF9
DATA readarray          ,&hFA
DATA writearray         ,&hFB
DATA readanalog         ,&hFC
DATA readmemory         ,&hFD
DATA writememory        ,&hFE
DATA system             ,&hFF

' two word single-byte codes...
DATA 3
DATA "if carry"         ,&hD0
DATA "if minus"         ,&hD2
DATA "if zero"          ,&hD4

' three word single-byte codes...
DATA 3
DATA "if not carry"     ,&hD1
DATA "if not minus"     ,&hD3
DATA "if not zero"      ,&hD5

initialize:
' initialise data arrays
READ numsymbols
numdatasymbols = numsymbols    'to reset for adding user symbols
FOR i = 1 TO numsymbols
 READ a$: symbol$(i) = LTRIM$(RTRIM$(LCASE$(a$)))
 READ a$: value$(i) = a$
NEXT i

READ num1codes
FOR i = 1 TO num1codes
 READ a$: oneword$(i) = LTRIM$(RTRIM$(LCASE$(a$)))
 READ a$: onebyte%(i) = VAL(a$)
NEXT i

READ num2codes
FOR i = 1 TO num2codes
 READ a$: twoword$(i) = LTRIM$(RTRIM$(LCASE$(a$)))
 READ a$: twobyte%(i) = VAL(a$)
NEXT i

READ num3codes
FOR i = 1 TO num3codes
 READ a$: threeword$(i) = LTRIM$(RTRIM$(LCASE$(a$)))
 READ a$: threebyte%(i) = VAL(a$)
NEXT i

rem compile or decompile the program
IF dodecompile GOTO decompile

PRINT "Compiling HLL file ";infile$;" to ";outfile$;"..."
ON ERROR GOTO infile_error
OPEN infile$ FOR INPUT AS #1
ON ERROR GOTO 0

' pass one, file goto's in fixup$(), fixadr%()
' then gosub fixrefs to replace with actual addresses

comperr = 0: endofsource = 0: PC = 0
fixptr = 0: labelptr = 0: linenumber = 0
word$ = "": word2$ = "": word3$ = "": inputline$ = ""
numsymbols = numdatasymbols  'reset pointer to end of predefined data

FOR i = 0 TO eesize - 1: eedata%(i) = 0: NEXT i

parseloop:
IF comperr GOTO endcompile
GOSUB getword
IF endofsource GOTO endcompile
IF word$ = "" GOTO parseloop

IF word$ = "define" AND word3$ = "=" THEN
 numsymbols = numsymbols + 1
 IF numsymbols > maxuser THEN
  PRINT : PRINT "  Symbol table overflow"
  comperr = 1: GOTO endcompile
 END IF
 GOSUB getword: symbol$(numsymbols) = word$
 GOSUB getword: GOSUB getword
 FOR i = 1 TO numsymbols - 1 'allow redefining symbols to other names
  IF symbol$(i) = word$ THEN word$ = value$(i)
 NEXT i
 value$(numsymbols) = word$
 GOTO parseloop
END IF

IF RIGHT$(word$, 1) = ":" GOTO dolabel
IF word$ = "goto" GOTO dogoto
IF word$ = "gosub" GOTO dogosub
IF word$ = "leftshift" GOTO doleftshift
IF word$ = "rightshift" GOTO dorightshift
' aliases setbit = set = set bit
'         clearbit = clear = clear bit
'         if not bit = if notbit
IF word$ = "set" AND word2$ = "bit" GOTO dosetbit2
IF word$ = "set" OR word$ = "setbit" GOTO dosetbit
IF word$ = "clear" AND word2$ = "bit" GOTO doclearbit2
IF word$ = "clear" OR word$ = "clearbit" GOTO doclearbit
IF word$ = "if" THEN
 IF word2$ = "bit" GOTO doifbit
 IF word2$ = "not" AND word3$ = "bit" GOTO doifnotbit
 IF word2$ = "notbit" GOTO doifnotbit1
END IF
IF word$ = "+" GOTO doadd
IF word$ = "-" GOTO dosubtract
IF word$ = "and" GOTO doand
IF word$ = "or" GOTO door
IF word$ = "xor" GOTO doxor
IF word$ = "not" OR word$ = "invert" GOTO donot
IF word$ = "swapnibbles" GOTO doswap
IF word$ = "increment" OR word$ = "inc" GOTO doincrement
IF word$ = "decrement" OR word$ = "dec" GOTO dodecrement
IF word$ = "code" OR word$ = "," GOTO docode
IF word$ = "then" GOTO dothen
IF word$ = "else" GOTO doelse
IF word$ = "endif" GOTO doendif
IF word$ = "do" GOTO dodo
IF word$ = "break" GOTO dobreak
IF word$ = "loop" GOTO doloop
IF word$ = "address" GOTO doaddress
IF word$ = "end_program_code" GOTO doendcode

hit = 0
IF word3$ <> "" THEN
 GOSUB find3
 IF hit THEN GOSUB getword: GOSUB getword: GOTO encodebyte
END IF
IF word2$ <> "" THEN
 GOSUB find2
 IF hit THEN GOSUB getword: GOTO encodebyte
END IF
GOSUB find1
IF hit GOTO encodebyte

GOSUB translate_symbol 'replace word if defined

' check for assignment
op$ = word$: GOSUB translateop
IF lastword$ <> "if" THEN
 IF uservar AND word2$ = "=" GOTO doletuser
 IF absol AND word2$ = "=" GOTO doletabs
END IF

' check for first number, make it an add with implied +
IF uservar OR absol OR constant GOTO doadd1

GOTO compileerror

doendcode: '12/29/12
FOR z = 1 TO 16
 code = 255
 GOSUB writedatabyte 'use data version so if it crosses 4096 no biggie
NEXT z
GOTO parseloop

translate_symbol:
' translate word$ if predefined symbol
FOR z = 1 TO numsymbols
 IF word$ = symbol$(z) THEN word$ = value$(z)
NEXT z
FOR z = 1 TO numsymbols 'twice in case defined to a define
 IF word$ = symbol$(z) THEN word$ = value$(z)
NEXT z
RETURN

'--------------- block support 12/10/12 ----------
'block if/then/else/endif
'compile THEN as goto _then_l_n goto _else_l_n
'compile ELSE as goto _endif_l_n _else_l_n:
'compile ENDIF as either _endif_l_n: or _else_l_n: if else not used
'l=if level, n=usage number

dothen:
iflevel = iflevel + 1
IF iflevel > maxlevels THEN PRINT "Too many IF levels": GOTO compileerror
ifelse%(iflevel) = 0
'compile "goto _then_[level]_[number]"
gtlabel$ = "_then_": GOSUB generateiflabel: GOSUB compilegoto
'compile "goto _else_[level]_[number]"
gtlabel$ = "_else_": GOSUB generateiflabel: GOSUB compilegoto
'compile "_then_[level]_[number]:"
gtlabel$ = "_then_": GOSUB generateiflabel: GOSUB compilelabel
GOTO parseloop

doelse:
IF iflevel < 1 THEN PRINT "ELSE without THEN": GOTO compileerror
ifelse%(iflevel) = 1
'compile "goto _endif_[level]_[number]"
gtlabel$ = "_endif_": GOSUB generateiflabel: GOSUB compilegoto
'compile "_else_[level]_[number]:"
gtlabel$ = "_else_": GOSUB generateiflabel: GOSUB compilelabel
GOTO parseloop

doendif:
IF iflevel < 1 THEN PRINT "ENDIF without THEN": GOTO compileerror
'compile _endif_[level]_[number] or _else_[level]_[number]
gtlabel$ = "_endif_"
IF ifelse%(iflevel) = 0 THEN gtlabel$ = "_else_"
GOSUB generateiflabel: GOSUB compilelabel
'fix up numbers
ifblock%(iflevel) = ifblock%(iflevel) + 1 'increment usage number
iflevel = iflevel - 1
GOTO parseloop

'block do/break/loop
'compile DO as: _do_l_n:
'compile BREAK as: goto _loopend_l_n
'compile LOOP as: goto _do_l_n _loopend_l_n:
'l=do level, n=usage number
'LOOP may be conditional (say IF A = 0 LOOP) but there can be
'only one LOOP per DO. BREAKs may be used anywhere after LOOP.

dodo:
dolevel = dolevel + 1
IF dolevel > maxlevels THEN PRINT "Too many DO levels": GOTO compileerror
'compile _do_[level]_[number]:
gtlabel$ = "_do_": GOSUB generatedolabel: GOSUB compilelabel
GOTO parseloop

dobreak:
IF dolevel = 0 THEN PRINT "BREAK before DO": GOTO compileerror
'compile goto _loopend_[level]_[number]
gtlabel$ = "_loopend_": GOSUB generatedolabel: GOSUB compilegoto
GOTO parseloop

doloop:
IF dolevel = 0 THEN PRINT "LOOP before DO": GOTO compileerror
'compile goto _do_[level]_[number] _loopend_[level]_[number]:
gtlabel$ = "_do_": GOSUB generatedolabel: GOSUB compilegoto
gtlabel$ = "_loopend_": GOSUB generatedolabel: GOSUB compilelabel
doblock%(dolevel) = doblock%(dolevel) + 1
dolevel = dolevel - 1
GOTO parseloop

'subs for block code
generateiflabel:
'add "[iflevel][ifnumber]" to gtlabel$
gtlabel$ = gtlabel$ + LTRIM$(RTRIM$(STR$(iflevel))) + "_"
gtlabel$ = gtlabel$ + LTRIM$(RTRIM$(STR$(ifblock%(iflevel))))
RETURN

generatedolabel:
'add "[dolevel][donumber]" to gtlabel$
gtlabel$ = gtlabel$ + LTRIM$(RTRIM$(STR$(dolevel))) + "_"
gtlabel$ = gtlabel$ + LTRIM$(RTRIM$(STR$(doblock%(dolevel))))
RETURN

compilegoto:
'compile goto gtlabel$ instruction
IF comperr = 0 THEN
 fixptr = fixptr + 1
 IF fixptr > maxfixups THEN
  comperr = 1
 ELSE
  fixup$(fixptr) = gtlabel$: fixadr%(fixptr) = PC
  code = &H20: GOSUB writebyte
  IF comperr = 0 THEN code = 0: GOSUB writebyte
 END IF
END IF
RETURN

compilelabel:
'compile label gtlabel$
IF comperr = 0 THEN
 labelptr = labelptr + 1
 IF labelptr > maxlabels THEN
  comperr = 1
 ELSE
  label$(labelptr) = gtlabel$
  address%(labelptr) = PC
 END IF
END IF
RETURN
'------------ end block code ---------------

'set compile address
doaddress:
GOSUB getword
n$ = word$: GOSUB checknumber
IF number = 0 GOTO compileerror
extent%(extentnumber, 1) = PC
PC = value
extentnumber = extentnumber + 1
IF extentnumber < maxextents THEN
 extent%(extentnumber, 0) = PC
ELSE
 PRINT "Too many extents."
 comperr = 1
END IF
GOTO parseloop

'do raw code...
docode:
GOSUB getword
'12/21/12 handle "ascii",num,symbol,etc formats
IF INSTR(word$,CHR$(34)) > 0 GOTO docomplexcode
IF INSTR(word$,",") > 0 GOTO docomplexcode
'encode a single code value...
GOSUB translate_symbol
n$ = word$: GOSUB checknumber
IF number = 0 THEN PRINT "Bad code value.": GOTO compileerror
'byte to encode in value
code = value
GOSUB writedatabyte
GOTO parseloop
'parse code word for quotes and commas
docomplexcode:
IF LEN(word$) = 0 GOTO parseloop 'done
IF LEFT$(word$, 1) = CHR$(34) THEN 'encode ascii
 z = INSTR(3, word$, CHR$(34))
 IF z < 3 THEN PRINT "Bad code string.": GOTO compileerror
 z$ = MID$(word$, 2, z - 2) 'isolate string
 word$ = MID$(word$, z + 1) 'remove string from word$
 FOR i = 1 TO LEN(z$)
  code = ASC(MID$(z$, i, 1))
  GOSUB writedatabyte
 NEXT i
 GOTO docomplexcode
END IF
IF LEFT$(word$, 1) = "," THEN 'encode comma separated value
 word$ = MID$(word$, 2) 'remove comma
 IF LEN(word$) = 0 OR LEFT$(word$, 1) = "," THEN
  PRINT "Extra code comma.": GOTO compileerror
 END IF
 GOTO docomplexcode 'parse next value/string
END IF
'encode normal value
z = INSTR(word$, ",")
IF z > 1 THEN
 tempword$ = MID$(word$, z)
 word$ = LEFT$(word$, z - 1)
ELSE
 tempword$ = ""
END IF
GOSUB translate_symbol
n$ = word$: GOSUB checknumber
IF number = 0 THEN PRINT "Bad code value.": GOTO compileerror
code = value
GOSUB writedatabyte
word$ = tempword$
GOTO docomplexcode

'encode single-byte instructions...
encodebyte:
GOSUB writebyte
GOTO parseloop

writedatabyte:  '12/19/12 permit writing all eeprom
IF PC >= eesize THEN comperr = 1: RETURN
GOTO writebytecommon

writebyte:  'code is restricted to 0-4095
IF PC >= codesize THEN comperr = 1: RETURN

writebytecommon:
IF code > 255 OR code < 0 THEN
 comperr = 1
ELSE
 IF debug1 THEN
  PRINT SPACE$(5); RIGHT$("00" + HEX$(PC), 3),
  PRINT RIGHT$("0" + HEX$(code), 2)
 END IF
 eedata%(PC) = code: PC = PC + 1
END IF
RETURN

doletuser:
code = &H10 + (ASC(word$) - 97)
GOSUB getword ' skip equal
GOTO encodebyte

doletabs:
code = &H1E: GOSUB writebyte: IF comperr GOTO endcompile
code = value: GOSUB writebyte: IF comperr GOTO endcompile
GOSUB getword ' skip equal
GOTO parseloop

docommon:
IF constant THEN
 code = code + &HF: GOSUB writebyte: IF comperr GOTO endcompile
 code = value: GOSUB writebyte
 GOTO parseloop
END IF
docommon1:   ' for no-constant instructions
IF uservar THEN code = code + (ASC(op$) - 97): GOTO encodebyte
IF absol THEN
 code = code + &HE: GOSUB writebyte: IF comperr GOTO endcompile
 code = value: GOSUB writebyte: IF comperr GOTO endcompile
 GOTO parseloop
END IF
GOTO compileerror

doincrement:
code = 2
GOSUB getword
GOTO doincdeccommon

dodecrement:
code = 3
GOSUB getword

doincdeccommon:
GOSUB translate_symbol
'word$ must now be either a (loc) or single letter variable
value = -1
IF LEN(word$) = 1 THEN 'translate variable to location
 IF word$ >= "a" AND word$ <= "n" THEN value = ASC(word$) - 97 + variablelocs
ELSE
 IF LEFT$(word$, 1) = "(" AND RIGHT$(word$, 1) = ")" THEN
  n$ = MID$(word$, 2, LEN(word$) - 2)
  GOSUB checknumber: IF number = 0 GOTO compileerror
  'number value in value
 END IF
END IF
IF value = -1 GOTO compileerror
GOSUB writebyte: IF comperror GOTO endcompile
code = value: GOSUB writebyte: IF comperror GOTO endcompile
GOTO parseloop

doadd:
GOSUB getword
op$ = word$: GOSUB translateop
doadd1:
code = &H40: GOTO docommon

dosubtract:
GOSUB getword
op$ = word$: GOSUB translateop
code = &H50: GOTO docommon

doand:
GOSUB getword
op$ = word$: GOSUB translateop
code = &H60: GOTO docommon

door:
GOSUB getword
op$ = word$: GOSUB translateop
code = &H70: GOTO docommon

doxor:
GOSUB getword
op$ = word$: GOSUB translateop
code = &H80: GOTO docommon

donot:
GOSUB getword
op$ = word$: GOSUB translateop
code = &H90: GOTO docommon1

doleftshift:
GOSUB getword
op$ = word$: GOSUB translateop
code = &HA0: GOTO docommon1

dorightshift:
GOSUB getword
op$ = word$: GOSUB translateop
code = &HB0: GOTO docommon1

doswap:
GOSUB getword
op$ = word$: GOSUB translateop
code = &HC0: GOTO docommon1

dogoto:
fixptr = fixptr + 1
IF fixptr > maxfixups GOTO compileerror
GOSUB getword
fixup$(fixptr) = word$
fixadr%(fixptr) = PC
code = &H20: GOSUB writebyte: IF comperr GOTO endcompile
code = 0: GOSUB writebyte: IF comperr GOTO endcompile
GOTO parseloop

dogosub:
fixptr = fixptr + 1
IF fixptr > maxfixups GOTO compileerror
GOSUB getword
fixup$(fixptr) = word$
fixadr%(fixptr) = PC
code = &H30: GOSUB writebyte: IF comperr GOTO endcompile
code = 0: GOSUB writebyte: IF comperr GOTO endcompile
GOTO parseloop

dolabel:
labelptr = labelptr + 1
IF labelptr > maxlabels GOTO compileerror
label$(labelptr) = LEFT$(word$, LEN(word$) - 1)
address%(labelptr) = PC
GOTO parseloop

doifbit:
GOSUB getword ' skip "bit"
state = 1
doifbitcommon:
code = &HF: GOSUB writebyte: IF comperr GOTO endcompile
dobitcommon:
GOSUB getword: op$ = word$: GOSUB translateop
IF constant = 0 OR value > 7 GOTO compileerror
bit = value
GOSUB getword: IF word$ <> "of" GOTO compileerror
GOSUB getword: op$ = word$: GOSUB translateop
code = state * 128 + bit * 16
GOTO docommon1

doifnotbit:
GOSUB getword ' skip "not"
doifnotbit1:
GOSUB getword ' skip "bit" or "notbit"
state = 0
GOTO doifbitcommon

dosetbit2:
GOSUB getword ' skip "bit" when using "set bit"
dosetbit:
state = 1
code = &HE: GOSUB writebyte: IF comperr GOTO endcompile
GOTO dobitcommon

doclearbit2:
GOSUB getword ' skip "bit" when using "set bit"
doclearbit:
state = 0
code = &HE: GOSUB writebyte: IF comperr GOTO endcompile
GOTO dobitcommon

compileerror:
comperr = 1

endcompile:
IF comperr THEN
 PRINT SPACE$(5); "Compile error at address"; PC
 PRINT SPACE$(5); "Source line ="; linenumber
ELSE
 GOSUB fixrefs
 IF referr THEN comperr = 1: PRINT SPACE$(5); "Reference error."
END IF

IF comperr = 0 THEN
 IF PC > 0 GOTO writehexfile
 PRINT "No code was generated."
END IF

close_and_exit:
CLOSE: PRINT

systemexit:
IF pauseflag THEN
 PRINT "--- press a key to exit --- ";
 SLEEP: a$ = INKEY$: PRINT
END IF
SYSTEM

infile_error:
PRINT "Input file error."
GOTO close_and_exit

outfile_error:
PRINT "Output file error."
GOTO close_and_exit

writehexfile: '12/19/12 extended to support multiple extents
'12/21/12 handle empty extents, warn but generate good code
CLOSE
extent%(extentnumber, 1) = PC
bytes = 0
FOR i = 0 TO extentnumber
 bytes = bytes + (extent%(i, 1) - extent%(i, 0))
NEXT i
PRINT "Generated"; bytes; " bytes in";
PRINT extentnumber + 1;" extent";
IF extentnumber > 0 THEN PRINT "s." ELSE PRINT "."
bytesperline = 16
zzflag = 0
ON ERROR GOTO outfile_error
OPEN outfile$ FOR OUTPUT AS #1
ON ERROR GOTO 0
FOR extblock = 0 TO extentnumber
 IF extent%(extblock, 1) > extent%(extblock, 0) THEN
  FOR address = extent%(extblock, 0) TO extent%(extblock, 1) - 1
   IF address MOD bytesperline = 0 THEN
    IF zzflag THEN PRINT #1, "" 'next line
    PRINT #1, RIGHT$("000" + HEX$(address),4);":";
   END IF
   PRINT #1, " ";RIGHT$("0" + HEX$(eedata%(address)),2);
   zzflag = 1 'output newlines for further addresses
  NEXT address
 ELSE 'output a dummy 0000: FF in case user defined data first
  'also triggered if ADDRESS used without including code
  address = extent%(extblock, 0)
  'not a good idea so...
  PRINT "Warning... unused extent at ";HEX$(address); "h, outputting FF."
  IF zzflag THEN PRINT #1, "" 'next line
  PRINT #1, RIGHT$("000" + HEX$(address),4);": FF ";
  zzflag = 1
 END IF
 IF extblock < extentnumber THEN 'more extents
  address = extent%(extblock, 0)
  IF address MOD bytesperline <> 0 THEN 'add newline and address
   PRINT #1, ""
   PRINT #1, RIGHT$("000" + HEX$(address),4);":";
  END IF 'otherwise main loop will add newline/address
 END IF
NEXT extblock

PRINT #1, "": PRINT #1, "END"
CLOSE: PRINT
IF debug3 THEN GOSUB list_outfile
GOTO systemexit

list_outfile:
PRINT
OPEN outfile$ FOR INPUT AS #1
WHILE NOT EOF(1)
 LINE INPUT #1, a$: PRINT a$
WEND: CLOSE: PRINT
RETURN

' get next word from file
getword:
lastword$ = word$ ' previously fetched word in lastword
word$ = "": word2$ = "": word3$ = ""
IF inputline$ = "" THEN
 IF EOF(1) = 0 THEN
skipblanklines:
  LINE INPUT #1, inputline$: linenumber = linenumber + 1
  sp = INSTR(inputline$, ";")
  IF sp = 0 THEN sp = INSTR(inputline$, "'")
  IF sp > 0 THEN inputline$ = LEFT$(inputline$, sp - 1)
  inputline$ = LTRIM$(RTRIM$(inputline$)) '12/21/12 no LCASE
  IF inputline$ = "" AND EOF(1) = 0 GOTO skipblanklines
' convert only non-quoted characters to lowercase
  IF inputline$ <> "" THEN
   zzflag = 0 'new zznames for no side effects
   FOR zz = 1 TO LEN(inputline$)
    zz$ = MID$(inputline$, zz, 1)
    IF zz$ = CHR$(34) THEN zzflag = 1 - zzflag 'flip quote flag
    IF zzflag = 0 THEN MID$(inputline$, zz, 1) = LCASE$(zz$)
   NEXT zz
  END IF
' need to get rid of extra spacing so each word has
' just one space between them
recurseforblanks:
  sp = INSTR(inputline$, "  ")
  IF sp > 0 THEN
   l = LEN(inputline$)
   inputline$ = LEFT$(inputline$, sp) + RIGHT$(inputline$, l - sp - 1)
   GOTO recurseforblanks
  END IF
 ELSE
  endofsource = 1
 END IF
END IF
IF endofsource = 0 THEN
 sp = INSTR(inputline$, " ")
 '12/21/12 don't split up strings
 IF sp > 0 THEN
  sp1 = INSTR(inputline$, CHR$(34))
  IF sp1 > 0 AND sp1 < sp AND sp1 < LEN(inputline$) THEN
   'find next non-quoted space
   sp = 0: zzflag = 1
   FOR zz = sp1 + 1 TO LEN(inputline$)
    zz$ = MID$(inputline$, zz, 1)
    IF zz$ = CHR$(34) THEN zzflag = 1 - zzflag
    IF sp = 0 AND zzflag = 0 AND zz$ = " " THEN sp = zz
   NEXT zz
  END IF
 END IF
 IF sp > 0 THEN
  word$ = LEFT$(inputline$, sp - 1)
  inputline$ = RIGHT$(inputline$, LEN(inputline$) - sp)
 ELSE
  word$ = inputline$
  inputline$ = ""
 END IF
END IF
'2 word lookahead... (don't care about strings here)
IF inputline$ <> "" THEN
 sp1 = INSTR(inputline$, " "): sp2 = 0
 IF sp1 > 0 THEN
  word2$ = LEFT$(inputline$, sp1 - 1)
  sp2 = INSTR(sp1 + 1, inputline$, " ")
  IF sp2 > 0 THEN
   word3$ = MID$(inputline$, sp1 + 1, sp2 - sp1 - 1)
  ELSE
   word3$ = RIGHT$(inputline$, LEN(inputline$) - sp1)
  END IF
 ELSE
  word2$ = inputline$
 END IF
END IF

IF debug2 THEN PRINT SPACE$(5); word$
RETURN

' search routines...
find1:
FOR i = 1 TO num1codes
 IF word$ = oneword$(i) THEN hit = 1: code = onebyte%(i)
NEXT i: RETURN
find2:
a$ = word$ + " " + word2$
FOR i = 1 TO num2codes
 IF a$ = twoword$(i) THEN hit = 1: code = twobyte%(i)
NEXT i: RETURN
find3:
a$ = word$ + " " + word2$ + " " + word3$
FOR i = 1 TO num3codes
 IF a$ = threeword$(i) THEN hit = 1: code = threebyte%(i)
NEXT i: RETURN

'evaluate op$ and return flags and value
translateop:
label = 0
uservar = 0
constant = 0
absol = 0
value = 0

'12/21/12 dpage(label) returns label's eepage
'         (0-15 for data 240-255 for code)
'         daddr(label) returns label's eeaddress
IF LEFT$(op$, 6) = "dpage(" THEN
 IF RIGHT$(op$, 1) <> ")" THEN
  comperr = 1: RETURN
 ELSE
'this is tricky... can only translate if label has
'already been defined.. existing fixup mechanism won't work
'so added new fixups for pages and low adr's
  pgfixnum = pgfixnum + 1
  z$ = MID$(op$, 7, LEN(op$) - 7)
  IF pgfixnum > maxfixups GOTO compileerror
  IF LEN(z$) = 0 GOTO compileerror
  number = 1: constant = 1: value = 0
  pgfixup$(pgfixnum) = z$
  pgadr%(pgfixnum) = PC + 1
  RETURN
 END IF
END IF
IF LEFT$(op$, 6) = "daddr(" THEN
 IF RIGHT$(op$, 1) <> ")" THEN
  comperr = 1: RETURN
 ELSE
  lowfixnum = lowfixnum + 1
  z$ = MID$(op$, 7, LEN(op$) - 7)
  IF lowfixnum > maxfixups GOTO compileerror
  IF LEN(z$) = 0 GOTO compileerror
  number = 1: constant = 1: value = 0
  lowfixup$(lowfixnum) = z$
  lowadr%(lowfixnum) = PC + 1
  RETURN
 END IF
END IF

'translate if symbol
FOR z = 1 TO numsymbols
 IF op$ = symbol$(z) THEN op$ = value$(z)
NEXT z
FOR z = 1 TO numsymbols
 IF op$ = symbol$(z) THEN op$ = value$(z)
NEXT z

IF LEN(op$) = 1 AND op$ >= "a" AND op$ <= "n" THEN uservar = 1: RETURN
IF LEFT$(op$, 1) = "(" AND RIGHT$(op$, 1) = ")" THEN
 n$ = MID$(op$, 2, LEN(op$) - 2): GOSUB checknumber
 IF number THEN absol = 1: RETURN
END IF
n$ = op$: GOSUB checknumber
IF number THEN constant = 1
RETURN

checknumber:
IF RIGHT$(n$, 1) = "h" GOTO checkhexvalue
IF RIGHT$(n$, 1) = "b" GOTO checkbinvalue
number = 1
FOR z = 1 TO LEN(n$)
 IF MID$(n$, z, 1) < "0" OR MID$(n$, z, 1) > "9" THEN number = 0
NEXT z
IF number THEN value = VAL(n$)
RETURN
checkhexvalue:
number = 1
FOR z = 1 TO LEN(n$) - 1
 IF MID$(n$, z, 1) >= "0" AND MID$(n$, z, 1) <= "9" GOTO hexok
 IF MID$(n$, z, 1) >= "a" AND MID$(n$, z, 1) <= "f" GOTO hexok
 number = 0
hexok:
NEXT z
IF number THEN value = VAL("&h" + LEFT$(n$, LEN(n$) - 1))
RETURN
checkbinvalue:
number = 1
FOR z = 1 TO LEN(n$) - 1
 IF MID$(n$, z, 1) <> "0" AND MID$(n$, z, 1) <> "1" THEN number = 0
NEXT z
IF number THEN
 value = 0: mult = 1
 FOR z = LEN(n$) - 1 TO 1 STEP -1
  IF MID$(n$, z, 1) = "1" THEN value = value + mult
  mult = mult * 2
 NEXT z
END IF
RETURN

'fix goto and gosub references
fixrefs:
referr = 0
IF fixptr > 0 THEN
 FOR z = 1 TO fixptr
  a$ = fixup$(z): adr = fixadr%(z)
  hit = 0
  FOR y = 1 TO labelptr
   IF a$ = label$(y) THEN hit = 1: value = address%(y)
  NEXT y
  IF hit THEN
   IF value >= codesize THEN  '12/21/12 error checks
    referr = 1
    PRINT "Label ";a$; " out of range"
   ELSE
    IF eedata%(adr + 1) = 0 THEN
     highbyte = INT(value / 256)
     lowbyte = value - (highbyte * 256)
     eedata%(adr) = eedata%(adr) OR highbyte
     eedata%(adr + 1) = lowbyte
    ELSE
     PRINT "Code overlap!"
     referr = 1
    END IF
   END IF
  ELSE
   referr = 1
   PRINT "Label ";a$; " not found"
  END IF
 NEXT z
END IF
'12/21/12 fix dpage and daddr references
IF pgfixnum > 0 THEN
 FOR z = 1 TO pgfixnum
  a$ = pgfixup$(z): adr = pgadr%(z)
  hit = 0
  FOR y = 1 TO labelptr
   IF a$ = label$(y) THEN hit = 1: value = address%(y)
  NEXT y
  IF hit THEN
   IF eedata%(adr) = 0 THEN
    highbyte = INT(value / 256) - 16 'offset for HLLPIC's eepage
    if highbyte < 0 THEN highbyte = highbyte + 256 '0-255
    eedata%(adr) = highbyte
   ELSE
    PRINT "Code overlap!"
    referr = 1
   END IF
  ELSE
   referr = 1
   PRINT "DPAGE("; a$; ") not found"
  END IF
 NEXT z
END IF
IF lowfixnum > 0 THEN
 FOR z = 1 TO lowfixnum
  a$ = lowfixup$(z): adr = lowadr%(z)
  hit = 0
  FOR y = 1 TO labelptr
   IF a$ = label$(y) THEN hit = 1: value = address%(y)
  NEXT y
  IF hit THEN
   IF eedata%(adr) = 0 THEN
    highbyte = INT(value / 256)

    lowbyte = value - (highbyte * 256)
    eedata%(adr) = lowbyte
   ELSE
    PRINT "Code overlap!"
    referr = 1
   END IF
  ELSE
   referr = 1
   PRINT "DADDR("; a$; ") not found"
  END IF
 NEXT z
END IF
RETURN

REM ------ decompiler ---------

'12/21/12 mods... handle multiple extents, treat data ee as code
'12/29/12 mods... output CODE data using commas and "ascii" to pack better
'                 special handling when decompiling full extract...
'                 detect 16 FF's to separate into code/data extents
'this is a mess.. can be tripped up by CODE statements mixed with instructions
'if the bytes match instructions. Empty extents or byte files starting with
'data then returning to address 0 are not handled well (but not supposed to
'do that). Theoretically the decompiled output should recompile to the same
'code (even with the glitches) but no guarantees. This feature is mainly for
'examining .bytes files and 'extracted code (manually trim extracted files).

decompile:
PRINT "Decompiling hex file ";infile$;" to ";outfile$;"..."
ON ERROR GOTO infile_error
OPEN infile$ FOR INPUT AS #1
ON ERROR GOTO 0
adr = 0
adrerror = 0
hexerror = 0
endofprog = 0
extentnumber = 0
extent%(0, 0) = 0
WHILE NOT EOF(1) AND adrerror = 0 AND hexerror = 0 AND endofprog = 0
 LINE INPUT #1, cl$
 cl$ = UCASE$(LTRIM$(RTRIM$(cl$)))
 IF cl$ = "END" THEN
  endofprog = 1
 ELSE
  WHILE cl$ <> "" AND adrerror = 0 AND hexerror = 0
   GOSUB gettoken
   IF RIGHT$(token$, 1) = ":" THEN
    adrerror = 1
    IF LEN(token$) = 5 THEN
     adrerror = 0
     FOR i = 1 TO 4
      a$ = MID$(token$, i, 1)
      IF (a$ < "0" OR a$ > "9") AND (a$ < "A" OR a$ > "F") THEN adrerror = 1
     NEXT i 
     newadr = VAL("&h" + LEFT$(token$, 4))
     IF newadr <> adr THEN 'new extent
      extent%(extentnumber, 1) = adr
      extentnumber = extentnumber + 1
      IF extentnumber > maxextents THEN
       PRINT "Too many extents": adrerror = 1
      ELSE
       extent%(extentnumber, 0) = newadr
      END IF
     END IF
     adr = newadr
     IF adr >= eesize THEN adrerror = 1
    END IF
   ELSE
    hexerror = 1
    IF LEN(token$) = 2 THEN
     hexerror = 0
     FOR i = 1 TO 2
      a$ = MID$(token$, i, 1)
      IF (a$ < "0" OR a$ > "9") AND (a$ < "A" OR a$ > "F") THEN hexerror = 1
     NEXT i
     byte = VAL("&h" + token$)
     eedata%(adr) = byte
     adr = adr + 1
     IF adr > eesize THEN adrerror = 1
    END IF
   END IF
  WEND
 END IF
WEND
IF adr <= 0 THEN
 PRINT "No hex in file."
 GOTO close_and_exit
END IF
IF adrerror THEN
 PRINT "Address error."
 GOTO close_and_exit
END IF
IF hexerror THEN
 PRINT "Hex error."
 GOTO close_and_exit
END IF
CLOSE

extent%(extentnumber, 1) = adr

'12/29/12 - detect if decompiling an extracted eeprom
'end the code extent after 16 FF's in a row
'will decompile as 16 system's in a row but that's OK
IF extentnumber = 0 AND extent%(0, 1) = eesize THEN
 FFcount = 0: lastcodeaddress = 0
 FOR z = 0 TO codesize - 1
  IF FFcount < 16 THEN
   byte = eedata%(z)
   IF byte = 255 THEN FFcount = FFcount + 1 ELSE FFcount = 0
   IF FFcount = 16 THEN lastcodeaddress = z
  END IF
 NEXT z
 IF lastcodeaddress > 0 THEN 'split into 2 extents
  extent%(0, 1) = lastcodeaddress + 1
  extent%(1, 0) = codesize
  extent%(1, 1) = eesize
  extentnumber = 1
 END IF
END IF
 
IF debug3 THEN GOSUB displayhex

currentextent = 0: eeadr = 0: labelptr = 0
pass1loop:
adr = eeadr
IF adr < codesize THEN 'ignore data
 byte = eedata%(eeadr)
 hinib = INT(byte / 16)
 lonib = byte - hinib * 16
 IF hinib = 2 OR hinib = 3 THEN   'if goto or gosub
  eeadr = eeadr + 1: byte = eedata%(eeadr)
  myaddress = byte + lonib * 256
  a$ = "LOC" + LTRIM$(RTRIM$(STR$(myaddress)))
  'check to see if already there
  hit = 0
  IF labelptr > 0 THEN
   FOR i = 0 TO labelptr - 1
    IF address%(i) = myaddress THEN hit = 1
   NEXT i
  END IF
  IF hit = 0 THEN
   label$(labelptr) = a$
   address%(labelptr) = myaddress
   labelptr = labelptr + 1
   IF labelptr > maxlabels THEN
    PRINT "Label overflow."
    PRINT: GOTO systemexit
   END IF
  END IF
  GOTO pass1next
 END IF
 ' interpret through other instructions
 IF hinib = 1 OR (hinib >= 4 AND hinib <= 12) THEN
  IF lonib < 14 GOTO pass1next
  eeadr = eeadr + 1: GOTO pass1next
 END IF
 IF byte = 14 OR byte = 15 THEN
  eeadr = eeadr + 1: byte = eedata%(eeadr)
  lonib = byte AND 15
  IF lonib < 14 THEN GOTO pass1next
  eeadr = eeadr + 1: GOTO pass1next
 END IF
 IF byte = 2 OR byte = 3 THEN eeadr = eeadr + 1 'inc/dec
END IF 'check for data ee
pass1next:
eeadr = eeadr + 1
IF eeadr < extent%(currentextent, 1) GOTO pass1loop
IF currentextent < extentnumber THEN 'more sections
 currentextent = currentextent + 1
 eeadr = extent%(currentextent, 0)
 GOTO pass1loop
END IF

ON ERROR GOTO outfile_error
OPEN outfile$ FOR OUTPUT AS #1
ON ERROR GOTO 0

ifflag = 0: eeadr = 0: currentextent = 0
codequote = 0: codecolumn = 0

pass2loop:
adr = eeadr
byte = eedata%(eeadr)
IF adr >= codesize GOTO outputcodebyte
hinib = INT(byte / 16)
lonib = byte - hinib * 16
'print a label if current address is in label table
IF labelptr > 0 THEN
 FOR i = 0 TO labelptr - 1
   IF address%(i) = eeadr THEN GOSUB thingy: PRINT #1, label$(i); ": ";
 NEXT i
END IF
'see if it's a one word instruction
hit = 0
FOR i = 1 TO num1codes
 IF byte = onebyte%(i) THEN hit = i
NEXT i
IF hit > 0 THEN
 IF byte < 7 OR byte > 12 THEN GOSUB thingy
 IF byte = 1 OR (byte >= 7 AND byte <= 12) THEN
  first = 1: PRINT #1, oneword$(hit); " ";
 ELSE
  PRINT #1, oneword$(hit); " ";
 END IF
 IF byte = 1 THEN ifflag = 1
 GOTO pass2next
END IF
'see if it's a two word instruction
hit = 0
FOR i = 1 TO num2codes
 IF byte = twobyte%(i) THEN hit = i
NEXT i
IF hit > 0 THEN
 GOSUB thingy: PRINT #1, twoword$(hit); " ";
 IF byte >= &HE0 AND byte <= &HEF THEN ifflag = 1
 IF byte >= &HD0 AND byte <= &HD5 THEN ifflag = 1
 GOTO pass2next
END IF
'see if it's a three word instruction
hit = 0
FOR i = 1 TO num3codes
 IF byte = threebyte%(i) THEN hit = i
NEXT i
IF hit > 0 THEN
 GOSUB thingy: PRINT #1, threeword$(hit); " ";
 IF byte >= &HE0 AND byte <= &HEF THEN ifflag = 1
 IF byte >= &HD0 AND byte <= &HD5 THEN ifflag = 1
 GOTO pass2next
END IF
'goto
IF hinib = 2 THEN
 GOSUB thingy
 eeadr = eeadr + 1: byte = eedata%(eeadr)
 myaddress = byte + lonib * 256
 PRINT #1, "goto LOC"; LTRIM$(RTRIM$(STR$(myaddress))); " ";
 GOTO pass2next
END IF
'gosub
IF hinib = 3 THEN
 GOSUB thingy
 eeadr = eeadr + 1: byte = eedata%(eeadr)
 myaddress = byte + lonib * 256
 PRINT #1, "gosub LOC"; LTRIM$(RTRIM$(STR$(myaddress))); " ";
 GOTO pass2next
END IF
' let
IF hinib = 1 THEN
 GOSUB thingy
 first = 1
 IF lonib < 14 THEN
  PRINT #1, CHR$(ASC("a") + lonib); " = ";
  GOTO pass2next
 ELSE
  IF lonib = 14 THEN ' abs
   eeadr = eeadr + 1: byte = eedata%(eeadr)
   a$ = "(" + LTRIM$(RTRIM$(STR$(byte))) + ")"
   'see if it's a symbol and convert
   FOR i = 1 TO numsymbols
    IF value$(i) = a$ THEN a$ = symbol$(i)
   NEXT i
   PRINT #1, a$; " = ";
  ELSE
   PRINT #1, "code ";RIGHT$("0" + HEX$(byte), 2);"h ";  '12/29/12
  END IF
  GOTO pass2next
 END IF
END IF
' +
IF hinib = 4 THEN
 IF first = 0 THEN PRINT #1, "+ ";
 first = 0
 GOSUB outnextbyte
 GOTO pass2next
END IF
' -
IF hinib = 5 THEN
 first = 0: PRINT #1, "- ";
 GOSUB outnextbyte
 GOTO pass2next
END IF
' and
IF hinib = 6 THEN
 first = 0: PRINT #1, "and ";
 GOSUB outnextbyte
 GOTO pass2next
END IF
' or
IF hinib = 7 THEN
 first = 0: PRINT #1, "or ";
 GOSUB outnextbyte
 GOTO pass2next
END IF
' xor
IF hinib = 8 THEN
 first = 0: PRINT #1, "xor ";
 GOSUB outnextbyte
 GOTO pass2next
END IF
' not
IF hinib = 9 THEN
 GOSUB thingy
 PRINT #1, "invert "; : GOSUB outnextbyte
 GOTO pass2next
END IF
' leftshift
IF hinib = 10 THEN
 GOSUB thingy
 PRINT #1, "leftshift "; : GOSUB outnextbyte
 GOTO pass2next
END IF
' rightshift
IF hinib = 11 THEN
 GOSUB thingy
 PRINT #1, "rightshift "; : GOSUB outnextbyte
 GOTO pass2next
END IF
' swapnibbles
IF hinib = 12 THEN
 GOSUB thingy
 PRINT #1, "swapnibbles "; : GOSUB outnextbyte
 GOTO pass2next
END IF

'set/clear bit
IF byte = 14 THEN
 GOSUB thingy
 eeadr = eeadr + 1: byte = eedata%(eeadr)
 IF byte < 128 THEN
  PRINT #1, "clear ";
 ELSE
  PRINT #1, "set ";
 END IF
 PRINT #1, "bit ";
 bit = byte AND 112  '01110000b
 bit = INT(bit / 16) 'reduce to 0-7
 PRINT #1, LTRIM$(RTRIM$(STR$(bit))); " of ";
 lonib = byte AND 15
 GOSUB outnextbyte
 GOTO pass2next
END IF

'if [not] bit
IF byte = 15 THEN
 GOSUB thingy
 PRINT #1, "if "; : nocr = 1: ifflag = 1
 eeadr = eeadr + 1: byte = eedata%(eeadr)
 IF byte < 128 THEN PRINT #1, "not ";
 PRINT #1, "bit ";
 bit = byte AND 112  '01110000b
 bit = INT(bit / 16) 'reduce to 0-7
 PRINT #1, LTRIM$(RTRIM$(STR$(bit))); " of ";
 lonib = byte AND 15
 GOSUB outnextbyte
 GOTO pass2next
END IF

IF byte = 2 OR byte = 3 THEN 'increment/decrement
 GOSUB thingy
 IF byte = 2 THEN PRINT #1, "increment "; ELSE PRINT #1, "decrement ";
 eeadr = eeadr + 1: byte = eedata%(eeadr)
 IF byte >= variablelocs AND byte < variablelocs + 14 THEN
  PRINT #1, CHR$(byte - variablelocs + 97); " ";
 ELSE '12/29/12 convert to symbol if defined
  a$ = "(" + LTRIM$(RTRIM$(STR$(byte))) + ")"
  FOR i = 1 TO numsymbols
   IF value$(i) = a$ THEN a$ = symbol$(i)
  NEXT i
  PRINT #1, a$; " ";
 END IF
 GOTO pass2next
END IF

outputcodebyte:
'12/29/12 modify for better code output
'new variables/flags...
'codecolumn - track current code line size
'codequote - track if currently quoting ascii

IF codecolumn = 0 THEN
 GOSUB thingy
 IF eeadr MOD 256 = 0 THEN
  'print comment with addresses but only if
  'not at the beginning of an extent
  IF eeadr <> extent%(currentextent, 0) THEN
   PRINT #1, "' ee address ";HEX$(eeadr);"h"
  END IF
 END IF
 PRINT #1, "code ";
END IF

IF codecolumn > 0 AND codequote = 0 THEN
 PRINT #1, ",";
 codecolumn = codecolumn + 1
END IF

IF byte >= 48 AND byte <= 57 GOTO docodequote
IF byte >= 65 AND byte <= 90 GOTO docodequote
IF byte >= 97 AND byte <= 120 GOTO docodequote
IF codequote <> 0 AND byte = 32 GOTO docodequote
GOTO donotquoted

docodequote:
IF codequote = 0 THEN
 PRINT #1, CHR$(34);
 codequote = 1
 codecolumn = codecolumn + 1
END IF
PRINT #1, CHR$(byte);
codecolumn = codecolumn + 1
GOTO docodenext

donotquoted:
IF codequote THEN
 PRINT #1, CHR$(34); ",";
 codequote = 0
 codecolumn = codecolumn + 2
END IF
PRINT #1, RIGHT$("0" + HEX$(byte), 2);"h";
codecolumn = codecolumn + 3

docodenext:
donewline = 0
IF codecolumn > 62 THEN donewline = 1
IF (eeadr + 1) MOD 256 = 0 THEN donewline = 1
IF codequote = 0 AND (eeadr + 1) MOD 16 = 0 THEN donewline = 1
IF donewline THEN
 IF codequote THEN
  PRINT #1, CHR$(34);
  codequote = 0
 END IF
 codecolumn = 0
END IF

pass2next:
eeadr = eeadr + 1
IF eeadr < extent%(currentextent, 1) GOTO pass2loop
IF currentextent < extentnumber THEN
 currentextent = currentextent + 1
 eeadr = extent%(currentextent, 0)
 PRINT #1, ""
 PRINT #1, "address "; HEX$(eeadr); "h ";
 GOTO pass2loop
END IF

PRINT #1,"": CLOSE
bytes = 0
FOR i = 0 to extentnumber
 bytes = bytes + (extent%(i, 1) - extent%(i, 0))
NEXT i

PRINT "Decompiled";bytes;" bytes in";extentnumber + 1;" extent";
IF extentnumber > 0 THEN PRINT "s." ELSE PRINT "."
IF debug3 THEN GOSUB list_outfile 'list the decompiled results
PRINT
GOTO systemexit

thingy:
IF codequote THEN
 PRINT #1, CHR$(34)
 codequote = 0: codecolumn = 0
 RETURN
END IF
IF ifflag THEN ifflag = 0: RETURN
IF eeadr > 0 THEN PRINT #1, ""
codecolumn = 0
RETURN

outnextbyte:
IF lonib < 14 THEN
 PRINT #1, CHR$(ASC("a") + lonib); " ";
ELSE
 IF lonib = 14 THEN
  eeadr = eeadr + 1: byte = eedata%(eeadr)
  a$ = "(" + LTRIM$(RTRIM$(STR$(byte))) + ")"
  'see if it's a symbol and convert
  FOR i = 1 TO numsymbols
   IF value$(i) = a$ THEN a$ = symbol$(i)
  NEXT i
  PRINT #1, a$; " ";
 ELSE
  IF lonib = 15 THEN
   eeadr = eeadr + 1: byte = eedata%(eeadr)
   PRINT #1, LTRIM$(RTRIM$(STR$(byte))); " ";
  END IF
 END IF
END IF
RETURN

' display hex list  12/21/12 handle multiple extents
displayhex:
FOR zz = 0 TO extentnumber
 zzflag = 0
 FOR z = extent%(zz, 0) TO extent%(zz, 1) - 1
  IF z mod 16 = 0 OR zzflag = 0 THEN
   PRINT: PRINT RIGHT$("000" + HEX$(z), 4); ": ";
  END IF
  PRINT RIGHT$("0" + HEX$(eedata%(z)), 2); " ";
  zzflag = 1
 NEXT z
NEXT zz
PRINT: PRINT
RETURN

REM end of hllcomp source