[A83] Memory Bug
[Prev][Next][Index][Thread]
[A83] Memory Bug
I have made a program for ION. When I run it on a ti83+ it works fine. But
when I quit to the main OS. I get a memory problem, there is 0 free bytes
left.
When I run it on a ti83 the program works fine and I don't get the memory
problem. Has anyone experienced something like this before? Please help.
I post the code beneath here:
;************************************
; PLANE HUNT 83+ v1.01
;************************************
;A fast paced action game. You have limited options.
;************************************
;The sourcecode is unclear at some times, but I
;will release a more commented version
;************************************
;by Maarten Zwartbol
;************************************
.nolist
#include "ion.inc" ;tells TASM--the compiler--what file to read
fromto define rom bcall( memory addresses and such
.list
KClear .equ 191
k2nd .equ 223
kMode .equ 191
kDel .equ 127
SavingArea = saferam1
speed = saferam2
shipx = speed+1
shipy = shipx+1
bombx = shipy+1
bomby = bombx+1
bombvalue = bomby+1
hightpointer = bombvalue+1
xbuild = hightpointer+2
ybuild = xbuild+1
levelh = ybuild+1
newheight = levelh+12
level = newheight+1
allscore = level+1
DefaultSpriteHeight = 8 ; This is the default for the sprite height
#ifdef TI83P ;a check for TASM to see whether it is making an 83
program--if so, do the next two commands
.org progstart-2
.db $BB,6D
#else ;if it isn't an 83 program, then do something [#]else--the next
line
.org progstart
#endif ;simply ends the #ifdef command
ret
jr nc,beglop ;Jumps to the beginning of the program (this
lineand the below three will be
.db "Plane Hunt 83+",0 ;The title displayed by ION--anything
youwant
beglop:
bcall(_indicatorOff)
ld hl,0
add hl,sp
ld (saved_sp+1),hl
ld a,255
ld (level),a
xor a
ld (allscore),a
ld (allscore+1),a
ld (shipx),a
ld (shipy),a
res 7,(iy+20) ; turn it off again
bcall(_cleargbuf)
bcall(_clrscrf)
ret
call line
call info
call adjustlevel
clearloop:
ld a,0ffh
out (1),a
ld a, 0fdh
out (1),a
in a,(1)
cp KClear
jp z, startgame1
ld a,0bfh
out (1),a
in a,(1)
cp K2nd
call z,adjustlevel
cp kDel
jp z,saved_sp
jr clearloop
info:
ld hl,0000h
ld (CURROW),hl
ld hl,0000h
ld (CURCOL),hl
ld hl,nameandversion
bcall(_puts)
bcall(_newline) ;_newline
ld hl,56*256+30
ld (pencol),hl
ld hl,clear
bcall(_vputs)
ld hl,9*256+15
ld (pencol),hl
ld hl,by
bcall(_vputs)
ld hl,16*256+12
ld (pencol),hl
ld hl,maxcoderz
bcall(_vputs)
ld hl,31*256+15
ld (pencol),hl
ld hl,leveltxt
bcall(_vputs)
ld hl,41*256+15
ld (pencol),hl
ld hl,hightxt
bcall(_vputs)
ld hl,41*256+78
ld (pencol),hl
ld a,(highscore)
ld l,a
ld h,0
bcall(_setxxxxop2)
bcall(_op2toop1)
ld a,3
bcall(_dispop1a)
ret
line:
ld b,12 ; draw 12 bytes = 1 row
ld hl,plotsscreen+(8*12) ; address in graph buffer at row 56
drawLineLoop:
ld (hl),$FF ; fill byte with %11111111
inc hl ; next byte
djnz drawLineLoop ; repeat 12 times
bcall(_copygbuf)
ret
adjustlevel:
ld hl,31*256+78
ld (pencol),hl
ld hl,space
bcall( _vputs
ld a,(level)
inc a
ld (level),a
cp 10
call z,resspeed
ld hl,31*256+78
ld (pencol),hl
ld a,(level)
add a,1
ld l,a
ld h,0
bcall(_setxxxxop2)
bcall(_op2toop1)
ld a,3
bcall(_dispop1a)
call PauseReturn
ret
resspeed:
xor a
ld (level),a
ret
;**************************
; Main gameplay begins here
;**************************
startgame1:
newlevel1:
call LoadLevel
ld hl,levelh
ld (hightpointer),hl
xor a
ld (bombvalue),a ;number of bombs in the air is 0
bcall(_cleargbuf)
bcall(_clrscrf) ;Clear the screen.
call disphight1
call SaveGBuf
startgame:
bcall(_cleargbuf)
xor a
ld a,0ffh ;resets the keypad.
out (1),a ;'Required syntax' :)
ld a,0bfh ;enable group 7
out (1),a
in a,(1) ;'Required Syntax'
cp kMode
jp z, pause
cp k2nd
call z, dropbombback
cp kDel
call z, dropbombfront
call LoadGBuF
call updatecoords
call drawship
call planehit
call drawbombs
bcall(_copygbuf)
jp startgame
updatecoords: ;THIS little routine makes sure your ship moves forward and
lowers your ship when you reach the end of the screen
ld a,(shipx)
inc a
cp 86
jp z, down
ld (shipx),a
ret
newlevel:
ld hl,(allscore)
ld de,10
add hl,de
ld (allscore),hl
ld a,(level)
cp 10
jp z,quit
call LoadLevel
ld hl,levelh
ld (hightpointer),hl
xor a
ld (bombvalue),a ;number of bombs in the air is 0
ld (shipy),a
ld (shipx),a
bcall(_cleargbuf)
call disphight1
call SaveGBuf
ret
down: ;THIS routine is used by the former routine
ld hl,(allscore)
ld a,(level)
ld e,a
ld d,0
add hl,de
ld (allscore),hl
xor a
ld (shipx),a
ld a,(level)
add a,1
ld e,a
ld a,(shipy)
cp 57
jp z, newlevel
add a,e
cp 57
jp nc, lowestflight
ld (shipy),a
ld a,(shipx)
call endhit
ret
lowestflight:
ld a,57
ld (shipy),a
xor a
ld (shipx),a
ret
planehit:
ld a,(shipx)
add a,8
endhit:
ld hl,(hightpointer)
sra a ;a/8
sra a
sra a
ld e,a
ld d,0
add hl,de
ld a,(shipy)
add a,6
ld b,a
ld a,(hl)
cp b
jp c,animateexplode
ret
animateexplode:
ld b,2
animate:
push bc
call LoadGBuf
ld a,(shipx)
add a,2
ld b,a
ld a,(shipy)
ld c,a
ld hl,explosion
call putsprclp
bcall(_copygbuf)
call PauseReturn
call LoadGBuf
ld a,(shipx)
ld b,a
ld a,(shipy)
add a,2
ld c,a
ld hl,explosion2
call putsprclp
bcall(_copygbuf)
call PauseReturn
pop bc
djnz animate
jp quit
dropbombfront:
ld a,(bombvalue)
cp 1
ret z
inc a
ld (bombvalue),a
ld a,(shipx)
add a,8
ld (bombx),a
jr bombtog
dropbombback: ;THIS routine checkes if you have pressed
2nd and if so it will make note that a bomb is being dropped
ld a,(bombvalue)
cp 1
ret z
inc a
ld (bombvalue),a
ld a,(shipx)
ld (bombx),a
bombtog:
ld a,(shipy)
add a,9
ld (bomby),a
ret
drawbombs:
ld a,(bombvalue) ;THIS routine will check if the bomb has hit a building
cp 1
ret c ;IF there is no bomb in the air then return, you see I've used 'c'
because I originally planned of having more bombs, maybe in the next version
ld a,(bomby)
inc a
ld (bomby),a
ld hl,(hightpointer)
ld a,(bombx)
sra a ;a/8
sra a
sra a
ld e,a
ld d,0
add hl,de
ld a,(bomby)
ld b,a
cp 66
jp z, bomb0
ld b,(hl)
cp b
jp nc, bombgone ;IF hit has hit a building than go to a label where it
makes the building smaller and stores the new value
bombgoneret: ;DRAW the bomb
ld a,(bombx)
ld b,a
ld a,(bomby)
ld c,a
ld hl,bomb
call putsprclp
ret
bombgone: ;THIS routine resets the number of bombs in the air and the
bomby-x coords, it also inputs the new building height (you bcall( this
routine when a building is hit)
ld a,(hl)
add a,10
ld (hl),a
bomb0:
ld a,(bombvalue)
dec a
ld (bombvalue),a
xor a
ld (bomby),a
bcall(_cleargbuf)
call disphight1
call SaveGBuf
ret
disphight1: ;THIS routine draws the buildings on the screen and after
thatstores it in a buffer
ld b,12
ld hl,(hightpointer)
xor a
drawheightx:
push bc
ld (xbuild),a
ld a,(hl)
ld (ybuild),a
push hl
drawheighty:
ld a,(xbuild)
ld b,a ;X-coord
ld a,(ybuild)
ld c,a ;Y-coord
ld hl,building
call putsprclp
ld a,(ybuild)
add a,8
cp 70
ld (ybuild),a
jp c, drawheighty ;C = gelijk of kleiner NC is gelijk of groter
;WHEN BUILDING IS FULLY DRAWN
pop hl
inc hl
ld a,(xbuild)
add a,8
pop bc
djnz drawheightx
ret
drawship: ;THIS ship draws your little ship flying around :D
ld a,(shipy)
ld l,a
ld a,(shipx)
ld b,8
ld ix,ship
call ionPutSprite
ret
pause: ;THIS routine makes sure you can pause the game
bcall(_clrscrf)
ld hl,0000h
ld (CURROW),hl
ld hl,0000h
ld (CURCOL),hl
ld hl,paused
bcall(_puts)
pausem: ;THIS checkes wheter a key is pressed during pause mode
ld a,0ffh ;resets the keypad.
out (1),a ;'Required syntax' :)
ld a,0bfh ;enable group 7
out (1),a
in a,(1) ;'Required Syntax'
cp kDel
jp z, quit
cp kMode
jp z, startgame
jr pausem
quit:
ld hl,(allscore)
ld de,(highscore)
bcall(_cphlde)
jp c, saved_sp
ld (highscore),hl
bcall(_clrscrf) ;Clear the screen.
ld hl,0003h
ld (CURROW),hl
ld hl,0001h
ld (CURCOL),hl
ld hl,newhigh
bcall(_puts)
jp beglop
pauseReturn:
ld b,50
ei
delay: halt
djnz delay
ret
saved_sp: ;HAS something to do with restoring the stack pointer?? ask
Alexat www.maxcoderz.com[1]
ld sp,0
ret
SaveGBuf: ;save the data from the graphic buffer to a save user defined
variable
ld hl,plotsscreen ;get data from graphbuf (=plotsscreen)
ld de,SavingArea ;copy it to saving area
ld bc,768 ;length is 768 bytes
ldir ;and it is copied
;done!
ret
LoadLevel:
ld a, (level)
push af
sla a
sla a
ld e,a
sla a
add a,e
ld e,a
ld d,0
pop af
inc a
ld (level),a
ld hl,hights
add hl,de
ld de,levelh ;copy it to saving area
ld bc,12 ;length is 768 bytes
ldir ;and it is copied
ret
LoadGBuf: ;LOAD the data from the save user defined var back to the
graphicbuffer
ld hl,SavingArea ;get data from saving area
ld de,plotsscreen ;copy to the graph buffer
ld bc,768 ;length is 768 bytes
ldir ;do the copying
;done!
ret
;---------------------------------------------------------------------------
-
;[ PutSprClp ] [ABCDEFIX] [ 177 bytes ] [ CrASH_Man
]
;---------------------------------------------------------------------------
-
; Draws a sprite with an AND/XOR mask with clipping
;
; parameters: HL -> sprite, (B,C) = coordinates
; returns: Puts sprite in GRAPH_MEM
;
PutSprClp: XOR A
__Change_1: LD DE, DefaultSpriteHeight ; D = 0, E = Height
OR C ; If C <0
JP M, _PSC_NoBotClp ; No bottom clip.
LD A, $3F ; Is C is offscreen?
SUB C
RET C
__Change_2: CP DefaultSpriteHeight-1 ; If C + 7 <64
JR NC, _PSC_NoVertClp ; No vertical clip.
INC A
LD E, A
JR _PSC_NoVertClp ; Height = 64 - C
_PSC_NoBotClp:
__Change_3: CP -(DefaultSpriteHeight-1) ; Is C is offscreen?
RET C
ADD A, E ; Find how many lines
LD C, A ; to actually draw
SUB E
NEG
LD E, A
ADD HL, DE ; Move HL down
LD E, C ; by -C lines
LD C, D
_PSC_NoVertClp: PUSH HL ; IX -> Sprite
POP IX
LD A, $77 ; OP code for
LD (_PSC_OPchg_1), A ; LD (HL), A
LD (_PSC_OPchg_2), A
XOR A ; Is B >0?
OR B
JP M, _PSC_NoRightClp
CP 89 ; Is B <89?
JR C, _PSC_ClpDone
CP 96
RET NC
LD HL, _PSC_OPchg_1 ; Modify LD to NOP
JR _PSC_ClpModify
_PSC_NoRightClp:CP -7 ; Is B is offscreen?
RET C
LD HL, _PSC_OPchg_2 ; Modify LD to NOP
_PSC_ClpModify: LD (HL), D
_PSC_ClpDone: LD B, D
LD H, B
LD L, C
ADD HL, BC ; HL = Y * 12
ADD HL, BC
ADD HL, HL
ADD HL, HL
LD C, A ; HL = Y*12 + X/8
SRA C
SRA C
SRA C
INC C
ADD HL, BC
LD BC, plotsscreen
ADD HL, BC
LD B, E ; B = number of rows
AND %00000111 ; find number of
LD E, A ; instructions to jump
ADD A, E
ADD A, E
LD (_PSC_OPchg_4 + 1), A ; 3 * number
SUB 22
CPL
LD (_PSC_OPchg_3 + 1), A ; 3 * (7 - number)
_PSC_LineLoop: LD C, (IX)
SCF
SBC A, A
_PSC_OPchg_3: JR _PSC_OPchg_3 ; modify
RR C
RRA
RR C
RRA
RR C
RRA
RR C
RRA
RR C
RRA
RR C
RRA
RR C
RRA
AND (HL) ; AND with background
LD E, A
__Change_4: LD A, (IX+DefaultSpriteHeight)
_PSC_OPchg_4: JR _PSC_OPchg_4 ; modify
RLA
RL D
RLA
RL D
RLA
RL D
RLA
RL D
RLA
RL D
RLA
RL D
RLA
RL D
RLA
RL D
XOR E ; XOR with background
_PSC_OPchg_1: LD (HL), A ; Write
DEC HL ; HL -> next 8 pixels
LD A, C
AND (HL) ; AND with background
XOR D ; XOR with background
_PSC_OPchg_2: LD (HL), A ; Write
INC IX ; Increment to next data
LD DE, 13 ; HL -> next row
ADD HL, DE
DJNZ _PSC_LineLoop
RET
#IFNDEF NO_MOD_AX
;---------------------------------------------------------------------------
-
;[ SetSpriteHeight ] [A] [ 16 bytes ] [ CrASH_Man
]
;---------------------------------------------------------------------------
-
; Changes the default sprite size
;
; parameters: A = New Sprite Height
; returns: Self modified routine.
;
SetSpriteHeight:LD (__Change_1+1), A
LD (__Change_4+2), A
DEC A
LD (__Change_2+1), A
NEG
LD (__Change_3+1), A
RET
#ENDIF
ship: ;THIS is the datasprites for a ship
.db %11000000
.db %11100000
.db %11111110
.db %11110011
.db %01111111
.db %00000000
.db %00000000
.db %00000000
explosion: ;THIS is the datasprites for an explosion
;MASK
.db %11111111
.db %11111111
.db %11111111
.db %11111111
.db %11111111
.db %10110111
.db %11011011
.db %11111111
;SPRITE
.db %00100000
.db %01010100
.db %10101010
.db %01010100
.db %10101000
.db %01010100
.db %00101000
.db %00000000
explosion2: ;THIS is the datasprites for an explosion
;MASK
.db %11111111
.db %11111111
.db %11111111
.db %11111111
.db %11111111
.db %11111111
.db %11111111
.db %11111111
;SPRITE
.db $52,$A9,$52,$A9,$40,$0A,$15,$0A
bomb:
;MASK
.db %00111111
.db %00111111
.db %11111111
.db %11111111
.db %11111111
.db %11111111
.db %11111111
.db %11111111
;SPRITE
.db %11000000
.db %11000000
.db %00000000
.db %00000000
.db %00000000
.db %00000000
.db %00000000
.db %00000000
building: ;BUILDING sprites
;MASK
.db %00000000
.db %00000000
.db %00000000
.db %00000000
.db %00000000
.db %00000000
.db %00000000
.db %00000000
;SPRITE
.db %11111111
.db %10000000
.db %10101010
.db %10010101
.db %10101010
.db %10010101
.db %10101010
.db %10010101
hights: ;the hights in the first level
.db 20,10,30,50,40,30,15,40,30,12,45,10
.db 10,14,37,10,10,23,10,40,10,10,10,10
.db 10,60,10,60,10,60,10,60,10,60,10,60
.db 30,20,20,50,20,5,50,40,30,40,30,20
.db 20,10,30,50,40,30,15,40,30,12,45,10
.db 20,14,37,10,10,23,10,40,10,20,10,10
.db 10,60,10,80,10,40,10,60,34,60,10,60
.db 6,15,25,35,45,55,45,35,25,15,6,6
.db 10,60,13,60,10,60,10,60,23,60,10,60
.db 20,20,20,20,20,10,70,70,70,40,30,20
nameandversion:
.db "Plane Hunt 83+",0
clear:
.db "Press Clear",0
leveltxt:
.db "Level:",0
hightxt:
.db "Highscore:",0
paused:
.db "Paused",0
highscore:
.dw 0
space:
.db " ",0
by:
.db "by Maarten Zwartbol",0
newhigh:
.db "New Highscore",0
maxcoderz:
.db "www.maxcoderz.com",0[2]
.end
END
---------------------------------------------------------------------
MaartenZwartbol - Maxcoderz Soft. - http://www.maxcoderz.com[3]
--------------------------------------------------------------------- "If I
have seen farther than others, it is because I was standing on the shoulders
of giants." - scientist Sir Isaac Newton, in a letter to his colleague
RobertHooke, February 1676.
----------------------------------------------------------------------------
Chat with friends online, try MSN Messenger: Click Here[4]
--- Links ---
1 http://www.maxcoderz.com
2 'http://www.maxcoderz.com",0'
3 http://www.maxcoderz.com
4 'http://g.msn.com/1HM300901/1S'
Follow-Ups: