crunch.src

	.page
	.subttl Crunch - Tokenization Routine
;        crunch
;
;  entry:  txtptr points to start of text to crunch
;  exit:   txtptr points to start of crunched text
;  calls:  chrget
;          chrgot
;          reser
;          kloop
;          rem
;          data
;  collapses all reserved words to tokens.  does
;  not alter data or rem.  removes all graphic
;  characters not in quoted strings
;
;
;  an escape token is implemented as follows:
;
;     as each character on a line of text to be crunched is scanned, an
;     indirect jump is performed. anyone wishing to scan for their own
;     commands should grab off this vector, saving the return vector.
;     on entry, if the carry flag is set, it is still up for grabs.
;     the current text pointer is at txtptr. if the escape
;     routine recognizes the command, it should:
;
;            ) put the length of the reserved word in y
;            ) put the desired 'second' token in a
;            ) clear the carry flag
;	     ) put type of token in x: 0==>command, ff==>function
;
;     if it is not your command, leave the acc. and the carry
;     flag intact. note: the reserved word *must* be >= 2 charcters
;     long. exit through the old vector (for daisy chaining). if
;     the carry flag is clear on entry, it means someone else
;     before you recognizes this command. in this case, just pass
;     control through the old vector

crunch
	jmp (icrnch)
ncrnch
	lda txtptr	;save old text loc
	pha
	lda txtptr+1
	pha
crun05
	jsr chrgot
	jmp crun20

crun10
	jsr chrget
crun20
	bcc crun10	;don't crunch numbers
	jmp (iesclk)    ;give others a chance at this. carry is set.
nesclk	bcs 1$
	jmp crun95	;carry clear if someone wanted it

1$	cmp #0		;end of line?
	beq crun90	;yes...
	cmp #':'	;multi-stmt char?
	beq crun10
	cmp #'?'	;print abreviation?
	bne crun30	;no...
	lda #printk     ;substitute print token
	bne crun75	;branch always
crun30
	cmp #$80	;graphics?
	bcc crun40	;no...
	cmp #pi		;yes...pi?
	beq crun10	;o.k....leave alone
	ldy #1
	jsr kloop	;crunch out graphics
	beq crun05	;branch always
crun40
	cmp #'"'	;quote string?
	bne crun_esc	;no...
crun50
	jsr chrget
	cmp #0		;end of line?
	beq crun90	;yes...
	cmp #'"'	;close quote?
	beq crun10	;yes...
	bne crun50	;no...


crun_esc
	lda #>esc_cmd_lst	;set up to look for token in escape-command list
	ldy #<esc_cmd_lst
	jsr reser
	bcc 10$			;not found.
	lda #lowest_esc_cmd_tk+$80-1 ;set up for common escape routine
	ldx #0			;..flag 'cmd' type escape
	beq crun94		;..and go to it.

10$	lda #>esc_fn_lst	;set up to look for token in escape-function list
	ldy #<esc_fn_lst
	jsr reser
	bcc 20$			;not found.
	lda #lowest_esc_fn_tk+$80-1 ;set up for common escape routine
	ldx #$ff		;..flag 'function' type escape
	bne crun94		;..always

20$	lda #>reslst	;set up to look for token in normal list
	ldy #<reslst
	jsr reser	;..and go look.
	bcc crun10	;not found
	cpy #0	   	;anything to move?
	beq 30$		;no...
	jsr kloop	;crunch it out
30$	lda count	;put token...

crun75	ldy #0
	sta (txtptr),y	;in text
	cmp #remtk
	beq crun80
	cmp #datatk
	bne crun10
	jsr chrget
	jsr data
	jmp crun05

crun80	jsr chrget
	jsr rem
;
;  no other statements can follow a rem
;

crun90	ldx txtptr
	pla
	sta txtptr+1
	pla
	sta txtptr
	sec		;compute length of line
	txa
	sbc txtptr
	tay
	iny
	rts




;crunch out old text, install an escape token

crun94	adc count	;make pointer into a token
crun95	pha		;save second token
	dey		;waste (# of chars) - 1
	jsr kloop

; see if this is function (x=ff) or command (x=0)

	lda #esc_cmd_tk	;assume command
	inx
	bne 1$		;branch if command
	lda #esc_fn_tk	;..else get correct token

1$	ldy #0
	sta (txtptr),y	;install escape token...
	iny
	pla
	sta (txtptr),y  ;..and second token
	jsr chrget	;skip over token,
	jmp crun10	;..and continue with line.

	.page
;      kloop
;
;  crunch loop.  moves offset .y characters
;  from txtptr to end of line. .x is preserved

kloop	clc		;compute source address
	tya
	adc txtptr
	sta index1
	lda txtptr+1
	adc #0
	sta index1+1
	ldy #$ff

1$	iny
	lda (index1),y	;move source..
	sta (txtptr),y	;to destination offset
	bne 1$		;not end of line
	rts
	.page
;      reser
;
;  search reserved word list for a match
;  entry:  (txtptr) is first char of word to match
;	   (y,a) is start of table to check
;
;  exit:   .y=length of word matched
;	   .c=success/fail (set/clear) flag
;	   count=token value

reser	sta index1+1
	sty index1
	ldy #0
	sty count
	dey
rese10	iny
rese20	lda (txtptr),y
	sec
	sbc (index1),y	;does letter match? (ind.ok)
	beq rese10	;yes...continue
	cmp #$80	;no....end of word?
	beq rese60	;yes...c set...done
;
;  find next word
;
rese30	lda (index1),y	;ind.ok
	bmi rese40	;found end of current
	iny
	bne rese30
rese40	iny		;start of next
	inc count	;value of token
	clc
	tya
	adc index1
	sta index1
	bcc rese50
	inc index1+1
rese50	clc
	ldy #0
	lda (index1),y	; end of list? ind.ok
	bne rese20	;no...
;
;  yes...carry clear...fail
;
rese60	ora count	;.a=$80 if match
	sta count	;token is formed
	rts

;.end