develop, the CD; issue 1

home *** CD-ROM | disk | FTP | other *** search

/ develop, the CD; issue 1 / Apple_Develop_1989.bin / dynamo / rt.a < prev next >

Wrap

Text File | 1989-12-10 | 18KB | 1,438 lines

******************************************************* * * * DYNAMO * * * * Apple II 8-bit runtime library routines. * * Copyright (C) 1989 Apple Computer. * * * * Written by Eric Soldan, Apple II DTS * * * ******************************************************* include 'sys.equ' include 'app.config' vsl equ varstart vsh equ varstart+hibyte ****************** export rtreset rtreset proc export numtocopy, chrhibiton, chrhibitoff export sign, readendchr, hexpadchr, padhex ldy #255 sty numtocopy sty chrhibitoff iny sty chrhibiton sty sign sty readendchr lda #'0' sta hexpadchr lsr padhex rts numtocopy dc.b 255 ;Will be set back to 255 after ;every string copy or append. chrhibitoff dc.b $FF chrhibiton dc.b 0 sign dc.b 0 readendchr dc.b 0 hexpadchr dc.b '0' padhex dc.b 0 endp *** export hibitchrs hibitchrs PROC lda #$80 ;We don't need to set chrhibitoff sta chrhibiton ;because it will either be a $7F rts ;or $FF, and in either case endp ;chrhibiton will turn it on anyway. *** export lowbitchrs lowbitchrs PROC asl chrhibiton ;Was a $00 or $80, so this makes it $00. lda #$7F sta chrhibitoff rts endp *** export regchrs regchrs PROC asl chrhibiton lda #$FF sta chrhibitoff rts endp *** export rtcout rtcout proc stx @keepx and chrhibitoff ora chrhibiton jsr $FDED ldx @keepx rts @keepx dc.b 0 endp *** export write write proc pla sta @getchr+1 pla sta @getchr+2 txa pha @loop inc @getchr+1 bne @getchr inc @getchr+2 @getchr lda $2000 ;Address modified. beq @exit jsr rtcout jmp @loop @exit pla tax lda @getchr+2 pha lda @getchr+1 pha rts endp *** export writecr writecr proc txa pha lda #13 jsr rtcout pla tax rts endp *** export wrcstr wrcstr proc sta @getchr+1 sty @getchr+2 txa pha @getchr lda $2000 ;Address modified. beq @exit jsr rtcout inc @getchr+1 bne @getchr inc @getchr+2 bne @getchr ;Always. @exit pla tax rts endp *** *** *** export signed signed proc sec ror sign rts endp *** export unsigned unsigned proc lsr sign rts endp *** export chngsgn chngsgn proc lda vsl,x eor #$FF clc adc #1 sta vsl,x lda vsh,x eor #$FF adc #0 sta vsh,x rts endp *** export decoutl decoutl proc import decout ldy #0 jmp decout ;jmp, instead of beq so we can be a lib. endp *** export vdecout vdecout proc export decout lda vsh,x tay lda vsl,x decout sta @templ sty @temph lda #'0' sta @temp2 txa pha bit sign bpl @pos tya bpl @pos lda #'-' jsr rtcout lda @templ eor #$FF clc adc #1 sta @templ lda @temph eor #$FF adc #0 sta @temph @pos ldx #4 @a lda #'0' sta @temp @b lda @templ sec sbc @decl,x tay lda @temph sbc @dech,x bcc @c sta @temph sty @templ inc @temp bcs @b @c lda @temp dex bmi @e ;Last digit -- print no matter what. cmp @temp2 beq @a ;Don't print leading 0's. lsr @temp2 ;Inval leading 0 test. jsr rtcout jmp @a @e jsr rtcout pla tax rts @decl dc.b 1 dc.b 10 dc.b 100 dc.b 1000-768 dc.b 10000-9984 @dech dc.b 1>>8 dc.b 10>>8 dc.b 100>>8 dc.b 1000>>8 dc.b 10000>>8 @templ dc.b 0 @temph dc.b 0 @temp dc.b 0 @temp2 dc.b 0 endp *** export hexpad hexpad proc sta hexpadchr lsr padhex rts endp *** export hexnopad hexnopad proc sec ror padhex rts endp *** export hexoutl hexoutl proc import hexout ldy #0 clc jmp hexout+1 ;jmp, instead of beq so we can be a lib. endp *** export vhexout vhexout proc export hexout import hexpadchr lda vsh,x tay lda vsl,x hexout sec sta @templ txa pha ldx #3 bcs @aa ldx #1 ldy @templ @aa sty @temph lda padhex sta @padhex lda hexpadchr sta @hexpadchr @loop lda #0 ldy #4 @a asl @templ rol @temph rol a dey bne @a tay bne @b lda @padhex bmi @nopad lda @hexpadchr jsr rtcout jmp @nopad @b jsr @doone lsr @padhex lda #'0' sta @hexpadchr @nopad dex bne @loop lda @temph lsr a lsr a lsr a lsr a tay pla tax @doone lda @hexdigit,y jmp rtcout @hexdigit dc.b '0123456789ABCDEF' @padhex dc.b 0 @hexpadchr dc.b 0 @templ dc.b 0 @temph dc.b 0 endp *** export ldyvar ldyvar proc lda vsl,y pha lda vsh,y tay pla rts endp *** export mulconl mulconl proc import mulcon ldy #0 jmp mulcon ;jmp, instead of beq so we can be a lib. endp *** export mulvar mulvar proc export mulcon, mulvall, mulvalh import multiply, setcon jsr ldyvar mulcon pha lda vsl,x sta mulvall lda vsh,x sta mulvalh pla jsr multiply jmp setcon mulvall dc.b 0 mulvalh dc.b 0 endp export multiply multiply proc sta @templ sty @temph lda #0 tay @a lsr mulvalh ror mulvall bcc @b clc adc @templ pha tya adc @temph tay pla @b asl @templ rol @temph pha lda mulvalh ora mulvall cmp #1 pla bcs @a rts @templ dc.b 0 @temph dc.b 0 endp export divconl divconl proc import divcon ldy #0 jmp divcon ;jmp, instead of beq so we can be a lib. endp *** export divvar divvar proc export divcon import ldyvar jsr ldyvar divcon sta @templ sty @temph lda #16 sta @temp lda #0 sta @temp2 sta @temp3 @a asl vsl,x rol vsh,x rol @temp2 rol @temp3 lda @temp2 sec sbc @templ sta @temp4 lda @temp3 sbc @temph bcc @b sta @temp3 lda @temp4 sta @temp2 inc vsl,x @b dec @temp bne @a lda @temp2 ldy @temp3 rts @templ dc.b 0 @temph dc.b 0 @temp dc.b 0 @temp2 dc.b 0 @temp3 dc.b 0 @temp4 dc.b 0 endp *** export addvar addvar proc export addcon import ldyvar jsr ldyvar addcon pha clc adc vsl,x sta vsl,x tya adc vsh,x sta vsh,x pla rts endp *** export addconl addconl proc ldy #0 jmp addcon ;jmp, instead of beq so we can be a lib. endp *** export subvar subvar proc export subcon import ldyvar jsr ldyvar subcon pha sta @temp lda vsl,x sec sbc @temp sta vsl,x sty @temp lda vsh,x sbc @temp sta vsh,x pla rts @temp dc.b 0 endp *** export subconl subconl proc ldy #0 jmp subcon ;jmp, instead of beq so we can be a lib. endp *** export setconl setconl proc export setcon ldy #0 setcon sta vsl,x pha tya sta vsh,x pla rts endp *** export setzero setzero proc lda #0 sta vsh,x sta vsl,x rts endp *** export seteq seteq proc lda vsh,y sta vsh,x lda vsl,y sta vsl,x rts endp *** export setvars setvars proc pla sta @getval+1 pla sta @getval+2 txa pha ldy #1 @loop jsr @getval cmp #255 beq @exit tax jsr @getval sta vsl,x jsr @getval sta vsh,x bcc @loop ;Always. @exit pla tax lda @getval+2 pha lda @getval+1 pha rts @getval lda $2000,y ;Address modified. inc @getval+1 bne @rts inc @getval+2 @rts rts endp *** export xgty xgty proc import vifequal, vifsgneq, xlty0 tya pha lda sign bpl @a jsr vifsgneq jmp @b @a jsr vifequal @b pla tay bcs @rts jmp xlty0 ;jmp, instead of bcc so we can be a lib. @rts rts endp *** export xlty xlty proc export xlty0 import vifequal, vifsgneq tya pha lda sign bpl @a jsr vifsgneq jmp @b @a jsr vifequal @b pla tay bcc xltyrts xlty0 lda vsl,x pha lda vsl,y sta vsl,x pla sta vsl,y lda vsh,x pha lda vsh,y sta vsh,x pla sta vsh,y xltyrts rts endp *** export ifequal ifequal proc sta @lo sty @hi lda vsh,x cmp @hi bne @exit lda vsl,x cmp @lo @exit php lda @lo plp rts ;eq=eq, cs>=, cc< @lo dc.b 0 @hi dc.b 0 endp *** export vifequal vifequal proc lda vsl,y ;Load up the variable value and go do it. pha lda vsh,y tay pla jmp ifequal endp *** export ifsgneq ifsgneq proc sta @lo ;Preserve acc. tya cmp #$80 ;See if right-side is negative. eor vsh,x ;See if signs are the same. bmi @exit ;xreg variable is smaller (signed). bcs @a ;xreg variable is negativ