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