> VList/s 1.12  List BASIC's variables ? v1.00 04-Feb-86 Initial version, published in Micro User. (B Only prints bottom byte of array dimensions. 2D v1.10 24-Sep-02 Prints reals if integer value, neater columns. Control chars and DIMs printed correctly d: n7osasci=&FFE3:oswrch=&FFEE:osnewl=&FFE7:osbyte=&FFF4 x: # mcode% &300:load%=&500:zp=&A8 :link=zp+0:col=zp+2:int=zp+3:flg=zp+3:txt=zp+4:exp=zp+7 colwidth=24 :  pass%=0 1 P%=load%:O%=mcode% [OPT pass%*2+4 .exec% 1 JMP start:BRK:BRK:BRK \ Header identifies 1 EQUB &62:EQUB copy-exec% \ this as 6502 code  EQUB &12:EQUS "VList" ' EQUB &00:EQUS "1.12 (22 Aug 2004)" .copy ' EQUB 0:EQUS"(C)J.G.Harston":EQUB 0  EQUD load% : " .start ,+ TSX:LDY &102,X:INY:CPY #&F9:BCC NoTube 6A LDA &103,X:STA &EE:STA &F2 :\ Restore caller's environment @ LDA &104,X:STA &EF:STA &F3 J .NoTube TD LDA #187 :\ Check BASIC is current language ^ .ChkBasic h& STX zp:LDX #0:LDY #255:JSR osbyte r #71:CMP #187:BNE ChkBasic | TXA: zp: #63:BNE errBasic  JSR main  LDA #end 255:STA &0B  LDA #end 256:STA &0C 0 LDA #0:STA &0A :\ ptra=>  .ChainEnd  RTS .end * EQUB 13:EQUB &FF :\  .errBasic ) BRK:EQUB 249:EQUS "Not in BASIC":BRK :  .main LDX #0:STX col  .MainLoop $JSR Follow:CPX #116:BCC MainLoop JMP osnewl &: 0 .Array :DLDA (link),Y:LSR A:STA flg:BNE ArrayNext :\ Number of dimensions D.ArrayLoop NLDA #",":JSR oswrch X.ArrayNext b/JSR PrAmper:INY:LDA (link),Y:SEC:SBC #1:PHA l3INY:LDA (link),Y:SBC #0:JSR PrHex:PLA:JSR PrHex vDEC flg:BNE ArrayLoop LDA #0:STA col:JSR PrClose JSR osnewl:JMP LinkNext :  .Follow  INX:INX LDA &480,X:STA link+0 LDA &481,X : .FollowChain STA link+1 BBEQ ChainEnd :\ terminated with &00xx LDA &FF:BMI ChainEnd HLDY #1:LDA col:BEQ PrVarName :\ first column, jump to print A.NameLength :\ Count varname length  #INY:LDA (link),Y:BNE NameLength =TYA:CLC:ADC col:CMP #84-colwidth :\ Would this wrap?  HLDA #32:BCC PrColumn :\ Space if not at end of line *FLDA #0:STA col:LDA #13 :\ Reset column and print NL 4 .PrColumn >JSR osasci H=CMP #32:BNE P%+5:JSR osasci :\ Print two spaces R.PrVarName \FTXA:LSR A:ADC #"@":JSR oswrch :\ Print first char of varname f LDY #1 p.NamePrint z$INY:LDA (link),Y:BEQ NamePrinted IJSR oswrch:JMP NamePrint :\ Print rest of name until &00 .NamePrinted FTXA:PHA:LDX #0 :\ Save index, and prepare X MDEY:LDA (link),Y:INY:INY :\ Get term. char and point to data BCPY #3:BEQ Real :\ n - real variable @CMP #"0":BCS Real :\ name - real variable CCMP #"%":BEQ Integer :\ name% - integer variable BCMP #"$":BNE P%+5:JMP String :\ name$ - string variable =CMP #"(":BNE P%+5:JMP Array :\ name[%|$]( - array 2LDA #"*":JSR oswrch :\ Unknown SEC:PHP:JMP RealOverflow : A.Real :\ (link),Y => exp, man KLDX #5 :\ Five bytes to reorder and copy  .RealLp1 HLDA (link),Y:STA int-1,X:INY :\ Copy and reverse into store $DEX:BNE RealLp1 .LDA exp:BEQ PrintInteger 8HLDA int+3:PHP:A #&80:STA int+3 :\ Save sign and put top bit in B .RealLp2 LDLDA exp:CMP #&A0:BCS RealDenormalised :\ Loop until denormalised V+ROR int+3:ROR int+2:ROR int+1:ROR int+0 `HBCS RealOverflow :\ Drop out if run out of bits jINC exp:BNE RealLp2 t.RealDenormalised ~GPLP:BPL RealPositive :\ Need to negate if negative 8LDX #&FC :\ Start at -4 C.RealNegate :\ Negate negative number &LDA #0:SBC int-&FC,X:STA int-&FC,X INX:BMI RealNegate .RealPositive JMP PrintInteger : <.Integer :\ (link),Y => int data JCJSR PrEqual:STX flg:STX col :\ Clear quote flag & col TBLDA (link),Y:STA txt+0:INY :\ Get pointer to string ^LDA (link),Y:STA txt+1:INY h/INY:LDA (link),Y:LDY #0:TAX:BEQ string_null r.string_loop |LDA (txt),Y:JSR pr_char INY:DEX:BNE string_loop +LDA flg:BMI string_end2:BPL string_exit .string_null:JSR PrQuote .string_end2:JSR PrQuote (.string_exit:JSR osnewl:JMP LinkNext :  .pr_char CCMP #32:BCC pr_check:CMP #127:BCC pr_ok :\ 32-126 print as char  .pr_check ?A$="*Save VList "+~mcode%+" "+~O%+" "+~exec%+" "+~load% H"Saving: "A$;:A$: