Skip to content

Instantly share code, notes, and snippets.

/d64.lis

Created July 30, 2014 14:14
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save anonymous/4b85bd8069a2bfaaea9f to your computer and use it in GitHub Desktop.
Save anonymous/4b85bd8069a2bfaaea9f to your computer and use it in GitHub Desktop.
Download ZIP
Raw
d64.lis
8000 org $8000 ; reset
8000 7EBB3C call_HWINIT jmp HWINIT ; reset
8003 7EBB88 call_SWINIT jmp SWINIT ; set up $8f - $9b
8006 7EBBE5 POLCAT jmp INCH ; scan keyboard (A)
8009 7EBBB5 call_CBLINK jmp CBLINK ; blink cursor
800C 7EBCAB CHROUT jmp OUTCH ; write to VDU (A)
800F 7EBD1A call_LPOUT jmp LPOUT ; write to printer (A)
8012 7EBD52 call_JOYIN jmp JOYIN ; update joysticks
8015 7EBDCF call_CASON jmp CASON ; motoron
8018 7EBDDC call_CASOFF jmp CASOFF ; motoroff
801B 7EBE68 call_WRTLDR jmp WRTLDR ; write leader
801E 7EBE12 call_CBOUT jmp CBOUT ; byte out (A)
8021 7EBDE7 call_CSRDON jmp CSRDON ; read leader
8024 7EBDAD call_CBIN jmp CBIN ; byte in (A)
8027 7EBDA5 call_BITIN jmp BITIN ; bit in (C)
802A 7EBE7B call_SERIN jmp SERIN ; read serial (A)
802D 7EBE98 call_SEROUT jmp SEROUT ; write serial (A)
8030 7EBEA6 call_SERSET jmp SERSET ; baud rate select
8033 464FD247CF5245CDA7454C53C549C6444154C15052494ED44FCE494E5055D445 reserved_words fcc /FO/,$d2,/G/,$cf,/RE/,$cd,$a7,/ELS/,$c5,/I/,$c6,/DAT/,$c1,/PRIN/,$d4,/O/,$ce,/INPU/,$d4,/E/ ; FOR 80
8053 4EC44E4558D44449CD524541C44C45D45255CE524553544F52C55245545552CE fcc /N/,$c4,/NEX/,$d4,/DI/,$cd,/REA/,$c4,/LE/,$d4,/RU/,$ce,/RESTOR/,$c5,/RETUR/,$ce
8073 53544FD0504F4BC5434F4ED44C4953D4434C4541D24E45D74445C6434C4F41C4 fcc /STO/,$d0,/POK/,$c5,/CON/,$d4,/LIS/,$d4,/CLEA/,$d2,/NE/,$d7,/DE/,$c6,/CLOA/,$c4 ; STOP 92
8093 43534156C54F5045CE434C4F53C54C4C4953D45345D452455345D4434CD34D4F fcc /CSAV/,$c5,/OPE/,$ce,/CLOS/,$c5,/LLIS/,$d4,/SE/,$d4,/RESE/,$d4,/CL/,$d3,/MO/ ; CSAVE 9A
80B3 544FD2534F554EC441554449CF455845C3534B4950C64445CC454449D454524F fcc /TO/,$d2,/SOUN/,$c4,/AUDI/,$cf,/EXE/,$c3,/SKIP/,$c6,/DE/,$cc,/EDI/,$d4,/TRO/
80D3 CE54524F46C64C494EC550434CD3505345D45052455345D45343524545CE5043 fcc $ce,/TROF/,$c6,/LIN/,$c5,/PCL/,$d3,/PSE/,$d4,/PRESE/,$d4,/SCREE/,$ce,/PC/
80F3 4C4541D2434F4C4FD2434952434CC55041494ED44745D45055D4445241D75043 fcc /LEA/,$d2,/COLO/,$d2,/CIRCL/,$c5,/PAIN/,$d4,/GE/,$d4,/PU/,$d4,/DRA/,$d7,/PC/
8113 4F50D9504D4F44C5504C41D9444C4F41C452454E55CD544142A854CF5355C246 fcc /OP/,$d9,/PMOD/,$c5,/PLA/,$d9,/DLOA/,$c4,/RENU/,$cd,/TAB/,$a8,/T/,$cf,/SU/,$c2,/F/
8133 CE544845CE4E4FD4535445D04F46C6ABADAAAFDE414EC44FD2BEBDBC5553494E fcc $ce,/THE/,$ce,/NO/,$d4,/STE/,$d0,/OF/,$c6,$ab,$ad,$aa,$af,$de,/AN/,$c4,/O/,$d2,$be,$bd,$bc,/USIN/
8153 C7 fcc $c7
8154 844885B986168616861686478613903D8675872B853288298A8B877786BC85A5 reserved_dispatch fdb FOR_dispatch,GO_dispatch,REM_ELSE_dispatch,REM_ELSE_dispatch,REM_ELSE_dispatch,IF_dispatch,DATA_dispatch,PRINT_dispatch,ON_dispatch,INPUT_dispatch,END_dispatch,NEXT_dispatch,DIM_dispatch,READ_dispatch,LET_dispatch,RUN_dispatch ; for go rem '
8174 851485F385398E9D85608EAA857184159C81B6D4B682B828B64C8EA4B9D2BA03 fdb RESTORE_dispatch,RETURN_dispatch,STOP_dispatch,POKE_dispatch,CONT_dispatch,LIST_dispatch,CLEAR_dispatch,NEW_dispatch,DEF_dispatch,CLOAD_dispatch,CSAVE_dispatch,OPEN_dispatch,CLOSE_dispatch,LLIST_dispatch,SET_dispatch,RESET_dispatch ; restore return stop poke
8194 BA5FB981BA9ABADFB770B81E9D6199659AD99ADAA749A8C0A6EFA6F3A9FEAA19 fdb CLS_dispatch,MOTOR_dispatch,SOUND_dispatch,AUDIO_dispatch,EXEC_dispatch,SKIPF_dispatch,DEL_dispatch,EDIT_dispatch,TRON_dispatch,TROFF_dispatch,LINE_dispatch,PCLS_dispatch,PSET_dispatch,PRESET_dispatch,SCREEN_dispatch,PCLEAR_dispatch ; cls motor sound audio
81B4 A8D4B238AC87AAF0AAF3B051AABEA9AFADBDA0499DFA fdb COLOR_dispatch,CIRCLE_dispatch,PAINT_dispatch,GET_dispatch,PUT_dispatch,DRAW_dispatch,PCOPY_dispatch,PMODE_dispatch,PLAY_dispatch,DLOAD_dispatch,RENUM_dispatch ; color circle paint get
81CA 5347CE494ED44142D3504FD3524EC45351D24C4FC74558D05349CE434FD35441 function_words fcc /SG/,$ce,/IN/,$d4,/AB/,$d3,/PO/,$d3,/RN/,$c4,/SQ/,$d2,/LO/,$c7,/EX/,$d0,/SI/,$ce,/CO/,$d3,/TA/ ; SGN FF80
81EA CE4154CE504545CB4C45CE535452A45641CC4153C3434852A4454FC64A4F5953 fcc $ce,/AT/,$ce,/PEE/,$cb,/LE/,$ce,/STR/,$a4,/VA/,$cc,/AS/,$c3,/CHR/,$a4,/EO/,$c6,/JOYS/
820A 54CB4649D8484558A44C454654A45249474854A44D4944A4504F494ED4494E4B fcc /T/,$cb,/FI/,$d8,/HEX/,$a4,/LEFT/,$a4,/RIGHT/,$a4,/MID/,$a4,/POIN/,$d4,/INK/
822A 4559A44D45CD5641525054D2494E5354D254494D45D250504F494ED453545249 fcc /EY/,$a4,/ME/,$cd,/VARPT/,$d2,/INST/,$d2,/TIME/,$d2,/PPOIN/,$d4,/STRI/
824A 4E47A45553D2 fcc /NG/,$a4,/US/,$d2
8250 94259499943E9ADE97729697923C971397D197CB981698778E968DC78C408E5C function_dispatch fdb SGN_dispatch,INT_dispach,ABS_dispatch,POS_dispatch,RND_dispatch,SQR_dispatch,LOG_dispatch,EXP_dispatch,SIN_dispatch,COS_dispatch,TAN_dispatch,ATN_dispatch,PEEK_dispatch,LEN_dispatch,STRstr_dispatch,VAL_dispatch ; sgn int abs pos
8270 8DE68DD2B800BB0D9956A00E8DF18E0E8E15BA44B7968C319AF49BB49D59A6C7 fdb ASC_dispatch,CHRstr_dispatch,EOF_dispatch,JOYSTK_dispatch,FIX_dispatch,HEXstr_dispatch,LEFTstr_dispatch,RIGHTstr_dispatch,MIDstr_dispatch,POINT_dispatch,INKEYstr_dispatch,MEM_dispatch,VARPTR_dispatch,INSTR_dispatch,TIMER_dispatch,PPOINT_dispatch ; asc chr$ eof joystk
8290 9B849D1D fdb STRINGstr_dispatch,USR_dispatch ; string$ usr
8294 79 operator_dispatch fcb $79 ; +
8295 910E fdb oper_plus_dispatch
8297 79 fcb $79 ; -
8298 9105 fdb oper_minus_dispatch
829A 7B fcb $7b ; *
829B 9275 fdb oper_mul_dispatch
829D 7B fcb $7b ; /
829E 933C fdb oper_div_dispatch
82A0 7F fcb $7f ; ^
82A1 96A0 fdb oper_pow_dispatch
82A3 50 fcb $50 ; AND
82A4 8A12 fdb AND_dispatch
82A6 46 fcb $46 ; OR
82A7 8A11 fdb OR_dispatch
82A9 4E46534E52474F4446434F564F4D554C425344442F304944544D4F534C535354 errcode_table fcc /NFSNRGODFCOVOMULBSDD/,$2f,/0IDTMOSLSST/ ; * error code strings
82C9 434E55464644414F444E494F464D4E4F494544534E45 fcc /CNUFFDAODNIOFMNOIEDSNE/
82DF 204552524F5200 text_error fcc / ERROR/,$00 ; /ERROR /
82E6 20494E2000 text_in fcc / IN /,$00 ; / IN /
82EB 0D4F4B0D text_ok fcc $0d,/OK/,$0d ; CR/OK/CR
82EF 00 fcc $00
82F0 0D425245414B00 text_break fcc $0d,/BREAK/,$00 ; CR/BREAK/
82F7 3064 L_82F7 leax 4,s ; point X past 2 return addresses
82F9 C612 L_82F9 ldb #$12 ; size of FOR stack entry
82FB 9F0F stx <$0f ; $0f = this entry
82FD A684 lda ,x
82FF 8080 suba #$80
8301 2615 bne L_8318 ; not a FOR entry
8303 AE01 ldx 1,x
8305 9F11 stx <$11 ; varptr of control variable
8307 9E3B ldx <$3b
8309 2709 beq L_8314 ; we were called by NEXT with no variable
830B 9C11 cmpx <$11
830D 2709 beq L_8318 ; found a matching entry
830F 9E0F ldx <$0f
8311 3A abx ; point X to next stack entry
8312 20E5 bra L_82F9 ; examine next entry
8314 9E11 L_8314 ldx <$11 ; set $3b up with varptr of control variable
8316 9F3B stx <$3b ; for unspecified NEXT
8318 9E0F L_8318 ldx <$0f
831A 4D tsta
831B 39 rts
831C 8D17 L_831C bsr L_8335 ; memory check
831E DE41 L_831E ldu <$41
8320 3341 leau 1,u
8322 9E43 ldx <$43
8324 3001 leax 1,x
8326 A682 L_8326 lda ,-x
8328 3602 pshu a
832A 9C47 cmpx <$47
832C 26F8 bne L_8326
832E DF45 stu <$45
8330 39 L_8330 rts
8331 4F L_8331 clra ; * check if there are B free words of storage left
8332 58 lslb
8333 D31F addd <$1f ; end of BASIC storage
8335 C3003A L_8335 addd #$003a
8338 2508 bcs OM_error ; ?OM ERROR
833A 10DF17 sts <$17
833D 109317 cmpd <$17
8340 25EE bcs L_8330 ; RTS
8342 C60C OM_error ldb #$0c ; ?OM ERROR
8344 BD018E system_error jsr >$018e ; user error trap
8347 BD0191 jsr >$0191 ; system error trap
834A BD8018 jsr call_CASOFF ; cassette relay off
834D BDBAC3 jsr L_BAC3 ; disable audio
8350 BD8434 jsr reset_stack ; reset stack & bits & pieces
8353 0F6F clr <$6f ; DEVN
8355 BD90A5 jsr L_90A5 ; initialise virtual DEVN device & new line
8358 BD90F8 jsr L_90F8 ; print '?' to DEVN
835B 8E82A9 ldx #errcode_table ; error string table
835E 3A abx
835F 8D3D bsr L_839E ; output to DEVN from ,X+
8361 8D3B bsr L_839E ; output to DEVN from ,X+
8363 8E82DE ldx #text_error - 1 ; 'ERROR'
8366 BD90E5 L_8366 jsr out_string ; print string to DEVN
8369 9668 lda <$68 ; current line number
836B 4C inca
836C 2703 beq goto_ok_prompt ; command mode
836E BD9573 jsr L_9573 ; print 'IN xxxx' (current line number)
8371 BD90A5 goto_ok_prompt jsr L_90A5 ; initialise virtual DEVN device & new line
8374 8E82EB ldx #text_ok
8377 BD90E5 jsr out_string ; print 'OK'
837A BDB5C6 L_837A jsr L_B5C6 ; line input from DEVN
837D CEFFFF ldu #$ffff
8380 DF68 stu <$68 ; current line number
8382 25F6 bcs L_837A ; command mode without 'OK'
8384 0D70 tst <$70 ; eof flag
8386 10263373 lbne L_B6FD ; close file & return to command mode
838A 9FA6 stx <$a6 ; BASIC source pointer
838C 9D9F jsr <$9f ; get next character from BASIC source
838E 27EA beq L_837A ; command mode without 'OK'
8390 2511 bcs L_83A3 ; enter BASIC line
8392 C632 ldb #$32 ; ?DS ERROR
8394 0D6F tst <$6f ; DEVN
8396 26AC bne system_error ; cause error
8398 BD8F67 jsr L_8F67 ; tokenize BASIC line
839B 7E84D6 jmp L_84D6 ; enter interpreter loop
839E A680 L_839E lda ,x+ ; * used by error routine to print error code
83A0 7E90FA jmp L_90FA ; output character to DEVN
83A3 BD869A L_83A3 jsr L_869A ; read line number & store in $2b
83A6 9E2B L_83A6 ldx <$2b
83A8 BF02DA stx >$02da
83AB BD8F67 jsr L_8F67 ; tokenize BASIC line
83AE D703 stb <$03 ; line length
83B0 8D4D bsr basic_line_after_2b ; search program for line number in <$2b
83B2 2512 bcs L_83C6 ; line number doesn't exist
83B4 DC47 ldd <$47 ; address where line needs to go
83B6 A384 subd ,x ; subtract next line pointer (-ve result)
83B8 D31B addd <$1b ; start of simple variables
83BA DD1B std <$1b ; new end of program
83BC EE84 ldu ,x
83BE 3702 L_83BE pulu a ; move program down, erasing existing line
83C0 A780 sta ,x+
83C2 9C1B cmpx <$1b ; start of simple variables
83C4 26F8 bne L_83BE
83C6 B602DC L_83C6 lda >$02dc
83C9 271C beq L_83E7 ; new line is empty
83CB DC1B ldd <$1b ; start of simple variables
83CD DD43 std <$43
83CF DB03 addb <$03 ; new line length
83D1 8900 adca #$00
83D3 DD41 std <$41
83D5 BD831C jsr L_831C ; move memory contents up
83D8 CE02D8 ldu #$02d8
83DB 3702 L_83DB pulu a
83DD A780 sta ,x+ ; copy new line into space just created
83DF 9C45 cmpx <$45
83E1 26F8 bne L_83DB
83E3 9E41 ldx <$41
83E5 9F1B stx <$1b ; new end of program
83E7 8D36 L_83E7 bsr BasVect1 ; clear variables and reset stack & cmd ptr
83E9 8D02 bsr BasVect2 ; set up next line pointers in BASIC program
83EB 208D bra L_837A ; command mode without 'OK'
83ED 9E19 BasVect2 ldx <$19 ; start of BASIC program
83EF EC84 L_83EF ldd ,x
83F1 2721 beq L_8414 ; RTS
83F3 3304 leau 4,x
83F5 A6C0 L_83F5 lda ,u+
83F7 26FC bne L_83F5
83F9 EF84 stu ,x
83FB AE84 ldx ,x
83FD 20F0 bra L_83EF
83FF DC2B basic_line_after_2b ldd <$2b ; * search program for line number in <$2b
8401 9E19 ldx <$19 ; start of BASIC program
8403 EE84 L_8403 ldu ,x ; * (first line after if it doesn't exist - carry clear if found)
8405 2709 beq L_8410 ; end of program
8407 10A302 cmpd 2,x ; scan program until line no. is greater
840A 2306 bls L_8412 ; than D
840C AE84 ldx ,x ; next line
840E 20F3 bra L_8403
8410 1A01 L_8410 orcc #$01
8412 9F47 L_8412 stx <$47
8414 39 L_8414 rts
8415 26FB NEW_dispatch bne L_8412 ; * NEW
8417 9E19 erase_basic ldx <$19 ; start of BASIC program
8419 6F80 clr ,x+
841B 6F80 clr ,x+
841D 9F1B stx <$1b ; start of simple variables
841F 9E19 BasVect1 ldx <$19 ; start of BASIC program
8421 BD85EE jsr L_85EE ; subtract 1 from X & store in $a6
8424 BD0197 L_8424 jsr >$0197 ; PATCH - reset BASIC memory
8427 9E27 ldx <$27 ; top of BASIC RAM
8429 9F23 stx <$23 ; top of free string space
842B BD8514 jsr RESTORE_dispatch ; RESTORE
842E 9E1B ldx <$1b ; start of simple variables
8430 9F1D stx <$1d ; start of array variables
8432 9F1F stx <$1f ; end of BASIC storage
8434 8E01A9 reset_stack ldx #$01a9
8437 9F0B stx <$0b
8439 AEE4 ldx ,s
843B 10DE21 lds <$21 ; stack root / string storage start
843E 6FE2 clr ,-s
8440 0F2D clr <$2d ; CONT source address
8442 0F2E clr <$2e
8444 0F08 clr <$08
8446 6E84 jmp ,x
8448 8680 FOR_dispatch lda #$80 ; * 16,S address of statement after FOR
844A 9708 sta <$08 ; array illegal flag
844C BD86BC jsr LET_dispatch ; LET
844F BD82F7 jsr L_82F7 ; examine BASIC stack
8452 3262 leas 2,s ; lose return address
8454 2604 bne L_845A ; no FOR with same control variable already
8456 9E0F ldx <$0f
8458 3285 leas b,x ; overwrite duplicate FOR entry
845A C609 L_845A ldb #$09
845C BD8331 jsr L_8331 ; memory check
845F BD861B jsr L_861B ; find end of statement
8462 DC68 ldd <$68 ; current line number
8464 3416 pshs a,b,x ; push next statement ptr & current line no.
8466 C6BC ldb #$bc ; token TO
8468 BD89AC jsr CkChar ; skip character in B
846B BD8874 jsr L_8874 ; validate numeric expression
846E BD8872 jsr L_8872 ; read numeric expression into FPA1
8471 D654 ldb <$54
8473 CA7F orb #$7f ; convert FPA1 back to standard variable
8475 D450 andb <$50
8477 D750 stb <$50
8479 108E8480 ldy #jmp_8480
847D 7E891B jmp L_891B ; push FPA1 onto stack & JMP ,Y
8480 8E920E jmp_8480 ldx #data_920E ; FP constant 1
8483 BD93BF jsr MOVFM ; load variable into FPA1 (X is varptr)
8486 9DA5 jsr <$a5 ; get current character from BASIC source
8488 81C1 cmpa #$c1 ; token STEP
848A 2605 bne L_8491 ; no STEP value specified
848C 9D9F jsr <$9f ; get next character from BASIC source
848E BD8872 jsr L_8872 ; read numeric expression into FPA1
8491 BD9418 L_8491 jsr L_9418 ; sets B to -1, 0 or 1 as per sign of FPA1
8494 BD8917 jsr L_8917 ; push B then FPA1 onto stack
8497 DC3B ldd <$3b ; varptr of control variable
8499 3406 pshs a,b
849B 8680 lda #$80 ; FOR signature on stack
849D 3402 pshs a
849F BD019A run_basic jsr >$019a ; PATCH - get command
84A2 1CAF andcc #$af ; unmask interrupts
84A4 8D75 bsr scan_key ; scan for BREAK / pause
84A6 9EA6 ldx <$a6 ; BASIC source pointer
84A8 9F2F stx <$2f ; address of current BASIC statement
84AA A680 lda ,x+
84AC 2707 beq L_84B5 ; end of line
84AE 813A cmpa #$3a
84B0 2724 beq L_84D6
84B2 7E89B4 do_sn_error_84B2 jmp SN_error ; ?SN ERROR
84B5 A681 L_84B5 lda ,x++
84B7 9700 sta <$00 ; this will be zero when end reached
84B9 10270088 lbeq L_8545 ; end of program
84BD EC80 ldd ,x+
84BF DD68 std <$68 ; current line number
84C1 9FA6 stx <$a6 ; BASIC source pointer
84C3 96AF lda <$af ; trace flag
84C5 270F beq L_84D6 ; trace off
84C7 865B lda #$5b
84C9 BDB54A jsr OUTCHR ; output character to DEVN
84CC 9668 lda <$68 ; current line number
84CE BD957A jsr print_D ; print unsigned number in D
84D1 865D lda #$5d
84D3 BDB54A jsr OUTCHR ; output character to DEVN
84D6 9D9F L_84D6 jsr <$9f ; get next character from BASIC source
84D8 8D02 bsr L_84DC ; interpret statement
84DA 20C3 bra run_basic ; interpreter loop
84DC 273C L_84DC beq L_851A ; RTS
84DE BD0179 jsr >$0179 ; PATCH - interpreter
84E1 4D tsta
84E2 102A01D6 lbpl LET_dispatch ; variable on LHS (LET)
84E6 81BA cmpa #$ba
84E8 220B bhi L_84F5 ; not a BASIC command
84EA BE0123 ldx >$0123 ; command JMP table
84ED 48 lsla
84EE 1F89 tfr a,b
84F0 3A abx
84F1 9D9F jsr <$9f ; get next character from BASIC source
84F3 6E94 jmp [,x]
84F5 81FF L_84F5 cmpa #$ff
84F7 2708 beq L_8501 ; function
84F9 81CD cmpa #$cd
84FB 23B5 bls do_sn_error_84B2 ; ?SN ERROR
84FD 6E9F012D jmp [$012d] ; must be disk command
8501 9D9F L_8501 jsr <$9f ; get next character from BASIC source
8503 8198 cmpa #$98
8505 10271603 lbeq LET_MIDstr_handler ; MID$ on LHS
8509 819E cmpa #$9e
850B 10271842 lbeq LET_TIMER_handler ; TIMER on LHS
850F BD01A0 jsr >$01a0 ; PATCH - CLS GET PUT ???
8512 209E bra do_sn_error_84B2 ; ?SN ERROR
8514 9E19 RESTORE_dispatch ldx <$19 ; start of BASIC program
8516 301F leax -1,x
8518 9F33 L_8518 stx <$33 ; READ pointer
851A 39 L_851A rts
851B BD8006 scan_key jsr POLCAT ; scan keyboard
851E 270A beq L_852A
8520 8103 L_8520 cmpa #$03
8522 2715 beq STOP_dispatch ; BREAK
8524 8113 cmpa #$13
8526 2703 beq wait_key ; SHIFT + @
8528 9787 sta <$87
852A 39 L_852A rts
852B BD8006 wait_key jsr POLCAT ; scan keyboard
852E 27FB beq wait_key
8530 20EE bra L_8520
8532 BDB65C END_dispatch jsr L_B65C ; close cassette stream
8535 9DA5 jsr <$a5 ; get current character from BASIC source
8537 2002 bra L_853B
8539 1A01 STOP_dispatch orcc #$01 ; * STOP
853B 2633 L_853B bne L_8570 ; RTS
853D 9EA6 ldx <$a6 ; BASIC source pointer
853F 9F2F stx <$2f ; address of current BASIC statement
8541 0600 L_8541 ror <$00 ; make -ve for STOP
8543 3262 leas 2,s ; lose return address
8545 9E68 L_8545 ldx <$68 ; current line number
8547 8CFFFF cmpx #$ffff
854A 2706 beq L_8552 ; already in command mode
854C 9F29 stx <$29 ; CONT line number
854E 9E2F ldx <$2f ; address of current BASIC statement
8550 9F2D stx <$2d ; CONT source address
8552 0F6F L_8552 clr <$6f ; DEVN
8554 8E82EF ldx #text_break - 1 ; /BREAK/
8557 0D00 tst <$00
8559 102AFE14 lbpl goto_ok_prompt ; command mode
855D 7E8366 jmp L_8366 ; print BREAK message
8560 260E CONT_dispatch bne L_8570 ; RTS
8562 C620 ldb #$20 ; ?CN ERROR
8564 9E2D ldx <$2d ; CONT source address
8566 1027FDDA lbeq system_error ; cause error
856A 9FA6 stx <$a6 ; BASIC source pointer
856C 9E29 ldx <$29 ; CONT line number
856E 9F68 stx <$68 ; current line number
8570 39 L_8570 rts
8571 272C CLEAR_dispatch beq L_859F ; clear variables & reset stack
8573 BD8B23 jsr L_8B23 ; read unsigned number into $52 & D
8576 3406 pshs a,b
8578 9E27 ldx <$27 ; top of BASIC RAM
857A 9DA5 jsr <$a5 ; get current character from BASIC source
857C 270C beq L_858A
857E BD89AA jsr CkComa ; skip comma
8581 BD8E83 jsr Get16Bit ; read 16 bit number into X
8584 301F leax -1,x
8586 9C74 cmpx <$74 ; top of RAM
8588 2218 bhi do_om_error_85A2 ; ?OM ERROR
858A 1F10 L_858A tfr x,d
858C A3E1 subd ,s++
858E 2512 bcs do_om_error_85A2 ; ?OM ERROR
8590 1F03 tfr d,u
8592 83003A subd #$003a
8595 250B bcs do_om_error_85A2 ; ?OM ERROR
8597 931B subd <$1b ; start of simple variables
8599 2507 bcs do_om_error_85A2 ; ?OM ERROR
859B DF21 stu <$21 ; new stack address
859D 9F27 stx <$27 ; new top of BASIC RAM
859F 7E8424 L_859F jmp L_8424 ; clear variables & reset stack
85A2 7E8342 do_om_error_85A2 jmp OM_error ; ?OM ERROR
85A5 BD0194 RUN_dispatch jsr >$0194 ; PATCH - run
85A8 BD98E3 jsr L_98E3 ; set up sound & graphics variables
85AB BDB65C jsr L_B65C ; close cassette stream
85AE 9DA5 jsr <$a5 ; get current character from BASIC source
85B0 1027FE6B lbeq BasVect1 ; clear variables and reset stack & cmd ptr
85B4 BD8424 jsr L_8424 ; clear variables & reset stack
85B7 2019 bra L_85D2 ; perform GOTO
85B9 1F89 GO_dispatch tfr a,b ; * 3,S address of GOSUB statement (points to SUB token)
85BB 9D9F L_85BB jsr <$9f ; get next character from BASIC source
85BD C1BC cmpb #$bc ; token TO
85BF 2716 beq GOTO_handoff ; perform GOTO
85C1 C1BD cmpb #$bd ; token SUB
85C3 2645 bne do_sn_error_860A ; ?SN ERROR
85C5 C603 GOSUB_handoff ldb #$03
85C7 BD8331 jsr L_8331 ; memory check
85CA DEA6 ldu <$a6 ; BASIC source pointer
85CC 9E68 ldx <$68 ; current line number
85CE 86BD lda #$bd ; token SUB
85D0 3452 pshs a,x,u
85D2 8D03 L_85D2 bsr GOTO_handoff ; perform GOTO
85D4 7E849F jmp run_basic ; interpreter loop
85D7 9DA5 GOTO_handoff jsr <$a5 ; get current character from BASIC source
85D9 BD869A jsr L_869A ; read line number & store in $2b
85DC 8D40 bsr L_861E ; find end of line
85DE 3001 leax 1,x
85E0 DC2B ldd <$2b
85E2 109368 cmpd <$68 ; current line number
85E5 2202 bhi L_85E9
85E7 9E19 ldx <$19 ; start of BASIC program
85E9 BD8403 L_85E9 jsr L_8403 ; scan for line D
85EC 2517 bcs UL_error ; ?UL ERROR
85EE 301F L_85EE leax -1,x
85F0 9FA6 stx <$a6 ; BASIC source pointer
85F2 39 L_85F2 rts
85F3 26FD RETURN_dispatch bne L_85F2 ; RTS
85F5 86FF lda #$ff
85F7 973B sta <$3b ; set $3b to skip all FOR entries
85F9 BD82F7 jsr L_82F7 ; examine BASIC stack
85FC 1F14 tfr x,s ; point stack to this entry
85FE 813D cmpa #$3d
8600 270B beq L_860D ; GOSUB signature (#$BD - #$80)
8602 C604 RG_error ldb #$04 ; ?RG ERROR
8604 8C fcb $8c ; cmpx #$c60e - comment byte
8605 C60E UL_error ldb #$0e ; usually skipped by comment byte
8607 7E8344 jmp system_error ; cause error
860A 7E89B4 do_sn_error_860A jmp SN_error ; ?SN ERROR
860D 3552 L_860D puls a,x,u
860F 9F68 stx <$68 ; current line number
8611 DFA6 stu <$a6 ; BASIC source pointer
8613 8D06 DATA_dispatch bsr L_861B ; find end of statement
8615 8C fcb $8c ; cmpx #$8d06 - comment byte
8616 8D06 REM_ELSE_dispatch bsr L_861E ; usually skipped by comment byte
8618 9FA6 stx <$a6 ; BASIC source pointer
861A 39 L_861A rts
861B C63A L_861B ldb #$3a ; * find end of statement
861D 86 fcb $86 ; lda #$5f - comment byte
861E 5F L_861E clrb ; usually skipped by comment byte
861F D701 stb <$01 ; * (861E 5F CLRB)
8621 5F clrb
8622 9EA6 ldx <$a6 ; BASIC source pointer
8624 1F98 L_8624 tfr b,a
8626 D601 ldb <$01
8628 9701 sta <$01
862A A684 L_862A lda ,x
862C 27EC beq L_861A ; RTS
862E 3404 pshs b
8630 A1E0 cmpa ,s+
8632 27E6 beq L_861A ; RTS
8634 3001 leax 1,x
8636 8122 cmpa #$22
8638 27EA beq L_8624
863A 4C inca
863B 2602 bne L_863F
863D 3001 leax 1,x
863F 8186 L_863F cmpa #$86 ; token IF (+1)
8641 26E7 bne L_862A
8643 0C04 inc <$04 ; increment for each IF token encountered
8645 20E3 bra L_862A
8647 BD8872 IF_dispatch jsr L_8872 ; read numeric expression into FPA1
864A 9DA5 jsr <$a5 ; get current character from BASIC source
864C 8181 cmpa #$81 ; token GO
864E 2705 beq L_8655
8650 C6BF ldb #$bf ; token THEN
8652 BD89AC jsr CkChar ; skip character in B
8655 964F L_8655 lda <$4f
8657 2613 bne L_866C ; IF condition true
8659 0F04 clr <$04 ; clear IF counter
865B 8DB6 L_865B bsr DATA_dispatch ; skip to start of next statement
865D 4D tsta
865E 27BA beq L_861A ; RTS
8660 9D9F jsr <$9f ; get next character from BASIC source
8662 8184 cmpa #$84 ; token ELSE
8664 26F5 bne L_865B ; we're looking for ELSE
8666 0A04 dec <$04 ; any IFs skipped?
8668 2AF1 bpl L_865B ; this ELSE doesn't go with this IF
866A 9D9F jsr <$9f ; get next character from BASIC source
866C 9DA5 L_866C jsr <$a5 ; get current character from BASIC source
866E 1025FF65 lbcs GOTO_handoff ; it's a number - perform GOTO
8672 7E84DC jmp L_84DC ; interpret statement
8675 BD8E51 ON_dispatch jsr Get8Bit ; get number into B
8678 C681 ldb #$81 ; token GO
867A BD89AC jsr CkChar ; skip character in B
867D 3402 pshs a
867F 81BD cmpa #$bd ; token SUB
8681 2704 beq L_8687
8683 81BC cmpa #$bc ; token TO
8685 2683 L_8685 bne do_sn_error_860A ; ?SN ERROR
8687 0A53 L_8687 dec <$53 ; control variable
8689 2605 bne L_8690
868B 3504 puls b
868D 7E85BB jmp L_85BB ; GO (cmd pointer now at desired choice)
8690 9D9F L_8690 jsr <$9f ; get next character from BASIC source
8692 8D06 bsr L_869A ; read line number & store in $2b
8694 812C cmpa #$2c
8696 27EF beq L_8687
8698 3584 puls b,pc
869A 9E8A L_869A ldx <$8a ; zero
869C 9F2B stx <$2b
869E 2464 L_869E bcc L_8704 ; not a digit - RTS
86A0 8030 suba #$30
86A2 9701 sta <$01
86A4 DC2B ldd <$2b
86A6 8118 cmpa #$18 ; D > 6399?
86A8 22DB bhi L_8685 ; ?SN ERROR
86AA 58 lslb
86AB 49 rola
86AC 58 lslb ; D = D * 10
86AD 49 rola
86AE D32B addd <$2b
86B0 58 lslb
86B1 49 rola
86B2 DB01 addb <$01 ; add new digit
86B4 8900 adca #$00
86B6 DD2B std <$2b
86B8 9D9F jsr <$9f ; get next character from BASIC source
86BA 20E2 bra L_869E ; process another digit
86BC BD8A94 LET_dispatch jsr GETVAR ; get varptr of variable in X
86BF 9F3B stx <$3b
86C1 C6CB ldb #$cb ; token =
86C3 BD89AC jsr CkChar ; skip character in B
86C6 9606 lda <$06 ; numeric / string flag
86C8 3402 pshs a
86CA BD8887 jsr get_string ; get expression
86CD 3502 puls a
86CF 46 rora ; check that variable & expression
86D0 BD8879 jsr L_8879 ; are of same type
86D3 10270D07 lbeq L_93DE ; assign FPA1 to varptr in <$3b
86D7 BD019D L_86D7 jsr >$019d ; PATCH - assign string variable
86DA 9E52 ldx <$52
86DC DC21 ldd <$21 ; stack root / string storage start
86DE 10A302 cmpd 2,x
86E1 2411 bcc L_86F4
86E3 9C1B cmpx <$1b ; start of simple variables
86E5 250D bcs L_86F4
86E7 E684 ldb ,x
86E9 BD8C50 jsr L_8C50 ; reserve B bytes of string space
86EC 9E4D ldx <$4d
86EE BD8D89 jsr L_8D89 ; copy string (len B) from varptr X to ($25)+
86F1 8E0056 ldx #$0056
86F4 9F4D L_86F4 stx <$4d
86F6 BD8DBB jsr L_8DBB ; if X is top of string stack then pull it
86F9 DE4D ldu <$4d
86FB 9E3B ldx <$3b
86FD 3726 pulu a,b,y
86FF A784 sta ,x
8701 10AF02 sty 2,x
8704 39 L_8704 rts
8705 3F5245444F0D text_redo fcc /?REDO/,$0d ; /?REDO/CR
870B 00 fcc $00
870C C624 L_870C ldb #$24 ; ?FD ERROR
870E 0D6F tst <$6f ; DEVN
8710 2703 beq L_8715
8712 7E8344 L_8712 jmp system_error ; cause error
8715 9609 L_8715 lda <$09
8717 2707 beq redo_input
8719 9E31 ldx <$31 ; line number of current DATA statement
871B 9F68 stx <$68 ; current line number
871D 7E89B4 jmp SN_error ; ?SN ERROR
8720 8E8704 redo_input ldx #L_8704 ; /?REDO/
8723 BD90E5 jsr out_string ; print string to DEVN
8726 9E2F ldx <$2f ; address of current BASIC statement
8728 9FA6 stx <$a6 ; BASIC source pointer
872A 39 rts
872B BD9C76 INPUT_dispatch jsr ensure_not_direct ; test for command mode
872E 8D03 bsr L_8733
8730 0F6F clr <$6f ; DEVN
8732 39 rts
8733 8123 L_8733 cmpa #$23
8735 2609 bne L_8740
8737 BDB7D7 jsr L_B7D7 ; read #-n & set up DEVN
873A BDB623 jsr L_B623 ; test cassette status OK for input
873D BD89AA jsr CkComa ; skip comma
8740 8122 L_8740 cmpa #$22
8742 260B bne L_874F ; no prompt
8744 BD8975 jsr L_8975 ; read literal string
8747 C63B ldb #$3b
8749 BD89AC jsr CkChar ; skip character in B
874C BD90E8 jsr L_90E8 ; print prompt
874F 8E02DC L_874F ldx #$02dc
8752 6F84 clr ,x
8754 0D6F tst <$6f ; DEVN
8756 2622 bne L_877A
8758 8D06 bsr L_8760 ; get something into input buffer
875A C62C ldb #$2c
875C E784 stb ,x
875E 201A bra L_877A ; read input into variables
8760 BD90F8 L_8760 jsr L_90F8 ; print '?' to DEVN
8763 BD90F5 jsr L_90F5 ; print a space to DEVN
8766 BDB5C6 L_8766 jsr L_B5C6 ; line input from DEVN
8769 2405 bcc L_8770
876B 3264 leas 4,s
876D 7E8541 jmp L_8541 ; BREAK
8770 C630 L_8770 ldb #$30 ; ?IE ERROR
8772 0D70 tst <$70 ; eof flag
8774 269C bne L_8712
8776 39 rts
8777 9E33 READ_dispatch ldx <$33 ; READ pointer
8779 86 fcb $86 ; lda #$4f - comment byte
877A 4F L_877A clra ; usually skipped by comment byte
877B 9709 sta <$09
877D 9F35 stx <$35
877F BD8A94 L_877F jsr GETVAR ; get varptr of variable in X
8782 9F3B stx <$3b
8784 9EA6 ldx <$a6 ; BASIC source pointer
8786 9F2B stx <$2b
8788 9E35 ldx <$35
878A A684 lda ,x
878C 260C bne L_879A
878E 9609 lda <$09
8790 2658 bne L_87EA
8792 BD017C jsr >$017c ; PATCH - re-request input
8795 BD90F8 jsr L_90F8 ; print '?' to DEVN
8798 8DC6 bsr L_8760
879A 9FA6 L_879A stx <$a6 ; BASIC source pointer
879C 9D9F jsr <$9f ; get next character from BASIC source
879E D606 ldb <$06 ; numeric / string flag
87A0 2727 beq L_87C9
87A2 9EA6 ldx <$a6 ; BASIC source pointer
87A4 9701 sta <$01
87A6 8122 cmpa #$22
87A8 2712 beq L_87BC
87AA 301F leax -1,x
87AC 4F clra
87AD 9701 sta <$01
87AF BDB595 jsr L_B595 ; initialise virtual DEVN device
87B2 0D6E tst <$6e ; cassette IO flag
87B4 2606 bne L_87BC ; IO in progress
87B6 863A lda #$3a
87B8 9701 sta <$01
87BA 862C lda #$2c
87BC 9702 L_87BC sta <$02
87BE BD8C61 jsr L_8C61 ; compile literal string at X
87C1 BD897A jsr L_897A
87C4 BD86D7 jsr L_86D7 ; assign string variable
87C7 2006 bra L_87CF
87C9 BD94BD L_87C9 jsr L_94BD ; read numeric constant into FPA1
87CC BD93DE jsr L_93DE ; assign FPA1 to varptr in <$3b
87CF 9DA5 L_87CF jsr <$a5 ; get current character from BASIC source
87D1 2706 beq L_87D9
87D3 812C cmpa #$2c
87D5 1026FF33 lbne L_870C ; take action for illegal input
87D9 9EA6 L_87D9 ldx <$a6 ; BASIC source pointer
87DB 9F35 stx <$35
87DD 9E2B ldx <$2b
87DF 9FA6 stx <$a6 ; BASIC source pointer
87E1 9DA5 jsr <$a5 ; get current character from BASIC source
87E3 2721 beq L_8806
87E5 BD89AA jsr CkComa ; skip comma
87E8 2095 bra L_877F
87EA 9FA6 L_87EA stx <$a6 ; BASIC source pointer
87EC BD861B jsr L_861B ; find end of statement
87EF 3001 leax 1,x
87F1 4D tsta
87F2 260A bne L_87FE
87F4 C606 ldb #$06
87F6 EE81 ldu ,x++
87F8 2741 beq L_883B
87FA EC81 ldd ,x++
87FC DD31 std <$31 ; line number of current DATA statement
87FE A684 L_87FE lda ,x
8800 8186 cmpa #$86
8802 26E6 bne L_87EA
8804 2094 bra L_879A
8806 9E35 L_8806 ldx <$35
8808 D609 ldb <$09
880A 1026FD0A lbne L_8518
880E A684 lda ,x
8810 2706 beq L_8818
8812 8E8818 ldx #L_8818
8815 7E90E5 jmp out_string ; print string to DEVN
8818 39 L_8818 rts
8819 3F45585452412049474E4F5245440D text_extra_ignored fcc /?EXTRA IGNORED/,$0d ; /?EXTRA IGNORED/CR
8828 00 fcc $00
8829 2604 NEXT_dispatch bne L_882F ; control variable specified
882B 9E8A ldx <$8a ; zero
882D 2003 bra L_8832
882F BD8A94 L_882F jsr GETVAR ; get varptr of variable in X
8832 9F3B L_8832 stx <$3b
8834 BD82F7 jsr L_82F7 ; examine BASIC stack
8837 2704 beq L_883D ; found match
8839 C600 ldb #$00 ; ?NF ERROR
883B 2047 L_883B bra L_8884
883D 1F14 L_883D tfr x,s ; point stack to this entry
883F 3003 leax 3,x ; point X to STEP value
8841 BD93BF jsr MOVFM ; load variable into FPA1 (X is varptr)
8844 A668 lda 8,s ; sign of STEP value
8846 9754 sta <$54
8848 9E3B ldx <$3b ; varptr of control variable
884A BD910B jsr L_910B ; add varptr X to FPA1
884D BD93DE jsr L_93DE ; assign FPA1 to varptr in <$3b
8850 3069 leax 9,s ; point X to terminating value
8852 BD9441 jsr L_9441 ; compare FPA1 - varptr X
8855 E068 subb 8,s ; test depends on step direction
8857 270C beq L_8865 ; terminating condition met
8859 AE6E ldx 14,s
885B 9F68 stx <$68 ; current line number
885D AEE810 ldx <$10,s
8860 9FA6 stx <$a6 ; BASIC source pointer
8862 7E849F L_8862 jmp run_basic ; interpreter loop
8865 32E812 L_8865 leas <$12,s ; finished with this entry
8868 9DA5 jsr <$a5 ; get current character from BASIC source
886A 812C cmpa #$2c
886C 26F4 bne L_8862 ; no more variables after NEXT
886E 9D9F jsr <$9f ; get next character from BASIC source
8870 8DBD bsr L_882F ; BSR used for correct stack structure
8872 8D13 L_8872 bsr get_string ; get expression
8874 1CFE L_8874 andcc #$fe ; * cause error if expression last evaluated not numeric
8876 7D fcb $7d ; tst >$1a01 - comment byte
8877 1A01 get_expr orcc #$01 ; usually skipped by comment byte
8879 0D06 L_8879 tst <$06 ; numeric / string flag
887B 2503 bcs L_8880
887D 2A99 bpl L_8818 ; RTS
887F 8C fcb $8c ; cmpx #$2b96 - comment byte
8880 2B96 L_8880 bmi L_8818 ; usually skipped by comment byte
8882 C618 TM_error ldb #$18 ; ?TM ERROR
8884 7E8344 L_8884 jmp system_error ; cause error
8887 8D6E get_string bsr L_88F7 ; move source pointer back one
8889 4F L_8889 clra
888A 8C fcb $8c ; cmpx #$3404 - comment byte
888B 3404 L_888B pshs b ; usually skipped by comment byte
888D 3402 pshs a ; * (888B 3404 PSHS B)
888F C601 ldb #$01
8891 BD8331 jsr L_8331 ; memory check
8894 BD8954 jsr L_8954 ; evaluate sub-expression
8897 0F3F clr <$3f ; flag used for relational operators
8899 9DA5 L_8899 jsr <$a5 ; get current character from BASIC source
889B 80CA L_889B suba #$ca ; branch to $88B2 if token is not in the set
889D 2513 bcs L_88B2 ; [ >, =, < ]
889F 8103 cmpa #$03
88A1 240F bcc L_88B2
88A3 8101 cmpa #$01 ; map [0, 1, 2] to [1, 2, 4]
88A5 49 rola
88A6 983F eora <$3f ; determine valid combination of > = <
88A8 913F cmpa <$3f
88AA 2564 bcs do_sn_error_8910 ; ?SN ERROR
88AC 973F sta <$3f
88AE 9D9F jsr <$9f ; get next character from BASIC source
88B0 20E9 bra L_889B
88B2 D63F L_88B2 ldb <$3f ; $3f = [ 1, 2, 3, 4, 5, 6 ]
88B4 2633 bne L_88E9 ; for [ > = >= < <> <= ]
88B6 1024006B lbcc L_8925
88BA 8B07 adda #$07
88BC 2467 bcc L_8925 ; not a binary operator
88BE 9906 adca <$06 ; A = A + 1 + ($06)
88C0 10270491 lbeq L_8D55 ; '+' in a string expression
88C4 89FF adca #$ff ; A = A - 1 if numeric expression
88C6 3402 pshs a
88C8 48 lsla
88C9 ABE0 adda ,s+ ; A = A * 3
88CB 8E8294 ldx #operator_dispatch ; binary operator precedence table
88CE 3086 leax a,x
88D0 3502 L_88D0 puls a ; precedence of last operator
88D2 A184 cmpa ,x
88D4 2455 bcc L_892B ; new op. has a lower precedence
88D6 8D9C bsr L_8874 ; validate numeric expression
88D8 3402 L_88D8 pshs a
88DA 8D29 bsr L_8905 ; push op handler & FPA1 / get expression
88DC 9E3D ldx <$3d
88DE 3502 puls a
88E0 261D bne L_88FF
88E2 4D tsta
88E3 1027006A lbeq L_8951 ; LDB <$4F RTS
88E7 204B bra L_8934
88E9 0806 L_88E9 lsl <$06 ; numeric / string flag
88EB 59 rolb
88EC 8D09 bsr L_88F7 ; move source pointer back one
88EE 8E88FC ldx #data_88FC
88F1 D73F stb <$3f
88F3 0F06 clr <$06 ; numeric / string flag
88F5 20D9 bra L_88D0
88F7 9EA6 L_88F7 ldx <$a6 ; BASIC source pointer
88F9 7E85EE jmp L_85EE ; subtract 1 from X & store in $a6
88FC 64 data_88FC fcb $64 ; * rel. op. precedence & handler
88FD 8A31 fdb jmp_8A31
88FF A184 L_88FF cmpa ,x
8901 2431 bcc L_8934
8903 20D3 bra L_88D8
8905 EC01 L_8905 ldd 1,x ; op handler
8907 3406 pshs a,b
8909 8D08 bsr L_8913 ; push FPA1 onto stack
890B D63F ldb <$3f ; rel. op. flag
890D 16FF7B lbra L_888B ; get expression
8910 7E89B4 do_sn_error_8910 jmp SN_error ; ?SN ERROR
8913 D654 L_8913 ldb <$54 ; * push FPA1 onto stack
8915 A684 lda ,x
8917 3520 L_8917 puls y
8919 3404 pshs b
891B D64F L_891B ldb <$4f
891D 9E50 ldx <$50
891F DE52 ldu <$52
8921 3454 pshs b,x,u
8923 6EA4 jmp ,y
8925 9E8A L_8925 ldx <$8a ; zero
8927 A6E0 lda ,s+
8929 2726 beq L_8951 ; LDB <$4F RTS
892B 8164 L_892B cmpa #$64
892D 2703 beq L_8932
892F BD8874 jsr L_8874 ; validate numeric expression
8932 9F3D L_8932 stx <$3d
8934 3504 L_8934 puls b
8936 815A cmpa #$5a
8938 2719 beq L_8953 ; RTS
893A 817D cmpa #$7d
893C 2715 beq L_8953 ; RTS
893E 54 lsrb ; sets carry if rel. op. was for string
893F D70A stb <$0a
8941 3552 puls a,x,u ; pull FPA2 off stack
8943 975C sta <$5c ; set $62 up with sign difference
8945 9F5D stx <$5d
8947 DF5F stu <$5f ; LDB <$4F
8949 3504 puls b
894B D761 stb <$61 ; RTS calls operator handler
894D D854 eorb <$54 ; (with carry from above)
894F D762 stb <$62
8951 D64F L_8951 ldb <$4f
8953 39 L_8953 rts
8954 BD018B L_8954 jsr >$018b ; PATCH - evaluate expression
8957 0F06 clr <$06 ; numeric / string flag
8959 9D9F jsr <$9f ; get next character from BASIC source
895B 2403 bcc L_8960
895D 7E94BD L_895D jmp L_94BD ; read numeric constant into FPA1
8960 BD8ADF L_8960 jsr L_8ADF ; carry clear if A-Z
8963 245C bcc L_89C1 ; evaluate variable
8965 812E cmpa #$2e
8967 27F4 beq L_895D
8969 81C4 cmpa #$c4 ; token -
896B 274C beq L_89B9 ; read expression & negate
896D 81C3 cmpa #$c3 ; token +
896F 27E3 beq L_8954 ; ignore +
8971 8122 cmpa #$22
8973 260A bne L_897F
8975 9EA6 L_8975 ldx <$a6 ; BASIC source pointer
8977 BD8C5B jsr L_8C5B ; compile literal string at X
897A 9E64 L_897A ldx <$64
897C 9FA6 stx <$a6 ; move source pointer to end of string
897E 39 rts
897F 81C0 L_897F cmpa #$c0 ; token NOT
8981 260D bne L_8990
8983 865A lda #$5a
8985 BD888B jsr L_888B
8988 BD8B2D jsr INTCNV ; read signed number from FPA1 to $52 & D
898B 43 coma
898C 53 comb
898D 7E8C37 jmp GIVABF ; assign D to FPA1
8990 81BE L_8990 cmpa #$be ; token FN
8992 1027132E lbeq L_9CC4
8996 8126 cmpa #$26
8998 1027127F lbeq L_9C1B ; read octal or hex number into $52 / $53
899C 4C inca
899D 272E beq L_89CD ; evaluate function
899F 8D06 L_899F bsr CkOpBrak ; skip open bracket (only legal chr. left)
89A1 BD8887 jsr get_string ; get expression
89A4 C629 CkClBrak ldb #$29 ; * check for close bracket
89A6 8C fcb $8c ; cmpx #$c628 - comment byte
89A7 C628 CkOpBrak ldb #$28 ; usually skipped by comment byte
89A9 8C fcb $8c ; * (89A7 C628 LDB #$28) / cmpx #$c62c - comment byte
89AA C62C CkComa ldb #$2c ; usually skipped by comment byte
89AC E19F00A6 CkChar cmpb [$00a6] ; * check for character in B
89B0 2602 bne SN_error ; ?SN ERROR
89B2 0E9F jmp <$9f ; get next character from BASIC source
89B4 C602 SN_error ldb #$02 ; ?SN ERROR
89B6 7E8344 jmp system_error ; cause error
89B9 867D L_89B9 lda #$7d ; * read expression & negate FPA1
89BB BD888B jsr L_888B
89BE 7E96DE jmp L_96DE ; COM $54 if FPA1 non zero
89C1 BD8A94 L_89C1 jsr GETVAR ; get varptr of variable in X
89C4 9F52 called_from_89C4 stx <$52
89C6 9606 lda <$06 ; numeric / string flag
89C8 2689 bne L_8953 ; RTS (string)
89CA 7E93BF jmp MOVFM ; load variable into FPA1 (X is varptr)
89CD 9D9F L_89CD jsr <$9f ; get next character from BASIC source
89CF 1F89 tfr a,b
89D1 58 lslb
89D2 9D9F jsr <$9f ; get next character from BASIC source
89D4 C142 cmpb #$42
89D6 2304 bls L_89DC
89D8 6E9F0132 jmp [$0132] ; disk function despatch
89DC 3404 L_89DC pshs b
89DE C12C cmpb #$2c
89E0 2522 bcs L_8A04 ; functions with single arguments
89E2 C134 cmpb #$34
89E4 2420 bcc L_8A06 ; functions with special or no arguments
89E6 8DBF bsr CkOpBrak ; skip open bracket
89E8 A6E4 lda ,s
89EA 8132 cmpa #$32
89EC 2418 bcc L_8A06 ; not LEFT$, RIGHT$ or MID$
89EE BD8887 jsr get_string ; get expression
89F1 8DB7 bsr CkComa ; skip comma
89F3 BD8877 jsr get_expr ; validate string
89F6 3502 puls a
89F8 DE52 ldu <$52
89FA 3442 pshs a,u
89FC BD8E51 jsr Get8Bit ; get number into B
89FF 3502 puls a
8A01 3406 pshs a,b
8A03 8E fcb $8e ; ldx #$8d99 - comment byte
8A04 8D99 L_8A04 bsr L_899F ; usually skipped by comment byte
8A06 3504 L_8A06 puls b ; * (8A04 8D99 BSR $899F) ;get expression inside brackets
8A08 BE0128 ldx >$0128 ; function despatch table
8A0B 3A abx
8A0C AD94 jsr [,x]
8A0E 7E8874 jmp L_8874 ; validate numeric expression
8A11 86 OR_dispatch fcb $86 ; * OR / lda #$4f - comment byte
8A12 4F AND_dispatch clra ; usually skipped by comment byte
8A13 9703 sta <$03 ; * (8A12 4F CLRA)
8A15 BD8B2D jsr INTCNV ; read signed number from FPA1 to $52 & D
8A18 DD01 std <$01
8A1A BD93F5 jsr L_93F5 ; copy FPA2 to FPA1
8A1D BD8B2D jsr INTCNV ; read signed number from FPA1 to $52 & D
8A20 0D03 tst <$03
8A22 2606 bne L_8A2A
8A24 9401 anda <$01
8A26 D402 andb <$02
8A28 2004 bra L_8A2E
8A2A 9A01 L_8A2A ora <$01
8A2C DA02 orb <$02
8A2E 7E8C37 L_8A2E jmp GIVABF ; assign D to FPA1
8A31 BD8879 jmp_8A31 jsr L_8879 ; validate string / numeric using carry
8A34 2610 bne L_8A46 ; valid string
8A36 9661 lda <$61
8A38 8A7F ora #$7f
8A3A 945D anda <$5d
8A3C 975D sta <$5d
8A3E 8E005C ldx #$005c ; FPA2
8A41 BD9441 jsr L_9441 ; compare FPA1 - varptr X
8A44 2036 bra L_8A7C
8A46 0F06 L_8A46 clr <$06 ; numeric / string flag
8A48 0A3F dec <$3f
8A4A BD8D9D jsr L_8D9D ; point X to string just compiled & len in B
8A4D D756 stb <$56
8A4F 9F58 stx <$58
8A51 9E5F ldx <$5f
8A53 BD8D9F jsr DELVAR ; point X to string & length in B
8A56 9656 lda <$56
8A58 3404 pshs b
8A5A A0E0 suba ,s+
8A5C 2707 beq L_8A65
8A5E 8601 lda #$01
8A60 2403 bcc L_8A65
8A62 D656 ldb <$56
8A64 40 nega
8A65 9754 L_8A65 sta <$54
8A67 DE58 ldu <$58
8A69 5C incb
8A6A 5A L_8A6A decb
8A6B 2604 bne L_8A71
8A6D D654 ldb <$54
8A6F 200B bra L_8A7C
8A71 A680 L_8A71 lda ,x+
8A73 A1C0 cmpa ,u+
8A75 27F3 beq L_8A6A
8A77 C6FF ldb #$ff
8A79 2401 bcc L_8A7C
8A7B 50 negb
8A7C CB01 L_8A7C addb #$01 ; map [-1, 0, 1] to [1, 2, 4]
8A7E 59 rolb
8A7F D40A andb <$0a ; rel. op. number
8A81 2702 beq L_8A85
8A83 C6FF ldb #$ff
8A85 7E9427 L_8A85 jmp L_9427 ; assign B to FPA1 (result of relation)
8A88 BD89AA L_8A88 jsr CkComa ; skip comma
8A8B C601 DIM_dispatch ldb #$01 ; * DIM
8A8D 8D08 bsr L_8A97 ; create variable
8A8F 9DA5 jsr <$a5 ; get current character from BASIC source
8A91 26F5 bne L_8A88 ; skip comma & read next array
8A93 39 rts
8A94 5F GETVAR clrb ; * returns $39 = X = varptr address
8A95 9DA5 jsr <$a5 ; get current character from BASIC source
8A97 D705 L_8A97 stb <$05 ; * set B to cause error if array variable already exists
8A99 9737 L_8A99 sta <$37
8A9B 9DA5 jsr <$a5 ; get current character from BASIC source
8A9D 8D40 bsr L_8ADF ; carry clear if A-Z
8A9F 1025FF11 lbcs SN_error ; ?SN ERROR
8AA3 5F clrb
8AA4 D706 stb <$06 ; numeric / string flag
8AA6 9D9F jsr <$9f ; get next character from BASIC source
8AA8 2504 bcs L_8AAE
8AAA 8D33 bsr L_8ADF ; carry clear if A-Z
8AAC 250A bcs L_8AB8
8AAE 1F89 L_8AAE tfr a,b
8AB0 9D9F L_8AB0 jsr <$9f ; get next character from BASIC source
8AB2 25FC bcs L_8AB0
8AB4 8D29 bsr L_8ADF ; carry clear if A-Z
8AB6 24F8 bcc L_8AB0
8AB8 8124 L_8AB8 cmpa #$24
8ABA 2606 bne L_8AC2 ; numeric variable
8ABC 0306 com <$06 ; numeric / string flag
8ABE CB80 addb #$80
8AC0 9D9F jsr <$9f ; get next character from BASIC source
8AC2 D738 L_8AC2 stb <$38
8AC4 9A08 ora <$08 ; set $08 to #$80 to exclude array variables
8AC6 8028 suba #$28
8AC8 10270078 lbeq L_8B44 ; array variable
8ACC 0F08 clr <$08
8ACE 9E1B ldx <$1b ; start of simple variables
8AD0 DC37 ldd <$37
8AD2 9C1D L_8AD2 cmpx <$1d ; start of array variables
8AD4 2712 beq L_8AE8 ; not found - create variable
8AD6 10A381 cmpd ,x++
8AD9 273E beq L_8B19 ; found existing variable - STX <$39 & RTS
8ADB 3005 leax 5,x
8ADD 20F3 bra L_8AD2 ; keep looking
8ADF 8141 L_8ADF cmpa #$41 ; * clear carry if A contains 'A'-'Z'
8AE1 2504 bcs L_8AE7
8AE3 805B suba #$5b
8AE5 80A5 suba #$a5
8AE7 39 L_8AE7 rts
8AE8 8E008A L_8AE8 ldx #$008a ; * create variable
8AEB EEE4 ldu ,s
8AED 118389C4 cmpu #called_from_89C4 ; if called by evaluate variable routine - RTS
8AF1 2728 beq L_8B1B ; (with X pointing to zero)
8AF3 DC1F ldd <$1f ; end of BASIC storage
8AF5 DD43 std <$43
8AF7 C30007 addd #$0007
8AFA DD41 std <$41
8AFC 9E1D ldx <$1d ; start of array variables
8AFE 9F47 stx <$47
8B00 BD831C jsr L_831C ; move memory contents up
8B03 9E41 ldx <$41
8B05 9F1F stx <$1f ; end of BASIC storage
8B07 9E45 ldx <$45
8B09 9F1D stx <$1d ; start of array variables
8B0B 9E47 ldx <$47
8B0D DC37 ldd <$37 ; variable name
8B0F ED81 std ,x++
8B11 4F clra
8B12 5F clrb
8B13 ED84 std ,x
8B15 ED02 std 2,x
8B17 A704 sta 4,x
8B19 9F39 L_8B19 stx <$39
8B1B 39 L_8B1B rts
8B1C 9080000000 data_8B1C fcb $90,$80,$00,$00,$00 ; FP constant -32768
8B21 9D9F L_8B21 jsr <$9f ; get next character from BASIC source
8B23 BD8872 L_8B23 jsr L_8872 ; read numeric expression into FPA1
8B26 BD8874 L_8B26 jsr L_8874 ; validate numeric expression
8B29 9654 GETUSR lda <$54 ; * read +ve number from FPA1 into $52 & D
8B2B 2B60 bmi FC_error ; ?FC ERROR
8B2D BD8874 INTCNV jsr L_8874 ; validate numeric expression
8B30 964F lda <$4f
8B32 8190 cmpa #$90
8B34 2508 bcs L_8B3E
8B36 8E8B1C ldx #data_8B1C ; only 16 bit number allowed is -32768
8B39 BD9441 jsr L_9441 ; compare FPA1 - varptr X
8B3C 264F bne FC_error ; ?FC ERROR
8B3E BD9473 L_8B3E jsr L_9473 ; denormalize FPA1 to an integer
8B41 DC52 ldd <$52
8B43 39 rts
8B44 D605 L_8B44 ldb <$05 ; * get varptr of variable continued (handle arrays)
8B46 9606 lda <$06 ; numeric / string flag
8B48 3406 pshs a,b
8B4A 5F clrb
8B4B 9E37 L_8B4B ldx <$37
8B4D 3414 pshs b,x
8B4F 8DD0 bsr L_8B21 ; read unsigned number into $52 & D
8B51 3534 puls b,x,y
8B53 9F37 stx <$37
8B55 DE52 ldu <$52
8B57 3460 pshs y,u
8B59 5C incb
8B5A 9DA5 jsr <$a5 ; get current character from BASIC source
8B5C 812C cmpa #$2c
8B5E 27EB beq L_8B4B ; get next dimension
8B60 D703 stb <$03 ; number of dimensions
8B62 BD89A4 jsr CkClBrak ; skip close bracket
8B65 3506 puls a,b
8B67 9706 sta <$06 ; numeric / string flag
8B69 D705 stb <$05
8B6B 9E1D ldx <$1d ; start of array variables
8B6D 9C1F L_8B6D cmpx <$1f ; end of BASIC storage
8B6F 2721 beq L_8B92 ; not found - create new array
8B71 DC37 ldd <$37
8B73 10A384 cmpd ,x
8B76 2706 beq L_8B7E ; found array name
8B78 EC02 ldd 2,x
8B7A 308B leax d,x
8B7C 20EF bra L_8B6D ; keep looking
8B7E C612 L_8B7E ldb #$12 ; ?DD ERROR
8B80 9605 lda <$05
8B82 260B bne L_8B8F ; cause error if array exists & $05 set
8B84 D603 ldb <$03
8B86 E104 cmpb 4,x
8B88 2759 beq L_8BE3 ; correct number of dimensions
8B8A C610 BS_error ldb #$10 ; ?BS ERROR
8B8C 8C fcb $8c ; cmpx #$c608 - comment byte
8B8D C608 FC_error ldb #$08 ; usually skipped by comment byte
8B8F 7E8344 L_8B8F jmp system_error ; cause error
8B92 CC0005 L_8B92 ldd #$0005 ; bytes per element
8B95 DD64 std <$64
8B97 DC37 ldd <$37
8B99 ED84 std ,x ; array name
8B9B D603 ldb <$03
8B9D E704 stb 4,x ; number of dimensions
8B9F BD8331 jsr L_8331 ; memory check
8BA2 9F41 stx <$41 ; start of array header
8BA4 C60B L_8BA4 ldb #$0b ; default number of elements
8BA6 4F clra
8BA7 0D05 tst <$05
8BA9 2705 beq L_8BB0
8BAB 3506 puls a,b
8BAD C30001 addd #$0001
8BB0 ED05 L_8BB0 std 5,x
8BB2 8D5D bsr L_8C11 ; D = word at 5,X * word at $64
8BB4 DD64 std <$64
8BB6 3002 leax 2,x
8BB8 0A03 dec <$03
8BBA 26E8 bne L_8BA4 ; next dimension
8BBC 9F0F stx <$0f ; start of array element storage
8BBE D30F addd <$0f ; D = end of array
8BC0 1025F77E lbcs OM_error ; ?OM ERROR
8BC4 1F01 tfr d,x
8BC6 BD8335 jsr L_8335 ; memory check (also adds #$3a to D)
8BC9 830035 subd #$0035
8BCC DD1F std <$1f ; end of BASIC storage
8BCE 4F clra
8BCF 301F L_8BCF leax -1,x ; clear array
8BD1 A705 sta 5,x
8BD3 9C0F cmpx <$0f
8BD5 26F8 bne L_8BCF
8BD7 9E41 ldx <$41 ; array header
8BD9 961F lda <$1f ; end of BASIC storage
8BDB 9341 subd <$41
8BDD ED02 std 2,x ; offset to next array (when it's created)
8BDF 9605 lda <$05
8BE1 262D bne L_8C10 ; RTS
8BE3 E604 L_8BE3 ldb 4,x
8BE5 D703 stb <$03
8BE7 4F clra
8BE8 5F clrb
8BE9 DD64 L_8BE9 std <$64
8BEB 3506 puls a,b
8BED DD52 std <$52
8BEF 10A305 cmpd 5,x
8BF2 243A bcc do_bs_error_8C2E ; ?BS ERROR
8BF4 DE64 ldu <$64
8BF6 2704 beq L_8BFC
8BF8 8D17 bsr L_8C11 ; D = word at 5,X * word at $64
8BFA D352 addd <$52
8BFC 3002 L_8BFC leax 2,x
8BFE 0A03 dec <$03
8C00 26E7 bne L_8BE9
8C02 EDE3 std ,--s
8C04 58 lslb
8C05 49 rola
8C06 58 lslb
8C07 49 rola
8C08 E3E1 addd ,s++ ; D = D * 5
8C0A 308B leax d,x
8C0C 3005 leax 5,x
8C0E 9F39 stx <$39
8C10 39 L_8C10 rts
8C11 8610 L_8C11 lda #$10 ; * D = word at 5,X * word at $64
8C13 9745 sta <$45
8C15 EC05 ldd 5,x
8C17 DD17 std <$17
8C19 4F clra
8C1A 5F clrb
8C1B 58 L_8C1B lslb
8C1C 49 rola
8C1D 250F bcs do_bs_error_8C2E ; ?BS ERROR
8C1F 0865 lsl <$65
8C21 0964 rol <$64
8C23 2404 bcc L_8C29
8C25 D317 addd <$17
8C27 2505 bcs do_bs_error_8C2E ; ?BS ERROR
8C29 0A45 L_8C29 dec <$45
8C2B 26EE bne L_8C1B
8C2D 39 rts
8C2E 7E8B8A do_bs_error_8C2E jmp BS_error ; ?BS ERROR
8C31 1F40 MEM_dispatch tfr s,d ; * MEM
8C33 7E9FCE jmp mem_patch ; ...continued
8C36 4F Assign8Bit clra ; * assign B to FPA1
8C37 0F06 GIVABF clr <$06 ; numeric / string flag
8C39 DD50 std <$50
8C3B C690 ldb #$90
8C3D 7E942D jmp L_942D ; signed assign!
8C40 BD8874 STRstr_dispatch jsr L_8874 ; validate numeric expression
8C43 CE03D9 ldu #$03d9
8C46 BD958A jsr L_958A ; convert FPA1 to string at U
8C49 3262 leas 2,s ; lose return address
8C4B 8E03D8 ldx #$03d8
8C4E 200B bra L_8C5B ; compile literal string at X
8C50 9F4D L_8C50 stx <$4d ; * B = $56 = length of block
8C52 8D5F L_8C52 bsr L_8CB3 ; reserve B bytes of string space
8C54 9F58 L_8C54 stx <$58
8C56 D756 stb <$56
8C58 39 rts
8C59 301F L_8C59 leax -1,x ; * if copied to string space, start & end also in $58 & $4d
8C5B 8622 L_8C5B lda #$22
8C5D 9701 L_8C5D sta <$01
8C5F 9702 sta <$02
8C61 3001 L_8C61 leax 1,x
8C63 9F62 stx <$62
8C65 9F58 stx <$58
8C67 C6FF ldb #$ff
8C69 5C L_8C69 incb
8C6A A680 lda ,x+
8C6C 270C beq L_8C7A
8C6E 9101 cmpa <$01
8C70 2704 beq L_8C76
8C72 9102 cmpa <$02
8C74 26F3 bne L_8C69
8C76 8122 L_8C76 cmpa #$22
8C78 2702 beq L_8C7C
8C7A 301F L_8C7A leax -1,x
8C7C 9F64 L_8C7C stx <$64
8C7E D756 stb <$56
8C80 BD0197 jsr >$0197 ; PATCH - reset BASIC memory
8C83 DE62 ldu <$62
8C85 118303D9 cmpu #$03d9
8C89 2207 bhi L_8C92 ; push temp string onto varptr stack
8C8B 8DC3 bsr L_8C50 ; reserve B bytes of string space
8C8D 9E62 ldx <$62
8C8F BD8D8B jsr L_8D8B ; copy string of length B from X+ to ($25)+
8C92 9E0B L_8C92 ldx <$0b
8C94 8C01D1 cmpx #$01d1
8C97 2605 bne L_8C9E
8C99 C61E ldb #$1e ; ?ST ERROR
8C9B 7E8344 L_8C9B jmp system_error ; cause error
8C9E 9656 L_8C9E lda <$56
8CA0 A784 sta ,x
8CA2 DC58 ldd <$58
8CA4 ED02 std 2,x
8CA6 86FF lda #$ff
8CA8 9706 sta <$06 ; numeric / string flag
8CAA 9F0D stx <$0d
8CAC 9F52 stx <$52
8CAE 3005 leax 5,x
8CB0 9F0B stx <$0b
8CB2 39 rts
8CB3 0F07 L_8CB3 clr <$07 ; * requested block also in $25
8CB5 4F L_8CB5 clra
8CB6 3406 pshs a,b
8CB8 DC23 ldd <$23 ; top of free string space
8CBA A3E0 subd ,s+
8CBC 109321 cmpd <$21 ; stack root / string storage start
8CBF 250A bcs L_8CCB ; not enough space
8CC1 DD23 std <$23 ; new free pointer
8CC3 9E23 ldx <$23
8CC5 3001 leax 1,x
8CC7 9F25 stx <$25 ; points to requested block
8CC9 3584 puls b,pc
8CCB C61A L_8CCB ldb #$1a ; ?OS ERROR
8CCD 0307 com <$07
8CCF 27CA beq L_8C9B ; already done garbage collect - give up
8CD1 8D04 bsr string_gc ; string garbage collect
8CD3 3504 puls b
8CD5 20DE bra L_8CB5 ; try to reserve space again
8CD7 9E27 string_gc ldx <$27 ; top of BASIC RAM
8CD9 9F23 L_8CD9 stx <$23 ; top of free string space
8CDB 4F clra
8CDC 5F clrb
8CDD DD4B std <$4b
8CDF 9E21 ldx <$21 ; stack root / string storage start
8CE1 9F47 stx <$47
8CE3 8E01A9 ldx #$01a9
8CE6 9C0B L_8CE6 cmpx <$0b
8CE8 2704 beq L_8CEE
8CEA 8D32 bsr L_8D1E
8CEC 20F8 bra L_8CE6
8CEE 9E1B L_8CEE ldx <$1b ; start of simple variables
8CF0 9C1D L_8CF0 cmpx <$1d ; start of array variables
8CF2 2704 beq L_8CF8
8CF4 8D22 bsr L_8D18
8CF6 20F8 bra L_8CF0
8CF8 9F41 L_8CF8 stx <$41
8CFA 9E41 L_8CFA ldx <$41
8CFC 9C1F L_8CFC cmpx <$1f ; end of BASIC storage
8CFE 2735 beq L_8D35
8D00 EC02 ldd 2,x
8D02 D341 addd <$41
8D04 DD41 std <$41
8D06 A601 lda 1,x
8D08 2AF0 bpl L_8CFA
8D0A E604 ldb 4,x
8D0C 58 lslb
8D0D CB05 addb #$05
8D0F 3A abx
8D10 9C41 L_8D10 cmpx <$41
8D12 27E8 beq L_8CFC
8D14 8D08 bsr L_8D1E
8D16 20F8 bra L_8D10
8D18 A601 L_8D18 lda 1,x
8D1A 3002 leax 2,x
8D1C 2A14 bpl L_8D32
8D1E E684 L_8D1E ldb ,x
8D20 2710 beq L_8D32
8D22 EC02 ldd 2,x
8D24 109323 cmpd <$23 ; top of free string space
8D27 2209 bhi L_8D32
8D29 109347 cmpd <$47
8D2C 2304 bls L_8D32
8D2E 9F4B stx <$4b
8D30 DD47 std <$47
8D32 3005 L_8D32 leax 5,x
8D34 39 L_8D34 rts
8D35 9E4B L_8D35 ldx <$4b
8D37 27FB beq L_8D34
8D39 4F clra
8D3A E684 ldb ,x
8D3C 5A decb
8D3D D347 addd <$47
8D3F DD43 std <$43
8D41 9E23 ldx <$23 ; top of free string space
8D43 9F41 stx <$41
8D45 BD831E jsr L_831E ; move memory contents up (no memory check)
8D48 9E4B ldx <$4b
8D4A DC45 ldd <$45
8D4C ED02 std 2,x
8D4E 9E45 ldx <$45
8D50 301F leax -1,x
8D52 7E8CD9 jmp L_8CD9
8D55 DC52 L_8D55 ldd <$52 ; * handle '+' in a string expression (concatenate)
8D57 3406 pshs a,b
8D59 BD8954 jsr L_8954 ; evaluate sub-expression
8D5C BD8877 jsr get_expr ; validate string expression
8D5F 3510 puls x
8D61 9F62 stx <$62
8D63 E684 ldb ,x
8D65 9E52 ldx <$52
8D67 EB84 addb ,x ; add string lengths
8D69 2405 bcc L_8D70 ; not too long
8D6B C61C ldb #$1c ; ?LS ERROR
8D6D 7E8344 jmp system_error ; cause error
8D70 BD8C50 L_8D70 jsr L_8C50 ; reserve B bytes of string space
8D73 9E62 ldx <$62
8D75 E684 ldb ,x
8D77 8D10 bsr L_8D89 ; copy string (len B) from varptr X to ($25)+
8D79 9E4D ldx <$4d
8D7B 8D22 bsr DELVAR ; point X to string & length in B
8D7D 8D0C bsr L_8D8B ; copy string of length B from X+ to ($25)+
8D7F 9E62 ldx <$62
8D81 8D1C bsr DELVAR ; point X to string & length in B
8D83 BD8C92 jsr L_8C92 ; push temp string onto varptr stack
8D86 7E8899 jmp L_8899 ; back to expression handler
8D89 AE02 L_8D89 ldx 2,x ; * copy string of length B from varptr X to ($25)+
8D8B DE25 L_8D8B ldu <$25 ; * copy string of length B from X+ to ($25)+
8D8D 5C incb
8D8E 2004 bra L_8D94
8D90 A680 L_8D90 lda ,x+
8D92 A7C0 sta ,u+
8D94 5A L_8D94 decb
8D95 26F9 bne L_8D90
8D97 DF25 stu <$25
8D99 39 rts
8D9A BD8877 L_8D9A jsr get_expr ; validate string expression
8D9D 9E52 L_8D9D ldx <$52
8D9F E684 DELVAR ldb ,x
8DA1 8D18 bsr L_8DBB ; if X is top of string stack then pull it
8DA3 2613 bne L_8DB8 ; normal varptr
8DA5 AE07 ldx 7,x
8DA7 301F leax -1,x
8DA9 9C23 cmpx <$23 ; top of free string space
8DAB 2608 bne L_8DB5
8DAD 3404 pshs b
8DAF D323 addd <$23 ; top of free string space
8DB1 DD23 std <$23 ; top of free string space
8DB3 3504 puls b
8DB5 3001 L_8DB5 leax 1,x
8DB7 39 rts
8DB8 AE02 L_8DB8 ldx 2,x
8DBA 39 rts
8DBB 9C0D L_8DBB cmpx <$0d ; * if X is top of string stack then pull it
8DBD 2607 bne L_8DC6
8DBF 9F0B stx <$0b
8DC1 301B leax -5,x
8DC3 9F0D stx <$0d
8DC5 4F clra
8DC6 39 L_8DC6 rts
8DC7 8D03 LEN_dispatch bsr L_8DCC ; validate string & test length
8DC9 7E8C36 L_8DC9 jmp Assign8Bit ; assign B to FPA1
8DCC 8DCC L_8DCC bsr L_8D9A ; validate string & point X to it
8DCE 0F06 clr <$06 ; numeric / string flag
8DD0 5D tstb
8DD1 39 rts
8DD2 BD8E54 CHRstr_dispatch jsr L_8E54 ; read 8 bit value into B from FPA1
8DD5 C601 L_8DD5 ldb #$01
8DD7 BD8CB3 jsr L_8CB3 ; reserve B bytes of string space
8DDA 9653 lda <$53
8DDC BD8C54 jsr L_8C54 ; store string details as for temp string
8DDF A784 sta ,x
8DE1 3262 L_8DE1 leas 2,s
8DE3 7E8C92 L_8DE3 jmp L_8C92 ; push temp string onto varptr stack
8DE6 8D02 ASC_dispatch bsr L_8DEA ; get 1st character of string into B
8DE8 20DF bra L_8DC9 ; assign B to FPA1
8DEA 8DE0 L_8DEA bsr L_8DCC ; validate string & test length
8DEC 275E beq do_fc_error_8E4C ; ?FC ERROR
8DEE E684 ldb ,x
8DF0 39 rts
8DF1 8D48 LEFTstr_dispatch bsr L_8E3B ; get str varptr in X & $4D, arg. in A & B
8DF3 4F L_8DF3 clra
8DF4 E184 L_8DF4 cmpb ,x
8DF6 2303 bls L_8DFB ; number of chrs <= string length
8DF8 E684 ldb ,x
8DFA 4F clra
8DFB 3406 L_8DFB pshs a,b
8DFD BD8C52 jsr L_8C52 ; reserve B bytes of string space
8E00 9E4D ldx <$4d
8E02 8D9B bsr DELVAR ; point X to string & length in B
8E04 3504 puls b
8E06 3A abx ; adjust string start for MID$ / RIGHT$
8E07 3504 puls b
8E09 BD8D8B jsr L_8D8B ; copy string of length B from X+ to ($25)+
8E0C 20D5 bra L_8DE3 ; push temp string onto varptr stack
8E0E 8D2B RIGHTstr_dispatch bsr L_8E3B ; get str varptr in X & $4D, arg. in A & B
8E10 A084 suba ,x
8E12 40 nega ; A = string length - argument
8E13 20DF bra L_8DF4 ; create new string
8E15 C6FF MIDstr_dispatch ldb #$ff ; default length
8E17 D753 stb <$53
8E19 9DA5 jsr <$a5 ; get current character from BASIC source
8E1B 8129 cmpa #$29
8E1D 2705 beq L_8E24 ; length not specified
8E1F BD89AA jsr CkComa ; skip comma
8E22 8D2D bsr Get8Bit ; get number into B (& $53)
8E24 8D15 L_8E24 bsr L_8E3B ; get str varptr in X & $4D, arg. in A & B
8E26 2724 beq do_fc_error_8E4C ; ?FC ERROR
8E28 5F clrb
8E29 4A deca ; A = pos - 1
8E2A A184 cmpa ,x
8E2C 24CD bcc L_8DFB ; pos past end - create empty string
8E2E 1F89 tfr a,b
8E30 E084 subb ,x
8E32 50 negb ; B = string length - pos
8E33 D153 cmpb <$53
8E35 23C4 bls L_8DFB ; no. of chrs available <= requested length
8E37 D653 ldb <$53
8E39 20C0 bra L_8DFB ; use requested length
8E3B BD89A4 L_8E3B jsr CkClBrak ; skip close bracket
8E3E EEE4 ldu ,s
8E40 AE65 ldx 5,s
8E42 9F4D stx <$4d
8E44 A664 lda 4,s
8E46 E664 ldb 4,s
8E48 3267 leas 7,s
8E4A 1F35 tfr u,pc
8E4C 7E8B8D do_fc_error_8E4C jmp FC_error ; ?FC ERROR
8E4F 9D9F L_8E4F jsr <$9f ; get next character from BASIC source
8E51 BD8872 Get8Bit jsr L_8872 ; read numeric expression into FPA1
8E54 BD8B26 L_8E54 jsr L_8B26 ; read unsigned number into $52 & D from FPA1
8E57 4D tsta
8E58 26F2 bne do_fc_error_8E4C ; ?FC ERROR
8E5A 0EA5 jmp <$a5 ; get current character from BASIC source
8E5C BD8DCC VAL_dispatch jsr L_8DCC ; validate string & test length
8E5F 1027031F lbeq L_9182 ; clear exponents in FPA1 ($4f & $54)
8E63 DEA6 ldu <$a6 ; save source pointer
8E65 9FA6 stx <$a6 ; point source pointer to start of string
8E67 3A abx
8E68 A684 lda ,x ; save byte at end of string
8E6A 3452 pshs a,x,u
8E6C 6F84 clr ,x ; put a zero at end of string
8E6E 9DA5 jsr <$a5 ; get current character from BASIC source
8E70 BD94BD jsr L_94BD ; read numeric expression into FPA1
8E73 3552 puls a,x,u
8E75 A784 sta ,x ; restore byte at end of string
8E77 DFA6 stu <$a6 ; restore source pointer
8E79 39 rts
8E7A 8D07 L_8E7A bsr Get16Bit ; read 16 bit number into X
8E7C 9F2B stx <$2b
8E7E BD89AA L_8E7E jsr CkComa ; skip comma
8E81 20CE bra Get8Bit ; get number into B
8E83 BD8872 Get16Bit jsr L_8872 ; read numeric expression into FPA1
8E86 9654 L_8E86 lda <$54 ; * read 16 bit unsigned number into X from FPA1
8E88 2BC2 bmi do_fc_error_8E4C ; ?FC ERROR
8E8A 964F lda <$4f
8E8C 8190 cmpa #$90
8E8E 22BC bhi do_fc_error_8E4C ; ?FC ERROR
8E90 BD9473 jsr L_9473 ; denormalize FPA1 to an integer
8E93 9E52 ldx <$52
8E95 39 rts
8E96 8DEE PEEK_dispatch bsr L_8E86 ; read 16 bit number into X from FPA1
8E98 E684 ldb ,x
8E9A 7E8C36 jmp Assign8Bit ; assign B to FPA1
8E9D 8DDB POKE_dispatch bsr L_8E7A ; read pair of numbers into $2b/2c & B
8E9F 9E2B ldx <$2b
8EA1 E784 stb ,x
8EA3 39 rts
8EA4 C6FE LLIST_dispatch ldb #$fe ; * LLIST
8EA6 D76F stb <$6f ; DEVN
8EA8 9DA5 jsr <$a5 ; get current character from BASIC source
8EAA 3401 LIST_dispatch pshs cc ; * LIST
8EAC BD869A jsr L_869A ; read line number & store in $2b
8EAF BD83FF jsr basic_line_after_2b ; search program for line number in <$2b
8EB2 9F66 stx <$66
8EB4 3501 puls cc
8EB6 2712 beq L_8ECA
8EB8 9DA5 jsr <$a5 ; get current character from BASIC source
8EBA 2713 beq L_8ECF
8EBC 81C4 cmpa #$c4 ; token -
8EBE 2609 bne L_8EC9
8EC0 9D9F jsr <$9f ; get next character from BASIC source
8EC2 2706 beq L_8ECA
8EC4 BD869A jsr L_869A ; read line number & store in $2b
8EC7 2706 beq L_8ECF
8EC9 39 L_8EC9 rts
8ECA CEFFFF L_8ECA ldu #$ffff
8ECD DF2B stu <$2b
8ECF 3262 L_8ECF leas 2,s
8ED1 9E66 ldx <$66
8ED3 BD90A5 L_8ED3 jsr L_90A5 ; initialise virtual DEVN device & new line
8ED6 BDB77B jsr L_B77B ; scan for BREAK & pause if DEVN is not -1
8ED9 EC84 ldd ,x
8EDB 2608 bne L_8EE5
8EDD BDB663 L_8EDD jsr L_B663 ; close DEVN stream
8EE0 0F6F clr <$6f ; DEVN
8EE2 7E8371 jmp goto_ok_prompt ; command mode
8EE5 9F66 L_8EE5 stx <$66
8EE7 EC02 ldd 2,x
8EE9 10932B cmpd <$2b
8EEC 22EF bhi L_8EDD
8EEE BD957A jsr print_D ; print unsigned number in D
8EF1 BD90F5 jsr L_90F5 ; print a space to DEVN
8EF4 9E66 ldx <$66
8EF6 8D10 bsr L_8F08 ; detokenize BASIC line
8EF8 AE9F0066 ldx [$0066]
8EFC CE02DD ldu #$02dd
8EFF A6C0 L_8EFF lda ,u+
8F01 27D0 beq L_8ED3
8F03 BD90FA jsr L_90FA ; output character to DEVN
8F06 20F7 bra L_8EFF
8F08 BD01A6 L_8F08 jsr >$01a6 ; PATCH - detokenize
8F0B 3004 leax 4,x
8F0D 108E02DD ldy #$02dd
8F11 A680 L_8F11 lda ,x+
8F13 2751 beq L_8F66
8F15 2B15 bmi L_8F2C
8F17 813A cmpa #$3a
8F19 260D bne L_8F28
8F1B E684 ldb ,x
8F1D C184 cmpb #$84
8F1F 27F0 beq L_8F11
8F21 C183 cmpb #$83
8F23 27EC beq L_8F11
8F25 8C fcb $8c ; cmpx #$8621 - comment byte
8F26 8621 L_8F26 lda #$21 ; usually skipped by comment byte
8F28 8D30 L_8F28 bsr L_8F5A
8F2A 20E5 bra L_8F11
8F2C CE0116 L_8F2C ldu #$0116
8F2F 81FF cmpa #$ff
8F31 2604 bne L_8F37
8F33 A680 lda ,x+
8F35 3345 leau 5,u
8F37 847F L_8F37 anda #$7f
8F39 334A L_8F39 leau 10,u
8F3B 6DC4 tst ,u
8F3D 27E7 beq L_8F26
8F3F A0C4 suba ,u
8F41 2AF6 bpl L_8F39
8F43 ABC4 adda ,u
8F45 EE41 ldu 1,u
8F47 4A L_8F47 deca
8F48 2B06 bmi L_8F50
8F4A 6DC0 L_8F4A tst ,u+
8F4C 2AFC bpl L_8F4A
8F4E 20F7 bra L_8F47
8F50 A6C4 L_8F50 lda ,u
8F52 8D06 bsr L_8F5A
8F54 6DC0 tst ,u+
8F56 2AF8 bpl L_8F50
8F58 20B7 bra L_8F11
8F5A 108C03D6 L_8F5A cmpy #$03d6
8F5E 2406 bcc L_8F66
8F60 847F anda #$7f
8F62 A7A0 sta ,y+
8F64 6FA4 clr ,y
8F66 39 L_8F66 rts
8F67 BD01A3 L_8F67 jsr >$01a3 ; PATCH - tokenize
8F6A 9EA6 ldx <$a6 ; BASIC source pointer
8F6C CE02DC ldu #$02dc
8F6F 0F43 L_8F6F clr <$43
8F71 0F44 clr <$44
8F73 A680 L_8F73 lda ,x+
8F75 2721 beq L_8F98
8F77 0D43 tst <$43
8F79 270F beq L_8F8A
8F7B BD8ADF jsr L_8ADF ; carry clear if A-Z
8F7E 2418 bcc L_8F98
8F80 8130 cmpa #$30
8F82 2504 bcs L_8F88
8F84 8139 cmpa #$39
8F86 2310 bls L_8F98
8F88 0F43 L_8F88 clr <$43
8F8A 8120 L_8F8A cmpa #$20
8F8C 270A beq L_8F98
8F8E 9742 sta <$42
8F90 8122 cmpa #$22
8F92 2738 beq L_8FCC
8F94 0D44 tst <$44
8F96 2719 beq L_8FB1
8F98 A7C0 L_8F98 sta ,u+
8F9A 2706 beq L_8FA2
8F9C 813A cmpa #$3a
8F9E 27CF beq L_8F6F
8FA0 20D1 L_8FA0 bra L_8F73
8FA2 6FC0 L_8FA2 clr ,u+
8FA4 6FC0 clr ,u+
8FA6 1F30 tfr u,d
8FA8 8302DA subd #$02da
8FAB 8E02DB ldx #$02db
8FAE 9FA6 stx <$a6 ; BASIC source pointer
8FB0 39 rts
8FB1 813F L_8FB1 cmpa #$3f
8FB3 2604 bne L_8FB9
8FB5 8687 lda #$87
8FB7 20DF bra L_8F98
8FB9 8127 L_8FB9 cmpa #$27
8FBB 2613 bne L_8FD0
8FBD CC3A83 ldd #$3a83
8FC0 EDC1 std ,u++
8FC2 0F42 L_8FC2 clr <$42
8FC4 A680 L_8FC4 lda ,x+
8FC6 27D0 beq L_8F98
8FC8 9142 cmpa <$42
8FCA 27CC beq L_8F98
8FCC A7C0 L_8FCC sta ,u+
8FCE 20F4 bra L_8FC4
8FD0 8130 L_8FD0 cmpa #$30
8FD2 2504 bcs L_8FD8
8FD4 813C cmpa #$3c
8FD6 25C0 bcs L_8F98
8FD8 301F L_8FD8 leax -1,x
8FDA 3450 pshs x,u
8FDC 0F41 clr <$41
8FDE CE0116 ldu #$0116
8FE1 0F42 L_8FE1 clr <$42
8FE3 334A L_8FE3 leau 10,u
8FE5 A6C4 lda ,u
8FE7 2731 beq L_901A
8FE9 10AE41 ldy 1,u
8FEC AEE4 L_8FEC ldx ,s
8FEE E6A0 L_8FEE ldb ,y+
8FF0 E080 subb ,x+
8FF2 27FA beq L_8FEE
8FF4 C180 cmpb #$80
8FF6 2638 bne L_9030
8FF8 3262 leas 2,s
8FFA 3540 puls u
8FFC DA42 orb <$42
8FFE 9641 lda <$41
9000 2606 bne L_9008
9002 C184 cmpb #$84
9004 2606 bne L_900C
9006 863A lda #$3a
9008 EDC1 L_9008 std ,u++
900A 2094 bra L_8FA0
900C E7C0 L_900C stb ,u+
900E C186 cmpb #$86
9010 2602 bne L_9014
9012 0C44 inc <$44
9014 C182 L_9014 cmpb #$82
9016 27AA beq L_8FC2
9018 2086 L_9018 bra L_8FA0
901A CE011B L_901A ldu #$011b
901D 0341 com <$41
901F 26C0 bne L_8FE1
9021 3550 puls x,u
9023 A680 lda ,x+
9025 A7C0 sta ,u+
9027 BD8ADF jsr L_8ADF ; carry clear if A-Z
902A 25EC bcs L_9018
902C 0343 com <$43
902E 20E8 bra L_9018
9030 0C42 L_9030 inc <$42
9032 4A deca
9033 27AE beq L_8FE3
9035 313F leay -1,y
9037 E6A0 L_9037 ldb ,y+
9039 2AFC bpl L_9037
903B 20AF bra L_8FEC
903D 2762 PRINT_dispatch beq print_CR ; send CR to DEVN
903F 8D03 bsr L_9044
9041 0F6F clr <$6f ; DEVN
9043 39 rts
9044 8140 L_9044 cmpa #$40
9046 2605 bne L_904D
9048 BDB786 jsr L_B786 ; handle PRINT@
904B 200A bra L_9057
904D 8123 L_904D cmpa #$23
904F 260D bne L_905E
9051 BDB7D7 jsr L_B7D7 ; read #-n & set up DEVN
9054 BDB63C jsr L_B63C ; if DEVN = -1, test cassette OK for output
9057 9DA5 L_9057 jsr <$a5 ; get current character from BASIC source
9059 2746 beq print_CR ; send CR to DEVN
905B BD89AA jsr CkComa ; skip comma
905E 81CD L_905E cmpa #$cd ; token USING
9060 102711C1 lbeq L_A225
9064 2748 L_9064 beq L_90AE ; RTS
9066 81BB L_9066 cmpa #$bb ; token TAB(
9068 275D beq L_90C7
906A 812C cmpa #$2c
906C 2741 beq L_90AF
906E 813B cmpa #$3b
9070 276E beq L_90E0 ; skip semicolon
9072 BD8887 jsr get_string ; get expression
9075 9606 lda <$06 ; numeric / string flag
9077 3402 pshs a
9079 2606 bne L_9081 ; string expression
907B BD9587 jsr L_9587 ; convert FPA1 to string at $3DA
907E BD8C59 jsr L_8C59 ; register string at X
9081 8D65 L_9081 bsr L_90E8 ; print string just compiled
9083 3504 puls b
9085 BDB595 jsr L_B595 ; initialise virtual DEVN device
9088 0D6E tst <$6e ; cassette IO flag
908A 2706 beq L_9092 ; no IO in progress
908C 8D13 bsr print_CR ; send CR to DEVN
908E 9DA5 jsr <$a5 ; get current character from BASIC source
9090 20D2 bra L_9064
9092 5D L_9092 tstb
9093 2608 bne L_909D ; string just printed so no space
9095 9DA5 jsr <$a5 ; get current character from BASIC source
9097 812C cmpa #$2c
9099 2714 beq L_90AF
909B 8D58 bsr L_90F5 ; print a space to DEVN
909D 9DA5 L_909D jsr <$a5 ; get current character from BASIC source
909F 26C5 bne L_9066
90A1 860D print_CR lda #$0d ; * send CR to DEVN
90A3 2055 bra L_90FA ; output character to DEVN
90A5 BDB595 L_90A5 jsr L_B595 ; initialise virtual DEVN device
90A8 27F7 beq print_CR ; send CR to DEVN
90AA 966C lda <$6c ; device current column
90AC 26F3 bne print_CR ; send CR to DEVN
90AE 39 L_90AE rts
90AF BDB595 L_90AF jsr L_B595 ; initialise virtual DEVN device
90B2 270A beq L_90BE
90B4 D66C ldb <$6c ; device current column
90B6 D16B cmpb <$6b ; device last comma field
90B8 2506 bcs L_90C0
90BA 8DE5 bsr print_CR ; send CR to DEVN
90BC 2022 bra L_90E0
90BE D66C L_90BE ldb <$6c ; device current column
90C0 D06A L_90C0 subb <$6a ; device comma field width
90C2 24FC bcc L_90C0
90C4 50 negb
90C5 2010 bra L_90D7
90C7 BD8E4F L_90C7 jsr L_8E4F ; skip character & get number in B
90CA 8129 cmpa #$29
90CC 1026F8E4 lbne SN_error ; ?SN ERROR
90D0 BDB595 jsr L_B595 ; initialise virtual DEVN device
90D3 D06C subb <$6c ; device current column
90D5 2309 bls L_90E0
90D7 0D6E L_90D7 tst <$6e ; cassette IO flag
90D9 2605 bne L_90E0 ; IO in progress
90DB 8D18 L_90DB bsr L_90F5 ; print a space to DEVN
90DD 5A decb
90DE 26FB bne L_90DB
90E0 9D9F L_90E0 jsr <$9f ; get next character from BASIC source
90E2 7E9064 jmp L_9064
90E5 BD8C5B out_string jsr L_8C5B ; compile literal string at X
90E8 BD8D9D L_90E8 jsr L_8D9D ; point X to string just compiled & len in B
90EB 5C incb
90EC 5A L_90EC decb
90ED 27BF beq L_90AE ; RTS
90EF A680 lda ,x+
90F1 8D07 bsr L_90FA ; output character to DEVN
90F3 20F7 bra L_90EC
90F5 8620 L_90F5 lda #$20 ; * print a space to DEVN
90F7 8C fcb $8c ; cmpx #L_863F - comment byte
90F8 863F L_90F8 lda #$3f ; usually skipped by comment byte
90FA 7EB54A L_90FA jmp OUTCHR ; output character to DEVN
90FD 8E966E L_90FD ldx #data_966E ; FP constant 0.5
9100 2009 bra L_910B ; add varptr X to FPA1
9102 BD92DA L_9102 jsr L_92DA ; load FPA2 from varptr X
9105 0354 oper_minus_dispatch com <$54
9107 0362 com <$62
9109 2003 bra oper_plus_dispatch
910B BD92DA L_910B jsr L_92DA ; load FPA2 from varptr X
910E 5D oper_plus_dispatch tstb ; FPA1 exponent
910F 102702E2 lbeq L_93F5 ; copy FPA2 to FPA1 (because FPA1 zero)
9113 8E005C ldx #$005c ; FPA2
9116 1F89 L_9116 tfr a,b ; A = B = FPA2 exponent
9118 5D tstb
9119 276C beq L_9187 ; RTS (FPA2 is zero)
911B D04F subb <$4f ; B = FPA2 exponent - FPA1 exponent
911D 2769 beq L_9188 ; FPA1 & FPA2 same order
911F 250A bcs L_912B ; FPA1 higher order
9121 974F sta <$4f
9123 9661 lda <$61
9125 9754 sta <$54
9127 8E004F ldx #$004f ; FPA1
912A 50 negb
912B C1F8 L_912B cmpb #$f8
912D 2F59 ble L_9188 ; more than 8 bits to shift
912F 4F clra
9130 6401 lsr 1,x
9132 BD9203 jsr L_9203 ; shift mantissa of varptr X right -B bits
9135 D662 L_9135 ldb <$62 ; (carries into A)
9137 2A0B bpl L_9144 ; FPA1 & FPA2 same sign
9139 6301 com 1,x
913B 6302 com 2,x ; 2's complement FPA1
913D 6303 com 3,x ; carry is picked up below
913F 6304 com 4,x
9141 43 coma
9142 8900 adca #$00
9144 9763 L_9144 sta <$63
9146 9653 lda <$53
9148 9960 adca <$60 ; add mantissa in FPA2 to FPA1
914A 9753 sta <$53
914C 9652 lda <$52
914E 995F adca <$5f
9150 9752 sta <$52
9152 9651 lda <$51
9154 995E adca <$5e
9156 9751 sta <$51
9158 9650 lda <$50
915A 995D adca <$5d
915C 9750 sta <$50
915E 5D tstb
915F 2A44 bpl L_91A5 ; signs were same
9161 2502 L_9161 bcs L_9165 ; normalize FPA1
9163 8D5D bsr L_91C2 ; 2's complent mantissa in FPA1
9165 5F L_9165 clrb
9166 9650 L_9166 lda <$50
9168 262E bne L_9198 ; normalize bit-wise
916A 9651 lda <$51
916C 9750 sta <$50
916E 9652 lda <$52
9170 9751 sta <$51
9172 9653 lda <$53
9174 9752 sta <$52
9176 9663 lda <$63
9178 9753 sta <$53
917A 0F63 clr <$63
917C CB08 addb #$08
917E C128 cmpb #$28
9180 2DE4 blt L_9166
9182 4F L_9182 clra
9183 974F L_9183 sta <$4f
9185 9754 sta <$54
9187 39 L_9187 rts
9188 8D6D L_9188 bsr L_91F7 ; shift mantissa of varptr X right -B bits
918A 5F clrb
918B 20A8 bra L_9135
918D 5C L_918D incb
918E 0863 lsl <$63
9190 0953 rol <$53
9192 0952 rol <$52
9194 0951 rol <$51
9196 0950 rol <$50
9198 2AF3 L_9198 bpl L_918D
919A 964F lda <$4f
919C 3404 pshs b
919E A0E0 suba ,s+
91A0 974F sta <$4f
91A2 23DE bls L_9182 ; clear exponents in FPA1 ($4f & $54)
91A4 8C fcb $8c ; cmpx #$2508 - comment byte
91A5 2508 L_91A5 bcs L_91AF ; usually skipped by comment byte
91A7 0863 lsl <$63 ; * (91A5 2508 BCS $91AF)
91A9 8600 lda #$00
91AB 9763 sta <$63
91AD 200C bra L_91BB
91AF 0C4F L_91AF inc <$4f
91B1 2728 beq OV_error ; ?OV ERROR
91B3 0650 ror <$50
91B5 0651 ror <$51
91B7 0652 ror <$52
91B9 0653 ror <$53
91BB 2404 L_91BB bcc L_91C1
91BD 8D0D bsr L_91CC ; add the carry to mantissa in FPA1
91BF 27EE beq L_91AF
91C1 39 L_91C1 rts
91C2 0354 L_91C2 com <$54 ; * 2's complement mantissa in FPA1
91C4 0350 L_91C4 com <$50
91C6 0351 com <$51
91C8 0352 com <$52
91CA 0353 com <$53
91CC 9E52 L_91CC ldx <$52
91CE 3001 leax 1,x
91D0 9F52 stx <$52
91D2 2606 bne L_91DA
91D4 9E50 ldx <$50
91D6 3001 leax 1,x
91D8 9F50 stx <$50
91DA 39 L_91DA rts
91DB C60A OV_error ldb #$0a ; ?OV ERROR
91DD 7E8344 jmp system_error ; cause error
91E0 8E0012 L_91E0 ldx #$0012 ; * (shifts 8 bits before testing B)
91E3 A604 L_91E3 lda 4,x
91E5 9763 sta <$63
91E7 A603 lda 3,x
91E9 A704 sta 4,x
91EB A602 lda 2,x
91ED A703 sta 3,x
91EF A601 lda 1,x
91F1 A702 sta 2,x
91F3 965B lda <$5b
91F5 A701 sta 1,x
91F7 CB08 L_91F7 addb #$08 ; * shift mantissa of varptr X right -B bits
91F9 2FE8 ble L_91E3
91FB 9663 lda <$63
91FD C008 subb #$08
91FF 270C beq L_920D ; RTS
9201 6701 L_9201 asr 1,x
9203 6602 L_9203 ror 2,x
9205 6603 ror 3,x
9207 6604 ror 4,x
9209 46 rora
920A 5C incb
920B 26F4 bne L_9201
920D 39 L_920D rts
920E 8100000000 data_920E fcb $81,$00,$00,$00,$00 ; FP constant 1
9213 037F5E56CB data_9213 fcb $03,$7f,$5e,$56,$cb ; * log series coefficients
9218 7980139B0B fcb $79,$80,$13,$9b,$0b
921D 6480763893 fcb $64,$80,$76,$38,$93
9222 168238AA3B20 fcb $16,$82,$38,$aa,$3b,$20
9228 803504F334 data_9228 fcb $80,$35,$04,$f3,$34 ; FP constant root 2 / 2
922D 813504F334 data_922D fcb $81,$35,$04,$f3,$34 ; FP constant root 2
9232 8080000000 data_9232 fcb $80,$80,$00,$00,$00 ; FP constant -0.5
9237 80317217F8 data_9237 fcb $80,$31,$72,$17,$f8 ; FP constant ln2
923C BD9418 LOG_dispatch jsr L_9418 ; sets B to -1, 0 or 1 as per sign of FPA1
923F 102FF94A lble FC_error ; ?FC ERROR
9243 8E9228 ldx #data_9228 ; FP constant root 2 / 2
9246 964F lda <$4f
9248 8080 suba #$80
924A 3402 pshs a
924C 8680 lda #$80
924E 974F sta <$4f
9250 BD910B jsr L_910B ; add varptr X to FPA1
9253 8E922D ldx #data_922D ; FP constant root 2
9256 BD933A jsr L_933A ; FPA1 = varptr X / FPA1
9259 8E920E ldx #data_920E ; FP constant 1
925C BD9102 jsr L_9102 ; FPA1 = varptr X - FPA1
925F 8E9213 ldx #data_9213 ; series coefficients
9262 BD9743 jsr L_9743 ; calculate odd power series
9265 8E9232 ldx #data_9232 ; FP constant -0.5
9268 BD910B jsr L_910B ; add varptr X to FPA1
926B 3504 puls b
926D BD9547 jsr L_9547 ; add B to FPA1
9270 8E9237 ldx #data_9237 ; FP constant ln2
9273 8D65 L_9273 bsr L_92DA ; load FPA2 from varptr X
9275 2762 oper_mul_dispatch beq L_92D9 ; RTS (FPA1 zero)
9277 8D7A bsr L_92F3 ; add A to exponent in FPA1
9279 8600 L_9279 lda #$00
927B 9713 sta <$13
927D 9714 sta <$14
927F 9715 sta <$15
9281 9716 sta <$16
9283 D653 ldb <$53
9285 8D22 bsr L_92A9 ; multiply mantissa in FPA2 by B
9287 D663 ldb <$63
9289 D7AE stb <$ae
928B D652 ldb <$52
928D 8D1A bsr L_92A9 ; multiply mantissa in FPA2 by B
928F D663 ldb <$63
9291 D7AD stb <$ad
9293 D651 ldb <$51
9295 8D12 bsr L_92A9 ; multiply mantissa in FPA2 by B
9297 D663 ldb <$63
9299 D7AC stb <$ac
929B D650 ldb <$50
929D 8D0E bsr L_92AD
929F D663 ldb <$63
92A1 D7AB stb <$ab
92A3 BD93B6 jsr L_93B6 ; copy mantissa from $13 - $16 to FPA1
92A6 7E9165 jmp L_9165 ; normalize FPA1
92A9 1027FF33 L_92A9 lbeq L_91E0 ; B=0 (shift $13 - $16 & $63 right 8 bits)
92AD 43 L_92AD coma
92AE 9613 L_92AE lda <$13
92B0 56 rorb
92B1 2726 beq L_92D9 ; RTS
92B3 2416 bcc L_92CB
92B5 9616 lda <$16
92B7 9B60 adda <$60
92B9 9716 sta <$16
92BB 9615 lda <$15
92BD 995F adca <$5f
92BF 9715 sta <$15
92C1 9614 lda <$14
92C3 995E adca <$5e
92C5 9714 sta <$14
92C7 9613 lda <$13
92C9 995D adca <$5d
92CB 46 L_92CB rora
92CC 9713 sta <$13
92CE 0614 ror <$14
92D0 0615 ror <$15
92D2 0616 ror <$16
92D4 0663 ror <$63
92D6 4F clra
92D7 20D5 bra L_92AE
92D9 39 L_92D9 rts
92DA EC01 L_92DA ldd 1,x ; * B = exponent from FPA1
92DC 9761 sta <$61
92DE 8A80 ora #$80
92E0 DD5D std <$5d
92E2 D661 ldb <$61
92E4 D854 eorb <$54
92E6 D762 stb <$62
92E8 EC03 ldd 3,x
92EA DD5F std <$5f
92EC A684 lda ,x
92EE 975C sta <$5c
92F0 D64F ldb <$4f
92F2 39 rts
92F3 4D L_92F3 tsta ; * add A to exponent in FPA1
92F4 2716 beq L_930C
92F6 9B4F adda <$4f
92F8 46 rora
92F9 49 rola
92FA 2810 bvc L_930C
92FC 8B80 adda #$80
92FE 974F sta <$4f
9300 270C beq L_930E ; clear exponents in FPA1 ($4f & $54)
9302 9662 lda <$62 ; sign difference FPA1 / FPA2
9304 9754 sta <$54
9306 39 rts
9307 9654 L_9307 lda <$54
9309 43 coma
930A 2002 bra L_930E
930C 3262 L_930C leas 2,s
930E 102AFE70 L_930E lbpl L_9182 ; clear exponents in FPA1 ($4f & $54)
9312 7E91DB do_ov_error_9312 jmp OV_error ; ?OV ERROR
9315 BD940A L_9315 jsr L_940A ; copy FPA1 to FPA2
9318 270D beq L_9327
931A 8B02 adda #$02 ; x4
931C 25F4 bcs do_ov_error_9312 ; ?OV ERROR
931E 0F62 clr <$62
9320 BD9116 jsr L_9116 ; add FPA2 to FPA1 (FPA1 exponent in A)
9323 0C4F inc <$4f ; double result
9325 27EB beq do_ov_error_9312 ; ?OV ERROR
9327 39 L_9327 rts
9328 8420000000 data_9328 fcb $84,$20,$00,$00,$00 ; FP constant 10
932D BD940A L_932D jsr L_940A ; copy FPA1 to FPA2
9330 8E9328 ldx #data_9328 ; FP constant 10
9333 5F clrb
9334 D762 L_9334 stb <$62
9336 BD93BF jsr MOVFM ; load variable into FPA1 (X is varptr)
9339 8C fcb $8c ; cmpx #DELVAR - 1 - comment byte
933A 8D9E L_933A bsr L_92DA ; usually skipped by comment byte
933C 2773 oper_div_dispatch beq D0_error ; ?/0 ERROR (FPA1 zero)
933E 004F neg <$4f
9340 8DB1 bsr L_92F3 ; add A to exponent in FPA1
9342 0C4F inc <$4f
9344 27CC beq do_ov_error_9312 ; ?OV ERROR
9346 8E0013 ldx #$0013
9349 C604 ldb #$04
934B D703 stb <$03
934D C601 ldb #$01
934F 9650 L_934F lda <$50
9351 915D cmpa <$5d
9353 2613 bne L_9368
9355 9651 lda <$51
9357 915E cmpa <$5e
9359 260D bne L_9368
935B 9652 lda <$52
935D 915F cmpa <$5f
935F 2607 bne L_9368
9361 9653 lda <$53
9363 9160 cmpa <$60
9365 2601 bne L_9368
9367 43 coma ; identical mantissas - set carry
9368 1FA8 L_9368 tfr cc,a
936A 59 rolb
936B 240A bcc L_9377
936D E780 stb ,x+
936F 0A03 dec <$03
9371 2B34 bmi L_93A7
9373 272E beq L_93A3
9375 C601 ldb #$01
9377 1F8A L_9377 tfr a,cc
9379 250E bcs L_9389
937B 0860 L_937B lsl <$60
937D 095F rol <$5f
937F 095E rol <$5e
9381 095D rol <$5d
9383 25E3 bcs L_9368
9385 2BC8 bmi L_934F
9387 20DF bra L_9368
9389 9660 L_9389 lda <$60
938B 9053 suba <$53
938D 9760 sta <$60
938F 965F lda <$5f
9391 9252 sbca <$52
9393 975F sta <$5f
9395 965E lda <$5e
9397 9251 sbca <$51
9399 975E sta <$5e
939B 965D lda <$5d
939D 9250 sbca <$50
939F 975D sta <$5d
93A1 20D8 bra L_937B
93A3 C640 L_93A3 ldb #$40
93A5 20D0 bra L_9377
93A7 56 L_93A7 rorb
93A8 56 rorb
93A9 56 rorb
93AA D763 stb <$63
93AC 8D08 bsr L_93B6 ; copy mantissa from $13 - $16 to FPA1
93AE 7E9165 jmp L_9165 ; normalize FPA1
93B1 C614 D0_error ldb #$14 ; ?/0 ERROR
93B3 7E8344 jmp system_error ; cause error
93B6 9E13 L_93B6 ldx <$13 ; * copy mantissa from $13 - $16 to FPA1
93B8 9F50 stx <$50
93BA 9E15 ldx <$15
93BC 9F52 stx <$52
93BE 39 rts
93BF 3402 MOVFM pshs a ; * load variable into FPA1 (X is varptr)
93C1 EC01 ldd 1,x
93C3 9754 sta <$54
93C5 8A80 ora #$80
93C7 DD50 std <$50
93C9 0F63 clr <$63
93CB E684 ldb ,x
93CD AE03 ldx 3,x
93CF 9F52 stx <$52
93D1 D74F stb <$4f
93D3 3582 puls a,pc
93D5 8E0045 L_93D5 ldx #$0045 ; * assign FPA1 to variable store $45 - $49
93D8 2006 bra L_93E0 ; assign FPA1 to varptr in X
93DA 8E0040 L_93DA ldx #$0040 ; * assign FPA1 to variable store $40 - $44
93DD 8C fcb $8c ; cmpx #$9e3b - comment byte
93DE 9E3B L_93DE ldx <$3b ; usually skipped by comment byte
93E0 964F L_93E0 lda <$4f ; * assign FPA1 to varptr in X
93E2 A784 sta ,x
93E4 9654 lda <$54
93E6 8A7F ora #$7f
93E8 9450 anda <$50
93EA A701 sta 1,x
93EC 9651 lda <$51
93EE A702 sta 2,x
93F0 DE52 ldu <$52
93F2 EF03 stu 3,x
93F4 39 rts
93F5 9661 L_93F5 lda <$61 ; * copy FPA2 to FPA1 (A = sign)
93F7 9754 L_93F7 sta <$54
93F9 9E5C ldx <$5c
93FB 9F4F stx <$4f
93FD 0F63 clr <$63
93FF 965E lda <$5e
9401 9751 sta <$51
9403 9654 lda <$54
9405 9E5F ldx <$5f
9407 9F52 stx <$52
9409 39 rts
940A DC4F L_940A ldd <$4f ; * copy FPA1 to FPA2 & test for exponent = 0
940C DD5C std <$5c
940E 9E51 ldx <$51
9410 9F5E stx <$5e
9412 9E53 ldx <$53
9414 9F60 stx <$60
9416 4D tsta
9417 39 rts
9418 D64F L_9418 ldb <$4f ; * sets B to -1, 0 or 1 according to sign of FPA1
941A 2708 beq L_9424
941C D654 L_941C ldb <$54
941E 59 L_941E rolb
941F C6FF ldb #$ff
9421 2501 bcs L_9424
9423 50 negb
9424 39 L_9424 rts
9425 8DF1 SGN_dispatch bsr L_9418 ; sets B to -1, 0 or 1 as per sign of FPA1
9427 D750 L_9427 stb <$50
9429 0F51 clr <$51
942B C688 ldb #$88
942D 9650 L_942D lda <$50
942F 8080 suba #$80 ; set carry according to sign
9431 D74F L_9431 stb <$4f
9433 DC8A ldd <$8a ; zero
9435 DD52 std <$52
9437 9763 sta <$63
9439 9754 sta <$54
943B 7E9161 jmp L_9161 ; normalize FPA1 (if carry clear, negate 1st)
943E 0F54 ABS_dispatch clr <$54 ; simply clear sign byte
9440 39 rts
9441 E684 L_9441 ldb ,x ; * compare FPA1 - varptr X (set B to -1, 0 or 1)
9443 27D3 beq L_9418 ; sets B to -1, 0 or 1 as per sign of FPA1
9445 E601 ldb 1,x
9447 D854 eorb <$54
9449 2BD1 bmi L_941C ; set B to -1 or 1 as per sign of FPA1
944B D64F L_944B ldb <$4f ; * compare FPA1 - varptr X (of same sign)
944D E184 cmpb ,x
944F 261D bne L_946E
9451 E601 ldb 1,x
9453 CA7F orb #$7f
9455 D450 andb <$50
9457 E101 cmpb 1,x
9459 2613 bne L_946E
945B D651 ldb <$51
945D E102 cmpb 2,x
945F 260D bne L_946E
9461 D652 ldb <$52
9463 E103 cmpb 3,x
9465 2607 bne L_946E
9467 D653 ldb <$53
9469 E004 subb 4,x
946B 2601 bne L_946E
946D 39 rts
946E 56 L_946E rorb ; turn carry into sign
946F D854 eorb <$54
9471 20AB bra L_941E ; reduce B to +/- 1
9473 D64F L_9473 ldb <$4f ; * denormalize FPA1 to an integer (but don't update exponent)
9475 273D beq L_94B4 ; clear mantissa in FPA1
9477 C0A0 subb #$a0
9479 9654 lda <$54
947B 2A05 bpl L_9482
947D 035B com <$5b
947F BD91C4 jsr L_91C4 ; 2's complement mantissa in FPA1 (not $54)
9482 8E004F L_9482 ldx #$004f ; FPA1
9485 C1F8 cmpb #$f8
9487 2E06 bgt L_948F
9489 BD91F7 jsr L_91F7 ; shift mantissa of varptr X right -B bits
948C 0F5B clr <$5b
948E 39 rts
948F 0F5B L_948F clr <$5b
9491 9654 lda <$54
9493 49 rola
9494 0650 ror <$50
9496 7E9203 jmp L_9203 ; shift mantissa of varptr X right -B bits
9499 D64F INT_dispach ldb <$4f ; * INT
949B C1A0 cmpb #$a0 ; when exponent >= $A0, no fractional part
949D 241D bcc L_94BC ; RTS (already an integer)
949F 8DD2 bsr L_9473 ; denormalize FPA1 to an integer
94A1 D763 stb <$63
94A3 9654 lda <$54
94A5 D754 stb <$54
94A7 8080 suba #$80
94A9 86A0 lda #$a0
94AB 974F sta <$4f
94AD 9653 lda <$53
94AF 9701 sta <$01
94B1 7E9161 jmp L_9161 ; normalize FPA1 (if carry clear, negate 1st)
94B4 D750 L_94B4 stb <$50 ; * clear mantissa in FPA1
94B6 D751 stb <$51
94B8 D752 stb <$52
94BA D753 stb <$53
94BC 39 L_94BC rts
94BD 9E8A L_94BD ldx <$8a ; zero
94BF 9F54 stx <$54
94C1 9F4F stx <$4f
94C3 9F51 stx <$51
94C5 9F52 stx <$52
94C7 9F47 stx <$47 ; $47 & $48 = decimal exponent & sign
94C9 9F45 stx <$45 ; $45 & $46 decimal place counter & flag
94CB 2567 bcs L_9534 ; read sig. figs. into FPA1
94CD 8126 cmpa #$26
94CF 10270748 lbeq L_9C1B ; read hex or octal
94D3 812D cmpa #$2d
94D5 2604 bne L_94DB
94D7 0355 com <$55
94D9 2004 bra L_94DF
94DB 812B L_94DB cmpa #$2b
94DD 2604 bne L_94E3
94DF 9D9F L_94DF jsr <$9f ; get next character from BASIC source
94E1 2551 bcs L_9534 ; read sig. figs. into FPA1
94E3 812E L_94E3 cmpa #$2e
94E5 2728 beq L_950F
94E7 8145 cmpa #$45
94E9 2628 bne L_9513 ; finished reading number, now finalise.
94EB 9D9F jsr <$9f ; get next character from BASIC source
94ED 2564 bcs L_9553 ; read decimal exponent into $47
94EF 81C4 cmpa #$c4 ; token -
94F1 270E beq L_9501
94F3 812D cmpa #$2d
94F5 270A beq L_9501
94F7 81C3 cmpa #$c3 ; token +
94F9 2708 beq L_9503
94FB 812B cmpa #$2b
94FD 2704 beq L_9503
94FF 2006 bra L_9507
9501 0348 L_9501 com <$48
9503 9D9F L_9503 jsr <$9f ; get next character from BASIC source
9505 254C bcs L_9553 ; read decimal exponent into $47
9507 0D48 L_9507 tst <$48
9509 2708 beq L_9513 ; finished reading number, now finalise.
950B 0047 neg <$47 ; -ve exponent
950D 2004 bra L_9513 ; finished reading number, now finalise.
950F 0346 L_950F com <$46
9511 26CC bne L_94DF ; 1st decimal point encountered
9513 9647 L_9513 lda <$47 ; * finished reading number, now finalise.
9515 9045 suba <$45
9517 9747 sta <$47
9519 2712 beq L_952D
951B 2A09 bpl L_9526
951D BD932D L_951D jsr L_932D ; divide FPA1 by 10
9520 0C47 inc <$47
9522 26F9 bne L_951D
9524 2007 bra L_952D
9526 BD9315 L_9526 jsr L_9315 ; multiply FPA1 by 10
9529 0A47 dec <$47
952B 26F9 bne L_9526
952D 9655 L_952D lda <$55
952F 2A8B bpl L_94BC ; RTS
9531 7E96DE jmp L_96DE ; COM $54 if FPA1 non zero
9534 D645 L_9534 ldb <$45 ; increment decimal place counter
9536 D046 subb <$46 ; if decimal point passed
9538 D745 stb <$45
953A 3402 pshs a
953C BD9315 jsr L_9315 ; multiply FPA1 by 10
953F 3504 puls b
9541 C030 subb #$30
9543 8D02 bsr L_9547 ; add B to FPA1
9545 2098 bra L_94DF
9547 BD93DA L_9547 jsr L_93DA ; assign FPA1 to variable store $40 - $44
954A BD9427 jsr L_9427 ; assign B to FPA1
954D 8E0040 ldx #$0040
9550 7E910B jmp L_910B ; add varptr X to FPA1
9553 D647 L_9553 ldb <$47 ; * (note that it doesn't check for more than two digits)
9555 58 lslb
9556 58 lslb
9557 DB47 addb <$47
9559 58 lslb ; B = 10 * $47
955A 8030 suba #$30
955C 3404 pshs b
955E ABE0 adda ,s+
9560 9747 sta <$47
9562 209F bra L_9503
9564 9B3EBC1FFD data_9564 fcb $9b,$3e,$bc,$1f,$fd ; FP constant 99999999.9
9569 9E6E6B27FD data_9569 fcb $9e,$6e,$6b,$27,$fd ; FP constant 999999999
956E 9E6E6B2800 data_956E fcb $9e,$6e,$6b,$28,$00 ; FP constant 1000000000
9573 8E82E5 L_9573 ldx #text_in - 1 ; * print 'IN xxxx' (current line number)
9576 8D0C bsr L_9584
9578 DC68 ldd <$68 ; current line number
957A DD50 print_D std <$50 ; * print unsigned number in D
957C C690 ldb #$90
957E 43 coma ; set carry for correct result
957F BD9431 jsr L_9431 ; normalize FPA1 using exponent in B
9582 8D03 bsr L_9587 ; convert FPA1 to string at $3DA
9584 7E90E5 L_9584 jmp out_string ; print string to DEVN
9587 CE03DA L_9587 ldu #$03da ; * convert FPA1 to string at $3DA
958A 8620 L_958A lda #$20
958C D654 ldb <$54
958E 2A02 bpl L_9592
9590 862D lda #$2d
9592 A7C0 L_9592 sta ,u+ ; print '-' for negative numbers else space
9594 DF64 stu <$64
9596 9754 sta <$54
9598 8630 lda #$30
959A D64F ldb <$4f
959C 102700C6 lbeq L_9666 ; number is zero
95A0 4F clra
95A1 C180 cmpb #$80
95A3 2208 bhi L_95AD ; number >= 1
95A5 8E956E ldx #data_956E ; FP constant 1000000000
95A8 BD9273 jsr L_9273 ; multiply varptr X & FPA1
95AB 86F7 lda #$f7 ; -9
95AD 9745 L_95AD sta <$45 ; decimal exponent
95AF 8E9569 L_95AF ldx #data_9569 ; FP constant 999999999
95B2 BD944B jsr L_944B ; compare FPA1 - varptr X (of same sign)
95B5 2E0F bgt L_95C6
95B7 8E9564 L_95B7 ldx #data_9564 ; FP constant 99999999.9
95BA BD944B jsr L_944B ; compare FPA1 - varptr X (of same sign)
95BD 2E0E bgt L_95CD ; (FPA1 is now 100000000 to 999999999)
95BF BD9315 jsr L_9315 ; multiply FPA1 by 10
95C2 0A45 dec <$45 ; correct exponent
95C4 20F1 bra L_95B7
95C6 BD932D L_95C6 jsr L_932D ; divide FPA1 by 10
95C9 0C45 inc <$45 ; correct exponent
95CB 20E2 bra L_95AF
95CD BD90FD L_95CD jsr L_90FD ; add 0.5 to FPA1 (round it up)
95D0 BD9473 jsr L_9473 ; denormalize FPA1 to an integer
95D3 C601 ldb #$01 ; 1 digit before point for sci. notation
95D5 9645 lda <$45
95D7 8B0A adda #$0a ; exponent now 2 more than it should be
95D9 2B09 bmi L_95E4 ; actual exponent < -2 (use sci. notation)
95DB 810B cmpa #$0b
95DD 2405 bcc L_95E4 ; actual exponent >= 9 (use sci. notation)
95DF 4A deca
95E0 1F89 tfr a,b ; number of digits before point = exp + 1
95E2 8602 lda #$02
95E4 4A L_95E4 deca
95E5 4A deca
95E6 9747 sta <$47 ; decimal exponent
95E8 D745 stb <$45 ; number of digits before decimal point
95EA 2E0D bgt L_95F9 ; no leading decimal point
95EC DE64 ldu <$64
95EE 862E lda #$2e
95F0 A7C0 sta ,u+
95F2 5D tstb ; can only be zero or -ve here
95F3 2704 beq L_95F9 ; no zero reqd after point & before 1st digit
95F5 8630 lda #$30
95F7 A7C0 sta ,u+
95F9 8E9673 L_95F9 ldx #data_9673
95FC C680 ldb #$80 ; sign bit used for zero crossing logic
95FE 9653 L_95FE lda <$53 ; resolves a decimal digit by adding powers
9600 AB03 adda 3,x ; of 10 until zero is passed.
9602 9753 sta <$53
9604 9652 lda <$52
9606 A902 adca 2,x ; On 1st pass -ve values are used to get FPA1
9608 9752 sta <$52 ; below zero. The digit is no. of loops - 1.
960A 9651 lda <$51
960C A901 adca 1,x ; On 2nd pass +ve values are used to get FPA1
960E 9751 sta <$51 ; above zero. The digit is 10 - no. loops.
9610 9650 lda <$50
9612 A984 adca ,x ; This continues with alternating signs.
9614 9750 sta <$50
9616 5C incb ; loop counter
9617 56 rorb ; logic to test if zero passed
9618 59 rolb
9619 28E3 bvc L_95FE
961B 2403 bcc L_9620 ; digit = loops - 1
961D C00B subb #$0b
961F 50 negb
9620 CB2F L_9620 addb #$2f ; 1 less & ASCII conversion
9622 3004 leax 4,x
9624 1F98 tfr b,a
9626 847F anda #$7f ; lose sign bit
9628 A7C0 sta ,u+
962A 0A45 dec <$45
962C 2604 bne L_9632 ; haven't reached decimal point yet
962E 862E lda #$2e
9630 A7C0 sta ,u+
9632 53 L_9632 comb ; alternates B between $00 & $80
9633 C480 andb #$80
9635 8C9697 cmpx #SQR_dispatch
9638 26C4 bne L_95FE
963A A6C2 L_963A lda ,-u ; backtrack over digits
963C 8130 cmpa #$30 ; until non-zero found
963E 27FA beq L_963A
9640 812E cmpa #$2e
9642 2602 bne L_9646 ; if no sig. figs. after decimal point
9644 335F leau -1,u ; then lose it.
9646 862B L_9646 lda #$2b
9648 D647 ldb <$47
964A 271C beq L_9668 ; normal number (no decimal exponent)
964C 2A03 bpl L_9651 ; +ve exponent
964E 862D lda #$2d
9650 50 negb
9651 A742 L_9651 sta 2,u
9653 8645 lda #$45
9655 A741 sta 1,u
9657 862F lda #$2f ; convert B to ASCII number in D
9659 4C L_9659 inca
965A C00A subb #$0a
965C 24FB bcc L_9659
965E CB3A addb #$3a
9660 ED43 std 3,u
9662 6F45 clr 5,u ; terminate string
9664 2004 bra L_966A
9666 A7C4 L_9666 sta ,u
9668 6F41 L_9668 clr 1,u ; terminate string
966A 8E03DA L_966A ldx #$03da
966D 39 L_966D rts
966E 8000000000 data_966E fcb $80,$00,$00,$00,$00 ; FP constant 0.5
9673 FA0A1F0000989680FFF0BDC0000186A0 data_9673 fcb $fa,$0a,$1f,$00,$00,$98,$96,$80,$ff,$f0,$bd,$c0,$00,$01,$86,$a0 ; -100000000
9683 FFFFD8F0000003E8FFFFFF9C0000000A fcb $ff,$ff,$d8,$f0,$00,$00,$03,$e8,$ff,$ff,$ff,$9c,$00,$00,$00,$0a ; -10000
9693 FFFFFFFF fcb $ff,$ff,$ff,$ff ; -1
9697 BD940A SQR_dispatch jsr L_940A ; copy FPA1 to FPA2
969A 8E966E ldx #data_966E ; FP constant 0.5
969D BD93BF jsr MOVFM ; load variable into FPA1 (X is varptr)
96A0 2771 oper_pow_dispatch beq EXP_dispatch ; EXP
96A2 4D tsta
96A3 2609 bne L_96AE
96A5 9654 lda <$54
96A7 102BFD06 lbmi D0_error ; ?/0 ERROR
96AB 7E9183 jmp L_9183 ; clear FPA1 exponents
96AE 8E004A L_96AE ldx #$004a
96B1 BD93E0 jsr L_93E0 ; assign FPA1 to varptr in X
96B4 5F clrb
96B5 9661 lda <$61
96B7 2A10 bpl L_96C9
96B9 BD9499 jsr INT_dispach ; INT
96BC 8E004A ldx #$004a
96BF 9661 lda <$61
96C1 BD944B jsr L_944B ; compare FPA1 - varptr X (of same sign)
96C4 2603 bne L_96C9
96C6 43 coma
96C7 D601 ldb <$01
96C9 BD93F7 L_96C9 jsr L_93F7 ; copy FPA2 to FPA1 & put A in $54
96CC 3404 pshs b
96CE BD923C jsr LOG_dispatch ; LOG
96D1 8E004A ldx #$004a
96D4 BD9273 jsr L_9273 ; multiply varptr X & FPA1
96D7 8D3A bsr EXP_dispatch ; EXP
96D9 3502 puls a
96DB 46 rora
96DC 248F bcc L_966D ; RTS
96DE 964F L_96DE lda <$4f
96E0 2702 beq L_96E4
96E2 0354 com <$54
96E4 39 L_96E4 rts
96E5 8138AA3B29 data_96E5 fcb $81,$38,$aa,$3b,$29 ; FP constant 1/ln 2
96EA 077134583E data_96EA fcb $07,$71,$34,$58,$3e ; * values appear to be error compensated
96EF 5674167EB31B772FEEE3857A1D841C2A fcb $56,$74,$16,$7e,$b3,$1b,$77,$2f,$ee,$e3,$85,$7a,$1d,$84,$1c,$2a
96FF 7C6359580A7E75FDE7C6803172181081 fcb $7c,$63,$59,$58,$0a,$7e,$75,$fd,$e7,$c6,$80,$31,$72,$18,$10,$81 ; FP constant .05550512686 (ln2)^3 / 3!
970F 00000000 fcb $00,$00,$00,$00
9713 8E96E5 EXP_dispatch ldx #data_96E5 ; FP constant 1/ln 2
9716 8D37 bsr L_974F ; multiply FPA1 by varptr X
9718 BD93DA jsr L_93DA ; assign FPA1 to variable store $40 - $44
971B 964F lda <$4f
971D 8188 cmpa #$88
971F 2503 bcs L_9724
9721 7E9307 L_9721 jmp L_9307 ; ?OV ERROR if FPA1 +ve else FPA1 = 0
9724 BD9499 L_9724 jsr INT_dispach ; INT
9727 9601 lda <$01 ; integer part of argument
9729 8B81 adda #$81
972B 27F4 beq L_9721 ; ?OV ERROR
972D 4A deca
972E 3402 pshs a
9730 8E0040 ldx #$0040
9733 BD9102 jsr L_9102 ; FPA1 = varptr X - FPA1
9736 8E96EA ldx #data_96EA ; EXP coefficient table
9739 8D17 bsr L_9752 ; series calculation
973B 0F62 clr <$62
973D 3502 puls a
973F BD92F3 jsr L_92F3 ; add A to exponent in FPA1
9742 39 rts
9743 9F64 L_9743 stx <$64 ; * result in FPA1
9745 BD93DA jsr L_93DA ; assign FPA1 to variable store $40 - $44
9748 8D05 bsr L_974F ; multiply varptr X & FPA1 (x squared)
974A 8D08 bsr L_9754 ; calculate series
974C 8E0040 ldx #$0040
974F 7E9273 L_974F jmp L_9273 ; multiply varptr X & FPA1 (odd powers)
9752 9F64 L_9752 stx <$64 ; * result in FPA1
9754 BD93D5 L_9754 jsr L_93D5 ; assign FPA1 to variable store $45 - $49
9757 9E64 ldx <$64
9759 E680 ldb ,x+
975B D755 stb <$55
975D 9F64 stx <$64
975F 8DEE L_975F bsr L_974F ; multiply varptr X & FPA1
9761 9E64 ldx <$64
9763 3005 leax 5,x
9765 9F64 stx <$64
9767 BD910B jsr L_910B ; add varptr X to FPA1
976A 8E0045 ldx #$0045
976D 0A55 dec <$55
976F 26EE bne L_975F
9771 39 rts
9772 BD9418 RND_dispatch jsr L_9418 ; sets B to -1, 0 or 1 as per sign of FPA1
9775 2B21 bmi L_9798
9777 2715 beq random_num
9779 8D10 bsr L_978B ; INT
977B BD93DA jsr L_93DA ; assign FPA1 to variable store $40 - $44
977E 8D0E bsr random_num
9780 8E0040 ldx #$0040
9783 8DCA bsr L_974F ; multiply varptr X & FPA1
9785 8E920E ldx #data_920E ; FP constant 1
9788 BD910B jsr L_910B ; add varptr X to FPA1
978B 7E9499 L_978B jmp INT_dispach ; INT
978E BE0116 random_num ldx >$0116
9791 9F50 stx <$50
9793 BE0118 ldx >$0118
9796 9F52 stx <$52
9798 BE97C7 L_9798 ldx L_97C7
979B 9F5D stx <$5d
979D BE97C9 ldx L_97C9
97A0 9F5F stx <$5f
97A2 BD9279 jsr L_9279 ; multiply FPA1 by mantissa in FPA2
97A5 DCAD ldd <$ad
97A7 C3658B addd #$658b
97AA FD0118 std >$0118
97AD DD52 std <$52
97AF DCAB ldd <$ab
97B1 C9B0 adcb #$b0
97B3 8905 adca #$05
97B5 FD0116 std >$0116
97B8 DD50 std <$50
97BA 0F54 clr <$54
97BC 8680 lda #$80
97BE 974F sta <$4f
97C0 9615 lda <$15
97C2 9763 sta <$63
97C4 7E9165 jmp L_9165 ; normalize FPA1
97C7 40E6 L_97C7 fcb $40,$e6 ; * RND multiplier
97C9 4DAB L_97C9 fcb $4d,$ab
97CB 8E983F COS_dispatch ldx #data_983F ; FP constant pi/2
97CE BD910B jsr L_910B ; add varptr X to FPA1
97D1 BD940A SIN_dispatch jsr L_940A ; copy FPA1 to FPA2
97D4 8E9844 ldx #data_9844 ; FP constant 2*pi
97D7 D661 ldb <$61
97D9 BD9334 jsr L_9334 ; STB $62 & divide FPA2 by varptr X (result FPA1)
97DC BD940A jsr L_940A ; copy FPA1 to FPA2
97DF 8DAA bsr L_978B ; INT
97E1 0F62 clr <$62
97E3 965C lda <$5c
97E5 D64F ldb <$4f
97E7 BD9105 jsr oper_minus_dispatch ; subtract FPA1 from FPA2 (B=FPA1 exponent)
97EA 8E9849 ldx #data_9849 ; FP constant 0.25
97ED BD9102 jsr L_9102 ; FPA1 = varptr X - FPA1
97F0 9654 lda <$54
97F2 3402 pshs a
97F4 2A09 bpl L_97FF ; angle is 1st quadrant
97F6 BD90FD jsr L_90FD ; add 0.5 to FPA1
97F9 9654 lda <$54
97FB 2B05 bmi L_9802
97FD 030A com <$0a
97FF BD96DE L_97FF jsr L_96DE ; COM $54 if FPA1 non zero
9802 8E9849 L_9802 ldx #data_9849 ; FP constant 0.25
9805 BD910B jsr L_910B ; add varptr X to FPA1
9808 3502 puls a
980A 4D tsta
980B 2A03 bpl L_9810
980D BD96DE jsr L_96DE ; COM $54 if FPA1 non zero
9810 8E984E L_9810 ldx #num_sin_coefficients ; series coefficients
9813 7E9743 L_9813 jmp L_9743 ; calculate odd power series
9816 BD93DA TAN_dispatch jsr L_93DA ; assign FPA1 to variable store $40 - $44
9819 0F0A clr <$0a
981B 8DB4 bsr SIN_dispatch ; SIN
981D 8E004A ldx #$004a
9820 BD93E0 jsr L_93E0 ; assign FPA1 to varptr in X
9823 8E0040 ldx #$0040
9826 BD93BF jsr MOVFM ; load variable into FPA1 (X is varptr)
9829 0F54 clr <$54
982B 960A lda <$0a
982D 8D0C bsr L_983B ; must calculate cos
982F 0D4F tst <$4f
9831 1027F9A6 lbeq OV_error ; ?OV ERROR
9835 8E004A ldx #$004a
9838 7E933A L_9838 jmp L_933A ; FPA1 = varptr X / FPA1
983B 3402 L_983B pshs a
983D 20C0 bra L_97FF
983F 81490FDAA2 data_983F fcb $81,$49,$0f,$da,$a2 ; FP constant pi/2
9844 83490FDAA2 data_9844 fcb $83,$49,$0f,$da,$a2 ; FP constant 2*pi
9849 7F00000000 data_9849 fcb $7f,$00,$00,$00,$00 ; FP constant 0.25
984E 05 num_sin_coefficients fcb $05 ; * values appear to be error compensated
984F 84E61A2D1B sin_coefficients fcb $84,$e6,$1a,$2d,$1b ; -((2*PI)**11)/11! / FP constant -14.38139067 -(2pi)^11 / 11!
9854 862807FBF8 fcb $86,$28,$07,$fb,$f8 ; ((2*PI)**9)/9! / FP constant 42.00779712 (2pi)^9 / 9!
9859 8799688901 fcb $87,$99,$68,$89,$01 ; -((2*PI)**7)/7! / FP constant -76.70417025 -(2pi)^7 / 7!
985E 872335DFE1 fcb $87,$23,$35,$df,$e1 ; ((2*PI)**5)/5! / FP constant 81.60522368 (2pi)^5 / 5!
9863 86A55DE728 fcb $86,$a5,$5d,$e7,$28 ; -((2*PI)**3)/3! / FP constant -41.34170211 -(2pi)^3 / 3!
9868 83490FDAA2 fcb $83,$49,$0f,$da,$a2 ; FP constant 2*pi / 2*PI
986D A154468F138F524389CD ms_easter_egg fcb $a1,$54,$46,$8f,$13,$8f,$52,$43,$89,$cd ; FP constant 7324114470
9877 9654 ATN_dispatch lda <$54 ; * same result either way but series only works -1 < x <= 1
9879 3402 pshs a
987B 2A02 bpl L_987F
987D 8D23 bsr L_98A2 ; COM $54 if FPA1 non zero
987F 964F L_987F lda <$4f
9881 3402 pshs a
9883 8181 cmpa #$81
9885 2505 bcs L_988C
9887 8E920E ldx #data_920E ; FP constant 1
988A 8DAC bsr L_9838 ; divide varptr X by FPA1
988C 8E98A6 L_988C ldx #data_98A6 ; series coefficients
988F 8D82 bsr L_9813 ; calculate odd power series
9891 3502 puls a
9893 8181 cmpa #$81
9895 2506 bcs L_989D
9897 8E983F ldx #data_983F ; FP constant pi/2
989A BD9102 jsr L_9102 ; FPA1 = varptr X - FPA1
989D 3502 L_989D puls a
989F 4D tsta
98A0 2A03 bpl L_98A5
98A2 7E96DE L_98A2 jmp L_96DE ; COM $54 if FPA1 non zero
98A5 39 L_98A5 rts
98A6 0B76B383BD data_98A6 fcb $0b,$76,$b3,$83,$bd ; * values appear to be error compensated
98AB D3791EF4A6 fcb $d3,$79,$1e,$f4,$a6
98B0 F57B83FCB0107C0C1F67CA7CDE53CBC1 fcb $f5,$7b,$83,$fc,$b0,$10,$7c,$0c,$1f,$67,$ca,$7c,$de,$53,$cb,$c1
98C0 7D1464704C7DB7EA517A7D6330887E7E fcb $7d,$14,$64,$70,$4c,$7d,$b7,$ea,$51,$7a,$7d,$63,$30,$88,$7e,$7e ; FP constant .07245719654
98D0 9244993A7E4CCC91C77FAAAAAA138100 fcb $92,$44,$99,$3a,$7e,$4c,$cc,$91,$c7,$7f,$aa,$aa,$aa,$13,$81,$00
98E0 000000 fcb $00,$00,$00
98E3 CCB844 L_98E3 ldd #$b844 ; * part of reset routine: sets up sound & graphics variables
98E6 DDDF std <$df ; PLAY volume data
98E8 8602 lda #$02
98EA 97E2 sta <$e2 ; PLAY tempo
98EC 97DE sta <$de ; PLAY octave
98EE 48 lsla
98EF 97E1 sta <$e1 ; PLAY note length
98F1 0FE5 clr <$e5 ; PLAY duration
98F3 DC8A ldd <$8a ; zero
98F5 DDE8 std <$e8 ; DRAW angle
98F7 C680 ldb #$80
98F9 DDC7 std <$c7 ; graphics X
98FB C660 ldb #$60
98FD DDC9 std <$c9 ; graphics Y
98FF 39 L_98FF rts
9900 9D9F L_9900 jsr <$9f ; get next character from BASIC source
9902 BDB7AA jsr L_B7AA ; get filename
9905 8D43 bsr L_994A ; get start address
9907 BF01E7 stx >$01e7
990A 8D3E bsr L_994A ; get end address
990C AC62 cmpx 2,s
990E 1025F27B lbcs FC_error ; ?FC ERROR
9912 8D36 bsr L_994A ; get entry address
9914 BF01E5 stx >$01e5
9917 9DA5 jsr <$a5 ; get current character from BASIC source
9919 26E4 bne L_98FF
991B 8602 lda #$02 ; file type = 2 = binary
991D 9E8A ldx <$8a ; non-ASCII & ungapped
991F BDB891 jsr L_B891 ; write filename block
9922 0F78 clr <$78 ; cassette status
9924 0C7C inc <$7c ; block type
9926 BD801B jsr call_WRTLDR ; write leader
9929 AE64 ldx 4,s
992B 9F7E L_992B stx <$7e ; IO buffer
992D 86FF lda #$ff
992F 977D sta <$7d ; block length
9931 EC62 ldd 2,s
9933 937E subd <$7e ; IO buffer
9935 2405 bcc L_993C
9937 3266 leas 6,s
9939 7EB6CD jmp L_B6CD ; NEG $7c CLR $7d & write last block
993C 108300FF L_993C cmpd #$00ff
9940 2403 bcc L_9945
9942 5C incb
9943 D77D stb <$7d ; block length
9945 BDB999 L_9945 jsr BLKOUT ; write block to tape
9948 20E1 bra L_992B
994A BD89AA L_994A jsr CkComa ; skip comma
994D BD8E83 jsr Get16Bit ; read 16 bit number into X
9950 EEE4 ldu ,s
9952 AFE4 stx ,s
9954 1F35 tfr u,pc
9956 BD9418 FIX_dispatch jsr L_9418 ; sets B to -1, 0 or 1 as per sign of FPA1
9959 2B03 bmi L_995E
995B 7E9499 L_995B jmp INT_dispach ; INT
995E 0354 L_995E com <$54
9960 8DF9 bsr L_995B
9962 7E96DE jmp L_96DE ; COM $54 if FPA1 non zero
9965 BD9D9F EDIT_dispatch jsr L_9D9F ; get line number in $2b
9968 3262 leas 2,s ; lose return address
996A 8601 L_996A lda #$01
996C 97D8 sta <$d8
996E BD83FF jsr basic_line_after_2b ; search program for line number in <$2b
9971 1025EC90 lbcs UL_error ; ?UL ERROR
9975 BD8F08 jsr L_8F08 ; detokenize BASIC line
9978 1F20 tfr y,d
997A 8302DE subd #$02de
997D D7D7 stb <$d7 ; line length
997F DC2B L_997F ldd <$2b
9981 BD957A jsr print_D ; print unsigned number in D
9984 BD90F5 jsr L_90F5 ; print a space to DEVN
9987 8E02DD ldx #$02dd
998A D6D8 ldb <$d8
998C 2625 bne L_99B3 ; print entire line
998E 5F L_998E clrb
998F BD9AB9 L_998F jsr L_9AB9 ; read keys (carry clear if control key)
9992 BDA438 jsr L_A438 ; set carry if A is non-numeric character
9995 250B bcs L_99A2
9997 8030 suba #$30 ; accumulate typed digits in B
9999 3402 pshs a
999B 860A lda #$0a
999D 3D mul
999E EBE0 addb ,s+
99A0 20ED bra L_998F
99A2 C001 L_99A2 subb #$01
99A4 C901 adcb #$01
99A6 8141 cmpa #$41 ; (A = abandon changes & start again)
99A8 2605 bne L_99AF
99AA BD90A1 jsr print_CR ; send CR to DEVN
99AD 20BB bra L_996A
99AF 814C L_99AF cmpa #$4c ; (L = show line in current state)
99B1 260B bne L_99BE
99B3 8D31 L_99B3 bsr L_99E6 ; output ASCIIZ string to DEVN (X is pointer)
99B5 0FD8 clr <$d8
99B7 BD90A1 jsr print_CR ; send CR to DEVN
99BA 20C3 bra L_997F
99BC 3262 L_99BC leas 2,s ; lose return address
99BE 810D L_99BE cmpa #$0d ; (RETURN = save changes, show line & quit)
99C0 260D bne L_99CF
99C2 8D22 bsr L_99E6 ; output ASCIIZ string to DEVN (X is pointer)
99C4 BD90A1 L_99C4 jsr print_CR ; send CR to DEVN
99C7 8E02DD ldx #$02dd
99CA 9FA6 stx <$a6 ; BASIC source pointer
99CC 7E83A6 jmp L_83A6 ; enter BASIC line
99CF 8145 L_99CF cmpa #$45 ; (E = save changes & quit)
99D1 27F1 beq L_99C4
99D3 8151 cmpa #$51 ; (Q = discard changes & quit)
99D5 2606 bne L_99DD
99D7 BD90A1 jsr print_CR ; send CR to DEVN
99DA 7E8371 jmp goto_ok_prompt ; command mode
99DD 8D02 L_99DD bsr L_99E1
99DF 20AD bra L_998E
99E1 8120 L_99E1 cmpa #$20 ; (SPACE = show more characters)
99E3 2610 bne L_99F5
99E5 8C fcb $8c ; cmpx #$c6f9 - comment byte
99E6 C6F9 L_99E6 ldb #$f9 ; usually skipped by comment byte
99E8 A684 L_99E8 lda ,x ; * (99E6 C6F9 LDB #$F9)
99EA 2708 beq L_99F4
99EC BDB54A jsr OUTCHR ; output character to DEVN
99EF 3001 leax 1,x
99F1 5A decb
99F2 26F4 bne L_99E8 ; show another (in EDIT context)
99F4 39 L_99F4 rts
99F5 8144 L_99F5 cmpa #$44 ; (D = delete a number of characters)
99F7 2648 bne L_9A41
99F9 6D84 L_99F9 tst ,x
99FB 27F7 beq L_99F4
99FD 8D04 bsr L_9A03 ; close line up over removed character
99FF 5A decb
9A00 26F7 bne L_99F9
9A02 39 rts
9A03 0AD7 L_9A03 dec <$d7 ; * EDIT: close line up over removed character
9A05 311F leay -1,x
9A07 3121 L_9A07 leay 1,y
9A09 A621 lda 1,y
9A0B A7A4 sta ,y
9A0D 26F8 bne L_9A07
9A0F 39 rts
9A10 8149 L_9A10 cmpa #$49 ; (I = insert mode)
9A12 2713 beq L_9A27
9A14 8158 cmpa #$58 ; (X = insert mode at end of line)
9A16 270D beq L_9A25
9A18 8148 cmpa #$48 ; (H = wipe rest of line & insert)
9A1A 265C bne L_9A78
9A1C 6F84 clr ,x
9A1E 1F10 tfr x,d
9A20 8302DE subd #$02de
9A23 D7D7 stb <$d7 ; updated line length
9A25 8DBF L_9A25 bsr L_99E6 ; output ASCIIZ string to DEVN (X is pointer)
9A27 BD9AB9 L_9A27 jsr L_9AB9 ; read keys (carry clear if control key)
9A2A 810D cmpa #$0d
9A2C 278E beq L_99BC ; RETURN
9A2E 811B cmpa #$1b
9A30 2725 beq L_9A57 ; RTS (escape insert mode)
9A32 8108 cmpa #$08
9A34 2622 bne L_9A58 ; not backspace
9A36 8C02DD cmpx #$02dd
9A39 27EC beq L_9A27 ; nothing to delete
9A3B 8D45 bsr L_9A82 ; delete it on screen
9A3D 8DC4 bsr L_9A03 ; delete it in memory
9A3F 20E6 bra L_9A27
9A41 8143 L_9A41 cmpa #$43 ; (C = change a number of characters)
9A43 26CB bne L_9A10
9A45 6D84 L_9A45 tst ,x
9A47 270E beq L_9A57 ; RTS
9A49 BD9AB9 jsr L_9AB9 ; read keys (carry clear if control key)
9A4C 2502 bcs L_9A50
9A4E 20F5 bra L_9A45
9A50 A780 L_9A50 sta ,x+
9A52 8D37 bsr L_9A8B ; output character to DEVN
9A54 5A decb
9A55 26EE bne L_9A45 ; change another
9A57 39 L_9A57 rts
9A58 D6D7 L_9A58 ldb <$d7 ; * EDIT: typed characters in insert mode
9A5A C1F9 cmpb #$f9
9A5C 2602 bne L_9A60
9A5E 20C7 bra L_9A27 ; line full
9A60 3410 L_9A60 pshs x
9A62 6D80 L_9A62 tst ,x+ ; create a space for character
9A64 26FC bne L_9A62
9A66 E682 L_9A66 ldb ,-x
9A68 E701 stb 1,x
9A6A ACE4 cmpx ,s
9A6C 26F8 bne L_9A66
9A6E 3262 leas 2,s
9A70 A780 sta ,x+
9A72 8D17 bsr L_9A8B ; output character to DEVN
9A74 0CD7 inc <$d7
9A76 20AF bra L_9A27
9A78 8108 L_9A78 cmpa #$08 ; * EDIT: backspace over a number of characters
9A7A 2612 bne L_9A8E
9A7C 8D04 L_9A7C bsr L_9A82
9A7E 5A decb
9A7F 26FB bne L_9A7C ; backspace again
9A81 39 rts
9A82 8C02DD L_9A82 cmpx #$02dd ; * EDIT: backspace
9A85 27D0 beq L_9A57 ; RTS
9A87 301F leax -1,x
9A89 8608 lda #$08
9A8B 7EB54A L_9A8B jmp OUTCHR ; output character to DEVN
9A8E 814B L_9A8E cmpa #$4b ; (K = wipe chrs until nth occurrence of chr)
9A90 2705 beq L_9A97
9A92 8053 suba #$53 ; (S = search for nth occurrence of chr)
9A94 2701 beq L_9A97
9A96 39 rts
9A97 3402 L_9A97 pshs a ; * EDIT: search functions
9A99 8D1E bsr L_9AB9 ; read keys (carry clear if control key)
9A9B 3402 pshs a
9A9D A684 L_9A9D lda ,x
9A9F 2716 beq L_9AB7 ; PULS Y,PC
9AA1 6D61 tst 1,s
9AA3 2606 bne L_9AAB ; Kill (not Search)
9AA5 8DE4 bsr L_9A8B ; output character to DEVN
9AA7 3001 leax 1,x
9AA9 2003 bra L_9AAE
9AAB BD9A03 L_9AAB jsr L_9A03 ; close line up over removed character
9AAE A684 L_9AAE lda ,x
9AB0 A1E4 cmpa ,s
9AB2 26E9 bne L_9A9D ; not found
9AB4 5A decb
9AB5 26E6 bne L_9A9D ; find next occurrence
9AB7 35A0 L_9AB7 puls y,pc
9AB9 BDB505 L_9AB9 jsr L_B505 ; read character from DEVN & strip MSB
9ABC 817F cmpa #$7f
9ABE 24F9 bcc L_9AB9 ; pointless test!
9AC0 815F cmpa #$5f
9AC2 2602 bne L_9AC6 ; not shift + CU
9AC4 861B lda #$1b
9AC6 810D L_9AC6 cmpa #$0d
9AC8 270E beq L_9AD8 ; return
9ACA 811B cmpa #$1b
9ACC 270A beq L_9AD8 ; escape
9ACE 8108 cmpa #$08
9AD0 2706 beq L_9AD8 ; backspace
9AD2 8120 cmpa #$20
9AD4 25E3 bcs L_9AB9 ; illegal
9AD6 1A01 orcc #$01
9AD8 39 L_9AD8 rts
9AD9 86 TRON_dispatch fcb $86 ; lda #$4f - comment byte / * TRON
9ADA 4F TROFF_dispatch clra ; usually skipped by comment byte
9ADB 97AF sta <$af ; * (9ADA 4F CLRA)
9ADD 39 rts
9ADE 966F POS_dispatch lda <$6f ; DEVN
9AE0 3402 pshs a
9AE2 BDB7E0 jsr L_B7E0 ; load DEVN from FPA1
9AE5 BDB63C jsr L_B63C ; if DEVN = -1, test cassette OK for output
9AE8 BDB595 jsr L_B595 ; initialise virtual DEVN device
9AEB D66C ldb <$6c ; device current column
9AED 3502 puls a
9AEF 976F sta <$6f ; DEVN
9AF1 7E8C36 jmp Assign8Bit ; assign B to FPA1
9AF4 BD89A7 VARPTR_dispatch jsr CkOpBrak ; skip open bracket
9AF7 DC1F ldd <$1f ; end of BASIC storage
9AF9 3406 pshs a,b
9AFB BD8A94 jsr GETVAR ; get varptr of variable in X
9AFE BD89A4 jsr CkClBrak ; skip close bracket
9B01 3506 puls a,b
9B03 1E10 exg x,d
9B05 9C1F cmpx <$1f ; not allowed to create new variable
9B07 2651 bne do_fc_error_9B5A ; ?FC ERROR
9B09 7E9FD0 jmp varptr_patch ; assign D to FPA1
9B0C 9D9F LET_MIDstr_handler jsr <$9f ; get next character from BASIC source
9B0E BD89A7 jsr CkOpBrak ; skip open bracket
9B11 BD8A94 jsr GETVAR ; get varptr of variable in X
9B14 3410 pshs x
9B16 EC02 ldd 2,x
9B18 109321 cmpd <$21 ; stack root / string storage start
9B1B 2304 bls L_9B21
9B1D 9327 subd <$27 ; top of BASIC RAM
9B1F 2312 bls L_9B33
9B21 E684 L_9B21 ldb ,x
9B23 BD8CB3 jsr L_8CB3 ; reserve B bytes of string space
9B26 3410 pshs x
9B28 AE62 ldx 2,s
9B2A BD8D89 jsr L_8D89 ; copy string (len B) from varptr X to ($25)+
9B2D 3550 puls x,u
9B2F AF42 stx 2,u
9B31 3440 pshs u
9B33 BD8E7E L_9B33 jsr L_8E7E
9B36 3404 pshs b
9B38 5D tstb
9B39 271F beq do_fc_error_9B5A ; ?FC ERROR
9B3B C6FF ldb #$ff
9B3D 8129 cmpa #$29
9B3F 2703 beq L_9B44
9B41 BD8E7E jsr L_8E7E
9B44 3404 L_9B44 pshs b
9B46 BD89A4 jsr CkClBrak ; skip close bracket
9B49 C6CB ldb #$cb
9B4B BD89AC jsr CkChar ; skip character in B
9B4E 8D2E bsr L_9B7E ; get string expression & point X to it
9B50 1F13 tfr x,u
9B52 AE62 ldx 2,s
9B54 A684 lda ,x
9B56 A061 suba 1,s
9B58 2403 bcc L_9B5D
9B5A 7E8B8D do_fc_error_9B5A jmp FC_error ; ?FC ERROR
9B5D 4C L_9B5D inca
9B5E A1E4 cmpa ,s
9B60 2402 bcc L_9B64
9B62 A7E4 sta ,s
9B64 A661 L_9B64 lda 1,s
9B66 1E89 exg a,b
9B68 AE02 ldx 2,x
9B6A 5A decb
9B6B 3A abx
9B6C 4D tsta
9B6D 270D beq L_9B7C
9B6F A1E4 cmpa ,s
9B71 2302 bls L_9B75
9B73 A6E4 lda ,s
9B75 1F89 L_9B75 tfr a,b
9B77 1E31 exg u,x
9B79 BDB7CC jsr L_B7CC ; copy B bytes from X to U
9B7C 3596 L_9B7C puls a,b,x,pc
9B7E BD8887 L_9B7E jsr get_string ; get expression
9B81 7E8D9A jmp L_8D9A ; validate string & point X to it (B=len)
9B84 BD89A7 STRINGstr_dispatch jsr CkOpBrak ; skip open bracket
9B87 BD8E51 jsr Get8Bit ; get number into B
9B8A 3404 pshs b
9B8C BD89AA jsr CkComa ; skip comma
9B8F BD8887 jsr get_string ; get expression
9B92 BD89A4 jsr CkClBrak ; skip close bracket
9B95 9606 lda <$06 ; numeric / string flag
9B97 2605 bne L_9B9E
9B99 BD8E54 jsr L_8E54 ; read 8 bit value into B from FPA1
9B9C 2003 bra L_9BA1
9B9E BD8DEA L_9B9E jsr L_8DEA ; get 1st character of string into B
9BA1 3404 L_9BA1 pshs b
9BA3 E661 ldb 1,s ; number of copies
9BA5 BD8C52 jsr L_8C52 ; reserve B bytes of string space
9BA8 3506 puls a,b
9BAA 2705 beq L_9BB1
9BAC A780 L_9BAC sta ,x+
9BAE 5A decb
9BAF 26FB bne L_9BAC
9BB1 7E8DE1 L_9BB1 jmp L_8DE1
9BB4 BD89A7 INSTR_dispatch jsr CkOpBrak ; skip open bracket
9BB7 BD8887 jsr get_string ; get expression
9BBA C601 ldb #$01 ; default start position
9BBC 3404 pshs b
9BBE 9606 lda <$06 ; numeric / string flag
9BC0 2610 bne L_9BD2 ; start pos not specified
9BC2 BD8E54 jsr L_8E54 ; read 8 bit value into B from FPA1
9BC5 E7E4 stb ,s
9BC7 2791 beq do_fc_error_9B5A ; ?FC ERROR
9BC9 BD89AA jsr CkComa ; skip comma
9BCC BD8887 jsr get_string ; get expression
9BCF BD8877 jsr get_expr ; validate string expression
9BD2 9E52 L_9BD2 ldx <$52
9BD4 3410 pshs x
9BD6 BD89AA jsr CkComa ; skip comma
9BD9 BD9B7E jsr L_9B7E ; get string expression & point X to it
9BDC 3414 pshs b,x
9BDE BD89A4 jsr CkClBrak ; skip close bracket
9BE1 AE63 ldx 3,s ; varptr of main string
9BE3 BD8D9F jsr DELVAR ; point X to string & length in B
9BE6 3404 pshs b
9BE8 E166 cmpb 6,s
9BEA 2523 bcs L_9C0F ; main string is shorter than start pos
9BEC A661 lda 1,s ; target string length
9BEE 271C beq L_9C0C
9BF0 E666 ldb 6,s ; start pos
9BF2 5A decb
9BF3 3A abx
9BF4 3184 L_9BF4 leay ,x ; Y = X = position to start search
9BF6 EE62 ldu 2,s ; U -> target characters
9BF8 E661 ldb 1,s ; B = target length
9BFA A6E4 lda ,s ; A = main string length
9BFC A066 suba 6,s
9BFE 4C inca ; A = A - start pos + 1
9BFF A161 cmpa 1,s
9C01 250C bcs L_9C0F ; remaining length is shorter than target
9C03 A680 L_9C03 lda ,x+
9C05 A1C0 cmpa ,u+
9C07 260C bne L_9C15 ; didn't match
9C09 5A decb
9C0A 26F7 bne L_9C03 ; test next character in target
9C0C E666 L_9C0C ldb 6,s ; found it
9C0E 21 fcb $21 ; brn L_9C6F - comment byte
9C0F 5F L_9C0F clrb ; usually skipped by comment byte
9C10 3267 leas 7,s ; * (9C0F 5F CLRB)
9C12 7E8C36 jmp Assign8Bit ; assign B to FPA1
9C15 6C66 L_9C15 inc 6,s
9C17 3021 leax 1,y ; advance start pos & try again
9C19 20D9 bra L_9BF4
9C1B 0F52 L_9C1B clr <$52 ; * read octal or hex number from command into $52 / $53
9C1D 0F53 clr <$53
9C1F 8E0052 ldx #$0052
9C22 9D9F jsr <$9f ; get next character from BASIC source
9C24 814F cmpa #$4f
9C26 2712 beq L_9C3A
9C28 8148 cmpa #$48
9C2A 2723 beq L_9C4F
9C2C 9DA5 jsr <$a5 ; get current character from BASIC source
9C2E 200C bra L_9C3C
9C30 8138 L_9C30 cmpa #$38
9C32 1022ED7E lbhi SN_error ; ?SN ERROR
9C36 C603 ldb #$03
9C38 8D2A bsr L_9C64 ; shift word at ,X left B bits
9C3A 9D9F L_9C3A jsr <$9f ; get next character from BASIC source
9C3C 25F2 L_9C3C bcs L_9C30
9C3E 0F50 Assign16BitB clr <$50 ; * assign contents of $52 / $53 to FPA1
9C40 0F51 clr <$51
9C42 0F06 clr <$06 ; numeric / string flag
9C44 0F63 clr <$63
9C46 0F54 clr <$54
9C48 C6A0 ldb #$a0
9C4A D74F stb <$4f
9C4C 7E9165 jmp L_9165 ; normalize FPA1
9C4F 9D9F L_9C4F jsr <$9f ; get next character from BASIC source
9C51 250B bcs L_9C5E
9C53 BD8ADF jsr L_8ADF ; carry clear if A-Z
9C56 25E6 bcs Assign16BitB ; assign contents of $52 / $53 to FPA1
9C58 8147 cmpa #$47
9C5A 24E2 bcc Assign16BitB ; assign contents of $52 / $53 to FPA1
9C5C 8007 suba #$07
9C5E C604 L_9C5E ldb #$04
9C60 8D02 bsr L_9C64 ; shift word at ,X left B bits
9C62 20EB bra L_9C4F
9C64 6801 L_9C64 lsl 1,x ; * shift word at ,X left B bits
9C66 6984 rol ,x
9C68 1025F56F lbcs OV_error ; ?OV ERROR
9C6C 5A decb
9C6D 26F5 bne L_9C64
9C6F 8030 L_9C6F suba #$30
9C71 AB01 adda 1,x
9C73 A701 sta 1,x
9C75 39 L_9C75 rts
9C76 9E68 ensure_not_direct ldx <$68 ; current line number
9C78 3001 leax 1,x
9C7A 26F9 bne L_9C75 ; not in command mode
9C7C C616 ldb #$16 ; ?ID ERROR
9C7E 7E8344 L_9C7E jmp system_error ; cause error
9C81 AE9F00A6 DEF_dispatch ldx [$00a6] ; * DEF
9C85 8CFFA1 cmpx #$ffa1 ; DEF USR
9C88 10270074 lbeq L_9D00
9C8C 8D23 bsr L_9CB1
9C8E 8DE6 bsr ensure_not_direct ; test for command mode
9C90 BD89A7 jsr CkOpBrak ; skip open bracket
9C93 C680 ldb #$80
9C95 D708 stb <$08 ; array illegal flag
9C97 BD8A94 jsr GETVAR ; get varptr of variable in X
9C9A 8D25 bsr L_9CC1
9C9C BD89A4 jsr CkClBrak ; skip close bracket
9C9F C6CB ldb #$cb
9CA1 BD89AC jsr CkChar ; skip character in B
9CA4 9E4B ldx <$4b
9CA6 DCA6 ldd <$a6 ; BASIC source pointer
9CA8 ED84 std ,x
9CAA DC39 ldd <$39
9CAC ED02 std 2,x
9CAE 7E8613 jmp DATA_dispatch ; skip to start of next statement
9CB1 C6BE L_9CB1 ldb #$be ; token FN
9CB3 BD89AC jsr CkChar ; skip character in B
9CB6 C680 ldb #$80
9CB8 D708 stb <$08 ; array illegal flag
9CBA 8A80 ora #$80
9CBC BD8A99 jsr L_8A99
9CBF 9F4B stx <$4b
9CC1 7E8874 L_9CC1 jmp L_8874 ; validate numeric expression
9CC4 8DEB L_9CC4 bsr L_9CB1
9CC6 3410 pshs x
9CC8 BD899F jsr L_899F ; get expression inside brackets
9CCB 8DF4 bsr L_9CC1
9CCD 3540 puls u
9CCF C622 ldb #$22 ; ?UF ERROR
9CD1 AE42 ldx 2,u
9CD3 27A9 beq L_9C7E ; cause error
9CD5 109EA6 ldy <$a6 ; BASIC source pointer
9CD8 EEC4 ldu ,u
9CDA DFA6 stu <$a6 ; BASIC source pointer
9CDC A604 lda 4,x
9CDE 3402 pshs a
9CE0 EC84 ldd ,x
9CE2 EE02 ldu 2,x
9CE4 3476 pshs a,b,x,y,u
9CE6 BD93E0 jsr L_93E0 ; assign FPA1 to varptr in X
9CE9 BD8872 jsr L_8872 ; read numeric expression into FPA1
9CEC 3576 puls a,b,x,y,u
9CEE ED84 std ,x
9CF0 EF02 stu 2,x
9CF2 3502 puls a
9CF4 A704 sta 4,x
9CF6 9DA5 jsr <$a5 ; get current character from BASIC source
9CF8 1026ECB8 lbne SN_error ; ?SN ERROR
9CFC 109FA6 sty <$a6 ; BASIC source pointer
9CFF 39 rts
9D00 9D9F L_9D00 jsr <$9f ; get next character from BASIC source
9D02 9D9F jsr <$9f ; get next character from BASIC source
9D04 8D07 bsr L_9D0D
9D06 3410 pshs x
9D08 8D2B bsr L_9D35
9D0A AFF1 stx [,s++]
9D0C 39 rts
9D0D 5F L_9D0D clrb ; * called by USR: converts following digit into USR table pointer
9D0E 9DA5 jsr <$a5 ; get current character from BASIC source
9D10 2406 bcc L_9D18
9D12 8030 suba #$30
9D14 1F89 tfr a,b
9D16 9D9F jsr <$9f ; get next character from BASIC source
9D18 9EB0 L_9D18 ldx <$b0 ; address of USR table
9D1A 58 lslb
9D1B 3A abx
9D1C 39 rts
9D1D 8DEE USR_dispatch bsr L_9D0D ; * USRx
9D1F AE84 ldx ,x
9D21 3410 pshs x
9D23 BD899F jsr L_899F ; get expression inside brackets
9D26 8E004F ldx #$004f ; FPA1
9D29 9606 lda <$06 ; numeric / string flag
9D2B 2707 beq L_9D34
9D2D BD8D9D jsr L_8D9D ; point X to string just compiled & len in B
9D30 9E52 ldx <$52
9D32 9606 lda <$06 ; numeric / string flag
9D34 39 L_9D34 rts
9D35 C6CB L_9D35 ldb #$cb ; token =
9D37 BD89AC jsr CkChar ; skip character in B
9D3A 7E8E83 jmp Get16Bit ; read 16 bit number into X
9D3D B6FF03 IRQ_service lda >$ff03 ; * IRQ service routine
9D40 2B01 bmi L_9D43 ; vsync
9D42 3B rti
9D43 B6FF02 L_9D43 lda >$ff02
9D46 BE0112 ldx >$0112 ; TIMER value
9D49 3001 leax 1,x
9D4B BF0112 stx >$0112
9D4E 7EAFD9 jmp L_AFD9 ; ...continued
9D51 9D9F LET_TIMER_handler jsr <$9f ; get next character from BASIC source
9D53 8DE0 bsr L_9D35
9D55 BF0112 stx >$0112 ; TIMER value
9D58 39 rts
9D59 BE0112 TIMER_dispatch ldx >$0112 ; TIMER value
9D5C 9F52 stx <$52
9D5E 7E9C3E jmp Assign16BitB ; assign contents of $52 / $53 to FPA1
9D61 1027EE28 DEL_dispatch lbeq FC_error ; ?FC ERROR
9D65 BD869A jsr L_869A ; read line number & store in $2b
9D68 BD83FF jsr basic_line_after_2b ; search program for line number in <$2b
9D6B 9FD3 stx <$d3
9D6D 9DA5 jsr <$a5 ; get current character from BASIC source
9D6F 2710 beq L_9D81
9D71 81C4 cmpa #$c4 ; token -
9D73 263B bne L_9DB0
9D75 9D9F jsr <$9f ; get next character from BASIC source
9D77 2704 beq L_9D7D
9D79 8D24 bsr L_9D9F
9D7B 2004 bra L_9D81
9D7D 86FF L_9D7D lda #$ff
9D7F 972B sta <$2b
9D81 DED3 L_9D81 ldu <$d3
9D83 8C fcb $8c ; cmpx #$eec4 - comment byte
9D84 EEC4 L_9D84 ldu ,u ; usually skipped by comment byte
9D86 ECC4 ldd ,u ; * (9D84 EEC4 LDU ,U)
9D88 2706 beq L_9D90
9D8A EC42 ldd 2,u
9D8C 932B subd <$2b
9D8E 23F4 bls L_9D84
9D90 9ED3 L_9D90 ldx <$d3
9D92 8D15 bsr L_9DA9 ; move program down from U to X
9D94 BD841F jsr BasVect1 ; clear variables and reset stack & cmd ptr
9D97 9ED3 ldx <$d3
9D99 BD83EF jsr L_83EF ; set up next line pointers from X onwards
9D9C 7E8371 jmp goto_ok_prompt ; command mode
9D9F BD869A L_9D9F jsr L_869A ; read line number & store in $2b
9DA2 7EB7F9 jmp L_B7F9 ; cause error if next byte is not zero
9DA5 A6C0 L_9DA5 lda ,u+
9DA7 A780 sta ,x+
9DA9 11931B L_9DA9 cmpu <$1b ; start of simple variables
9DAC 26F7 bne L_9DA5
9DAE 9F1B stx <$1b ; start of simple variables
9DB0 39 L_9DB0 rts
9DB1 BD9C76 LINE_INPUT_handler jsr ensure_not_direct ; test for command mode
9DB4 9D9F jsr <$9f ; get next character from BASIC source
9DB6 8123 cmpa #$23
9DB8 2609 bne L_9DC3
9DBA BDB7D7 jsr L_B7D7 ; read #-n & set up DEVN
9DBD BDB623 jsr L_B623 ; test cassette status OK for input
9DC0 BD89AA jsr CkComa ; skip comma
9DC3 8122 L_9DC3 cmpa #$22
9DC5 260B bne L_9DD2 ; no prompt
9DC7 BD8975 jsr L_8975 ; read literal string
9DCA C63B ldb #$3b
9DCC BD89AC jsr CkChar ; skip character in B
9DCF BD90E8 jsr L_90E8 ; print string just compiled
9DD2 327E L_9DD2 leas -2,s
9DD4 BD8766 jsr L_8766
9DD7 3262 leas 2,s
9DD9 0F6F clr <$6f ; DEVN
9DDB BD8A94 jsr GETVAR ; get varptr of variable in X
9DDE 9F3B stx <$3b
9DE0 BD8877 jsr get_expr ; validate string expression
9DE3 8E02DC ldx #$02dc
9DE6 4F clra
9DE7 BD8C5D jsr L_8C5D ; compile literal string at X
9DEA 7E86D7 jmp L_86D7 ; assign string variable
9DED BD869A L_9DED jsr L_869A ; read line number & store in $2b
9DF0 9E2B ldx <$2b
9DF2 39 rts
9DF3 9ED1 L_9DF3 ldx <$d1 ; * RENUM: search for start line
9DF5 9F2B L_9DF5 stx <$2b
9DF7 7E83FF jmp basic_line_after_2b ; search program for line number in <$2b
9DFA BD8424 RENUM_dispatch jsr L_8424 ; clear variables & reset stack
9DFD CC000A ldd #$000a
9E00 DDD5 std <$d5 ; default RENUM 10,0,10
9E02 DDCF std <$cf
9E04 5F clrb
9E05 DDD1 std <$d1
9E07 9DA5 jsr <$a5 ; get current character from BASIC source
9E09 2406 bcc L_9E11
9E0B 8DE0 bsr L_9DED ; read line number into X & $2b
9E0D 9FD5 stx <$d5 ; new start line
9E0F 9DA5 jsr <$a5 ; get current character from BASIC source
9E11 271B L_9E11 beq L_9E2E
9E13 BD89AA jsr CkComa ; skip comma
9E16 2406 bcc L_9E1E
9E18 8DD3 bsr L_9DED ; read line number into X & $2b
9E1A 9FD1 stx <$d1 ; line to start renumbering at
9E1C 9DA5 jsr <$a5 ; get current character from BASIC source
9E1E 270E L_9E1E beq L_9E2E
9E20 BD89AA jsr CkComa ; skip comma
9E23 2406 bcc L_9E2B
9E25 8DC6 bsr L_9DED ; read line number into X & $2b
9E27 9FCF stx <$cf ; line increment
9E29 2749 beq do_fc_error_9E74 ; ?FC ERROR
9E2B BDB7F9 L_9E2B jsr L_B7F9 ; cause error if next byte is not zero
9E2E 8DC3 L_9E2E bsr L_9DF3 ; search for start line
9E30 9FD3 stx <$d3 ; save address
9E32 9ED5 ldx <$d5
9E34 8DBF bsr L_9DF5 ; search for new start line
9E36 9CD3 cmpx <$d3 ; not allowed to be lower than start line
9E38 253A bcs do_fc_error_9E74 ; ?FC ERROR
9E3A 8D1C bsr L_9E58 ; dry run - check lines don't get too high
9E3C BD9ECE jsr L_9ECE ; prepare line numbers in statements
9E3F BD83ED jsr BasVect2 ; set up next line pointers in BASIC program
9E42 8DAF bsr L_9DF3 ; search for start line
9E44 9FD3 stx <$d3 ; save address
9E46 8D3A bsr L_9E82 ; convert line numbers to addresses
9E48 8D0F bsr L_9E59 ; do the actual renumbering
9E4A 8D36 bsr L_9E82 ; convert addresses to line numbers
9E4C BD9F6C jsr L_9F6C ; convert line numbers back to ASCII
9E4F BD8424 jsr L_8424 ; clear variables & reset stack
9E52 BD83ED jsr BasVect2 ; set up next line pointers in BASIC program
9E55 7E8371 jmp goto_ok_prompt ; command mode
9E58 86 L_9E58 fcb $86 ; lda #$4f - comment byte / * RENUM: dry run to check that line numbers don't get too high
9E59 4F L_9E59 clra ; usually skipped by comment byte
9E5A 97D8 sta <$d8 ; * (9E59 4F CLRA)
9E5C 9ED3 ldx <$d3 ; start address
9E5E DCD5 ldd <$d5 ; new start number
9E60 8D15 bsr L_9E77 ; test for end of program
9E62 0DD8 L_9E62 tst <$d8 ; dry run flag
9E64 2602 bne L_9E68
9E66 ED02 std 2,x ; store new line number
9E68 AE84 L_9E68 ldx ,x ; point X to next line
9E6A 8D0B bsr L_9E77 ; test for end of program
9E6C D3CF addd <$cf ; increment line number
9E6E 2504 bcs do_fc_error_9E74 ; ?FC ERROR
9E70 81FA cmpa #$fa
9E72 25EE bcs L_9E62
9E74 7E8B8D do_fc_error_9E74 jmp FC_error ; ?FC ERROR
9E77 3406 L_9E77 pshs a,b ; * RENUM: test for end of program
9E79 EC84 ldd ,x
9E7B 3506 puls a,b
9E7D 2602 bne L_9E81
9E7F 3262 leas 2,s ; return 2 levels if at end of program
9E81 39 L_9E81 rts
9E82 9E19 L_9E82 ldx <$19 ; start of BASIC program
9E84 301F leax -1,x
9E86 3001 L_9E86 leax 1,x
9E88 8DED bsr L_9E77 ; test for end of program
9E8A 3003 L_9E8A leax 3,x
9E8C 3001 L_9E8C leax 1,x
9E8E A684 lda ,x
9E90 27F4 beq L_9E86 ; end of line
9E92 9F0F stx <$0f
9E94 4A deca
9E95 270C beq L_9EA3 ; 1st pass - convert line number to address
9E97 4A deca
9E98 272A beq L_9EC4 ; 2nd pass - convert address to line number
9E9A 4A deca
9E9B 26EF bne L_9E8C
9E9D 8603 L_9E9D lda #$03
9E9F A780 sta ,x+
9EA1 20E7 bra L_9E8A
9EA3 EC01 L_9EA3 ldd 1,x ; reconstruct line number coded in block
9EA5 6A02 dec 2,x
9EA7 2701 beq L_9EAA
9EA9 4F clra
9EAA E603 L_9EAA ldb 3,x
9EAC 6A04 dec 4,x
9EAE 2701 beq L_9EB1
9EB0 5F clrb
9EB1 ED01 L_9EB1 std 1,x
9EB3 DD2B std <$2b
9EB5 BD83FF jsr basic_line_after_2b ; search program for line number in <$2b
9EB8 9E0F L_9EB8 ldx <$0f
9EBA 25E1 bcs L_9E9D ; line not found - store a 3 for 'UL'
9EBC DC47 ldd <$47 ; address of line
9EBE 6C80 inc ,x+
9EC0 ED84 std ,x
9EC2 20C6 bra L_9E8A
9EC4 6F84 L_9EC4 clr ,x ; becomes a 1 in a moment
9EC6 AE01 ldx 1,x ; address of line
9EC8 AE02 ldx 2,x ; actual line number
9ECA 9F47 stx <$47
9ECC 20EA bra L_9EB8 ; store it in info block
9ECE 9E19 L_9ECE ldx <$19 ; start of BASIC program
9ED0 2004 bra L_9ED6
9ED2 9EA6 L_9ED2 ldx <$a6 ; BASIC source pointer
9ED4 3001 leax 1,x
9ED6 8D9F L_9ED6 bsr L_9E77 ; test for end of program
9ED8 3002 leax 2,x
9EDA 3001 L_9EDA leax 1,x
9EDC 9FA6 L_9EDC stx <$a6 ; BASIC source pointer
9EDE 9D9F L_9EDE jsr <$9f ; get next character from BASIC source
9EE0 4D L_9EE0 tsta
9EE1 27EF beq L_9ED2 ; end of line
9EE3 2AF9 bpl L_9EDE ; non-token
9EE5 9EA6 ldx <$a6 ; BASIC source pointer
9EE7 81FF cmpa #$ff
9EE9 27EF beq L_9EDA ; skip function token
9EEB BD01A0 jsr >$01a0 ; PATCH - CLS GET PUT ???
9EEE 81BF cmpa #$bf ; token THEN
9EF0 2712 beq L_9F04
9EF2 8184 cmpa #$84 ; token ELSE
9EF4 270E beq L_9F04
9EF6 8181 cmpa #$81 ; token GO
9EF8 26E4 bne L_9EDE
9EFA 9D9F jsr <$9f ; get next character from BASIC source
9EFC 81BC cmpa #$bc ; token TO
9EFE 2704 beq L_9F04
9F00 81BD cmpa #$bd ; token SUB
9F02 26D8 bne L_9EDC ; keep looking for interesting stuff
9F04 9D9F L_9F04 jsr <$9f ; get next character from BASIC source
9F06 2504 bcs L_9F0C ; found digit
9F08 9DA5 L_9F08 jsr <$a5 ; get current character from BASIC source
9F0A 20D4 bra L_9EE0
9F0C 9EA6 L_9F0C ldx <$a6 ; BASIC source pointer
9F0E 3410 pshs x ; start of digits
9F10 BD869A jsr L_869A ; read line number & store in $2b
9F13 9EA6 ldx <$a6 ; BASIC source pointer
9F15 A682 L_9F15 lda ,-x
9F17 BDA438 jsr L_A438 ; set carry if A is non-numeric character
9F1A 25F9 bcs L_9F15
9F1C 3001 leax 1,x ; end of digits
9F1E 1F10 tfr x,d
9F20 E061 subb 1,s
9F22 C005 subb #$05
9F24 2720 beq L_9F46 ; exactly 5 digits
9F26 250A bcs L_9F32 ; less than 5 digits
9F28 3384 leau ,x
9F2A 50 negb
9F2B 3085 leax b,x
9F2D BD9DA9 jsr L_9DA9 ; move program down from U to X
9F30 2014 bra L_9F46
9F32 9F47 L_9F32 stx <$47
9F34 9E1B ldx <$1b ; start of simple variables
9F36 9F43 stx <$43
9F38 50 negb
9F39 3085 leax b,x
9F3B 9F41 stx <$41
9F3D 9F1B stx <$1b ; start of simple variables
9F3F BD831C jsr L_831C ; move memory contents up
9F42 9E45 ldx <$45
9F44 9FA6 stx <$a6 ; BASIC source pointer
9F46 3510 L_9F46 puls x ; start of digits
9F48 8601 lda #$01
9F4A A784 sta ,x ; replace line number with 5 byte info block
9F4C A702 sta 2,x ; line number coded to avoid zeros
9F4E A704 sta 4,x ; otherwise world would fall apart
9F50 D62B ldb <$2b
9F52 2604 bne L_9F58
9F54 C601 ldb #$01
9F56 6C02 inc 2,x
9F58 E701 L_9F58 stb 1,x
9F5A D62C ldb <$2c
9F5C 2604 bne L_9F62
9F5E C601 ldb #$01
9F60 6C04 inc 4,x
9F62 E703 L_9F62 stb 3,x
9F64 9DA5 jsr <$a5 ; get current character from BASIC source
9F66 812C cmpa #$2c
9F68 279A beq L_9F04 ; comma - look for another line number
9F6A 209C bra L_9F08
9F6C 9E19 L_9F6C ldx <$19 ; start of BASIC program
9F6E 301F leax -1,x
9F70 3001 L_9F70 leax 1,x
9F72 EC02 ldd 2,x
9F74 DD68 std <$68 ; current line number
9F76 BD9E77 jsr L_9E77 ; test for end of program
9F79 3003 leax 3,x
9F7B 3001 L_9F7B leax 1,x
9F7D A684 L_9F7D lda ,x
9F7F 27EF beq L_9F70 ; end of line
9F81 4A deca
9F82 271B beq L_9F9F ; found an info block
9F84 8002 suba #$02
9F86 26F3 bne L_9F7B
9F88 3410 pshs x
9F8A 8E9FC9 ldx #text_ul - 1 ; /UL /
9F8D BD90E5 jsr out_string ; print string to DEVN
9F90 AEE4 ldx ,s
9F92 EC01 ldd 1,x
9F94 BD957A jsr print_D ; print unsigned number in D
9F97 BD9573 jsr L_9573 ; print 'IN xxxx' (current line number)
9F9A BD90A1 jsr print_CR ; send CR to DEVN
9F9D 3510 puls x
9F9F 3410 L_9F9F pshs x
9FA1 EC01 ldd 1,x ; adjusted line number
9FA3 DD52 std <$52
9FA5 BD9C3E jsr Assign16BitB ; assign contents of $52 / $53 to FPA1
9FA8 BD9587 jsr L_9587 ; convert FPA1 to string at $3DA
9FAB 3540 puls u
9FAD C605 ldb #$05
9FAF 3001 L_9FAF leax 1,x ; write line number into program
9FB1 A684 lda ,x
9FB3 2705 beq L_9FBA
9FB5 5A decb
9FB6 A7C0 sta ,u+
9FB8 20F5 bra L_9FAF
9FBA 30C4 L_9FBA leax ,u
9FBC 5D tstb
9FBD 27BE beq L_9F7D ; exactly 5 digits - no problem
9FBF 31C4 leay ,u
9FC1 33C5 leau b,u
9FC3 BD9DA9 jsr L_9DA9 ; move program down from U to X
9FC6 30A4 leax ,y
9FC8 20B3 bra L_9F7D
9FCA 554C2000 text_ul fcc /UL /,$00 ; /UL /
9FCE 931F mem_patch fcb $93,$1f ; end of BASIC storage
9FD0 0F06 varptr_patch clr <$06 ; numeric / string flag
9FD2 DD52 std <$52
9FD4 C690 ldb #$90 ; meaningless
9FD6 7E9C3E jmp Assign16BitB ; assign contents of $52 / $53 to FPA1
9FD9 00000000000000000000000000000000 fcb $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00 ; * unused
9FE9 00000000000000000000000000000000 fcb $00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00,$00
9FF9 00000000000000 fcb $00,$00,$00,$00,$00,$00,$00
A000 org $a000 ; scan keyboard
A000 8006B54A8021B93EB9998012801B indirect_jump_table fdb POLCAT,OUTCHR,call_CSRDON,BLKIN,BLKOUT,call_JOYIN,call_WRTLDR ; scan keyboard
A00E BD8E86 HEXstr_dispatch jsr L_8E86 ; read 16 bit number into X from FPA1 (& $52)
A011 8E03D9 ldx #$03d9
A014 C604 ldb #$04
A016 3404 L_A016 pshs b
A018 5F clrb
A019 8604 lda #$04
A01B 0853 L_A01B lsl <$53 ; get a nibble into B
A01D 0952 rol <$52
A01F 59 rolb
A020 4A deca
A021 26F8 bne L_A01B
A023 5D tstb
A024 260A bne L_A030 ; digit non-zero
A026 A6E4 lda ,s
A028 4A deca
A029 2705 beq L_A030 ; at last digit
A02B 8C03D9 cmpx #$03d9
A02E 270C beq L_A03C ; don't store leading zeroes
A030 CB30 L_A030 addb #$30
A032 C139 cmpb #$39
A034 2302 bls L_A038 ; not A - F
A036 CB07 addb #$07
A038 E780 L_A038 stb ,x+
A03A 6F84 clr ,x
A03C 3504 L_A03C puls b
A03E 5A decb
A03F 26D5 bne L_A016
A041 3262 leas 2,s ; lose return address
A043 8E03D8 ldx #$03d8
A046 7E8C5B jmp L_8C5B ; register string at X
A049 BDB65F DLOAD_dispatch jsr L_B65F ; close cassette stream & set DEVN to 0
A04C 6FE2 clr ,-s
A04E 9DA5 jsr <$a5 ; get current character from BASIC source
A050 814D cmpa #$4d
A052 2604 bne L_A058
A054 A7E4 sta ,s
A056 9D9F jsr <$9f ; get next character from BASIC source
A058 BDB7AA L_A058 jsr L_B7AA ; get filename
A05B 9DA5 jsr <$a5 ; get current character from BASIC source
A05D 2711 beq L_A070
A05F BD89AA jsr CkComa ; check comma
A062 812C cmpa #$2c
A064 270A beq L_A070
A066 BD8E51 jsr Get8Bit ; get number in B
A069 BD8030 jsr call_SERSET ; select baud rate
A06C 1025EB1D lbcs FC_error ; ?FC ERROR
A070 BDA0F4 L_A070 jsr L_A0F4 ; send filename & get 1st block
A073 3402 pshs a
A075 86FD lda #$fd
A077 976F sta <$6f ; DEVN = -3
A079 3502 puls a
A07B 6DE0 tst ,s+
A07D 262A bne L_A0A9 ; DLOADM
A07F BDB7F9 jsr L_B7F9 ; ensure nothing else on command line
A082 5D tstb ; B must not be 0
A083 2706 beq do_fm_error_A08B ; ?FM ERROR
A085 BD8417 jsr erase_basic ; NEW BASIC
A088 7E837A jmp L_837A ; command mode / no device initialise
A08B 7EB848 do_fm_error_A08B jmp FM_error ; ?FM ERROR
A08E 0F78 L_A08E clr <$78 ; cassette IO status
A090 9D9F jsr <$9f ; get next character from BASIC source
A092 BDB7AA jsr L_B7AA ; get filename
A095 BDB87A jsr L_B87A ; find file & set up buffer
A098 7D01E4 tst >$01e4 ; gap flag
A09B 1027169D lbeq L_B73C ; continuous file
A09F FE01E2 ldu >$01e2 ; U = file type & ASCII flag
A0A2 0A6F dec <$6f ; DEVN
A0A4 BDB867 jsr L_B867 ; get block from tape
A0A7 1F30 tfr u,d
A0A9 830200 L_A0A9 subd #$0200 ; * no data in the EOF block.
A0AC 26DD bne do_fm_error_A08B ; ?FM ERROR
A0AE 9E8A ldx <$8a ; zero
A0B0 9DA5 jsr <$a5 ; get current character from BASIC source
A0B2 2706 beq L_A0BA
A0B4 BD89AA jsr CkComa ; check comma
A0B7 BD8E83 jsr Get16Bit ; get 16 bit number into X
A0BA 9FD3 L_A0BA stx <$d3 ; load offset
A0BC BDB7F9 jsr L_B7F9 ; ensure nothing else on command line
A0BF 8D29 L_A0BF bsr wait_key_flash ; read character from DEVN
A0C1 3402 pshs a
A0C3 8D1E bsr L_A0E3 ; read 2 characters from DEVN into D
A0C5 1F02 tfr d,y ; Y = data length
A0C7 8D1A bsr L_A0E3 ; read 2 characters from DEVN into D
A0C9 D3D3 addd <$d3
A0CB DD9D std <$9d ; default EXEC address
A0CD 1F01 tfr d,x ; X = load address (inc. offset)
A0CF A6E0 lda ,s+
A0D1 1026158E lbne L_B663 ; close DEVN stream & set DEVN to 0
A0D5 8D13 L_A0D5 bsr wait_key_flash ; read character from DEVN
A0D7 A784 sta ,x
A0D9 A180 cmpa ,x+ ; checks that we are loading into RAM
A0DB 2614 bne do_io_error_A0F1 ; ?IO ERROR
A0DD 313F leay -1,y
A0DF 26F4 bne L_A0D5
A0E1 20DC bra L_A0BF
A0E3 8D00 L_A0E3 bsr L_A0E5 ; * read 2 characters from DEVN into D
A0E5 8D03 L_A0E5 bsr wait_key_flash ; read character from DEVN
A0E7 1E89 exg a,b
A0E9 39 L_A0E9 rts
A0EA BDB50A wait_key_flash jsr L_B50A ; * (+cause error if EOF)
A0ED 0D70 tst <$70 ; EOF flag
A0EF 27F8 beq L_A0E9
A0F1 7EB84B do_io_error_A0F1 jmp IO_error ; ?IO ERROR
A0F4 8D1F L_A0F4 bsr L_A115 ; send filename to serial port
A0F6 3406 pshs a,b
A0F8 4C inca
A0F9 2706 beq NE_error
A0FB DE8A ldu <$8a ; zero
A0FD 8D09 bsr L_A108 ; get block from serial port
A0FF 3586 puls a,b,pc
A101 C634 NE_error ldb #$34 ; ?NE ERROR
A103 7E8344 jmp system_error
A106 DE7E L_A106 ldu <$7e ; * get block from serial port into IO buffer
A108 3041 L_A108 leax 1,u
A10A 9F7E stx <$7e
A10C 8E01DA ldx #$01da ; IO buffer
A10F BDA17E jsr L_A17E ; get serial block & store at X
A112 7EB876 jmp L_B876 ; update IO buffer size / reset header address
A115 4F L_A115 clra ; * send filename to serial port
A116 3416 pshs a,b,x
A118 31E4 leay ,s
A11A 2002 bra L_A11E
A11C 8D2B L_A11C bsr L_A149 ; 5 retries only
A11E 868A L_A11E lda #$8a
A120 8D37 bsr L_A159 ; clear checksum, write, read & compare
A122 26F8 bne L_A11C
A124 8E01D2 ldx #$01d2 ; filename
A127 A680 L_A127 lda ,x+
A129 BDA1C1 jsr L_A1C1 ; update checksum & write serial
A12C 8C01DA cmpx #$01da ; IO buffer
A12F 26F6 bne L_A127 ; filename now sent
A131 8D30 bsr L_A163 ; send checksum & clear, read & compare #$c8
A133 26E7 bne L_A11C
A135 8D3C bsr L_A173 ; read serial & update checksum
A137 26E3 bne L_A11C
A139 A722 sta 2,y
A13B 8D36 bsr L_A173 ; read serial & update checksum
A13D 26DD bne L_A11C
A13F A723 sta 3,y
A141 8D29 bsr L_A16C ; read serial, update checksum & load A
A143 26D7 bne L_A11C
A145 3262 leas 2,s
A147 3586 puls a,b,pc
A149 6CA4 L_A149 inc ,y ; * retry count - cause error if count reaches 5
A14B A6A4 lda ,y
A14D 8105 cmpa #$05
A14F 251A bcs L_A16B
A151 86BC lda #$bc
A153 BD802D jsr call_SEROUT ; write serial character
A156 7EB84B jmp IO_error ; ?IO ERROR
A159 3402 L_A159 pshs a ; * clear checksum, write serial, read & compare
A15B 8D5D bsr L_A1BA ; clear checksum, write serial & read
A15D 2602 bne L_A161
A15F A1E4 cmpa ,s
A161 3582 L_A161 puls a,pc
A163 A621 L_A163 lda 1,y ; * send checksum & clear, read & compare #$c8
A165 8D53 bsr L_A1BA ; clear checksum, write serial & read
A167 2602 bne L_A16B
A169 81C8 cmpa #$c8
A16B 39 L_A16B rts
A16C 8D05 L_A16C bsr L_A173 ; read serial & update checksum
A16E 26FB bne L_A16B
A170 A621 lda 1,y
A172 39 rts
A173 BD802A L_A173 jsr call_SERIN ; read serial character
A176 3403 pshs cc,a
A178 A821 eora 1,y
A17A A721 sta 1,y
A17C 3583 puls cc,a,pc
A17E 4F L_A17E clra ; * get block from serial & store starting at X
A17F 3476 pshs a,b,x,y,u
A181 6867 lsl 7,s
A183 6966 rol 6,s
A185 6467 lsr 7,s
A187 31E4 leay ,s
A189 2002 bra L_A18D
A18B 8DBC L_A18B bsr L_A149 ; 5 retries only
A18D 8697 L_A18D lda #$97
A18F 8DC8 bsr L_A159 ; clear checksum, write, read & compare
A191 26F8 bne L_A18B
A193 A626 lda 6,y
A195 8D2A bsr L_A1C1 ; update checksum & write serial
A197 A627 lda 7,y
A199 8D26 bsr L_A1C1 ; update checksum & write serial
A19B 8DC6 bsr L_A163 ; send checksum & clear, read & compare #$c8
A19D 26EC bne L_A18B
A19F 8DD2 bsr L_A173 ; read serial & update checksum
A1A1 26E8 bne L_A18B
A1A3 A724 sta 4,y
A1A5 AE22 ldx 2,y
A1A7 C680 ldb #$80
A1A9 8DC8 L_A1A9 bsr L_A173 ; read serial & update checksum
A1AB 26DE bne L_A18B
A1AD A780 sta ,x+
A1AF 5A decb
A1B0 26F7 bne L_A1A9
A1B2 8DB8 bsr L_A16C ; read serial, update checksum & load A
A1B4 26D5 bne L_A18B
A1B6 3264 leas 4,s
A1B8 3596 puls a,b,x,pc
A1BA 6F21 L_A1BA clr 1,y ; * clear checksum, write serial & read
A1BC 8D0B bsr L_A1C9
A1BE 7E802A jmp call_SERIN ; read serial character
A1C1 3402 L_A1C1 pshs a ; * update checksum & write serial
A1C3 A821 eora 1,y
A1C5 A721 sta 1,y
A1C7 3502 puls a
A1C9 7E802D L_A1C9 jmp call_SEROUT ; write serial character
A1CC 8601 L_A1CC lda #$01 ; * handle ! (PRINT USING 1st character)
A1CE 97D9 sta <$d9
A1D0 5A L_A1D0 decb
A1D1 BDA366 jsr L_A366 ; print a plus sign to DEVN if $DA set
A1D4 9DA5 jsr <$a5 ; get current character from BASIC source
A1D6 1027008C lbeq L_A266
A1DA D7D3 stb <$d3
A1DC BD8887 jsr get_string ; get expression
A1DF BD8877 jsr get_expr ; validate string
A1E2 9E52 ldx <$52
A1E4 9F4D stx <$4d
A1E6 D6D9 ldb <$d9
A1E8 BD8DF3 jsr L_8DF3 ; perform left$ of B chrs on varptr X
A1EB BD90E8 jsr L_90E8 ; print string just compiled to DEVN
A1EE 9E52 ldx <$52
A1F0 D6D9 ldb <$d9
A1F2 E084 subb ,x
A1F4 5A L_A1F4 decb
A1F5 102B0148 lbmi L_A341
A1F9 BD90F5 jsr L_90F5 ; send a space to DEVN
A1FC 20F6 bra L_A1F4
A1FE D7D3 L_A1FE stb <$d3 ; * handle % (PRINT USING string field)
A200 9F0F stx <$0f
A202 8602 lda #$02
A204 97D9 sta <$d9
A206 A684 L_A206 lda ,x
A208 8125 cmpa #$25
A20A 27C4 beq L_A1D0
A20C 8120 cmpa #$20
A20E 2607 bne L_A217
A210 0CD9 inc <$d9
A212 3001 leax 1,x
A214 5A decb
A215 26EF bne L_A206
A217 9E0F L_A217 ldx <$0f
A219 D6D3 ldb <$d3
A21B 8625 lda #$25
A21D BDA366 L_A21D jsr L_A366 ; print a plus sign to DEVN if $DA set
A220 BDB54A jsr OUTCHR ; output character to DEVN
A223 2022 bra L_A247
A225 BD8889 L_A225 jsr L_8889 ; get expression
A228 BD8877 jsr get_expr ; validate string
A22B C63B ldb #$3b
A22D BD89AC jsr CkChar ; skip semicolon
A230 9E52 ldx <$52
A232 9FD5 stx <$d5 ; varptr of USING string
A234 2006 bra L_A23C
A236 96D7 L_A236 lda <$d7
A238 2708 beq do_fc_error_A242 ; ?FC ERROR
A23A 9ED5 ldx <$d5
A23C 0FD7 L_A23C clr <$d7 ; comma counter?
A23E E684 ldb ,x
A240 2603 bne L_A245 ; USING string has a length
A242 7E8B8D do_fc_error_A242 jmp FC_error ; ?FC ERROR
A245 AE02 L_A245 ldx 2,x ; point X to USING string
A247 0FDA L_A247 clr <$da
A249 0FD9 L_A249 clr <$d9
A24B A680 lda ,x+
A24D 8121 cmpa #$21
A24F 1027FF79 lbeq L_A1CC ; print 1st character
A253 8123 cmpa #$23
A255 275B beq L_A2B2 ; numeric field
A257 5A decb
A258 2616 bne L_A270
A25A BDA366 jsr L_A366 ; print a plus sign to DEVN if $DA set
A25D BDB54A jsr OUTCHR ; output character to DEVN
A260 9DA5 L_A260 jsr <$a5 ; get current character from BASIC source
A262 26D2 bne L_A236
A264 96D7 lda <$d7
A266 2603 L_A266 bne L_A26B
A268 BD90A1 jsr print_CR ; send CR to DEVN
A26B 9ED5 L_A26B ldx <$d5
A26D 7E8D9F jmp DELVAR ; point X to string & length in B
A270 812B L_A270 cmpa #$2b
A272 2609 bne L_A27D
A274 BDA366 jsr L_A366 ; print a plus sign to DEVN if $DA set
A277 8608 lda #$08
A279 97DA sta <$da
A27B 20CC bra L_A249
A27D 812E L_A27D cmpa #$2e
A27F 274E beq L_A2CF
A281 8125 cmpa #$25
A283 1027FF77 lbeq L_A1FE
A287 A184 cmpa ,x
A289 2692 L_A289 bne L_A21D
A28B 8124 cmpa #$24
A28D 2719 beq L_A2A8
A28F 812A cmpa #$2a
A291 26F6 bne L_A289
A293 96DA lda <$da
A295 8A20 ora #$20
A297 97DA sta <$da
A299 C102 cmpb #$02
A29B 2511 bcs L_A2AE
A29D A601 lda 1,x
A29F 8124 cmpa #$24
A2A1 260B bne L_A2AE
A2A3 5A decb
A2A4 3001 leax 1,x
A2A6 0CD9 inc <$d9
A2A8 96DA L_A2A8 lda <$da
A2AA 8A10 ora #$10
A2AC 97DA sta <$da
A2AE 3001 L_A2AE leax 1,x
A2B0 0CD9 inc <$d9
A2B2 0FD8 L_A2B2 clr <$d8
A2B4 0CD9 L_A2B4 inc <$d9
A2B6 5A decb
A2B7 2749 beq L_A302
A2B9 A680 lda ,x+
A2BB 812E cmpa #$2e
A2BD 271E beq L_A2DD
A2BF 8123 cmpa #$23
A2C1 27F1 beq L_A2B4
A2C3 812C cmpa #$2c
A2C5 2621 bne L_A2E8
A2C7 96DA lda <$da
A2C9 8A40 ora #$40
A2CB 97DA sta <$da
A2CD 20E5 bra L_A2B4
A2CF A684 L_A2CF lda ,x
A2D1 8123 cmpa #$23
A2D3 1026FF46 lbne L_A21D
A2D7 8601 lda #$01
A2D9 97D8 sta <$d8
A2DB 3001 leax 1,x
A2DD 0CD8 L_A2DD inc <$d8
A2DF 5A decb
A2E0 2720 beq L_A302
A2E2 A680 lda ,x+
A2E4 8123 cmpa #$23
A2E6 27F5 beq L_A2DD
A2E8 815E L_A2E8 cmpa #$5e
A2EA 2616 bne L_A302
A2EC A184 cmpa ,x
A2EE 2612 bne L_A302
A2F0 A101 cmpa 1,x
A2F2 260E bne L_A302
A2F4 A102 cmpa 2,x
A2F6 260A bne L_A302
A2F8 C104 cmpb #$04
A2FA 2506 bcs L_A302
A2FC C004 subb #$04
A2FE 3004 leax 4,x
A300 0CDA inc <$da
A302 301F L_A302 leax -1,x
A304 0CD9 inc <$d9
A306 96DA lda <$da
A308 8508 bita #$08
A30A 2618 bne L_A324
A30C 0AD9 dec <$d9
A30E 5D tstb
A30F 2713 beq L_A324
A311 A684 lda ,x
A313 802D suba #$2d
A315 2706 beq L_A31D
A317 81FE cmpa #$fe
A319 2609 bne L_A324
A31B 8608 lda #$08
A31D 8A04 L_A31D ora #$04
A31F 9ADA ora <$da
A321 97DA sta <$da
A323 5A decb
A324 9DA5 L_A324 jsr <$a5 ; get current character from BASIC source
A326 1027FF3C lbeq L_A266
A32A D7D3 stb <$d3
A32C BD8872 jsr L_8872
A32F 96D9 lda <$d9
A331 9BD8 adda <$d8
A333 8111 cmpa #$11
A335 1022E854 lbhi FC_error ; ?FC ERROR
A339 BDA373 jsr L_A373
A33C 301F leax -1,x
A33E BD90E5 jsr out_string ; print string to DEVN
A341 0FD7 L_A341 clr <$d7
A343 9DA5 jsr <$a5 ; get current character from BASIC source
A345 270D beq L_A354
A347 97D7 sta <$d7
A349 813B cmpa #$3b
A34B 2705 beq L_A352
A34D BD89AA jsr CkComa ; check comma
A350 2002 bra L_A354
A352 9D9F L_A352 jsr <$9f ; get next character from BASIC source
A354 9ED5 L_A354 ldx <$d5
A356 E684 ldb ,x
A358 D0D3 subb <$d3
A35A AE02 ldx 2,x
A35C 3A abx
A35D D6D3 ldb <$d3
A35F 1026FEE4 lbne L_A247
A363 7EA260 jmp L_A260
A366 3402 L_A366 pshs a ; * print a plus sign to DEVN if $DA set
A368 862B lda #$2b
A36A 0DDA tst <$da
A36C 2703 beq L_A371
A36E BDB54A jsr OUTCHR ; output character to DEVN
A371 3582 L_A371 puls a,pc
A373 CE03DB L_A373 ldu #$03db
A376 C620 ldb #$20
A378 96DA lda <$da
A37A 8508 bita #$08
A37C 2702 beq L_A380
A37E C62B ldb #$2b
A380 0D54 L_A380 tst <$54
A382 2A04 bpl L_A388
A384 0F54 clr <$54
A386 C62D ldb #$2d
A388 E7C0 L_A388 stb ,u+
A38A C630 ldb #$30
A38C E7C0 stb ,u+
A38E 8401 anda #$01
A390 10260107 lbne L_A49B
A394 8E956E ldx #data_956E ; FP constant 1000000000
A397 BD944B jsr L_944B ; compare FPA1 - varptr X (of same sign)
A39A 2B15 bmi L_A3B1
A39C BD9587 jsr L_9587 ; convert FPA1 to string at $3da
A39F A680 L_A39F lda ,x+
A3A1 26FC bne L_A39F
A3A3 A682 L_A3A3 lda ,-x
A3A5 A701 sta 1,x
A3A7 8C03DA cmpx #$03da
A3AA 26F7 bne L_A3A3
A3AC 8625 lda #$25
A3AE A784 sta ,x
A3B0 39 rts
A3B1 964F L_A3B1 lda <$4f
A3B3 9747 sta <$47
A3B5 2703 beq L_A3BA
A3B7 BDA55B jsr L_A55B ; convert FPA1 to sig figs & exponent in $47
A3BA 9647 L_A3BA lda <$47
A3BC 102B0081 lbmi L_A441
A3C0 40 nega
A3C1 9BD9 adda <$d9
A3C3 8009 suba #$09
A3C5 BDA478 jsr L_A478
A3C8 BDA5F1 jsr L_A5F1
A3CB BDA590 jsr L_A590 ; print number to U (commas & point if reqd)
A3CE 9647 lda <$47
A3D0 BDA60F jsr L_A60F
A3D3 9647 lda <$47
A3D5 BDA5D7 jsr L_A5D7
A3D8 96D8 lda <$d8
A3DA 2602 bne L_A3DE
A3DC 335F leau -1,u
A3DE 4A L_A3DE deca
A3DF BDA478 jsr L_A478
A3E2 BDA513 L_A3E2 jsr L_A513
A3E5 4D tsta
A3E6 2706 beq L_A3EE
A3E8 C12A cmpb #$2a
A3EA 2702 beq L_A3EE
A3EC E7C0 stb ,u+
A3EE 6FC4 L_A3EE clr ,u
A3F0 8E03DA ldx #$03da
A3F3 3001 L_A3F3 leax 1,x
A3F5 9F0F stx <$0f
A3F7 963A lda <$3a
A3F9 9010 suba <$10
A3FB 90D9 suba <$d9
A3FD 2738 beq L_A437
A3FF A684 lda ,x
A401 8120 cmpa #$20
A403 27EE beq L_A3F3
A405 812A cmpa #$2a
A407 27EA beq L_A3F3
A409 4F clra
A40A 3402 L_A40A pshs a
A40C A680 lda ,x+
A40E 812D cmpa #$2d
A410 27F8 beq L_A40A
A412 812B cmpa #$2b
A414 27F4 beq L_A40A
A416 8124 cmpa #$24
A418 27F0 beq L_A40A
A41A 8130 cmpa #$30
A41C 260E bne L_A42C
A41E A601 lda 1,x
A420 8D16 bsr L_A438 ; carry set if A non-numeric
A422 2508 bcs L_A42C
A424 3502 L_A424 puls a
A426 A782 sta ,-x
A428 26FA bne L_A424
A42A 20C7 bra L_A3F3
A42C 3502 L_A42C puls a
A42E 4D tsta
A42F 26FB bne L_A42C
A431 9E0F ldx <$0f
A433 8625 lda #$25
A435 A782 sta ,-x
A437 39 L_A437 rts
A438 8130 L_A438 cmpa #$30 ; * carry clear if A is ASCII digit
A43A 2504 bcs L_A440
A43C 803A suba #$3a
A43E 80C6 suba #$c6
A440 39 L_A440 rts
A441 96D8 L_A441 lda <$d8
A443 2701 beq L_A446
A445 4A deca
A446 9B47 L_A446 adda <$47
A448 2B01 bmi L_A44B
A44A 4F clra
A44B 3402 L_A44B pshs a
A44D 2A0A L_A44D bpl L_A459
A44F 3402 pshs a
A451 BD932D jsr L_932D ; divide FPA1 by 10
A454 3502 puls a
A456 4C inca
A457 20F4 bra L_A44D
A459 9647 L_A459 lda <$47
A45B A0E0 suba ,s+
A45D 9747 sta <$47
A45F 8B09 adda #$09
A461 2B19 bmi L_A47C
A463 96D9 lda <$d9
A465 8009 suba #$09
A467 9047 suba <$47
A469 8D0D bsr L_A478
A46B BDA5F1 jsr L_A5F1
A46E 201D bra L_A48D
A470 3402 L_A470 pshs a
A472 8630 lda #$30
A474 A7C0 sta ,u+
A476 3502 puls a
A478 4A L_A478 deca
A479 2AF5 bpl L_A470
A47B 39 rts
A47C 96D9 L_A47C lda <$d9
A47E 8DF8 bsr L_A478
A480 BDA5DB jsr L_A5DB
A483 86F7 lda #$f7
A485 9047 suba <$47
A487 8DEF bsr L_A478
A489 0F45 clr <$45
A48B 0FD7 clr <$d7
A48D BDA590 L_A48D jsr L_A590 ; print number to U (commas & point if reqd)
A490 96D8 lda <$d8
A492 2602 bne L_A496
A494 DE39 ldu <$39
A496 9B47 L_A496 adda <$47
A498 16FF43 lbra L_A3DE
A49B 964F L_A49B lda <$4f
A49D 3402 pshs a
A49F 2703 beq L_A4A4
A4A1 BDA55B jsr L_A55B ; convert FPA1 to sig figs & exponent in $47
A4A4 96D8 L_A4A4 lda <$d8
A4A6 2701 beq L_A4A9
A4A8 4A deca
A4A9 9BD9 L_A4A9 adda <$d9
A4AB 7F03DA clr >$03da
A4AE D6DA ldb <$da
A4B0 C404 andb #$04
A4B2 2603 bne L_A4B7
A4B4 7303DA com >$03da
A4B7 BB03DA L_A4B7 adda >$03da
A4BA 8009 suba #$09
A4BC 3402 pshs a
A4BE 2A0A L_A4BE bpl L_A4CA
A4C0 3402 pshs a
A4C2 BD932D jsr L_932D ; divide FPA1 by 10
A4C5 3502 puls a
A4C7 4C inca
A4C8 20F4 bra L_A4BE
A4CA A6E4 L_A4CA lda ,s
A4CC 2B01 bmi L_A4CF
A4CE 4F clra
A4CF 40 L_A4CF nega
A4D0 9BD9 adda <$d9
A4D2 4C inca
A4D3 BB03DA adda >$03da
A4D6 9745 sta <$45
A4D8 0FD7 clr <$d7
A4DA BDA590 jsr L_A590 ; print number to U (commas & point if reqd)
A4DD 3502 puls a
A4DF BDA60F jsr L_A60F
A4E2 96D8 lda <$d8
A4E4 2602 bne L_A4E8
A4E6 335F leau -1,u
A4E8 E6E0 L_A4E8 ldb ,s+
A4EA 2709 beq L_A4F5
A4EC D647 ldb <$47
A4EE CB09 addb #$09
A4F0 D0D9 subb <$d9
A4F2 F003DA subb >$03da
A4F5 862B L_A4F5 lda #$2b
A4F7 5D tstb
A4F8 2A03 bpl L_A4FD
A4FA 862D lda #$2d
A4FC 50 negb
A4FD A741 L_A4FD sta 1,u
A4FF 8645 lda #$45
A501 A7C1 sta ,u++
A503 862F lda #$2f
A505 4C L_A505 inca
A506 C00A subb #$0a
A508 24FB bcc L_A505
A50A CB3A addb #$3a
A50C EDC1 std ,u++
A50E 6FC4 clr ,u
A510 7EA3E2 jmp L_A3E2
A513 8E03DB L_A513 ldx #$03db
A516 E684 ldb ,x
A518 3404 pshs b
A51A 8620 lda #$20
A51C D6DA ldb <$da
A51E C520 bitb #$20
A520 3504 puls b
A522 2708 beq L_A52C
A524 862A lda #$2a
A526 C120 cmpb #$20
A528 2602 bne L_A52C
A52A 1F89 tfr a,b
A52C 3404 L_A52C pshs b
A52E A780 L_A52E sta ,x+
A530 E684 ldb ,x
A532 2710 beq L_A544
A534 C145 cmpb #$45
A536 270C beq L_A544
A538 C130 cmpb #$30
A53A 27F2 beq L_A52E
A53C C12C cmpb #$2c
A53E 27EE beq L_A52E
A540 C12E cmpb #$2e
A542 2604 bne L_A548
A544 8630 L_A544 lda #$30
A546 A782 sta ,-x
A548 96DA L_A548 lda <$da
A54A 8510 bita #$10
A54C 2704 beq L_A552
A54E C624 ldb #$24
A550 E782 stb ,-x
A552 8404 L_A552 anda #$04
A554 3504 puls b
A556 2602 bne L_A55A
A558 E782 stb ,-x
A55A 39 L_A55A rts
A55B 3440 L_A55B pshs u ; * convert FPA1 to sig figs & exponent in $47
A55D 4F clra
A55E 9747 L_A55E sta <$47
A560 D64F ldb <$4f
A562 C180 cmpb #$80
A564 2211 bhi L_A577
A566 8E956E ldx #data_956E ; FP constant 1000000000
A569 BD9273 jsr L_9273 ; FPA1 = varptr X * FPA1
A56C 9647 lda <$47
A56E 8009 suba #$09
A570 20EC bra L_A55E
A572 BD932D L_A572 jsr L_932D ; divide FPA1 by 10
A575 0C47 inc <$47
A577 8E9569 L_A577 ldx #data_9569 ; FP constant 999999999
A57A BD944B jsr L_944B ; compare FPA1 - varptr X (of same sign)
A57D 2EF3 bgt L_A572
A57F 8E9564 L_A57F ldx #data_9564 ; FP constant 99999999.9
A582 BD944B jsr L_944B ; compare FPA1 - varptr X (of same sign)
A585 2E07 bgt L_A58E
A587 BD9315 jsr L_9315 ; multiply FPA1 by 10
A58A 0A47 dec <$47
A58C 20F1 bra L_A57F
A58E 35C0 L_A58E puls u,pc
A590 3440 L_A590 pshs u ; * print number to U (commas & point if reqd)
A592 BD90FD jsr L_90FD ; add 0.5 to FPA1
A595 BD9473 jsr L_9473 ; denormalize FPA1 to an integer
A598 3540 puls u
A59A 8E9673 ldx #data_9673 ; powers of 10 table
A59D C680 ldb #$80
A59F 8D36 L_A59F bsr L_A5D7
A5A1 9653 L_A5A1 lda <$53
A5A3 AB03 adda 3,x
A5A5 9753 sta <$53
A5A7 9652 lda <$52
A5A9 A902 adca 2,x
A5AB 9752 sta <$52
A5AD 9651 lda <$51
A5AF A901 adca 1,x
A5B1 9751 sta <$51
A5B3 9650 lda <$50
A5B5 A984 adca ,x
A5B7 9750 sta <$50
A5B9 5C incb
A5BA 56 rorb
A5BB 59 rolb
A5BC 28E3 bvc L_A5A1
A5BE 2403 bcc L_A5C3
A5C0 C00B subb #$0b
A5C2 50 negb
A5C3 CB2F L_A5C3 addb #$2f
A5C5 3004 leax 4,x
A5C7 1F98 tfr b,a
A5C9 847F anda #$7f
A5CB A7C0 sta ,u+
A5CD 53 comb
A5CE C480 andb #$80
A5D0 8C9697 cmpx #SQR_dispatch
A5D3 26CA bne L_A59F
A5D5 6FC4 clr ,u
A5D7 0A45 L_A5D7 dec <$45
A5D9 2609 bne L_A5E4
A5DB DF39 L_A5DB stu <$39
A5DD 862E lda #$2e
A5DF A7C0 sta ,u+
A5E1 0FD7 clr <$d7
A5E3 39 rts
A5E4 0AD7 L_A5E4 dec <$d7 ; * store a comma if required
A5E6 2608 bne L_A5F0
A5E8 8603 lda #$03
A5EA 97D7 sta <$d7
A5EC 862C lda #$2c
A5EE A7C0 sta ,u+
A5F0 39 L_A5F0 rts
A5F1 9647 L_A5F1 lda <$47
A5F3 8B0A adda #$0a
A5F5 9745 sta <$45
A5F7 4C inca
A5F8 8003 L_A5F8 suba #$03
A5FA 24FC bcc L_A5F8
A5FC 8B05 adda #$05
A5FE 97D7 sta <$d7
A600 96DA lda <$da
A602 8440 anda #$40
A604 2602 bne L_A608
A606 97D7 sta <$d7
A608 39 L_A608 rts
A609 3402 L_A609 pshs a
A60B 8DCA bsr L_A5D7
A60D 3502 puls a
A60F 4A L_A60F deca
A610 2B0A bmi L_A61C
A612 3402 pshs a
A614 8630 lda #$30
A616 A7C0 sta ,u+
A618 A6E0 lda ,s+
A61A 26ED bne L_A609
A61C 39 L_A61C rts
A61D CEA62A L_A61D ldu #data_A62A ; * get address of pixel calc routine for current PMODE
A620 96B6 lda <$b6 ; current PMODE
A622 48 lsla
A623 EEC6 ldu a,u
A625 39 rts
A626 8DF5 L_A626 bsr L_A61D ; * call relevant pixel calc routine for PMODE
A628 6EC4 jmp ,u
A62A A634A650A634A650A634 data_A62A fdb jmp_A634,jmp_A650,jmp_A634,jmp_A650,jmp_A634 ; * JMP table containing pixel calc routines for each PMODE
A634 3444 jmp_A634 pshs b,u ; * calculate pixel address & mask for 2 colour modes
A636 D6B9 ldb <$b9 ; bytes per line in current graphics mode
A638 96C0 lda <$c0
A63A 3D mul
A63B D3BA addd <$ba ; start of current graphics
A63D 1F01 tfr d,x
A63F D6BE ldb <$be
A641 54 lsrb
A642 54 lsrb
A643 54 lsrb
A644 3A abx
A645 96BE lda <$be
A647 8407 anda #$07
A649 CEA66B ldu #data_A66B
A64C A6C6 lda a,u
A64E 35C4 puls b,u,pc
A650 3444 jmp_A650 pshs b,u ; * calculate pixel address & mask for 4 colour modes
A652 D6B9 ldb <$b9 ; bytes per line in current graphics mode
A654 96C0 lda <$c0
A656 3D mul
A657 D3BA addd <$ba ; start of current graphics
A659 1F01 tfr d,x
A65B D6BE ldb <$be
A65D 54 lsrb
A65E 54 lsrb
A65F 3A abx
A660 96BE lda <$be
A662 8403 anda #$03
A664 CEA673 ldu #data_A673
A667 A6C6 lda a,u
A669 35C4 puls b,u,pc
A66B 8040201008040201 data_A66B fcb $80,$40,$20,$10,$08,$04,$02,$01 ; * pixel mask table for 2 colour modes
A673 C0300C03 data_A673 fcb $c0,$30,$0c,$03 ; * pixel mask table for 4 colour modes
A677 D6B9 jmp_A677 ldb <$b9 ; bytes per line in current graphics mode
A679 3A abx
A67A 39 rts
A67B 44 jmp_A67B lsra ; * used by LINE
A67C 2403 bcc L_A681
A67E 46 rora
A67F 3001 leax 1,x
A681 39 L_A681 rts
A682 44 jmp_A682 lsra ; * used by LINE
A683 24F6 bcc jmp_A67B
A685 86C0 lda #$c0
A687 3001 leax 1,x
A689 39 rts
A68A BD8E7A L_A68A jsr L_8E7A ; read pair of numbers into $2b/$2c & B
A68D 108E00BD ldy #$00bd
A691 C1C0 L_A691 cmpb #$c0
A693 2502 bcs L_A697
A695 C6BF ldb #$bf
A697 4F L_A697 clra
A698 ED22 std 2,y
A69A DC2B ldd <$2b
A69C 10830100 cmpd #$0100
A6A0 2503 bcs L_A6A5
A6A2 CC00FF ldd #$00ff
A6A5 EDA4 L_A6A5 std ,y
A6A7 39 rts
A6A8 BDA68A L_A6A8 jsr L_A68A ; read coordinates into $bd & $bf
A6AB CE00BD L_A6AB ldu #$00bd ; * adjust standard coords into true pixel coords
A6AE 96B6 L_A6AE lda <$b6 ; current PMODE
A6B0 8102 cmpa #$02
A6B2 2406 bcc L_A6BA
A6B4 EC42 ldd 2,u ; adjust Y for PMODEs 0 & 1
A6B6 44 lsra
A6B7 56 rorb
A6B8 ED42 std 2,u
A6BA 96B6 L_A6BA lda <$b6 ; current PMODE
A6BC 8104 cmpa #$04
A6BE 2406 bcc L_A6C6
A6C0 ECC4 ldd ,u ; adjust X for PMODEs 0 to 3
A6C2 44 lsra
A6C3 56 rorb
A6C4 EDC4 std ,u
A6C6 39 L_A6C6 rts
A6C7 BDA740 PPOINT_dispatch jsr L_A740 ; get coords into $bd / $bf
A6CA BDA6AB jsr L_A6AB ; adjust coords for PMODE
A6CD BDA626 jsr L_A626 ; call relevant pixel calc routine for PMODE
A6D0 A484 anda ,x
A6D2 D6B6 ldb <$b6 ; current PMODE
A6D4 56 rorb
A6D5 2412 bcc L_A6E9
A6D7 8104 L_A6D7 cmpa #$04
A6D9 2504 bcs L_A6DF
A6DB 46 rora
A6DC 46 rora
A6DD 20F8 bra L_A6D7
A6DF 4C L_A6DF inca
A6E0 48 lsla
A6E1 9BC1 adda <$c1 ; current colour set
A6E3 44 lsra
A6E4 1F89 L_A6E4 tfr a,b
A6E6 7E8C36 jmp Assign8Bit ; assign B to FPA1
A6E9 4D L_A6E9 tsta
A6EA 27F8 beq L_A6E4
A6EC 4F clra
A6ED 20F0 bra L_A6DF
A6EF 8601 PSET_dispatch lda #$01 ; * PSET
A6F1 2001 bra L_A6F4
A6F3 4F PRESET_dispatch clra ; * PRESET
A6F4 97C2 L_A6F4 sta <$c2 ; PRESET / PSET flag
A6F6 BD89A7 jsr CkOpBrak ; skip open bracket
A6F9 BDA6A8 jsr L_A6A8 ; read coords into $bd & $bf and adjust
A6FC BDA90F jsr L_A90F ; read optional colour
A6FF BD89A4 jsr CkClBrak ; skip close bracket
A702 BDA626 jsr L_A626 ; call relevant pixel calc routine for PMODE
A705 E684 L_A705 ldb ,x ; * called by LINE to plot pixel
A707 3404 pshs b
A709 1F89 tfr a,b
A70B 43 coma
A70C A484 anda ,x
A70E D4B5 andb <$b5 ; byte value of plot colour
A710 3404 pshs b
A712 AAE0 ora ,s+
A714 A784 sta ,x
A716 A0E0 suba ,s+
A718 9ADB ora <$db
A71A 97DB sta <$db
A71C 39 rts
A71D 9EC7 L_A71D ldx <$c7 ; * if first pair is missing then current coords are used
A71F 9FBD stx <$bd
A721 9EC9 ldx <$c9
A723 9FBF stx <$bf
A725 81C4 cmpa #$c4 ; token -
A727 2703 beq L_A72C
A729 BDA740 jsr L_A740
A72C C6C4 L_A72C ldb #$c4
A72E BD89AC jsr CkChar
A731 BD89A7 jsr CkOpBrak ; skip open bracket
A734 BD8E7A jsr L_8E7A ; read pair of numbers into $2b/$2c & B
A737 108E00C3 ldy #$00c3
A73B BDA691 jsr L_A691
A73E 2006 bra L_A746 ; skip close bracket
A740 BD89A7 L_A740 jsr CkOpBrak ; skip open bracket
A743 BDA68A jsr L_A68A ; read coordinates into $bd & $bf
A746 7E89A4 L_A746 jmp CkClBrak ; skip close bracket
A749 8189 LINE_dispatch cmpa #$89 ; token INPUT
A74B 1027F662 lbeq LINE_INPUT_handler ; LINE INPUT
A74F 8128 cmpa #$28
A751 2709 beq L_A75C
A753 81C4 cmpa #$c4 ; token -
A755 2705 beq L_A75C
A757 C640 ldb #$40
A759 BD89AC jsr CkChar ; optional @ before coords
A75C BDA71D L_A75C jsr L_A71D ; sets up $bd/$bf & $c3/$c5
A75F 9EC3 ldx <$c3 ; with coords
A761 9FC7 stx <$c7
A763 9EC5 ldx <$c5
A765 9FC9 stx <$c9
A767 BD89AA jsr CkComa ; check comma
A76A 81AD cmpa #$ad ; token PRESET
A76C 2709 beq L_A777
A76E 81AC cmpa #$ac ; token PSET
A770 1026E240 lbne SN_error ; ?SN ERROR
A774 C601 ldb #$01
A776 86 fcb $86 ; lda #$5f - comment byte
A777 5F L_A777 clrb ; usually skipped by comment byte
A778 3404 pshs b ; * (A777 5F CLRB)
A77A 9D9F jsr <$9f ; get next character from BASIC source
A77C BDA7AE jsr L_A7AE ; adjust coords for PMODE
A77F 3504 puls b
A781 D7C2 stb <$c2 ; PRESET / PSET flag
A783 BDA928 jsr L_A928 ; set up current colour
A786 9DA5 jsr <$a5 ; get current character from BASIC source
A788 102700A3 lbeq L_A82F ; must be a normal line
A78C BD89AA jsr CkComa ; check comma
A78F C642 ldb #$42
A791 BD89AC jsr CkChar ; check for 'B'
A794 2621 bne L_A7B7
A796 8D3A bsr L_A7D2 ; * draw empty rectangle
A798 8D62 bsr L_A7FC
A79A 9EBD ldx <$bd
A79C 3410 pshs x
A79E 9EC3 ldx <$c3
A7A0 9FBD stx <$bd
A7A2 8D58 bsr L_A7FC
A7A4 3510 puls x
A7A6 9FBD stx <$bd
A7A8 9EC5 ldx <$c5
A7AA 9FBF stx <$bf
A7AC 2024 bra L_A7D2
A7AE BDA6AB L_A7AE jsr L_A6AB ; * adjust line's coords for current PMODE
A7B1 CE00C3 ldu #$00c3
A7B4 7EA6AE jmp L_A6AE
A7B7 C646 L_A7B7 ldb #$46 ; * only 'F' allowed after 'B'
A7B9 BD89AC jsr CkChar
A7BC 2004 bra L_A7C2
A7BE 301F L_A7BE leax -1,x
A7C0 9FBF L_A7C0 stx <$bf
A7C2 BDA7D2 L_A7C2 jsr L_A7D2 ; draw horizontal line
A7C5 9EBF ldx <$bf
A7C7 9CC5 cmpx <$c5
A7C9 2706 beq L_A7D1
A7CB 24F1 bcc L_A7BE ; next Y up or down?
A7CD 3001 leax 1,x
A7CF 20EF bra L_A7C0
A7D1 39 L_A7D1 rts
A7D2 9EBD L_A7D2 ldx <$bd ; * draw horizontal line from left to right
A7D4 3410 pshs x
A7D6 BDAAB8 jsr L_AAB8 ; calc +ve difference in x ords
A7D9 2404 bcc L_A7DF
A7DB 9EC3 ldx <$c3
A7DD 9FBD stx <$bd ; store lower of two values for calc
A7DF 1F02 L_A7DF tfr d,y
A7E1 3121 leay 1,y
A7E3 BDA626 jsr L_A626 ; calc pixel
A7E6 3540 puls u
A7E8 DFBD stu <$bd
A7EA 8D36 bsr L_A822 ; get address of pixel stepper in U
A7EC 97D7 L_A7EC sta <$d7 ; store pixel mask
A7EE BDA705 jsr L_A705 ; plot
A7F1 96D7 lda <$d7
A7F3 ADC4 jsr ,u ; next pixel
A7F5 313F leay -1,y
A7F7 26F3 bne L_A7EC
A7F9 39 rts
A7FA 3506 L_A7FA puls a,b ; * jumped from general line routine
A7FC DCBF L_A7FC ldd <$bf ; * draw vertical line downwards
A7FE 3406 pshs a,b
A800 BDAAAB jsr L_AAAB ; +ve difference in Y ords
A803 2404 bcc L_A809
A805 9EC5 ldx <$c5
A807 9FBF stx <$bf
A809 1F02 L_A809 tfr d,y
A80B 3121 leay 1,y
A80D BDA626 jsr L_A626 ; call relevant pixel calc routine for PMODE
A810 3540 puls u
A812 DFBF stu <$bf
A814 8D15 bsr L_A82B
A816 20D4 bra L_A7EC
A818 A67BA682A67BA682A67B data_A818 fdb jmp_A67B,jmp_A682,jmp_A67B,jmp_A682,jmp_A67B ; * table of addresses of pixel step routines according to PMODE
A822 CEA818 L_A822 ldu #data_A818 ; * get address of pixel step routine according to PMODE
A825 D6B6 ldb <$b6 ; current PMODE
A827 58 lslb
A828 EEC5 ldu b,u
A82A 39 rts
A82B CEA677 L_A82B ldu #jmp_A677 ; * set U up with address of vertical pixel stepper
A82E 39 rts
A82F 108EA89B L_A82F ldy #jmp_A89B ; increment Y ord
A833 BDAAAB jsr L_AAAB ; +ve difference in Y ords
A836 1027FF98 lbeq L_A7D2 ; horizontal line
A83A 2404 bcc L_A840 ; draw left to right
A83C 108EA8A9 ldy #jmp_A8A9 ; decrement Y ord
A840 3406 L_A840 pshs a,b
A842 CEA894 ldu #jmp_A894 ; increment X ord
A845 BDAAB8 jsr L_AAB8 ; +ve difference in X ords
A848 27B0 beq L_A7FA ; vertical line
A84A 2403 bcc L_A84F ; draw top to bottom
A84C CEA8A2 ldu #jmp_A8A2 ; decrement X ord
A84F 10A3E4 L_A84F cmpd ,s
A852 3510 puls x
A854 2404 bcc L_A85A ; delta X >= delta Y
A856 1E32 exg u,y ; get main stepper in U
A858 1E01 exg d,x ; get larger delta in D
A85A 3446 L_A85A pshs a,b,u
A85C 3406 pshs a,b
A85E 44 lsra ; make initial total 1/2 of large
A85F 56 rorb ; delta for equal end segments
A860 2509 bcs L_A86B ; large delta was odd
A862 1183A89C cmpu #jmp_A89B + 1
A866 2503 bcs L_A86B ; main stepper is in +ve direction
A868 830001 subd #$0001 ; mystery tweak
A86B 3416 L_A86B pshs a,b,x
A86D BDA61D jsr L_A61D ; get pixel calc in U
A870 ADC4 L_A870 jsr ,u
A872 BDA705 jsr L_A705 ; plot
A875 AE66 ldx 6,s
A877 2717 beq L_A890
A879 301F leax -1,x
A87B AF66 stx 6,s ; dec counter
A87D ADF808 jsr [<$08,s] ; step pixel in main direction
A880 ECE4 ldd ,s
A882 E362 addd 2,s ; add small delta
A884 EDE4 std ,s ; to total
A886 A364 subd 4,s ; subtract larger delta
A888 25E6 bcs L_A870 ; threshold not reached
A88A EDE4 std ,s
A88C ADA4 jsr ,y ; step pixel in lesser direction
A88E 20E0 bra L_A870
A890 3510 L_A890 puls x
A892 35F6 puls a,b,x,y,u,pc
A894 9EBD jmp_A894 ldx <$bd ; * increment X ord (LINE / PAINT)
A896 3001 leax 1,x
A898 9FBD stx <$bd
A89A 39 rts
A89B 9EBF jmp_A89B ldx <$bf ; * increment Y ord (LINE)
A89D 3001 leax 1,x
A89F 9FBF stx <$bf
A8A1 39 rts
A8A2 9EBD jmp_A8A2 ldx <$bd ; * decrement X ord (LINE / PAINT)
A8A4 301F leax -1,x
A8A6 9FBD stx <$bd
A8A8 39 rts
A8A9 9EBF jmp_A8A9 ldx <$bf ; * decrement Y ord (LINE)
A8AB 301F leax -1,x
A8AD 9FBF stx <$bf
A8AF 39 rts
A8B0 CE00D3 L_A8B0 ldu #$00d3 ; * sets up $d3 / $d5 with max coords adjusted for PMODE
A8B3 8E00FF ldx #$00ff
A8B6 AFC4 stx ,u
A8B8 8E00BF ldx #$00bf
A8BB AF42 stx 2,u
A8BD 7EA6AE jmp L_A6AE
A8C0 270E PCLS_dispatch beq L_A8D0 ; * PCLS
A8C2 8D24 bsr L_A8E8
A8C4 8655 L_A8C4 lda #$55
A8C6 3D mul
A8C7 9EBA pcls_B ldx <$ba ; start of current graphics
A8C9 E780 L_A8C9 stb ,x+
A8CB 9CB7 cmpx <$b7 ; 1st byte after current graphics
A8CD 26FA bne L_A8C9
A8CF 39 rts
A8D0 D6B3 L_A8D0 ldb <$b3 ; current background colour
A8D2 20F0 bra L_A8C4
A8D4 812C COLOR_dispatch cmpa #$2c ; * COLOR
A8D6 2708 beq L_A8E0
A8D8 8D0E bsr L_A8E8
A8DA D7B2 stb <$b2 ; current foreground colour
A8DC 9DA5 jsr <$a5 ; get current character from BASIC source
A8DE 2707 beq L_A8E7
A8E0 BD89AA L_A8E0 jsr CkComa ; check comma
A8E3 8D03 bsr L_A8E8
A8E5 D7B3 stb <$b3 ; current background colour
A8E7 39 L_A8E7 rts
A8E8 BD8E51 L_A8E8 jsr Get8Bit ; get number in B
A8EB C109 L_A8EB cmpb #$09
A8ED 1024E29C lbcc FC_error ; ?FC ERROR
A8F1 4F clra
A8F2 C105 cmpb #$05
A8F4 2504 bcs L_A8FA
A8F6 8608 lda #$08
A8F8 C004 subb #$04
A8FA 3402 L_A8FA pshs a
A8FC 96B6 lda <$b6 ; current PMODE
A8FE 46 rora
A8FF 2408 bcc L_A909
A901 5D tstb
A902 2602 bne L_A906
A904 C604 L_A904 ldb #$04
A906 5A L_A906 decb
A907 3582 L_A907 puls a,pc
A909 56 L_A909 rorb
A90A 25F8 bcs L_A904
A90C 5F clrb
A90D 20F8 bra L_A907
A90F BDA928 L_A90F jsr L_A928 ; set up colours
A912 9DA5 jsr <$a5 ; get current character from BASIC source
A914 2710 beq L_A926
A916 8129 cmpa #$29
A918 270C beq L_A926
A91A BD89AA jsr CkComa ; check comma
A91D 812C cmpa #$2c
A91F 2705 beq L_A926
A921 BDA8E8 jsr L_A8E8
A924 8D0A bsr L_A930
A926 0EA5 L_A926 jmp <$a5 ; get current character from BASIC source
A928 D6B2 L_A928 ldb <$b2 ; current foreground colour
A92A 0DC2 tst <$c2 ; PRESET / PSET flag
A92C 2602 bne L_A930
A92E D6B3 ldb <$b3 ; current background colour
A930 D7B4 L_A930 stb <$b4 ; plot colour
A932 8655 lda #$55
A934 3D mul
A935 D7B5 stb <$b5 ; byte value of plot colour
A937 39 rts
A938 2623 L_A938 bne L_A95D ; * called by SCREEN: sets up text or graphics according to Z
A93A 3416 reset_vdu pshs a,b,x ; * reset VDU
A93C 8EFFC8 ldx #$ffc8
A93F A70A sta 10,x
A941 A708 sta 8,x
A943 A706 sta 6,x
A945 A704 sta 4,x
A947 A702 sta 2,x
A949 A701 sta 1,x
A94B A71E sta -2,x
A94D A71C sta -4,x
A94F A71A sta -6,x
A951 A718 sta -8,x
A953 B6FF22 lda >$ff22
A956 8407 anda #$07
A958 B7FF22 sta >$ff22
A95B 3596 puls a,b,x,pc
A95D 3416 L_A95D pshs a,b,x ; * set up graphics display
A95F 96B6 lda <$b6 ; current PMODE
A961 8B03 adda #$03
A963 C610 ldb #$10
A965 3D mul
A966 CA80 orb #$80
A968 DAC1 orb <$c1 ; current colour set
A96A B6FF22 lda >$ff22
A96D 8407 anda #$07
A96F 3402 pshs a
A971 EAE0 orb ,s+
A973 F7FF22 stb >$ff22
A976 96BA lda <$ba ; start of current graphics
A978 44 lsra
A979 BDA99D jsr L_A99D ; set up SAM VDG base
A97C 96B6 lda <$b6 ; current PMODE
A97E 8B03 adda #$03
A980 8107 cmpa #$07
A982 2601 bne L_A985
A984 4A deca
A985 8D02 L_A985 bsr set_vdg_mode_A ; set up SAM VDG mem mode
A987 3596 puls a,b,x,pc
A989 C603 set_vdg_mode_A ldb #$03 ; * set up SAM VDG mode
A98B 8EFFC0 ldx #$ffc0
A98E 46 L_A98E rora
A98F 2404 bcc L_A995
A991 A701 sta 1,x
A993 2002 bra L_A997
A995 A784 L_A995 sta ,x
A997 3002 L_A997 leax 2,x
A999 5A decb
A99A 26F2 bne L_A98E
A99C 39 rts
A99D C607 L_A99D ldb #$07 ; * set up VDG offset
A99F 8EFFC6 ldx #$ffc6
A9A2 20EA bra L_A98E
A9A4 B6FF22 L_A9A4 lda >$ff22 ; * select VDG colour set
A9A7 84F7 anda #$f7
A9A9 9AC1 ora <$c1 ; current colour set
A9AB B7FF22 sta >$ff22
A9AE 39 rts
A9AF 812C PMODE_dispatch cmpa #$2c ; * PMODE
A9B1 272B beq L_A9DE
A9B3 BD8E51 jsr Get8Bit ; get number in B
A9B6 C105 cmpb #$05
A9B8 2441 bcc do_fc_error_A9FB ; ?FC ERROR
A9BA 96BC lda <$bc ; MSB of start of graphics page 1
A9BC 97BA sta <$ba ; start of current graphics
A9BE 58 lslb
A9BF CEAAA2 ldu #pmode_table + 1 ; PMODE setup table + 1
A9C2 ABC5 adda b,u
A9C4 9119 cmpa <$19 ; start of BASIC program
A9C6 2233 bhi do_fc_error_A9FB ; ?FC ERROR
A9C8 97B7 sta <$b7 ; 1st byte after current graphics
A9CA 335F leau -1,u
A9CC A6C5 lda b,u
A9CE 97B9 sta <$b9 ; bytes per line in current graphics mode
A9D0 54 lsrb
A9D1 D7B6 stb <$b6 ; current PMODE
A9D3 4F clra
A9D4 97B3 sta <$b3 ; current background colour
A9D6 8603 lda #$03
A9D8 97B2 sta <$b2 ; current foreground colour
A9DA 9DA5 jsr <$a5 ; get current character from BASIC source
A9DC 271C beq L_A9FA ; RTS
A9DE BD8E7E L_A9DE jsr L_8E7E ; skip comma & get number in B
A9E1 5D tstb
A9E2 2717 beq do_fc_error_A9FB ; ?FC ERROR
A9E4 5A decb
A9E5 8606 lda #$06
A9E7 3D mul
A9E8 DBBC addb <$bc ; MSB of start of graphics page 1
A9EA 3404 pshs b
A9EC DBB7 addb <$b7 ; 1st byte after current graphics
A9EE D0BA subb <$ba ; start of current graphics
A9F0 D119 cmpb <$19 ; start of BASIC program
A9F2 2207 bhi do_fc_error_A9FB ; ?FC ERROR
A9F4 D7B7 stb <$b7 ; 1st byte after current graphics
A9F6 3504 puls b
A9F8 D7BA stb <$ba ; start of current graphics
A9FA 39 L_A9FA rts
A9FB 7E8B8D do_fc_error_A9FB jmp FC_error ; ?FC ERROR
A9FE 812C SCREEN_dispatch cmpa #$2c ; * SCREEN
AA00 270B beq L_AA0D
AA02 BD8E51 jsr Get8Bit ; get number in B
AA05 5D tstb
AA06 BDA938 jsr L_A938
AA09 9DA5 jsr <$a5 ; get current character from BASIC source
AA0B 27ED beq L_A9FA
AA0D BD8E7E L_AA0D jsr L_8E7E ; skip comma & get number in B
AA10 5D tstb
AA11 2702 beq L_AA15
AA13 C608 ldb #$08
AA15 D7C1 L_AA15 stb <$c1 ; current colour set
AA17 208B bra L_A9A4
AA19 BD8E51 PCLEAR_dispatch jsr Get8Bit ; get number in B
AA1C 5D tstb
AA1D 27DC beq do_fc_error_A9FB ; ?FC ERROR
AA1F C109 cmpb #$09
AA21 24D8 bcc do_fc_error_A9FB ; ?FC ERROR
AA23 8606 lda #$06
AA25 3D mul
AA26 DBBC addb <$bc ; MSB of start of graphics page 1
AA28 1F98 tfr b,a
AA2A C601 ldb #$01
AA2C 1F02 tfr d,y
AA2E 1093B7 cmpd <$b7 ; 1st byte after current graphics
AA31 1025E158 lbcs FC_error ; ?FC ERROR
AA35 9319 subd <$19 ; start of BASIC program
AA37 D31B addd <$1b ; start of simple variables
AA39 1F01 tfr d,x
AA3B C300C8 addd #$00c8
AA3E 9321 subd <$21 ; stack root / string storage start
AA40 24B9 bcc do_fc_error_A9FB ; ?FC ERROR
AA42 9668 lda <$68 ; current line number
AA44 4C inca
AA45 2708 beq L_AA4F
AA47 1F20 tfr y,d
AA49 9319 subd <$19 ; start of BASIC program
AA4B D3A6 addd <$a6 ; BASIC source pointer
AA4D DDA6 std <$a6
AA4F DE1B L_AA4F ldu <$1b ; start of simple variables
AA51 9F1B stx <$1b
AA53 11931B cmpu <$1b
AA56 2417 bcc L_AA6F
AA58 A6C2 L_AA58 lda ,-u
AA5A A782 sta ,-x
AA5C 119319 cmpu <$19 ; start of BASIC program
AA5F 26F7 bne L_AA58
AA61 109F19 sty <$19 ; start of BASIC program
AA64 6F3F clr -1,y
AA66 BD83ED L_AA66 jsr BasVect2 ; set up next line pointers in BASIC program
AA69 BD8424 jsr L_8424 ; clear variables & reset stack
AA6C 7E849F jmp run_basic ; interpreter loop
AA6F DE19 L_AA6F ldu <$19 ; start of BASIC program
AA71 109F19 sty <$19
AA74 6F3F clr -1,y
AA76 A6C0 L_AA76 lda ,u+
AA78 A7A0 sta ,y+
AA7A 109C1B cmpy <$1b ; start of simple variables
AA7D 26F7 bne L_AA76
AA7F 20E5 bra L_AA66
AA81 C61E L_AA81 ldb #$1e ; * called by reset routine to PCLEAR 4
AA83 D719 stb <$19 ; start of BASIC program
AA85 8606 lda #$06
AA87 97BC sta <$bc ; MSB of start of graphics page 1
AA89 97BA sta <$ba ; start of current graphics
AA8B 4F clra
AA8C 97B6 sta <$b6 ; current PMODE
AA8E 8610 lda #$10
AA90 97B9 sta <$b9 ; bytes per line in current graphics mode
AA92 8603 lda #$03
AA94 97B2 sta <$b2 ; current foreground colour
AA96 860C lda #$0c
AA98 97B7 sta <$b7 ; 1st byte after current graphics
AA9A 9E19 ldx <$19 ; start of BASIC program
AA9C 6F1F clr -1,x
AA9E 7E8417 jmp erase_basic ; NEW BASIC
AAA1 1006200C100C20182018 pmode_table fcb $10,$06,$20,$0c,$10,$0c,$20,$18,$20,$18 ; * PMODE setup table: bytes/line + MSB of display size
AAAB DCC5 L_AAAB ldd <$c5 ; * calc +ve difference in Y ords
AAAD 93BF subd <$bf
AAAF 243B L_AAAF bcc L_AAEC
AAB1 3401 pshs cc
AAB3 BDB15E jsr L_B15E ; D = -D
AAB6 3581 puls cc,pc
AAB8 DCC3 L_AAB8 ldd <$c3 ; * calc +ve difference in X ords
AABA 93BD subd <$bd
AABC 20F1 bra L_AAAF
AABE 8D1A PCOPY_dispatch bsr L_AADA ; * PCOPY
AAC0 3406 pshs a,b
AAC2 C6BC ldb #$bc
AAC4 BD89AC jsr CkChar ; check for token TO
AAC7 8D11 bsr L_AADA
AAC9 3510 puls x
AACB 1F03 tfr d,u
AACD 108E0300 ldy #$0300
AAD1 EC81 L_AAD1 ldd ,x++
AAD3 EDC1 std ,u++
AAD5 313F leay -1,y
AAD7 26F8 bne L_AAD1
AAD9 39 rts
AADA BD8E51 L_AADA jsr Get8Bit ; get number in B
AADD 5D tstb
AADE 270D beq do_fc_error_AAED ; ?FC ERROR
AAE0 5A decb
AAE1 8606 lda #$06
AAE3 3D mul
AAE4 DBBC addb <$bc ; MSB of start of graphics page 1
AAE6 D119 cmpb <$19 ; page address must be lower
AAE8 2403 bcc do_fc_error_AAED ; than BASIC program
AAEA 1E89 exg a,b
AAEC 39 L_AAEC rts
AAED 7E8B8D do_fc_error_AAED jmp FC_error ; ?FC ERROR
AAF0 5F GET_dispatch clrb ; * GET
AAF1 2002 bra L_AAF5
AAF3 C601 PUT_dispatch ldb #$01 ; * PUT
AAF5 D7D8 L_AAF5 stb <$d8
AAF7 BD01A0 jsr >$01a0 ; PATCH - CLS GET PUT
AAFA 8140 cmpa #$40
AAFC 2602 bne L_AB00 ; optional @ before coords
AAFE 9D9F jsr <$9f ; get next character from BASIC source
AB00 BDA71D L_AB00 jsr L_A71D ; get coords into $bd/$bf & $c3/$c5
AB03 BD89AA jsr CkComa ; check comma
AB06 BDAC67 jsr L_AC67 ; validate & get varptr of array
AB09 1F10 tfr x,d
AB0B EE84 ldu ,x
AB0D 335E leau -2,u
AB0F 33CB leau d,u
AB11 DFD1 stu <$d1 ; address of last byte of array+1
AB13 3002 leax 2,x
AB15 E684 ldb ,x ; no. of dimensions
AB17 58 lslb
AB18 3A abx
AB19 9FCF stx <$cf ; address of first byte of array
AB1B 9606 lda <$06 ; string arrays not allowed
AB1D 26CE bne do_fc_error_AAED ; ?FC ERROR
AB1F 0FD4 clr <$d4
AB21 9DA5 jsr <$a5 ; get current character from BASIC source
AB23 272D beq L_AB52 ; no parameter after array
AB25 03D4 com <$d4
AB27 BD89AA jsr CkComa ; check comma
AB2A 0DD8 tst <$d8
AB2C 2607 bne L_AB35 ; PUT
AB2E C647 ldb #$47
AB30 BD89AC jsr CkChar ; skip G
AB33 2030 bra L_AB65 ; GET ,G
AB35 C605 L_AB35 ldb #$05
AB37 8EABD4 ldx #data_ABD4
AB3A EE81 L_AB3A ldu ,x++ ; set up action routines for PUT
AB3C 10AE81 ldy ,x++
AB3F A180 cmpa ,x+
AB41 2706 beq L_AB49
AB43 5A decb
AB44 26F4 bne L_AB3A
AB46 7E89B4 jmp SN_error ; ?SN ERROR
AB49 109FD5 L_AB49 sty <$d5
AB4C DFD9 stu <$d9
AB4E 9D9F jsr <$9f ; get next character from BASIC source
AB50 2013 bra L_AB65
AB52 C6F8 L_AB52 ldb #$f8 ; * bytewise GET / PUT
AB54 96B6 lda <$b6 ; current PMODE
AB56 46 rora
AB57 2402 bcc L_AB5B ; 2 colour modes
AB59 C6FC ldb #$fc
AB5B 1F98 L_AB5B tfr b,a
AB5D D4BE andb <$be ; adjust horizontal coords to align with bytes
AB5F D7BE stb <$be
AB61 94C4 anda <$c4
AB63 97C4 sta <$c4
AB65 BDAAB8 L_AB65 jsr L_AAB8 ; calc +ve difference in x ords
AB68 2404 bcc L_AB6E ; 1st is less than 2nd
AB6A 9EC3 ldx <$c3
AB6C 9FBD stx <$bd
AB6E DDC3 L_AB6E std <$c3 ; x ord difference
AB70 BDAAAB jsr L_AAAB ; +ve difference in Y ords
AB73 2404 bcc L_AB79 ; 1st is less than 2nd
AB75 9EC5 ldx <$c5
AB77 9FBF stx <$bf
AB79 DDC5 L_AB79 std <$c5 ; y ord difference
AB7B 96B6 lda <$b6 ; current PMODE
AB7D 46 rora
AB7E DCC3 ldd <$c3
AB80 2404 bcc L_AB86 ; 2 colour modes
AB82 D3C3 addd <$c3
AB84 DDC3 std <$c3
AB86 BDA7AE L_AB86 jsr L_A7AE ; adjust coords for PMODE
AB89 DCC3 ldd <$c3
AB8B 9EC5 ldx <$c5
AB8D 3001 leax 1,x
AB8F 9FC5 stx <$c5 ; add 1 to y difference to get height
AB91 0DD4 tst <$d4
AB93 2658 bne L_ABED ; action specified
AB95 44 lsra
AB96 56 rorb
AB97 44 lsra
AB98 56 rorb
AB99 44 lsra
AB9A 56 rorb
AB9B C30001 addd #$0001
AB9E DDC3 std <$c3 ; width of image in bytes
ABA0 BDA626 jsr L_A626 ; call relevant pixel calc routine for PMODE
ABA3 D6C4 L_ABA3 ldb <$c4
ABA5 3410 pshs x
ABA7 0DD8 L_ABA7 tst <$d8
ABA9 2721 beq L_ABCC ; GET
ABAB 8D11 bsr L_ABBE ; increment array pointer (U)
ABAD A6C4 lda ,u
ABAF A780 sta ,x+
ABB1 5A L_ABB1 decb
ABB2 26F3 bne L_ABA7 ; repeat until line done
ABB4 3510 puls x
ABB6 BDA677 jsr jmp_A677 ; move X one line down for all PMODEs
ABB9 0AC6 dec <$c6
ABBB 26E6 bne L_ABA3 ; another line
ABBD 39 L_ABBD rts
ABBE DECF L_ABBE ldu <$cf ; * increment array pointer (U)
ABC0 3341 leau 1,u
ABC2 DFCF stu <$cf
ABC4 1193D1 cmpu <$d1
ABC7 26F4 bne L_ABBD ; RTS
ABC9 7E8B8D do_fc_error_ABC9 jmp FC_error ; ?FC ERROR
ABCC A680 L_ABCC lda ,x+ ; * action for GET without G parameter
ABCE 8DEE bsr L_ABBE ; increment array pointer (U)
ABD0 A7C4 sta ,u
ABD2 20DD bra L_ABB1
ABD4 AC2FAC36 data_ABD4 fdb PUT_handle_0,PUT_handle_1 ; PSET
ABD8 AC fcb $ac
ABD9 AC36AC2F fdb PUT_handle_1,PUT_handle_0 ; PRESET
ABDD AD fcb $ad
ABDE AC4CAC36 fdb PUT_handle_3,PUT_handle_1 ; OR
ABE2 C9 fcb $c9
ABE3 AC2FAC4C fdb PUT_handle_0,PUT_handle_3 ; AND
ABE7 C8 fcb $c8
ABE8 AC3CAC3C fdb PUT_handle_2,PUT_handle_2 ; NOT
ABEC C0 fcb $c0
ABED C30001 L_ABED addd #$0001 ; * GET(G) & PUT(action) - does it bitwise
ABF0 DDC3 std <$c3 ; width of image in bits
ABF2 96D8 lda <$d8
ABF4 2609 bne L_ABFF ; PUT
ABF6 DED1 ldu <$d1
ABF8 A7C2 L_ABF8 sta ,-u ; clear array for GET
ABFA 1193CF cmpu <$cf
ABFD 22F9 bhi L_ABF8
ABFF BDA626 L_ABFF jsr L_A626 ; call relevant pixel calc routine for PMODE
AC02 D6B6 ldb <$b6 ; current PMODE
AC04 56 rorb
AC05 2402 bcc L_AC09 ; 2 colour modes
AC07 84AA anda #$aa ; reduce mask to single bit
AC09 C601 L_AC09 ldb #$01
AC0B 109ECF ldy <$cf
AC0E 3412 L_AC0E pshs a,x
AC10 DEC3 ldu <$c3 ; U = image width in bits
AC12 3442 L_AC12 pshs a,u
AC14 54 lsrb ; step array bit pointer
AC15 2408 bcc L_AC1F
AC17 56 rorb ; B = $80
AC18 3121 leay 1,y ; filled an array byte, so point to next one
AC1A 109CD1 cmpy <$d1 ; test for end of array
AC1D 27AA beq do_fc_error_ABC9 ; ?FC ERROR
AC1F 0DD8 L_AC1F tst <$d8
AC21 271F beq L_AC42 ; GET
AC23 E5A4 bitb ,y ; test array bit
AC25 2704 beq L_AC2B
AC27 6E9F00D5 jmp [$00d5] ; action if array bit set
AC2B 6E9F00D9 L_AC2B jmp [$00d9] ; action if array bit clear
AC2F 43 PUT_handle_0 coma ; * action for PSET 0, PRESET 1, AND 0
AC30 A484 anda ,x
AC32 A784 sta ,x ; clear screen bit
AC34 2016 bra PUT_handle_3 ; next bit
AC36 AA84 PUT_handle_1 ora ,x ; * action for PSET 1, PRESET 0, OR 1
AC38 A784 sta ,x ; set screen bit
AC3A 2010 bra PUT_handle_3 ; next bit
AC3C A884 PUT_handle_2 eora ,x ; * action for NOT 0, NOT 1
AC3E A784 sta ,x ; invert screen bit
AC40 200A bra PUT_handle_3 ; next bit
AC42 A584 L_AC42 bita ,x ; test screen bit
AC44 2706 beq PUT_handle_3 ; don't set array bit - next pixel
AC46 1F98 tfr b,a
AC48 AAA4 ora ,y
AC4A A7A4 sta ,y ; set array bit
AC4C 3542 PUT_handle_3 puls a,u ; pixel mask & width counter
AC4E BDA67B jsr jmp_A67B ; step bit one to right
AC51 335F leau -1,u
AC53 11938A cmpu <$8a ; zero
AC56 26BA bne L_AC12 ; not end of line
AC58 AE61 ldx 1,s
AC5A 96B9 lda <$b9 ; bytes per line in current graphics mode
AC5C 3086 leax a,x ; point X to next line
AC5E 3502 puls a
AC60 3262 leas 2,s
AC62 0AC6 dec <$c6
AC64 26A8 bne L_AC0E ; do another line
AC66 39 rts
AC67 BD8A94 L_AC67 jsr GETVAR ; get varptr address
AC6A E682 ldb ,-x
AC6C A682 lda ,-x
AC6E 1F03 tfr d,u ; get variable name in U
AC70 9E1D ldx <$1d
AC72 9C1F L_AC72 cmpx <$1f
AC74 1027DF15 lbeq FC_error ; ?FC ERROR
AC78 11A384 cmpu ,x ; search array storage to ensure
AC7B 2706 beq L_AC83 ; that specified variable is an
AC7D EC02 ldd 2,x ; array
AC7F 308B leax d,x
AC81 20EF bra L_AC72
AC83 3002 L_AC83 leax 2,x ; varptr
AC85 39 rts
AC86 39 L_AC86 rts
AC87 8140 PAINT_dispatch cmpa #$40 ; * PAINT
AC89 2602 bne L_AC8D ; optional @ before coords
AC8B 9D9F jsr <$9f ; get next character from BASIC source
AC8D BDA740 L_AC8D jsr L_A740 ; get coords into $bd / $bf
AC90 BDA6AB jsr L_A6AB ; adjust coords for PMODE
AC93 8601 lda #$01
AC95 97C2 sta <$c2 ; PRESET / PSET flag
AC97 BDA90F jsr L_A90F ; read optional colour
AC9A DCB4 ldd <$b4 ; plot colour
AC9C 3406 pshs a,b
AC9E 9DA5 jsr <$a5 ; get current character from BASIC source
ACA0 2703 beq L_ACA5
ACA2 BDA90F jsr L_A90F ; read optional colour
ACA5 96B5 L_ACA5 lda <$b5 ; byte value of plot colour
ACA7 97D8 sta <$d8
ACA9 3506 puls a,b
ACAB DDB4 std <$b4 ; plot colour
ACAD 4F clra
ACAE 3456 pshs a,b,x,u
ACB0 BDA8B0 jsr L_A8B0 ; set up max coords for PMODE
ACB3 BDA61D jsr L_A61D ; get address of pixel calc routine
ACB6 DFD9 stu <$d9 ; pixel calc
ACB8 BDAD7A jsr L_AD7A ; paint left & count pixels in U, D & X
ACBB 270F beq L_ACCC ; none painted
ACBD BDAD66 jsr L_AD66 ; paint right after previous left
ACC0 8601 lda #$01
ACC2 97D7 sta <$d7
ACC4 BDAD55 jsr L_AD55 ; save pos on stack
ACC7 00D7 neg <$d7
ACC9 BDAD55 jsr L_AD55 ; save pos on stack
ACCC 10DFDC L_ACCC sts <$dc
ACCF 0DDB L_ACCF tst <$db ; * (main loop)
ACD1 2603 bne L_ACD6 ; pixels were painted on previous line
ACD3 10DEDC lds <$dc
ACD6 3556 L_ACD6 puls a,b,x,u
ACD8 0FDB clr <$db ; pixel changed flag (updated by plot)
ACDA 10DFDC sts <$dc
ACDD 3001 leax 1,x
ACDF 9FBD stx <$bd ; current x pos
ACE1 DFD1 stu <$d1 ; no. of pixels painted on previous line
ACE3 97D7 sta <$d7 ; up / down flag
ACE5 279F beq L_AC86 ; RTS - pulled final stack entry
ACE7 2B06 bmi L_ACEF ; paint up
ACE9 5C incb
ACEA D1D6 cmpb <$d6
ACEC 2305 bls L_ACF3 ; not off bottom of screen
ACEE 5F clrb
ACEF 5D L_ACEF tstb
ACF0 27DD beq L_ACCF ; at top/bottom of screen
ACF2 5A decb
ACF3 D7C0 L_ACF3 stb <$c0
ACF5 BDAD7A jsr L_AD7A ; paint left & count pixels in U, D & X
ACF8 270F beq L_AD09 ; none painted
ACFA 10830003 cmpd #$0003
ACFE 2504 bcs L_AD04 ; only 1 or 2 pixels painted
AD00 301E leax -2,x
AD02 8D38 bsr L_AD3C ; save pos on stack with reverse direction
AD04 BDAD66 L_AD04 jsr L_AD66 ; paint right after previous left
AD07 8D4C L_AD07 bsr L_AD55 ; save pos on stack
AD09 43 L_AD09 coma
AD0A 53 comb
AD0B D3D1 L_AD0B addd <$d1
AD0D DDD1 std <$d1
AD0F 2F16 ble L_AD27
AD11 BDA894 jsr jmp_A894 ; increment X ord
AD14 BDADAD jsr L_ADAD ; calc pixel & test for border colour
AD17 2605 bne L_AD1E
AD19 CCFFFF ldd #$ffff
AD1C 20ED bra L_AD0B
AD1E BDA8A2 L_AD1E jsr jmp_A8A2 ; decrement X ord
AD21 8D3E bsr L_AD61 ; copy X ord to $c3
AD23 8D5E bsr L_AD83 ; paint right & count pixels in U, D & X
AD25 20E0 bra L_AD07
AD27 BDA894 L_AD27 jsr jmp_A894 ; increment X ord
AD2A 308B leax d,x
AD2C 9FBD stx <$bd
AD2E 43 coma
AD2F 53 comb
AD30 830001 subd #$0001
AD33 2F04 ble L_AD39
AD35 1F01 tfr d,x
AD37 8D03 bsr L_AD3C ; save pos on stack with reverse direction
AD39 7EACCF L_AD39 jmp L_ACCF ; loop again
AD3C DDCB L_AD3C std <$cb ; * save pos with reverse direction
AD3E 3520 puls y
AD40 DCBD ldd <$bd
AD42 3416 pshs a,b,x
AD44 96D7 lda <$d7
AD46 40 nega
AD47 D6C0 L_AD47 ldb <$c0
AD49 3406 pshs a,b
AD4B 3420 pshs y
AD4D C602 ldb #$02
AD4F BD8331 jsr L_8331 ; memory check
AD52 DCCB ldd <$cb
AD54 39 rts
AD55 DDCB L_AD55 std <$cb ; * save pos on stack
AD57 3520 puls y
AD59 DCC3 ldd <$c3
AD5B 3416 pshs a,b,x
AD5D 96D7 lda <$d7
AD5F 20E6 bra L_AD47
AD61 9EBD L_AD61 ldx <$bd ; * copy X ord to $c3
AD63 9FC3 stx <$c3
AD65 39 rts
AD66 DDCD L_AD66 std <$cd ; * D = no. of pixels painted right + 1
AD68 109EC3 ldy <$c3
AD6B 8DF4 bsr L_AD61 ; copy X ord to $c3
AD6D 109FBD sty <$bd
AD70 8D11 bsr L_AD83 ; paint right & count pixels in U, D & X
AD72 9ECD ldx <$cd
AD74 308B leax d,x
AD76 C30001 addd #$0001
AD79 39 rts
AD7A BDAD61 L_AD7A jsr L_AD61 ; copy X ord to $c3
AD7D 108EA8A2 ldy #jmp_A8A2 ; decrement X ord
AD81 2006 bra L_AD89
AD83 108EA894 L_AD83 ldy #jmp_A894 ; increment X ord
AD87 ADA4 jsr ,y ; step X ord
AD89 DE8A L_AD89 ldu <$8a ; zero
AD8B 9EBD ldx <$bd
AD8D 2B17 L_AD8D bmi L_ADA6 ; < min X
AD8F 9CD3 cmpx <$d3
AD91 2213 bhi L_ADA6 ; > max X
AD93 3460 pshs y,u
AD95 8D16 bsr L_ADAD ; calc pixel & test for border colour
AD97 270B beq L_ADA4
AD99 BDA705 jsr L_A705 ; plot
AD9C 3560 puls y,u
AD9E 3341 leau 1,u
ADA0 ADA4 jsr ,y ; step X ord
ADA2 20E9 bra L_AD8D
ADA4 3560 L_ADA4 puls y,u
ADA6 1F30 L_ADA6 tfr u,d
ADA8 1F01 tfr d,x
ADAA 938A subd <$8a ; CMPD #0
ADAC 39 rts
ADAD AD9F00D9 L_ADAD jsr [$00d9] ; pixel calc
ADB1 1F89 tfr a,b
ADB3 D4D8 andb <$d8
ADB5 3406 pshs a,b
ADB7 A484 anda ,x
ADB9 A161 cmpa 1,s
ADBB 3586 puls a,b,pc
ADBD 9E8A PLAY_dispatch ldx <$8a ; zero
ADBF C601 ldb #$01
ADC1 3414 pshs b,x
ADC3 BD8887 jsr get_string ; get expression
ADC6 5F clrb
ADC7 BDBAF1 jsr L_BAF1 ; B=0 to select d/a sound
ADCA BDBAC5 jsr L_BAC5 ; enable audio
ADCD BD8D9A L_ADCD jsr L_8D9A ; validate string & point X to it (len in B)
ADD0 2002 bra L_ADD4
ADD2 3514 L_ADD2 puls b,x
ADD4 D7D8 L_ADD4 stb <$d8 ; string length
ADD6 27FA beq L_ADD2
ADD8 9FD9 stx <$d9 ; 1st byte in string
ADDA 10270CE5 lbeq L_BAC3 ; nothing to do - disable audio & quit
ADDE 0DD8 L_ADDE tst <$d8 ; remaining string length
ADE0 27F0 beq L_ADD2
ADE2 BDAF33 jsr L_AF33 ; get character
ADE5 813B cmpa #$3b
ADE7 27F5 beq L_ADDE
ADE9 8127 cmpa #$27
ADEB 27F1 beq L_ADDE
ADED 8158 cmpa #$58
ADEF 102701B2 lbeq L_AFA5 ; execute substring
ADF3 8D02 bsr L_ADF7 ; interpret meta-command
ADF5 20E7 bra L_ADDE
ADF7 814F L_ADF7 cmpa #$4f ; * change octave
ADF9 260D bne L_AE08
ADFB D6DE ldb <$de ; PLAY octave
ADFD 5C incb
ADFE 8D5B bsr L_AE5B ; modify B according to PLAY parameter
AE00 5A decb
AE01 C104 cmpb #$04
AE03 2263 bhi do_fc_error_AE68 ; ?FC ERROR
AE05 D7DE stb <$de ; PLAY octave
AE07 39 rts
AE08 8156 L_AE08 cmpa #$56 ; * change volume
AE0A 261A bne L_AE26
AE0C D6DF ldb <$df ; PLAY d/a high value
AE0E 54 lsrb
AE0F 54 lsrb
AE10 C01F subb #$1f
AE12 8D47 bsr L_AE5B ; modify B according to PLAY parameter
AE14 C11F cmpb #$1f
AE16 2250 bhi do_fc_error_AE68 ; ?FC ERROR
AE18 58 lslb
AE19 58 lslb
AE1A 3404 pshs b
AE1C CC7E7C ldd #$7e7c
AE1F ABE4 adda ,s
AE21 E0E0 subb ,s+
AE23 DDDF std <$df ; PLAY volume data
AE25 39 rts
AE26 814C L_AE26 cmpa #$4c ; * change note length
AE28 2623 bne L_AE4D
AE2A D6E1 ldb <$e1 ; PLAY note length
AE2C 8D2D bsr L_AE5B ; modify B according to PLAY parameter
AE2E 5D tstb
AE2F 2737 beq do_fc_error_AE68 ; ?FC ERROR
AE31 D7E1 stb <$e1 ; PLAY note length
AE33 0FE5 clr <$e5 ; duration modifier (no. of dots)
AE35 8D03 L_AE35 bsr L_AE3A
AE37 24FC bcc L_AE35
AE39 39 rts
AE3A 0DD8 L_AE3A tst <$d8 ; remaining string length
AE3C 270A beq L_AE48
AE3E BDAF33 jsr L_AF33 ; get character
AE41 812E cmpa #$2e
AE43 2705 beq L_AE4A
AE45 BDAF7D jsr L_AF7D ; move string pointer back one
AE48 43 L_AE48 coma
AE49 39 rts
AE4A 0CE5 L_AE4A inc <$e5 ; duration modifier (no. of dots)
AE4C 39 rts
AE4D 8154 L_AE4D cmpa #$54 ; * change tempo
AE4F 260D bne L_AE5E
AE51 D6E2 ldb <$e2 ; PLAY tempo
AE53 8D06 bsr L_AE5B ; modify B according to PLAY parameter
AE55 5D tstb
AE56 2710 beq do_fc_error_AE68 ; ?FC ERROR
AE58 D7E2 stb <$e2 ; PLAY tempo
AE5A 39 rts
AE5B 7EAF47 L_AE5B jmp L_AF47 ; * change a PLAY parameter (modifies value in B)
AE5E 8150 L_AE5E cmpa #$50 ; * play a pause
AE60 2624 bne L_AE86
AE62 BDB066 jsr L_B066 ; check for number or =variable (get into B)
AE65 5D tstb
AE66 2603 bne L_AE6B
AE68 7E8B8D do_fc_error_AE68 jmp FC_error ; ?FC ERROR
AE6B 96E5 L_AE6B lda <$e5 ; duration modifier (no. of dots)
AE6D 9EDF ldx <$df ; PLAY volume data
AE6F 3412 pshs a,x
AE71 867C lda #$7c
AE73 97DF sta <$df ; PLAY d/a high value
AE75 97E0 sta <$e0 ; PLAY d/a low value
AE77 0FE5 clr <$e5 ; duration modifier (no. of dots)
AE79 8D07 bsr L_AE82
AE7B 3512 puls a,x
AE7D 97E5 sta <$e5 ; duration modifier (no. of dots)
AE7F 9FDF stx <$df ; PLAY volume data
AE81 39 rts
AE82 6FE2 L_AE82 clr ,-s
AE84 2040 bra L_AEC6
AE86 814E L_AE86 cmpa #$4e ; * ignore an N!
AE88 2603 bne L_AE8D
AE8A BDAF33 jsr L_AF33 ; get character
AE8D 8141 L_AE8D cmpa #$41
AE8F 2504 bcs L_AE95
AE91 8147 cmpa #$47
AE93 2305 bls play_note_A
AE95 BDAF59 L_AE95 jsr L_AF59 ; check for number or =variable (get into B)
AE98 2023 bra L_AEBD
AE9A 8041 play_note_A suba #$41
AE9C 8EAFF6 ldx #data_AFF6 ; note number XLAT table
AE9F E686 ldb a,x ; XLAT into number
AEA1 0DD8 tst <$d8 ; remaining string length
AEA3 2718 beq L_AEBD
AEA5 BDAF33 jsr L_AF33 ; get character
AEA8 8123 cmpa #$23
AEAA 2704 beq L_AEB0
AEAC 812B cmpa #$2b
AEAE 2603 bne L_AEB3
AEB0 5C L_AEB0 incb ; sharpen note
AEB1 200A bra L_AEBD
AEB3 812D L_AEB3 cmpa #$2d
AEB5 2603 bne L_AEBA
AEB7 5A decb ; flatten note
AEB8 2003 bra L_AEBD
AEBA BDAF7D L_AEBA jsr L_AF7D ; move string pointer back one
AEBD 5A L_AEBD decb
AEBE C10B cmpb #$0b
AEC0 22A6 bhi do_fc_error_AE68 ; ?FC ERROR
AEC2 3404 pshs b
AEC4 D6E1 ldb <$e1 ; PLAY note length
AEC6 96E2 L_AEC6 lda <$e2 ; PLAY tempo
AEC8 3D mul
AEC9 DDD5 std <$d5 ; PLAY duration decrement value
AECB 3361 leau 1,s ; point U to return address ($ADF5)
AECD 96DE lda <$de ; PLAY octave
AECF 8101 cmpa #$01
AED1 222C bhi L_AEFF
AED3 8EAFFD ldx #data_AFFD ; pitch XLAT table for octaves 1 & 2
AED6 C618 ldb #$18
AED8 3D mul
AED9 3A abx
AEDA 3504 puls b
AEDC 58 lslb
AEDD 3A abx
AEDE 3184 leay ,x ; XLAT note for octaves 1 & 2
AEE0 8D45 bsr L_AF27 ; compute PLAY duration
AEE2 DDE3 std <$e3 ; PLAY duration counter
AEE4 8D0C L_AEE4 bsr L_AEF2 ; zero d/a
AEE6 96DF lda <$df ; PLAY d/a high value
AEE8 8D0B bsr L_AEF5 ; set d/a
AEEA 8D06 bsr L_AEF2 ; zero d/a
AEEC 96E0 lda <$e0 ; PLAY d/a low value
AEEE 8D05 bsr L_AEF5 ; set d/a
AEF0 20F2 bra L_AEE4 ; irq routine controls duration
AEF2 867C L_AEF2 lda #$7c ; * ;forces jump to $adf5
AEF4 12 nop
AEF5 B7FF20 L_AEF5 sta >$ff20
AEF8 AEA4 ldx ,y
AEFA 301F L_AEFA leax -1,x
AEFC 26FC bne L_AEFA
AEFE 39 rts
AEFF 8EB015 L_AEFF ldx #data_B015 ; XLAT table for octaves 3 - 5 (-$18)
AF02 C60C ldb #$0c
AF04 3D mul
AF05 3A abx
AF06 3504 puls b
AF08 3A abx ; XLAT note for octaves 3 - 5
AF09 8D1C bsr L_AF27 ; compute PLAY duration
AF0B DDE3 std <$e3 ; PLAY duration counter
AF0D 8D0C L_AF0D bsr L_AF1B ; zero d/a
AF0F 96DF lda <$df ; PLAY d/a high value
AF11 8D0B bsr L_AF1E ; set d/a
AF13 8D06 bsr L_AF1B ; zero d/a
AF15 96E0 lda <$e0 ; PLAY d/a low value
AF17 8D05 bsr L_AF1E ; set d/a
AF19 20F2 bra L_AF0D ; irq routine controls duration
AF1B 867C L_AF1B lda #$7c ; * ;forces jump to $adf5
AF1D 12 nop
AF1E B7FF20 L_AF1E sta >$ff20
AF21 A684 lda ,x
AF23 4A L_AF23 deca
AF24 26FD bne L_AF23
AF26 39 rts
AF27 C6FF L_AF27 ldb #$ff ; * compute PLAY duration
AF29 96E5 lda <$e5 ; duration modifier (no. of dots)
AF2B 2705 beq L_AF32
AF2D 8B02 adda #$02
AF2F 3D mul
AF30 44 lsra
AF31 56 rorb
AF32 39 L_AF32 rts
AF33 3410 L_AF33 pshs x ; * (called by PLAY & DRAW)
AF35 0DD8 L_AF35 tst <$d8 ; remaining string length
AF37 274D beq do_fc_error_AF86
AF39 9ED9 ldx <$d9 ; string pointer
AF3B A680 lda ,x+
AF3D 9FD9 stx <$d9 ; string pointer
AF3F 0AD8 dec <$d8 ; remaining string length
AF41 8120 cmpa #$20
AF43 27F0 beq L_AF35
AF45 3590 puls x,pc
AF47 8DEA L_AF47 bsr L_AF33 ; get character
AF49 812B cmpa #$2b ; inc
AF4B 273C beq L_AF89
AF4D 812D cmpa #$2d ; dec
AF4F 273C beq L_AF8D
AF51 813E cmpa #$3e ; double
AF53 2742 beq L_AF97
AF55 813C cmpa #$3c ; halve
AF57 2739 beq L_AF92
AF59 813D L_AF59 cmpa #$3d ; equals a variable
AF5B 273F beq L_AF9C
AF5D BDA438 jsr L_A438 ; carry set if A non-numeric
AF60 2524 bcs do_fc_error_AF86 ; ?FC ERROR
AF62 5F clrb
AF63 8030 L_AF63 suba #$30
AF65 97D7 sta <$d7
AF67 860A lda #$0a
AF69 3D mul
AF6A 4D tsta
AF6B 2619 bne do_fc_error_AF86 ; ?FC ERROR
AF6D DBD7 addb <$d7
AF6F 2515 bcs do_fc_error_AF86 ; ?FC ERROR
AF71 0DD8 tst <$d8 ; remaining string length
AF73 2717 beq L_AF8C
AF75 BDAF33 jsr L_AF33 ; get character
AF78 BDA438 jsr L_A438 ; carry set if A non-numeric
AF7B 24E6 bcc L_AF63
AF7D 0CD8 L_AF7D inc <$d8 ; remaining string length
AF7F 9ED9 ldx <$d9 ; string pointer
AF81 301F leax -1,x
AF83 9FD9 stx <$d9 ; string pointer
AF85 39 rts
AF86 7E8B8D do_fc_error_AF86 jmp FC_error ; ?FC ERROR
AF89 5C L_AF89 incb ; * increment PLAY parameter
AF8A 27FA beq do_fc_error_AF86 ; ?FC ERROR
AF8C 39 L_AF8C rts
AF8D 5D L_AF8D tstb ; * decrement PLAY parameter
AF8E 27F6 beq do_fc_error_AF86 ; ?FC ERROR
AF90 5A decb
AF91 39 rts
AF92 5D L_AF92 tstb ; * halve PLAY parameter
AF93 27F1 beq do_fc_error_AF86 ; ?FC ERROR
AF95 54 lsrb
AF96 39 rts
AF97 5D L_AF97 tstb ; * double PLAY parameter
AF98 2BEC bmi do_fc_error_AF86 ; ?FC ERROR
AF9A 58 lslb
AF9B 39 rts
AF9C 3460 L_AF9C pshs y,u ; * PLAY parameter equals a variable
AF9E 8D16 bsr L_AFB6 ; validate variable
AFA0 BD8E54 jsr L_8E54 ; get number in B from FPA1
AFA3 35E0 puls y,u,pc
AFA5 BDAFB6 L_AFA5 jsr L_AFB6 ; validate variable
AFA8 C602 ldb #$02
AFAA BD8331 jsr L_8331 ; memory check
AFAD D6D8 ldb <$d8 ; remaining string length
AFAF 9ED9 ldx <$d9 ; string pointer
AFB1 3414 pshs b,x
AFB3 7EADCD jmp L_ADCD
AFB6 9ED9 L_AFB6 ldx <$d9 ; string pointer
AFB8 3410 pshs x
AFBA BDAF33 jsr L_AF33 ; get character
AFBD BD8ADF jsr L_8ADF ; carry clear if A-Z
AFC0 25C4 bcs do_fc_error_AF86 ; ?FC ERROR
AFC2 BDAF33 L_AFC2 jsr L_AF33 ; get character
AFC5 813B cmpa #$3b
AFC7 26F9 bne L_AFC2
AFC9 3510 puls x
AFCB DEA6 ldu <$a6 ; BASIC source pointer
AFCD 3440 pshs u
AFCF 9FA6 stx <$a6 ; BASIC source pointer
AFD1 BD89C1 jsr L_89C1
AFD4 3510 puls x
AFD6 9FA6 stx <$a6 ; BASIC source pointer
AFD8 39 rts
AFD9 4F L_AFD9 clra ; * IRQ service routine continued
AFDA 1F8B tfr a,dp
AFDC DCE3 ldd <$e3 ; PLAY duration counter
AFDE 10270B20 lbeq L_BB02
AFE2 93D5 subd <$d5 ; must be in PLAY loop
AFE4 DDE3 std <$e3 ; therefore calculate
AFE6 220D bhi L_AFF5 ; duration remaining
AFE8 0FE3 clr <$e3 ; PLAY duration counter
AFEA 0FE4 clr <$e4
AFEC 3502 puls a
AFEE 10EE67 lds 7,s ; points S to old U (=$adf5)
AFF1 847F anda #$7f ; mask entire state save
AFF3 3402 pshs a ; RTI will now return to $adf5
AFF5 3B L_AFF5 rti
AFF6 0A0C0103050608 data_AFF6 fcb $0a,$0c,$01,$03,$05,$06,$08 ; * PLAY letter to note number XLAT table
AFFD 01A80190017A01640150013D012B011A data_AFFD fcb $01,$a8,$01,$90,$01,$7a,$01,$64,$01,$50,$01,$3d,$01,$2b,$01,$1a ; * PLAY pitch XLAT table for octaves 1 & 2
B00D 010A00FB00ED00DF fcb $01,$0a,$00,$fb,$00,$ed,$00,$df
B015 00D300C700BB00B100A6009D0094008B data_B015 fcb $00,$d3,$00,$c7,$00,$bb,$00,$b1,$00,$a6,$00,$9d,$00,$94,$00,$8b
B025 0083007C0075006EA69C938B837B746D fcb $00,$83,$00,$7c,$00,$75,$00,$6e,$a6,$9c,$93,$8b,$83,$7b,$74,$6d
B035 67615B56514C47433F3B3734312E2B28 fcb $67,$61,$5b,$56,$51,$4c,$47,$43,$3f,$3b,$37,$34,$31,$2e,$2b,$28
B045 2623211F1D1B191816141312 fcb $26,$23,$21,$1f,$1d,$1b,$19,$18,$16,$14,$13,$12
B051 9E8A DRAW_dispatch ldx <$8a ; zero
B053 C601 ldb #$01
B055 3414 pshs b,x
B057 D7C2 stb <$c2 ; PRESET / PSET flag
B059 9FD5 stx <$d5
B05B BDA928 jsr L_A928 ; set up colours
B05E BD8887 jsr get_string ; get expression
B061 BD8D9A L_B061 jsr L_8D9A ; validate string & point X to it (len in B)
B064 2008 bra L_B06E
B066 BDAF33 L_B066 jsr L_AF33 ; get character
B069 7EAF59 jmp L_AF59 ; check for number or =variable (get into B)
B06C 3514 L_B06C puls b,x
B06E D7D8 L_B06E stb <$d8 ; remaining string length
B070 27FA beq L_B06C
B072 9FD9 stx <$d9 ; string pointer
B074 102700EA lbeq L_B162 ; nothing left to do - RTS
B078 0DD8 L_B078 tst <$d8 ; remaining string length
B07A 27F0 beq L_B06C
B07C BDAF33 jsr L_AF33 ; get character
B07F 813B cmpa #$3b
B081 27F5 beq L_B078
B083 8127 cmpa #$27
B085 27F1 beq L_B078
B087 814E cmpa #$4e
B089 2604 bne L_B08F
B08B 03D5 com <$d5
B08D 20E9 bra L_B078
B08F 8142 L_B08F cmpa #$42
B091 2604 bne L_B097
B093 03D6 com <$d6
B095 20E1 bra L_B078
B097 8158 L_B097 cmpa #$58
B099 10270096 lbeq L_B133
B09D 814D cmpa #$4d
B09F 1027012A lbeq L_B1CD
B0A3 3402 pshs a
B0A5 C601 ldb #$01
B0A7 0DD8 tst <$d8 ; remaining string length
B0A9 2711 beq L_B0BC
B0AB BDAF33 jsr L_AF33 ; get character
B0AE BD8ADF jsr L_8ADF ; carry clear if A-Z
B0B1 3401 pshs cc
B0B3 BDAF7D jsr L_AF7D ; move string pointer back one
B0B6 3501 puls cc
B0B8 2402 bcc L_B0BC
B0BA 8DAA bsr L_B066 ; check for number or =variable (get into B)
B0BC 3502 L_B0BC puls a
B0BE 8143 cmpa #$43
B0C0 2728 beq L_B0EA
B0C2 8141 cmpa #$41
B0C4 272E beq L_B0F4
B0C6 8153 cmpa #$53
B0C8 2732 beq L_B0FC
B0CA 8155 cmpa #$55
B0CC 275C beq L_B12A
B0CE 8144 cmpa #$44
B0D0 2755 beq L_B127
B0D2 814C cmpa #$4c
B0D4 274C beq L_B122
B0D6 8152 cmpa #$52
B0D8 2743 beq L_B11D
B0DA 8045 suba #$45
B0DC 272F beq L_B10D
B0DE 4A deca
B0DF 2727 beq L_B108
B0E1 4A deca
B0E2 2732 beq L_B116
B0E4 4A deca
B0E5 271D beq L_B104
B0E7 7E8B8D do_fc_error_B0E7 jmp FC_error ; ?FC ERROR
B0EA BDA8EB L_B0EA jsr L_A8EB ; interpret colour in B
B0ED D7B2 stb <$b2 ; foreground colour
B0EF BDA928 jsr L_A928 ; set up colours
B0F2 2084 L_B0F2 bra L_B078
B0F4 C104 L_B0F4 cmpb #$04 ; * DRAW 'A'
B0F6 24EF bcc do_fc_error_B0E7 ; ?FC ERROR
B0F8 D7E8 stb <$e8 ; angle
B0FA 20F6 bra L_B0F2
B0FC C13F L_B0FC cmpb #$3f ; * DRAW 'S'
B0FE 24E7 bcc do_fc_error_B0E7 ; ?FC ERROR
B100 D7E9 stb <$e9 ; scale
B102 20EE bra L_B0F2
B104 4F L_B104 clra ; * DRAW 'H' (D = X = -B)
B105 8D58 bsr L_B15F ; NEGB, A=A-C
B107 21 fcb $21 ; brn L_B158 - comment byte
B108 4F L_B108 clra ; usually skipped by comment byte
B109 1F01 tfr d,x ; * (B108 4F CLRA)
B10B 2059 bra L_B166
B10D 4F L_B10D clra ; * DRAW 'E' (D = B, X = -B)
B10E 1F01 tfr d,x
B110 8D4D bsr L_B15F ; NEGB, A=A-C
B112 1E01 exg d,x
B114 2050 bra L_B166
B116 4F L_B116 clra ; * DRAW 'G' (D = -B, X = B)
B117 1F01 tfr d,x
B119 8D44 bsr L_B15F ; NEGB, A=A-C
B11B 2049 bra L_B166
B11D 4F L_B11D clra ; * DRAW 'R' (D = B, X = 0)
B11E 9E8A L_B11E ldx <$8a ; zero
B120 2044 bra L_B166
B122 4F L_B122 clra ; * DRAW 'L' (D = -B, X = 0)
B123 8D3A bsr L_B15F ; NEGB, A=A-C
B125 20F7 bra L_B11E
B127 4F L_B127 clra ; * DRAW 'D' (D = 0, X = B)
B128 2003 bra L_B12D
B12A 4F L_B12A clra ; * DRAW 'U' (D = 0, X = -B)
B12B 8D32 bsr L_B15F ; NEGB, A=A-C
B12D 9E8A L_B12D ldx <$8a ; zero
B12F 1E10 exg x,d
B131 2033 bra L_B166
B133 BDAFB6 L_B133 jsr L_AFB6 ; validate variable
B136 C602 ldb #$02
B138 BD8331 jsr L_8331 ; memory check
B13B D6D8 ldb <$d8 ; remaining string length
B13D 9ED9 ldx <$d9 ; string pointer
B13F 3414 pshs b,x ; store current string
B141 7EB061 jmp L_B061 ; start again with new string
B144 D6E9 L_B144 ldb <$e9 ; * apply DRAW scale factor to X
B146 271B beq L_B163
B148 4F clra
B149 1E01 exg d,x
B14B A7E2 sta ,-s
B14D 2A02 bpl L_B151
B14F 8D0D bsr L_B15E ; D = -D
B151 BDB350 L_B151 jsr L_B350 ; Y:U = D * X
B154 1F30 tfr u,d
B156 44 lsra
B157 56 rorb
B158 44 L_B158 lsra
B159 56 rorb
B15A 6DE0 tst ,s+
B15C 2A04 bpl L_B162
B15E 40 L_B15E nega
B15F 50 L_B15F negb
B160 8200 sbca #$00
B162 39 L_B162 rts
B163 1F10 L_B163 tfr x,d
B165 39 rts
B166 3406 L_B166 pshs a,b ; * (D = horizontal component, X = vertical component)
B168 8DDA bsr L_B144 ; scale X into D
B16A 3510 puls x
B16C 3406 pshs a,b
B16E 8DD4 bsr L_B144 ; scale X into D
B170 3510 puls x
B172 109EE8 ldy <$e8 ; angle
B175 3420 pshs y
B177 6DE4 L_B177 tst ,s
B179 2708 beq L_B183
B17B 1E10 exg x,d ; swap vector components
B17D 8DDF bsr L_B15E ; D = -D
B17F 6AE4 dec ,s
B181 20F4 bra L_B177 ; rotate another 90 degrees
B183 3520 L_B183 puls y
B185 DE8A ldu <$8a ; zero
B187 D3C7 addd <$c7 ; current X
B189 2B02 bmi L_B18D
B18B 1F03 tfr d,u ; U = new X
B18D 1F10 L_B18D tfr x,d
B18F 9E8A ldx <$8a ; zero
B191 D3C9 addd <$c9 ; current Y
B193 2B02 bmi L_B197
B195 1F01 tfr d,x
B197 11830100 L_B197 cmpu #$0100
B19B 2503 bcs L_B1A0
B19D CE00FF ldu #$00ff
B1A0 8C00C0 L_B1A0 cmpx #$00c0
B1A3 2503 bcs L_B1A8
B1A5 8E00BF ldx #$00bf ; X = new Y
B1A8 DCC7 L_B1A8 ldd <$c7
B1AA DDBD std <$bd
B1AC DCC9 ldd <$c9
B1AE DDBF std <$bf
B1B0 9FC5 stx <$c5
B1B2 DFC3 stu <$c3
B1B4 0DD5 tst <$d5
B1B6 2604 bne L_B1BC ; no position update
B1B8 9FC9 stx <$c9
B1BA DFC7 stu <$c7
B1BC BDA7AE L_B1BC jsr L_A7AE ; adjust coords for PMODE
B1BF 0DD6 tst <$d6
B1C1 2603 bne L_B1C6 ; blank move
B1C3 BDA82F jsr L_A82F ; draw line
B1C6 0FD5 L_B1C6 clr <$d5
B1C8 0FD6 clr <$d6
B1CA 7EB078 jmp L_B078
B1CD BDAF33 L_B1CD jsr L_AF33 ; get character
B1D0 3402 pshs a
B1D2 BDB1F9 jsr L_B1F9 ; get ordinate into D
B1D5 3406 pshs a,b
B1D7 BDAF33 jsr L_AF33 ; get character
B1DA 812C cmpa #$2c
B1DC 1026FF07 lbne do_fc_error_B0E7
B1E0 BDB1F6 jsr L_B1F6 ; get ordinate into D
B1E3 1F01 tfr d,x
B1E5 3540 puls u
B1E7 3502 puls a
B1E9 812B cmpa #$2b
B1EB 2704 beq L_B1F1
B1ED 812D cmpa #$2d
B1EF 26A6 bne L_B197 ; absolute position
B1F1 1F30 L_B1F1 tfr u,d
B1F3 7EB166 jmp L_B166 ; relative movement
B1F6 BDAF33 L_B1F6 jsr L_AF33 ; get character
B1F9 812B L_B1F9 cmpa #$2b
B1FB 2707 beq L_B204
B1FD 812D cmpa #$2d
B1FF 2704 beq L_B205
B201 BDAF7D jsr L_AF7D ; move string pointer back one
B204 4F L_B204 clra
B205 3402 L_B205 pshs a
B207 BDB066 jsr L_B066 ; check for number or =variable (get into B)
B20A 3502 puls a
B20C 4D tsta
B20D 2704 beq L_B213
B20F 4F clra
B210 50 negb
B211 8200 sbca #$00
B213 39 L_B213 rts
B214 00000001FEC51919FB1631F2F4FB4A51 data_B214 fcb $00,$00,$00,$01,$fe,$c5,$19,$19,$fb,$16,$31,$f2,$f4,$fb,$4a,$51 ; * circle is drawn in 8 main sectors with 8 or 9 subdivisions each
B224 EC8461F9E1C778AED4DC8E3BC5E5A269 fcb $ec,$84,$61,$f9,$e1,$c7,$78,$ae,$d4,$dc,$8e,$3b,$c5,$e5,$a2,$69
B234 B506B506 fcb $b5,$06,$b5,$06
B238 8140 CIRCLE_dispatch cmpa #$40 ; * CIRCLE
B23A 2602 bne L_B23E ; optional @ before coords
B23C 9D9F jsr <$9f ; get next character from BASIC source
B23E BDA8B0 L_B23E jsr L_A8B0 ; set up max coords for PMODE
B241 BDA740 jsr L_A740 ; get coords from command into $bd / $bf
B244 BDA6AB jsr L_A6AB ; adjust coords for PMODE
B247 AEC4 ldx ,u
B249 9FCB stx <$cb
B24B AE42 ldx 2,u
B24D 9FCD stx <$cd
B24F BD89AA jsr CkComa ; check comma
B252 BD8E83 jsr Get16Bit ; get 16 bit number into X
B255 CE00CF ldu #$00cf
B258 AFC4 stx ,u ; circle radius
B25A BDA6AE jsr L_A6AE ; adjust radius correct for PMODE
B25D 8601 lda #$01
B25F 97C2 sta <$c2 ; PRESET / PSET flag
B261 BDA90F jsr L_A90F ; read optional colour
B264 8E0100 ldx #$0100
B267 9DA5 jsr <$a5 ; get current character from BASIC source
B269 270F beq L_B27A
B26B BD89AA jsr CkComa ; check comma
B26E BD8872 jsr L_8872 ; get FP number (h/w ratio)
B271 964F lda <$4f
B273 8B08 adda #$08
B275 974F sta <$4f ; multiply FP number by 256
B277 BD8E86 jsr L_8E86 ; read 16 bit number into X from FPA1
B27A 96B6 L_B27A lda <$b6 ; current PMODE
B27C 8502 bita #$02
B27E 2704 beq L_B284
B280 1F10 tfr x,d
B282 308B leax d,x ; double hw ratio for PMODEs 2 & 3
B284 9FD1 L_B284 stx <$d1
B286 C601 ldb #$01
B288 D7C2 stb <$c2 ; PRESET / PSET flag
B28A D7D8 stb <$d8
B28C BDB37D jsr L_B37D ; read optional start value
B28F 3406 pshs a,b
B291 BDB37D jsr L_B37D ; read optional end value
B294 DDD9 std <$d9
B296 3506 puls a,b
B298 3406 L_B298 pshs a,b ; loop starts here
B29A 9EC3 ldx <$c3 ; move old end coords to start coords
B29C 9FBD stx <$bd
B29E 9EC5 ldx <$c5
B2A0 9FBF stx <$bf
B2A2 CEB216 ldu #data_B214 + 2
B2A5 8401 anda #$01
B2A7 2703 beq L_B2AC
B2A9 50 negb
B2AA CB08 addb #$08 ; B = 8-B for odd sectors
B2AC 58 L_B2AC lslb
B2AD 58 lslb
B2AE 33C5 leau b,u
B2B0 3440 pshs u
B2B2 BDB342 jsr L_B342 ; X= (,U) x radius
B2B5 3540 puls u
B2B7 335E leau -2,u
B2B9 3410 pshs x
B2BB BDB342 jsr L_B342 ; X= (,U) x radius
B2BE 3520 puls y ; X & Y now hold circle coord offsets
B2C0 A6E4 lda ,s
B2C2 8403 anda #$03
B2C4 2706 beq L_B2CC
B2C6 8103 cmpa #$03
B2C8 2702 beq L_B2CC
B2CA 1E12 exg x,y ; swap X & Y for sectors 1,2,5,6
B2CC 9FC3 L_B2CC stx <$c3 ; x offset
B2CE 1F21 tfr y,x
B2D0 DCD1 ldd <$d1
B2D2 BDB350 jsr L_B350 ; Y:U = D * X
B2D5 1F20 tfr y,d ; D = hw ratio x y ord
B2D7 4D tsta
B2D8 1026D8B1 lbne FC_error ; ?FC ERROR
B2DC D7C5 stb <$c5 ; MSB of y offset
B2DE 1F30 tfr u,d
B2E0 97C6 sta <$c6 ; LSB of y offset
B2E2 A6E4 lda ,s
B2E4 8102 cmpa #$02
B2E6 250E bcs L_B2F6
B2E8 8106 cmpa #$06
B2EA 240A bcc L_B2F6
B2EC DCCB ldd <$cb
B2EE 93C3 subd <$c3 ; x = centre - offset
B2F0 2411 bcc L_B303 ; for sectors 2,3,4,5
B2F2 4F clra ; keep on screen
B2F3 5F clrb
B2F4 200D bra L_B303
B2F6 DCCB L_B2F6 ldd <$cb
B2F8 D3C3 addd <$c3 ; x = centre + offset
B2FA 2505 bcs L_B301 ; for sectors 0,1,6,7
B2FC 1093D3 cmpd <$d3 ; keep on screen
B2FF 2502 bcs L_B303
B301 DCD3 L_B301 ldd <$d3
B303 DDC3 L_B303 std <$c3 ; circle x ord now calculated
B305 A6E4 lda ,s
B307 8104 cmpa #$04
B309 250A bcs L_B315
B30B DCCD ldd <$cd
B30D 93C5 subd <$c5 ; y = centre - offset
B30F 2411 bcc L_B322 ; for sectors 4,5,6,7
B311 4F clra ; keep on screen
B312 5F clrb
B313 200D bra L_B322
B315 DCCD L_B315 ldd <$cd
B317 D3C5 addd <$c5 ; y = centre + offset
B319 2505 bcs L_B320 ; for sectors 0,1,2,3
B31B 1093D5 cmpd <$d5 ; keep on screen
B31E 2502 bcs L_B322
B320 DCD5 L_B320 ldd <$d5
B322 DDC5 L_B322 std <$c5 ; circle y ord now calculated
B324 0DD8 tst <$d8
B326 2602 bne L_B32A ; 1st loop - don't draw
B328 8D50 bsr L_B37A ; draw line ($bd,$bf)-($c3,$c5)
B32A 3506 L_B32A puls a,b
B32C 04D8 lsr <$d8
B32E 2505 bcs L_B335 ; 1st loop - don't test end condition
B330 1093D9 cmpd <$d9 ; reached end angle?
B333 270C beq L_B341
B335 5C L_B335 incb ; increment angle counter
B336 C108 cmpb #$08
B338 2604 bne L_B33E
B33A 4C inca
B33B 5F clrb
B33C 8407 anda #$07
B33E 7EB298 L_B33E jmp L_B298
B341 39 L_B341 rts
B342 9ECF L_B342 ldx <$cf ; radius
B344 ECC4 ldd ,u
B346 2707 beq L_B34F
B348 830001 subd #$0001
B34B 8D03 bsr L_B350 ; Y:U = D * X
B34D 1F21 tfr y,x
B34F 39 L_B34F rts
B350 3476 L_B350 pshs a,b,x,y,u ; * multiplies D by X & leaves result in Y:U
B352 6F64 clr 4,s
B354 A663 lda 3,s
B356 3D mul
B357 ED66 std 6,s
B359 EC61 ldd 1,s
B35B 3D mul
B35C EB66 addb 6,s
B35E 8900 adca #$00
B360 ED65 std 5,s
B362 E6E4 ldb ,s
B364 A663 lda 3,s
B366 3D mul
B367 E365 addd 5,s
B369 ED65 std 5,s
B36B 2402 bcc L_B36F
B36D 6C64 inc 4,s
B36F A6E4 L_B36F lda ,s
B371 E662 ldb 2,s
B373 3D mul
B374 E364 addd 4,s
B376 ED64 std 4,s
B378 35F6 puls a,b,x,y,u,pc
B37A 7EA82F L_B37A jmp L_A82F ; draw line
B37D 5F L_B37D clrb ; * & bottom 3 bits in B
B37E 9DA5 jsr <$a5 ; get current character from BASIC source
B380 2711 beq L_B393
B382 BD89AA jsr CkComa ; check comma
B385 BD8872 jsr L_8872 ; get FP number
B388 964F lda <$4f
B38A 8B06 adda #$06
B38C 974F sta <$4f ; multiply FP number by 64
B38E BD8E54 jsr L_8E54 ; get FP number in B
B391 C43F andb #$3f
B393 1F98 L_B393 tfr b,a
B395 C407 andb #$07
B397 44 lsra
B398 44 lsra
B399 44 lsra
B39A 39 rts
B39B 10CE03D7 continue_reset lds #$03d7 ; * reset routine continued
B39F 8637 lda #$37 ; enable cart FIRQ
B3A1 B7FF23 sta >$ff23
B3A4 9671 lda <$71 ; cold boot flag
B3A6 8155 cmpa #$55
B3A8 2610 bne cold_start ; cold boot
B3AA 9E72 ldx <$72 ; soft reset vector
B3AC A684 lda ,x
B3AE 8112 cmpa #$12
B3B0 2608 bne cold_start ; cold boot
B3B2 6E84 jmp ,x ; soft reset
B3B4 318CE4 RESET_service leay <continue_reset,pcr ; * reset routine (CPU vector)
B3B7 7E8000 jmp call_HWINIT ; JMP to $BB3C
B3BA 8E0401 cold_start ldx #$0401 ; clear 0 - 3ff
B3BD 6F83 L_B3BD clr ,--x
B3BF 3001 leax 1,x
B3C1 26FA bne L_B3BD
B3C3 BDBA77 jsr clear_screen ; clear text screen
B3C6 6F80 clr ,x+
B3C8 9F19 stx <$19 ; start of BASIC program
B3CA A602 L_B3CA lda 2,x ; memory test
B3CC 43 coma
B3CD A702 sta 2,x
B3CF A102 cmpa 2,x
B3D1 2606 bne L_B3D9
B3D3 3001 leax 1,x
B3D5 6301 com 1,x
B3D7 20F1 bra L_B3CA
B3D9 9F74 L_B3D9 stx <$74 ; top of RAM
B3DB 9F27 stx <$27 ; top of BASIC RAM
B3DD 9F23 stx <$23 ; top of free string space
B3DF 3089FF38 leax >$ff38,x
B3E3 9F21 stx <$21 ; stack root / string storage start
B3E5 1F14 tfr x,s
B3E7 BD8003 jsr call_SWINIT ; calls $BB88
B3EA 8EB487 ldx #copy_to_009D
B3ED CE009D ldu #$009d ; initialise system variables
B3F0 C60E ldb #$0e
B3F2 BDB7CC jsr L_B7CC ; copy B bytes from X to U
B3F5 CE010C ldu #$010c ; initialise system variables
B3F8 C61E ldb #$1e
B3FA BDB7CC jsr L_B7CC ; copy B bytes from X to U
B3FD 8E89B4 ldx #SN_error ; ?SN ERROR
B400 AF43 stx 3,u ; dummy disk command jump
B402 AF48 stx 8,u ; dummy disk function jump
B404 8E015E ldx #$015e ; set patch vectors to RTS
B407 CC394B ldd #$394b
B40A A780 L_B40A sta ,x+
B40C 5A decb
B40D 26FB bne L_B40A
B40F B702D9 sta >$02d9 ; mystery RTS
B412 BD8417 jsr erase_basic ; NEW BASIC
B415 BD98E3 jsr L_98E3 ; set up PLAY & graphics variables
B418 8E0134 ldx #$0134 ; set up USR vectors
B41B 9FB0 stx <$b0 ; address of USR table
B41D CE8B8D ldu #FC_error ; ?FC ERROR
B420 C60A ldb #$0a
B422 EF81 L_B422 stu ,x++
B424 5A decb
B425 26FB bne L_B422
B427 BDAA81 jsr L_AA81 ; PCLEAR 4
B42A B6FF03 lda >$ff03
B42D 8A01 ora #$01
B42F B7FF03 sta >$ff03 ; enable vsync irq
B432 8E444B ldx #$444b ; check for 'DK' disk
B435 BCC000 cmpx >$c000 ; cartridge sigature
B438 10270BC6 lbeq L_C002
B43C 1CAF andcc #$af ; enable interrupts
B43E 8EB4B2 ldx #copyright - 1
B441 BD90E5 jsr out_string ; display copyright message
B444 8EB44F ldx #warm_start ; set up soft reset vector
B447 9F72 stx <$72 ; soft reset vector
B449 8655 lda #$55
B44B 9771 sta <$71 ; cold boot flag
B44D 2017 bra L_B466 ; (JMP $8371 - command mode)
B44F 12 warm_start nop ; * normal soft reset routine
B450 0FE3 clr <$e3 ; clear PLAY duration counter
B452 0FE4 clr <$e4
B454 B6FF03 lda >$ff03 ; enable vsync irq
B457 8A01 ora #$01
B459 B7FF03 sta >$ff03
B45C 0F6F clr <$6f ; DEVN = VDU
B45E BD8434 jsr reset_stack ; reset stack
B461 1CAF andcc #$af ; enable interrupts
B463 BDBA77 jsr clear_screen ; clear screen
B466 7E8371 L_B466 jmp goto_ok_prompt ; command mode
B469 7DFF23 FIRQ_service tst >$ff23 ; * FIRQ service routine
B46C 2B01 bmi L_B46F ; cartridge
B46E 3B rti
B46F BDB480 L_B46F jsr L_B480 ; delay
B472 BDB480 jsr L_B480
B475 318C03 leay <start_cartridge,pcr
B478 7E8000 jmp call_HWINIT
B47B 0F71 start_cartridge clr <$71 ; cold boot flag
B47D 7EC000 jmp >$c000
B480 9E8A L_B480 ldx <$8a ; zero
B482 301F L_B482 leax -1,x
B484 26FC bne L_B482
B486 39 rts
B487 BF49 copy_to_009D fdb BOOT64K ; * (default EXEC & get character routine) / EXEC default entry
B489 0CA7 inc <$a7 ; CHRGET
B48B 2602 bne L_B48F
B48D 0CA6 inc <$a6
B48F B60000 L_B48F lda >$0000
B492 7EBB26 jmp chrget_next
B495 7E9D3D copy_to_010C jmp IRQ_service ; * (IRQ, FIRQ, RND seeds, key delay, command addresses)
B498 7EB469 jmp FIRQ_service
B49B 000000 fcb $00,$00,$00
B49E 804FC75259 fcb $80,$4f,$c7,$52,$59 ; random number seed
B4A3 00 fcb $00 ; FLAG64
B4A4 0000 fcb $00,$00 ; CSUM64
B4A6 00 fcb $00 ; LSTKEY
B4A7 00 fcb $00 ; CNTDWN
B4A8 05 fcb $05 ; REPDLY
B4A9 4E fcb $4e ; STUB0 - number of words
B4AA 80338154 fdb reserved_words,reserved_dispatch
B4AE 22 fcb $22 ; STUB0 - number of functions
B4AF 81CA8250 fdb function_words,function_dispatch
B4B3 284329203139383220445241474F4E2044415441204C5444200D copyright fcc /(C) 1982 DRAGON DATA LTD /,$0d ; * copyright message
B4CD 31364B20424153494320494E54455250524554455220312E302020202020200D fcc /16K BASIC INTERPRETER 1.0 /,$0d
B4ED 2843292031393832204259204D4943524F534F46540D copyright_ms fcc /(C) 1982 BY MICROSOFT/,$0d
B503 0D00 fcc $0d,$00
B505 8D03 L_B505 bsr L_B50A ; * read 7 bit character from device DEVN
B507 847F anda #$7f
B509 39 rts
B50A BD016A L_B50A jsr >$016a ; PATCH - input character from DEVN
B50D 0F70 clr <$70 ; EOF flag
B50F 0D6F tst <$6f ; DEVN
B511 2725 beq L_B538 ; get character from keyboard
B513 0D79 tst <$79 ; no. of characters in buffer
B515 2603 bne L_B51A ; get character from file
B517 0370 com <$70 ; set EOF flag
B519 39 rts
B51A 3474 L_B51A pshs b,x,y,u ; * read character from file
B51C 9E7A ldx <$7a ; buffer pointer
B51E A680 lda ,x+
B520 3402 pshs a
B522 9F7A stx <$7a ; buffer pointer
B524 0A79 dec <$79 ; no. of characters in buffer
B526 2609 bne L_B531
B528 966F lda <$6f ; DEVN
B52A 81FD cmpa #$fd
B52C 2705 beq L_B533 ; serial
B52E BDB867 jsr L_B867 ; get block from tape
B531 35F6 L_B531 puls a,b,x,y,u,pc
B533 BDA106 L_B533 jsr L_A106 ; get block from serial
B536 20F9 bra L_B531
B538 3414 L_B538 pshs b,x ; * (with cursor)
B53A BD8009 L_B53A jsr call_CBLINK ; blink cursor
B53D BD8006 jsr POLCAT ; scan keyboard
B540 27F8 beq L_B53A
B542 C660 ldb #$60
B544 E79F0088 stb [$0088] ; text cursor address
B548 3594 puls b,x,pc
B54A BD0167 OUTCHR jsr >$0167 ; PATCH - output character to DEVN
B54D 3404 pshs b
B54F D66F ldb <$6f ; DEVN
B551 C1FD cmpb #$fd
B553 2602 bne L_B557 ; not -3 (serial output not supported)
B555 3584 puls b,pc
B557 5C L_B557 incb
B558 3504 puls b
B55A 102BCAB1 lbmi call_LPOUT ; send to printer
B55E 262F bne L_B58F ; send to VDU
B560 3416 pshs a,b,x ; send to file
B562 D678 ldb <$78 ; cassette IO status
B564 5A decb
B565 270F beq L_B576 ; input - quit
B567 D679 ldb <$79 ; no. of characters in buffer
B569 5C incb
B56A 2602 bne L_B56E
B56C 8D0A bsr L_B578 ; flush tape buffer
B56E 9E7A L_B56E ldx <$7a ; buffer pointer
B570 A780 sta ,x+
B572 9F7A stx <$7a ; buffer pointer
B574 0C79 inc <$79 ; no. of characters in buffer
B576 3596 L_B576 puls a,b,x,pc
B578 C601 L_B578 ldb #$01 ; * flush tape buffer
B57A D77C L_B57A stb <$7c ; block type
B57C 8E01DA ldx #$01da ; IO buffer
B57F 9F7E stx <$7e
B581 D679 ldb <$79 ; no. of characters in buffer
B583 D77D stb <$7d ; block length
B585 3462 pshs a,y,u
B587 BDB991 jsr L_B991 ; write leader & block to tape
B58A 3562 puls a,y,u
B58C 7EB882 jmp L_B882 ; reset IO buffer
B58F BDA93A L_B58F jsr reset_vdu ; reset VDU
B592 7E800C jmp CHROUT ; write to VDU
B595 BD0164 L_B595 jsr >$0164 ; PATCH - device initialisation
B598 3416 pshs a,b,x
B59A 0F6E clr <$6e ; cassette IO flag
B59C 966F lda <$6f ; DEVN
B59E 2709 beq L_B5A9 ; VDU
B5A0 4C inca
B5A1 2717 beq L_B5BA ; cassette
B5A3 9E99 ldx <$99 ; printer comma field width / last comma field
B5A5 DC9B ldd <$9b ; printer line width / head pos
B5A7 2009 bra L_B5B2
B5A9 D689 L_B5A9 ldb <$89
B5AB C41F andb #$1f ; get VDU column number
B5AD 8E1010 ldx #$1010
B5B0 8620 lda #$20
B5B2 9F6A L_B5B2 stx <$6a ; comma field width / last comma field
B5B4 D76C stb <$6c ; current column number
B5B6 976D sta <$6d ; line width
B5B8 3596 puls a,b,x,pc
B5BA 036E L_B5BA com <$6e ; set cassette IO flag
B5BC 8E0100 ldx #$0100
B5BF 4F clra
B5C0 5F clrb
B5C1 20EF bra L_B5B2
B5C3 BDBA77 L_B5C3 jsr clear_screen ; clear screen
B5C6 BD0182 L_B5C6 jsr >$0182 ; PATCH - line input file
B5C9 0F87 clr <$87 ; last key pressed
B5CB 8E02DD ldx #$02dd
B5CE C601 ldb #$01 ; B = character count
B5D0 BDB505 L_B5D0 jsr L_B505 ; read 7 bit character from DEVN
B5D3 0D70 tst <$70 ; EOF flag
B5D5 262B bne L_B602 ; EOF
B5D7 0D6F tst <$6f ; DEVN
B5D9 2623 bne L_B5FE ; not keyed input
B5DB 810C cmpa #$0c ; CLEAR key
B5DD 27E4 beq L_B5C3
B5DF 8108 cmpa #$08 ; backspace
B5E1 2607 bne L_B5EA
B5E3 5A decb
B5E4 27E0 beq L_B5C6 ; nothing to delete
B5E6 301F leax -1,x
B5E8 2034 bra L_B61E
B5EA 8115 L_B5EA cmpa #$15 ; shift + backspace
B5EC 260A bne L_B5F8
B5EE 5A L_B5EE decb
B5EF 27D5 beq L_B5C6 ; nothing to delete
B5F1 8608 lda #$08
B5F3 BDB54A jsr OUTCHR ; output character to DEVN
B5F6 20F6 bra L_B5EE
B5F8 8103 L_B5F8 cmpa #$03 ; BREAK
B5FA 1A01 orcc #$01
B5FC 2705 beq L_B603
B5FE 810D L_B5FE cmpa #$0d ; RETURN
B600 260D bne L_B60F
B602 4F L_B602 clra
B603 3401 L_B603 pshs cc
B605 BD90A1 jsr print_CR ; send CR to DEVN
B608 6F84 clr ,x
B60A 8E02DC ldx #$02dc ; return with carry set if
B60D 3581 puls cc,pc ; input aborted with BREAK
B60F 8120 L_B60F cmpa #$20
B611 25BD bcs L_B5D0 ; chr < $20
B613 817B cmpa #$7b
B615 24B9 bcc L_B5D0 ; chr >= $7b
B617 C1FA cmpb #$fa
B619 24B5 bcc L_B5D0 ; max no. of characters = $fa
B61B A780 sta ,x+
B61D 5C incb
B61E BDB54A L_B61E jsr OUTCHR ; echo typed character
B621 20AD bra L_B5D0
B623 BD016D L_B623 jsr >$016d ; PATCH - input file
B626 966F lda <$6f ; DEVN
B628 2721 beq L_B64B ; RTS
B62A 4C inca
B62B 260C bne do_fm_error_B639 ; ?FM ERROR
B62D 9678 lda <$78 ; cassette IO status
B62F 2605 bne L_B636 ; open
B631 C62E NO_error ldb #$2e ; ?NO ERROR
B633 7E8344 jmp system_error
B636 4A L_B636 deca
B637 2712 beq L_B64B ; input - RTS
B639 7EB848 do_fm_error_B639 jmp FM_error ; ?FM ERROR
B63C BD0170 L_B63C jsr >$0170 ; PATCH - output file
B63F 966F lda <$6f ; DEVN
B641 4C inca
B642 2607 bne L_B64B ; not cassette
B644 9678 lda <$78 ; cassette IO status
B646 27E9 beq NO_error ; ?NO ERROR
B648 4A deca
B649 27EE beq do_fm_error_B639 ; ?FM ERROR
B64B 39 L_B64B rts
B64C 270E CLOSE_dispatch beq L_B65C ; no parameter so close #-1
B64E BDB7D7 jsr L_B7D7 ; read #-n & set up DEVN (no skip comma)
B651 8D10 L_B651 bsr L_B663 ; close DEVN stream & set DEVN to 0
B653 9DA5 jsr <$a5 ; get current character from BASIC source
B655 272A beq L_B681 ; RTS
B657 BDB7D4 jsr L_B7D4 ; read #-n & set up DEVN
B65A 20F5 bra L_B651 ; read next stream no.
B65C BD0173 L_B65C jsr >$0173 ; PATCH - close all files
B65F 86FF L_B65F lda #$ff ; * close cassette stream & set DEVN to 0
B661 976F sta <$6f ; DEVN
B663 BD0176 L_B663 jsr >$0176 ; PATCH - close file
B666 966F lda <$6f ; DEVN
B668 0F6F clr <$6f ; DEVN
B66A 4C inca
B66B 2614 bne L_B681 ; not cassette
B66D 9678 lda <$78 ; cassette IO status
B66F 8102 cmpa #$02
B671 260C bne L_B67F ; not output
B673 9679 lda <$79 ; no. of characters in buffer
B675 2703 beq L_B67A
B677 BDB578 jsr L_B578 ; flush tape buffer
B67A C6FF L_B67A ldb #$ff
B67C BDB57A jsr L_B57A ; B = $FF = EOF block
B67F 0F78 L_B67F clr <$78 ; cassette IO status
B681 39 L_B681 rts
B682 814D CSAVE_dispatch cmpa #$4d ; * CSAVE
B684 1027E278 lbeq L_9900 ; CSAVEM
B688 BDB7AA jsr L_B7AA ; get filename
B68B 9DA5 jsr <$a5 ; get current character from BASIC source
B68D 2716 beq L_B6A5 ; normal CSAVE
B68F BD89AA jsr CkComa ; check comma
B692 C641 ldb #$41
B694 BD89AC jsr CkChar ; skip over 'A'
B697 26E8 bne L_B681 ; return if anything else on command line
B699 4F clra ; file type = 0 = tokenized BASIC
B69A BDB88E jsr L_B88E ; write filename block for gapped ASCII
B69D 86FF lda #$ff
B69F 976F sta <$6f ; DEVN = -1
B6A1 4F clra
B6A2 7E8EAA jmp LIST_dispatch ; LIST to DEVN - very clever!
B6A5 4F L_B6A5 clra ; tokenized BASIC
B6A6 9E8A ldx <$8a ; non-ASCII & ungapped
B6A8 BDB891 jsr L_B891 ; write filename block
B6AB 0F78 clr <$78 ; cassette IO status
B6AD 0C7C inc <$7c ; block type
B6AF BD801B jsr call_WRTLDR ; write leader
B6B2 9E19 ldx <$19 ; start of BASIC program
B6B4 9F7E L_B6B4 stx <$7e ; IO buffer
B6B6 86FF lda #$ff
B6B8 977D sta <$7d ; block length
B6BA DC1B ldd <$1b ; start of simple variables
B6BC 937E subd <$7e ; IO buffer
B6BE 270D beq L_B6CD
B6C0 108300FF cmpd #$00ff
B6C4 2402 bcc L_B6C8
B6C6 D77D stb <$7d ; block length
B6C8 BDB999 L_B6C8 jsr BLKOUT ; write block to tape
B6CB 20E7 bra L_B6B4
B6CD 007C L_B6CD neg <$7c ; block type
B6CF 0F7D clr <$7d ; block length
B6D1 7EB994 jmp L_B994 ; write block & cassette relay off
B6D4 0F78 CLOAD_dispatch clr <$78 ; cassette IO status
B6D6 814D cmpa #$4d
B6D8 1027E9B2 lbeq L_A08E ; CLOADM (returns to $b73c if not gapped)
B6DC 3262 leas 2,s
B6DE BDB7F7 jsr L_B7F7 ; get filename
B6E1 BDB87A jsr L_B87A ; find file & set up buffer
B6E4 7D01E4 tst >$01e4 ; gap flag
B6E7 271D beq L_B706
B6E9 B601E3 lda >$01e3 ; ASCII flag
B6EC 271D beq do_fm_error_B70B ; ?FM ERROR
B6EE BD8417 jsr erase_basic ; NEW BASIC
B6F1 86FF lda #$ff
B6F3 976F sta <$6f ; DEVN = -1
B6F5 0C78 inc <$78 ; cassette status 1 = input
B6F7 BDB867 jsr L_B867 ; get block from tape
B6FA 7E837A jmp L_837A ; command mode / no device initialise
B6FD BD0185 L_B6FD jsr >$0185 ; PATCH - close ASCII file
B700 BDB663 jsr L_B663 ; close DEVN stream & set DEVN to 0
B703 7E8371 jmp goto_ok_prompt ; command mode
B706 B601E2 L_B706 lda >$01e2 ; file type 0 = tokenized BASIC
B709 2703 beq L_B70E
B70B 7EB848 do_fm_error_B70B jmp FM_error ; ?FM ERROR
B70E BD8417 L_B70E jsr erase_basic ; NEW BASIC
B711 BD8021 jsr call_CSRDON ; read leader from tape
B714 9E19 ldx <$19 ; start of BASIC program
B716 9F7E L_B716 stx <$7e ; IO buffer
B718 DC7E ldd <$7e
B71A 4C inca
B71B BD8335 jsr L_8335 ; memory check
B71E BDB93E jsr BLKIN ; read block from tape
B721 2613 bne L_B736 ; error
B723 967C lda <$7c ; block type
B725 270F beq L_B736 ; error
B727 2AED bpl L_B716
B729 9F1B stx <$1b ; start of simple variables
B72B 8D40 bsr L_B76D ; cassette relay off
B72D 8E82EA ldx #text_ok - 1
B730 BD90E5 jsr out_string ; print string to DEVN
B733 7E83E7 jmp L_83E7 ; set up new BASIC program & go command mode
B736 BD8417 L_B736 jsr erase_basic ; NEW BASIC
B739 7EB84B do_io_error_B739 jmp IO_error ; ?IO ERROR
B73C 9E8A L_B73C ldx <$8a ; zero
B73E 9DA5 jsr <$a5 ; get current character from BASIC source
B740 2706 beq L_B748
B742 BD89AA jsr CkComa ; check comma
B745 BD8E83 jsr Get16Bit ; get 16 bit number into X
B748 B601E2 L_B748 lda >$01e2 ; file type
B74B 8102 cmpa #$02 ; 2 = binary
B74D 26BC bne do_fm_error_B70B ; ?FM ERROR
B74F FC01E5 ldd >$01e5 ; entry address
B752 338B leau d,x ; apply offset
B754 DF9D stu <$9d ; EXEC address
B756 FC01E7 ldd >$01e7 ; load address
B759 308B leax d,x
B75B 9F7E stx <$7e ; IO buffer
B75D BD8021 jsr call_CSRDON ; read leader from tape
B760 BDB93E L_B760 jsr BLKIN ; read block from tape
B763 26D4 bne do_io_error_B739 ; ?IO ERROR
B765 9F7E stx <$7e ; IO buffer
B767 0D7C tst <$7c ; block type
B769 27CE beq do_io_error_B739 ; ?IO ERROR
B76B 2AF3 bpl L_B760
B76D 7E8018 L_B76D jmp call_CASOFF ; cassette relay off
B770 2705 EXEC_dispatch beq L_B777 ; * EXEC
B772 BD8E83 jsr Get16Bit ; get 16 bit number into X
B775 9F9D stx <$9d ; default EXEC address
B777 6E9F009D L_B777 jmp [$009d]
B77B BD017F L_B77B jsr >$017f ; PATCH - check break & pause
B77E 966F lda <$6f ; DEVN
B780 4C inca
B781 2750 beq L_B7D3 ; RTS
B783 7E851B jmp scan_key ; scan keyboard for break & pause
B786 BD8B21 L_B786 jsr L_8B21 ; get unsigned number into D & $52 from FPA1
B789 8301FF subd #$01ff
B78C 1022D3FD lbhi FC_error ; ?FC ERROR
B790 C305FF addd #$05ff
B793 DD88 std <$88 ; text cursor address
B795 39 rts
B796 9687 INKEYstr_dispatch lda <$87 ; last key pressed
B798 2603 bne L_B79D ; key ready
B79A BD8006 jsr POLCAT ; scan keyboard
B79D 0F87 L_B79D clr <$87 ; last key pressed
B79F 9753 sta <$53
B7A1 1026D630 lbne L_8DD5 ; set up character & put on varptr stack
B7A5 9756 sta <$56
B7A7 7E8DE1 jmp L_8DE1 ; leas 2,s & put temp string on varptr stack
B7AA 8E01D1 L_B7AA ldx #$01d1 ; * (reads filename from command into usual location)
B7AD 6F80 clr ,x+
B7AF 8620 lda #$20
B7B1 A780 L_B7B1 sta ,x+
B7B3 8C01DA cmpx #$01da ; IO buffer
B7B6 26F9 bne L_B7B1
B7B8 9DA5 jsr <$a5 ; get current character from BASIC source
B7BA 2717 beq L_B7D3 ; RTS
B7BC BD8887 jsr get_string ; get expression
B7BF BD8D9A jsr L_8D9A ; validate string & point X to it (len in B)
B7C2 CE01D1 ldu #$01d1
B7C5 E7C0 stb ,u+ ; store length
B7C7 270A beq L_B7D3
B7C9 8C fcb $8c ; cmpx #$c608 - comment byte
B7CA C608 L_B7CA ldb #$08 ; usually skipped by comment byte
B7CC A680 L_B7CC lda ,x+ ; * copy B bytes from X to U
B7CE A7C0 sta ,u+
B7D0 5A decb
B7D1 26F9 bne L_B7CC
B7D3 39 L_B7D3 rts
B7D4 BD89AA L_B7D4 jsr CkComa ; check comma
B7D7 8123 L_B7D7 cmpa #$23
B7D9 2602 bne L_B7DD
B7DB 9D9F jsr <$9f ; get next character from BASIC source
B7DD BD8872 L_B7DD jsr L_8872 ; get numeric expression into FPA1
B7E0 BD8B2D L_B7E0 jsr INTCNV ; get 16 bit number into D & $52 from FPA1
B7E3 59 rolb
B7E4 8900 adca #$00
B7E6 2669 bne DN_error ; ?DN ERROR
B7E8 56 rorb
B7E9 D76F stb <$6f ; DEVN
B7EB BD0161 jsr >$0161 ; PATCH - check device number
B7EE 2706 beq L_B7F6
B7F0 2A5F bpl DN_error ; ?DN ERROR
B7F2 C1FE cmpb #$fe
B7F4 2D5B blt DN_error ; ?DN ERROR
B7F6 39 L_B7F6 rts
B7F7 8DB1 L_B7F7 bsr L_B7AA ; get filename
B7F9 9DA5 L_B7F9 jsr <$a5 ; get current character from BASIC source
B7FB 27F9 L_B7FB beq L_B7F6 ; RTS
B7FD 7E89B4 jmp SN_error ; ?SN ERROR
B800 BD0188 EOF_dispatch jsr >$0188 ; PATCH - check eof
B803 966F lda <$6f ; DEVN
B805 3402 pshs a
B807 8DD7 bsr L_B7E0 ; get device number from command
B809 BDB623 jsr L_B623 ; test cassette status OK for input
B80C 5F clrb
B80D 966F lda <$6f ; DEVN
B80F 2705 beq L_B816 ; VDU
B811 0D79 tst <$79 ; no. of characters in buffer
B813 2601 bne L_B816 ; not EOF
B815 53 comb
B816 3502 L_B816 puls a
B818 976F sta <$6f ; DEVN
B81A 1D L_B81A sex
B81B 7E8C37 jmp GIVABF ; assign D to FPA1
B81E 8DD7 SKIPF_dispatch bsr L_B7F7 ; get filename
B820 8D58 bsr L_B87A ; find file & set up buffer
B822 BDB903 jsr L_B903 ; skip rest of file
B825 2624 bne IO_error ; ?IO ERROR
B827 39 rts
B828 BD015E OPEN_dispatch jsr >$015e ; PATCH - device open
B82B BD8887 jsr get_string ; get expression
B82E BD8DEA jsr L_8DEA ; get 1st character of string into B
B831 3404 pshs b
B833 8D9F bsr L_B7D4 ; read #-n & set up DEVN
B835 BD89AA jsr CkComa ; check comma
B838 8DBD bsr L_B7F7 ; get filename
B83A 966F lda <$6f ; DEVN
B83C 0F6F clr <$6f ; DEVN
B83E 3504 puls b
B840 C149 cmpb #$49
B842 2712 beq L_B856 ; open for input
B844 C14F cmpb #$4f
B846 2742 beq L_B88A ; write filename block if A = -1
B848 C62C FM_error ldb #$2c ; ?FM ERROR
B84A 8C fcb $8c ; cmpx #$c62a - comment byte
B84B C62A IO_error ldb #$2a ; usually skipped by comment byte
B84D 8C fcb $8c ; cmpx #$c626 - comment byte / * (B84B C62A LDB #$2A) ;?IO ERROR
B84E C626 AO_error ldb #$26 ; usually skipped by comment byte
B850 8C fcb $8c ; * (B84E C626 LDB #$26) ;?AO ERROR / cmpx #$c628 - comment byte
B851 C628 DN_error ldb #$28 ; usually skipped by comment byte
B853 7E8344 jmp system_error ; * (B851 C628 LDB #$28) ;?DN ERROR
B856 4C L_B856 inca ; input stream must be >= -1
B857 2BEF bmi FM_error ; ?FM ERROR
B859 262E bne L_B889 ; return if stream <> -1
B85B 8D1D bsr L_B87A ; find file & set up buffer
B85D B601E3 lda >$01e3 ; must be ASCII
B860 B401E4 anda >$01e4 ; and gapped
B863 27E3 beq FM_error ; ?FM ERROR
B865 0C78 inc <$78 ; cassette IO status
B867 BDB933 L_B867 jsr read_1st_block ; read leader & block from tape
B86A 26DF bne IO_error ; ?IO ERROR
B86C 0D7C tst <$7c ; block must be data or EOF
B86E 27DB beq IO_error ; ?IO ERROR
B870 2B17 bmi L_B889 ; return if EOF block
B872 967D lda <$7d ; block length
B874 27F1 beq L_B867 ; get another block if zero length
B876 9779 L_B876 sta <$79 ; no. of characters in buffer
B878 200A bra L_B884 ; finish setting up buffer
B87A 0D78 L_B87A tst <$78 ; cassette IO status
B87C 26D0 bne AO_error ; ?AO ERROR
B87E 8D33 bsr find_file ; find file
B880 26C9 bne IO_error ; ?IO ERROR
B882 0F79 L_B882 clr <$79 ; no. of characters in buffer
B884 8E01DA L_B884 ldx #$01da ; IO buffer
B887 9F7A stx <$7a ; buffer pointer
B889 39 L_B889 rts
B88A 4C L_B88A inca ; * if A = -1 then write filename block for gapped ASCII
B88B 26FC bne L_B889 ; RTS
B88D 4C inca ; A = 1
B88E 8EFFFF L_B88E ldx #$ffff ; * write filename block for gapped ASCII (file type in A)
B891 0D78 L_B891 tst <$78 ; cassette IO status
B893 26B9 bne AO_error ; ?AO ERROR
B895 CE01DA ldu #$01da ; IO buffer
B898 DF7E stu <$7e
B89A A748 sta 8,u ; file type
B89C AF49 stx 9,u ; ASCII flag & gap flag
B89E 8E01D2 ldx #$01d2 ; filename
B8A1 BDB7CA jsr L_B7CA ; copy 8 bytes from X to U
B8A4 0F7C clr <$7c ; block type
B8A6 860F lda #$0f
B8A8 977D sta <$7d ; block length
B8AA BDB991 jsr L_B991 ; write leader & block to tape
B8AD 8602 lda #$02 ; 2 = output
B8AF 9778 sta <$78 ; cassette IO status
B8B1 20CF bra L_B882 ; reset IO buffer
B8B3 8E01DA find_file ldx #$01da ; IO buffer
B8B6 9F7E stx <$7e
B8B8 9668 L_B8B8 lda <$68 ; current line number
B8BA 4C inca
B8BB 260B bne L_B8C8 ; not in command mode
B8BD BDBA77 jsr clear_screen ; clear screen
B8C0 9E88 ldx <$88 ; text cursor address
B8C2 C653 ldb #$53
B8C4 E781 stb ,x++
B8C6 9F88 stx <$88 ; text cursor address
B8C8 8D69 L_B8C8 bsr read_1st_block ; read leader & block from tape
B8CA DA7C orb <$7c ; block type
B8CC 26FA bne L_B8C8 ; keep going until filename block loaded
B8CE 8E01DA ldx #$01da ; IO buffer
B8D1 CE01D2 ldu #$01d2 ; filename to find
B8D4 C608 ldb #$08
B8D6 6FE2 clr ,-s
B8D8 A680 L_B8D8 lda ,x+
B8DA 109E68 ldy <$68 ; current line number
B8DD 3121 leay 1,y
B8DF 2605 bne L_B8E6 ; not in command mode
B8E1 0F6F clr <$6f ; DEVN
B8E3 BDB54A jsr OUTCHR ; output character to DEVN
B8E6 A0C0 L_B8E6 suba ,u+
B8E8 AAE4 ora ,s
B8EA A7E4 sta ,s
B8EC 5A decb
B8ED 26E9 bne L_B8D8
B8EF A6E0 lda ,s+
B8F1 270A beq L_B8FD ; matched filename
B8F3 6D57 tst -9,u
B8F5 2706 beq L_B8FD ; no filename specified
B8F7 8D0A bsr L_B903 ; skip rest of file
B8F9 2607 bne L_B902 ; return with error
B8FB 20BB bra L_B8B8 ; try next file
B8FD 8646 L_B8FD lda #$46
B8FF 8D29 bsr L_B92A ; display 'F'
B901 4F clra
B902 39 L_B902 rts
B903 7D01E4 L_B903 tst >$01e4 ; gap flag
B906 2609 bne L_B911 ; gapped file
B908 BD8021 jsr call_CSRDON ; read leader from tape
B90B 8D31 L_B90B bsr BLKIN ; read block from tape
B90D 8D08 bsr L_B917 ; test file status
B90F 20FA bra L_B90B ; do next block
B911 8D20 L_B911 bsr read_1st_block ; read leader & block from tape
B913 8D02 bsr L_B917 ; test file status
B915 20FA bra L_B911 ; do next block
B917 2606 L_B917 bne L_B91F ; * test file status
B919 967C lda <$7c ; block type
B91B 40 nega
B91C 2B14 bmi L_B932 ; normal block - RTS
B91E 4A deca
B91F 9781 L_B91F sta <$81 ; error status
B921 3262 leas 2,s
B923 2013 bra L_B938 ; cassette relay off & get status in B
B925 B60400 flash_0400 lda >$0400 ; * flash loading cursor
B928 8840 eora #$40
B92A D668 L_B92A ldb <$68 ; current line number
B92C 5C incb
B92D 2603 bne L_B932 ; not in command mode
B92F B70400 sta >$0400
B932 39 L_B932 rts
B933 BD8021 read_1st_block jsr call_CSRDON ; read leader from tape
B936 8D06 bsr BLKIN ; read block from tape
B938 BD8018 L_B938 jsr call_CASOFF ; cassette relay off
B93B D681 ldb <$81 ; error status
B93D 39 rts
B93E 1A50 BLKIN orcc #$50 ; mask interrupts
B940 8DE3 bsr flash_0400 ; flash loading cursor
B942 9E7E ldx <$7e ; IO buffer
B944 4F clra
B945 BD8027 L_B945 jsr call_BITIN ; bit in
B948 46 rora
B949 813C cmpa #$3c
B94B 26F8 bne L_B945 ; wait for sync byte
B94D BD8024 jsr call_CBIN ; byte in
B950 977C sta <$7c ; block type
B952 BD8024 jsr call_CBIN ; byte in
B955 977D sta <$7d ; block length
B957 9B7C adda <$7c ; block type
B959 9780 sta <$80 ; checksum
B95B 967D lda <$7d ; block length
B95D 9781 sta <$81 ; use error status as counter
B95F 2711 beq L_B972 ; no data
B961 BD8024 L_B961 jsr call_CBIN ; byte in
B964 A784 sta ,x
B966 A180 cmpa ,x+ ; check that we are loading into RAM
B968 2612 bne L_B97C
B96A 9B80 adda <$80
B96C 9780 sta <$80 ; checksum
B96E 0A81 dec <$81
B970 26EF bne L_B961 ; get next data byte
B972 BD8024 L_B972 jsr call_CBIN ; byte in
B975 9080 suba <$80 ; checksum
B977 2705 beq L_B97E ; status = OK
B979 8601 lda #$01 ; status = CRC error
B97B 8C fcb $8c ; cmpx #RG_error - comment byte
B97C 8602 L_B97C lda #$02 ; usually skipped by comment byte
B97E 9781 L_B97E sta <$81 ; status
B980 39 rts
B981 1F89 MOTOR_dispatch tfr a,b ; * MOTOR
B983 9D9F jsr <$9f ; get next character from BASIC source
B985 C1C2 cmpb #$c2 ; token OFF
B987 270D beq L_B996 ; cassette relay off
B989 C188 cmpb #$88 ; token ON
B98B BDB7FB jsr L_B7FB ; ?SN ERROR if <>0
B98E 7E8015 jmp call_CASON ; cassette relay on
B991 BD801B L_B991 jsr call_WRTLDR ; write leader
B994 8D03 L_B994 bsr BLKOUT ; write block to tape
B996 7E8018 L_B996 jmp call_CASOFF ; cassette relay off
B999 1A50 BLKOUT orcc #$50 ; mask interrupts
B99B D67D ldb <$7d ; block length
B99D D781 stb <$81 ; use error status as counter
B99F 967D lda <$7d ; block length
B9A1 2707 beq L_B9AA ; no data
B9A3 9E7E ldx <$7e ; IO buffer address
B9A5 AB80 L_B9A5 adda ,x+
B9A7 5A decb
B9A8 26FB bne L_B9A5 ; calculate checksum
B9AA 9B7C L_B9AA adda <$7c ; block type
B9AC 9780 sta <$80 ; checksum
B9AE 9E7E ldx <$7e ; IO buffer address
B9B0 8D1B bsr L_B9CD ; write single leader byte
B9B2 863C lda #$3c ; sync byte
B9B4 8D19 bsr L_B9CF ; byte out
B9B6 967C lda <$7c ; block type
B9B8 8D15 bsr L_B9CF ; byte out
B9BA 967D lda <$7d ; block length
B9BC 8D11 bsr L_B9CF ; byte out
B9BE 4D tsta
B9BF 2708 beq L_B9C9 ; no data
B9C1 A680 L_B9C1 lda ,x+
B9C3 8D0A bsr L_B9CF ; byte out
B9C5 0A81 dec <$81
B9C7 26F8 bne L_B9C1 ; keep going until all data sent
B9C9 9680 L_B9C9 lda <$80 ; checksum
B9CB 8D02 bsr L_B9CF ; byte out
B9CD 8655 L_B9CD lda #$55 ; leader byte
B9CF 7E801E L_B9CF jmp call_CBOUT ; byte out
B9D2 8D3F SET_dispatch bsr L_BA13 ; read coords & calc pixel
B9D4 3410 pshs x
B9D6 BD8E7E jsr L_8E7E ; skip comma & get number in B
B9D9 3510 puls x
B9DB C108 cmpb #$08
B9DD 2245 bhi L_BA24 ; ?FC ERROR
B9DF 5A decb
B9E0 2B05 bmi L_B9E7 ; black
B9E2 8610 lda #$10
B9E4 3D mul
B9E5 2008 bra L_B9EF
B9E7 E684 L_B9E7 ldb ,x
B9E9 2A03 bpl L_B9EE ; non-graphics block present
B9EB C470 andb #$70
B9ED 21 fcb $21 ; brn L_BA4E - comment byte
B9EE 5F L_B9EE clrb ; usually skipped by comment byte
B9EF 3404 L_B9EF pshs b ; * (B9EE 5F CLRB)
B9F1 8D69 bsr L_BA5C ; skip close bracket
B9F3 A684 lda ,x
B9F5 2B01 bmi L_B9F8
B9F7 4F clra ; non-graphics block present
B9F8 840F L_B9F8 anda #$0f
B9FA 9A86 ora <$86 ; lo-res pixel mask
B9FC AAE0 ora ,s+
B9FE 8A80 L_B9FE ora #$80
BA00 A784 sta ,x
BA02 39 rts
BA03 8D0E RESET_dispatch bsr L_BA13 ; read coords & calc pixel
BA05 8D55 bsr L_BA5C ; skip close bracket
BA07 4F clra
BA08 E684 ldb ,x
BA0A 2AF2 bpl L_B9FE
BA0C 0386 com <$86 ; lo-res pixel mask
BA0E D486 andb <$86
BA10 E784 stb ,x
BA12 39 rts
BA13 BD89A7 L_BA13 jsr CkOpBrak ; skip open bracket
BA16 BD8E51 L_BA16 jsr Get8Bit ; get number in B
BA19 C13F cmpb #$3f
BA1B 2207 bhi L_BA24 ; ?FC ERROR
BA1D 3404 pshs b
BA1F BD8E7E jsr L_8E7E ; skip comma & get number in B
BA22 C11F cmpb #$1f
BA24 2271 L_BA24 bhi do_fc_error_BA97 ; ?FC ERROR
BA26 3404 pshs b
BA28 54 lsrb
BA29 8620 lda #$20
BA2B 3D mul
BA2C 8E0400 ldx #$0400
BA2F 308B leax d,x
BA31 E661 ldb 1,s
BA33 54 lsrb
BA34 3A abx
BA35 3506 puls a,b
BA37 8401 anda #$01
BA39 56 rorb
BA3A 49 rola
BA3B C610 ldb #$10
BA3D 54 L_BA3D lsrb
BA3E 4A deca
BA3F 2AFC bpl L_BA3D
BA41 D786 stb <$86 ; lo-res pixel mask
BA43 39 rts
BA44 8DD0 POINT_dispatch bsr L_BA16 ; read coords
BA46 C6FF ldb #$ff
BA48 A684 lda ,x
BA4A 2A0D bpl L_BA59 ; non-graphics block
BA4C 9486 anda <$86 ; lo-res pixel mask
BA4E 2708 L_BA4E beq L_BA58
BA50 E684 ldb ,x
BA52 54 lsrb
BA53 54 lsrb
BA54 54 lsrb
BA55 54 lsrb
BA56 C407 andb #$07
BA58 5C L_BA58 incb
BA59 BDB81A L_BA59 jsr L_B81A ; return number to BASIC
BA5C 7E89A4 L_BA5C jmp CkClBrak ; skip close bracket
BA5F BD01A0 CLS_dispatch jsr >$01a0 ; PATCH - CLS GET PUT
BA62 2713 beq clear_screen ; no parameter - clear to spaces
BA64 BD8E51 jsr Get8Bit ; get number in B
BA67 C108 cmpb #$08
BA69 221B bhi clear_screen_ms ; CLS 9+
BA6B 5D tstb
BA6C 2706 beq L_BA74 ; CLS 0
BA6E 5A decb
BA6F 8610 lda #$10
BA71 3D mul
BA72 CA0F orb #$0f
BA74 CA80 L_BA74 orb #$80
BA76 8C fcb $8c ; cmpx #$c660 - comment byte
BA77 C660 clear_screen ldb #$60 ; usually skipped by comment byte
BA79 8E0400 ldx #$0400 ; * (BA77 C660 LDB #$60)
BA7C 9F88 stx <$88 ; text cursor address
BA7E E780 L_BA7E stb ,x+
BA80 8C05FF cmpx #$05ff
BA83 23F9 bls L_BA7E
BA85 39 rts
BA86 8DEF clear_screen_ms bsr clear_screen ; clear screen
BA88 8EB4EC ldx #copyright_ms - 1
BA8B 7E90E5 jmp out_string ; print string to DEVN
BA8E BD89AA L_BA8E jsr CkComa ; check comma
BA91 BD8E51 L_BA91 jsr Get8Bit ; get number in B
BA94 5D tstb
BA95 263C bne L_BAD3 ; RTS
BA97 7E8B8D do_fc_error_BA97 jmp FC_error ; ?FC ERROR
BA9A 8DF5 SOUND_dispatch bsr L_BA91 ; get pitch
BA9C D78C stb <$8c ; pitch
BA9E 8DEE bsr L_BA8E ; skip comma & get duration
BAA0 8604 lda #$04
BAA2 3D mul
BAA3 DD8D std <$8d ; duration x 4
BAA5 B6FF03 lda >$ff03
BAA8 8A01 ora #$01
BAAA B7FF03 sta >$ff03 ; enable vsync irq
BAAD 12 nop
BAAE 5F clrb
BAAF 8D40 bsr L_BAF1 ; B=0 to select d/a sound
BAB1 8D12 bsr L_BAC5 ; enable audio
BAB3 8D1F L_BAB3 bsr L_BAD4 ; centre d/a
BAB5 86FC lda #$fc
BAB7 8D1D bsr L_BAD6 ; max d/a
BAB9 8D19 bsr L_BAD4 ; centre d/a
BABB 8600 lda #$00
BABD 8D17 bsr L_BAD6 ; min d/a
BABF 9E8D ldx <$8d ; loop until irq routine
BAC1 26F0 bne L_BAB3 ; decrements duration to zero
BAC3 4F L_BAC3 clra ; * disable audio
BAC4 8C fcb $8c ; cmpx #do_sn_error_860A - 2 - comment byte
BAC5 8608 L_BAC5 lda #$08 ; usually skipped by comment byte
BAC7 A7E2 sta ,-s ; * (BAC5 8608 LDA #$08)
BAC9 B6FF23 lda >$ff23
BACC 84F7 anda #$f7
BACE AAE0 ora ,s+
BAD0 B7FF23 sta >$ff23
BAD3 39 L_BAD3 rts
BAD4 867C L_BAD4 lda #$7c ; * reset D/A and delay
BAD6 B7FF20 L_BAD6 sta >$ff20 ; * store A in D/A and delay
BAD9 968C lda <$8c ; SOUND pitch value
BADB 4C L_BADB inca
BADC 26FD bne L_BADB
BADE 39 rts
BADF 1F89 AUDIO_dispatch tfr a,b ; * AUDIO
BAE1 9D9F jsr <$9f ; get next character from BASIC source
BAE3 C1C2 cmpb #$c2 ; token OFF
BAE5 27DC beq L_BAC3
BAE7 C088 subb #$88 ; token ON
BAE9 BDB7FB jsr L_B7FB ; ?SN ERROR if <>0
BAEC 5C incb
BAED 8D02 bsr L_BAF1 ; B=1 for cassette sound
BAEF 20D4 bra L_BAC5 ; enable audio
BAF1 CEFF01 L_BAF1 ldu #$ff01 ; * select sound source
BAF4 8D00 bsr L_BAF6
BAF6 A6C4 L_BAF6 lda ,u
BAF8 84F7 anda #$f7
BAFA 57 asrb
BAFB 2402 bcc L_BAFF
BAFD 8A08 ora #$08
BAFF A7C1 L_BAFF sta ,u++
BB01 39 rts
BB02 BE008D L_BB02 ldx >$008d ; SOUND counter
BB05 2705 beq L_BB0C
BB07 301F leax -1,x
BB09 BF008D stx >$008d ; SOUND counter
BB0C 3B L_BB0C rti
BB0D BD8E54 JOYSTK_dispatch jsr L_8E54 ; get number in B from FPA1
BB10 C103 cmpb #$03
BB12 1022D077 lbhi FC_error ; ?FC ERROR
BB16 5D tstb
BB17 2603 bne L_BB1C
BB19 BD8012 jsr call_JOYIN ; update joysticks if B = 0
BB1C 8E015A L_BB1C ldx #$015a ; joystick value table
BB1F D653 ldb <$53 ; get number again
BB21 E685 ldb b,x
BB23 7E8C36 jmp Assign8Bit ; assign B to FPA1
BB26 813A chrget_next cmpa #$3a ; * character is a digit
BB28 240A bcc L_BB34 ; higher than '9'
BB2A 8120 cmpa #$20
BB2C 2602 bne L_BB30 ; not a space
BB2E 0E9F jmp <$9f ; get next character from BASIC source
BB30 8030 L_BB30 suba #$30
BB32 80D0 suba #$d0 ; set carry if >= '0'
BB34 39 L_BB34 rts
BB35 00000000000000 fcb $00,$00,$00,$00,$00,$00,$00 ; * unused
BB3C CC0034 HWINIT ldd #$0034 ; initialise PIA0:
BB3F 8EFF00 ldx #$ff00 ; $FF00 PDR rrrrrrrr
BB42 A701 sta 1,x ; $FF02 PDR wwwwwwww
BB44 A703 sta 3,x ; CA2 bit3 output mode
BB46 A784 sta ,x ; CB2 bit3 output mode
BB48 43 coma ; IRQA disabled (hsync)
BB49 A702 sta 2,x ; IRQB disabled (vsync)
BB4B E701 stb 1,x
BB4D E703 stb 3,x
BB4F 8EFF20 ldx #$ff20 ; initialise PIA1:
BB52 6F01 clr 1,x ; $FF20 PDR wwwwwwwr
BB54 6F03 clr 3,x ; $FF22 PDR wwwwwrrr
BB56 4A deca ; CA2 bit3 output mode
BB57 A784 sta ,x ; CB2 bit3 output mode
BB59 86F8 lda #$f8 ; IRQA disabled (ack)
BB5B A702 sta 2,x ; IRQB disabled (cart)
BB5D E701 stb 1,x
BB5F E703 stb 3,x
BB61 6F84 clr ,x
BB63 6F02 clr 2,x
BB65 CC0A98 ldd #$0a98 ; initialise serial hardware:
BB68 FDFF06 std >$ff06 ; no parity, no IRQ, DTR low
BB6B B6FF04 lda >$ff04 ; 1200 baud, 8 data, 2 stop
BB6E 8EFFC0 ldx #$ffc0 ; initialise SAM:
BB71 C610 ldb #$10 ; 512 byte display
BB73 A781 L_BB73 sta ,x++ ; display base 1024
BB75 5A decb ; mem page 0
BB76 26FB bne L_BB73 ; slow MPU rate
BB78 F7FFC9 stb >$ffc9 ; 64K dynamic memory
BB7B F7FFDD stb >$ffdd ; MAP 0
BB7E 2003 bra L_BB83
BB80 7EBF49 call_BOOT64K jmp BOOT64K ; * boot 64K BASIC
BB83 5F L_BB83 clrb ; * reset routine continued
BB84 1F9B tfr b,dp
BB86 1F25 tfr y,pc ; JMP to $B39B
BB88 8EBB9F SWINIT ldx #copy_to_008F ; * part of start up reset routine
BB8B CE008F ldu #$008f
BB8E C60D ldb #$0d
BB90 8D05 bsr L_BB97 ; copy B bytes from X to U
BB92 BDBEFF jsr L_BEFF ; set up serial printer parameters
BB95 C609 ldb #$09
BB97 A680 L_BB97 lda ,x+
BB99 A7C0 sta ,u+
BB9B 5A decb
BB9C 26F9 bne L_BB97 ; copy B bytes from X to U
BB9E 39 rts
BB9F 320100120A12DA5C045E107484 copy_to_008F fcb $32,$01,$00,$12,$0a,$12,$da,$5c,$04,$5e,$10,$74,$84 ; * key scan delay, printer parameters)
BBAC FFFF010D0A00000000 copy_to_0148 fcb $ff,$ff,$01,$0d,$0a,$00,$00,$00,$00 ; * (auto LF flag, caps flag, printer EOL sequence)
BBB5 0A8F CBLINK dec <$8f ; cursor flash counter
BBB7 260C bne delay_1ms
BBB9 8632 lda #$32
BBBB 978F sta <$8f ; cursor flash counter
BBBD 9E88 ldx <$88 ; text cursor address
BBBF A684 lda ,x
BBC1 8840 eora #$40
BBC3 A784 sta ,x
BBC5 8E045E delay_1ms ldx #$045e
BBC8 301F delay_X leax -1,x
BBCA 26FC bne delay_X
BBCC 39 rts
BBCD F6FF00 L_BBCD ldb >$ff00 ; * read key matrix & mask SHIFT key
BBD0 CA80 orb #$80 ; mask analogue comp.
BBD2 7DFF02 tst >$ff02
BBD5 2B02 bmi L_BBD9
BBD7 CA40 orb #$40
BBD9 39 L_BBD9 rts
BBDA C67F check_shift ldb #$7f ; * test for SHIFT key
BBDC F7FF02 stb >$ff02
BBDF F6FF00 ldb >$ff00
BBE2 C440 andb #$40
BBE4 39 rts
BBE5 3414 INCH pshs b,x ; * scan keyboard & return ASCII
BBE7 8D03 bsr L_BBEC
BBE9 7EBEE0 jmp L_BEE0
BBEC 327E L_BBEC leas -2,s
BBEE 8E0151 ldx #$0151 ; key rollover table
BBF1 7FFF02 clr >$ff02 ; test all keys
BBF4 F6FF00 ldb >$ff00
BBF7 CA80 orb #$80 ; mask analogue comp.
BBF9 E184 cmpb ,x
BBFB 2772 beq L_BC6F ; nothing changed - return NUL
BBFD 1F98 tfr b,a
BBFF 73FF02 com >$ff02 ; disable all keys
BC02 8DC9 bsr L_BBCD ; read matrix & mask shift
BC04 C1FF cmpb #$ff
BC06 2667 bne L_BC6F ; joystick button pressed - return NUL
BC08 A780 sta ,x+ ; $0151 = keyboard state
BC0A 6FE4 clr ,s ; row counter
BC0C C6FE ldb #$fe
BC0E F7FF02 stb >$ff02
BC11 8DBA L_BC11 bsr L_BBCD ; read matrix & mask shift
BC13 E761 stb 1,s
BC15 E884 eorb ,x
BC17 E484 andb ,x ; sets bits in B for new keys pressed
BC19 A661 lda 1,s
BC1B A780 sta ,x+ ; save new scan code
BC1D 5D tstb
BC1E 260A bne L_BC2A ; new keys pressed
BC20 6CE4 inc ,s
BC22 43 coma ; set carry
BC23 79FF02 rol >$ff02 ; next row
BC26 25E9 bcs L_BC11 ; more rows to do
BC28 2045 bra L_BC6F ; no new keys pressed - return NUL
BC2A 9E97 L_BC2A ldx <$97
BC2C 8D9A bsr delay_X ; debounce delay
BC2E 1E89 exg a,b
BC30 8D9B bsr L_BBCD ; read matrix & mask shift
BC32 E161 cmpb 1,s
BC34 1E89 exg a,b
BC36 2637 bne L_BC6F ; key state changed during delay - return NUL
BC38 A6E4 lda ,s ; row number
BC3A 8008 suba #$08
BC3C 8B08 L_BC3C adda #$08 ; convert scan code into a number
BC3E 54 lsrb ; between 0 and 54
BC3F 24FB bcc L_BC3C ; (nb. shift masked out)
BC41 4D tsta
BC42 2732 beq L_BC76 ; zero key
BC44 810C cmpa #$0c
BC46 2517 bcs L_BC5F ; keys 1 to 9 : ;
BC48 8111 cmpa #$11
BC4A 2528 bcs L_BC74 ; keys , - . / @
BC4C 812A cmpa #$2a
BC4E 2222 bhi L_BC72 ; arrows SPC RET CLR BRK
BC50 8B30 adda #$30 ; ASCII A - Z
BC52 8D86 bsr check_shift ; test for SHIFT key
BC54 2712 beq L_BC68 ; SHIFT pressed
BC56 7D0149 tst >$0149 ; CAPS flag
BC59 260D bne L_BC68 ; upper case
BC5B 8A20 ora #$20 ; convert to lower case
BC5D 2009 bra L_BC68
BC5F 8B30 L_BC5F adda #$30 ; ASCII 1 to 9 : ;
BC61 17FF76 lbsr check_shift ; test for SHIFT key
BC64 2602 bne L_BC68 ; SHIFT not pressed
BC66 8010 suba #$10
BC68 8112 L_BC68 cmpa #$12
BC6A 2604 bne L_BC70 ; not shift + 0
BC6C 730149 com >$0149 ; CAPS flag
BC6F 4F L_BC6F clra
BC70 3590 L_BC70 puls x,pc
BC72 801A L_BC72 suba #$1a ; * XLAT key scan code to ASCII
BC74 800B L_BC74 suba #$0b
BC76 48 L_BC76 lsla
BC77 17FF60 lbsr check_shift ; test for SHIFT key
BC7A 2601 bne L_BC7D
BC7C 4C inca
BC7D 8EBC84 L_BC7D ldx #kbd_map_00
BC80 A686 lda a,x
BC82 20E4 bra L_BC68
BC84 3012 kbd_map_00 fcb $30,$12 ; 0 ,
BC86 2C3C2D3D2E3E2F3F4013 kbd_map_0c_10 fcb $2c,$3c,$2d,$3d,$2e,$3e,$2f,$3f,$40,$13
BC90 5E5F0A5B0815095D20200D0D0C5C0303 kbd_map_2b_32 fcb $5e,$5f,$0a,$5b,$08,$15,$09,$5d,$20,$20,$0d,$0d,$0c,$5c,$03,$03 ; CU CD
BCA0 8660 clear_to_eol lda #$60 ; * clear VDU line + CR/LF
BCA2 A780 sta ,x+
BCA4 1F10 tfr x,d
BCA6 C41F andb #$1f
BCA8 26F6 bne clear_to_eol
BCAA 39 rts
BCAB 3416 OUTCH pshs a,b,x ; * write character to VDU
BCAD 9E88 ldx <$88 ; text cursor address
BCAF 8108 cmpa #$08
BCB1 260B bne L_BCBE
BCB3 8C0400 cmpx #$0400 ; backspace
BCB6 273B beq L_BCF3
BCB8 8660 lda #$60
BCBA A782 sta ,-x
BCBC 201D bra L_BCDB
BCBE 810D L_BCBE cmpa #$0d ; return
BCC0 2604 bne L_BCC6
BCC2 8DDC bsr clear_to_eol ; clear VDU line + CR/LF
BCC4 2015 bra L_BCDB
BCC6 8120 L_BCC6 cmpa #$20
BCC8 2529 bcs L_BCF3 ; chr < $20
BCCA 4D tsta
BCCB 2B0C bmi L_BCD9 ; chr >= 128
BCCD 8140 cmpa #$40
BCCF 2506 bcs L_BCD7 ; $20 <= chr < $40
BCD1 8160 cmpa #$60
BCD3 2504 bcs L_BCD9 ; $40 <= chr < $60
BCD5 84DF anda #$df
BCD7 8840 L_BCD7 eora #$40
BCD9 A780 L_BCD9 sta ,x+
BCDB 9F88 L_BCDB stx <$88 ; text cursor address
BCDD 8C05FF cmpx #$05ff
BCE0 2311 bls L_BCF3
BCE2 8E0400 ldx #$0400 ; scroll
BCE5 EC8820 L_BCE5 ldd <$20,x
BCE8 ED81 std ,x++
BCEA 8C05E0 cmpx #$05e0
BCED 25F6 bcs L_BCE5
BCEF 9F88 stx <$88 ; text cursor address
BCF1 8DAD bsr clear_to_eol ; clear VDU line + CR/LF
BCF3 3596 L_BCF3 puls a,b,x,pc
BCF5 3404 TXLPCH pshs b ; * write character direct to printer
BCF7 7D03FF tst >$03ff ; printer type flag
BCFA 7EBEC5 jmp L_BEC5 ; continued...
BCFD B7FF02 L_BCFD sta >$ff02 ; * write character to parallel port
BD00 C602 ldb #$02
BD02 F7FF20 stb >$ff20
BD05 7FFF20 clr >$ff20 ; strobe
BD08 3584 puls b,pc
BD0A 8E014A L_BD0A ldx #$014a ; * send EOL characters to printer
BD0D E680 ldb ,x+
BD0F 5D L_BD0F tstb
BD10 2707 beq L_BD19
BD12 A680 lda ,x+
BD14 8DDF bsr TXLPCH ; send character direct to printer
BD16 7EBF0C jmp L_BF0C ; continued...
BD19 39 L_BD19 rts
BD1A 3416 LPOUT pshs a,b,x ; * write character to printer
BD1C 810D cmpa #$0d
BD1E 2713 beq L_BD33
BD20 8120 cmpa #$20
BD22 2502 bcs L_BD26 ; don't advance head pos for CTRL chrs
BD24 0C9C inc <$9c ; printer head pos
BD26 8DCD L_BD26 bsr TXLPCH ; send character to printer
BD28 D69C ldb <$9c ; printer head pos
BD2A D19B cmpb <$9b ; printer line width
BD2C 2511 bcs L_BD3F
BD2E 7D0148 tst >$0148 ; printer auto LF flag
BD31 260A bne L_BD3D
BD33 0D9C L_BD33 tst <$9c ; printer head pos
BD35 2604 bne L_BD3B
BD37 8620 lda #$20
BD39 8DBA bsr TXLPCH ; send character to printer
BD3B 8DCD L_BD3B bsr L_BD0A ; send EOL sequence
BD3D 0F9C L_BD3D clr <$9c ; printer head pos
BD3F 3596 L_BD3F puls a,b,x,pc
BD41 CEFF01 SNDSEL ldu #$ff01 ; * select joystick source B (0-3)
BD44 8D00 bsr L_BD46
BD46 A6C4 L_BD46 lda ,u
BD48 84F7 anda #$f7
BD4A 56 rorb
BD4B 2402 bcc L_BD4F
BD4D 8A08 ora #$08
BD4F A7C1 L_BD4F sta ,u++
BD51 39 rts
BD52 327D JOYIN leas -3,s ; * (reads each channel up to 10 times until stable result is obtained)
BD54 8E015E ldx #$015e ; end of joystick table + 1
BD57 C603 ldb #$03
BD59 860A L_BD59 lda #$0a
BD5B ED61 std 1,s
BD5D 8DE2 bsr SNDSEL ; select joystick source B
BD5F CC4080 L_BD5F ldd #$4080
BD62 A7E4 L_BD62 sta ,s
BD64 F7FF20 stb >$ff20
BD67 7DFF00 tst >$ff00 ; test analogue comp.
BD6A 2B04 bmi L_BD70 ; approximation low
BD6C E0E4 subb ,s ; try smaller value
BD6E 2002 bra L_BD72
BD70 EBE4 L_BD70 addb ,s ; try larger value
BD72 44 L_BD72 lsra
BD73 8101 cmpa #$01
BD75 26EB bne L_BD62 ; do finer approximation
BD77 54 lsrb
BD78 54 lsrb ; convert range to 0-63
BD79 E11F cmpb -1,x
BD7B 2704 beq L_BD81 ; reading stable
BD7D 6A61 dec 1,s
BD7F 26DE bne L_BD5F ; do up to 10 readings until stable
BD81 E782 L_BD81 stb ,-x
BD83 E662 ldb 2,s
BD85 5A decb
BD86 2AD1 bpl L_BD59 ; do next joystick channel
BD88 3592 puls a,x,pc
BD8A 0C82 sample_cas inc <$82 ; wavelength timer
BD8C F6FF20 ldb >$ff20
BD8F 56 rorb
BD90 39 rts
BD91 0F82 tape_wait_2p clr <$82 ; wavelength timer
BD93 0D84 tst <$84 ; phase flag
BD95 2607 bne tape_wait_p1_p0 ; time antiphase wave
BD97 8D07 tape_wait_p0_p1 bsr tape_wait_p0 ; time +ve going wave
BD99 8DEF tape_wait_p1 bsr sample_cas ; read cassette input & update timer
BD9B 24FC bcc tape_wait_p1
BD9D 39 rts
BD9E 8DF9 tape_wait_p1_p0 bsr tape_wait_p1 ; time -ve going wave
BDA0 8DE8 tape_wait_p0 bsr sample_cas ; read cassette input & update timer
BDA2 25FC bcs tape_wait_p0
BDA4 39 rts
BDA5 8DEA BITIN bsr tape_wait_2p ; * read bit from tape into carry
BDA7 D682 ldb <$82 ; wavelength timer
BDA9 5A decb
BDAA D192 cmpb <$92 ; wavelength threshold
BDAC 39 rts
BDAD 8608 CBIN lda #$08 ; * read byte from tape into A
BDAF 9783 sta <$83
BDB1 8DF2 L_BDB1 bsr BITIN ; read bit from tape into carry
BDB3 46 rora ; LSB first
BDB4 0A83 dec <$83
BDB6 26F9 bne L_BDB1 ; do next bit
BDB8 39 rts
BDB9 0F82 tape_cmp_p1_1200 clr <$82 ; wavelength timer
BDBB 8DE3 bsr tape_wait_p0 ; time +ve going wave
BDBD 2004 bra L_BDC3
BDBF 0F82 tape_cmp_p0_1200 clr <$82 ; wavelength timer
BDC1 8DD6 bsr tape_wait_p1 ; time -ve going wave
BDC3 D682 L_BDC3 ldb <$82 ; wavelength timer
BDC5 D194 cmpb <$94 ; rejection threshold
BDC7 2203 bhi L_BDCC ; bad wave - clear counter
BDC9 D193 cmpb <$93 ; discrimination threshold
BDCB 39 rts
BDCC 0F83 L_BDCC clr <$83 ; phase lock counter
BDCE 39 rts
BDCF B6FF21 CASON lda >$ff21 ; * turn cassette relay on
BDD2 8A08 ora #$08
BDD4 B7FF21 sta >$ff21
BDD7 9E95 ldx <$95
BDD9 16FDEC lbra delay_X
BDDC B6FF21 CASOFF lda >$ff21 ; * turn cassette relay off
BDDF 84F7 anda #$f7
BDE1 B7FF21 sta >$ff21
BDE4 1CAF andcc #$af
BDE6 39 rts
BDE7 1A50 CSRDON orcc #$50 ; mask interrupts
BDE9 8DE4 bsr CASON ; cassette relay on
BDEB 0F83 clr <$83 ; phase lock counter
BDED 8DA8 L_BDED bsr tape_wait_p0_p1 ; synchronise to in-phase wave (+ve then -ve)
BDEF 8DC8 L_BDEF bsr tape_cmp_p1_1200 ; test +ve wave
BDF1 220C bhi L_BDFF ; 0 or bad
BDF3 8DCA L_BDF3 bsr tape_cmp_p0_1200 ; test -ve wave
BDF5 250C bcs L_BE03 ; 1 or bad
BDF7 0C83 inc <$83 ; add 1 for each antiphase pair of cycles
BDF9 9683 lda <$83
BDFB 8160 cmpa #$60
BDFD 200E bra L_BE0D
BDFF 8DBE L_BDFF bsr tape_cmp_p0_1200 ; test -ve wave
BE01 22EC bhi L_BDEF ; 0 or bad
BE03 8DB4 L_BE03 bsr tape_cmp_p1_1200 ; test +ve wave
BE05 25EC bcs L_BDF3 ; 1 or bad
BE07 0A83 dec <$83 ; subtract 1 for each in-phase pair of cycles
BE09 9683 lda <$83
BE0B 8B60 adda #$60 ; SUBA #-$60
BE0D 26DE L_BE0D bne L_BDED ; need $60 locks in a row ($18 leader bytes)
BE0F 9784 sta <$84 ; phase flag
BE11 39 rts
BE12 3402 CBOUT pshs a ; * write byte out to tape (A)
BE14 C601 ldb #$01 ; send LSB first
BE16 108EBE44 L_BE16 ldy #cas_wav ; wave table
BE1A 9685 lda <$85 ; inter-wave level
BE1C B7FF20 sta >$ff20
BE1F E5E4 bitb ,s
BE21 260D bne L_BE30 ; high frequency for 1
BE23 A6A0 L_BE23 lda ,y+ ; low frequency for 0
BE25 108CBE68 cmpy #WRTLDR
BE29 2412 bcc L_BE3D ; done 0
BE2B B7FF20 sta >$ff20
BE2E 20F3 bra L_BE23
BE30 A6A1 L_BE30 lda ,y++
BE32 108CBE68 cmpy #WRTLDR
BE36 2405 bcc L_BE3D ; done 1
BE38 B7FF20 sta >$ff20
BE3B 20F3 bra L_BE30
BE3D 9785 L_BE3D sta <$85 ; inter-wave level
BE3F 58 lslb
BE40 24D4 bcc L_BE16 ; do next bit
BE42 3582 puls a,pc
BE44 8090A8B8C8D8E8F0F8F8F8F0E8D8C8B8 cas_wav fcb $80,$90,$a8,$b8,$c8,$d8,$e8,$f0,$f8,$f8,$f8,$f0,$e8,$d8,$c8,$b8 ; * wave table for cassette output
BE54 A8907868504030201008000000081020 fcb $a8,$90,$78,$68,$50,$40,$30,$20,$10,$08,$00,$00,$00,$08,$10,$20
BE64 30405068 fcb $30,$40,$50,$68
BE68 3424 WRTLDR pshs b,y ; * write leader to tape
BE6A 1A50 orcc #$50 ; mask interrupts
BE6C 17FF60 lbsr CASON ; cassette relay on
BE6F 8655 lda #$55
BE71 9E90 ldx <$90 ; cassette leader byte count
BE73 8D9D L_BE73 bsr CBOUT ; write byte out to tape
BE75 301F leax -1,x
BE77 26FA bne L_BE73 ; do next byte
BE79 35A4 puls b,y,pc
BE7B 3405 SERIN pshs cc,b ; * read character from serial port into A
BE7D 1A50 orcc #$50 ; mask interrupts
BE7F 8608 lda #$08
BE81 F6FF06 ldb >$ff06
BE84 CA01 orb #$01
BE86 F7FF06 stb >$ff06 ; set DTR
BE89 C4FE andb #$fe
BE8B B5FF05 L_BE8B bita >$ff05 ; wait until RX full
BE8E 27FB beq L_BE8B
BE90 F7FF06 stb >$ff06 ; clear DTR
BE93 B6FF04 lda >$ff04
BE96 3585 puls cc,b,pc
BE98 3405 SEROUT pshs cc,b ; * write character to serial port (A)
BE9A C610 ldb #$10
BE9C F5FF05 L_BE9C bitb >$ff05 ; wait until TX ready
BE9F 27FB beq L_BE9C
BEA1 B7FF04 sta >$ff04
BEA4 3585 puls cc,b,pc
BEA6 C107 SERSET cmpb #$07 ; * (parameter in B is as per DLOAD)
BEA8 2412 bcc L_BEBC ; B must be 0 - 6
BEAA 8EBEBE ldx #acia_baud_table ; serial baud setup table
BEAD 3A abx
BEAE F6FF07 ldb >$ff07
BEB1 C4F0 andb #$f0
BEB3 EA84 orb ,x
BEB5 F7FF07 stb >$ff07
BEB8 1CFE andcc #$fe
BEBA 2001 bra L_BEBD
BEBC 53 L_BEBC comb
BEBD 39 L_BEBD rts
BEBE 030607080A0C0E acia_baud_table fcb $03,$06,$07,$08,$0a,$0c,$0e ; * serial port baud setup table
BEC5 2614 L_BEC5 bne L_BEDB ; * printer direct out (continued from $BCF5)
BEC7 F6FF22 L_BEC7 ldb >$ff22
BECA 56 rorb
BECB 25FA bcs L_BEC7 ; printer busy
BECD 7FFF02 L_BECD clr >$ff02
BED0 F6FF00 ldb >$ff00
BED3 CA80 orb #$80
BED5 5C incb
BED6 26F5 bne L_BECD ; wait until keys released
BED8 7EBCFD jmp L_BCFD
BEDB 3504 L_BEDB puls b
BEDD 7EBE98 jmp SEROUT ; send character to serial port
BEE0 F60151 L_BEE0 ldb >$0151 ; * scan keyboard continued
BEE3 5C incb
BEE4 2603 bne L_BEE9 ; key pressed
BEE6 F7011D stb >$011d ; stores a zero
BEE9 4D L_BEE9 tsta
BEEA 2711 beq L_BEFD ; ASCII NUL
BEEC F6011F ldb >$011f ; repeat delay
BEEF B1011D cmpa >$011d ; current key
BEF2 2703 beq L_BEF7 ; same key pressed - use normal repeat rate
BEF4 58 lslb
BEF5 58 lslb ; set up initial repeat delay
BEF6 58 lslb
BEF7 F7011E L_BEF7 stb >$011e ; repeat counter
BEFA B7011D sta >$011d ; current key
BEFD 3594 L_BEFD puls b,x,pc
BEFF 7F03FF L_BEFF clr >$03ff ; printer type flag
BF02 7F03FD clr >$03fd ; serial printer EOL delay
BF05 7F03FE clr >$03fe
BF08 CE0148 ldu #$0148
BF0B 39 rts
BF0C 5A L_BF0C decb ; * send printer EOL characters (continued)
BF0D 2703 beq L_BF12
BF0F 7EBD0F jmp L_BD0F
BF12 10BE03FD L_BF12 ldy >$03fd ; EOL delay
BF16 2707 beq L_BF1F
BF18 BDBBC5 L_BF18 jsr delay_1ms ; 10ms delay
BF1B 313F leay -1,y
BF1D 26F9 bne L_BF18
BF1F 39 L_BF1F rts
BF20 F6FF05 ldb >$ff05 ; * (gives autorepeat keys)
BF23 2A0D bpl L_BF32 ; not serial interrupt
BF25 C408 andb #$08
BF27 2708 beq L_BF31 ; RX not full
BF29 B6FF06 lda >$ff06
BF2C 84FE anda #$fe
BF2E B7FF06 sta >$ff06 ; set DTR low
BF31 3B L_BF31 rti
BF32 740151 L_BF32 lsr >$0151 ; force complete keyboard read
BF35 7A011E dec >$011e ; key repeat counter
BF38 260C bne L_BF46 ; not yet...
BF3A 86FF lda #$ff ; clear key rollover table
BF3C 8E0151 ldx #$0151
BF3F A780 L_BF3F sta ,x+
BF41 8C015A cmpx #$015a
BF44 25F9 bcs L_BF3F
BF46 7E9D3D L_BF46 jmp IRQ_service ; resume with normal IRQ routine
BF49 12 BOOT64K nop ; * (doubles as 64K BASIC soft reset)
BF4A 1A50 orcc #$50 ; mask interrupts
BF4C 8EBF5A ldx #bootcode_64k
BF4F CE01DA ldu #$01da ; IO buffer
BF52 C68F ldb #$8f
BF54 17FC40 lbsr L_BB97 ; copy B bytes from X to U
BF57 7E01DA jmp >$01da ; IO buffer
BF5A B6011A bootcode_64k lda >$011a ; 64K BASIC flag
BF5D 8155 cmpa #$55
BF5F 2616 bne L_BF77
BF61 B7FFDF sta >$ffdf
BF64 8EC000 ldx #$c000
BF67 CC0000 ldd #$0000
BF6A E381 L_BF6A addd ,x++
BF6C 8CFF00 cmpx #$ff00
BF6F 25F9 bcs L_BF6A
BF71 10B3011B cmpd >$011b ; 64K BASIC checksum
BF75 276F beq L_BFE6
BF77 B7FFDE L_BF77 sta >$ffde
BF7A B6FF23 lda >$ff23
BF7D 84FB anda #$fb
BF7F B7FF23 sta >$ff23
BF82 F6FF22 ldb >$ff22
BF85 CA04 orb #$04
BF87 F7FF22 stb >$ff22
BF8A 8A04 ora #$04
BF8C B7FF23 sta >$ff23
BF8F B6FF22 lda >$ff22
BF92 84FB anda #$fb
BF94 B7FF22 sta >$ff22
BF97 FEBFF0 ldu cpu_vectors
BF9A 11833634 cmpu #$3634
BF9E 2708 beq L_BFA8
BFA0 8A04 ora #$04
BFA2 B7FF22 sta >$ff22
BFA5 7E8B8D jmp FC_error ; ?FC ERROR
BFA8 7F011B L_BFA8 clr >$011b ; 64K BASIC checksum
BFAB 7F011C clr >$011c
BFAE 8E8000 ldx #call_HWINIT
BFB1 108EC000 ldy #$c000
BFB5 EC81 L_BFB5 ldd ,x++
BFB7 B7FFDF sta >$ffdf
BFBA EDA1 std ,y++
BFBC F3011B addd >$011b ; 64K BASIC checksum
BFBF FD011B std >$011b
BFC2 108CFF00 cmpy #$ff00
BFC6 2405 bcc L_BFCD
BFC8 B7FFDE sta >$ffde
BFCB 20E8 bra L_BFB5
BFCD 8EBFF0 L_BFCD ldx #cpu_vectors
BFD0 9F74 stx <$74 ; top of RAM
BFD2 9F27 stx <$27 ; top of BASIC RAM
BFD4 9F23 stx <$23 ; top of free string space
BFD6 3089FF38 leax >$ff38,x
BFDA 9F21 stx <$21 ; stack root / string storage start
BFDC 1F14 tfr x,s
BFDE 8EBF49 ldx #BOOT64K
BFE1 9F72 stx <$72 ; soft reset vector
BFE3 7EC000 jmp >$c000
BFE6 7EC003 L_BFE6 jmp >$c003
BFE9 00000000000000 fcb $00,$00,$00,$00,$00,$00,$00
BFF0 org $bff0
BFF0 000001000103010F010C01060109B3B4 cpu_vectors fdb $0000,$0100,$0103,$010f,$010c,$0106,$0109,RESET_service
C002 L_C002 equ $c002
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment