10REM Program to show the current status in BASIC
   20REM From The Master ROM (C) John Robinson 1988
   30REM (C) John Robinson 1988
   40:
   50DIM code &400
   60origin$="FFFF0900"
   70oswrch=&FFEE
   80osnewl=&FFE7
   90osargs=&FFDA
  100gsinit=&FFC2
  110osrdrm=&FFB9
  120from=&A8
  130to=&AA
  140:
  150FOR pass=4 TO 7 STEP 3
  160P%=EVAL("&"+origin$)
  170O%=code
  180[OPT pass
  190
  200LDA #1
  210LDX #&A8
  220LDY #0
  230JSR osargs
  240LDY &A9
  250LDX &A8
  260STY &F3
  270STX &F2
  280LDY #0
  290CLC
  300JSR gsinit
  310BEQ nothing
  320BRK
  330EQUB 254
  340EQUS "Syntax: *BSTATUS"
  350EQUB 0
  360.nothing
  370LDA &28C
  380CMP &24B        \ BASIC rom slot number
  390BEQ yup_BASIC_rom
  400BRK
  410EQUB 254
  420EQUS "Not in BASIC"
  430EQUB 0
  440.yup_BASIC_rom
  450JSR mprint
  460EQUS "This is BASIC "
  470EQUB 0
  480LDA #&80
  490STA &F7
  500LDX #&15
  510STX &F6
  520LDY &24B
  530JSR osrdrm
  540ORA #&30
  550AND #&7F
  560JSR oswrch
  570LDA #ASC "."
  580JSR oswrch
  590.printenable
  600JSR osnewl
  610JSR showenable
  620JSR mprint
  630EQUS "PAGE =&"
  640EQUB 0
  650LDA #0
  660STA from+1
  670LDA #&18
  680JSR heebeegeebee
  690JSR mprint
  700EQUS "00           TOP  =&"
  710EQUB 0
  720LDA #&13
  730JSR heebeegeebee
  740LDA #&12
  750JSR heebeegeebee
  760JSR mprint
  770EQUB 1
  780EQUS "LOMEM=&"
  790EQUB 0
  800LDA #&01
  810JSR heebeegeebee
  820LDA #&00
  830JSR heebeegeebee
  840JSR mprint
  850EQUS "           HIMEM=&"
  860EQUB 0
  870LDA #&07
  880JSR heebeegeebee
  890LDA #&06
  900JSR heebeegeebee
  910JSR mprint
  920EQUB 1
  930EQUS "First free memory location: &"
  940EQUB 0
  950LDA #&03
  960JSR heebeegeebee
  970LDA #&02
  980JSR heebeegeebee
  990JSR mprint
 1000EQUB 1
 1010EQUS "Bottom of BASIC stack:      &"
 1020EQUB 0
 1030LDA #5
 1040JSR heebeegeebee
 1050LDA #4
 1060JSR heebeegeebee
 1070JSR mprint
 1080EQUW &D0A
 1090EQUS "@%=&"
 1100EQUB 0
 1110LDY #4
 1120STY from+1
 1130LDX #3
 1140.beegees
 1150TXA
 1160JSR heebeegeebee
 1170DEX
 1180BPL beegees
 1190JSR osnewl
 1200RTS
 1210
 1220.heebeegeebee
 1230STA from
 1240TXA
 1250PHA
 1260TYA
 1270PHA
 1280JSR gengetbyte
 1290JSR hex_byte_out
 1300PLA
 1310TAY
 1320PLA
 1330TAX
 1340LDA from
 1350RTS
 1360 
 1370.showenable
 1380LDX &24B
 1390LDA &2A1,X
 1400BEQ not_enabled
 1410LDY #&80
 1420LDX #6
 1430STY &F7
 1440STX &F6
 1450LDY &24B
 1460JSR osrdrm
 1470LDX &24B
 1480CMP &2A1,X
 1490BEQ enabled
 1500JSR mprint
 1510EQUS "It is not properly enabled."
 1520EQUW &D0A:EQUB 0
 1530SEC
 1540RTS
 1550.not_enabled
 1560JSR mprint
 1570EQUS "It is currently disabled."
 1580EQUW &D0A:EQUB 0
 1590SEC
 1600RTS
 1610.enabled
 1620JSR mprint
 1630EQUS "It is enabled."
 1640EQUW &D0A:EQUB 0
 1650CLC
 1660RTS
 1670
 1680.mprint
 1690PLA
 1700STA &E8           \ OSWORD 0 workspace. This routine will NEVER be called
 1710PLA               \ during an OSWORD 0 call (input line of text from
 1720STA &E8+1         \ current input stream). This ROM does not redirect
 1730TXA               \ OSWORD so this CANNOT be called during ... call.
 1740PHA
 1750TYA
 1760PHA
 1770LDY #0
 1780INC &E8
 1790BNE mprint_it
 1800INC &E8+1
 1810.mprint_it
 1820LDA (&E8),Y
 1830BEQ mpdone
 1840CMP #1            \ Special code for "tab to 40 characters or new line"
 1850BEQ tab40         \ To save space and make stuff more readable in 80 cols
 1860CMP #2
 1870BEQ tab23
 1880JSR oswrch
 1890.nextmprintchar
 1900INC &E8
 1910BNE mprint_it
 1920INC &E8+1
 1930JMP mprint_it
 1940.mpdone
 1950PLA
 1960TAY
 1970PLA
 1980TAX
 1990LDA &E8+1
 2000PHA
 2010LDA &E8
 2020PHA
 2030RTS
 2040
 2050.tab40
 2060LDA #0
 2070BEQ gofortab
 2080.tab23
 2090LDA #23
 2100.gofortab
 2110JSR tabacrossscr
 2120JMP nextmprintchar
 2130
 2140.tab12
 2150LDA #12
 2160.tabacrossscr
 2170STA tabpos
 2180LDA &30A
 2190SEC
 2200SBC &308
 2210CMP tabpos
 2220BCC newline_byebye
 2230LDA #40
 2240SEC
 2250SBC tabpos
 2260STA tabpos
 2270LDA &30A
 2280SEC
 2290SBC &318
 2300CMP tabpos
 2310BCC newline_byebye
 2320.acrosswindow
 2330LDA #&20
 2340JSR oswrch
 2350LDA &318
 2360SEC
 2370SBC &308
 2380.sub40
 2390SBC #40
 2400BCS sub40
 2410ADC tabpos
 2420BNE acrosswindow
 2430RTS
 2440.newline_byebye
 2450JMP osnewl
 2460.temp_wkspc
 2470EQUB 0
 2480.tabpos
 2490EQUB 0
 2500
 2510.hex_dig_out
 2520CLC
 2530ADC #&30
 2540CMP #&3A
 2550BMI print
 2560CLC
 2570ADC #7
 2580.print
 2590JSR oswrch
 2600RTS
 2610 
 2620.hex_byte_out
 2630PHA
 2640LSR A
 2650LSR A
 2660LSR A
 2670LSR A
 2680JSR hex_dig_out
 2690PLA
 2700AND #&F
 2710JSR hex_dig_out
 2720RTS
 2730
 2740.gengetbyte
 2750LDY from+1
 2760LDX from
 2770LDA tubeflag             \ This byte should contain &FF to read from the
 2780BPL ioproc               \ tube (if present) or the ROM number to read.
 2790LDA &27A                 \ Tube present flag
 2800CMP #&FF
 2810BEQ tubegetbyte
 2820LDA &28C        \ Current language
 2830STA tubeflag
 2840.ioproc
 2850STY &F7
 2860STX &F6
 2870LDY tubeflag
 2880JSR osrdrm
 2890RTS
 2900
 2910]
 2920tube=&406
 2930identi=ASC("J") AND &1F
 2940tr3status=&FEE4
 2950tr3data  =&FEE5
 2960zp=&2EE            :REM No space left in zero-page, so...
 2970[OPT pass
 2980
 2990\ Tube get byte routine.     X,Y point to byte to be read
 3000
 3010.tubegetbyte
 3020PHP
 3030STY zp+1
 3040STX zp
 3050JSR claim_tube
 3060LDY #zp DIV 256
 3070LDX #zp MOD 256
 3080LDA #0
 3090STA zp+2
 3100STA zp+3
 3110SEI               \ No interrupts
 3120JSR tube
 3130LDA #0
 3140.zz1
 3150BIT tr3status
 3160BPL zz1
 3170LDA tr3data
 3180PHA
 3190JSR release_tube
 3200PLA
 3210PLP
 3220RTS
 3230
 3240.claim_tube
 3250LDA #(identi OR &C0)
 3260JSR tube
 3270BCC claim_tube
 3280RTS
 3290
 3300.release_tube
 3310LDA #(identi OR &80)
 3320JSR tube
 3330RTS
 3340
 3350.tubeflag
 3360EQUB &FF
 3370
 3380]
 3390NEXT pass
 3400:
 3410save$="*SAVE BStatus "+STR$~code+" "+STR$~O%+" "+origin$+" "+origin$
 3420PRINT save$;" ? (Y/N) ";
 3430IF (GET OR &20)=ASC "y" THEN PRINT "Yes":OSCLI save$:PRINT "OK" ELSE PRINT "No"
 3440: