10 REM > VList/s 1.12
   20 REM List BASIC's variables
   30 REM v1.00 04-Feb-86 Initial version, published in Micro User.
   40 REM                 Only prints bottom byte of array dimensions.
   50 REM v1.10 24-Sep-02 Prints reals if integer value, neater columns.
   60 REM v1.11 19-Jul-04 Two spaces between columns, colwidth variable,
   70 REM                 DIMs not printed correctly.
   80 REM v1.12 22-Aug-04 Runs in BASIC workspace, so works both sides of Tube.
   90 REM                 Control chars and DIMs printed correctly
  100 :
  110 osasci=&FFE3:oswrch=&FFEE:osnewl=&FFE7:osbyte=&FFF4
  120 :
  130 DIM mcode% &300:load%=&500:zp=&A8
  140 link=zp+0:col=zp+2:int=zp+3:flg=zp+3:txt=zp+4:exp=zp+7
  150 colwidth=24
  160 :
  170 FOR pass%=0 TO 1
  180   P%=load%:O%=mcode%
  190   [OPT pass%*2+4
  200   .exec%
  210    JMP start:BRK:BRK:BRK    \ Header identifies
  220    EQUB &62:EQUB copy-exec% \ this as 6502 code
  230    EQUB &12:EQUS "VList"
  240    EQUB &00:EQUS "1.12 (22 Aug 2004)"
  250   .copy
  260    EQUB 0:EQUS"(C)J.G.Harston":EQUB 0
  270    EQUD load%
  280   :
  290   .start
  300    TSX:LDY &102,X:INY:CPY #&F9:BCC NoTube
  310    LDA &103,X:STA &EE:STA &F2   :\ Restore caller's environment
  320    LDA &104,X:STA &EF:STA &F3
  330   .NoTube
  340    LDA #187                     :\ Check BASIC is current language
  350   .ChkBasic
  360    STX zp:LDX #0:LDY #255:JSR osbyte
  370    EOR #71:CMP #187:BNE ChkBasic
  380    TXA:EOR zp:AND #63:BNE errBasic
  390    JSR main
  400    LDA #end AND 255:STA &0B
  410    LDA #end DIV 256:STA &0C
  420    LDA #0:STA &0A     :\ ptra=><cr><endmarker>
  430   .ChainEnd
  440    RTS
  450   .end
  460    EQUB 13:EQUB &FF   :\ <cr><endmarker>
  470   .errBasic
  480    BRK:EQUB 249:EQUS "Not in BASIC":BRK
  490   :
  500   .main
  510   LDX #0:STX col
  520   .MainLoop
  530   JSR Follow:CPX #116:BCC MainLoop
  540   JMP osnewl
  550   :
  560   .Array
  570   LDA (link),Y:LSR A:STA flg:BNE ArrayNext :\ Number of dimensions
  580   .ArrayLoop
  590   LDA #ASC",":JSR oswrch
  600   .ArrayNext
  610   JSR PrAmper:INY:LDA (link),Y:SEC:SBC #1:PHA
  620   INY:LDA (link),Y:SBC #0:JSR PrHex:PLA:JSR PrHex
  630   DEC flg:BNE ArrayLoop
  640   LDA #0:STA col:JSR PrClose
  650   JSR osnewl:JMP LinkNext
  660   :
  670   .Follow
  680   INX:INX
  690   LDA &480,X:STA link+0
  700   LDA &481,X
  710   :
  720   .FollowChain
  730   STA link+1
  740   BEQ ChainEnd                          :\ terminated with &00xx
  750   LDA &FF:BMI ChainEnd
  760   LDY #1:LDA col:BEQ PrVarName          :\ first column, jump to print
  770   .NameLength                           :\ Count varname length
  780   INY:LDA (link),Y:BNE NameLength
  790   TYA:CLC:ADC col:CMP #84-colwidth      :\ Would this wrap?
  800   LDA #32:BCC PrColumn                  :\ Space if not at end of line
  810   LDA #0:STA col:LDA #13                :\ Reset column and print NL
  820   .PrColumn
  830   JSR osasci
  840   CMP #32:BNE P%+5:JSR osasci           :\ Print two spaces
  850   .PrVarName
  860   TXA:LSR A:ADC #ASC"@":JSR oswrch      :\ Print first char of varname
  870   LDY #1
  880   .NamePrint
  890   INY:LDA (link),Y:BEQ NamePrinted
  900   JSR oswrch:JMP NamePrint              :\ Print rest of name until &00
  910   .NamePrinted
  920   TXA:PHA:LDX #0                        :\ Save index, and prepare X
  930   DEY:LDA (link),Y:INY:INY              :\ Get term. char and point to data
  940   CPY #3:BEQ Real                       :\ n     - real variable
  950   CMP #ASC"0":BCS Real                  :\ name  - real variable
  960   CMP #ASC"%":BEQ Integer               :\ name% - integer variable
  970   CMP #ASC"$":BNE P%+5:JMP String       :\ name$ - string variable
  980   CMP #ASC"(":BNE P%+5:JMP Array        :\ name[%|$]( - array
  990   LDA #ASC"*":JSR oswrch                :\ Unknown
 1000   SEC:PHP:JMP RealOverflow
 1010   :
 1020   .Real                                 :\ (link),Y => exp, man
 1030   LDX #5                                :\ Five bytes to reorder and copy
 1040   .RealLp1
 1050   LDA (link),Y:STA int-1,X:INY          :\ Copy and reverse into store
 1060   DEX:BNE RealLp1
 1070   LDA exp:BEQ PrintInteger
 1080   LDA int+3:PHP:ORA #&80:STA int+3      :\ Save sign and put top bit in
 1090   .RealLp2
 1100   LDA exp:CMP #&A0:BCS RealDenormalised :\ Loop until denormalised
 1110   ROR int+3:ROR int+2:ROR int+1:ROR int+0
 1120   BCS RealOverflow                      :\ Drop out if run out of bits
 1130   INC exp:BNE RealLp2
 1140   .RealDenormalised
 1150   PLP:BPL RealPositive                  :\ Need to negate if negative
 1160   LDX #&FC                              :\ Start at -4
 1170   .RealNegate                           :\ Negate negative number
 1180   LDA #0:SBC int-&FC,X:STA int-&FC,X
 1190   INX:BMI RealNegate
 1200   .RealPositive
 1210   JMP PrintInteger
 1220   :
 1230   .Integer                              :\ (link),Y => int
 1240   LDA (link),Y:STA int,X:INY            :\ Copy into store
 1250   INX:CPX #4:BNE Integer:INY
 1260   .PrintInteger                         :\ Y=name length+5
 1270   CPY #colwidth-5:BCS PrInt
 1280   JSR PrSpace
 1290   INY:BNE PrintInteger
 1300   .PrInt
 1310   JSR PrEqual:JSR PrAmper
 1320   LDX #3
 1330   .PrIntLp
 1340   LDA int,X:JSR PrHex
 1350   DEX:BPL PrIntLp
 1360   CLC:PHP
 1370   .RealOverflow
 1380   TYA:CLC:ADC #4:ADC col:STA col
 1390   PLP:BCS PadToNext
 1400   CPY #colwidth-3:BCC LinkNext
 1410   .PadToNext
 1420   LDA col:CMP #60:BCC LinkPad
 1430   LDA #80:STA col:BNE LinkNext
 1440   .LinkPad
 1450   JSR PrSpace
 1460   INC col:LDA col
 1470   CMP #colwidth*0.5:BEQ LinkNext
 1480   CMP #colwidth*1.0:BEQ LinkNext
 1490   CMP #colwidth*1.5:BEQ LinkNext
 1500   CMP #colwidth*2.0:BEQ LinkNext
 1510   CMP #colwidth*2.5:BEQ LinkNext
 1520   CMP #colwidth*3.0:BNE LinkPad
 1530   :
 1540   .LinkNext
 1550   PLA:TAX
 1560   LDY #1:LDA (link),Y:PHA               :\ Get next link high byte
 1570   DEY:LDA (link),Y:STA link             :\ Get next link low byte
 1580   PLA:JMP FollowChain                   :\ Jump to follow chain
 1590   :
 1600   .String                               :\ X=0, (link),Y=>data
 1610   JSR PrEqual:STX flg:STX col           :\ Clear quote flag & col
 1620   LDA (link),Y:STA txt+0:INY            :\ Get pointer to string
 1630   LDA (link),Y:STA txt+1:INY
 1640   INY:LDA (link),Y:LDY #0:TAX:BEQ string_null
 1650   .string_loop
 1660   LDA (txt),Y:JSR pr_char
 1670   INY:DEX:BNE string_loop
 1680   LDA flg:BMI string_end2:BPL string_exit
 1690   .string_null:JSR PrQuote
 1700   .string_end2:JSR PrQuote
 1710   .string_exit:JSR osnewl:JMP LinkNext
 1720   :
 1730   .pr_char
 1740   CMP #32:BCC pr_check:CMP #127:BCC pr_ok :\ 32-126 print as char
 1750   .pr_check
 1760   PHA:BIT flg:BPL pr_noquote:JSR PrQuote  :\ Closing quote
 1770   .pr_noquote
 1780   LDA flg:BEQ no_plus1:JSR PrPlus         :\ plus between CHR$
 1790   .no_plus1
 1800   TXA:PHA:LDX #0
 1810   .pr_chrlp
 1820   LDA pr_table,X:JSR oswrch:INX:CPX #5:BNE pr_chrlp
 1830   PLA:TAX:PLA:PHA:JSR PrHex               :\ CHR$&nn
 1840   LDA #64:STA flg:PLA:RTS
 1850   :
 1860   .pr_ok
 1870   BIT flg:BMI no_quote:PHA                :\ Already have opening quote
 1880   BVC no_plus2:JSR PrPlus                 :\ Print + prefix
 1890   .no_plus2
 1900   JSR PrQuote:LDA #128:STA flg:PLA        :\ Print opening quote
 1910   .no_quote
 1920   JMP oswrch
 1930   :
 1940   .pr_table:EQUS "CHR$&"
 1950   :
 1960   .PrSpace:LDA #ASC" ":BNE PrChar
 1970   .PrEqual:LDA #ASC"=":BNE PrChar
 1980   .PrAmper:LDA #ASC"&":BNE PrChar
 1990   .PrQuote:LDA #34:BNE PrChar
 2000   .PrClose:LDA #ASC")":BNE PrChar
 2010   .PrPlus :LDA #ASC"+":BNE PrChar
 2020   :
 2030   .PrHex
 2040   PHA:LSR A:LSR A:LSR A
 2050   LSR A:JSR PrNyb:PLA
 2060   .PrNyb:AND #15:CMP #10:BCC PrDig
 2070   ADC #6:.PrDig:ADC #ASC"0"
 2080   .PrChar
 2090   JMP oswrch
 2100 ]:NEXT
 2110 A$="*Save VList "+STR$~mcode%+" "+STR$~O%+" "+STR$~exec%+" "+STR$~load%
 2120 PRINT"Saving: "A$;:OSCLIA$:PRINT

Download VList.s

BBC BASIC detokeniser and syntax highlighter by Ben Ryves.