Unfortunately, I couldn't make this part of WimBasic. But the code is fully relocatable, so this opens up possibilities.
The tapebuffer is large enough to hold the code. I ran some tests now and it works as expected.
Removing an array can be useful when memory is scarce, or when an array needs redimensioning.
Deleting all arrays in one blow can be done with: DOKE $31, DEEK($2F) in WimBasic, or POKE 49,PEEK(47):POKE 50,PEEK(48) in CBM Basic
EDIT: After some effort, I did manage to make ERASE a new command in WimBasic. It takes a list of array names as parameter. ERASE replaces the TOGGLE command.
2ND EDIT: After some more effort, I managed to include the TOGGLE command again.
Regards,
wimoos
Code: Select all
;
;;
;
; Routine to erase a DIMed array
; Can be loaded in the tape buffer
; Then, SYS828,<arrayname and type>
; does the trick
;
.org $033c
LD091 JSR $CEFD ; skip comma and get first character
JSR $D113 ; check byte, return Cb = 0 if<"A" or >"Z"
BCS LD09F ; if ok continue
LD095 JMP $CF08 ; else syntax error then warm start
LD09F STA $45 ; save 1st character
JSR $0073 ; increment and scan memory, 2nd character
BCC LD0AF ; if character = "0"-"9" (ok) go save 2nd character
LDX #$00
JSR $D113 ; check byte, return Cb = 0 if<"A" or >"Z"
BCC LD0BA ; if <"A" or >"Z" go check if string
LD0AF TAX ; copy 2nd character
LD0B0 JSR $0073 ; increment and scan memory, 3rd character
BCC LD0B0 ; loop if character = "0"-"9" (ignore)
JSR $D113 ; check byte, return Cb = 0 if<"A" or >"Z"
BCS LD0B0 ; loop if character = "A"-"Z" (ignore)
LD0BA CMP #'$' ; compare with "$"
BEQ LD0D4
CMP #$25 ; compare with "%"
BNE LD0DB ; if not integer go check for an array
LDA #$80 ; set integer type
ORA $45 ; OR current variable name first byte
STA $45 ; save current variable name first byte
LD0D4 TXA ; get 2nd character back
ORA #$80 ; set top bit, indicate string or integer variable
TAX ; copy back to 2nd character temp
JSR $0073 ; skip datatype identifier
LD0DB STX $46 ; save 2nd character
;
; Name of array and arraytype is now read.
;
JSR $0079
BNE LD095
;
; We know now there's no syntax error. Start searching for the array.
;
LDX $2F ; set end of variables low byte
LDA $30 ; set end of variables high byte
LD21C CMP $32 ; compare with end of arrays high byte
BNE LD228 ; if not reached array memory end continue searching
CPX $31 ; else compare with end of arrays low byte
BEQ LD261 ; array not found - leave silently
LD228 STX $5F ; save as array start pointer low byte
STA $60 ; save as array start pointer high byte
LDY #$00
LDA ($5F),Y ; get array name first byte
INY ; increment index to second name byte
CMP $45 ; compare with this array name first byte
BNE LD237 ; if no match go try the next array
LDA $46 ; else get this array name second byte
CMP ($5F),Y ; compare with array name second byte
;
; Found an array, determine pointer to next, already.
; Z-flag says this the target or not - we'll see to that later
;
LD237 PHP
INY ; increment index
LDA ($5F),Y ; get array size low byte
CLC ; clear carry for add
ADC $5F ; add array start pointer low byte
TAX ; copy low byte to X
INY ; increment index
LDA ($5F),Y ; get array size high byte
ADC $60 ; add array memory pointer high byte
PLP
BNE LD21C ; not the target, set up for the next
;
; Tartget is found - move all the next arrays forward, if any
;
STX $61
STA $62
LDY #$00
LD240 LDA $61
CMP $31
LDA $62
SBC $32
BCS LD260
LD243 LDA ($61),Y
STA ($5F),Y
INC $5F
BNE LD244
INC $60
LD244 INC $61
BNE LD240
INC $62
BNE LD240 ; branch always
LD260 LDA $5F
STA $31
LDA $60
STA $32
LD261 RTS
.end
