FINAL

   10PROCheader("(line)")
   20bline%=P%
   30FORo%=0TO3STEP3
   40P%=bline%
   50[:OPTo%
   60JSRswap%
   70JSRcl%
   80JSRfetch%
   90JSRbbuf%
  100JSRfetch%
  110JSRmuldivmod%
  120JSRrot%
  130JSRadd%
  140JSRblock%
  150JSRadd%
  160JSRcl%
  170JSRfetch%
  180RTS
  190]:NEXTo%
  200PROCheader(".line")
  210dotline%=P%
  220FORo%=0TO3STEP3
  230P%=dotline%
  240[:OPTo%
  250JSRbline%
  260JSRtrail%
  270JSRtype%
  280RTS
  290]:NEXTo%
  300PROCheader("list")
  310list%=P%
  320FORo%=0TO3STEP3
  330P%=list%
  340[:OPTo%
  350JSRdec%
  360JSRcr%
  370JSRdup%
  380JSRscr%
  390JSRstore%
  400JSRdup%
  410JSRslit%
  420EQUB &05
  430EQUS "SCR #"
  440JSRcount%
  450JSRtype%
  460JSRspace%
  470JSRdot%
  480OPT FNliteral(&10)
  490OPT FNliteral(&00)
  500JSRbdo%
  510.lloop
  520JSRcr%
  530JSRa%
  540OPT FNliteral(&03)
  550JSRdotr%
  560JSRspace%
  570JSRa%
  580JSRover%
  590JSRdotline%
  600JSRbloop%
  610BCClloop
  620JSRadrop%
  630JSRadrop%
  640JSRcr%
  650JSRdrop%
  660RTS
  670]:NEXTo%
  680PROCheader("index")
  690index%=P%
  700FORo%=0TO3STEP3
  710P%=index%
  720[:OPTo%
  730JSRoneplus%
  740JSRswap%
  750JSRbdo%
  760.iloop
  770JSRcr%
  780JSRa%
  790OPT FNliteral(&03)
  800JSRdotr%
  810JSRspace%
  820OPT FNliteral(&00)
  830JSRa%
  840JSRdotline%
  850JSRbloop%
  860BCCiloop
  870JSRadrop%
  880JSRadrop%
  890JSRcr%
  900RTS
  910]:NEXTo%
  920PROCheader("load")
  930load%=P%
  940FORo%=0TO3STEP3
  950p%=load%
  960[:OPTo%
  970JSRblk%
  980JSRfetch%
  990JSRtoa%
 1000JSRin%
 1010JSRfetch%
 1020JSRtoa%
 1030OPT FNliteral(&00)
 1040JSRin%
 1050JSRstore%
 1060OPT FNliteral(&8000)
 1070JSRor%
 1080JSRblk%
 1090JSRstore%
 1100JSRinter%
 1110JSRafrom%
 1120JSRin%
 1130JSRstore%
 1140JSRafrom%
 1150JSRblk%
 1160JSRstore%
 1170RTS
 1180]:NEXTo%
 1190PROCheader("-->")
 1200minusgreat%=P%
 1210FORo%=0TO3STEP3
 1220P%=minusgreat%
 1230[:OPTo%
 1240JSRqload%
 1250OPT FNliteral(&00)
 1260JSRin%
 1270JSRstore%
 1280OPT FNliteral(&01)
 1290JSRblk%
 1300JSRplusstore%
 1310RTS
 1320]:NEXTo%
 1330PROCsetbit(6,last%)
 1340PROCheader("openin")
 1350openin%=P%
 1360FORo%=0TO3STEP3
 1370P%=openin%
 1380[:OPTo%
 1390OPT FNliteral(&40)
 1400JSRbopen%
 1410RTS
 1420]:NEXTo%
 1430PROCheader("openout")
 1440openout%=P%
 1450FORo%=0TO3STEP3
 1460P%=openout%
 1470[:OPTo%
 1480OPT FNliteral(&80)
 1490JSRbopen%
 1500RTS
 1510]:NEXTo%
 1520PROCheader("openup")
 1530openup%=P%
 1540FORo%=0TO3STEP3
 1550P%=openup%
 1560[:OPTo%
 1570OPT FNliteral(&C0)
 1580JSRbopen%
 1590RTS
 1600]:NEXTo%
 1610PROCheader("using")
 1620using%=P%
 1630FORo%=0TO3STEP3
 1640P%=using%
 1650[:OPTo%
 1660JSRhere%
 1670JSRbl%
 1680JSRword%
 1690JSRopenup%
 1700JSRdup%
 1710JSRzeroequal%
 1720OPT FNliteral(efound%)
 1730JSRqerror%
 1740JSRchannel%
 1750JSRdup%
 1760JSRfetch%
 1770JSRbranch%
 1780BEQnochannel
 1790JSRdup%
 1800JSRfetch%
 1810JSRclose%
 1820JSRempty%
 1830.nochannel
 1840JSRstore%
 1850RTS
 1860]:NEXTo%
 1870PROCheader("discard")
 1880discard%=P%
 1890FORo%=0TO3STEP3
 1900P%=discard%
 1910[:OPTo%
 1920JSRflush%
 1930JSRchannel%
 1940JSRfetch%
 1950JSRclose%
 1960OPT FNliteral(&00)
 1970JSRchannel%
 1980JSRstore%
 1990JSRempty%
 2000RTS
 2010]:NEXTo%
 2020PROCheader("abort")
 2030abort%=P%
 2040FORo%=0TO3STEP3
 2050P%=abort%
 2060[:OPTo%
 2070JSRspstore%
 2080JSRapstore%
 2090JSRdec%
 2100JSRslit%
 2110EQUB &22
 2120EQUS "Generic Subroutine-Threaded FORTH."
 2130JSRcount%
 2140JSRtype%
 2150JSRcr%
 2160JSRslit%
 2170EQUB &1D
 2180EQUS "BBC Model 'B' Implementation."
 2190JSRcount%
 2200JSRtype%
 2210JSRcr%
 2220JSRslit%
 2230EQUB &0C
 2240EQUS "Version 1.06"
 2250JSRcount%
 2260JSRtype%
 2270JSRcr%
 2280JSRempty%
 2290JMPquit%
 2300]:NEXTo%
 2310syserr%=P%
 2320FORo%=0TO3STEP3
 2330P%=syserr%
 2340[:OPTo%
 2350LDX#stkbot%
 2360DEX:DEX
 2370STAstk%+1,X
 2380LDA#&00
 2390STAstk%+2,X
 2400LDA#astkbot%
 2410STAasp%
 2420JSRmess%
 2430JSRquit%
 2440]:NEXTo%
 2450brkerr%=P%
 2460FORo%=0TO3STEP3
 2470P%=brkerr%
 2480[:OPTo%
 2490LDX#stkbot%
 2500LDA#astkbot%
 2510STAasp%
 2520DEX:DEX
 2530LDA#&00
 2540STAstk%+1,X
 2550STAstk%+2,X
 2560JSRsmess%
 2570JSRcount%
 2580JSRtype%
 2590JSRspace%
 2600DEX:DEX
 2610LDY#&00
 2620LDA(&FD),Y
 2630STAstk%+1,X
 2640TYA
 2650STAstk%+2,X
 2660JSRdot%
 2670INC&FD
 2680BNEbrktxt
 2690INC&FE
 2700.brktxt
 2710LDA#&22
 2720JSR&FFEE
 2730LDY#&00
 2740.brkloop
 2750LDA(&FD),Y
 2760BEQbrkexit
 2770JSR&FFEE
 2780INY
 2790BNEbrkloop
 2800.brkexit
 2810LDA#&22
 2820JSR&FFEE
 2830JSRquit%
 2840]:NEXTo%
 2850PROCheader("warm")
 2860warm%=P%
 2870FORo%=0TO3STEP3
 2880P%=warm%
 2890[:OPTo%
 2900LDY#uvcurrent%
 2910LDAorigin%+uvccurrent%
 2920STA(up%),Y
 2930INY
 2940LDAorigin%+uvccurrent%+1
 2950STA(up%),Y
 2960LDY#uvcontext%
 2970LDAorigin%+uvccontext%
 2980STA(up%),Y
 2990INY
 3000LDAorigin%+uvccontext%+1
 3010STA(up%),Y
 3020JMPabort%
 3030]:NEXTo%
 3040PROCheader("cold")
 3050cold%=P%
 3060FORo%=0TO3STEP3
 3070P%=cold%
 3080[:OPTo%
 3090LDA#origin% MOD 256
 3100STAup%
 3110LDA#origin% DIV 256
 3120STAup%+1
 3130LDAorigin%+uvcdp%
 3140STAorigin%+uvdp%
 3150LDAorigin%+uvcdp%+1
 3160STAorigin%+uvdp%+1
 3170LDAorigin%+uvccurrent%
 3180STAorigin%+uvcurrent%
 3190STAsc%
 3200LDAorigin%+uvccurrent%+1
 3210STAorigin%+uvcurrent%+1
 3220STAsc%+1
 3230LDAorigin%+uvccontext%
 3240STAorigin%+uvcontext%
 3250LDAorigin%+uvccontext%+1
 3260STAorigin%+uvcontext%+1
 3270LDAorigin%+uvcvoclink%
 3280STAorigin%+uvvoclink%
 3290LDAorigin%+uvcvoclink%+1
 3300STAorigin%+uvvoclink%+1
 3310LDY#&00
 3320LDAorigin%+uvclast%
 3330STA(sc%),Y
 3340INY
 3350LDAorigin%+uvclast%+1
 3360STA(sc%),Y
 3370LDA#syserr% MOD 256
 3380STAsvct%
 3390LDA#syserr% DIV 256
 3400STAsvct%+1
 3410LDA#brkerr% MOD 256
 3420STA&202
 3430LDA#brkerr% DIV 256
 3440STA&203
 3450JMPabort%
 3460]:NEXTo%
 3470PROCpoke(qerror%,(epatch+1))
 3480PROCpoke(qerror%,(apatch+1))
 3490PROCpoke(block%,(bpatch+1))
 3500PROCpoke(P%,origin%+uvcdp%)
 3510PROCpoke(fbody,origin%+uvccurrent%)
 3520PROCpoke(fbody,origin%+uvccontext%)
 3530PROCpoke(vbody,origin%+uvcvoclink%)
 3540PROCpoke(last%,origin%+uvclast%)
 3550PRINT:PRINT
 3560PRINT"  ***"
 3570PRINT"  *** Dictionary map complete."
 3580PRINT"  ***"
 3590PRINT"  *** Base address    : "; ~origin% ; "."
 3595PRINT"  *** Final address  : ";~P%
 3596PRINT"  *** Cold address   : ";~cold%
 3600PRINT"  *** Size of map     : "; ~( P%-origin%);" bytes."
 3610PRINT"  *** Labels defined  : "; label% ;"."
 3620PRINT"  ***"
 3630END
 3640DEFPROCheader(name$)
 3650PRINT:PRINT
 3660PRINT"  *** ";~P%;" nfa '";name$;"'"
 3670LETxhere%=P%
 3680LETspan%=LEN(name$)
 3690?P%=span%
 3700PROCsetbit(7,P%)
 3710LETP%=P%+1
 3720IFspan% > length%THENspan%=length%
 3730FORi%=1TOspan%
 3740?P%=ASC(MID$(name$,i%,1))
 3750LETP%=P%+1
 3760NEXTi%
 3770PRINT"  *** ";~P%;" lfa (";~last%;")"
 3780PROCsetbit(7,P%-1)
 3790PROCpoke(last%,P%)
 3800LETP%=P%+2
 3810LETlast%=xhere%
 3820LETlabel%=label%+1
 3830PRINT:PRINT
 3840ENDPROC
 3850DEFPROCsetbit(bit%,addr%)
 3860?addr%=?addr%OR(2^bit%)
 3870ENDPROC
 3880DEFPROCpoke(val%,addr%)
 3890?addr%=val%MOD256
 3900?(addr%+1)=val%DIV256
 3910ENDPROC
 3920DEFFNliteral(value%):[:OPTo%:JSRlit%:]:PROCpoke(value%,P%):P%=P%+2:=o%