Browse Source

added BASIC_C128, EDITOR_C128, EDITOR_C128_DIN, KERNAL_C128_05, KERNAL_C128_06, MONITOR_C128

master
Michael Steil 6 months ago
parent
commit
b01114bd12
100 changed files with 14393 additions and 0 deletions
  1. 357
    0
      BASIC_C128/array.src
  2. 18
    0
      BASIC_C128/auto.src
  3. 25
    0
      BASIC_C128/bank.src
  4. 47
    0
      BASIC_C128/basic.map
  5. 173
    0
      BASIC_C128/basic.src
  6. 145
    0
      BASIC_C128/bground.src
  7. 45
    0
      BASIC_C128/boot.src
  8. 238
    0
      BASIC_C128/box.src
  9. 236
    0
      BASIC_C128/boxwork.src
  10. 33
    0
      BASIC_C128/bump.src
  11. 255
    0
      BASIC_C128/char.src
  12. 28
    0
      BASIC_C128/checkval.src
  13. 178
    0
      BASIC_C128/circle.src
  14. 69
    0
      BASIC_C128/clrhires.src
  15. 417
    0
      BASIC_C128/code0.src
  16. 75
    0
      BASIC_C128/code12.src
  17. 44
    0
      BASIC_C128/code17.src
  18. 276
    0
      BASIC_C128/code18.src
  19. 548
    0
      BASIC_C128/code19.src
  20. 255
    0
      BASIC_C128/code21.src
  21. 187
    0
      BASIC_C128/code22.src
  22. 122
    0
      BASIC_C128/code23.src
  23. 140
    0
      BASIC_C128/code24.src
  24. 326
    0
      BASIC_C128/code26.src
  25. 44
    0
      BASIC_C128/collision.src
  26. 106
    0
      BASIC_C128/color.src
  27. 45
    0
      BASIC_C128/continue.src
  28. 234
    0
      BASIC_C128/crunch.src
  29. 59
    0
      BASIC_C128/dec.src
  30. 597
    0
      BASIC_C128/declare.src
  31. 117
    0
      BASIC_C128/def.src
  32. 110
    0
      BASIC_C128/delete.src
  33. 23
    0
      BASIC_C128/dim.src
  34. 24
    0
      BASIC_C128/disclaim.src
  35. 46
    0
      BASIC_C128/display.map
  36. 184
    0
      BASIC_C128/disptable.src
  37. 88
    0
      BASIC_C128/doakey.src
  38. 165
    0
      BASIC_C128/doloop.src
  39. 543
    0
      BASIC_C128/dos1.src
  40. 483
    0
      BASIC_C128/dos2.src
  41. 245
    0
      BASIC_C128/dos3.src
  42. 114
    0
      BASIC_C128/dos4.src
  43. 113
    0
      BASIC_C128/dos5.src
  44. 49
    0
      BASIC_C128/draw.src
  45. 95
    0
      BASIC_C128/entries.src
  46. 97
    0
      BASIC_C128/envelope.src
  47. 54
    0
      BASIC_C128/errfunc.src
  48. 82
    0
      BASIC_C128/errmsgs.src
  49. 28
    0
      BASIC_C128/errprint.src
  50. 240
    0
      BASIC_C128/execute.src
  51. 20
    0
      BASIC_C128/fast.src
  52. 9
    0
      BASIC_C128/fetch.src
  53. 84
    0
      BASIC_C128/filter.src
  54. 53
    0
      BASIC_C128/findline.src
  55. 133
    0
      BASIC_C128/for.src
  56. 285
    0
      BASIC_C128/formeval.src
  57. 55
    0
      BASIC_C128/fre.src
  58. 224
    0
      BASIC_C128/functions.src
  59. 339
    0
      BASIC_C128/getpointr.src
  60. 25
    0
      BASIC_C128/go.src
  61. 87
    0
      BASIC_C128/gosubgoto.src
  62. 100
    0
      BASIC_C128/graphic.src
  63. 176
    0
      BASIC_C128/graphic10.src
  64. 38
    0
      BASIC_C128/graphic11.src
  65. 138
    0
      BASIC_C128/graphic3.src
  66. 224
    0
      BASIC_C128/graphic7.src
  67. 205
    0
      BASIC_C128/graphic8.src
  68. 215
    0
      BASIC_C128/graphic9.src
  69. 284
    0
      BASIC_C128/grbcol.src
  70. 141
    0
      BASIC_C128/gshape.src
  71. 10
    0
      BASIC_C128/header.src
  72. 42
    0
      BASIC_C128/help.src
  73. 41
    0
      BASIC_C128/hexfunc.src
  74. 149
    0
      BASIC_C128/if.src
  75. 43
    0
      BASIC_C128/indjumps.src
  76. 360
    0
      BASIC_C128/init.src
  77. 284
    0
      BASIC_C128/input.src
  78. 104
    0
      BASIC_C128/instring.src
  79. 303
    0
      BASIC_C128/irq.src
  80. 63
    0
      BASIC_C128/joy.src
  81. 70
    0
      BASIC_C128/jumptable.src
  82. 133
    0
      BASIC_C128/key.src
  83. 192
    0
      BASIC_C128/keydefs.src
  84. 247
    0
      BASIC_C128/let.src
  85. 47
    0
      BASIC_C128/lineget.src
  86. 200
    0
      BASIC_C128/list.src
  87. 18
    0
      BASIC_C128/locate.src
  88. 79
    0
      BASIC_C128/midequal.src
  89. 184
    0
      BASIC_C128/movspr.src
  90. 107
    0
      BASIC_C128/newclr.src
  91. 116
    0
      BASIC_C128/next.src
  92. 30
    0
      BASIC_C128/ongoto.src
  93. 38
    0
      BASIC_C128/overflow.src
  94. 203
    0
      BASIC_C128/paint.src
  95. 13
    0
      BASIC_C128/patch.src
  96. 28
    0
      BASIC_C128/patcheshi.src
  97. 78
    0
      BASIC_C128/patcheslo.src
  98. 32
    0
      BASIC_C128/peekpoke.src
  99. 122
    0
      BASIC_C128/penpot.src
  100. 0
    0
      BASIC_C128/play.src

+ 357
- 0
BASIC_C128/array.src View File

@@ -0,0 +1,357 @@
.page
.subttl Array Routines

;
; format of arrays in core:
;
; descriptor:
; lowbyte = first character.
; high byte = second character (m.s.bit is string flag).
; length of array in core in bytes (includes everything).
; number of dimensions.
; for each dimension starting with the first a list (2 bytes each)
; of the max indice+1
; the values
;


is_array
lda dimflg
ora intflg
pha ;save (dimflg) for recursion.
lda valtyp
pha ;save (valtyp) for recursion.
ldy #0 ;set number of dimensions to zero.

indlop tya ;save number of dims.
pha
lda varnam+1
pha
lda varnam
pha ;save looks.
jsr intidx ;evaluate indice into facmo&lo.
pla
sta varnam
pla
sta varnam+1 ;get back all...we're home.
pla ;(# of units).
tay
tsx
lda 258,x
pha ;push dimflg and valtyp further.
lda 257,x
pha
lda indice ;put indice onto stack.
sta 258,x ;under dimflg and valtyp.
lda indice+1
sta 257,x
iny ;y counts # of subscripts
sty count ;protect y from chrget
jsr chrgot ;get terminating character.
ldy count
cmp #',' ;more subscripts?
beq indlop ;yes.

jsr chkcls ;must be closed paren.
pla
sta valtyp ;get valtyp and
pla
sta intflg
and #$7f
sta dimflg ;dimflg off stack.
ldx arytab ;place to start search.
lda arytab+1
lopfda
stx lowtr
sta lowtr+1
cmp strend+1 ;end of arrays?
bne lopfdv
cpx strend
beq notfdd ;a fine thing! no array!
lopfdv
ldy #0
jsr indlow_ram1 ;get high of name from array bank (ram1)
iny
cmp varnam ;compare high orders.
bne nmary1 ;no way is it this. get the bite outta here.
jsr indlow_ram1
cmp varnam+1 ;low orders?
beq gotary ;well here it is.
nmary1
iny
jsr indlow_ram1 ;get length.
clc
adc lowtr
tax
iny
jsr indlow_ram1
adc lowtr+1
bcc lopfda ;always branches.
bserr ldx #errbs ;get bad sub error number.
.byte $2c

fcerr ldx #errfc ;too big. Illegal Quantity error
errgo3 jmp error



gotary ldx #errdd ;perhaps a "re-dimension" error.
lda dimflg ;test the dimflg.
bne errgo3
jsr fmaptr
ldy #4
jsr indlow_ram1
sta syntmp
lda count ;get number of dims input.
cmp syntmp ;# of dims the same?
bne bserr ;same so get definition.
jmp getdef
.page
;
; here when variable is not found in the array table.
;
; building an entry.
;
; put down the descriptor.
; setup number of dimensions.
; make sure there is room for the new entry.
; remember "varpnt".
; tally=4.
; skip two locs for later fill in of size.
; loop: get an indice
; put down number+1 and increment varptr.
; tally=tally*number+1
; decrement number of dims
; bne loop
; call "reason" with (a,b) reflecting last loc
; of variable
; update strend
; zero all.
; make tally include maxdims and descriptor
; put down tally
; if called by dimension, return.
; otherwise index into the variable as if it
; were found on the initial search.
;
notfdd
jsr fmaptr ;form arypnt.
jsr reason
ldy #0
sty curtol+1
ldx #5
lda varnam
sta sw_rom_ram1 ;point to string/array bank
sta (lowtr),y
bpl notflt
dex
notflt
iny
lda varnam+1
sta (lowtr),y
bpl stomlt
dex
dex
stomlt
stx curtol
lda count
iny
iny
iny
sta (lowtr),y ;save number of dimensions.
loppta
ldx #11 ;default size.
lda #0
bit dimflg
bvc notdim ;not in a dim statement.
pla ;get low order of indice.
clc
adc #1
tax
pla ;get high order of indice.
adc #0
notdim
iny
sta (lowtr),y ;store high part of indice.
iny
txa
sta (lowtr),y ;store low part of indice.
jsr umult ;(a,x)+(curtol)*(lowtr,y).
stx curtol ;save new tally.
sta curtol+1
ldy index
dec count ;any more indices left?
bne loppta ;yes.
adc arypnt+1
bcs omerr1 ;overflow.
sta arypnt+1 ;compute where to zero.
tay
txa
adc arypnt
bcc grease
iny
beq omerr1
grease
jsr reason ;get room.
sta strend
sty strend+1 ;new end of storage.
lda #0 ;storing (acca) is faster than clear.
inc curtol+1

ldy curtol
beq deccur

zerita dey ;zero out new entry
sta (arypnt),y
bne zerita ;no. continue.
deccur
dec arypnt+1
dec curtol+1
bne zerita ;do another block.
inc arypnt+1 ;bump back up. will use later.
sec
lda strend ;restore (acca).
sbc lowtr ;determine length.
ldy #2
sta (lowtr),y ;low.
lda strend+1
iny
sbc lowtr+1
sta (lowtr),y ;high.
lda dimflg ;quit here if this is a dim statement
bne dimrts ;bye!
iny


; At this point (lowtr,y) points beyond the size to the number of dimensions. strategy:
; numdim=number of dimensions.
; curtol=0.
;inlpnm:get a new indice.
; make sure indice is not too big.
; multiply curtol by curmax.
; add indice to curtol.
; numdim=numdim-1.
; bne inlpnm.
; use (curtol)*4 as offset.

getdef jsr indlow_ram1 ;get # of dim's from ram bank 1
sta count ;save a counter.
lda #0 ;zero (curtol).
sta curtol
inlpnm
sta curtol+1
iny
pla ;get low indice.
tax
sta indice
jsr indlow_ram1
sta syntmp
pla ;and the high part.
sta indice+1
cmp syntmp ;compare with max indice.
bcc inlpn2
bne bserr7 ;if greater, "bad subscript" error.
iny
jsr indlow_ram1
sta syntmp
cpx syntmp
bcc inlpn1

bserr7 jmp bserr

omerr1 jmp omerr

inlpn2
iny
inlpn1 lda curtol+1 ;don't multiply if curtol=0.
ora curtol
clc ;prepare to get indice back.
beq addind ;get high part of indice back.
jsr umult ;multiply (curtol) by (5&6,lowtr).
txa
adc indice ;add in (indice).
tax
tya
ldy index1
addind
adc indice+1
stx curtol
dec count ;any more?
bne inlpnm ;yes.
sta curtol+1
ldx #5
lda varnam
bpl notfl1
dex
notfl1
lda varnam+1
bpl 10$
dex
dex
10$ stx addend
lda #0
jsr umultd ;on rts, a & y = hi. x = lo.
txa
adc arypnt
sta varpnt
tya
adc arypnt+1
sta varpnt+1
tay
lda varpnt
dimrts rts
.page

;integer arithmetic routines.
;
;two byte unsigned integer multiply.
;this is for multiply dimensioned arrays.
; (a,b)=(curtol)*(5&6,x).
umult
sty index
jsr indlow_ram1
sta addend ;low, then high.
dey
jsr indlow_ram1 ;put (5&6,lowtr) in faster memory.
umultd
sta addend+1
lda #16
sta deccnt
ldx #0 ;clear the accs.
ldy #0 ;result initially zero.
umultc
txa
asl a ;multiply by two.
tax
tya
rol a
tay
bcs omerr1 ;to much!
asl curtol
rol curtol+1
bcc umlcnt ;nothing in this position to multiply.
clc
txa
adc addend
tax
tya
adc addend+1
tay
bcs omerr1 ;man, just too much!
umlcnt
dec deccnt ;done?
bne umultc ;keep it up.
rts ;yes, all done.


fmaptr lda count
asl a
adc #5 ;point to entries. c cleared by asl.
adc lowtr
ldy lowtr+1
bcc 1$
iny
1$ sta arypnt
sty arypnt+1
rts

;end

+ 18
- 0
BASIC_C128/auto.src View File

@@ -0,0 +1,18 @@

.page
.subttl AUTO Command

; auto increment
; syntax : auto {line-number}
; line-number = 0 means turn off

auto
jsr errind
jsr linget
lda linnum
sta autinc
lda linnum+1
sta autinc+1
jmp ready

;end

+ 25
- 0
BASIC_C128/bank.src View File

@@ -0,0 +1,25 @@
.page
.subttl BANK Command

;********************************************************
;*
;* Set Context Bank for SYS, PEEK, POKE.
;*
;* Syntax: BANK n
;* Where:
;* n=0 ==> ram 0
;* n=1 ==> ram 1
;* n=14 ==> system rom / io out (charrom in)
;* n=15 ==> system rom / io in
;*
;********************************************************

bank jsr getbyt ;get bank number in .x
cpx #16
bcs 10$ ;bank >15 is an error
stx current_bank
rts

10$ jmp fcerr ;illegal value error

;end

+ 47
- 0
BASIC_C128/basic.map View File

@@ -0,0 +1,47 @@
.page
; a brief explanation of the pointer structure in basic:
;
; RAM bank 0 RAM bank 1
; FFFF |---------------|<=(MAX_MEM_0)* |---------------|<=(MAX_MEM_1)
; | | | |
; | | | |
; | Free RAM | | Strings |
; | | | |
; | | | |
; | | |---------------|<===(FRETOP)
; | | | |
; |---------------|<==(TEXT_TOP) | |
; | | | |
; | | | |
; | | | |
; | Text area | | |
; | | |---------------|<===(STREND)
; | | | |
; | | | |
; 4000===>|---------------|<=\ | Arrays |
; | | \ | |
; | Bit Mapped | \ | |
; | Screen | (TXTTAB) | |
; | (Sometimes) | / |---------------|<===(ARYTAB)
; |(and color RAM)| / | |
; 1C00===>|---------------|<=/ | |
; | | | |
; | Misc. Buffers | | |
; | | | |
; 1000===>|---------------| | |
; | | | Variables |
; | Misc. Var's | | |
; | | | |
; 0800===>|---------------| | |
; | | | |
; | Text Screen | | |
; | | | |
; 0400===>|---------------|<=============>|---------------|<===(VARTAB)
; | | | |
; | Common RAM | | Common RAM |
; | | | |
; 0000 |_______________| |_______________|
;
;
; 1. * indicates a new pointer.


+ 173
- 0
BASIC_C128/basic.src View File

@@ -0,0 +1,173 @@
.nam C128 BASIC (318018,19-04 RELEASE: 11/07/86)
.formln 60

.include disclaim

.include basic.map
.include display.map
.include sysdoc
.include relnotes
.include declare
.include entries
.include header
.include init
.include indjumps
.include crunch
.include tokens1
.include tokens2
.include disptable
.include errmsgs
.include errprint
.include execute
.include functions
.include code0
.include rtstack
.include findline
.include lineget
.include list ;command
.include newclr ;command
.include return ;command
.include remdata ;command
.include if ;command
.include ongoto ;command
.include let ;command
.include print ;command
.include input ;command
.include next ;command
.include dim ;command
.include sys ;command
.include trontroff ;command
.include rreg ;command
.include midequal ;command
.include auto ;command
.include help ;command
.include gosubgoto ;command
.include go ;command
.include continue ;command
.include run ;command
.include restore ;command
.include renumber ;command
.include for ;command
.include delete ;command
.include pudef ;command
.include trap ;command
.include resume ;command
.include doloop ;command
.include key ;command
.include paint ;command
.include box ;command
.include sshape ;command
.include gshape ;command
.include circle ;command
.include draw ;command
.include char ;command
.include locate ;command
.include scale ;command
.include color ;command
.include scnclr ;command
.include graphic ;command
.include bank ;command
.include sleep ;command
.include wait ;command
.include sprite ;command
.include movspr ;command
.include play ;command
.include filter ;command
.include envelope ;command
.include collision ;command
.include sprcolor ;command
.include width ;command
.include volume ;command
.include sound ;command
.include window ;command
.include boot ;command
.include sprdef ;command
.include sprsav ;command
.include fast ;command
.include slow ;command
.include checkval
.include formeval
.include variables
.include getpointr
.include array

.ifge *-$7f00 ;put a break of AT LEAST 1 page for patch code
.messg "*** ADDRESS CHECK ***" ;..before next rom starts (at $8000)
.endif

.include patcheslo

.ifge *-$8000 ;..next rom starts at $8000
.messg "*** ADDRESS CHECK ***"
.endif

*=$8000

.include fre ;function
.include val ;function
.include dec ;function
.include peekpoke
.include errfunc ;function
.include hexfunc ;function
.include rgr ;function
.include rclr ;function
.include joy ;function
.include penpot ;function
.include pointer ;function
.include rsprite ;function
.include rspcolor ;function
.include bump ;function
.include rsppos ;function
.include xor ;function
.include rwindow ;function
.include rnd ;function
.include code12
.include def
.include stringfns
.include strings
.include code17
.include code18
.include code19
.include code21
.include code22
.include code23
.include code24
.include code26
.include grbcol
.include trig
.include using
.include instring
.include graphic3
.include rdot
.include graphic7
.include graphic8
.include graphic9
.include graphic10
.include graphic11
.include sethires
.include clrhires
.include dos1
.include dos2
.include dos3
.include dos4
.include overflow
.include irq
.include stash
.include fetch
.include swap
.include patcheshi

.ifge *-$af00 ;make sure JUMPTABLE starts at $af00
.messg "*** ADDRESS CHECK ***"
.endif
*=$af00

.include jumptable

.ifge *-$b000 ;make sure end of code doesn't overflow ROM
.messg "*** ADDRESS CHECK ***"
.endif


.subttl *************** cross reference *****************
.end

+ 145
- 0
BASIC_C128/bground.src View File

@@ -0,0 +1,145 @@
.page
.subttl Basic memory maps

; a brief explanation of the pointer structure in basic:
;
; RAM bank 0 RAM bank 1
; FFFF |---------------|<===(VARMAX)* |---------------|<===(MEMSIZ)
; | | | |
; | | | |
; | Free RAM | | Strings |
; | | | |
; | | | |
; |---------------|<===(VAREND)* | |
; | | |---------------|<===(FRETOP)
; | Variables | | |
; | | | |
; |---------------|<===(VARTAB) | |
; | | | |
; | | | |
; | | | |
; | Text area | | Free RAM |
; | | | |
; | | | |
; | | | |
; 4000===>|---------------|<=\ | |
; | | \ | |
; | Bit Mapped | \ | |
; | Screen | (TXTTAB) | |
; | (Sometimes) | / |---------------|<===(STREND)
; |(and color RAM)| / | |
; 1C00===>|---------------|<=/ | |
; | | | |
; | Misc. Buffers | | |
; | | | |
; 1000===>|---------------| | |
; | | | Arrays |
; | Misc. Var's | | |
; | | | |
; 0800===>|---------------| | |
; | | | |
; | Text Screen | | |
; | | | |
; 0400===>|---------------|<=============>|---------------|<===(ARYTAB)
; | | | |
; | Common RAM | | Common RAM |
; | | | |
; 0000 |_______________| |_______________|
;
;
; 1. * indicates a new pointer.
.page

;"RAM.MAP"
;
; | |
; | |
; | |
; | |
; $4000 |-----------------------| <--- Bottom of BASIC text when
; | | graphics area is allocated.
; | |
; | |
; | Bit map |
; | Screen |
; | |
; | (In graphics mode) |
; | |
; | |
; | |
; | |
; $2000 |-----------------------|
; | |
; | Video Matrix #2 |
; | (In graphics mode) |
; | |
; $1C00 |-----------------------| <---- Bottom of BASIC text when no
; | RS232 Buffers (2 pgs),| graphics area is allocated.
; | PF Key Buf. (1 pg), |
; | Sprite def'n (2 pgs) |
; | |
; $1000 |-----------------------|
; | |
; | Misc. vars & buffers |
; | |
; | |
; $0800 |-----------------------|
; | |
; | Text Screen / |
; | Video Matrix 1 |
; | |
; $0400 |-----------------------|
; | |
; | System |
; | Ram |
; | |
; |_______________________|
;
;end
.page

; "DISPLAY.MAP"
; TEXT HIRES MULTI HIRES MULTI
; MODE BIT-MAPPED BIT-MAPPED SPLIT SPLIT
; | |
; $DC00 |-------| ------------ ------------ ------------ ------------ ------------
; | | | Text color Bit-mapped Text color Text color/ (*1)
; | | | info. color info. info. BM color info.
; $D800 |-------| ------------ ------------ ------------ ------------ ------------
; | |
; | |
; ~ ~
; | |
; | |
; $4000 |-------| ------------ ------------ ------------ ------------ ------------
; | | |
; | | | Not Bit Bit Bit Bit
; | ~ ~ map map map map
; | | | used. screen screen screen screen
; | | |
; $2000 |-------| ------------ ------------ ------------ ------------ ------------
; | | | Not Bit-mapped Bit-mapped Bit-mapped Bit-mapped
; | | | used. color info. color info. color info. color info.
; $1C00 |-------| ------------ ------------ ------------ ------------ ------------
; | |
; | |
; | |
; $0800 |-------| ------------ ------------ ------------ ------------ ------------
; | | | Text Not Not Text Text
; | | | screen used. (*2) used. (*2) screen screen
; $0400 |-------| ------------ ------------ ------------ ------------ ------------
; | |
; | |
;
; (*1) There are actually 2 banks of RAM that can be mapped into this slot in the map. By
; selecting one bank during the BM portion of the screen (top), and the other during
; the TEXT portion of the screen (bottom), each mode will have unique RAM for it's
; own purposes.
;
; (*2) Although the information on the TEXT screen is not actually being displayed at this
; time, it is still being acessed and updated during any operation normally routed to
; the screen (such as default print statements, error messages, etc.) "Not used" is
; NOT meant to imply that during this mode, all print operations are going into the
; bit-bucket.

;end

+ 45
- 0
BASIC_C128/boot.src View File

@@ -0,0 +1,45 @@
.page
.subttl BOOT Command

;****************************************************************************
;
; BOOT - Boot a 'BOOT' disk, or 'BLOAD' a file, and SYS to it.
;
; Syntax : Same as 'BLOAD'
; if 'filename' present, assume 'BLOAD' and sys to starting addr.
; else call kernal 'BOOT' routine, with our device & unit #'s as args.
;
;****************************************************************************

boot lda #$e6 ;set up parms for parse routine
ldx #$fc
jsr dosprx ;parse

lda parsts ;was there a filename?
lsr a
bcc 20$ ;no, do kernal BOOT

jsr bload_1 ;finish 'BLOAD' command
bcs 30$ ;if error (c=1), tell 'em about it!
ldx current_bank ;assume no B(ank) arg was given
lda parstx
lsr a
bcc 10$ ;branch if no arg.
ldx dosbnk ;..otherwise, get users bank number
10$ stx _bank
lda _starting_addr ;set up address BLOAD loaded to
sta _pclo
lda _starting_addr+1
sta _pchi
jmp _jjsr ;go do it!

20$ lda dosds1 ;get drive number
ora #'0' ;make ascii
ldx dosfa ;get unit number
jsr put_io_in_map
jsr _boot_call
bcs 30$ ;branch if error
rts

30$ jmp erexit
;end

+ 238
- 0
BASIC_C128/box.src View File

@@ -0,0 +1,238 @@
.page
.subttl BOX Command

;**************************************************************
;
; box (s), p1 ( , (p2) (, (ang) , fill ) ) -- draw a box
; s = color (1-4) (default=fg (1))
; p1 = a corner coordinate
; x2,y2 = opposite diagonal coordinate
; (default = current xpos/ypos)
; ang = rotation angle (default = 0)
; fill = fill with color (default = 0)
;
;*************************************************************

box jsr grpcol ;make sure a graphics area has been allocated, get color
ldx #xcord1-vwork
jsr incor3 ;get x/y coordinates
ldx #xcord2-vwork
jsr incor2 ;get optional 2nd x/y coordinates
jsr optwrd ;get 2 byte angle, or 0,0 if no arg.
sty boxang
sta boxang+1 ;save rotation angle
jsr optzer
cpx #2
bcc 1$ ;good arg
jmp fcerr ;illegal value

1$ stx filflg
txa
pha
jsr boxsub ;set up values & get 1st side
pla
bne boxfil ;skip if to be filled
beq box15

box10
jsr boxpnt ;get next position
box15
jsr drawln ;connect to last position
lda angcnt
bne box10 ;loop 4 times
box20
ldx #4
box30
lda xcord2-1,x ;reset xpos/ypos to x2,y2
sta xpos-1,x
dex
bne box30
stx filflg ;clear fill flag
rts



;***********************************************************
;
; boxfil -- same as box except fill rectangle with color
;
;***********************************************************

boxfil
ldx #0
lda angsgn
lsr a
bcc boxf05
ldx #2
boxf05
lda xcord1+16,x
sta bxleng ;save absolute difference
lda xcord1+17,x
sta bxleng+1
lda #0
ldx #3
boxf10
sta xcount,x ;init values to zero
dex
bpl boxf10
;
; fill box by drawing lines connecting opposite sides of the box
;
boxf20
ldx #7
boxf25
lda xpos,x ;save coordinates
pha
dex
bpl boxf25
jsr drawln ;connect the two points
ldx #0
boxf28
pla
sta xpos,x ;restore coordinates
inx
cpx #8
bne boxf28
boxf30
lda bxleng
bne boxf40 ;check count
dec bxleng+1
bmi box20 ;exit if down to zero
boxf40
dec bxleng ;decrement count
ldx #xcount-vwork
ldy #cosval-vwork
lda angsgn
lsr a
bcc boxf45
ldy #sinval-vwork
boxf45
lda #0
boxf50
lsr a
pha
jsr addtwo ;add inc value to count of increment
sta vwork,x
tya ;save sum to count of increment
sta vwork+1,x
pla
bcc boxf60
ora #$a0 ;flag to show to increment position
boxf60
inx
inx
ldy #sinval-vwork
lsr angsgn
bcc boxf65
ldy #cosval-vwork
boxf65
rol angsgn
cpx #ycount-vwork
beq boxf50 ;loop to do y-increment
ldx #6
asl a
beq boxf30 ;loop if neither position incremented
boxf70
bcc boxf80 ;skip increment to position
inc xpos,x
bne boxf80
inc xpos+1,x
boxf80
asl a
dex
dex
bpl boxf70 ;loop 4 times
bmi boxf20 ;loop to connect points



;**************************************************************
;
; boxsub - set up coordinate positions for box drawing
; get first coordinate point
;
;*************************************************************

boxsub
ldy #boxang-vwork
jsr getang ;set up sine & cosine values for rotation angle
ldx #xcord1-vwork
ldy #xcord2-vwork
boxs10
tya
pha
jsr abstwo
sta vwork+4,x ;set distance = abs(coord1-coord2)
sta vwork+8,x
sta vwork+16,x
tya
sta vwork+5,x ;save high byte
sta vwork+9,x
sta vwork+17,x
pla
tay
jsr addtwo
sta vwork,x ;set center pts = coord1+coord2
tya
sta vwork+1,x
ldy #ycord2-vwork
inx
inx
cpx #ycord1-vwork
beq boxs10 ;loop to do y values
lda #$90
jsr angdst ;set up xang1-4
lda angsgn
and #03
sta angsgn ;mask to 1 of four angle phases
tax
lda boxtab,x ;get values for 1st points
jsr boxpnt ;set pt1 = xctr-xd*cos+yd*sin , yctr-xd*sin-yd*cos
jsr dstpos ;move to xpos/ypos
lda angcnt
jsr boxpnt ;get next coordinate counter clockwise
ldx angsgn
lda boxtab,x
and #$f0
sta angcnt+1
lda boxtab+4,x
sta angcnt
rts

boxtab
.byte $be,$e4,$41,$1b,$41,$1b,$be,$e4
.byte $46,$52,$45,$44,$20,$42,$0d
.byte $54,$45,$52,$52,$59,$20,$52,$0d
.byte $4d,$49,$4b,$45,$20,$49,$0d



;*************************************************************
;
; boxpnt -- get the next box corner point
; pt(x) = xcenter +/- xd*cos +/- yd*sin
; pt(y) = ycenter +/- xd*sin +/- yd*cos
; a = +/-,+/-,+/-,+/-
;
;*************************************************************

boxpnt
jsr anglpt ;get coordinate point
ldx #4
boxp10
lda xpos+1,x
asl a ;carry sign into shift
ror xpos+1,x ;divide by 2 to scale
ror xpos,x
bcc boxp20
inc xpos,x ;add 1 for rounding
bne boxp20
inc xpos+1,x
boxp20
inx
inx
cpx #6
beq boxp10 ;loop to divide ydest
rts

;.end

+ 236
- 0
BASIC_C128/boxwork.src View File

@@ -0,0 +1,236 @@
.page
.subttl BOX Command

;**************************************************************
;
; box (s), p1 ( , (p2) (, (ang) , fill ) ) -- draw a box
; s = color (1-4) (default=fg (1))
; p1 = a corner coordinate
; x2,y2 = opposite diagonal coordinate
; (default = current xpos/ypos)
; ang = rotation angle (default = 0)
; fill = fill with color (default = 0)
;
;*************************************************************

box jsr grpcol ;make sure a graphics area has been allocated, get color
ldx #xcord1-vwork
jsr incor3 ;get x/y coordinates
ldx #xcord2-vwork
jsr incor2 ;get optional 2nd x/y coordinates
jsr optwrd ;get 2 byte angle, or 0,0 if no arg.
sty boxang
sta boxang+1 ;save rotation angle
jsr optzer
cpx #2
bcc 1$ ;good arg
jmp fcerr ;illegal value

1$ stx filflg
txa
pha
jsr boxsub ;set up values & get 1st side
pla
bne boxfil ;skip if to be filled
beq box15

box10
jsr anglpt ;get next position
box15
jsr drawln ;connect to last position
lda angcnt
bne box10 ;loop 4 times
box20
ldx #4
box30
lda xcord2-1,x ;reset xpos/ypos to x2,y2
sta xpos-1,x
dex
bne box30
stx filflg ;clear fill flag
rts

.page
;***********************************************************
;
; boxfil -- same as box except fill rectangle with color
;
;***********************************************************

boxfil
ldx #0
lda angsgn
lsr a
bcc boxf05
ldx #2
boxf05
lda xcord1+16,x
sta bxleng ;save absolute difference
lda xcord1+17,x
sta bxleng+1
lda #0
ldx #3
boxf10
sta xcount,x ;init values to zero
dex
bpl boxf10
;
; fill box by drawing lines connecting opposite sides of the box
;
boxf20
ldx #7
boxf25
lda xpos,x ;save coordinates
pha
dex
bpl boxf25
jsr drawln ;connect the two points
ldx #0
boxf28
pla
sta xpos,x ;restore coordinates
inx
cpx #8
bne boxf28
boxf30
lda bxleng
bne boxf40 ;check count
dec bxleng+1
bmi box20 ;exit if down to zero
boxf40
dec bxleng ;decrement count
ldx #xcount-vwork
ldy #cosval-vwork
lda angsgn
lsr a
bcc boxf45
ldy #sinval-vwork
boxf45
lda #0
boxf50
lsr a
pha
jsr addtwo ;add inc value to count of increment
sta vwork,x
tya ;save sum to count of increment
sta vwork+1,x
pla
bcc boxf60
ora #$a0 ;flag to show to increment position
boxf60
inx
inx
ldy #sinval-vwork
lsr angsgn
bcc boxf65
ldy #cosval-vwork
boxf65
rol angsgn
cpx #ycount-vwork
beq boxf50 ;loop to do y-increment
ldx #6
asl a
beq boxf30 ;loop if neither position incremented
boxf70
bcc boxf80 ;skip increment to position
inc xpos,x
bne boxf80
inc xpos+1,x
boxf80
asl a
dex
dex
bpl boxf70 ;loop 4 times
bmi boxf20 ;loop to connect points

.page
;**************************************************************
;
; boxsub - set up coordinate positions for box drawing
; get first coordinate point
;
;*************************************************************

boxsub
ldy #boxang-vwork
jsr getang ;set up sine & cosine values for rotation angle
ldx #xcord1-vwork
ldy #xcord2-vwork
boxs10
tya
pha
jsr box_patch_1 ; (318018-03 mod; fab: fix values >16383)
sta vwork+4,x ;set distance = abs(coord1-coord2)
sta vwork+8,x
sta vwork+16,x
tya
sta vwork+5,x ;save high byte
sta vwork+9,x
sta vwork+17,x
pla
tay
jsr box_patch_2 ; (318018-03 mod; fab: fix values >16383)
sta vwork,x ;set center pts = coord1+coord2
tya
sta vwork+1,x
ldy #ycord2-vwork
inx
inx
cpx #ycord1-vwork
beq boxs10 ;loop to do y values
lda #$90
jsr angdst ;set up xang1-4
lda angsgn
and #03
sta angsgn ;mask to 1 of four angle phases
tax
lda boxtab,x ;get values for 1st points
jsr anglpt ;set pt1 = xctr-xd*cos+yd*sin , yctr-xd*sin-yd*cos
jsr dstpos ;move to xpos/ypos
lda angcnt
jsr anglpt ;get next coordinate counter clockwise
ldx angsgn
lda boxtab,x
and #$f0
sta angcnt+1
lda boxtab+4,x
sta angcnt
rts

boxtab
.byte $be,$e4,$41,$1b,$41,$1b,$be,$e4
.byte $46,$52,$45,$44,$20,$42,$0d
.byte $54,$45,$52,$52,$59,$20,$52,$0d
.byte $4d,$49,$4b,$45,$20,$49,$0d
.page
;*************************************************************
;
; boxpnt -- get the next box corner point
; pt(x) = xcenter +/- xd*cos +/- yd*sin
; pt(y) = ycenter +/- xd*sin +/- yd*cos
; a = +/-,+/-,+/-,+/-
;
; **** 318018-03 mod- this subbie no longer called. FAB ****
;
;*************************************************************

boxpnt
jsr anglpt ;get coordinate point
ldx #4
boxp10
lda xpos+1,x
asl a ;carry sign into shift
ror xpos+1,x ;divide by 2 to scale
ror xpos,x
bcc boxp20
inc xpos,x ;add 1 for rounding
bne boxp20
inc xpos+1,x
boxp20
inx
inx
cpx #6
beq boxp10 ;loop to divide ydest
rts

;.end

+ 33
- 0
BASIC_C128/bump.src View File

@@ -0,0 +1,33 @@
.page
.subttl BUMP Function

;******************************************************************
;*
;* BUMP - read sprite collision
;*
;* Syntax : BUMP (argument)
;*
;* Where : argument = [1..2]
;* 1 : sprite/sprite collision
;* 2 : sprite/background collision
;*
;******************************************************************

bump jsr chkcls
jsr conint ;get arg in .X
dex ;adjust [1..2] to [0..1
cpx #2
bcs 98$ ;value error

sei
ldy vic_save+17,x ;get collision info
lda #0
sta vic_save+17,x ;..and reset for next read
cli

jmp sngflt ;float 1 byte arg in .Y


98$ jmp fcerr ;bad value error

;end

+ 255
- 0
BASIC_C128/char.src View File

@@ -0,0 +1,255 @@
.page
.subttl CHAR Command

;*****************************************************************
;
; char (s),x,y,str(,r) -- display a character string
; s = color selection (1-4) (default is foreground (1))
; x,y = column/row position for 1st character
; str = character string (1-255)
; r = normal(0) or reverse(1)
;
;*****************************************************************

char jsr incolr ;get color selection

ldx #llen+1 ;set up screen size. assume graphics
ldy #nlines+1
lda _graphm ;test if assumption correct
bne 10$ ;..it's twooo! it's twooo!
jsr _screen_org ;it's text. test how large the virtual window is
inx
iny

10$ stx colcnt
sty rowcnt

jsr combyt ;check comma, get column number
cpx colcnt
bcs charer ;exit - col number too large
stx colcnt

jsr combyt ;check comma, get row number
cpx rowcnt
bcc char10 ;skip if okay

charer jmp fcerr ;exit - illegal value

char10 stx rowcnt ;initialize column counter
jsr chrgot ;end of line?
bne 10$ ;no, go get string

lda #0 ;force a length of zero,
beq 20$ ;..and skip over string handler

10$ jsr chkcom ;check for comma

jsr frmstr ;do frmevl, frestr. returns len in a, index points to string
20$ sta sw_rom_ram0
sta numcnt ;save length
tya
pha ;save index
txa
pha

jsr optzer ;look for optional invert (def. is 0, normal)
txa ;move .x's lsb to xysgn's msb
ror a
ror xysgn

pla ;restore 'index' (ptr to string)
sta index
pla
sta index+1
lda _graphm
bne char20 ;skip if not text screen

; case: printing to text screen

ldx rowcnt ;text mode: treat like 'print at x,y,string'
ldy colcnt
clc
jsr char_patch ;move cursor (318018-03 mod: fab; call plot w/IO in)
ldy #0

bit xysgn ;test if reverse flag set
bpl 30$ ;branch if not
lda #18 ; (318018-03 mod: FAB; call print w/IO in)
jsr k_print ;otherwise send 'reverse on' character

30$ cpy numcnt
beq 40$
jsr indin1_ram1 ;get the character from the string
jsr put_io_in_map
jsr _print ;print to text screen
iny
bne 30$

40$ bit xysgn ;test if reverse flag set
bpl 50$ ;branch if not
lda #146 ; (318018-03 mod: FAB; call print w/IO in)
jsr k_print ;else send 'reverse off' char, do rts
50$ rts


; case: printing to bit mapped screen

char20 jsr isgrap ;make sure a graphic area has been allocated

lda upper_graphic
sta character_rom ;set up pointer to upper/graphic character base

lda foreground
tax
pha ;save foreground color
lda colsel
pha
bit _graphm
bpl char25 ;skip if not multicolor mode
pla ;colsel
beq char27 ;use fgnd color (feature)
lsr a
beq char27 ;use fgnd color
ldx multicolor_1
bcc char27 ;use multicolor-1
ldx multicolor_2
bcs char27 ;use multicolor-2

char25 ldx foreground ;high-res mode
pla ;colsel
bne char27 ;use foreground color
jsr put_io_in_map
ldx vic_background

char27 stx foreground
ldx rowcnt
ldy #0
sty strcnt ;initialize string counter

char30 ldy strcnt ;get string offset
inc strcnt ;increment offset
jsr indin1_ram1 ;get string character
sta sw_rom_ram0
dec numcnt
bmi char50 ;exit if end of string

cmp #14 ;is character 'go to upper/lower'?
bne 10$ ;no, go on.
lda upper_lower
bne 20$

10$ cmp #142 ;is character 'go to upper/graphic'?
bne 30$ ;no, go on.
lda upper_graphic
20$ sta character_rom ;point to correct rom
bne 40$ ;always

30$ ldy colcnt
jsr chrdsp ;not special, so display the character
inc colcnt ;increment column count

40$ cpy #llen-1 ;check if at end
bcc char30 ;loop if not
ldy #0
sty colcnt ;set to start of next line
inx
cpx #24
bcc char30 ;loop if not at end of screen

char50 pla
sta foreground ;restore color
rts



;*****************************************************************
;
; chrdsp - display a character
; x = row number
; y = column number
; a = character
;
;*****************************************************************

chrdsp pha ;save character
jsr docolr ;set colors

tya ;get addr for row (X) and col (Y) in grapnt
clc
adc _ldtb2,x ;add column position to low byte offset
sta grapnt
lda _ldtb1,x ;get high byte screen address
adc #0 ;add any carry
asl grapnt
rol a
asl grapnt ;mult by 8 to get offset into 8k area
rol a
asl grapnt
rol a
sta grapnt+1

sta sw_rom_ram0 ;mostly here to take i/o out of map
lda #0
sta z_p_temp_1
pla ;recall character
pha
asl a ;multiply by 8 to get char rom addr
rol z_p_temp_1
asl a
asl a
rol z_p_temp_1
sta index2
lda z_p_temp_1
adc character_rom ;get char rom base
sta index2+1
tya
pha ;save column number
ldy #7

movchr lda xysgn ;rvs fld flag
asl a
lda (index2),y ;get char byte (was jsr charin)
bcc movch0 ;invert fields if carry set
eor #$ff

movch0 bit _graphm ;get graphic mode
bpl dochr0 ;skip if not multicolor

and #$aa ;remove every other bit
sta z_p_temp_1
lda colsel ;what is color source?
bne movch1
lda z_p_temp_1
bcs movrvs ;bgnd: is it rvs fld?
lsr a ;bgnd (do fgnd on mc#1)
eor z_p_temp_1
eor #$aa
bne dochr0
movrvs
ora #$55 ;bgnd rvs (do fgnd on mc#2)
bne dochr0
movch1
cmp #2
bne movch2
lda z_p_temp_1 ;mc#1 pattern '10'
bcs dochr0
movch2
bcc movch3
lda z_p_temp_1 ;mc#2 pattern '11'
lsr a
eor z_p_temp_1
bcc dochr0
movch3
lda z_p_temp_1 ;fgnd pattern '01'
lsr a

dochr0
sta (grapnt),y ;save into graphic bit map
dey
bpl movchr
pla
tay ;restore colnum
pla ;restore character
rts

;end

+ 28
- 0
BASIC_C128/checkval.src View File

@@ -0,0 +1,28 @@
.page
.subttl form/check value types
;
; these routines check for certain "valtyp".
; (c) is not preserved.
;


frmnum jsr frmevl

chknum clc
bcc chkval

chkstr sec ;set carry.

chkval bit valtyp
bmi docstr
bcs chkerr
chkok rts

docstr bcs chkok
chkerr ldx #errtm
.byte $2c
sterr ldx #errst
jmp error

;.end


+ 178
- 0
BASIC_C128/circle.src View File

@@ -0,0 +1,178 @@
.page
.subttl CIRCLE Command

;*************************************************************
;
; circle s,(pc),xr(,(yr)(,(as)(,(ae)(,(rot) (,inc) ) ) ) )
; -- draw an ellipse
; s = color selection (1-4) (default = fg (1))
; pc = center coordinates (default = xpos,ypos)
; xr = x-radius - yr = y-radius (default = xr)
; as,ae = arc start & arc end (defalut = 0)
; rot = rotation angle (default = 0)
; inc = increment to next point (default = 2)
;
;*************************************************************

circle jsr grpcol ;make sure graphics area has been allocated, get color
ldx #xcircl-vwork
jsr incor2 ;get optional center coordinates
jsr optwrd ;get 2-byte x-radius (default to zero?)
sty xradus
sta xradus+1
jsr optwrd ;get 2-byte y-radius (.c=0 if not given)
sty yradus
bcs 10$ ;branch if y-radius given (318018-03 mod; fab)

lda xradus ;else use x radius for y as well
sta yradus
lda xradus+1
bit _graphm
bpl 10$ ;skip if not multicolor mode
asl yradus ;double it for circle
rol a
10$ sta yradus+1

ldx #xradus-vwork
jsr scalxy ;scale the values ;(318018-03 mod; fab)
.byte $ea,$ea,$ea,$ea,$ea ;(318018-03 placeholder; fab)

jsr optwrd ;get optional 2-byte arc start
sty angbeg
sta angbeg+1

jsr optwrd ;get optional 2-byte arc end
sty angend
sta angend+1

jsr optwrd ;get optional 2-byte rotation angle
sta z_p_temp_1 ;swap y and a
tya
ldy z_p_temp_1
jsr gtang1 ;set sine & cosine for rotation angle

ldx #angend-vwork ;test if angend>angbeg
ldy #angbeg-vwork
jsr subtwo
bcc circ10 ;skip if yes
lda #104
ldy #1
jsr addtw2 ;add 360 to arc-end
sta vwork,x
tya
sta vwork+1,x
circ10
ldx #3
circ20
lda xradus,x ;duplicate x-rad/y-rad in xdist2/ydist2
sta xdist2,x
dex
bpl circ20
lda #$90
jsr angdst ;get distances * rotation angle

; xdist1 = xr*cos -- ydist1 = yr*sin
; xdist2 = xr*sin -- ydist2 = yr*cos

ldx #7
circ30
lda xdist1,x ;move for later use
sta xrcos,x
dex
bpl circ30
jsr cirsub ;get 1st point on circle
jsr dstpos ;move to xpos/ypos

; draw circle with connected lines
; incrementing angbeg by cirinc for each point

ldx #2
jsr optbyt ;get optional 1 byte increment value (default is 2)
txa ;must be >0
bne 40$ ;ok
jmp fcerr ;bad

40$ stx circle_segment
clc

circ45 lda circle_segment
adc angbeg ;add increment (carry assumed clear)
sta angbeg
bcc circ50
inc angbeg+1
circ50 ldx #angend-vwork ;test if angend>angbeg
ldy #angbeg-vwork
jsr subtwo
bcs cirend ;yes - do once more
jsr cirsub ;get next point on circle
jsr drawln ;connect to last point
bcc circ45 ;loop always
cirend
ldy #angend-vwork
jsr cirs10 ;get last point for arc-end
jmp drawln

.page

;***********************************************************
;
; cirsub -- find the next point on the circle
; x = xctr + xr*cos(a)*sin(b) + yr*sin(a)*cos(b)
; y = yctr + xr*sin(a)*sin(b) - yr*cos(a)*cos(b)
; where: a = rotation angle -- b = circle arc angle
;
;***********************************************************

cirsub ldy #angbeg-vwork

cirs10 jsr getang ;get sine & cosine values for arc angle

ldx #7
1$ lda xrcos,x ;move radius * rotation-angle values to xdist
sta xdist1,x
dex
bpl 1$

lda #$50
jsr angdst ;multiply times arc-angle values
lda #$10 ;fall thru to angplt


;**************************************************************
;
; anglpt -- determine a point on the screen
; xdest = xcentr +/- xdist1 +/- ydist1
; ydest = ycentr +/- xdist2 +/- ydist2
; a = signs: +/-,+/-,+/-,+/-,0,0,0,0
;
;**************************************************************

anglpt sta angcnt ;save plus or minus signs
ldy #xcentr-vwork
ldx #xdist1-vwork

10$ asl angcnt+1
rol angcnt ;get sign
jsr dotwo ;add or subtract 1st value to center pt
inx
inx ;point to next value
asl angcnt+1
rol angcnt ;get next sign
jsr dotwo2 ;add or subtract to previous result
pha
tya ;save 2-byte result on stack
pha
ldy #ycentr-vwork ;set to do y-point
inx
inx ;point to next value
cpx #xdist2-vwork
beq 10$ ;loop to do y-point

ldx #3
20$ pla
sta xdest,x ;move results to xdest/ydest
dex
bpl 20$
rts

;.end

+ 69
- 0
BASIC_C128/clrhires.src View File

@@ -0,0 +1,69 @@
.page
.subttl Clear Hires Mode Routines

; clear (de-allocate) 10k graphics area, if installed

clrhir lda mvdflg ;see if already cleared
bne 1$ ;branch if not,
rts ;else done

1$ ldy #0
sty mvdflg ;flag 'moved'
sty index1 ;set up pointers for memory transfer
sty index2
lda #$1c
sta index1+1 ;destination
lda #$40
sta index2+1 ;origin

2$ jsr indin2 ;lda (index2),y
sta (index1),y
iny
bne 2$ ;do 1 full page
inc index1+1
inc index2+1
lda text_top+1 ;test if page containing last bytes was moved
cmp index2+1
bcs 2$ ;keep going until msb of index2 > msb of strend

sec
lda txttab+1
sbc #$24
sta txttab+1

lda text_top+1
sbc #$24
sta text_top+1

lda datptr+1
sbc #$24
sta datptr+1

jmp seth30



addoff lda (fndpnt),y
bit mvdflg
bne 10$ ;if z then subtract.else add $30
sec
sbc #$24
sta (fndpnt),y
rts

10$ clc
adc #$24
sta (fndpnt),y
rts



isgrap lda mvdflg ;test if graphics mode allocated, error if not
beq isgrer ;oh-oh, bad news
rts ;ok!

isgrer ldx #errng ;'no graphics area' error
jmp error


;.end

+ 417
- 0
BASIC_C128/code0.src View File

@@ -0,0 +1,417 @@
.page
.subttl code0: 08/04/86

reddy jsr k_primm ;print immediate
.byte cr,'READY.',cr,0
rts

ready ldx #$80
.byte $2c

omerr ldx #errom

error jmp (ierror)
nerror sta sw_rom_ram0 ;bank ram 0 in (just in case)
txa
bmi readyx ;...branch if no error (from 'ready')
stx errnum ;save error # for 'er'
bit runmod ;direct mode?
bpl errisd ;yes...always display error text

ldy #1 ;copy curlin to errlin, oldtxt to errtxt
1$ lda curlin,y
sta errlin,y
lda oldtxt,y
sta errtxt,y
dey
bpl 1$

ldy trapno+1 ;is trap set?
iny
beq errisd ;no.
dey ;restore msb of line #
sty linnum+1
sty tmptrp ;save until a resume is executed
ldy trapno
sty linnum

ldx #$ff
jsr error_patch ;-04 FIX: reset string temps & flag no more traps
ldx oldstk
txs
jsr luk4it
jmp newstt
errisd
dex
txa
jsr erstup ;set up address of error msg in .a in index2
jsr k_clrch
lda #0
sta channl
bit _mode ;are we in 80 col?
bmi 10$ ;yes, don't reset graphics mode
sta _graphm ;make sure we're in text mode

10$ jsr crdo
jsr outqst
ldy #0

geterr lda (index2),y ;ind.ok
pha
and #127
jsr outdo
iny
pla
bpl geterr

jsr stkini
jsr k_primm
.byte ' ERROR',0

errfin ldy curlin+1 ;direct mode?
iny
beq readyx ;yes...no line #
jsr inprt




readyx jsr reddy ;print 'ready'
lda #$80
jsr _setmsg ;turn kernal messages on
lda #0
sta runmod ;turn run mode off



main jmp (imain)
nmain ldx #$ff
stx curlin+1
jsr inlin ;get a line from terminal
execute_a_line
stx txtptr ;txtptr is ptr to index buffer
sty txtptr+1
jsr chrget
tax

main00 beq main ;if end of line
bcc main1 ;if line number
jsr crunch
jsr chrgot ;get command
jmp xeqdir ;execute command



main1
jsr linget ;read line # into linnum
jsr crunch
sty count ;retain char count
jsr fndlin
bcc nodel ;no match, so don't delete

; test : if new line is longer than the line it replaces,
; then if there isn't enough room in memory to add this new line,
; then out-of-memory error
;
; before this fix, the old line was deleted BEFORE testing if the new line fit
;
;N.B.: I am assuming that lines cannot be greater than 255 chars, as is the
; case where the line was entered 'normally', that is, using LINGET, The only
; consequence of this assumption is that lines > 255 will fall prey to the
; pre-fix problem mentioned above.

ldy #0
jsr indlow ;get lsb of the next lines starting address
sec
sbc lowtr ;subtract lsb of this lines starting address
sec ;ignore borrow (gives abs. value)
sbc #4 ;allow for link & line number
sbc count ;compare with new length
bcs 3$ ;new line is shorter, no problem.
eor #$ff
adc #1 ;convert to positive delta (.c=0)

ldy text_top+1 ;get msb of end of text
adc text_top ;add our calculated delta to end of text
bcc 1$
iny
1$ cpy max_mem_0+1
bcc 3$ ;result is less than top-of-memory : ok
bne 2$ ;oops, overflow. too bad.
cmp max_mem_0 ;msb's the same, test lsb's
bcc 3$ ;ok if lsb is less than top,
2$ jmp omerr ;..else an error


3$ ldy #1
jsr indlow
sta index1+1
lda text_top ;text end
sta index1
lda lowtr+1 ;set xfer to
sta index2+1
dey
jsr indlow ;compute length
clc
sbc lowtr
eor #$ff ;make it negative
clc
adc text_top ;compute new text end
sta text_top
sta index2 ;set low of xfer to
lda text_top+1
adc #255
sta text_top+1 ;compute high of text end
sbc lowtr+1 ;compute # of blocks to move
tax
sec
lda lowtr
sbc text_top ;compute offset
tay
bcs qdect1 ;if text_top <= lowtr
inx ;dec due to carry and
dec index2+1 ;dec store so carry works
qdect1
clc
adc index1
bcc 10$
dec index1+1
clc

10$ jsr indin1
sta (index2),y
iny
bne 10$
inc index1+1
inc index2+1
dex
bne 10$

nodel jsr stkini ;jsr clearc removed since changes to text no longer
jsr lnkprg
ldy #0 ;..require trashing variables
lda (txtptr),y ;delete line?
bne 5$
jmp main00

5$ clc ;no...something to insert
lda text_top
ldy text_top+1
sta hightr
sty hightr+1 ;top of block to move

adc count ;length of characters in line
bcc 1$
iny
1$ clc
adc #4 ;plus link and line #
bcc 2$
iny
2$ sta highds ;destination of top
sty highds+1

; low block address is lowtr
; where it was left in the call to fndlin
;
cpy max_mem_0+1 ;make sure new top doesn't crash into top of available ram
bcc 4$ ;ok
bne 3$ ;out of memory
cmp max_mem_0
bcc 4$ ;ok
3$ jmp omerr ;out of memory

4$ sta text_top ;new top of text
sty text_top+1

.page
; Move text up to make room for an insertion.
;
; our story so far...
;
; (highds)= destination of (high address).
; (lowtr)= lowest addr to be transferred.
; (hightr)= highest addr to be transferred.
;
sec ;prepare to subtract.
lda hightr
sbc lowtr ;compute number of things to move.
sta index ;save it for later.
tay
lda hightr+1
sbc lowtr+1
tax ;put it in a counter register.
inx ;so that counter algorithm works.
tya ;see if low part of count is zero.
beq 60$ ;yes, go start moving blocks.
lda hightr ;no, must modify base address.
sec
sbc index ;borrow if off since (hightr) > (lowtr).
sta hightr ;save modified abse address.
bcs 30$ ;if no borrow, go shove it.
dec hightr+1 ;borrow implies sub 1 from high order.
sec

30$ lda highds ;mod base of dest addr.
sbc index
sta highds
bcs 50$ ;no borrow.
dec highds+1 ;decrement high order byte
bcc 50$ ;always skip

40$ jsr indhtr ;lda (hightr),y
sta (highds),y