; Disassembly of Apple 1 BASIC ; Apple 1 BASIC was written by Steve Wozniak ; This disassembly is copyright 2003, 2019 Eric Smith ; Includes some updates by Jeff Tranter ; Cross-assembles on modern systems using the Macro Assembler AS ; by Alfred Arnold: ; http://john.ccac.rwth-aachen.de:8000/as/ cpu 6502 fcs macro arg irpc char,arg fcb 'char'+$80 endm endm errstr macro arg if strlen(arg) > 1 fcs substr(arg,0,strlen(arg)-1) endif fcb charfromstr(arg,strlen(arg)-1) endm synstr macro arg i set strlen(arg) while i > 0 i set i-1 fcb charfromstr(arg, i)+$60 endm endm synstr1 macro arg i set strlen(arg) i set i-1 fcb charfromstr(arg, i)+$a0 while i > 0 i set i-1 fcb charfromstr(arg, i)+$60 endm endm verb macro num,precv,target org verb_prec_tbl+num fcb precv org verb_addr_l+num fcb target & $ff org verb_addr_h+num fcb target >> 8 endm ch_cr equ $0d reset equ $00 Z1d equ $1d ch equ $24 ; cursor horizontal location cv equ $25 ; cusror vertical location lomem equ $4a ; lower limit of memory used by BASIC (2 bytes) himem equ $4c ; upper limit of memory used by BASIC (2 bytes) rnd equ $4e ; random number (2 bytes) ; The noun stack and syntax stack appear to overlap, which is OK since ; they apparently are not used simultaneously. ; The noun stack size appears to be 32 entries, based on LDX #$20 ; instruction at e67f. However, there seems to be enough room for ; another 8 entries. The noun stack builds down from noun_stk_+$1f ; to noun_stk_+$00, indexed by the X register. ; Noun stack usage appears to be: ; integer: ; (noun_stk_h_int,noun_stk_l) = value ; noun_stk_h_str = 0 ; string: ; (noun_stk_h_str,noun_stk_l) = pointer to string ; noun_stk_h_int = any ; Since noun_stk_h_str determines whether stack entry is integer or string, ; strings can't start in zero page. noun_stk_l equ $50 syn_stk_h equ $58 ; through $77 noun_stk_h_str equ $78 syn_stk_l equ $80 ; through $9f noun_stk_h_int equ $a0 txtndxstk equ $a8 ; through $c7 text_index equ $c8 ; index into text being tokenized (in buffer at $0200) leadbl equ $c9 ; leading blanks pp equ $ca ; pointer to end fo program (2 bytes) pv equ $cc ; pointer to end of variable storage (2 bytes) acc equ $ce ; (2 bytes) srch equ $d0 tokndxstk equ $d1 srch2 equ $d2 if_flag equ $d4 cr_flag equ $d5 current_verb equ $d6 precedence equ $d7 x_save equ $d8 run_flag equ $d9 aux equ $da pline equ $dc ; pointer to current program line (2 bytes) pverb equ $e0 ; pointer to current verb (2 bytes) p1 equ $e2 p2 equ $e4 p3 equ $e6 token_index equ $f1 ; pointer used to write tokens into buffer (2 bytes) pcon equ $f2 ; temp used in decimal output (2 bytes) auto_inc equ $f4 auto_ln equ $f6 auto_flag equ $f8 char equ $f9 leadzr equ $fa for_nest_count equ $fb ; count of active (nested) FOR loops gosub_nest_count equ $fc ; count of active (nested) subroutine calls (GOSUB) synstkdx equ $fd synpag equ $fe ; GOSUB stack, max eight entries ; note that the Apple II version has sixteen entries gstk_pverbl equ $0100 gstk_pverbh equ $0108 gstk_plinel equ $0110 gstk_plineh equ $0118 ; FOR stack, max eight entries ; note that the Apple II version has sixteen entries fstk_varl equ $0120 fstk_varh equ $0128 fstk_stepl equ $0130 fstk_steph equ $0138 fstk_plinel equ $0140 fstk_plineh equ $0148 fstk_pverbl equ $0150 fstk_pverbh equ $0158 fstk_tol equ $0160 fstk_toh equ $0168 buffer equ $0200 ; hardware locations: kbd equ $d010 kbdcr equ $d011 dsp equ $d0f2 ; the canonical address is $d012, but due to incomplete decode, this works org $e000 Pe000: jmp cold ; BASIC cold start entry point ; Get character from keybaord, return in A. rdkey: lda kbdcr ; read control register bpl rdkey ; loop if no key pressed lda kbd ; read data rts Se00c: txa and #$20 beq Le034 Se011: lda #' '+$80 sta p2 jmp cout Se018: lda #' ' Se01a: cmp ch bcs nextbyte lda #ch_cr+$80 ldy #$07 Le022: jsr cout lda #' '+$80 dey bne Le022 nextbyte: ldy #$00 lda (p1),y inc p1 bne Le034 inc p1+1 Le034: rts list_comman: jsr get16bit jsr find_line2 Le03b: lda p1 cmp p3 lda p1+1 sbc p3+1 bcs Le034 jsr list_line jmp Le03b list_all: lda pp sta p1 lda pp+1 sta p1+1 lda himem sta p3 lda himem+1 sta p3+1 bne Le03b list_cmd: jsr get16bit jsr find_line lda p2 sta p1 lda p2+1 sta p1+1 bcs Le034 list_line: stx x_save lda #$a0 sta leadzr jsr nextbyte tya list_int: sta p2 jsr nextbyte tax jsr nextbyte jsr prdec Le083: jsr Se018 sty leadzr tax bpl list_token asl a bpl list_int lda p2 bne Le095 jsr Se011 Le095: txa Le096: jsr cout Le099: lda #$25 jsr Se01a tax bmi Le096 sta p2 list_token: cmp #$01 bne Le0ac ldx x_save jmp crout Le0ac: pha sty acc ldx #$ed stx acc+1 cmp #$51 bcc Le0bb dec acc+1 sbc #$50 Le0bb: pha lda (acc),y Le0be: tax dey lda (acc),y bpl Le0be cpx #$c0 bcs Le0cc cpx #$00 bmi Le0be Le0cc: tax pla sbc #$01 bne Le0bb bit p2 bmi Le0d9 jsr Seff8 Le0d9: lda (acc),y bpl Le0ed tax and #$3f sta p2 clc adc #' '+$80 jsr cout dey cpx #$c0 bcc Le0d9 Le0ed: jsr Se00c pla cmp #$5d beq Le099 cmp #$28 bne Le083 beq Le099 paren_substr: jsr Se118 sta noun_stk_l,x cmp noun_stk_h_str,x Le102: bcc Le115 string_err: ldy #$2b go_errmess_1: jmp do_error comma_substr: jsr getbyte cmp noun_stk_l,x bcc string_err jsr Sefe4 sta noun_stk_h_str,x Le115: jmp left_paren Se118: jsr getbyte beq string_err sec sbc #$01 rts str_arr_dest: jsr Se118 sta noun_stk_l,x clc sbc noun_stk_h_str,x jmp Le102 Le12c: ldy #$14 bne go_errmess_1 dim_str: jsr Se118 inx Le134: lda noun_stk_l,x sta aux adc acc pha tay lda noun_stk_h_str,x sta aux+1 adc acc+1 pha cpy pp sbc pp+1 bcs Le12c lda aux adc #$fe sta aux lda #$ff tay adc aux+1 sta aux+1 Le156: iny lda (aux),y cmp pv,y bne Le16d tya beq Le156 Le161: pla sta (aux),y sta pv,y dey bpl Le161 inx rts nop ; unused Le16d: ldy #$80 Le16f: bne go_errmess_1 input_str: lda #$00 jsr push_a_noun_stk ldy #$02 sty noun_stk_h_str,x jsr push_a_noun_stk lda #$bf jsr cout ldy #$00 jsr read_line sty noun_stk_h_str,x nop nop nop string_lit: lda noun_stk_l+1,x sta acc lda noun_stk_h_str+1,x sta acc+1 inx inx jsr Se1bc Le199: lda rnd,x cmp syn_stk_h+30,x bcs Le1b4 inc rnd,x tay lda (acc),y ldy noun_stk_l,x cpy p2 bcc Le1ae ldy #$83 bne Le16f Le1ae: sta (aux),y inc noun_stk_l,x bcc Le199 Le1b4: ldy noun_stk_l,x txa sta (aux),y inx inx rts Se1bc: lda noun_stk_l+1,x sta aux sec sbc #$02 sta p2 lda noun_stk_h_str+1,x sta aux+1 sbc #$00 sta p2+1 ldy #$00 lda (p2),y clc sbc aux sta p2 rts string_eq: lda noun_stk_l+3,x sta acc lda noun_stk_h_str+3,x sta acc+1 lda noun_stk_l+1,x sta aux lda noun_stk_h_str+1,x sta aux+1 inx inx inx ldy #$00 sty noun_stk_h_str,x sty noun_stk_h_int,x iny sty noun_stk_l,x Le1f3: lda himem+1,x cmp syn_stk_h+29,x php pha lda rnd+1,x cmp syn_stk_h+31,x bcc Le206 pla plp bcs Le205 Le203: lsr noun_stk_l,x Le205: rts Le206: tay lda (acc),y sta p2 pla tay plp bcs Le203 lda (aux),y cmp p2 bne Le203 inc rnd+1,x inc himem+1,x bcs Le1f3 string_neq: jsr string_eq jmp not_op multiply_op: jsr Se254 Le225: asl acc rol acc+1 bcc Le238 clc lda p3 adc aux sta p3 lda p3+1 adc aux+1 sta p3+1 Le238: dey beq Le244 asl p3 rol p3+1 bpl Le225 jmp Le77e Le244: lda p3 jsr push_ya_noun_stk lda p3+1 sta noun_stk_h_int,x asl p2+1 bcc Le279 jmp negate Se254: lda #$55 sta p2+1 jsr Se25b Se25b: lda acc sta aux lda acc+1 sta aux+1 jsr get16bit sty p3 sty p3+1 lda acc+1 bpl Le277 dex asl p2+1 jsr negate jsr get16bit Le277: ldy #$10 Le279: rts mod_op: jsr See6c beq Le244 ; hoepfully always taken fcb $ff ; hopefully unused Le280: cmp #$84 bne Le286 lsr auto_flag Le286: cmp #$df beq Le29b cmp #$9b beq Le294 sta buffer,y iny bpl read_line Le294: ldy #$8b jsr Se3c4 Se299: ldy #$01 Le29b: dey bmi Le294 read_line: jsr rdkey nop nop jsr cout cmp #ch_cr+$80 bne Le280 lda #'_'+$80 ; mark end of line with underscore sta buffer,y rts cold: jsr mem_init_4k warm: jsr crout Le2b6: lsr run_flag lda #$be jsr cout ldy #$00 sty leadzr bit auto_flag bpl Le2d1 ldx auto_ln lda auto_ln+1 jsr prdec lda #' '+$80 jsr cout Le2d1: ldx #$ff txs jsr read_line sty token_index txa sta text_index ldx #$20 jsr Se491 lda text_index adc #$00 sta pverb lda #$00 tax adc #$02 sta pverb+1 lda (pverb,x) and #$f0 cmp #$b0 beq Le2f9 jmp Le883 Le2f9: ldy #$02 Le2fb: lda (pverb),y sta pv+1,y dey bne Le2fb jsr Se38a lda token_index sbc text_index cmp #$04 beq Le2b6 sta (pverb),y lda pp sbc (pverb),y sta p2 lda pp+1 sbc #$00 sta p2+1 lda p2 cmp pv lda p2+1 sbc pv+1 bcc Le36b Le326: lda pp sbc (pverb),y sta p3 lda pp+1 sbc #$00 sta p3+1 lda (pp),y sta (p3),y inc pp bne Le33c inc pp+1 Le33c: lda p1 cmp pp lda p1+1 sbc pp+1 bcs Le326 Le346: lda p2,x sta pp,x dex bpl Le346 lda (pverb),y tay Le350: dey lda (pverb),y sta (p3),y tya bne Le350 bit auto_flag bpl Le365 Le35c: lda auto_ln+1,x adc auto_inc+1,x sta auto_ln+1,x inx beq Le35c Le365: bpl Le3e5 fcb $00,$00,$00,$00 ; BRK instructions, hopefully never executed Le36b: ldy #erri_mem_full bne do_error del_comma: jsr get16bit lda p1 sta p3 lda p1+1 sta p3+1 jsr find_line1 lda p1 sta p2 lda p1+1 sta p2+1 bne Le395 del_cmd: jsr get16bit Se38a: jsr find_line lda p3 sta p1 lda p3+1 sta p1+1 Le395: ldy #$00 Le397: lda pp cmp p2 lda pp+1 sbc p2+1 bcs Le3b7 lda p2 bne Le3a7 dec p2+1 Le3a7: dec p2 lda p3 bne Le3af dec p3+1 Le3af: dec p3 lda (p2),y sta (p3),y bcc Le397 Le3b7: lda p3 sta pp lda p3+1 sta pp+1 rts Le3c0: jsr cout iny Se3c4: lda error_msg_tbl,y bmi Le3c0 cout: cmp #ch_cr+$80 bne Le3d3 crout: lda #$00 sta ch lda #ch_cr+$80 Le3d3: inc ch ; Send character in A to display. Le3d5: bit dsp bmi Le3d5 sta dsp rts too_long_err: ldy #erri_too_long do_error: jsr print_err_msg bit run_flag Le3e5: bmi Le3ea jmp Le2b6 Le3ea: jmp Leb9a Le3ed: rol adc #$a0 cmp buffer,x bne Le448 lda (synpag),y asl bmi Le400 dey lda (synpag),y bmi Le428 iny Le400: stx text_index tya pha ldx #$00 lda (synpag,x) tax Le409: lsr eor #$48 ora (synpag),y cmp #$c0 bcc Le413 inx Le413: iny bne Le409 pla tay txa jmp Le4c0 put_token: inc token_index ldx token_index beq too_long_err sta buffer,x Le425: rts Le426: ldx text_index Le428: lda #$a0 Le42a: inx cmp buffer,x bcs Le42a lda (synpag),y and #$3f lsr bne Le3ed lda buffer,x bcs Le442 adc #$3f cmp #$1a bcc Le4b1 Le442: adc #$4f cmp #$0a bcc Le4b1 Le448: ldx synstkdx Le44a: iny lda (synpag),y and #$e0 cmp #$20 beq Le4cd lda txtndxstk,x sta text_index lda tokndxstk,x sta token_index Le45b: dey lda (synpag),y asl a bpl Le45b dey bcs Le49c asl a bmi Le49c ldy syn_stk_h,x sty synpag+1 ldy syn_stk_l,x inx bpl Le44a Le470: beq Le425 cmp #$7e bcs Le498 dex bpl Le47d ldy #$06 bpl go_errmess_2 ; always taken Le47d: sty syn_stk_l,x ldy synpag+1 sty syn_stk_h,x ldy text_index sty txtndxstk,x ldy token_index sty tokndxstk,x and #$1f ; mask to get syntax category number tay lda category_table,y Se491: asl a tay lda #$ec/2 rol sta synpag+1 Le498: bne Le49b iny Le49b: iny Le49c: stx synstkdx lda (synpag),y bmi Le426 bne Le4a9 ldy #erri_syntax go_errmess_2: jmp do_error Le4a9: cmp #$03 bcs Le470 lsr a ldx text_index inx Le4b1: lda buffer,x bcc Le4ba cmp #'"'+$80 beq Le4c4 Le4ba: cmp #'_'+$80 beq Le4c4 stx text_index Le4c0: jsr put_token iny Le4c4: dey ldx synstkdx Le4c7: lda (synpag),y dey asl bpl Le49c Le4cd: ldy syn_stk_h,x sty synpag+1 ldy syn_stk_l,x inx lda (synpag),y and #$9f bne Le4c7 sta pcon sta pcon+1 tya pha stx synstkdx ldy srch,x sty leadbl clc Le4e7: lda #$0a sta char ldx #$00 iny lda buffer,y and #$0f Le4f3: adc pcon pha txa adc pcon+1 bmi Le517 tax pla dec char bne Le4f3 sta pcon stx pcon+1 cpy token_index bne Le4e7 ldy leadbl iny sty token_index jsr put_token pla tay lda pcon+1 bcs Le4c0 Le517: ldy #$00 bpl go_errmess_2 prdec: sta pcon+1 stx pcon ldx #$04 stx leadbl Le523: lda #'0'+$80 sta char Le527: lda pcon cmp dectabl,x lda pcon+1 sbc dectabh,x bcc Le540 sta pcon+1 lda pcon sbc dectabl,x sta pcon inc char bne Le527 Le540: lda char inx dex beq Le554 cmp #'0'+$80 beq Le54c sta leadbl Le54c: bit leadbl bmi Le554 lda leadzr beq Le55f Le554: jsr cout bit auto_flag bpl Le55f sta buffer,y iny Le55f: dex bpl Le523 rts dectabl: fcb $01,$0a,$64,$e8,$10 dectabh: fcb $00,$00,$00,$03,$27 find_line: lda pp sta p3 lda pp+1 sta p3+1 find_line1: inx find_line2: lda p3+1 sta p2+1 lda p3 sta p2 cmp himem lda p2+1 sbc himem+1 bcs Le5ac ldy #$01 lda (p2),y sbc acc iny lda (p2),y sbc acc+1 bcs Le5ac ldy #$00 lda p3 adc (p2),y sta p3 bcc Le5a0 inc p3+1 clc Le5a0: iny lda acc sbc (p2),y iny lda acc+1 sbc (p2),y bcs find_line2 Le5ac: rts new_cmd: lsr auto_flag lda himem sta pp lda himem+1 sta pp+1 clr_cmd: lda lomem sta pv lda lomem+1 sta pv+1 lda #$00 sta for_nest_count sta gosub_nest_count sta synpag lda #$00 sta Z1d rts Le5cc: lda srch adc #$05 sta srch2 lda tokndxstk adc #$00 sta srch2+1 lda srch2 cmp pp lda srch2+1 sbc pp+1 bcc Le5e5 jmp Le36b Le5e5: lda acc sta (srch),y lda acc+1 iny sta (srch),y lda srch2 iny sta (srch),y lda srch2+1 iny sta (srch),y lda #$00 iny sta (srch),y iny sta (srch),y lda srch2 sta pv lda srch2+1 sta pv+1 lda srch bcc Le64f execute_var: sta acc sty acc+1 jsr get_next_prog_byte bmi Le623 cmp #$40 beq Le623 jmp Le628 fcb $06,$c9,$49,$d0,$07,$a9,$49 Le623: sta acc+1 jsr get_next_prog_byte Le628: lda lomem+1 sta tokndxstk lda lomem Le62e: sta srch cmp pv lda tokndxstk sbc pv+1 bcs Le5cc lda (srch),y iny cmp acc bne Le645 lda (srch),y cmp acc+1 beq Le653 Le645: iny lda (srch),y pha iny lda (srch),y sta tokndxstk pla Le64f: ldy #$00 beq Le62e Le653: lda srch adc #$03 jsr push_a_noun_stk lda tokndxstk adc #$00 sta noun_stk_h_str,x lda acc+1 cmp #$40 bne fetch_prog_byte dey tya jsr push_a_noun_stk dey sty noun_stk_h_str,x ldy #$03 Le670: inc noun_stk_h_str,x iny lda (srch),y bmi Le670 bpl fetch_prog_byte execute_stmt: lda #$00 sta if_flag sta cr_flag ldx #$20 push_old_verb: pha fetch_prog_byte: ldy #$00 lda (pverb),y Le686: bpl execute_token asl a bmi execute_var jsr get_next_prog_byte jsr push_ya_noun_stk jsr get_next_prog_byte sta noun_stk_h_int,x Le696: bit if_flag bpl Le69b dex Le69b: jsr get_next_prog_byte bcs Le686 execute_token: cmp #$28 bne execute_verb lda pverb jsr push_a_noun_stk lda pverb+1 sta noun_stk_h_str,x bit if_flag bmi Le6bc lda #$01 jsr push_a_noun_stk lda #$00 sta noun_stk_h_str,x Le6ba: inc noun_stk_h_str,x Le6bc: jsr get_next_prog_byte bmi Le6ba bcs Le696 execute_verb: bit if_flag bpl Le6cd cmp #$04 bcs Le69b lsr if_flag Le6cd: tay sta current_verb lda verb_prec_tbl,y and #$55 asl sta precedence Le6d8: pla tay lda verb_prec_tbl,y and #$aa cmp precedence bcs do_verb tya pha jsr get_next_prog_byte lda current_verb bcc push_old_verb do_verb: lda verb_addr_l,y sta acc lda verb_addr_h,y sta acc+1 jsr Se6fc jmp Le6d8 Se6fc: jmp (acc) get_next_prog_byte: inc pverb bne Le705 inc pverb+1 Le705: lda (pverb),y rts push_ya_noun_stk: sty syn_stk_h+31,x push_a_noun_stk: dex bmi Le710 sta noun_stk_l,x rts Le710: ldy #erri_stopped_at+3 ; The "+3" is a bug! go_errmess_3: jmp do_error get16bit: ldy #$00 lda noun_stk_l,x sta acc lda noun_stk_h_int,x sta acc+1 lda noun_stk_h_str,x beq Le731 sta acc+1 lda (acc),y pha iny lda (acc),y sta acc+1 pla sta acc dey Le731: inx rts eq_op: jsr neq_op not_op: jsr get16bit tya jsr push_ya_noun_stk sta noun_stk_h_int,x cmp acc bne Le749 cmp acc+1 bne Le749 inc noun_stk_l,x Le749: rts neq_op: jsr subtract_op jsr sgn_fn abs_fn: jsr get16bit bit acc+1 bmi Se772 Le757: dex Le758: rts sgn_fn: jsr get16bit lda acc+1 bne Le764 lda acc beq Le757 Le764: lda #$ff jsr push_ya_noun_stk sta noun_stk_h_int,x bit acc+1 bmi Le758 negate: jsr get16bit Se772: tya sec sbc acc jsr push_ya_noun_stk tya sbc acc+1 bvc Le7a1 Le77e: ldy #$00 bpl go_errmess_3 subtract_op: jsr negate add_op: jsr get16bit lda acc sta aux lda acc+1 sta aux+1 jsr get16bit Se793: clc lda acc adc aux jsr push_ya_noun_stk lda acc+1 adc aux+1 bvs Le77e Le7a1: sta noun_stk_h_int,x unary_pos: rts tab_fn: jsr get16bit ldy acc beq Le7b0 dey lda acc+1 beq Le7bc Le7b0: rts tabout: lda ch ora #7 tay iny Le7b7: lda #' '+$80 jsr cout Le7bc: cpy ch bcs Le7b7 rts print_com_num: jsr tabout print_num: jsr get16bit lda acc+1 bpl Le7d5 lda #'-'+$80 jsr cout jsr Se772 bvc print_num Le7d5: dey sty cr_flag stx acc+1 ldx acc jsr prdec ldx acc+1 rts auto_cmd: jsr get16bit lda acc sta auto_ln lda acc+1 sta auto_ln+1 dey sty auto_flag iny lda #$0a Le7f3: sta auto_inc sty auto_inc+1 rts auto_comma: jsr get16bit lda acc ldy acc+1 bpl Le7f3 var_assign: jsr get16bit lda noun_stk_l,x sta aux lda noun_stk_h_str,x sta aux+1 lda acc sta (aux),y iny lda acc+1 sta (aux),y inx null_stmt: rts ; used to execute LET keyword or colon ; (statement separator), which need no ; processing begin_line: pla pla colon: bit cr_flag bpl Le822 print_cr: jsr crout print_semi: lsr cr_flag Le822: rts left_paren: ldy #$ff sty precedence right_paren: rts if_stmt: jsr Sefcd beq Le834 lda #$25 sta current_verb dey sty if_flag Le834: inx rts run_warm: lda pp ldy pp+1 bne Le896 gosub_stmt: ldy #$41 lda gosub_nest_count cmp #8 bcs go_errmess_4 tay inc gosub_nest_count lda pverb sta gstk_pverbl,y lda pverb+1 sta gstk_pverbh,y lda pline sta gstk_plinel,y lda pline+1 sta gstk_plineh,y goto_stmt: jsr get16bit jsr find_line bcc Le867 ldy #$37 bne go_errmess_4 Le867: lda p2 ldy p2+1 run_loop: sta pline sty pline+1 bit kbdcr bmi Le8c3 clc adc #$03 bcc Le87a iny Le87a: ldx #$ff stx run_flag txs sta pverb sty pverb+1 Le883: jsr execute_stmt bit run_flag bpl end_stmt clc ldy #$00 lda pline adc (pline),y ldy pline+1 bcc Le896 iny Le896: cmp himem bne run_loop cpy himem+1 bne run_loop ldy #erri_end lsr run_flag go_errmess_4: jmp do_error return_stmt: ldy #$4a lda gosub_nest_count beq go_errmess_4 dec gosub_nest_count tay lda gstk_plinel-1,y sta pline lda gstk_plineh-1,y sta pline+1 fcb $be ; ldx synpag+1,y, but force absolute addressing mode fdb synpag+1 lda gstk_pverbh-1,y Le8be: tay txa jmp Le87a Le8c3: ldy #$63 jsr Se3c4 ldy #$01 lda (pline),y tax iny lda (pline),y jsr prdec end_stmt: jmp warm Le8d6: dec for_nest_count next_stmt: ldy #erri_bad_next lda for_nest_count Le8dc: beq go_errmess_4 tay lda noun_stk_l,x cmp fstk_varl-1,y bne Le8d6 lda noun_stk_h_str,x cmp fstk_varh-1,y bne Le8d6 lda fstk_stepl-1,y sta aux lda fstk_steph-1,y sta aux+1 jsr get16bit dex jsr Se793 jsr var_assign dex ldy for_nest_count lda fstk_toh-1,y sta syn_stk_l+31,x lda fstk_tol-1,y ldy #$00 jsr push_ya_noun_stk jsr subtract_op jsr sgn_fn jsr get16bit ldy for_nest_count lda acc beq Le925 eor fstk_steph-1,y bpl Le937 Le925: lda fstk_plinel-1,y sta pline lda fstk_plineh-1,y sta pline+1 ldx fstk_pverbl-1,y lda fstk_pverbh-1,y bne Le8be Le937: dec for_nest_count rts for_stmt: ldy #erri_too_many_fors lda for_nest_count cmp #$08 beq Le8dc inc for_nest_count tay lda noun_stk_l,x sta fstk_varl,y lda noun_stk_h_str,x sta fstk_varh,y rts to_clause: jsr get16bit ldy for_nest_count lda acc sta fstk_tol-1,y lda acc+1 sta fstk_toh-1,y lda #$01 sta fstk_stepl-1,y lda #$00 Le966: sta fstk_steph-1,y lda pline sta fstk_plinel-1,y lda pline+1 sta fstk_plineh-1,y lda pverb sta fstk_pverbl-1,y lda pverb+1 sta fstk_pverbh-1,y rts step_clause: jsr get16bit ldy for_nest_count lda acc sta fstk_stepl-1,y lda acc+1 jmp Le966 fcb $00,$00,$00,$00,$00,$00,$00,$00 fcb $00,$00,$00 verb_prec_tbl: rmb $78 verb_addr_l: rmb $78 verb_addr_h: rmb $78 verb $00,$00,begin_line verb $01,$00,$ffff verb $02,$00,$ffff verb $03,$ab,colon verb $04,$03,list_cmd verb $05,$03,list_comman verb $06,$03,list_all verb $07,$03,run_cmd_w_lno ; RUN w/ line # verb $08,$03,run_cmd ; RUN w/o line # verb $09,$03,del_cmd ; DEL verb $0a,$03,del_comma ; comma used with DEL verb $0b,$03,new_cmd ; SCR (New) verb $0c,$03,clr_cmd ; CLR verb $0d,$03,auto_cmd ; AUTO verb $0e,$03,auto_comma ; comma used with AUTO verb $0f,$03,man_cmd ; MAN verb $10,$03,himem_cmd ; HIMEM: verb $11,$03,lomem_cmd ; LOMEM: verb $12,$3f,add_op ; + verb $13,$3f,subtract_op ; - verb $14,$c0,multiply_op ; * verb $15,$c0,divide_op ; / verb $16,$3c,eq_op ; = verb $17,$3c,neq_op ; # verb $18,$3c,gt_eq_op ; >= verb $19,$3c,gt_op ; > verb $1a,$3c,lt_eq_op ; <= verb $1b,$3c,neq_op ; <> verb $1c,$3c,lt_op ; < verb $1d,$30,and_op ; AND verb $1e,$0f,or_op ; OR verb $1f,$c0,mod_op ; MOD verb $20,$cc,$0000 verb $21,$ff,$ffff verb $22,$55,left_paren ; ( used in string DIM verb $23,$00,comma_substr ; , verb $24,$ab,goto_stmt ; THEN followed by a line number verb $25,$ab,null_stmt ; THEN followed by a statement verb $26,$03,string_input ; , used in string INPUT verb $27,$03,input_num_comma ; , used in numeric input verb $28,$ff,$ffff verb $29,$ff,$ffff verb $2a,$55,paren_substr ; ( substring verb $2b,$ff,$ffff verb $2c,$ff,$ffff verb $2d,$55,num_array_subs ; ( variable array subscript verb $2e,$cf,peek_fn ; PEEK verb $2f,$cf,rnd_fn ; RND verb $30,$cf,sgn_fn ; SGN verb $31,$cf,abs_fn ; ABS verb $32,$cf,$0000 ; USR verb $33,$ff,$ffff verb $34,$55,left_paren ; ( used in variable DIM verb $35,$c3,unary_pos ; unary + verb $36,$c3,negate ; unary - verb $37,$c3,not_op ; NOT verb $38,$55,left_paren ; ( numeric verb $39,$f0,string_eq ; = string verb $3a,$f0,string_neq ; # string verb $3b,$cf,len_fn ; LEN( verb $3c,$56,asc_fn ; ASC( XXX doesnt' work verb $3d,$56,scrn_fn ; SCRN( ??? verb $3e,$56,scrn_comma ; , used in SCRN verb $3f,$55,left_paren ; ( verb $40,$ff,$ffff verb $41,$ff,$ffff verb $42,$55,str_arr_dest ; ( for string index on left side of assignment verb $43,$03,dim_str ; , for DIM string var verb $44,$03,dim_num ; , for DIM numeric var verb $45,$03,print_str ; ; string PRINT verb $46,$03,print_num ; ; numeric PRINT verb $47,$03,print_semi ; ; end of PRINT verb $48,$03,print_str_comma ; , string PRINT verb $49,$03,print_com_num ; , numeric PRINT verb $4a,$ff,$ffff verb $4b,$ff,$ffff verb $4c,$ff,$ffff verb $4d,$03,call_stmt ; CALL verb $4e,$03,dim_str ; DIM string var verb $4f,$03,dim_num ; DIM numeric var verb $50,$03,tab_fn ; TAB verb $51,$03,end_stmt ; END verb $52,$03,string_input ; INPUT string with no prompt verb $53,$03,input_prompt ; INPUT prompt verb $54,$03,input_num_stmt ; INPUT numeric verb $55,$03,for_stmt ; FOR verb $56,$03,var_assign ; = in FOR verb $57,$03,to_clause ; TO verb $58,$03,step_clause ; STEP verb $59,$03,next_stmt ; NEXT verb $5a,$03,next_stmt ; , verb $5b,$03,return_stmt ; RETURN verb $5c,$03,gosub_stmt ; GOSUB verb $5d,$00,$ffff ; REM verb $5e,$ab,null_stmt ; LET verb $5f,$03,goto_stmt ; GOTO verb $60,$57,if_stmt ; IF verb $61,$03,print_str ; PRINT string verb $62,$03,print_num ; PRINT numeric verb $63,$03,print_cr ; PRINT w/o arg verb $64,$03,poke_stmt ; POKE verb $65,$07,poke_comma ; , in POKE verb $66,$03,color_stmt ; COLOR= ??? verb $67,$03,$ef00 ; PLOT ??? verb $68,$03,$ee3e ; , in PLOT ??? verb $69,$03,$ef00 ; HLIN ??? verb $6a,$03,$eea6 ; , in HLIN ??? verb $6b,$03,$eeb0 ; AT in HLIN ??? verb $6c,$03,$ef00 ; VLIN ??? verb $6d,$03,$eebc ; , in VLIN ??? verb $6e,$03,$eec6 ; AT in VLIN ??? verb $6f,$03,$ee57 ; VTAB ??? verb $70,$03,string_lit ; = string assginment verb $71,$03,var_assign ; = numeric assignment verb $72,$aa,right_paren ; ) verb $73,$ff,$ffff verb $74,$ff,$ffff verb $75,$ff,$ffff verb $76,$ff,$ffff verb $77,$ff,$ffff error_msg_tbl equ * erri_gr_32767 equ *-error_msg_tbl errstr ">32767" erri_too_long equ *-error_msg_tbl errstr "TOO LONG" erri_syntax equ *-error_msg_tbl errstr "SYNTAX" erri_mem_full equ *-error_msg_tbl errstr "MEM FULL" erri_too_many_parens equ *-error_msg_tbl errstr "TOO MANY PARENS" erri_string equ *-error_msg_tbl errstr "STRING" erri_no_end equ *-error_msg_tbl fcs "NO " erri_end equ *-error_msg_tbl errstr "END" erri_bad_branch equ *-error_msg_tbl errstr "BAD BRANCH" erri_too_many_gosubs equ *-error_msg_tbl errstr ">8 GOSUBS" erri_bad_return equ *-error_msg_tbl errstr "BAD RETURN" erri_too_many_fors equ *-error_msg_tbl errstr ">8 FORS" erri_bad_next equ *-error_msg_tbl errstr "BAD NEXT" erri_stopped_at equ *-error_msg_tbl errstr "STOPPED AT " erri_err equ *-error_msg_tbl errstr "*** " fcs " ERR" fcb ch_cr erri_gr_255 equ *-error_msg_tbl errstr ">255" erri_range equ *-error_msg_tbl errstr "RANGE" erri_dim equ *-error_msg_tbl errstr "DIM" erri_str_ovfl equ *-error_msg_tbl errstr "STR OVFL" fcb $dc ; backslash fcb ch_cr erri_retype_line equ *-error_msg_tbl fcs "RETYPE LINE" fcb ch_cr+$80,'?' Leb9a: lsr run_flag bcc Leba1 jmp Le8c3 Leba1: ldx acc+1 txs ldx acc ldy #$8d bne Lebac input_num_stmt: ldy #$99 Lebac: jsr Se3c4 stx acc tsx stx acc+1 ldy #$fe sty run_flag iny sty text_index jsr Se299 sty token_index ldx #$20 lda #$30 jsr Se491 inc run_flag ldx acc input_num_comma: ldy text_index asl a Lebce: sta acc iny lda buffer,y cmp #$74 beq input_num_stmt eor #$b0 cmp #$0a bcs Lebce iny iny sty text_index lda buffer,y pha lda buffer-1,y ldy #$00 jsr push_ya_noun_stk pla sta noun_stk_h_int,x lda acc cmp #$c7 bne Lebfa jsr negate Lebfa: jmp var_assign fcb $ff,$ff,$ff,$50 lt_op: jsr gt_eq_op bne Lec1b gt_op: jsr lt_eq_op bne Lec1b lt_eq_op: jsr subtract_op jsr negate bvc Lec16 gt_eq_op: jsr subtract_op Lec16: jsr sgn_fn lsr noun_stk_l,x Lec1b: jmp not_op fcb $ff,$ff category_table: fcb ((syn_cat_00-1)/2)&$ff fcb $ff fcb ((syn_cat_02-1)/2)&$ff fcb $d1 ; $03 fcb ((syn_cat_04-1)/2)&$ff fcb ((syn_cat_05-1)/2)&$ff fcb ((syn_cat_06-1)/2)&$ff fcb ((syn_cat_07-1)/2)&$ff ; numeric expressoin fcb ((syn_cat_08-1)/2)&$ff fcb ((syn_cat_09-1)/2)&$ff fcb ((syn_cat_0a-1)/2)&$ff fcb ((syn_cat_0b-1)/2)&$ff ; statement fcb ((syn_cat_0c-1)/2)&$ff fcb ((syn_cat_0d-1)/2)&$ff fcb ((syn_cat_0e-1)/2)&$ff fcb ((syn_cat_0f-1)/2)&$ff fcb ((syn_cat_10-1)/2)&$ff fcb ((syn_cat_11-1)/2)&$ff fcb ((syn_cat_12-1)/2)&$ff fcb $2b ; $13 fcb ((syn_cat_14-1)/2)&$ff ; function fcb ((syn_cat_15-1)/2)&$ff fcb ((syn_cat_16-1)/2)&$ff fcb ((syn_cat_17-1)/2)&$ff fcb $35 ; $18 fcb $8e ; $19: numeric variable name fcb ((syn_cat_1a-1)/2)&$ff fcb $ff fcb $ff fcb $ff fcb ((syn_cat_1e-1)/2)&$ff ; binary operator fcb ((syn_cat_1f-1)/2)&$ff and_op: jsr Sefc9 ora rnd+1,x bpl Lec4c or_op: jsr Sefc9 and rnd+1,x Lec4c: sta noun_stk_l,x bpl Lec1b jmp Sefc9 ; syntax tables fcb $40 ; cat 00, end of category fcb $60 ; unsigned integer, end of rule synstr "-" syn_cat_13: fcb $60 ; cat 00, end of rule synstr "+" fcb $00 fcb $7e ; branch "backward" two bytes synstr "," fcb $33 syn_cat_12: fcb $00 fcb $00 fcb $60 ; cat 00, end of rule fcb $03 ; string literal synstr "_" fcb $12 fcb $00 ; return with syntax error fcb $40 synstr ")" syn_cat_11: synstr1 ")" fcb $47 synstr "=" fcb $17 syn_cat_18: fcb $68 synstr "=" fcb $0a fcb $00 ; return with syntax error fcb $40 fcb $60 synstr "-" fcb $60 synstr "+" fcb $00 ; return with syntax error fcb $7e ; branch "backward" two bytes synstr "," fcb $3c fcb $00 fcb $00 ; return with syntax error fcb $60 fcb $03 ; string literal synstr "_" fcb $1b fcb $4b fcb $67 ; numeric expression, end of rule synstr "AT" fcb $07 ; numeric expression synstr "," fcb $07 ; numeric expression synstr "HLIN" fcb $67 ; numeric expression, end of rule synstr "," fcb $07 ; numeric expression synstr "PLOT" fcb $67 ; numeric expression, end of rule synstr "COLOR=" fcb $67 ; numeric expression, end of rule synstr "," fcb $07 ; numeric expression synstr "POKE" synstr1 "PRINT" fcb $7f ; branch "backward" one byte fcb $0e fcb $27 synstr "PRINT" fcb $7f ; branch "backward" one byte fcb $0e fcb $28 synstr "PRINT" fcb $64 fcb $07 ; numeric expressoin synstr "IF" fcb $67 synstr "GOTO" fcb $78 synstr "LET" fcb $78 ; end of rule fcb $7f ; branch "backward" one byte fcb $02 ; comment characte synstr "REM" syn_cat_1a: fcb $67 ; numeric expression, end of rule synstr "GOSUB" synstr1 "RETURN" fcb $7e ; branch "backward" two bytes synstr "," fcb $39 synstr "NEXT" fcb $67 ; numeric expression, end of rule synstr "STEP" fcb $27 ; numeric expression, rest optional synstr "TO" fcb $07 ; numeric expression synstr "=" fcb $19 synstr "FOR" fcb $7f ; branch "backward" one byte fcb $05 fcb $37 synstr "INPUT" fcb $7f ; branch "backward" one byte fcb $05 fcb $28 synstr "INPUT" fcb $7f ; branch "backward" one byte fcb $05 fcb $2a synstr "INPUT" synstr1 "END" syn_cat_02: fcb $00 fcb $ff fcb $ff fcb $47 ; numeric expression, end of category synstr "TAB" fcb $7f ; branch "backward" one byte fcb $0d fcb $30 synstr "DIM" fcb $7f ; branch "backward" one byte fcb $0d ; category 0d, required fcb $23 ; category 03, optional synstr "DIM" fcb $67 ; numeric expression, end of rule synstr "CALL" syn_cat_0b: fcb $00 fcb $40 ; unsigned integer, end of category fcb $80 ; letter A-Z syn_cat_19: fcb $c0 fcb $c1 fcb $80 fcb $00 fcb $47 ; numeric expression, end of category synstr "," fcb $68 synstr "," fcb $db fcb $67 ; numeric expression, end of rule synstr ";" fcb $68 synstr ";" syn_cat_0e: fcb $50 synstr "," fcb $63 synstr "," syn_cat_0d: fcb $7f ; branch "backward" one byte fcb $01 ; return with no error syn_cat_0c: fcb $51 fcb $07 ; numeric expression fcb $88 syn_cat_0a: fcb $29 fcb $84 fcb $80 fcb $c4 syn_cat_09: fcb $80 fcb $57 fcb $71 fcb $07 ; numeric expression synstr "(" fcb $14 synstr1 "LOMEM" synstr1 "HIMEM" synstr1 "COLOR" fcb $71 fcb $08 synstr "LEN(" fcb $68 fcb $83 fcb $08 fcb $68 synstr "=" fcb $08 fcb $71 ; cat 11, end of rule fcb $07 ; numeric expression synstr "(" syn_cat_16: fcb $60 ; cat 00, end of rule fcb $76 ; cat 16, end of rule synstr "NOT" fcb $76 ; cat 16, end of rule synstr "-" fcb $76 ; cat 16, end of rule synstr "+" syn_cat_15: fcb $51 fcb $07 synstr "(" fcb $19 syn_cat_10: synstr "RNDX" ; can never be matched since it ; comes "after" RND synstr1 "USR" synstr1 "ABS" synstr1 "SGN" synstr1 "RND" synstr1 "PEEK" syn_cat_14: fcb $51 fcb $07 ; numeric expression synstr "(" syn_cat_17: fcb $39 synstr "!" syn_cat_0f: fcb $c1 ; parse 0-9, end of rule fcb $4f ; cat 15, end of category fcb $7f ; branch "backward" one byte fcb $0f ; cat 15 syn_cat_00: fcb $2f ; cat 15 fcb $00 fcb $51 fcb $06 synstr "(" fcb $29 fcb $c2 fcb $0c syn_cat_08: synstr "\"" fcb $57 synstr "," fcb $6a syn_cat_05: synstr "," fcb $42 synstr "THEN" fcb $60 synstr "THEN" syn_cat_04: fcb $4f fcb $7e ; branch "backward" two bytes fcb $1e syn_cat_07: fcb $35 synstr "," syn_cat_06: fcb $27 ; optional reset, numeric expr fcb $51 fcb $07 ; numeric expr synstr "(" fcb $09 synstr "+" syn_cat_03: synstr1 "^" synstr1 "MOD" synstr1 "OR" synstr1 "AND" synstr1 "<" synstr1 "<>" synstr1 "<=" synstr1 ">" synstr1 ">=" synstr1 "#" synstr1 "=" synstr1 "/" synstr1 "*" synstr1 "-" synstr1 "+" syn_cat_1e: fcb $00 fcb $47 synstr "LOMEM=" fcb $76 synstr "HIMEM=" synstr1 "OFF" fcb $60 ; unsigned integer, end of rule synstr "," fcb $20 ; (optional) unsigned integer synstr "AUTO" synstr1 "CLR" synstr1 "SCR" fcb $60 ; unsgined integer, end of rule synstr "," fcb $20 ; (optional) unsigned integer synstr "DEL" synstr1 "RUN" ; RUN with no line number fcb $60 ; unsigned integer, end of rule synstr "RUN" synstr1 "LIST" fcb $60 ; unsigned integer, end of rule synstr "," fcb $20 ; (optional) unsigned integer synstr "LIST" fcb $7a fcb $7e ; branch "backward" two bytes fcb $9a fcb $22 fcb $20 ; (optional) unsigned integer syn_cat_1f: fcb $00 fcb $60 fcb $03 ; string literal fcb $bf fcb $60 fcb $03 fcb $bf fcb $1f print_str_comma: jsr tabout print_str: inx inx lda rnd+1,x sta aux lda syn_stk_h+31,x sta aux+1 ldy rnd,x Lee0f: tya cmp syn_stk_h+30,x bcs Lee1d lda (aux),y jsr cout iny jmp Lee0f Lee1d: lda #$ff sta cr_flag rts len_fn: inx lda #$00 sta noun_stk_h_str,x sta noun_stk_h_int,x lda syn_stk_h+31,x sec sbc rnd+1,x sta noun_stk_l,x jmp left_paren fcb $ff getbyte: jsr get16bit lda acc+1 bne gr_255_err lda acc rts plot_comma: jsr getbyte ldy text_index cmp #$30 bcs range_err cpy #$28 bcs range_err rts nop nop ; COLOR= statement not usable on Apple 1 color_stmt: jsr getbyte rts nop nop man_cmd: lsr auto_flag rts vtab_stmt: jsr getbyte cmp #$18 bcs range_err sta cv rts nop nop gr_255_err: ldy #erri_gr_255 go_errmess_5: jmp do_error range_err: ldy #erri_range bne go_errmess_5 See6c: jsr Se254 lda aux bne Lee7a lda aux+1 bne Lee7a jmp Le77e Lee7a: asl acc rol acc+1 rol p3 rol p3+1 lda p3 cmp aux lda p3+1 sbc aux+1 bcc Lee96 sta p3+1 lda p3 sbc aux sta p3 inc acc Lee96: dey bne Lee7a rts fcb $ff,$ff,$ff,$ff,$ff,$ff call_stmt: jsr get16bit jmp (acc) fcb $20,$34,$ee,$c5,$c8,$90,$bb,$85 ; SCRN function not usable on Apple 1 scrn_fn: lda himem+1 Teeb0: pha lda himem jsr push_ya_noun_stk pla sta noun_stk_h_int,x rts scrn_comma: lda lomem+1 Teebc: pha lda lomem jmp Lefb3 ; bogus code, ASC function doesn't work asc_fn: fcb $a5,$85,$2d,$60 Teec6: jsr getbyte cmp #$28 Leecb: bcs range_err tay lda text_index rts nop nop print_err_msg: tya tax ldy #$6e jsr Se3c4 txa tay jsr Se3c4 ldy #$72 jmp Se3c4 Seee4: jsr get16bit Leee7: asl acc rol acc+1 bmi Leee7 bcs Leecb bne Leef5 cmp acc bcs Leecb Leef5: rts peek_fn: jsr get16bit lda (acc),y sty syn_stk_l+31,x jmp push_ya_noun_stk poke_stmt: jsr getbyte lda acc pha jsr get16bit pla sta (acc),y poke_comma: rts fcb $ff,$ff,$ff divide_op: jsr See6c lda acc sta p3 lda acc+1 sta p3+1 jmp Le244 dim_num: jsr Seee4 jmp Le134 num_array_subs: jsr Seee4 ldy noun_stk_h_str,x lda noun_stk_l,x adc #$fe bcs Lef30 dey Lef30: sta aux sty aux+1 clc adc acc sta noun_stk_l,x tya adc acc+1 sta noun_stk_h_str,x ldy #$00 lda noun_stk_l,x cmp (aux),y iny lda noun_stk_h_str,x sbc (aux),y bcs Leecb jmp left_paren rnd_fn: jsr get16bit lda rnd jsr push_ya_noun_stk lda rnd+1 bne Lef5e cmp rnd adc #$00 Lef5e: and #$7f sta rnd+1 sta noun_stk_h_int,x ldy #$11 Lef66: lda rnd+1 asl clc adc #$40 asl rol rnd rol rnd+1 dey bne Lef66 lda acc jsr push_ya_noun_stk lda acc+1 sta noun_stk_h_int,x jmp mod_op himem_cmd: jsr get16bit ldy acc cpy lomem lda acc+1 sbc lomem+1 bcc Lefab sty himem lda acc+1 sta himem+1 Lef93: jmp new_cmd lomem_cmd: jsr get16bit ldy acc cpy himem lda acc+1 sbc himem+1 bcs Lefab sty lomem lda acc+1 sta lomem+1 bcc Lef93 Lefab: jmp Leecb fcb $a5,$4d,$48,$a5,$4c Lefb3: jsr Sefc9 string_input: jsr input_str jmp Lefbf input_prompt: jsr print_str Lefbf: lda #$ff sta text_index lda #$74 sta buffer rts Sefc9: jsr not_op inx Sefcd: jsr not_op lda noun_stk_l,x rts mem_init_4k: lda #$00 sta lomem sta himem lda #$08 sta lomem+1 lda #$10 sta himem+1 jmp new_cmd Sefe4: cmp noun_stk_h_str,x bne Lefe9 clc Lefe9: jmp Le102 run_cmd: jsr clr_cmd jmp run_warm run_cmd_w_lno: jsr clr_cmd jmp goto_stmt Seff8: cpx #$80 bne Leffd dey Leffd: jmp Se00c