Skip to content

Instantly share code, notes, and snippets.

@BigEd

BigEd/kb9.lbl

Created November 21, 2012 21:40
Show Gist options
  • Save BigEd/4127984 to your computer and use it in GitHub Desktop.
Save BigEd/4127984 to your computer and use it in GitHub Desktop.
Download ZIP
listing and labels from KB9 BASIC source (see http://www.pagetable.com/?p=46)
Raw
kb9.lbl
al 004225 .QT_BASIC
al 004216 .QT_BYTES_FREE
al 004192 .L4192
al 004157 .L4157
al 004183 .L4183
al 0041C6 .QT_WANT
al 004129 .L4129
al 004127 .L2829
al 004136 .L4136
al 004207 .QT_TERMINAL_WIDTH
al 004106 .L4106
al 0040FA .L40FA
al 0040DD .L40DD
al 0040D7 .L40D7
al 004261 .RAMSTART2
al 0040EE .L40EE
al 0041FB .QT_MEMORY_SIZE
al 004098 .L4098
al 004065 .COLD_START
al 0041DB .QT_WRITTEN_BY
al 00405E .PR_WRITTEN_BY
al 004002 .L4002
al 003FFC .L3FFC
al 004003 .POLY_ATN
al 003FE9 .L3FE9
al 003FDB .L3FDB
al 003FC9 .MICROSOFT
al 003F97 .TAN1
al 003FAA .POLY_SIN
al 003F68 .L3F68
al 003F5B .L3F5B
al 003F58 .SIN1
al 003FA5 .QUARTER
al 003FA0 .CON_PI_DOUB
al 003F9B .CON_PI_HALF
al 003F1F .SIN_COS_TAN_ATN
al 00405E .GENERIC_CHRGET_END
al 003F1C .GOMOVMF
al 003F01 .L3F01
al 003EDF .CONRND2
al 003EDB .CONRND1
al 004058 .L4058
al 004041 .RAMSTART1
al 003EDA .RTS19
al 003ECB .L3ECB
al 003EBE .L3EBE
al 003EBA .L3EBA
al 003EAB .SERMAIN
al 003EA7 .POLYNOMIAL
al 003E6C .L3E6C
al 003E59 .L3E59
al 003E5C .L3E5C
al 003E4E .L3E4E
al 003E15 .POLY_EXP
al 003E10 .CON_LOG_E
al 003E0F .L3E0F
al 003DEF .L3DEF
al 003DD5 .L3DD5
al 003D94 .L3D94
al 003D77 .L3D77
al 003D6B .L3D6B
al 003D8F .L3D8F
al 003D5B .L3D5B
al 003D4E .L3D4E
al 003D4C .LDD96
al 003DC2 .DECTBL_END
al 003D3E .L3D3E
al 003D23 .L3D23
al 003D1C .L3D1C
al 003D1A .L3D1A
al 003D9E .DECTBL
al 003CF6 .L3CF6
al 003CF4 .LDD3A
al 003CF0 .L3CF0
al 003CF2 .L3CF2
al 003CDF .L3CDF
al 003CD4 .L3CD4
al 003CD3 .L3CD3
al 003CBB .L3CBB
al 003CAD .L3CAD
al 003CA2 .L3CA2
al 003CB4 .L3CB4
al 003CBE .L3CBE
al 003C97 .L3C97
al 003C95 .L3C95
al 003C8C .L3C8C
al 003D8C .FOUT4
al 003C84 .L3C84
al 003C73 .L3C73
al 003C66 .GOSTROUT2
al 003C49 .CON_BILLION
al 003C44 .CON_999999999
al 003C3F .CON_99999999_9
al 003C2C .LDC70
al 003C3A .L3C3A
al 003C2C .L3C2C
al 003BFD .L3BFD
al 003BF3 .L3BF3
al 003BDE .L3BDE
al 003BE7 .L3BE7
al 003BEE .L3BEE
al 003BC9 .L3BC9
al 003BD5 .FIN8
al 003C1D .GETEXP
al 003BAC .L3BAC
al 003BB7 .FIN6
al 003BB2 .FIN4
al 003BA6 .L3BA6
al 003BB5 .FIN5
al 003BD3 .FIN7
al 003BC3 .FIN10
al 003BF6 .FIN9
al 003B87 .FIN3
al 003B82 .FIN1
al 003B7E .L3B7E
al 003B85 .FIN2
al 003B6F .L3B6F
al 003B6A .RTS17
al 003B33 .QINT2
al 003B27 .L3B27
al 003B61 .QINT3
al 003B10 .L3B10
al 003B32 .L3B32
al 003B0A .L3B0A
al 003AC7 .LDB21
al 003AC1 .FLOAT2
al 003AA9 .SIGN2
al 003AA7 .L3AA7
al 003AB0 .RTS15
al 003A9B .INCREMENT_MANTISSA
al 003A92 .RTS14
al 003A89 .L3A89
al 003A87 .MAF
al 003A7A .L3A7A
al 003A76 .MFA
al 003A42 .STORE_FAC_IN_TEMP1_ROUNDED
al 003A3F .STORE_FAC_IN_TEMP2_ROUNDED
al 0039C7 .L39C7
al 0039D5 .L39D5
al 0039F6 .L39F6
al 0039F2 .L39F2
al 0039C4 .L39C4
al 0039B7 .L39B7
al 0039A1 .L39A1
al 003A02 .L3A02
al 00397F .DIV
al 003976 .DIV10
al 003971 .CONTEN
al 003965 .LD9BF
al 003970 .L3970
al 003A84 .COPY_FAC_TO_ARG_ROUNDED
al 00395A .MUL10
al 00394C .OUTOFRNG
al 003947 .L3947
al 003957 .JOV
al 00393C .L393C
al 003952 .ZERO
al 003931 .ADD_EXPONENTS1
al 0038F9 .L38F9
al 0038ED .L38ED
al 0038E1 .L38E1
al 0038D5 .L38D5
al 0038C9 .L38C9
al 0038C3 .L38C3
al 0038A7 .L38A7
al 003A07 .COPY_RESULT_INTO_FAC
al 0038A4 .MULTIPLY2
al 00389F .MULTIPLY1
al 00392F .ADD_EXPONENTS
al 003903 .L3903
al 00386E .FMULT
al 003C0A .ADDACC
al 003E91 .POLYNOMIAL_ODD
al 003987 .FDIV
al 00383A .LOG2
al 003837 .GIQ
al 00382B .CON_LOG_TWO
al 003826 .CON_NEG_HALF
al 003821 .CON_SQR_TWO
al 00381C .CON_SQR_HALF
al 003807 .POLY_LOG
al 0037FD .L37FD
al 0037EF .L37EF
al 0037E3 .L37E3
al 0037D7 .L37D7
al 0037C4 .L37C4
al 003800 .SHIFT_RIGHT5
al 0037A3 .SHIFT_RIGHT2
al 0037A1 .SHIFT_RIGHT1
al 00378D .INCREMENT_FAC_MANTISSA
al 00379B .RTS12
al 00376B .COMPLEMENT_FAC_MANTISSA
al 00375E .L375E
al 003752 .L3752
al 003746 .L3746
al 00373A .L373A
al 00372E .L372E
al 00379C .OVERFLOW
al 003724 .NORMALIZE_FAC6
al 003764 .L3764
al 003709 .NORMALIZE_FAC3
al 003722 .NORMALIZE_FAC5
al 0036E7 .STA_IN_FAC_SIGN
al 0036E5 .STA_IN_FAC_SIGN_AND_EXP
al 003715 .NORMALIZE_FAC4
al 0036C7 .L36C7
al 003765 .COMPLEMENT_FAC
al 0036C3 .NORMALIZE_FAC2
al 0036BE .NORMALIZE_FAC1
al 00369B .L369B
al 0036EA .FADD4
al 0037D0 .SHIFT_RIGHT4
al 003683 .L3683
al 00367F .L367F
al 003663 .FADD2
al 00365B .L365B
al 00368F .FADD3
al 0037B7 .SHIFT_RIGHT
al 00364E .FADD1
al 003904 .LOAD_ARG_FROM_YA
al 00363C .FSUB
al 003D99 .CON_HALF
al 003635 .FADDH
al 003634 .RTS3
al 00362C .L362C
al 003628 .L3628
al 00360D .LD6F6
al 0035E9 .COMBYTE
al 0035EF .GETADR
al 0035E3 .GTNUM
al 0035C4 .L35C4
al 0036E3 .ZERO_FAC
al 0035AC .L35AC
al 003576 .SNGFLT1
al 003579 .GETSTR
al 00358F .GOIQ
al 00353F .L353F
al 00351C .L351C
al 003505 .SUBSTRING3
al 003504 .SUBSTRING2
al 003503 .L3503
al 0034FD .SUBSTRING1
al 003556 .SUBSTRING_SETUP
al 003598 .CONINT
al 0034E2 .L34E2
al 0034CC .L34CC
al 0034CD .L34CD
al 00349A .FRESTR
al 003499 .L3499
al 003487 .L3487
al 003490 .L3490
al 003483 .MOVSTR1
al 003454 .L3454
al 0033FA .L33FA
al 0033DF .L33DF
al 0033D5 .L33D5
al 0033EF .CHECK_BUMP
al 0033B1 .L33B1
al 0033A9 .L33A9
al 0033A7 .L33A7
al 0033FF .MOVE_HIGHEST_STRING_TO_TOP
al 003376 .L3376
al 00336B .L336B
al 003367 .L3367
al 0033B6 .CHECK_SIMPLE_VARIABLE
al 00335F .L335F
al 00335A .L335A
al 003352 .L3352
al 0033C0 .CHECK_VARIABLE
al 003346 .L3346
al 00333D .L333D
al 003325 .FINDHIGHESTSTRING
al 003306 .L3306
al 003311 .L3311
al 0032FC .L32FC
al 0032F1 .L32F1
al 0032CF .JERR
al 0032D2 .PUTEMP
al 00347F .MOVSTR
al 0032BC .LD399
al 0032C7 .PUTNEW
al 0032B6 .L32B6
al 0032AA .L32AA
al 0032A5 .L32A5
al 0032A9 .L32A9
al 003298 .L3298
al 0032EF .GETSPA
al 00327E .STRSPA
al 003270 .LD353
al 003C6B .FOUT1
al 00324A .L324A
al 003A4C .STORE_FAC_AT_YX_ROUNDED
al 003219 .L3219
al 003250 .L3250
al 0031E0 .FNC
al 0031AF .L31AF
al 0031A4 .SNGFLT
al 003ABC .FLOAT1
al 003188 .L3188
al 00317C .L317C
al 003163 .L3163
al 003159 .MULTIPLY_SUBS1
al 00313B .L313B
al 003135 .L3135
al 003124 .L3124
al 003113 .FAE3
al 00310C .GSE
al 003112 .FAE2
al 0030F6 .L30F6
al 00314F .RTS9
al 0030CC .L30CC
al 0030D1 .L30D1
al 0030BD .L30BD
al 00310F .GME
al 003150 .MULTIPLY_SUBSCRIPT
al 00309A .L309A
al 00308A .L308A
al 003081 .L3081
al 003078 .L3078
al 0030EE .FIND_ARRAY_ELEMENT
al 00304D .JER
al 003048 .SUBERR
al 003050 .USE_OLD_ARRAY
al 00303A .L303A
al 003064 .MAKE_NEW_ARRAY
al 00302B .L302B
al 00301F .L301F
al 002FDE .L2FDE
al 003B13 .QINT
al 002FD1 .MI2
al 002FCF .MI1
al 002FBE .MKINT
al 002FB8 .MAKINT
al 002FB4 .NEG32768
al 002FAF .L2FAF
al 002FA3 .GETARY
al 002F9E .L2F9E
al 002F68 .L2F68
al 002F50 .C_ZERO
al 002F4B .LD015
al 002F52 .MAKENEWVARIABLE
al 002F3C .L2F3C
al 002F94 .SET_VARPNT_AND_YA
al 002F29 .L2F29
al 002F3D .NAMENOTFOUND
al 002F1B .L2F1B
al 002F11 .L2F11
al 002F0F .L2F0F
al 002FD4 .ARRAY
al 002F05 .L2F05
al 002EF9 .L2EF9
al 002EF2 .L2EF2
al 002EE2 .L2EE2
al 002ECE .L2ECE
al 002ED8 .L2ED8
al 002ECD .L2ECD
al 002EBA .SYNERR3
al 002EBD .NAMOK
al 002EB0 .PTRGET3
al 002EAE .PTRGET2
al 002E9C .NXDIM
al 003AB4 .FLOAT
al 002E99 .L2E99
al 002E90 .CMPDONE
al 002E84 .L2E84
al 002E79 .STRCMP1
al 002E74 .L2E74
al 0034A1 .FRETMP
al 002E7F .NUMCMP
al 003AD3 .FCOMP
al 002E4C .STRCMP
al 003A74 .COPY_ARG_TO_FAC
al 002DF4 .L2DF4
al 002DEF .L2DEF
al 002DC2 .L2DC2
al 002DB1 .L2DB1
al 002D88 .CHKCLS
al 002D8B .CHKOPN
al 002DC5 .UNARY
al 002D82 .PARCHK
al 0031F3 .L31F3
al 002D7B .L2D7B
al 003195 .GIVAYF
al 002DA0 .EQUL
al 002D74 .L2D74
al 002D57 .L2D57
al 002D5D .NOT_
al 002D9E .MIN
al 002DA5 .FRM_VARIABLE
al 002F33 .ISLETC
al 002D36 .L2D36
al 002D39 .L2D39
al 002D31 .L2D31
al 002D0E .L2D0E
al 002D2A .EXIT
al 002CDD .FRM_STACK1
al 002CBB .L2CBB
al 002D10 .FRM_PERFORM2
al 002D05 .GOEX
al 002CC3 .PREFNC
al 002CCA .FRM_RECURSE
al 002CA4 .L2CA4
al 002CA3 .L2CA3
al 002D07 .FRM_PERFORM1
al 002C9A .FRM_PRECEDENCE_TEST
al 003434 .CAT
al 002C92 .L2C92
al 002D02 .L2D02
al 002CB1 .FRM_RELATIONAL
al 002CDA .SNTXERR
al 002C81 .L2C81
al 002C65 .L2C65
al 002C62 .FRMEVL2
al 002D2D .FRM_ELEMENT
al 002C53 .FRMEVL1
al 002C4E .L2C4E
al 002C40 .L2C40
al 002C43 .L2C43
al 002C41 .L2C41
al 002C39 .CHKSTR
al 002C1F .L2C1F
al 002C22 .L2C22
al 003AD5 .FCOMP2
al 003653 .FADD
al 002C45 .JERROR
al 002BDC .NEXT3
al 002BCF .NEXT2
al 002BCC .NEXT1
al 002BA2 .ERREXTRA
al 002BA1 .L2BA1
al 002B94 .L2B94
al 002BDA .GERR
al 002B7C .L2B7C
al 002D8E .CHKCOM
al 002B89 .INPDONE
al 002B48 .L2B48
al 003B6B .FIN
al 002B3C .INPUT_MORE
al 0035DA .POINT
al 00328E .STRLT2
al 002B28 .L2B28
al 002B1D .L2B1D
al 002B1C .L2B1C
al 002B10 .L2B10
al 002B34 .L2B34
al 002AF5 .LCB64
al 002B63 .FINDATA
al 002AF8 .L2AF8
al 002AF0 .L2AF0
al 002AFC .INSTART
al 002AC5 .PROCESS_INPUT_ITEM
al 002AB6 .LCB21
al 002ABE .L2ABE
al 002AB0 .NXIN
al 002AA5 .LCAF8
al 002D4E .STRTXT
al 002A9E .L2A9E
al 002ABF .PROCESS_INPUT_LIST
al 0031A8 .ERRDIR
al 002A7D .RTS20
al 002BB3 .ERRREENTRY
al 002A6B .SYNERR4
al 002A67 .L2A67
al 002A63 .L2A63
al 002A6E .RESPERR
al 002A59 .INPUTERR
al 002A58 .LE8F2
al 002A4C .L2A4C
al 002A43 .LCA6A
al 002A4E .L2A4E
al 002A56 .L2A56
al 002A22 .L2A22
al 00349D .FREFAC
al 002A13 .L2A13
al 002A0A .L2A0A
al 002A09 .L2A09
al 003592 .GTBYTC
al 002A08 .L2A08
al 0029EB .L29EB
al 0029EA .L29EA
al 0029D3 .L29D3
al 0029D9 .L29D9
al 0029CB .PRINTNULLS
al 0029C6 .CRDO2
al 002A35 .OUTSP
al 0029B1 .L29B1
al 003288 .STRLIT
al 003C69 .FOUT
al 002A0D .L2A0D
al 0029DE .L29DE
al 0029F5 .L29F5
al 0029DD .L29DD
al 002983 .PRINT2
al 00297E .L297E
al 002A1B .STRPRT
al 00297B .PRSTRING
al 0034D2 .FRETMS
al 003471 .MOVINS
al 003276 .STRINI
al 002963 .L2963
al 00294D .L294D
al 002938 .L2938
al 002946 .L2946
al 002927 .PUTSTR
al 003A48 .SETFOR
al 002FC2 .AYINT
al 003A93 .ROUND_FAC
al 002923 .L2923
al 00290F .LET2
al 002926 .LETSTRING
al 002C3A .CHKVAL
al 002EA9 .PTRGET
al 0028EC .L28EC
al 0028BE .L28BE
al 0028B7 .L28B7
al 0028AC .L28AC
al 0028A0 .L28A0
al 0028A4 .L28A4
al 002895 .L2895
al 00288D .L288D
al 002884 .L2884
al 002C48 .FRMEVL
al 002866 .L2866
al 00285E .L285E
al 002852 .L2852
al 002848 .ADDON
al 002835 .SYNERR2
al 002838 .RETURN
al 00281E .L281E
al 002830 .UNDERR
al 00280D .L280D
al 002809 .L2809
al 002856 .REMN
al 0027E9 .L27E9
al 0027CF .L27CF
al 0027C2 .L27C2
al 0027A6 .L27A6
al 002769 .QT_LOADED
al 002770 .QT_SAVED
al 002739 .L2739
al 003595 .GETBYT
al 00271C .L271C
al 00270E .L270E
al 0026F7 .CONTROL_C_TYPED
al 0026FF .END4
al 00272A .RET1
al 0026EB .END2
al 0026D5 .SETDA
al 002D99 .SYNERR
al 0026C8 .SYNERR1
al 0026C1 .LET1
al 0026AC .EXECUTE_STATEMENT1
al 0026D9 .RET2
al 0026AA .EXECUTE_STATEMENT
al 002701 .L2701
al 0026C4 .COLON
al 002681 .LC6D4
al 002683 .L2683
al 002674 .NEWSTT
al 002CE2 .FRM_STACK2
al 003AA3 .SIGN
al 002665 .L2665
al 003A1A .LOAD_FAC_FROM_YA
al 003802 .CON_ONE
al 002CED .FRM_STACK3
al 002651 .STEP
al 002C34 .FRMNUM
al 002C37 .CHKNUM
al 002D90 .SYNCHR
al 002853 .DATAN
al 002619 .L2619
al 0025F5 .L25F5
al 0025FD .L25FD
al 0025F2 .L25F2
al 0025E8 .L25E8
al 0025CE .L25CE
al 0025CA .L25CA
al 003C59 .LINPRT
al 0025C3 .L25C3
al 0025C1 .L25C1
al 0026DA .ISCNTC
al 0025E5 .L25E5
al 0025A6 .L25A6X
al 0025A6 .L25A6
al 002598 .L2598
al 002581 .L2581
al 00253E .CLEARC
al 00256A .L256A
al 00256B .STXTPT
al 002523 .SCRTCH
al 002516 .L2516
al 00250D .L250D
al 002520 .L2520
al 00251F .L251F
al 0024F6 .FL1
al 0024DB .L24DB
al 0024C8 .L24C8
al 0024C1 .L24C1
al 0024BF .L24BF
al 0024EA .L24EA
al 0024AA .L24AA
al 0024D7 .L24D7
al 002498 .L2498
al 002497 .L2497
al 002496 .L2496
al 00248C .L248C
al 002484 .L2484
al 0024D0 .L24D0
al 0024AC .L24AC
al 00246C .L246C
al 002465 .L2465
al 0029B9 .L29B9
al 00244C .L244C
al 002453 .L2453
al 002443 .L2443
al 002456 .GETLN
al 002423 .L2423
al 002428 .INLIN2
al 002420 .L2420
al 002405 .L2405
al 0023FA .L23FA
al 002537 .SETPTRS
al 0023E6 .L23E6
al 0023D6 .L23D6
al 0023EE .FIX_LINKS
al 0023AD .L23AD
al 0023A5 .L23A5
al 0023BB .PUT_NEW_LINE
al 0024F2 .FNDLIN
al 0028B8 .LINGET
al 0026A1 .NEWSTT2
al 002466 .PARSE_INPUT_LINE
al 00236A .NUMBERED_LINE
al 002426 .INLIN
al 002351 .L2351
al 003C4E .INPRT
al 002348 .RESTART
al 002A18 .STROUT
al 00233D .PRINT_ERROR_LINNUM
al 002555 .STKINI
al 002A3A .OUTDO
al 002329 .L2329
al 002A38 .OUTQUES
al 0029BF .CRDO
al 002321 .ERROR
al 00230B .L230B
al 003321 .GARBAG
al 002300 .L2300
al 0022FC .L22FC
al 00231E .L231E
al 00231F .MEMERR
al 0022E5 .CHKMEM
al 0022D2 .L22D2
al 0022D6 .L22D6
al 0022C6 .L22C6
al 0022DD .L22DD
al 0022A9 .BLTU2
al 0022F2 .REASON
al 0022A2 .BLTU
al 00229A .L229A
al 00228E .L228E
al 0022A1 .L22A1
al 002279 .L2279
al 002274 .GTFORPNT
al 00226C .QT_BREAK
al 002265 .QT_OK
al 002260 .QT_IN
al 002259 .QT_ERROR
al 0000E0 .ERR_UNDEFFN
al 0000D2 .ERR_CANTCONT
al 0000BF .ERR_FRMCPX
al 0000B0 .ERR_STRLONG
al 0000A3 .ERR_BADTYPE
al 000095 .ERR_ILLDIR
al 000085 .ERR_ZERODIV
al 000078 .ERR_REDIMD
al 00006B .ERR_BADSUBS
al 00005A .ERR_UNDEFSTAT
al 00004D .ERR_MEMFULL
al 000045 .ERR_OVERFLOW
al 000035 .ERR_ILLQTY
al 00002A .ERR_NODATA
al 000016 .ERR_NOGOSUB
al 000010 .ERR_SYNTAX
al 000000 .ERR_NOFOR
al 002169 .ERROR_MESSAGES
al 002E34 .RELOPS
al 002D65 .EQUOP
al 003E05 .NEGOP
al 002E04 .OR
al 002E07 .TAND
al 003DCC .FPWRT
al 00398A .FDIVT
al 003871 .FMULTT
al 00363F .FSUBT
al 003656 .FADDT
al 002068 .MATHTBL
al 00352E .MIDSTR
al 003523 .RIGHTSTR
al 0000C2 .TOKEN_LEFTSTR
al 0034F7 .LEFTSTR
al 0034E3 .CHRSTR
al 003582 .ASC
al 0035A4 .VAL
al 003266 .STR
al 003573 .LEN
al 003605 .PEEK
al 003FD3 .ATN
al 002054 .UNFNC_ATN
al 003F6F .TAN
al 002052 .UNFNC_TAN
al 003F26 .SIN
al 002050 .UNFNC_SIN
al 003F1F .COS
al 00204E .UNFNC_COS
al 003E3E .EXP
al 003830 .LOG
al 003EE3 .RND
al 003DC2 .SQR
al 0031A2 .POS
al 003181 .FRE
al 00304B .IQERR
al 003AD0 .ABS
al 003B44 .INT
al 0000AE .TOKEN_SGN
al 003AB1 .SGN
al 00203A .UNFNC
al 0000AC .TOKEN_EQUAL
al 0000AB .TOKEN_GREATER
al 0000A5 .TOKEN_MINUS
al 0000A4 .TOKEN_PLUS
al 0000A3 .TOKEN_STEP
al 0000A2 .TOKEN_NOT
al 0000A1 .TOKEN_THEN
al 0000A0 .TOKEN_SPC
al 00009F .TOKEN_FN
al 00009E .TOKEN_TO
al 00009D .TOKEN_TAB
al 00001D .NUM_TOKENS
al 002521 .NEW
al 002A7E .GET
al 00253C .CLEAR
al 002579 .LIST
al 002711 .CONT
al 000097 .TOKEN_PRINT
al 002981 .PRINT
al 003610 .POKE
al 0031B2 .DEF
al 00273C .SAVE
al 00278C .LOAD
al 003619 .WAIT
al 00272B .NULL
al 002898 .ON
al 0026E8 .STOP
al 00008E .TOKEN_REM
al 002888 .REM
al 00281F .POP
al 00008C .TOKEN_GOSUB
al 0027D5 .GOSUB
al 0026CB .RESTORE
al 002875 .IF
al 0027CA .RUN
al 000088 .TOKEN_GOTO
al 0027F2 .GOTO
al 0028F2 .LET
al 002AB9 .READ
al 002E9F .DIM
al 002A8D .INPUT
al 002845 .DATA
al 002BC6 .NEXT
al 002608 .FOR
al 0026EA .END
al 000000 .DUMMY_START
al 002086 .TOKEN_NAME_TABLE
al 002000 .TOKEN_ADDRESS_TABLE
al 004059 .GENERIC_RNDSEED
al 00404E .GENERIC_CHRGOT2
al 004047 .GENERIC_CHRGOT
al 004041 .GENERIC_CHRGET
al 0000C0 .CHRGET
al 0000BE .STRNG2
al 0000BC .STRNG1
al 0000BB .ARGSIGN
al 0000B6 .ARG
al 0000B5 .SHIFTSIGNEXT
al 0000B4 .SERLEN
al 0000B3 .FACSIGN
al 0000AE .FAC
al 0000AD .EXPSGN
al 0000AC .LOWTRX
al 0000AC .LOWTR
al 0000AB .EXPON
al 0000AA .TMPEXP
al 0000AA .INDX
al 0000A9 .TEMP2
al 0000A7 .HIGHTR
al 0000A5 .HIGHDS
al 0000A4 .TEMP1
al 0000A3 .ARGEXTENSION
al 0000A2 .Z52
al 0000A1 .JMPADRS
al 0000A0 .DSCLEN
al 00009D .DSCPTR
al 00009B .TEMP3
al 00009B .FNCNAM
al 00009A .CPRTYP
al 000098 .LASTOP
al 000096 .FORPNT
al 000094 .VARPNT
al 000092 .VARNAM
al 000090 .INPTR
al 00008E .DATPTR
al 00008C .Z8C
al 00008A .OLDTEXT
al 000088 .OLDLIN
al 000086 .CURLIN
al 000084 .MEMSIZ
al 000082 .FRESPC
al 000080 .FRETOP
al 00007E .STREND
al 00007C .ARYTAB
al 00007A .VARTAB
al 000078 .TXTTAB
al 000073 .RESULT
al 000071 .DEST
al 00006F .INDEX
al 000066 .TEMPST
al 000064 .LASTPT
al 000063 .TEMPPT
al 000014 .Z14
al 000013 .CPRMASK
al 000012 .INPUTFLG
al 000011 .SUBFLG
al 000010 .DATAFLG
al 00000E .VALTYP
al 00000D .DIMFLG
al 00000C .EOLPNTR
al 00000B .ENDCHR
al 00000A .CHARAC
al 000019 .TXPSV
al 000019 .LINNUM
al 000018 .Z18
al 000017 .Z17
al 000016 .POSX
al 000015 .Z15
al 000008 .GOGIVEAYF
al 000006 .GOAYINT
al 000003 .GOSTROUT
al 000000 .GORESTART
al 00000A .CRLF_2
al 00000D .CRLF_1
al 00001B .INPUTBUFFER
al 000100 .STACK
al 000009 .FOR_STACK2
al 00000F .FOR_STACK1
al 000012 .BYTES_PER_FRAME
al 000004 .MANTISSA_BYTES
al 000007 .BYTES_PER_VARIABLE
al 000005 .BYTES_PER_ELEMENT
al 000005 .BYTES_FP
al 000001 .CONFIG_10A
al 000001 .CONFIG_11
al 001EA0 .MONCOUT
al 001E5A .MONRDKEY
al 001873 .L1873
al 001800 .L1800
al 000038 .WIDTH2
al 000048 .WIDTH
al 0000F2 .NULL_MAX
al 000036 .SPACE_FOR_GOSUB
al 0000FC .STACK_TOP
al 000002 .CONFIG_SCRTCH_ORDER
al 000001 .CONFIG_SAFE_NAMENOTFOUND
al 000001 .CONFIG_ROR_WORKAROUND
al 000001 .CONFIG_RAM
al 000001 .CONFIG_PRINT_CR
al 000001 .CONFIG_NULL
al 000001 .CONFIG_MONCOUT_DESTROYS_Y
al 000001 .CONFIG_11A
al 000001 .KIM
Raw
msbasic.lst
ca65 V2.13.9 - (C) Copyright 1998-2005 Ullrich von Bassewitz
Main file : msbasic.s
Current file: msbasic.s
000000r 1 ; Microsoft BASIC for 6502
000000r 1 ;
000000r 1 ; (first revision of this distribution, 20 Oct 2008, Michael Steil www.pagetable.com)
000000r 1 ;
000000r 1 ; This is a single integrated assembly source tree that can generate seven different versions of
000000r 1 ; Microsoft BASIC for 6502.
000000r 1 ;
000000r 1 ; By running ./make.sh, this will generate all versions and compare them to the original files
000000r 1 ; byte by byte. The CC65 compiler suite is need to build this project.
000000r 1 ;
000000r 1 ; These are the first eight (known) versions of Microsoft BASIC for 6502:
000000r 1 ;
000000r 1 ; Name Release MS Version ROM 9digit INPUTBUFFER extensions .define
000000r 1 ;---------------------------------------------------------------------------------------------------
000000r 1 ; Commodore BASIC 1 1977 Y Y ZP CBM
000000r 1 ; OSI BASIC 1977 1.0 REV 3.2 Y N ZP - CONFIG_10A
000000r 1 ; AppleSoft I 1977 1.1 N Y $0200 Apple CONFIG_11
000000r 1 ; KIM BASIC 1977 1.1 N Y ZP - CONFIG_11A
000000r 1 ; AppleSoft II 1978 Y Y $0200 Apple CONFIG_2
000000r 1 ; Commodore BASIC 2 1979 Y Y $0200 CBM CONFIG_2A
000000r 1 ; KBD BASIC 1982 Y N $0700 KBD CONFIG_2B
000000r 1 ; MicroTAN 1980 Y Y ZP - CONFIG_2C
000000r 1 ;
000000r 1 ; (Note that this assembly source cannot (yet) build AppleSoft II.)
000000r 1 ;
000000r 1 ; This lists the versions in the order in which they were forked from the Microsoft source base.
000000r 1 ; Commodore BASIC 1, as used on the original PET is the oldest known version of Microsoft BASIC
000000r 1 ; for 6502. It contains some additions to Microsoft's version, like Commodore-style file I/O.
000000r 1 ;
000000r 1 ; The CONFIG_n defines specify what Microsoft-version the OEM version is based on. If CONFIG_2B
000000r 1 ; is defined, for example, CONFIG_2A, CONFIG_2, CONFIG_11A, CONFIG_11 and CONFIG_10A will be
000000r 1 ; defined as well, and all bugfixes up to version 2B will be enabled.
000000r 1 ;
000000r 1 ; The following symbols can be defined in addition:
000000r 1 ;
000000r 1 ; CONFIG_CBM1_PATCHES jump out into CBM1's binary patches instead of doing the right thing inline
000000r 1 ; CONFIG_CBM_ALL add all Commodore-specific additions except file I/O
000000r 1 ; CONFIG_DATAFLG ?
000000r 1 ; CONFIG_EASTER_EGG include the CBM2 "WAIT 6502" easter egg
000000r 1 ; CONFIG_FILE support Commodore PRINT#, INPUT#, GET#, CMD
000000r 1 ; CONFIG_IO_MSB all I/O has bit #7 set
000000r 1 ; CONFIG_MONCOUT_DESTROYS_Y Y needs to be preserved when calling MONCOUT
000000r 1 ; CONFIG_NO_CR terminal doesn't need explicit CRs on line ends
000000r 1 ; CONFIG_NO_LINE_EDITING disable support for Microsoft-style "@", "_", BEL etc.
000000r 1 ; CONFIG_NO_POKE don't support PEEK, POKE and WAIT
000000r 1 ; CONFIG_NO_READ_Y_IS_ZERO_HACK don't do a very volatile trick that saves one byte
000000r 1 ; CONFIG_NULL support for the NULL statement
000000r 1 ; CONFIG_PEEK_SAVE_LINNUM preserve LINNUM on a PEEK
000000r 1 ; CONFIG_PRINTNULLS whether PRINTNULLS does anything
000000r 1 ; CONFIG_PRINT_CR print CR when line end reached
000000r 1 ; CONFIG_RAM optimizations for RAM version of BASIC, only use on 1.x
000000r 1 ; CONFIG_ROR_WORKAROUND use workaround for buggy 6502s from 1975/1976; not safe for CONFIG_SMALL!
000000r 1 ; CONFIG_SAFE_NAMENOTFOUND check both bytes of the caller's address in NAMENOTFOUND
000000r 1 ; CONFIG_SCRTCH_ORDER where in the init code to call SCRTCH
000000r 1 ; CONFIG_SMALL use 6 digit FP instead of 9 digit, use 2 character error messages, don't have GET
000000r 1 ;
000000r 1 ; Changing symbol definitions can alter an existing base configuration, but it not guaranteed to assemble
000000r 1 ; or work correctly.
000000r 1 ;
000000r 1 ; Credits:
000000r 1 ; * main work by Michael Steil
000000r 1 ; * function names and all uppercase comments taken from Bob Sander-Cederlof's excellent AppleSoft II disassembly:
000000r 1 ; http://www.txbobsc.com/scsc/scdocumentor/
000000r 1 ; * Applesoft lite by Tom Greene http://cowgod.org/replica1/applesoft/ helped a lot, too.
000000r 1 ; * Thanks to Joe Zbicak for help with Intellision Keyboard BASIC
000000r 1 ; * This work is dedicated to the memory of my dear hacking pal Michael "acidity" Kollmann.
000000r 1
000000r 1 .debuginfo +
000000r 1
000000r 1 .setcpu "6502"
000000r 1 .macpack longbranch
000000r 1
000000r 1 .include "defines.s"
000000r 2 .if .def(cbmbasic1)
000000r 2 CBM1 := 1
000000r 2 .include "defines_cbm1.s"
000000r 2 .elseif .def(osi)
000000r 2 OSI := 1
000000r 2 .include "defines_osi.s"
000000r 2 .elseif .def(applesoft)
000000r 2 APPLE := 1
000000r 2 .include "defines_apple.s"
000000r 2 .elseif .def(kb9)
000000r 2 KIM := 1
000000r 2 .include "defines_kim.s"
000000r 3 ; configuration
000000r 3 CONFIG_11A := 1
000000r 3
000000r 3 CONFIG_MONCOUT_DESTROYS_Y := 1
000000r 3 CONFIG_NULL := 1
000000r 3 CONFIG_PRINT_CR := 1 ; print CR when line end reached
000000r 3 CONFIG_RAM := 1
000000r 3 CONFIG_ROR_WORKAROUND := 1
000000r 3 CONFIG_SAFE_NAMENOTFOUND := 1
000000r 3 CONFIG_SCRTCH_ORDER := 2
000000r 3
000000r 3 ; zero page
000000r 3 ZP_START1 = $00
000000r 3 ZP_START2 = $15
000000r 3 ZP_START3 = $0A
000000r 3 ZP_START4 = $63
000000r 3
000000r 3 ; constants
000000r 3 STACK_TOP := $FC
000000r 3 SPACE_FOR_GOSUB := $36
000000r 3 NULL_MAX := $F2 ; probably different in original version; the image I have seems to be modified; see PDF
000000r 3 WIDTH := 72
000000r 3 WIDTH2 := 56
000000r 3
000000r 3 ; magic memory locations
000000r 3 L1800 := $1800
000000r 3 L1873 := $1873
000000r 3
000000r 3 ; monitor functions
000000r 3 MONRDKEY := $1E5A
000000r 3 MONCOUT := $1EA0
000000r 3
000000r 3
000000r 2 .elseif .def(cbmbasic2)
000000r 2 CBM2 := 1
000000r 2 .include "defines_cbm2.s"
000000r 2 .elseif .def(kbdbasic)
000000r 2 KBD := 1
000000r 2 .include "defines_kbd.s"
000000r 2 .elseif .def(microtan)
000000r 2 MICROTAN := 1
000000r 2 .include "defines_microtan.s"
000000r 2 .endif
000000r 2
000000r 2 .ifdef CONFIG_2C
000000r 2 CONFIG_2B := 1
000000r 2 .endif
000000r 2 .ifdef CONFIG_2B
000000r 2 CONFIG_2A := 1
000000r 2 .endif
000000r 2 .ifdef CONFIG_2A
000000r 2 CONFIG_2 := 1
000000r 2 .endif
000000r 2 .ifdef CONFIG_2
000000r 2 CONFIG_11A := 1
000000r 2 .endif
000000r 2 .ifdef CONFIG_11A
000000r 2 CONFIG_11 := 1
000000r 2 .endif
000000r 2 .ifdef CONFIG_11
000000r 2 CONFIG_10A := 1
000000r 2 .endif
000000r 2
000000r 2 .ifdef CONFIG_SMALL
000000r 2 BYTES_FP := 4
000000r 2 .else
000000r 2 BYTES_FP := 5
000000r 2 .endif
000000r 2
000000r 2 .ifndef BYTES_PER_ELEMENT
000000r 2 BYTES_PER_ELEMENT := BYTES_FP
000000r 2 .endif
000000r 2 BYTES_PER_VARIABLE := BYTES_FP+2
000000r 2 MANTISSA_BYTES := BYTES_FP-1
000000r 2 BYTES_PER_FRAME := 2*BYTES_FP+8
000000r 2 FOR_STACK1 := 2*BYTES_FP+5
000000r 2 FOR_STACK2 := BYTES_FP+4
000000r 2
000000r 2 .ifndef MAX_EXPON
000000r 2 MAX_EXPON = 10
000000r 2 .endif
000000r 2
000000r 2 STACK := $0100
000000r 2
000000r 2 .ifdef INPUTBUFFER
000000r 2 .if INPUTBUFFER >= $0100
000000r 2 CONFIG_NO_INPUTBUFFER_ZP := 1
000000r 2 .endif
000000r 2 .if INPUTBUFFER = $0200
000000r 2 CONFIG_INPUTBUFFER_0200 := 1
000000r 2 .endif
000000r 2 .endif
000000r 2 INPUTBUFFERX = INPUTBUFFER & $FF00
000000r 2
000000r 2 CR=13
000000r 2 LF=10
000000r 2
000000r 2 .ifndef CRLF_1
000000r 2 CRLF_1 := CR
000000r 2 CRLF_2 := LF
000000r 2 .endif
000000r 2
000000r 2
000000r 2
000000r 2
000000r 1 .include "macros.s"
000000r 2 ; htasc - set the hi bit on the last byte of a string for termination
000000r 2 ; (by Tom Greene)
000000r 2 .macro htasc str
000000r 2 .repeat .strlen(str)-1,I
000000r 2 .byte .strat(str,I)
000000r 2 .endrep
000000r 2 .byte .strat(str,.strlen(str)-1) | $80
000000r 2 .endmacro
000000r 2
000000r 2 ; For every token, a byte gets put into segment "DUMMY".
000000r 2 ; This way, we count up with every token. The DUMMY segment
000000r 2 ; doesn't get linked into the binary.
000000r 2 .macro init_token_tables
000000r 2 .segment "VECTORS"
000000r 2 TOKEN_ADDRESS_TABLE:
000000r 2 .segment "KEYWORDS"
000000r 2 TOKEN_NAME_TABLE:
000000r 2 .segment "DUMMY"
000000r 2 DUMMY_START:
000000r 2 .endmacro
000000r 2
000000r 2 ; optionally define token symbol
000000r 2 ; count up token number
000000r 2 .macro define_token token
000000r 2 .segment "DUMMY"
000000r 2 .ifnblank token
000000r 2 token := <(*-DUMMY_START)+$80
000000r 2 .endif
000000r 2 .res 1; count up in any case
000000r 2 .endmacro
000000r 2
000000r 2 ; lay down a keyword, optionally define a token symbol
000000r 2 .macro keyword key, token
000000r 2 .segment "KEYWORDS"
000000r 2 htasc key
000000r 2 define_token token
000000r 2 .endmacro
000000r 2
000000r 2 ; lay down a keyword and an address (RTS style),
000000r 2 ; optionally define a token symbol
000000r 2 .macro keyword_rts key, vec, token
000000r 2 .segment "VECTORS"
000000r 2 .word vec-1
000000r 2 keyword key, token
000000r 2 .endmacro
000000r 2
000000r 2 ; lay down a keyword and an address,
000000r 2 ; optionally define a token symbol
000000r 2 .macro keyword_addr key, vec, token
000000r 2 .segment "VECTORS"
000000r 2 .addr vec
000000r 2 keyword key, token
000000r 2 .endmacro
000000r 2
000000r 2 .macro count_tokens
000000r 2 .segment "DUMMY"
000000r 2 NUM_TOKENS := <(*-DUMMY_START)
000000r 2 .endmacro
000000r 2
000000r 2 .macro init_error_table
000000r 2 .segment "ERROR"
000000r 2 ERROR_MESSAGES:
000000r 2 .endmacro
000000r 2
000000r 2 .macro define_error error, msg
000000r 2 .segment "ERROR"
000000r 2 error := <(*-ERROR_MESSAGES)
000000r 2 htasc msg
000000r 2 .endmacro
000000r 2
000000r 2 ;---------------------------------------------
000000r 2 ; set the MSB of every byte of a string
000000r 2 .macro asc80 str
000000r 2 .repeat .strlen(str),I
000000r 2 .byte .strat(str,I)+$80
000000r 2 .endrep
000000r 2 .endmacro
000000r 2
000000r 2
000000r 1 .include "zeropage.s"
000000r 2
000000r 2 .feature org_per_seg
000000r 2 .zeropage
000000r 2
000000r 2 .org ZP_START1
000000 2
000000 2 GORESTART:
000000 2 xx xx xx .res 3
000003 2 GOSTROUT:
000003 2 xx xx xx .res 3
000006 2 GOAYINT:
000006 2 xx xx .res 2
000008 2 GOGIVEAYF:
000008 2 xx xx .res 2
00000A 2
00000A 2 .org ZP_START2
000015 2 Z15:
000015 2 xx .res 1
000016 2 .ifndef POSX; allow override
000016 2 POSX:
000016 2 .endif
000016 2 xx .res 1
000017 2 .ifndef Z17; allow override
000017 2 Z17:
000017 2 .endif
000017 2 xx .res 1
000018 2 .ifndef Z18; allow override
000018 2 Z18:
000018 2 .endif
000018 2 xx .res 1
000019 2 LINNUM:
000019 2 .ifndef TXPSV; allow override
000019 2 TXPSV:
000019 2 .endif
000019 2 xx xx .res 2
00001B 2 .ifndef INPUTBUFFER; allow override
00001B 2 INPUTBUFFER:
00001B 2 .endif
00001B 2
00001B 2 .org ZP_START3
00000A 2
00000A 2 CHARAC:
00000A 2 xx .res 1
00000B 2 ENDCHR:
00000B 2 xx .res 1
00000C 2 EOLPNTR:
00000C 2 xx .res 1
00000D 2 DIMFLG:
00000D 2 xx .res 1
00000E 2 VALTYP:
00000E 2 .ifdef CONFIG_SMALL
00000E 2 .res 1
00000E 2 .else
00000E 2 xx xx .res 2
000010 2 .endif
000010 2 DATAFLG:
000010 2 xx .res 1
000011 2 SUBFLG:
000011 2 xx .res 1
000012 2 INPUTFLG:
000012 2 xx .res 1
000013 2 CPRMASK:
000013 2 xx .res 1
000014 2 Z14:
000014 2 xx .res 1
000015 2
000015 2 .org ZP_START4
000063 2
000063 2 TEMPPT:
000063 2 xx .res 1
000064 2 LASTPT:
000064 2 xx xx .res 2
000066 2 TEMPST:
000066 2 xx xx xx xx .res 9
00006A 2 xx xx xx xx
00006E 2 xx
00006F 2 INDEX:
00006F 2 xx xx .res 2
000071 2 DEST:
000071 2 xx xx .res 2
000073 2 RESULT:
000073 2 xx xx xx xx .res BYTES_FP
000077 2 xx
000078 2 RESULT_LAST = RESULT + BYTES_FP-1
000078 2 TXTTAB:
000078 2 xx xx .res 2
00007A 2 VARTAB:
00007A 2 xx xx .res 2
00007C 2 ARYTAB:
00007C 2 xx xx .res 2
00007E 2 STREND:
00007E 2 xx xx .res 2
000080 2 FRETOP:
000080 2 xx xx .res 2
000082 2 FRESPC:
000082 2 xx xx .res 2
000084 2 MEMSIZ:
000084 2 xx xx .res 2
000086 2 CURLIN:
000086 2 xx xx .res 2
000088 2 OLDLIN:
000088 2 xx xx .res 2
00008A 2 OLDTEXT:
00008A 2 xx xx .res 2
00008C 2 Z8C:
00008C 2 xx xx .res 2
00008E 2 DATPTR:
00008E 2 xx xx .res 2
000090 2 INPTR:
000090 2 xx xx .res 2
000092 2 VARNAM:
000092 2 xx xx .res 2
000094 2 VARPNT:
000094 2 xx xx .res 2
000096 2 FORPNT:
000096 2 xx xx .res 2
000098 2 LASTOP:
000098 2 xx xx .res 2
00009A 2 CPRTYP:
00009A 2 xx .res 1
00009B 2 FNCNAM:
00009B 2 TEMP3:
00009B 2 xx xx .res 2
00009D 2 DSCPTR:
00009D 2 .ifdef CONFIG_SMALL
00009D 2 .res 2
00009D 2 .else
00009D 2 xx xx xx .res 3
0000A0 2 .endif
0000A0 2 DSCLEN:
0000A0 2 xx xx .res 2
0000A2 2 .ifndef JMPADRS ; allow override
0000A2 2 JMPADRS := DSCLEN + 1
0000A2 2 .endif
0000A2 2 Z52:
0000A2 2 xx .res 1
0000A3 2 ARGEXTENSION:
0000A3 2 .ifndef CONFIG_SMALL
0000A3 2 xx .res 1
0000A4 2 .endif
0000A4 2 TEMP1:
0000A4 2 xx .res 1
0000A5 2 HIGHDS:
0000A5 2 xx xx .res 2
0000A7 2 HIGHTR:
0000A7 2 xx xx .res 2
0000A9 2 .ifndef CONFIG_SMALL
0000A9 2 TEMP2:
0000A9 2 xx .res 1
0000AA 2 .endif
0000AA 2 INDX:
0000AA 2 TMPEXP:
0000AA 2 .ifdef CONFIG_SMALL
0000AA 2 TEMP2:
0000AA 2 .endif
0000AA 2 xx .res 1
0000AB 2 EXPON:
0000AB 2 xx .res 1
0000AC 2 LOWTR:
0000AC 2 .ifndef LOWTRX ; allow override
0000AC 2 LOWTRX:
0000AC 2 .endif
0000AC 2 xx .res 1
0000AD 2 EXPSGN:
0000AD 2 xx .res 1
0000AE 2 FAC:
0000AE 2 xx xx xx xx .res BYTES_FP
0000B2 2 xx
0000B3 2 FAC_LAST = FAC + BYTES_FP-1
0000B3 2 FACSIGN:
0000B3 2 xx .res 1
0000B4 2 SERLEN:
0000B4 2 xx .res 1
0000B5 2 SHIFTSIGNEXT:
0000B5 2 xx .res 1
0000B6 2 ARG:
0000B6 2 xx xx xx xx .res BYTES_FP
0000BA 2 xx
0000BB 2 ARG_LAST = ARG + BYTES_FP-1
0000BB 2 ARGSIGN:
0000BB 2 xx .res 1
0000BC 2 STRNG1:
0000BC 2 xx xx .res 2
0000BE 2 SGNCPR = STRNG1
0000BE 2 FACEXTENSION = STRNG1+1
0000BE 2 STRNG2:
0000BE 2 xx xx .res 2
0000C0 2 CHRGET:
0000C0 2 TXTPTR = <(GENERIC_TXTPTR-GENERIC_CHRGET + CHRGET)
0000C0 2 CHRGOT = <(GENERIC_CHRGOT-GENERIC_CHRGET + CHRGET)
0000C0 2 CHRGOT2 = <(GENERIC_CHRGOT2-GENERIC_CHRGET + CHRGET)
0000C0 2 RNDSEED = <(GENERIC_RNDSEED-GENERIC_CHRGET + CHRGET)
0000C0 2
0000C0 2
0000C0 2
0000C0 1
0000C0 1 .include "header.s"
0000C0 2 .segment "HEADER"
000000r 2 .ifdef KBD
000000r 2 jmp LE68C
000000r 2 .byte $00,$13,$56
000000r 2 .endif
000000r 2
000000r 1 .include "token.s"
000000r 2 init_token_tables
000000r 2
000000r 2 rr rr 45 4E keyword_rts "END", END
000004r 2 C4 xx
000001r 2 rr rr 46 4F keyword_rts "FOR", FOR
000005r 2 D2 xx
000002r 2 rr rr 4E 45 keyword_rts "NEXT", NEXT
000006r 2 58 D4 xx
000003r 2 rr rr 44 41 keyword_rts "DATA", DATA
000007r 2 54 C1 xx
000004r 2 .ifdef CONFIG_FILE
000004r 2 keyword_rts "INPUT#", INPUTH
000004r 2 .endif
000004r 2 rr rr 49 4E keyword_rts "INPUT", INPUT
000008r 2 50 55 D4 xx
000005r 2 rr rr 44 49 keyword_rts "DIM", DIM
000009r 2 CD xx
000006r 2 rr rr 52 45 keyword_rts "READ", READ
00000Ar 2 41 C4 xx
000007r 2 .ifdef APPLE
000007r 2 keyword_rts "PLT", PLT
000007r 2 .else
000007r 2 rr rr 4C 45 keyword_rts "LET", LET
00000Br 2 D4 xx
000008r 2 .endif
000008r 2 rr rr 47 4F keyword_rts "GOTO", GOTO, TOKEN_GOTO
00000Cr 2 54 CF xx
000009r 2 rr rr 52 55 keyword_rts "RUN", RUN
00000Dr 2 CE xx
00000Ar 2 rr rr 49 C6 keyword_rts "IF", IF
00000Er 2 xx
00000Br 2 rr rr 52 45 keyword_rts "RESTORE", RESTORE
00000Fr 2 53 54 4F 52
000013r 2 C5 xx
00000Cr 2 rr rr 47 4F keyword_rts "GOSUB", GOSUB, TOKEN_GOSUB
000010r 2 53 55 C2 xx
00000Dr 2 rr rr 52 45 keyword_rts "RETURN", POP
000011r 2 54 55 52 CE
000015r 2 xx
00000Er 2 .ifdef APPLE
00000Er 2 keyword_rts "TEX", TEX, TOKEN_REM
00000Er 2 .else
00000Er 2 rr rr 52 45 keyword_rts "REM", REM, TOKEN_REM
000012r 2 CD xx
00000Fr 2 .endif
00000Fr 2 rr rr 53 54 keyword_rts "STOP", STOP
000013r 2 4F D0 xx
000010r 2 rr rr 4F CE keyword_rts "ON", ON
000014r 2 xx
000011r 2 .ifdef CONFIG_NULL
000011r 2 rr rr 4E 55 keyword_rts "NULL", NULL
000015r 2 4C CC xx
000012r 2 .endif
000012r 2 .ifdef KBD
000012r 2 keyword_rts "PLOD", PLOD
000012r 2 keyword_rts "PSAV", PSAV
000012r 2 keyword_rts "VLOD", VLOD
000012r 2 keyword_rts "VSAV", VSAV
000012r 2 .endif
000012r 2 .ifndef CONFIG_NO_POKE
000012r 2 rr rr 57 41 keyword_rts "WAIT", WAIT
000016r 2 49 D4 xx
000013r 2 .endif
000013r 2 .ifndef KBD
000013r 2 rr rr 4C 4F keyword_rts "LOAD", LOAD
000017r 2 41 C4 xx
000014r 2 rr rr 53 41 keyword_rts "SAVE", SAVE
000018r 2 56 C5 xx
000015r 2 .endif
000015r 2 .ifdef CONFIG_CBM_ALL
000015r 2 keyword_rts "VERIFY", VERIFY
000015r 2 .endif
000015r 2 rr rr 44 45 keyword_rts "DEF", DEF
000019r 2 C6 xx
000016r 2 .ifdef KBD
000016r 2 keyword_rts "SLOD", SLOD
000016r 2 .endif
000016r 2 .ifndef CONFIG_NO_POKE
000016r 2 rr rr 50 4F keyword_rts "POKE", POKE
00001Ar 2 4B C5 xx
000017r 2 .endif
000017r 2 .ifdef CONFIG_FILE
000017r 2 keyword_rts "PRINT#", PRINTH
000017r 2 .endif
000017r 2 rr rr 50 52 keyword_rts "PRINT", PRINT, TOKEN_PRINT
00001Br 2 49 4E D4 xx
000018r 2 rr rr 43 4F keyword_rts "CONT", CONT
00001Cr 2 4E D4 xx
000019r 2 rr rr 4C 49 keyword_rts "LIST", LIST
00001Dr 2 53 D4 xx
00001Ar 2 .ifdef CONFIG_CBM_ALL
00001Ar 2 keyword_rts "CLR", CLEAR
00001Ar 2 .else
00001Ar 2 rr rr 43 4C keyword_rts "CLEAR", CLEAR
00001Er 2 45 41 D2 xx
00001Br 2 .endif
00001Br 2 .ifdef CONFIG_FILE
00001Br 2 keyword_rts "CMD", CMD
00001Br 2 keyword_rts "SYS", SYS
00001Br 2 keyword_rts "OPEN", OPEN
00001Br 2 keyword_rts "CLOSE", CLOSE
00001Br 2 .endif
00001Br 2 .ifndef CONFIG_SMALL
00001Br 2 rr rr 47 45 keyword_rts "GET", GET
00001Fr 2 D4 xx
00001Cr 2 .endif
00001Cr 2 .ifdef KBD
00001Cr 2 keyword_rts "PRT", PRT
00001Cr 2 .endif
00001Cr 2 rr rr 4E 45 keyword_rts "NEW", NEW
000020r 2 D7 xx
00001Dr 2
00001Dr 2 count_tokens
00001Dr 2
00001Dr 2 54 41 42 A8 keyword "TAB(", TOKEN_TAB
000021r 2 xx
00001Er 2 54 CF xx keyword "TO", TOKEN_TO
00001Fr 2 46 CE xx keyword "FN", TOKEN_FN
000020r 2 53 50 43 A8 keyword "SPC(", TOKEN_SPC
000024r 2 xx
000021r 2 54 48 45 CE keyword "THEN", TOKEN_THEN
000025r 2 xx
000022r 2 4E 4F D4 xx keyword "NOT", TOKEN_NOT
000023r 2 53 54 45 D0 keyword "STEP", TOKEN_STEP
000027r 2 xx
000024r 2 AB xx keyword "+", TOKEN_PLUS
000025r 2 AD xx keyword "-", TOKEN_MINUS
000026r 2 AA xx keyword "*"
000027r 2 AF xx keyword "/"
000028r 2 .ifdef KBD
000028r 2 keyword "#"
000028r 2 .else
000028r 2 DE xx keyword "^"
000029r 2 .endif
000029r 2 41 4E C4 xx keyword "AND"
00002Ar 2 4F D2 xx keyword "OR"
00002Br 2 BE xx keyword ">", TOKEN_GREATER
00002Cr 2 BD xx keyword "=", TOKEN_EQUAL
00002Dr 2 BC xx keyword "<"
00002Er 2
00002Er 2 .segment "VECTORS"
00003Ar 2 UNFNC:
00003Ar 2
00003Ar 2 rr rr 53 47 keyword_addr "SGN", SGN, TOKEN_SGN
00003Er 2 CE xx
00002Fr 2 rr rr 49 4E keyword_addr "INT", INT
000033r 2 D4 xx
000030r 2 rr rr 41 42 keyword_addr "ABS", ABS
000034r 2 D3 xx
000031r 2 .ifdef KBD
000031r 2 keyword_addr "VER", VER
000031r 2 .endif
000031r 2 .ifndef CONFIG_NO_POKE
000031r 2 .ifdef CONFIG_RAM
000031r 2 rr rr 55 53 keyword_addr "USR", IQERR
000035r 2 D2 xx
000032r 2 .else
000032r 2 keyword_addr "USR", USR
000032r 2 .endif
000032r 2 .endif
000032r 2 rr rr 46 52 keyword_addr "FRE", FRE
000036r 2 C5 xx
000033r 2 rr rr 50 4F keyword_addr "POS", POS
000037r 2 D3 xx
000034r 2 rr rr 53 51 keyword_addr "SQR", SQR
000038r 2 D2 xx
000035r 2 rr rr 52 4E keyword_addr "RND", RND
000039r 2 C4 xx
000036r 2 rr rr 4C 4F keyword_addr "LOG", LOG
00003Ar 2 C7 xx
000037r 2 rr rr 45 58 keyword_addr "EXP", EXP
00003Br 2 D0 xx
000038r 2 .segment "VECTORS"
00004Er 2 UNFNC_COS:
00004Er 2 rr rr 43 4F keyword_addr "COS", COS
000052r 2 D3 xx
000039r 2 .segment "VECTORS"
000050r 2 UNFNC_SIN:
000050r 2 rr rr 53 49 keyword_addr "SIN", SIN
000054r 2 CE xx
00003Ar 2 .segment "VECTORS"
000052r 2 UNFNC_TAN:
000052r 2 rr rr 54 41 keyword_addr "TAN", TAN
000056r 2 CE xx
00003Br 2 .segment "VECTORS"
000054r 2 UNFNC_ATN:
000054r 2 rr rr 41 54 keyword_addr "ATN", ATN
000058r 2 CE xx
00003Cr 2 .ifdef KBD
00003Cr 2 keyword_addr "GETC", GETC
00003Cr 2 .endif
00003Cr 2 .ifndef CONFIG_NO_POKE
00003Cr 2 rr rr 50 45 keyword_addr "PEEK", PEEK
000040r 2 45 CB xx
00003Dr 2 .endif
00003Dr 2 rr rr 4C 45 keyword_addr "LEN", LEN
000041r 2 CE xx
00003Er 2 rr rr 53 54 keyword_addr "STR$", STR
000042r 2 52 A4 xx
00003Fr 2 rr rr 56 41 keyword_addr "VAL", VAL
000043r 2 CC xx
000040r 2 rr rr 41 53 keyword_addr "ASC", ASC
000044r 2 C3 xx
000041r 2 rr rr 43 48 keyword_addr "CHR$", CHRSTR
000045r 2 52 A4 xx
000042r 2 rr rr 4C 45 keyword_addr "LEFT$", LEFTSTR, TOKEN_LEFTSTR
000046r 2 46 54 A4 xx
000043r 2 rr rr 52 49 keyword_addr "RIGHT$", RIGHTSTR
000047r 2 47 48 54 A4
00004Br 2 xx
000044r 2 rr rr 4D 49 keyword_addr "MID$", MIDSTR
000048r 2 44 A4 xx
000045r 2 .ifdef CONFIG_2
000045r 2 keyword "GO", TOKEN_GO
000045r 2 .endif
000045r 2 .segment "KEYWORDS"
0000E2r 2 00 .byte 0
0000E3r 2
0000E3r 2 .segment "VECTORS"
000068r 2 MATHTBL:
000068r 2 79 .byte $79
000069r 2 rr rr .word FADDT-1
00006Br 2 79 .byte $79
00006Cr 2 rr rr .word FSUBT-1
00006Er 2 7B .byte $7B
00006Fr 2 rr rr .word FMULTT-1
000071r 2 7B .byte $7B
000072r 2 rr rr .word FDIVT-1
000074r 2 7F .byte $7F
000075r 2 rr rr .word FPWRT-1
000077r 2 50 .byte $50
000078r 2 rr rr .word TAND-1
00007Ar 2 46 .byte $46
00007Br 2 rr rr .word OR-1
00007Dr 2 7D .byte $7D
00007Er 2 rr rr .word NEGOP-1
000080r 2 5A .byte $5A
000081r 2 rr rr .word EQUOP-1
000083r 2 64 .byte $64
000084r 2 rr rr .word RELOPS-1
000086r 2
000086r 1 .include "error.s"
000086r 2 init_error_table
000000r 2
000000r 2 .ifdef CONFIG_SMALL
000000r 2 define_error ERR_NOFOR, "NF"
000000r 2 define_error ERR_SYNTAX, "SN"
000000r 2 define_error ERR_NOGOSUB, "RG"
000000r 2 define_error ERR_NODATA, "OD"
000000r 2 define_error ERR_ILLQTY, "FC"
000000r 2 define_error ERR_OVERFLOW, "OV"
000000r 2 define_error ERR_MEMFULL, "OM"
000000r 2 define_error ERR_UNDEFSTAT, "US"
000000r 2 define_error ERR_BADSUBS, "BS"
000000r 2 define_error ERR_REDIMD, "DD"
000000r 2 define_error ERR_ZERODIV, "/0"
000000r 2 define_error ERR_ILLDIR, "ID"
000000r 2 define_error ERR_BADTYPE, "TM"
000000r 2 define_error ERR_STRLONG, "LS"
000000r 2 define_error ERR_FRMCPX, "ST"
000000r 2 define_error ERR_CANTCONT, "CN"
000000r 2 define_error ERR_UNDEFFN, "UF"
000000r 2 .else
000000r 2 4E 45 58 54 define_error ERR_NOFOR, "NEXT WITHOUT FOR"
000004r 2 20 57 49 54
000008r 2 48 4F 55 54
000010r 2 53 59 4E 54 define_error ERR_SYNTAX, "SYNTAX"
000014r 2 41 D8
000016r 2 52 45 54 55 define_error ERR_NOGOSUB, "RETURN WITHOUT GOSUB"
00001Ar 2 52 4E 20 57
00001Er 2 49 54 48 4F
00002Ar 2 4F 55 54 20 define_error ERR_NODATA, "OUT OF DATA"
00002Er 2 4F 46 20 44
000032r 2 41 54 C1
000035r 2 49 4C 4C 45 define_error ERR_ILLQTY, "ILLEGAL QUANTITY"
000039r 2 47 41 4C 20
00003Dr 2 51 55 41 4E
000045r 2 .ifdef CBM1
000045r 2 .byte 0,0,0,0,0
000045r 2 .endif
000045r 2 4F 56 45 52 define_error ERR_OVERFLOW, "OVERFLOW"
000049r 2 46 4C 4F D7
00004Dr 2 4F 55 54 20 define_error ERR_MEMFULL, "OUT OF MEMORY"
000051r 2 4F 46 20 4D
000055r 2 45 4D 4F 52
00005Ar 2 55 4E 44 45 define_error ERR_UNDEFSTAT, "UNDEF'D STATEMENT"
00005Er 2 46 27 44 20
000062r 2 53 54 41 54
00006Br 2 42 41 44 20 define_error ERR_BADSUBS, "BAD SUBSCRIPT"
00006Fr 2 53 55 42 53
000073r 2 43 52 49 50
000078r 2 52 45 44 49 define_error ERR_REDIMD, "REDIM'D ARRAY"
00007Cr 2 4D 27 44 20
000080r 2 41 52 52 41
000085r 2 44 49 56 49 define_error ERR_ZERODIV, "DIVISION BY ZERO"
000089r 2 53 49 4F 4E
00008Dr 2 20 42 59 20
000095r 2 49 4C 4C 45 define_error ERR_ILLDIR, "ILLEGAL DIRECT"
000099r 2 47 41 4C 20
00009Dr 2 44 49 52 45
0000A3r 2 54 59 50 45 define_error ERR_BADTYPE, "TYPE MISMATCH"
0000A7r 2 20 4D 49 53
0000ABr 2 4D 41 54 43
0000B0r 2 53 54 52 49 define_error ERR_STRLONG, "STRING TOO LONG"
0000B4r 2 4E 47 20 54
0000B8r 2 4F 4F 20 4C
0000BFr 2 .ifdef CONFIG_FILE
0000BFr 2 .ifdef CBM1
0000BFr 2 define_error ERR_BADDATA, "BAD DATA"
0000BFr 2 .else
0000BFr 2 define_error ERR_BADDATA, "FILE DATA"
0000BFr 2 .endif
0000BFr 2 .endif
0000BFr 2 46 4F 52 4D define_error ERR_FRMCPX, "FORMULA TOO COMPLEX"
0000C3r 2 55 4C 41 20
0000C7r 2 54 4F 4F 20
0000D2r 2 43 41 4E 27 define_error ERR_CANTCONT, "CAN'T CONTINUE"
0000D6r 2 54 20 43 4F
0000DAr 2 4E 54 49 4E
0000E0r 2 55 4E 44 45 define_error ERR_UNDEFFN, "UNDEF'D FUNCTION"
0000E4r 2 46 27 44 20
0000E8r 2 46 55 4E 43
0000F0r 2 .endif
0000F0r 2
0000F0r 1 .include "message.s"
0000F0r 2 ; global messages: "error", "in", "ready", "break"
0000F0r 2
0000F0r 2 .segment "CODE"
000000r 2
000000r 2 QT_ERROR:
000000r 2 .ifdef KBD
000000r 2 .byte " err"
000000r 2 .else
000000r 2 .ifdef APPLE
000000r 2 .byte " ERR"
000000r 2 .byte $07,$07
000000r 2 .else
000000r 2 20 45 52 52 .byte " ERROR"
000004r 2 4F 52
000006r 2 .endif
000006r 2 .endif
000006r 2 00 .byte 0
000007r 2
000007r 2 .ifndef KBD
000007r 2 QT_IN:
000007r 2 20 49 4E 20 .byte " IN "
00000Br 2 00 .byte $00
00000Cr 2 .endif
00000Cr 2
00000Cr 2 .ifdef KBD
00000Cr 2 .byte $54,$D2 ; ???
00000Cr 2 OKPRT:
00000Cr 2 jsr PRIMM
00000Cr 2 .byte CR,CR,">>",CR,LF
00000Cr 2 .byte 0
00000Cr 2 rts
00000Cr 2 nop
00000Cr 2 .else
00000Cr 2 QT_OK:
00000Cr 2 .ifdef CONFIG_CBM_ALL
00000Cr 2 .byte CR,LF,"READY.",CR,LF
00000Cr 2 .else
00000Cr 2 .ifdef APPLE
00000Cr 2 ; binary patch!
00000Cr 2 .byte CR,0,0,"K",CR,LF
00000Cr 2 .else
00000Cr 2 0D 0A 4F 4B .byte CR,LF,"OK",CR,LF
000010r 2 0D 0A
000012r 2 .endif
000012r 2 .endif
000012r 2 00 .byte 0
000013r 2 .endif
000013r 2
000013r 2 QT_BREAK:
000013r 2
000013r 2 .ifdef KBD
000013r 2 .byte CR,LF," Brk"
000013r 2 .byte 0
000013r 2 .byte $54,$D0 ; ???
000013r 2 .elseif .def(MICROTAN)
000013r 2 .byte CR,LF," BREAK"
000013r 2 .byte 0
000013r 2 .else
000013r 2 0D 0A 42 52 .byte CR,LF,"BREAK"
000017r 2 45 41 4B
00001Ar 2 00 .byte 0
00001Br 2 .endif
00001Br 2
00001Br 1 .include "memory.s"
00001Br 2 ; generic stack and memory management code
00001Br 2 ; this code is identical across all versions of
00001Br 2 ; BASIC
00001Br 2
00001Br 2 .segment "CODE"
00001Br 2
00001Br 2 ; ----------------------------------------------------------------------------
00001Br 2 ; CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH
00001Br 2 ; THE STACK FOR A FRAME WITH THE SAME VARIABLE.
00001Br 2 ;
00001Br 2 ; (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT"
00001Br 2 ; = $XXFF IF CALLED FROM "RETURN"
00001Br 2 ; <<< BUG: SHOULD BE $FFXX >>>
00001Br 2 ;
00001Br 2 ; RETURNS .NE. IF VARIABLE NOT FOUND,
00001Br 2 ; (X) = STACK PNTR AFTER SKIPPING ALL FRAMES
00001Br 2 ;
00001Br 2 ; .EQ. IF FOUND
00001Br 2 ; (X) = STACK PNTR OF FRAME FOUND
00001Br 2 ; ----------------------------------------------------------------------------
00001Br 2 GTFORPNT:
00001Br 2 BA tsx
00001Cr 2 E8 inx
00001Dr 2 E8 inx
00001Er 2 E8 inx
00001Fr 2 E8 inx
000020r 2 L2279:
000020r 2 BD 01 01 lda STACK+1,x
000023r 2 C9 81 cmp #$81
000025r 2 D0 21 bne L22A1
000027r 2 A5 97 lda FORPNT+1
000029r 2 D0 0A bne L228E
00002Br 2 BD 02 01 lda STACK+2,x
00002Er 2 85 96 sta FORPNT
000030r 2 BD 03 01 lda STACK+3,x
000033r 2 85 97 sta FORPNT+1
000035r 2 L228E:
000035r 2 DD 03 01 cmp STACK+3,x
000038r 2 D0 07 bne L229A
00003Ar 2 A5 96 lda FORPNT
00003Cr 2 DD 02 01 cmp STACK+2,x
00003Fr 2 F0 07 beq L22A1
000041r 2 L229A:
000041r 2 8A txa
000042r 2 18 clc
000043r 2 69 12 adc #BYTES_PER_FRAME
000045r 2 AA tax
000046r 2 D0 D8 bne L2279
000048r 2 L22A1:
000048r 2 60 rts
000049r 2
000049r 2 ; ----------------------------------------------------------------------------
000049r 2 ; MOVE BLOCK OF MEMORY UP
000049r 2 ;
000049r 2 ; ON ENTRY:
000049r 2 ; (Y,A) = (HIGHDS) = DESTINATION END+1
000049r 2 ; (LOWTR) = LOWEST ADDRESS OF SOURCE
000049r 2 ; (HIGHTR) = HIGHEST SOURCE ADDRESS+1
000049r 2 ; ----------------------------------------------------------------------------
000049r 2 BLTU:
000049r 2 20 rr rr jsr REASON
00004Cr 2 85 7E sta STREND
00004Er 2 84 7F sty STREND+1
000050r 2 BLTU2:
000050r 2 38 sec
000051r 2 A5 A7 lda HIGHTR
000053r 2 E5 AC sbc LOWTR
000055r 2 85 6F sta INDEX
000057r 2 A8 tay
000058r 2 A5 A8 lda HIGHTR+1
00005Ar 2 E5 AD sbc LOWTR+1
00005Cr 2 AA tax
00005Dr 2 E8 inx
00005Er 2 98 tya
00005Fr 2 F0 23 beq L22DD
000061r 2 A5 A7 lda HIGHTR
000063r 2 38 sec
000064r 2 E5 6F sbc INDEX
000066r 2 85 A7 sta HIGHTR
000068r 2 B0 03 bcs L22C6
00006Ar 2 C6 A8 dec HIGHTR+1
00006Cr 2 38 sec
00006Dr 2 L22C6:
00006Dr 2 A5 A5 lda HIGHDS
00006Fr 2 E5 6F sbc INDEX
000071r 2 85 A5 sta HIGHDS
000073r 2 B0 08 bcs L22D6
000075r 2 C6 A6 dec HIGHDS+1
000077r 2 90 04 bcc L22D6
000079r 2 L22D2:
000079r 2 B1 A7 lda (HIGHTR),y
00007Br 2 91 A5 sta (HIGHDS),y
00007Dr 2 L22D6:
00007Dr 2 88 dey
00007Er 2 D0 F9 bne L22D2
000080r 2 B1 A7 lda (HIGHTR),y
000082r 2 91 A5 sta (HIGHDS),y
000084r 2 L22DD:
000084r 2 C6 A8 dec HIGHTR+1
000086r 2 C6 A6 dec HIGHDS+1
000088r 2 CA dex
000089r 2 D0 F2 bne L22D6
00008Br 2 60 rts
00008Cr 2
00008Cr 2 ; ----------------------------------------------------------------------------
00008Cr 2 ; CHECK IF ENOUGH ROOM LEFT ON STACK
00008Cr 2 ; FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION
00008Cr 2 ; ----------------------------------------------------------------------------
00008Cr 2 CHKMEM:
00008Cr 2 0A asl a
00008Dr 2 69 36 adc #SPACE_FOR_GOSUB
00008Fr 2 B0 35 bcs MEMERR
000091r 2 85 6F sta INDEX
000093r 2 BA tsx
000094r 2 E4 6F cpx INDEX
000096r 2 90 2E bcc MEMERR
000098r 2 60 rts
000099r 2
000099r 2 ; ----------------------------------------------------------------------------
000099r 2 ; CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS
000099r 2 ; (Y,A) = ADDR ARRAYS NEED TO GROW TO
000099r 2 ; ----------------------------------------------------------------------------
000099r 2 REASON:
000099r 2 C4 81 cpy FRETOP+1
00009Br 2 90 28 bcc L231E
00009Dr 2 D0 04 bne L22FC
00009Fr 2 C5 80 cmp FRETOP
0000A1r 2 90 22 bcc L231E
0000A3r 2 L22FC:
0000A3r 2 48 pha
0000A4r 2 A2 09 ldx #FAC-TEMP1-1
0000A6r 2 98 tya
0000A7r 2 L2300:
0000A7r 2 48 pha
0000A8r 2 B5 A4 lda TEMP1,x
0000AAr 2 CA dex
0000ABr 2 10 FA bpl L2300
0000ADr 2 20 rr rr jsr GARBAG
0000B0r 2 A2 F7 ldx #TEMP1-FAC+1
0000B2r 2 L230B:
0000B2r 2 68 pla
0000B3r 2 95 AE sta FAC,x
0000B5r 2 E8 inx
0000B6r 2 30 FA bmi L230B
0000B8r 2 68 pla
0000B9r 2 A8 tay
0000BAr 2 68 pla
0000BBr 2 C4 81 cpy FRETOP+1
0000BDr 2 90 06 bcc L231E
0000BFr 2 D0 05 bne MEMERR
0000C1r 2 C5 80 cmp FRETOP
0000C3r 2 B0 01 bcs MEMERR
0000C5r 2 L231E:
0000C5r 2 60 rts
0000C6r 2
0000C6r 1 .include "program.s"
0000C6r 2 ; error
0000C6r 2 ; line input, line editing
0000C6r 2 ; tokenize
0000C6r 2 ; detokenize
0000C6r 2 ; BASIC program memory management
0000C6r 2
0000C6r 2 ; MICROTAN has some nonstandard extension to LIST here
0000C6r 2
0000C6r 2 .segment "CODE"
0000C6r 2
0000C6r 2 MEMERR:
0000C6r 2 A2 4D ldx #ERR_MEMFULL
0000C8r 2
0000C8r 2 ; ----------------------------------------------------------------------------
0000C8r 2 ; HANDLE AN ERROR
0000C8r 2 ;
0000C8r 2 ; (X)=OFFSET IN ERROR MESSAGE TABLE
0000C8r 2 ; (ERRFLG) > 128 IF "ON ERR" TURNED ON
0000C8r 2 ; (CURLIN+1) = $FF IF IN DIRECT MODE
0000C8r 2 ; ----------------------------------------------------------------------------
0000C8r 2 ERROR:
0000C8r 2 46 14 lsr Z14
0000CAr 2 .ifdef CONFIG_FILE
0000CAr 2 lda CURDVC ; output
0000CAr 2 beq LC366 ; is screen
0000CAr 2 jsr CLRCH ; otherwise redirect output back to screen
0000CAr 2 lda #$00
0000CAr 2 sta CURDVC
0000CAr 2 LC366:
0000CAr 2 .endif
0000CAr 2 20 rr rr jsr CRDO
0000CDr 2 20 rr rr jsr OUTQUES
0000D0r 2 L2329:
0000D0r 2 BD rr rr lda ERROR_MESSAGES,x
0000D3r 2 .ifndef CONFIG_SMALL
0000D3r 2 48 pha
0000D4r 2 29 7F and #$7F
0000D6r 2 .endif
0000D6r 2 20 rr rr jsr OUTDO
0000D9r 2 .ifdef CONFIG_SMALL
0000D9r 2 lda ERROR_MESSAGES+1,x
0000D9r 2 .ifdef KBD
0000D9r 2 and #$7F
0000D9r 2 .endif
0000D9r 2 jsr OUTDO
0000D9r 2 .else
0000D9r 2 E8 inx
0000DAr 2 68 pla
0000DBr 2 10 F3 bpl L2329
0000DDr 2 .endif
0000DDr 2 20 rr rr jsr STKINI
0000E0r 2 A9 rr lda #<QT_ERROR
0000E2r 2 A0 rr ldy #>QT_ERROR
0000E4r 2
0000E4r 2 ; ----------------------------------------------------------------------------
0000E4r 2 ; PRINT STRING AT (Y,A)
0000E4r 2 ; PRINT CURRENT LINE # UNLESS IN DIRECT MODE
0000E4r 2 ; FALL INTO WARM RESTART
0000E4r 2 ; ----------------------------------------------------------------------------
0000E4r 2 PRINT_ERROR_LINNUM:
0000E4r 2 20 rr rr jsr STROUT
0000E7r 2 A4 87 ldy CURLIN+1
0000E9r 2 C8 iny
0000EAr 2 F0 03 beq RESTART
0000ECr 2 20 rr rr jsr INPRT
0000EFr 2
0000EFr 2 ; ----------------------------------------------------------------------------
0000EFr 2 ; WARM RESTART ENTRY
0000EFr 2 ; ----------------------------------------------------------------------------
0000EFr 2 RESTART:
0000EFr 2 .ifdef KBD
0000EFr 2 jsr CRDO
0000EFr 2 nop
0000EFr 2 L2351X:
0000EFr 2 jsr OKPRT
0000EFr 2 L2351:
0000EFr 2 jsr INLIN
0000EFr 2 LE28E:
0000EFr 2 bpl RESTART
0000EFr 2 .else
0000EFr 2 46 14 lsr Z14
0000F1r 2 A9 rr lda #<QT_OK
0000F3r 2 A0 rr ldy #>QT_OK
0000F5r 2 .ifdef CONFIG_CBM_ALL
0000F5r 2 jsr STROUT
0000F5r 2 .else
0000F5r 2 20 03 00 jsr GOSTROUT
0000F8r 2 .endif
0000F8r 2 L2351:
0000F8r 2 20 rr rr jsr INLIN
0000FBr 2 .endif
0000FBr 2 86 C7 stx TXTPTR
0000FDr 2 84 C8 sty TXTPTR+1
0000FFr 2 20 C0 00 jsr CHRGET
000102r 2 .ifdef CONFIG_11
000102r 2 ; bug in pre-1.1: CHRGET sets Z on '\0'
000102r 2 ; and ':' - a line starting with ':' in
000102r 2 ; direct mode gets ignored
000102r 2 AA tax
000103r 2 .endif
000103r 2 .ifdef KBD
000103r 2 beq L2351X
000103r 2 .else
000103r 2 F0 F3 beq L2351
000105r 2 .endif
000105r 2 A2 FF ldx #$FF
000107r 2 86 87 stx CURLIN+1
000109r 2 90 06 bcc NUMBERED_LINE
00010Br 2 20 rr rr jsr PARSE_INPUT_LINE
00010Er 2 4C rr rr jmp NEWSTT2
000111r 2
000111r 2 ; ----------------------------------------------------------------------------
000111r 2 ; HANDLE NUMBERED LINE
000111r 2 ; ----------------------------------------------------------------------------
000111r 2 NUMBERED_LINE:
000111r 2 20 rr rr jsr LINGET
000114r 2 20 rr rr jsr PARSE_INPUT_LINE
000117r 2 84 0C sty EOLPNTR
000119r 2 .ifdef KBD
000119r 2 jsr FNDLIN2
000119r 2 lda JMPADRS+1
000119r 2 sta LOWTR
000119r 2 sta Z96
000119r 2 lda JMPADRS+2
000119r 2 sta LOWTR+1
000119r 2 sta Z96+1
000119r 2 lda LINNUM
000119r 2 sta L06FE
000119r 2 lda LINNUM+1
000119r 2 sta L06FE+1
000119r 2 inc LINNUM
000119r 2 bne LE2D2
000119r 2 inc LINNUM+1
000119r 2 bne LE2D2
000119r 2 jmp SYNERR
000119r 2 LE2D2:
000119r 2 jsr LF457
000119r 2 ldx #Z96
000119r 2 jsr CMPJMPADRS
000119r 2 bcs LE2FD
000119r 2 LE2DC:
000119r 2 ldx #$00
000119r 2 lda (JMPADRS+1,x)
000119r 2 sta (Z96,x)
000119r 2 inc JMPADRS+1
000119r 2 bne LE2E8
000119r 2 inc JMPADRS+2
000119r 2 LE2E8:
000119r 2 inc Z96
000119r 2 bne LE2EE
000119r 2 inc Z96+1
000119r 2 LE2EE:
000119r 2 ldx #VARTAB
000119r 2 jsr CMPJMPADRS
000119r 2 bne LE2DC
000119r 2 lda Z96
000119r 2 sta VARTAB
000119r 2 lda Z96+1
000119r 2 sta VARTAB+1
000119r 2 LE2FD:
000119r 2 jsr SETPTRS
000119r 2 jsr LE33D
000119r 2 lda INPUTBUFFER
000119r 2 LE306:
000119r 2 beq LE28E
000119r 2 cmp #$A5
000119r 2 beq LE306
000119r 2 clc
000119r 2 .else
000119r 2 20 rr rr jsr FNDLIN
00011Cr 2 90 44 bcc PUT_NEW_LINE
00011Er 2 A0 01 ldy #$01
000120r 2 B1 AC lda (LOWTR),y
000122r 2 85 70 sta INDEX+1
000124r 2 A5 7A lda VARTAB
000126r 2 85 6F sta INDEX
000128r 2 A5 AD lda LOWTR+1
00012Ar 2 85 72 sta DEST+1
00012Cr 2 A5 AC lda LOWTR
00012Er 2 88 dey
00012Fr 2 F1 AC sbc (LOWTR),y
000131r 2 18 clc
000132r 2 65 7A adc VARTAB
000134r 2 85 7A sta VARTAB
000136r 2 85 71 sta DEST
000138r 2 A5 7B lda VARTAB+1
00013Ar 2 69 FF adc #$FF
00013Cr 2 85 7B sta VARTAB+1
00013Er 2 E5 AD sbc LOWTR+1
000140r 2 AA tax
000141r 2 38 sec
000142r 2 A5 AC lda LOWTR
000144r 2 E5 7A sbc VARTAB
000146r 2 A8 tay
000147r 2 B0 03 bcs L23A5
000149r 2 E8 inx
00014Ar 2 C6 72 dec DEST+1
00014Cr 2 L23A5:
00014Cr 2 18 clc
00014Dr 2 65 6F adc INDEX
00014Fr 2 90 03 bcc L23AD
000151r 2 C6 70 dec INDEX+1
000153r 2 18 clc
000154r 2 L23AD:
000154r 2 B1 6F lda (INDEX),y
000156r 2 91 71 sta (DEST),y
000158r 2 C8 iny
000159r 2 D0 F9 bne L23AD
00015Br 2 E6 70 inc INDEX+1
00015Dr 2 E6 72 inc DEST+1
00015Fr 2 CA dex
000160r 2 D0 F2 bne L23AD
000162r 2 .endif
000162r 2 ; ----------------------------------------------------------------------------
000162r 2 PUT_NEW_LINE:
000162r 2 .ifndef KBD
000162r 2 .ifdef CONFIG_2
000162r 2 jsr SETPTRS
000162r 2 jsr LE33D
000162r 2 lda INPUTBUFFER
000162r 2 beq L2351
000162r 2 clc
000162r 2 .else
000162r 2 A5 1B lda INPUTBUFFER
000164r 2 F0 2F beq FIX_LINKS
000166r 2 A5 84 lda MEMSIZ
000168r 2 A4 85 ldy MEMSIZ+1
00016Ar 2 85 80 sta FRETOP
00016Cr 2 84 81 sty FRETOP+1
00016Er 2 .endif
00016Er 2 .endif
00016Er 2 A5 7A lda VARTAB
000170r 2 85 A7 sta HIGHTR
000172r 2 65 0C adc EOLPNTR
000174r 2 85 A5 sta HIGHDS
000176r 2 A4 7B ldy VARTAB+1
000178r 2 84 A8 sty HIGHTR+1
00017Ar 2 90 01 bcc L23D6
00017Cr 2 C8 iny
00017Dr 2 L23D6:
00017Dr 2 84 A6 sty HIGHDS+1
00017Fr 2 20 rr rr jsr BLTU
000182r 2 .ifdef CONFIG_INPUTBUFFER_0200
000182r 2 lda LINNUM
000182r 2 ldy LINNUM+1
000182r 2 sta INPUTBUFFER-2
000182r 2 sty INPUTBUFFER-1
000182r 2 .endif
000182r 2 A5 7E lda STREND
000184r 2 A4 7F ldy STREND+1
000186r 2 85 7A sta VARTAB
000188r 2 84 7B sty VARTAB+1
00018Ar 2 A4 0C ldy EOLPNTR
00018Cr 2 88 dey
00018Dr 2 ; ---COPY LINE INTO PROGRAM-------
00018Dr 2 L23E6:
00018Dr 2 B9 17 00 lda INPUTBUFFER-4,y
000190r 2 91 AC sta (LOWTR),y
000192r 2 88 dey
000193r 2 10 F8 bpl L23E6
000195r 2
000195r 2 ; ----------------------------------------------------------------------------
000195r 2 ; CLEAR ALL VARIABLES
000195r 2 ; RE-ESTABLISH ALL FORWARD LINKS
000195r 2 ; ----------------------------------------------------------------------------
000195r 2 FIX_LINKS:
000195r 2 20 rr rr jsr SETPTRS
000198r 2 .ifdef CONFIG_2
000198r 2 jsr LE33D
000198r 2 jmp L2351
000198r 2 LE33D:
000198r 2 .endif
000198r 2 A5 78 lda TXTTAB
00019Ar 2 A4 79 ldy TXTTAB+1
00019Cr 2 85 6F sta INDEX
00019Er 2 84 70 sty INDEX+1
0001A0r 2 18 clc
0001A1r 2 L23FA:
0001A1r 2 A0 01 ldy #$01
0001A3r 2 B1 6F lda (INDEX),y
0001A5r 2 .ifdef CONFIG_2
0001A5r 2 beq RET3
0001A5r 2 .else
0001A5r 2 D0 03 4C rr jeq L2351
0001A9r 2 rr
0001AAr 2 .endif
0001AAr 2 A0 04 ldy #$04
0001ACr 2 L2405:
0001ACr 2 C8 iny
0001ADr 2 B1 6F lda (INDEX),y
0001AFr 2 D0 FB bne L2405
0001B1r 2 C8 iny
0001B2r 2 98 tya
0001B3r 2 65 6F adc INDEX
0001B5r 2 AA tax
0001B6r 2 A0 00 ldy #$00
0001B8r 2 91 6F sta (INDEX),y
0001BAr 2 A5 70 lda INDEX+1
0001BCr 2 69 00 adc #$00
0001BEr 2 C8 iny
0001BFr 2 91 6F sta (INDEX),y
0001C1r 2 86 6F stx INDEX
0001C3r 2 85 70 sta INDEX+1
0001C5r 2 90 DA bcc L23FA ; always
0001C7r 2
0001C7r 2 ; ----------------------------------------------------------------------------
0001C7r 2 .ifdef KBD
0001C7r 2 .include "kbd_loadsave.s"
0001C7r 2 .endif
0001C7r 2
0001C7r 2 .ifdef CONFIG_2
0001C7r 2 ; !!! kbd_loadsave.s requires an RTS here!
0001C7r 2 RET3:
0001C7r 2 rts
0001C7r 2 .endif
0001C7r 2
0001C7r 2 .include "inline.s"
0001C7r 3 .segment "CODE"
0001C7r 3
0001C7r 3 .ifndef CONFIG_NO_INPUTBUFFER_ZP
0001C7r 3 L2420:
0001C7r 3 .ifdef OSI
0001C7r 3 jsr OUTDO
0001C7r 3 .endif
0001C7r 3 CA dex
0001C8r 3 10 05 bpl INLIN2
0001CAr 3 L2423:
0001CAr 3 .ifdef OSI
0001CAr 3 jsr OUTDO
0001CAr 3 .endif
0001CAr 3 20 rr rr jsr CRDO
0001CDr 3 .endif
0001CDr 3
0001CDr 3 ; ----------------------------------------------------------------------------
0001CDr 3 ; READ A LINE, AND STRIP OFF SIGN BITS
0001CDr 3 ; ----------------------------------------------------------------------------
0001CDr 3 .ifndef KBD
0001CDr 3 INLIN:
0001CDr 3 .ifdef APPLE
0001CDr 3 ldx #$DD
0001CDr 3 INLIN1:
0001CDr 3 stx $33
0001CDr 3 jsr L2900
0001CDr 3 cpx #$EF
0001CDr 3 bcs L0C32
0001CDr 3 ldx #$EF
0001CDr 3 L0C32:
0001CDr 3 lda #$00
0001CDr 3 sta INPUTBUFFER,x
0001CDr 3 ldx #<INPUTBUFFER-1
0001CDr 3 ldy #>INPUTBUFFER-1
0001CDr 3 rts
0001CDr 3 .endif
0001CDr 3
0001CDr 3 .ifndef APPLE
0001CDr 3 A2 00 ldx #$00
0001CFr 3 INLIN2:
0001CFr 3 20 rr rr jsr GETLN
0001D2r 3 .ifndef CONFIG_NO_LINE_EDITING
0001D2r 3 C9 07 cmp #$07
0001D4r 3 F0 14 beq L2443
0001D6r 3 .endif
0001D6r 3 C9 0D cmp #$0D
0001D8r 3 F0 20 beq L2453
0001DAr 3 .ifndef CONFIG_NO_LINE_EDITING
0001DAr 3 C9 20 cmp #$20
0001DCr 3 90 F1 bcc INLIN2
0001DEr 3 .ifdef MICROTAN
0001DEr 3 cmp #$80
0001DEr 3 .else
0001DEr 3 C9 7D cmp #$7D
0001E0r 3 .endif
0001E0r 3 B0 ED bcs INLIN2
0001E2r 3 C9 40 cmp #$40 ; @
0001E4r 3 F0 E4 beq L2423
0001E6r 3 .ifdef MICROTAN
0001E6r 3 cmp #$7F ; DEL
0001E6r 3 .else
0001E6r 3 C9 5F cmp #$5F ; _
0001E8r 3 .endif
0001E8r 3 F0 DD beq L2420
0001EAr 3 L2443:
0001EAr 3 .ifdef MICROTAN
0001EAr 3 cpx #$4F
0001EAr 3 .else
0001EAr 3 E0 47 cpx #$47
0001ECr 3 .endif
0001ECr 3 B0 05 bcs L244C
0001EEr 3 .endif
0001EEr 3 95 1B sta INPUTBUFFER,x
0001F0r 3 E8 inx
0001F1r 3 .ifdef OSI
0001F1r 3 .byte $2C
0001F1r 3 .else
0001F1r 3 D0 DC bne INLIN2
0001F3r 3 .endif
0001F3r 3 L244C:
0001F3r 3 .ifndef CONFIG_NO_LINE_EDITING
0001F3r 3 A9 07 lda #$07 ; BEL
0001F5r 3 20 rr rr jsr OUTDO
0001F8r 3 D0 D5 bne INLIN2
0001FAr 3 .endif
0001FAr 3 L2453:
0001FAr 3 4C rr rr jmp L29B9
0001FDr 3 .endif
0001FDr 3 .endif
0001FDr 3
0001FDr 3 .ifndef KBD
0001FDr 3 .ifndef APPLE
0001FDr 3 GETLN:
0001FDr 3 .ifdef CONFIG_FILE
0001FDr 3 jsr CHRIN
0001FDr 3 ldy CURDVC
0001FDr 3 bne L2465
0001FDr 3 .else
0001FDr 3 20 5A 1E jsr MONRDKEY
000200r 3 .endif
000200r 3 .ifdef OSI
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 nop
000200r 3 and #$7F
000200r 3 .endif
000200r 3 .endif ; /* APPLE */
000200r 3 .ifdef APPLE
000200r 3 RDKEY:
000200r 3 jsr LFD0C
000200r 3 and #$7F
000200r 3 .endif
000200r 3 C9 0F cmp #$0F
000202r 3 D0 08 bne L2465
000204r 3 48 pha
000205r 3 A5 14 lda Z14
000207r 3 49 FF eor #$FF
000209r 3 85 14 sta Z14
00020Br 3 68 pla
00020Cr 3 L2465:
00020Cr 3 60 rts
00020Dr 3 .endif ; /* KBD */
00020Dr 3
00020Dr 2
00020Dr 2 ; ----------------------------------------------------------------------------
00020Dr 2 ; TOKENIZE THE INPUT LINE
00020Dr 2 ; ----------------------------------------------------------------------------
00020Dr 2 PARSE_INPUT_LINE:
00020Dr 2 A6 C7 ldx TXTPTR
00020Fr 2 A0 04 ldy #$04
000211r 2 84 10 sty DATAFLG
000213r 2 L246C:
000213r 2 B5 00 lda INPUTBUFFERX,x
000215r 2 .ifdef CONFIG_CBM_ALL
000215r 2 bpl LC49E
000215r 2 cmp #$FF
000215r 2 beq L24AC
000215r 2 inx
000215r 2 bne L246C
000215r 2 LC49E:
000215r 2 .endif
000215r 2 C9 20 cmp #$20
000217r 2 F0 3A beq L24AC
000219r 2 85 0B sta ENDCHR
00021Br 2 C9 22 cmp #$22
00021Dr 2 F0 58 beq L24D0
00021Fr 2 24 10 bit DATAFLG
000221r 2 70 30 bvs L24AC
000223r 2 C9 3F cmp #$3F
000225r 2 D0 04 bne L2484
000227r 2 A9 97 lda #TOKEN_PRINT
000229r 2 D0 28 bne L24AC
00022Br 2 L2484:
00022Br 2 C9 30 cmp #$30
00022Dr 2 90 04 bcc L248C
00022Fr 2 C9 3C cmp #$3C
000231r 2 90 20 bcc L24AC
000233r 2 ; ----------------------------------------------------------------------------
000233r 2 ; SEARCH TOKEN NAME TABLE FOR MATCH STARTING
000233r 2 ; WITH CURRENT CHAR FROM INPUT LINE
000233r 2 ; ----------------------------------------------------------------------------
000233r 2 L248C:
000233r 2 84 BE sty STRNG2
000235r 2 A0 00 ldy #$00
000237r 2 84 0C sty EOLPNTR
000239r 2 88 dey
00023Ar 2 86 C7 stx TXTPTR
00023Cr 2 CA dex
00023Dr 2 L2496:
00023Dr 2 C8 iny
00023Er 2 L2497:
00023Er 2 E8 inx
00023Fr 2 L2498:
00023Fr 2 .ifdef KBD
00023Fr 2 jsr GET_UPPER
00023Fr 2 .else
00023Fr 2 B5 00 lda INPUTBUFFERX,x
000241r 2 .ifndef CONFIG_2
000241r 2 C9 20 cmp #$20
000243r 2 F0 F9 beq L2497
000245r 2 .endif
000245r 2 .endif
000245r 2 38 sec
000246r 2 F9 rr rr sbc TOKEN_NAME_TABLE,y
000249r 2 F0 F2 beq L2496
00024Br 2 C9 80 cmp #$80
00024Dr 2 D0 2F bne L24D7
00024Fr 2 05 0C ora EOLPNTR
000251r 2 ; ----------------------------------------------------------------------------
000251r 2 ; STORE CHARACTER OR TOKEN IN OUTPUT LINE
000251r 2 ; ----------------------------------------------------------------------------
000251r 2 L24AA:
000251r 2 A4 BE ldy STRNG2
000253r 2 L24AC:
000253r 2 E8 inx
000254r 2 C8 iny
000255r 2 99 16 00 sta INPUTBUFFER-5,y
000258r 2 B9 16 00 lda INPUTBUFFER-5,y
00025Br 2 F0 34 beq L24EA
00025Dr 2 38 sec
00025Er 2 E9 3A sbc #$3A
000260r 2 F0 04 beq L24BF
000262r 2 C9 49 cmp #$49
000264r 2 D0 02 bne L24C1
000266r 2 L24BF:
000266r 2 85 10 sta DATAFLG
000268r 2 L24C1:
000268r 2 38 sec
000269r 2 E9 54 sbc #TOKEN_REM-':'
00026Br 2 D0 A6 bne L246C
00026Dr 2 85 0B sta ENDCHR
00026Fr 2 ; ----------------------------------------------------------------------------
00026Fr 2 ; HANDLE LITERAL (BETWEEN QUOTES) OR REMARK,
00026Fr 2 ; BY COPYING CHARS UP TO ENDCHR.
00026Fr 2 ; ----------------------------------------------------------------------------
00026Fr 2 L24C8:
00026Fr 2 B5 00 lda INPUTBUFFERX,x
000271r 2 F0 E0 beq L24AC
000273r 2 C5 0B cmp ENDCHR
000275r 2 F0 DC beq L24AC
000277r 2 L24D0:
000277r 2 C8 iny
000278r 2 99 16 00 sta INPUTBUFFER-5,y
00027Br 2 E8 inx
00027Cr 2 D0 F1 bne L24C8
00027Er 2 ; ----------------------------------------------------------------------------
00027Er 2 ; ADVANCE POINTER TO NEXT TOKEN NAME
00027Er 2 ; ----------------------------------------------------------------------------
00027Er 2 L24D7:
00027Er 2 A6 C7 ldx TXTPTR
000280r 2 E6 0C inc EOLPNTR
000282r 2 L24DB:
000282r 2 C8 iny
000283r 2 B9 rr rr lda MATHTBL+28+1,y
000286r 2 10 FA bpl L24DB
000288r 2 B9 rr rr lda TOKEN_NAME_TABLE,y
00028Br 2 D0 B2 bne L2498
00028Dr 2 B5 00 lda INPUTBUFFERX,x
00028Fr 2 10 C0 bpl L24AA
000291r 2 ; ---END OF LINE------------------
000291r 2 L24EA:
000291r 2 99 18 00 sta INPUTBUFFER-3,y
000294r 2 .ifdef CONFIG_NO_INPUTBUFFER_ZP
000294r 2 dec TXTPTR+1
000294r 2 .endif
000294r 2 A9 1A lda #<INPUTBUFFER-1
000296r 2 85 C7 sta TXTPTR
000298r 2 60 rts
000299r 2
000299r 2 ; ----------------------------------------------------------------------------
000299r 2 ; SEARCH FOR LINE
000299r 2 ;
000299r 2 ; (LINNUM) = LINE # TO FIND
000299r 2 ; IF NOT FOUND: CARRY = 0
000299r 2 ; LOWTR POINTS AT NEXT LINE
000299r 2 ; IF FOUND: CARRY = 1
000299r 2 ; LOWTR POINTS AT LINE
000299r 2 ; ----------------------------------------------------------------------------
000299r 2 FNDLIN:
000299r 2 .ifdef KBD
000299r 2 jsr CHRGET
000299r 2 jmp LE444
000299r 2 LE440:
000299r 2 php
000299r 2 jsr LINGET
000299r 2 LE444:
000299r 2 jsr LF457
000299r 2 ldx #$FF
000299r 2 plp
000299r 2 beq LE464
000299r 2 jsr CHRGOT
000299r 2 beq L2520
000299r 2 cmp #$A5
000299r 2 bne L2520
000299r 2 jsr CHRGET
000299r 2 beq LE464
000299r 2 bcs LE461
000299r 2 jsr LINGET
000299r 2 beq L2520
000299r 2 LE461:
000299r 2 jmp SYNERR
000299r 2 LE464:
000299r 2 stx LINNUM
000299r 2 stx LINNUM+1
000299r 2 .else
000299r 2 A5 78 lda TXTTAB
00029Br 2 A6 79 ldx TXTTAB+1
00029Dr 2 FL1:
00029Dr 2 A0 01 ldy #$01
00029Fr 2 85 AC sta LOWTR
0002A1r 2 86 AD stx LOWTR+1
0002A3r 2 B1 AC lda (LOWTR),y
0002A5r 2 F0 1F beq L251F
0002A7r 2 C8 iny
0002A8r 2 C8 iny
0002A9r 2 A5 1A lda LINNUM+1
0002ABr 2 D1 AC cmp (LOWTR),y
0002ADr 2 90 18 bcc L2520
0002AFr 2 F0 03 beq L250D
0002B1r 2 88 dey
0002B2r 2 D0 09 bne L2516
0002B4r 2 L250D:
0002B4r 2 A5 19 lda LINNUM
0002B6r 2 88 dey
0002B7r 2 D1 AC cmp (LOWTR),y
0002B9r 2 90 0C bcc L2520
0002BBr 2 F0 0A beq L2520
0002BDr 2 L2516:
0002BDr 2 88 dey
0002BEr 2 B1 AC lda (LOWTR),y
0002C0r 2 AA tax
0002C1r 2 88 dey
0002C2r 2 B1 AC lda (LOWTR),y
0002C4r 2 B0 D7 bcs FL1
0002C6r 2 L251F:
0002C6r 2 18 clc
0002C7r 2 .endif
0002C7r 2 L2520:
0002C7r 2 60 rts
0002C8r 2
0002C8r 2 ; ----------------------------------------------------------------------------
0002C8r 2 ; "NEW" STATEMENT
0002C8r 2 ; ----------------------------------------------------------------------------
0002C8r 2 NEW:
0002C8r 2 D0 FD bne L2520
0002CAr 2 SCRTCH:
0002CAr 2 A9 00 lda #$00
0002CCr 2 A8 tay
0002CDr 2 91 78 sta (TXTTAB),y
0002CFr 2 C8 iny
0002D0r 2 91 78 sta (TXTTAB),y
0002D2r 2 A5 78 lda TXTTAB
0002D4r 2 .ifdef CONFIG_2
0002D4r 2 clc
0002D4r 2 .endif
0002D4r 2 69 02 adc #$02
0002D6r 2 85 7A sta VARTAB
0002D8r 2 A5 79 lda TXTTAB+1
0002DAr 2 69 00 adc #$00
0002DCr 2 85 7B sta VARTAB+1
0002DEr 2 ; ----------------------------------------------------------------------------
0002DEr 2 SETPTRS:
0002DEr 2 20 rr rr jsr STXTPT
0002E1r 2 .ifdef CONFIG_11A
0002E1r 2 A9 00 lda #$00
0002E3r 2
0002E3r 2 ; ----------------------------------------------------------------------------
0002E3r 2 ; "CLEAR" STATEMENT
0002E3r 2 ; ----------------------------------------------------------------------------
0002E3r 2 CLEAR:
0002E3r 2 D0 2C bne L256A
0002E5r 2 .endif
0002E5r 2 CLEARC:
0002E5r 2 .ifdef KBD
0002E5r 2 lda #<CONST_MEMSIZ
0002E5r 2 ldy #>CONST_MEMSIZ
0002E5r 2 .else
0002E5r 2 A5 84 lda MEMSIZ
0002E7r 2 A4 85 ldy MEMSIZ+1
0002E9r 2 .endif
0002E9r 2 85 80 sta FRETOP
0002EBr 2 84 81 sty FRETOP+1
0002EDr 2 .ifdef CONFIG_CBM_ALL
0002EDr 2 jsr CLALL
0002EDr 2 .endif
0002EDr 2 A5 7A lda VARTAB
0002EFr 2 A4 7B ldy VARTAB+1
0002F1r 2 85 7C sta ARYTAB
0002F3r 2 84 7D sty ARYTAB+1
0002F5r 2 85 7E sta STREND
0002F7r 2 84 7F sty STREND+1
0002F9r 2 20 rr rr jsr RESTORE
0002FCr 2 ; ----------------------------------------------------------------------------
0002FCr 2 STKINI:
0002FCr 2 A2 66 ldx #TEMPST
0002FEr 2 86 63 stx TEMPPT
000300r 2 68 pla
000301r 2 .ifdef CONFIG_2
000301r 2 tay
000301r 2 .else
000301r 2 8D FD 01 sta STACK+STACK_TOP+1
000304r 2 .endif
000304r 2 68 pla
000305r 2 .ifndef CONFIG_2
000305r 2 8D FE 01 sta STACK+STACK_TOP+2
000308r 2 .endif
000308r 2 A2 FC ldx #STACK_TOP
00030Ar 2 9A txs
00030Br 2 .ifdef CONFIG_2
00030Br 2 pha
00030Br 2 tya
00030Br 2 pha
00030Br 2 .endif
00030Br 2 A9 00 lda #$00
00030Dr 2 85 8B sta OLDTEXT+1
00030Fr 2 85 11 sta SUBFLG
000311r 2 L256A:
000311r 2 60 rts
000312r 2
000312r 2 ; ----------------------------------------------------------------------------
000312r 2 ; SET TXTPTR TO BEGINNING OF PROGRAM
000312r 2 ; ----------------------------------------------------------------------------
000312r 2 STXTPT:
000312r 2 18 clc
000313r 2 A5 78 lda TXTTAB
000315r 2 69 FF adc #$FF
000317r 2 85 C7 sta TXTPTR
000319r 2 A5 79 lda TXTTAB+1
00031Br 2 69 FF adc #$FF
00031Dr 2 85 C8 sta TXTPTR+1
00031Fr 2 60 rts
000320r 2
000320r 2 ; ----------------------------------------------------------------------------
000320r 2 .ifdef KBD
000320r 2 LE4C0:
000320r 2 ldy #<LE444
000320r 2 ldx #>LE444
000320r 2 LE4C4:
000320r 2 jsr LFFD6
000320r 2 jsr LFFED
000320r 2 lda $0504
000320r 2 clc
000320r 2 adc #$08
000320r 2 sta $0504
000320r 2 rts
000320r 2
000320r 2 CMPJMPADRS:
000320r 2 lda 1,x
000320r 2 cmp JMPADRS+2
000320r 2 bne LE4DE
000320r 2 lda 0,x
000320r 2 cmp JMPADRS+1
000320r 2 LE4DE:
000320r 2 rts
000320r 2 .endif
000320r 2
000320r 2 ; ----------------------------------------------------------------------------
000320r 2 ; "LIST" STATEMENT
000320r 2 ; ----------------------------------------------------------------------------
000320r 2 LIST:
000320r 2 .ifdef KBD
000320r 2 jsr LE440
000320r 2 bne LE4DE
000320r 2 pla
000320r 2 pla
000320r 2 L25A6:
000320r 2 jsr CRDO
000320r 2 .else
000320r 2 .ifdef MICROTAN
000320r 2 php
000320r 2 jmp LE21C ; patch
000320r 2 LC57E:
000320r 2 .else
000320r 2 90 06 bcc L2581
000322r 2 F0 04 beq L2581
000324r 2 C9 A5 cmp #TOKEN_MINUS
000326r 2 D0 E9 bne L256A
000328r 2 L2581:
000328r 2 20 rr rr jsr LINGET
00032Br 2 .endif
00032Br 2 20 rr rr jsr FNDLIN
00032Er 2 .ifdef MICROTAN
00032Er 2 plp
00032Er 2 beq L2598
00032Er 2 .endif
00032Er 2 20 C6 00 jsr CHRGOT
000331r 2 .ifdef MICROTAN
000331r 2 beq L25A6
000331r 2 .else
000331r 2 F0 0C beq L2598
000333r 2 .endif
000333r 2 C9 A5 cmp #TOKEN_MINUS
000335r 2 D0 90 bne L2520
000337r 2 20 C0 00 jsr CHRGET
00033Ar 2 .ifdef MICROTAN
00033Ar 2 beq L2598
00033Ar 2 jsr LINGET
00033Ar 2 beq L25A6
00033Ar 2 rts
00033Ar 2 .else
00033Ar 2 20 rr rr jsr LINGET
00033Dr 2 D0 88 bne L2520
00033Fr 2 .endif
00033Fr 2 L2598:
00033Fr 2 .ifndef MICROTAN
00033Fr 2 68 pla
000340r 2 68 pla
000341r 2 A5 19 lda LINNUM
000343r 2 05 1A ora LINNUM+1
000345r 2 D0 06 bne L25A6
000347r 2 .endif
000347r 2 A9 FF lda #$FF
000349r 2 85 19 sta LINNUM
00034Br 2 85 1A sta LINNUM+1
00034Dr 2 L25A6:
00034Dr 2 .ifdef MICROTAN
00034Dr 2 pla
00034Dr 2 pla
00034Dr 2 .endif
00034Dr 2 L25A6X:
00034Dr 2 .endif
00034Dr 2 A0 01 ldy #$01
00034Fr 2 .ifdef CONFIG_DATAFLG
00034Fr 2 sty DATAFLG
00034Fr 2 .endif
00034Fr 2 B1 AC lda (LOWTRX),y
000351r 2 F0 39 beq L25E5
000353r 2 .ifdef MICROTAN
000353r 2 jmp LE21F
000353r 2 LC5A9:
000353r 2 .else
000353r 2 20 rr rr jsr ISCNTC
000356r 2 .endif
000356r 2 .ifndef KBD
000356r 2 20 rr rr jsr CRDO
000359r 2 .endif
000359r 2 C8 iny
00035Ar 2 B1 AC lda (LOWTRX),y
00035Cr 2 AA tax
00035Dr 2 C8 iny
00035Er 2 B1 AC lda (LOWTRX),y
000360r 2 C5 1A cmp LINNUM+1
000362r 2 D0 04 bne L25C1
000364r 2 E4 19 cpx LINNUM
000366r 2 F0 02 beq L25C3
000368r 2 L25C1:
000368r 2 B0 22 bcs L25E5
00036Ar 2 ; ---LIST ONE LINE----------------
00036Ar 2 L25C3:
00036Ar 2 84 96 sty FORPNT
00036Cr 2 20 rr rr jsr LINPRT
00036Fr 2 A9 20 lda #$20
000371r 2 L25CA:
000371r 2 A4 96 ldy FORPNT
000373r 2 29 7F and #$7F
000375r 2 L25CE:
000375r 2 20 rr rr jsr OUTDO
000378r 2 .ifdef CONFIG_DATAFLG
000378r 2 cmp #$22
000378r 2 bne LA519
000378r 2 lda DATAFLG
000378r 2 eor #$FF
000378r 2 sta DATAFLG
000378r 2 LA519:
000378r 2 .endif
000378r 2 C8 iny
000379r 2 .ifdef CONFIG_11
000379r 2 F0 11 beq L25E5
00037Br 2 .endif
00037Br 2 B1 AC lda (LOWTRX),y
00037Dr 2 D0 10 bne L25E8
00037Fr 2 A8 tay
000380r 2 B1 AC lda (LOWTRX),y
000382r 2 AA tax
000383r 2 C8 iny
000384r 2 B1 AC lda (LOWTRX),y
000386r 2 86 AC stx LOWTRX
000388r 2 85 AD sta LOWTRX+1
00038Ar 2 .ifdef MICROTAN
00038Ar 2 bne L25A6X
00038Ar 2 .else
00038Ar 2 D0 C1 bne L25A6
00038Cr 2 .endif
00038Cr 2 L25E5:
00038Cr 2 4C rr rr jmp RESTART
00038Fr 2 L25E8:
00038Fr 2 10 E4 bpl L25CE
000391r 2 .ifdef CONFIG_DATAFLG
000391r 2 cmp #$FF
000391r 2 beq L25CE
000391r 2 bit DATAFLG
000391r 2 bmi L25CE
000391r 2 .endif
000391r 2 38 sec
000392r 2 E9 7F sbc #$7F
000394r 2 AA tax
000395r 2 84 96 sty FORPNT
000397r 2 A0 FF ldy #$FF
000399r 2 L25F2:
000399r 2 CA dex
00039Ar 2 F0 08 beq L25FD
00039Cr 2 L25F5:
00039Cr 2 C8 iny
00039Dr 2 B9 rr rr lda TOKEN_NAME_TABLE,y
0003A0r 2 10 FA bpl L25F5
0003A2r 2 30 F5 bmi L25F2
0003A4r 2 L25FD:
0003A4r 2 C8 iny
0003A5r 2 B9 rr rr lda TOKEN_NAME_TABLE,y
0003A8r 2 30 C7 bmi L25CA
0003AAr 2 20 rr rr jsr OUTDO
0003ADr 2 D0 F5 bne L25FD ; always
0003AFr 2
0003AFr 2
0003AFr 1 .include "flow1.s"
0003AFr 2 .segment "CODE"
0003AFr 2
0003AFr 2 ; ----------------------------------------------------------------------------
0003AFr 2 ; "FOR" STATEMENT
0003AFr 2 ;
0003AFr 2 ; FOR PUSHES 18 BYTES ON THE STACK:
0003AFr 2 ; 2 -- TXTPTR
0003AFr 2 ; 2 -- LINE NUMBER
0003AFr 2 ; 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE
0003AFr 2 ; 1 -- STEP SIGN
0003AFr 2 ; 5 -- STEP VALUE
0003AFr 2 ; 2 -- ADDRESS OF FOR VARIABLE IN VARTAB
0003AFr 2 ; 1 -- FOR TOKEN ($81)
0003AFr 2 ; ----------------------------------------------------------------------------
0003AFr 2 FOR:
0003AFr 2 A9 80 lda #$80
0003B1r 2 85 11 sta SUBFLG
0003B3r 2 20 rr rr jsr LET
0003B6r 2 20 rr rr jsr GTFORPNT
0003B9r 2 D0 05 bne L2619
0003BBr 2 8A txa
0003BCr 2 69 0F adc #FOR_STACK1
0003BEr 2 AA tax
0003BFr 2 9A txs
0003C0r 2 L2619:
0003C0r 2 68 pla
0003C1r 2 68 pla
0003C2r 2 A9 09 lda #FOR_STACK2
0003C4r 2 20 rr rr jsr CHKMEM
0003C7r 2 20 rr rr jsr DATAN
0003CAr 2 18 clc
0003CBr 2 98 tya
0003CCr 2 65 C7 adc TXTPTR
0003CEr 2 48 pha
0003CFr 2 A5 C8 lda TXTPTR+1
0003D1r 2 69 00 adc #$00
0003D3r 2 48 pha
0003D4r 2 A5 87 lda CURLIN+1
0003D6r 2 48 pha
0003D7r 2 A5 86 lda CURLIN
0003D9r 2 48 pha
0003DAr 2 A9 9E lda #TOKEN_TO
0003DCr 2 20 rr rr jsr SYNCHR
0003DFr 2 20 rr rr jsr CHKNUM
0003E2r 2 20 rr rr jsr FRMNUM
0003E5r 2 A5 B3 lda FACSIGN
0003E7r 2 09 7F ora #$7F
0003E9r 2 25 AF and FAC+1
0003EBr 2 85 AF sta FAC+1
0003EDr 2 A9 rr lda #<STEP
0003EFr 2 A0 rr ldy #>STEP
0003F1r 2 85 6F sta INDEX
0003F3r 2 84 70 sty INDEX+1
0003F5r 2 4C rr rr jmp FRM_STACK3
0003F8r 2
0003F8r 2 ; ----------------------------------------------------------------------------
0003F8r 2 ; "STEP" PHRASE OF "FOR" STATEMENT
0003F8r 2 ; ----------------------------------------------------------------------------
0003F8r 2 STEP:
0003F8r 2 A9 rr lda #<CON_ONE
0003FAr 2 A0 rr ldy #>CON_ONE
0003FCr 2 20 rr rr jsr LOAD_FAC_FROM_YA
0003FFr 2 20 C6 00 jsr CHRGOT
000402r 2 C9 A3 cmp #TOKEN_STEP
000404r 2 D0 06 bne L2665
000406r 2 20 C0 00 jsr CHRGET
000409r 2 20 rr rr jsr FRMNUM
00040Cr 2 L2665:
00040Cr 2 20 rr rr jsr SIGN
00040Fr 2 20 rr rr jsr FRM_STACK2
000412r 2 A5 97 lda FORPNT+1
000414r 2 48 pha
000415r 2 A5 96 lda FORPNT
000417r 2 48 pha
000418r 2 A9 81 lda #$81
00041Ar 2 48 pha
00041Br 2
00041Br 2 ; ----------------------------------------------------------------------------
00041Br 2 ; PERFORM NEXT STATEMENT
00041Br 2 ; ----------------------------------------------------------------------------
00041Br 2 NEWSTT:
00041Br 2 20 rr rr jsr ISCNTC
00041Er 2 A5 C7 lda TXTPTR
000420r 2 A4 C8 ldy TXTPTR+1
000422r 2 .if .def(CONFIG_NO_INPUTBUFFER_ZP) && .def(CONFIG_2)
000422r 2 cpy #>INPUTBUFFER
000422r 2 .ifdef CBM2
000422r 2 nop
000422r 2 .endif
000422r 2 beq LC6D4
000422r 2 .else
000422r 2 ; BUG on AppleSoft I,
000422r 2 ; fixed differently on AppleSoft II (ldx/inx)
000422r 2 F0 06 beq L2683
000424r 2 .endif
000424r 2 85 8A sta OLDTEXT
000426r 2 84 8B sty OLDTEXT+1
000428r 2 LC6D4:
000428r 2 A0 00 ldy #$00
00042Ar 2 L2683:
00042Ar 2 B1 C7 lda (TXTPTR),y
00042Cr 2 .ifndef CONFIG_11
00042Cr 2 beq LA5DC ; old: 1 cycle more on generic case
00042Cr 2 cmp #$3A
00042Cr 2 beq NEWSTT2
00042Cr 2 SYNERR1:
00042Cr 2 jmp SYNERR
00042Cr 2 LA5DC:
00042Cr 2 .else
00042Cr 2 D0 3D bne COLON; new: 1 cycle more on ":" case
00042Er 2 .endif
00042Er 2 A0 02 ldy #$02
000430r 2 B1 C7 lda (TXTPTR),y
000432r 2 18 clc
000433r 2 .ifdef CONFIG_2
000433r 2 jeq L2701
000433r 2 .else
000433r 2 F0 73 beq L2701
000435r 2 .endif
000435r 2 C8 iny
000436r 2 B1 C7 lda (TXTPTR),y
000438r 2 85 86 sta CURLIN
00043Ar 2 C8 iny
00043Br 2 B1 C7 lda (TXTPTR),y
00043Dr 2 85 87 sta CURLIN+1
00043Fr 2 98 tya
000440r 2 65 C7 adc TXTPTR
000442r 2 85 C7 sta TXTPTR
000444r 2 90 02 bcc NEWSTT2
000446r 2 E6 C8 inc TXTPTR+1
000448r 2 NEWSTT2:
000448r 2 20 C0 00 jsr CHRGET
00044Br 2 20 rr rr jsr EXECUTE_STATEMENT
00044Er 2 4C rr rr jmp NEWSTT
000451r 2
000451r 2 ; ----------------------------------------------------------------------------
000451r 2 ; EXECUTE A STATEMENT
000451r 2 ;
000451r 2 ; (A) IS FIRST CHAR OF STATEMENT
000451r 2 ; CARRY IS SET
000451r 2 ; ----------------------------------------------------------------------------
000451r 2 EXECUTE_STATEMENT:
000451r 2 .ifndef CONFIG_11A
000451r 2 beq RET1
000451r 2 .else
000451r 2 F0 2D beq RET2
000453r 2 .endif
000453r 2 .ifndef CONFIG_11
000453r 2 sec
000453r 2 .endif
000453r 2 EXECUTE_STATEMENT1:
000453r 2 E9 80 sbc #$80
000455r 2 .ifndef CONFIG_11
000455r 2 jcc LET ; old: 1 cycle more on instr.
000455r 2 .else
000455r 2 90 11 bcc LET1; new: 1 cycle more on assignment
000457r 2 .endif
000457r 2 C9 1D cmp #NUM_TOKENS
000459r 2 .ifdef CONFIG_2
000459r 2 bcs LC721
000459r 2 .else
000459r 2 B0 14 bcs SYNERR1
00045Br 2 .endif
00045Br 2 0A asl a
00045Cr 2 A8 tay
00045Dr 2 B9 rr rr lda TOKEN_ADDRESS_TABLE+1,y
000460r 2 48 pha
000461r 2 B9 rr rr lda TOKEN_ADDRESS_TABLE,y
000464r 2 48 pha
000465r 2 4C C0 00 jmp CHRGET
000468r 2
000468r 2 .ifdef CONFIG_11
000468r 2 LET1:
000468r 2 4C rr rr jmp LET
00046Br 2
00046Br 2 COLON:
00046Br 2 C9 3A cmp #$3A
00046Dr 2 F0 D9 beq NEWSTT2
00046Fr 2 SYNERR1:
00046Fr 2 4C rr rr jmp SYNERR
000472r 2 .endif
000472r 2
000472r 2 .ifdef CONFIG_2; GO TO
000472r 2 LC721:
000472r 2 cmp #TOKEN_GO-$80
000472r 2 bne SYNERR1
000472r 2 jsr CHRGET
000472r 2 lda #TOKEN_TO
000472r 2 jsr SYNCHR
000472r 2 jmp GOTO
000472r 2 .endif
000472r 2
000472r 2 ; ----------------------------------------------------------------------------
000472r 2 ; "RESTORE" STATEMENT
000472r 2 ; ----------------------------------------------------------------------------
000472r 2 RESTORE:
000472r 2 38 sec
000473r 2 A5 78 lda TXTTAB
000475r 2 E9 01 sbc #$01
000477r 2 A4 79 ldy TXTTAB+1
000479r 2 B0 01 bcs SETDA
00047Br 2 88 dey
00047Cr 2 SETDA:
00047Cr 2 85 8E sta DATPTR
00047Er 2 84 8F sty DATPTR+1
000480r 2 RET2:
000480r 2 60 rts
000481r 2
000481r 2 .include "iscntc.s"
000481r 3 .segment "CODE"
000481r 3 ; ----------------------------------------------------------------------------
000481r 3 ; SEE IF CONTROL-C TYPED
000481r 3 ; ----------------------------------------------------------------------------
000481r 3 .ifndef CONFIG_CBM_ALL
000481r 3 .include "cbm_iscntc.s"
000481r 4 ; nothing - ISCNTC is a KERNAL function
000481r 4
000481r 3 .endif
000481r 3 .ifdef KBD
000481r 3 .include "kbd_iscntc.s"
000481r 3 .endif
000481r 3 .ifdef OSI
000481r 3 .include "osi_iscntc.s"
000481r 3 .endif
000481r 3 .ifdef APPLE
000481r 3 .include "apple_iscntc.s"
000481r 3 .endif
000481r 3 .ifdef KIM
000481r 3 .include "kim_iscntc.s"
000481r 4 .segment "CODE"
000481r 4 ISCNTC:
000481r 4 A9 01 lda #$01
000483r 4 2C 40 17 bit $1740
000486r 4 30 F8 bmi RET2
000488r 4 A2 08 ldx #$08
00048Ar 4 A9 03 lda #$03
00048Cr 4 18 clc
00048Dr 4 C9 03 cmp #$03
00048Fr 4 ;!!! runs into "STOP"
00048Fr 4
00048Fr 3 .endif
00048Fr 3 .ifdef MICROTAN
00048Fr 3 .include "microtan_iscntc.s"
00048Fr 3 .endif
00048Fr 3 ;!!! runs into "STOP"
00048Fr 3
00048Fr 2 ;!!! runs into "STOP"
00048Fr 2 ; ----------------------------------------------------------------------------
00048Fr 2 ; "STOP" STATEMENT
00048Fr 2 ; ----------------------------------------------------------------------------
00048Fr 2 STOP:
00048Fr 2 B0 01 bcs END2
000491r 2
000491r 2 ; ----------------------------------------------------------------------------
000491r 2 ; "END" STATEMENT
000491r 2 ; ----------------------------------------------------------------------------
000491r 2 END:
000491r 2 18 clc
000492r 2 END2:
000492r 2 D0 3D bne RET1
000494r 2 A5 C7 lda TXTPTR
000496r 2 A4 C8 ldy TXTPTR+1
000498r 2 .if .def(CONFIG_NO_INPUTBUFFER_ZP) && .def(CONFIG_2)
000498r 2 ; BUG on AppleSoft I
000498r 2 ; fix exists on AppleSoft II
000498r 2 ; TXTPTR+1 will always be > 0
000498r 2 ldx CURLIN+1
000498r 2 inx
000498r 2 .endif
000498r 2 F0 0C beq END4
00049Ar 2 85 8A sta OLDTEXT
00049Cr 2 84 8B sty OLDTEXT+1
00049Er 2 CONTROL_C_TYPED:
00049Er 2 A5 86 lda CURLIN
0004A0r 2 A4 87 ldy CURLIN+1
0004A2r 2 85 88 sta OLDLIN
0004A4r 2 84 89 sty OLDLIN+1
0004A6r 2 END4:
0004A6r 2 68 pla
0004A7r 2 68 pla
0004A8r 2 L2701:
0004A8r 2 A9 rr lda #<QT_BREAK
0004AAr 2 A0 rr ldy #>QT_BREAK
0004ACr 2 .ifndef KBD
0004ACr 2 A2 00 ldx #$00
0004AEr 2 86 14 stx Z14
0004B0r 2 .endif
0004B0r 2 90 03 bcc L270E
0004B2r 2 4C rr rr jmp PRINT_ERROR_LINNUM
0004B5r 2 L270E:
0004B5r 2 4C rr rr jmp RESTART
0004B8r 2 .ifdef KBD
0004B8r 2 LE664:
0004B8r 2 tay
0004B8r 2 jmp SNGFLT
0004B8r 2 .endif
0004B8r 2
0004B8r 2 ; ----------------------------------------------------------------------------
0004B8r 2 ; "CONT" COMMAND
0004B8r 2 ; ----------------------------------------------------------------------------
0004B8r 2 CONT:
0004B8r 2 D0 17 bne RET1
0004BAr 2 A2 D2 ldx #ERR_CANTCONT
0004BCr 2 A4 8B ldy OLDTEXT+1
0004BEr 2 D0 03 bne L271C
0004C0r 2 4C rr rr jmp ERROR
0004C3r 2 L271C:
0004C3r 2 A5 8A lda OLDTEXT
0004C5r 2 85 C7 sta TXTPTR
0004C7r 2 84 C8 sty TXTPTR+1
0004C9r 2 A5 88 lda OLDLIN
0004CBr 2 A4 89 ldy OLDLIN+1
0004CDr 2 85 86 sta CURLIN
0004CFr 2 84 87 sty CURLIN+1
0004D1r 2 RET1:
0004D1r 2 60 rts
0004D2r 2
0004D2r 2 .ifdef KBD
0004D2r 2 PRT:
0004D2r 2 jsr GETBYT
0004D2r 2 txa
0004D2r 2 ; not ROR bug safe
0004D2r 2 ror a
0004D2r 2 ror a
0004D2r 2 ror a
0004D2r 2 sta $8F
0004D2r 2 rts
0004D2r 2
0004D2r 2 LE68C:
0004D2r 2 ldy #$12
0004D2r 2 LE68E:
0004D2r 2 lda LEA30,y
0004D2r 2 sta $03A2,y
0004D2r 2 dey
0004D2r 2 bpl LE68E
0004D2r 2 rts
0004D2r 2 .endif
0004D2r 2
0004D2r 2 .if .def(CONFIG_NULL) || .def(CONFIG_PRINTNULLS)
0004D2r 2 ; CBM1 has the keyword removed,
0004D2r 2 ; but the code is still here
0004D2r 2 NULL:
0004D2r 2 20 rr rr jsr GETBYT
0004D5r 2 D0 FA bne RET1
0004D7r 2 E8 inx
0004D8r 2 E0 F2 cpx #NULL_MAX
0004DAr 2 B0 04 bcs L2739
0004DCr 2 CA dex
0004DDr 2 86 15 stx Z15
0004DFr 2 60 rts
0004E0r 2 L2739:
0004E0r 2 4C rr rr jmp IQERR
0004E3r 2 .endif
0004E3r 2 .ifndef CONFIG_11A
0004E3r 2 CLEAR:
0004E3r 2 bne RET1
0004E3r 2 jmp CLEARC
0004E3r 2 .endif
0004E3r 2
0004E3r 1 .include "loadsave.s"
0004E3r 2 .segment "CODE"
0004E3r 2
0004E3r 2 .ifdef APPLE
0004E3r 2 .include "apple_loadsave.s"
0004E3r 2 .endif
0004E3r 2 .ifdef KIM
0004E3r 2 .include "kim_loadsave.s"
0004E3r 3 .segment "CODE"
0004E3r 3 SAVE:
0004E3r 3 BA tsx
0004E4r 3 86 12 stx INPUTFLG
0004E6r 3 A9 37 lda #$37
0004E8r 3 85 F2 sta $F2
0004EAr 3 A9 FE lda #$FE
0004ECr 3 8D F9 17 sta $17F9
0004EFr 3 A5 78 lda TXTTAB
0004F1r 3 A4 79 ldy TXTTAB+1
0004F3r 3 8D F5 17 sta $17F5
0004F6r 3 8C F6 17 sty $17F6
0004F9r 3 A5 7A lda VARTAB
0004FBr 3 A4 7B ldy VARTAB+1
0004FDr 3 8D F7 17 sta $17F7
000500r 3 8C F8 17 sty $17F8
000503r 3 4C 00 18 jmp L1800
000506r 3 A6 12 ldx INPUTFLG
000508r 3 9A txs
000509r 3 A9 rr lda #<QT_SAVED
00050Br 3 A0 rr ldy #>QT_SAVED
00050Dr 3 4C rr rr jmp STROUT
000510r 3 QT_LOADED:
000510r 3 4C 4F 41 44 .byte "LOADED"
000514r 3 45 44
000516r 3 00 .byte $00
000517r 3 QT_SAVED:
000517r 3 53 41 56 45 .byte "SAVED"
00051Br 3 44
00051Cr 3 0D 0A 00 00 .byte $0D,$0A,$00,$00,$00,$00,$00,$00
000520r 3 00 00 00 00
000524r 3 00 00 00 00 .byte $00,$00,$00,$00,$00,$00,$00,$00
000528r 3 00 00 00 00
00052Cr 3 00 00 00 00 .byte $00,$00,$00,$00,$00,$00,$00
000530r 3 00 00 00
000533r 3 LOAD:
000533r 3 A5 78 lda TXTTAB
000535r 3 A4 79 ldy TXTTAB+1
000537r 3 8D F5 17 sta $17F5
00053Ar 3 8C F6 17 sty $17F6
00053Dr 3 A9 FF lda #$FF
00053Fr 3 8D F9 17 sta $17F9
000542r 3 A9 rr lda #<L27A6
000544r 3 A0 rr ldy #>L27A6
000546r 3 85 01 sta GORESTART+1
000548r 3 84 02 sty GORESTART+2
00054Ar 3 4C 73 18 jmp L1873
00054Dr 3 L27A6:
00054Dr 3 A2 FF ldx #$FF
00054Fr 3 9A txs
000550r 3 A9 rr lda #<RESTART
000552r 3 A0 rr ldy #>RESTART
000554r 3 85 01 sta GORESTART+1
000556r 3 84 02 sty GORESTART+2
000558r 3 A9 rr lda #<QT_LOADED
00055Ar 3 A0 rr ldy #>QT_LOADED
00055Cr 3 20 rr rr jsr STROUT
00055Fr 3 AE ED 17 ldx $17ED
000562r 3 AC EE 17 ldy $17EE
000565r 3 8A txa
000566r 3 D0 01 bne L27C2
000568r 3 EA nop
000569r 3 L27C2:
000569r 3 EA nop
00056Ar 3 86 7A stx VARTAB
00056Cr 3 84 7B sty VARTAB+1
00056Er 3 4C rr rr jmp FIX_LINKS
000571r 3
000571r 2 .endif
000571r 2 .ifdef MICROTAN
000571r 2 .include "microtan_loadsave.s"
000571r 2 .endif
000571r 2
000571r 1 .include "flow2.s"
000571r 2 .segment "CODE"
000571r 2 ; ----------------------------------------------------------------------------
000571r 2 ; "RUN" COMMAND
000571r 2 ; ----------------------------------------------------------------------------
000571r 2 RUN:
000571r 2 D0 03 bne L27CF
000573r 2 4C rr rr jmp SETPTRS
000576r 2 L27CF:
000576r 2 20 rr rr jsr CLEARC
000579r 2 4C rr rr jmp L27E9
00057Cr 2
00057Cr 2 ; ----------------------------------------------------------------------------
00057Cr 2 ; "GOSUB" STATEMENT
00057Cr 2 ;
00057Cr 2 ; LEAVES 7 BYTES ON STACK:
00057Cr 2 ; 2 -- RETURN ADDRESS (NEWSTT)
00057Cr 2 ; 2 -- TXTPTR
00057Cr 2 ; 2 -- LINE #
00057Cr 2 ; 1 -- GOSUB TOKEN
00057Cr 2 ; ----------------------------------------------------------------------------
00057Cr 2 GOSUB:
00057Cr 2 A9 03 lda #$03
00057Er 2 20 rr rr jsr CHKMEM
000581r 2 A5 C8 lda TXTPTR+1
000583r 2 48 pha
000584r 2 A5 C7 lda TXTPTR
000586r 2 48 pha
000587r 2 A5 87 lda CURLIN+1
000589r 2 48 pha
00058Ar 2 A5 86 lda CURLIN
00058Cr 2 48 pha
00058Dr 2 A9 8C lda #TOKEN_GOSUB
00058Fr 2 48 pha
000590r 2 L27E9:
000590r 2 20 C6 00 jsr CHRGOT
000593r 2 20 rr rr jsr GOTO
000596r 2 4C rr rr jmp NEWSTT
000599r 2
000599r 2 ; ----------------------------------------------------------------------------
000599r 2 ; "GOTO" STATEMENT
000599r 2 ; ALSO USED BY "RUN" AND "GOSUB"
000599r 2 ; ----------------------------------------------------------------------------
000599r 2 GOTO:
000599r 2 20 rr rr jsr LINGET
00059Cr 2 20 rr rr jsr REMN
00059Fr 2 A5 87 lda CURLIN+1
0005A1r 2 C5 1A cmp LINNUM+1
0005A3r 2 B0 0B bcs L2809
0005A5r 2 98 tya
0005A6r 2 38 sec
0005A7r 2 65 C7 adc TXTPTR
0005A9r 2 A6 C8 ldx TXTPTR+1
0005ABr 2 90 07 bcc L280D
0005ADr 2 E8 inx
0005AEr 2 B0 04 bcs L280D
0005B0r 2 L2809:
0005B0r 2 A5 78 lda TXTTAB
0005B2r 2 A6 79 ldx TXTTAB+1
0005B4r 2 L280D:
0005B4r 2 .ifdef KBD
0005B4r 2 jsr LF457
0005B4r 2 bne UNDERR
0005B4r 2 .else
0005B4r 2 20 rr rr jsr FL1
0005B7r 2 90 1E bcc UNDERR
0005B9r 2 .endif
0005B9r 2 A5 AC lda LOWTRX
0005BBr 2 E9 01 sbc #$01
0005BDr 2 85 C7 sta TXTPTR
0005BFr 2 A5 AD lda LOWTRX+1
0005C1r 2 E9 00 sbc #$00
0005C3r 2 85 C8 sta TXTPTR+1
0005C5r 2 L281E:
0005C5r 2 60 rts
0005C6r 2
0005C6r 2 ; ----------------------------------------------------------------------------
0005C6r 2 ; "POP" AND "RETURN" STATEMENTS
0005C6r 2 ; ----------------------------------------------------------------------------
0005C6r 2 POP:
0005C6r 2 D0 FD bne L281E
0005C8r 2 A9 FF lda #$FF
0005CAr 2 .ifdef CONFIG_2A
0005CAr 2 sta FORPNT+1 ; bugfix, wrong in AppleSoft II
0005CAr 2 .else
0005CAr 2 85 96 sta FORPNT
0005CCr 2 .endif
0005CCr 2 20 rr rr jsr GTFORPNT
0005CFr 2 9A txs
0005D0r 2 C9 8C cmp #TOKEN_GOSUB
0005D2r 2 F0 0B beq RETURN
0005D4r 2 A2 16 ldx #ERR_NOGOSUB
0005D6r 2 2C .byte $2C
0005D7r 2 UNDERR:
0005D7r 2 A2 5A ldx #ERR_UNDEFSTAT
0005D9r 2 4C rr rr jmp ERROR
0005DCr 2 ; ----------------------------------------------------------------------------
0005DCr 2 SYNERR2:
0005DCr 2 4C rr rr jmp SYNERR
0005DFr 2 ; ----------------------------------------------------------------------------
0005DFr 2 RETURN:
0005DFr 2 68 pla
0005E0r 2 68 pla
0005E1r 2 85 86 sta CURLIN
0005E3r 2 68 pla
0005E4r 2 85 87 sta CURLIN+1
0005E6r 2 68 pla
0005E7r 2 85 C7 sta TXTPTR
0005E9r 2 68 pla
0005EAr 2 85 C8 sta TXTPTR+1
0005ECr 2
0005ECr 2 ; ----------------------------------------------------------------------------
0005ECr 2 ; "DATA" STATEMENT
0005ECr 2 ; EXECUTED BY SKIPPING TO NEXT COLON OR EOL
0005ECr 2 ; ----------------------------------------------------------------------------
0005ECr 2 DATA:
0005ECr 2 20 rr rr jsr DATAN
0005EFr 2
0005EFr 2 ; ----------------------------------------------------------------------------
0005EFr 2 ; ADD (Y) TO TXTPTR
0005EFr 2 ; ----------------------------------------------------------------------------
0005EFr 2 ADDON:
0005EFr 2 98 tya
0005F0r 2 18 clc
0005F1r 2 65 C7 adc TXTPTR
0005F3r 2 85 C7 sta TXTPTR
0005F5r 2 90 02 bcc L2852
0005F7r 2 E6 C8 inc TXTPTR+1
0005F9r 2 L2852:
0005F9r 2 60 rts
0005FAr 2
0005FAr 2 ; ----------------------------------------------------------------------------
0005FAr 2 ; SCAN AHEAD TO NEXT ":" OR EOL
0005FAr 2 ; ----------------------------------------------------------------------------
0005FAr 2 DATAN:
0005FAr 2 A2 3A ldx #$3A
0005FCr 2 2C .byte $2C
0005FDr 2 REMN:
0005FDr 2 A2 00 ldx #$00
0005FFr 2 86 0A stx CHARAC
000601r 2 A0 00 ldy #$00
000603r 2 84 0B sty ENDCHR
000605r 2 L285E:
000605r 2 A5 0B lda ENDCHR
000607r 2 A6 0A ldx CHARAC
000609r 2 85 0A sta CHARAC
00060Br 2 86 0B stx ENDCHR
00060Dr 2 L2866:
00060Dr 2 B1 C7 lda (TXTPTR),y
00060Fr 2 F0 E8 beq L2852
000611r 2 C5 0B cmp ENDCHR
000613r 2 F0 E4 beq L2852
000615r 2 C8 iny
000616r 2 C9 22 cmp #$22
000618r 2 .ifndef CONFIG_11
000618r 2 beq L285E; old: swap & cont is faster
000618r 2 bne L2866
000618r 2 .else
000618r 2 D0 F3 bne L2866; new: cont is faster
00061Ar 2 F0 E9 beq L285E
00061Cr 2 .endif
00061Cr 2
00061Cr 2 ; ----------------------------------------------------------------------------
00061Cr 2 ; "IF" STATEMENT
00061Cr 2 ; ----------------------------------------------------------------------------
00061Cr 2 IF:
00061Cr 2 20 rr rr jsr FRMEVL
00061Fr 2 20 C6 00 jsr CHRGOT
000622r 2 C9 88 cmp #TOKEN_GOTO
000624r 2 F0 05 beq L2884
000626r 2 A9 A1 lda #TOKEN_THEN
000628r 2 20 rr rr jsr SYNCHR
00062Br 2 L2884:
00062Br 2 A5 AE lda FAC
00062Dr 2 D0 05 bne L288D
00062Fr 2
00062Fr 2 ; ----------------------------------------------------------------------------
00062Fr 2 ; "REM" STATEMENT, OR FALSE "IF" STATEMENT
00062Fr 2 ; ----------------------------------------------------------------------------
00062Fr 2 REM:
00062Fr 2 20 rr rr jsr REMN
000632r 2 F0 BB beq ADDON
000634r 2 L288D:
000634r 2 20 C6 00 jsr CHRGOT
000637r 2 B0 03 bcs L2895
000639r 2 4C rr rr jmp GOTO
00063Cr 2 L2895:
00063Cr 2 4C rr rr jmp EXECUTE_STATEMENT
00063Fr 2
00063Fr 2 ; ----------------------------------------------------------------------------
00063Fr 2 ; "ON" STATEMENT
00063Fr 2 ;
00063Fr 2 ; ON <EXP> GOTO <LIST>
00063Fr 2 ; ON <EXP> GOSUB <LIST>
00063Fr 2 ; ----------------------------------------------------------------------------
00063Fr 2 ON:
00063Fr 2 20 rr rr jsr GETBYT
000642r 2 48 pha
000643r 2 C9 8C cmp #TOKEN_GOSUB
000645r 2 F0 04 beq L28A4
000647r 2 L28A0:
000647r 2 C9 88 cmp #TOKEN_GOTO
000649r 2 D0 91 bne SYNERR2
00064Br 2 L28A4:
00064Br 2 C6 B2 dec FAC_LAST
00064Dr 2 D0 04 bne L28AC
00064Fr 2 68 pla
000650r 2 4C rr rr jmp EXECUTE_STATEMENT1
000653r 2 L28AC:
000653r 2 20 C0 00 jsr CHRGET
000656r 2 20 rr rr jsr LINGET
000659r 2 C9 2C cmp #$2C
00065Br 2 F0 EE beq L28A4
00065Dr 2 68 pla
00065Er 2 L28B7:
00065Er 2 60 rts
00065Fr 2
00065Fr 1 .include "misc1.s"
00065Fr 2 .segment "CODE"
00065Fr 2
00065Fr 2 ; ----------------------------------------------------------------------------
00065Fr 2 ; CONVERT LINE NUMBER
00065Fr 2 ; ----------------------------------------------------------------------------
00065Fr 2 LINGET:
00065Fr 2 A2 00 ldx #$00
000661r 2 86 19 stx LINNUM
000663r 2 86 1A stx LINNUM+1
000665r 2 L28BE:
000665r 2 B0 F7 bcs L28B7
000667r 2 E9 2F sbc #$2F
000669r 2 85 0A sta CHARAC
00066Br 2 A5 1A lda LINNUM+1
00066Dr 2 85 6F sta INDEX
00066Fr 2 C9 19 cmp #$19
000671r 2 B0 D4 bcs L28A0
000673r 2 ; <<<<<DANGEROUS CODE>>>>>
000673r 2 ; NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
000673r 2 ; ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC
000673r 2 ; JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
000673r 2 ; FOR OTHER CALLS TO LINGET.
000673r 2 ;
000673r 2 ; YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
000673r 2 ; THEN TYPE "GO TO 437761".
000673r 2 ;
000673r 2 ; ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
000673r 2 ; THE PROBLEM. ($AB00 - $ABFF)
000673r 2 ; <<<<<DANGEROUS CODE>>>>>
000673r 2 A5 19 lda LINNUM
000675r 2 0A asl a
000676r 2 26 6F rol INDEX
000678r 2 0A asl a
000679r 2 26 6F rol INDEX
00067Br 2 65 19 adc LINNUM
00067Dr 2 85 19 sta LINNUM
00067Fr 2 A5 6F lda INDEX
000681r 2 65 1A adc LINNUM+1
000683r 2 85 1A sta LINNUM+1
000685r 2 06 19 asl LINNUM
000687r 2 26 1A rol LINNUM+1
000689r 2 A5 19 lda LINNUM
00068Br 2 65 0A adc CHARAC
00068Dr 2 85 19 sta LINNUM
00068Fr 2 90 02 bcc L28EC
000691r 2 E6 1A inc LINNUM+1
000693r 2 L28EC:
000693r 2 20 C0 00 jsr CHRGET
000696r 2 4C rr rr jmp L28BE
000699r 2
000699r 2 ; ----------------------------------------------------------------------------
000699r 2 ; "LET" STATEMENT
000699r 2 ;
000699r 2 ; LET <VAR> = <EXP>
000699r 2 ; <VAR> = <EXP>
000699r 2 ; ----------------------------------------------------------------------------
000699r 2 LET:
000699r 2 20 rr rr jsr PTRGET
00069Cr 2 85 96 sta FORPNT
00069Er 2 84 97 sty FORPNT+1
0006A0r 2 A9 AC lda #TOKEN_EQUAL
0006A2r 2 20 rr rr jsr SYNCHR
0006A5r 2 .ifndef CONFIG_SMALL
0006A5r 2 A5 0F lda VALTYP+1
0006A7r 2 48 pha
0006A8r 2 .endif
0006A8r 2 A5 0E lda VALTYP
0006AAr 2 48 pha
0006ABr 2 20 rr rr jsr FRMEVL
0006AEr 2 68 pla
0006AFr 2 2A rol a
0006B0r 2 20 rr rr jsr CHKVAL
0006B3r 2 D0 18 bne LETSTRING
0006B5r 2 .ifndef CONFIG_SMALL
0006B5r 2 68 pla
0006B6r 2 LET2:
0006B6r 2 10 12 bpl L2923
0006B8r 2 20 rr rr jsr ROUND_FAC
0006BBr 2 20 rr rr jsr AYINT
0006BEr 2 A0 00 ldy #$00
0006C0r 2 A5 B1 lda FAC+3
0006C2r 2 91 96 sta (FORPNT),y
0006C4r 2 C8 iny
0006C5r 2 A5 B2 lda FAC+4
0006C7r 2 91 96 sta (FORPNT),y
0006C9r 2 60 rts
0006CAr 2 L2923:
0006CAr 2 .endif
0006CAr 2
0006CAr 2 ; ----------------------------------------------------------------------------
0006CAr 2 ; REAL VARIABLE = EXPRESSION
0006CAr 2 ; ----------------------------------------------------------------------------
0006CAr 2 4C rr rr jmp SETFOR
0006CDr 2 LETSTRING:
0006CDr 2 .ifndef CONFIG_SMALL
0006CDr 2 68 pla
0006CEr 2 .endif
0006CEr 2
0006CEr 2 ; ----------------------------------------------------------------------------
0006CEr 2 ; INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4
0006CEr 2 ; ----------------------------------------------------------------------------
0006CEr 2 PUTSTR:
0006CEr 2 .ifdef CONFIG_CBM_ALL
0006CEr 2 ldy FORPNT+1
0006CEr 2 .ifdef CBM1
0006CEr 2 cpy #$D0 ; TI$
0006CEr 2 .else
0006CEr 2 cpy #$DE
0006CEr 2 .endif
0006CEr 2 bne LC92B
0006CEr 2 jsr FREFAC
0006CEr 2 cmp #$06
0006CEr 2 .ifdef CBM2
0006CEr 2 bne IQERR1
0006CEr 2 .else
0006CEr 2 jne IQERR
0006CEr 2 .endif
0006CEr 2 ldy #$00
0006CEr 2 sty FAC
0006CEr 2 sty FACSIGN
0006CEr 2 LC8E8:
0006CEr 2 sty STRNG2
0006CEr 2 jsr LC91C
0006CEr 2 jsr MUL10
0006CEr 2 inc STRNG2
0006CEr 2 ldy STRNG2
0006CEr 2 jsr LC91C
0006CEr 2 jsr COPY_FAC_TO_ARG_ROUNDED
0006CEr 2 tax
0006CEr 2 beq LC902
0006CEr 2 inx
0006CEr 2 txa
0006CEr 2 jsr LD9BF
0006CEr 2 LC902:
0006CEr 2 ldy STRNG2
0006CEr 2 iny
0006CEr 2 cpy #$06
0006CEr 2 bne LC8E8
0006CEr 2 jsr MUL10
0006CEr 2 jsr QINT
0006CEr 2 ldx #$02
0006CEr 2 sei
0006CEr 2 LC912:
0006CEr 2 lda FAC+2,x
0006CEr 2 sta TISTR,x
0006CEr 2 dex
0006CEr 2 bpl LC912
0006CEr 2 cli
0006CEr 2 rts
0006CEr 2 LC91C:
0006CEr 2 lda (INDEX),y
0006CEr 2 jsr CHRGOT2
0006CEr 2 bcc LC926
0006CEr 2 IQERR1:
0006CEr 2 jmp IQERR
0006CEr 2 LC926:
0006CEr 2 sbc #$2F
0006CEr 2 jmp ADDACC
0006CEr 2 LC92B:
0006CEr 2 .endif
0006CEr 2 A0 02 ldy #$02
0006D0r 2 B1 B1 lda (FAC_LAST-1),y
0006D2r 2 C5 81 cmp FRETOP+1
0006D4r 2 90 17 bcc L2946
0006D6r 2 D0 07 bne L2938
0006D8r 2 88 dey
0006D9r 2 B1 B1 lda (FAC_LAST-1),y
0006DBr 2 C5 80 cmp FRETOP
0006DDr 2 90 0E bcc L2946
0006DFr 2 L2938:
0006DFr 2 A4 B2 ldy FAC_LAST
0006E1r 2 C4 7B cpy VARTAB+1
0006E3r 2 90 08 bcc L2946
0006E5r 2 D0 0D bne L294D
0006E7r 2 A5 B1 lda FAC_LAST-1
0006E9r 2 C5 7A cmp VARTAB
0006EBr 2 B0 07 bcs L294D
0006EDr 2 L2946:
0006EDr 2 A5 B1 lda FAC_LAST-1
0006EFr 2 A4 B2 ldy FAC_LAST
0006F1r 2 4C rr rr jmp L2963
0006F4r 2 L294D:
0006F4r 2 A0 00 ldy #$00
0006F6r 2 B1 B1 lda (FAC_LAST-1),y
0006F8r 2 20 rr rr jsr STRINI
0006FBr 2 A5 9D lda DSCPTR
0006FDr 2 A4 9E ldy DSCPTR+1
0006FFr 2 85 BC sta STRNG1
000701r 2 84 BD sty STRNG1+1
000703r 2 20 rr rr jsr MOVINS
000706r 2 A9 AE lda #FAC
000708r 2 A0 00 ldy #$00
00070Ar 2 L2963:
00070Ar 2 85 9D sta DSCPTR
00070Cr 2 84 9E sty DSCPTR+1
00070Er 2 20 rr rr jsr FRETMS
000711r 2 A0 00 ldy #$00
000713r 2 B1 9D lda (DSCPTR),y
000715r 2 91 96 sta (FORPNT),y
000717r 2 C8 iny
000718r 2 B1 9D lda (DSCPTR),y
00071Ar 2 91 96 sta (FORPNT),y
00071Cr 2 C8 iny
00071Dr 2 B1 9D lda (DSCPTR),y
00071Fr 2 91 96 sta (FORPNT),y
000721r 2 60 rts
000722r 2 .ifdef CONFIG_FILE
000722r 2 PRINTH:
000722r 2 jsr CMD
000722r 2 jmp LCAD6
000722r 2 CMD:
000722r 2 jsr GETBYT
000722r 2 beq LC98F
000722r 2 lda #$2C
000722r 2 jsr SYNCHR
000722r 2 LC98F:
000722r 2 php
000722r 2 jsr CHKOUT
000722r 2 stx CURDVC
000722r 2 plp
000722r 2 jmp PRINT
000722r 2 .endif
000722r 2
000722r 2
000722r 1 .include "print.s"
000722r 2 .segment "CODE"
000722r 2
000722r 2 PRSTRING:
000722r 2 20 rr rr jsr STRPRT
000725r 2 L297E:
000725r 2 20 C6 00 jsr CHRGOT
000728r 2
000728r 2 ; ----------------------------------------------------------------------------
000728r 2 ; "PRINT" STATEMENT
000728r 2 ; ----------------------------------------------------------------------------
000728r 2 PRINT:
000728r 2 F0 3C beq CRDO
00072Ar 2 PRINT2:
00072Ar 2 F0 58 beq L29DD
00072Cr 2 C9 9D cmp #TOKEN_TAB
00072Er 2 F0 6C beq L29F5
000730r 2 C9 A0 cmp #TOKEN_SPC
000732r 2 .ifdef CONFIG_2
000732r 2 clc ; also AppleSoft II
000732r 2 .endif
000732r 2 F0 68 beq L29F5
000734r 2 C9 2C cmp #','
000736r 2 ; Pre-KIM had no CLC. KIM added the CLC
000736r 2 ; here. Post-KIM moved the CLC up...
000736r 2 ; (makes no sense on KIM, liveness = 0)
000736r 2 .if .def(CONFIG_11A) && (!.def(CONFIG_2))
000736r 2 18 clc
000737r 2 .endif
000737r 2 F0 4C beq L29DE
000739r 2 C9 3B cmp #$3B
00073Br 2 F0 77 beq L2A0D
00073Dr 2 20 rr rr jsr FRMEVL
000740r 2 24 0E bit VALTYP
000742r 2 30 DE bmi PRSTRING
000744r 2 20 rr rr jsr FOUT
000747r 2 20 rr rr jsr STRLIT
00074Ar 2 .ifndef CONFIG_NO_CR
00074Ar 2 A0 00 ldy #$00
00074Cr 2 B1 B1 lda (FAC_LAST-1),y
00074Er 2 18 clc
00074Fr 2 65 16 adc POSX
000751r 2 .ifdef KBD
000751r 2 cmp #$28
000751r 2 .else
000751r 2 C5 17 cmp Z17
000753r 2 .endif
000753r 2 90 03 bcc L29B1
000755r 2 20 rr rr jsr CRDO
000758r 2 L29B1:
000758r 2 .endif
000758r 2 20 rr rr jsr STRPRT
00075Br 2 .ifdef KBD
00075Br 2 jmp L297E
00075Br 2 .else
00075Br 2 20 rr rr jsr OUTSP
00075Er 2 D0 C5 bne L297E ; branch always
000760r 2 .endif
000760r 2
000760r 2 .ifdef KBD
000760r 2 ; PATCHES
000760r 2 LE86C:
000760r 2 pla
000760r 2 jmp CONTROL_C_TYPED
000760r 2 LE870:
000760r 2 jsr GETBYT
000760r 2 txa
000760r 2 LE874:
000760r 2 beq LE878
000760r 2 bpl LE8F2
000760r 2 LE878:
000760r 2 jmp IQERR
000760r 2 ; PATCHES
000760r 2 .endif
000760r 2
000760r 2
000760r 2
000760r 2 .ifndef KBD
000760r 2 L29B9:
000760r 2 .ifdef CBM2
000760r 2 lda #$00
000760r 2 sta INPUTBUFFER,x
000760r 2 ldx #<(INPUTBUFFER-1)
000760r 2 ldy #>(INPUTBUFFER-1)
000760r 2 .else
000760r 2 .ifndef APPLE
000760r 2 A0 00 ldy #$00
000762r 2 94 1B sty INPUTBUFFER,x
000764r 2 A2 1A ldx #LINNUM+1
000766r 2 .endif
000766r 2 .ifdef MICROTAN
000766r 2 bne CRDO2
000766r 2 .endif
000766r 2 .endif
000766r 2 .ifdef CONFIG_FILE
000766r 2 lda CURDVC
000766r 2 bne L29DD
000766r 2 .endif
000766r 2 .endif
000766r 2
000766r 2
000766r 2 CRDO:
000766r 2 .if .def(CONFIG_PRINTNULLS) && .def(CONFIG_FILE)
000766r 2 lda CURDVC
000766r 2 bne LC9D8
000766r 2 sta POSX
000766r 2 LC9D8:
000766r 2 .endif
000766r 2 A9 0D lda #CRLF_1
000768r 2 .ifndef CONFIG_CBM_ALL
000768r 2 85 16 sta POSX
00076Ar 2 .endif
00076Ar 2 20 rr rr jsr OUTDO
00076Dr 2 CRDO2:
00076Dr 2 A9 0A lda #CRLF_2
00076Fr 2 20 rr rr jsr OUTDO
000772r 2
000772r 2 PRINTNULLS:
000772r 2 .ifdef KBD
000772r 2 lda #$00
000772r 2 sta POSX
000772r 2 eor #$FF
000772r 2 .else
000772r 2 .if .def(CONFIG_NULL) || .def(CONFIG_PRINTNULLS)
000772r 2 .ifdef CONFIG_FILE
000772r 2 ; Although there is no statement for it,
000772r 2 ; CBM1 had NULL support and ignores
000772r 2 ; it when not targeting the screen,
000772r 2 ; CBM2 dropped it completely.
000772r 2 lda CURDVC
000772r 2 bne L29DD
000772r 2 .endif
000772r 2 8A txa
000773r 2 48 pha
000774r 2 A6 15 ldx Z15
000776r 2 F0 08 beq L29D9
000778r 2 A9 00 lda #$00
00077Ar 2 L29D3:
00077Ar 2 20 rr rr jsr OUTDO
00077Dr 2 CA dex
00077Er 2 D0 FA bne L29D3
000780r 2 L29D9:
000780r 2 86 16 stx POSX
000782r 2 68 pla
000783r 2 AA tax
000784r 2 .else
000784r 2 .ifndef CONFIG_2
000784r 2 lda #$00
000784r 2 sta POSX
000784r 2 .endif
000784r 2 eor #$FF
000784r 2 .endif
000784r 2 .endif
000784r 2 L29DD:
000784r 2 60 rts
000785r 2 L29DE:
000785r 2 A5 16 lda POSX
000787r 2 .ifndef CONFIG_NO_CR
000787r 2 .ifdef KBD
000787r 2 cmp #$1A
000787r 2 .else
000787r 2 C5 18 cmp Z18
000789r 2 .endif
000789r 2 90 06 bcc L29EA
00078Br 2 20 rr rr jsr CRDO
00078Er 2 4C rr rr jmp L2A0D
000791r 2 L29EA:
000791r 2 .endif
000791r 2 38 sec
000792r 2 L29EB:
000792r 2 .ifdef CONFIG_CBM_ALL
000792r 2 sbc #$0A
000792r 2 .else
000792r 2 .ifdef KBD
000792r 2 sbc #$0D
000792r 2 .else
000792r 2 E9 0E sbc #$0E
000794r 2 .endif
000794r 2 .endif
000794r 2 B0 FC bcs L29EB
000796r 2 49 FF eor #$FF
000798r 2 69 01 adc #$01
00079Ar 2 D0 13 bne L2A08
00079Cr 2 L29F5:
00079Cr 2 .ifdef CONFIG_11A
00079Cr 2 08 php
00079Dr 2 .else
00079Dr 2 pha
00079Dr 2 .endif
00079Dr 2 20 rr rr jsr GTBYTC
0007A0r 2 C9 29 cmp #')'
0007A2r 2 .ifdef CONFIG_11A
0007A2r 2 .ifdef CONFIG_2
0007A2r 2 bne SYNERR4
0007A2r 2 .else
0007A2r 2 F0 03 4C rr jne SYNERR
0007A6r 2 rr
0007A7r 2 .endif
0007A7r 2 28 plp
0007A8r 2 90 06 bcc L2A09
0007AAr 2 .else
0007AAr 2 .ifdef CONFIG_11
0007AAr 2 jne SYNERR
0007AAr 2 .else
0007AAr 2 bne SYNERR4
0007AAr 2 .endif
0007AAr 2 pla
0007AAr 2 cmp #TOKEN_TAB
0007AAr 2 .ifdef CONFIG_11
0007AAr 2 bne L2A09
0007AAr 2 .else
0007AAr 2 bne L2A0A
0007AAr 2 .endif
0007AAr 2 .endif
0007AAr 2 8A txa
0007ABr 2 E5 16 sbc POSX
0007ADr 2 90 05 bcc L2A0D
0007AFr 2 .ifndef CONFIG_11
0007AFr 2 beq L2A0D
0007AFr 2 .endif
0007AFr 2 L2A08:
0007AFr 2 AA tax
0007B0r 2 .ifdef CONFIG_11
0007B0r 2 L2A09:
0007B0r 2 E8 inx
0007B1r 2 .endif
0007B1r 2 L2A0A:
0007B1r 2 .ifndef CONFIG_11
0007B1r 2 jsr OUTSP
0007B1r 2 .endif
0007B1r 2 CA dex
0007B2r 2 .ifndef CONFIG_11
0007B2r 2 bne L2A0A
0007B2r 2 .else
0007B2r 2 D0 06 bne L2A13
0007B4r 2 .endif
0007B4r 2 L2A0D:
0007B4r 2 20 C0 00 jsr CHRGET
0007B7r 2 4C rr rr jmp PRINT2
0007BAr 2 .ifdef CONFIG_11
0007BAr 2 L2A13:
0007BAr 2 20 rr rr jsr OUTSP
0007BDr 2 D0 F2 bne L2A0A
0007BFr 2 .endif
0007BFr 2
0007BFr 2 ; ----------------------------------------------------------------------------
0007BFr 2 ; PRINT STRING AT (Y,A)
0007BFr 2 ; ----------------------------------------------------------------------------
0007BFr 2 STROUT:
0007BFr 2 20 rr rr jsr STRLIT
0007C2r 2
0007C2r 2 ; ----------------------------------------------------------------------------
0007C2r 2 ; PRINT STRING AT (FACMO,FACLO)
0007C2r 2 ; ----------------------------------------------------------------------------
0007C2r 2 STRPRT:
0007C2r 2 20 rr rr jsr FREFAC
0007C5r 2 AA tax
0007C6r 2 A0 00 ldy #$00
0007C8r 2 E8 inx
0007C9r 2 L2A22:
0007C9r 2 CA dex
0007CAr 2 F0 B8 beq L29DD
0007CCr 2 B1 6F lda (INDEX),y
0007CEr 2 20 rr rr jsr OUTDO
0007D1r 2 C8 iny
0007D2r 2 C9 0D cmp #$0D
0007D4r 2 D0 F3 bne L2A22
0007D6r 2 20 rr rr jsr PRINTNULLS
0007D9r 2 4C rr rr jmp L2A22
0007DCr 2 ; ----------------------------------------------------------------------------
0007DCr 2 OUTSP:
0007DCr 2 .ifdef CONFIG_FILE
0007DCr 2 .ifndef CBM1
0007DCr 2 ; on non-screen devices, print SPACE
0007DCr 2 ; instead of CRSR RIGHT
0007DCr 2 lda CURDVC
0007DCr 2 beq LCA40
0007DCr 2 lda #$20
0007DCr 2 .byte $2C
0007DCr 2 LCA40:
0007DCr 2 .endif
0007DCr 2 lda #$1D ; CRSR RIGHT
0007DCr 2 .else
0007DCr 2 A9 20 lda #$20
0007DEr 2 .endif
0007DEr 2 2C .byte $2C
0007DFr 2 OUTQUES:
0007DFr 2 A9 3F lda #$3F
0007E1r 2
0007E1r 2 ; ----------------------------------------------------------------------------
0007E1r 2 ; PRINT CHAR FROM (A)
0007E1r 2 ; ----------------------------------------------------------------------------
0007E1r 2 OUTDO:
0007E1r 2 .ifndef KBD
0007E1r 2 24 14 bit Z14
0007E3r 2 30 18 bmi L2A56
0007E5r 2 .endif
0007E5r 2 .if .def(CONFIG_PRINT_CR) || .def(CBM1)
0007E5r 2 ; Commodore forgot to remove this in CBM1
0007E5r 2 48 pha
0007E6r 2 .endif
0007E6r 2 .ifdef CBM1
0007E6r 2 cmp #$1D ; CRSR RIGHT
0007E6r 2 beq LCA6A
0007E6r 2 cmp #$9D ; CRSR LEFT
0007E6r 2 beq LCA5A
0007E6r 2 cmp #$14 ; DEL
0007E6r 2 bne LCA64
0007E6r 2 LCA5A:
0007E6r 2 lda POSX
0007E6r 2 beq L2A4E
0007E6r 2 lda CURDVC
0007E6r 2 bne L2A4E
0007E6r 2 dec POSX
0007E6r 2 LCA64:
0007E6r 2 and #$7F
0007E6r 2 .endif
0007E6r 2 .ifndef CBM2
0007E6r 2 C9 20 cmp #$20
0007E8r 2 90 0B bcc L2A4E
0007EAr 2 .endif
0007EAr 2 LCA6A:
0007EAr 2 .ifdef CONFIG_CBM1_PATCHES
0007EAr 2 lda CURDVC
0007EAr 2 jsr PATCH6
0007EAr 2 nop
0007EAr 2 .endif
0007EAr 2 .ifdef CONFIG_PRINT_CR
0007EAr 2 A5 16 lda POSX
0007ECr 2 C5 17 cmp Z17
0007EEr 2 D0 03 bne L2A4C
0007F0r 2 .ifdef APPLE
0007F0r 2 nop ; PATCH!
0007F0r 2 nop ; don't print CR
0007F0r 2 nop
0007F0r 2 .else
0007F0r 2 20 rr rr jsr CRDO
0007F3r 2 .endif
0007F3r 2 L2A4C:
0007F3r 2 .endif
0007F3r 2 .ifndef CONFIG_CBM_ALL
0007F3r 2 E6 16 inc POSX
0007F5r 2 .endif
0007F5r 2 L2A4E:
0007F5r 2 .if .def(CONFIG_PRINT_CR) || .def(CBM1)
0007F5r 2 ; Commodore forgot to remove this in CBM1
0007F5r 2 68 pla
0007F6r 2 .endif
0007F6r 2 .ifdef CONFIG_MONCOUT_DESTROYS_Y
0007F6r 2 84 0D sty DIMFLG
0007F8r 2 .endif
0007F8r 2 .ifdef CONFIG_IO_MSB
0007F8r 2 ora #$80
0007F8r 2 .endif
0007F8r 2 20 A0 1E jsr MONCOUT
0007FBr 2 .ifdef CONFIG_IO_MSB
0007FBr 2 and #$7F
0007FBr 2 .endif
0007FBr 2 .ifdef CONFIG_MONCOUT_DESTROYS_Y
0007FBr 2 A4 0D ldy DIMFLG
0007FDr 2 .endif
0007FDr 2 .ifdef OSI
0007FDr 2 nop
0007FDr 2 nop
0007FDr 2 nop
0007FDr 2 nop
0007FDr 2 .endif
0007FDr 2 L2A56:
0007FDr 2 29 FF and #$FF
0007FFr 2 LE8F2:
0007FFr 2 60 rts
000800r 2
000800r 2 ; ----------------------------------------------------------------------------
000800r 2 ; ???
000800r 2 ; ----------------------------------------------------------------------------
000800r 2 .ifdef KBD
000800r 2 LE8F3:
000800r 2 pha
000800r 2 lda $047F
000800r 2 clc
000800r 2 beq LE900
000800r 2 lda #$00
000800r 2 sta $047F
000800r 2 sec
000800r 2 LE900:
000800r 2 pla
000800r 2 rts
000800r 2 .endif
000800r 2
000800r 1 .include "input.s"
000800r 2 .segment "CODE"
000800r 2
000800r 2 ; ----------------------------------------------------------------------------
000800r 2 ; INPUT CONVERSION ERROR: ILLEGAL CHARACTER
000800r 2 ; IN NUMERIC FIELD. MUST DISTINGUISH
000800r 2 ; BETWEEN INPUT, READ, AND GET
000800r 2 ; ----------------------------------------------------------------------------
000800r 2 INPUTERR:
000800r 2 A5 12 lda INPUTFLG
000802r 2 F0 11 beq RESPERR ; INPUT
000804r 2 .ifndef CONFIG_SMALL
000804r 2 .ifdef CONFIG_10A
000804r 2 ; without this, it treats GET errors
000804r 2 ; like READ errors
000804r 2 30 04 bmi L2A63 ; READ
000806r 2 A0 FF ldy #$FF ; GET
000808r 2 D0 04 bne L2A67
00080Ar 2 L2A63:
00080Ar 2 .endif
00080Ar 2 .endif
00080Ar 2 .ifdef CONFIG_CBM1_PATCHES
00080Ar 2 jsr PATCH5
00080Ar 2 nop
00080Ar 2 .else
00080Ar 2 A5 8C lda Z8C
00080Cr 2 A4 8D ldy Z8C+1
00080Er 2 .endif
00080Er 2 L2A67:
00080Er 2 85 86 sta CURLIN
000810r 2 84 87 sty CURLIN+1
000812r 2 SYNERR4:
000812r 2 4C rr rr jmp SYNERR
000815r 2 RESPERR:
000815r 2 .ifdef CONFIG_FILE
000815r 2 lda CURDVC
000815r 2 beq LCA8F
000815r 2 ldx #ERR_BADDATA
000815r 2 jmp ERROR
000815r 2 LCA8F:
000815r 2 .endif
000815r 2 A9 rr lda #<ERRREENTRY
000817r 2 A0 rr ldy #>ERRREENTRY
000819r 2 20 rr rr jsr STROUT
00081Cr 2 A5 8A lda OLDTEXT
00081Er 2 A4 8B ldy OLDTEXT+1
000820r 2 85 C7 sta TXTPTR
000822r 2 84 C8 sty TXTPTR+1
000824r 2 RTS20:
000824r 2 60 rts
000825r 2
000825r 2 ; ----------------------------------------------------------------------------
000825r 2 ; "GET" STATEMENT
000825r 2 ; ----------------------------------------------------------------------------
000825r 2 .ifndef CONFIG_SMALL
000825r 2 GET:
000825r 2 20 rr rr jsr ERRDIR
000828r 2 ; CBM: if GET#, then switch input
000828r 2 .ifdef CONFIG_FILE
000828r 2 cmp #'#'
000828r 2 bne LCAB6
000828r 2 jsr CHRGET
000828r 2 jsr GETBYT
000828r 2 lda #','
000828r 2 jsr SYNCHR
000828r 2 jsr CHKIN
000828r 2 stx CURDVC
000828r 2 LCAB6:
000828r 2 .endif
000828r 2 A2 1C ldx #<(INPUTBUFFER+1)
00082Ar 2 A0 00 ldy #>(INPUTBUFFER+1)
00082Cr 2 .ifdef CONFIG_NO_INPUTBUFFER_ZP
00082Cr 2 lda #$00
00082Cr 2 sta INPUTBUFFER+1
00082Cr 2 .else
00082Cr 2 84 1C sty INPUTBUFFER+1
00082Er 2 .endif
00082Er 2 A9 40 lda #$40
000830r 2 20 rr rr jsr PROCESS_INPUT_LIST
000833r 2 ; CBM: if GET#, then switch input back
000833r 2 .ifdef CONFIG_FILE
000833r 2 ldx CURDVC
000833r 2 bne LCAD8
000833r 2 .endif
000833r 2 60 rts
000834r 2 .endif
000834r 2
000834r 2 ; ----------------------------------------------------------------------------
000834r 2 ; "INPUT#" STATEMENT
000834r 2 ; ----------------------------------------------------------------------------
000834r 2 .ifdef CONFIG_FILE
000834r 2 INPUTH:
000834r 2 jsr GETBYT
000834r 2 lda #$2C
000834r 2 jsr SYNCHR
000834r 2 jsr CHKIN
000834r 2 stx CURDVC
000834r 2 jsr L2A9E
000834r 2 LCAD6:
000834r 2 lda CURDVC
000834r 2 LCAD8:
000834r 2 jsr CLRCH
000834r 2 ldx #$00
000834r 2 stx CURDVC
000834r 2 rts
000834r 2 LCAE0:
000834r 2 .endif
000834r 2
000834r 2 ; ----------------------------------------------------------------------------
000834r 2 ; "INPUT" STATEMENT
000834r 2 ; ----------------------------------------------------------------------------
000834r 2 INPUT:
000834r 2 .ifndef KBD
000834r 2 46 14 lsr Z14
000836r 2 .endif
000836r 2 C9 22 cmp #$22
000838r 2 D0 0B bne L2A9E
00083Ar 2 20 rr rr jsr STRTXT
00083Dr 2 A9 3B lda #$3B
00083Fr 2 20 rr rr jsr SYNCHR
000842r 2 20 rr rr jsr STRPRT
000845r 2 L2A9E:
000845r 2 20 rr rr jsr ERRDIR
000848r 2 A9 2C lda #$2C
00084Ar 2 85 1A sta INPUTBUFFER-1
00084Cr 2 LCAF8:
00084Cr 2 .ifdef APPLE
00084Cr 2 jsr INLINX
00084Cr 2 .else
00084Cr 2 20 rr rr jsr NXIN
00084Fr 2 .endif
00084Fr 2 .ifdef KBD
00084Fr 2 bmi L2ABE
00084Fr 2 .else
00084Fr 2 .ifdef CONFIG_FILE
00084Fr 2 lda CURDVC
00084Fr 2 beq LCB0C
00084Fr 2 lda Z96
00084Fr 2 and #$02
00084Fr 2 beq LCB0C
00084Fr 2 jsr LCAD6
00084Fr 2 jmp DATA
00084Fr 2 LCB0C:
00084Fr 2 .endif
00084Fr 2 A5 1B lda INPUTBUFFER
000851r 2 D0 12 bne L2ABE
000853r 2 .ifdef CONFIG_FILE
000853r 2 lda CURDVC
000853r 2 bne LCAF8
000853r 2 .endif
000853r 2 .ifdef CONFIG_CBM1_PATCHES
000853r 2 jmp PATCH1
000853r 2 .else
000853r 2 18 clc
000854r 2 4C rr rr jmp CONTROL_C_TYPED
000857r 2 .endif
000857r 2 .endif
000857r 2
000857r 2 NXIN:
000857r 2 .ifdef KBD
000857r 2 jsr INLIN
000857r 2 bmi RTS20
000857r 2 pla
000857r 2 jmp LE86C
000857r 2 .else
000857r 2 .ifdef CONFIG_FILE
000857r 2 lda CURDVC
000857r 2 bne LCB21
000857r 2 .endif
000857r 2 20 rr rr jsr OUTQUES ; '?'
00085Ar 2 20 rr rr jsr OUTSP
00085Dr 2 LCB21:
00085Dr 2 4C rr rr jmp INLIN
000860r 2 .endif
000860r 2
000860r 2 ; ----------------------------------------------------------------------------
000860r 2 ; "GETC" STATEMENT
000860r 2 ; ----------------------------------------------------------------------------
000860r 2 .ifdef KBD
000860r 2 GETC:
000860r 2 jsr CONINT
000860r 2 jsr LF43D
000860r 2 jmp LE664
000860r 2 .endif
000860r 2
000860r 2 ; ----------------------------------------------------------------------------
000860r 2 ; "READ" STATEMENT
000860r 2 ; ----------------------------------------------------------------------------
000860r 2 READ:
000860r 2 A6 8E ldx DATPTR
000862r 2 A4 8F ldy DATPTR+1
000864r 2 .ifdef CONFIG_NO_READ_Y_IS_ZERO_HACK
000864r 2 ; AppleSoft II, too
000864r 2 lda #$98 ; READ
000864r 2 .byte $2C
000864r 2 L2ABE:
000864r 2 lda #$00 ; INPUT
000864r 2 .else
000864r 2 A9 .byte $A9 ; LDA #$98
000865r 2 L2ABE:
000865r 2 98 tya
000866r 2 .endif
000866r 2
000866r 2 ; ----------------------------------------------------------------------------
000866r 2 ; PROCESS INPUT LIST
000866r 2 ;
000866r 2 ; (Y,X) IS ADDRESS OF INPUT DATA STRING
000866r 2 ; (A) = VALUE FOR INPUTFLG: $00 FOR INPUT
000866r 2 ; $40 FOR GET
000866r 2 ; $98 FOR READ
000866r 2 ; ----------------------------------------------------------------------------
000866r 2 PROCESS_INPUT_LIST:
000866r 2 85 12 sta INPUTFLG
000868r 2 86 90 stx INPTR
00086Ar 2 84 91 sty INPTR+1
00086Cr 2 PROCESS_INPUT_ITEM:
00086Cr 2 20 rr rr jsr PTRGET
00086Fr 2 85 96 sta FORPNT
000871r 2 84 97 sty FORPNT+1
000873r 2 A5 C7 lda TXTPTR
000875r 2 A4 C8 ldy TXTPTR+1
000877r 2 85 19 sta TXPSV
000879r 2 84 1A sty TXPSV+1
00087Br 2 A6 90 ldx INPTR
00087Dr 2 A4 91 ldy INPTR+1
00087Fr 2 86 C7 stx TXTPTR
000881r 2 84 C8 sty TXTPTR+1
000883r 2 20 C6 00 jsr CHRGOT
000886r 2 D0 1B bne INSTART
000888r 2 24 12 bit INPUTFLG
00088Ar 2 .ifndef CONFIG_SMALL ; GET
00088Ar 2 50 0B bvc L2AF0
00088Cr 2 .ifdef MICROTAN
00088Cr 2 jsr MONRDKEY2
00088Cr 2 .else
00088Cr 2 20 5A 1E jsr MONRDKEY
00088Fr 2 .endif
00088Fr 2 .ifdef CONFIG_IO_MSB
00088Fr 2 and #$7F
00088Fr 2 .endif
00088Fr 2 85 1B sta INPUTBUFFER
000891r 2 ; BUG: The beq/bne L2AF8 below is supposed
000891r 2 ; to be always taken. For this to happen,
000891r 2 ; the last load must be a 0 for beq
000891r 2 ; and != 0 for bne. The original Microsoft
000891r 2 ; code had ldx/ldy/bne here, which was only
000891r 2 ; correct for a non-ZP INPUTBUFFER. Commodore
000891r 2 ; fixed it in CBMBASIC V1 by swapping the
000891r 2 ; ldx and the ldy. It was broken on KIM,
000891r 2 ; but okay on APPLE and CBM2, because
000891r 2 ; these used a non-ZP INPUTBUFFER.
000891r 2 ; Microsoft fixed this somewhere after KIM
000891r 2 ; and before MICROTAN, by using beq instead
000891r 2 ; of bne in the ZP case.
000891r 2 .ifdef CBM1
000891r 2 ldy #>(INPUTBUFFER-1)
000891r 2 ldx #<(INPUTBUFFER-1)
000891r 2 .else
000891r 2 A2 1A ldx #<(INPUTBUFFER-1)
000893r 2 A0 00 ldy #>(INPUTBUFFER-1)
000895r 2 .endif
000895r 2 .if .def(CONFIG_2) && (!.def(CONFIG_NO_INPUTBUFFER_ZP))
000895r 2 beq L2AF8 ; always
000895r 2 .else
000895r 2 D0 08 bne L2AF8 ; always
000897r 2 .endif
000897r 2 L2AF0:
000897r 2 .endif
000897r 2 30 71 bmi FINDATA
000899r 2 .ifdef CONFIG_FILE
000899r 2 lda CURDVC
000899r 2 bne LCB64
000899r 2 .endif
000899r 2 .ifdef KBD
000899r 2 jsr OUTQUESSP
000899r 2 .else
000899r 2 20 rr rr jsr OUTQUES
00089Cr 2 .endif
00089Cr 2 LCB64:
00089Cr 2 20 rr rr jsr NXIN
00089Fr 2 L2AF8:
00089Fr 2 86 C7 stx TXTPTR
0008A1r 2 84 C8 sty TXTPTR+1
0008A3r 2
0008A3r 2 ; ----------------------------------------------------------------------------
0008A3r 2 INSTART:
0008A3r 2 20 C0 00 jsr CHRGET
0008A6r 2 24 0E bit VALTYP
0008A8r 2 10 31 bpl L2B34
0008AAr 2 .ifndef CONFIG_SMALL ; GET
0008AAr 2 24 12 bit INPUTFLG
0008ACr 2 50 09 bvc L2B10
0008AEr 2 .ifdef CONFIG_CBM1_PATCHES
0008AEr 2 lda #$00
0008AEr 2 jsr PATCH4
0008AEr 2 nop
0008AEr 2 .else
0008AEr 2 E8 inx
0008AFr 2 86 C7 stx TXTPTR
0008B1r 2 A9 00 lda #$00
0008B3r 2 85 0A sta CHARAC
0008B5r 2 F0 0C beq L2B1C
0008B7r 2 .endif
0008B7r 2 L2B10:
0008B7r 2 .endif
0008B7r 2 85 0A sta CHARAC
0008B9r 2 C9 22 cmp #$22
0008BBr 2 F0 07 beq L2B1D
0008BDr 2 A9 3A lda #$3A
0008BFr 2 85 0A sta CHARAC
0008C1r 2 A9 2C lda #$2C
0008C3r 2 L2B1C:
0008C3r 2 18 clc
0008C4r 2 L2B1D:
0008C4r 2 85 0B sta ENDCHR
0008C6r 2 A5 C7 lda TXTPTR
0008C8r 2 A4 C8 ldy TXTPTR+1
0008CAr 2 69 00 adc #$00
0008CCr 2 90 01 bcc L2B28
0008CEr 2 C8 iny
0008CFr 2 L2B28:
0008CFr 2 20 rr rr jsr STRLT2
0008D2r 2 20 rr rr jsr POINT
0008D5r 2 .ifdef CONFIG_SMALL
0008D5r 2 jsr LETSTRING
0008D5r 2 .else
0008D5r 2 20 rr rr jsr PUTSTR
0008D8r 2 .endif
0008D8r 2 4C rr rr jmp INPUT_MORE
0008DBr 2 ; ----------------------------------------------------------------------------
0008DBr 2 L2B34:
0008DBr 2 20 rr rr jsr FIN
0008DEr 2 .ifdef CONFIG_SMALL
0008DEr 2 jsr SETFOR
0008DEr 2 .else
0008DEr 2 A5 0F lda VALTYP+1
0008E0r 2 20 rr rr jsr LET2
0008E3r 2 .endif
0008E3r 2 ; ----------------------------------------------------------------------------
0008E3r 2 INPUT_MORE:
0008E3r 2 20 C6 00 jsr CHRGOT
0008E6r 2 F0 07 beq L2B48
0008E8r 2 C9 2C cmp #$2C
0008EAr 2 F0 03 beq L2B48
0008ECr 2 4C rr rr jmp INPUTERR
0008EFr 2 L2B48:
0008EFr 2 A5 C7 lda TXTPTR
0008F1r 2 A4 C8 ldy TXTPTR+1
0008F3r 2 85 90 sta INPTR
0008F5r 2 84 91 sty INPTR+1
0008F7r 2 A5 19 lda TXPSV
0008F9r 2 A4 1A ldy TXPSV+1
0008FBr 2 85 C7 sta TXTPTR
0008FDr 2 84 C8 sty TXTPTR+1
0008FFr 2 20 C6 00 jsr CHRGOT
000902r 2 F0 2C beq INPDONE
000904r 2 20 rr rr jsr CHKCOM
000907r 2 4C rr rr jmp PROCESS_INPUT_ITEM
00090Ar 2 ; ----------------------------------------------------------------------------
00090Ar 2 FINDATA:
00090Ar 2 20 rr rr jsr DATAN
00090Dr 2 C8 iny
00090Er 2 AA tax
00090Fr 2 D0 12 bne L2B7C
000911r 2 A2 2A ldx #ERR_NODATA
000913r 2 C8 iny
000914r 2 B1 C7 lda (TXTPTR),y
000916r 2 F0 69 beq GERR
000918r 2 C8 iny
000919r 2 B1 C7 lda (TXTPTR),y
00091Br 2 85 8C sta Z8C
00091Dr 2 C8 iny
00091Er 2 B1 C7 lda (TXTPTR),y
000920r 2 C8 iny
000921r 2 85 8D sta Z8C+1
000923r 2 L2B7C:
000923r 2 B1 C7 lda (TXTPTR),y
000925r 2 AA tax
000926r 2 20 rr rr jsr ADDON
000929r 2 E0 83 cpx #$83
00092Br 2 D0 DD bne FINDATA
00092Dr 2 4C rr rr jmp INSTART
000930r 2 ; ---NO MORE INPUT REQUESTED------
000930r 2 INPDONE:
000930r 2 A5 90 lda INPTR
000932r 2 A4 91 ldy INPTR+1
000934r 2 A6 12 ldx INPUTFLG
000936r 2 .if .def(CONFIG_SMALL) && (!.def(CONFIG_11))
000936r 2 beq L2B94 ; INPUT
000936r 2 .else
000936r 2 10 03 bpl L2B94; INPUT or GET
000938r 2 .endif
000938r 2 4C rr rr jmp SETDA
00093Br 2 L2B94:
00093Br 2 A0 00 ldy #$00
00093Dr 2 B1 90 lda (INPTR),y
00093Fr 2 F0 07 beq L2BA1
000941r 2 .ifdef CONFIG_FILE
000941r 2 lda CURDVC
000941r 2 bne L2BA1
000941r 2 .endif
000941r 2 A9 rr lda #<ERREXTRA
000943r 2 A0 rr ldy #>ERREXTRA
000945r 2 4C rr rr jmp STROUT
000948r 2 L2BA1:
000948r 2 60 rts
000949r 2
000949r 2 ; ----------------------------------------------------------------------------
000949r 2 ERREXTRA:
000949r 2 .ifdef KBD
000949r 2 .byte "?Extra"
000949r 2 .else
000949r 2 3F 45 58 54 .byte "?EXTRA IGNORED"
00094Dr 2 52 41 20 49
000951r 2 47 4E 4F 52
000957r 2 .endif
000957r 2 0D 0A 00 .byte $0D,$0A,$00
00095Ar 2 ERRREENTRY:
00095Ar 2 .ifdef KBD
00095Ar 2 .byte "What?"
00095Ar 2 .else
00095Ar 2 3F 52 45 44 .byte "?REDO FROM START"
00095Er 2 4F 20 46 52
000962r 2 4F 4D 20 53
00096Ar 2 .endif
00096Ar 2 0D 0A 00 .byte $0D,$0A,$00
00096Dr 2 .ifdef KBD
00096Dr 2 LEA30:
00096Dr 2 .byte "B"
00096Dr 2 .byte $FD
00096Dr 2 .byte "GsBASIC"
00096Dr 2 .byte $00,$1B,$0D,$13
00096Dr 2 .byte " BASIC"
00096Dr 2 .endif
00096Dr 2
00096Dr 1 .include "eval.s"
00096Dr 2 .segment "CODE"
00096Dr 2
00096Dr 2 ; ----------------------------------------------------------------------------
00096Dr 2 ; "NEXT" STATEMENT
00096Dr 2 ; ----------------------------------------------------------------------------
00096Dr 2 NEXT:
00096Dr 2 D0 04 bne NEXT1
00096Fr 2 A0 00 ldy #$00
000971r 2 F0 03 beq NEXT2
000973r 2 NEXT1:
000973r 2 20 rr rr jsr PTRGET
000976r 2 NEXT2:
000976r 2 85 96 sta FORPNT
000978r 2 84 97 sty FORPNT+1
00097Ar 2 20 rr rr jsr GTFORPNT
00097Dr 2 F0 04 beq NEXT3
00097Fr 2 A2 00 ldx #$00
000981r 2 GERR:
000981r 2 F0 69 beq JERROR
000983r 2 NEXT3:
000983r 2 9A txs
000984r 2 .ifndef CONFIG_2
000984r 2 E8 inx
000985r 2 E8 inx
000986r 2 E8 inx
000987r 2 E8 inx
000988r 2 .endif
000988r 2 8A txa
000989r 2 .ifdef CONFIG_2
000989r 2 clc
000989r 2 adc #$04
000989r 2 pha
000989r 2 adc #BYTES_FP+1
000989r 2 sta DEST
000989r 2 pla
000989r 2 .else
000989r 2 E8 inx
00098Ar 2 E8 inx
00098Br 2 E8 inx
00098Cr 2 E8 inx
00098Dr 2 E8 inx
00098Er 2 .ifndef CONFIG_SMALL
00098Er 2 E8 inx
00098Fr 2 .endif
00098Fr 2 86 71 stx DEST
000991r 2 .endif
000991r 2 A0 01 ldy #>STACK
000993r 2 20 rr rr jsr LOAD_FAC_FROM_YA
000996r 2 BA tsx
000997r 2 BD 09 01 lda STACK+BYTES_FP+4,x
00099Ar 2 85 B3 sta FACSIGN
00099Cr 2 A5 96 lda FORPNT
00099Er 2 A4 97 ldy FORPNT+1
0009A0r 2 20 rr rr jsr FADD
0009A3r 2 20 rr rr jsr SETFOR
0009A6r 2 A0 01 ldy #>STACK
0009A8r 2 20 rr rr jsr FCOMP2
0009ABr 2 BA tsx
0009ACr 2 38 sec
0009ADr 2 FD 09 01 sbc STACK+BYTES_FP+4,x
0009B0r 2 F0 17 beq L2C22
0009B2r 2 BD 0F 01 lda STACK+2*BYTES_FP+5,x
0009B5r 2 85 86 sta CURLIN
0009B7r 2 BD 10 01 lda STACK+2*BYTES_FP+6,x
0009BAr 2 85 87 sta CURLIN+1
0009BCr 2 BD 12 01 lda STACK+2*BYTES_FP+8,x
0009BFr 2 85 C7 sta TXTPTR
0009C1r 2 BD 11 01 lda STACK+2*BYTES_FP+7,x
0009C4r 2 85 C8 sta TXTPTR+1
0009C6r 2 L2C1F:
0009C6r 2 4C rr rr jmp NEWSTT
0009C9r 2 L2C22:
0009C9r 2 8A txa
0009CAr 2 69 11 adc #2*BYTES_FP+7
0009CCr 2 AA tax
0009CDr 2 9A txs
0009CEr 2 20 C6 00 jsr CHRGOT
0009D1r 2 C9 2C cmp #$2C
0009D3r 2 D0 F1 bne L2C1F
0009D5r 2 20 C0 00 jsr CHRGET
0009D8r 2 20 rr rr jsr NEXT1
0009DBr 2
0009DBr 2 ; ----------------------------------------------------------------------------
0009DBr 2 ; EVALUATE EXPRESSION, MAKE SURE IT IS NUMERIC
0009DBr 2 ; ----------------------------------------------------------------------------
0009DBr 2 FRMNUM:
0009DBr 2 20 rr rr jsr FRMEVL
0009DEr 2
0009DEr 2 ; ----------------------------------------------------------------------------
0009DEr 2 ; MAKE SURE (FAC) IS NUMERIC
0009DEr 2 ; ----------------------------------------------------------------------------
0009DEr 2 CHKNUM:
0009DEr 2 18 clc
0009DFr 2 24 .byte $24
0009E0r 2
0009E0r 2 ; ----------------------------------------------------------------------------
0009E0r 2 ; MAKE SURE (FAC) IS STRING
0009E0r 2 ; ----------------------------------------------------------------------------
0009E0r 2 CHKSTR:
0009E0r 2 38 sec
0009E1r 2
0009E1r 2 ; ----------------------------------------------------------------------------
0009E1r 2 ; MAKE SURE (FAC) IS CORRECT TYPE
0009E1r 2 ; IF C=0, TYPE MUST BE NUMERIC
0009E1r 2 ; IF C=1, TYPE MUST BE STRING
0009E1r 2 ; ----------------------------------------------------------------------------
0009E1r 2 CHKVAL:
0009E1r 2 24 0E bit VALTYP
0009E3r 2 30 03 bmi L2C41
0009E5r 2 B0 03 bcs L2C43
0009E7r 2 L2C40:
0009E7r 2 60 rts
0009E8r 2 L2C41:
0009E8r 2 B0 FD bcs L2C40
0009EAr 2 L2C43:
0009EAr 2 A2 A3 ldx #ERR_BADTYPE
0009ECr 2 JERROR:
0009ECr 2 4C rr rr jmp ERROR
0009EFr 2
0009EFr 2 ; ----------------------------------------------------------------------------
0009EFr 2 ; EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE
0009EFr 2 ; RESULT IN FAC. WORKS FOR BOTH STRING AND NUMERIC
0009EFr 2 ; EXPRESSIONS.
0009EFr 2 ; ----------------------------------------------------------------------------
0009EFr 2 FRMEVL:
0009EFr 2 A6 C7 ldx TXTPTR
0009F1r 2 D0 02 bne L2C4E
0009F3r 2 C6 C8 dec TXTPTR+1
0009F5r 2 L2C4E:
0009F5r 2 C6 C7 dec TXTPTR
0009F7r 2 A2 00 ldx #$00
0009F9r 2 24 .byte $24
0009FAr 2 FRMEVL1:
0009FAr 2 48 pha
0009FBr 2 8A txa
0009FCr 2 48 pha
0009FDr 2 A9 01 lda #$01
0009FFr 2 20 rr rr jsr CHKMEM
000A02r 2 20 rr rr jsr FRM_ELEMENT
000A05r 2 A9 00 lda #$00
000A07r 2 85 9A sta CPRTYP
000A09r 2 FRMEVL2:
000A09r 2 20 C6 00 jsr CHRGOT
000A0Cr 2 L2C65:
000A0Cr 2 38 sec
000A0Dr 2 E9 AB sbc #TOKEN_GREATER
000A0Fr 2 90 17 bcc L2C81
000A11r 2 C9 03 cmp #$03
000A13r 2 B0 13 bcs L2C81
000A15r 2 C9 01 cmp #$01
000A17r 2 2A rol a
000A18r 2 49 01 eor #$01
000A1Ar 2 45 9A eor CPRTYP
000A1Cr 2 C5 9A cmp CPRTYP
000A1Er 2 90 61 bcc SNTXERR
000A20r 2 85 9A sta CPRTYP
000A22r 2 20 C0 00 jsr CHRGET
000A25r 2 4C rr rr jmp L2C65
000A28r 2 L2C81:
000A28r 2 A6 9A ldx CPRTYP
000A2Ar 2 D0 2C bne FRM_RELATIONAL
000A2Cr 2 B0 7B bcs L2D02
000A2Er 2 69 07 adc #$07
000A30r 2 90 77 bcc L2D02
000A32r 2 65 0E adc VALTYP
000A34r 2 D0 03 bne L2C92
000A36r 2 4C rr rr jmp CAT
000A39r 2 L2C92:
000A39r 2 69 FF adc #$FF
000A3Br 2 85 6F sta INDEX
000A3Dr 2 0A asl a
000A3Er 2 65 6F adc INDEX
000A40r 2 A8 tay
000A41r 2 FRM_PRECEDENCE_TEST:
000A41r 2 68 pla
000A42r 2 D9 rr rr cmp MATHTBL,y
000A45r 2 B0 67 bcs FRM_PERFORM1
000A47r 2 20 rr rr jsr CHKNUM
000A4Ar 2 L2CA3:
000A4Ar 2 48 pha
000A4Br 2 L2CA4:
000A4Br 2 20 rr rr jsr FRM_RECURSE
000A4Er 2 68 pla
000A4Fr 2 A4 98 ldy LASTOP
000A51r 2 10 17 bpl PREFNC
000A53r 2 AA tax
000A54r 2 F0 56 beq GOEX
000A56r 2 D0 5F bne FRM_PERFORM2
000A58r 2
000A58r 2 ; ----------------------------------------------------------------------------
000A58r 2 ; FOUND ONE OR MORE RELATIONAL OPERATORS <,=,>
000A58r 2 ; ----------------------------------------------------------------------------
000A58r 2 FRM_RELATIONAL:
000A58r 2 46 0E lsr VALTYP
000A5Ar 2 8A txa
000A5Br 2 2A rol a
000A5Cr 2 A6 C7 ldx TXTPTR
000A5Er 2 D0 02 bne L2CBB
000A60r 2 C6 C8 dec TXTPTR+1
000A62r 2 L2CBB:
000A62r 2 C6 C7 dec TXTPTR
000A64r 2 A0 1B ldy #$1B
000A66r 2 85 9A sta CPRTYP
000A68r 2 D0 D7 bne FRM_PRECEDENCE_TEST
000A6Ar 2 PREFNC:
000A6Ar 2 D9 rr rr cmp MATHTBL,y
000A6Dr 2 B0 48 bcs FRM_PERFORM2
000A6Fr 2 90 D9 bcc L2CA3
000A71r 2
000A71r 2 ; ----------------------------------------------------------------------------
000A71r 2 ; STACK THIS OPERATION AND CALL FRMEVL FOR
000A71r 2 ; ANOTHER ONE
000A71r 2 ; ----------------------------------------------------------------------------
000A71r 2 FRM_RECURSE:
000A71r 2 B9 rr rr lda MATHTBL+2,y
000A74r 2 48 pha
000A75r 2 B9 rr rr lda MATHTBL+1,y
000A78r 2 48 pha
000A79r 2 20 rr rr jsr FRM_STACK1
000A7Cr 2 A5 9A lda CPRTYP
000A7Er 2 4C rr rr jmp FRMEVL1
000A81r 2 SNTXERR:
000A81r 2 4C rr rr jmp SYNERR
000A84r 2
000A84r 2 ; ----------------------------------------------------------------------------
000A84r 2 ; STACK (FAC)
000A84r 2 ; THREE ENTRY POINTS:
000A84r 2 ; 1, FROM FRMEVL
000A84r 2 ; 2, FROM "STEP"
000A84r 2 ; 3, FROM "FOR"
000A84r 2 ; ----------------------------------------------------------------------------
000A84r 2 FRM_STACK1:
000A84r 2 A5 B3 lda FACSIGN
000A86r 2 BE rr rr ldx MATHTBL,y
000A89r 2
000A89r 2 ; ----------------------------------------------------------------------------
000A89r 2 ; ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE
000A89r 2 ; ----------------------------------------------------------------------------
000A89r 2 FRM_STACK2:
000A89r 2 A8 tay
000A8Ar 2 68 pla
000A8Br 2 85 6F sta INDEX
000A8Dr 2 .ifndef CONFIG_2B
000A8Dr 2 E6 6F inc INDEX ; bug: assumes not on page boundary
000A8Fr 2 ; bug exists on AppleSoft II
000A8Fr 2 .endif
000A8Fr 2 68 pla
000A90r 2 85 70 sta INDEX+1
000A92r 2 .ifdef CONFIG_2B
000A92r 2 inc INDEX
000A92r 2 bne LEB69
000A92r 2 inc INDEX+1
000A92r 2 LEB69:
000A92r 2 .endif
000A92r 2 98 tya
000A93r 2 48 pha
000A94r 2
000A94r 2 ; ----------------------------------------------------------------------------
000A94r 2 ; ENTER HERE FROM "FOR", WITH (INDEX) = STEP,
000A94r 2 ; TO PUSH INITIAL VALUE OF "FOR" VARIABLE
000A94r 2 ; ----------------------------------------------------------------------------
000A94r 2 FRM_STACK3:
000A94r 2 20 rr rr jsr ROUND_FAC
000A97r 2 .ifndef CONFIG_SMALL
000A97r 2 A5 B2 lda FAC+4
000A99r 2 48 pha
000A9Ar 2 .endif
000A9Ar 2 A5 B1 lda FAC+3
000A9Cr 2 48 pha
000A9Dr 2 A5 B0 lda FAC+2
000A9Fr 2 48 pha
000AA0r 2 A5 AF lda FAC+1
000AA2r 2 48 pha
000AA3r 2 A5 AE lda FAC
000AA5r 2 48 pha
000AA6r 2 6C 6F 00 jmp (INDEX)
000AA9r 2 L2D02:
000AA9r 2 A0 FF ldy #$FF
000AABr 2 68 pla
000AACr 2 GOEX:
000AACr 2 F0 23 beq EXIT
000AAEr 2
000AAEr 2 ; ----------------------------------------------------------------------------
000AAEr 2 ; PERFORM STACKED OPERATION
000AAEr 2 ;
000AAEr 2 ; (A) = PRECEDENCE BYTE
000AAEr 2 ; STACK: 1 -- CPRMASK
000AAEr 2 ; 5 -- (ARG)
000AAEr 2 ; 2 -- ADDR OF PERFORMER
000AAEr 2 ; ----------------------------------------------------------------------------
000AAEr 2 FRM_PERFORM1:
000AAEr 2 C9 64 cmp #$64
000AB0r 2 F0 03 beq L2D0E
000AB2r 2 20 rr rr jsr CHKNUM
000AB5r 2 L2D0E:
000AB5r 2 84 98 sty LASTOP
000AB7r 2 FRM_PERFORM2:
000AB7r 2 68 pla
000AB8r 2 4A lsr a
000AB9r 2 85 13 sta CPRMASK
000ABBr 2 68 pla
000ABCr 2 85 B6 sta ARG
000ABEr 2 68 pla
000ABFr 2 85 B7 sta ARG+1
000AC1r 2 68 pla
000AC2r 2 85 B8 sta ARG+2
000AC4r 2 68 pla
000AC5r 2 85 B9 sta ARG+3
000AC7r 2 68 pla
000AC8r 2 .ifndef CONFIG_SMALL
000AC8r 2 85 BA sta ARG+4
000ACAr 2 68 pla
000ACBr 2 .endif
000ACBr 2 85 BB sta ARGSIGN
000ACDr 2 45 B3 eor FACSIGN
000ACFr 2 85 BC sta SGNCPR
000AD1r 2 EXIT:
000AD1r 2 A5 AE lda FAC
000AD3r 2 60 rts
000AD4r 2
000AD4r 2 ; ----------------------------------------------------------------------------
000AD4r 2 ; GET ELEMENT IN EXPRESSION
000AD4r 2 ;
000AD4r 2 ; GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT
000AD4r 2 ; TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC.
000AD4r 2 ; ----------------------------------------------------------------------------
000AD4r 2 FRM_ELEMENT:
000AD4r 2 A9 00 lda #$00
000AD6r 2 85 0E sta VALTYP
000AD8r 2 L2D31:
000AD8r 2 20 C0 00 jsr CHRGET
000ADBr 2 B0 03 bcs L2D39
000ADDr 2 L2D36:
000ADDr 2 4C rr rr jmp FIN
000AE0r 2 L2D39:
000AE0r 2 20 rr rr jsr ISLETC
000AE3r 2 B0 67 bcs FRM_VARIABLE
000AE5r 2 .ifdef CONFIG_CBM_ALL
000AE5r 2 cmp #$FF
000AE5r 2 bne LCDC1
000AE5r 2 lda #<CON_PI
000AE5r 2 ldy #>CON_PI
000AE5r 2 jsr LOAD_FAC_FROM_YA
000AE5r 2 jmp CHRGET
000AE5r 2 CON_PI:
000AE5r 2 .byte $82,$49,$0f,$DA,$A1
000AE5r 2 LCDC1:
000AE5r 2 .endif
000AE5r 2 C9 2E cmp #$2E
000AE7r 2 F0 F4 beq L2D36
000AE9r 2 C9 A5 cmp #TOKEN_MINUS
000AEBr 2 F0 58 beq MIN
000AEDr 2 C9 A4 cmp #TOKEN_PLUS
000AEFr 2 F0 E7 beq L2D31
000AF1r 2 C9 22 cmp #$22
000AF3r 2 D0 0F bne NOT_
000AF5r 2
000AF5r 2 ; ----------------------------------------------------------------------------
000AF5r 2 ; STRING CONSTANT ELEMENT
000AF5r 2 ;
000AF5r 2 ; SET Y,A = (TXTPTR)+CARRY
000AF5r 2 ; ----------------------------------------------------------------------------
000AF5r 2 STRTXT:
000AF5r 2 A5 C7 lda TXTPTR
000AF7r 2 A4 C8 ldy TXTPTR+1
000AF9r 2 69 00 adc #$00
000AFBr 2 90 01 bcc L2D57
000AFDr 2 C8 iny
000AFEr 2 L2D57:
000AFEr 2 20 rr rr jsr STRLIT
000B01r 2 4C rr rr jmp POINT
000B04r 2
000B04r 2 ; ----------------------------------------------------------------------------
000B04r 2 ; "NOT" FUNCTION
000B04r 2 ; IF FAC=0, RETURN FAC=1
000B04r 2 ; IF FAC<>0, RETURN FAC=0
000B04r 2 ; ----------------------------------------------------------------------------
000B04r 2 NOT_:
000B04r 2 C9 A2 cmp #TOKEN_NOT
000B06r 2 D0 13 bne L2D74
000B08r 2 A0 18 ldy #$18
000B0Ar 2 D0 3B bne EQUL
000B0Cr 2
000B0Cr 2 ; ----------------------------------------------------------------------------
000B0Cr 2 ; COMPARISON FOR EQUALITY (= OPERATOR)
000B0Cr 2 ; ALSO USED TO EVALUATE "NOT" FUNCTION
000B0Cr 2 ; ----------------------------------------------------------------------------
000B0Cr 2 EQUOP:
000B0Cr 2 20 rr rr jsr AYINT
000B0Fr 2 A5 B2 lda FAC_LAST
000B11r 2 49 FF eor #$FF
000B13r 2 A8 tay
000B14r 2 A5 B1 lda FAC_LAST-1
000B16r 2 49 FF eor #$FF
000B18r 2 4C rr rr jmp GIVAYF
000B1Br 2 L2D74:
000B1Br 2 C9 9F cmp #TOKEN_FN
000B1Dr 2 D0 03 bne L2D7B
000B1Fr 2 4C rr rr jmp L31F3
000B22r 2 L2D7B:
000B22r 2 C9 AE cmp #TOKEN_SGN
000B24r 2 90 03 bcc PARCHK
000B26r 2 4C rr rr jmp UNARY
000B29r 2
000B29r 2 ; ----------------------------------------------------------------------------
000B29r 2 ; EVALUATE "(EXPRESSION)"
000B29r 2 ; ----------------------------------------------------------------------------
000B29r 2 PARCHK:
000B29r 2 20 rr rr jsr CHKOPN
000B2Cr 2 20 rr rr jsr FRMEVL
000B2Fr 2 CHKCLS:
000B2Fr 2 A9 29 lda #$29
000B31r 2 2C .byte $2C
000B32r 2 CHKOPN:
000B32r 2 A9 28 lda #$28
000B34r 2 2C .byte $2C
000B35r 2 CHKCOM:
000B35r 2 A9 2C lda #$2C
000B37r 2
000B37r 2 ; ----------------------------------------------------------------------------
000B37r 2 ; UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR
000B37r 2 ; ----------------------------------------------------------------------------
000B37r 2 SYNCHR: ; XXX all CBM code calls SYNCHR instead of CHKCOM
000B37r 2 A0 00 ldy #$00
000B39r 2 D1 C7 cmp (TXTPTR),y
000B3Br 2 D0 03 bne SYNERR
000B3Dr 2 4C C0 00 jmp CHRGET
000B40r 2 ; ----------------------------------------------------------------------------
000B40r 2 SYNERR:
000B40r 2 A2 10 ldx #ERR_SYNTAX
000B42r 2 4C rr rr jmp ERROR
000B45r 2 ; ----------------------------------------------------------------------------
000B45r 2 MIN:
000B45r 2 A0 15 ldy #$15
000B47r 2 EQUL:
000B47r 2 68 pla
000B48r 2 68 pla
000B49r 2 4C rr rr jmp L2CA4
000B4Cr 2 ; ----------------------------------------------------------------------------
000B4Cr 2 FRM_VARIABLE:
000B4Cr 2 20 rr rr jsr PTRGET
000B4Fr 2 FRM_VARIABLE_CALL = *-1
000B4Fr 2 85 B1 sta FAC_LAST-1
000B51r 2 84 B2 sty FAC_LAST
000B53r 2 .ifdef CONFIG_CBM_ALL
000B53r 2 lda VARNAM
000B53r 2 ldy VARNAM+1
000B53r 2 .endif
000B53r 2 A6 0E ldx VALTYP
000B55r 2 F0 01 beq L2DB1
000B57r 2 .ifdef CONFIG_CBM_ALL
000B57r 2 .ifdef CONFIG_CBM1_PATCHES
000B57r 2 jmp PATCH2
000B57r 2 clc
000B57r 2 LCE3B:
000B57r 2 .else
000B57r 2 ldx #$00
000B57r 2 stx STRNG1+1
000B57r 2 bit FAC+4
000B57r 2 bpl LCE53
000B57r 2 cmp #$54 ; T
000B57r 2 bne LCE53
000B57r 2 .endif
000B57r 2 cpy #$C9 ; I$
000B57r 2 bne LCE53
000B57r 2 jsr LCE76
000B57r 2 sty EXPON
000B57r 2 dey
000B57r 2 sty STRNG2
000B57r 2 ldy #$06
000B57r 2 sty INDX
000B57r 2 ldy #$24
000B57r 2 jsr LDD3A
000B57r 2 jmp LD353
000B57r 2 LCE53:
000B57r 2 .endif
000B57r 2 .ifdef CONFIG_2
000B57r 2 .ifndef CBM2
000B57r 2 ; bugfix?
000B57r 2 ; fixed on AppleSoft II, not on any CBM
000B57r 2 ldx #$00
000B57r 2 stx STRNG1+1
000B57r 2 .endif
000B57r 2 .endif
000B57r 2 60 rts
000B58r 2 L2DB1:
000B58r 2 .ifndef CONFIG_SMALL
000B58r 2 A6 0F ldx VALTYP+1
000B5Ar 2 10 0D bpl L2DC2
000B5Cr 2 A0 00 ldy #$00
000B5Er 2 B1 B1 lda (FAC+3),y
000B60r 2 AA tax
000B61r 2 C8 iny
000B62r 2 B1 B1 lda (FAC+3),y
000B64r 2 A8 tay
000B65r 2 8A txa
000B66r 2 4C rr rr jmp GIVAYF
000B69r 2 L2DC2:
000B69r 2 .endif
000B69r 2 .ifdef CONFIG_CBM1_PATCHES
000B69r 2 jmp PATCH3
000B69r 2 .byte $19
000B69r 2 .endif
000B69r 2 .ifdef CBM2
000B69r 2 bit FAC+4
000B69r 2 bpl LCE90
000B69r 2 cmp #$54
000B69r 2 bne LCE82
000B69r 2 .endif
000B69r 2 .ifndef CONFIG_CBM_ALL
000B69r 2 4C rr rr jmp LOAD_FAC_FROM_YA
000B6Cr 2 .endif
000B6Cr 2 .ifdef CONFIG_CBM_ALL
000B6Cr 2 LCE69:
000B6Cr 2 cpy #$49
000B6Cr 2 .ifdef CBM1
000B6Cr 2 bne LCE82
000B6Cr 2 .else
000B6Cr 2 bne LCE90
000B6Cr 2 .endif
000B6Cr 2 jsr LCE76
000B6Cr 2 tya
000B6Cr 2 ldx #$A0
000B6Cr 2 jmp LDB21
000B6Cr 2 LCE76:
000B6Cr 2 .ifdef CBM1
000B6Cr 2 lda #$FE
000B6Cr 2 ldy #$01
000B6Cr 2 .else
000B6Cr 2 lda #$8B
000B6Cr 2 ldy #$00
000B6Cr 2 .endif
000B6Cr 2 sei
000B6Cr 2 jsr LOAD_FAC_FROM_YA
000B6Cr 2 cli
000B6Cr 2 sty FAC+1
000B6Cr 2 rts
000B6Cr 2 LCE82:
000B6Cr 2 cmp #$53
000B6Cr 2 bne LCE90
000B6Cr 2 cpy #$54
000B6Cr 2 bne LCE90
000B6Cr 2 lda Z96
000B6Cr 2 jmp FLOAT
000B6Cr 2 LCE90:
000B6Cr 2 lda FAC+3
000B6Cr 2 ldy FAC+4
000B6Cr 2 jmp LOAD_FAC_FROM_YA
000B6Cr 2 .endif
000B6Cr 2
000B6Cr 2 ; ----------------------------------------------------------------------------
000B6Cr 2 UNARY:
000B6Cr 2 0A asl a
000B6Dr 2 48 pha
000B6Er 2 AA tax
000B6Fr 2 20 C0 00 jsr CHRGET
000B72r 2 E0 83 cpx #<(TOKEN_LEFTSTR*2-1)
000B74r 2 90 20 bcc L2DEF
000B76r 2 20 rr rr jsr CHKOPN
000B79r 2 20 rr rr jsr FRMEVL
000B7Cr 2 20 rr rr jsr CHKCOM
000B7Fr 2 20 rr rr jsr CHKSTR
000B82r 2 68 pla
000B83r 2 AA tax
000B84r 2 A5 B2 lda FAC_LAST
000B86r 2 48 pha
000B87r 2 A5 B1 lda FAC_LAST-1
000B89r 2 48 pha
000B8Ar 2 8A txa
000B8Br 2 48 pha
000B8Cr 2 20 rr rr jsr GETBYT
000B8Fr 2 68 pla
000B90r 2 A8 tay
000B91r 2 8A txa
000B92r 2 48 pha
000B93r 2 4C rr rr jmp L2DF4
000B96r 2 L2DEF:
000B96r 2 20 rr rr jsr PARCHK
000B99r 2 68 pla
000B9Ar 2 A8 tay
000B9Br 2 L2DF4:
000B9Br 2 B9 rr rr lda UNFNC-TOKEN_SGN-TOKEN_SGN+$100,y
000B9Er 2 85 A2 sta JMPADRS+1
000BA0r 2 B9 rr rr lda UNFNC-TOKEN_SGN-TOKEN_SGN+$101,y
000BA3r 2 85 A3 sta JMPADRS+2
000BA5r 2 .ifdef KBD
000BA5r 2 jsr LF47D
000BA5r 2 .else
000BA5r 2 20 A1 00 jsr JMPADRS
000BA8r 2 .endif
000BA8r 2 4C rr rr jmp CHKNUM
000BABr 2
000BABr 2 ; ----------------------------------------------------------------------------
000BABr 2 OR:
000BABr 2 A0 FF ldy #$FF
000BADr 2 2C .byte $2C
000BAEr 2 ; ----------------------------------------------------------------------------
000BAEr 2 TAND:
000BAEr 2 A0 00 ldy #$00
000BB0r 2 84 0C sty EOLPNTR
000BB2r 2 20 rr rr jsr AYINT
000BB5r 2 A5 B1 lda FAC_LAST-1
000BB7r 2 45 0C eor EOLPNTR
000BB9r 2 85 0A sta CHARAC
000BBBr 2 A5 B2 lda FAC_LAST
000BBDr 2 45 0C eor EOLPNTR
000BBFr 2 85 0B sta ENDCHR
000BC1r 2 20 rr rr jsr COPY_ARG_TO_FAC
000BC4r 2 20 rr rr jsr AYINT
000BC7r 2 A5 B2 lda FAC_LAST
000BC9r 2 45 0C eor EOLPNTR
000BCBr 2 25 0B and ENDCHR
000BCDr 2 45 0C eor EOLPNTR
000BCFr 2 A8 tay
000BD0r 2 A5 B1 lda FAC_LAST-1
000BD2r 2 45 0C eor EOLPNTR
000BD4r 2 25 0A and CHARAC
000BD6r 2 45 0C eor EOLPNTR
000BD8r 2 4C rr rr jmp GIVAYF
000BDBr 2
000BDBr 2 ; ----------------------------------------------------------------------------
000BDBr 2 ; PERFORM RELATIONAL OPERATIONS
000BDBr 2 ; ----------------------------------------------------------------------------
000BDBr 2 RELOPS:
000BDBr 2 20 rr rr jsr CHKVAL
000BDEr 2 B0 13 bcs STRCMP
000BE0r 2 A5 BB lda ARGSIGN
000BE2r 2 09 7F ora #$7F
000BE4r 2 25 B7 and ARG+1
000BE6r 2 85 B7 sta ARG+1
000BE8r 2 A9 B6 lda #<ARG
000BEAr 2 A0 00 ldy #$00
000BECr 2 20 rr rr jsr FCOMP
000BEFr 2 AA tax
000BF0r 2 4C rr rr jmp NUMCMP
000BF3r 2
000BF3r 2 ; ----------------------------------------------------------------------------
000BF3r 2 ; STRING COMPARISON
000BF3r 2 ; ----------------------------------------------------------------------------
000BF3r 2 STRCMP:
000BF3r 2 A9 00 lda #$00
000BF5r 2 85 0E sta VALTYP
000BF7r 2 C6 9A dec CPRTYP
000BF9r 2 20 rr rr jsr FREFAC
000BFCr 2 85 AE sta FAC
000BFEr 2 86 AF stx FAC+1
000C00r 2 84 B0 sty FAC+2
000C02r 2 A5 B9 lda ARG_LAST-1
000C04r 2 A4 BA ldy ARG_LAST
000C06r 2 20 rr rr jsr FRETMP
000C09r 2 86 B9 stx ARG_LAST-1
000C0Br 2 84 BA sty ARG_LAST
000C0Dr 2 AA tax
000C0Er 2 38 sec
000C0Fr 2 E5 AE sbc FAC
000C11r 2 F0 08 beq L2E74
000C13r 2 A9 01 lda #$01
000C15r 2 90 04 bcc L2E74
000C17r 2 A6 AE ldx FAC
000C19r 2 A9 FF lda #$FF
000C1Br 2 L2E74:
000C1Br 2 85 B3 sta FACSIGN
000C1Dr 2 A0 FF ldy #$FF
000C1Fr 2 E8 inx
000C20r 2 STRCMP1:
000C20r 2 C8 iny
000C21r 2 CA dex
000C22r 2 D0 07 bne L2E84
000C24r 2 A6 B3 ldx FACSIGN
000C26r 2 NUMCMP:
000C26r 2 30 0F bmi CMPDONE
000C28r 2 18 clc
000C29r 2 90 0C bcc CMPDONE
000C2Br 2 L2E84:
000C2Br 2 B1 B9 lda (ARG_LAST-1),y
000C2Dr 2 D1 AF cmp (FAC+1),y
000C2Fr 2 F0 EF beq STRCMP1
000C31r 2 A2 FF ldx #$FF
000C33r 2 B0 02 bcs CMPDONE
000C35r 2 A2 01 ldx #$01
000C37r 2 CMPDONE:
000C37r 2 E8 inx
000C38r 2 8A txa
000C39r 2 2A rol a
000C3Ar 2 25 13 and CPRMASK
000C3Cr 2 F0 02 beq L2E99
000C3Er 2 A9 FF lda #$FF
000C40r 2 L2E99:
000C40r 2 4C rr rr jmp FLOAT
000C43r 2
000C43r 1 .include "var.s"
000C43r 2 .segment "CODE"
000C43r 2
000C43r 2 ; ----------------------------------------------------------------------------
000C43r 2 ; "DIM" STATEMENT
000C43r 2 ; ----------------------------------------------------------------------------
000C43r 2 NXDIM:
000C43r 2 20 rr rr jsr CHKCOM
000C46r 2 DIM:
000C46r 2 AA tax
000C47r 2 20 rr rr jsr PTRGET2
000C4Ar 2 20 C6 00 jsr CHRGOT
000C4Dr 2 D0 F4 bne NXDIM
000C4Fr 2 60 rts
000C50r 2
000C50r 2 ; ----------------------------------------------------------------------------
000C50r 2 ; PTRGET -- GENERAL VARIABLE SCAN
000C50r 2 ;
000C50r 2 ; SCANS VARIABLE NAME AT TXTPTR, AND SEARCHES THE
000C50r 2 ; VARTAB AND ARYTAB FOR THE NAME.
000C50r 2 ; IF NOT FOUND, CREATE VARIABLE OF APPROPRIATE TYPE.
000C50r 2 ; RETURN WITH ADDRESS IN VARPNT AND Y,A
000C50r 2 ;
000C50r 2 ; ACTUAL ACTIVITY CONTROLLED SOMEWHAT BY TWO FLAGS:
000C50r 2 ; DIMFLG -- NONZERO IF CALLED FROM "DIM"
000C50r 2 ; ELSE = 0
000C50r 2 ;
000C50r 2 ; SUBFLG -- = $00
000C50r 2 ; = $40 IF CALLED FROM "GETARYPT"
000C50r 2 ; ----------------------------------------------------------------------------
000C50r 2 PTRGET:
000C50r 2 A2 00 ldx #$00
000C52r 2 20 C6 00 jsr CHRGOT
000C55r 2 PTRGET2:
000C55r 2 86 0D stx DIMFLG
000C57r 2 PTRGET3:
000C57r 2 85 92 sta VARNAM
000C59r 2 20 C6 00 jsr CHRGOT
000C5Cr 2 20 rr rr jsr ISLETC
000C5Fr 2 B0 03 bcs NAMOK
000C61r 2 SYNERR3:
000C61r 2 4C rr rr jmp SYNERR
000C64r 2 NAMOK:
000C64r 2 A2 00 ldx #$00
000C66r 2 86 0E stx VALTYP
000C68r 2 .ifndef CONFIG_SMALL
000C68r 2 86 0F stx VALTYP+1
000C6Ar 2 .endif
000C6Ar 2 20 C0 00 jsr CHRGET
000C6Dr 2 90 05 bcc L2ECD
000C6Fr 2 20 rr rr jsr ISLETC
000C72r 2 90 0B bcc L2ED8
000C74r 2 L2ECD:
000C74r 2 AA tax
000C75r 2 L2ECE:
000C75r 2 20 C0 00 jsr CHRGET
000C78r 2 90 FB bcc L2ECE
000C7Ar 2 20 rr rr jsr ISLETC
000C7Dr 2 B0 F6 bcs L2ECE
000C7Fr 2 L2ED8:
000C7Fr 2 C9 24 cmp #$24
000C81r 2 .ifdef CONFIG_SMALL
000C81r 2 bne L2EF9
000C81r 2 .else
000C81r 2 D0 06 bne L2EE2
000C83r 2 .endif
000C83r 2 A9 FF lda #$FF
000C85r 2 85 0E sta VALTYP
000C87r 2 .ifndef CONFIG_SMALL
000C87r 2 D0 10 bne L2EF2
000C89r 2 L2EE2:
000C89r 2 C9 25 cmp #$25
000C8Br 2 D0 13 bne L2EF9
000C8Dr 2 A5 11 lda SUBFLG
000C8Fr 2 D0 D0 bne SYNERR3
000C91r 2 A9 80 lda #$80
000C93r 2 85 0F sta VALTYP+1
000C95r 2 05 92 ora VARNAM
000C97r 2 85 92 sta VARNAM
000C99r 2 L2EF2:
000C99r 2 .endif
000C99r 2 8A txa
000C9Ar 2 09 80 ora #$80
000C9Cr 2 AA tax
000C9Dr 2 20 C0 00 jsr CHRGET
000CA0r 2 L2EF9:
000CA0r 2 86 93 stx VARNAM+1
000CA2r 2 38 sec
000CA3r 2 05 11 ora SUBFLG
000CA5r 2 E9 28 sbc #$28
000CA7r 2 D0 03 bne L2F05
000CA9r 2 4C rr rr jmp ARRAY
000CACr 2 L2F05:
000CACr 2 A9 00 lda #$00
000CAEr 2 85 11 sta SUBFLG
000CB0r 2 A5 7A lda VARTAB
000CB2r 2 A6 7B ldx VARTAB+1
000CB4r 2 A0 00 ldy #$00
000CB6r 2 L2F0F:
000CB6r 2 86 AD stx LOWTR+1
000CB8r 2 L2F11:
000CB8r 2 85 AC sta LOWTR
000CBAr 2 E4 7D cpx ARYTAB+1
000CBCr 2 D0 04 bne L2F1B
000CBEr 2 C5 7C cmp ARYTAB
000CC0r 2 F0 22 beq NAMENOTFOUND
000CC2r 2 L2F1B:
000CC2r 2 A5 92 lda VARNAM
000CC4r 2 D1 AC cmp (LOWTR),y
000CC6r 2 D0 08 bne L2F29
000CC8r 2 A5 93 lda VARNAM+1
000CCAr 2 C8 iny
000CCBr 2 D1 AC cmp (LOWTR),y
000CCDr 2 F0 6C beq SET_VARPNT_AND_YA
000CCFr 2 88 dey
000CD0r 2 L2F29:
000CD0r 2 18 clc
000CD1r 2 A5 AC lda LOWTR
000CD3r 2 69 07 adc #BYTES_PER_VARIABLE
000CD5r 2 90 E1 bcc L2F11
000CD7r 2 E8 inx
000CD8r 2 D0 DC bne L2F0F
000CDAr 2
000CDAr 2 ; ----------------------------------------------------------------------------
000CDAr 2 ; CHECK IF (A) IS ASCII LETTER A-Z
000CDAr 2 ;
000CDAr 2 ; RETURN CARRY = 1 IF A-Z
000CDAr 2 ; = 0 IF NOT
000CDAr 2 ; ----------------------------------------------------------------------------
000CDAr 2 ISLETC:
000CDAr 2 C9 41 cmp #$41
000CDCr 2 90 05 bcc L2F3C
000CDEr 2 E9 5B sbc #$5B
000CE0r 2 38 sec
000CE1r 2 E9 A5 sbc #$A5
000CE3r 2 L2F3C:
000CE3r 2 60 rts
000CE4r 2
000CE4r 2 ; ----------------------------------------------------------------------------
000CE4r 2 ; VARIABLE NOT FOUND, SO MAKE ONE
000CE4r 2 ; ----------------------------------------------------------------------------
000CE4r 2 NAMENOTFOUND:
000CE4r 2 68 pla
000CE5r 2 48 pha
000CE6r 2 C9 rr cmp #<FRM_VARIABLE_CALL
000CE8r 2 D0 0F bne MAKENEWVARIABLE
000CEAr 2 .ifdef CONFIG_SAFE_NAMENOTFOUND
000CEAr 2 BA tsx
000CEBr 2 BD 02 01 lda STACK+2,x
000CEEr 2 C9 rr cmp #>FRM_VARIABLE_CALL
000CF0r 2 D0 07 bne MAKENEWVARIABLE
000CF2r 2 .endif
000CF2r 2 LD015:
000CF2r 2 A9 rr lda #<C_ZERO
000CF4r 2 A0 rr ldy #>C_ZERO
000CF6r 2 60 rts
000CF7r 2
000CF7r 2 ; ----------------------------------------------------------------------------
000CF7r 2 .ifndef CONFIG_2
000CF7r 2 C_ZERO:
000CF7r 2 00 00 .byte $00,$00
000CF9r 2 .endif
000CF9r 2
000CF9r 2 ; ----------------------------------------------------------------------------
000CF9r 2 ; MAKE A NEW SIMPLE VARIABLE
000CF9r 2 ;
000CF9r 2 ; MOVE ARRAYS UP 7 BYTES TO MAKE ROOM FOR NEW VARIABLE
000CF9r 2 ; ENTER 7-BYTE VARIABLE DATA IN THE HOLE
000CF9r 2 ; ----------------------------------------------------------------------------
000CF9r 2 MAKENEWVARIABLE:
000CF9r 2 .ifdef CONFIG_CBM_ALL
000CF9r 2 lda VARNAM
000CF9r 2 ldy VARNAM+1
000CF9r 2 cmp #$54
000CF9r 2 bne LD02F
000CF9r 2 cpy #$C9
000CF9r 2 beq LD015
000CF9r 2 cpy #$49
000CF9r 2 bne LD02F
000CF9r 2 LD02C:
000CF9r 2 jmp SYNERR
000CF9r 2 LD02F:
000CF9r 2 cmp #$53
000CF9r 2 bne LD037
000CF9r 2 cpy #$54
000CF9r 2 beq LD02C
000CF9r 2 LD037:
000CF9r 2 .endif
000CF9r 2 A5 7C lda ARYTAB
000CFBr 2 A4 7D ldy ARYTAB+1
000CFDr 2 85 AC sta LOWTR
000CFFr 2 84 AD sty LOWTR+1
000D01r 2 A5 7E lda STREND
000D03r 2 A4 7F ldy STREND+1
000D05r 2 85 A7 sta HIGHTR
000D07r 2 84 A8 sty HIGHTR+1
000D09r 2 18 clc
000D0Ar 2 69 07 adc #BYTES_PER_VARIABLE
000D0Cr 2 90 01 bcc L2F68
000D0Er 2 C8 iny
000D0Fr 2 L2F68:
000D0Fr 2 85 A5 sta HIGHDS
000D11r 2 84 A6 sty HIGHDS+1
000D13r 2 20 rr rr jsr BLTU
000D16r 2 A5 A5 lda HIGHDS
000D18r 2 A4 A6 ldy HIGHDS+1
000D1Ar 2 C8 iny
000D1Br 2 85 7C sta ARYTAB
000D1Dr 2 84 7D sty ARYTAB+1
000D1Fr 2 A0 00 ldy #$00
000D21r 2 A5 92 lda VARNAM
000D23r 2 91 AC sta (LOWTR),y
000D25r 2 C8 iny
000D26r 2 A5 93 lda VARNAM+1
000D28r 2 91 AC sta (LOWTR),y
000D2Ar 2 A9 00 lda #$00
000D2Cr 2 C8 iny
000D2Dr 2 91 AC sta (LOWTR),y
000D2Fr 2 C8 iny
000D30r 2 91 AC sta (LOWTR),y
000D32r 2 C8 iny
000D33r 2 91 AC sta (LOWTR),y
000D35r 2 C8 iny
000D36r 2 91 AC sta (LOWTR),y
000D38r 2 .ifndef CONFIG_SMALL
000D38r 2 C8 iny
000D39r 2 91 AC sta (LOWTR),y
000D3Br 2 .endif
000D3Br 2
000D3Br 2 ; ----------------------------------------------------------------------------
000D3Br 2 ; PUT ADDRESS OF VALUE OF VARIABLE IN VARPNT AND Y,A
000D3Br 2 ; ----------------------------------------------------------------------------
000D3Br 2 SET_VARPNT_AND_YA:
000D3Br 2 A5 AC lda LOWTR
000D3Dr 2 18 clc
000D3Er 2 69 02 adc #$02
000D40r 2 A4 AD ldy LOWTR+1
000D42r 2 90 01 bcc L2F9E
000D44r 2 C8 iny
000D45r 2 L2F9E:
000D45r 2 85 94 sta VARPNT
000D47r 2 84 95 sty VARPNT+1
000D49r 2 60 rts
000D4Ar 2
000D4Ar 1 .include "array.s"
000D4Ar 2 .segment "CODE"
000D4Ar 2
000D4Ar 2 ; ----------------------------------------------------------------------------
000D4Ar 2 ; COMPUTE ADDRESS OF FIRST VALUE IN ARRAY
000D4Ar 2 ; ARYPNT = (LOWTR) + #DIMS*2 + 5
000D4Ar 2 ; ----------------------------------------------------------------------------
000D4Ar 2 GETARY:
000D4Ar 2 A5 0C lda EOLPNTR
000D4Cr 2 0A asl a
000D4Dr 2 69 05 adc #$05
000D4Fr 2 65 AC adc LOWTR
000D51r 2 A4 AD ldy LOWTR+1
000D53r 2 90 01 bcc L2FAF
000D55r 2 C8 iny
000D56r 2 L2FAF:
000D56r 2 85 A5 sta HIGHDS
000D58r 2 84 A6 sty HIGHDS+1
000D5Ar 2 60 rts
000D5Br 2
000D5Br 2 ; ----------------------------------------------------------------------------
000D5Br 2 NEG32768:
000D5Br 2 90 80 00 00 .byte $90,$80,$00,$00
000D5Fr 2
000D5Fr 2 .ifdef CONFIG_2C
000D5Fr 2 .byte $00; bugfix: short number
000D5Fr 2 .endif
000D5Fr 2
000D5Fr 2 ; ----------------------------------------------------------------------------
000D5Fr 2 ; EVALUATE NUMERIC FORMULA AT TXTPTR
000D5Fr 2 ; CONVERTING RESULT TO INTEGER 0 <= X <= 32767
000D5Fr 2 ; IN FAC+3,4
000D5Fr 2 ; ----------------------------------------------------------------------------
000D5Fr 2 MAKINT:
000D5Fr 2 20 C0 00 jsr CHRGET
000D62r 2 .ifdef CONFIG_2
000D62r 2 jsr FRMEVL
000D62r 2 .else
000D62r 2 20 rr rr jsr FRMNUM
000D65r 2 .endif
000D65r 2
000D65r 2 ; ----------------------------------------------------------------------------
000D65r 2 ; CONVERT FAC TO INTEGER
000D65r 2 ; MUST BE POSITIVE AND LESS THAN 32768
000D65r 2 ; ----------------------------------------------------------------------------
000D65r 2 MKINT:
000D65r 2 .ifdef CONFIG_2
000D65r 2 jsr CHKNUM
000D65r 2 .endif
000D65r 2 A5 B3 lda FACSIGN
000D67r 2 30 0D bmi MI1
000D69r 2
000D69r 2 ; ----------------------------------------------------------------------------
000D69r 2 ; CONVERT FAC TO INTEGER
000D69r 2 ; MUST BE -32767 <= FAC <= 32767
000D69r 2 ; ----------------------------------------------------------------------------
000D69r 2 AYINT:
000D69r 2 A5 AE lda FAC
000D6Br 2 C9 90 cmp #$90
000D6Dr 2 90 09 bcc MI2
000D6Fr 2 A9 rr lda #<NEG32768
000D71r 2 A0 rr ldy #>NEG32768
000D73r 2 20 rr rr jsr FCOMP
000D76r 2 MI1:
000D76r 2 D0 7A bne IQERR
000D78r 2 MI2:
000D78r 2 4C rr rr jmp QINT
000D7Br 2
000D7Br 2 ; ----------------------------------------------------------------------------
000D7Br 2 ; LOCATE ARRAY ELEMENT OR CREATE AN ARRAY
000D7Br 2 ; ----------------------------------------------------------------------------
000D7Br 2 ARRAY:
000D7Br 2 A5 0D lda DIMFLG
000D7Dr 2 .ifndef CONFIG_SMALL
000D7Dr 2 05 0F ora VALTYP+1
000D7Fr 2 .endif
000D7Fr 2 48 pha
000D80r 2 A5 0E lda VALTYP
000D82r 2 48 pha
000D83r 2 A0 00 ldy #$00
000D85r 2 L2FDE:
000D85r 2 98 tya
000D86r 2 48 pha
000D87r 2 A5 93 lda VARNAM+1
000D89r 2 48 pha
000D8Ar 2 A5 92 lda VARNAM
000D8Cr 2 48 pha
000D8Dr 2 20 rr rr jsr MAKINT
000D90r 2 68 pla
000D91r 2 85 92 sta VARNAM
000D93r 2 68 pla
000D94r 2 85 93 sta VARNAM+1
000D96r 2 68 pla
000D97r 2 A8 tay
000D98r 2 BA tsx
000D99r 2 BD 02 01 lda STACK+2,x
000D9Cr 2 48 pha
000D9Dr 2 BD 01 01 lda STACK+1,x
000DA0r 2 48 pha
000DA1r 2 A5 B1 lda FAC_LAST-1
000DA3r 2 9D 02 01 sta STACK+2,x
000DA6r 2 A5 B2 lda FAC_LAST
000DA8r 2 9D 01 01 sta STACK+1,x
000DABr 2 C8 iny
000DACr 2 20 C6 00 jsr CHRGOT
000DAFr 2 C9 2C cmp #$2C
000DB1r 2 F0 D2 beq L2FDE
000DB3r 2 84 0C sty EOLPNTR
000DB5r 2 20 rr rr jsr CHKCLS
000DB8r 2 68 pla
000DB9r 2 85 0E sta VALTYP
000DBBr 2 68 pla
000DBCr 2 .ifndef CONFIG_SMALL
000DBCr 2 85 0F sta VALTYP+1
000DBEr 2 29 7F and #$7F
000DC0r 2 .endif
000DC0r 2 85 0D sta DIMFLG
000DC2r 2 ; ----------------------------------------------------------------------------
000DC2r 2 ; SEARCH ARRAY TABLE FOR THIS ARRAY NAME
000DC2r 2 ; ----------------------------------------------------------------------------
000DC2r 2 A6 7C ldx ARYTAB
000DC4r 2 A5 7D lda ARYTAB+1
000DC6r 2 L301F:
000DC6r 2 86 AC stx LOWTR
000DC8r 2 85 AD sta LOWTR+1
000DCAr 2 C5 7F cmp STREND+1
000DCCr 2 D0 04 bne L302B
000DCEr 2 E4 7E cpx STREND
000DD0r 2 F0 39 beq MAKE_NEW_ARRAY
000DD2r 2 L302B:
000DD2r 2 A0 00 ldy #$00
000DD4r 2 B1 AC lda (LOWTR),y
000DD6r 2 C8 iny
000DD7r 2 C5 92 cmp VARNAM
000DD9r 2 D0 06 bne L303A
000DDBr 2 A5 93 lda VARNAM+1
000DDDr 2 D1 AC cmp (LOWTR),y
000DDFr 2 F0 16 beq USE_OLD_ARRAY
000DE1r 2 L303A:
000DE1r 2 C8 iny
000DE2r 2 B1 AC lda (LOWTR),y
000DE4r 2 18 clc
000DE5r 2 65 AC adc LOWTR
000DE7r 2 AA tax
000DE8r 2 C8 iny
000DE9r 2 B1 AC lda (LOWTR),y
000DEBr 2 65 AD adc LOWTR+1
000DEDr 2 90 D7 bcc L301F
000DEFr 2
000DEFr 2 ; ----------------------------------------------------------------------------
000DEFr 2 ; ERROR: BAD SUBSCRIPTS
000DEFr 2 ; ----------------------------------------------------------------------------
000DEFr 2 SUBERR:
000DEFr 2 A2 6B ldx #ERR_BADSUBS
000DF1r 2 2C .byte $2C
000DF2r 2
000DF2r 2 ; ----------------------------------------------------------------------------
000DF2r 2 ; ERROR: ILLEGAL QUANTITY
000DF2r 2 ; ----------------------------------------------------------------------------
000DF2r 2 IQERR:
000DF2r 2 A2 35 ldx #ERR_ILLQTY
000DF4r 2 JER:
000DF4r 2 4C rr rr jmp ERROR
000DF7r 2
000DF7r 2 ; ----------------------------------------------------------------------------
000DF7r 2 ; FOUND THE ARRAY
000DF7r 2 ; ----------------------------------------------------------------------------
000DF7r 2 USE_OLD_ARRAY:
000DF7r 2 A2 78 ldx #ERR_REDIMD
000DF9r 2 A5 0D lda DIMFLG
000DFBr 2 D0 F7 bne JER
000DFDr 2 20 rr rr jsr GETARY
000E00r 2 A5 0C lda EOLPNTR
000E02r 2 A0 04 ldy #$04
000E04r 2 D1 AC cmp (LOWTR),y
000E06r 2 D0 E7 bne SUBERR
000E08r 2 4C rr rr jmp FIND_ARRAY_ELEMENT
000E0Br 2
000E0Br 2 ; ----------------------------------------------------------------------------
000E0Br 2 ; CREATE A NEW ARRAY, UNLESS CALLED FROM GETARYPT
000E0Br 2 ; ----------------------------------------------------------------------------
000E0Br 2 MAKE_NEW_ARRAY:
000E0Br 2 20 rr rr jsr GETARY
000E0Er 2 20 rr rr jsr REASON
000E11r 2 A9 00 lda #$00
000E13r 2 A8 tay
000E14r 2 85 BF sta STRNG2+1
000E16r 2 A2 05 ldx #BYTES_PER_ELEMENT
000E18r 2 .if .def(CONFIG_SMALL) && (!.def(CONFIG_2))
000E18r 2 stx STRNG2
000E18r 2 .endif
000E18r 2 A5 92 lda VARNAM
000E1Ar 2 91 AC sta (LOWTR),y
000E1Cr 2 .ifndef CONFIG_SMALL
000E1Cr 2 10 01 bpl L3078
000E1Er 2 CA dex
000E1Fr 2 L3078:
000E1Fr 2 .endif
000E1Fr 2 C8 iny
000E20r 2 A5 93 lda VARNAM+1
000E22r 2 91 AC sta (LOWTR),y
000E24r 2 .if (!.def(CONFIG_SMALL)) || .def(CONFIG_2)
000E24r 2 10 02 bpl L3081
000E26r 2 CA dex
000E27r 2 .if !(.def(CONFIG_SMALL) && .def(CONFIG_2))
000E27r 2 CA dex
000E28r 2 .endif
000E28r 2 L3081:
000E28r 2 86 BE stx STRNG2
000E2Ar 2 .endif
000E2Ar 2 A5 0C lda EOLPNTR
000E2Cr 2 C8 iny
000E2Dr 2 C8 iny
000E2Er 2 C8 iny
000E2Fr 2 91 AC sta (LOWTR),y
000E31r 2 L308A:
000E31r 2 A2 0B ldx #$0B
000E33r 2 A9 00 lda #$00
000E35r 2 24 0D bit DIMFLG
000E37r 2 50 08 bvc L309A
000E39r 2 68 pla
000E3Ar 2 18 clc
000E3Br 2 69 01 adc #$01
000E3Dr 2 AA tax
000E3Er 2 68 pla
000E3Fr 2 69 00 adc #$00
000E41r 2 L309A:
000E41r 2 C8 iny
000E42r 2 91 AC sta (LOWTR),y
000E44r 2 C8 iny
000E45r 2 8A txa
000E46r 2 91 AC sta (LOWTR),y
000E48r 2 20 rr rr jsr MULTIPLY_SUBSCRIPT
000E4Br 2 86 BE stx STRNG2
000E4Dr 2 85 BF sta STRNG2+1
000E4Fr 2 A4 6F ldy INDEX
000E51r 2 C6 0C dec EOLPNTR
000E53r 2 D0 DC bne L308A
000E55r 2 65 A6 adc HIGHDS+1
000E57r 2 B0 5D bcs GME
000E59r 2 85 A6 sta HIGHDS+1
000E5Br 2 A8 tay
000E5Cr 2 8A txa
000E5Dr 2 65 A5 adc HIGHDS
000E5Fr 2 90 03 bcc L30BD
000E61r 2 C8 iny
000E62r 2 F0 52 beq GME
000E64r 2 L30BD:
000E64r 2 20 rr rr jsr REASON
000E67r 2 85 7E sta STREND
000E69r 2 84 7F sty STREND+1
000E6Br 2 A9 00 lda #$00
000E6Dr 2 E6 BF inc STRNG2+1
000E6Fr 2 A4 BE ldy STRNG2
000E71r 2 F0 05 beq L30D1
000E73r 2 L30CC:
000E73r 2 88 dey
000E74r 2 91 A5 sta (HIGHDS),y
000E76r 2 D0 FB bne L30CC
000E78r 2 L30D1:
000E78r 2 C6 A6 dec HIGHDS+1
000E7Ar 2 C6 BF dec STRNG2+1
000E7Cr 2 D0 F5 bne L30CC
000E7Er 2 E6 A6 inc HIGHDS+1
000E80r 2 38 sec
000E81r 2 A5 7E lda STREND
000E83r 2 E5 AC sbc LOWTR
000E85r 2 A0 02 ldy #$02
000E87r 2 91 AC sta (LOWTR),y
000E89r 2 A5 7F lda STREND+1
000E8Br 2 C8 iny
000E8Cr 2 E5 AD sbc LOWTR+1
000E8Er 2 91 AC sta (LOWTR),y
000E90r 2 A5 0D lda DIMFLG
000E92r 2 D0 62 bne RTS9
000E94r 2 C8 iny
000E95r 2
000E95r 2 ; ----------------------------------------------------------------------------
000E95r 2 ; FIND SPECIFIED ARRAY ELEMENT
000E95r 2 ;
000E95r 2 ; (LOWTR),Y POINTS AT # OF DIMS IN ARRAY DESCRIPTOR
000E95r 2 ; THE SUBSCRIPTS ARE ALL ON THE STACK AS INTEGERS
000E95r 2 ; ----------------------------------------------------------------------------
000E95r 2 FIND_ARRAY_ELEMENT:
000E95r 2 B1 AC lda (LOWTR),y
000E97r 2 85 0C sta EOLPNTR
000E99r 2 A9 00 lda #$00
000E9Br 2 85 BE sta STRNG2
000E9Dr 2 L30F6:
000E9Dr 2 85 BF sta STRNG2+1
000E9Fr 2 C8 iny
000EA0r 2 68 pla
000EA1r 2 AA tax
000EA2r 2 85 B1 sta FAC_LAST-1
000EA4r 2 68 pla
000EA5r 2 85 B2 sta FAC_LAST
000EA7r 2 D1 AC cmp (LOWTR),y
000EA9r 2 90 0E bcc FAE2
000EABr 2 D0 06 bne GSE
000EADr 2 C8 iny
000EAEr 2 8A txa
000EAFr 2 D1 AC cmp (LOWTR),y
000EB1r 2 90 07 bcc FAE3
000EB3r 2 ; ----------------------------------------------------------------------------
000EB3r 2 GSE:
000EB3r 2 4C rr rr jmp SUBERR
000EB6r 2 GME:
000EB6r 2 4C rr rr jmp MEMERR
000EB9r 2 ; ----------------------------------------------------------------------------
000EB9r 2 FAE2:
000EB9r 2 C8 iny
000EBAr 2 FAE3:
000EBAr 2 A5 BF lda STRNG2+1
000EBCr 2 05 BE ora STRNG2
000EBEr 2 18 clc
000EBFr 2 F0 0A beq L3124
000EC1r 2 20 rr rr jsr MULTIPLY_SUBSCRIPT
000EC4r 2 8A txa
000EC5r 2 65 B1 adc FAC_LAST-1
000EC7r 2 AA tax
000EC8r 2 98 tya
000EC9r 2 A4 6F ldy INDEX
000ECBr 2 L3124:
000ECBr 2 65 B2 adc FAC_LAST
000ECDr 2 86 BE stx STRNG2
000ECFr 2 C6 0C dec EOLPNTR
000ED1r 2 D0 CA bne L30F6
000ED3r 2 .if .def(CONFIG_SMALL) && (!.def(CONFIG_2))
000ED3r 2 asl STRNG2
000ED3r 2 rol a
000ED3r 2 bcs GSE
000ED3r 2 asl STRNG2
000ED3r 2 rol a
000ED3r 2 bcs GSE
000ED3r 2 tay
000ED3r 2 lda STRNG2
000ED3r 2 .else
000ED3r 2 .ifdef CONFIG_11A
000ED3r 2 85 BF sta STRNG2+1
000ED5r 2 .endif
000ED5r 2 A2 05 ldx #BYTES_FP
000ED7r 2 .ifdef CONFIG_SMALL
000ED7r 2 lda VARNAM+1
000ED7r 2 .else
000ED7r 2 A5 92 lda VARNAM
000ED9r 2 .endif
000ED9r 2 10 01 bpl L3135
000EDBr 2 CA dex
000EDCr 2 L3135:
000EDCr 2 .ifdef CONFIG_SMALL
000EDCr 2 stx RESULT+1
000EDCr 2 .else
000EDCr 2 A5 93 lda VARNAM+1
000EDEr 2 10 02 bpl L313B
000EE0r 2 CA dex
000EE1r 2 CA dex
000EE2r 2 L313B:
000EE2r 2 86 75 stx RESULT+2
000EE4r 2 .endif
000EE4r 2 A9 00 lda #$00
000EE6r 2 20 rr rr jsr MULTIPLY_SUBS1
000EE9r 2 8A txa
000EEAr 2 .endif
000EEAr 2 65 A5 adc HIGHDS
000EECr 2 85 94 sta VARPNT
000EEEr 2 98 tya
000EEFr 2 65 A6 adc HIGHDS+1
000EF1r 2 85 95 sta VARPNT+1
000EF3r 2 A8 tay
000EF4r 2 A5 94 lda VARPNT
000EF6r 2 RTS9:
000EF6r 2 60 rts
000EF7r 2
000EF7r 2 ; ----------------------------------------------------------------------------
000EF7r 2 ; MULTIPLY (STRNG2) BY ((LOWTR),Y)
000EF7r 2 ; LEAVING PRODUCT IN A,X. (HI-BYTE ALSO IN Y.)
000EF7r 2 ; USED ONLY BY ARRAY SUBSCRIPT ROUTINES
000EF7r 2 ; ----------------------------------------------------------------------------
000EF7r 2 MULTIPLY_SUBSCRIPT:
000EF7r 2 84 6F sty INDEX
000EF9r 2 B1 AC lda (LOWTR),y
000EFBr 2 85 75 sta RESULT_LAST-2
000EFDr 2 88 dey
000EFEr 2 B1 AC lda (LOWTR),y
000F00r 2 MULTIPLY_SUBS1:
000F00r 2 85 76 sta RESULT_LAST-1
000F02r 2 A9 10 lda #$10
000F04r 2 85 AA sta INDX
000F06r 2 A2 00 ldx #$00
000F08r 2 A0 00 ldy #$00
000F0Ar 2 L3163:
000F0Ar 2 8A txa
000F0Br 2 0A asl a
000F0Cr 2 AA tax
000F0Dr 2 98 tya
000F0Er 2 2A rol a
000F0Fr 2 A8 tay
000F10r 2 B0 A4 bcs GME
000F12r 2 06 BE asl STRNG2
000F14r 2 26 BF rol STRNG2+1
000F16r 2 90 0B bcc L317C
000F18r 2 18 clc
000F19r 2 8A txa
000F1Ar 2 65 75 adc RESULT_LAST-2
000F1Cr 2 AA tax
000F1Dr 2 98 tya
000F1Er 2 65 76 adc RESULT_LAST-1
000F20r 2 A8 tay
000F21r 2 B0 93 bcs GME
000F23r 2 L317C:
000F23r 2 C6 AA dec INDX
000F25r 2 D0 E3 bne L3163
000F27r 2 60 rts
000F28r 2
000F28r 2
000F28r 1 .include "misc2.s"
000F28r 2 .segment "CODE"
000F28r 2
000F28r 2 ; ----------------------------------------------------------------------------
000F28r 2 ; "FRE" FUNCTION
000F28r 2 ;
000F28r 2 ; COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT
000F28r 2 ; ----------------------------------------------------------------------------
000F28r 2 FRE:
000F28r 2 A5 0E lda VALTYP
000F2Ar 2 F0 03 beq L3188
000F2Cr 2 20 rr rr jsr FREFAC
000F2Fr 2 L3188:
000F2Fr 2 20 rr rr jsr GARBAG
000F32r 2 38 sec
000F33r 2 A5 80 lda FRETOP
000F35r 2 E5 7E sbc STREND
000F37r 2 A8 tay
000F38r 2 A5 81 lda FRETOP+1
000F3Ar 2 E5 7F sbc STREND+1
000F3Cr 2 ; FALL INTO GIVAYF TO FLOAT THE VALUE
000F3Cr 2 ; NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE
000F3Cr 2
000F3Cr 2 ; ----------------------------------------------------------------------------
000F3Cr 2 ; FLOAT THE SIGNED INTEGER IN A,Y
000F3Cr 2 ; ----------------------------------------------------------------------------
000F3Cr 2 GIVAYF:
000F3Cr 2 A2 00 ldx #$00
000F3Er 2 86 0E stx VALTYP
000F40r 2 85 AF sta FAC+1
000F42r 2 84 B0 sty FAC+2
000F44r 2 A2 90 ldx #$90
000F46r 2 4C rr rr jmp FLOAT1
000F49r 2 POS:
000F49r 2 A4 16 ldy POSX
000F4Br 2
000F4Br 2 ; ----------------------------------------------------------------------------
000F4Br 2 ; FLOAT (Y) INTO FAC, GIVING VALUE 0-255
000F4Br 2 ; ----------------------------------------------------------------------------
000F4Br 2 SNGFLT:
000F4Br 2 A9 00 lda #$00
000F4Dr 2 F0 ED beq GIVAYF
000F4Fr 2
000F4Fr 2 ; ----------------------------------------------------------------------------
000F4Fr 2 ; CHECK FOR DIRECT OR RUNNING MODE
000F4Fr 2 ; GIVING ERROR IF DIRECT MODE
000F4Fr 2 ; ----------------------------------------------------------------------------
000F4Fr 2 ERRDIR:
000F4Fr 2 A6 87 ldx CURLIN+1
000F51r 2 E8 inx
000F52r 2 D0 A2 bne RTS9
000F54r 2 A2 95 ldx #ERR_ILLDIR
000F56r 2 .ifdef CONFIG_2
000F56r 2 .byte $2C
000F56r 2 LD288:
000F56r 2 ldx #ERR_UNDEFFN
000F56r 2 .endif
000F56r 2 L31AF:
000F56r 2 4C rr rr jmp ERROR
000F59r 2 DEF:
000F59r 2 20 rr rr jsr FNC
000F5Cr 2 20 rr rr jsr ERRDIR
000F5Fr 2 20 rr rr jsr CHKOPN
000F62r 2 A9 80 lda #$80
000F64r 2 85 11 sta SUBFLG
000F66r 2 20 rr rr jsr PTRGET
000F69r 2 20 rr rr jsr CHKNUM
000F6Cr 2 20 rr rr jsr CHKCLS
000F6Fr 2 A9 AC lda #TOKEN_EQUAL
000F71r 2 20 rr rr jsr SYNCHR
000F74r 2 .ifndef CONFIG_SMALL
000F74r 2 48 pha
000F75r 2 .endif
000F75r 2 A5 95 lda VARPNT+1
000F77r 2 48 pha
000F78r 2 A5 94 lda VARPNT
000F7Ar 2 48 pha
000F7Br 2 A5 C8 lda TXTPTR+1
000F7Dr 2 48 pha
000F7Er 2 A5 C7 lda TXTPTR
000F80r 2 48 pha
000F81r 2 20 rr rr jsr DATA
000F84r 2 4C rr rr jmp L3250
000F87r 2 FNC:
000F87r 2 A9 9F lda #TOKEN_FN
000F89r 2 20 rr rr jsr SYNCHR
000F8Cr 2 09 80 ora #$80
000F8Er 2 85 11 sta SUBFLG
000F90r 2 20 rr rr jsr PTRGET3
000F93r 2 85 9B sta FNCNAM
000F95r 2 84 9C sty FNCNAM+1
000F97r 2 4C rr rr jmp CHKNUM
000F9Ar 2 L31F3:
000F9Ar 2 20 rr rr jsr FNC
000F9Dr 2 A5 9C lda FNCNAM+1
000F9Fr 2 48 pha
000FA0r 2 A5 9B lda FNCNAM
000FA2r 2 48 pha
000FA3r 2 20 rr rr jsr PARCHK
000FA6r 2 20 rr rr jsr CHKNUM
000FA9r 2 68 pla
000FAAr 2 85 9B sta FNCNAM
000FACr 2 68 pla
000FADr 2 85 9C sta FNCNAM+1
000FAFr 2 A0 02 ldy #$02
000FB1r 2 .ifndef CONFIG_2
000FB1r 2 A2 E0 ldx #ERR_UNDEFFN
000FB3r 2 .endif
000FB3r 2 B1 9B lda (FNCNAM),y
000FB5r 2 .ifndef CONFIG_2
000FB5r 2 F0 9F beq L31AF
000FB7r 2 .endif
000FB7r 2 85 94 sta VARPNT
000FB9r 2 AA tax
000FBAr 2 C8 iny
000FBBr 2 B1 9B lda (FNCNAM),y
000FBDr 2 .ifdef CONFIG_2
000FBDr 2 beq LD288
000FBDr 2 .endif
000FBDr 2 85 95 sta VARPNT+1
000FBFr 2 .ifndef CONFIG_SMALL
000FBFr 2 C8 iny
000FC0r 2 .endif
000FC0r 2 L3219:
000FC0r 2 B1 94 lda (VARPNT),y
000FC2r 2 48 pha
000FC3r 2 88 dey
000FC4r 2 10 FA bpl L3219
000FC6r 2 A4 95 ldy VARPNT+1
000FC8r 2 20 rr rr jsr STORE_FAC_AT_YX_ROUNDED
000FCBr 2 A5 C8 lda TXTPTR+1
000FCDr 2 48 pha
000FCEr 2 A5 C7 lda TXTPTR
000FD0r 2 48 pha
000FD1r 2 B1 9B lda (FNCNAM),y
000FD3r 2 85 C7 sta TXTPTR
000FD5r 2 C8 iny
000FD6r 2 B1 9B lda (FNCNAM),y
000FD8r 2 85 C8 sta TXTPTR+1
000FDAr 2 A5 95 lda VARPNT+1
000FDCr 2 48 pha
000FDDr 2 A5 94 lda VARPNT
000FDFr 2 48 pha
000FE0r 2 20 rr rr jsr FRMNUM
000FE3r 2 68 pla
000FE4r 2 85 9B sta FNCNAM
000FE6r 2 68 pla
000FE7r 2 85 9C sta FNCNAM+1
000FE9r 2 20 C6 00 jsr CHRGOT
000FECr 2 F0 03 beq L324A
000FEEr 2 4C rr rr jmp SYNERR
000FF1r 2 L324A:
000FF1r 2 68 pla
000FF2r 2 85 C7 sta TXTPTR
000FF4r 2 68 pla
000FF5r 2 85 C8 sta TXTPTR+1
000FF7r 2 L3250:
000FF7r 2 A0 00 ldy #$00
000FF9r 2 68 pla
000FFAr 2 91 9B sta (FNCNAM),y
000FFCr 2 68 pla
000FFDr 2 C8 iny
000FFEr 2 91 9B sta (FNCNAM),y
001000r 2 68 pla
001001r 2 C8 iny
001002r 2 91 9B sta (FNCNAM),y
001004r 2 68 pla
001005r 2 C8 iny
001006r 2 91 9B sta (FNCNAM),y
001008r 2 .ifndef CONFIG_SMALL
001008r 2 68 pla
001009r 2 C8 iny
00100Ar 2 91 9B sta (FNCNAM),y
00100Cr 2 .endif
00100Cr 2 60 rts
00100Dr 2
00100Dr 1 .include "string.s"
00100Dr 2 .segment "CODE"
00100Dr 2 ; ----------------------------------------------------------------------------
00100Dr 2 ; "STR$" FUNCTION
00100Dr 2 ; ----------------------------------------------------------------------------
00100Dr 2 STR:
00100Dr 2 20 rr rr jsr CHKNUM
001010r 2 A0 00 ldy #$00
001012r 2 20 rr rr jsr FOUT1
001015r 2 68 pla
001016r 2 68 pla
001017r 2 LD353:
001017r 2 A9 FF lda #$FF
001019r 2 A0 00 ldy #$00
00101Br 2 F0 12 beq STRLIT
00101Dr 2
00101Dr 2 ; ----------------------------------------------------------------------------
00101Dr 2 ; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
00101Dr 2 ; ADDRESS IS IN FAC+3,4 AND WHOSE LENGTH IS IN A-REG
00101Dr 2 ; ----------------------------------------------------------------------------
00101Dr 2 STRINI:
00101Dr 2 A6 B1 ldx FAC_LAST-1
00101Fr 2 A4 B2 ldy FAC_LAST
001021r 2 86 9D stx DSCPTR
001023r 2 84 9E sty DSCPTR+1
001025r 2
001025r 2 ; ----------------------------------------------------------------------------
001025r 2 ; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
001025r 2 ; ADDRESS IS IN Y,X AND WHOSE LENGTH IS IN A-REG
001025r 2 ; ----------------------------------------------------------------------------
001025r 2 STRSPA:
001025r 2 20 rr rr jsr GETSPA
001028r 2 86 AF stx FAC+1
00102Ar 2 84 B0 sty FAC+2
00102Cr 2 85 AE sta FAC
00102Er 2 60 rts
00102Fr 2
00102Fr 2 ; ----------------------------------------------------------------------------
00102Fr 2 ; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
00102Fr 2 ; AND TERMINATED BY $00 OR QUOTATION MARK
00102Fr 2 ; RETURN WITH DESCRIPTOR IN A TEMPORARY
00102Fr 2 ; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
00102Fr 2 ; ----------------------------------------------------------------------------
00102Fr 2 STRLIT:
00102Fr 2 A2 22 ldx #$22
001031r 2 86 0A stx CHARAC
001033r 2 86 0B stx ENDCHR
001035r 2
001035r 2 ; ----------------------------------------------------------------------------
001035r 2 ; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
001035r 2 ; AND TERMINATED BY $00, (CHARAC), OR (ENDCHR)
001035r 2 ;
001035r 2 ; RETURN WITH DESCRIPTOR IN A TEMPORARY
001035r 2 ; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
001035r 2 ; ----------------------------------------------------------------------------
001035r 2 STRLT2:
001035r 2 85 BC sta STRNG1
001037r 2 84 BD sty STRNG1+1
001039r 2 85 AF sta FAC+1
00103Br 2 84 B0 sty FAC+2
00103Dr 2 A0 FF ldy #$FF
00103Fr 2 L3298:
00103Fr 2 C8 iny
001040r 2 B1 BC lda (STRNG1),y
001042r 2 F0 0C beq L32A9
001044r 2 C5 0A cmp CHARAC
001046r 2 F0 04 beq L32A5
001048r 2 C5 0B cmp ENDCHR
00104Ar 2 D0 F3 bne L3298
00104Cr 2 L32A5:
00104Cr 2 C9 22 cmp #$22
00104Er 2 F0 01 beq L32AA
001050r 2 L32A9:
001050r 2 18 clc
001051r 2 L32AA:
001051r 2 84 AE sty FAC
001053r 2 98 tya
001054r 2 65 BC adc STRNG1
001056r 2 85 BE sta STRNG2
001058r 2 A6 BD ldx STRNG1+1
00105Ar 2 90 01 bcc L32B6
00105Cr 2 E8 inx
00105Dr 2 L32B6:
00105Dr 2 86 BF stx STRNG2+1
00105Fr 2 A5 BD lda STRNG1+1
001061r 2 .ifdef CONFIG_NO_INPUTBUFFER_ZP
001061r 2 beq LD399
001061r 2 cmp #>INPUTBUFFER
001061r 2 .endif
001061r 2 D0 0B bne PUTNEW
001063r 2 LD399:
001063r 2 98 tya
001064r 2 20 rr rr jsr STRINI
001067r 2 A6 BC ldx STRNG1
001069r 2 A4 BD ldy STRNG1+1
00106Br 2 20 rr rr jsr MOVSTR
00106Er 2
00106Er 2 ; ----------------------------------------------------------------------------
00106Er 2 ; STORE DESCRIPTOR IN TEMPORARY DESCRIPTOR STACK
00106Er 2 ;
00106Er 2 ; THE DESCRIPTOR IS NOW IN FAC, FAC+1, FAC+2
00106Er 2 ; PUT ADDRESS OF TEMP DESCRIPTOR IN FAC+3,4
00106Er 2 ; ----------------------------------------------------------------------------
00106Er 2 PUTNEW:
00106Er 2 A6 63 ldx TEMPPT
001070r 2 E0 6F cpx #TEMPST+9
001072r 2 D0 05 bne PUTEMP
001074r 2 A2 BF ldx #ERR_FRMCPX
001076r 2 JERR:
001076r 2 4C rr rr jmp ERROR
001079r 2 PUTEMP:
001079r 2 A5 AE lda FAC
00107Br 2 95 00 sta 0,x
00107Dr 2 A5 AF lda FAC+1
00107Fr 2 95 01 sta 1,x
001081r 2 A5 B0 lda FAC+2
001083r 2 95 02 sta 2,x
001085r 2 A0 00 ldy #$00
001087r 2 86 B1 stx FAC_LAST-1
001089r 2 84 B2 sty FAC_LAST
00108Br 2 .ifdef CONFIG_2
00108Br 2 sty FACEXTENSION
00108Br 2 .endif
00108Br 2 88 dey
00108Cr 2 84 0E sty VALTYP
00108Er 2 86 64 stx LASTPT
001090r 2 E8 inx
001091r 2 E8 inx
001092r 2 E8 inx
001093r 2 86 63 stx TEMPPT
001095r 2 60 rts
001096r 2
001096r 2 ; ----------------------------------------------------------------------------
001096r 2 ; MAKE SPACE FOR STRING AT BOTTOM OF STRING SPACE
001096r 2 ; (A)=# BYTES SPACE TO MAKE
001096r 2 ;
001096r 2 ; RETURN WITH (A) SAME,
001096r 2 ; AND Y,X = ADDRESS OF SPACE ALLOCATED
001096r 2 ; ----------------------------------------------------------------------------
001096r 2 GETSPA:
001096r 2 46 10 lsr DATAFLG
001098r 2 L32F1:
001098r 2 48 pha
001099r 2 49 FF eor #$FF
00109Br 2 38 sec
00109Cr 2 65 80 adc FRETOP
00109Er 2 A4 81 ldy FRETOP+1
0010A0r 2 B0 01 bcs L32FC
0010A2r 2 88 dey
0010A3r 2 L32FC:
0010A3r 2 C4 7F cpy STREND+1
0010A5r 2 90 11 bcc L3311
0010A7r 2 D0 04 bne L3306
0010A9r 2 C5 7E cmp STREND
0010ABr 2 90 0B bcc L3311
0010ADr 2 L3306:
0010ADr 2 85 80 sta FRETOP
0010AFr 2 84 81 sty FRETOP+1
0010B1r 2 85 82 sta FRESPC
0010B3r 2 84 83 sty FRESPC+1
0010B5r 2 AA tax
0010B6r 2 68 pla
0010B7r 2 60 rts
0010B8r 2 L3311:
0010B8r 2 A2 4D ldx #ERR_MEMFULL
0010BAr 2 A5 10 lda DATAFLG
0010BCr 2 30 B8 bmi JERR
0010BEr 2 20 rr rr jsr GARBAG
0010C1r 2 A9 80 lda #$80
0010C3r 2 85 10 sta DATAFLG
0010C5r 2 68 pla
0010C6r 2 D0 D0 bne L32F1
0010C8r 2
0010C8r 2 ; ----------------------------------------------------------------------------
0010C8r 2 ; SHOVE ALL REFERENCED STRINGS AS HIGH AS POSSIBLE
0010C8r 2 ; IN MEMORY (AGAINST HIMEM), FREEING UP SPACE
0010C8r 2 ; BELOW STRING AREA DOWN TO STREND.
0010C8r 2 ; ----------------------------------------------------------------------------
0010C8r 2 GARBAG:
0010C8r 2
0010C8r 2 .ifdef CONST_MEMSIZ
0010C8r 2 ldx #<CONST_MEMSIZ
0010C8r 2 lda #>CONST_MEMSIZ
0010C8r 2 .else
0010C8r 2 A6 84 ldx MEMSIZ
0010CAr 2 A5 85 lda MEMSIZ+1
0010CCr 2 .endif
0010CCr 2 FINDHIGHESTSTRING:
0010CCr 2 86 80 stx FRETOP
0010CEr 2 85 81 sta FRETOP+1
0010D0r 2 A0 00 ldy #$00
0010D2r 2 84 9C sty FNCNAM+1
0010D4r 2 .ifdef CONFIG_2
0010D4r 2 sty FNCNAM ; GC bugfix!
0010D4r 2 .endif
0010D4r 2 A5 7E lda STREND
0010D6r 2 A6 7F ldx STREND+1
0010D8r 2 85 AC sta LOWTR
0010DAr 2 86 AD stx LOWTR+1
0010DCr 2 A9 66 lda #TEMPST
0010DEr 2 A2 00 ldx #$00
0010E0r 2 85 6F sta INDEX
0010E2r 2 86 70 stx INDEX+1
0010E4r 2 L333D:
0010E4r 2 C5 63 cmp TEMPPT
0010E6r 2 F0 05 beq L3346
0010E8r 2 20 rr rr jsr CHECK_VARIABLE
0010EBr 2 F0 F7 beq L333D
0010EDr 2 L3346:
0010EDr 2 A9 07 lda #BYTES_PER_VARIABLE
0010EFr 2 85 A0 sta DSCLEN
0010F1r 2 A5 7A lda VARTAB
0010F3r 2 A6 7B ldx VARTAB+1
0010F5r 2 85 6F sta INDEX
0010F7r 2 86 70 stx INDEX+1
0010F9r 2 L3352:
0010F9r 2 E4 7D cpx ARYTAB+1
0010FBr 2 D0 04 bne L335A
0010FDr 2 C5 7C cmp ARYTAB
0010FFr 2 F0 05 beq L335F
001101r 2 L335A:
001101r 2 20 rr rr jsr CHECK_SIMPLE_VARIABLE
001104r 2 F0 F3 beq L3352
001106r 2 L335F:
001106r 2 85 A5 sta HIGHDS
001108r 2 86 A6 stx HIGHDS+1
00110Ar 2 A9 03 lda #$03 ; OSI GC bugfix -> $04 ???
00110Cr 2 85 A0 sta DSCLEN
00110Er 2 L3367:
00110Er 2 A5 A5 lda HIGHDS
001110r 2 A6 A6 ldx HIGHDS+1
001112r 2 L336B:
001112r 2 E4 7F cpx STREND+1
001114r 2 D0 07 bne L3376
001116r 2 C5 7E cmp STREND
001118r 2 D0 03 bne L3376
00111Ar 2 4C rr rr jmp MOVE_HIGHEST_STRING_TO_TOP
00111Dr 2 L3376:
00111Dr 2 85 6F sta INDEX
00111Fr 2 86 70 stx INDEX+1
001121r 2 .ifdef CONFIG_SMALL
001121r 2 ldy #$01
001121r 2 .else
001121r 2 A0 00 ldy #$00
001123r 2 B1 6F lda (INDEX),y
001125r 2 AA tax
001126r 2 C8 iny
001127r 2 .endif
001127r 2 B1 6F lda (INDEX),y
001129r 2 08 php
00112Ar 2 C8 iny
00112Br 2 B1 6F lda (INDEX),y
00112Dr 2 65 A5 adc HIGHDS
00112Fr 2 85 A5 sta HIGHDS
001131r 2 C8 iny
001132r 2 B1 6F lda (INDEX),y
001134r 2 65 A6 adc HIGHDS+1
001136r 2 85 A6 sta HIGHDS+1
001138r 2 28 plp
001139r 2 10 D3 bpl L3367
00113Br 2 .ifndef CONFIG_SMALL
00113Br 2 8A txa
00113Cr 2 30 D0 bmi L3367
00113Er 2 .endif
00113Er 2 C8 iny
00113Fr 2 B1 6F lda (INDEX),y
001141r 2 .ifdef CONFIG_CBM1_PATCHES
001141r 2 jsr LE7F3 ; XXX patch, call into screen editor
001141r 2 .else
001141r 2 .ifdef CONFIG_11
001141r 2 A0 00 ldy #$00 ; GC bugfix
001143r 2 .endif
001143r 2 0A asl a
001144r 2 69 05 adc #$05
001146r 2 .endif
001146r 2 65 6F adc INDEX
001148r 2 85 6F sta INDEX
00114Ar 2 90 02 bcc L33A7
00114Cr 2 E6 70 inc INDEX+1
00114Er 2 L33A7:
00114Er 2 A6 70 ldx INDEX+1
001150r 2 L33A9:
001150r 2 E4 A6 cpx HIGHDS+1
001152r 2 D0 04 bne L33B1
001154r 2 C5 A5 cmp HIGHDS
001156r 2 F0 BA beq L336B
001158r 2 L33B1:
001158r 2 20 rr rr jsr CHECK_VARIABLE
00115Br 2 F0 F3 beq L33A9
00115Dr 2
00115Dr 2 ; ----------------------------------------------------------------------------
00115Dr 2 ; PROCESS A SIMPLE VARIABLE
00115Dr 2 ; ----------------------------------------------------------------------------
00115Dr 2 CHECK_SIMPLE_VARIABLE:
00115Dr 2 .ifndef CONFIG_SMALL
00115Dr 2 B1 6F lda (INDEX),y
00115Fr 2 30 35 bmi CHECK_BUMP
001161r 2 .endif
001161r 2 C8 iny
001162r 2 B1 6F lda (INDEX),y
001164r 2 10 30 bpl CHECK_BUMP
001166r 2 C8 iny
001167r 2
001167r 2 ; ----------------------------------------------------------------------------
001167r 2 ; IF STRING IS NOT EMPTY, CHECK IF IT IS HIGHEST
001167r 2 ; ----------------------------------------------------------------------------
001167r 2 CHECK_VARIABLE:
001167r 2 B1 6F lda (INDEX),y
001169r 2 F0 2B beq CHECK_BUMP
00116Br 2 C8 iny
00116Cr 2 B1 6F lda (INDEX),y
00116Er 2 AA tax
00116Fr 2 C8 iny
001170r 2 B1 6F lda (INDEX),y
001172r 2 C5 81 cmp FRETOP+1
001174r 2 90 06 bcc L33D5
001176r 2 D0 1E bne CHECK_BUMP
001178r 2 E4 80 cpx FRETOP
00117Ar 2 B0 1A bcs CHECK_BUMP
00117Cr 2 L33D5:
00117Cr 2 C5 AD cmp LOWTR+1
00117Er 2 90 16 bcc CHECK_BUMP
001180r 2 D0 04 bne L33DF
001182r 2 E4 AC cpx LOWTR
001184r 2 90 10 bcc CHECK_BUMP
001186r 2 L33DF:
001186r 2 86 AC stx LOWTR
001188r 2 85 AD sta LOWTR+1
00118Ar 2 A5 6F lda INDEX
00118Cr 2 A6 70 ldx INDEX+1
00118Er 2 85 9B sta FNCNAM
001190r 2 86 9C stx FNCNAM+1
001192r 2 A5 A0 lda DSCLEN
001194r 2 85 A2 sta Z52
001196r 2
001196r 2 ; ----------------------------------------------------------------------------
001196r 2 ; ADD (DSCLEN) TO PNTR IN INDEX
001196r 2 ; RETURN WITH Y=0, PNTR ALSO IN X,A
001196r 2 ; ----------------------------------------------------------------------------
001196r 2 CHECK_BUMP:
001196r 2 A5 A0 lda DSCLEN
001198r 2 18 clc
001199r 2 65 6F adc INDEX
00119Br 2 85 6F sta INDEX
00119Dr 2 90 02 bcc L33FA
00119Fr 2 E6 70 inc INDEX+1
0011A1r 2 L33FA:
0011A1r 2 A6 70 ldx INDEX+1
0011A3r 2 A0 00 ldy #$00
0011A5r 2 60 rts
0011A6r 2
0011A6r 2 ; ----------------------------------------------------------------------------
0011A6r 2 ; FOUND HIGHEST NON-EMPTY STRING, SO MOVE IT
0011A6r 2 ; TO TOP AND GO BACK FOR ANOTHER
0011A6r 2 ; ----------------------------------------------------------------------------
0011A6r 2 MOVE_HIGHEST_STRING_TO_TOP:
0011A6r 2 .ifdef CONFIG_2
0011A6r 2 lda FNCNAM+1 ; GC bugfix
0011A6r 2 ora FNCNAM
0011A6r 2 .else
0011A6r 2 A6 9C ldx FNCNAM+1
0011A8r 2 .endif
0011A8r 2 F0 F7 beq L33FA
0011AAr 2 A5 A2 lda Z52
0011ACr 2 .ifndef CONFIG_10A
0011ACr 2 sbc #$03
0011ACr 2 .else
0011ACr 2 29 04 and #$04
0011AEr 2 .endif
0011AEr 2 4A lsr a
0011AFr 2 A8 tay
0011B0r 2 85 A2 sta Z52
0011B2r 2 B1 9B lda (FNCNAM),y
0011B4r 2 65 AC adc LOWTR
0011B6r 2 85 A7 sta HIGHTR
0011B8r 2 A5 AD lda LOWTR+1
0011BAr 2 69 00 adc #$00
0011BCr 2 85 A8 sta HIGHTR+1
0011BEr 2 A5 80 lda FRETOP
0011C0r 2 A6 81 ldx FRETOP+1
0011C2r 2 85 A5 sta HIGHDS
0011C4r 2 86 A6 stx HIGHDS+1
0011C6r 2 20 rr rr jsr BLTU2
0011C9r 2 A4 A2 ldy Z52
0011CBr 2 C8 iny
0011CCr 2 A5 A5 lda HIGHDS
0011CEr 2 91 9B sta (FNCNAM),y
0011D0r 2 AA tax
0011D1r 2 E6 A6 inc HIGHDS+1
0011D3r 2 A5 A6 lda HIGHDS+1
0011D5r 2 C8 iny
0011D6r 2 91 9B sta (FNCNAM),y
0011D8r 2 4C rr rr jmp FINDHIGHESTSTRING
0011DBr 2
0011DBr 2 ; ----------------------------------------------------------------------------
0011DBr 2 ; CONCATENATE TWO STRINGS
0011DBr 2 ; ----------------------------------------------------------------------------
0011DBr 2 CAT:
0011DBr 2 A5 B2 lda FAC_LAST
0011DDr 2 48 pha
0011DEr 2 A5 B1 lda FAC_LAST-1
0011E0r 2 48 pha
0011E1r 2 20 rr rr jsr FRM_ELEMENT
0011E4r 2 20 rr rr jsr CHKSTR
0011E7r 2 68 pla
0011E8r 2 85 BC sta STRNG1
0011EAr 2 68 pla
0011EBr 2 85 BD sta STRNG1+1
0011EDr 2 A0 00 ldy #$00
0011EFr 2 B1 BC lda (STRNG1),y
0011F1r 2 18 clc
0011F2r 2 71 B1 adc (FAC_LAST-1),y
0011F4r 2 90 05 bcc L3454
0011F6r 2 A2 B0 ldx #ERR_STRLONG
0011F8r 2 4C rr rr jmp ERROR
0011FBr 2 L3454:
0011FBr 2 20 rr rr jsr STRINI
0011FEr 2 20 rr rr jsr MOVINS
001201r 2 A5 9D lda DSCPTR
001203r 2 A4 9E ldy DSCPTR+1
001205r 2 20 rr rr jsr FRETMP
001208r 2 20 rr rr jsr MOVSTR1
00120Br 2 A5 BC lda STRNG1
00120Dr 2 A4 BD ldy STRNG1+1
00120Fr 2 20 rr rr jsr FRETMP
001212r 2 20 rr rr jsr PUTNEW
001215r 2 4C rr rr jmp FRMEVL2
001218r 2
001218r 2 ; ----------------------------------------------------------------------------
001218r 2 ; GET STRING DESCRIPTOR POINTED AT BY (STRNG1)
001218r 2 ; AND MOVE DESCRIBED STRING TO (FRESPC)
001218r 2 ; ----------------------------------------------------------------------------
001218r 2 MOVINS:
001218r 2 A0 00 ldy #$00
00121Ar 2 B1 BC lda (STRNG1),y
00121Cr 2 48 pha
00121Dr 2 C8 iny
00121Er 2 B1 BC lda (STRNG1),y
001220r 2 AA tax
001221r 2 C8 iny
001222r 2 B1 BC lda (STRNG1),y
001224r 2 A8 tay
001225r 2 68 pla
001226r 2
001226r 2 ; ----------------------------------------------------------------------------
001226r 2 ; MOVE STRING AT (Y,X) WITH LENGTH (A)
001226r 2 ; TO DESTINATION WHOSE ADDRESS IS IN FRESPC,FRESPC+1
001226r 2 ; ----------------------------------------------------------------------------
001226r 2 MOVSTR:
001226r 2 86 6F stx INDEX
001228r 2 84 70 sty INDEX+1
00122Ar 2 MOVSTR1:
00122Ar 2 A8 tay
00122Br 2 F0 0A beq L3490
00122Dr 2 48 pha
00122Er 2 L3487:
00122Er 2 88 dey
00122Fr 2 B1 6F lda (INDEX),y
001231r 2 91 82 sta (FRESPC),y
001233r 2 98 tya
001234r 2 D0 F8 bne L3487
001236r 2 68 pla
001237r 2 L3490:
001237r 2 18 clc
001238r 2 65 82 adc FRESPC
00123Ar 2 85 82 sta FRESPC
00123Cr 2 90 02 bcc L3499
00123Er 2 E6 83 inc FRESPC+1
001240r 2 L3499:
001240r 2 60 rts
001241r 2
001241r 2 ; ----------------------------------------------------------------------------
001241r 2 ; IF (FAC) IS A TEMPORARY STRING, RELEASE DESCRIPTOR
001241r 2 ; ----------------------------------------------------------------------------
001241r 2 FRESTR:
001241r 2 20 rr rr jsr CHKSTR
001244r 2
001244r 2 ; ----------------------------------------------------------------------------
001244r 2 ; IF STRING DESCRIPTOR POINTED TO BY FAC+3,4 IS
001244r 2 ; A TEMPORARY STRING, RELEASE IT.
001244r 2 ; ----------------------------------------------------------------------------
001244r 2 FREFAC:
001244r 2 A5 B1 lda FAC_LAST-1
001246r 2 A4 B2 ldy FAC_LAST
001248r 2
001248r 2 ; ----------------------------------------------------------------------------
001248r 2 ; IF STRING DESCRIPTOR WHOSE ADDRESS IS IN Y,A IS
001248r 2 ; A TEMPORARY STRING, RELEASE IT.
001248r 2 ; ----------------------------------------------------------------------------
001248r 2 FRETMP:
001248r 2 85 6F sta INDEX
00124Ar 2 84 70 sty INDEX+1
00124Cr 2 20 rr rr jsr FRETMS
00124Fr 2 08 php
001250r 2 A0 00 ldy #$00
001252r 2 B1 6F lda (INDEX),y
001254r 2 48 pha
001255r 2 C8 iny
001256r 2 B1 6F lda (INDEX),y
001258r 2 AA tax
001259r 2 C8 iny
00125Ar 2 B1 6F lda (INDEX),y
00125Cr 2 A8 tay
00125Dr 2 68 pla
00125Er 2 28 plp
00125Fr 2 D0 13 bne L34CD
001261r 2 C4 81 cpy FRETOP+1
001263r 2 D0 0F bne L34CD
001265r 2 E4 80 cpx FRETOP
001267r 2 D0 0B bne L34CD
001269r 2 48 pha
00126Ar 2 18 clc
00126Br 2 65 80 adc FRETOP
00126Dr 2 85 80 sta FRETOP
00126Fr 2 90 02 bcc L34CC
001271r 2 E6 81 inc FRETOP+1
001273r 2 L34CC:
001273r 2 68 pla
001274r 2 L34CD:
001274r 2 86 6F stx INDEX
001276r 2 84 70 sty INDEX+1
001278r 2 60 rts
001279r 2
001279r 2 ; ----------------------------------------------------------------------------
001279r 2 ; RELEASE TEMPORARY DESCRIPTOR IF Y,A = LASTPT
001279r 2 ; ----------------------------------------------------------------------------
001279r 2 FRETMS:
001279r 2 .ifdef KBD
001279r 2 cpy #$00
001279r 2 .else
001279r 2 C4 65 cpy LASTPT+1
00127Br 2 .endif
00127Br 2 D0 0C bne L34E2
00127Dr 2 C5 64 cmp LASTPT
00127Fr 2 D0 08 bne L34E2
001281r 2 85 63 sta TEMPPT
001283r 2 E9 03 sbc #$03
001285r 2 85 64 sta LASTPT
001287r 2 A0 00 ldy #$00
001289r 2 L34E2:
001289r 2 60 rts
00128Ar 2
00128Ar 2 ; ----------------------------------------------------------------------------
00128Ar 2 ; "CHR$" FUNCTION
00128Ar 2 ; ----------------------------------------------------------------------------
00128Ar 2 CHRSTR:
00128Ar 2 20 rr rr jsr CONINT
00128Dr 2 8A txa
00128Er 2 48 pha
00128Fr 2 A9 01 lda #$01
001291r 2 20 rr rr jsr STRSPA
001294r 2 68 pla
001295r 2 A0 00 ldy #$00
001297r 2 91 AF sta (FAC+1),y
001299r 2 68 pla
00129Ar 2 68 pla
00129Br 2 4C rr rr jmp PUTNEW
00129Er 2
00129Er 2 ; ----------------------------------------------------------------------------
00129Er 2 ; "LEFT$" FUNCTION
00129Er 2 ; ----------------------------------------------------------------------------
00129Er 2 LEFTSTR:
00129Er 2 20 rr rr jsr SUBSTRING_SETUP
0012A1r 2 D1 9D cmp (DSCPTR),y
0012A3r 2 98 tya
0012A4r 2 SUBSTRING1:
0012A4r 2 90 04 bcc L3503
0012A6r 2 B1 9D lda (DSCPTR),y
0012A8r 2 AA tax
0012A9r 2 98 tya
0012AAr 2 L3503:
0012AAr 2 48 pha
0012ABr 2 SUBSTRING2:
0012ABr 2 8A txa
0012ACr 2 SUBSTRING3:
0012ACr 2 48 pha
0012ADr 2 20 rr rr jsr STRSPA
0012B0r 2 A5 9D lda DSCPTR
0012B2r 2 A4 9E ldy DSCPTR+1
0012B4r 2 20 rr rr jsr FRETMP
0012B7r 2 68 pla
0012B8r 2 A8 tay
0012B9r 2 68 pla
0012BAr 2 18 clc
0012BBr 2 65 6F adc INDEX
0012BDr 2 85 6F sta INDEX
0012BFr 2 90 02 bcc L351C
0012C1r 2 E6 70 inc INDEX+1
0012C3r 2 L351C:
0012C3r 2 98 tya
0012C4r 2 20 rr rr jsr MOVSTR1
0012C7r 2 4C rr rr jmp PUTNEW
0012CAr 2
0012CAr 2 ; ----------------------------------------------------------------------------
0012CAr 2 ; "RIGHT$" FUNCTION
0012CAr 2 ; ----------------------------------------------------------------------------
0012CAr 2 RIGHTSTR:
0012CAr 2 20 rr rr jsr SUBSTRING_SETUP
0012CDr 2 18 clc
0012CEr 2 F1 9D sbc (DSCPTR),y
0012D0r 2 49 FF eor #$FF
0012D2r 2 4C rr rr jmp SUBSTRING1
0012D5r 2
0012D5r 2 ; ----------------------------------------------------------------------------
0012D5r 2 ; "MID$" FUNCTION
0012D5r 2 ; ----------------------------------------------------------------------------
0012D5r 2 MIDSTR:
0012D5r 2 A9 FF lda #$FF
0012D7r 2 85 B2 sta FAC_LAST
0012D9r 2 20 C6 00 jsr CHRGOT
0012DCr 2 C9 29 cmp #$29
0012DEr 2 F0 06 beq L353F
0012E0r 2 20 rr rr jsr CHKCOM
0012E3r 2 20 rr rr jsr GETBYT
0012E6r 2 L353F:
0012E6r 2 20 rr rr jsr SUBSTRING_SETUP
0012E9r 2 .ifdef CONFIG_2
0012E9r 2 beq GOIQ
0012E9r 2 .endif
0012E9r 2 CA dex
0012EAr 2 8A txa
0012EBr 2 48 pha
0012ECr 2 18 clc
0012EDr 2 A2 00 ldx #$00
0012EFr 2 F1 9D sbc (DSCPTR),y
0012F1r 2 B0 B8 bcs SUBSTRING2
0012F3r 2 49 FF eor #$FF
0012F5r 2 C5 B2 cmp FAC_LAST
0012F7r 2 90 B3 bcc SUBSTRING3
0012F9r 2 A5 B2 lda FAC_LAST
0012FBr 2 B0 AF bcs SUBSTRING3
0012FDr 2
0012FDr 2 ; ----------------------------------------------------------------------------
0012FDr 2 ; COMMON SETUP ROUTINE FOR LEFT$, RIGHT$, MID$:
0012FDr 2 ; REQUIRE ")"; POP RETURN ADRS, GET DESCRIPTOR
0012FDr 2 ; ADDRESS, GET 1ST PARAMETER OF COMMAND
0012FDr 2 ; ----------------------------------------------------------------------------
0012FDr 2 SUBSTRING_SETUP:
0012FDr 2 20 rr rr jsr CHKCLS
001300r 2 68 pla
001301r 2 .ifndef CONFIG_11
001301r 2 sta JMPADRS+1
001301r 2 pla
001301r 2 sta JMPADRS+2
001301r 2 .else
001301r 2 A8 tay
001302r 2 68 pla
001303r 2 85 A2 sta Z52
001305r 2 .endif
001305r 2 68 pla
001306r 2 68 pla
001307r 2 68 pla
001308r 2 AA tax
001309r 2 68 pla
00130Ar 2 85 9D sta DSCPTR
00130Cr 2 68 pla
00130Dr 2 85 9E sta DSCPTR+1
00130Fr 2 .ifdef CONFIG_11
00130Fr 2 A5 A2 lda Z52
001311r 2 48 pha
001312r 2 98 tya
001313r 2 48 pha
001314r 2 .endif
001314r 2 A0 00 ldy #$00
001316r 2 8A txa
001317r 2 .ifndef CONFIG_2
001317r 2 F0 1D beq GOIQ
001319r 2 .endif
001319r 2 .ifndef CONFIG_11
001319r 2 inc JMPADRS+1
001319r 2 jmp (JMPADRS+1)
001319r 2 .else
001319r 2 60 rts
00131Ar 2 .endif
00131Ar 2
00131Ar 2 ; ----------------------------------------------------------------------------
00131Ar 2 ; "LEN" FUNCTION
00131Ar 2 ; ----------------------------------------------------------------------------
00131Ar 2 LEN:
00131Ar 2 20 rr rr jsr GETSTR
00131Dr 2 SNGFLT1:
00131Dr 2 4C rr rr jmp SNGFLT
001320r 2
001320r 2 ; ----------------------------------------------------------------------------
001320r 2 ; IF LAST RESULT IS A TEMPORARY STRING, FREE IT
001320r 2 ; MAKE VALTYP NUMERIC, RETURN LENGTH IN Y-REG
001320r 2 ; ----------------------------------------------------------------------------
001320r 2 GETSTR:
001320r 2 20 rr rr jsr FRESTR
001323r 2 A2 00 ldx #$00
001325r 2 86 0E stx VALTYP
001327r 2 A8 tay
001328r 2 60 rts
001329r 2
001329r 2 ; ----------------------------------------------------------------------------
001329r 2 ; "ASC" FUNCTION
001329r 2 ; ----------------------------------------------------------------------------
001329r 2 ASC:
001329r 2 20 rr rr jsr GETSTR
00132Cr 2 F0 08 beq GOIQ
00132Er 2 A0 00 ldy #$00
001330r 2 B1 6F lda (INDEX),y
001332r 2 A8 tay
001333r 2 .ifndef CONFIG_11A
001333r 2 jmp SNGFLT1
001333r 2 .else
001333r 2 4C rr rr jmp SNGFLT
001336r 2 .endif
001336r 2 ; ----------------------------------------------------------------------------
001336r 2 GOIQ:
001336r 2 4C rr rr jmp IQERR
001339r 2
001339r 2 ; ----------------------------------------------------------------------------
001339r 2 ; SCAN TO NEXT CHARACTER AND CONVERT EXPRESSION
001339r 2 ; TO SINGLE BYTE IN X-REG
001339r 2 ; ----------------------------------------------------------------------------
001339r 2 GTBYTC:
001339r 2 20 C0 00 jsr CHRGET
00133Cr 2
00133Cr 2 ; ----------------------------------------------------------------------------
00133Cr 2 ; EVALUATE EXPRESSION AT TXTPTR, AND
00133Cr 2 ; CONVERT IT TO SINGLE BYTE IN X-REG
00133Cr 2 ; ----------------------------------------------------------------------------
00133Cr 2 GETBYT:
00133Cr 2 20 rr rr jsr FRMNUM
00133Fr 2
00133Fr 2 ; ----------------------------------------------------------------------------
00133Fr 2 ; CONVERT (FAC) TO SINGLE BYTE INTEGER IN X-REG
00133Fr 2 ; ----------------------------------------------------------------------------
00133Fr 2 CONINT:
00133Fr 2 20 rr rr jsr MKINT
001342r 2 A6 B1 ldx FAC_LAST-1
001344r 2 D0 F0 bne GOIQ
001346r 2 A6 B2 ldx FAC_LAST
001348r 2 4C C6 00 jmp CHRGOT
00134Br 2
00134Br 2 ; ----------------------------------------------------------------------------
00134Br 2 ; "VAL" FUNCTION
00134Br 2 ; ----------------------------------------------------------------------------
00134Br 2 VAL:
00134Br 2 20 rr rr jsr GETSTR
00134Er 2 D0 03 bne L35AC
001350r 2 4C rr rr jmp ZERO_FAC
001353r 2 L35AC:
001353r 2 A6 C7 ldx TXTPTR
001355r 2 A4 C8 ldy TXTPTR+1
001357r 2 86 BE stx STRNG2
001359r 2 84 BF sty STRNG2+1
00135Br 2 A6 6F ldx INDEX
00135Dr 2 86 C7 stx TXTPTR
00135Fr 2 18 clc
001360r 2 65 6F adc INDEX
001362r 2 85 71 sta DEST
001364r 2 A6 70 ldx INDEX+1
001366r 2 86 C8 stx TXTPTR+1
001368r 2 90 01 bcc L35C4
00136Ar 2 E8 inx
00136Br 2 L35C4:
00136Br 2 86 72 stx DEST+1
00136Dr 2 A0 00 ldy #$00
00136Fr 2 B1 71 lda (DEST),y
001371r 2 48 pha
001372r 2 A9 00 lda #$00
001374r 2 91 71 sta (DEST),y
001376r 2 20 C6 00 jsr CHRGOT
001379r 2 20 rr rr jsr FIN
00137Cr 2 68 pla
00137Dr 2 A0 00 ldy #$00
00137Fr 2 91 71 sta (DEST),y
001381r 2
001381r 2 ; ----------------------------------------------------------------------------
001381r 2 ; COPY STRNG2 INTO TXTPTR
001381r 2 ; ----------------------------------------------------------------------------
001381r 2 POINT:
001381r 2 A6 BE ldx STRNG2
001383r 2 A4 BF ldy STRNG2+1
001385r 2 86 C7 stx TXTPTR
001387r 2 84 C8 sty TXTPTR+1
001389r 2 60 rts
00138Ar 2
00138Ar 2
00138Ar 1 .include "misc3.s"
00138Ar 2 ; KBD specific patches
00138Ar 2
00138Ar 2 .segment "CODE"
00138Ar 2
00138Ar 2 .ifdef KBD
00138Ar 2 VARTAB_MINUS_2_TO_AY:
00138Ar 2 lda VARTAB
00138Ar 2 sec
00138Ar 2 sbc #$02
00138Ar 2 ldy VARTAB+1
00138Ar 2 bcs LF42C
00138Ar 2 dey
00138Ar 2 LF42C:
00138Ar 2 rts
00138Ar 2
00138Ar 2 ; ----------------------------------------------------------------------------
00138Ar 2 GET_UPPER:
00138Ar 2 lda INPUTBUFFERX,x
00138Ar 2 LF430:
00138Ar 2 cmp #'a'
00138Ar 2 bcc LF43A
00138Ar 2 cmp #'z'+1
00138Ar 2 bcs LF43A
00138Ar 2 LF438:
00138Ar 2 sbc #$1F
00138Ar 2 LF43A:
00138Ar 2 rts
00138Ar 2
00138Ar 2 ; ----------------------------------------------------------------------------
00138Ar 2 GETLN:
00138Ar 2 ldx #$5D
00138Ar 2 LF43D:
00138Ar 2 txa
00138Ar 2 and #$7F
00138Ar 2 cmp $0340
00138Ar 2 beq LF44D
00138Ar 2 sta $0340
00138Ar 2 lda #$03
00138Ar 2 jsr LDE48
00138Ar 2 LF44D:
00138Ar 2 jsr LDE7F
00138Ar 2 bne RTS4
00138Ar 2 cpx #$80
00138Ar 2 bcc LF44D
00138Ar 2 RTS4:
00138Ar 2 rts
00138Ar 2
00138Ar 2 ; ----------------------------------------------------------------------------
00138Ar 2 LF457:
00138Ar 2 lda TXTTAB
00138Ar 2 ldx TXTTAB+1
00138Ar 2 LF45B:
00138Ar 2 sta JMPADRS+1
00138Ar 2 stx JMPADRS+2
00138Ar 2 ldy #$01
00138Ar 2 lda (JMPADRS+1),y
00138Ar 2 beq LF438
00138Ar 2 iny
00138Ar 2 iny
00138Ar 2 lda (JMPADRS+1),y
00138Ar 2 dey
00138Ar 2 cmp LINNUM+1
00138Ar 2 bne LF472
00138Ar 2 lda (JMPADRS+1),y
00138Ar 2 cmp LINNUM
00138Ar 2 LF472:
00138Ar 2 bcs LF43A
00138Ar 2 dey
00138Ar 2 lda (JMPADRS+1),y
00138Ar 2 tax
00138Ar 2 dey
00138Ar 2 lda (JMPADRS+1),y
00138Ar 2 bcc LF45B
00138Ar 2 LF47D:
00138Ar 2 jmp (JMPADRS+1)
00138Ar 2 .endif
00138Ar 2
00138Ar 1 .include "poke.s"
00138Ar 2 .segment "CODE"
00138Ar 2
00138Ar 2 .ifndef CONFIG_NO_POKE
00138Ar 2 ; ----------------------------------------------------------------------------
00138Ar 2 ; EVALUATE "EXP1,EXP2"
00138Ar 2 ;
00138Ar 2 ; CONVERT EXP1 TO 16-BIT NUMBER IN LINNUM
00138Ar 2 ; CONVERT EXP2 TO 8-BIT NUMBER IN X-REG
00138Ar 2 ; ----------------------------------------------------------------------------
00138Ar 2 GTNUM:
00138Ar 2 20 rr rr jsr FRMNUM
00138Dr 2 20 rr rr jsr GETADR
001390r 2
001390r 2 ; ----------------------------------------------------------------------------
001390r 2 ; EVALUATE ",EXPRESSION"
001390r 2 ; CONVERT EXPRESSION TO SINGLE BYTE IN X-REG
001390r 2 ; ----------------------------------------------------------------------------
001390r 2 COMBYTE:
001390r 2 20 rr rr jsr CHKCOM
001393r 2 4C rr rr jmp GETBYT
001396r 2
001396r 2 ; ----------------------------------------------------------------------------
001396r 2 ; CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM
001396r 2 ; ----------------------------------------------------------------------------
001396r 2 GETADR:
001396r 2 A5 B3 lda FACSIGN
001398r 2 .ifdef APPLE
001398r 2 nop ; PATCH
001398r 2 nop
001398r 2 .else
001398r 2 30 9C bmi GOIQ
00139Ar 2 .endif
00139Ar 2 A5 AE lda FAC
00139Cr 2 C9 91 cmp #$91
00139Er 2 B0 96 bcs GOIQ
0013A0r 2 20 rr rr jsr QINT
0013A3r 2 A5 B1 lda FAC_LAST-1
0013A5r 2 A4 B2 ldy FAC_LAST
0013A7r 2 84 19 sty LINNUM
0013A9r 2 85 1A sta LINNUM+1
0013ABr 2 60 rts
0013ACr 2
0013ACr 2 ; ----------------------------------------------------------------------------
0013ACr 2 ; "PEEK" FUNCTION
0013ACr 2 ; ----------------------------------------------------------------------------
0013ACr 2 PEEK:
0013ACr 2 .ifdef CONFIG_PEEK_SAVE_LINNUM
0013ACr 2 lda LINNUM+1
0013ACr 2 pha
0013ACr 2 lda LINNUM
0013ACr 2 pha
0013ACr 2 .endif
0013ACr 2 20 rr rr jsr GETADR
0013AFr 2 A0 00 ldy #$00
0013B1r 2 .ifdef CBM1
0013B1r 2 ; disallow PEEK between $C000 and $DFFF
0013B1r 2 cmp #$C0
0013B1r 2 bcc LD6F3
0013B1r 2 cmp #$E1
0013B1r 2 bcc LD6F6
0013B1r 2 LD6F3:
0013B1r 2 .endif
0013B1r 2 .ifdef CBM2
0013B1r 2 nop ; patch that disables the compares above
0013B1r 2 nop
0013B1r 2 nop
0013B1r 2 nop
0013B1r 2 nop
0013B1r 2 nop
0013B1r 2 nop
0013B1r 2 nop
0013B1r 2 .endif
0013B1r 2 B1 19 lda (LINNUM),y
0013B3r 2 A8 tay
0013B4r 2 .ifdef CONFIG_PEEK_SAVE_LINNUM
0013B4r 2 pla
0013B4r 2 sta LINNUM
0013B4r 2 pla
0013B4r 2 sta LINNUM+1
0013B4r 2 .endif
0013B4r 2 LD6F6:
0013B4r 2 4C rr rr jmp SNGFLT
0013B7r 2
0013B7r 2 ; ----------------------------------------------------------------------------
0013B7r 2 ; "POKE" STATEMENT
0013B7r 2 ; ----------------------------------------------------------------------------
0013B7r 2 POKE:
0013B7r 2 20 rr rr jsr GTNUM
0013BAr 2 8A txa
0013BBr 2 A0 00 ldy #$00
0013BDr 2 91 19 sta (LINNUM),y
0013BFr 2 60 rts
0013C0r 2
0013C0r 2 ; ----------------------------------------------------------------------------
0013C0r 2 ; "WAIT" STATEMENT
0013C0r 2 ; ----------------------------------------------------------------------------
0013C0r 2 WAIT:
0013C0r 2 20 rr rr jsr GTNUM
0013C3r 2 86 96 stx FORPNT
0013C5r 2 A2 00 ldx #$00
0013C7r 2 20 C6 00 jsr CHRGOT
0013CAr 2 .ifdef CONFIG_EASTER_EGG
0013CAr 2 beq EASTER_EGG
0013CAr 2 .else
0013CAr 2 F0 03 beq L3628
0013CCr 2 .endif
0013CCr 2 20 rr rr jsr COMBYTE
0013CFr 2 L3628:
0013CFr 2 86 97 stx FORPNT+1
0013D1r 2 A0 00 ldy #$00
0013D3r 2 L362C:
0013D3r 2 B1 19 lda (LINNUM),y
0013D5r 2 45 97 eor FORPNT+1
0013D7r 2 25 96 and FORPNT
0013D9r 2 F0 F8 beq L362C
0013DBr 2 RTS3:
0013DBr 2 60 rts
0013DCr 2 .endif ;/* KBD */
0013DCr 2
0013DCr 1 .include "float.s"
0013DCr 2 .segment "CODE"
0013DCr 2
0013DCr 2 TEMP1X = TEMP1+(5-BYTES_FP)
0013DCr 2
0013DCr 2 ; ----------------------------------------------------------------------------
0013DCr 2 ; ADD 0.5 TO FAC
0013DCr 2 ; ----------------------------------------------------------------------------
0013DCr 2 FADDH:
0013DCr 2 A9 rr lda #<CON_HALF
0013DEr 2 A0 rr ldy #>CON_HALF
0013E0r 2 4C rr rr jmp FADD
0013E3r 2
0013E3r 2 ; ----------------------------------------------------------------------------
0013E3r 2 ; FAC = (Y,A) - FAC
0013E3r 2 ; ----------------------------------------------------------------------------
0013E3r 2 FSUB:
0013E3r 2 20 rr rr jsr LOAD_ARG_FROM_YA
0013E6r 2
0013E6r 2 ; ----------------------------------------------------------------------------
0013E6r 2 ; FAC = ARG - FAC
0013E6r 2 ; ----------------------------------------------------------------------------
0013E6r 2 FSUBT:
0013E6r 2 A5 B3 lda FACSIGN
0013E8r 2 49 FF eor #$FF
0013EAr 2 85 B3 sta FACSIGN
0013ECr 2 45 BB eor ARGSIGN
0013EEr 2 85 BC sta SGNCPR
0013F0r 2 A5 AE lda FAC
0013F2r 2 4C rr rr jmp FADDT
0013F5r 2
0013F5r 2 ; ----------------------------------------------------------------------------
0013F5r 2 ; Commodore BASIC V2 Easter Egg
0013F5r 2 ; ----------------------------------------------------------------------------
0013F5r 2 .ifdef CONFIG_EASTER_EGG
0013F5r 2 EASTER_EGG:
0013F5r 2 lda LINNUM
0013F5r 2 cmp #<6502
0013F5r 2 bne L3628
0013F5r 2 lda LINNUM+1
0013F5r 2 sbc #>6502
0013F5r 2 bne L3628
0013F5r 2 sta LINNUM
0013F5r 2 tay
0013F5r 2 lda #$80
0013F5r 2 sta LINNUM+1
0013F5r 2 LD758:
0013F5r 2 ldx #$0A
0013F5r 2 LD75A:
0013F5r 2 lda MICROSOFT-1,x
0013F5r 2 and #$3F
0013F5r 2 sta (LINNUM),y
0013F5r 2 iny
0013F5r 2 bne LD766
0013F5r 2 inc LINNUM+1
0013F5r 2 LD766:
0013F5r 2 dex
0013F5r 2 bne LD75A
0013F5r 2 dec FORPNT
0013F5r 2 bne LD758
0013F5r 2 rts
0013F5r 2 .endif
0013F5r 2
0013F5r 2 ; ----------------------------------------------------------------------------
0013F5r 2 ; SHIFT SMALLER ARGUMENT MORE THAN 7 BITS
0013F5r 2 ; ----------------------------------------------------------------------------
0013F5r 2 FADD1:
0013F5r 2 20 rr rr jsr SHIFT_RIGHT
0013F8r 2 90 3C bcc FADD3
0013FAr 2
0013FAr 2 ; ----------------------------------------------------------------------------
0013FAr 2 ; FAC = (Y,A) + FAC
0013FAr 2 ; ----------------------------------------------------------------------------
0013FAr 2 FADD:
0013FAr 2 20 rr rr jsr LOAD_ARG_FROM_YA
0013FDr 2
0013FDr 2 ; ----------------------------------------------------------------------------
0013FDr 2 ; FAC = ARG + FAC
0013FDr 2 ; ----------------------------------------------------------------------------
0013FDr 2 FADDT:
0013FDr 2 D0 03 bne L365B
0013FFr 2 4C rr rr jmp COPY_ARG_TO_FAC
001402r 2 L365B:
001402r 2 A6 BD ldx FACEXTENSION
001404r 2 86 A3 stx ARGEXTENSION
001406r 2 A2 B6 ldx #ARG
001408r 2 A5 B6 lda ARG
00140Ar 2 FADD2:
00140Ar 2 A8 tay
00140Br 2 .ifdef KBD
00140Br 2 beq RTS4
00140Br 2 .else
00140Br 2 F0 CE beq RTS3
00140Dr 2 .endif
00140Dr 2 38 sec
00140Er 2 E5 AE sbc FAC
001410r 2 F0 24 beq FADD3
001412r 2 90 12 bcc L367F
001414r 2 84 AE sty FAC
001416r 2 A4 BB ldy ARGSIGN
001418r 2 84 B3 sty FACSIGN
00141Ar 2 49 FF eor #$FF
00141Cr 2 69 00 adc #$00
00141Er 2 A0 00 ldy #$00
001420r 2 84 A3 sty ARGEXTENSION
001422r 2 A2 AE ldx #FAC
001424r 2 D0 04 bne L3683
001426r 2 L367F:
001426r 2 A0 00 ldy #$00
001428r 2 84 BD sty FACEXTENSION
00142Ar 2 L3683:
00142Ar 2 C9 F9 cmp #$F9
00142Cr 2 30 C7 bmi FADD1
00142Er 2 A8 tay
00142Fr 2 A5 BD lda FACEXTENSION
001431r 2 56 01 lsr 1,x
001433r 2 20 rr rr jsr SHIFT_RIGHT4
001436r 2 FADD3:
001436r 2 24 BC bit SGNCPR
001438r 2 10 57 bpl FADD4
00143Ar 2 A0 AE ldy #FAC
00143Cr 2 E0 B6 cpx #ARG
00143Er 2 F0 02 beq L369B
001440r 2 A0 B6 ldy #ARG
001442r 2 L369B:
001442r 2 38 sec
001443r 2 49 FF eor #$FF
001445r 2 65 A3 adc ARGEXTENSION
001447r 2 85 BD sta FACEXTENSION
001449r 2 .ifndef CONFIG_SMALL
001449r 2 B9 04 00 lda 4,y
00144Cr 2 F5 04 sbc 4,x
00144Er 2 85 B2 sta FAC+4
001450r 2 .endif
001450r 2 B9 03 00 lda 3,y
001453r 2 F5 03 sbc 3,x
001455r 2 85 B1 sta FAC+3
001457r 2 B9 02 00 lda 2,y
00145Ar 2 F5 02 sbc 2,x
00145Cr 2 85 B0 sta FAC+2
00145Er 2 B9 01 00 lda 1,y
001461r 2 F5 01 sbc 1,x
001463r 2 85 AF sta FAC+1
001465r 2
001465r 2 ; ----------------------------------------------------------------------------
001465r 2 ; NORMALIZE VALUE IN FAC
001465r 2 ; ----------------------------------------------------------------------------
001465r 2 NORMALIZE_FAC1:
001465r 2 B0 03 bcs NORMALIZE_FAC2
001467r 2 20 rr rr jsr COMPLEMENT_FAC
00146Ar 2 NORMALIZE_FAC2:
00146Ar 2 A0 00 ldy #$00
00146Cr 2 98 tya
00146Dr 2 18 clc
00146Er 2 L36C7:
00146Er 2 A6 AF ldx FAC+1
001470r 2 D0 4A bne NORMALIZE_FAC4
001472r 2 A6 B0 ldx FAC+2
001474r 2 86 AF stx FAC+1
001476r 2 A6 B1 ldx FAC+3
001478r 2 86 B0 stx FAC+2
00147Ar 2 .ifdef CONFIG_SMALL
00147Ar 2 ldx FACEXTENSION
00147Ar 2 stx FAC+3
00147Ar 2 .else
00147Ar 2 A6 B2 ldx FAC+4
00147Cr 2 86 B1 stx FAC+3
00147Er 2 A6 BD ldx FACEXTENSION
001480r 2 86 B2 stx FAC+4
001482r 2 .endif
001482r 2 84 BD sty FACEXTENSION
001484r 2 69 08 adc #$08
001486r 2 .ifdef CONFIG_2B
001486r 2 ; bugfix?
001486r 2 ; fix does not exist on AppleSoft 2
001486r 2 cmp #(MANTISSA_BYTES+1)*8
001486r 2 .else
001486r 2 C9 20 cmp #MANTISSA_BYTES*8
001488r 2 .endif
001488r 2 D0 E4 bne L36C7
00148Ar 2
00148Ar 2 ; ----------------------------------------------------------------------------
00148Ar 2 ; SET FAC = 0
00148Ar 2 ; (ONLY NECESSARY TO ZERO EXPONENT AND SIGN CELLS)
00148Ar 2 ; ----------------------------------------------------------------------------
00148Ar 2 ZERO_FAC:
00148Ar 2 A9 00 lda #$00
00148Cr 2 STA_IN_FAC_SIGN_AND_EXP:
00148Cr 2 85 AE sta FAC
00148Er 2 STA_IN_FAC_SIGN:
00148Er 2 85 B3 sta FACSIGN
001490r 2 60 rts
001491r 2
001491r 2 ; ----------------------------------------------------------------------------
001491r 2 ; ADD MANTISSAS OF FAC AND ARG INTO FAC
001491r 2 ; ----------------------------------------------------------------------------
001491r 2 FADD4:
001491r 2 65 A3 adc ARGEXTENSION
001493r 2 85 BD sta FACEXTENSION
001495r 2 .ifndef CONFIG_SMALL
001495r 2 A5 B2 lda FAC+4
001497r 2 65 BA adc ARG+4
001499r 2 85 B2 sta FAC+4
00149Br 2 .endif
00149Br 2 A5 B1 lda FAC+3
00149Dr 2 65 B9 adc ARG+3
00149Fr 2 85 B1 sta FAC+3
0014A1r 2 A5 B0 lda FAC+2
0014A3r 2 65 B8 adc ARG+2
0014A5r 2 85 B0 sta FAC+2
0014A7r 2 A5 AF lda FAC+1
0014A9r 2 65 B7 adc ARG+1
0014ABr 2 85 AF sta FAC+1
0014ADr 2 4C rr rr jmp NORMALIZE_FAC5
0014B0r 2
0014B0r 2 ; ----------------------------------------------------------------------------
0014B0r 2 ; FINISH NORMALIZING FAC
0014B0r 2 ; ----------------------------------------------------------------------------
0014B0r 2 NORMALIZE_FAC3:
0014B0r 2 69 01 adc #$01
0014B2r 2 06 BD asl FACEXTENSION
0014B4r 2 .ifndef CONFIG_SMALL
0014B4r 2 26 B2 rol FAC+4
0014B6r 2 .endif
0014B6r 2 26 B1 rol FAC+3
0014B8r 2 26 B0 rol FAC+2
0014BAr 2 26 AF rol FAC+1
0014BCr 2 NORMALIZE_FAC4:
0014BCr 2 10 F2 bpl NORMALIZE_FAC3
0014BEr 2 38 sec
0014BFr 2 E5 AE sbc FAC
0014C1r 2 B0 C7 bcs ZERO_FAC
0014C3r 2 49 FF eor #$FF
0014C5r 2 69 01 adc #$01
0014C7r 2 85 AE sta FAC
0014C9r 2 NORMALIZE_FAC5:
0014C9r 2 90 40 bcc L3764
0014CBr 2 NORMALIZE_FAC6:
0014CBr 2 E6 AE inc FAC
0014CDr 2 F0 74 beq OVERFLOW
0014CFr 2 .ifndef CONFIG_ROR_WORKAROUND
0014CFr 2 ror FAC+1
0014CFr 2 ror FAC+2
0014CFr 2 ror FAC+3
0014CFr 2 .ifndef CONFIG_SMALL
0014CFr 2 ror FAC+4
0014CFr 2 .endif
0014CFr 2 ror FACEXTENSION
0014CFr 2 .else
0014CFr 2 A9 00 lda #$00
0014D1r 2 90 02 bcc L372E
0014D3r 2 A9 80 lda #$80
0014D5r 2 L372E:
0014D5r 2 46 AF lsr FAC+1
0014D7r 2 05 AF ora FAC+1
0014D9r 2 85 AF sta FAC+1
0014DBr 2 A9 00 lda #$00
0014DDr 2 90 02 bcc L373A
0014DFr 2 A9 80 lda #$80
0014E1r 2 L373A:
0014E1r 2 46 B0 lsr FAC+2
0014E3r 2 05 B0 ora FAC+2
0014E5r 2 85 B0 sta FAC+2
0014E7r 2 A9 00 lda #$00
0014E9r 2 90 02 bcc L3746
0014EBr 2 A9 80 lda #$80
0014EDr 2 L3746:
0014EDr 2 46 B1 lsr FAC+3
0014EFr 2 05 B1 ora FAC+3
0014F1r 2 85 B1 sta FAC+3
0014F3r 2 A9 00 lda #$00
0014F5r 2 90 02 bcc L3752
0014F7r 2 A9 80 lda #$80
0014F9r 2 L3752:
0014F9r 2 46 B2 lsr FAC+4
0014FBr 2 05 B2 ora FAC+4
0014FDr 2 85 B2 sta FAC+4
0014FFr 2 A9 00 lda #$00
001501r 2 90 02 bcc L375E
001503r 2 A9 80 lda #$80
001505r 2 L375E:
001505r 2 46 BD lsr FACEXTENSION
001507r 2 05 BD ora FACEXTENSION
001509r 2 85 BD sta FACEXTENSION
00150Br 2 .endif
00150Br 2 L3764:
00150Br 2 60 rts
00150Cr 2
00150Cr 2 ; ----------------------------------------------------------------------------
00150Cr 2 ; 2'S COMPLEMENT OF FAC
00150Cr 2 ; ----------------------------------------------------------------------------
00150Cr 2 COMPLEMENT_FAC:
00150Cr 2 A5 B3 lda FACSIGN
00150Er 2 49 FF eor #$FF
001510r 2 85 B3 sta FACSIGN
001512r 2
001512r 2 ; ----------------------------------------------------------------------------
001512r 2 ; 2'S COMPLEMENT OF FAC MANTISSA ONLY
001512r 2 ; ----------------------------------------------------------------------------
001512r 2 COMPLEMENT_FAC_MANTISSA:
001512r 2 A5 AF lda FAC+1
001514r 2 49 FF eor #$FF
001516r 2 85 AF sta FAC+1
001518r 2 A5 B0 lda FAC+2
00151Ar 2 49 FF eor #$FF
00151Cr 2 85 B0 sta FAC+2
00151Er 2 A5 B1 lda FAC+3
001520r 2 49 FF eor #$FF
001522r 2 85 B1 sta FAC+3
001524r 2 .ifndef CONFIG_SMALL
001524r 2 A5 B2 lda FAC+4
001526r 2 49 FF eor #$FF
001528r 2 85 B2 sta FAC+4
00152Ar 2 .endif
00152Ar 2 A5 BD lda FACEXTENSION
00152Cr 2 49 FF eor #$FF
00152Er 2 85 BD sta FACEXTENSION
001530r 2 E6 BD inc FACEXTENSION
001532r 2 D0 0E bne RTS12
001534r 2
001534r 2 ; ----------------------------------------------------------------------------
001534r 2 ; INCREMENT FAC MANTISSA
001534r 2 ; ----------------------------------------------------------------------------
001534r 2 INCREMENT_FAC_MANTISSA:
001534r 2 .ifndef CONFIG_SMALL
001534r 2 E6 B2 inc FAC+4
001536r 2 D0 0A bne RTS12
001538r 2 .endif
001538r 2 E6 B1 inc FAC+3
00153Ar 2 D0 06 bne RTS12
00153Cr 2 E6 B0 inc FAC+2
00153Er 2 D0 02 bne RTS12
001540r 2 E6 AF inc FAC+1
001542r 2 RTS12:
001542r 2 60 rts
001543r 2 OVERFLOW:
001543r 2 A2 45 ldx #ERR_OVERFLOW
001545r 2 4C rr rr jmp ERROR
001548r 2
001548r 2 ; ----------------------------------------------------------------------------
001548r 2 ; SHIFT 1,X THRU 5,X RIGHT
001548r 2 ; (A) = NEGATIVE OF SHIFT COUNT
001548r 2 ; (X) = POINTER TO BYTES TO BE SHIFTED
001548r 2 ;
001548r 2 ; RETURN WITH (Y)=0, CARRY=0, EXTENSION BITS IN A-REG
001548r 2 ; ----------------------------------------------------------------------------
001548r 2 SHIFT_RIGHT1:
001548r 2 A2 72 ldx #RESULT-1
00154Ar 2 SHIFT_RIGHT2:
00154Ar 2 .ifdef CONFIG_SMALL
00154Ar 2 ldy 3,x
00154Ar 2 .else
00154Ar 2 B4 04 ldy 4,x
00154Cr 2 .endif
00154Cr 2 84 BD sty FACEXTENSION
00154Er 2 .ifndef CONFIG_SMALL
00154Er 2 B4 03 ldy 3,x
001550r 2 94 04 sty 4,x
001552r 2 .endif
001552r 2 B4 02 ldy 2,x
001554r 2 94 03 sty 3,x
001556r 2 B4 01 ldy 1,x
001558r 2 94 02 sty 2,x
00155Ar 2 A4 B5 ldy SHIFTSIGNEXT
00155Cr 2 94 01 sty 1,x
00155Er 2
00155Er 2 ; ----------------------------------------------------------------------------
00155Er 2 ; MAIN ENTRY TO RIGHT SHIFT SUBROUTINE
00155Er 2 ; ----------------------------------------------------------------------------
00155Er 2 SHIFT_RIGHT:
00155Er 2 69 08 adc #$08
001560r 2 30 E8 bmi SHIFT_RIGHT2
001562r 2 F0 E6 beq SHIFT_RIGHT2
001564r 2 E9 08 sbc #$08
001566r 2 A8 tay
001567r 2 A5 BD lda FACEXTENSION
001569r 2 B0 3C bcs SHIFT_RIGHT5
00156Br 2 .ifndef CONFIG_ROR_WORKAROUND
00156Br 2 LB588:
00156Br 2 asl 1,x
00156Br 2 bcc LB58E
00156Br 2 inc 1,x
00156Br 2 LB58E:
00156Br 2 ror 1,x
00156Br 2 ror 1,x
00156Br 2
00156Br 2 ; ----------------------------------------------------------------------------
00156Br 2 ; ENTER HERE FOR SHORT SHIFTS WITH NO SIGN EXTENSION
00156Br 2 ; ----------------------------------------------------------------------------
00156Br 2 SHIFT_RIGHT4:
00156Br 2 ror 2,x
00156Br 2 ror 3,x
00156Br 2 .ifndef CONFIG_SMALL
00156Br 2 ror 4,x
00156Br 2 .endif
00156Br 2 ror a
00156Br 2 iny
00156Br 2 bne LB588
00156Br 2 .else
00156Br 2 L37C4:
00156Br 2 48 pha
00156Cr 2 B5 01 lda 1,x
00156Er 2 29 80 and #$80
001570r 2 56 01 lsr 1,x
001572r 2 15 01 ora 1,x
001574r 2 95 01 sta 1,x
001576r 2 24 .byte $24
001577r 2 SHIFT_RIGHT4:
001577r 2 48 pha
001578r 2 A9 00 lda #$00
00157Ar 2 90 02 bcc L37D7
00157Cr 2 A9 80 lda #$80
00157Er 2 L37D7:
00157Er 2 56 02 lsr 2,x
001580r 2 15 02 ora 2,x
001582r 2 95 02 sta 2,x
001584r 2 A9 00 lda #$00
001586r 2 90 02 bcc L37E3
001588r 2 A9 80 lda #$80
00158Ar 2 L37E3:
00158Ar 2 56 03 lsr 3,x
00158Cr 2 15 03 ora 3,x
00158Er 2 95 03 sta 3,x
001590r 2 A9 00 lda #$00
001592r 2 90 02 bcc L37EF
001594r 2 A9 80 lda #$80
001596r 2 L37EF:
001596r 2 56 04 lsr 4,x
001598r 2 15 04 ora 4,x
00159Ar 2 95 04 sta 4,x
00159Cr 2 68 pla
00159Dr 2 08 php
00159Er 2 4A lsr a
00159Fr 2 28 plp
0015A0r 2 90 02 bcc L37FD
0015A2r 2 09 80 ora #$80
0015A4r 2 L37FD:
0015A4r 2 C8 iny
0015A5r 2 D0 C4 bne L37C4
0015A7r 2 .endif
0015A7r 2 SHIFT_RIGHT5:
0015A7r 2 18 clc
0015A8r 2 60 rts
0015A9r 2
0015A9r 2 ; ----------------------------------------------------------------------------
0015A9r 2 .ifdef CONFIG_SMALL
0015A9r 2 CON_ONE:
0015A9r 2 .byte $81,$00,$00,$00
0015A9r 2 POLY_LOG:
0015A9r 2 .byte $02
0015A9r 2 .byte $80,$19,$56,$62
0015A9r 2 .byte $80,$76,$22,$F3
0015A9r 2 .byte $82,$38,$AA,$40
0015A9r 2 CON_SQR_HALF:
0015A9r 2 .byte $80,$35,$04,$F3
0015A9r 2 CON_SQR_TWO:
0015A9r 2 .byte $81,$35,$04,$F3
0015A9r 2 CON_NEG_HALF:
0015A9r 2 .byte $80,$80,$00,$00
0015A9r 2 CON_LOG_TWO:
0015A9r 2 .byte $80,$31,$72,$18
0015A9r 2 .else
0015A9r 2 CON_ONE:
0015A9r 2 81 00 00 00 .byte $81,$00,$00,$00,$00
0015ADr 2 00
0015AEr 2 POLY_LOG:
0015AEr 2 03 .byte $03
0015AFr 2 7F 5E 56 CB .byte $7F,$5E,$56,$CB,$79
0015B3r 2 79
0015B4r 2 80 13 9B 0B .byte $80,$13,$9B,$0B,$64
0015B8r 2 64
0015B9r 2 80 76 38 93 .byte $80,$76,$38,$93,$16
0015BDr 2 16
0015BEr 2 82 38 AA 3B .byte $82,$38,$AA,$3B,$20
0015C2r 2 20
0015C3r 2 CON_SQR_HALF:
0015C3r 2 80 35 04 F3 .byte $80,$35,$04,$F3,$34
0015C7r 2 34
0015C8r 2 CON_SQR_TWO:
0015C8r 2 81 35 04 F3 .byte $81,$35,$04,$F3,$34
0015CCr 2 34
0015CDr 2 CON_NEG_HALF:
0015CDr 2 80 80 00 00 .byte $80,$80,$00,$00,$00
0015D1r 2 00
0015D2r 2 CON_LOG_TWO:
0015D2r 2 80 31 72 17 .byte $80,$31,$72,$17,$F8
0015D6r 2 F8
0015D7r 2 .endif
0015D7r 2
0015D7r 2 ; ----------------------------------------------------------------------------
0015D7r 2 ; "LOG" FUNCTION
0015D7r 2 ; ----------------------------------------------------------------------------
0015D7r 2 LOG:
0015D7r 2 20 rr rr jsr SIGN
0015DAr 2 F0 02 beq GIQ
0015DCr 2 10 03 bpl LOG2
0015DEr 2 GIQ:
0015DEr 2 4C rr rr jmp IQERR
0015E1r 2 LOG2:
0015E1r 2 A5 AE lda FAC
0015E3r 2 E9 7F sbc #$7F
0015E5r 2 48 pha
0015E6r 2 A9 80 lda #$80
0015E8r 2 85 AE sta FAC
0015EAr 2 A9 rr lda #<CON_SQR_HALF
0015ECr 2 A0 rr ldy #>CON_SQR_HALF
0015EEr 2 20 rr rr jsr FADD
0015F1r 2 A9 rr lda #<CON_SQR_TWO
0015F3r 2 A0 rr ldy #>CON_SQR_TWO
0015F5r 2 20 rr rr jsr FDIV
0015F8r 2 A9 rr lda #<CON_ONE
0015FAr 2 A0 rr ldy #>CON_ONE
0015FCr 2 20 rr rr jsr FSUB
0015FFr 2 A9 rr lda #<POLY_LOG
001601r 2 A0 rr ldy #>POLY_LOG
001603r 2 20 rr rr jsr POLYNOMIAL_ODD
001606r 2 A9 rr lda #<CON_NEG_HALF
001608r 2 A0 rr ldy #>CON_NEG_HALF
00160Ar 2 20 rr rr jsr FADD
00160Dr 2 68 pla
00160Er 2 20 rr rr jsr ADDACC
001611r 2 A9 rr lda #<CON_LOG_TWO
001613r 2 A0 rr ldy #>CON_LOG_TWO
001615r 2
001615r 2 ; ----------------------------------------------------------------------------
001615r 2 ; FAC = (Y,A) * FAC
001615r 2 ; ----------------------------------------------------------------------------
001615r 2 FMULT:
001615r 2 20 rr rr jsr LOAD_ARG_FROM_YA
001618r 2
001618r 2 ; ----------------------------------------------------------------------------
001618r 2 ; FAC = ARG * FAC
001618r 2 ; ----------------------------------------------------------------------------
001618r 2 FMULTT:
001618r 2 .ifndef CONFIG_11
001618r 2 beq L3903
001618r 2 .else
001618r 2 D0 03 4C rr jeq L3903
00161Cr 2 rr
00161Dr 2 .endif
00161Dr 2 20 rr rr jsr ADD_EXPONENTS
001620r 2 A9 00 lda #$00
001622r 2 85 73 sta RESULT
001624r 2 85 74 sta RESULT+1
001626r 2 85 75 sta RESULT+2
001628r 2 .ifndef CONFIG_SMALL
001628r 2 85 76 sta RESULT+3
00162Ar 2 .endif
00162Ar 2 A5 BD lda FACEXTENSION
00162Cr 2 20 rr rr jsr MULTIPLY1
00162Fr 2 .ifndef CONFIG_SMALL
00162Fr 2 A5 B2 lda FAC+4
001631r 2 20 rr rr jsr MULTIPLY1
001634r 2 .endif
001634r 2 A5 B1 lda FAC+3
001636r 2 20 rr rr jsr MULTIPLY1
001639r 2 A5 B0 lda FAC+2
00163Br 2 20 rr rr jsr MULTIPLY1
00163Er 2 A5 AF lda FAC+1
001640r 2 20 rr rr jsr MULTIPLY2
001643r 2 4C rr rr jmp COPY_RESULT_INTO_FAC
001646r 2
001646r 2 ; ----------------------------------------------------------------------------
001646r 2 ; MULTIPLY ARG BY (A) INTO RESULT
001646r 2 ; ----------------------------------------------------------------------------
001646r 2 MULTIPLY1:
001646r 2 D0 03 bne MULTIPLY2
001648r 2 4C rr rr jmp SHIFT_RIGHT1
00164Br 2 MULTIPLY2:
00164Br 2 4A lsr a
00164Cr 2 09 80 ora #$80
00164Er 2 L38A7:
00164Er 2 A8 tay
00164Fr 2 90 19 bcc L38C3
001651r 2 18 clc
001652r 2 .ifndef CONFIG_SMALL
001652r 2 A5 76 lda RESULT+3
001654r 2 65 BA adc ARG+4
001656r 2 85 76 sta RESULT+3
001658r 2 .endif
001658r 2 A5 75 lda RESULT+2
00165Ar 2 65 B9 adc ARG+3
00165Cr 2 85 75 sta RESULT+2
00165Er 2 A5 74 lda RESULT+1
001660r 2 65 B8 adc ARG+2
001662r 2 85 74 sta RESULT+1
001664r 2 A5 73 lda RESULT
001666r 2 65 B7 adc ARG+1
001668r 2 85 73 sta RESULT
00166Ar 2 L38C3:
00166Ar 2 .ifndef CONFIG_ROR_WORKAROUND
00166Ar 2 ror RESULT
00166Ar 2 ror RESULT+1
00166Ar 2 .ifdef APPLE_BAD_BYTE
00166Ar 2 ; this seems to be a bad byte in the dump
00166Ar 2 .byte RESULT+2,RESULT+2 ; XXX BUG!
00166Ar 2 .else
00166Ar 2 ror RESULT+2
00166Ar 2 .endif
00166Ar 2 .ifndef CONFIG_SMALL
00166Ar 2 ror RESULT+3
00166Ar 2 .endif
00166Ar 2 ror FACEXTENSION
00166Ar 2 .else
00166Ar 2 A9 00 lda #$00
00166Cr 2 90 02 bcc L38C9
00166Er 2 A9 80 lda #$80
001670r 2 L38C9:
001670r 2 46 73 lsr RESULT
001672r 2 05 73 ora RESULT
001674r 2 85 73 sta RESULT
001676r 2 A9 00 lda #$00
001678r 2 90 02 bcc L38D5
00167Ar 2 A9 80 lda #$80
00167Cr 2 L38D5:
00167Cr 2 46 74 lsr RESULT+1
00167Er 2 05 74 ora RESULT+1
001680r 2 85 74 sta RESULT+1
001682r 2 A9 00 lda #$00
001684r 2 90 02 bcc L38E1
001686r 2 A9 80 lda #$80
001688r 2 L38E1:
001688r 2 46 75 lsr RESULT+2
00168Ar 2 05 75 ora RESULT+2
00168Cr 2 85 75 sta RESULT+2
00168Er 2 A9 00 lda #$00
001690r 2 90 02 bcc L38ED
001692r 2 A9 80 lda #$80
001694r 2 L38ED:
001694r 2 46 76 lsr RESULT+3
001696r 2 05 76 ora RESULT+3
001698r 2 85 76 sta RESULT+3
00169Ar 2 A9 00 lda #$00
00169Cr 2 90 02 bcc L38F9
00169Er 2 A9 80 lda #$80
0016A0r 2 L38F9:
0016A0r 2 46 BD lsr FACEXTENSION
0016A2r 2 05 BD ora FACEXTENSION
0016A4r 2 85 BD sta FACEXTENSION
0016A6r 2 .endif
0016A6r 2 98 tya
0016A7r 2 4A lsr a
0016A8r 2 D0 A4 bne L38A7
0016AAr 2 L3903:
0016AAr 2 60 rts
0016ABr 2
0016ABr 2 ; ----------------------------------------------------------------------------
0016ABr 2 ; UNPACK NUMBER AT (Y,A) INTO ARG
0016ABr 2 ; ----------------------------------------------------------------------------
0016ABr 2 LOAD_ARG_FROM_YA:
0016ABr 2 85 6F sta INDEX
0016ADr 2 84 70 sty INDEX+1
0016AFr 2 A0 04 ldy #BYTES_FP-1
0016B1r 2 .ifndef CONFIG_SMALL
0016B1r 2 B1 6F lda (INDEX),y
0016B3r 2 85 BA sta ARG+4
0016B5r 2 88 dey
0016B6r 2 .endif
0016B6r 2 B1 6F lda (INDEX),y
0016B8r 2 85 B9 sta ARG+3
0016BAr 2 88 dey
0016BBr 2 B1 6F lda (INDEX),y
0016BDr 2 85 B8 sta ARG+2
0016BFr 2 88 dey
0016C0r 2 B1 6F lda (INDEX),y
0016C2r 2 85 BB sta ARGSIGN
0016C4r 2 45 B3 eor FACSIGN
0016C6r 2 85 BC sta SGNCPR
0016C8r 2 A5 BB lda ARGSIGN
0016CAr 2 09 80 ora #$80
0016CCr 2 85 B7 sta ARG+1
0016CEr 2 88 dey
0016CFr 2 B1 6F lda (INDEX),y
0016D1r 2 85 B6 sta ARG
0016D3r 2 A5 AE lda FAC
0016D5r 2 60 rts
0016D6r 2
0016D6r 2 ; ----------------------------------------------------------------------------
0016D6r 2 ; ADD EXPONENTS OF ARG AND FAC
0016D6r 2 ; (CALLED BY FMULT AND FDIV)
0016D6r 2 ;
0016D6r 2 ; ALSO CHECK FOR OVERFLOW, AND SET RESULT SIGN
0016D6r 2 ; ----------------------------------------------------------------------------
0016D6r 2 ADD_EXPONENTS:
0016D6r 2 A5 B6 lda ARG
0016D8r 2 ADD_EXPONENTS1:
0016D8r 2 F0 1F beq ZERO
0016DAr 2 18 clc
0016DBr 2 65 AE adc FAC
0016DDr 2 90 04 bcc L393C
0016DFr 2 30 1D bmi JOV
0016E1r 2 18 clc
0016E2r 2 2C .byte $2C
0016E3r 2 L393C:
0016E3r 2 10 14 bpl ZERO
0016E5r 2 69 80 adc #$80
0016E7r 2 85 AE sta FAC
0016E9r 2 D0 03 bne L3947
0016EBr 2 4C rr rr jmp STA_IN_FAC_SIGN
0016EEr 2 L3947:
0016EEr 2 A5 BC lda SGNCPR
0016F0r 2 85 B3 sta FACSIGN
0016F2r 2 60 rts
0016F3r 2
0016F3r 2 ; ----------------------------------------------------------------------------
0016F3r 2 ; IF (FAC) IS POSITIVE, GIVE "OVERFLOW" ERROR
0016F3r 2 ; IF (FAC) IS NEGATIVE, SET FAC=0, POP ONE RETURN, AND RTS
0016F3r 2 ; CALLED FROM "EXP" FUNCTION
0016F3r 2 ; ----------------------------------------------------------------------------
0016F3r 2 OUTOFRNG:
0016F3r 2 A5 B3 lda FACSIGN
0016F5r 2 49 FF eor #$FF
0016F7r 2 30 05 bmi JOV
0016F9r 2
0016F9r 2 ; ----------------------------------------------------------------------------
0016F9r 2 ; POP RETURN ADDRESS AND SET FAC=0
0016F9r 2 ; ----------------------------------------------------------------------------
0016F9r 2 ZERO:
0016F9r 2 68 pla
0016FAr 2 68 pla
0016FBr 2 4C rr rr jmp ZERO_FAC
0016FEr 2 JOV:
0016FEr 2 4C rr rr jmp OVERFLOW
001701r 2
001701r 2 ; ----------------------------------------------------------------------------
001701r 2 ; MULTIPLY FAC BY 10
001701r 2 ; ----------------------------------------------------------------------------
001701r 2 MUL10:
001701r 2 20 rr rr jsr COPY_FAC_TO_ARG_ROUNDED
001704r 2 AA tax
001705r 2 F0 10 beq L3970
001707r 2 18 clc
001708r 2 69 02 adc #$02
00170Ar 2 B0 F2 bcs JOV
00170Cr 2 LD9BF:
00170Cr 2 A2 00 ldx #$00
00170Er 2 86 BC stx SGNCPR
001710r 2 20 rr rr jsr FADD2
001713r 2 E6 AE inc FAC
001715r 2 F0 E7 beq JOV
001717r 2 L3970:
001717r 2 60 rts
001718r 2
001718r 2 ; ----------------------------------------------------------------------------
001718r 2 CONTEN:
001718r 2 .ifdef CONFIG_SMALL
001718r 2 .byte $84,$20,$00,$00
001718r 2 .else
001718r 2 84 20 00 00 .byte $84,$20,$00,$00,$00
00171Cr 2 00
00171Dr 2 .endif
00171Dr 2
00171Dr 2 ; ----------------------------------------------------------------------------
00171Dr 2 ; DIVIDE FAC BY 10
00171Dr 2 ; ----------------------------------------------------------------------------
00171Dr 2 DIV10:
00171Dr 2 20 rr rr jsr COPY_FAC_TO_ARG_ROUNDED
001720r 2 A9 rr lda #<CONTEN
001722r 2 A0 rr ldy #>CONTEN
001724r 2 A2 00 ldx #$00
001726r 2
001726r 2 ; ----------------------------------------------------------------------------
001726r 2 ; FAC = ARG / (Y,A)
001726r 2 ; ----------------------------------------------------------------------------
001726r 2 DIV:
001726r 2 86 BC stx SGNCPR
001728r 2 20 rr rr jsr LOAD_FAC_FROM_YA
00172Br 2 4C rr rr jmp FDIVT
00172Er 2
00172Er 2 ; ----------------------------------------------------------------------------
00172Er 2 ; FAC = (Y,A) / FAC
00172Er 2 ; ----------------------------------------------------------------------------
00172Er 2 FDIV:
00172Er 2 20 rr rr jsr LOAD_ARG_FROM_YA
001731r 2
001731r 2 ; ----------------------------------------------------------------------------
001731r 2 ; FAC = ARG / FAC
001731r 2 ; ----------------------------------------------------------------------------
001731r 2 FDIVT:
001731r 2 F0 76 beq L3A02
001733r 2 20 rr rr jsr ROUND_FAC
001736r 2 A9 00 lda #$00
001738r 2 38 sec
001739r 2 E5 AE sbc FAC
00173Br 2 85 AE sta FAC
00173Dr 2 20 rr rr jsr ADD_EXPONENTS
001740r 2 E6 AE inc FAC
001742r 2 F0 BA beq JOV
001744r 2 A2 FC ldx #-MANTISSA_BYTES
001746r 2 A9 01 lda #$01
001748r 2 L39A1:
001748r 2 A4 B7 ldy ARG+1
00174Ar 2 C4 AF cpy FAC+1
00174Cr 2 D0 10 bne L39B7
00174Er 2 A4 B8 ldy ARG+2
001750r 2 C4 B0 cpy FAC+2
001752r 2 D0 0A bne L39B7
001754r 2 A4 B9 ldy ARG+3
001756r 2 C4 B1 cpy FAC+3
001758r 2 .ifndef CONFIG_SMALL
001758r 2 D0 04 bne L39B7
00175Ar 2 A4 BA ldy ARG+4
00175Cr 2 C4 B2 cpy FAC+4
00175Er 2 .endif
00175Er 2 L39B7:
00175Er 2 08 php
00175Fr 2 2A rol a
001760r 2 90 09 bcc L39C4
001762r 2 E8 inx
001763r 2 95 76 sta RESULT_LAST-1,x
001765r 2 F0 32 beq L39F2
001767r 2 10 34 bpl L39F6
001769r 2 A9 01 lda #$01
00176Br 2 L39C4:
00176Br 2 28 plp
00176Cr 2 B0 0E bcs L39D5
00176Er 2 L39C7:
00176Er 2 06 BA asl ARG_LAST
001770r 2 .ifndef CONFIG_SMALL
001770r 2 26 B9 rol ARG+3
001772r 2 .endif
001772r 2 26 B8 rol ARG+2
001774r 2 26 B7 rol ARG+1
001776r 2 B0 E6 bcs L39B7
001778r 2 30 CE bmi L39A1
00177Ar 2 10 E2 bpl L39B7
00177Cr 2 L39D5:
00177Cr 2 A8 tay
00177Dr 2 .ifndef CONFIG_SMALL
00177Dr 2 A5 BA lda ARG+4
00177Fr 2 E5 B2 sbc FAC+4
001781r 2 85 BA sta ARG+4
001783r 2 .endif
001783r 2 A5 B9 lda ARG+3
001785r 2 E5 B1 sbc FAC+3
001787r 2 85 B9 sta ARG+3
001789r 2 A5 B8 lda ARG+2
00178Br 2 E5 B0 sbc FAC+2
00178Dr 2 85 B8 sta ARG+2
00178Fr 2 A5 B7 lda ARG+1
001791r 2 E5 AF sbc FAC+1
001793r 2 85 B7 sta ARG+1
001795r 2 98 tya
001796r 2 4C rr rr jmp L39C7
001799r 2 L39F2:
001799r 2 A9 40 lda #$40
00179Br 2 D0 CE bne L39C4
00179Dr 2 L39F6:
00179Dr 2 0A asl a
00179Er 2 0A asl a
00179Fr 2 0A asl a
0017A0r 2 0A asl a
0017A1r 2 0A asl a
0017A2r 2 0A asl a
0017A3r 2 85 BD sta FACEXTENSION
0017A5r 2 28 plp
0017A6r 2 4C rr rr jmp COPY_RESULT_INTO_FAC
0017A9r 2 L3A02:
0017A9r 2 A2 85 ldx #ERR_ZERODIV
0017ABr 2 4C rr rr jmp ERROR
0017AEr 2
0017AEr 2 ; ----------------------------------------------------------------------------
0017AEr 2 ; COPY RESULT INTO FAC MANTISSA, AND NORMALIZE
0017AEr 2 ; ----------------------------------------------------------------------------
0017AEr 2 COPY_RESULT_INTO_FAC:
0017AEr 2 A5 73 lda RESULT
0017B0r 2 85 AF sta FAC+1
0017B2r 2 A5 74 lda RESULT+1
0017B4r 2 85 B0 sta FAC+2
0017B6r 2 A5 75 lda RESULT+2
0017B8r 2 85 B1 sta FAC+3
0017BAr 2 .ifndef CONFIG_SMALL
0017BAr 2 A5 76 lda RESULT+3
0017BCr 2 85 B2 sta FAC+4
0017BEr 2 .endif
0017BEr 2 4C rr rr jmp NORMALIZE_FAC2
0017C1r 2
0017C1r 2 ; ----------------------------------------------------------------------------
0017C1r 2 ; UNPACK (Y,A) INTO FAC
0017C1r 2 ; ----------------------------------------------------------------------------
0017C1r 2 LOAD_FAC_FROM_YA:
0017C1r 2 85 6F sta INDEX
0017C3r 2 84 70 sty INDEX+1
0017C5r 2 A0 04 ldy #MANTISSA_BYTES
0017C7r 2 .ifndef CONFIG_SMALL
0017C7r 2 B1 6F lda (INDEX),y
0017C9r 2 85 B2 sta FAC+4
0017CBr 2 88 dey
0017CCr 2 .endif
0017CCr 2 B1 6F lda (INDEX),y
0017CEr 2 85 B1 sta FAC+3
0017D0r 2 88 dey
0017D1r 2 B1 6F lda (INDEX),y
0017D3r 2 85 B0 sta FAC+2
0017D5r 2 88 dey
0017D6r 2 B1 6F lda (INDEX),y
0017D8r 2 85 B3 sta FACSIGN
0017DAr 2 09 80 ora #$80
0017DCr 2 85 AF sta FAC+1
0017DEr 2 88 dey
0017DFr 2 B1 6F lda (INDEX),y
0017E1r 2 85 AE sta FAC
0017E3r 2 84 BD sty FACEXTENSION
0017E5r 2 60 rts
0017E6r 2
0017E6r 2 ; ----------------------------------------------------------------------------
0017E6r 2 ; ROUND FAC, STORE IN TEMP2
0017E6r 2 ; ----------------------------------------------------------------------------
0017E6r 2 STORE_FAC_IN_TEMP2_ROUNDED:
0017E6r 2 A2 A9 ldx #TEMP2
0017E8r 2 2C .byte $2C
0017E9r 2
0017E9r 2 ; ----------------------------------------------------------------------------
0017E9r 2 ; ROUND FAC, STORE IN TEMP1
0017E9r 2 ; ----------------------------------------------------------------------------
0017E9r 2 STORE_FAC_IN_TEMP1_ROUNDED:
0017E9r 2 A2 A4 ldx #TEMP1X
0017EBr 2 A0 00 ldy #$00
0017EDr 2 F0 04 beq STORE_FAC_AT_YX_ROUNDED
0017EFr 2
0017EFr 2 ; ----------------------------------------------------------------------------
0017EFr 2 ; ROUND FAC, AND STORE WHERE FORPNT POINTS
0017EFr 2 ; ----------------------------------------------------------------------------
0017EFr 2 SETFOR:
0017EFr 2 A6 96 ldx FORPNT
0017F1r 2 A4 97 ldy FORPNT+1
0017F3r 2
0017F3r 2 ; ----------------------------------------------------------------------------
0017F3r 2 ; ROUND FAC, AND STORE AT (Y,X)
0017F3r 2 ; ----------------------------------------------------------------------------
0017F3r 2 STORE_FAC_AT_YX_ROUNDED:
0017F3r 2 20 rr rr jsr ROUND_FAC
0017F6r 2 86 6F stx INDEX
0017F8r 2 84 70 sty INDEX+1
0017FAr 2 A0 04 ldy #MANTISSA_BYTES
0017FCr 2 .ifndef CONFIG_SMALL
0017FCr 2 A5 B2 lda FAC+4
0017FEr 2 91 6F sta (INDEX),y
001800r 2 88 dey
001801r 2 .endif
001801r 2 A5 B1 lda FAC+3
001803r 2 91 6F sta (INDEX),y
001805r 2 88 dey
001806r 2 A5 B0 lda FAC+2
001808r 2 91 6F sta (INDEX),y
00180Ar 2 88 dey
00180Br 2 A5 B3 lda FACSIGN
00180Dr 2 09 7F ora #$7F
00180Fr 2 25 AF and FAC+1
001811r 2 91 6F sta (INDEX),y
001813r 2 88 dey
001814r 2 A5 AE lda FAC
001816r 2 91 6F sta (INDEX),y
001818r 2 84 BD sty FACEXTENSION
00181Ar 2 60 rts
00181Br 2
00181Br 2 ; ----------------------------------------------------------------------------
00181Br 2 ; COPY ARG INTO FAC
00181Br 2 ; ----------------------------------------------------------------------------
00181Br 2 COPY_ARG_TO_FAC:
00181Br 2 A5 BB lda ARGSIGN
00181Dr 2 MFA:
00181Dr 2 85 B3 sta FACSIGN
00181Fr 2 A2 05 ldx #BYTES_FP
001821r 2 L3A7A:
001821r 2 B5 B5 lda SHIFTSIGNEXT,x
001823r 2 95 AD sta EXPSGN,x
001825r 2 CA dex
001826r 2 D0 F9 bne L3A7A
001828r 2 86 BD stx FACEXTENSION
00182Ar 2 60 rts
00182Br 2
00182Br 2 ; ----------------------------------------------------------------------------
00182Br 2 ; ROUND FAC AND COPY TO ARG
00182Br 2 ; ----------------------------------------------------------------------------
00182Br 2 COPY_FAC_TO_ARG_ROUNDED:
00182Br 2 20 rr rr jsr ROUND_FAC
00182Er 2 MAF:
00182Er 2 A2 06 ldx #BYTES_FP+1
001830r 2 L3A89:
001830r 2 B5 AD lda EXPSGN,x
001832r 2 95 B5 sta SHIFTSIGNEXT,x
001834r 2 CA dex
001835r 2 D0 F9 bne L3A89
001837r 2 86 BD stx FACEXTENSION
001839r 2 RTS14:
001839r 2 60 rts
00183Ar 2
00183Ar 2 ; ----------------------------------------------------------------------------
00183Ar 2 ; ROUND FAC USING EXTENSION BYTE
00183Ar 2 ; ----------------------------------------------------------------------------
00183Ar 2 ROUND_FAC:
00183Ar 2 A5 AE lda FAC
00183Cr 2 F0 FB beq RTS14
00183Er 2 06 BD asl FACEXTENSION
001840r 2 90 F7 bcc RTS14
001842r 2
001842r 2 ; ----------------------------------------------------------------------------
001842r 2 ; INCREMENT MANTISSA AND RE-NORMALIZE IF CARRY
001842r 2 ; ----------------------------------------------------------------------------
001842r 2 INCREMENT_MANTISSA:
001842r 2 20 rr rr jsr INCREMENT_FAC_MANTISSA
001845r 2 D0 F2 bne RTS14
001847r 2 4C rr rr jmp NORMALIZE_FAC6
00184Ar 2
00184Ar 2 ; ----------------------------------------------------------------------------
00184Ar 2 ; TEST FAC FOR ZERO AND SIGN
00184Ar 2 ;
00184Ar 2 ; FAC > 0, RETURN +1
00184Ar 2 ; FAC = 0, RETURN 0
00184Ar 2 ; FAC < 0, RETURN -1
00184Ar 2 ; ----------------------------------------------------------------------------
00184Ar 2 SIGN:
00184Ar 2 A5 AE lda FAC
00184Cr 2 F0 09 beq RTS15
00184Er 2 L3AA7:
00184Er 2 A5 B3 lda FACSIGN
001850r 2 SIGN2:
001850r 2 2A rol a
001851r 2 A9 FF lda #$FF
001853r 2 B0 02 bcs RTS15
001855r 2 A9 01 lda #$01
001857r 2 RTS15:
001857r 2 60 rts
001858r 2
001858r 2 ; ----------------------------------------------------------------------------
001858r 2 ; "SGN" FUNCTION
001858r 2 ; ----------------------------------------------------------------------------
001858r 2 SGN:
001858r 2 20 rr rr jsr SIGN
00185Br 2
00185Br 2 ; ----------------------------------------------------------------------------
00185Br 2 ; CONVERT (A) INTO FAC, AS SIGNED VALUE -128 TO +127
00185Br 2 ; ----------------------------------------------------------------------------
00185Br 2 FLOAT:
00185Br 2 85 AF sta FAC+1
00185Dr 2 A9 00 lda #$00
00185Fr 2 85 B0 sta FAC+2
001861r 2 A2 88 ldx #$88
001863r 2
001863r 2 ; ----------------------------------------------------------------------------
001863r 2 ; FLOAT UNSIGNED VALUE IN FAC+1,2
001863r 2 ; (X) = EXPONENT
001863r 2 ; ----------------------------------------------------------------------------
001863r 2 FLOAT1:
001863r 2 A5 AF lda FAC+1
001865r 2 49 FF eor #$FF
001867r 2 2A rol a
001868r 2
001868r 2 ; ----------------------------------------------------------------------------
001868r 2 ; FLOAT UNSIGNED VALUE IN FAC+1,2
001868r 2 ; (X) = EXPONENT
001868r 2 ; C=0 TO MAKE VALUE NEGATIVE
001868r 2 ; C=1 TO MAKE VALUE POSITIVE
001868r 2 ; ----------------------------------------------------------------------------
001868r 2 FLOAT2:
001868r 2 A9 00 lda #$00
00186Ar 2 .ifndef CONFIG_SMALL
00186Ar 2 85 B2 sta FAC+4
00186Cr 2 .endif
00186Cr 2 85 B1 sta FAC+3
00186Er 2 LDB21:
00186Er 2 86 AE stx FAC
001870r 2 85 BD sta FACEXTENSION
001872r 2 85 B3 sta FACSIGN
001874r 2 4C rr rr jmp NORMALIZE_FAC1
001877r 2
001877r 2 ; ----------------------------------------------------------------------------
001877r 2 ; "ABS" FUNCTION
001877r 2 ; ----------------------------------------------------------------------------
001877r 2 ABS:
001877r 2 46 B3 lsr FACSIGN
001879r 2 60 rts
00187Ar 2
00187Ar 2 ; ----------------------------------------------------------------------------
00187Ar 2 ; COMPARE FAC WITH PACKED # AT (Y,A)
00187Ar 2 ; RETURN A=1,0,-1 AS (Y,A) IS <,=,> FAC
00187Ar 2 ; ----------------------------------------------------------------------------
00187Ar 2 FCOMP:
00187Ar 2 85 71 sta DEST
00187Cr 2
00187Cr 2 ; ----------------------------------------------------------------------------
00187Cr 2 ; SPECIAL ENTRY FROM "NEXT" PROCESSOR
00187Cr 2 ; "DEST" ALREADY SET UP
00187Cr 2 ; ----------------------------------------------------------------------------
00187Cr 2 FCOMP2:
00187Cr 2 84 72 sty DEST+1
00187Er 2 A0 00 ldy #$00
001880r 2 B1 71 lda (DEST),y
001882r 2 C8 iny
001883r 2 AA tax
001884r 2 F0 C4 beq SIGN
001886r 2 B1 71 lda (DEST),y
001888r 2 45 B3 eor FACSIGN
00188Ar 2 30 C2 bmi L3AA7
00188Cr 2 E4 AE cpx FAC
00188Er 2 D0 21 bne L3B0A
001890r 2 B1 71 lda (DEST),y
001892r 2 09 80 ora #$80
001894r 2 C5 AF cmp FAC+1
001896r 2 D0 19 bne L3B0A
001898r 2 C8 iny
001899r 2 B1 71 lda (DEST),y
00189Br 2 C5 B0 cmp FAC+2
00189Dr 2 D0 12 bne L3B0A
00189Fr 2 C8 iny
0018A0r 2 .ifndef CONFIG_SMALL
0018A0r 2 B1 71 lda (DEST),y
0018A2r 2 C5 B1 cmp FAC+3
0018A4r 2 D0 0B bne L3B0A
0018A6r 2 C8 iny
0018A7r 2 .endif
0018A7r 2 A9 7F lda #$7F
0018A9r 2 C5 BD cmp FACEXTENSION
0018ABr 2 B1 71 lda (DEST),y
0018ADr 2 E5 B2 sbc FAC_LAST
0018AFr 2 F0 28 beq L3B32
0018B1r 2 L3B0A:
0018B1r 2 A5 B3 lda FACSIGN
0018B3r 2 90 02 bcc L3B10
0018B5r 2 49 FF eor #$FF
0018B7r 2 L3B10:
0018B7r 2 4C rr rr jmp SIGN2
0018BAr 2
0018BAr 2 ; ----------------------------------------------------------------------------
0018BAr 2 ; QUICK INTEGER FUNCTION
0018BAr 2 ;
0018BAr 2 ; CONVERTS FP VALUE IN FAC TO INTEGER VALUE
0018BAr 2 ; IN FAC+1...FAC+4, BY SHIFTING RIGHT WITH SIGN
0018BAr 2 ; EXTENSION UNTIL FRACTIONAL BITS ARE OUT.
0018BAr 2 ;
0018BAr 2 ; THIS SUBROUTINE ASSUMES THE EXPONENT < 32.
0018BAr 2 ; ----------------------------------------------------------------------------
0018BAr 2 QINT:
0018BAr 2 A5 AE lda FAC
0018BCr 2 F0 4A beq QINT3
0018BEr 2 38 sec
0018BFr 2 E9 A0 sbc #120+8*BYTES_FP
0018C1r 2 24 B3 bit FACSIGN
0018C3r 2 10 09 bpl L3B27
0018C5r 2 AA tax
0018C6r 2 A9 FF lda #$FF
0018C8r 2 85 B5 sta SHIFTSIGNEXT
0018CAr 2 20 rr rr jsr COMPLEMENT_FAC_MANTISSA
0018CDr 2 8A txa
0018CEr 2 L3B27:
0018CEr 2 A2 AE ldx #FAC
0018D0r 2 C9 F9 cmp #$F9
0018D2r 2 10 06 bpl QINT2
0018D4r 2 20 rr rr jsr SHIFT_RIGHT
0018D7r 2 84 B5 sty SHIFTSIGNEXT
0018D9r 2 L3B32:
0018D9r 2 60 rts
0018DAr 2 QINT2:
0018DAr 2 A8 tay
0018DBr 2 A5 B3 lda FACSIGN
0018DDr 2 29 80 and #$80
0018DFr 2 46 AF lsr FAC+1
0018E1r 2 05 AF ora FAC+1
0018E3r 2 85 AF sta FAC+1
0018E5r 2 20 rr rr jsr SHIFT_RIGHT4
0018E8r 2 84 B5 sty SHIFTSIGNEXT
0018EAr 2 60 rts
0018EBr 2
0018EBr 2 ; ----------------------------------------------------------------------------
0018EBr 2 ; "INT" FUNCTION
0018EBr 2 ;
0018EBr 2 ; USES QINT TO CONVERT (FAC) TO INTEGER FORM,
0018EBr 2 ; AND THEN REFLOATS THE INTEGER.
0018EBr 2 ; ----------------------------------------------------------------------------
0018EBr 2 INT:
0018EBr 2 A5 AE lda FAC
0018EDr 2 C9 A0 cmp #120+8*BYTES_FP
0018EFr 2 B0 20 bcs RTS17
0018F1r 2 20 rr rr jsr QINT
0018F4r 2 84 BD sty FACEXTENSION
0018F6r 2 A5 B3 lda FACSIGN
0018F8r 2 84 B3 sty FACSIGN
0018FAr 2 49 80 eor #$80
0018FCr 2 2A rol a
0018FDr 2 A9 A0 lda #120+8*BYTES_FP
0018FFr 2 85 AE sta FAC
001901r 2 A5 B2 lda FAC_LAST
001903r 2 85 0A sta CHARAC
001905r 2 4C rr rr jmp NORMALIZE_FAC1
001908r 2 QINT3:
001908r 2 85 AF sta FAC+1
00190Ar 2 85 B0 sta FAC+2
00190Cr 2 85 B1 sta FAC+3
00190Er 2 .ifndef CONFIG_SMALL
00190Er 2 85 B2 sta FAC+4
001910r 2 .endif
001910r 2 A8 tay
001911r 2 RTS17:
001911r 2 60 rts
001912r 2
001912r 2 ; ----------------------------------------------------------------------------
001912r 2 ; CONVERT STRING TO FP VALUE IN FAC
001912r 2 ;
001912r 2 ; STRING POINTED TO BY TXTPTR
001912r 2 ; FIRST CHAR ALREADY SCANNED BY CHRGET
001912r 2 ; (A) = FIRST CHAR, C=0 IF DIGIT.
001912r 2 ; ----------------------------------------------------------------------------
001912r 2 FIN:
001912r 2 A0 00 ldy #$00
001914r 2 A2 0A ldx #SERLEN-TMPEXP
001916r 2 L3B6F:
001916r 2 94 AA sty TMPEXP,x
001918r 2 CA dex
001919r 2 10 FB bpl L3B6F
00191Br 2 90 0F bcc FIN2
00191Dr 2 C9 2D cmp #$2D
00191Fr 2 D0 04 bne L3B7E
001921r 2 86 B4 stx SERLEN
001923r 2 F0 04 beq FIN1
001925r 2 L3B7E:
001925r 2 C9 2B cmp #$2B
001927r 2 D0 05 bne FIN3
001929r 2 FIN1:
001929r 2 20 C0 00 jsr CHRGET
00192Cr 2 FIN2:
00192Cr 2 90 6F bcc FIN9
00192Er 2 FIN3:
00192Er 2 C9 2E cmp #$2E
001930r 2 F0 38 beq FIN10
001932r 2 C9 45 cmp #$45
001934r 2 D0 44 bne FIN7
001936r 2 20 C0 00 jsr CHRGET
001939r 2 90 21 bcc FIN5
00193Br 2 C9 A5 cmp #TOKEN_MINUS
00193Dr 2 F0 0E beq L3BA6
00193Fr 2 C9 2D cmp #$2D
001941r 2 F0 0A beq L3BA6
001943r 2 C9 A4 cmp #TOKEN_PLUS
001945r 2 F0 12 beq FIN4
001947r 2 C9 2B cmp #$2B
001949r 2 F0 0E beq FIN4
00194Br 2 D0 11 bne FIN6
00194Dr 2 L3BA6:
00194Dr 2 .ifndef CONFIG_ROR_WORKAROUND
00194Dr 2 ror EXPSGN
00194Dr 2 .else
00194Dr 2 A9 00 lda #$00
00194Fr 2 90 02 bcc L3BAC
001951r 2 A9 80 lda #$80
001953r 2 L3BAC:
001953r 2 46 AD lsr EXPSGN
001955r 2 05 AD ora EXPSGN
001957r 2 85 AD sta EXPSGN
001959r 2 .endif
001959r 2 FIN4:
001959r 2 20 C0 00 jsr CHRGET
00195Cr 2 FIN5:
00195Cr 2 90 66 bcc GETEXP
00195Er 2 FIN6:
00195Er 2 24 AD bit EXPSGN
001960r 2 10 18 bpl FIN7
001962r 2 A9 00 lda #$00
001964r 2 38 sec
001965r 2 E5 AB sbc EXPON
001967r 2 4C rr rr jmp FIN8
00196Ar 2
00196Ar 2 ; ----------------------------------------------------------------------------
00196Ar 2 ; FOUND A DECIMAL POINT
00196Ar 2 ; ----------------------------------------------------------------------------
00196Ar 2 FIN10:
00196Ar 2 .ifndef CONFIG_ROR_WORKAROUND
00196Ar 2 ror LOWTR
00196Ar 2 .else
00196Ar 2 A9 00 lda #$00
00196Cr 2 90 02 bcc L3BC9
00196Er 2 A9 80 lda #$80
001970r 2 L3BC9:
001970r 2 46 AC lsr LOWTR
001972r 2 05 AC ora LOWTR
001974r 2 85 AC sta LOWTR
001976r 2 .endif
001976r 2 24 AC bit LOWTR
001978r 2 50 AF bvc FIN1
00197Ar 2
00197Ar 2 ; ----------------------------------------------------------------------------
00197Ar 2 ; NUMBER TERMINATED, ADJUST EXPONENT NOW
00197Ar 2 ; ----------------------------------------------------------------------------
00197Ar 2 FIN7:
00197Ar 2 A5 AB lda EXPON
00197Cr 2 FIN8:
00197Cr 2 38 sec
00197Dr 2 E5 AA sbc INDX
00197Fr 2 85 AB sta EXPON
001981r 2 F0 12 beq L3BEE
001983r 2 10 09 bpl L3BE7
001985r 2 L3BDE:
001985r 2 20 rr rr jsr DIV10
001988r 2 E6 AB inc EXPON
00198Ar 2 D0 F9 bne L3BDE
00198Cr 2 F0 07 beq L3BEE
00198Er 2 L3BE7:
00198Er 2 20 rr rr jsr MUL10
001991r 2 C6 AB dec EXPON
001993r 2 D0 F9 bne L3BE7
001995r 2 L3BEE:
001995r 2 A5 B4 lda SERLEN
001997r 2 30 01 bmi L3BF3
001999r 2 60 rts
00199Ar 2 L3BF3:
00199Ar 2 4C rr rr jmp NEGOP
00199Dr 2
00199Dr 2 ; ----------------------------------------------------------------------------
00199Dr 2 ; ACCUMULATE A DIGIT INTO FAC
00199Dr 2 ; ----------------------------------------------------------------------------
00199Dr 2 FIN9:
00199Dr 2 48 pha
00199Er 2 24 AC bit LOWTR
0019A0r 2 10 02 bpl L3BFD
0019A2r 2 E6 AA inc INDX
0019A4r 2 L3BFD:
0019A4r 2 20 rr rr jsr MUL10
0019A7r 2 68 pla
0019A8r 2 38 sec
0019A9r 2 E9 30 sbc #$30
0019ABr 2 20 rr rr jsr ADDACC
0019AEr 2 4C rr rr jmp FIN1
0019B1r 2
0019B1r 2 ; ----------------------------------------------------------------------------
0019B1r 2 ; ADD (A) TO FAC
0019B1r 2 ; ----------------------------------------------------------------------------
0019B1r 2 ADDACC:
0019B1r 2 48 pha
0019B2r 2 20 rr rr jsr COPY_FAC_TO_ARG_ROUNDED
0019B5r 2 68 pla
0019B6r 2 20 rr rr jsr FLOAT
0019B9r 2 A5 BB lda ARGSIGN
0019BBr 2 45 B3 eor FACSIGN
0019BDr 2 85 BC sta SGNCPR
0019BFr 2 A6 AE ldx FAC
0019C1r 2 4C rr rr jmp FADDT
0019C4r 2
0019C4r 2 ; ----------------------------------------------------------------------------
0019C4r 2 ; ACCUMULATE DIGIT OF EXPONENT
0019C4r 2 ; ----------------------------------------------------------------------------
0019C4r 2 GETEXP:
0019C4r 2 A5 AB lda EXPON
0019C6r 2 C9 0A cmp #MAX_EXPON
0019C8r 2 90 09 bcc L3C2C
0019CAr 2 .ifdef CONFIG_10A
0019CAr 2 A9 64 lda #$64
0019CCr 2 .endif
0019CCr 2 24 AD bit EXPSGN
0019CEr 2 .ifdef CONFIG_10A
0019CEr 2 30 11 bmi L3C3A
0019D0r 2 .else
0019D0r 2 bmi LDC70
0019D0r 2 .endif
0019D0r 2 4C rr rr jmp OVERFLOW
0019D3r 2 LDC70:
0019D3r 2 .ifndef CONFIG_10A
0019D3r 2 lda #$0B
0019D3r 2 .endif
0019D3r 2 L3C2C:
0019D3r 2 0A asl a
0019D4r 2 0A asl a
0019D5r 2 18 clc
0019D6r 2 65 AB adc EXPON
0019D8r 2 0A asl a
0019D9r 2 18 clc
0019DAr 2 A0 00 ldy #$00
0019DCr 2 71 C7 adc (TXTPTR),y
0019DEr 2 38 sec
0019DFr 2 E9 30 sbc #$30
0019E1r 2 L3C3A:
0019E1r 2 85 AB sta EXPON
0019E3r 2 4C rr rr jmp FIN4
0019E6r 2
0019E6r 2 ; ----------------------------------------------------------------------------
0019E6r 2 .ifdef CONFIG_SMALL
0019E6r 2 ; these values are /1000 of what the labels say
0019E6r 2 CON_99999999_9:
0019E6r 2 .byte $91,$43,$4F,$F8
0019E6r 2 CON_999999999:
0019E6r 2 .byte $94,$74,$23,$F7
0019E6r 2 CON_BILLION:
0019E6r 2 .byte $94,$74,$24,$00
0019E6r 2 .else
0019E6r 2 CON_99999999_9:
0019E6r 2 9B 3E BC 1F .byte $9B,$3E,$BC,$1F,$FD
0019EAr 2 FD
0019EBr 2 CON_999999999:
0019EBr 2 .ifndef CONFIG_10A
0019EBr 2 .byte $9E,$6E,$6B,$27,$FE
0019EBr 2 .else
0019EBr 2 9E 6E 6B 27 .byte $9E,$6E,$6B,$27,$FD
0019EFr 2 FD
0019F0r 2 .endif
0019F0r 2 CON_BILLION:
0019F0r 2 9E 6E 6B 28 .byte $9E,$6E,$6B,$28,$00
0019F4r 2 00
0019F5r 2 .endif
0019F5r 2
0019F5r 2 ; ----------------------------------------------------------------------------
0019F5r 2 ; PRINT "IN <LINE #>"
0019F5r 2 ; ----------------------------------------------------------------------------
0019F5r 2 INPRT:
0019F5r 2 .ifdef KBD
0019F5r 2 jsr LFE0B
0019F5r 2 .byte " in"
0019F5r 2 .byte 0
0019F5r 2 .else
0019F5r 2 A9 rr lda #<QT_IN
0019F7r 2 A0 rr ldy #>QT_IN
0019F9r 2 20 rr rr jsr GOSTROUT2
0019FCr 2 .endif
0019FCr 2 A5 87 lda CURLIN+1
0019FEr 2 A6 86 ldx CURLIN
001A00r 2
001A00r 2 ; ----------------------------------------------------------------------------
001A00r 2 ; PRINT A,X AS DECIMAL INTEGER
001A00r 2 ; ----------------------------------------------------------------------------
001A00r 2 LINPRT:
001A00r 2 85 AF sta FAC+1
001A02r 2 86 B0 stx FAC+2
001A04r 2 A2 90 ldx #$90
001A06r 2 38 sec
001A07r 2 20 rr rr jsr FLOAT2
001A0Ar 2 20 rr rr jsr FOUT
001A0Dr 2 GOSTROUT2:
001A0Dr 2 4C rr rr jmp STROUT
001A10r 2
001A10r 2 ; ----------------------------------------------------------------------------
001A10r 2 ; CONVERT (FAC) TO STRING STARTING AT STACK
001A10r 2 ; RETURN WITH (Y,A) POINTING AT STRING
001A10r 2 ; ----------------------------------------------------------------------------
001A10r 2 FOUT:
001A10r 2 A0 01 ldy #$01
001A12r 2
001A12r 2 ; ----------------------------------------------------------------------------
001A12r 2 ; "STR$" FUNCTION ENTERS HERE, WITH (Y)=0
001A12r 2 ; SO THAT RESULT STRING STARTS AT STACK-1
001A12r 2 ; (THIS IS USED AS A FLAG)
001A12r 2 ; ----------------------------------------------------------------------------
001A12r 2 FOUT1:
001A12r 2 A9 20 lda #$20
001A14r 2 24 B3 bit FACSIGN
001A16r 2 10 02 bpl L3C73
001A18r 2 A9 2D lda #$2D
001A1Ar 2 L3C73:
001A1Ar 2 99 FF 00 sta $FF,y
001A1Dr 2 85 B3 sta FACSIGN
001A1Fr 2 84 BE sty STRNG2
001A21r 2 C8 iny
001A22r 2 A9 30 lda #$30
001A24r 2 A6 AE ldx FAC
001A26r 2 D0 03 bne L3C84
001A28r 2 4C rr rr jmp FOUT4
001A2Br 2 L3C84:
001A2Br 2 A9 00 lda #$00
001A2Dr 2 E0 80 cpx #$80
001A2Fr 2 F0 02 beq L3C8C
001A31r 2 B0 09 bcs L3C95
001A33r 2 L3C8C:
001A33r 2 A9 rr lda #<CON_BILLION
001A35r 2 A0 rr ldy #>CON_BILLION
001A37r 2 20 rr rr jsr FMULT
001A3Ar 2 .ifdef CONFIG_SMALL
001A3Ar 2 lda #-6 ; exponent adjustment
001A3Ar 2 .else
001A3Ar 2 A9 F7 lda #-9
001A3Cr 2 .endif
001A3Cr 2 L3C95:
001A3Cr 2 85 AA sta INDX
001A3Er 2 ; ----------------------------------------------------------------------------
001A3Er 2 ; ADJUST UNTIL 1E8 <= (FAC) <1E9
001A3Er 2 ; ----------------------------------------------------------------------------
001A3Er 2 L3C97:
001A3Er 2 A9 rr lda #<CON_999999999
001A40r 2 A0 rr ldy #>CON_999999999
001A42r 2 20 rr rr jsr FCOMP
001A45r 2 F0 1E beq L3CBE
001A47r 2 10 12 bpl L3CB4
001A49r 2 L3CA2:
001A49r 2 A9 rr lda #<CON_99999999_9
001A4Br 2 A0 rr ldy #>CON_99999999_9
001A4Dr 2 20 rr rr jsr FCOMP
001A50r 2 F0 02 beq L3CAD
001A52r 2 10 0E bpl L3CBB
001A54r 2 L3CAD:
001A54r 2 20 rr rr jsr MUL10
001A57r 2 C6 AA dec INDX
001A59r 2 D0 EE bne L3CA2
001A5Br 2 L3CB4:
001A5Br 2 20 rr rr jsr DIV10
001A5Er 2 E6 AA inc INDX
001A60r 2 D0 DC bne L3C97
001A62r 2 L3CBB:
001A62r 2 20 rr rr jsr FADDH
001A65r 2 L3CBE:
001A65r 2 20 rr rr jsr QINT
001A68r 2 ; ----------------------------------------------------------------------------
001A68r 2 ; FAC+1...FAC+4 IS NOW IN INTEGER FORM
001A68r 2 ; WITH POWER OF TEN ADJUSTMENT IN TMPEXP
001A68r 2 ;
001A68r 2 ; IF -10 < TMPEXP > 1, PRINT IN DECIMAL FORM
001A68r 2 ; OTHERWISE, PRINT IN EXPONENTIAL FORM
001A68r 2 ; ----------------------------------------------------------------------------
001A68r 2 A2 01 ldx #$01
001A6Ar 2 A5 AA lda INDX
001A6Cr 2 18 clc
001A6Dr 2 69 0A adc #3*BYTES_FP-5
001A6Fr 2 30 09 bmi L3CD3
001A71r 2 C9 0B cmp #3*BYTES_FP-4
001A73r 2 B0 06 bcs L3CD4
001A75r 2 69 FF adc #$FF
001A77r 2 AA tax
001A78r 2 A9 02 lda #$02
001A7Ar 2 L3CD3:
001A7Ar 2 38 sec
001A7Br 2 L3CD4:
001A7Br 2 E9 02 sbc #$02
001A7Dr 2 85 AB sta EXPON
001A7Fr 2 86 AA stx INDX
001A81r 2 8A txa
001A82r 2 F0 02 beq L3CDF
001A84r 2 10 13 bpl L3CF2
001A86r 2 L3CDF:
001A86r 2 A4 BE ldy STRNG2
001A88r 2 A9 2E lda #$2E
001A8Ar 2 C8 iny
001A8Br 2 99 FF 00 sta $FF,y
001A8Er 2 8A txa
001A8Fr 2 F0 06 beq L3CF0
001A91r 2 A9 30 lda #$30
001A93r 2 C8 iny
001A94r 2 99 FF 00 sta $FF,y
001A97r 2 L3CF0:
001A97r 2 84 BE sty STRNG2
001A99r 2 ; ----------------------------------------------------------------------------
001A99r 2 ; NOW DIVIDE BY POWERS OF TEN TO GET SUCCESSIVE DIGITS
001A99r 2 ; ----------------------------------------------------------------------------
001A99r 2 L3CF2:
001A99r 2 A0 00 ldy #$00
001A9Br 2 LDD3A:
001A9Br 2 A2 80 ldx #$80
001A9Dr 2 L3CF6:
001A9Dr 2 A5 B2 lda FAC_LAST
001A9Fr 2 18 clc
001AA0r 2 .ifndef CONFIG_SMALL
001AA0r 2 79 rr rr adc DECTBL+3,y
001AA3r 2 85 B2 sta FAC+4
001AA5r 2 A5 B1 lda FAC+3
001AA7r 2 .endif
001AA7r 2 79 rr rr adc DECTBL+2,y
001AAAr 2 85 B1 sta FAC+3
001AACr 2 A5 B0 lda FAC+2
001AAEr 2 79 rr rr adc DECTBL+1,y
001AB1r 2 85 B0 sta FAC+2
001AB3r 2 A5 AF lda FAC+1
001AB5r 2 79 rr rr adc DECTBL,y
001AB8r 2 85 AF sta FAC+1
001ABAr 2 E8 inx
001ABBr 2 B0 04 bcs L3D1A
001ABDr 2 10 DE bpl L3CF6
001ABFr 2 30 02 bmi L3D1C
001AC1r 2 L3D1A:
001AC1r 2 30 DA bmi L3CF6
001AC3r 2 L3D1C:
001AC3r 2 8A txa
001AC4r 2 90 04 bcc L3D23
001AC6r 2 49 FF eor #$FF
001AC8r 2 69 0A adc #$0A
001ACAr 2 L3D23:
001ACAr 2 69 2F adc #$2F
001ACCr 2 C8 iny
001ACDr 2 C8 iny
001ACEr 2 C8 iny
001ACFr 2 .ifndef CONFIG_SMALL
001ACFr 2 C8 iny
001AD0r 2 .endif
001AD0r 2 84 94 sty VARPNT
001AD2r 2 A4 BE ldy STRNG2
001AD4r 2 C8 iny
001AD5r 2 AA tax
001AD6r 2 29 7F and #$7F
001AD8r 2 99 FF 00 sta $FF,y
001ADBr 2 C6 AA dec INDX
001ADDr 2 D0 06 bne L3D3E
001ADFr 2 A9 2E lda #$2E
001AE1r 2 C8 iny
001AE2r 2 99 FF 00 sta $FF,y
001AE5r 2 L3D3E:
001AE5r 2 84 BE sty STRNG2
001AE7r 2 A4 94 ldy VARPNT
001AE9r 2 8A txa
001AEAr 2 49 FF eor #$FF
001AECr 2 29 80 and #$80
001AEEr 2 AA tax
001AEFr 2 C0 24 cpy #DECTBL_END-DECTBL
001AF1r 2 .ifdef CONFIG_CBM_ALL
001AF1r 2 beq LDD96
001AF1r 2 cpy #$3C ; XXX
001AF1r 2 .endif
001AF1r 2 D0 AA bne L3CF6
001AF3r 2 ; ----------------------------------------------------------------------------
001AF3r 2 ; NINE DIGITS HAVE BEEN STORED IN STRING. NOW LOOK
001AF3r 2 ; BACK AND LOP OFF TRAILING ZEROES AND A TRAILING
001AF3r 2 ; DECIMAL POINT.
001AF3r 2 ; ----------------------------------------------------------------------------
001AF3r 2 LDD96:
001AF3r 2 A4 BE ldy STRNG2
001AF5r 2 L3D4E:
001AF5r 2 B9 FF 00 lda $FF,y
001AF8r 2 88 dey
001AF9r 2 C9 30 cmp #$30
001AFBr 2 F0 F8 beq L3D4E
001AFDr 2 C9 2E cmp #$2E
001AFFr 2 F0 01 beq L3D5B
001B01r 2 C8 iny
001B02r 2 L3D5B:
001B02r 2 A9 2B lda #$2B
001B04r 2 A6 AB ldx EXPON
001B06r 2 F0 2E beq L3D8F
001B08r 2 10 08 bpl L3D6B
001B0Ar 2 A9 00 lda #$00
001B0Cr 2 38 sec
001B0Dr 2 E5 AB sbc EXPON
001B0Fr 2 AA tax
001B10r 2 A9 2D lda #$2D
001B12r 2 L3D6B:
001B12r 2 99 01 01 sta STACK+1,y
001B15r 2 A9 45 lda #$45
001B17r 2 99 00 01 sta STACK,y
001B1Ar 2 8A txa
001B1Br 2 A2 2F ldx #$2F
001B1Dr 2 38 sec
001B1Er 2 L3D77:
001B1Er 2 E8 inx
001B1Fr 2 E9 0A sbc #$0A
001B21r 2 B0 FB bcs L3D77
001B23r 2 69 3A adc #$3A
001B25r 2 99 03 01 sta STACK+3,y
001B28r 2 8A txa
001B29r 2 99 02 01 sta STACK+2,y
001B2Cr 2 A9 00 lda #$00
001B2Er 2 99 04 01 sta STACK+4,y
001B31r 2 F0 08 beq L3D94
001B33r 2 FOUT4:
001B33r 2 99 FF 00 sta $FF,y
001B36r 2 L3D8F:
001B36r 2 A9 00 lda #$00
001B38r 2 99 00 01 sta STACK,y
001B3Br 2 L3D94:
001B3Br 2 A9 00 lda #$00
001B3Dr 2 A0 01 ldy #$01
001B3Fr 2 60 rts
001B40r 2
001B40r 2 ; ----------------------------------------------------------------------------
001B40r 2 CON_HALF:
001B40r 2 .ifdef CONFIG_SMALL
001B40r 2 .byte $80,$00,$00,$00
001B40r 2 .else
001B40r 2 80 00 00 00 .byte $80,$00,$00,$00,$00
001B44r 2 00
001B45r 2 .endif
001B45r 2
001B45r 2 ; ----------------------------------------------------------------------------
001B45r 2 ; POWERS OF 10 FROM 1E8 DOWN TO 1,
001B45r 2 ; AS 32-BIT INTEGERS, WITH ALTERNATING SIGNS
001B45r 2 ; ----------------------------------------------------------------------------
001B45r 2 DECTBL:
001B45r 2 .ifdef CONFIG_SMALL
001B45r 2 .byte $FE,$79,$60 ; -100000
001B45r 2 .byte $00,$27,$10 ; 10000
001B45r 2 .byte $FF,$FC,$18 ; -1000
001B45r 2 .byte $00,$00,$64 ; 100
001B45r 2 .byte $FF,$FF,$F6 ; -10
001B45r 2 .byte $00,$00,$01 ; 1
001B45r 2 .else
001B45r 2 FA 0A 1F 00 .byte $FA,$0A,$1F,$00 ; -100000000
001B49r 2 00 98 96 80 .byte $00,$98,$96,$80 ; 10000000
001B4Dr 2 FF F0 BD C0 .byte $FF,$F0,$BD,$C0 ; -1000000
001B51r 2 00 01 86 A0 .byte $00,$01,$86,$A0 ; 100000
001B55r 2 FF FF D8 F0 .byte $FF,$FF,$D8,$F0 ; -10000
001B59r 2 00 00 03 E8 .byte $00,$00,$03,$E8 ; 1000
001B5Dr 2 FF FF FF 9C .byte $FF,$FF,$FF,$9C ; -100
001B61r 2 00 00 00 0A .byte $00,$00,$00,$0A ; 10
001B65r 2 FF FF FF FF .byte $FF,$FF,$FF,$FF ; -1
001B69r 2 .endif
001B69r 2 DECTBL_END:
001B69r 2 .ifdef CONFIG_CBM_ALL
001B69r 2 .byte $FF,$DF,$0A,$80 ; TI$
001B69r 2 .byte $00,$03,$4B,$C0
001B69r 2 .byte $FF,$FF,$73,$60
001B69r 2 .byte $00,$00,$0E,$10
001B69r 2 .byte $FF,$FF,$FD,$A8
001B69r 2 .byte $00,$00,$00,$3C
001B69r 2 .endif
001B69r 2 .ifdef CONFIG_2
001B69r 2 C_ZERO = CON_HALF + 2
001B69r 2 .endif
001B69r 2
001B69r 2 ; ----------------------------------------------------------------------------
001B69r 2 ; "SQR" FUNCTION
001B69r 2 ; ----------------------------------------------------------------------------
001B69r 2 SQR:
001B69r 2 20 rr rr jsr COPY_FAC_TO_ARG_ROUNDED
001B6Cr 2 A9 rr lda #<CON_HALF
001B6Er 2 A0 rr ldy #>CON_HALF
001B70r 2 20 rr rr jsr LOAD_FAC_FROM_YA
001B73r 2
001B73r 2 ; ----------------------------------------------------------------------------
001B73r 2 ; EXPONENTIATION OPERATION
001B73r 2 ;
001B73r 2 ; ARG ^ FAC = EXP( LOG(ARG) * FAC )
001B73r 2 ; ----------------------------------------------------------------------------
001B73r 2 FPWRT:
001B73r 2 F0 70 beq EXP
001B75r 2 A5 B6 lda ARG
001B77r 2 D0 03 bne L3DD5
001B79r 2 4C rr rr jmp STA_IN_FAC_SIGN_AND_EXP
001B7Cr 2 L3DD5:
001B7Cr 2 A2 9B ldx #TEMP3
001B7Er 2 A0 00 ldy #$00
001B80r 2 20 rr rr jsr STORE_FAC_AT_YX_ROUNDED
001B83r 2 A5 BB lda ARGSIGN
001B85r 2 10 0F bpl L3DEF
001B87r 2 20 rr rr jsr INT
001B8Ar 2 A9 9B lda #TEMP3
001B8Cr 2 A0 00 ldy #$00
001B8Er 2 20 rr rr jsr FCOMP
001B91r 2 D0 03 bne L3DEF
001B93r 2 98 tya
001B94r 2 A4 0A ldy CHARAC
001B96r 2 L3DEF:
001B96r 2 20 rr rr jsr MFA
001B99r 2 98 tya
001B9Ar 2 48 pha
001B9Br 2 20 rr rr jsr LOG
001B9Er 2 A9 9B lda #TEMP3
001BA0r 2 A0 00 ldy #$00
001BA2r 2 20 rr rr jsr FMULT
001BA5r 2 20 rr rr jsr EXP
001BA8r 2 68 pla
001BA9r 2 4A lsr a
001BAAr 2 90 0A bcc L3E0F
001BACr 2
001BACr 2 ; ----------------------------------------------------------------------------
001BACr 2 ; NEGATE VALUE IN FAC
001BACr 2 ; ----------------------------------------------------------------------------
001BACr 2 NEGOP:
001BACr 2 A5 AE lda FAC
001BAEr 2 F0 06 beq L3E0F
001BB0r 2 A5 B3 lda FACSIGN
001BB2r 2 49 FF eor #$FF
001BB4r 2 85 B3 sta FACSIGN
001BB6r 2 L3E0F:
001BB6r 2 60 rts
001BB7r 2
001BB7r 2 ; ----------------------------------------------------------------------------
001BB7r 2 .ifdef CONFIG_SMALL
001BB7r 2 CON_LOG_E:
001BB7r 2 .byte $81,$38,$AA,$3B
001BB7r 2 POLY_EXP:
001BB7r 2 .byte $06
001BB7r 2 .byte $74,$63,$90,$8C
001BB7r 2 .byte $77,$23,$0C,$AB
001BB7r 2 .byte $7A,$1E,$94,$00
001BB7r 2 .byte $7C,$63,$42,$80
001BB7r 2 .byte $7E,$75,$FE,$D0
001BB7r 2 .byte $80,$31,$72,$15
001BB7r 2 .byte $81,$00,$00,$00
001BB7r 2 .else
001BB7r 2 CON_LOG_E:
001BB7r 2 81 38 AA 3B .byte $81,$38,$AA,$3B,$29
001BBBr 2 29
001BBCr 2 POLY_EXP:
001BBCr 2 07 .byte $07
001BBDr 2 71 34 58 3E .byte $71,$34,$58,$3E,$56
001BC1r 2 56
001BC2r 2 74 16 7E B3 .byte $74,$16,$7E,$B3,$1B
001BC6r 2 1B
001BC7r 2 77 2F EE E3 .byte $77,$2F,$EE,$E3,$85
001BCBr 2 85
001BCCr 2 7A 1D 84 1C .byte $7A,$1D,$84,$1C,$2A
001BD0r 2 2A
001BD1r 2 7C 63 59 58 .byte $7C,$63,$59,$58,$0A
001BD5r 2 0A
001BD6r 2 7E 75 FD E7 .byte $7E,$75,$FD,$E7,$C6
001BDAr 2 C6
001BDBr 2 80 31 72 18 .byte $80,$31,$72,$18,$10
001BDFr 2 10
001BE0r 2 81 00 00 00 .byte $81,$00,$00,$00,$00
001BE4r 2 00
001BE5r 2 .endif
001BE5r 2
001BE5r 2 ; ----------------------------------------------------------------------------
001BE5r 2 ; "EXP" FUNCTION
001BE5r 2 ;
001BE5r 2 ; FAC = E ^ FAC
001BE5r 2 ; ----------------------------------------------------------------------------
001BE5r 2 EXP:
001BE5r 2 A9 rr lda #<CON_LOG_E
001BE7r 2 A0 rr ldy #>CON_LOG_E
001BE9r 2 20 rr rr jsr FMULT
001BECr 2 A5 BD lda FACEXTENSION
001BEEr 2 69 50 adc #$50
001BF0r 2 90 03 bcc L3E4E
001BF2r 2 20 rr rr jsr INCREMENT_MANTISSA
001BF5r 2 L3E4E:
001BF5r 2 85 A3 sta ARGEXTENSION
001BF7r 2 20 rr rr jsr MAF
001BFAr 2 A5 AE lda FAC
001BFCr 2 C9 88 cmp #$88
001BFEr 2 90 03 bcc L3E5C
001C00r 2 L3E59:
001C00r 2 20 rr rr jsr OUTOFRNG
001C03r 2 L3E5C:
001C03r 2 20 rr rr jsr INT
001C06r 2 A5 0A lda CHARAC
001C08r 2 18 clc
001C09r 2 69 81 adc #$81
001C0Br 2 F0 F3 beq L3E59
001C0Dr 2 38 sec
001C0Er 2 E9 01 sbc #$01
001C10r 2 48 pha
001C11r 2 A2 05 ldx #BYTES_FP
001C13r 2 L3E6C:
001C13r 2 B5 B6 lda ARG,x
001C15r 2 B4 AE ldy FAC,x
001C17r 2 95 AE sta FAC,x
001C19r 2 94 B6 sty ARG,x
001C1Br 2 CA dex
001C1Cr 2 10 F5 bpl L3E6C
001C1Er 2 A5 A3 lda ARGEXTENSION
001C20r 2 85 BD sta FACEXTENSION
001C22r 2 20 rr rr jsr FSUBT
001C25r 2 20 rr rr jsr NEGOP
001C28r 2 A9 rr lda #<POLY_EXP
001C2Ar 2 A0 rr ldy #>POLY_EXP
001C2Cr 2 20 rr rr jsr POLYNOMIAL
001C2Fr 2 A9 00 lda #$00
001C31r 2 85 BC sta SGNCPR
001C33r 2 68 pla
001C34r 2 20 rr rr jsr ADD_EXPONENTS1
001C37r 2 60 rts
001C38r 2
001C38r 2 ; ----------------------------------------------------------------------------
001C38r 2 ; ODD POLYNOMIAL SUBROUTINE
001C38r 2 ;
001C38r 2 ; F(X) = X * P(X^2)
001C38r 2 ;
001C38r 2 ; WHERE: X IS VALUE IN FAC
001C38r 2 ; Y,A POINTS AT COEFFICIENT TABLE
001C38r 2 ; FIRST BYTE OF COEFF. TABLE IS N
001C38r 2 ; COEFFICIENTS FOLLOW, HIGHEST POWER FIRST
001C38r 2 ;
001C38r 2 ; P(X^2) COMPUTED USING NORMAL POLYNOMIAL SUBROUTINE
001C38r 2 ; ----------------------------------------------------------------------------
001C38r 2 POLYNOMIAL_ODD:
001C38r 2 85 BE sta STRNG2
001C3Ar 2 84 BF sty STRNG2+1
001C3Cr 2 20 rr rr jsr STORE_FAC_IN_TEMP1_ROUNDED
001C3Fr 2 A9 A4 lda #TEMP1X
001C41r 2 20 rr rr jsr FMULT
001C44r 2 20 rr rr jsr SERMAIN
001C47r 2 A9 A4 lda #TEMP1X
001C49r 2 A0 00 ldy #$00
001C4Br 2 4C rr rr jmp FMULT
001C4Er 2
001C4Er 2 ; ----------------------------------------------------------------------------
001C4Er 2 ; NORMAL POLYNOMIAL SUBROUTINE
001C4Er 2 ;
001C4Er 2 ; P(X) = C(0)*X^N + C(1)*X^(N-1) + ... + C(N)
001C4Er 2 ;
001C4Er 2 ; WHERE: X IS VALUE IN FAC
001C4Er 2 ; Y,A POINTS AT COEFFICIENT TABLE
001C4Er 2 ; FIRST BYTE OF COEFF. TABLE IS N
001C4Er 2 ; COEFFICIENTS FOLLOW, HIGHEST POWER FIRST
001C4Er 2 ; ----------------------------------------------------------------------------
001C4Er 2 POLYNOMIAL:
001C4Er 2 85 BE sta STRNG2
001C50r 2 84 BF sty STRNG2+1
001C52r 2 SERMAIN:
001C52r 2 20 rr rr jsr STORE_FAC_IN_TEMP2_ROUNDED
001C55r 2 B1 BE lda (STRNG2),y
001C57r 2 85 B4 sta SERLEN
001C59r 2 A4 BE ldy STRNG2
001C5Br 2 C8 iny
001C5Cr 2 98 tya
001C5Dr 2 D0 02 bne L3EBA
001C5Fr 2 E6 BF inc STRNG2+1
001C61r 2 L3EBA:
001C61r 2 85 BE sta STRNG2
001C63r 2 A4 BF ldy STRNG2+1
001C65r 2 L3EBE:
001C65r 2 20 rr rr jsr FMULT
001C68r 2 A5 BE lda STRNG2
001C6Ar 2 A4 BF ldy STRNG2+1
001C6Cr 2 18 clc
001C6Dr 2 69 05 adc #BYTES_FP
001C6Fr 2 90 01 bcc L3ECB
001C71r 2 C8 iny
001C72r 2 L3ECB:
001C72r 2 85 BE sta STRNG2
001C74r 2 84 BF sty STRNG2+1
001C76r 2 20 rr rr jsr FADD
001C79r 2 A9 A9 lda #TEMP2
001C7Br 2 A0 00 ldy #$00
001C7Dr 2 C6 B4 dec SERLEN
001C7Fr 2 D0 E4 bne L3EBE
001C81r 2 RTS19:
001C81r 2 60 rts
001C82r 2
001C82r 1 .include "chrget.s"
001C82r 2 .segment "CHRGET"
000000r 2 RAMSTART1:
000000r 2 GENERIC_CHRGET:
000000r 2 E6 C7 inc TXTPTR
000002r 2 D0 02 bne GENERIC_CHRGOT
000004r 2 E6 C8 inc TXTPTR+1
000006r 2 GENERIC_CHRGOT:
000006r 2 GENERIC_TXTPTR = GENERIC_CHRGOT + 1
000006r 2 AD 60 EA lda $EA60
000009r 2 .ifdef KBD
000009r 2 jsr LF430
000009r 2 .endif
000009r 2 C9 3A cmp #$3A
00000Br 2 B0 0A bcs L4058
00000Dr 2 GENERIC_CHRGOT2:
00000Dr 2 C9 20 cmp #$20
00000Fr 2 F0 EF beq GENERIC_CHRGET
000011r 2 38 sec
000012r 2 E9 30 sbc #$30
000014r 2 38 sec
000015r 2 E9 D0 sbc #$D0
000017r 2 L4058:
000017r 2 60 rts
000018r 2
000018r 1 .include "rnd.s"
000018r 2 .segment "CODE"
001C82r 2
001C82r 2 ; ----------------------------------------------------------------------------
001C82r 2 ; "RND" FUNCTION
001C82r 2 ; ----------------------------------------------------------------------------
001C82r 2
001C82r 2 .ifdef KBD
001C82r 2 RND:
001C82r 2 ldx #$10
001C82r 2 jsr SIGN
001C82r 2 beq LFC26
001C82r 2 bmi LFC10
001C82r 2 lda RNDSEED
001C82r 2 ldy RNDSEED+1
001C82r 2 LFBFA:
001C82r 2 sta FAC+2
001C82r 2 sty FAC+1
001C82r 2 LFBFE:
001C82r 2 asl a
001C82r 2 asl a
001C82r 2 eor FAC+2
001C82r 2 asl a
001C82r 2 eor FAC+1
001C82r 2 asl a
001C82r 2 asl a
001C82r 2 asl a
001C82r 2 asl a
001C82r 2 eor FAC+1
001C82r 2 asl a
001C82r 2 rol FAC+2
001C82r 2 rol FAC+1
001C82r 2 LFC10:
001C82r 2 lda FAC+2
001C82r 2 dex
001C82r 2 bne LFBFE
001C82r 2 sta RNDSEED
001C82r 2 sta FAC+3
001C82r 2 lda FAC+1
001C82r 2 sta RNDSEED+1
001C82r 2 lda #$80
001C82r 2 sta FAC
001C82r 2 stx FACSIGN
001C82r 2 jmp NORMALIZE_FAC2
001C82r 2 LFC26:
001C82r 2 ldy $03CA
001C82r 2 lda $03C7
001C82r 2 ora #$01
001C82r 2 GOMOVMF:
001C82r 2 bne LFBFA
001C82r 2 .byte $F0
001C82r 2 .else
001C82r 2 ; <<< THESE ARE MISSING ONE BYTE FOR FP VALUES >>>
001C82r 2 ; (non CONFIG_SMALL)
001C82r 2 CONRND1:
001C82r 2 98 35 44 7A .byte $98,$35,$44,$7A
001C86r 2 CONRND2:
001C86r 2 68 28 B1 46 .byte $68,$28,$B1,$46
001C8Ar 2 RND:
001C8Ar 2 20 rr rr jsr SIGN
001C8Dr 2 .ifdef CONFIG_CBM_ALL
001C8Dr 2 bmi L3F01
001C8Dr 2 bne LDF63
001C8Dr 2 lda ENTROPY
001C8Dr 2 sta FAC+1
001C8Dr 2 lda ENTROPY+4
001C8Dr 2 sta FAC+2
001C8Dr 2 lda ENTROPY+1
001C8Dr 2 sta FAC+3
001C8Dr 2 lda ENTROPY+5
001C8Dr 2 sta FAC+4
001C8Dr 2 jmp LDF88
001C8Dr 2 LDF63:
001C8Dr 2 .else
001C8Dr 2 AA tax
001C8Er 2 30 18 bmi L3F01
001C90r 2 .endif
001C90r 2 A9 D8 lda #<RNDSEED
001C92r 2 A0 00 ldy #>RNDSEED
001C94r 2 20 rr rr jsr LOAD_FAC_FROM_YA
001C97r 2 .ifndef CONFIG_CBM_ALL
001C97r 2 8A txa
001C98r 2 F0 E7 beq RTS19
001C9Ar 2 .endif
001C9Ar 2 A9 rr lda #<CONRND1
001C9Cr 2 A0 rr ldy #>CONRND1
001C9Er 2 20 rr rr jsr FMULT
001CA1r 2 A9 rr lda #<CONRND2
001CA3r 2 A0 rr ldy #>CONRND2
001CA5r 2 20 rr rr jsr FADD
001CA8r 2 L3F01:
001CA8r 2 A6 B2 ldx FAC_LAST
001CAAr 2 A5 AF lda FAC+1
001CACr 2 85 B2 sta FAC_LAST
001CAEr 2 86 AF stx FAC+1
001CB0r 2 .ifdef CONFIG_CBM_ALL
001CB0r 2 ldx FAC+2
001CB0r 2 lda FAC+3
001CB0r 2 sta FAC+2
001CB0r 2 stx FAC+3
001CB0r 2 LDF88:
001CB0r 2 .endif
001CB0r 2 A9 00 lda #$00
001CB2r 2 85 B3 sta FACSIGN
001CB4r 2 A5 AE lda FAC
001CB6r 2 85 BD sta FACEXTENSION
001CB8r 2 A9 80 lda #$80
001CBAr 2 85 AE sta FAC
001CBCr 2 20 rr rr jsr NORMALIZE_FAC2
001CBFr 2 A2 D8 ldx #<RNDSEED
001CC1r 2 A0 00 ldy #>RNDSEED
001CC3r 2 GOMOVMF:
001CC3r 2 4C rr rr jmp STORE_FAC_AT_YX_ROUNDED
001CC6r 2 .endif
001CC6r 2
001CC6r 2 .segment "CHRGET"
000018r 2 ; ----------------------------------------------------------------------------
000018r 2 ; INITIAL VALUE FOR RANDOM NUMBER, ALSO COPIED
000018r 2 ; IN ALONG WITH CHRGET, BUT ERRONEOUSLY:
000018r 2 ; <<< THE LAST BYTE IS NOT COPIED >>>
000018r 2 ; (on all non-CONFIG_SMALL)
000018r 2 ; ----------------------------------------------------------------------------
000018r 2 GENERIC_RNDSEED:
000018r 2 .ifndef KBD
000018r 2 ; random number seed
000018r 2 .ifdef CONFIG_SMALL
000018r 2 .byte $80,$4F,$C7,$52
000018r 2 .else
000018r 2 .ifdef CONFIG_11
000018r 2 80 4F C7 52 .byte $80,$4F,$C7,$52,$58
00001Cr 2 58
00001Dr 2 .else
00001Dr 2 .byte $80,$4F,$C7,$52,$59
00001Dr 2 .endif
00001Dr 2 .endif
00001Dr 2 .endif
00001Dr 2 GENERIC_CHRGET_END:
00001Dr 2
00001Dr 1 .include "trig.s"
00001Dr 2 .segment "CODE"
001CC6r 2
001CC6r 2 SIN_COS_TAN_ATN:
001CC6r 2 ; ----------------------------------------------------------------------------
001CC6r 2 ; "COS" FUNCTION
001CC6r 2 ; ----------------------------------------------------------------------------
001CC6r 2 COS:
001CC6r 2 A9 rr lda #<CON_PI_HALF
001CC8r 2 A0 rr ldy #>CON_PI_HALF
001CCAr 2 20 rr rr jsr FADD
001CCDr 2
001CCDr 2 ; ----------------------------------------------------------------------------
001CCDr 2 ; "SIN" FUNCTION
001CCDr 2 ; ----------------------------------------------------------------------------
001CCDr 2 SIN:
001CCDr 2 20 rr rr jsr COPY_FAC_TO_ARG_ROUNDED
001CD0r 2 A9 rr lda #<CON_PI_DOUB
001CD2r 2 A0 rr ldy #>CON_PI_DOUB
001CD4r 2 A6 BB ldx ARGSIGN
001CD6r 2 20 rr rr jsr DIV
001CD9r 2 20 rr rr jsr COPY_FAC_TO_ARG_ROUNDED
001CDCr 2 20 rr rr jsr INT
001CDFr 2 A9 00 lda #$00
001CE1r 2 85 BC sta STRNG1
001CE3r 2 20 rr rr jsr FSUBT
001CE6r 2 ; ----------------------------------------------------------------------------
001CE6r 2 ; (FAC) = ANGLE AS A FRACTION OF A FULL CIRCLE
001CE6r 2 ;
001CE6r 2 ; NOW FOLD THE RANGE INTO A QUARTER CIRCLE
001CE6r 2 ;
001CE6r 2 ; <<< THERE ARE MUCH SIMPLER WAYS TO DO THIS >>>
001CE6r 2 ; ----------------------------------------------------------------------------
001CE6r 2 A9 rr lda #<QUARTER
001CE8r 2 A0 rr ldy #>QUARTER
001CEAr 2 20 rr rr jsr FSUB
001CEDr 2 A5 B3 lda FACSIGN
001CEFr 2 48 pha
001CF0r 2 10 0D bpl SIN1
001CF2r 2 20 rr rr jsr FADDH
001CF5r 2 A5 B3 lda FACSIGN
001CF7r 2 30 09 bmi L3F5B
001CF9r 2 A5 13 lda CPRMASK
001CFBr 2 49 FF eor #$FF
001CFDr 2 85 13 sta CPRMASK
001CFFr 2 ; ----------------------------------------------------------------------------
001CFFr 2 ; IF FALL THRU, RANGE IS 0...1/2
001CFFr 2 ; IF BRANCH HERE, RANGE IS 0...1/4
001CFFr 2 ; ----------------------------------------------------------------------------
001CFFr 2 SIN1:
001CFFr 2 20 rr rr jsr NEGOP
001D02r 2 ; ----------------------------------------------------------------------------
001D02r 2 ; IF FALL THRU, RANGE IS -1/2...0
001D02r 2 ; IF BRANCH HERE, RANGE IS -1/4...0
001D02r 2 ; ----------------------------------------------------------------------------
001D02r 2 L3F5B:
001D02r 2 A9 rr lda #<QUARTER
001D04r 2 A0 rr ldy #>QUARTER
001D06r 2 20 rr rr jsr FADD
001D09r 2 68 pla
001D0Ar 2 10 03 bpl L3F68
001D0Cr 2 20 rr rr jsr NEGOP
001D0Fr 2 L3F68:
001D0Fr 2 A9 rr lda #<POLY_SIN
001D11r 2 A0 rr ldy #>POLY_SIN
001D13r 2 4C rr rr jmp POLYNOMIAL_ODD
001D16r 2
001D16r 2 ; ----------------------------------------------------------------------------
001D16r 2 ; "TAN" FUNCTION
001D16r 2 ;
001D16r 2 ; COMPUTE TAN(X) = SIN(X) / COS(X)
001D16r 2 ; ----------------------------------------------------------------------------
001D16r 2 TAN:
001D16r 2 20 rr rr jsr STORE_FAC_IN_TEMP1_ROUNDED
001D19r 2 A9 00 lda #$00
001D1Br 2 85 13 sta CPRMASK
001D1Dr 2 20 rr rr jsr SIN
001D20r 2 A2 9B ldx #TEMP3
001D22r 2 A0 00 ldy #$00
001D24r 2 20 rr rr jsr GOMOVMF
001D27r 2 A9 A4 lda #TEMP1+(5-BYTES_FP)
001D29r 2 A0 00 ldy #$00
001D2Br 2 20 rr rr jsr LOAD_FAC_FROM_YA
001D2Er 2 A9 00 lda #$00
001D30r 2 85 B3 sta FACSIGN
001D32r 2 A5 13 lda CPRMASK
001D34r 2 20 rr rr jsr TAN1
001D37r 2 A9 9B lda #TEMP3
001D39r 2 A0 00 ldy #$00
001D3Br 2 4C rr rr jmp FDIV
001D3Er 2 TAN1:
001D3Er 2 48 pha
001D3Fr 2 4C rr rr jmp SIN1
001D42r 2
001D42r 2 ; ----------------------------------------------------------------------------
001D42r 2 .ifdef CONFIG_SMALL
001D42r 2 CON_PI_HALF:
001D42r 2 .byte $81,$49,$0F,$DB
001D42r 2 CON_PI_DOUB:
001D42r 2 .byte $83,$49,$0F,$DB
001D42r 2 QUARTER:
001D42r 2 .byte $7F,$00,$00,$00
001D42r 2 POLY_SIN:
001D42r 2 .byte $04,$86,$1E,$D7,$FB,$87,$99,$26
001D42r 2 .byte $65,$87,$23,$34,$58,$86,$A5,$5D
001D42r 2 .byte $E1,$83,$49,$0F,$DB
001D42r 2 .else
001D42r 2 CON_PI_HALF:
001D42r 2 81 49 0F DA .byte $81,$49,$0F,$DA,$A2
001D46r 2 A2
001D47r 2 CON_PI_DOUB:
001D47r 2 83 49 0F DA .byte $83,$49,$0F,$DA,$A2
001D4Br 2 A2
001D4Cr 2 QUARTER:
001D4Cr 2 7F 00 00 00 .byte $7F,$00,$00,$00,$00
001D50r 2 00
001D51r 2 POLY_SIN:
001D51r 2 05 84 E6 1A .byte $05,$84,$E6,$1A,$2D,$1B,$86,$28
001D55r 2 2D 1B 86 28
001D59r 2 07 FB F8 87 .byte $07,$FB,$F8,$87,$99,$68,$89,$01
001D5Dr 2 99 68 89 01
001D61r 2 87 23 35 DF .byte $87,$23,$35,$DF,$E1,$86,$A5,$5D
001D65r 2 E1 86 A5 5D
001D69r 2 E7 28 83 49 .byte $E7,$28,$83,$49,$0F,$DA,$A2
001D6Dr 2 0F DA A2
001D70r 2 .ifndef CONFIG_11
001D70r 2 ; no easter egg text before BASIC 1.1
001D70r 2 .elseif !.def(CONFIG_2A)
001D70r 2 ; ASCII encoded easter egg
001D70r 2 MICROSOFT:
001D70r 2 A6 D3 C1 C8 .byte $A6,$D3,$C1,$C8,$D4,$C8,$D5,$C4
001D74r 2 D4 C8 D5 C4
001D78r 2 CE CA .byte $CE,$CA
001D7Ar 2 .else
001D7Ar 2 ; PET encoded easter egg text since CBM2
001D7Ar 2 MICROSOFT:
001D7Ar 2 .byte $A1,$54,$46,$8F,$13,$8F,$52,$43
001D7Ar 2 .byte $89,$CD
001D7Ar 2 .endif
001D7Ar 2 .endif
001D7Ar 2
001D7Ar 2 ; ----------------------------------------------------------------------------
001D7Ar 2 ; "ATN" FUNCTION
001D7Ar 2 ; ----------------------------------------------------------------------------
001D7Ar 2 ATN:
001D7Ar 2 A5 B3 lda FACSIGN
001D7Cr 2 48 pha
001D7Dr 2 10 03 bpl L3FDB
001D7Fr 2 20 rr rr jsr NEGOP
001D82r 2 L3FDB:
001D82r 2 A5 AE lda FAC
001D84r 2 48 pha
001D85r 2 C9 81 cmp #$81
001D87r 2 90 07 bcc L3FE9
001D89r 2 A9 rr lda #<CON_ONE
001D8Br 2 A0 rr ldy #>CON_ONE
001D8Dr 2 20 rr rr jsr FDIV
001D90r 2 ; ----------------------------------------------------------------------------
001D90r 2 ; 0 <= X <= 1
001D90r 2 ; 0 <= ATN(X) <= PI/8
001D90r 2 ; ----------------------------------------------------------------------------
001D90r 2 L3FE9:
001D90r 2 A9 rr lda #<POLY_ATN
001D92r 2 A0 rr ldy #>POLY_ATN
001D94r 2 20 rr rr jsr POLYNOMIAL_ODD
001D97r 2 68 pla
001D98r 2 C9 81 cmp #$81
001D9Ar 2 90 07 bcc L3FFC
001D9Cr 2 A9 rr lda #<CON_PI_HALF
001D9Er 2 A0 rr ldy #>CON_PI_HALF
001DA0r 2 20 rr rr jsr FSUB
001DA3r 2 L3FFC:
001DA3r 2 68 pla
001DA4r 2 10 03 bpl L4002
001DA6r 2 4C rr rr jmp NEGOP
001DA9r 2 L4002:
001DA9r 2 60 rts
001DAAr 2
001DAAr 2 ; ----------------------------------------------------------------------------
001DAAr 2 POLY_ATN:
001DAAr 2 .ifdef CONFIG_SMALL
001DAAr 2 .byte $08
001DAAr 2 .byte $78,$3A,$C5,$37
001DAAr 2 .byte $7B,$83,$A2,$5C
001DAAr 2 .byte $7C,$2E,$DD,$4D
001DAAr 2 .byte $7D,$99,$B0,$1E
001DAAr 2 .byte $7D,$59,$ED,$24
001DAAr 2 .byte $7E,$91,$72,$00
001DAAr 2 .byte $7E,$4C,$B9,$73
001DAAr 2 .byte $7F,$AA,$AA,$53
001DAAr 2 .byte $81,$00,$00,$00
001DAAr 2 .else
001DAAr 2 0B .byte $0B
001DABr 2 76 B3 83 BD .byte $76,$B3,$83,$BD,$D3
001DAFr 2 D3
001DB0r 2 79 1E F4 A6 .byte $79,$1E,$F4,$A6,$F5
001DB4r 2 F5
001DB5r 2 7B 83 FC B0 .byte $7B,$83,$FC,$B0,$10
001DB9r 2 10
001DBAr 2 7C 0C 1F 67 .byte $7C,$0C,$1F,$67,$CA
001DBEr 2 CA
001DBFr 2 7C DE 53 CB .byte $7C,$DE,$53,$CB,$C1
001DC3r 2 C1
001DC4r 2 7D 14 64 70 .byte $7D,$14,$64,$70,$4C
001DC8r 2 4C
001DC9r 2 7D B7 EA 51 .byte $7D,$B7,$EA,$51,$7A
001DCDr 2 7A
001DCEr 2 7D 63 30 88 .byte $7D,$63,$30,$88,$7E
001DD2r 2 7E
001DD3r 2 7E 92 44 99 .byte $7E,$92,$44,$99,$3A
001DD7r 2 3A
001DD8r 2 7E 4C CC 91 .byte $7E,$4C,$CC,$91,$C7
001DDCr 2 C7
001DDDr 2 7F AA AA AA .byte $7F,$AA,$AA,$AA,$13
001DE1r 2 13
001DE2r 2 81 00 00 00 .byte $81,$00,$00,$00,$00
001DE6r 2 00
001DE7r 2 .endif
001DE7r 2
001DE7r 2 .if .def(CONFIG_11A) && (!.def(CONFIG_2))
001DE7r 2 00 .byte $00 ; XXX
001DE8r 2 .endif
001DE8r 2
001DE8r 1 .include "init.s"
001DE8r 2 .segment "INIT"
000000r 2
000000r 2 .ifdef KBD
000000r 2 FNDLIN2:
000000r 2 php
000000r 2 jmp FNDLIN
000000r 2 .endif
000000r 2
000000r 2 ; ----------------------------------------------------------------------------
000000r 2 PR_WRITTEN_BY:
000000r 2 .ifndef KBD
000000r 2 .ifndef CONFIG_CBM_ALL
000000r 2 A9 rr lda #<QT_WRITTEN_BY
000002r 2 A0 rr ldy #>QT_WRITTEN_BY
000004r 2 20 rr rr jsr STROUT
000007r 2 .endif
000007r 2 .endif
000007r 2 COLD_START:
000007r 2 .ifdef KBD
000007r 2 lda #<LFD81
000007r 2 sta $03A0
000007r 2 lda #>LFD81
000007r 2 sta $03A1
000007r 2 lda #$20
000007r 2 sta $0480
000007r 2 lda $0352
000007r 2 sta $04
000007r 2 lda $0353
000007r 2 sta $05
000007r 2 .else
000007r 2 .ifndef CBM2
000007r 2 A2 FF ldx #$FF
000009r 2 86 87 stx CURLIN+1
00000Br 2 .endif
00000Br 2 .ifdef CONFIG_NO_INPUTBUFFER_ZP
00000Br 2 ldx #$FB
00000Br 2 .endif
00000Br 2 9A txs
00000Cr 2 .ifndef CONFIG_CBM_ALL
00000Cr 2 A9 rr lda #<COLD_START
00000Er 2 A0 rr ldy #>COLD_START
000010r 2 85 01 sta GORESTART+1
000012r 2 84 02 sty GORESTART+2
000014r 2 85 04 sta GOSTROUT+1
000016r 2 84 05 sty GOSTROUT+2
000018r 2 A9 rr lda #<AYINT
00001Ar 2 A0 rr ldy #>AYINT
00001Cr 2 85 06 sta GOAYINT
00001Er 2 84 07 sty GOAYINT+1
000020r 2 A9 rr lda #<GIVAYF
000022r 2 A0 rr ldy #>GIVAYF
000024r 2 85 08 sta GOGIVEAYF
000026r 2 84 09 sty GOGIVEAYF+1
000028r 2 .endif
000028r 2 A9 4C lda #$4C
00002Ar 2 .ifdef CONFIG_CBM_ALL
00002Ar 2 sta JMPADRS
00002Ar 2 .endif
00002Ar 2 85 00 sta GORESTART
00002Cr 2 .ifndef CONFIG_CBM_ALL
00002Cr 2 85 03 sta GOSTROUT
00002Er 2 85 A1 sta JMPADRS
000030r 2 .endif
000030r 2 .if (!.def(CONFIG_RAM)) && (!.def(CONFIG_CBM_ALL))
000030r 2 sta USR
000030r 2 .endif
000030r 2
000030r 2 .ifndef CONFIG_RAM
000030r 2 .ifdef APPLE
000030r 2 lda #<USR_FUNC
000030r 2 ldy #>USR_FUNC
000030r 2 .else
000030r 2 lda #<IQERR
000030r 2 ldy #>IQERR
000030r 2 .endif
000030r 2 sta USR+1
000030r 2 sty USR+2
000030r 2 .endif
000030r 2 .ifndef CBM1
000030r 2 A9 48 lda #WIDTH
000032r 2 85 17 sta Z17
000034r 2 A9 38 lda #WIDTH2
000036r 2 85 18 sta Z18
000038r 2 .endif
000038r 2 .endif ;/* KBD */
000038r 2
000038r 2 ; All non-CONFIG_SMALL versions of BASIC have
000038r 2 ; the same bug here: While the number of bytes
000038r 2 ; to be copied is correct for CONFIG_SMALL,
000038r 2 ; it is one byte short on non-CONFIG_SMALL:
000038r 2 ; It seems the "ldx" value below has been
000038r 2 ; hardcoded. So on these configurations,
000038r 2 ; the last byte of GENERIC_RNDSEED, which
000038r 2 ; is 5 bytes instead of 4, does not get copied -
000038r 2 ; which is nothing major, because it is just
000038r 2 ; the least significant 8 bits of the mantissa
000038r 2 ; of the random number seed.
000038r 2 ; KBD added three bytes to CHRGET and removed
000038r 2 ; the random number seed, but only adjusted
000038r 2 ; the number of bytes by adding 3 - this
000038r 2 ; copies four bytes too many, which is no
000038r 2 ; problem.
000038r 2 .ifdef CONFIG_SMALL
000038r 2 .ifdef KBD
000038r 2 ldx #GENERIC_CHRGET_END-GENERIC_CHRGET+4
000038r 2 .else
000038r 2 ldx #GENERIC_CHRGET_END-GENERIC_CHRGET
000038r 2 .endif
000038r 2 .else
000038r 2 A2 1C ldx #GENERIC_CHRGET_END-GENERIC_CHRGET-1 ; XXX
00003Ar 2 .endif
00003Ar 2 L4098:
00003Ar 2 BD rr rr lda GENERIC_CHRGET-1,x
00003Dr 2 95 BF sta CHRGET-1,x
00003Fr 2 CA dex
000040r 2 D0 F8 bne L4098
000042r 2 .ifdef CONFIG_2
000042r 2 lda #$03
000042r 2 sta DSCLEN
000042r 2 .endif
000042r 2 .ifndef KBD
000042r 2 8A txa
000043r 2 85 B5 sta SHIFTSIGNEXT
000045r 2 .ifdef CONFIG_CBM_ALL
000045r 2 sta CURDVC
000045r 2 .endif
000045r 2 85 65 sta LASTPT+1
000047r 2 .if .defined(CONFIG_NULL) || .defined(CONFIG_PRINTNULLS)
000047r 2 85 15 sta Z15
000049r 2 .endif
000049r 2 .ifndef CONFIG_11
000049r 2 sta POSX
000049r 2 .endif
000049r 2 48 pha
00004Ar 2 85 14 sta Z14
00004Cr 2 .ifndef CBM2
00004Cr 2 .ifndef MICROTAN
00004Cr 2 A9 03 lda #$03
00004Er 2 85 A0 sta DSCLEN
000050r 2 .endif
000050r 2 .ifndef CONFIG_11
000050r 2 lda #$2C
000050r 2 sta LINNUM+1
000050r 2 .endif
000050r 2 20 rr rr jsr CRDO
000053r 2 .endif
000053r 2 .ifdef CBM2
000053r 2 inx
000053r 2 stx INPUTBUFFER-3
000053r 2 stx INPUTBUFFER-4
000053r 2 .endif
000053r 2 .ifdef APPLE
000053r 2 lda #$01
000053r 2 sta INPUTBUFFER-3
000053r 2 sta INPUTBUFFER-4
000053r 2 .endif
000053r 2 A2 66 ldx #TEMPST
000055r 2 86 63 stx TEMPPT
000057r 2 .ifndef CONFIG_CBM_ALL
000057r 2 A9 rr lda #<QT_MEMORY_SIZE
000059r 2 A0 rr ldy #>QT_MEMORY_SIZE
00005Br 2 20 rr rr jsr STROUT
00005Er 2 .ifdef APPLE
00005Er 2 jsr INLINX
00005Er 2 .else
00005Er 2 20 rr rr jsr NXIN
000061r 2 .endif
000061r 2 86 C7 stx TXTPTR
000063r 2 84 C8 sty TXTPTR+1
000065r 2 20 C0 00 jsr CHRGET
000068r 2 C9 41 cmp #$41
00006Ar 2 F0 94 beq PR_WRITTEN_BY
00006Cr 2 A8 tay
00006Dr 2 D0 21 bne L40EE
00006Fr 2 .endif
00006Fr 2 .ifndef CBM2
00006Fr 2 A9 rr lda #<RAMSTART2
000071r 2 .endif
000071r 2 A0 rr ldy #>RAMSTART2
000073r 2 .ifdef CONFIG_2
000073r 2 sta TXTTAB
000073r 2 sty TXTTAB+1
000073r 2 .endif
000073r 2 85 19 sta LINNUM
000075r 2 84 1A sty LINNUM+1
000077r 2 .ifdef CBM2
000077r 2 tay
000077r 2 .else
000077r 2 A0 00 ldy #$00
000079r 2 .endif
000079r 2 L40D7:
000079r 2 E6 19 inc LINNUM
00007Br 2 D0 02 bne L40DD
00007Dr 2 E6 1A inc LINNUM+1
00007Fr 2 .ifdef CBM1
00007Fr 2 ; CBM: hard RAM top limit is $8000
00007Fr 2 lda LINNUM+1
00007Fr 2 cmp #$80
00007Fr 2 beq L40FA
00007Fr 2 .endif
00007Fr 2 .ifdef CBM2
00007Fr 2 ; optimized version of the CBM1 code
00007Fr 2 bmi L40FA
00007Fr 2 .endif
00007Fr 2 L40DD:
00007Fr 2 .ifdef CONFIG_2
00007Fr 2 lda #$55 ; 01010101 / 10101010
00007Fr 2 .else
00007Fr 2 A9 92 lda #$92 ; 10010010 / 00100100
000081r 2 .endif
000081r 2 91 19 sta (LINNUM),y
000083r 2 D1 19 cmp (LINNUM),y
000085r 2 D0 15 bne L40FA
000087r 2 0A asl a
000088r 2 91 19 sta (LINNUM),y
00008Ar 2 D1 19 cmp (LINNUM),y
00008Cr 2 .ifdef CONFIG_CBM_ALL
00008Cr 2 beq L40D7
00008Cr 2 .else
00008Cr 2 .ifndef CONFIG_11
00008Cr 2 beq L40D7; old: faster
00008Cr 2 bne L40FA
00008Cr 2 .else
00008Cr 2 D0 0E bne L40FA; new: slower
00008Er 2 F0 E9 beq L40D7
000090r 2 .endif
000090r 2 L40EE:
000090r 2 20 C6 00 jsr CHRGOT
000093r 2 20 rr rr jsr LINGET
000096r 2 A8 tay
000097r 2 F0 03 beq L40FA
000099r 2 4C rr rr jmp SYNERR
00009Cr 2 .endif
00009Cr 2 L40FA:
00009Cr 2 A5 19 lda LINNUM
00009Er 2 A4 1A ldy LINNUM+1
0000A0r 2 85 84 sta MEMSIZ
0000A2r 2 84 85 sty MEMSIZ+1
0000A4r 2 .ifndef MICROTAN
0000A4r 2 85 80 sta FRETOP
0000A6r 2 84 81 sty FRETOP+1
0000A8r 2 .endif
0000A8r 2 L4106:
0000A8r 2 .ifndef CONFIG_CBM_ALL
0000A8r 2 .ifdef APPLE
0000A8r 2 lda #$FF
0000A8r 2 jmp L2829
0000A8r 2 .word STROUT ; PATCH!
0000A8r 2 jsr NXIN
0000A8r 2 .else
0000A8r 2 A9 rr lda #<QT_TERMINAL_WIDTH
0000AAr 2 A0 rr ldy #>QT_TERMINAL_WIDTH
0000ACr 2 20 rr rr jsr STROUT
0000AFr 2 20 rr rr jsr NXIN
0000B2r 2 .endif
0000B2r 2 86 C7 stx TXTPTR
0000B4r 2 84 C8 sty TXTPTR+1
0000B6r 2 20 C0 00 jsr CHRGET
0000B9r 2 A8 tay
0000BAr 2 F0 1C beq L4136
0000BCr 2 20 rr rr jsr LINGET
0000BFr 2 A5 1A lda LINNUM+1
0000C1r 2 D0 E5 bne L4106
0000C3r 2 A5 19 lda LINNUM
0000C5r 2 C9 10 cmp #$10
0000C7r 2 90 DF bcc L4106
0000C9r 2 L2829:
0000C9r 2 85 17 sta Z17
0000CBr 2 L4129:
0000CBr 2 E9 0E sbc #$0E
0000CDr 2 B0 FC bcs L4129
0000CFr 2 49 FF eor #$FF
0000D1r 2 E9 0C sbc #$0C
0000D3r 2 18 clc
0000D4r 2 65 17 adc Z17
0000D6r 2 85 18 sta Z18
0000D8r 2 .endif
0000D8r 2 L4136:
0000D8r 2 .ifdef CONFIG_RAM
0000D8r 2 A9 rr lda #<QT_WANT
0000DAr 2 A0 rr ldy #>QT_WANT
0000DCr 2 20 rr rr jsr STROUT
0000DFr 2 20 rr rr jsr NXIN
0000E2r 2 86 C7 stx TXTPTR
0000E4r 2 84 C8 sty TXTPTR+1
0000E6r 2 20 C0 00 jsr CHRGET
0000E9r 2 A2 rr ldx #<RAMSTART1
0000EBr 2 A0 rr ldy #>RAMSTART1
0000EDr 2 C9 59 cmp #'Y'
0000EFr 2 F0 34 beq L4183
0000F1r 2 C9 41 cmp #'A'
0000F3r 2 F0 04 beq L4157
0000F5r 2 C9 4E cmp #'N'
0000F7r 2 D0 DF bne L4136
0000F9r 2 L4157:
0000F9r 2 A2 rr ldx #<IQERR
0000FBr 2 A0 rr ldy #>IQERR
0000FDr 2 8E rr rr stx UNFNC_ATN
000100r 2 8C rr rr sty UNFNC_ATN+1
000103r 2 A2 rr ldx #<ATN ; overwrite starting
000105r 2 A0 rr ldy #>ATN ; with ATN
000107r 2 C9 41 cmp #'A'
000109r 2 F0 1A beq L4183
00010Br 2 A2 rr ldx #<IQERR
00010Dr 2 A0 rr ldy #>IQERR
00010Fr 2 8E rr rr stx UNFNC_COS
000112r 2 8C rr rr sty UNFNC_COS+1
000115r 2 8E rr rr stx UNFNC_TAN
000118r 2 8C rr rr sty UNFNC_TAN+1
00011Br 2 8E rr rr stx UNFNC_SIN
00011Er 2 8C rr rr sty UNFNC_SIN+1
000121r 2 A2 rr ldx #<SIN_COS_TAN_ATN ; overwrite
000123r 2 A0 rr ldy #>SIN_COS_TAN_ATN ; all of trig.s
000125r 2 L4183:
000125r 2 .else
000125r 2 ldx #<RAMSTART2
000125r 2 ldy #>RAMSTART2
000125r 2 .endif
000125r 2 86 78 stx TXTTAB
000127r 2 84 79 sty TXTTAB+1
000129r 2 A0 00 ldy #$00
00012Br 2 98 tya
00012Cr 2 91 78 sta (TXTTAB),y
00012Er 2 E6 78 inc TXTTAB
000130r 2 .ifndef CBM2
000130r 2 D0 02 bne L4192
000132r 2 E6 79 inc TXTTAB+1
000134r 2 L4192:
000134r 2 .endif
000134r 2 .if CONFIG_SCRTCH_ORDER = 1
000134r 2 jsr SCRTCH
000134r 2 .endif
000134r 2 A5 78 lda TXTTAB
000136r 2 A4 79 ldy TXTTAB+1
000138r 2 20 rr rr jsr REASON
00013Br 2 .ifdef CBM2
00013Br 2 lda #<QT_BASIC
00013Br 2 ldy #>QT_BASIC
00013Br 2 jsr STROUT
00013Br 2 .else
00013Br 2 20 rr rr jsr CRDO
00013Er 2 .endif
00013Er 2 A5 84 lda MEMSIZ
000140r 2 38 sec
000141r 2 E5 78 sbc TXTTAB
000143r 2 AA tax
000144r 2 A5 85 lda MEMSIZ+1
000146r 2 E5 79 sbc TXTTAB+1
000148r 2 20 rr rr jsr LINPRT
00014Br 2 A9 rr lda #<QT_BYTES_FREE
00014Dr 2 A0 rr ldy #>QT_BYTES_FREE
00014Fr 2 20 rr rr jsr STROUT
000152r 2 .if CONFIG_SCRTCH_ORDER = 2
000152r 2 20 rr rr jsr SCRTCH
000155r 2 .endif
000155r 2 .ifdef CONFIG_CBM_ALL
000155r 2 jmp RESTART
000155r 2 .else
000155r 2 A9 rr lda #<STROUT
000157r 2 A0 rr ldy #>STROUT
000159r 2 85 04 sta GOSTROUT+1
00015Br 2 84 05 sty GOSTROUT+2
00015Dr 2 .if CONFIG_SCRTCH_ORDER = 3
00015Dr 2 jsr SCRTCH
00015Dr 2 .endif
00015Dr 2 A9 rr lda #<RESTART
00015Fr 2 A0 rr ldy #>RESTART
000161r 2 85 01 sta GORESTART+1
000163r 2 84 02 sty GORESTART+2
000165r 2 6C 01 00 jmp (GORESTART+1)
000168r 2 .endif
000168r 2
000168r 2 .if .def(CONFIG_RAM) || .def(OSI)
000168r 2 ; OSI is compiled for ROM, but includes
000168r 2 ; this unused string
000168r 2 QT_WANT:
000168r 2 57 41 4E 54 .byte "WANT SIN-COS-TAN-ATN"
00016Cr 2 20 53 49 4E
000170r 2 2D 43 4F 53
00017Cr 2 00 .byte 0
00017Dr 2 .endif
00017Dr 2 QT_WRITTEN_BY:
00017Dr 2 .ifndef CONFIG_CBM_ALL
00017Dr 2 .ifdef APPLE
00017Dr 2 asc80 "COPYRIGHT 1977 BY MICROSOFT CO"
00017Dr 2 .byte CR,0
00017Dr 2 .else
00017Dr 2 0D 0A 0C .byte CR,LF,$0C ; FORM FEED
000180r 2 .ifndef CONFIG_11
000180r 2 .byte "WRITTEN BY RICHARD W. WEILAND."
000180r 2 .else
000180r 2 57 52 49 54 .byte "WRITTEN BY WEILAND & GATES"
000184r 2 54 45 4E 20
000188r 2 42 59 20 57
00019Ar 2 .endif
00019Ar 2 0D 0A 00 .byte CR,LF,0
00019Dr 2 .endif
00019Dr 2 QT_MEMORY_SIZE:
00019Dr 2 4D 45 4D 4F .byte "MEMORY SIZE"
0001A1r 2 52 59 20 53
0001A5r 2 49 5A 45
0001A8r 2 00 .byte 0
0001A9r 2 QT_TERMINAL_WIDTH:
0001A9r 2 54 45 52 4D .byte "TERMINAL WIDTH"
0001ADr 2 49 4E 41 4C
0001B1r 2 20 57 49 44
0001B7r 2 00 .byte 0
0001B8r 2 .endif
0001B8r 2 QT_BYTES_FREE:
0001B8r 2 20 42 59 54 .byte " BYTES FREE"
0001BCr 2 45 53 20 46
0001C0r 2 52 45 45
0001C3r 2 .ifdef CBM1
0001C3r 2 .elseif .def(CBM2)
0001C3r 2 .byte CR,0
0001C3r 2 .elseif .def(APPLE)
0001C3r 2 .byte 0
0001C3r 2 .else
0001C3r 2 0D 0A 0D 0A .byte CR,LF,CR,LF
0001C7r 2 .endif
0001C7r 2 QT_BASIC:
0001C7r 2 .ifdef OSI
0001C7r 2 .byte "OSI 6502 BASIC VERSION 1.0 REV 3.2"
0001C7r 2 .endif
0001C7r 2 .ifdef KIM
0001C7r 2 4D 4F 53 20 .byte "MOS TECH 6502 BASIC V1.1"
0001CBr 2 54 45 43 48
0001CFr 2 20 36 35 30
0001DFr 2 .endif
0001DFr 2 .ifdef MICROTAN
0001DFr 2 .byte "MICROTAN BASIC"
0001DFr 2 .endif
0001DFr 2 .ifdef CBM1
0001DFr 2 .byte $13 ; HOME
0001DFr 2 .byte "*** COMMODORE BASIC ***"
0001DFr 2 .byte $11,$11,$11,0 ; DOWN/DOWN/DOWN
0001DFr 2 .endif
0001DFr 2 .ifdef CBM2
0001DFr 2 .byte "### COMMODORE BASIC ###"
0001DFr 2 .byte CR,CR,0
0001DFr 2 .endif
0001DFr 2 .ifdef APPLE
0001DFr 2 .byte LF,CR,LF
0001DFr 2 .byte "APPLE BASIC V1.1"
0001DFr 2 .endif
0001DFr 2 .ifndef CONFIG_CBM_ALL
0001DFr 2 0D 0A .byte CR,LF
0001E1r 2 .ifdef MICROTAN
0001E1r 2 .byte "(C) 1980 MICROSOFT"
0001E1r 2 .else
0001E1r 2 43 4F 50 59 .byte "COPYRIGHT 1977 BY MICROSOFT CO."
0001E5r 2 52 49 47 48
0001E9r 2 54 20 31 39
000200r 2 .endif
000200r 2 0D 0A 00 .byte CR,LF,0
000203r 2 .endif
000203r 2 .endif ; /* KBD */
000203r 2
000203r 1 .include "extra.s"
000203r 2 .segment "EXTRA"
000000r 2
000000r 2 .ifdef KIM
000000r 2 .include "kim_extra.s"
000000r 3 .segment "EXTRA"
000000r 3
000000r 3 RAMSTART2:
000000r 3 08 29 25 20 .byte $08,$29,$25,$20,$60,$2A,$E5,$E4
000004r 3 60 2A E5 E4
000008r 3 20 66 24 65 .byte $20,$66,$24,$65,$AC,$04,$A4
00000Cr 3 AC 04 A4
00000Fr 3
00000Fr 2 .endif
00000Fr 2
00000Fr 2 .ifdef CONFIG_CBM1_PATCHES
00000Fr 2 .include "cbm1_patches.s"
00000Fr 2 .endif
00000Fr 2
00000Fr 2 .ifdef KBD
00000Fr 2 .include "kbd_extra.s"
00000Fr 2 .endif
00000Fr 2
00000Fr 2 .ifdef APPLE
00000Fr 2 .include "apple_extra.s"
00000Fr 2 .endif
00000Fr 2
00000Fr 2 .ifdef MICROTAN
00000Fr 2 .include "microtan_extra.s"
00000Fr 2 .endif
00000Fr 2
00000Fr 1
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment