User:Eriksiers/BBC BASIC detokenizer/Generator

This code uses data contained in an Excel spreadsheet to generate the QBasic code on the main detokenizer page. (I'm not including the actual data, but it can be easily reconstructed from the QBasic code.)

Licensing

All source code on this page is Copyright ©2012 Erik Siers. (This specifically includes everything generated by this VBA/Excel code!) The sources are dual-licensed under the terms of the following licenses:

• The GNU General Public License (GNU GPL) v2 or, at your option, any later version.
• The GNU Free Documentation License (GNU FDL) v1.2 or, at your option, any later version.

The two licenses are not 100% compatible; which license you use, I leave up to you.

Exception

Any source code that is generated by the generated QBasic program (only) is specifically excluded from the above licensing terms, and is instead covered by whatever license(s) cover the original, tokenized sources.

create_detoken.bas

<lang vb>Sub buildBas()

   Open ActiveWorkbook.Path & "\detoken.bas" For Output As 1
       For L0 = 2 To Cells.SpecialCells(xlCellTypeLastCell).Row
           If Len(Cells(L0, 2).Value) Then
               tmp = tmp + 1
               If (tmp Mod 10) = 1 Then Print #1, "DATA ";
               Print #1, LTrim$(Val("&h" & Cells(L0, 1).Value)); ","; Cells(L0, 2).Value; "";
               If (tmp Mod 10) = 0 Then
                   Print #1,
               Else
                   Print #1, ",";
               End If
           End If
       Next
       Print #1, "0": Print #1,
       Print #1, "DIM lineNum AS LONG, encoded AS STRING * 1"
       Print #1, "DIM tmp AS LONG, lineNumDec AS LONG"
       Print #1, "DIM keywords(255) AS STRING"
       Print #1, "DO"
       Print #1, "    READ t%"
       Print #1, "    IF 0 = t% THEN EXIT DO"
       Print #1, "    READ keywords(t%)"
       Print #1, "LOOP"
       Print #1, "nm$ = ENVIRON$(""DETOKEN"")"
       Print #1, "OPEN nm$ + "".bbc"" FOR BINARY AS 2"
       Print #1, "OPEN nm$ + "".bas"" FOR OUTPUT AS 3"
       Print #1, "'skip first char"
       Print #1, "GET #2, , encoded"
       Print #1, "GET #2, , lineNum"
       Print #1, "SEEK #2, SEEK(2) - 2"
       Print #1, "lineNum = (lineNum AND &HFFFF&)"
       Print #1, "IF (CHR$(0) = encoded) AND (&HFFFF& = lineNum) THEN"
       Print #1, "    CLOSE : SYSTEM"
       Print #1, "ELSEIF lineNum <> 0 THEN"
       Print #1, "    PRINT #3, LTRIM$(STR$(lineNum)); "" "";"
       Print #1, "END IF"
       'still haven't figured out the first char...
       'Print #1, "PRINT #3, ASC(encoded); CHR$(9);"
       Print #1, "DO UNTIL EOF(2)"
       Print #1, "    GET #2, , encoded"
       Print #1, "    i% = ASC(encoded)"
       Print #1, "    SELECT CASE i%"
       Print #1, "        CASE 0"
       Print #1, "            'do nothing"
       Print #1, "        CASE 13"
       Print #1, "            PRINT #3,"
       Print #1, "            'skip first char of next line"
       Print #1, "            IF NOT EOF(2) THEN"
       Print #1, "                GET #2, , encoded"
       Print #1, "                GET #2, , lineNum"
       Print #1, "                SEEK #2, SEEK(2) - 2"
       Print #1, "                lineNum = (lineNum AND &HFFFF&)"
       Print #1, "                IF (CHR$(0) = encoded) AND (&HFFFF& = lineNum) THEN"
       Print #1, "                    CLOSE : SYSTEM"
       Print #1, "                ELSEIF lineNum <> 0 THEN"
       Print #1, "                    PRINT #3, LTRIM$(STR$(lineNum)); "" "";"
       Print #1, "                END IF"
       Print #1, "            END IF"
       Print #1, "        CASE &H8D"
       Print #1, "            'deal with encoded line numbers (GOTO targets)"
       Print #1, "            IF NOT EOF(2) THEN"
       Print #1, "                GET #2, , encoded"
       Print #1, "                IF NOT EOF(2) THEN"
       Print #1, "                    GET #2, , lineNum"
       Print #1, "                    SEEK #2, SEEK(2) - 2"
       Print #1, "                    lineNum = (lineNum AND &HFFFF&)"
       Print #1, "                ELSE"
       Print #1, "                    'should NEVER get here"
       Print #1, "                    lineNum = 0"
       Print #1, "                END IF"
       Print #1, "                lo& = ((ASC(encoded) * 4&) AND &HC0) XOR (lineNum AND 255&)           'LEFT SHIFT ASC(encoded), 2"
       Print #1, "                hi& = ((ASC(encoded) * 16&) AND &HC0) XOR ((lineNum \ 256&) AND 255&) 'LEFT SHIFT ASC(encoded), 4"
       Print #1, "                tmp = lo& + (hi& * 256&)"
       Print #1, "                PRINT #3, LTRIM$(RTRIM$(STR$(tmp)));"
       Print #1, "            END IF"
       Print #1, "        CASE ELSE"
       Print #1, "            IF keywords(i%) <> """" THEN"
       Print #1, "                PRINT #3, keywords(i%);"
       Print #1, "            ELSE"
       Print #1, "                PRINT #3, encoded;"
       Print #1, "            END IF"
       Print #1, "    END SELECT"
       Print #1, "LOOP"
       Print #1, "CLOSE"
       Print #1, "SYSTEM"
   Close

End Sub</lang>