10REM > VList/s 1.12 20REM List BASIC's variables 30REM v1.00 04-Feb-86 JGH: Initial ve rsion, published in Micro User 40REM - only prints bottom byte of array dimensions 50REM v1.10 24-Sep-02 JGH: prints rea ls if integer value 60REM - prints in neater columns 70REM v1.11 19-Jul-04 JGH: Two spaces between columns, colwidth variable 80REM - DIMs not printed correct ly 90REM v1.12 22-Aug-04 JGH: Runs in BA SIC workspace, so works on both sides of Tube 100: 110osasci=&FFE3:oswrch=&FFEE:osnewl=&F FE7:osbyte=&FFF4 120: 130DIM mcode% &300:load%=&500:zp=&70 140link=zp+0:col=zp+2:int=zp+3:flg=zp+ 3:txt=zp+4:exp=zp+7 150colwidth=24 160: 170FOR pass%=0 TO 1 180P%=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><e ndmarker> 350.end 360 EQUB 13:EQUB &FF :½ <cr><endmark er> 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":B RK 430: 440.main 450LDX #0:STX col 460.MainLoop 470JSR Follow:CPX #116:BCC MainLoop 480JMP osnewl 490: 500.ArrayLoop 510LDA #ASC",":JSR oswrch 520.Array 530JSR PrAmper:LDA (link),Y:SEC:SBC #1 :JSR PrHex 540INY:INY:LDA (link),Y:BNE ArrayLoop :½ NB Only prints 8-bit 550STA col:JSR PrClose 560JSR osnewl:JMP LinkNext 570: 580.Follow 590INX:INX 600LDA &480,X:STA link+0 610LDA &481,X 620: 630.FollowChain 640STA link+1 650BEQ ChainEnd :½ terminated with &00xx 660LDA &FF:BMI ChainEnd 670LDY #1:LDA col:BEQ PrVarName :½ first column, jump to print 680.NameLength :½ Count varname length 690INY:LDA (link),Y:BNE NameLength 700TYA:CLC:ADC col:CMP #84-colwidth :½ Would this wrap? 710LDA #32:BCC PrColumn :½ Space if not at end of line 720LDA #0:STA col:LDA #13 :½ Reset column and print NL 730.PrColumn 740JSR osasci 750CMP #32:BNE P%+5:JSR osasci :½ Print two spaces 760.PrVarName 770TXA:LSR A:ADC #ASC"@":JSR oswrch :½ Print first char of varname 780LDY #1 790.NamePrint 800INY:LDA (link),Y:BEQ NamePrinted 810JSR oswrch:JMP NamePrint :½ Print rest of name until &00 820.NamePrinted 830TXA:PHA:LDX #0 :½ Save index, and prepare X 840DEY:LDA (link),Y:INY:INY :½ Get term. char and point to data 850CPY #3:BEQ Real :½ n - real variable 860CMP #ASC"0":BCS Real :½ name - real variable 870CMP #ASC"%":BEQ Integer :½ name% - integer variable 880CMP #ASC"$":BNE P%+5:JMP String :½ name$ - string variable 890INY:CMP #ASC"(":BNE P%+5:JMP Array :½ name[%|$]( - array 900DEY:LDA #ASC"*":JSR oswrch :½ Unknown 910SEC:PHP:JMP RealOverflow 920: 930.Real :½ (link),Y => exp, man 940LDX #5 :½ Five bytes to reorder and copy 950.RealLp1 960LDA (link),Y:STA int-1,X:INY :½ Copy and reverse into store 970DEX:BNE RealLp1 980LDA exp:BEQ PrintInteger 990LDA int+3:PHP:ORA #&80:STA int+3 :½ Save sign and put top bit in 1000.RealLp2 1010LDA exp:CMP #&A0:BCS RealDenormalis ed :½ Loop until denormalised 1020ROR int+3:ROR int+2:ROR int+1:ROR i nt+0 1030BCS RealOverflow :½ Drop out if run out of bits 1040INC exp:BNE RealLp2 1050.RealDenormalised 1060PLP:BPL RealPositive :½ Need to negate if negative 1070LDX #&FC :½ Start at -4 1080.RealNegate :½ Negate negative number 1090LDA #0:SBC int-&FC,X:STA int-&FC,X 1100INX:BMI RealNegate 1110.RealPositive 1120JMP PrintInteger 1130: 1140.Integer :½ (link),Y => int 1150LDA (link),Y:STA int,X:INY :½ Copy into store 1160INX:CPX #4:BNE Integer:INY 1170.PrintInteger :½ Y=name length+5 1180CPY #colwidth-5:BCS PrInt 1190JSR PrSpace 1200INY:BNE PrintInteger 1210.PrInt 1220JSR PrEqual:JSR PrAmper 1230LDX #3 1240.PrIntLp 1250LDA int,X:JSR PrHex 1260DEX:BPL PrIntLp 1270CLC:PHP 1280.RealOverflow 1290TYA:CLC:ADC #4:ADC col:STA col 1300PLP:BCS PadToNext 1310CPY #colwidth-3:BCC LinkNext 1320.PadToNext 1330LDA col:CMP #60:BCC LinkPad 1340LDA #80:STA col:BNE LinkNext 1350.LinkPad 1360JSR PrSpace 1370INC col:LDA col 1380CMP #colwidth*0.5:BEQ LinkNext 1390CMP #colwidth*1.0:BEQ LinkNext 1400CMP #colwidth*1.5:BEQ LinkNext 1410CMP #colwidth*2.0:BEQ LinkNext 1420CMP #colwidth*2.5:BEQ LinkNext 1430CMP #colwidth*3.0:BNE LinkPad 1440: 1450.LinkNext 1460PLA:TAX 1470LDY #1:LDA (link),Y:PHA :½ Get next link high byte 1480DEY:LDA (link),Y:STA link :½ Get next link low byte 1490PLA:JMP FollowChain :½ Jump to follow chain 1500: 1510.String :½ X=0, (link),Y=>data 1520JSR PrEqual:STX flg:STX col :½ Clear quote flag & col 1530LDA (link),Y:STA txt:INY :½ Get pointer to string 1540LDA (link),Y:STA txt+1:INY 1550INY:LDA (link),Y:LDY #0:TAX:BEQ Str ingNull 1560LDA (txt),Y:CMP #32:BCC string`loop 1570CMP #127:BEQ string`loop:LDA #34:JS R oswrch 1580.string`loop 1590LDA (txt),Y:PHA:JSR pr`char:PLA 1600INY:DEX:BNE string`loop 1610CMP #32:BCC string`exit:CMP #127:BE Q string`exit:BNE string`end2 1620.StringNull:JSR PrQuote 1630.string`end2:JSR PrQuote 1640.string`exit:JSR osnewl:JMP LinkNex t 1650: 1660.pr`char:CMP #32:BCS pr`ok 1670.pr`check 1680PHA:TXA:PHA:CPY #0:BEQ pr`check2 1690LDA flg:BEQ pr`check1 1700JSR PrQuote:.pr`check1 1710JSR PrPlus:.pr`check2 1720LDX #0:STX flg:.pr`c`loop 1730LDA pr`table,X:JSR oswrch:INX:CPX # 6:BNE pr`c`loop 1740PLA:TAX:PLA:JSR PrHex:JSR PrClose 1750.pr`ok 1760CMP #127:BEQ pr`check:CPY #0:BEQ pr `ok3 1770PHA:LDA flg:BNE pr`ok2 1780JSR 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 1910PHA:LSR A:LSR A:LSR A 1920LSR A:JSR PrNyb:PLA 1930.PrNyb:AND #15:CMP #10:BCC PrDig 1940ADC #6:.PrDig:ADC #ASC"0" 1950.PrChar 1960JMP oswrch 1970]:NEXT 1980PRINT"*SAVE VList ";÷mcode%;" ";÷O% ;" ";÷exec%;" ";÷load%