Coco Roms: bas13.s annotate

author	William Astle <lost@l-w.ca>
date	Sat, 08 Dec 2018 19:57:01 -0700
parents
children

rev	line source
0 605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	1 *pragma nolist
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	2 include defs.s
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	3 *pragma list
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	5 ; COLOR BASIC ROM
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	7 org BASIC
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	8 ; This is the official set of ROM entry points. It is unfortunate that the generic input ("console in") routine is not exposed
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	9 ; here. It is also unfortunate that no open and close file routines are exposed. This and other oversignts led to a lot of
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	10 ; software either having to re-invent the wheel or calling directly into the ROM instead of via these official entry points.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	11 POLCAT fdb KEYIN ; indirect jump, get a keystroke
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	12 CHROUT fdb PUTCHR ; indirect jump, output character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	13 CSRDON fdb CASON ; indirect jump, turn cassette on and start reading
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	14 BLKIN fdb GETBLK ; indirect jump, read a block from tape
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	15 BLKOUT fdb SNDBLK ; indirect jump, write a block to tape
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	16 JOYIN fdb GETJOY ; indirect jump, read joystick axes
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	17 WRTLDR fdb WRLDR ; indirect jump, turn cassette on and write a leader
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	18 ; Initialization code.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	19 LA00E lds #LINBUF+LBUFMX+1 ; put the stack in the line input buffer which is a safe place for now
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	20 lda #0x37 ; enable the cartidge interrupt (to detect autostarting cartridges)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	21 sta PIA1+3
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	22 lda RSTFLG ; get warm start flag
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	23 cmpa #0x55 ; is it valid?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	24 bne BACDST ; brif not - cold start
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	25 ldx RSTVEC ; get warm start routine pointer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	26 lda ,x ; get first byte of the routine
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	27 cmpa #0x12 ; is it NOP?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	28 bne BACDST ; brif not - the routine is invalid so do a cold start
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	29 jmp ,x ; transfer control to the warm start routine
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	30 ; RESET/power on comes here
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	31 RESVEC leay LA00E,pcr ; point to warm start check code
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	32 LA02A ldx #PIA1 ; point to PIA1 - we're going to rely on the mirroring to reach PIA0
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	33 clr -3,x ; set PIA0 DA to direction mode
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	34 clr -1,x ; set PIA0 DB to direction mode
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	35 clr -4,x ; set PIA0 DA to inputs
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	36 ldd #0xff34
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	37 sta -2,x ; set PIA0 DB to outputs
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	38 stb -3,x ; set PIA0 DA to data mode
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	39 stb -1,x ; set PIA0 DB to data mode
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	40 clr 1,x ; set PIA1 DA to direction mode
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	41 clr 3,x ; set PIA1 DB to direction mode
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	42 deca
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	43 sta ,x ; set PIA1 DA bits 7-1 as output, 0 as input
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	44 lda #0xf8 ; set PIA1 DB bits 7-3 as output, 2-0 as input
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	45 sta 2,x
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	46 stb 1,x ; set PIA1 DA to data mode
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	47 stb 3,x ; set PIA1 DB to data mode
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	48 clr 2,x ; set VDG to alpha-numeric
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	49 ldb #2 ; make RS232 marking ("stop" bit)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	50 stb ,x
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	51 ldu #SAMREG ; point to SAM register
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	52 ldb #16 ; 16 bits to clear
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	53 LA056 sta ,u++ ; clear a bit
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	54 decb ; done all?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	55 bne LA056 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	56 sta SAMREG+9 ; put display at 0x400
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	57 tfr b,dp ; set direct page to 0
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	58 ldb #4 ; use as mask to check ram size input
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	59 clr -2,x ; strobe ram size low
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	60 bitb 2,x ; is the input set?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	61 beq LA06E ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	62 sta -5,u ; program SAM for 16Kx4 RAMs
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	63 sta -11,u ; the P bit is required to work with 16Kx4 RAMs
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	64 bra LA072
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	65 LA06E nop
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	66 nop
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	67 sta -3,u ; program SAM for 64Kx1 RAMs
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	68 LA072 jmp ,y ; transfer control to startup routine
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	69 ; Cold start jumps here
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	70 BACDST ldx #VIDRAM+1 ; point past the top of the first 1K of memory (for double predec below)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	71 LA077 clr ,--x ; clear a byte (last will actually try clearing LSB of RESET vector in ROM)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	72 leax 1,x ; move forward one byte (will set Z if we're done)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	73 bne LA077 ; brif not donw yet
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	74 jsr LA928 ; clear the screen
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	75 clr ,x+ ; put the constant zero that lives before the program
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	76 stx TXTTAB ; set beginning of program storage
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	77 LA084 lda 2,x ; get value from memory
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	78 coma ; make it different
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	79 sta 2,x ; try putting different into memory
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	80 cmpa 2,x ; did it matcH?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	81 bne LA093 ; brif not - we found the end of memory
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	82 leax 1,x ; move pointer forward
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	83 com 1,x ; restore the original memory contents
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	84 bra LA084 ; try another byte
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	85 LA093 stx TOPRAM ; save top of memory (one below actual top because we need a byte for VAL() to work)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	86 stx MEMSIZ ; save top of string space
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	87 stx STRTAB ; set bottom of allocated string space
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	88 leax -200,x ; allocate 200 bytes of string space
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	89 stx FRETOP ; set top of actually free memory
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	90 tfr x,s ; put the stack there
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	91 ldx #LA10D ; point to variable initializer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	92 ldu #CMPMID ; point to variables to initialize (first batch)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	93 ldb #28 ; 28 bytes in first batch
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	94 jsr LA59A ; copy bytes to variables
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	95 ldu #IRQVEC ; point to variables to initialize (second batch)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	96 ldb #30 ; 30 bytes this time
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	97 jsr LA59A ; copy bytes to variables
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	98 ldx -12,x ; get SN error address
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	99 stx 3,u ; set ECB's command handlers to error
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	100 stx 8,u
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	101 ldx #RVEC0 ; point to RAM vectors
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	102 ldd #0x394b ; write 75 RTS opcodes (25 RAM vectors)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	103 LA0C0 sta ,x+ ; put an RTS
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	104 decb ; done?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	105 bne LA0C0 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	106 sta LINHDR-1 ; make temporary line header data for line encoding have a nonzero next line pointer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	107 jsr LAD19 ; do a "NEW"
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	108 ldx #'E*256+'X ; magic number to detect ECB ROM
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	109 cmpx EXBAS ; is there an ECB ROM?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	110 lbeq EXBAS+2 ; brif so - launch it
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	111 andcc #0xaf ; start interrupts
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	112 ldx #LA147-1 ; point to sign on message
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	113 jsr LB99C ; print it out
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	114 ldx #BAWMST ; warm start routine address
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	115 stx RSTVEC ; set vector there
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	116 lda #0x55 ; warm start valid flag
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	117 sta RSTFLG ; mark warm start valid
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	118 bra LA0F3 ; go to direct mode
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	119 ; Warm start entry point
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	120 BAWMST nop ; valid routine marker
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	121 clr DEVNUM ; reset output/input to screen
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	122 jsr LAD33 ; do a partial NEW
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	123 andcc #0xaf ; start interrupts
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	124 jsr LA928 ; clear the screen
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	125 LA0F3 jmp LAC73 ; go to direct mode
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	126 ; FIRQ service routine - this handles starting autostart cartridges
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	127 BFRQSV tst PIA1+3 ; is it the cartridge interrupt?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	128 bmi LA0FC ; brif so
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	129 rti
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	130 LA0FC jsr LA7D1 ; delay for a while
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	131 jsr LA7D1 ; delay for another while
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	132 leay <LA108,pcr ; point to cartridge starter
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	133 jmp LA02A ; go initialize everything clean for the cartridge
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	134 LA108 clr RSTFLG ; force a cold start a cartridge reset
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	135 jmp ROMPAK ; transfer control to the cartridge
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	136 ; Variable initializers (first batch)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	137 LA10D fcb 18 ; mid band partition of the 1200/2400 Hz period
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	138 fcb 24 ; upper limit of 1200 Hz period
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	139 fcb 10 ; upper limit of 2400 Hz period
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	140 fdb 128 ; number of 0x55s for cassette leader
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	141 fcb 11 ; cursor blink delay
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	142 fdb 88 ; 600 baud delay constant
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	143 fdb 1 ; printer carriage return delay constant
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	144 fcb 16 ; printer tab field width
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	145 fcb 112 ; last printer tab zone
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	146 fcb 132 ; printer carriage width
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	147 fcb 0 ; printer carriage position
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	148 fdb LB44A ; default execution address for EXEC
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	149 inc CHARAD+1 ;* character fetching routines (DP portion) - we first do a two
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	150 bne LA123 ;* two stage increment of CHARAD then load the value into A
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	151 inc CHARAD ;* before transferring control to the bottom half routine in ROM
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	152 LA123 lda >0 ; NOTE: the 0 is a placeholder, extended addressing is required
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	153 jmp BROMHK
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	154 ; Variable initializers (second batch)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	155 jmp BIRQSV ; IRQ handler
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	156 jmp BFRQSV ; FIRQ handler
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	157 jmp LB44A ; default USR() address
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	158 fcb 0x80,0x4f,0xc7,0x52,0x59 ; random seed
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	159 fcb 0xff ; capslock flag - default to upper case
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	160 fdb DEBDEL ; keyboard debounce delay (why is it a variable?)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	161 jmp LB277 ; exponentiation handler vector
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	162 fcb 53 ; (command interpretation table) 53 commands
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	163 fdb LAA66 ; (command interpretation table) reserved words list (commands)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	164 fdb LAB67 ; (command interpretation table) jump table (commands)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	165 fcb 20 ; (command interpretation table) 20 functions
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	166 fdb LAB1A ; (command interpretation table) reserved words list (functions)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	167 fdb LAA29 ; (command interpretation table) jump table (functions)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	168 ; This is the signon message.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	169 LA147 fcc 'COLOR BASIC 1.3'
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	170 fcb 0x0d
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	171 fcc '(C) 1982 TANDY'
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	172 fcb 0
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	173 ; This is the "invalid colour" CLS easter egg text. Basically 11 wasted bytes
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	174 LA166 fcc 'MICROSOFT'
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	175 fcb 0x0d,0
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	176 ; Read a character from current device and mask off bit 7 (keep it as 7 bit ASCII)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	177 LA171 bsr LA176 ; get character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	178 anda #0x7f ; mask off high bit
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	179 rts
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	180 ; Generic read routine. Reads a character from the device specified by DEVNUM. If no input was available,
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	181 ; CINBFL will bet nonzero (on EOF). If input was available, CINBFL will be zero. Note that this routine
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	182 ; has undefined results when called on an output only device. All registers except CC and A are preserved.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	183 LA176 jsr RVEC4 ; do RAM hook
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	184 clr CINBFL ; flag data available
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	185 tst DEVNUM ; is it keyboard?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	186 beq LA1B1 ; brif so - blink cursor and wait for key press
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	187 tst CINCTR ; is there anything in cassette input buffer?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	188 bne LA186 ; brif so
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	189 com CINBFL ; flag EOF
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	190 rts
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	191 ; Read character from cassette file
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	192 LA186 pshs u,y,x,b ; preserve registers
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	193 ldx CINPTR ; get input buffer pointer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	194 lda ,x+ ; get character from buffer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	195 pshs a ; save it for return
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	196 stx CINPTR ; save new input buffer pointer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	197 dec CINCTR ; count character just consumed
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	198 bne LA197 ; brif buffer is not empty yet
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	199 jsr LA635 ; go read another block, if any, to refill the buffer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	200 LA197 puls a,b,x,y,u,pc ; restore registers and return the character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	201 ; Blink the cursor. This might be better timed via an interrupt or something.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	202 LA199 dec BLKCNT ; is it time to blink the cursor?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	203 bne LA1AB ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	204 ldb #11 ; reset blink timer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	205 stb BLKCNT
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	206 ldx CURPOS ; get cursor position
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	207 lda ,x ; get character at the cursor
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	208 adda #0x10 ; move to next color
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	209 ora #0x8f ; make sure it's a grahpics block with all elements lit
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	210 sta ,x ; put new cursor block on screen
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	211 LA1AB ldx #DEBDEL ; we'll use the debounce delay for the cursor blink timer (10ms)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	212 LA1AE jmp LA7D3 ; go count X down
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	213 ; Blink cursor while waiting for a key press
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	214 LA1B1 pshs x,b ; save registers
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	215 LA1B3 bsr LA199 ; go do a cursor iteration
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	216 bsr KEYIN ; go read a key
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	217 beq LA1B3 ; brif no key pressed
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	218 ldb #0x60 ; VDG screen space character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	219 stb [CURPOS] ; blank cursor out
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	220 puls b,x,pc ; restore registers and return
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	221 ; This is the actual keyboard polling routine. Returns 0 if no new key is down. Compared to the 1.0 and 1.1
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	222 ; ROMs, this routine is quite a lot more compact and robust.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	223 LA1C1 clr PIA0+2 ; strobe all columns
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	224 lda PIA0 ; get rows
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	225 coma ; bits set if keys down
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	226 lsla ; remove the comparator input
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	227 beq LA244 ; brif no keys down - don't actually poll the keyboard
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	228 KEYIN pshs u,x,b ; save registers
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	229 ldu #PIA0 ; point to keyboard PIA
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	230 ldx #KEYBUF ; point to state table
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	231 clra ; clear carry, set column to 0xff (no strobe)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	232 deca ; (note: deca does not affect C)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	233 pshs x,a ; save column counter and make a couple of holes for temporaries
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	234 sta 2,u ; set strobe to no columns
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	235 LA1D9 rol 2,u ; move to next column (C is 0 initially, 1 after)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	236 bcc LA220 ; brif we shifted out a 0 - we've done 8 columns
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	237 inc 0,s ; bump column counter (first bump goes to 0)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	238 bsr LA23A ; read row data
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	239 sta 1,s ; save key data (for debounce check and later saving)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	240 eora ,x ; now bits set if key state changed
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	241 anda ,x ; now bits are only set if a key has been pressed
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	242 ldb 1,s ; get new key data
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	243 stb ,x+ ; save in state table
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	244 tsta ; was a key down?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	245 beq LA1D9 ; brif not - do another (nothing above cleared C)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	246 ldb 2,u ; get strobe data
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	247 stb 2,s ; save it for debounce check
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	248 ldb #0xf8 ; set up so B is 0 after first add
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	249 LA1F4 addb #8 ; add 8 for each row
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	250 lsra ; did we hit the right row?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	251 bcc LA1F4 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	252 addb 0,s ; add in column number
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	253 beq LA245 ; brif @
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	254 cmpb #26 ; letter?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	255 bhi LA247 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	256 orb #0x40 ; bias into letter range
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	257 bsr LA22E ; check for SHIFT
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	258 ora CASFLG ; merge in capslock state
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	259 bne LA20C ; brif either capslock or SHIFT - keep upper case
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	260 orb #0x20 ; move to lower case
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	261 LA20C stb 0,s ; save ASCII value
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	262 ldx DEBVAL ; get debounce delay
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	263 bsr LA1AE ; do the 10ms debounce delay
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	264 ldb #0xff ; set strobe to none - only joystick buttons register now
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	265 bsr LA238 ; read keyboard
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	266 inca ; A now 0 if no buttons down
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	267 bne LA220 ; brif button down - return nothing since we have interference
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	268 LA21A ldb 2,s ; get column strobe data
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	269 bsr LA238 ; read row data
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	270 cmpa 1,s ; does it match original read?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	271 LA220 puls a,x ; clean up stack and get return value
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	272 bne LA22B ; brif failed debounce or a joystick button down
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	273 cmpa #0x12 ; is it SHIFT-0?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	274 bne LA22C ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	275 com CASFLG ; swap capslock state
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	276 LA22B clra ; set no key down
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	277 LA22C puls b,x,u,pc ; restore registers and return
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	278 LA22E lda #0x7f ; column strobe for SHIFT
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	279 sta 2,u ; set column
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	280 lda ,u ; get row data
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	281 coma ; set if key down
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	282 anda #0x40 ; only keep SHIFT state
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	283 rts
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	284 LA238 stb 2,u ; save strobe data
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	285 LA23A lda ,u ; get row data
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	286 ora #0x80 ; mask off comparator so it doesn't interfere
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	287 tst 2,u ; are we on column 7?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	288 bmi LA244 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	289 ora #0xc0 ; also mask off SHIFT
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	290 LA244 rts
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	291 LA245 ldb #51 ; scan code for @
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	292 LA247 ldx #CONTAB-0x36 ; point to code table
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	293 cmpb #33 ; arrows, space, zero?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	294 blo LA264 ; brif so
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	295 ldx #CONTAB-0x54 ; adjust to other half of table
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	296 cmpb #48 ; ENTER, CLEAR, BREAK, @?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	297 bhs LA264 ; brif so
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	298 bsr LA22E ; read shift state
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	299 cmpb #43 ; is it a number, colon, semicolon?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	300 bls LA25D ; brif so
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	301 eora #0x40 ; invert shift state for others
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	302 LA25D tsta ; shift down?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	303 bne LA20C ; brif not - return result
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	304 addb #0x10 ; add in offset to shifted character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	305 bra LA20C ; go return result
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	306 LA264 lslb ; two entries per key
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	307 bsr LA22E ; check SHIFT state
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	308 beq LA26A ; brif not shift
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	309 incb ; point to shifted entry
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	310 LA26A ldb b,x ; get actual key code
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	311 bra LA20C ; go return result
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	312 CONTAB fcb 0x5e,0x5f ; <UP> (^, _)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	313 fcb 0x0a,0x5b ; <DOWN> (LF, [)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	314 fcb 0x08,0x15 ; <LEFT> (BS, ^U)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	315 fcb 0x09,0x5d ; <RIGHT> (TAB, ])
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	316 fcb 0x20,0x20 ; <SPACE>
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	317 fcb 0x30,0x12 ; <0> (0, ^R)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	318 fcb 0x0d,0x0d ; <ENTER> (CR, CR)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	319 fcb 0x0c,0x5c ; <CLEAR> (FF, \)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	320 fcb 0x03,0x03 ; <BREAK> (^C, ^C)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	321 fcb 0x40,0x13 ; <@> (@, ^S)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	322 ; Generic output routine.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	323 ; Output character in A to the device specified by DEVNUM. All registers are preserved except CC.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	324 ; Sending output to a device that does not support output is undefined.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	325 PUTCHR jsr RVEC3 ; call RAM hook
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	326 pshs b ; save B
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	327 ldb DEVNUM ; get desired device number
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	328 incb ; set flags (Z for -1, etc.)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	329 puls b ; restore B
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	330 bmi LA2BF ; brif < -1 (line printer)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	331 bne LA30A ; brif > -1 (screen)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	332 ; Write character to tape file
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	333 pshs x,b,a ; save registers
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	334 ldb FILSTA ; get file status
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	335 decb ; input file?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	336 beq LA2A6 ; brif so
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	337 ldb CINCTR ; get character count
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	338 incb ; account for this character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	339 bne LA29E ; brif buffer not full
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	340 bsr LA2A8 ; write previously full block to tape
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	341 LA29E ldx CINPTR ; get output buffer pointer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	342 sta ,x+ ; put character in output
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	343 stx CINPTR ; save new buffer pointer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	344 inc CINCTR ; account for this character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	345 LA2A6 puls a,b,x,pc ; restore registers and return
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	346 ; Write a block of data to tape.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	347 LA2A8 ldb #1 ; data block type
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	348 LA2AA stb BLKTYP ; set block type
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	349 ldx #CASBUF ; point to output buffer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	350 stx CBUFAD ; set buffer pointer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	351 ldb CINCTR ; get number of bytes in the block
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	352 stb BLKLEN ; set length to write
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	353 pshs u,y,a ; save registers
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	354 jsr LA7E5 ; write a block to tape
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	355 puls a,y,u ; restore registers
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	356 jmp LA650 ; reset buffer pointers
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	357 ; Send byte to line printer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	358 LA2BF pshs x,b,a,cc ; save registers and interrupt status
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	359 orcc #0x50 ; disable interrupts
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	360 LA2C3 ldb PIA1+2 ; get RS232 status
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	361 lsrb ; get status to C
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	362 bcs LA2C3 ; brif busy - loop until not busy
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	363 bsr LA2FB ; set output to marking
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	364 clrb ; transmit one start bit
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	365 bsr LA2FD
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	366 ldb #8 ; counter for 8 bits
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	367 LA2D0 pshs b ; save bit count
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	368 clrb ; zero output bits
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	369 lsra ; bet output bit to C
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	370 rolb ; get output bit to correct bit for output byte
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	371 lslb
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	372 bsr LA2FD ; transmit bit
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	373 puls b ; get back bit counter
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	374 decb ; are we done yet?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	375 bne LA2D0 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	376 bsr LA2FB ; send stop bit (marking)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	377 puls cc,a ; restore interrupt status and output character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	378 cmpa #0x0d ; carriage return?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	379 beq LA2ED ; brif so
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	380 inc LPTPOS ; bump output position
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	381 ldb LPTPOS ; get new position
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	382 cmpb LPTWID ; end of line?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	383 blo LA2F3 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	384 LA2ED clr LPTPOS ; reset position to start of line
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	385 bsr LA305 ; do carriage return delay
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	386 bsr LA305
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	387 LA2F3 ldb PIA1+2 ; get RS232 status
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	388 lsrb ; get status to C
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	389 bcs LA2F3 ; brif still busy, keep waiting
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	390 puls b,x,pc ; restore registers and return
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	391 LA2FB ldb #2 ; set output to high (marking)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	392 LA2FD stb PIA1 ; set RS232 output
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	393 bsr LA302 ; do baud delay (first iteration) then fall through for second
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	394 LA302 ldx LPTBTD ; get buard rate delay constant
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	395 skip2
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	396 LA305 ldx LPTLND ; get carriage return delay constant
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	397 jmp LA7D3 ; count X down
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	398 ; Output character to screen
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	399 LA30A pshs x,b,a ; save registers
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	400 ldx CURPOS ; get cursor pointer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	401 cmpa #0x08 ; backspace?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	402 bne LA31D ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	403 cmpx #VIDRAM ; at top of screen?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	404 beq LA35D ; brif so - it's a no-op
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	405 lda #0x60 ; VDG space character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	406 sta ,-x ; put a space at previous location and move pointer back
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	407 bra LA344 ; save new cursor position and return
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	408 LA31D cmpa #0x0d ; carriage return?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	409 bne LA32F ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	410 ldx CURPOS ; get cursor pointer (why? we already have it)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	411 LA323 lda #0x60 ; VDG space character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	412 sta ,x+ ; put output space
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	413 tfr x,d ; see if we at a multiple of 32 now
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	414 bitb #0x1f
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	415 bne LA323 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	416 bra LA344 ; go check for scrolling
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	417 LA32F cmpa #0x20 ; control character?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	418 blo LA35D ; brif so
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	419 tsta ; is it graphics block?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	420 bmi LA342 ; brif so
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	421 cmpa #0x40 ; number or special?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	422 blo LA340 ; brif so (flip "case" bit)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	423 cmpa #0x60 ; upper case alpha?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	424 blo LA342 ; brif so - keep it unmodified
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	425 anda #0xdf ; clear bit 5 (inverse video)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	426 LA340 eora #0x40 ; flip inverse video bit
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	427 LA342 sta ,x+ ; output character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	428 LA344 stx CURPOS ; save new cursor position
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	429 cmpx #VIDRAM+511 ; end of screen?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	430 bls LA35D ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	431 ldx #VIDRAM ; point to start of screen
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	432 LA34E ldd 32,x ; get two characters from next row
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	433 std ,x++ ; put them on this row
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	434 cmpx #VIDRAM+0x1e0 ; at start of last row on screen?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	435 blo LA34E ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	436 ldb #0x60 ; VDG space
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	437 jsr LA92D ; blank out last line (borrow CLS's loop)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	438 LA35D puls a,b,x,pc ; restore registers and return
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	439 ; Set up device parameters for output
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	440 LA35F jsr RVEC2 ; do the RAM hook dance
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	441 pshs x,b,a ; save registers
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	442 clr PRTDEV ; flag device as a screen
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	443 lda DEVNUM ; get devicenumber
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	444 beq LA373 ; brif screen
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	445 inca ; is it tape?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	446 beq LA384 ; brif so
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	447 ldx LPTCFW ; get tab width and last tab stop for printer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	448 ldd LPTWID ; get line width and current position for printer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	449 bra LA37C ; set parameters
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	450 LA373 ldb CURPOS+1 ; get LSB of cursor position
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	451 andb #0x1f ; now we have the offset into the line
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	452 ldx #0x1010 ; 16 character tab, position 16 is last tab stop
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	453 lda #32 ; screen is 32 characters wide
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	454 LA37C stx DEVCFW ; save tab width and last tab stop for active device
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	455 stb DEVPOS ; save line position for current device
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	456 sta DEVWID ; save line width for current device
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	457 puls a,b,x,pc ; restore registers and return
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	458 LA384 com PRTDEV ; flag device as non-display
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	459 ldx #0x0100 ; tab width is 1, last tab field is 0
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	460 clra ; line width is 0
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	461 clrb ; character position on line is 0
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	462 bra LA37C ; go set parameters
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	463 ; This is the line input routine used for reading lines for Basic, both in immediate mode and for
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	464 ; INPUT and LINE INPUT. Exit with C set if terminated by BREAK and C clear if terminated by ENTER.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	465 ; The actualy entry point is LA390. Note that this routine echoes to all devices.
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	466 LA38D jsr LA928 ; clear screen (CLEAR key handling)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	467 LA390 jsr RVEC12 ; do the RAM hook dance
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	468 clr IKEYIM ; reset cached input character from BREAK check
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	469 ldx #LINBUF+1 ; point to line input buffer (input pointer)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	470 ldb #1 ; Number of characters in line (we start at 1 so BS handling is easier)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	471 LA39A jsr LA171 ; get an input character, only keep low 7 bits
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	472 tst CINBFL ; is it EOF?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	473 bne LA3CC ; brif EOF
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	474 tst DEVNUM ; is it keyboard input?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	475 bne LA3C8 ; brif not - don't do line editing
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	476 cmpa #0x0c ; form feed (CLEAR)?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	477 beq LA38D ; brif so - clear screen and reset
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	478 cmpa #0x08 ; backspace?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	479 bne LA3B4 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	480 decb ; move back one character
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	481 beq LA390 ; brif we were at the start of the line - reset and start again
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	482 leax -1,x ; move input pointer back
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	483 bra LA3E8 ; echo the backspace and continue
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	484 LA3B4 cmpa #0x15 ; SHIFT-LEFT (kill line)?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	485 bne LA3C2 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	486 LA3B8 decb ; at start of line?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	487 beq LA390 ; brif so - reset and restart
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	488 lda #0x08 ; echo a backspace
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	489 jsr PUTCHR
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	490 bra LA3B8 ; see if we've erased everything yet
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	491 LA3C2 cmpa #0x03 ; BREAK?
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	492 orcc #1 ; set C if it is (only need Z for the next test
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	493 beq LA3CD ; brif BREAK - exit
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	494 LA3C8 cmpa #0x0d ; ENTER (CR)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	495 bne LA3D9 ; brif not
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	496 LA3CC clra ; clear carry (it might not be clear on EOF)
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	497 LA3CD pshs cc ; save ENTER/BREAK flag
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	498 jsr LB958 ; echo a carriage return
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	499 clr ,x ; make sure we have a NUL at the end of the buffer
605ff82c4618 Initial check in with cleaned up sources William Astle <lost@l-w.ca> parents: diff changeset	500 ldx #LINBUF ; point to input buffer

0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1 *pragma nolist

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2 include defs.s

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3 *pragma list

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

5 ; COLOR BASIC ROM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

6 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

7 org BASIC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

8 ; This is the official set of ROM entry points. It is unfortunate that the generic input ("console in") routine is not exposed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

9 ; here. It is also unfortunate that no open and close file routines are exposed. This and other oversignts led to a lot of

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

10 ; software either having to re-invent the wheel or calling directly into the ROM instead of via these official entry points.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

11 POLCAT fdb KEYIN ; indirect jump, get a keystroke

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

12 CHROUT fdb PUTCHR ; indirect jump, output character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

13 CSRDON fdb CASON ; indirect jump, turn cassette on and start reading

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

14 BLKIN fdb GETBLK ; indirect jump, read a block from tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

15 BLKOUT fdb SNDBLK ; indirect jump, write a block to tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

16 JOYIN fdb GETJOY ; indirect jump, read joystick axes

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

17 WRTLDR fdb WRLDR ; indirect jump, turn cassette on and write a leader

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

18 ; Initialization code.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

19 LA00E lds #LINBUF+LBUFMX+1 ; put the stack in the line input buffer which is a safe place for now

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

20 lda #0x37 ; enable the cartidge interrupt (to detect autostarting cartridges)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

21 sta PIA1+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

22 lda RSTFLG ; get warm start flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

23 cmpa #0x55 ; is it valid?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

24 bne BACDST ; brif not - cold start

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

25 ldx RSTVEC ; get warm start routine pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

26 lda ,x ; get first byte of the routine

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

27 cmpa #0x12 ; is it NOP?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

28 bne BACDST ; brif not - the routine is invalid so do a cold start

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

29 jmp ,x ; transfer control to the warm start routine

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

30 ; RESET/power on comes here

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

31 RESVEC leay LA00E,pcr ; point to warm start check code

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

32 LA02A ldx #PIA1 ; point to PIA1 - we're going to rely on the mirroring to reach PIA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

33 clr -3,x ; set PIA0 DA to direction mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

34 clr -1,x ; set PIA0 DB to direction mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

35 clr -4,x ; set PIA0 DA to inputs

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

36 ldd #0xff34

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

37 sta -2,x ; set PIA0 DB to outputs

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

38 stb -3,x ; set PIA0 DA to data mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

39 stb -1,x ; set PIA0 DB to data mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

40 clr 1,x ; set PIA1 DA to direction mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

41 clr 3,x ; set PIA1 DB to direction mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

42 deca

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

43 sta ,x ; set PIA1 DA bits 7-1 as output, 0 as input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

44 lda #0xf8 ; set PIA1 DB bits 7-3 as output, 2-0 as input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

45 sta 2,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

46 stb 1,x ; set PIA1 DA to data mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

47 stb 3,x ; set PIA1 DB to data mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

48 clr 2,x ; set VDG to alpha-numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

49 ldb #2 ; make RS232 marking ("stop" bit)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

50 stb ,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

51 ldu #SAMREG ; point to SAM register

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

52 ldb #16 ; 16 bits to clear

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

53 LA056 sta ,u++ ; clear a bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

54 decb ; done all?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

55 bne LA056 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

56 sta SAMREG+9 ; put display at 0x400

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

57 tfr b,dp ; set direct page to 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

58 ldb #4 ; use as mask to check ram size input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

59 clr -2,x ; strobe ram size low

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

60 bitb 2,x ; is the input set?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

61 beq LA06E ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

62 sta -5,u ; program SAM for 16Kx4 RAMs

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

63 sta -11,u ; the P bit is required to work with 16Kx4 RAMs

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

64 bra LA072

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

65 LA06E nop

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

66 nop

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

67 sta -3,u ; program SAM for 64Kx1 RAMs

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

68 LA072 jmp ,y ; transfer control to startup routine

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

69 ; Cold start jumps here

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

70 BACDST ldx #VIDRAM+1 ; point past the top of the first 1K of memory (for double predec below)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

71 LA077 clr ,--x ; clear a byte (last will actually try clearing LSB of RESET vector in ROM)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

72 leax 1,x ; move forward one byte (will set Z if we're done)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

73 bne LA077 ; brif not donw yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

74 jsr LA928 ; clear the screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

75 clr ,x+ ; put the constant zero that lives before the program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

76 stx TXTTAB ; set beginning of program storage

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

77 LA084 lda 2,x ; get value from memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

78 coma ; make it different

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

79 sta 2,x ; try putting different into memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

80 cmpa 2,x ; did it matcH?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

81 bne LA093 ; brif not - we found the end of memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

82 leax 1,x ; move pointer forward

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

83 com 1,x ; restore the original memory contents

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

84 bra LA084 ; try another byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

85 LA093 stx TOPRAM ; save top of memory (one below actual top because we need a byte for VAL() to work)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

86 stx MEMSIZ ; save top of string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

87 stx STRTAB ; set bottom of allocated string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

88 leax -200,x ; allocate 200 bytes of string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

89 stx FRETOP ; set top of actually free memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

90 tfr x,s ; put the stack there

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

91 ldx #LA10D ; point to variable initializer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

92 ldu #CMPMID ; point to variables to initialize (first batch)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

93 ldb #28 ; 28 bytes in first batch

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

94 jsr LA59A ; copy bytes to variables

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

95 ldu #IRQVEC ; point to variables to initialize (second batch)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

96 ldb #30 ; 30 bytes this time

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

97 jsr LA59A ; copy bytes to variables

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

98 ldx -12,x ; get SN error address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

99 stx 3,u ; set ECB's command handlers to error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

100 stx 8,u

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

101 ldx #RVEC0 ; point to RAM vectors

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

102 ldd #0x394b ; write 75 RTS opcodes (25 RAM vectors)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

103 LA0C0 sta ,x+ ; put an RTS

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

104 decb ; done?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

105 bne LA0C0 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

106 sta LINHDR-1 ; make temporary line header data for line encoding have a nonzero next line pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

107 jsr LAD19 ; do a "NEW"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

108 ldx #'E*256+'X ; magic number to detect ECB ROM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

109 cmpx EXBAS ; is there an ECB ROM?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

110 lbeq EXBAS+2 ; brif so - launch it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

111 andcc #0xaf ; start interrupts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

112 ldx #LA147-1 ; point to sign on message

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

113 jsr LB99C ; print it out

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

114 ldx #BAWMST ; warm start routine address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

115 stx RSTVEC ; set vector there

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

116 lda #0x55 ; warm start valid flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

117 sta RSTFLG ; mark warm start valid

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

118 bra LA0F3 ; go to direct mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

119 ; Warm start entry point

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

120 BAWMST nop ; valid routine marker

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

121 clr DEVNUM ; reset output/input to screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

122 jsr LAD33 ; do a partial NEW

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

123 andcc #0xaf ; start interrupts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

124 jsr LA928 ; clear the screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

125 LA0F3 jmp LAC73 ; go to direct mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

126 ; FIRQ service routine - this handles starting autostart cartridges

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

127 BFRQSV tst PIA1+3 ; is it the cartridge interrupt?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

128 bmi LA0FC ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

129 rti

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

130 LA0FC jsr LA7D1 ; delay for a while

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

131 jsr LA7D1 ; delay for another while

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

132 leay <LA108,pcr ; point to cartridge starter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

133 jmp LA02A ; go initialize everything clean for the cartridge

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

134 LA108 clr RSTFLG ; force a cold start a cartridge reset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

135 jmp ROMPAK ; transfer control to the cartridge

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

136 ; Variable initializers (first batch)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

137 LA10D fcb 18 ; mid band partition of the 1200/2400 Hz period

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

138 fcb 24 ; upper limit of 1200 Hz period

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

139 fcb 10 ; upper limit of 2400 Hz period

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

140 fdb 128 ; number of 0x55s for cassette leader

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

141 fcb 11 ; cursor blink delay

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

142 fdb 88 ; 600 baud delay constant

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

143 fdb 1 ; printer carriage return delay constant

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

144 fcb 16 ; printer tab field width

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

145 fcb 112 ; last printer tab zone

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

146 fcb 132 ; printer carriage width

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

147 fcb 0 ; printer carriage position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

148 fdb LB44A ; default execution address for EXEC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

149 inc CHARAD+1 ;* character fetching routines (DP portion) - we first do a two

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

150 bne LA123 ;* two stage increment of CHARAD then load the value into A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

151 inc CHARAD ;* before transferring control to the bottom half routine in ROM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

152 LA123 lda >0 ; NOTE: the 0 is a placeholder, extended addressing is required

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

153 jmp BROMHK

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

154 ; Variable initializers (second batch)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

155 jmp BIRQSV ; IRQ handler

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

156 jmp BFRQSV ; FIRQ handler

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

157 jmp LB44A ; default USR() address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

158 fcb 0x80,0x4f,0xc7,0x52,0x59 ; random seed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

159 fcb 0xff ; capslock flag - default to upper case

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

160 fdb DEBDEL ; keyboard debounce delay (why is it a variable?)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

161 jmp LB277 ; exponentiation handler vector

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

162 fcb 53 ; (command interpretation table) 53 commands

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

163 fdb LAA66 ; (command interpretation table) reserved words list (commands)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

164 fdb LAB67 ; (command interpretation table) jump table (commands)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

165 fcb 20 ; (command interpretation table) 20 functions

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

166 fdb LAB1A ; (command interpretation table) reserved words list (functions)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

167 fdb LAA29 ; (command interpretation table) jump table (functions)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

168 ; This is the signon message.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

169 LA147 fcc 'COLOR BASIC 1.3'

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

170 fcb 0x0d

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

172 fcb 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

173 ; This is the "invalid colour" CLS easter egg text. Basically 11 wasted bytes

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

174 LA166 fcc 'MICROSOFT'

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

175 fcb 0x0d,0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

176 ; Read a character from current device and mask off bit 7 (keep it as 7 bit ASCII)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

177 LA171 bsr LA176 ; get character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

178 anda #0x7f ; mask off high bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

179 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

180 ; Generic read routine. Reads a character from the device specified by DEVNUM. If no input was available,

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

181 ; CINBFL will bet nonzero (on EOF). If input was available, CINBFL will be zero. Note that this routine

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

182 ; has undefined results when called on an output only device. All registers except CC and A are preserved.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

183 LA176 jsr RVEC4 ; do RAM hook

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

184 clr CINBFL ; flag data available

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

185 tst DEVNUM ; is it keyboard?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

186 beq LA1B1 ; brif so - blink cursor and wait for key press

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

187 tst CINCTR ; is there anything in cassette input buffer?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

188 bne LA186 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

189 com CINBFL ; flag EOF

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

190 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

191 ; Read character from cassette file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

192 LA186 pshs u,y,x,b ; preserve registers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

193 ldx CINPTR ; get input buffer pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

194 lda ,x+ ; get character from buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

195 pshs a ; save it for return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

196 stx CINPTR ; save new input buffer pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

197 dec CINCTR ; count character just consumed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

198 bne LA197 ; brif buffer is not empty yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

199 jsr LA635 ; go read another block, if any, to refill the buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

200 LA197 puls a,b,x,y,u,pc ; restore registers and return the character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

201 ; Blink the cursor. This might be better timed via an interrupt or something.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

202 LA199 dec BLKCNT ; is it time to blink the cursor?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

203 bne LA1AB ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

204 ldb #11 ; reset blink timer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

205 stb BLKCNT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

206 ldx CURPOS ; get cursor position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

207 lda ,x ; get character at the cursor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

208 adda #0x10 ; move to next color

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

209 ora #0x8f ; make sure it's a grahpics block with all elements lit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

210 sta ,x ; put new cursor block on screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

211 LA1AB ldx #DEBDEL ; we'll use the debounce delay for the cursor blink timer (10ms)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

212 LA1AE jmp LA7D3 ; go count X down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

213 ; Blink cursor while waiting for a key press

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

214 LA1B1 pshs x,b ; save registers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

215 LA1B3 bsr LA199 ; go do a cursor iteration

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

216 bsr KEYIN ; go read a key

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

217 beq LA1B3 ; brif no key pressed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

218 ldb #0x60 ; VDG screen space character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

219 stb [CURPOS] ; blank cursor out

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

220 puls b,x,pc ; restore registers and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

221 ; This is the actual keyboard polling routine. Returns 0 if no new key is down. Compared to the 1.0 and 1.1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

222 ; ROMs, this routine is quite a lot more compact and robust.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

223 LA1C1 clr PIA0+2 ; strobe all columns

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

224 lda PIA0 ; get rows

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

225 coma ; bits set if keys down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

226 lsla ; remove the comparator input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

227 beq LA244 ; brif no keys down - don't actually poll the keyboard

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

228 KEYIN pshs u,x,b ; save registers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

229 ldu #PIA0 ; point to keyboard PIA

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

230 ldx #KEYBUF ; point to state table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

231 clra ; clear carry, set column to 0xff (no strobe)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

232 deca ; (note: deca does not affect C)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

233 pshs x,a ; save column counter and make a couple of holes for temporaries

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

234 sta 2,u ; set strobe to no columns

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

235 LA1D9 rol 2,u ; move to next column (C is 0 initially, 1 after)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

236 bcc LA220 ; brif we shifted out a 0 - we've done 8 columns

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

237 inc 0,s ; bump column counter (first bump goes to 0)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

238 bsr LA23A ; read row data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

239 sta 1,s ; save key data (for debounce check and later saving)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

240 eora ,x ; now bits set if key state changed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

241 anda ,x ; now bits are only set if a key has been pressed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

242 ldb 1,s ; get new key data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

243 stb ,x+ ; save in state table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

244 tsta ; was a key down?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

245 beq LA1D9 ; brif not - do another (nothing above cleared C)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

246 ldb 2,u ; get strobe data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

247 stb 2,s ; save it for debounce check

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

248 ldb #0xf8 ; set up so B is 0 after first add

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

249 LA1F4 addb #8 ; add 8 for each row

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

250 lsra ; did we hit the right row?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

251 bcc LA1F4 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

252 addb 0,s ; add in column number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

253 beq LA245 ; brif @

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

254 cmpb #26 ; letter?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

255 bhi LA247 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

256 orb #0x40 ; bias into letter range

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

257 bsr LA22E ; check for SHIFT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

258 ora CASFLG ; merge in capslock state

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

259 bne LA20C ; brif either capslock or SHIFT - keep upper case

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

260 orb #0x20 ; move to lower case

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

261 LA20C stb 0,s ; save ASCII value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

262 ldx DEBVAL ; get debounce delay

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

263 bsr LA1AE ; do the 10ms debounce delay

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

264 ldb #0xff ; set strobe to none - only joystick buttons register now

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

265 bsr LA238 ; read keyboard

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

266 inca ; A now 0 if no buttons down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

267 bne LA220 ; brif button down - return nothing since we have interference

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

268 LA21A ldb 2,s ; get column strobe data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

269 bsr LA238 ; read row data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

270 cmpa 1,s ; does it match original read?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

271 LA220 puls a,x ; clean up stack and get return value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

272 bne LA22B ; brif failed debounce or a joystick button down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

273 cmpa #0x12 ; is it SHIFT-0?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

274 bne LA22C ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

275 com CASFLG ; swap capslock state

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

276 LA22B clra ; set no key down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

277 LA22C puls b,x,u,pc ; restore registers and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

278 LA22E lda #0x7f ; column strobe for SHIFT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

279 sta 2,u ; set column

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

280 lda ,u ; get row data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

281 coma ; set if key down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

282 anda #0x40 ; only keep SHIFT state

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

283 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

284 LA238 stb 2,u ; save strobe data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

285 LA23A lda ,u ; get row data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

286 ora #0x80 ; mask off comparator so it doesn't interfere

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

287 tst 2,u ; are we on column 7?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

288 bmi LA244 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

289 ora #0xc0 ; also mask off SHIFT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

290 LA244 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

291 LA245 ldb #51 ; scan code for @

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

292 LA247 ldx #CONTAB-0x36 ; point to code table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

293 cmpb #33 ; arrows, space, zero?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

294 blo LA264 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

295 ldx #CONTAB-0x54 ; adjust to other half of table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

296 cmpb #48 ; ENTER, CLEAR, BREAK, @?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

297 bhs LA264 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

298 bsr LA22E ; read shift state

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

299 cmpb #43 ; is it a number, colon, semicolon?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

300 bls LA25D ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

301 eora #0x40 ; invert shift state for others

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

302 LA25D tsta ; shift down?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

303 bne LA20C ; brif not - return result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

304 addb #0x10 ; add in offset to shifted character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

305 bra LA20C ; go return result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

306 LA264 lslb ; two entries per key

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

307 bsr LA22E ; check SHIFT state

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

308 beq LA26A ; brif not shift

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

309 incb ; point to shifted entry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

310 LA26A ldb b,x ; get actual key code

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

311 bra LA20C ; go return result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

312 CONTAB fcb 0x5e,0x5f ; <UP> (^, _)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

313 fcb 0x0a,0x5b ; <DOWN> (LF, [)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

314 fcb 0x08,0x15 ; <LEFT> (BS, ^U)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

315 fcb 0x09,0x5d ; <RIGHT> (TAB, ])

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

316 fcb 0x20,0x20 ; <SPACE>

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

317 fcb 0x30,0x12 ; <0> (0, ^R)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

318 fcb 0x0d,0x0d ; <ENTER> (CR, CR)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

319 fcb 0x0c,0x5c ; <CLEAR> (FF, \)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

320 fcb 0x03,0x03 ; <BREAK> (^C, ^C)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

321 fcb 0x40,0x13 ; <@> (@, ^S)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

322 ; Generic output routine.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

323 ; Output character in A to the device specified by DEVNUM. All registers are preserved except CC.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

324 ; Sending output to a device that does not support output is undefined.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

325 PUTCHR jsr RVEC3 ; call RAM hook

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

326 pshs b ; save B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

327 ldb DEVNUM ; get desired device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

328 incb ; set flags (Z for -1, etc.)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

329 puls b ; restore B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

330 bmi LA2BF ; brif < -1 (line printer)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

331 bne LA30A ; brif > -1 (screen)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

332 ; Write character to tape file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

333 pshs x,b,a ; save registers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

334 ldb FILSTA ; get file status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

335 decb ; input file?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

336 beq LA2A6 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

337 ldb CINCTR ; get character count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

338 incb ; account for this character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

339 bne LA29E ; brif buffer not full

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

340 bsr LA2A8 ; write previously full block to tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

341 LA29E ldx CINPTR ; get output buffer pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

342 sta ,x+ ; put character in output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

343 stx CINPTR ; save new buffer pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

344 inc CINCTR ; account for this character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

345 LA2A6 puls a,b,x,pc ; restore registers and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

346 ; Write a block of data to tape.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

347 LA2A8 ldb #1 ; data block type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

348 LA2AA stb BLKTYP ; set block type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

349 ldx #CASBUF ; point to output buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

350 stx CBUFAD ; set buffer pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

351 ldb CINCTR ; get number of bytes in the block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

352 stb BLKLEN ; set length to write

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

353 pshs u,y,a ; save registers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

354 jsr LA7E5 ; write a block to tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

355 puls a,y,u ; restore registers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

356 jmp LA650 ; reset buffer pointers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

357 ; Send byte to line printer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

358 LA2BF pshs x,b,a,cc ; save registers and interrupt status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

359 orcc #0x50 ; disable interrupts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

360 LA2C3 ldb PIA1+2 ; get RS232 status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

361 lsrb ; get status to C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

362 bcs LA2C3 ; brif busy - loop until not busy

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

363 bsr LA2FB ; set output to marking

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

364 clrb ; transmit one start bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

365 bsr LA2FD

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

366 ldb #8 ; counter for 8 bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

367 LA2D0 pshs b ; save bit count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

368 clrb ; zero output bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

369 lsra ; bet output bit to C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

370 rolb ; get output bit to correct bit for output byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

371 lslb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

372 bsr LA2FD ; transmit bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

373 puls b ; get back bit counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

374 decb ; are we done yet?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

375 bne LA2D0 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

376 bsr LA2FB ; send stop bit (marking)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

377 puls cc,a ; restore interrupt status and output character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

378 cmpa #0x0d ; carriage return?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

379 beq LA2ED ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

380 inc LPTPOS ; bump output position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

381 ldb LPTPOS ; get new position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

382 cmpb LPTWID ; end of line?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

383 blo LA2F3 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

384 LA2ED clr LPTPOS ; reset position to start of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

385 bsr LA305 ; do carriage return delay

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

386 bsr LA305

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

387 LA2F3 ldb PIA1+2 ; get RS232 status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

388 lsrb ; get status to C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

389 bcs LA2F3 ; brif still busy, keep waiting

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

390 puls b,x,pc ; restore registers and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

391 LA2FB ldb #2 ; set output to high (marking)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

392 LA2FD stb PIA1 ; set RS232 output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

393 bsr LA302 ; do baud delay (first iteration) then fall through for second

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

394 LA302 ldx LPTBTD ; get buard rate delay constant

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

395 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

396 LA305 ldx LPTLND ; get carriage return delay constant

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

397 jmp LA7D3 ; count X down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

398 ; Output character to screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

399 LA30A pshs x,b,a ; save registers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

400 ldx CURPOS ; get cursor pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

401 cmpa #0x08 ; backspace?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

402 bne LA31D ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

403 cmpx #VIDRAM ; at top of screen?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

404 beq LA35D ; brif so - it's a no-op

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

405 lda #0x60 ; VDG space character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

406 sta ,-x ; put a space at previous location and move pointer back

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

407 bra LA344 ; save new cursor position and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

408 LA31D cmpa #0x0d ; carriage return?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

409 bne LA32F ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

410 ldx CURPOS ; get cursor pointer (why? we already have it)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

411 LA323 lda #0x60 ; VDG space character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

412 sta ,x+ ; put output space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

413 tfr x,d ; see if we at a multiple of 32 now

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

414 bitb #0x1f

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

415 bne LA323 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

416 bra LA344 ; go check for scrolling

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

417 LA32F cmpa #0x20 ; control character?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

418 blo LA35D ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

419 tsta ; is it graphics block?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

420 bmi LA342 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

421 cmpa #0x40 ; number or special?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

422 blo LA340 ; brif so (flip "case" bit)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

423 cmpa #0x60 ; upper case alpha?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

424 blo LA342 ; brif so - keep it unmodified

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

425 anda #0xdf ; clear bit 5 (inverse video)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

426 LA340 eora #0x40 ; flip inverse video bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

427 LA342 sta ,x+ ; output character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

428 LA344 stx CURPOS ; save new cursor position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

429 cmpx #VIDRAM+511 ; end of screen?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

430 bls LA35D ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

431 ldx #VIDRAM ; point to start of screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

432 LA34E ldd 32,x ; get two characters from next row

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

433 std ,x++ ; put them on this row

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

434 cmpx #VIDRAM+0x1e0 ; at start of last row on screen?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

435 blo LA34E ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

436 ldb #0x60 ; VDG space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

437 jsr LA92D ; blank out last line (borrow CLS's loop)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

438 LA35D puls a,b,x,pc ; restore registers and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

439 ; Set up device parameters for output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

440 LA35F jsr RVEC2 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

441 pshs x,b,a ; save registers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

442 clr PRTDEV ; flag device as a screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

443 lda DEVNUM ; get devicenumber

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

444 beq LA373 ; brif screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

445 inca ; is it tape?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

446 beq LA384 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

447 ldx LPTCFW ; get tab width and last tab stop for printer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

448 ldd LPTWID ; get line width and current position for printer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

449 bra LA37C ; set parameters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

450 LA373 ldb CURPOS+1 ; get LSB of cursor position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

451 andb #0x1f ; now we have the offset into the line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

452 ldx #0x1010 ; 16 character tab, position 16 is last tab stop

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

453 lda #32 ; screen is 32 characters wide

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

454 LA37C stx DEVCFW ; save tab width and last tab stop for active device

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

455 stb DEVPOS ; save line position for current device

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

456 sta DEVWID ; save line width for current device

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

457 puls a,b,x,pc ; restore registers and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

458 LA384 com PRTDEV ; flag device as non-display

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

459 ldx #0x0100 ; tab width is 1, last tab field is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

460 clra ; line width is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

461 clrb ; character position on line is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

462 bra LA37C ; go set parameters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

463 ; This is the line input routine used for reading lines for Basic, both in immediate mode and for

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

464 ; INPUT and LINE INPUT. Exit with C set if terminated by BREAK and C clear if terminated by ENTER.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

465 ; The actualy entry point is LA390. Note that this routine echoes to *all* devices.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

466 LA38D jsr LA928 ; clear screen (CLEAR key handling)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

467 LA390 jsr RVEC12 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

468 clr IKEYIM ; reset cached input character from BREAK check

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

469 ldx #LINBUF+1 ; point to line input buffer (input pointer)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

470 ldb #1 ; Number of characters in line (we start at 1 so BS handling is easier)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

471 LA39A jsr LA171 ; get an input character, only keep low 7 bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

472 tst CINBFL ; is it EOF?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

473 bne LA3CC ; brif EOF

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

474 tst DEVNUM ; is it keyboard input?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

475 bne LA3C8 ; brif not - don't do line editing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

476 cmpa #0x0c ; form feed (CLEAR)?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

477 beq LA38D ; brif so - clear screen and reset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

478 cmpa #0x08 ; backspace?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

479 bne LA3B4 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

480 decb ; move back one character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

481 beq LA390 ; brif we were at the start of the line - reset and start again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

482 leax -1,x ; move input pointer back

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

483 bra LA3E8 ; echo the backspace and continue

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

484 LA3B4 cmpa #0x15 ; SHIFT-LEFT (kill line)?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

485 bne LA3C2 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

486 LA3B8 decb ; at start of line?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

487 beq LA390 ; brif so - reset and restart

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

488 lda #0x08 ; echo a backspace

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

489 jsr PUTCHR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

490 bra LA3B8 ; see if we've erased everything yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

491 LA3C2 cmpa #0x03 ; BREAK?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

492 orcc #1 ; set C if it is (only need Z for the next test

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

493 beq LA3CD ; brif BREAK - exit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

494 LA3C8 cmpa #0x0d ; ENTER (CR)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

495 bne LA3D9 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

496 LA3CC clra ; clear carry (it might not be clear on EOF)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

497 LA3CD pshs cc ; save ENTER/BREAK flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

498 jsr LB958 ; echo a carriage return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

499 clr ,x ; make sure we have a NUL at the end of the buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

500 ldx #LINBUF ; point to input buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

501 puls cc,pc ; restore ENTER/BREAK flag and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

502 LA3D9 cmpa #0x20 ; control character?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

503 blo LA39A ; brif so - skip it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

504 cmpa #'z+1 ; above z?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

505 bhs LA39A ; brif so - ignore it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

506 cmpb #LBUFMX ; is the buffer full?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

507 bhs LA39A ; brif so - ignore extra characters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

508 sta ,x+ ; put character in the buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

509 incb ; bump character count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

510 LA3E8 jsr PUTCHR ; echo character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

511 bra LA39A ; go handle next input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

512 ; Check if DEVNUM Is valid for reading. Raise FM error if open but not for reading. NO error if not open.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

513 LA3ED jsr RVEC5 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

514 lda DEVNUM ; get device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

515 beq LA415 ; brif keyboard - always valid

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

516 inca ; is it tape?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

517 bne LA403 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

518 lda FILSTA ; get tape file status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

519 bne LA400 ; brif file is open

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

520 LA3FB ldb #22*2 ; raise NO error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

521 jmp LAC46

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

522 LA400 deca ; is it in input mode?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

523 beq LA415 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

524 LA403 jmp LA616 ; raise FM error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

525 ; Check if DEVNUM is valid for writing. Raise FM error if open but not for writing. NO error if not open.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

526 LA406 jsr RVEC6 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

527 lda DEVNUM ; get device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

528 inca ; is it tape?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

529 bne LA415 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

530 lda FILSTA ; get file status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

531 beq LA3FB ; brif not open

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

532 deca ; is it open for reading?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

533 beq LA403 ; brif so - bad mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

534 LA415 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

535 ; CLOSE command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

536 CLOSE beq LA426 ; brif no file specified - close all files

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

537 jsr LA5A5 ; parse device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

538 LA41B bsr LA42D ; close specified file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

539 jsr GETCCH ; is there more?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

540 beq LA44B ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

541 jsr LA5A2 ; check for comma and parse another device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

542 bra LA41B ; go close this one

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

543 ; Close all files handler.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

544 LA426 jsr RVEC7 ; Yup. The RAM hook dance.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

545 lda #-1 ; start with tape file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

546 sta DEVNUM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

547 ; Close file specified in DEVNUM. Note that this never fails.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

548 LA42D jsr RVEC8 ; You know it. RAM hook.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

549 lda DEVNUM ; get device we're closing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

550 clr DEVNUM ; reset to screen/keyboard

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

551 inca ; is it tape?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

552 bne LA44B ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

553 lda FILSTA ; get file status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

554 cmpa #2 ; is it output?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

555 bne LA449 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

556 lda CINCTR ; is there anything waiting to be written?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

557 beq LA444 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

558 jsr LA2A8 ; write final block of data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

559 LA444 ldb #0xff ; write EOF block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

560 jsr LA2AA

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

561 LA449 clr FILSTA ; mark tape file closed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

562 LA44B rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

563 ; CSAVE command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

564 CSAVE jsr LA578 ; parse filename

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

565 jsr GETCCH ; see what we have after the file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

566 beq LA469 ; brif none

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

567 jsr LB26D ; make sure there's a comma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

568 ldb #'A ; make sure there's an A after

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

569 jsr LB26F

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

570 bne LA44B ; brif not end of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

571 clra ; file type 0 (basic program)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

572 jsr LA65C ; write out header block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

573 lda #-1 ; set output to tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

574 sta DEVNUM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

575 clra ; set Z so we list the whole program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

576 jmp LIST ; go list the program to tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

577 LA469 clra ; file type 0 (basic program)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

578 ldx ZERO ; set to binary file mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

579 jsr LA65F ; write header block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

580 clr FILSTA ; close files

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

581 inc BLKTYP ; set block type to data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

582 jsr WRLDR ; write out a leader

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

583 ldx TXTTAB ; point to start of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

584 LA478 stx CBUFAD ; set buffer location

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

585 lda #255 ; block size to 255 bytes (max size)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

586 sta BLKLEN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

587 ldd VARTAB ; get end of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

588 subd CBUFAD ; how much is left?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

589 beq LA491 ; brif we have nothing left

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

590 cmpd #255 ; do we have a full block worth?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

591 bhs LA48C ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

592 stb BLKLEN ; save actual remainder as block length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

593 LA48C jsr SNDBLK ; write a block out

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

594 bra LA478 ; go do another block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

595 LA491 neg BLKTYP ; set block type to 0xff (EOF)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

596 clr BLKLEN ; no data in EOF block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

597 jmp LA7E7 ; write EOF, stop tape, and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

598 ; CLOAD and CLOADM commands

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

599 CLOAD clr FILSTA ; close tape file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

600 cmpa #'M ; is it ClOADM?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

601 beq LA4FE ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

602 leas 2,s ; clean up stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

603 jsr LA5C5 ; parse file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

604 jsr LA648 ; go find the file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

605 tst CASBUF+10 ; is it binary?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

606 beq LA4C8 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

607 lda CASBUF+9 ; is it ASCII?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

608 beq LA4CD ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

609 jsr LAD19 ; clear out existing program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

610 lda #-1 ; set up for reading from tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

611 sta DEVNUM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

612 inc FILSTA ; set tape file to input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

613 jsr LA635 ; go read first block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

614 jmp LAC7C ; go to immediate mode to read in the program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

615 ; This is the EOF handler for immediate mode. It's rather assinine for this to be located here. It is

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

616 ; probably an artifact of a substantially different code layout prior to compacting the ROM to fit in

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

617 ; 8K.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

618 LA4BF jsr RVEC13 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

619 jsr LA42D ; close file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

620 jmp LAC73 ; go back to immediate mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

621 LA4C8 lda CASBUF+8 ; get file type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

622 beq LA4D0 ; brif basic program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

623 LA4CD jmp LA616 ; raise FM error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

624 LA4D0 jsr LAD19 ; erase existing program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

625 jsr CASON ; start reading tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

626 ldx TXTTAB ; get start of program storage

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

627 LA4D8 stx CBUFAD ; set load address for block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

628 ldd CBUFAD ; get start of block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

629 inca ; bump by 256

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

630 jsr LAC37 ; check if there's room for a maximum sized block of 255

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

631 jsr GETBLK ; go read a block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

632 bne LA4F8 ; brif there was an error during reading

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

633 lda BLKTYP ; get type of block read

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

634 beq LA4F8 ; brif header block - IO error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

635 bpl LA4D8 ; brif data block - read another

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

636 stx VARTAB ; save new end of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

637 bsr LA53B ; stop tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

638 ldx #LABED-1 ; point to "OK" prompt

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

639 jsr LB99C ; show prompt

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

640 jmp LACE9 ; reset various things and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

641 LA4F8 jsr LAD19 ; clear out partial program load

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

642 LA4FB jmp LA619 ; raise IO error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

643 ; This is the CLOADM command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

644 LA4FE jsr GETNCH ; eat the "M"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

645 bsr LA578 ; parse file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

646 jsr LA648 ; go find the file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

647 LA505 ldx ZERO ; default offset is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

648 jsr GETCCH ; see if there's something after the file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

649 beq LA511 ; brif no offset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

650 jsr LB26D ; make sure there's a comma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

651 jsr LB73D ; evaluate offset to X

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

652 LA511 lda CASBUF+8 ; get file mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

653 cmpa #2 ; M/L program?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

654 bne LA4CD ; brif not - FM error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

655 ldd CASBUF+11 ; get load address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

656 leau D,x ; add in offset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

657 stu EXECJP ; set EXEC default address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

658 tst CASBUF+10 ; is it binary?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

659 bne LA4CD ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

660 ldd CASBUF+13 ; get load address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

661 leax d,x ; add in offset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

662 stx CBUFAD ; set buffer address for loading

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

663 jsr CASON ; start up tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

664 LA52E jsr GETBLK ; read a block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

665 bne LA4FB ; brif error reading

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

666 stx CBUFAD ; save new load address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

667 tst BLKTYP ; set flags on block type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

668 beq LA4FB ; brif another header - IO error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

669 bpl LA52E ; brif it was data - read more

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

670 LA53B jmp LA7E9 ; turn off tape and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

671 ; The EXEC command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

672 EXEC beq LA545 ; brif no argument - use default address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

673 jsr LB73D ; evaluate EXEC address to X

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

674 stx EXECJP ; set new default EXEC address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

675 LA545 jmp [EXECJP] ; transfer control to execution address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

676 ; Break check for LIST so it doesn't interrupt ASCII saves. Why is this here instead of with the rest of the break

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

677 ; check logic or packaged up with LIST?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

678 LA549 jsr RVEC11 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

679 lda DEVNUM ; get device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

680 inca ; is it tape?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

681 beq LA5A1 ; brif so - don't do break check

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

682 jmp LADEB ; do the actual break check

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

683 ; Evaluate an expression and make sure it is within the limits of the screen and sets the cursor position.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

684 ; This really should be located with the PRINT command.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

685 LA554 jsr LB3E4 ; evaluate a positive expression to D

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

686 subd #511 ; is it within bounds?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

687 lbhi LB44A ; brif not - error out

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

688 addd #VIDRAM+511 ; adjust to be within the screen (and undo the SUBD above)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

689 std CURPOS ; set cursor position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

690 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

691 ; INKEY$ function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

692 INKEY lda IKEYIM ; was a key down during break check?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

693 bne LA56B ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

694 jsr KEYIN ; poll the keyboard

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

695 LA56B clr IKEYIM ; reset the break check cache

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

696 sta FPA0+3 ; store result for later return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

697 lbne LB68F ; brif a key was down - return it as a string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

698 sta STRDES ; set string length to 0 (no key down)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

699 jmp LB69B ; return the NULL string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

700 ; Parse a filename

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

701 LA578 ldx #CFNBUF ; point to file name buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

702 clr ,x+ ; zero out file name length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

703 lda #0x20 ; space character to initialize file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

704 LA57F sta ,x+ ; put a space in the buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

705 cmpx #CASBUF ; at end of file name?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

706 bne LA57F ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

707 jsr GETCCH ; get input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

708 beq LA5A1 ; brif no name present

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

709 jsr LB156 ; evaluate the file name expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

710 jsr LB654 ; point to start of the file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

711 ldu #CFNBUF ; point to file name buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

712 stb ,u+ ; save string length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

713 beq LA5A1 ; brif empty - we're done

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

714 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

715 LA598 ldb #8 ; copy 8 bytes

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

716 ; Move B bytes from (X) to (U)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

717 LA59A lda ,x+ ; copy a byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

718 sta ,u+

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

719 decb ; done yet?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

720 bne LA59A ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

721 LA5A1 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

722 ; Parse a device number and check validity

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

723 LA5A2 jsr LB26D ; check for comma and SN error if not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

724 LA5A5 cmpa #'# ; do we have a #?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

725 bne LA5AB ; brif not (it's optional)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

726 jsr GETNCH ; munch the #

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

727 LA5AB jsr LB141 ; evaluate the expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

728 LA5AE jsr INTCNV ; convert it to an integer in D

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

729 rolb ; move sign of B into C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

730 adca #0 ; add sign of B to A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

731 bne LA61F ; brif A doesn't match the sign of B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

732 rorb ; restore B (ADCA will have set C if B was negative)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

733 stb DEVNUM ; set device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

734 jsr RVEC1 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

735 beq LA5C4 ; brif device number set to screen/keyboard (valid)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

736 bpl LA61F ; brif not negative (not valid)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

737 cmpb #-2 ; is it printer or tape?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

738 blt LA61F ; brif not (not valid)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

739 LA5C4 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

740 ; Read file name from the line and do an error if anything follows it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

741 LA5C5 bsr LA578 ; parse file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

742 jsr GETCCH ; set flags on current character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

743 LA5C9 beq LA5C4 ; brif nothing there - it's good

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

744 jmp LB277 ; raise SN error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

745 ; EOF functoin

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

746 EOF jsr RVEC14 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

747 lda DEVNUM ; get device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

748 pshs a ; save it (so we can restore it later)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

749 bsr LA5AE ; check the device number (which is in FPA0)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

750 jsr LA3ED ; check validity for reading

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

751 LA5DA clrb ; not EOF = 0 (FALSE)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

752 lda DEVNUM ; get device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

753 beq LA5E4 ; brif keyboard - never EOF

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

754 tst CINCTR ; is there anything in the input buffer?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

755 bne LA5E4 ; brif so - not EOF

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

756 comb ; set EOF flag to -1 (true)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

757 LA5E4 puls a ; get back original device

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

758 sta DEVNUM ; restore it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

759 LA5E8 sex ; sign extend result to 16 bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

760 jmp GIVABF ; go return the result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

761 ; SKIPF command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

762 SKIPF bsr LA5C5 ; parse file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

763 bsr LA648 ; look for the file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

764 jsr LA6D1 ; read the file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

765 bne LA619 ; brif error reading file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

766 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

767 ; OPEN command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

768 OPEN jsr RVEC0 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

769 jsr LB156 ; get file status (input/output)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

770 jsr LB6A4 ; get first character of status string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

771 pshs b ; save status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

772 bsr LA5A2 ; parse a comma then the device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

773 jsr LB26D ; make sure there's a comma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

774 bsr LA5C5 ; parse the file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

775 lda DEVNUM ; get device number of the file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

776 clr DEVNUM ; reset actual device to the screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

777 puls b ; get back status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

778 cmpb #'I ; INPUT?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

779 beq LA624 ; brif so - open a file for INPUT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

780 cmpb #'O ; OUTPUT?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

781 beq LA658 ; brif so - open a file for OUTPUT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

782 LA616 ldb #21*2 ; raise FM error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

783 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

784 LA619 ldb #20*2 ; raise I/O error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

785 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

786 LA61C ldb #18*2 ; raise AO error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

787 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

788 LA61F ldb #19*2 ; raise DN error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

789 jmp LAC46

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

790 LA624 inca ; are we opening the tape?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

791 bmi LA616 ; brif printer - FM error; printer can't be opened for READ

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

792 bne LA657 ; brif screen - screen is always open

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

793 bsr LA648 ; read header block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

794 lda CASBUF+9 ; clear A if binary or machine language file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

795 anda CASBUF+10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

796 beq LA616 ; bad file mode if not data file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

797 inc FILSTA ; open file for input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

798 LA635 jsr LA701 ; start tape, read block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

799 bne LA619 ; brif error during read

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

800 tst BLKTYP ; check block type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

801 beq LA619 ; brif header block - something's wrong

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

802 bmi LA657 ; brif EOF

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

803 lda BLKLEN ; get length of block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

804 beq LA635 ; brif empty block - read another

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

805 LA644 sta CINCTR ; set buffer count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

806 bra LA652 ; reset buffer pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

807 LA648 tst FILSTA ; is the file open?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

808 bne LA61C ; brif so - AO error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

809 bsr LA681 ; search for file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

810 bne LA619 ; brif error on read

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

811 LA650 clr CINCTR ; mark buffer empty

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

812 LA652 ldx #CASBUF ; set buffer pointer to start of buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

813 stx CINPTR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

814 LA657 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

815 LA658 inca ; check for tape device

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

816 bne LA657 ; brif not tape (nothing doing - it's always open)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

817 inca ; make file type 1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

818 LA65C ldx #0xffff ; ASCII and data mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

819 LA65F tst FILSTA ; is file open?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

820 bne LA61C ; brif so - raise error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

821 ldu #CASBUF ; point to tape buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

822 stu CBUFAD ; set address of block to write

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

823 sta 8,u ; set file type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

824 stx 9,u ; set ASCII flag and mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

825 ldx #CFNBUF+1 ; point to file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

826 jsr LA598 ; move file name to the tape buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

827 clr BLKTYP ; set for header block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

828 lda #15 ; 15 bytes in a header block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

829 sta BLKLEN ; set block length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

830 jsr LA7E5 ; write the block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

831 lda #2 ; set file type to output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

832 sta FILSTA

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

833 bra LA650 ; reset file pointers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

834 ; Search for correct cassette file name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

835 LA681 ldx #CASBUF ; point to cassette buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

836 stx CBUFAD ; set location to read blocks to

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

837 LA686 lda CURLIN ; are we in immediate mode?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

838 inca

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

839 bne LA696 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

840 jsr LA928 ; clear screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

841 ldx CURPOS ; get start of screen (set after clear)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

842 ldb #'S ; for "searching"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

843 stb ,x++ ; put it on the screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

844 stx CURPOS ; save cursor position to be one past the search indicator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

845 LA696 bsr LA701 ; read a block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

846 orb BLKTYP ; merge error flag with block type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

847 bne LA6D0 ; brif error or not header

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

848 ldx #CASBUF ; point to block just read

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

849 ldu #CFNBUF+1 ; point to the desired name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

850 ldb #8 ; compare 8 characters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

851 clr ,-s ; set flag to "match"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

852 LA6A6 lda ,x+ ; get character from just read block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

853 ldy CURLIN ; immediate mode?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

854 leay 1,y

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

855 bne LA6B4 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

856 clr DEVNUM ; set output to screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

857 jsr PUTCHR ; display character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

858 LA6B4 suba ,u+ ; subtract from desired file name (nonzero if no match)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

859 ora ,s ; merge with match flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

860 sta ,s ; save new match flag (will be nonzero if any character differs)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

861 decb ; done all characters?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

862 bne LA6A6 ; brif not - do another

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

863 lda ,s+ ; get match flag (and set flags)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

864 beq LA6CB ; brif we have a match

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

865 tst -9,u ; did we actually have a file name or will any file do?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

866 beq LA6CB ; brif any file will do

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

867 bsr LA6D1 ; go read past the file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

868 bne LA6D0 ; return on error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

869 bra LA686 ; keep looking

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

870 LA6CB lda #'F ; for "found"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

871 bsr LA6F8 ; put "F" on screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

872 clra ; set Z to indicat eno errors

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

873 LA6D0 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

874 LA6D1 tst CASBUF+10 ; check type of file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

875 bne LA6DF ; brif "blocked" file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

876 jsr CASON ; turn on tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

877 LA6D9 bsr GETBLK ; read a block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

878 bsr LA6E5 ; error or EOF?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

879 bra LA6D9 ; read another block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

880 LA6DF bsr LA701 ; read a single block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

881 bsr LA6E5 ; error or EOF?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

882 bra LA6DF ; read another block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

883 LA6E5 bne LA6ED ; got error reading block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

884 lda BLKTYP ; check block type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

885 nega ; A is 0 now if EOF

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

886 bmi LA700 ; brif not end of file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

887 deca ; clear error indicator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

888 LA6ED sta CSRERR ; set error flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

889 leas 2,s ; don't return to original caller

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

890 bra LA705 ; turn off motor and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

891 LA6F3 lda VIDRAM ; get first char on screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

892 eora #0x40 ; flip case

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

893 LA6F8 ldb CURLIN ; immediate mode?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

894 incb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

895 bne LA700 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

896 sta VIDRAM ; save flipped case character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

897 LA700 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

898 ; Read a single block from tape (for a "blocked" file)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

899 LA701 bsr CASON ; start tape going

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

900 bsr GETBLK ; read block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

901 LA705 jsr LA7E9 ; stop tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

902 ldb CSRERR ; get error status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

903 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

904 ; Read a block from tape - this does the heavy lifting

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

905 GETBLK orcc #0x50 ; disable interrupts (timing is important)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

906 bsr LA6F3 ; reverse video of upper left character in direct mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

907 ldx CBUFAD ; point to destination buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

908 clra ; reset read byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

909 LA712 bsr LA755 ; read a bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

910 rora ; move bit into accumulator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

911 cmpa #0x3c ; have we synched on the start of the block data yet?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

912 bne LA712 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

913 bsr LA749 ; read block type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

914 sta BLKTYP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

915 bsr LA749 ; get block size

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

916 sta BLKLEN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

917 adda BLKTYP ; accumulate checksum

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

918 sta CCKSUM ; save current checksum

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

919 lda BLKLEN ; get back count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

920 sta CSRERR ; initialize counter; we use this since it will be ovewritten later anyway

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

921 beq LA73B ; brif empty block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

922 LA72B bsr LA749 ; read a byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

923 sta ,x ; save in buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

924 cmpa ,x+ ; make sure it wrote

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

925 bne LA744 ; brif error if it didn't match

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

926 adda CCKSUM ; accumulate checksum

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

927 sta CCKSUM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

928 dec CSRERR ; read all bytes?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

929 bne LA72B ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

930 LA73B bsr LA749 ; read checksum from tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

931 suba CCKSUM ; does it match?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

932 beq LA746 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

933 lda #1 ; checksum error flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

934 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

935 LA744 lda #2 ; non-RAM error flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

936 LA746 sta CSRERR ; save error status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

937 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

938 LA749 lda #8 ; read 8 bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

939 sta CPULWD ; initialize counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

940 LA74D bsr LA755 ; read a bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

941 rora ; put it into accumulator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

942 dec CPULWD ; got all 8 bits?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

943 bne LA74D ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

944 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

945 LA755 bsr LA75D ; get time between transitions

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

946 ldb CPERTM ; get timer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

947 decb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

948 cmpb CMPMID ; set C if timer is below the transition point - high or 1; clear otherwise

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

949 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

950 LA75D clr CPERTM ; reset timer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

951 tst CBTPHA ; check which phase we synched on

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

952 bne LA773 ; brif HI-LO synch

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

953 LA763 bsr LA76C ; read input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

954 bcs LA763 ; brif still high

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

955 LA767 bsr LA76C ; read input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

956 bcc LA767 ; brif still low

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

957 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

958 LA76C inc CPERTM ; bump timer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

959 ldb PIA1 ; get input bit to C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

960 rorb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

961 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

962 LA773 bsr LA76C ; read input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

963 bcc LA773 ; brif still low

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

964 LA777 bsr LA76C ; read output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

965 bcs LA777 ; brif still high

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

966 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

967 ; Start tape and look for sync bytes

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

968 CASON orcc #0x50 ; disable interrupts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

969 bsr LA7CA ; turn on tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

970 clr CPULWD ; reset timer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

971 LA782 bsr LA763 ; wait for low-high transition

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

972 LA784 bsr LA7AD ; wait for it to go low again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

973 bhi LA797 ; brif in range for 1200 Hz

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

974 LA788 bsr LA7A7 ; wait for it to go high again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

975 blo LA79B ; brif in range for 2400 Hz

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

976 dec CPULWD ; decrement counter (synched on low-high)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

977 lda CPULWD ; get counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

978 cmpa #-96 ; have we seen 96 1-0-1-0 patterns (48 0x55s)?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

979 LA792 bne LA782 ; brif not - wait some more

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

980 sta CBTPHA ; save phase we synched on

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

981 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

982 LA797 bsr LA7A7 ; wait for it to go high again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

983 bhi LA784 ; brif another 1200 Hz, 2 in a row, try again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

984 LA79B bsr LA7AD ; wait for it to go low again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

985 blo LA788 ; brif another 2400 Hz; go try again for high

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

986 inc CPULWD ; bump counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

987 lda CPULWD ; get counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

988 suba #96 ; set 0 if we've seen enought 0-1-0-1 patterns (0xaa)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

989 bra LA792 ; set phase and return or keep waiting

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

990 LA7A7 clr CPERTM ; reset period timer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

991 bsr LA767 ; wait for high

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

992 bra LA7B1 ; set flags on result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

993 LA7AD clr CPERTM ; reset period timer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

994 bsr LA777 ; wait for low

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

995 LA7B1 ldb CPERTM ; get period count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

996 cmpb CMP0 ; is it too long for 1200Hz?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

997 bhi LA7BA ; brif so - reset counts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

998 cmpb CMP1 ; set C if 2400Hz, clear C if 1200 Hz

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

999 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1000 LA7BA clr CPULWD ; reset sync counter (too slow or drop out)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1001 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1002 ; MOTOR command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1003 MOTOR tfr a,b ; save ON/OFF

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1004 jsr GETNCH ; eat the ON/OFF token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1005 cmpb #0xaa ; OFF?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1006 beq LA7E9 ; brif so - turn off tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1007 cmpb #0x88 ; ON?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1008 jsr LA5C9 ; SN error if no match

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1009 ; Turn on tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1010 LA7CA lda PIA1+1 ; get motor control value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1011 ora #8 ; turn on bit 3 (starts motor)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1012 bsr LA7F0 ; put it back (dumb but it saves a byte)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1013 LA7D1 ldx ZERO ; maximum delay timer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1014 LA7D3 leax -1,x ; count down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1015 bne LA7D3 ; brif not at 0 yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1016 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1017 ; Write a synch leader to tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1018 WRLDR orcc #0x50 ; disable interrupts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1019 bsr LA7CA ; turn on tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1020 ldx SYNCLN ; get count of 0x55s to write

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1021 LA7DE bsr LA828 ; write a 0x55

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1022 leax -1,x ; done?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1023 bne LA7DE ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1024 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1025 ; Write sync bytes and a block, then stop tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1026 LA7E5 bsr WRLDR ; write sync

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1027 LA7E7 bsr SNDBLK ; write block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1028 ; Turn off tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1029 LA7E9 andcc #0xaf ; enable interrupts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1030 lda PIA1+1 ; get control register

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1031 anda #0xf7 ; disable motor bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1032 LA7F0 sta PIA1+1 ; set motor enable bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1033 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1034 ; Write a block to tape.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1035 SNDBLK orcc #0x50 ; disable interrupts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1036 ldb BLKLEN ; get block size

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1037 stb CSRERR ; initialize character counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1038 lda BLKLEN ; initialize checksum

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1039 beq LA805 ; brif empty block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1040 ldx CBUFAD ; point to tape buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1041 LA800 adda ,x+ ; accumulate checksum

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1042 decb ; end of block data?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1043 bne LA800 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1044 LA805 adda BLKTYP ; accumulate block type into checksum

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1045 sta CCKSUM ; save calculated checksum

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1046 ldx CBUFAD ; point to buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1047 bsr LA828 ; send a 0x55

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1048 lda #0x3c ; and then a 0x3c

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1049 bsr LA82A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1050 lda BLKTYP ; send block type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1051 bsr LA82A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1052 lda BLKLEN ; send block size

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1053 bsr LA82A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1054 tsta ; empty block?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1055 beq LA824 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1056 LA81C lda ,x+ ; send character from block data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1057 bsr LA82A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1058 dec CSRERR ; are we done yet?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1059 bne LA81C ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1060 LA824 lda CCKSUM ; send checksum

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1061 bsr LA82A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1062 LA828 lda #0x55 ; send a 0x55

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1063 LA82A pshs a ; save output byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1064 ldb #1 ; initialize bit probe

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1065 LA82E lda CLSTSN ; get ending value of last cycle

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1066 sta PIA1 ; set DA

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1067 ldy #LA85C ; point to sine wave table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1068 bitb ,s ; is bit set?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1069 bne LA848 ; brif so - do high frequency

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1070 LA83B lda ,y+ ; get next sample (use all for low frequency)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1071 cmpy #LA85C+36 ; end of table?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1072 beq LA855 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1073 sta PIA1 ; set output sample

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1074 bra LA83B ; do another sample

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1075 LA848 lda ,y++ ; get next sample (use every other for high frequency)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1076 cmpy #LA85C+36 ; end of table?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1077 beq LA855 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1078 sta PIA1 ; send output sample

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1079 bra LA848 ; do another sample

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1080 LA855 sta CLSTSN ; save last sample that *would* have been sent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1081 lslb ; shift mask to next bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1082 bcc LA82E ; brif not done all 8 bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1083 puls a,pc ; get back original character and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1084 ; This is the sample table for the tape sine wave

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1085 LA85C fcb 0x82,0x92,0xaa,0xba,0xca,0xda

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1086 fcb 0xea,0xf2,0xfa,0xfa,0xfa,0xf2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1087 fcb 0xea,0xda,0xca,0xba,0xaa,0x92

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1088 fcb 0x7a,0x6a,0x52,0x42,0x32,0x22

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1089 fcb 0x12,0x0a,0x02,0x02,0x02,0x0a

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1090 fcb 0x12,0x22,0x32,0x42,0x52,0x6a

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1091 ; SET command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1092 SET bsr LA8C1 ; get absolute screen position of graphics block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1093 pshs x ; save character location

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1094 jsr LB738 ; evaluate comma then expression in B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1095 puls x ; get back character pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1096 cmpb #8 ; valid colour?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1097 bhi LA8D5 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1098 decb ; normalize colours

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1099 bmi LA895 ; brif colour 0 (use current colour)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1100 lda #0x10 ; 16 patterns per colour

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1101 mul

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1102 bra LA89D ; go save the colour

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1103 LA895 ldb ,x ; get current value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1104 bpl LA89C ; brif not grahpic

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1105 andb #0x70 ; keep only the colour

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1106 skip1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1107 LA89C clrb ; reset block to all black

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1108 LA89D pshs b ; save colour

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1109 bsr LA90D ; force a )

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1110 lda ,x ; get current screen value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1111 bmi LA8A6 ; brif graphic block already

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1112 clra ; force all pixels off

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1113 LA8A6 anda #0x0f ; keep only pixel data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1114 ora GRBLOK ; set the desired pixel

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1115 ora ,s+ ; merge with desired colour

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1116 LA8AC ora #0x80 ; force it to be a graphic block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1117 sta ,x ; put new block on screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1118 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1119 ; RESET command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1120 RESET bsr LA8C1 ; get address of desired block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1121 bsr LA90D ; force a )

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1122 clra ; zero block (no pixels)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1123 ldb ,x ; is it graphics?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1124 bpl LA8AC ; brif not - just blank the block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1125 com GRBLOK ; invert pixel data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1126 andb GRBLOK ; turn off the desired pixel

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1127 stb ,x ; put new pixel data on screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1128 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1129 ; Parse SET/RESET/POINT coordinates except for closing )

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1130 LA8C1 jsr LB26A ; make sure it starts with (

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1131 LA8C4 jsr RVEC21 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1132 jsr LB70B ; get first coordinate

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1133 cmpb #63 ; valid horizontal coordinate

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1134 bhi LA8D5 ; brif out of range

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1135 pshs b ; save horizontal coordinate

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1136 jsr LB738 ; look for , followed by vertical coordinate

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1137 cmpb #31 ; in range for vertical?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1138 LA8D5 bhi LA948 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1139 pshs b ; save vertical coordinate

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1140 lsrb ; divide by two (two blocks per row)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1141 lda #32 ; 32 bytes per row

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1142 mul ; now we have the offset into video RAM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1143 ldx #VIDRAM ; point to start of screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1144 leax d,x ; now X points to the correct character row

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1145 ldb 1,s ; get horizontal coordinate

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1146 lsrb ; divide by two (two per character cell)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1147 abx ; now we're pointing to the correct character cell

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1148 puls a,b ; get back coordinates (vertical in A)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1149 anda #1 ; keep only row offset of vertical

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1150 rorb ; get column offset of horizontal to C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1151 rola ; now we have "row * 2 + col" in A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1152 ldb #0x10 ; make a bit mask (one bit left of first pixel)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1153 LA8EE lsrb ; move mask right

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1154 deca ; at the right pixel?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1155 bpl LA8EE ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1156 stb GRBLOK ; save graphics block mask

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1157 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1158 ; POINT function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1159 POINT bsr LA8C4 ; evaluate coordinates

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1160 ldb #0xff ; default colour value is -1 (not graphics)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1161 lda ,x ; get character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1162 bpl LA90A ; brif not graphics

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1163 anda GRBLOK ; is desired pixel set?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1164 beq LA909 ; brif not - return 0 for "black"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1165 ldb ,x ; get graphics data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1166 lsrb ; shift right 4 to get colour in low bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1167 lsrb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1168 lsrb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1169 lsrb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1170 andb #7 ; lose the graphics block bias

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1171 LA909 incb ; shift colours into 1 to 8 range

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1172 LA90A jsr LA5E8 ; convert B to floating point

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1173 LA90D jmp LB267 ; make sure we have a ) and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1174 ; CLS command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1175 CLS jsr RVEC22 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1176 LA913 beq LA928 ; brif no colour - just do a basic screen clear

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1177 jsr LB70B ; evaluate colour number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1178 cmpb #8 ; valid colour?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1179 bhi LA937 ; brif not - do the easter egg

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1180 tstb ; color 0?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1181 beq LA925 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1182 decb ; normalize to 0 based colour numbers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1183 lda #0x10 ; 16 blocks per colour

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1184 mul ; now we have the base code for that colour

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1185 orb #0x0f ; set all pixels

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1186 LA925 orb #0x80 ; make it a graphics block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1187 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1188 LA928 ldb #0x60 ; VDG screen space character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1189 ldx #VIDRAM ; point to start of screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1190 LA92D stx CURPOS ; set cursor position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1191 LA92F stb ,x+ ; blank a character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1192 cmpx #VIDRAM+511 ; end of screen?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1193 bls LA92F ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1194 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1195 LA937 bsr LA928 ; clear te screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1196 ldx #LA166-1 ; point to the easter egg

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1197 jmp LB99C ; go display it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1198 ; Evaluate an expression to B, prefixed by a comma, and do FC error if 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1199 LA93F jsr LB26D ; force a comma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1200 LA942 jsr LB70B ; evaluate expression to B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1201 tstb ; is it 0?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1202 bne LA984 ; brif not - return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1203 LA948 jmp LB44A ; raise FC error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1204 ; SOUND command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1205 SOUND bsr LA942 ; evaluate frequency

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1206 stb SNDTON ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1207 bsr LA93F ; evaluate duration (after a comma)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1208 LA951 lda #4 ; constant factor for duration (each increment is 1/15 of a second)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1209 mul

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1210 std SNDDUR ; save length of sound (IRQ will count it down)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1211 lda PIA0+3 ; enable 60 Hz interrupt

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1212 ora #1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1213 sta PIA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1214 clr ARYDIS ; clear array disable flag for some reason

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1215 bsr LA9A2 ; connect DAC to MUX output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1216 bsr LA976 ; turn on sound

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1217 LA964 bsr LA985 ; store mid range output value and delay

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1218 lda #0xfe ; store high value and delay

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1219 bsr LA987

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1220 bsr LA985 ; store mid range value and delay

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1221 lda #2 ; store low value and delay

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1222 bsr LA987

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1223 ldx SNDDUR ; has timer expired?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1224 bne LA964 ; brif not, do another wave

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1225 ; Disable sound output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1226 LA974 clra ; bit 3 to 0 will disable output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1227 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1228 ; Enable sound output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1229 LA976 lda #8 ; bit 3 set to enable output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1230 sta ,-s ; save desired value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1231 lda PIA1+3 ; get control register value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1232 anda #0xf7 ; reset value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1233 ora ,s+ ; set to desired value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1234 sta PIA1+3 ; set new sound output status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1235 LA984 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1236 LA985 lda #0x7e ; mid range value for DAC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1237 LA987 sta PIA1 ; set DAC output value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1238 lda SNDTON ; get frequency

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1239 LA98C inca ; increment it (gives shorter count with higher values, so higher frequencies work)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1240 bne LA98C ; brif not done yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1241 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1242 ; AUDIO command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1243 AUDIO tfr a,b ; save ON/OFF token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1244 jsr GETNCH ; munch the ON/OFF token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1245 cmpb #0xaa ; OFF?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1246 beq LA974 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1247 subb #0x88 ; ON?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1248 jsr LA5C9 ; do SN error if not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1249 incb ; now B is 1 - cassette sound source

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1250 bsr LA9A2 ; set MUX input to tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1251 bra LA976 ; enable sound

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1252 ; Set MUX source to value in B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1253 LA9A2 ldu #PIA0+1 ; point to PIA0 control register A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1254 bsr LA9A7 ; program bit 0 then fall through for bit 1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1255 LA9A7 lda ,u ; get control register value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1256 anda #0xf7 ; reset mux control bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1257 asrb ; shift desired value to C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1258 bcc LA9B0 ; brif this bit is clear

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1259 ora #8 ; set the bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1260 LA9B0 sta ,u++ ; set register value and move to next register

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1261 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1262 ; IRQ service routine

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1263 BIRQSV lda PIA0+3 ; check for VSYNC interrupt

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1264 bpl LA9C5 ; brif not - return. BUG: should clear HSYNC interrupt status first

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1265 lda PIA0+2 ; clear VSYNC interrupt status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1266 ldx >SNDDUR ; are we counting down for SOUND? (force extended in case DP is modified)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1267 beq LA9C5 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1268 leax -1,x ; count down one tick

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1269 stx >SNDDUR ; save new count (forced extended in case DP is modified)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1270 LA9C5 rti

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1271 ; JOYSTK function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1272 JOYSTK jsr LB70E ; evaluate which joystick axis is desired

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1273 cmpb #3 ; valid axis?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1274 lbhi LB44A ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1275 tstb ; want axis 0?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1276 bne LA9D4 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1277 bsr GETJOY ; read axis data if axis 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1278 LA9D4 ldx #POTVAL ; point to axis values

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1279 ldb FPA0+3 ; get desired axis

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1280 ldb b,x ; get axis value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1281 jmp LB4F3 ; return value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1282 ; Read all four joystick axes. Note that this routine will try 10 times to get a value that matches

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1283 ; the value obtained during the *previous call to this routine*. Thus, if the axis value has changed,

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1284 ; this routine will do the read *ten times* before just returning the last value. This is assininely

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1285 ; slow and probably a bug since it seems more logical to look for two matching reads in a row. Note

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1286 ; also that this routine should be using PSHS and PULS but it doesn't.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1287 GETJOY bsr LA974 ; turn off sound

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1288 ldx #POTVAL+4 ; point to the end of the axis data (we'll work backwards)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1289 ldb #3 ; start with axis 3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1290 LA9E5 lda #10 ; 10 tries to see if we match *the last call* to this routine

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1291 std ,--s ; save retry counter and axis number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1292 bsr LA9A2 ; set MUX for the correct axis

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1293 LA9EB ldd #0x4080 ; set initial trial value to mid range and the next difference to add/subtract to half

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1294 LA9EE sta ,-s ; store the add/subtract value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1295 orb #2 ; keep rs232 output marking

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1296 stb PIA1 ; set DAC output to the trial value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1297 eorb #2 ; remove RS232 output value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1298 lda PIA0 ; read the comparator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1299 bmi LA9FF ; brif comparator output is high (DAC is lower than the axis value)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1300 subb ,s ; subtract next bit value (split the difference toward 0)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1301 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1302 LA9FF addb ,s ; add next bit value (split the different toward infinity)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1303 lda ,s+ ; get bit value back

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1304 lsra ; cut in half

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1305 cmpa #1 ; have we done that last value for the DAC?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1306 bne LA9EE ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1307 lsrb ; normalize the axis value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1308 lsrb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1309 cmpb -1,x ; does it match the read from the last call to this routine?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1310 beq LAA12 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1311 dec ,s ; are we out of retries?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1312 bne LA9EB ; brif not - try again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1313 LAA12 stb ,-x ; save new value and move pointer back

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1314 ldd ,s++ ; get axis counter and clean up retry counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1315 decb ; move to next axis

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1316 bpl LA9E5 ; brif still more axes to do

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1317 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1318 ; This is the "bottom half" of the character fetching routines.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1319 BROMHK cmpa #'9+1 ; is it >= colon?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1320 bhs LAA28 ; brif so Z set if colon, C clear.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1321 cmpa #0x20 ; space?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1322 bne LAA24 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1323 jmp GETNCH ; move on to another character if space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1324 LAA24 suba #'0 ; normalize ascii digit to 0-9; we already handled above digit 9

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1325 suba #-'0 ; this will cause a carry for any value that was already positive

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1326 LAA28 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1327 ; Jump table for functions

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1328 LAA29 fdb SGN ; SGN 0x80

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1329 fdb INT ; INT 0x81

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1330 fdb ABS ; ABS 0x82

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1331 fdb USRJMP ; USR 0x83

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1332 fdb RND ; RND 0x84

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1333 fdb SIN ; SIN 0x85

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1334 fdb PEEK ; PEEK 0x86

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1335 fdb LEN ; LEN 0x87

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1336 fdb STR ; STR$ 0x88

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1337 fdb VAL ; VAL 0x89

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1338 fdb ASC ; ASC 0x8a

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1339 fdb CHR ; CHR$ 0x8b

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1340 fdb EOF ; EOF 0x8c

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1341 fdb JOYSTK ; JOYSTK 0x8d

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1342 fdb LEFT ; LEFT$ 0x8e

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1343 fdb RIGHT ; RIGHT$ 0x8f

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1344 fdb MID ; MID$ 0x90

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1345 fdb POINT ; POINT 0x91

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1346 fdb INKEY ; INKEY$ 0x92

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1347 fdb MEM ; MEM 0x93

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1348 ; Operator precedence and jump table (binary ops except relational)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1349 LAA51 fcb 0x79 ; +

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1350 fdb LB9C5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1351 fcb 0x79 ; -

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1352 fdb LB9BC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1353 fcb 0x7b ; *

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1354 fdb LBACC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1355 fcb 0x7b ; /

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1356 fdb LBB91

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1357 fcb 0x7f ; ^ (exponentiation)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1358 fdb EXPJMP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1359 fcb 0x50 ; AND

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1360 fdb LB2D5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1361 fcb 0x46 ; OR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1362 fdb LB2D4

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1363 ; Reserved words table for commands

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1364 LAA66 fcs 'FOR' ; 0x80

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1365 fcs 'GO' ; 0x81

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1366 fcs 'REM' ; 0x82

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1367 fcs "'" ; 0x83

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1368 fcs 'ELSE' ; 0x84

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1369 fcs 'IF' ; 0x85

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1370 fcs 'DATA' ; 0x86

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1371 fcs 'PRINT' ; 0x87

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1372 fcs 'ON' ; 0x88

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1373 fcs 'INPUT' ; 0x89

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1374 fcs 'END' ; 0x8a

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1375 fcs 'NEXT' ; 0x8b

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1376 fcs 'DIM' ; 0x8c

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1377 fcs 'READ' ; 0x8d

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1378 fcs 'RUN' ; 0x8e

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1379 fcs 'RESTORE' ; 0x8f

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1380 fcs 'RETURN' ; 0x90

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1381 fcs 'STOP' ; 0x91

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1382 fcs 'POKE' ; 0x92

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1383 fcs 'CONT' ; 0x93

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1384 fcs 'LIST' ; 0x94

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1385 fcs 'CLEAR' ; 0x95

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1386 fcs 'NEW' ; 0x96

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1387 fcs 'CLOAD' ; 0x97

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1388 fcs 'CSAVE' ; 0x98

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1389 fcs 'OPEN' ; 0x99

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1390 fcs 'CLOSE' ; 0x9a

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1391 fcs 'LLIST' ; 0x9b

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1392 fcs 'SET' ; 0x9c

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1393 fcs 'RESET' ; 0x9d

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1394 fcs 'CLS' ; 0x9e

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1395 fcs 'MOTOR' ; 0x9f

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1396 fcs 'SOUND' ; 0xa0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1397 fcs 'AUDIO' ; 0xa1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1398 fcs 'EXEC' ; 0xa2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1399 fcs 'SKIPF' ; 0xa3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1400 fcs 'TAB(' ; 0xa4

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1401 fcs 'TO' ; 0xa5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1402 fcs 'SUB' ; 0xa6

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1403 fcs 'THEN' ; 0xa7

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1404 fcs 'NOT' ; 0xa8

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1405 fcs 'STEP' ; 0xa9

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1406 fcs 'OFF' ; 0xaa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1407 fcs '+' ; 0xab

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1408 fcs '-' ; 0xac

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1409 fcs '*' ; 0xad

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1410 fcs '/' ; 0xae

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1411 fcs '^' ; 0xaf

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1412 fcs 'AND' ; 0xb0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1413 fcs 'OR' ; 0xb1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1414 fcs '>' ; 0xb2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1415 fcs '=' ; 0xb3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1416 fcs '<' ; 0xb4

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1417 ; Reserved word list for functions

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1418 LAB1A fcs 'SGN' ; 0x80

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1419 fcs 'INT' ; 0x81

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1420 fcs 'ABS' ; 0x82

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1421 fcs 'USR' ; 0x83

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1422 fcs 'RND' ; 0x84

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1423 fcs 'SIN' ; 0x85

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1424 fcs 'PEEK' ; 0x86

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1425 fcs 'LEN' ; 0x87

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1426 fcs 'STR$' ; 0x88

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1427 fcs 'VAL' ; 0x89

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1428 fcs 'ASC' ; 0x8a

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1429 fcs 'CHR$' ; 0x8b

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1430 fcs 'EOF' ; 0x8c

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1431 fcs 'JOYSTK' ; 0x8d

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1432 fcs 'LEFT$' ; 0x8e

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1433 fcs 'RIGHT$' ; 0x8f

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1434 fcs 'MID$' ; 0x90

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1435 fcs 'POINT' ; 0x91

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1436 fcs 'INKEY$' ; 0x92

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1437 fcs 'MEM' ; 0x93

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1438 ; Jump table for commands

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1439 LAB67 fdb FOR ; 0x80 FOR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1440 fdb GO ; 0x81 GO

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1441 fdb REM ; 0x82 REM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1442 fdb REM ; 0x83 '

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1443 fdb REM ; 0x84 ELSE

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1444 fdb IFTOK ; 0x85 IF

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1445 fdb DATA ; 0x86 DATA

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1446 fdb PRINT ; 0x87 PRINT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1447 fdb ON ; 0x88 ON

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1448 fdb INPUT ; 0x89 INPUT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1449 fdb ENDTOK ; 0x8a END

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1450 fdb NEXT ; 0x8b NEXT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1451 fdb DIM ; 0x8c DIM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1452 fdb READ ; 0x8d READ

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1453 fdb RUN ; 0x8e RUN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1454 fdb RESTOR ; 0x8f RESTORE

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1455 fdb RETURN ; 0x90 RETURN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1456 fdb STOP ; 0x91 STOP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1457 fdb POKE ; 0x92 POKE

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1458 fdb CONT ; 0x93 CONT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1459 fdb LIST ; 0x94 LIST

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1460 fdb CLEAR ; 0x95 CLEAR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1461 fdb NEW ; 0x96 NEW

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1462 fdb CLOAD ; 0x97 CLOAD

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1463 fdb CSAVE ; 0x98 CSAVE

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1464 fdb OPEN ; 0x99 OPEN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1465 fdb CLOSE ; 0x9a CLOSE

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1466 fdb LLIST ; 0x9b LLIST

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1467 fdb SET ; 0x9c SET

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1468 fdb RESET ; 0x9d RESET

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1469 fdb CLS ; 0x9e CLS

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1470 fdb MOTOR ; 0x9f MOTOR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1471 fdb SOUND ; 0xa0 SOUND

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1472 fdb AUDIO ; 0xa1 AUDIO

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1473 fdb EXEC ; 0xa2 EXEC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1474 fdb SKIPF ; 0xa3 SKIPF

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1475 ; Error message table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1476 LABAF fcc 'NF' ; 0 NEXT without FOR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1477 fcc 'SN' ; 1 Syntax error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1478 fcc 'RG' ; 2 RETURN without GOSUB

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1479 fcc 'OD' ; 3 Out of data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1480 fcc 'FC' ; 4 Illegal function call

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1481 fcc 'OV' ; 5 Overflow

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1482 fcc 'OM' ; 6 Out of memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1483 fcc 'UL' ; 7 Undefined line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1484 fcc 'BS' ; 8 Bad subscript

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1485 fcc 'DD' ; 9 Redimensioned array

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1486 fcc '/0' ; 10 Division by 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1487 fcc 'ID' ; 11 Illegal direct statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1488 fcc 'TM' ; 12 Type mismatch

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1489 fcc 'OS' ; 13 Out of string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1490 fcc 'LS' ; 14 String too long

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1491 fcc 'ST' ; 15 String formula too complex

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1492 fcc 'CN' ; 16 Can't continue

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1493 fcc 'FD' ; 17 Bad file data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1494 fcc 'AO' ; 18 File already open

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1495 fcc 'DN' ; 19 Device number error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1496 fcc 'IO' ; 20 Input/output error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1497 fcc 'FM' ; 21 Bad file mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1498 fcc 'NO' ; 22 File not open

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1499 fcc 'IE' ; 23 Input past end of file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1500 fcc 'DS' ; 24 Direct statement in file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1501 LABE1 fcn ' ERROR'

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1502 LABE8 fcn ' IN '

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1503 LABED fcb 0x0d

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1504 LABEE fcc 'OK'

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1505 fcb 0x0d,0x00

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1506 LABF2 fcb 0x0d

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1507 fcn 'BREAK'

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1508 ; Search stack for a FOR/NEXT stack frame. Stop search when something that isn't a FOR/NEXT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1509 ; stack frame is found. Enter with the index variable descriptor pointer in VARDES, or NULL

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1510 ; for the first match.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1511 ;

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1512 ; NOTE: this routine can be reworked to avoid needed two temporaries by taking advantage of the

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1513 ; 6809's registers. This requires some minor tweaks where the routine is called. Further, the

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1514 ; use of B is completely pointless and, even if B is going to be used, why is it reloaded on

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1515 ; every loop?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1516 LABF9 leax 4,s ; skip past our caller and the main command loop return address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1517 LABFB ldb #18 ; each FOR/NEXT frame is 18 bytes

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1518 stx TEMPTR ; save current search pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1519 lda ,x ; get first byte of this frame

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1520 suba #0x80 ; set to 0 if FOR/NEXT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1521 bne LAC1A ; brif not FOR/NEXT (we hit the end of the stack for a GOSUB frame)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1522 ldx 1,x ; get index variable descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1523 stx TMPTR1 ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1524 ldx VARDES ; get desired index descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1525 beq LAC16 ; brif NULL - we found something

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1526 cmpx TMPTR1 ; does this one match?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1527 beq LAC1A ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1528 ldx TEMPTR ; get back frame pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1529 abx ; move to next entry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1530 bra LABFB ; check next block of data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1531 LAC16 ldx TMPTR1 ; get index variable of this frame

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1532 stx VARDES ; set it as the one found

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1533 LAC1A ldx TEMPTR ; get matching frame pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1534 tsta ; set Z if FOR/NEXT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1535 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1536 ; This is a block copy routine which copies from top to bottom. It's not clear that the use of

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1537 ; this routine actually saves any ROM space compared to just implementing the copies directly

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1538 ; once all the marshalling to set up the parameter variables is taken into account.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1539 LAC1E bsr LAC37 ; check to see if stack collides with D

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1540 LAC20 ldu V41 ; point to destination

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1541 leau 1,u ; offset for pre-dec

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1542 ldx V43 ; point to source

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1543 leax 1,x ; offset for pre-dec

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1544 LAC28 lda ,-x ; get source byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1545 pshu a ; store at destination (sta ,-u would be less weird)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1546 cmpx V47 ; at the bottom of the copy?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1547 bne LAC28 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1548 stu V45 ; save final destination address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1549 LAC32 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1550 ; Check for 2*B (0 <= B <= 127) bytes for free memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1551 LAC33 clra ; zero extend

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1552 aslb ; times 2 (loses bit 7 of B)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1553 addd ARYEND ; add to top of used memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1554 LAC37 addd #STKBUF ; add a fudge factor for interpreter operation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1555 bcs LAC44 ; brif >65535!

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1556 sts BOTSTK ; get current stack pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1557 cmpd BOTSTK ; is our new address above that?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1558 blo LAC32 ; brif not - no error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1559 LAC44 ldb #6*2 ; raise OM error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1560 ; The error servicing routine

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1561 LAC46 jsr RVEC16 ; do the RAM hook dance (ON ERROR reserved hook)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1562 LAC49 jsr RVEC17 ; do the RAM hook dance again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1563 jsr LA7E9 ; turn off tape

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1564 jsr LA974 ; disable sound

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1565 jsr LAD33 ; reset stack, etc.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1566 clr DEVNUM ; reset output to screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1567 jsr LB95C ; do a newline

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1568 jsr LB9AF ; send a ?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1569 ldx #LABAF ; point to error table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1570 abx ; offset to correct message

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1571 bsr LACA0 ; send a char from X

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1572 bsr LACA0 ; send another char from X

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1573 ldx #LABE1-1 ; point to "ERROR" message

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1574 LAC68 jsr LB99C ; print ERROR message (or BREAK)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1575 lda CURLIN ; are we in immediate mode?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1576 inca

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1577 beq LAC73 ; brif not - go to immediate mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1578 jsr LBDC5 ; print "IN ****"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1579 ; This is the immediate mode loop

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1580 LAC73 jsr LB95C ; do a newline if needed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1581 LAC76 ldx #LABEE-1 ; point to prompt (without leading CR)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1582 jsr LB99C ; show prompt

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1583 LAC7C jsr LA390 ; read an input line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1584 ldu #0xffff ; flag immediate mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1585 stu CURLIN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1586 bcs LAC7C ; brif we ended on BREAK - just go for another line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1587 tst CINBFL ; EOF?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1588 lbne LA4BF ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1589 stx CHARAD ; save start of input line as input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1590 jsr GETNCH ; get character from input line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1591 beq LAC7C ; brif no input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1592 bcs LACA5 ; brif numeric - adding or removing a line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1593 ldb #2*24 ; code for "direct statement in file"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1594 tst DEVNUM ; keyboard input?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1595 bne LAC46 ; brif not - complain about direct statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1596 jsr LB821 ; go tokenize the input line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1597 jmp LADC0 ; go execute the newly tokenized line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1598 LACA0 lda ,x+ ; get character and advance pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1599 jmp LB9B1 ; output it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1600 LACA5 jsr LAF67 ; convert line number to binary

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1601 ldx BINVAL ; get converted number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1602 stx LINHDR ; put it before the line we just read

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1603 jsr LB821 ; tokenize the input line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1604 stb TMPLOC ; save line length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1605 bsr LAD01 ; find where the line should be in the program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1606 bcs LACC8 ; brif the line number isn't already present

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1607 ldd V47 ; get address where the line is in the program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1608 subd ,x ; get the difference between here and the end of the line (negative)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1609 addd VARTAB ; subtract line length from the end of the program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1610 std VARTAB ; save new end of program address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1611 ldu ,x ; get start of next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1612 LACC0 pulu a ; get source byte (lda ,u+ would be less weird)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1613 sta ,x+ ; move it down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1614 cmpx VARTAB ; have we moved everything yet?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1615 bne LACC0 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1616 LACC8 lda LINBUF ; see if there is actually a line to input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1617 beq LACE9 ; brif not - we just needed to remove the line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1618 ldd VARTAB ; get current end of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1619 std V43 ; set as source pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1620 addb TMPLOC ; add in the length of the new line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1621 adca #0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1622 std V41 ; save destination pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1623 jsr LAC1E ; make sure there's enough room and then make a hole for the new line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1624 ldu #LINHDR-2 ; point to the line (well, 4 bytes before it, incl line number and fake next line pointer)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1625 LACDD pulu a ; get byte from new line (lda ,u+ would be less weird)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1626 sta ,x+ ; stow it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1627 cmpx V45 ; at the end of the hole we just made?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1628 bne LACDD ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1629 ldx V41 ; get save new top of program address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1630 stx VARTAB

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1631 LACE9 bsr LAD21 ; reset variables, etc.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1632 bsr LACEF ; adjust next line pointers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1633 bra LAC7C ; go read another input line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1634 ; Recompute next line pointers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1635 LACEF ldx TXTTAB ; point to start of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1636 LACF1 ldd ,x ; get address of next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1637 beq LAD16 ; brif end of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1638 leau 4,x ; move past pointer and line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1639 LACF7 lda ,u+ ; are we at the end of the line?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1640 bne LACF7 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1641 stu ,x ; save new next line pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1642 ldx ,x ; point to next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1643 bra LACF1 ; process the next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1644 ; Find a line in the program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1645 LAD01 ldd BINVAL ; get desired line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1646 ldx TXTTAB ; point to start of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1647 LAD05 ldu ,x ; get address of next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1648 beq LAD12 ; brif end of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1649 cmpd 2,x ; do we have a match?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1650 bls LAD14 ; brif our search number is <= the number here

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1651 ldx ,x ; move to next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1652 bra LAD05 ; check another line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1653 LAD12 orcc #1 ; set C for not found

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1654 LAD14 stx V47 ; save address of matching line *or* line just after where it would have been

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1655 LAD16 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1656 ; NEW command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1657 ; This routine has multiple entry points used for various "levels" of NEW

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1658 NEW bne LAD14 ; brif there was input given; should be LAD16!

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1659 LAD19 ldx TXTTAB ; point to start of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1660 clr ,x+ ; blank out program (with NULL next line pointer)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1661 clr ,x+

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1662 stx VARTAB ; save end of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1663 LAD21 ldx TXTTAB ; get start of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1664 jsr LAEBB ; put input pointer there

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1665 LAD26 ldx MEMSIZ ; reset string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1666 stx STRTAB

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1667 jsr RESTOR ; reset DATA pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1668 ldx VARTAB ; clear out scalars and arrays

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1669 stx ARYTAB

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1670 stx ARYEND

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1671 LAD33 ldx #STRSTK ; reset the string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1672 stx TEMPPT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1673 ldx ,s ; get return address (we're going to reset the stack)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1674 lds FRETOP ; reset the stack to top of memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1675 clr ,-s ; put stopper so FOR/NEXT search will actually stop here

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1676 clr OLDPTR ; reset "CONT" state

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1677 clr OLDPTR+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1678 clr ARYDIS ; un-disable arrays

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1679 jmp ,x ; return to original caller

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1680 ; FOR command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1681 FOR lda #0x80 ; disable array parsing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1682 sta ARYDIS

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1683 jsr LET ; assign start value to index

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1684 jsr LABF9 ; search stack for matching FOR/NEXT frame

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1685 leas 2,s ; lose return address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1686 bne LAD59 ; brif variable not already being used

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1687 ldx TEMPTR ; get address of matched data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1688 leas b,x ; move stack pointer to the end of it (B is set to 18 in the stack search)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1689 LAD59 ldb #9 ; is there room for 18 bytes in memory?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1690 jsr LAC33

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1691 jsr LAEE8 ; get address of the end of this statement in X

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1692 ldd CURLIN ; get line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1693 pshs x,b,a ; save next line address and current line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1694 ldb #0xa5 ; make sure we have TO

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1695 jsr LB26F

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1696 jsr LB143 ; make sure we have a numeric index

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1697 jsr LB141 ; evaluate terminal condition value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1698 ldb FP0SGN ; pack FPA0 in place

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1699 orb #0x7f

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1700 andb FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1701 stb FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1702 ldy #LAD7F ; where to come back to

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1703 jmp LB1EA ; stash terminal condition on the stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1704 LAD7F ldx #LBAC5 ; point to FP 1.0 (default step)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1705 jsr LBC14 ; unpack it to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1706 jsr GETCCH ; get character after the terminal

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1707 cmpa #0xa9 ; is it STEP?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1708 bne LAD90 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1709 jsr GETNCH ; eat STEP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1710 jsr LB141 ; evaluate step condition

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1711 LAD90 jsr LBC6D ; get "status" of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1712 jsr LB1E6 ; stash FPA0 on the stack (for step value)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1713 ldd VARDES ; get variable descriptor pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1714 pshs d ; put that on the stack too

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1715 lda #0x80 ; flag the frame as a FOR/NEXT frame

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1716 pshs a

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1717 ; Main command interpretation loop

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1718 LAD9E jsr RVEC20 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1719 andcc #0xaf ; make sure interrupts are running

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1720 bsr LADEB ; check for BREAK/pause

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1721 ldx CHARAD ; get input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1722 stx TINPTR ; save input pointer for start of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1723 lda ,x+ ; get current input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1724 beq LADB4 ; brif end of line - move to another line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1725 cmpa #': ; end of statement?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1726 beq LADC0 ; brif so - keep processing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1727 LADB1 jmp LB277 ; raise a syntax error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1728 LADB4 lda ,x++ ; get MSB of next line pointer and skip past pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1729 sta ENDFLG

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1730 beq LAE15 ; brif MSB of next line address is 0 (do END)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1731 ldd ,x+ ; get line number but only advance one

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1732 std CURLIN ; set current line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1733 stx CHARAD ; set input pointer to one before line text

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1734 LADC0 jsr GETNCH ; move past statement separator or to first character in line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1735 bsr LADC6 ; process a command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1736 bra LAD9E ; handle next statement or line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1737 LADC6 beq LAE40 ; return if end of statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1738 tsta ; is it a token?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1739 lbpl LET ; brif not - do a LET

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1740 cmpa #0xa3 ; above SKIPF?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1741 bhi LADDC ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1742 ldx COMVEC+3 ; point to jump table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1743 lsla ; two bytes per entry (loses the token bias)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1744 tfr a,b ; put it in B for unsigned ABX

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1745 abx

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1746 jsr GETNCH ; move past token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1747 jmp [,x] ; transfer control to the handler (which will return to the main loop)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1748 LADDC cmpa #0xb4 ; is it a non-executable token?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1749 bls LADB1 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1750 jmp [COMVEC+13] ; transfer control to ECB command handler

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1751 ; RESTORE command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1752 RESTOR ldx TXTTAB ; point to beginning of the program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1753 leax -1,x ; move back one (to compensate for "GETNCH")

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1754 LADE8 stx DATPTR ; save as new data pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1755 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1756 ; BREAK check

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1757 LADEB jsr LA1C1 ; read keyboard

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1758 beq LADFA ; brif no key down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1759 LADF0 cmpa #3 ; BREAK?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1760 beq STOP ; brif so - do a STOP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1761 cmpa #0x13 ; pause (SHIFT-@)?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1762 beq LADFB ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1763 sta IKEYIM ; cache key for later INKEY$ so break check doesn't break INKEY$

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1764 LADFA rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1765 LADFB jsr KEYIN ; read keyboard

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1766 beq LADFB ; brif no key down

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1767 bra LADF0 ; process pressed key in case BREAK or SHIFT-@ again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1768 ; END command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1769 ENDTOK jsr LA426 ; close files

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1770 jsr GETCCH ; re-get input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1771 bra LAE0B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1772 ; STOP command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1773 STOP orcc #1 ; flag "STOP"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1774 LAE0B bne LAE40 ; brif not end of statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1775 ldx CHARAD ; save current input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1776 stx TINPTR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1777 LAE11 ror ENDFLG ; save END/STOP flag (C)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1778 leas 2,s ; lose return address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1779 LAE15 ldx CURLIN ; get current input line (end of program comes here)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1780 cmpx #0xffff ; immediate mode?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1781 beq LAE22 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1782 stx OLDTXT ; save line where we stopped executing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1783 ldx TINPTR ; get input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1784 stx OLDPTR ; save location where we stopped executing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1785 LAE22 clr DEVNUM ; reset to screen/keyboard

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1786 ldx #LABF2-1 ; point to BREAK message

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1787 tst ENDFLG ; are we doing "BREAK"?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1788 lbpl LAC73 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1789 jmp LAC68 ; go do the BREAK message and return to main loop

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1790 ; CONT command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1791 CONT bne LAE40 ; brif not end of statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1792 ldb #2*16 ; code for can't continue

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1793 ldx OLDPTR ; get saved execution pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1794 lbeq LAC46 ; brif no saved pointer - raise CN error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1795 stx CHARAD ; reset input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1796 ldx OLDTXT ; reset current line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1797 stx CURLIN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1798 LAE40 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1799 ; CLEAR command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1800 CLEAR beq LAE6F ; brif no argument

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1801 jsr LB3E6 ; evaluate string space size

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1802 pshs d ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1803 ldx MEMSIZ ; get memory size (top of memory)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1804 jsr GETCCH ; is there anything after the string space size?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1805 beq LAE5A ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1806 jsr LB26D ; force a comma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1807 jsr LB73D ; get top of memory value in X

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1808 leax -1,x ; move back one (top of cleared space)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1809 cmpx TOPRAM ; is it within the memory available?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1810 bhi LAE72 ; brif higher than top of memory - OM error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1811 LAE5A tfr x,d ; so we can do math for checking memory usage

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1812 subd ,s++ ; subtract out string space value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1813 bcs LAE72 ; brif less than 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1814 tfr d,u ; U is bottom of cleared space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1815 subd #STKBUF ; also account for slop space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1816 bcs LAE72 ; brif less than 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1817 subd VARTAB ; is there still room for the program?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1818 blo LAE72 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1819 stu FRETOP ; set top of free memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1820 stx MEMSIZ ; set size of usable memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1821 LAE6F jmp LAD26 ; erase variables, etc.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1822 LAE72 jmp LAC44 ; raise OM error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1823 ; RUN command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1824 RUN jsr RVEC18 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1825 jsr LA426 ; close any open files

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1826 jsr GETCCH ; is there a line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1827 lbeq LAD21 ; brif no line number - start from beginning

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1828 jsr LAD26 ; clear variables, etc.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1829 bra LAE9F ; "GOTO" the line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1830 ; GO command (GOTO and GOSUB)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1831 GO tfr a,b ; save TO/SUB

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1832 LAE88 jsr GETNCH ; eat the TO/SUB token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1833 cmpb #0xa5 ; TO?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1834 beq LAEA4 ; brif GOTO

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1835 cmpb #0xa6 ; SUB?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1836 bne LAED7 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1837 ldb #3 ; room for 6 bytes?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1838 jsr LAC33

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1839 ldu CHARAD ; get input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1840 ldx CURLIN ; get line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1841 lda #0xa6 ; flag for GOSUB frame

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1842 pshs u,x,a ; set stack frame

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1843 LAE9F bsr LAEA4 ; do "GOTO"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1844 jmp LAD9E ; go back to main loop

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1845 ; Actual GOTO is here

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1846 LAEA4 jsr GETCCH ; get current input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1847 jsr LAF67 ; convert number to binary

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1848 bsr LAEEB ; move input pointer to end of statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1849 leax 1,x ; point to start of next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1850 ldd BINVAL ; get desired line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1851 cmpd CURLIN ; is it beyond here?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1852 bhi LAEB6 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1853 ldx TXTTAB ; start search at beginning of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1854 LAEB6 jsr LAD05 ; find line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1855 bcs LAED2 ; brif not found

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1856 LAEBB leax -1,x ; move to just before start of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1857 stx CHARAD ; reset input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1858 LAEBF rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1859 ; RETURN command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1860 RETURN bne LAEBF ; exit if argument given

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1861 lda #0xff ; set VARDES to an illegal value so we ignore FOR frames

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1862 sta VARDES

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1863 jsr LABF9 ; look for a GOSUB frame

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1864 tfr x,s ; reset stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1865 cmpa #0xa6-0x80 ; is it a GOSUB frame?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1866 beq LAEDA ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1867 ldb #2*2 ; code for RETURN without GOSUB

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1868 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1869 LAED2 ldb #7*2 ; code for undefined line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1870 jmp LAC46 ; raise error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1871 LAED7 jmp LB277 ; raise syntax error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1872 LAEDA puls a,x,u ; get back saved line number and input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1873 stx CURLIN ; reset line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1874 stu CHARAD ; reset input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1875 ; DATA command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1876 DATA bsr LAEE8 ; move input pointer to end of statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1877 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1878 ; REM command (also ELSE)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1879 REM bsr LAEEB ; move input pointer to end of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1880 stx CHARAD ; save new input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1881 LAEE7 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1882 ; Return end of statement (LAEE8) or line (AEEB) in X

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1883 LAEE8 ldb #': ; colon is statement terminator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1884 skip1lda

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1885 LAEEB clrb ; make main terminator NUL

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1886 stb CHARAC ; save terminator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1887 clrb ; end of line - always terminates

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1888 ldx CHARAD ; get input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1889 LAEF1 tfr b,a ; save secondary terminator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1890 ldb CHARAC ; get main terminator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1891 sta CHARAC ; save secondary

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1892 LAEF7 lda ,x ; get input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1893 beq LAEE7 ; brif end of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1894 pshs b ; save terminator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1895 cmpa ,s+ ; does it match?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1896 beq LAEE7 ; brif so - bail

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1897 leax 1,x ; move pointer ahead

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1898 cmpa #'" ; start of string?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1899 beq LAEF1 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1900 inca ; functon token?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1901 bne LAF0C ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1902 leax 1,x ; skip second part of function token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1903 LAF0C cmpa #0x85+1 ; IF?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1904 bne LAEF7 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1905 inc IFCTR ; bump "IF" count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1906 bra LAEF7 ; get check another input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1907 ; IF command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1908 IFTOK jsr LB141 ; evaluate condition

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1909 jsr GETCCH ; find out what's after the conditin

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1910 cmpa #0x81 ; GO?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1911 beq LAF22 ; treat same as THEN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1912 ldb #0xa7 ; make sure we have a THEN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1913 jsr LB26F

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1914 LAF22 lda FP0EXP ; get true/false (false is 0)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1915 bne LAF39 ; brif condition true

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1916 clr IFCTR ; reset IF counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1917 LAF28 bsr DATA ; skip over statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1918 tsta ; end of line?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1919 beq LAEE7 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1920 jsr GETNCH ; get start of this statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1921 cmpa #0x84 ; ELSE?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1922 bne LAF28 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1923 dec IFCTR ; is it a matching ELSE?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1924 bpl LAF28 ; brif not - keep looking

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1925 jsr GETNCH ; eat the ELSE

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1926 LAF39 jsr GETCCH ; get current input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1927 lbcs LAEA4 ; brif numeric - to a GOTO

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1928 jmp LADC6 ; let main loop interpret the next command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1929 ; ON command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1930 ON jsr LB70B ; evaluate index expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1931 LAF45 ldb #0x81 ; make sure we have "GO"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1932 jsr LB26F

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1933 pshs a ; save TO/SUB

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1934 cmpa #0xa6 ; SUB?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1935 beq LAF54 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1936 cmpa #0xa5 ; TO?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1937 LAF52 bne LAED7 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1938 LAF54 dec FPA0+3 ; are we at the right index?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1939 bne LAF5D ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1940 puls b ; get TO/SUB token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1941 jmp LAE88 ; go do GOTO or GOSUB

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1942 LAF5D jsr GETNCH ; munch a character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1943 bsr LAF67 ; parse line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1944 cmpa #', ; is there another line following?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1945 beq LAF54 ; brif so - see if we're there yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1946 puls b,pc ; clean up TO/SUB token and return - we fell through

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1947 ; Parse a line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1948 LAF67 ldx ZERO ; initialize line number accumulator to 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1949 stx BINVAL

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1950 LAF6B bcc LAFCE ; brif not numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1951 suba #'0 ; adjust to actual value of digit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1952 sta CHARAC ; save digit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1953 ldd BINVAL ; get accumulated number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1954 cmpa #24 ; will this overflow?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1955 bhi LAF52 ; brif so - raise syntax error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1956 aslb ; times 2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1957 rola

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1958 aslb ; times 4

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1959 rola

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1960 addd BINVAL ; times 5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1961 aslb ; times 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1962 rola

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1963 addb CHARAC ; add in digit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1964 adca #0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1965 std BINVAL ; save new accumulated number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1966 jsr GETNCH ; fetch next character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1967 bra LAF6B ; process next digit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1968 ; LET command (the LET keyword requires Extended Basic)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1969 LET jsr LB357 ; evaluate destination variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1970 stx VARDES ; save descriptor pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1971 ldb #0xb3 ; make sure we have =

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1972 jsr LB26F

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1973 lda VALTYP ; get destination variable type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1974 pshs a ; save it for later

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1975 jsr LB156 ; evaluate the expression to assign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1976 puls a ; get back original variable type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1977 rora ; put type in C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1978 jsr LB148 ; make sure the current result matches the type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1979 lbeq LBC33 ; bri fnumeric - copy FPA0 to variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1980 LAFA4 ldx FPA0+2 ; point to descriptor of replacement string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1981 ldd FRETOP ; get bottom of string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1982 cmpd 2,x ; is the string already in string space?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1983 bhs LAFBE ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1984 cmpx VARTAB ; is the descriptor in variable space?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1985 blo LAFBE ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1986 LAFB1 ldb ,x ; get length of string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1987 jsr LB50D ; allocate space for this string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1988 ldx V4D ; get descriptor pointer back

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1989 jsr LB643 ; copy string into string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1990 ldx #STRDES ; point to temporary string descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1991 LAFBE stx V4D ; save descriptor pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1992 jsr LB675 ; remove string from string stack if appropriate

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1993 ldu V4D ; get back replacement descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1994 ldx VARDES ; get target descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1995 pulu a,b,y ; get string length (A) and data pointer (Y)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1996 sta ,x ; save new length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1997 sty 2,x ; save new pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1998 LAFCE rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

1999 ; READ and INPUT commands.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2000 LAFCF fcc '?REDO' ; The ?REDO message

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2001 fcb 0x0d,0x00

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2002 LAFD6 ldb #2*17 ; bad file data code

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2003 tst DEVNUM ; are we reading from the keyboard?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2004 beq LAFDF ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2005 LAFDC jmp LAC46 ; raise the error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2006 LAFDF lda INPFLG ; are we doing INPUT?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2007 beq LAFEA ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2008 ldx DATTXT ; get line number where the DATA statement happened

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2009 stx CURLIN ; set current line number to that so can report the correct location

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2010 jmp LB277 ; raise a syntax error on bad data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2011 LAFEA ldx #LAFCF-1 ; show the ?REDO if we're doing INPUT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2012 jsr LB99C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2013 ldx TINPTR ;* reset input pointer to start of statement (this will cause the

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2014 stx CHARAD ;* INPUT statement to be re-executed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2015 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2016 INPUT ldb #11*2 ; code for illegal direct statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2017 ldx CURLIN ; are we in immediate mode?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2018 leax 1,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2019 beq LAFDC ; brif so - raise ID error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2020 bsr LB002 ; go do the INPUT thing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2021 clr DEVNUM ; reset device to screen/keyboard

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2022 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2023 LB002 cmpa #'# ; is there a device number?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2024 bne LB00F ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2025 jsr LA5A5 ; parse device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2026 jsr LA3ED ; make sure it's valid for input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2027 jsr LB26D ; make sure we have a comma after the device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2028 LB00F cmpa #'" ; is there a prompt string?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2029 bne LB01E ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2030 jsr LB244 ; parse the prompt string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2031 ldb #'; ; make sure we have a semicolon after the prompt

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2032 jsr LB26F

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2033 jsr LB99F ; print the prompt

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2034 LB01E ldx #LINBUF ; point to line input buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2035 clr ,x ; NUL first byte to indicate no data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2036 tst DEVNUM ; is it keyboard input?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2037 bne LB049 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2038 bsr LB02F ; read a line from the keyboard

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2039 ldb #', ; put a comma at the start of the buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2040 stb ,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2041 bra LB049 ; go process some input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2042 LB02F jsr LB9AF ; send a ?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2043 jsr LB9AC ; send a space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2044 LB035 jsr LA390 ; read input from the keyboard

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2045 bcc LB03F ; brif not BREAK

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2046 leas 4,s ; clean up stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2047 LB03C jmp LAE11 ; go process BREAK

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2048 LB03F ldb #2*23 ; input past end of file error code

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2049 tst CINBFL ; was it EOF?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2050 bne LAFDC ; brif so - raise the error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2051 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2052 READ ldx DATPTR ; fetch current DATA pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2053 skip1lda ; set A to nonzero (for READ)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2054 LB049 clra ; set A to zero (for INPUT)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2055 sta INPFLG ; record whether we're doing READ or INPUT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2056 stx DATTMP ; save current input location

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2057 LB04E jsr LB357 ; evaluate a variable (destination of data)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2058 stx VARDES ; save descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2059 ldx CHARAD ; save interpreter input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2060 stx BINVAL

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2061 ldx DATTMP ; get data pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2062 lda ,x ; is there anything to read?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2063 bne LB069 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2064 lda INPFLG ; is it INPUT?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2065 bne LB0B9 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2066 jsr RVEC10 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2067 jsr LB9AF ; send a ? (so subsequent lines get ??)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2068 bsr LB02F ; go read an input line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2069 LB069 stx CHARAD ; save data pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2070 jsr GETNCH ; fetch next data character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2071 ldb VALTYP ; do we want a number?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2072 beq LB098 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2073 ldx CHARAD ; get input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2074 sta CHARAC ; save initial character as the delimiter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2075 cmpa #'" ; do we have a string delimiter?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2076 beq LB08B ; brif so - use " as both delimiters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2077 leax -1,x ; back up input if we don't have a delimiter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2078 clra ; set delimiter to NUL (end of line)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2079 sta CHARAC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2080 jsr LA35F ; set up print parameters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2081 tst PRTDEV ; is it a file type device?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2082 bne LB08B ; brif so - use two NULs

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2083 lda #': ; use colon as one delimiter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2084 sta CHARAC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2085 lda #', ; and use comma as the other

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2086 LB08B sta ENDCHR ; save second terminator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2087 jsr LB51E ; parse out the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2088 jsr LB249 ; move input pointer past the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2089 jsr LAFA4 ; assign the string to the variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2090 bra LB09E ; go see if there's more to read

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2091 LB098 jsr LBD12 ; parse a numeric string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2092 jsr LBC33 ; assign the numbe to the variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2093 LB09E jsr GETCCH ; get current input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2094 beq LB0A8 ; brif end of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2095 cmpa #', ; check for comma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2096 lbne LAFD6 ; brif not - we have bad data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2097 LB0A8 ldx CHARAD ; get current data pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2098 stx DATTMP ; save the data pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2099 ldx BINVAL ; restore the interpreter input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2100 stx CHARAD

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2101 jsr GETCCH ; get current input from program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2102 beq LB0D5 ; brif end of statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2103 jsr LB26D ; make sure there's a comma between variables

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2104 bra LB04E ; go read another item

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2105 LB0B9 stx CHARAD ; reset input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2106 jsr LAEE8 ; search for end of statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2107 leax 1,x ; move past end of statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2108 tsta ; was it end of line?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2109 bne LB0CD ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2110 ldb #2*3 ; code for out of data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2111 ldu ,x++ ; get pointer to next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2112 beq LB10A ; brif end of program - raise OD error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2113 ldd ,x++ ; get line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2114 std DATTXT ; record it for raising errors in DATA statements

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2115 LB0CD lda ,x ; do we have a DATA statement?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2116 cmpa #0x86

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2117 bne LB0B9 ; brif not - keep scanning

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2118 bra LB069 ; go process the input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2119 LB0D5 ldx DATTMP ; get data pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2120 ldb INPFLG ; were we doing READ?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2121 lbne LADE8 ; brif so - save DATA pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2122 lda ,x ; is there something after the input in the input buffer?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2123 beq LB0E7 ; brif not - we consumed everything

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2124 ldx #LB0E8-1 ; print the ?EXTRA IGNORED message

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2125 jmp LB99C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2126 LB0E7 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2127 LB0E8 fcc '?EXTRA IGNORED'

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2128 fcb 0x0d,0x00

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2129 ; NEXT command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2130 NEXT bne LB0FE ; brif argument given

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2131 ldx ZERO ; set to NULL descriptor pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2132 bra LB101 ; go process "any index will do"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2133 LB0FE jsr LB357 ; evaluate the variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2134 LB101 stx VARDES ; save the index we're looking for

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2135 jsr LABF9 ; search the stack for the matching frame

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2136 beq LB10C ; brif we found a matching frame

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2137 ldb #0 ; code for NEXT without FOR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2138 LB10A bra LB153 ; raise the error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2139 LB10C tfr x,s ; reset the stack to the start of the stack frame

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2140 leax 3,x ; point to the STEP value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2141 jsr LBC14 ; copy the value to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2142 lda 8,s ; get step direction

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2143 sta FP0SGN ; save as sign of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2144 ldx VARDES ; point to index variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2145 jsr LB9C2 ; add (X) to FPA0 (steps the index)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2146 jsr LBC33 ; save new value to the index

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2147 leax 9,s ; point to terminal condition

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2148 jsr LBC96 ; compare the new index value with the terminal

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2149 subb 8,s ; set B=0 if we hit the terminal (or passed it with nonzero step)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2150 beq LB134 ; brif loop complete

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2151 ldx 14,s ; restore line number and input pointer to start of loop

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2152 stx CURLIN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2153 ldx 16,s

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2154 stx CHARAD

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2155 LB131 jmp LAD9E ; return to interpretation loop

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2156 LB134 leas 18,s ; remove the frame from the stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2157 jsr GETCCH ; get character after the index

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2158 cmpa #', ; do we have more indexes?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2159 bne LB131 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2160 jsr GETNCH ; munch the comma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2161 bsr LB0FE ; go process another value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2162 ; NOTE: despite the BSR on the preceding line, execution of the NEXT command will not fall

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2163 ; through this point, nor will the stack grow without bound. The BSR is required to make sure

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2164 ; the stack is aligned properly for the stack search for the subsequent index variable.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2165 ;

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2166 ; The following is the expression evaluation system. It has various entry points including for type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2167 ; checking. This really consists of two co-routines, one for evaluating operators and one for individual

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2168 ; terms. However, it does some rather confusing stack operations so it's a bit difficult to follow

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2169 ; just how some of this works.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2170 ;

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2171 ; Evaluate numeric expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2172 LB141 bsr LB156 ; evaluate an expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2173 ; TM error if string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2174 LB143 andcc #0xfe ; clear C to indicate we want a number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2175 skip2keepc

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2176 ; TM error if numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2177 LB146 orcc #1 ; set C to indicate we want a string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2178 ; TM error if: C = 1 and number, OR C = 0 and string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2179 LB148 tst VALTYP ; set flags on the current value to (doesn't change C)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2180 bcs LB14F ; brif we want a string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2181 bpl LB0E7 ; brif we have a number (we want a number)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2182 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2183 LB14F bmi LB0E7 ; brif we have a string (we want a string)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2184 LB151 ldb #12*2 ; code for TM error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2185 LB153 jmp LAC46 ; raise the error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2186 ; The general expression evaluation entry point

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2187 LB156 bsr LB1C6 ; back up input pointer to compensate for GETNCH below

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2188 LB158 clra ; set operator precedence to 0 (no previous operator)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2189 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2190 LB15A pshs b ; save relational operator flags

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2191 pshs a ; save previous operator precedence

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2192 ldb #1 ; make sure we aren't overflowing the stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2193 jsr LAC33

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2194 jsr LB223 ; go evaluate the first term

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2195 LB166 clr TRELFL ; flag no relational operators seen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2196 LB168 jsr GETCCH ; get input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2197 LB16A suba #0xb2 ; token for > (lowest relational operator)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2198 blo LB181 ; brif below relational operators

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2199 cmpa #3 ; there are three relational operators, is it one?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2200 bhs LB181 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2201 cmpa #1 ; set C if >

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2202 rola ; shift C into bit 0 (4: <, 2: =, 1: >)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2203 eora TRELFL ; flip the bit for this operator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2204 cmpa TRELFL ; did the result get lower?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2205 blo LB1DF ; brif so - we have a duplicate so raise an error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2206 sta TRELFL ; save new operator flags

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2207 jsr GETNCH ; munch the operator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2208 bra LB16A ; go see if we have another one

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2209 LB181 ldb TRELFL ; do we have a relational comparison?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2210 bne LB1B8 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2211 lbcc LB1F4 ; brif the token is above the relational operators

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2212 adda #7 ; put operators starting at 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2213 bhs LB1F4 ; brif we're above 0 - it's an operator, Jim

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2214 adca VALTYP ; add carry, numeric flag, and modified token number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2215 lbeq LB60F ; brif we have string and A is + - do concatenation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2216 adca #-1 ; restore operator number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2217 pshs a ; save operator number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2218 asla ; times 2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2219 adda ,s+ ; and times 3 (3 bytes per entry)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2220 ldx #LAA51 ; point to operator pecedence and jump table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2221 leax a,x ; point to correct entry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2222 LB19F puls a ; get precedence of previous operation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2223 cmpa ,x ; is hit higher (or same) than the current one?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2224 bhs LB1FA ; brif so - we need to process that operator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2225 bsr LB143 ; TM error if we have a string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2226 LB1A7 pshs a ; save previous operation precedence

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2227 bsr LB1D4 ; push operator handler address and FPA0 onto the stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2228 ldx RELPTR ; get pointer to arithmetic/logical table entry for last operation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2229 puls a ; get back precedence

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2230 bne LB1CE ; brif we had a relational operation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2231 tsta ; check precedence of previous operation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2232 lbeq LB220 ; brif end of expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2233 bra LB203 ; go handle operation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2234 LB1B8 asl VALTYP ; get type of value to C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2235 rolb ; mix it in to bit 0 of relational flags

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2236 bsr LB1C6 ; back up input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2237 ldx #LB1CB ; point to relational operator precedence and handler

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2238 stb TRELFL ; save relational comparison flags

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2239 clr VALTYP ; result will be numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2240 bra LB19F ; to process the operation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2241 LB1C6 ldx CHARAD ; get input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2242 jmp LAEBB ; back it up one and put it back

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2243 LB1CB fcb 0x64 ; precedence of relational comparison

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2244 fdb LB2F4 ; handler address for relational comparison

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2245 LB1CE cmpa ,x ; is last done operation higher (or same) precedence?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2246 bhs LB203 ; brif so - go process it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2247 bra LB1A7 ; go push things on the stack and process this operation otherwise

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2248 LB1D4 ldd 1,x ; get address of operatorroutine

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2249 pshs d ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2250 bsr LB1E2 ; push FPA0 onto the stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2251 ldb TRELFL ; get back relational operator flags

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2252 lbra LB15A ; go evaluate another operation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2253 LB1DF jmp LB277 ; raise a syntax error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2254 LB1E2 ldb FP0SGN ; get sign of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2255 lda ,x ; get precedence of this operation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2256 LB1E6 puls y ; get back original caller

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2257 pshs b ; save sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2258 LB1EA ldb FP0EXP ; get exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2259 ldx FPA0 ; get mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2260 ldu FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2261 pshs u,x,b ; stow FPA0 sign and mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2262 jmp ,y ; return to caller

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2263 LB1F4 ldx ZERO ; point to dummy value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2264 lda ,s+ ; get precedence of previous operation (and set flags)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2265 beq LB220 ; brif end of expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2266 LB1FA cmpa #0x64 ; relational operation?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2267 beq LB201 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2268 jsr LB143 ; type mismatch if string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2269 LB201 stx RELPTR ; save pointer to operator routine

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2270 LB203 puls b ; get relational flags

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2271 cmpa #0x5a ; NOT operation?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2272 beq LB222 ; brif so (it was unary)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2273 cmpa #0x7d ; unary negation?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2274 beq LB222 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2275 lsrb ; shift value type flag out of relational flags

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2276 stb RELFLG ; save relational operator flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2277 puls a,x,u ; get FP value back

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2278 sta FP1EXP ; set exponent and mantissa in FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2279 stx FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2280 stu FPA1+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2281 puls b ; and the sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2282 stb FP1SGN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2283 eorb FP0SGN ; set RESSGN if the two operand signs differ

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2284 stb RESSGN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2285 LB220 ldb FP0EXP ; get exponent of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2286 LB222 rts ; return or transfer control to operator handler routine

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2287 LB223 jsr RVEC15 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2288 clr VALTYP ; set type to numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2289 jsr GETNCH ; get first character in the term

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2290 bcc LB22F ; brif not numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2291 LB22C jmp LBD12 ; parse a number (and return)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2292 LB22F jsr LB3A2 ; set carry if not alpha

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2293 bcc LB284 ; brif alpha character (variable)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2294 cmpa #'. ; decimal point?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2295 beq LB22C ; brif so - evaluate number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2296 cmpa #0xac ; minus?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2297 beq LB27C ; brif so - process unary negation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2298 cmpa #0xab ; plus?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2299 beq LB223 ; brif so - ignore unary "posation"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2300 cmpa #'" ; string delimiter?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2301 bne LB24E ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2302 LB244 ldx CHARAD ; get input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2303 jsr LB518 ; go parse the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2304 LB249 ldx COEFPT ; get address of end of string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2305 stx CHARAD ; move input pointer past string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2306 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2307 LB24E cmpa #0xa8 ; NOT?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2308 bne LB25F ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2309 lda #0x5a ; precedence of unary NOT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2310 jsr LB15A ; process the operand of NOT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2311 jsr INTCNV ; convert to integer in D

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2312 coma ; do a bitwise complement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2313 comb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2314 jmp GIVABF ; resturn the result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2315 LB25F inca ; is it a function token?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2316 beq LB290 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2317 LB262 bsr LB26A ; only other legal thing must be a (expr)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2318 jsr LB156 ; evaluate parentheticized expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2319 LB267 ldb #') ; force a )

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2320 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2321 LB26A ldb #'( ; force a (

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2322 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2323 LB26D ldb #', ; force a ,

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2324 LB26F cmpb [CHARAD] ; does character match?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2325 bne LB277 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2326 jmp GETNCH ; each the character and return the next

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2327 LB277 ldb #2*1 ; raise syntax error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2328 jmp LAC46

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2329 LB27C lda #0x7d ; unary negation precedence

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2330 jsr LB15A ; evaluate argument

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2331 jmp LBEE9 ; flip sign of FPA0 and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2332 LB284 jsr LB357 ; evaluate variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2333 LB287 stx FPA0+2 ; save descriptor address in FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2334 lda VALTYP ; test variable type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2335 bne LB222 ; brif string - we're done

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2336 jmp LBC14 ; copy FP number from (X) into FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2337 LB290 jsr GETNCH ; get the actual token number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2338 tfr a,b ; save it (for offsetting X)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2339 lslb ; two bytes per jump table entry (and lose high bit)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2340 jsr GETNCH ; eat the token byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2341 cmpb #2*19 ; is it a valid token for Color Basic?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2342 bls LB29F ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2343 jmp [COMVEC+18] ; transfer control to Extended Basic if not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2344 LB29F pshs b ; save jump table offset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2345 cmpb #2*14 ; does it expect a numeric argument?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2346 blo LB2C7 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2347 cmpb #2*18 ; does it need no arguments?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2348 bhs LB2C9 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2349 bsr LB26A ; force a (

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2350 lda ,s ; get token value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2351 cmpa #2*17 ; is it POINT?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2352 bhs LB2C9 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2353 jsr LB156 ; evaluate first argument string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2354 bsr LB26D ; force a comma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2355 jsr LB146 ; TM error if string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2356 puls a ; get token value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2357 ldu FPA0+2 ; get string descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2358 pshs u,a ; now we save the first string argument and the token value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2359 jsr LB70B ; evaluate first numeric argument

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2360 puls a ; get back token value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2361 pshs b,a ; save second argument and token value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2362 fcb 0x8e ; opcode of LDX immediate (skips two bytes)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2363 LB2C7 bsr LB262 ; force a (

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2364 LB2C9 puls b ; get offset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2365 ldx COMVEC+8 ; get jump table pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2366 abx ; add offset into table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2367 jsr [,x] ; go process function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2368 jmp LB143 ; make sure result is numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2369 ; operator OR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2370 LB2D4 skip1lda ; set flag to nonzero to signal OR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2371 ; operator AND

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2372 LB2D5 clra ; set flag to zero to signal AND

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2373 sta TMPLOC ; save AND/OR flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2374 jsr INTCNV ; convert second argument to intenger

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2375 std CHARAC ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2376 jsr LBC4A ; move first argument to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2377 jsr INTCNV ; convert first argument to integer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2378 tst TMPLOC ; is it AND or OR?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2379 bne LB2ED ; brif OR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2380 anda CHARAC ; do the bitwise AND

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2381 andb ENDCHR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2382 bra LB2F1 ; finish up

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2383 LB2ED ora CHARAC ; do the bitwise OR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2384 orb ENDCHR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2385 LB2F1 jmp GIVABF ; return integer result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2386 ; relational comparision operators

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2387 LB2F4 jsr LB148 ; TM error if type mismatch

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2388 BNE LB309 ; brif we have a string comparison

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2389 lda FP1SGN ; pack FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2390 ora #0x7f

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2391 anda FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2392 sta FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2393 ldx #FP1EXP ; point to packed FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2394 jsr LBC96 ; compare FPA0 to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2395 bra LB33F ; handle truth comparison

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2396 LB309 clr VALTYP ; the result of a comparison is always a number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2397 dec TRELFL ; remove the string flag from the comparison data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2398 jsr LB657 ; get string details for second argument

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2399 stb STRDES ; save them in the temporary string descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2400 stx STRDES+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2401 ldx FPA1+2 ; get pointer to first argument descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2402 jsr LB659 ; get string details for second argument

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2403 lda STRDES ; get length of second argument

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2404 pshs b ; save length of first argument

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2405 suba ,s+ ; now A is the difference in string lengths

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2406 beq LB328 ; brif string lengths are equal

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2407 lda #1 ; flag for second argument is longer than first

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2408 bcc LB328 ; brif second string is longer than first

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2409 ldb STRDES ; get length of second string (shorter)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2410 nega ; invert default comparison result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2411 LB328 sta FP0SGN ; save default truth flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2412 ldu STRDES+2 ; get pointer to start of second string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2413 incb ; compensate for DECB

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2414 LB32D decb ; have we compared everything?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2415 bne LB334 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2416 ldb FP0SGN ; get default truth value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2417 bra LB33F ; decide comparison truth

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2418 LB334 lda ,x+ ; get byte from first argument

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2419 cmpa ,u+ ; compare with second argument

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2420 beq LB32D ; brif equal - keep comparing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2421 ldb #0xff ; negative if first string is > second

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2422 bcc LB33F ; brif string A > string B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2423 negb ; invert result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2424 LB33F addb #1 ; convert to 0,1,2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2425 rolb ; shift left - now it's 4,2,1 for <, =, >

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2426 andb RELFLG ; keep only the truth we care about

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2427 beq LB348 ; brif no matching bits - it's false

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2428 ldb #0xff ; set true

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2429 LB348 jmp LBC7C ; convert result to FP and return it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2430 ; DIM command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2431 LB34B jsr LB26D ; make sure there's a comma between variables

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2432 DIM ldb #1 ; flag that we're dimensioning

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2433 bsr LB35A ; go allocate the variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2434 jsr GETCCH ; are we done?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2435 bne LB34B ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2436 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2437 ; This routine parses a variable. For scalars, it will return a NULL string or 0 value number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2438 ; if it is called from "evaluate term". Otherwise, it allocates the variable. For arrays, it will

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2439 ; allocate a default sized array if dimensioning is not underway and then attempt to look up

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2440 ; the requested coordinates in that array. Otherwise, it will allocate an array based on the

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2441 ; specified dimension values.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2442 LB357 clrb ; flag that we're not setting up an array

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2443 jsr GETCCH

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2444 LB35A stb DIMFLG ; save dimensioning flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2445 sta VARNAM ; save first character of variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2446 jsr GETCCH ; get input character (why? we already have it)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2447 bsr LB3A2 ; set carry if not alpha

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2448 lbcs LB277 ; brif our variable doesn't start with a letter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2449 clrb ; default second variable character to NUL

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2450 stb VALTYP ; set value type to numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2451 jsr GETNCH ; get second character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2452 bcs LB371 ; brif numeric - numbers are allowed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2453 bsr LB3A2 ; set carry if not alpha

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2454 bcs LB37B ; brif not alpha

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2455 LB371 tfr a,b ; save set second character of variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2456 LB373 jsr GETNCH ; get an input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2457 bcs LB373 ; brif numeric - still in variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2458 bsr LB3A2 ; set carry if not alpha

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2459 bcc LB373 ; brif alpha - still in variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2460 LB37B cmpa #'$ ; do we have the string sigil?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2461 bne LB385 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2462 com VALTYP ; set value type to string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2463 addb #0x80 ; set bit 7 of second variable character to indicate string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2464 jsr GETNCH ; eat the sigil

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2465 LB385 stb VARNAM+1 ; save second variable name character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2466 ora ARYDIS ; merge array disable flag (will set bit 7 of input character if no arrays)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2467 suba #'( ; do we have a subscript?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2468 lbeq LB404 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2469 clr ARYDIS ; disable the array disable flag - it's single use

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2470 ldx VARTAB ; point to the start of the variable table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2471 ldd VARNAM ; get variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2472 LB395 cmpx ARYTAB ; are we at the top of the variable table?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2473 beq LB3AB ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2474 cmpd ,x++ ; does the variable name match (and move pointer to variable data)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2475 beq LB3DC ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2476 leax 5,x ; move to next table entry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2477 bra LB395 ; see if we have a match

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2478 ; Set carry if not upper case alpha

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2479 LB3A2 cmpa #'A ; set C if less than A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2480 bcs LB3AA ; brif less than A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2481 suba #'Z+1 ; set C if greater than Z

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2482 suba #-('Z+1)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2483 LB3AA rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2484 LB3AB ldx #ZERO ; point to empty location (NULL/0 value)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2485 ldu ,s ; get caller address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2486 cmpu #LB287 ; coming from "evaluate term"?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2487 beq LB3DE ; brif so - don't allocate

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2488 ldd ARYEND ; get end of arrays

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2489 std V43 ; save as top of source block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2490 addd #7 ; 7 bytes per scalar entry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2491 std V41 ; save as top of destination block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2492 ldx ARYTAB ; get bottom of arrays

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2493 stx V47 ; save as bottom of source block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2494 jsr LAC1E ; move the arrays up to make a hole

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2495 ldx V41 ; get new top of arrays

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2496 stx ARYEND ; set new end of arrays

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2497 ldx V45 ; get bottom of destination block

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2498 stx ARYTAB ; set as new start of arrays

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2499 ldx V47 ; get old end of variables

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2500 ldd VARNAM ; get name of variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2501 std ,x++ ; set variable name and advance X to the value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2502 clra ; zero out the variable value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2503 clrb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2504 std ,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2505 std 2,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2506 sta 4,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2507 LB3DC stx VARPTR ; save descriptor address of return value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2508 LB3DE rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2509 ; Various integer conversion routines

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2510 LB3DF fcb 0x90,0x80,0x00,0x00,0x00 ; FP constant -32768

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2511 LB3E4 jsr GETNCH ; fetch input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2512 LB3E6 jsr LB141 ; evaluate numeric expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2513 LB3E9 lda FP0SGN ; get sign of value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2514 bmi LB44A ; brif negative (raise FC error)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2515 INTCNV jsr LB143 ; TM error if string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2516 lda FP0EXP ; get exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2517 cmpa #0x90 ; is it within the range for a 16 bit integer?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2518 blo LB3FE ; brif smaller than 32768

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2519 ldx #LB3DF ; point to -32678 constant

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2520 jsr LBC96 ; is FPA0 equal to -32768?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2521 bne LB44A ; brif not - magnitude is too far negative

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2522 LB3FE jsr LBCC8 ; move binary point to the right of FPA0 and correct sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2523 ldd FPA0+2 ; get the resulting integer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2524 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2525 LB404 ldd DIMFLG ; get dimensioning flag and variable type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2526 pshs b,a ; save them (to avoid issues while evaluating dimension values)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2527 nop ; dead space caused by 1.2 revision

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2528 clrb ; reset dimension counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2529 LB40A ldx VARNAM ; get variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2530 pshs x,b ; save dimension counter and variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2531 bsr LB3E4 ; evaluate a dimension value (and skip either ( or ,)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2532 puls b,x,y ; get variable name, dimension counter, and dimensioning/type flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2533 stx VARNAM ; restore variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2534 ldu FPA0+2 ; get dimension size/index

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2535 pshs u,y ; save dimension size and dimensioning/type flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2536 incb ; bump dimension counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2537 jsr GETCCH ; get what's after the dimension count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2538 cmpa #', ; do we have another dimension?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2539 beq LB40A ; brif so - parse it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2540 stb TMPLOC ; save dimension counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2541 jsr LB267 ; make sure we have a )

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2542 puls a,b ; get back variable type and dimensioning flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2543 std DIMFLG ; restore variable type and dimensioning flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2544 ldx ARYTAB ; get start of arrays

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2545 LB42A cmpx ARYEND ; are we at the end of the array table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2546 beq LB44F ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2547 ldd VARNAM ; get variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2548 cmpd ,x ; does it match?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2549 beq LB43B ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2550 ldd 2,x ; get length of this array

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2551 leax d,x ; move to next array

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2552 bra LB42A ; go check another entry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2553 LB43B ldb #2*9 ; code for redimensioned array error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2554 lda DIMFLG ; are we dimensioning?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2555 bne LB44C ; brif so - raise error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2556 ldb TMPLOC ; get number of dimensions given

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2557 cmpb 4,x ; does it match?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2558 beq LB4A0 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2559 LB447 ldb #8*2 ; raise "bad subscript"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2560 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2561 LB44A ldb #4*2 ; raise "illegal function call"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2562 LB44C jmp LAC46 ; raise error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2563 LB44F ldd #5 ; 5 bytes per array entry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2564 std COEFPT ; initialize array size to entry size

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2565 ldd VARNAM ; get variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2566 std ,x ; set array name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2567 ldb TMPLOC ; get dimension count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2568 stb 4,x ; set dimension count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2569 jsr LAC33 ; make sure we haven't overflowed memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2570 stx V41 ; save array descriptor address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2571 LB461 ldb #11 ; default dimension value (zero-based, gives max index of 10)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2572 clra ; zero extend (??? why not LDD above?)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2573 tst DIMFLG ; are we dimensioning?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2574 beq LB46D ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2575 puls a,b ; get dimension size

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2576 addd #1 ; account for zero based indexing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2577 LB46D std 5,x ; save dimension size

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2578 bsr LB4CE ; multiply by accumulated array size

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2579 std COEFPT ; save new array size

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2580 leax 2,x ; move to next dimension

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2581 dec TMPLOC ; have we done all dimensions?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2582 bne LB461 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2583 stx TEMPTR ; save end of array descriptor (minus 5)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2584 addd TEMPTR ; add total size of array to address of descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2585 lbcs LAC44 ; brif it overflows memory

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2586 tfr d,x ; save end of array for later

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2587 jsr LAC37 ; does array fit in memory?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2588 subd #STKBUF-5 ; subtract out the "stack fudge factor" but add 5 to the result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2589 std ARYEND ; save new end of arrays

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2590 clra ; set up for clearing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2591 LB48C leax -1,x ; move back one

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2592 sta 5,x ; blank out a byte in the array data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2593 cmpx TEMPTR ; have we reached the array header?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2594 bne LB48C ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2595 ldx V41 ; get address of start of descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2596 lda ARYEND ; get MSB of end of array back (B still has LSB)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2597 subd V41 ; subtract start of descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2598 std 2,x ; save length of array in array header

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2599 lda DIMFLG ; are we dimensioning?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2600 bne LB4CD ; brif so - we're done

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2601 LB4A0 ldb 4,x ; get number of dimensions

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2602 stb TMPLOC ; initialize counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2603 clra ; initialize accumulated offset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2604 clrb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2605 LB4A6 std COEFPT ; save accumulated offset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2606 puls a,b ; get desired index

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2607 std FPA0+2 ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2608 cmpd 5,x ; is it in range for this dimension?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2609 bhs LB4EB ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2610 ldu COEFPT ; get accumulated offset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2611 beq LB4B9 ; brif first dimension

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2612 bsr LB4CE ; multiply accumulated offset by dimension length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2613 addd FPA0+2 ; add in offset into this dimension

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2614 LB4B9 leax 2,x ; move to next dimension in header

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2615 dec TMPLOC ; done all dimensions?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2616 bne LB4A6 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2617 std ,--s ; save D for multiply by 5 (should be pshs d)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2618 aslb ; times 2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2619 rola

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2620 aslb ; times 4

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2621 rola

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2622 addd ,s++ ; times 5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2623 leax d,x ; add in offset from start of array data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2624 leax 5,x ; offset to end of header

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2625 stx VARPTR ; save pointer to element data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2626 LB4CD rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2627 ; multiply 16 bit number at 5,x by the 16 bit number in COEFPT; return result in D; BS error if carry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2628 LB4CE lda #16 ; 16 shifts to do a multiply

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2629 sta V45 ; save shift counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2630 ldd 5,x ; get multiplier

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2631 std BOTSTK ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2632 clra ; zero out product

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2633 clrb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2634 LB4D8 aslb ; shift product left

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2635 rola

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2636 bcs LB4EB ; brif we have a carry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2637 asl COEFPT+1 ; shift other factor left

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2638 rol COEFPT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2639 bcc LB4E6 ; brif no carry - this bit position is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2640 addd BOTSTK ; add in multiplier at this bit position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2641 bcs LB4EB ; brif carry - do an error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2642 LB4E6 dec V45 ; have we done all 16 bits?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2643 bne LB4D8 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2644 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2645 LB4EB jmp LB447 ; raise a BS error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2646 ; MEM function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2647 ; BUG: this doesn't account for the STKBUF fudge factor used for memory availability checks

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2648 MEM tfr s,d ; get stack pointer where we can do math

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2649 subd ARYEND ; calculate number of bytes between the stack and the top of arrays

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2650 skip1 ; return result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2651 ; Convert unsigned value in B to FP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2652 LB4F3 clra ; zero extend

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2653 ; Convert signed value in D to FP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2654 GIVABF clr VALTYP ; set value type to numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2655 std FPA0 ; save value in FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2656 ldb #0x90 ; exponent for top two bytes to be an integer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2657 jmp LBC82 ; finish conversion to integer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2658 ; STR$ function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2659 STR jsr LB143 ; make sure we have a number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2660 ldu #STRBUF+2 ; convert FP number to string in temporary string buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2661 jsr LBDDC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2662 leas 2,s ; don't return to the function evaluator (which will do a numeric type check)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2663 ldx #STRBUF+1 ; point to number string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2664 bra LB518 ; to stash the string in string space and return to the "evaluate term" caller

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2665 ; Reserve B bytes of string space. Return start in X and FRESPC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2666 LB50D stx V4D ; save X somewhere in case the caller needs it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2667 LB50F bsr LB56D ; allocate string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2668 LB511 stx STRDES+2 ; save pointer to allocated space in the temporary descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2669 stb STRDES ; save length in the temporary descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2670 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2671 LB516 leax -1,x ; move pointer back one (to compensate for the increment below)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2672 ; Scan from X until either NUL or one of the string terminators is found

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2673 LB518 lda #'" ; set terminator to be string delimiter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2674 LB51A sta CHARAC ; set both delimiters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2675 sta ENDCHR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2676 LB51E leax 1,x ; move to next character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2677 stx RESSGN ; save start of string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2678 stx STRDES+2 ; save start of string in the temporary string descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2679 ldb #-1 ; initialize length counter to -1 (compensate for initial INCB)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2680 LB526 incb ; bump string length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2681 lda ,x+ ; get character from string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2682 beq LB537 ; brif end of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2683 cmpa CHARAC ; is it delimiter #1?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2684 beq LB533 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2685 cmpa ENDCHR ; is it delimiter #2?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2686 bne LB526 ; brif not - keep scanning

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2687 LB533 cmpa #'" ; string delimiter?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2688 beq LB539 ; brif so - don't move pointer back

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2689 LB537 leax -1,x ; move pointer back (so we don't consume the delimiter)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2690 LB539 stx COEFPT ; save end of string address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2691 stb STRDES ; save string length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2692 ldu RESSGN ; get start of string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2693 cmpu #STRBUF+2 ; is it at the start of the string buffer?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2694 bhi LB54C ; brif so - don't copy it to string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2695 bsr LB50D ; allocate string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2696 ldx RESSGN ; point to beginning of the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2697 jsr LB645 ; copy string data (B bytes) from (X) to (FRESPC)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2698 ; Put temporary string descriptor on the string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2699 LB54C ldx TEMPPT ; get top of string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2700 cmpx #CFNBUF ; is the string stack full?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2701 bne LB558 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2702 ldb #15*2 ; code for "string formula too complex"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2703 LB555 jmp LAC46 ; raise error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2704 LB558 lda STRDES ; get string length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2705 sta 0,x ; save it in the string stack descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2706 ldd STRDES+2 ; get string data pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2707 std 2,x ; save in string stack descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2708 lda #0xff ; set value type to string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2709 sta VALTYP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2710 stx LASTPT ; set pointer to last used entry on the string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2711 stx FPA0+2 ; set pointer to descriptor in the current evaluation value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2712 leax 5,x ; advance string stack pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2713 stx TEMPPT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2714 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2715 ; Reserve B bytes in string space. If there isn't enough space, try compacting string space and

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2716 ; then try the allocation again. If it still fails, raise OS error.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2717 LB56D clr GARBFL ; flag that compaction not yet done

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2718 LB56F clra ; zero extend the length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2719 pshs d ; save requested string length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2720 ldd STRTAB ; get current bottom of strings

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2721 subd ,s+ ; calculate new bottom of strings and remove zero extension

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2722 cmpd FRETOP ; does the string fit?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2723 blo LB585 ; brif not - try compaction

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2724 std STRTAB ; save new bottom of strings

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2725 ldx STRTAB ; get bottom of strings

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2726 leax 1,x ; now X points to the real start of the allocated space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2727 stx FRESPC ; save the string pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2728 puls b,pc ; restore length and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2729 LB585 ldb #2*13 ; code for out of string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2730 com GARBFL ; have we compacted string space yet?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2731 beq LB555 ; brif so - raise error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2732 bsr LB591 ; compact string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2733 puls b ; get back string length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2734 bra LB56F ; go try allocation again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2735 ; Compact string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2736 ; This is an O(n^2) algorithm. It first searches all extant strings for the highest address data pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2737 ; that hasn't already been moved into the freshly compacted string space. If then moves that string data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2738 ; up to the highest address it can go to. It repeats this process over and over until it finds no string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2739 ; that isn't already in the compacted space. While doing this, it has to search all strings on the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2740 ; stack (this is why the string stack is needed - so we can track anonymous strings), all scalar string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2741 ; variables, and *every* entry in every string array.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2742 LB591 ldx MEMSIZ ; get to of string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2743 LB593 stx STRTAB ; save top of uncompacted stringspace

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2744 clra ; zero out D and reset pointer to discovered variable to NULL

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2745 clrb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2746 std V4B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2747 ldx FRETOP ; point to bottom of string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2748 stx V47 ; save as lowest match address (match will be higher)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2749 ldx #STRSTK ; point to start of string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2750 LB5A0 cmpx TEMPPT ; are we at the top of the string stack?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2751 beq LB5A8 ; brif so - done with the string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2752 bsr LB5D8 ; check for string in uncompacted space (and advance pointer)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2753 bra LB5A0 ; check another on the string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2754 LB5A8 ldx VARTAB ; point to start of scalar variables

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2755 LB5AA cmpx ARYTAB ; end of scalars?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2756 beq LB5B2 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2757 bsr LB5D2 ; check for string in uncompacted space and advance pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2758 bra LB5AA ; check another variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2759 LB5B2 stx V41 ; save address of end of variables (address of first array)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2760 LB5B4 ldx V41 ; get start of the next array

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2761 LB5B6 cmpx ARYEND ; end of arrays?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2762 beq LB5EF ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2763 ldd 2,x ; get length of array

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2764 addd V41 ; add to start of array

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2765 std V41 ; save address of next array

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2766 lda 1,x ; get second character of variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2767 bpl LB5B4 ; brif numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2768 ldb 4,x ; get number of dimensions

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2769 aslb ; two bytes per dimension size

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2770 addb #5 ; add in fixed overhead for array descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2771 abx ; now X points to first array element

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2772 LB5CA cmpx V41 ; at the start of the next array?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2773 beq LB5B6 ; brif so - go handle another array

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2774 bsr LB5D8 ; check for string in uncompacted space (and advance pointer)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2775 bra LB5CA ; process next array element

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2776 LB5D2 lda 1,x ; get second character of variable name

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2777 leax 2,x ; move to variable data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2778 bpl LB5EC ; brif numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2779 LB5D8 ldb ,x ; get length of string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2780 beq LB5EC ; brif NULL - don't need to check data pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2781 ldd 2,x ; get data pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2782 cmpd STRTAB ; is it in compacted string space?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2783 bhi LB5EC ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2784 cmpd V47 ; is it better match than previous best?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2785 bls LB5EC ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2786 stx V4B ; save descriptor address of best match

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2787 std V47 ; save new best data pointer match

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2788 LB5EC leax 5,x ; move to next descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2789 LB5EE rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2790 LB5EF ldx V4B ; get descriptor address of the matched string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2791 beq LB5EE ; brif we didn't find one - we're done

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2792 clra ; zero extend length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2793 ldb ,x ; get string length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2794 decb ; subtract one (we won't have a NULL string here)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2795 addd V47 ; now D points to the address of the end of the string data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2796 std V43 ; save as top address of move

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2797 ldx STRTAB ; set top of uncompacted space as destination

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2798 stx V41

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2799 jsr LAC20 ; move string to top of uncompactedspace

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2800 ldx V4B ; point to string descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2801 ldd V45 ; get new data pointer address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2802 std 2,x ; update descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2803 ldx V45 ; get bottom of copy destination

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2804 leax -1,x ; move back below it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2805 jmp LB593 ; go search for another string to move (and set new bottom of string space)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2806 ; Concatenate two strings. We come here directly from the operator handler rather than via a JSR.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2807 LB60F ldd FPA0+2 ; get string descriptor for the first string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2808 pshs d ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2809 jsr LB223 ; evaluate a second string (concatenation is left associative)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2810 jsr LB146 ; make sure we have a string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2811 puls x ; get back first string descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2812 stx RESSGN ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2813 ldb ,x ; get length of first string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2814 ldx FPA0+2 ; get pointer to second string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2815 addb ,x ; add length of second string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2816 bcc LB62A ; brif combined length is OK

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2817 ldb #2*14 ; raise string too long error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2818 jmp LAC46

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2819 LB62A jsr LB50D ; reserve room for new string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2820 ldx RESSGN ; get descriptor address of the first string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2821 ldb ,x ; get length of first string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2822 bsr LB643 ; copy it to string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2823 ldx V4D ; get descriptor address of second string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2824 bsr LB659 ; get string details for second string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2825 bsr LB645 ; copy second string into new string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2826 ldx RESSGN ; get pointer to first string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2827 bsr LB659 ; remove it from the string stack if possible

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2828 jsr LB54C ; put new string on the string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2829 jmp LB168 ; return to expression evaluator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2830 ; Copy B bytes to space pointed to by FRESPC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2831 LB643 ldx 2,x ; get source address from string descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2832 LB645 ldu FRESPC ; get destination address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2833 incb ; compensate for decb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2834 bra LB64E ; do the copy

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2835 LB64A lda ,x+ ; copy a byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2836 sta ,u+

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2837 LB64E decb ; done yet?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2838 bne LB64A ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2839 stu FRESPC ; save destination pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2840 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2841 ; Fetch details of string in FPA0+2 and remove from the string stack if possible

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2842 LB654 jsr LB146 ; make sure we have a string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2843 LB657 ldx FPA0+2 ; get descriptor pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2844 LB659 ldb ,x ; get length of string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2845 bsr LB675 ; see if it's at the top of the string stack and remove it if so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2846 bne LB672 ; brif not removed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2847 ldx 5+2,x ; get start address of string just removed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2848 leax -1,x ; move pointer down 1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2849 cmpx STRTAB ; is it at the bottom of string space?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2850 bne LB66F ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2851 pshs b ; save length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2852 addd STRTAB ; add length to start of strings (A was cleared previously)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2853 std STRTAB ; save new string space start (deallocated space for this string)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2854 puls b ; get back string length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2855 LB66F leax 1,x ; restore pointer to pointing at the actual string data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2856 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2857 LB672 ldx 2,x ; get data pointer for the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2858 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2859 ; Remove string pointed to by X from the string stack if it is at the top of the stack; return with

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2860 ; A clear and Z set if string removed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2861 LB675 cmpx LASTPT ; is it at the top of the string stack?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2862 bne LB680 ; brif not - do nothing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2863 stx TEMPPT ; save new top of stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2864 leax -5,x ; move the "last" pointer back as well

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2865 stx LASTPT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2866 clra ; flag string removed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2867 LB680 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2868 ; LEN function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2869 LEN bsr LB686 ; get string details

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2870 LB683 jmp LB4F3 ; return unsigned length in B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2871 LB686 bsr LB654 ; get string details and remove from string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2872 clr VALTYP ; set value type to numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2873 tstb ; set flags according to length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2874 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2875 ; CHR$ function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2876 CHR jsr LB70E ; get 8 bit unsigned integer to B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2877 LB68F ldb #1 ; allocate a one byte string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2878 jsr LB56D

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2879 lda FPA0+3 ; get character code

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2880 jsr LB511 ; save reserved string details in temp descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2881 sta ,x ; put character in string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2882 LB69B leas 2,s ; don't go back to function handler - avoid numeric type check

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2883 LB69D jmp LB54C ; return temporary string on string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2884 ; ASC function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2885 ASC bsr LB6A4 ; get first character of argument

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2886 bra LB683 ; return unsigned code in B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2887 LB6A4 bsr LB686 ; fetch string details

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2888 beq LB706 ; brif NULL string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2889 ldb ,x ; get character at start of string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2890 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2891 ; LEFT$ function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2892 LEFT bsr LB6F5 ; get arguments from the stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2893 LB6AD clra ; clear pointer offset (set to start of string)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2894 LB6AE cmpb ,x ; are we asking for more characters than there are in the string?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2895 bls LB6B5 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2896 ldb ,x ; only return the number that are in the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2897 clra ; force starting offset to be the start of the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2898 LB6B5 pshs b,a ; save offset and length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2899 jsr LB50F ; reserve space in string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2900 ldx V4D ; point to original string descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2901 bsr LB659 ; get string details

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2902 puls b ; get string offset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2903 abx ; now X points to the start of the data to copy

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2904 puls b ; get length of copy

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2905 jsr LB645 ; copy the data to the allocated space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2906 bra LB69D ; return temp string on string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2907 ; RIGHT$ function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2908 RIGHT bsr LB6F5 ; get arguments from stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2909 suba ,x ; subtract length of original string from desired length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2910 nega ; now A is offset into old string where we start copying

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2911 bra LB6AE ; go handle everything else

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2912 ; MID$ function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2913 MID ldb #255 ; default length is the whole string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2914 stb FPA0+3 ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2915 jsr GETCCH ; see what we have after offset

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2916 cmpa #') ; end of function?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2917 beq LB6DE ; brif so - no length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2918 jsr LB26D ; force a comma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2919 bsr LB70B ; get length parameter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2920 LB6DE bsr LB6F5 ; get string and offset parameters from the stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2921 beq LB706 ; brif we have a 0 offset requested (string offsets are 1-based)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2922 clrb ; clear length counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2923 deca ; subtract one from position parameter (we work on 0-based, param is 1-based)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2924 cmpa ,x ; is start greater than length of string?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2925 bhs LB6B5 ; brif so - return NULL string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2926 tfr a,b ; save absolute position parameter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2927 subb ,x ; now B is postition less length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2928 negb ; now B is amount of string to copy

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2929 cmpb FPA0+3 ; is it less than the length requested?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2930 bls LB6B5 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2931 ldb FPA0+3 ; set length to the requested length

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2932 bra LB6B5 ; go finish up copying the substring

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2933 ; Common routine for LEFT$, RIGHT$, MID$ - check for ) and fetch string data and first parameter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2934 ; from the stack. These were evaluated in the function evaluation handler. (It's not clear that doing

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2935 ; it that way is actually beneficial. However, this is what the ROM designers did, so here we are.)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2936 LB6F5 jsr LB267 ; make sure we have )

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2937 ldu ,s ; get return address - we're going to mess with the stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2938 ldx 5,s ; get address of string descriptor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2939 stx V4D ; save descriptor adddress

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2940 lda 4,s ; get first numeric parameter in both A and B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2941 ldb 4,s

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2942 leas 7,s ; clean up stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2943 tfr u,pc ; return to original caller

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2944 LB706 jmp LB44A ; raise FC error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2945 ; Evaluate an unsigned 8 bit expression to B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2946 LB709 jsr GETNCH ; move to next character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2947 LB70B jsr LB141 ; evaluate a numeric expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2948 LB70E jsr LB3E9 ; convert to integer in D

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2949 tsta ; are we negative or > 255?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2950 bne LB706 ; brif so - FC error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2951 jmp GETCCH ; fetch current input character and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2952 ; VAL function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2953 VAL jsr LB686 ; get string details

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2954 lbeq LBA39 ; brif NULL string - return 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2955 ldu CHARAD ; get input pointer so we can replace it later

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2956 stx CHARAD ; point interpreter at string data

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2957 abx ; calculate end address of the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2958 lda ,x ; get byte after the end of the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2959 pshs u,x,a ; save end of string address, input pointer, and character after end of string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2960 clr ,x ; put a NUL after the string (stops the number interpreter)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2961 jsr GETCCH ; get input character at start of string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2962 jsr LBD12 ; evaluate numeric expression in string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2963 puls a,x,u ; get back saved character and pointers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2964 sta ,x ; restore byte after string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2965 stu CHARAD ; restore interpeter's input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2966 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2967 ; Evaluate unsigned expression to BINVAL, then evaluate an unsigned expression to B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2968 LB734 bsr LB73D ; evaluate expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2969 stx BINVAL ; save result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2970 LB738 jsr LB26D ; make sure there's a comma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2971 bra LB70B ; evaluate unsigned expression to B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2972 ; Evaluate unsigned expression in X

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2973 LB73D jsr LB141 ; evaluate numeric expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2974 LB740 lda FP0SGN ; is it negative?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2975 bmi LB706 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2976 lda FP0EXP ; get exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2977 cmpa #0x90 ; largest possible exponent for 16 bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2978 bhi LB706 ; brif too large

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2979 jsr LBCC8 ; move binary point to right of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2980 ldx FPA0+2 ; get resulting unsigned value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2981 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2982 ; PEEK function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2983 PEEK bsr LB740 ; get address to X

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2984 ldb ,x ; get the value at that address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2985 jmp LB4F3 ; return B as unsigned value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2986 ; POKE function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2987 POKE bsr LB734 ; evaluate address and byte value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2988 ldx BINVAL ; get address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2989 stb ,x ; put value there

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2990 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2991 ; LLIST command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2992 LLIST ldb #-2 ; set output device to printer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2993 stb DEVNUM

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2994 jsr GETCCH ; reset flags for input character and fall through to LIST

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2995 ; LIST command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2996 LIST pshs cc ; save zero flag (end of statement)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2997 jsr LAF67 ; parse line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2998 jsr LAD01 ; find address of that line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

2999 stx LSTTXT ; save that address as the start of the list

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3000 puls cc ; get back ent of statement flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3001 beq LB784 ; brif end of line - list whole program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3002 jsr GETCCH ; are we at the end of the line (one number)?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3003 beq LB789 ; brif end of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3004 cmpa #0xac ; is it "-"?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3005 bne LB783 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3006 jsr GETNCH ; eat the "-"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3007 beq LB784 ; brif no second number - list to end of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3008 jsr LAF67 ; evaluate the second number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3009 beq LB789 ; brif illegal number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3010 LB783 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3011 LB784 ldu #0xffff ; this will cause listing to do the entire program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3012 stu BINVAL

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3013 LB789 leas 2,s ; don't return to the caller - we'll jump back to the main loop

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3014 ldx LSTTXT ; get address of line to list

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3015 LB78D jsr LB95C ; do a newline if needed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3016 jsr LA549 ; do a break check

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3017 ldd ,x ; get address of next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3018 bne LB79F ; brif not end of program

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3019 LB797 jsr LA42D ; close output file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3020 clr DEVNUM ; reset device to screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3021 jmp LAC73 ; go back to immediate mode

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3022 LB79F stx LSTTXT ; save new line address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3023 ldd 2,x ; get line number of this line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3024 cmpd BINVAL ; is it above the end line?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3025 bhi LB797 ; brif so - return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3026 jsr LBDCC ; display line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3027 jsr LB9AC ; put a space after it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3028 ldx LSTTXT ; get line address

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3029 bsr LB7C2 ; detokenize the line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3030 ldx [LSTTXT] ; get pointer to next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3031 ldu #LINBUF+1 ; point to start of detokenized line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3032 LB7B9 lda ,u+ ; get byte from detokenized line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3033 beq LB78D ; brif end of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3034 jsr LB9B1 ; output character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3035 bra LB7B9 ; handle next character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3036 ; Detokenize a line from (X) to the line input buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3037 LB7C2 jsr RVEC24 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3038 leax 4,x ; move past next line pointer and line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3039 ldy #LINBUF+1 ; point to line input buffer (destination)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3040 LB7CB lda ,x+ ; get character from tokenized line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3041 beq LB820 ; brif end of input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3042 bmi LB7E6 ; brif it's a token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3043 cmpa #': ; colon?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3044 bne LB7E2 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3045 ldb ,x ; get what's after the colon

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3046 cmpb #0x84 ; ELSE?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3047 beq LB7CB ; brif so - suppress the colon

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3048 cmpb #0x83 ; '?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3049 beq LB7CB ; brif so - suppress the colon

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3050 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3051 LB7E0 lda #'! ; placeholder for unknown token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3052 LB7E2 bsr LB814 ; stow output character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3053 bra LB7CB ; go process another input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3054 LB7E6 ldu #COMVEC-10 ; point to command interptation table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3055 cmpa #0xff ; is it a function?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3056 bne LB7F1 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3057 lda ,x+ ; get function token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3058 leau 5,u ; shift to the function half of the interpretation tables

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3059 LB7F1 anda #0x7f ; remove token bias

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3060 LB7F3 leau 10,u ; move to next command/function table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3061 tst ,u ; is this table active?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3062 beq LB7E0 ; brif not - use place holder

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3063 suba ,u ; subtract number of tokens handled by this table entry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3064 bpl LB7F3 ; brif this token isn't handled here

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3065 adda ,u ; undo extra subtraction

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3066 ldu 1,u ; get reserved word list for this table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3067 LB801 deca ; are we at the right entry?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3068 bmi LB80A ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3069 LB804 tst ,u+ ; end of entry?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3070 bpl LB804 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3071 bra LB801 ; see if we're there yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3072 LB80A lda ,u ; get character from wordlist

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3073 bsr LB814 ; put character in the buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3074 tst ,u+ ; end of word?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3075 bpl LB80A ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3076 bra LB7CB ; go handle another input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3077 LB814 cmpy #LINBUF+LBUFMX ; is there room?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3078 bhs LB820 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3079 anda #0x7f ; lose bit 7

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3080 sta ,y+ ; save character in output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3081 clr ,y ; make sure there's always a NUL terminator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3082 LB820 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3083 ; Tokenize the line that the input pointer is pointing to; put result in the line input buffer; return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3084 ; length in D

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3085 LB821 jsr RVEC23 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3086 ldx CHARAD ; get input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3087 ldu #LINBUF ; set destination pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3088 LB829 clr V43 ; clear alpha string flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3089 clr V44 ; clear DATA flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3090 LB82D lda ,x+ ; get input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3091 beq LB852 ; brif end of input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3092 tst V43 ; are we handling an alphanumeric string?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3093 beq LB844 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3094 jsr LB3A2 ; set carry if not alpha

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3095 bcc LB852 ; brif alpha

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3096 cmpa #'0 ; is it below the digits?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3097 blo LB842 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3098 cmpa #'9 ; is it within the digits?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3099 bls LB852 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3100 LB842 clr V43 ; flag that we're past the alphanumeric string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3101 LB844 cmpa #0x20 ; space?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3102 beq LB852 ; brif so - keep it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3103 sta V42 ; save scan delimiter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3104 cmpa #'" ; string delimiter?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3105 beq LB886 ; brif so - copy until another "

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3106 tst V44 ; doing "DATA"?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3107 beq LB86B ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3108 LB852 sta ,u+ ; put character in output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3109 beq LB85C ; brif end of input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3110 cmpa #': ; colon?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3111 beq LB829 ; brif so - reset DATA and alpha string flags

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3112 LB85A bra LB82D ; go process another input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3113 LB85C clr ,u+ ; put a double NUL at the end

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3114 clr ,u+

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3115 tfr u,d ; calculate length of result (includes double NUL and an extra two bytes)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3116 subd #LINHDR

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3117 ldx #LINBUF-1 ; point to one before the output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3118 stx CHARAD ; set input pointer there

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3119 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3120 LB86B cmpa #'? ; print abbreviation?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3121 bne LB873 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3122 lda #0x87 ; token for PRINT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3123 bra LB852 ; go stash it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3124 LB873 cmpa #'' ; REM abbreviation?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3125 bne LB88A ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3126 ldd #0x3a83 ; colon plus ' token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3127 std ,u++ ; put it in the output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3128 LB87C clr V42 ; set delimiter to NUL

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3129 LB87E lda ,x+ ; get input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3130 beq LB852 ; brif end of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3131 cmpa V42 ; at the delimiter?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3132 beq LB852 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3133 LB886 sta ,u+ ; save in output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3134 bra LB87E ; keep scanning for delimiter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3135 LB88A cmpa #'0 ; is it below digits?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3136 blo LB892 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3137 cmpa #';+1 ; is it digit, colon, or semicolon?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3138 blo LB852 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3139 LB892 leax -1,x ; move input pointer back one (to point at this input character)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3140 pshs u,x ; save input and output pointers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3141 clr V41 ; set token type to 0 (command)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3142 ldu #COMVEC-10 ; point to command interpretation table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3143 LB89B clr V42 ; set token counter to 0 (0x80)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3144 LB89D leau 10,u ;

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3145 lda ,u ; get number of reserved words

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3146 beq LB8D4 ; brif this table isn't active

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3147 ldy 1,u ; point to reserved words list

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3148 LB8A6 ldx ,s ; get input pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3149 LB8A8 ldb ,y+ ; get character from reserved word table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3150 subb ,x+ ; compare with input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3151 beq LB8A8 ; brif exact match

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3152 cmpb #0x80 ; brif it was the last character in word and exact match

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3153 bne LB8EA ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3154 leas 2,s ; remove original input pointer from stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3155 puls u ; get back output pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3156 orb V42 ; create token value (B has 0x80 from above)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3157 lda V41 ; get token type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3158 bne LB8C2 ; brif function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3159 cmpb #0x84 ; is it ELSE?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3160 bne LB8C6 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3161 lda #': ; silently add a colon before ELSE

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3162 LB8C2 std ,u++ ; put two byte token into output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3163 bra LB85A ; go handle more input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3164 LB8C6 stb ,u+ ; save single byte token

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3165 cmpb #0x86 ; DATA?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3166 bne LB8CE ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3167 inc V44 ; set DATA flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3168 LB8CE cmpb #0x82 ; REM?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3169 beq LB87C ; brif so - skip over rest of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3170 LB8D2 bra LB85A ; go handle more input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3171 LB8D4 ldu #COMVEC-5 ; point to interpretation table, function style

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3172 LB8D7 com V41 ; invert token flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3173 bne LB89B ; brif we haven't already done functions

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3174 puls x,u ; restore input and output pointers

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3175 lda ,x+ ; copy first character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3176 sta ,u+

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3177 jsr LB3A2 ; set C if not alpha

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3178 bcs LB8D2 ; brif not alpha - it isn't a variable

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3179 com V43 ; set alphanumeric string flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3180 bra LB8D2 ; process more input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3181 LB8EA inc V42 ; bump token number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3182 deca ; checked all in this table?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3183 beq LB89D ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3184 leay -1,y ; unconsume last compared character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3185 LB8F1 ldb ,y+ ; end of entry?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3186 bpl LB8F1 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3187 bra LB8A6 ; check next reserved word

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3188 ; PRINT command

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3189 PRINT beq LB958 ; brif no argument - do a newline

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3190 bsr LB8FE ; process print options

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3191 clr DEVNUM ; reset output to screen

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3192 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3193 LB8FE cmpa #'@ ; is it PRINT @?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3194 bne LB907 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3195 jsr LA554 ; move cursor to correct location

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3196 bra LB911 ; handle some more

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3197 LB907 cmpa #'# ; device number specified?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3198 bne LB918 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3199 jsr LA5A5 ; parse device number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3200 jsr LA406 ; check for valid output file

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3201 LB911 jsr GETCCH ; get input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3202 beq LB958 ; brif nothing - do newline

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3203 jsr LB26D ; need comma after @ or #

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3204 LB918 jsr RVEC9 ; do the RAM hook boogaloo

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3205 LB91B beq LB965 ; brif end of input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3206 LB91D cmpa #0xa4 ; TAB(?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3207 beq LB97E ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3208 cmpa #', ; comma (next tab field)?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3209 beq LB966 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3210 cmpa #'; ; semicolon (do not advance print position)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3211 beq LB997 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3212 jsr LB156 ; evaluate expression

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3213 lda VALTYP ; get type of value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3214 pshs a ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3215 bne LB938 ; brif string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3216 jsr LBDD9 ; convert FP number to string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3217 jsr LB516 ; parse a string and put on string stack

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3218 LB938 bsr LB99F ; print string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3219 puls b ; get back variable type

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3220 jsr LA35F ; set up print parameters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3221 tst PRTDEV ; is it a display device?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3222 beq LB949 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3223 bsr LB958 ; do a newline

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3224 jsr GETCCH ; get input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3225 bra LB91B ; process more print stuff

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3226 LB949 tstb ; set flags on print position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3227 bne LB954 ; brif not at start of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3228 jsr GETCCH ; get current input

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3229 cmpa #', ; comma?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3230 beq LB966 ; skip to next tab field if so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3231 bsr LB9AC ; send a space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3232 LB954 jsr GETCCH ; get input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3233 bne LB91D ; brif not end of statement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3234 LB958 lda #0x0d ; carriage return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3235 bra LB9B1 ; send it to output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3236 LB95C jsr LA35F ; set up print parameters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3237 LB95F beq LB958 ; brif width is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3238 lda DEVPOS ; get line position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3239 bne LB958 ; brif not at start of line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3240 LB965 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3241 LB966 jsr LA35F ; set up print parameters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3242 beq LB975 ; brif line width is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3243 ldb DEVPOS ; get line position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3244 cmpb DEVLCF ; at or past last comma field?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3245 blo LB977 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3246 bsr LB958 ; move to next line

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3247 bra LB997 ; handle more stuff

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3248 LB975 ldb DEVPOS ; get line position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3249 LB977 subb DEVCFW ; subtract a comma field width

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3250 bhs LB977 ; brif we don't have a remainder yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3251 negb ; now B is number of of spaces needed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3252 bra LB98E ; go advance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3253 LB97E jsr LB709 ; evaluate TAB distance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3254 cmpa #') ; closing )?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3255 lbne LB277 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3256 jsr LA35F ; set up print parameters

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3257 subb DEVPOS ; subtract print position from desired position

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3258 bls LB997 ; brif we're already past it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3259 LB98E tst PRTDEV ; is it a display device?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3260 bne LB997 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3261 LB992 bsr LB9AC ; output a space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3262 decb ; done enough?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3263 bne LB992 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3264 LB997 jsr GETNCH ; get input character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3265 jmp LB91B ; process more items

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3266 ; cpoy string from (X-1) to output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3267 LB99C jsr LB518 ; parse the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3268 LB99F jsr LB657 ; get string details

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3269 LB9A2 incb ; compensate for decb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3270 LB9A3 decb ; done all of the string?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3271 beq LB965 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3272 lda ,x+ ; get character from string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3273 bsr LB9B1 ; send to output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3274 bra LB9A3 ; go do another character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3275 LB9AC lda #0x20 ; space character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3276 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3277 LB9AF lda #'? ; question mark character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3278 LB9B1 jmp PUTCHR ; output character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3279 ; The floating point math package and related functions and operations follow from here

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3280 ; to the end of the Color Basic ROM area

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3281 LB9B4 ldx #LBEC0 ; point to FP constant 0.5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3282 bra LB9C2 ; add 0.5 to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3283 LB9B9 jsr LBB2F ; unpack FP data from (X) to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3284 ; subtraction operator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3285 LB9BC com FP0SGN ; invert sign of FPA0 (subtracting is adding the negative)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3286 com RESSGN ; that also inverts the sign differential

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3287 bra LB9C5 ; go add the negative of FPA0 to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3288 LB9C2 jsr LBB2F ; unpack FP data from (X) to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3289 ; addition operator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3290 LB9C5 tstb ; check exponent of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3291 lbeq LBC4A ; copy FPA1 to FPA0 if FPA0 is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3292 ldx #FP1EXP ; point X to FPA1 (first operand) as the operand to denormalize

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3293 LB9CD tfr a,b ; put exponent of FPA1 into B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3294 tstb ; is FPA1 0?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3295 beq LBA3E ; brif exponent is 0 - no-op; adding 0 to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3296 subb FP0EXP ; get difference in exponents - number of bits to shift the smaller mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3297 beq LBA3F ; brif exponents are equal - no need to denormalize

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3298 blo LB9E2 ; brif FPA0 > FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3299 sta FP0EXP ; replace result exponent with FPA1's (FPA1 is bigger)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3300 lda FP1SGN ; also copy sign over

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3301 sta FP0SGN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3302 ldx #FP0EXP ; point to FPA0 (we need to denormalize the smaller number)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3303 negb ; invert the difference - this is the number of bits to shift the mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3304 LB9E2 cmpb #-8 ; do we have to shift by a whole byte?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3305 ble LBA3F ; brif so start by shifting whole bytes to the right

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3306 clra ; clear overflow byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3307 lsr 1,x ; shift high bit of mantissa right (LSR will force a zero into the high bit)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3308 jsr LBABA ; shift remainder of mantissa right -B times

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3309 LB9EC ldb RESSGN ; get the sign flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3310 bpl LB9FB ; brif signs are the same (we add the mantissas then)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3311 com 1,x ; complement the mantissa and extra precision bytes

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3312 com 2,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3313 com 3,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3314 com 4,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3315 coma

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3316 adca #0 ; add one to A (COM sets C); this may cause a carry to enter the ADD below

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3317 LB9FB sta FPSBYT ; save extra precision byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3318 lda FPA0+3 ; add the main mantissa bytes (and propage carry from above)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3319 adca FPA1+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3320 sta FPA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3321 lda FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3322 adca FPA1+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3323 sta FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3324 lda FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3325 adca FPA1+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3326 sta FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3327 lda FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3328 adca FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3329 sta FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3330 tstb ; were signs the same?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3331 bpl LBA5C ; brif so - number may have gotten bigger so normalize if needed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3332 LBA18 bcs LBA1C ; brif we had a carry - result is positive?)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3333 bsr LBA79 ; do a proper negation of FPA0 mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3334 LBA1C clrb ; clear temporary exponent accumulator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3335 LBA1D lda FPA0 ; test high byte of mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3336 bne LBA4F ; brif not 0 - we need to do bit shifting

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3337 lda FPA0+1 ; shift left 8 bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3338 sta FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3339 lda FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3340 sta FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3341 lda FPA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3342 sta FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3343 lda FPSBYT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3344 sta FPA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3345 clr FPSBYT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3346 addb #8 ; account for 8 bits shifted

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3347 cmpb #5*8 ; shifted 5 bytes worth?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3348 blt LBA1D ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3349 LBA39 clra ; zero out exponent and sign - result is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3350 LBA3A sta FP0EXP ; set exponent and sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3351 sta FP0SGN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3352 LBA3E rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3353 LBA3F bsr LBAAE ; shift FPA0 mantissa to the right

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3354 clrb ; clear carry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3355 bra LB9EC ; get on with adding

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3356 LBA44 incb ; account for one bit shift

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3357 asl FPSBYT ; shift mantissa and extra precision left

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3358 rol FPA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3359 rol FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3360 rol FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3361 rol FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3362 LBA4F bpl LBA44 ; brif we haven't got a 1 in bit 7

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3363 lda FP0EXP ; get exponent of result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3364 pshs b ; subtract shift count from exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3365 suba ,s+

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3366 sta FP0EXP ; save adjusted exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3367 bls LBA39 ; brif we underflowed - set result to 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3368 skip2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3369 LBA5C bcs LBA66 ; brif mantissa overflowed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3370 asl FPSBYT ; get bit 7 of expra precision to C (used for round off)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3371 lda #0 ; set to 0 without affecting C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3372 sta FPSBYT ; clear out extra precision bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3373 bra LBA72 ; go round off result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3374 LBA66 inc FP0EXP ; bump exponent (for a right shift to bring carry in)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3375 beq LBA92 ; brif we overflowed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3376 ror FPA0 ; shift carry into mantissa, shift right

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3377 ror FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3378 ror FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3379 ror FPA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3380 LBA72 bcc LBA78 ; brif no round-off needed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3381 bsr LBA83 ; add one to mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3382 beq LBA66 ; brif carry - need to shift right again

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3383 LBA78 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3384 LBA79 com FP0SGN ; invert sign of value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3385 LBA7B com FPA0 ; first do a one's copmlement

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3386 com FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3387 com FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3388 com FPA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3389 LBA83 ldx FPA0+2 ; add one to mantissa (after one's complement gives two's complement)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3390 leax 1,x ; bump low word

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3391 stx FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3392 bne LBA91 ; brif no carry from low word

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3393 ldx FPA0 ; bump high word

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3394 leax 1,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3395 stx FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3396 LBA91 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3397 LBA92 ldb #2*5 ; code for overflow

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3398 jmp LAC46 ; raise error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3399 LBA97 ldx #FPA2-1 ; point to FPA2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3400 LBA9A lda 4,x ; shift mantissa right by 8 bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3401 sta FPSBYT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3402 lda 3,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3403 sta 4,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3404 lda 2,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3405 sta 3,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3406 lda 1,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3407 sta 2,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3408 lda FPCARY ; and handle extra precision on the left

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3409 sta 1,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3410 LBAAE addb #8 ; account for 8 bits shifted

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3411 ble LBA9A ; brif more shifts needed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3412 lda FPSBYT ; get sub byte (extra precision)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3413 subb #8 ; undo the 8 added above

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3414 beq LBAC4 ; brif difference is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3415 LBAB8 asr 1,x ; shift mantissa and sub byte one bit (keep mantissa high bit set)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3416 LBABA ror 2,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3417 ror 3,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3418 ror 4,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3419 rora

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3420 incb ; account for one shift

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3421 bne LBAB8 ; brif not enought shifts yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3422 LBAC4 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3423 LBAC5 fcb 0x81,0x00,0x00,0x00,0x00 ; packed FP 1.0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3424 LBACA bsr LBB2F ; unpack FP value from (X) to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3425 ; multiplication operator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3426 LBACC beq LBB2E ; brif exponent of FPA0 is 0 (result is 0)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3427 bsr LBB48 ; calculate exponent of product

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3428 LBAD0 lda #0 ; zero out mantissa of FPA2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3429 sta FPA2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3430 sta FPA2+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3431 sta FPA2+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3432 sta FPA2+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3433 ldb FPA0+3 ; multiply FPA1 by LSB of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3434 bsr LBB00

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3435 ldb FPSBYT ; save extra precision byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3436 stb VAE

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3437 ldb FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3438 bsr LBB00 ; again for next byte of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3439 ldb FPSBYT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3440 stb VAD

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3441 ldb FPA0+1 ; again for next byte of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3442 bsr LBB00

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3443 ldb FPSBYT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3444 stb VAC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3445 ldb FPA0 ; and finally for the high byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3446 bsr LBB02

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3447 ldb FPSBYT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3448 stb VAB

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3449 jsr LBC0B ; copy mantissa from FPA2 to FPA0 (result)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3450 jmp LBA1C ; normalize

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3451 LBB00 beq LBA97 ; brif multiplier is 0 - just shift, don't multiply

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3452 LBB02 coma ; set carry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3453 LBB03 lda FPA2 ; get FPA2 MS byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3454 rorb ; data bit to carry; will be 0 when all shifts done

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3455 beq LBB2E ; brif 8 shifts done

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3456 bcc LBB20 ; brif data bit is 0 - no addition

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3457 lda FPA2+3 ; add mantissa of FPA1 and FPA2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3458 adda FPA1+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3459 sta FPA2+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3460 lda FPA2+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3461 adca FPA1+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3462 sta FPA2+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3463 lda FPA2+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3464 adca FPA1+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3465 sta FPA2+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3466 lda FPA2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3467 adca FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3468 LBB20 rora ; shift carry into FPA2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3469 sta FPA2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3470 ror FPA2+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3471 ror FPA2+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3472 ror FPA2+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3473 ror FPSBYT

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3474 clra ; clear carry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3475 bra LBB03

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3476 LBB2E rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3477 ; Unpack FP value from (X) to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3478 LBB2F ldd 1,x ; copy mantissa (and sign)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3479 sta FP1SGN ; save sign bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3480 ora #0x80 ; make sure mantissa has bit 7 set

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3481 std FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3482 ldb FP1SGN ; get sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3483 eorb FP0SGN ; set if FPA0 sign differs

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3484 stb RESSGN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3485 ldd 3,x ; copy remainder of mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3486 std FPA1+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3487 lda ,x ; and exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3488 sta FP1EXP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3489 ldb FP0EXP ; fetch FPA0 exponent and set flags

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3490 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3491 ; Calculate eponent for product of FPA0 and FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3492 LBB48 tsta ; is FPA1 zero?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3493 beq LBB61 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3494 adda FP0EXP ; add to exponent of FPA0 (this is how scientific notation works)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3495 rora ; set V if we *don't* have an overflow

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3496 rola

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3497 bvc LBB61 ; brif exponent too larger or small

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3498 adda #0x80 ; restore the bias

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3499 sta FP0EXP ; set result exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3500 beq LBB63 ; brif 0 - clear FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3501 lda RESSGN ; the result sign (negative if signs differ) is the result sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3502 sta FP0SGN ; so set it as such

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3503 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3504 LBB5C lda FP0SGN ; get sign of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3505 coma ; invert sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3506 bra LBB63 ; zero sign and exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3507 LBB61 leas 2,s ; don't go back to caller (mul/div) - return to previous caller

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3508 LBB63 lbpl LBA39 ; brif we underflowed - go zero things out

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3509 LBB67 jmp LBA92 ; raise overflow error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3510 ; fast multiply by 10 - leave result in FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3511 LBB6A jsr LBC5F ; copy FPA0 to FPA1 (for addition later)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3512 beq LBB7C ; brif exponent is 0 - it's a no-op then

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3513 adda #2 ; this gives "times 4"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3514 bcs LBB67 ; raise overflow if required

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3515 clr RESSGN ; set result sign to "signs the same"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3516 jsr LB9CD ; add FPA1 to FPA0 "times 5"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3517 inc FP0EXP ; times 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3518 beq LBB67 ; brif overflow

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3519 LBB7C rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3520 LBB7D fcb 0x84,0x20,0x00,0x00,0x00 ; packed FP constant 10.0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3521 ; Divide by 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3522 LBB82 jsr LBC5F ; move FPA0 to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3523 ldx #LBB7D ; point to constant 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3524 clrb ; zero sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3525 LBB89 stb RESSGN ; result will be positive or zero

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3526 jsr LBC14 ; unpack constant 10 to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3527 skip2 ; fall through to division (divide FPA1 by 10)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3528 LBB8F bsr LBB2F ; unpack FP number from (X) to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3529 ; division operator

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3530 LBB91 beq LBC06 ; brif FPA0 is 0 - division by zero

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3531 neg FP0EXP ; get exponent of reciprocal of the divisor

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3532 bsr LBB48 ; calculate exponent of quotient

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3533 inc FP0EXP ; bump exponent (due to division algorithm below)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3534 beq LBB67 ; brif overflow

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3535 ldx #FPA2 ; point to temporary storage location

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3536 ldb #4 ; do 5 bytes

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3537 stb TMPLOC ; save counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3538 ldb #1 ; shift counter and quotient byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3539 LBBA4 lda FPA0 ; compare mantissa of FPA0 to FPA1, set C if FPA1 less

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3540 cmpa FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3541 bne LBBBD

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3542 lda FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3543 cmpa FPA1+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3544 bne LBBBD

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3545 lda FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3546 cmpa FPA1+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3547 bne LBBBD

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3548 lda FPA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3549 cmpa FPA1+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3550 bne LBBBD

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3551 coma ; set C if FPA0 = FPA1 (it "goes")

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3552 LBBBD tfr cc,a ; save "it goes" status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3553 rolb ; rotate carry into quotient

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3554 bcc LBBCC ; brif carry clear - haven't done 8 shifts yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3555 stb ,x+ ; save quotient byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3556 dec TMPLOC ; done enough bytes?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3557 bmi LBBFC ; brif done all 5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3558 beq LBBF8 ; brif last byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3559 ldb #1 ; reset shift counter and quotient byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3560 LBBCC tfr a,cc ; get back carry status

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3561 bcs LBBDE ; brif it "went"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3562 LBBD0 asl FPA1+3 ; shift mantissa (dividend) left

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3563 rol FPA1+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3564 rol FPA1+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3565 rol FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3566 bcs LBBBD ; brif carry - it "goes" so we have to bump quotient

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3567 bmi LBBA4 ; brif high order bit is set - compare mantissas

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3568 bra LBBBD ; otherwise, count a 0 bit and try next bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3569 LBBDE lda FPA1+3 ; subtract mantissa of FPA0 from mantissa of FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3570 suba FPA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3571 sta FPA1+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3572 lda FPA1+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3573 sbca FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3574 sta FPA1+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3575 lda FPA1+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3576 sbca FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3577 sta FPA1+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3578 lda FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3579 sbca FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3580 sta FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3581 bra LBBD0 ; go check for another go

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3582 LBBF8 ldb #0x40 ; only two bits in last byte (for rounding)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3583 bra LBBCC ; go do the last byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3584 LBBFC rorb ; get low bits to bits 7,6 and C to bit 5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3585 rorb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3586 rorb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3587 stb FPSBYT ; save result extra precision

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3588 bsr LBC0B ; move FPA2 mantissa to FPA0 (result)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3589 jmp LBA1C ; go normalize the result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3590 LBC06 ldb #2*10 ; division by zero

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3591 jmp LAC46 ; raise error

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3592 ; Copy mantissa of FPA2 to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3593 LBC0B ldx FPA2 ; copy high word

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3594 stx FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3595 ldx FPA2+2 ; copy low word

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3596 stx FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3597 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3598 ; unpack FP number at (X) to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3599 LBC14 pshs a ; save register

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3600 ldd 1,x ; get mantissa high word and sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3601 sta FP0SGN ; set sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3602 ora #0x80 ; make sure mantissa always has bit 7 set

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3603 std FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3604 clr FPSBYT ; clear extra precision

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3605 ldb ,x ; get exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3606 ldx 3,x ; copy mantissa low word

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3607 stx FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3608 stb FP0EXP ; save exponent (and set flags)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3609 puls a,pc ; restore register and return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3610 LBC2A ldx #V45 ; point to FPA4

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3611 bra LBC35 ; pack FPA0 there

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3612 LBC2F ldx #V40 ; point to FPA3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3613 skip2 ; fall through to pack FPA0 there

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3614 LBC33 ldx VARDES ; get variable descriptor pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3615 ; Pack FPA0 to (X)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3616 LBC35 lda FP0EXP ; get exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3617 sta ,x ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3618 lda FP0SGN ; get sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3619 ora #0x7f ; force set low bits - only keep sign in high bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3620 anda FPA0 ; merge in bits 6-0 of high byte of mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3621 sta 1,x ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3622 lda FPA0+1 ; copy next highest byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3623 sta 2,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3624 ldu FPA0+2 ; and the low word of the mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3625 stu 3,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3626 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3627 ; Copy FPA1 to FPA0; return with sign in A

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3628 LBC4A lda FP1SGN ; copy sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3629 LBC4C sta FP0SGN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3630 ldx FP1EXP ; copy exponent, mantissa high byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3631 stx FP0EXP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3632 clr FPSBYT ; clear extra precision

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3633 lda FPA1+1 ; copy mantissa second highest byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3634 sta FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3635 lda FP0SGN ; set sign for return

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3636 ldx FPA1+2 ; copy low word of mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3637 stx FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3638 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3639 ; Copy FPA0 to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3640 LBC5F ldd FP0EXP ; copy exponent and high byte of mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3641 std FP1EXP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3642 ldx FPA0+1 ; copy middle bytes of mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3643 stx FPA1+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3644 ldx FPA0+3 ; copy low byte of mantissa and sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3645 stx FPA1+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3646 tsta ; set flags on exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3647 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3648 ; check FPA0: return B = 0, if FPA0 is 0, 0xff if negative, and 0x01 if positive

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3649 LBC6D ldb FP0EXP ; get exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3650 beq LBC79 ; brif 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3651 LBC71 ldb FP0SGN ; get sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3652 LBC73 rolb ; get sign to C

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3653 ldb #0xff ; set for negative result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3654 bcs LBC79 ; brif negative

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3655 negb ; set to 1 for positive

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3656 LBC79 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3657 ; SGN function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3658 SGN bsr LBC6D ; get sign of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3659 LBC7C stb FPA0 ; save result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3660 clr FPA0+1 ; clear next lower 8 bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3661 ldb #0x88 ; exponent if mantissa is 8 bit integer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3662 LBC82 lda FPA0 ; get high bits of mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3663 suba #0x80 ; set C if mantissa was positive (will cause a negation if it was negative)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3664 LBC86 stb FP0EXP ; set exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3665 ldd ZERO ; clear out low word

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3666 std FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3667 sta FPSBYT ; clear extra precision

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3668 sta FP0SGN ; set sign to positive

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3669 jmp LBA18 ; normalize the result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3670 ; ABS function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3671 ABS clr FP0SGN ; force FPA0 to be positive (yes, it's that simple)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3672 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3673 ; Compare packed FP number at (X) to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3674 ; Return with B = -1, 0, 1 for FPA0 <, =, > (X) and flags set based on that

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3675 LBC96 ldb ,x ; get exponent of (X)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3676 beq LBC6D ; brif (X) is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3677 ldb 1,x ; get MS byte of mantissa of (X)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3678 eorb FP0SGN ; set bit 7 if signs of (X) and FPA0 differ

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3679 bmi LBC71 ; brif signs differ - no need to compare the magnitude

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3680 LBCA0 ldb FP0EXP ; compare exponents and brif different

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3681 cmpb ,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3682 bne LBCC3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3683 ldb 1,x ; compare mantissa (but we have to pack the FPA0 bits first

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3684 orb #0x7f ; keep only sign bit (note: signs are the same)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3685 andb FPA0 ; merge in the mantissa bits from FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3686 cmpb 1,x ; do the packed versions match?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3687 bne LBCC3 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3688 ldb FPA0+1 ; compare second byte of mantissas

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3689 cmpb 2,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3690 bne LBCC3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3691 ldb FPA0+2 ; compare third byte of mantissas

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3692 cmpb 3,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3693 bne LBCC3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3694 ldb FPA0+3 ; compare low byte of mantissas, but use subtraction so B = 0 on match

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3695 subb 4,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3696 bne LBCC3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3697 rts ; return B = 0 if (X) = FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3698 LBCC3 rorb ; shift carry to bit 7 (C set if FPA0 < (X))

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3699 eorb FP0SGN ; invert the comparision sense if the signs are negative

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3700 bra LBC73 ; interpret comparison result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3701 ; Shift mantissa of FPA0 until the binary point is immediately to the right of the mantissa and set up the

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3702 ; result as a two's complement value.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3703 LBCC8 ldb FP0EXP ; get exponent of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3704 beq LBD09 ; brif FPA0 is zero - we don't have to do anything, just blank it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3705 subb #0xa0 ; calculate number of shifts to get to the correct exponent (binary point to the right)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3706 lda FP0SGN ; do we have a positive number?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3707 bpl LBCD7 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3708 com FPCARY ; negate the mantissa and set extra inbound precision to the correct sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3709 jsr LBA7B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3710 LBCD7 ldx #FP0EXP ; point to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3711 cmpb #-8 ; moving by whole bytes?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3712 bgt LBCE4 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3713 jsr LBAAE ; do bit shifting

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3714 clr FPCARY ; clear carry in byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3715 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3716 LBCE4 clr FPCARY ; clear the extra carry in precision

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3717 lda FP0SGN ; get sign of value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3718 rola ; get sign to carry (so rotate repeats the sign)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3719 ror FPA0 ; shift the first bit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3720 jmp LBABA ; do the shifting dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3721 ; INT function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3722 INT ldb FP0EXP ; get exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3723 cmpb #0xa0 ; is the number big enough that there can be no fractional part?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3724 bhs LBD11 ; brif so - we don't have to do anything

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3725 bsr LBCC8 ; go shift binary point to the right of the mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3726 stb FPSBYT ; save extra precision bits

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3727 lda FP0SGN ; get original sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3728 stb FP0SGN ; force result to be positive

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3729 suba #0x80 ; set C if we had a positive result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3730 lda #0xa0 ; set exponent to match denormalized result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3731 sta FP0EXP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3732 lda FPA0+3 ; save low byte

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3733 sta CHARAC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3734 jmp LBA18 ; go normalize (this will correct for the two's complement representation of negatives)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3735 LBD09 stb FPA0 ; replace mantissa of FPA0 with contents of B

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3736 stb FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3737 stb FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3738 stb FPA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3739 LBD11 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3740 ; Convert ASCII string to FP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3741 ; BUG: no overflow is checked on the decimal exponent in exponential notation.

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3742 LBD12 ldx ZERO ; zero out FPA0 and temporaries

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3743 stx FP0SGN

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3744 stx FP0EXP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3745 stx FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3746 stx FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3747 stx V47

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3748 stx V45

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3749 bcs LBD86 ; brif input character is numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3750 jsr RVEC19 ; do the RAM hook dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3751 cmpa #'- ; regular negative sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3752 bne LBD2D ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3753 com COEFCT ; invert sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3754 bra LBD31 ; process stuff after the sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3755 LBD2D cmpa #'+ ; regular plus?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3756 bne LBD35 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3757 LBD31 jsr GETNCH ; get character after sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3758 bcs LBD86 ; brif numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3759 LBD35 cmpa #'. ; decimal point?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3760 beq LBD61 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3761 cmpa #'E ; scientific notation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3762 bne LBD65 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3763 jsr GETNCH ; eat the "E"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3764 bcs LBDA5 ; brif numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3765 cmpa #0xac ; negative sign (token)?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3766 beq LBD53 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3767 cmpa #'- ; regular negative?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3768 beq LBD53 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3769 cmpa #0xab ; plus sign (token)?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3770 beq LBD55 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3771 cmpa #'+ ; regular plus?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3772 beq LBD55

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3773 bra LBD59 ; brif no sign found

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3774 LBD53 com V48 ; set exponent sign to negative

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3775 LBD55 jsr GETNCH ; eat the sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3776 bcs LBDA5 ; brif numeric

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3777 LBD59 tst V48 ; is the exponent sign negatvie?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3778 beq LBD65 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3779 neg V47 ; negate base 10 exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3780 bra LBD65

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3781 LBD61 com V46 ; toggle decimal point flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3782 bne LBD31 ; brif we haven't seen two decimal points

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3783 LBD65 lda V47 ; get base 10 exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3784 suba V45 ; subtract number of places to the right

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3785 sta V47 ; we now have a complete decimal exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3786 beq LBD7F ; brif we have no base 10 shifting required

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3787 bpl LBD78 ; brif positive exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3788 LBD6F jsr LBB82 ; divide FPA0 by 10 (shift decimal point left)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3789 inc V47 ; bump exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3790 bne LBD6F ; brif we haven't reached 0 yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3791 bra LBD7F ; return result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3792 LBD78 jsr LBB6A ; multiply by 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3793 dec V47 ; downshift the exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3794 bne LBD78 ; brif not at 0 yet

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3795 LBD7F lda COEFCT ; get desired sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3796 bpl LBD11 ; brif it will be positive - no need to do anything

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3797 jmp LBEE9 ; flip the sign of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3798 LBD86 ldb V45 ; get the decimal count

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3799 subb V46 ; (if decimal seen, will add one; otherwise it does nothing)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3800 stb V45

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3801 pshs a ; save new digit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3802 jsr LBB6A ; multiply partial result by 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3803 puls b ; get back digit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3804 subb #'0 ; remove ASCII bias

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3805 bsr LBD99 ; add B to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3806 bra LBD31 ; go process another digit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3807 LBD99 jsr LBC2F ; save FPA0 to FPA3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3808 jsr LBC7C ; convert B to FP number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3809 ldx #V40 ; point to FPA3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3810 jmp LB9C2 ; add FPA3 and FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3811 LBDA5 ldb V47 ; get exponent value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3812 aslb ; times 2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3813 aslb ; times 4

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3814 addb V47 ; times 5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3815 aslb ; times 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3816 suba #'0 ; remove ASCII bias

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3817 pshs b ; save acculated result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3818 adda ,s+ ; add new digit to accumulated result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3819 sta V47 ; save new accumulated decimal exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3820 bra LBD55 ; interpret another exponent character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3821 LBDB6 fcb 0x9b,0x3e,0xbc,0x1f,0xfd ; packed FP: 99999999.9

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3822 LBDBB fcb 0x9e,0x6e,0x6b,0x27,0xfd ; packed FP: 999999999

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3823 LBDC0 fcb 0x9e,0x6e,0x6b,0x28,0x00 ; pakced FP: 1E9

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3824 LBDC5 ldx #LABE8-1 ; point to "IN" message

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3825 bsr LBDD6 ; output the string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3826 ldd CURLIN ; get basic line number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3827 LBDCC std FPA0 ; save 16 bit unsigned integer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3828 ldb #0x90 ; exponent for upper 16 bits of FPA0 to be an integer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3829 coma ; set C (force normalization to treat as positive)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3830 jsr LBC86 ; zero bottom half, save exponent, and normalize

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3831 bsr LBDD9 ; convert FP number to ASCII string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3832 LBDD6 jmp LB99C ; output string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3833 ; Convert FP number to ASCII string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3834 LBDD9 ldu #STRBUF+3 ; point to buffer address that will not cause string to go to string space

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3835 LBDDC lda #0x20 ; default sign is a space character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3836 ldb FP0SGN ; get sign of value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3837 bpl LBDE4 ; brif positive

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3838 lda #'- ; use negative sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3839 LBDE4 sta ,u+ ; save sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3840 stu COEFPT ; save output buffer pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3841 sta FP0SGN ; save sign character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3842 lda #'0 ; result is 0 if exponent is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3843 ldb FP0EXP ; get exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3844 lbeq LBEB8 ; brif FPA0 is 0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3845 clra ; base 10 exponent is 0 for > 1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3846 cmpb #0x80 ; is number > 1?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3847 bhi LBDFF ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3848 ldx #LBDC0 ; point to 1E+09

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3849 jsr LBACA ; shift decimal to the right by 9 spaces

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3850 lda #-9 ; account for shift

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3851 LBDFF sta V45 ; save base 10 exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3852 LBE01 ldx #LBDBB ; point to 999999999

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3853 jsr LBCA0 ; are we above that?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3854 bgt LBE18 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3855 LBE09 ldx #LBDB6 ; point to 99999999.9

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3856 jsr LBCA0 ; are we above that?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3857 bgt LBE1F ; brif in range

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3858 jsr LBB6A ; multiply by 10 (we were small)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3859 dec V45 ; account for shift

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3860 bra LBE09 ; see if we've come into range

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3861 LBE18 jsr LBB82 ; divide by 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3862 inc V45 ; account for shift

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3863 bra LBE01 ; see if we've come into range

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3864 LBE1F jsr LB9B4 ; add 0.5 to FPA0 (rounding)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3865 jsr LBCC8 ; do the integer dance

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3866 ldb #1 ; default decimal flag (force immediate decimal)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3867 lda V45 ; get base 10 exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3868 adda #10 ; account for "unormalized" number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3869 bmi LBE36 ; brif number < 1.0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3870 cmpa #11 ; do we have more than 9 places?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3871 bhs LBE36 ; brif so - do scientific notation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3872 deca

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3873 tfr a,b

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3874 lda #2 ; force no scientific notation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3875 LBE36 deca ; subtract wo without affecting carry

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3876 deca

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3877 sta V47 ; save exponent - 0 is do not display in scientific notation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3878 stb V45 ; save number of places to left of decimal

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3879 bgt LBE4B ; brif >= 1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3880 ldu COEFPT ; point to string buffer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3881 lda #'. ; put decimal

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3882 sta ,u+

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3883 tstb ; is there anything to left of decimal?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3884 beq LBE4B ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3885 lda #'0 ; store a zero

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3886 sta ,u+

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3887 LBE4B ldx #LBEC5 ; point to powers of 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3888 ldb #0x80 ; set digit counter to 0x80

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3889 LBE50 lda FPA0+3 ; add mantissa to power of 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3890 adda 3,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3891 sta FPA0+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3892 lda FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3893 adca 2,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3894 sta FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3895 lda FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3896 adca 1,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3897 sta FPA0+1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3898 lda FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3899 adca ,x

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3900 sta FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3901 incb ; add one to digit counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3902 rorb ; put carry into bit 7

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3903 rolb ; set V if carry and sign differ

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3904 bvc LBE50 ; brif positive mantissa or carry is 0 and negative mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3905 bcc LBE72 ; brif negative mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3906 subb #10+1 ; take 9's complement if adding mantissa

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3907 negb

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3908 LBE72 addb #'0-1 ; add ASCII bias

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3909 leax 4,x ; move to next power of 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3910 tfr b,a ; save digit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3911 anda #0x7f ; remove add/subtract flag

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3912 sta ,u+ ; put in output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3913 dec V45 ; do we need a decimal yet?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3914 bne LBE84 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3915 lda #'. ; put decimal

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3916 sta ,u+

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3917 LBE84 comb ; toggle bit 7 (add/sub flag)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3918 andb #0x80 ; only keep bit 7

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3919 cmpx #LBEC5+9*4 ; done all places?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3920 bne LBE50 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3921 LBE8C lda ,-u ; get last character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3922 cmpa #'0 ; was it 0?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3923 beq LBE8C ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3924 cmpa #'. ; decimal?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3925 bne LBE98 ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3926 leau -1,u ; move past decimal if it isn't needed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3927 LBE98 lda #'+ ; plus sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3928 ldb V47 ; get scientific notation exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3929 beq LBEBA ; brif not scientific notation

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3930 bpl LBEA3 ; brif positive exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3931 lda #'- ; negative sign for base 10 exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3932 negb ; switch to positive exponent

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3933 LBEA3 sta 2,u ; put sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3934 lda #'E ; put "E"

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3935 sta 1,u

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3936 lda #'0-1 ; init to ASCII 0 (compensate for INC)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3937 LBEAB inca ; bump digit

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3938 subb #10 ; have we hit the correct one yet?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3939 bcc LBEAB ; brif not

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3940 addb #'9+1 ; convert units digit to ASCII

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3941 std 3,u ; put exponent in output

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3942 clr 5,u ; put trailing NUL

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3943 bra LBEBC ; go reset pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3944 LBEB8 sta ,u ; store last character

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3945 LBEBA clr 1,u ; put NUL at the end

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3946 LBEBC ldx #STRBUF+3 ; point to start of string

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3947 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3948 LBEC0 fcb 0x80,0x00,0x00,0x00,0x00 ; packed FP 0.5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3949 LBEC5 fqb -100000000

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3950 fqb 10000000

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3951 fqb -1000000

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3952 fqb 100000

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3953 fqb -10000

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3954 fqb 1000

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3955 fqb -100

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3956 fqb 10

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3957 fqb -1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3958 LBEE9 lda FP0EXP ; get exponent of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3959 beq LBEEF ; brif 0 - don't flip sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3960 com FP0SGN ; flip sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3961 LBEEF rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3962 ; Expand a polynomial of the form

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3963 ; AQ+BQ^3+CQ^5+DQ^7..... where Q is FPA0 and X points to a table

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3964 LBEF0 stx COEFPT ; save coefficient table pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3965 jsr LBC2F ; copy FPA0 to FPA3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3966 bsr LBEFC ; multiply FPA3 by FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3967 bsr LBF01 ; expand polynomial

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3968 ldx #V40 ; point to FPA3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3969 LBEFC jmp LBACA ; multiply FPA0 by FPA3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3970 LBEFF stx COEFPT ; save coefficient table counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3971 LBF01 jsr LBC2A ; move FPA0 to FPA4

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3972 ldx COEFPT ; get the current coefficient

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3973 ldb ,x+ ; get the number of entries

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3974 stb COEFCT ; save as counter

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3975 stx COEFPT ; save new pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3976 LBF0C bsr LBEFC ; multiply (X) and FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3977 ldx COEFPT ; get this coefficient

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3978 leax 5,x ; move to next one

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3979 stx COEFPT ; save new pointer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3980 jsr LB9C2 ; add (X) to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3981 ldx #V45 ; point X to FPA4

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3982 dec COEFCT ; done all coefficients?

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3983 bne LBF0C ; brif more left

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3984 rts

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3985 ; RND function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3986 RND jsr LBC6D ; set flags on FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3987 bmi LBF45 ; brif negative - set seed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3988 beq LBF3B ; brif 0 - do random between 0 and 1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3989 bsr LBF38 ; convert to integer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3990 jsr LBC2F ; save range value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3991 bsr LBF3B ; get random number

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3992 ldx #V40 ; point to FPA3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3993 bsr LBEFC ; multply (X) by FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3994 ldx #LBAC5 ; point to FP 1.0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3995 jsr LB9C2 ; add 1 to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3996 LBF38 jmp INT ; return integer value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3997 LBF3B ldx RVSEED+1 ; move variable random number seed to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3998 stx FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

3999 ldx RVSEED+3

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4000 stx FPA0+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4001 LBF45 ldx RSEED ; move fixed seed to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4002 stx FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4003 ldx RSEED+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4004 stx FPA1+2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4005 jsr LBAD0 ; multiply them

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4006 ldd VAD ; get lowest order product bytes

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4007 addd #0x658b ; add a constant

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4008 std RVSEED+3 ; save it as new seed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4009 std FPA0+2 ; save in result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4010 ldd VAB ; get high order extra product bytes

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4011 adcb #0xb0 ; add upper bytes of constant

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4012 adca #5

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4013 std RVSEED+1 ; save as new seed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4014 std FPA0 ; save as result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4015 clr FP0SGN ; set result to positive

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4016 lda #0x80 ; set exponent to 0 < FPA0 < 1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4017 sta FP0EXP

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4018 lda FPA2+2 ; get a byte from FPA2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4019 sta FPSBYT ; save as extra precision

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4020 jmp LBA1C ; go normalize FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4021 RSEED fqb 0x40e64dab ; constant random number generator seed

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4022 ; SIN function

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4023 SIN jsr LBC5F ; copy FPA0 to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4024 ldx #LBFBD ; point to 2*pi

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4025 ldb FP1SGN ; get sign of FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4026 jsr LBB89 ; divide FPA0 by 2*pi

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4027 jsr LBC5F ; copy FPA0 to FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4028 bsr LBF38 ; convert FPA0 to an integer

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4029 clr RESSGN ; set result to positive

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4030 lda FP1EXP ; get exponent of FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4031 ldb FP0EXP ; get exponent of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4032 jsr LB9BC ; subtract FPA0 from FPA1

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4033 ldx #LBFC2 ; point to FP 0.25

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4034 jsr LB9B9 ; subtract FPA0 from 0.25 (pi/2)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4035 lda FP0SGN ; get result sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4036 pshs a ; save it

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4037 bpl LBFA6 ; brif positive

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4038 jsr LB9B4 ; add 0.5 (pi) to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4039 lda FP0SGN ; get sign of result

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4040 bmi LBFA9 ; brif negative

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4041 com RELFLG ; if 3pi/2 >= arg >= pi/2

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4042 LBFA6 jsr LBEE9 ; flip sign of FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4043 LBFA9 ldx #LBFC2 ; point to 0.25

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4044 jsr LB9C2 ; add 0.25 (pi/2) to FPA0

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4045 puls a ; get original sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4046 tsta ; was it positive

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4047 bpl LBFB7 ; brif so

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4048 jsr LBEE9 ; flip result sign

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4049 LBFB7 ldx #LBFC7 ; point to series coefficients

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4050 jmp LBEF0 ; go calculate value

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4051 LBFBD fcb 0x83,0x49,0x0f,0xda,0xa2 ; 2*pi

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4052 LBFC2 fcb 0x7f,0x00,0x00,0x00,0x00 ; 0.25

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4053 ; modified taylor series SIN coefficients

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4054 LBFC7 fcb 6-1 ; six coefficients

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4055 fcb 0x84,0xe6,0x1a,0x2d,0x1b ; -((2pi)^11)/11!

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4056 fcb 0x86,0x28,0x07,0xfb,0xf8 ; ((2pi)^9)/9!

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4057 fcb 0x87,0x99,0x68,0x89,0x01 ; -((2pi)^7)/7!

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4058 fcb 0x87,0x23,0x35,0xdf,0xe1 ; ((2pi)^5)/5!

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4059 fcb 0x86,0xa5,0x5d,0xe7,0x28 ; -(2pi)^3)/3!

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4060 fcb 0x83,0x49,0x0f,0xda,0xa2 ; 2*pi

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4061 ; these 12 bytes are unused

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4062 fcb 0xa1,0x54,0x46,0x8f,0x13,0x8f,0x52,0x43

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4063 fcb 0x89,0xcd,0xa6,0x81

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4064 ; these are the hardware interrupt vectors (coco1/2 only)

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4065 fdb SW3VEC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4066 fdb SW2VEC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4067 fdb FRQVEC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4068 fdb IRQVEC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4069 fdb SWIVEC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4070 fdb NMIVEC

605ff82c4618 Initial check in with cleaned up sources

William Astle <lost@l-w.ca>

parents:

diff changeset

4071 fdb RESVEC

Mercurial > hg > index.cgi

annotate bas13.s @ 0:605ff82c4618