6502
/
pill_6502
mirror of https://github.com/satoshinm/pill_6502.git
1
0
Fork 0
Code Issues Projects Releases Wiki Activity
pill_6502/osi_bas/osi_bas.lst

5903 lines
288 KiB
Plaintext
Raw Permalink Blame History

ca65 V2.13.3 - (C) Copyright 1998-2012 Ullrich von Bassewitz
Main file : osi_bas.s
Current file: osi_bas.s
000000r 1 ; Microsoft BASIC for 6502 (OSI VERSION)
000000r 1 ;
000000r 1 ; ==================================================================================
000000r 1 ; MODIFIED FROM THE ORIGINAL FILES AT http://www.pagetable.com/?p=46
000000r 1 ; MERGED INTO ONE FILE AND MACROS AND CONDITIONAL STATEMENTS REMOVED
000000r 1 ; BY G. SEARLE 2013
000000r 1 ;
000000r 1 ; I/O and dummy load/saves added to the end of this code
000000r 1 ;
000000r 1 ; This then assembles to the OSI version with the following
000000r 1 ; minor changes to the original BASIC code:
000000r 1 ; 1. Control-C call changed
000000r 1 ; 2. Load/save calls changed
000000r 1 ; 3. RAM start set to $0200 instead of $0300
000000r 1 ; 4. ROM start set to $C000
000000r 1 ; 5. Second letter of error messages back to ASCII value (instead of $80+val)
000000r 1 ; ==================================================================================
000000r 1 ;
000000r 1 ; Extract of original header comments follows:
000000r 1 ;
000000r 1 ; (first revision of this distribution, 20 Oct 2008, Michael Steil www.pagetable.com)
000000r 1 ;
000000r 1 ;
000000r 1 ; Name Release MS Version ROM 9digit INPUTBUFFER extensions
000000r 1 ;---------------------------------------------------------------------------------------------------
000000r 1 ; OSI BASIC 1977 1.0 REV 3.2 Y N ZP -
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 ; zero page
000000r 1 ZP_START1 = $00
000000r 1 ZP_START2 = $0D
000000r 1 ZP_START3 = $5B
000000r 1 ZP_START4 = $65
000000r 1
000000r 1 ;extra ZP variables
000000r 1 USR := $000A
000000r 1
000000r 1 ; constants
000000r 1 STACK_TOP := $FC
000000r 1 SPACE_FOR_GOSUB := $33
000000r 1 NULL_MAX := $0A
000000r 1 WIDTH := 72
000000r 1 WIDTH2 := 56
000000r 1
000000r 1 ; memory layout
000000r 1 RAMSTART2 := $0200
000000r 1 BYTES_FP := 4
000000r 1 BYTES_PER_ELEMENT := BYTES_FP
000000r 1 BYTES_PER_VARIABLE := BYTES_FP+2
000000r 1 MANTISSA_BYTES := BYTES_FP-1
000000r 1 BYTES_PER_FRAME := 2*BYTES_FP+8
000000r 1 FOR_STACK1 := 2*BYTES_FP+5
000000r 1 FOR_STACK2 := BYTES_FP+4
000000r 1 MAX_EXPON = 10
000000r 1 STACK := $0100
000000r 1
000000r 1 INPUTBUFFERX = INPUTBUFFER & $FF00
000000r 1
000000r 1 CR=13
000000r 1 LF=10
000000r 1
000000r 1 CRLF_1 := CR
000000r 1 CRLF_2 := LF
000000r 1
000000r 1 .feature org_per_seg
000000r 1 .zeropage
000000r 1 .org $0000
000000 1 .org ZP_START1
000000 1 GORESTART:
000000 1 xx xx xx .res 3
000003 1 GOSTROUT:
000003 1 xx xx xx .res 3
000006 1 GOAYINT:
000006 1 xx xx .res 2
000008 1 GOGIVEAYF:
000008 1 xx xx .res 2
00000A 1
00000A 1 .org ZP_START2
00000D 1 Z15:
00000D 1 xx .res 1
00000E 1 POSX:
00000E 1 xx .res 1
00000F 1 Z17:
00000F 1 xx .res 1
000010 1 Z18:
000010 1 xx .res 1
000011 1 LINNUM:
000011 1 TXPSV:
000011 1 xx xx .res 2
000013 1 INPUTBUFFER:
000013 1
000013 1 .org ZP_START3
00005B 1 CHARAC:
00005B 1 xx .res 1
00005C 1 ENDCHR:
00005C 1 xx .res 1
00005D 1 EOLPNTR:
00005D 1 xx .res 1
00005E 1 DIMFLG:
00005E 1 xx .res 1
00005F 1 VALTYP:
00005F 1 xx .res 1
000060 1 DATAFLG:
000060 1 xx .res 1
000061 1 SUBFLG:
000061 1 xx .res 1
000062 1 INPUTFLG:
000062 1 xx .res 1
000063 1 CPRMASK:
000063 1 xx .res 1
000064 1 Z14:
000064 1 xx .res 1
000065 1
000065 1 .org ZP_START4
000065 1 TEMPPT:
000065 1 xx .res 1
000066 1 LASTPT:
000066 1 xx xx .res 2
000068 1 TEMPST:
000068 1 xx xx xx xx .res 9
00006C 1 xx xx xx xx
000070 1 xx
000071 1 INDEX:
000071 1 xx xx .res 2
000073 1 DEST:
000073 1 xx xx .res 2
000075 1 RESULT:
000075 1 xx xx xx xx .res BYTES_FP
000079 1 RESULT_LAST = RESULT + BYTES_FP-1
000079 1 TXTTAB:
000079 1 xx xx .res 2
00007B 1 VARTAB:
00007B 1 xx xx .res 2
00007D 1 ARYTAB:
00007D 1 xx xx .res 2
00007F 1 STREND:
00007F 1 xx xx .res 2
000081 1 FRETOP:
000081 1 xx xx .res 2
000083 1 FRESPC:
000083 1 xx xx .res 2
000085 1 MEMSIZ:
000085 1 xx xx .res 2
000087 1 CURLIN:
000087 1 xx xx .res 2
000089 1 OLDLIN:
000089 1 xx xx .res 2
00008B 1 OLDTEXT:
00008B 1 xx xx .res 2
00008D 1 Z8C:
00008D 1 xx xx .res 2
00008F 1 DATPTR:
00008F 1 xx xx .res 2
000091 1 INPTR:
000091 1 xx xx .res 2
000093 1 VARNAM:
000093 1 xx xx .res 2
000095 1 VARPNT:
000095 1 xx xx .res 2
000097 1 FORPNT:
000097 1 xx xx .res 2
000099 1 LASTOP:
000099 1 xx xx .res 2
00009B 1 CPRTYP:
00009B 1 xx .res 1
00009C 1 FNCNAM:
00009C 1 TEMP3:
00009C 1 xx xx .res 2
00009E 1 DSCPTR:
00009E 1 xx xx .res 2
0000A0 1 DSCLEN:
0000A0 1 xx xx .res 2
0000A2 1 JMPADRS := DSCLEN + 1
0000A2 1
0000A2 1 Z52:
0000A2 1 xx .res 1
0000A3 1 ARGEXTENSION:
0000A3 1 TEMP1:
0000A3 1 xx .res 1
0000A4 1 HIGHDS:
0000A4 1 xx xx .res 2
0000A6 1 HIGHTR:
0000A6 1 xx xx .res 2
0000A8 1 INDX:
0000A8 1 TMPEXP:
0000A8 1 TEMP2:
0000A8 1 xx .res 1
0000A9 1 EXPON:
0000A9 1 xx .res 1
0000AA 1 LOWTR:
0000AA 1 LOWTRX:
0000AA 1 xx .res 1
0000AB 1 EXPSGN:
0000AB 1 xx .res 1
0000AC 1 FAC:
0000AC 1 xx xx xx xx .res BYTES_FP
0000B0 1 FAC_LAST = FAC + BYTES_FP-1
0000B0 1 FACSIGN:
0000B0 1 xx .res 1
0000B1 1 SERLEN:
0000B1 1 xx .res 1
0000B2 1 SHIFTSIGNEXT:
0000B2 1 xx .res 1
0000B3 1 ARG:
0000B3 1 xx xx xx xx .res BYTES_FP
0000B7 1 ARG_LAST = ARG + BYTES_FP-1
0000B7 1 ARGSIGN:
0000B7 1 xx .res 1
0000B8 1 STRNG1:
0000B8 1 xx xx .res 2
0000BA 1 SGNCPR = STRNG1
0000BA 1 FACEXTENSION = STRNG1+1
0000BA 1 STRNG2:
0000BA 1 xx xx .res 2
0000BC 1 CHRGET:
0000BC 1 TXTPTR = <(GENERIC_TXTPTR-GENERIC_CHRGET + CHRGET)
0000BC 1 CHRGOT = <(GENERIC_CHRGOT-GENERIC_CHRGET + CHRGET)
0000BC 1 CHRGOT2 = <(GENERIC_CHRGOT2-GENERIC_CHRGET + CHRGET)
0000BC 1 RNDSEED = <(GENERIC_RNDSEED-GENERIC_CHRGET + CHRGET)
0000BC 1
0000BC 1 .segment "CODE"
000000r 1 .org $C000
00C000 1 TOKEN_ADDRESS_TABLE:
00C000 1 2D C6 .word END-1
00C002 1 55 C5 .word FOR-1
00C004 1 33 CA .word NEXT-1
00C006 1 FF C6 .word DATA-1
00C008 1 16 C9 .word INPUT-1
00C00A 1 F4 CC .word DIM-1
00C00C 1 42 C9 .word READ-1
00C00E 1 AC C7 .word LET-1
00C010 1 TOKEN_GOTO=$80+(*-TOKEN_ADDRESS_TABLE)/2
00C010 1 AC C6 .word GOTO-1
00C012 1 84 C6 .word RUN-1
00C014 1 2F C7 .word IF-1
00C016 1 19 C6 .word RESTORE-1
00C018 1 TOKEN_GOSUB=$80+(*-TOKEN_ADDRESS_TABLE)/2
00C018 1 8F C6 .word GOSUB-1
00C01A 1 D9 C6 .word POP-1
00C01C 1 TOKEN_REM=$80+(*-TOKEN_ADDRESS_TABLE)/2
00C01C 1 42 C7 .word REM-1
00C01E 1 2B C6 .word STOP-1
00C020 1 52 C7 .word ON-1
00C022 1 6E C6 .word NULL-1
00C024 1 25 D4 .word WAIT-1
00C026 1 74 FF .word LOAD-1
00C028 1 75 FF .word SAVE-1
00C02A 1 D1 CF .word DEF-1
00C02C 1 1C D4 .word POKE-1
00C02E 1 TOKEN_PRINT=$80+(*-TOKEN_ADDRESS_TABLE)/2
00C02E 1 22 C8 .word PRINT-1
00C030 1 54 C6 .word CONT-1
00C032 1 B4 C4 .word LIST-1
00C034 1 7F C6 .word CLEAR-1
00C036 1 60 C4 .word NEW-1
00C038 1 TOKEN_TAB=$00+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 TOKEN_TO=$01+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 TOKEN_FN=$02+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 TOKEN_SPC=$03+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 TOKEN_THEN=$04+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 TOKEN_NOT=$05+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 TOKEN_STEP=$06+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 TOKEN_PLUS=$07+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 TOKEN_MINUS=$08+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 TOKEN_GREATER=$0E+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 TOKEN_EQUAL=$0F+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 NUM_TOKENS=(*-TOKEN_ADDRESS_TABLE)/2
00C038 1
00C038 1 UNFNC:
00C038 1 TOKEN_SGN=$11+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C038 1 CC D7 .word SGN
00C03A 1 56 D8 .word INT
00C03C 1 E9 D7 .word ABS
00C03E 1 0A 00 .word USR
00C040 1 A1 CF .word FRE
00C042 1 C2 CF .word POS
00C044 1 A0 DA .word SQR
00C046 1 B4 DB .word RND
00C048 1 B1 D5 .word LOG
00C04A 1 0F DB .word EXP
00C04C 1 F0 DB .word COS
00C04E 1 F7 DB .word SIN
00C050 1 40 DC .word TAN
00C052 1 8D DC .word ATN
00C054 1 12 D4 .word PEEK
00C056 1 80 D3 .word LEN
00C058 1 80 D0 .word STR
00C05A 1 B1 D3 .word VAL
00C05C 1 8F D3 .word ASC
00C05E 1 F0 D2 .word CHRSTR
00C060 1 TOKEN_LEFTSTR=$11+$80+(*-TOKEN_ADDRESS_TABLE)/2
00C060 1 04 D3 .word LEFTSTR
00C062 1 30 D3 .word RIGHTSTR
00C064 1 3B D3 .word MIDSTR
00C066 1
00C066 1 MATHTBL:
00C066 1 79 .byte $79
00C067 1 62 D4 .word FADDT-1
00C069 1 79 .byte $79
00C06A 1 4B D4 .word FSUBT-1
00C06C 1 7B .byte $7B
00C06D 1 F1 D5 .word FMULTT-1
00C06F 1 7B .byte $7B
00C070 1 C0 D6 .word FDIVT-1
00C072 1 7F .byte $7F
00C073 1 A9 DA .word FPWRT-1
00C075 1 50 .byte $50
00C076 1 5C CC .word TAND-1
00C078 1 46 .byte $46
00C079 1 59 CC .word OR-1
00C07B 1 7D .byte $7D
00C07C 1 E2 DA .word NEGOP-1
00C07E 1 5A .byte $5A
00C07F 1 CB CB .word EQUOP-1
00C081 1 64 .byte $64
00C082 1 89 CC .word RELOPS-1
00C084 1
00C084 1 TOKEN_NAME_TABLE:
00C084 1 45 4E C4 .byte "EN", $80+'D'
00C087 1 46 4F D2 .byte "FO", $80+'R'
00C08A 1 4E 45 58 D4 .byte "NEX", $80+'T'
00C08E 1 44 41 54 C1 .byte "DAT", $80+'A'
00C092 1 49 4E 50 55 .byte "INPU", $80+'T'
00C096 1 D4
00C097 1 44 49 CD .byte "DI", $80+'M'
00C09A 1 52 45 41 C4 .byte "REA", $80+'D'
00C09E 1 4C 45 D4 .byte "LE", $80+'T'
00C0A1 1 47 4F 54 CF .byte "GOT", $80+'O'
00C0A5 1 52 55 CE .byte "RU", $80+'N'
00C0A8 1 49 C6 .byte "I", $80+'F'
00C0AA 1 52 45 53 54 .byte "RESTOR", $80+'E'
00C0AE 1 4F 52 C5
00C0B1 1 47 4F 53 55 .byte "GOSU", $80+'B'
00C0B5 1 C2
00C0B6 1 52 45 54 55 .byte "RETUR", $80+'N'
00C0BA 1 52 CE
00C0BC 1 52 45 CD .byte "RE", $80+'M'
00C0BF 1 53 54 4F D0 .byte "STO", $80+'P'
00C0C3 1 4F CE .byte "O", $80+'N'
00C0C5 1 4E 55 4C CC .byte "NUL", $80+'L'
00C0C9 1 57 41 49 D4 .byte "WAI", $80+'T'
00C0CD 1 4C 4F 41 C4 .byte "LOA", $80+'D'
00C0D1 1 53 41 56 C5 .byte "SAV", $80+'E'
00C0D5 1 44 45 C6 .byte "DE", $80+'F'
00C0D8 1 50 4F 4B C5 .byte "POK", $80+'E'
00C0DC 1 50 52 49 4E .byte "PRIN", $80+'T'
00C0E0 1 D4
00C0E1 1 43 4F 4E D4 .byte "CON", $80+'T'
00C0E5 1 4C 49 53 D4 .byte "LIS", $80+'T'
00C0E9 1 43 4C 45 41 .byte "CLEA", $80+'R'
00C0ED 1 D2
00C0EE 1 4E 45 D7 .byte "NE", $80+'W'
00C0F1 1 54 41 42 A8 .byte "TAB", $80+'('
00C0F5 1 54 CF .byte "T", $80+'O'
00C0F7 1 46 CE .byte "F", $80+'N'
00C0F9 1 53 50 43 A8 .byte "SPC", $80+'('
00C0FD 1 54 48 45 CE .byte "THE", $80+'N'
00C101 1 4E 4F D4 .byte "NO", $80+'T'
00C104 1 53 54 45 D0 .byte "STE", $80+'P'
00C108 1 AB .byte "", $80+'+'
00C109 1 AD .byte "", $80+'-'
00C10A 1 AA .byte "", $80+'*'
00C10B 1 AF .byte "", $80+'/'
00C10C 1 DE .byte "", $80+'^'
00C10D 1 41 4E C4 .byte "AN", $80+'D'
00C110 1 4F D2 .byte "O", $80+'R'
00C112 1 BE .byte "", $80+'>'
00C113 1 BD .byte "", $80+'='
00C114 1 BC .byte "", $80+'<'
00C115 1 53 47 CE .byte "SG", $80+'N'
00C118 1 49 4E D4 .byte "IN", $80+'T'
00C11B 1 41 42 D3 .byte "AB", $80+'S'
00C11E 1 55 53 D2 .byte "US", $80+'R'
00C121 1 46 52 C5 .byte "FR", $80+'E'
00C124 1 50 4F D3 .byte "PO", $80+'S'
00C127 1 53 51 D2 .byte "SQ", $80+'R'
00C12A 1 52 4E C4 .byte "RN", $80+'D'
00C12D 1 4C 4F C7 .byte "LO", $80+'G'
00C130 1 45 58 D0 .byte "EX", $80+'P'
00C133 1 43 4F D3 .byte "CO", $80+'S'
00C136 1 53 49 CE .byte "SI", $80+'N'
00C139 1 54 41 CE .byte "TA", $80+'N'
00C13C 1 41 54 CE .byte "AT", $80+'N'
00C13F 1 50 45 45 CB .byte "PEE", $80+'K'
00C143 1 4C 45 CE .byte "LE", $80+'N'
00C146 1 53 54 52 A4 .byte "STR", $80+'$'
00C14A 1 56 41 CC .byte "VA", $80+'L'
00C14D 1 41 53 C3 .byte "AS", $80+'C'
00C150 1 43 48 52 A4 .byte "CHR", $80+'$'
00C154 1 4C 45 46 54 .byte "LEFT", $80+'$'
00C158 1 A4
00C159 1 52 49 47 48 .byte "RIGHT", $80+'$'
00C15D 1 54 A4
00C15F 1 4D 49 44 A4 .byte "MID", $80+'$'
00C163 1 00 .byte 0
00C164 1
00C164 1 ERROR_MESSAGES:
00C164 1 ERR_NOFOR := <(*-ERROR_MESSAGES)
00C164 1 4E 46 .byte "NF"
00C166 1 ERR_SYNTAX := <(*-ERROR_MESSAGES)
00C166 1 53 4E .byte "SN"
00C168 1 ERR_NOGOSUB := <(*-ERROR_MESSAGES)
00C168 1 52 47 .byte "RG"
00C16A 1 ERR_NODATA := <(*-ERROR_MESSAGES)
00C16A 1 4F 44 .byte "OD"
00C16C 1 ERR_ILLQTY := <(*-ERROR_MESSAGES)
00C16C 1 46 43 .byte "FC"
00C16E 1 ERR_OVERFLOW := <(*-ERROR_MESSAGES)
00C16E 1 4F 56 .byte "OV"
00C170 1 ERR_MEMFULL := <(*-ERROR_MESSAGES)
00C170 1 4F 4D .byte "OM"
00C172 1 ERR_UNDEFSTAT := <(*-ERROR_MESSAGES)
00C172 1 55 53 .byte "US"
00C174 1 ERR_BADSUBS := <(*-ERROR_MESSAGES)
00C174 1 42 53 .byte "BS"
00C176 1 ERR_REDIMD := <(*-ERROR_MESSAGES)
00C176 1 44 44 .byte "DD"
00C178 1 ERR_ZERODIV := <(*-ERROR_MESSAGES)
00C178 1 2F 30 .byte "/0"
00C17A 1 ERR_ILLDIR := <(*-ERROR_MESSAGES)
00C17A 1 49 44 .byte "ID"
00C17C 1 ERR_BADTYPE := <(*-ERROR_MESSAGES)
00C17C 1 54 4D .byte "TM"
00C17E 1 ERR_STRLONG := <(*-ERROR_MESSAGES)
00C17E 1 4C 53 .byte "LS"
00C180 1 ERR_FRMCPX := <(*-ERROR_MESSAGES)
00C180 1 53 54 .byte "ST"
00C182 1 ERR_CANTCONT := <(*-ERROR_MESSAGES)
00C182 1 43 4E .byte "CN"
00C184 1 ERR_UNDEFFN := <(*-ERROR_MESSAGES)
00C184 1 55 46 .byte "UF"
00C186 1
00C186 1 ; global messages: "error", "in", "ready", "break"
00C186 1 QT_ERROR:
00C186 1 20 45 52 52 .byte " ERROR"
00C18A 1 4F 52
00C18C 1 00 .byte 0
00C18D 1 QT_IN:
00C18D 1 20 49 4E 20 .byte " IN "
00C191 1 00 .byte $00
00C192 1 QT_OK:
00C192 1 0D 0A 4F 4B .byte CR,LF,"OK",CR,LF
00C196 1 0D 0A
00C198 1 00 .byte 0
00C199 1 QT_BREAK:
00C199 1 0D 0A 42 52 .byte CR,LF,"BREAK"
00C19D 1 45 41 4B
00C1A0 1 00 .byte 0
00C1A1 1
00C1A1 1 ; generic stack and memory management code
00C1A1 1 ; this code is identical across all versions of
00C1A1 1 ; BASIC
00C1A1 1 ; ----------------------------------------------------------------------------
00C1A1 1 ; CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH
00C1A1 1 ; THE STACK FOR A FRAME WITH THE SAME VARIABLE.
00C1A1 1 ;
00C1A1 1 ; (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT"
00C1A1 1 ; = $XXFF IF CALLED FROM "RETURN"
00C1A1 1 ; <<< BUG: SHOULD BE $FFXX >>>
00C1A1 1 ;
00C1A1 1 ; RETURNS .NE. IF VARIABLE NOT FOUND,
00C1A1 1 ; (X) = STACK PNTR AFTER SKIPPING ALL FRAMES
00C1A1 1 ;
00C1A1 1 ; .EQ. IF FOUND
00C1A1 1 ; (X) = STACK PNTR OF FRAME FOUND
00C1A1 1 ; ----------------------------------------------------------------------------
00C1A1 1 GTFORPNT:
00C1A1 1 BA tsx
00C1A2 1 E8 inx
00C1A3 1 E8 inx
00C1A4 1 E8 inx
00C1A5 1 E8 inx
00C1A6 1 L2279:
00C1A6 1 BD 01 01 lda STACK+1,x
00C1A9 1 C9 81 cmp #$81
00C1AB 1 D0 21 bne L22A1
00C1AD 1 A5 98 lda FORPNT+1
00C1AF 1 D0 0A bne L228E
00C1B1 1 BD 02 01 lda STACK+2,x
00C1B4 1 85 97 sta FORPNT
00C1B6 1 BD 03 01 lda STACK+3,x
00C1B9 1 85 98 sta FORPNT+1
00C1BB 1 L228E:
00C1BB 1 DD 03 01 cmp STACK+3,x
00C1BE 1 D0 07 bne L229A
00C1C0 1 A5 97 lda FORPNT
00C1C2 1 DD 02 01 cmp STACK+2,x
00C1C5 1 F0 07 beq L22A1
00C1C7 1 L229A:
00C1C7 1 8A txa
00C1C8 1 18 clc
00C1C9 1 69 10 adc #BYTES_PER_FRAME
00C1CB 1 AA tax
00C1CC 1 D0 D8 bne L2279
00C1CE 1 L22A1:
00C1CE 1 60 rts
00C1CF 1 ; ----------------------------------------------------------------------------
00C1CF 1 ; MOVE BLOCK OF MEMORY UP
00C1CF 1 ;
00C1CF 1 ; ON ENTRY:
00C1CF 1 ; (Y,A) = (HIGHDS) = DESTINATION END+1
00C1CF 1 ; (LOWTR) = LOWEST ADDRESS OF SOURCE
00C1CF 1 ; (HIGHTR) = HIGHEST SOURCE ADDRESS+1
00C1CF 1 ; ----------------------------------------------------------------------------
00C1CF 1 BLTU:
00C1CF 1 20 1F C2 jsr REASON
00C1D2 1 85 7F sta STREND
00C1D4 1 84 80 sty STREND+1
00C1D6 1 BLTU2:
00C1D6 1 38 sec
00C1D7 1 A5 A6 lda HIGHTR
00C1D9 1 E5 AA sbc LOWTR
00C1DB 1 85 71 sta INDEX
00C1DD 1 A8 tay
00C1DE 1 A5 A7 lda HIGHTR+1
00C1E0 1 E5 AB sbc LOWTR+1
00C1E2 1 AA tax
00C1E3 1 E8 inx
00C1E4 1 98 tya
00C1E5 1 F0 23 beq L22DD
00C1E7 1 A5 A6 lda HIGHTR
00C1E9 1 38 sec
00C1EA 1 E5 71 sbc INDEX
00C1EC 1 85 A6 sta HIGHTR
00C1EE 1 B0 03 bcs L22C6
00C1F0 1 C6 A7 dec HIGHTR+1
00C1F2 1 38 sec
00C1F3 1 L22C6:
00C1F3 1 A5 A4 lda HIGHDS
00C1F5 1 E5 71 sbc INDEX
00C1F7 1 85 A4 sta HIGHDS
00C1F9 1 B0 08 bcs L22D6
00C1FB 1 C6 A5 dec HIGHDS+1
00C1FD 1 90 04 bcc L22D6
00C1FF 1 L22D2:
00C1FF 1 B1 A6 lda (HIGHTR),y
00C201 1 91 A4 sta (HIGHDS),y
00C203 1 L22D6:
00C203 1 88 dey
00C204 1 D0 F9 bne L22D2
00C206 1 B1 A6 lda (HIGHTR),y
00C208 1 91 A4 sta (HIGHDS),y
00C20A 1 L22DD:
00C20A 1 C6 A7 dec HIGHTR+1
00C20C 1 C6 A5 dec HIGHDS+1
00C20E 1 CA dex
00C20F 1 D0 F2 bne L22D6
00C211 1 60 rts
00C212 1 ; ----------------------------------------------------------------------------
00C212 1 ; CHECK IF ENOUGH ROOM LEFT ON STACK
00C212 1 ; FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION
00C212 1 ; ----------------------------------------------------------------------------
00C212 1 CHKMEM:
00C212 1 0A asl a
00C213 1 69 33 adc #SPACE_FOR_GOSUB
00C215 1 B0 35 bcs MEMERR
00C217 1 85 71 sta INDEX
00C219 1 BA tsx
00C21A 1 E4 71 cpx INDEX
00C21C 1 90 2E bcc MEMERR
00C21E 1 60 rts
00C21F 1 ; ----------------------------------------------------------------------------
00C21F 1 ; CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS
00C21F 1 ; (Y,A) = ADDR ARRAYS NEED TO GROW TO
00C21F 1 ; ----------------------------------------------------------------------------
00C21F 1 REASON:
00C21F 1 C4 82 cpy FRETOP+1
00C221 1 90 28 bcc L231E
00C223 1 D0 04 bne L22FC
00C225 1 C5 81 cmp FRETOP
00C227 1 90 22 bcc L231E
00C229 1 L22FC:
00C229 1 48 pha
00C22A 1 A2 08 ldx #FAC-TEMP1-1
00C22C 1 98 tya
00C22D 1 L2300:
00C22D 1 48 pha
00C22E 1 B5 A3 lda TEMP1,x
00C230 1 CA dex
00C231 1 10 FA bpl L2300
00C233 1 20 3B D1 jsr GARBAG
00C236 1 A2 F8 ldx #TEMP1-FAC+1
00C238 1 L230B:
00C238 1 68 pla
00C239 1 95 AC sta FAC,x
00C23B 1 E8 inx
00C23C 1 30 FA bmi L230B
00C23E 1 68 pla
00C23F 1 A8 tay
00C240 1 68 pla
00C241 1 C4 82 cpy FRETOP+1
00C243 1 90 06 bcc L231E
00C245 1 D0 05 bne MEMERR
00C247 1 C5 81 cmp FRETOP
00C249 1 B0 01 bcs MEMERR
00C24B 1 L231E:
00C24B 1 60 rts
00C24C 1 MEMERR:
00C24C 1 A2 0C ldx #ERR_MEMFULL
00C24E 1 ; ----------------------------------------------------------------------------
00C24E 1 ; HANDLE AN ERROR
00C24E 1 ;
00C24E 1 ; (X)=OFFSET IN ERROR MESSAGE TABLE
00C24E 1 ; (ERRFLG) > 128 IF "ON ERR" TURNED ON
00C24E 1 ; (CURLIN+1) = $FF IF IN DIRECT MODE
00C24E 1 ; ----------------------------------------------------------------------------
00C24E 1 ERROR:
00C24E 1 46 64 lsr Z14
00C250 1 20 60 C8 jsr CRDO
00C253 1 20 D7 C8 jsr OUTQUES
00C256 1 BD 64 C1 lda ERROR_MESSAGES,x
00C259 1 20 D9 C8 jsr OUTDO
00C25C 1 BD 65 C1 lda ERROR_MESSAGES+1,x
00C25F 1 20 D9 C8 jsr OUTDO
00C262 1 20 91 C4 jsr STKINI
00C265 1 A9 86 lda #<QT_ERROR
00C267 1 A0 C1 ldy #>QT_ERROR
00C269 1 ; ----------------------------------------------------------------------------
00C269 1 ; PRINT STRING AT (Y,A)
00C269 1 ; PRINT CURRENT LINE # UNLESS IN DIRECT MODE
00C269 1 ; FALL INTO WARM RESTART
00C269 1 ; ----------------------------------------------------------------------------
00C269 1 PRINT_ERROR_LINNUM:
00C269 1 20 B7 C8 jsr STROUT
00C26C 1 A4 88 ldy CURLIN+1
00C26E 1 C8 iny
00C26F 1 F0 03 beq RESTART
00C271 1 20 47 D9 jsr INPRT
00C274 1 ; ----------------------------------------------------------------------------
00C274 1 ; WARM RESTART ENTRY
00C274 1 ; ----------------------------------------------------------------------------
00C274 1 RESTART:
00C274 1 46 64 lsr Z14
00C276 1 A9 92 lda #<QT_OK
00C278 1 A0 C1 ldy #>QT_OK
00C27A 1 20 03 00 jsr GOSTROUT
00C27D 1 L2351:
00C27D 1 20 57 C3 jsr INLIN
00C280 1 86 C3 stx TXTPTR
00C282 1 84 C4 sty TXTPTR+1
00C284 1 20 BC 00 jsr CHRGET
00C287 1 ; bug in pre-1.1: CHRGET sets Z on '\0'
00C287 1 ; and ':' - a line starting with ':' in
00C287 1 ; direct mode gets ignored
00C287 1 F0 F4 beq L2351
00C289 1 A2 FF ldx #$FF
00C28B 1 86 88 stx CURLIN+1
00C28D 1 90 06 bcc NUMBERED_LINE
00C28F 1 20 A6 C3 jsr PARSE_INPUT_LINE
00C292 1 4C F6 C5 jmp NEWSTT2
00C295 1 ; ----------------------------------------------------------------------------
00C295 1 ; HANDLE NUMBERED LINE
00C295 1 ; ----------------------------------------------------------------------------
00C295 1 NUMBERED_LINE:
00C295 1 20 73 C7 jsr LINGET
00C298 1 20 A6 C3 jsr PARSE_INPUT_LINE
00C29B 1 84 5D sty EOLPNTR
00C29D 1 20 32 C4 jsr FNDLIN
00C2A0 1 90 44 bcc PUT_NEW_LINE
00C2A2 1 A0 01 ldy #$01
00C2A4 1 B1 AA lda (LOWTR),y
00C2A6 1 85 72 sta INDEX+1
00C2A8 1 A5 7B lda VARTAB
00C2AA 1 85 71 sta INDEX
00C2AC 1 A5 AB lda LOWTR+1
00C2AE 1 85 74 sta DEST+1
00C2B0 1 A5 AA lda LOWTR
00C2B2 1 88 dey
00C2B3 1 F1 AA sbc (LOWTR),y
00C2B5 1 18 clc
00C2B6 1 65 7B adc VARTAB
00C2B8 1 85 7B sta VARTAB
00C2BA 1 85 73 sta DEST
00C2BC 1 A5 7C lda VARTAB+1
00C2BE 1 69 FF adc #$FF
00C2C0 1 85 7C sta VARTAB+1
00C2C2 1 E5 AB sbc LOWTR+1
00C2C4 1 AA tax
00C2C5 1 38 sec
00C2C6 1 A5 AA lda LOWTR
00C2C8 1 E5 7B sbc VARTAB
00C2CA 1 A8 tay
00C2CB 1 B0 03 bcs L23A5
00C2CD 1 E8 inx
00C2CE 1 C6 74 dec DEST+1
00C2D0 1 L23A5:
00C2D0 1 18 clc
00C2D1 1 65 71 adc INDEX
00C2D3 1 90 03 bcc L23AD
00C2D5 1 C6 72 dec INDEX+1
00C2D7 1 18 clc
00C2D8 1 L23AD:
00C2D8 1 B1 71 lda (INDEX),y
00C2DA 1 91 73 sta (DEST),y
00C2DC 1 C8 iny
00C2DD 1 D0 F9 bne L23AD
00C2DF 1 E6 72 inc INDEX+1
00C2E1 1 E6 74 inc DEST+1
00C2E3 1 CA dex
00C2E4 1 D0 F2 bne L23AD
00C2E6 1 ; ----------------------------------------------------------------------------
00C2E6 1 PUT_NEW_LINE:
00C2E6 1 A5 13 lda INPUTBUFFER
00C2E8 1 F0 2F beq FIX_LINKS
00C2EA 1 A5 85 lda MEMSIZ
00C2EC 1 A4 86 ldy MEMSIZ+1
00C2EE 1 85 81 sta FRETOP
00C2F0 1 84 82 sty FRETOP+1
00C2F2 1 A5 7B lda VARTAB
00C2F4 1 85 A6 sta HIGHTR
00C2F6 1 65 5D adc EOLPNTR
00C2F8 1 85 A4 sta HIGHDS
00C2FA 1 A4 7C ldy VARTAB+1
00C2FC 1 84 A7 sty HIGHTR+1
00C2FE 1 90 01 bcc L23D6
00C300 1 C8 iny
00C301 1 L23D6:
00C301 1 84 A5 sty HIGHDS+1
00C303 1 20 CF C1 jsr BLTU
00C306 1 A5 7F lda STREND
00C308 1 A4 80 ldy STREND+1
00C30A 1 85 7B sta VARTAB
00C30C 1 84 7C sty VARTAB+1
00C30E 1 A4 5D ldy EOLPNTR
00C310 1 88 dey
00C311 1 ; ---COPY LINE INTO PROGRAM-------
00C311 1 L23E6:
00C311 1 B9 0F 00 lda INPUTBUFFER-4,y
00C314 1 91 AA sta (LOWTR),y
00C316 1 88 dey
00C317 1 10 F8 bpl L23E6
00C319 1 ; ----------------------------------------------------------------------------
00C319 1 ; CLEAR ALL VARIABLES
00C319 1 ; RE-ESTABLISH ALL FORWARD LINKS
00C319 1 ; ----------------------------------------------------------------------------
00C319 1 FIX_LINKS:
00C319 1 20 77 C4 jsr SETPTRS
00C31C 1 A5 79 lda TXTTAB
00C31E 1 A4 7A ldy TXTTAB+1
00C320 1 85 71 sta INDEX
00C322 1 84 72 sty INDEX+1
00C324 1 18 clc
00C325 1 L23FA:
00C325 1 A0 01 ldy #$01
00C327 1 B1 71 lda (INDEX),y
00C329 1 D0 03 4C 7D jeq L2351
00C32D 1 C2
00C32E 1
00C32E 1 A0 04 ldy #$04
00C330 1 L2405:
00C330 1 C8 iny
00C331 1 B1 71 lda (INDEX),y
00C333 1 D0 FB bne L2405
00C335 1 C8 iny
00C336 1 98 tya
00C337 1 65 71 adc INDEX
00C339 1 AA tax
00C33A 1 A0 00 ldy #$00
00C33C 1 91 71 sta (INDEX),y
00C33E 1 A5 72 lda INDEX+1
00C340 1 69 00 adc #$00
00C342 1 C8 iny
00C343 1 91 71 sta (INDEX),y
00C345 1 86 71 stx INDEX
00C347 1 85 72 sta INDEX+1
00C349 1 90 DA bcc L23FA ; always
00C34B 1 ; ----------------------------------------------------------------------------
00C34B 1 L2420:
00C34B 1 20 D9 C8 jsr OUTDO
00C34E 1 CA dex
00C34F 1 10 08 bpl INLIN2
00C351 1 L2423:
00C351 1 20 D9 C8 jsr OUTDO
00C354 1 20 60 C8 jsr CRDO
00C357 1 ; ----------------------------------------------------------------------------
00C357 1 ; READ A LINE, AND STRIP OFF SIGN BITS
00C357 1 ; ----------------------------------------------------------------------------
00C357 1 INLIN:
00C357 1 A2 00 ldx #$00
00C359 1 INLIN2:
00C359 1 20 86 C3 jsr GETLN
00C35C 1 C9 07 cmp #$07
00C35E 1 F0 14 beq L2443
00C360 1 C9 0D cmp #$0D
00C362 1 F0 1F beq L2453
00C364 1 C9 08 cmp #$08 ; BACKSPACE
00C366 1 F0 E3 beq L2420
00C368 1 C9 20 cmp #$20
00C36A 1 90 ED bcc INLIN2
00C36C 1 C9 7D cmp #$7D
00C36E 1 B0 E9 bcs INLIN2
00C370 1 C9 40 cmp #$40 ; @
00C372 1 F0 DD beq L2423
00C374 1 L2443:
00C374 1 E0 47 cpx #$47
00C376 1 B0 04 bcs L244C
00C378 1 95 13 sta INPUTBUFFER,x
00C37A 1 E8 inx
00C37B 1 2C .byte $2C
00C37C 1 L244C:
00C37C 1 A9 07 lda #$07 ; BEL
00C37E 1 20 D9 C8 jsr OUTDO
00C381 1 D0 D6 bne INLIN2
00C383 1 L2453:
00C383 1 4C 5A C8 jmp L29B9
00C386 1 GETLN:
00C386 1 20 39 FF jsr MONRDKEY
00C389 1 EA nop
00C38A 1 EA nop
00C38B 1 EA nop
00C38C 1 EA nop
00C38D 1 EA nop
00C38E 1 EA nop
00C38F 1 EA nop
00C390 1 EA nop
00C391 1 EA nop
00C392 1 EA nop
00C393 1 EA nop
00C394 1 EA nop
00C395 1 EA nop
00C396 1 EA nop
00C397 1 29 7F and #$7F
00C399 1 RDKEY:
00C399 1 C9 0F cmp #$0F
00C39B 1 D0 08 bne L2465
00C39D 1 48 pha
00C39E 1 A5 64 lda Z14
00C3A0 1 49 FF eor #$FF
00C3A2 1 85 64 sta Z14
00C3A4 1 68 pla
00C3A5 1 L2465:
00C3A5 1 60 rts
00C3A6 1 ; ----------------------------------------------------------------------------
00C3A6 1 ; TOKENIZE THE INPUT LINE
00C3A6 1 ; ----------------------------------------------------------------------------
00C3A6 1 PARSE_INPUT_LINE:
00C3A6 1 A6 C3 ldx TXTPTR
00C3A8 1 A0 04 ldy #$04
00C3AA 1 84 60 sty DATAFLG
00C3AC 1 L246C:
00C3AC 1 B5 00 lda INPUTBUFFERX,x
00C3AE 1 C9 20 cmp #$20
00C3B0 1 F0 3A beq L24AC
00C3B2 1 85 5C sta ENDCHR
00C3B4 1 C9 22 cmp #$22
00C3B6 1 F0 58 beq L24D0
00C3B8 1 24 60 bit DATAFLG
00C3BA 1 70 30 bvs L24AC
00C3BC 1 C9 3F cmp #$3F
00C3BE 1 D0 04 bne L2484
00C3C0 1 A9 97 lda #TOKEN_PRINT
00C3C2 1 D0 28 bne L24AC
00C3C4 1 L2484:
00C3C4 1 C9 30 cmp #$30
00C3C6 1 90 04 bcc L248C
00C3C8 1 C9 3C cmp #$3C
00C3CA 1 90 20 bcc L24AC
00C3CC 1 ; ----------------------------------------------------------------------------
00C3CC 1 ; SEARCH TOKEN NAME TABLE FOR MATCH STARTING
00C3CC 1 ; WITH CURRENT CHAR FROM INPUT LINE
00C3CC 1 ; ----------------------------------------------------------------------------
00C3CC 1 L248C:
00C3CC 1 84 BA sty STRNG2
00C3CE 1 A0 00 ldy #$00
00C3D0 1 84 5D sty EOLPNTR
00C3D2 1 88 dey
00C3D3 1 86 C3 stx TXTPTR
00C3D5 1 CA dex
00C3D6 1 L2496:
00C3D6 1 C8 iny
00C3D7 1 L2497:
00C3D7 1 E8 inx
00C3D8 1 L2498:
00C3D8 1 B5 00 lda INPUTBUFFERX,x
00C3DA 1 C9 20 cmp #$20
00C3DC 1 F0 F9 beq L2497
00C3DE 1 38 sec
00C3DF 1 F9 84 C0 sbc TOKEN_NAME_TABLE,y
00C3E2 1 F0 F2 beq L2496
00C3E4 1 C9 80 cmp #$80
00C3E6 1 D0 2F bne L24D7
00C3E8 1 05 5D ora EOLPNTR
00C3EA 1 ; ----------------------------------------------------------------------------
00C3EA 1 ; STORE CHARACTER OR TOKEN IN OUTPUT LINE
00C3EA 1 ; ----------------------------------------------------------------------------
00C3EA 1 L24AA:
00C3EA 1 A4 BA ldy STRNG2
00C3EC 1 L24AC:
00C3EC 1 E8 inx
00C3ED 1 C8 iny
00C3EE 1 99 0E 00 sta INPUTBUFFER-5,y
00C3F1 1 B9 0E 00 lda INPUTBUFFER-5,y
00C3F4 1 F0 34 beq L24EA
00C3F6 1 38 sec
00C3F7 1 E9 3A sbc #$3A
00C3F9 1 F0 04 beq L24BF
00C3FB 1 C9 49 cmp #$49
00C3FD 1 D0 02 bne L24C1
00C3FF 1 L24BF:
00C3FF 1 85 60 sta DATAFLG
00C401 1 L24C1:
00C401 1 38 sec
00C402 1 E9 54 sbc #TOKEN_REM-':'
00C404 1 D0 A6 bne L246C
00C406 1 85 5C sta ENDCHR
00C408 1 ; ----------------------------------------------------------------------------
00C408 1 ; HANDLE LITERAL (BETWEEN QUOTES) OR REMARK,
00C408 1 ; BY COPYING CHARS UP TO ENDCHR.
00C408 1 ; ----------------------------------------------------------------------------
00C408 1 L24C8:
00C408 1 B5 00 lda INPUTBUFFERX,x
00C40A 1 F0 E0 beq L24AC
00C40C 1 C5 5C cmp ENDCHR
00C40E 1 F0 DC beq L24AC
00C410 1 L24D0:
00C410 1 C8 iny
00C411 1 99 0E 00 sta INPUTBUFFER-5,y
00C414 1 E8 inx
00C415 1 D0 F1 bne L24C8
00C417 1 ; ----------------------------------------------------------------------------
00C417 1 ; ADVANCE POINTER TO NEXT TOKEN NAME
00C417 1 ; ----------------------------------------------------------------------------
00C417 1 L24D7:
00C417 1 A6 C3 ldx TXTPTR
00C419 1 E6 5D inc EOLPNTR
00C41B 1 L24DB:
00C41B 1 C8 iny
00C41C 1 B9 83 C0 lda MATHTBL+28+1,y
00C41F 1 10 FA bpl L24DB
00C421 1 B9 84 C0 lda TOKEN_NAME_TABLE,y
00C424 1 D0 B2 bne L2498
00C426 1 B5 00 lda INPUTBUFFERX,x
00C428 1 10 C0 bpl L24AA
00C42A 1 ; ---END OF LINE------------------
00C42A 1 L24EA:
00C42A 1 99 10 00 sta INPUTBUFFER-3,y
00C42D 1 A9 12 lda #<INPUTBUFFER-1
00C42F 1 85 C3 sta TXTPTR
00C431 1 60 rts
00C432 1 ; ----------------------------------------------------------------------------
00C432 1 ; SEARCH FOR LINE
00C432 1 ;
00C432 1 ; (LINNUM) = LINE # TO FIND
00C432 1 ; IF NOT FOUND: CARRY = 0
00C432 1 ; LOWTR POINTS AT NEXT LINE
00C432 1 ; IF FOUND: CARRY = 1
00C432 1 ; LOWTR POINTS AT LINE
00C432 1 ; ----------------------------------------------------------------------------
00C432 1 FNDLIN:
00C432 1 A5 79 lda TXTTAB
00C434 1 A6 7A ldx TXTTAB+1
00C436 1 FL1:
00C436 1 A0 01 ldy #$01
00C438 1 85 AA sta LOWTR
00C43A 1 86 AB stx LOWTR+1
00C43C 1 B1 AA lda (LOWTR),y
00C43E 1 F0 1F beq L251F
00C440 1 C8 iny
00C441 1 C8 iny
00C442 1 A5 12 lda LINNUM+1
00C444 1 D1 AA cmp (LOWTR),y
00C446 1 90 18 bcc L2520
00C448 1 F0 03 beq L250D
00C44A 1 88 dey
00C44B 1 D0 09 bne L2516
00C44D 1 L250D:
00C44D 1 A5 11 lda LINNUM
00C44F 1 88 dey
00C450 1 D1 AA cmp (LOWTR),y
00C452 1 90 0C bcc L2520
00C454 1 F0 0A beq L2520
00C456 1 L2516:
00C456 1 88 dey
00C457 1 B1 AA lda (LOWTR),y
00C459 1 AA tax
00C45A 1 88 dey
00C45B 1 B1 AA lda (LOWTR),y
00C45D 1 B0 D7 bcs FL1
00C45F 1 L251F:
00C45F 1 18 clc
00C460 1 L2520:
00C460 1 60 rts
00C461 1 ; ----------------------------------------------------------------------------
00C461 1 ; "NEW" STATEMENT
00C461 1 ; ----------------------------------------------------------------------------
00C461 1 NEW:
00C461 1 D0 FD bne L2520
00C463 1 SCRTCH:
00C463 1 A9 00 lda #$00
00C465 1 A8 tay
00C466 1 91 79 sta (TXTTAB),y
00C468 1 C8 iny
00C469 1 91 79 sta (TXTTAB),y
00C46B 1 A5 79 lda TXTTAB
00C46D 1 69 02 adc #$02
00C46F 1 85 7B sta VARTAB
00C471 1 A5 7A lda TXTTAB+1
00C473 1 69 00 adc #$00
00C475 1 85 7C sta VARTAB+1
00C477 1 ; ----------------------------------------------------------------------------
00C477 1 SETPTRS:
00C477 1 20 A7 C4 jsr STXTPT
00C47A 1 ; ----------------------------------------------------------------------------
00C47A 1 ; "CLEAR" STATEMENT
00C47A 1 ; ----------------------------------------------------------------------------
00C47A 1 CLEARC:
00C47A 1 A5 85 lda MEMSIZ
00C47C 1 A4 86 ldy MEMSIZ+1
00C47E 1 85 81 sta FRETOP
00C480 1 84 82 sty FRETOP+1
00C482 1 A5 7B lda VARTAB
00C484 1 A4 7C ldy VARTAB+1
00C486 1 85 7D sta ARYTAB
00C488 1 84 7E sty ARYTAB+1
00C48A 1 85 7F sta STREND
00C48C 1 84 80 sty STREND+1
00C48E 1 20 1A C6 jsr RESTORE
00C491 1 ; ----------------------------------------------------------------------------
00C491 1 STKINI:
00C491 1 A2 68 ldx #TEMPST
00C493 1 86 65 stx TEMPPT
00C495 1 68 pla
00C496 1 8D FD 01 sta STACK+STACK_TOP+1
00C499 1 68 pla
00C49A 1 8D FE 01 sta STACK+STACK_TOP+2
00C49D 1 A2 FC ldx #STACK_TOP
00C49F 1 9A txs
00C4A0 1 A9 00 lda #$00
00C4A2 1 85 8C sta OLDTEXT+1
00C4A4 1 85 61 sta SUBFLG
00C4A6 1 L256A:
00C4A6 1 60 rts
00C4A7 1 ; ----------------------------------------------------------------------------
00C4A7 1 ; SET TXTPTR TO BEGINNING OF PROGRAM
00C4A7 1 ; ----------------------------------------------------------------------------
00C4A7 1 STXTPT:
00C4A7 1 18 clc
00C4A8 1 A5 79 lda TXTTAB
00C4AA 1 69 FF adc #$FF
00C4AC 1 85 C3 sta TXTPTR
00C4AE 1 A5 7A lda TXTTAB+1
00C4B0 1 69 FF adc #$FF
00C4B2 1 85 C4 sta TXTPTR+1
00C4B4 1 60 rts
00C4B5 1 ; ----------------------------------------------------------------------------
00C4B5 1 ; ----------------------------------------------------------------------------
00C4B5 1 ; "LIST" STATEMENT
00C4B5 1 ; ----------------------------------------------------------------------------
00C4B5 1 LIST:
00C4B5 1 90 06 bcc L2581
00C4B7 1 F0 04 beq L2581
00C4B9 1 C9 A4 cmp #TOKEN_MINUS
00C4BB 1 D0 E9 bne L256A
00C4BD 1 L2581:
00C4BD 1 20 73 C7 jsr LINGET
00C4C0 1 20 32 C4 jsr FNDLIN
00C4C3 1 20 C2 00 jsr CHRGOT
00C4C6 1 F0 0C beq L2598
00C4C8 1 C9 A4 cmp #TOKEN_MINUS
00C4CA 1 D0 94 bne L2520
00C4CC 1 20 BC 00 jsr CHRGET
00C4CF 1 20 73 C7 jsr LINGET
00C4D2 1 D0 8C bne L2520
00C4D4 1 L2598:
00C4D4 1 68 pla
00C4D5 1 68 pla
00C4D6 1 A5 11 lda LINNUM
00C4D8 1 05 12 ora LINNUM+1
00C4DA 1 D0 06 bne L25A6
00C4DC 1 A9 FF lda #$FF
00C4DE 1 85 11 sta LINNUM
00C4E0 1 85 12 sta LINNUM+1
00C4E2 1 L25A6:
00C4E2 1 A0 01 ldy #$01
00C4E4 1 84 60 sty DATAFLG
00C4E6 1 B1 AA lda (LOWTRX),y
00C4E8 1 F0 41 beq L25E5
00C4EA 1 20 29 C6 jsr ISCNTC
00C4ED 1 20 60 C8 jsr CRDO
00C4F0 1 C8 iny
00C4F1 1 B1 AA lda (LOWTRX),y
00C4F3 1 AA tax
00C4F4 1 C8 iny
00C4F5 1 B1 AA lda (LOWTRX),y
00C4F7 1 C5 12 cmp LINNUM+1
00C4F9 1 D0 04 bne L25C1
00C4FB 1 E4 11 cpx LINNUM
00C4FD 1 F0 02 beq L25C3
00C4FF 1 L25C1:
00C4FF 1 B0 2A bcs L25E5
00C501 1 ; ---LIST ONE LINE----------------
00C501 1 L25C3:
00C501 1 84 97 sty FORPNT
00C503 1 20 52 D9 jsr LINPRT
00C506 1 A9 20 lda #$20
00C508 1 L25CA:
00C508 1 A4 97 ldy FORPNT
00C50A 1 29 7F and #$7F
00C50C 1 L25CE:
00C50C 1 20 D9 C8 jsr OUTDO
00C50F 1 C9 22 cmp #$22
00C511 1 D0 06 bne LA519
00C513 1 A5 60 lda DATAFLG
00C515 1 49 FF eor #$FF
00C517 1 85 60 sta DATAFLG
00C519 1 LA519:
00C519 1 C8 iny
00C51A 1 B1 AA lda (LOWTRX),y
00C51C 1 D0 10 bne L25E8
00C51E 1 A8 tay
00C51F 1 B1 AA lda (LOWTRX),y
00C521 1 AA tax
00C522 1 C8 iny
00C523 1 B1 AA lda (LOWTRX),y
00C525 1 86 AA stx LOWTRX
00C527 1 85 AB sta LOWTRX+1
00C529 1 D0 B7 bne L25A6
00C52B 1 L25E5:
00C52B 1 4C 74 C2 jmp RESTART
00C52E 1 L25E8:
00C52E 1 10 DC bpl L25CE
00C530 1 C9 FF cmp #$FF
00C532 1 F0 D8 beq L25CE
00C534 1 24 60 bit DATAFLG
00C536 1 30 D4 bmi L25CE
00C538 1 38 sec
00C539 1 E9 7F sbc #$7F
00C53B 1 AA tax
00C53C 1 84 97 sty FORPNT
00C53E 1 A0 FF ldy #$FF
00C540 1 L25F2:
00C540 1 CA dex
00C541 1 F0 08 beq L25FD
00C543 1 L25F5:
00C543 1 C8 iny
00C544 1 B9 84 C0 lda TOKEN_NAME_TABLE,y
00C547 1 10 FA bpl L25F5
00C549 1 30 F5 bmi L25F2
00C54B 1 L25FD:
00C54B 1 C8 iny
00C54C 1 B9 84 C0 lda TOKEN_NAME_TABLE,y
00C54F 1 30 B7 bmi L25CA
00C551 1 20 D9 C8 jsr OUTDO
00C554 1 D0 F5 bne L25FD ; always
00C556 1 ; ----------------------------------------------------------------------------
00C556 1 ; "FOR" STATEMENT
00C556 1 ;
00C556 1 ; FOR PUSHES 18 BYTES ON THE STACK:
00C556 1 ; 2 -- TXTPTR
00C556 1 ; 2 -- LINE NUMBER
00C556 1 ; 5 -- INITIAL (CURRENT) FOR VARIABLE VALUE
00C556 1 ; 1 -- STEP SIGN
00C556 1 ; 5 -- STEP VALUE
00C556 1 ; 2 -- ADDRESS OF FOR VARIABLE IN VARTAB
00C556 1 ; 1 -- FOR TOKEN ($81)
00C556 1 ; ----------------------------------------------------------------------------
00C556 1 FOR:
00C556 1 A9 80 lda #$80
00C558 1 85 61 sta SUBFLG
00C55A 1 20 AD C7 jsr LET
00C55D 1 20 A1 C1 jsr GTFORPNT
00C560 1 D0 05 bne L2619
00C562 1 8A txa
00C563 1 69 0D adc #FOR_STACK1
00C565 1 AA tax
00C566 1 9A txs
00C567 1 L2619:
00C567 1 68 pla
00C568 1 68 pla
00C569 1 A9 08 lda #FOR_STACK2
00C56B 1 20 12 C2 jsr CHKMEM
00C56E 1 20 0E C7 jsr DATAN
00C571 1 18 clc
00C572 1 98 tya
00C573 1 65 C3 adc TXTPTR
00C575 1 48 pha
00C576 1 A5 C4 lda TXTPTR+1
00C578 1 69 00 adc #$00
00C57A 1 48 pha
00C57B 1 A5 88 lda CURLIN+1
00C57D 1 48 pha
00C57E 1 A5 87 lda CURLIN
00C580 1 48 pha
00C581 1 A9 9D lda #TOKEN_TO
00C583 1 20 F7 CB jsr SYNCHR
00C586 1 20 A4 CA jsr CHKNUM
00C589 1 20 A1 CA jsr FRMNUM
00C58C 1 A5 B0 lda FACSIGN
00C58E 1 09 7F ora #$7F
00C590 1 25 AD and FAC+1
00C592 1 85 AD sta FAC+1
00C594 1 A9 9F lda #<STEP
00C596 1 A0 C5 ldy #>STEP
00C598 1 85 71 sta INDEX
00C59A 1 84 72 sty INDEX+1
00C59C 1 4C 5A CB jmp FRM_STACK3
00C59F 1 ; ----------------------------------------------------------------------------
00C59F 1 ; "STEP" PHRASE OF "FOR" STATEMENT
00C59F 1 ; ----------------------------------------------------------------------------
00C59F 1 STEP:
00C59F 1 A9 90 lda #<CON_ONE
00C5A1 1 A0 D5 ldy #>CON_ONE
00C5A3 1 20 3F D7 jsr LOAD_FAC_FROM_YA
00C5A6 1 20 C2 00 jsr CHRGOT
00C5A9 1 C9 A2 cmp #TOKEN_STEP
00C5AB 1 D0 06 bne L2665
00C5AD 1 20 BC 00 jsr CHRGET
00C5B0 1 20 A1 CA jsr FRMNUM
00C5B3 1 L2665:
00C5B3 1 20 BE D7 jsr SIGN
00C5B6 1 20 4F CB jsr FRM_STACK2
00C5B9 1 A5 98 lda FORPNT+1
00C5BB 1 48 pha
00C5BC 1 A5 97 lda FORPNT
00C5BE 1 48 pha
00C5BF 1 A9 81 lda #$81
00C5C1 1 48 pha
00C5C2 1 ; ----------------------------------------------------------------------------
00C5C2 1 ; PERFORM NEXT STATEMENT
00C5C2 1 ; ----------------------------------------------------------------------------
00C5C2 1 NEWSTT:
00C5C2 1 20 29 C6 jsr ISCNTC
00C5C5 1 A5 C3 lda TXTPTR
00C5C7 1 A4 C4 ldy TXTPTR+1
00C5C9 1 F0 06 beq L2683
00C5CB 1 85 8B sta OLDTEXT
00C5CD 1 84 8C sty OLDTEXT+1
00C5CF 1 A0 00 ldy #$00
00C5D1 1 L2683:
00C5D1 1 B1 C3 lda (TXTPTR),y
00C5D3 1 F0 07 beq LA5DC ; old: 1 cycle more on generic case
00C5D5 1 C9 3A cmp #$3A
00C5D7 1 F0 1D beq NEWSTT2
00C5D9 1 SYNERR1:
00C5D9 1 4C 00 CC jmp SYNERR
00C5DC 1 LA5DC:
00C5DC 1 A0 02 ldy #$02
00C5DE 1 B1 C3 lda (TXTPTR),y
00C5E0 1 18 clc
00C5E1 1 F0 62 beq L2701
00C5E3 1 C8 iny
00C5E4 1 B1 C3 lda (TXTPTR),y
00C5E6 1 85 87 sta CURLIN
00C5E8 1 C8 iny
00C5E9 1 B1 C3 lda (TXTPTR),y
00C5EB 1 85 88 sta CURLIN+1
00C5ED 1 98 tya
00C5EE 1 65 C3 adc TXTPTR
00C5F0 1 85 C3 sta TXTPTR
00C5F2 1 90 02 bcc NEWSTT2
00C5F4 1 E6 C4 inc TXTPTR+1
00C5F6 1 NEWSTT2:
00C5F6 1 20 BC 00 jsr CHRGET
00C5F9 1 20 FF C5 jsr EXECUTE_STATEMENT
00C5FC 1 4C C2 C5 jmp NEWSTT
00C5FF 1 ; ----------------------------------------------------------------------------
00C5FF 1 ; EXECUTE A STATEMENT
00C5FF 1 ;
00C5FF 1 ; (A) IS FIRST CHAR OF STATEMENT
00C5FF 1 ; CARRY IS SET
00C5FF 1 ; ----------------------------------------------------------------------------
00C5FF 1 EXECUTE_STATEMENT:
00C5FF 1 F0 6D beq RET1
00C601 1 38 sec
00C602 1 EXECUTE_STATEMENT1:
00C602 1 E9 80 sbc #$80
00C604 1 B0 03 4C AD jcc LET ; old: 1 cycle more on instr.
00C608 1 C7
00C609 1
00C609 1 C9 1C cmp #NUM_TOKENS
00C60B 1 B0 CC bcs SYNERR1
00C60D 1 0A asl a
00C60E 1 A8 tay
00C60F 1 B9 01 C0 lda TOKEN_ADDRESS_TABLE+1,y
00C612 1 48 pha
00C613 1 B9 00 C0 lda TOKEN_ADDRESS_TABLE,y
00C616 1 48 pha
00C617 1 4C BC 00 jmp CHRGET
00C61A 1 ; ----------------------------------------------------------------------------
00C61A 1 ; "RESTORE" STATEMENT
00C61A 1 ; ----------------------------------------------------------------------------
00C61A 1 RESTORE:
00C61A 1 38 sec
00C61B 1 A5 79 lda TXTTAB
00C61D 1 E9 01 sbc #$01
00C61F 1 A4 7A ldy TXTTAB+1
00C621 1 B0 01 bcs SETDA
00C623 1 88 dey
00C624 1 SETDA:
00C624 1 85 8F sta DATPTR
00C626 1 84 90 sty DATPTR+1
00C628 1 60 rts
00C629 1 ; ----------------------------------------------------------------------------
00C629 1 ; SEE IF CONTROL-C TYPED
00C629 1 ; ----------------------------------------------------------------------------
00C629 1
00C629 1 ISCNTC:
00C629 1 ; MODIFIED CALL BY G.SEARLE FROM THE ORIGINAL OSI CODE
00C629 1 20 49 FF jsr MONISCNTC
00C62C 1 ; runs into "STOP"
00C62C 1 ; ----------------------------------------------------------------------------
00C62C 1 ; "STOP" STATEMENT
00C62C 1 ; ----------------------------------------------------------------------------
00C62C 1 STOP:
00C62C 1 B0 01 bcs END2
00C62E 1 ; ----------------------------------------------------------------------------
00C62E 1 ; "END" STATEMENT
00C62E 1 ; ----------------------------------------------------------------------------
00C62E 1 END:
00C62E 1 18 clc
00C62F 1 END2:
00C62F 1 D0 3D bne RET1
00C631 1 A5 C3 lda TXTPTR
00C633 1 A4 C4 ldy TXTPTR+1
00C635 1 F0 0C beq END4
00C637 1 85 8B sta OLDTEXT
00C639 1 84 8C sty OLDTEXT+1
00C63B 1 CONTROL_C_TYPED:
00C63B 1 A5 87 lda CURLIN
00C63D 1 A4 88 ldy CURLIN+1
00C63F 1 85 89 sta OLDLIN
00C641 1 84 8A sty OLDLIN+1
00C643 1 END4:
00C643 1 68 pla
00C644 1 68 pla
00C645 1 L2701:
00C645 1 A9 99 lda #<QT_BREAK
00C647 1 A0 C1 ldy #>QT_BREAK
00C649 1 A2 00 ldx #$00
00C64B 1 86 64 stx Z14
00C64D 1 90 03 bcc L270E
00C64F 1 4C 69 C2 jmp PRINT_ERROR_LINNUM
00C652 1 L270E:
00C652 1 4C 74 C2 jmp RESTART
00C655 1 ; ----------------------------------------------------------------------------
00C655 1 ; "CONT" COMMAND
00C655 1 ; ----------------------------------------------------------------------------
00C655 1 CONT:
00C655 1 D0 17 bne RET1
00C657 1 A2 1E ldx #ERR_CANTCONT
00C659 1 A4 8C ldy OLDTEXT+1
00C65B 1 D0 03 bne L271C
00C65D 1 4C 4E C2 jmp ERROR
00C660 1 L271C:
00C660 1 A5 8B lda OLDTEXT
00C662 1 85 C3 sta TXTPTR
00C664 1 84 C4 sty TXTPTR+1
00C666 1 A5 89 lda OLDLIN
00C668 1 A4 8A ldy OLDLIN+1
00C66A 1 85 87 sta CURLIN
00C66C 1 84 88 sty CURLIN+1
00C66E 1 RET1:
00C66E 1 60 rts
00C66F 1 NULL:
00C66F 1 20 A2 D3 jsr GETBYT
00C672 1 D0 FA bne RET1
00C674 1 E8 inx
00C675 1 E0 0A cpx #NULL_MAX
00C677 1 B0 04 bcs L2739
00C679 1 CA dex
00C67A 1 86 0D stx Z15
00C67C 1 60 rts
00C67D 1 L2739:
00C67D 1 4C 7C CE jmp IQERR
00C680 1 CLEAR:
00C680 1 D0 EC bne RET1
00C682 1 4C 7A C4 jmp CLEARC
00C685 1 ; ----------------------------------------------------------------------------
00C685 1 ; "RUN" COMMAND
00C685 1 ; ----------------------------------------------------------------------------
00C685 1 RUN:
00C685 1 D0 03 bne L27CF
00C687 1 4C 77 C4 jmp SETPTRS
00C68A 1 L27CF:
00C68A 1 20 7A C4 jsr CLEARC
00C68D 1 4C A4 C6 jmp L27E9
00C690 1 ; ----------------------------------------------------------------------------
00C690 1 ; "GOSUB" STATEMENT
00C690 1 ;
00C690 1 ; LEAVES 7 BYTES ON STACK:
00C690 1 ; 2 -- RETURN ADDRESS (NEWSTT)
00C690 1 ; 2 -- TXTPTR
00C690 1 ; 2 -- LINE #
00C690 1 ; 1 -- GOSUB TOKEN
00C690 1 ; ----------------------------------------------------------------------------
00C690 1 GOSUB:
00C690 1 A9 03 lda #$03
00C692 1 20 12 C2 jsr CHKMEM
00C695 1 A5 C4 lda TXTPTR+1
00C697 1 48 pha
00C698 1 A5 C3 lda TXTPTR
00C69A 1 48 pha
00C69B 1 A5 88 lda CURLIN+1
00C69D 1 48 pha
00C69E 1 A5 87 lda CURLIN
00C6A0 1 48 pha
00C6A1 1 A9 8C lda #TOKEN_GOSUB
00C6A3 1 48 pha
00C6A4 1 L27E9:
00C6A4 1 20 C2 00 jsr CHRGOT
00C6A7 1 20 AD C6 jsr GOTO
00C6AA 1 4C C2 C5 jmp NEWSTT
00C6AD 1 ; ----------------------------------------------------------------------------
00C6AD 1 ; "GOTO" STATEMENT
00C6AD 1 ; ALSO USED BY "RUN" AND "GOSUB"
00C6AD 1 ; ----------------------------------------------------------------------------
00C6AD 1 GOTO:
00C6AD 1 20 73 C7 jsr LINGET
00C6B0 1 20 11 C7 jsr REMN
00C6B3 1 A5 88 lda CURLIN+1
00C6B5 1 C5 12 cmp LINNUM+1
00C6B7 1 B0 0B bcs L2809
00C6B9 1 98 tya
00C6BA 1 38 sec
00C6BB 1 65 C3 adc TXTPTR
00C6BD 1 A6 C4 ldx TXTPTR+1
00C6BF 1 90 07 bcc L280D
00C6C1 1 E8 inx
00C6C2 1 B0 04 bcs L280D
00C6C4 1 L2809:
00C6C4 1 A5 79 lda TXTTAB
00C6C6 1 A6 7A ldx TXTTAB+1
00C6C8 1 L280D:
00C6C8 1 20 36 C4 jsr FL1
00C6CB 1 90 1E bcc UNDERR
00C6CD 1 A5 AA lda LOWTRX
00C6CF 1 E9 01 sbc #$01
00C6D1 1 85 C3 sta TXTPTR
00C6D3 1 A5 AB lda LOWTRX+1
00C6D5 1 E9 00 sbc #$00
00C6D7 1 85 C4 sta TXTPTR+1
00C6D9 1 L281E:
00C6D9 1 60 rts
00C6DA 1 ; ----------------------------------------------------------------------------
00C6DA 1 ; "POP" AND "RETURN" STATEMENTS
00C6DA 1 ; ----------------------------------------------------------------------------
00C6DA 1 POP:
00C6DA 1 D0 FD bne L281E
00C6DC 1 A9 FF lda #$FF
00C6DE 1 85 97 sta FORPNT
00C6E0 1 20 A1 C1 jsr GTFORPNT
00C6E3 1 9A txs
00C6E4 1 C9 8C cmp #TOKEN_GOSUB
00C6E6 1 F0 0B beq RETURN
00C6E8 1 A2 04 ldx #ERR_NOGOSUB
00C6EA 1 2C .byte $2C
00C6EB 1 UNDERR:
00C6EB 1 A2 0E ldx #ERR_UNDEFSTAT
00C6ED 1 4C 4E C2 jmp ERROR
00C6F0 1 ; ----------------------------------------------------------------------------
00C6F0 1 SYNERR2:
00C6F0 1 4C 00 CC jmp SYNERR
00C6F3 1 ; ----------------------------------------------------------------------------
00C6F3 1 RETURN:
00C6F3 1 68 pla
00C6F4 1 68 pla
00C6F5 1 85 87 sta CURLIN
00C6F7 1 68 pla
00C6F8 1 85 88 sta CURLIN+1
00C6FA 1 68 pla
00C6FB 1 85 C3 sta TXTPTR
00C6FD 1 68 pla
00C6FE 1 85 C4 sta TXTPTR+1
00C700 1 ; ----------------------------------------------------------------------------
00C700 1 ; "DATA" STATEMENT
00C700 1 ; EXECUTED BY SKIPPING TO NEXT COLON OR EOL
00C700 1 ; ----------------------------------------------------------------------------
00C700 1 DATA:
00C700 1 20 0E C7 jsr DATAN
00C703 1 ; ----------------------------------------------------------------------------
00C703 1 ; ADD (Y) TO TXTPTR
00C703 1 ; ----------------------------------------------------------------------------
00C703 1 ADDON:
00C703 1 98 tya
00C704 1 18 clc
00C705 1 65 C3 adc TXTPTR
00C707 1 85 C3 sta TXTPTR
00C709 1 90 02 bcc L2852
00C70B 1 E6 C4 inc TXTPTR+1
00C70D 1 L2852:
00C70D 1 60 rts
00C70E 1 ; ----------------------------------------------------------------------------
00C70E 1 ; SCAN AHEAD TO NEXT ":" OR EOL
00C70E 1 ; ----------------------------------------------------------------------------
00C70E 1 DATAN:
00C70E 1 A2 3A ldx #$3A
00C710 1 2C .byte $2C
00C711 1 REMN:
00C711 1 A2 00 ldx #$00
00C713 1 86 5B stx CHARAC
00C715 1 A0 00 ldy #$00
00C717 1 84 5C sty ENDCHR
00C719 1 L285E:
00C719 1 A5 5C lda ENDCHR
00C71B 1 A6 5B ldx CHARAC
00C71D 1 85 5B sta CHARAC
00C71F 1 86 5C stx ENDCHR
00C721 1 L2866:
00C721 1 B1 C3 lda (TXTPTR),y
00C723 1 F0 E8 beq L2852
00C725 1 C5 5C cmp ENDCHR
00C727 1 F0 E4 beq L2852
00C729 1 C8 iny
00C72A 1 C9 22 cmp #$22
00C72C 1 F0 EB beq L285E; old: swap & cont is faster
00C72E 1 D0 F1 bne L2866
00C730 1 ; ----------------------------------------------------------------------------
00C730 1 ; "IF" STATEMENT
00C730 1 ; ----------------------------------------------------------------------------
00C730 1 IF:
00C730 1 20 B5 CA jsr FRMEVL
00C733 1 20 C2 00 jsr CHRGOT
00C736 1 C9 88 cmp #TOKEN_GOTO
00C738 1 F0 05 beq L2884
00C73A 1 A9 A0 lda #TOKEN_THEN
00C73C 1 20 F7 CB jsr SYNCHR
00C73F 1 L2884:
00C73F 1 A5 AC lda FAC
00C741 1 D0 05 bne L288D
00C743 1 ; ----------------------------------------------------------------------------
00C743 1 ; "REM" STATEMENT, OR FALSE "IF" STATEMENT
00C743 1 ; ----------------------------------------------------------------------------
00C743 1 REM:
00C743 1 20 11 C7 jsr REMN
00C746 1 F0 BB beq ADDON
00C748 1 L288D:
00C748 1 20 C2 00 jsr CHRGOT
00C74B 1 B0 03 bcs L2895
00C74D 1 4C AD C6 jmp GOTO
00C750 1 L2895:
00C750 1 4C FF C5 jmp EXECUTE_STATEMENT
00C753 1 ; ----------------------------------------------------------------------------
00C753 1 ; "ON" STATEMENT
00C753 1 ;
00C753 1 ; ON <EXP> GOTO <LIST>
00C753 1 ; ON <EXP> GOSUB <LIST>
00C753 1 ; ----------------------------------------------------------------------------
00C753 1 ON:
00C753 1 20 A2 D3 jsr GETBYT
00C756 1 48 pha
00C757 1 C9 8C cmp #TOKEN_GOSUB
00C759 1 F0 04 beq L28A4
00C75B 1 L28A0:
00C75B 1 C9 88 cmp #TOKEN_GOTO
00C75D 1 D0 91 bne SYNERR2
00C75F 1 L28A4:
00C75F 1 C6 AF dec FAC_LAST
00C761 1 D0 04 bne L28AC
00C763 1 68 pla
00C764 1 4C 02 C6 jmp EXECUTE_STATEMENT1
00C767 1 L28AC:
00C767 1 20 BC 00 jsr CHRGET
00C76A 1 20 73 C7 jsr LINGET
00C76D 1 C9 2C cmp #$2C
00C76F 1 F0 EE beq L28A4
00C771 1 68 pla
00C772 1 L28B7:
00C772 1 60 rts
00C773 1 ; ----------------------------------------------------------------------------
00C773 1 ; CONVERT LINE NUMBER
00C773 1 ; ----------------------------------------------------------------------------
00C773 1 LINGET:
00C773 1 A2 00 ldx #$00
00C775 1 86 11 stx LINNUM
00C777 1 86 12 stx LINNUM+1
00C779 1 L28BE:
00C779 1 B0 F7 bcs L28B7
00C77B 1 E9 2F sbc #$2F
00C77D 1 85 5B sta CHARAC
00C77F 1 A5 12 lda LINNUM+1
00C781 1 85 71 sta INDEX
00C783 1 C9 19 cmp #$19
00C785 1 B0 D4 bcs L28A0
00C787 1 ; <<<<<DANGEROUS CODE>>>>>
00C787 1 ; NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
00C787 1 ; ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC
00C787 1 ; JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
00C787 1 ; FOR OTHER CALLS TO LINGET.
00C787 1 ;
00C787 1 ; YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
00C787 1 ; THEN TYPE "GO TO 437761".
00C787 1 ;
00C787 1 ; ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
00C787 1 ; THE PROBLEM. ($AB00 - $ABFF)
00C787 1 ; <<<<<DANGEROUS CODE>>>>>
00C787 1 A5 11 lda LINNUM
00C789 1 0A asl a
00C78A 1 26 71 rol INDEX
00C78C 1 0A asl a
00C78D 1 26 71 rol INDEX
00C78F 1 65 11 adc LINNUM
00C791 1 85 11 sta LINNUM
00C793 1 A5 71 lda INDEX
00C795 1 65 12 adc LINNUM+1
00C797 1 85 12 sta LINNUM+1
00C799 1 06 11 asl LINNUM
00C79B 1 26 12 rol LINNUM+1
00C79D 1 A5 11 lda LINNUM
00C79F 1 65 5B adc CHARAC
00C7A1 1 85 11 sta LINNUM
00C7A3 1 90 02 bcc L28EC
00C7A5 1 E6 12 inc LINNUM+1
00C7A7 1 L28EC:
00C7A7 1 20 BC 00 jsr CHRGET
00C7AA 1 4C 79 C7 jmp L28BE
00C7AD 1 ; ----------------------------------------------------------------------------
00C7AD 1 ; "LET" STATEMENT
00C7AD 1 ;
00C7AD 1 ; LET <VAR> = <EXP>
00C7AD 1 ; <VAR> = <EXP>
00C7AD 1 ; ----------------------------------------------------------------------------
00C7AD 1 LET:
00C7AD 1 20 FF CC jsr PTRGET
00C7B0 1 85 97 sta FORPNT
00C7B2 1 84 98 sty FORPNT+1
00C7B4 1 A9 AB lda #TOKEN_EQUAL
00C7B6 1 20 F7 CB jsr SYNCHR
00C7B9 1 A5 5F lda VALTYP
00C7BB 1 48 pha
00C7BC 1 20 B5 CA jsr FRMEVL
00C7BF 1 68 pla
00C7C0 1 2A rol a
00C7C1 1 20 A7 CA jsr CHKVAL
00C7C4 1 D0 03 bne LETSTRING
00C7C6 1 ; ----------------------------------------------------------------------------
00C7C6 1 ; REAL VARIABLE = EXPRESSION
00C7C6 1 ; ----------------------------------------------------------------------------
00C7C6 1 4C 68 D7 jmp SETFOR
00C7C9 1 LETSTRING:
00C7C9 1 ; ----------------------------------------------------------------------------
00C7C9 1 ; INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4
00C7C9 1 ; ----------------------------------------------------------------------------
00C7C9 1 A0 02 ldy #$02
00C7CB 1 B1 AE lda (FAC_LAST-1),y
00C7CD 1 C5 82 cmp FRETOP+1
00C7CF 1 90 17 bcc L2946
00C7D1 1 D0 07 bne L2938
00C7D3 1 88 dey
00C7D4 1 B1 AE lda (FAC_LAST-1),y
00C7D6 1 C5 81 cmp FRETOP
00C7D8 1 90 0E bcc L2946
00C7DA 1 L2938:
00C7DA 1 A4 AF ldy FAC_LAST
00C7DC 1 C4 7C cpy VARTAB+1
00C7DE 1 90 08 bcc L2946
00C7E0 1 D0 0D bne L294D
00C7E2 1 A5 AE lda FAC_LAST-1
00C7E4 1 C5 7B cmp VARTAB
00C7E6 1 B0 07 bcs L294D
00C7E8 1 L2946:
00C7E8 1 A5 AE lda FAC_LAST-1
00C7EA 1 A4 AF ldy FAC_LAST
00C7EC 1 4C 05 C8 jmp L2963
00C7EF 1 L294D:
00C7EF 1 A0 00 ldy #$00
00C7F1 1 B1 AE lda (FAC_LAST-1),y
00C7F3 1 20 90 D0 jsr STRINI
00C7F6 1 A5 9E lda DSCPTR
00C7F8 1 A4 9F ldy DSCPTR+1
00C7FA 1 85 B8 sta STRNG1
00C7FC 1 84 B9 sty STRNG1+1
00C7FE 1 20 7E D2 jsr MOVINS
00C801 1 A9 AC lda #FAC
00C803 1 A0 00 ldy #$00
00C805 1 L2963:
00C805 1 85 9E sta DSCPTR
00C807 1 84 9F sty DSCPTR+1
00C809 1 20 DF D2 jsr FRETMS
00C80C 1 A0 00 ldy #$00
00C80E 1 B1 9E lda (DSCPTR),y
00C810 1 91 97 sta (FORPNT),y
00C812 1 C8 iny
00C813 1 B1 9E lda (DSCPTR),y
00C815 1 91 97 sta (FORPNT),y
00C817 1 C8 iny
00C818 1 B1 9E lda (DSCPTR),y
00C81A 1 91 97 sta (FORPNT),y
00C81C 1 60 rts
00C81D 1 PRSTRING:
00C81D 1 20 BA C8 jsr STRPRT
00C820 1 L297E:
00C820 1 20 C2 00 jsr CHRGOT
00C823 1 ; ----------------------------------------------------------------------------
00C823 1 ; "PRINT" STATEMENT
00C823 1 ; ----------------------------------------------------------------------------
00C823 1 PRINT:
00C823 1 F0 3B beq CRDO
00C825 1 PRINT2:
00C825 1 F0 57 beq L29DD
00C827 1 C9 9C cmp #TOKEN_TAB
00C829 1 F0 6B beq L29F5
00C82B 1 C9 9F cmp #TOKEN_SPC
00C82D 1 F0 67 beq L29F5
00C82F 1 C9 2C cmp #','
00C831 1 F0 4C beq L29DE
00C833 1 C9 3B cmp #$3B
00C835 1 F0 7A beq L2A0D
00C837 1 20 B5 CA jsr FRMEVL
00C83A 1 24 5F bit VALTYP
00C83C 1 30 DF bmi PRSTRING
00C83E 1 20 62 D9 jsr FOUT
00C841 1 20 A2 D0 jsr STRLIT
00C844 1 A0 00 ldy #$00
00C846 1 B1 AE lda (FAC_LAST-1),y
00C848 1 18 clc
00C849 1 65 0E adc POSX
00C84B 1 C5 0F cmp Z17
00C84D 1 90 03 bcc L29B1
00C84F 1 20 60 C8 jsr CRDO
00C852 1 L29B1:
00C852 1 20 BA C8 jsr STRPRT
00C855 1 20 D4 C8 jsr OUTSP
00C858 1 D0 C6 bne L297E ; branch always
00C85A 1 L29B9:
00C85A 1 A0 00 ldy #$00
00C85C 1 94 13 sty INPUTBUFFER,x
00C85E 1 A2 12 ldx #LINNUM+1
00C860 1 CRDO:
00C860 1 A9 0D lda #CRLF_1
00C862 1 85 0E sta POSX
00C864 1 20 D9 C8 jsr OUTDO
00C867 1 A9 0A lda #CRLF_2
00C869 1 20 D9 C8 jsr OUTDO
00C86C 1 PRINTNULLS:
00C86C 1 8A txa
00C86D 1 48 pha
00C86E 1 A6 0D ldx Z15
00C870 1 F0 08 beq L29D9
00C872 1 A9 00 lda #$00
00C874 1 L29D3:
00C874 1 20 D9 C8 jsr OUTDO
00C877 1 CA dex
00C878 1 D0 FA bne L29D3
00C87A 1 L29D9:
00C87A 1 86 0E stx POSX
00C87C 1 68 pla
00C87D 1 AA tax
00C87E 1 L29DD:
00C87E 1 60 rts
00C87F 1 L29DE:
00C87F 1 A5 0E lda POSX
00C881 1 C5 10 cmp Z18
00C883 1 90 06 bcc L29EA
00C885 1 20 60 C8 jsr CRDO
00C888 1 4C B1 C8 jmp L2A0D
00C88B 1 L29EA:
00C88B 1 38 sec
00C88C 1 L29EB:
00C88C 1 E9 0E sbc #$0E
00C88E 1 B0 FC bcs L29EB
00C890 1 49 FF eor #$FF
00C892 1 69 01 adc #$01
00C894 1 D0 14 bne L2A08
00C896 1 L29F5:
00C896 1 48 pha
00C897 1 20 9F D3 jsr GTBYTC
00C89A 1 C9 29 cmp #')'
00C89C 1 D0 66 bne SYNERR4
00C89E 1 68 pla
00C89F 1 C9 9C cmp #TOKEN_TAB
00C8A1 1 D0 08 bne L2A0A
00C8A3 1 8A txa
00C8A4 1 E5 0E sbc POSX
00C8A6 1 90 09 bcc L2A0D
00C8A8 1 F0 07 beq L2A0D
00C8AA 1 L2A08:
00C8AA 1 AA tax
00C8AB 1 L2A0A:
00C8AB 1 20 D4 C8 jsr OUTSP
00C8AE 1 CA dex
00C8AF 1 D0 FA bne L2A0A
00C8B1 1 L2A0D:
00C8B1 1 20 BC 00 jsr CHRGET
00C8B4 1 4C 25 C8 jmp PRINT2
00C8B7 1 ; ----------------------------------------------------------------------------
00C8B7 1 ; PRINT STRING AT (Y,A)
00C8B7 1 ; ----------------------------------------------------------------------------
00C8B7 1 STROUT:
00C8B7 1 20 A2 D0 jsr STRLIT
00C8BA 1 ; ----------------------------------------------------------------------------
00C8BA 1 ; PRINT STRING AT (FACMO,FACLO)
00C8BA 1 ; ----------------------------------------------------------------------------
00C8BA 1 STRPRT:
00C8BA 1 20 AA D2 jsr FREFAC
00C8BD 1 AA tax
00C8BE 1 A0 00 ldy #$00
00C8C0 1 E8 inx
00C8C1 1 L2A22:
00C8C1 1 CA dex
00C8C2 1 F0 BA beq L29DD
00C8C4 1 B1 71 lda (INDEX),y
00C8C6 1 20 D9 C8 jsr OUTDO
00C8C9 1 C8 iny
00C8CA 1 C9 0D cmp #$0D
00C8CC 1 D0 F3 bne L2A22
00C8CE 1 20 6C C8 jsr PRINTNULLS
00C8D1 1 4C C1 C8 jmp L2A22
00C8D4 1 ; ----------------------------------------------------------------------------
00C8D4 1 OUTSP:
00C8D4 1 A9 20 lda #$20
00C8D6 1 2C .byte $2C
00C8D7 1 OUTQUES:
00C8D7 1 A9 3F lda #$3F
00C8D9 1 ; ----------------------------------------------------------------------------
00C8D9 1 ; PRINT CHAR FROM (A)
00C8D9 1 ; ----------------------------------------------------------------------------
00C8D9 1 OUTDO:
00C8D9 1 24 64 bit Z14
00C8DB 1 30 18 bmi L2A56
00C8DD 1 ; Commodore forgot to remove this in CBM1
00C8DD 1 48 pha
00C8DE 1 C9 20 cmp #$20
00C8E0 1 90 0B bcc L2A4E
00C8E2 1 A5 0E lda POSX
00C8E4 1 C5 0F cmp Z17
00C8E6 1 D0 03 bne L2A4C
00C8E8 1 20 60 C8 jsr CRDO
00C8EB 1 L2A4C:
00C8EB 1 E6 0E inc POSX
00C8ED 1 L2A4E:
00C8ED 1 ; Commodore forgot to remove this in CBM1
00C8ED 1 68 pla
00C8EE 1 20 2A FF jsr MONCOUT
00C8F1 1 EA nop
00C8F2 1 EA nop
00C8F3 1 EA nop
00C8F4 1 EA nop
00C8F5 1 L2A56:
00C8F5 1 29 FF and #$FF
00C8F7 1 60 rts
00C8F8 1 ; ----------------------------------------------------------------------------
00C8F8 1 ; ???
00C8F8 1 ; ----------------------------------------------------------------------------
00C8F8 1 ; ----------------------------------------------------------------------------
00C8F8 1 ; INPUT CONVERSION ERROR: ILLEGAL CHARACTER
00C8F8 1 ; IN NUMERIC FIELD. MUST DISTINGUISH
00C8F8 1 ; BETWEEN INPUT, READ, AND GET
00C8F8 1 ; ----------------------------------------------------------------------------
00C8F8 1 INPUTERR:
00C8F8 1 A5 62 lda INPUTFLG
00C8FA 1 F0 0B beq RESPERR ; INPUT
00C8FC 1 ; without this, it treats GET errors
00C8FC 1 ; like READ errors
00C8FC 1 A5 8D lda Z8C
00C8FE 1 A4 8E ldy Z8C+1
00C900 1 85 87 sta CURLIN
00C902 1 84 88 sty CURLIN+1
00C904 1 SYNERR4:
00C904 1 4C 00 CC jmp SYNERR
00C907 1 RESPERR:
00C907 1 A9 21 lda #<ERRREENTRY
00C909 1 A0 CA ldy #>ERRREENTRY
00C90B 1 20 B7 C8 jsr STROUT
00C90E 1 A5 8B lda OLDTEXT
00C910 1 A4 8C ldy OLDTEXT+1
00C912 1 85 C3 sta TXTPTR
00C914 1 84 C4 sty TXTPTR+1
00C916 1 60 rts
00C917 1 ; ----------------------------------------------------------------------------
00C917 1 ; "GET" STATEMENT
00C917 1 ; ----------------------------------------------------------------------------
00C917 1 GET:
00C917 1 ; ----------------------------------------------------------------------------
00C917 1 ; "INPUT#" STATEMENT
00C917 1 ; ----------------------------------------------------------------------------
00C917 1 ; ----------------------------------------------------------------------------
00C917 1 ; "INPUT" STATEMENT
00C917 1 ; ----------------------------------------------------------------------------
00C917 1 INPUT:
00C917 1 46 64 lsr Z14
00C919 1 C9 22 cmp #$22
00C91B 1 D0 0B bne L2A9E
00C91D 1 20 B5 CB jsr STRTXT
00C920 1 A9 3B lda #$3B
00C922 1 20 F7 CB jsr SYNCHR
00C925 1 20 BA C8 jsr STRPRT
00C928 1 L2A9E:
00C928 1 20 C8 CF jsr ERRDIR
00C92B 1 A9 2C lda #$2C
00C92D 1 85 12 sta INPUTBUFFER-1
00C92F 1 20 3A C9 jsr NXIN
00C932 1 A5 13 lda INPUTBUFFER
00C934 1 D0 12 bne L2ABE
00C936 1 18 clc
00C937 1 4C 3B C6 jmp CONTROL_C_TYPED
00C93A 1 NXIN:
00C93A 1 20 D7 C8 jsr OUTQUES ; '?'
00C93D 1 20 D4 C8 jsr OUTSP
00C940 1 4C 57 C3 jmp INLIN
00C943 1 ; ----------------------------------------------------------------------------
00C943 1 ; "GETC" STATEMENT
00C943 1 ; ----------------------------------------------------------------------------
00C943 1 ; ----------------------------------------------------------------------------
00C943 1 ; "READ" STATEMENT
00C943 1 ; ----------------------------------------------------------------------------
00C943 1 READ:
00C943 1 A6 8F ldx DATPTR
00C945 1 A4 90 ldy DATPTR+1
00C947 1 ; AppleSoft II, too
00C947 1 A9 .byte $A9 ; LDA #$98
00C948 1 L2ABE:
00C948 1 98 tya
00C949 1 ; ----------------------------------------------------------------------------
00C949 1 ; PROCESS INPUT LIST
00C949 1 ;
00C949 1 ; (Y,X) IS ADDRESS OF INPUT DATA STRING
00C949 1 ; (A) = VALUE FOR INPUTFLG: $00 FOR INPUT
00C949 1 ; $40 FOR GET
00C949 1 ; $98 FOR READ
00C949 1 ; ----------------------------------------------------------------------------
00C949 1 85 62 sta INPUTFLG
00C94B 1 86 91 stx INPTR
00C94D 1 84 92 sty INPTR+1
00C94F 1 PROCESS_INPUT_ITEM:
00C94F 1 20 FF CC jsr PTRGET
00C952 1 85 97 sta FORPNT
00C954 1 84 98 sty FORPNT+1
00C956 1 A5 C3 lda TXTPTR
00C958 1 A4 C4 ldy TXTPTR+1
00C95A 1 85 11 sta TXPSV
00C95C 1 84 12 sty TXPSV+1
00C95E 1 A6 91 ldx INPTR
00C960 1 A4 92 ldy INPTR+1
00C962 1 86 C3 stx TXTPTR
00C964 1 84 C4 sty TXTPTR+1
00C966 1 20 C2 00 jsr CHRGOT
00C969 1 D0 0E bne INSTART
00C96B 1 24 62 bit INPUTFLG
00C96D 1 ; BUG: The beq/bne L2AF8 below is supposed
00C96D 1 ; to be always taken. For this to happen,
00C96D 1 ; the last load must be a 0 for beq
00C96D 1 ; and != 0 for bne. The original Microsoft
00C96D 1 ; code had ldx/ldy/bne here, which was only
00C96D 1 ; correct for a non-ZP INPUTBUFFER. Commodore
00C96D 1 ; fixed it in CBMBASIC V1 by swapping the
00C96D 1 ; ldx and the ldy. It was broken on KIM,
00C96D 1 ; but okay on APPLE and CBM2, because
00C96D 1 ; these used a non-ZP INPUTBUFFER.
00C96D 1 ; Microsoft fixed this somewhere after KIM
00C96D 1 ; and before MICROTAN, by using beq instead
00C96D 1 ; of bne in the ZP case.
00C96D 1 30 62 bmi FINDATA
00C96F 1 20 D7 C8 jsr OUTQUES
00C972 1 20 3A C9 jsr NXIN
00C975 1 86 C3 stx TXTPTR
00C977 1 84 C4 sty TXTPTR+1
00C979 1 ; ----------------------------------------------------------------------------
00C979 1 INSTART:
00C979 1 20 BC 00 jsr CHRGET
00C97C 1 24 5F bit VALTYP
00C97E 1 10 24 bpl L2B34
00C980 1 85 5B sta CHARAC
00C982 1 C9 22 cmp #$22
00C984 1 F0 07 beq L2B1D
00C986 1 A9 3A lda #$3A
00C988 1 85 5B sta CHARAC
00C98A 1 A9 2C lda #$2C
00C98C 1 18 clc
00C98D 1 L2B1D:
00C98D 1 85 5C sta ENDCHR
00C98F 1 A5 C3 lda TXTPTR
00C991 1 A4 C4 ldy TXTPTR+1
00C993 1 69 00 adc #$00
00C995 1 90 01 bcc L2B28
00C997 1 C8 iny
00C998 1 L2B28:
00C998 1 20 A8 D0 jsr STRLT2
00C99B 1 20 E7 D3 jsr POINT
00C99E 1 20 C9 C7 jsr LETSTRING
00C9A1 1 4C AA C9 jmp INPUT_MORE
00C9A4 1 ; ----------------------------------------------------------------------------
00C9A4 1 L2B34:
00C9A4 1 20 7B D8 jsr FIN
00C9A7 1 20 68 D7 jsr SETFOR
00C9AA 1 ; ----------------------------------------------------------------------------
00C9AA 1 INPUT_MORE:
00C9AA 1 20 C2 00 jsr CHRGOT
00C9AD 1 F0 07 beq L2B48
00C9AF 1 C9 2C cmp #$2C
00C9B1 1 F0 03 beq L2B48
00C9B3 1 4C F8 C8 jmp INPUTERR
00C9B6 1 L2B48:
00C9B6 1 A5 C3 lda TXTPTR
00C9B8 1 A4 C4 ldy TXTPTR+1
00C9BA 1 85 91 sta INPTR
00C9BC 1 84 92 sty INPTR+1
00C9BE 1 A5 11 lda TXPSV
00C9C0 1 A4 12 ldy TXPSV+1
00C9C2 1 85 C3 sta TXTPTR
00C9C4 1 84 C4 sty TXTPTR+1
00C9C6 1 20 C2 00 jsr CHRGOT
00C9C9 1 F0 2C beq INPDONE
00C9CB 1 20 F5 CB jsr CHKCOM
00C9CE 1 4C 4F C9 jmp PROCESS_INPUT_ITEM
00C9D1 1 ; ----------------------------------------------------------------------------
00C9D1 1 FINDATA:
00C9D1 1 20 0E C7 jsr DATAN
00C9D4 1 C8 iny
00C9D5 1 AA tax
00C9D6 1 D0 12 bne L2B7C
00C9D8 1 A2 06 ldx #ERR_NODATA
00C9DA 1 C8 iny
00C9DB 1 B1 C3 lda (TXTPTR),y
00C9DD 1 F0 69 beq GERR
00C9DF 1 C8 iny
00C9E0 1 B1 C3 lda (TXTPTR),y
00C9E2 1 85 8D sta Z8C
00C9E4 1 C8 iny
00C9E5 1 B1 C3 lda (TXTPTR),y
00C9E7 1 C8 iny
00C9E8 1 85 8E sta Z8C+1
00C9EA 1 L2B7C:
00C9EA 1 B1 C3 lda (TXTPTR),y
00C9EC 1 AA tax
00C9ED 1 20 03 C7 jsr ADDON
00C9F0 1 E0 83 cpx #$83
00C9F2 1 D0 DD bne FINDATA
00C9F4 1 4C 79 C9 jmp INSTART
00C9F7 1 ; ---NO MORE INPUT REQUESTED------
00C9F7 1 INPDONE:
00C9F7 1 A5 91 lda INPTR
00C9F9 1 A4 92 ldy INPTR+1
00C9FB 1 A6 62 ldx INPUTFLG
00C9FD 1 F0 03 beq L2B94 ; INPUT
00C9FF 1 4C 24 C6 jmp SETDA
00CA02 1 L2B94:
00CA02 1 A0 00 ldy #$00
00CA04 1 B1 91 lda (INPTR),y
00CA06 1 F0 07 beq L2BA1
00CA08 1 A9 10 lda #<ERREXTRA
00CA0A 1 A0 CA ldy #>ERREXTRA
00CA0C 1 4C B7 C8 jmp STROUT
00CA0F 1 L2BA1:
00CA0F 1 60 rts
00CA10 1 ; ----------------------------------------------------------------------------
00CA10 1 ERREXTRA:
00CA10 1 3F 45 58 54 .byte "?EXTRA IGNORED"
00CA14 1 52 41 20 49
00CA18 1 47 4E 4F 52
00CA1E 1
00CA1E 1
00CA1E 1 0D 0A 00 .byte $0D,$0A,$00
00CA21 1 ERRREENTRY:
00CA21 1 3F 52 45 44 .byte "?REDO FROM START"
00CA25 1 4F 20 46 52
00CA29 1 4F 4D 20 53
00CA31 1
00CA31 1
00CA31 1 0D 0A 00 .byte $0D,$0A,$00
00CA34 1 ; ----------------------------------------------------------------------------
00CA34 1 ; "NEXT" STATEMENT
00CA34 1 ; ----------------------------------------------------------------------------
00CA34 1 NEXT:
00CA34 1 D0 04 bne NEXT1
00CA36 1 A0 00 ldy #$00
00CA38 1 F0 03 beq NEXT2
00CA3A 1 NEXT1:
00CA3A 1 20 FF CC jsr PTRGET
00CA3D 1 NEXT2:
00CA3D 1 85 97 sta FORPNT
00CA3F 1 84 98 sty FORPNT+1
00CA41 1 20 A1 C1 jsr GTFORPNT
00CA44 1 F0 04 beq NEXT3
00CA46 1 A2 00 ldx #$00
00CA48 1 GERR:
00CA48 1 F0 68 beq JERROR
00CA4A 1 NEXT3:
00CA4A 1 9A txs
00CA4B 1 E8 inx
00CA4C 1 E8 inx
00CA4D 1 E8 inx
00CA4E 1 E8 inx
00CA4F 1 8A txa
00CA50 1 E8 inx
00CA51 1 E8 inx
00CA52 1 E8 inx
00CA53 1 E8 inx
00CA54 1 E8 inx
00CA55 1 86 73 stx DEST
00CA57 1 A0 01 ldy #>STACK
00CA59 1 20 3F D7 jsr LOAD_FAC_FROM_YA
00CA5C 1 BA tsx
00CA5D 1 BD 08 01 lda STACK+BYTES_FP+4,x
00CA60 1 85 B0 sta FACSIGN
00CA62 1 A5 97 lda FORPNT
00CA64 1 A4 98 ldy FORPNT+1
00CA66 1 20 60 D4 jsr FADD
00CA69 1 20 68 D7 jsr SETFOR
00CA6C 1 A0 01 ldy #>STACK
00CA6E 1 20 EE D7 jsr FCOMP2
00CA71 1 BA tsx
00CA72 1 38 sec
00CA73 1 FD 08 01 sbc STACK+BYTES_FP+4,x
00CA76 1 F0 17 beq L2C22
00CA78 1 BD 0D 01 lda STACK+2*BYTES_FP+5,x
00CA7B 1 85 87 sta CURLIN
00CA7D 1 BD 0E 01 lda STACK+2*BYTES_FP+6,x
00CA80 1 85 88 sta CURLIN+1
00CA82 1 BD 10 01 lda STACK+2*BYTES_FP+8,x
00CA85 1 85 C3 sta TXTPTR
00CA87 1 BD 0F 01 lda STACK+2*BYTES_FP+7,x
00CA8A 1 85 C4 sta TXTPTR+1
00CA8C 1 L2C1F:
00CA8C 1 4C C2 C5 jmp NEWSTT
00CA8F 1 L2C22:
00CA8F 1 8A txa
00CA90 1 69 0F adc #2*BYTES_FP+7
00CA92 1 AA tax
00CA93 1 9A txs
00CA94 1 20 C2 00 jsr CHRGOT
00CA97 1 C9 2C cmp #$2C
00CA99 1 D0 F1 bne L2C1F
00CA9B 1 20 BC 00 jsr CHRGET
00CA9E 1 20 3A CA jsr NEXT1
00CAA1 1 ; ----------------------------------------------------------------------------
00CAA1 1 ; EVALUATE EXPRESSION, MAKE SURE IT IS NUMERIC
00CAA1 1 ; ----------------------------------------------------------------------------
00CAA1 1 FRMNUM:
00CAA1 1 20 B5 CA jsr FRMEVL
00CAA4 1 ; ----------------------------------------------------------------------------
00CAA4 1 ; MAKE SURE (FAC) IS NUMERIC
00CAA4 1 ; ----------------------------------------------------------------------------
00CAA4 1 CHKNUM:
00CAA4 1 18 clc
00CAA5 1 24 .byte $24
00CAA6 1 ; ----------------------------------------------------------------------------
00CAA6 1 ; MAKE SURE (FAC) IS STRING
00CAA6 1 ; ----------------------------------------------------------------------------
00CAA6 1 CHKSTR:
00CAA6 1 38 sec
00CAA7 1 ; ----------------------------------------------------------------------------
00CAA7 1 ; MAKE SURE (FAC) IS CORRECT TYPE
00CAA7 1 ; IF C=0, TYPE MUST BE NUMERIC
00CAA7 1 ; IF C=1, TYPE MUST BE STRING
00CAA7 1 ; ----------------------------------------------------------------------------
00CAA7 1 CHKVAL:
00CAA7 1 24 5F bit VALTYP
00CAA9 1 30 03 bmi L2C41
00CAAB 1 B0 03 bcs L2C43
00CAAD 1 L2C40:
00CAAD 1 60 rts
00CAAE 1 L2C41:
00CAAE 1 B0 FD bcs L2C40
00CAB0 1 L2C43:
00CAB0 1 A2 18 ldx #ERR_BADTYPE
00CAB2 1 JERROR:
00CAB2 1 4C 4E C2 jmp ERROR
00CAB5 1 ; ----------------------------------------------------------------------------
00CAB5 1 ; EVALUATE THE EXPRESSION AT TXTPTR, LEAVING THE
00CAB5 1 ; RESULT IN FAC. WORKS FOR BOTH STRING AND NUMERIC
00CAB5 1 ; EXPRESSIONS.
00CAB5 1 ; ----------------------------------------------------------------------------
00CAB5 1 FRMEVL:
00CAB5 1 A6 C3 ldx TXTPTR
00CAB7 1 D0 02 bne L2C4E
00CAB9 1 C6 C4 dec TXTPTR+1
00CABB 1 L2C4E:
00CABB 1 C6 C3 dec TXTPTR
00CABD 1 A2 00 ldx #$00
00CABF 1 24 .byte $24
00CAC0 1 FRMEVL1:
00CAC0 1 48 pha
00CAC1 1 8A txa
00CAC2 1 48 pha
00CAC3 1 A9 01 lda #$01
00CAC5 1 20 12 C2 jsr CHKMEM
00CAC8 1 20 94 CB jsr FRM_ELEMENT
00CACB 1 A9 00 lda #$00
00CACD 1 85 9B sta CPRTYP
00CACF 1 FRMEVL2:
00CACF 1 20 C2 00 jsr CHRGOT
00CAD2 1 L2C65:
00CAD2 1 38 sec
00CAD3 1 E9 AA sbc #TOKEN_GREATER
00CAD5 1 90 17 bcc L2C81
00CAD7 1 C9 03 cmp #$03
00CAD9 1 B0 13 bcs L2C81
00CADB 1 C9 01 cmp #$01
00CADD 1 2A rol a
00CADE 1 49 01 eor #$01
00CAE0 1 45 9B eor CPRTYP
00CAE2 1 C5 9B cmp CPRTYP
00CAE4 1 90 61 bcc SNTXERR
00CAE6 1 85 9B sta CPRTYP
00CAE8 1 20 BC 00 jsr CHRGET
00CAEB 1 4C D2 CA jmp L2C65
00CAEE 1 L2C81:
00CAEE 1 A6 9B ldx CPRTYP
00CAF0 1 D0 2C bne FRM_RELATIONAL
00CAF2 1 B0 78 bcs L2D02
00CAF4 1 69 07 adc #$07
00CAF6 1 90 74 bcc L2D02
00CAF8 1 65 5F adc VALTYP
00CAFA 1 D0 03 bne L2C92
00CAFC 1 4C 41 D2 jmp CAT
00CAFF 1 L2C92:
00CAFF 1 69 FF adc #$FF
00CB01 1 85 71 sta INDEX
00CB03 1 0A asl a
00CB04 1 65 71 adc INDEX
00CB06 1 A8 tay
00CB07 1 FRM_PRECEDENCE_TEST:
00CB07 1 68 pla
00CB08 1 D9 66 C0 cmp MATHTBL,y
00CB0B 1 B0 64 bcs FRM_PERFORM1
00CB0D 1 20 A4 CA jsr CHKNUM
00CB10 1 L2CA3:
00CB10 1 48 pha
00CB11 1 L2CA4:
00CB11 1 20 37 CB jsr FRM_RECURSE
00CB14 1 68 pla
00CB15 1 A4 99 ldy LASTOP
00CB17 1 10 17 bpl PREFNC
00CB19 1 AA tax
00CB1A 1 F0 53 beq GOEX
00CB1C 1 D0 5C bne FRM_PERFORM2
00CB1E 1 ; ----------------------------------------------------------------------------
00CB1E 1 ; FOUND ONE OR MORE RELATIONAL OPERATORS <,=,>
00CB1E 1 ; ----------------------------------------------------------------------------
00CB1E 1 FRM_RELATIONAL:
00CB1E 1 46 5F lsr VALTYP
00CB20 1 8A txa
00CB21 1 2A rol a
00CB22 1 A6 C3 ldx TXTPTR
00CB24 1 D0 02 bne L2CBB
00CB26 1 C6 C4 dec TXTPTR+1
00CB28 1 L2CBB:
00CB28 1 C6 C3 dec TXTPTR
00CB2A 1 A0 1B ldy #$1B
00CB2C 1 85 9B sta CPRTYP
00CB2E 1 D0 D7 bne FRM_PRECEDENCE_TEST
00CB30 1 PREFNC:
00CB30 1 D9 66 C0 cmp MATHTBL,y
00CB33 1 B0 45 bcs FRM_PERFORM2
00CB35 1 90 D9 bcc L2CA3
00CB37 1 ; ----------------------------------------------------------------------------
00CB37 1 ; STACK THIS OPERATION AND CALL FRMEVL FOR
00CB37 1 ; ANOTHER ONE
00CB37 1 ; ----------------------------------------------------------------------------
00CB37 1 FRM_RECURSE:
00CB37 1 B9 68 C0 lda MATHTBL+2,y
00CB3A 1 48 pha
00CB3B 1 B9 67 C0 lda MATHTBL+1,y
00CB3E 1 48 pha
00CB3F 1 20 4A CB jsr FRM_STACK1
00CB42 1 A5 9B lda CPRTYP
00CB44 1 4C C0 CA jmp FRMEVL1
00CB47 1 SNTXERR:
00CB47 1 4C 00 CC jmp SYNERR
00CB4A 1 ; ----------------------------------------------------------------------------
00CB4A 1 ; STACK (FAC)
00CB4A 1 ; THREE ENTRY POINTS:
00CB4A 1 ; 1, FROM FRMEVL
00CB4A 1 ; 2, FROM "STEP"
00CB4A 1 ; 3, FROM "FOR"
00CB4A 1 ; ----------------------------------------------------------------------------
00CB4A 1 FRM_STACK1:
00CB4A 1 A5 B0 lda FACSIGN
00CB4C 1 BE 66 C0 ldx MATHTBL,y
00CB4F 1 ; ----------------------------------------------------------------------------
00CB4F 1 ; ENTER HERE FROM "STEP", TO PUSH STEP SIGN AND VALUE
00CB4F 1 ; ----------------------------------------------------------------------------
00CB4F 1 FRM_STACK2:
00CB4F 1 A8 tay
00CB50 1 68 pla
00CB51 1 85 71 sta INDEX
00CB53 1 E6 71 inc INDEX ; bug: assumes not on page boundary
00CB55 1 ; bug exists on AppleSoft II
00CB55 1 68 pla
00CB56 1 85 72 sta INDEX+1
00CB58 1 98 tya
00CB59 1 48 pha
00CB5A 1 ; ----------------------------------------------------------------------------
00CB5A 1 ; ENTER HERE FROM "FOR", WITH (INDEX) = STEP,
00CB5A 1 ; TO PUSH INITIAL VALUE OF "FOR" VARIABLE
00CB5A 1 ; ----------------------------------------------------------------------------
00CB5A 1 FRM_STACK3:
00CB5A 1 20 AE D7 jsr ROUND_FAC
00CB5D 1 A5 AF lda FAC+3
00CB5F 1 48 pha
00CB60 1 A5 AE lda FAC+2
00CB62 1 48 pha
00CB63 1 A5 AD lda FAC+1
00CB65 1 48 pha
00CB66 1 A5 AC lda FAC
00CB68 1 48 pha
00CB69 1 6C 71 00 jmp (INDEX)
00CB6C 1 L2D02:
00CB6C 1 A0 FF ldy #$FF
00CB6E 1 68 pla
00CB6F 1 GOEX:
00CB6F 1 F0 20 beq EXIT
00CB71 1 ; ----------------------------------------------------------------------------
00CB71 1 ; PERFORM STACKED OPERATION
00CB71 1 ;
00CB71 1 ; (A) = PRECEDENCE BYTE
00CB71 1 ; STACK: 1 -- CPRMASK
00CB71 1 ; 5 -- (ARG)
00CB71 1 ; 2 -- ADDR OF PERFORMER
00CB71 1 ; ----------------------------------------------------------------------------
00CB71 1 FRM_PERFORM1:
00CB71 1 C9 64 cmp #$64
00CB73 1 F0 03 beq L2D0E
00CB75 1 20 A4 CA jsr CHKNUM
00CB78 1 L2D0E:
00CB78 1 84 99 sty LASTOP
00CB7A 1 FRM_PERFORM2:
00CB7A 1 68 pla
00CB7B 1 4A lsr a
00CB7C 1 85 63 sta CPRMASK
00CB7E 1 68 pla
00CB7F 1 85 B3 sta ARG
00CB81 1 68 pla
00CB82 1 85 B4 sta ARG+1
00CB84 1 68 pla
00CB85 1 85 B5 sta ARG+2
00CB87 1 68 pla
00CB88 1 85 B6 sta ARG+3
00CB8A 1 68 pla
00CB8B 1 85 B7 sta ARGSIGN
00CB8D 1 45 B0 eor FACSIGN
00CB8F 1 85 B8 sta SGNCPR
00CB91 1 EXIT:
00CB91 1 A5 AC lda FAC
00CB93 1 60 rts
00CB94 1 ; ----------------------------------------------------------------------------
00CB94 1 ; GET ELEMENT IN EXPRESSION
00CB94 1 ;
00CB94 1 ; GET VALUE OF VARIABLE OR NUMBER AT TXTPNT, OR POINT
00CB94 1 ; TO STRING DESCRIPTOR IF A STRING, AND PUT IN FAC.
00CB94 1 ; ----------------------------------------------------------------------------
00CB94 1 FRM_ELEMENT:
00CB94 1 A9 00 lda #$00
00CB96 1 85 5F sta VALTYP
00CB98 1 L2D31:
00CB98 1 20 BC 00 jsr CHRGET
00CB9B 1 B0 03 bcs L2D39
00CB9D 1 L2D36:
00CB9D 1 4C 7B D8 jmp FIN
00CBA0 1 L2D39:
00CBA0 1 20 75 CD jsr ISLETC
00CBA3 1 B0 67 bcs FRM_VARIABLE
00CBA5 1 CON_PI:
00CBA5 1 C9 2E cmp #$2E
00CBA7 1 F0 F4 beq L2D36
00CBA9 1 C9 A4 cmp #TOKEN_MINUS
00CBAB 1 F0 58 beq MIN
00CBAD 1 C9 A3 cmp #TOKEN_PLUS
00CBAF 1 F0 E7 beq L2D31
00CBB1 1 C9 22 cmp #$22
00CBB3 1 D0 0F bne NOT_
00CBB5 1 ; ----------------------------------------------------------------------------
00CBB5 1 ; STRING CONSTANT ELEMENT
00CBB5 1 ;
00CBB5 1 ; SET Y,A = (TXTPTR)+CARRY
00CBB5 1 ; ----------------------------------------------------------------------------
00CBB5 1 STRTXT:
00CBB5 1 A5 C3 lda TXTPTR
00CBB7 1 A4 C4 ldy TXTPTR+1
00CBB9 1 69 00 adc #$00
00CBBB 1 90 01 bcc L2D57
00CBBD 1 C8 iny
00CBBE 1 L2D57:
00CBBE 1 20 A2 D0 jsr STRLIT
00CBC1 1 4C E7 D3 jmp POINT
00CBC4 1 ; ----------------------------------------------------------------------------
00CBC4 1 ; "NOT" FUNCTION
00CBC4 1 ; IF FAC=0, RETURN FAC=1
00CBC4 1 ; IF FAC<>0, RETURN FAC=0
00CBC4 1 ; ----------------------------------------------------------------------------
00CBC4 1 NOT_:
00CBC4 1 C9 A1 cmp #TOKEN_NOT
00CBC6 1 D0 13 bne L2D74
00CBC8 1 A0 18 ldy #$18
00CBCA 1 D0 3B bne EQUL
00CBCC 1 ; ----------------------------------------------------------------------------
00CBCC 1 ; COMPARISON FOR EQUALITY (= OPERATOR)
00CBCC 1 ; ALSO USED TO EVALUATE "NOT" FUNCTION
00CBCC 1 ; ----------------------------------------------------------------------------
00CBCC 1 EQUOP:
00CBCC 1 20 F9 CD jsr AYINT
00CBCF 1 A5 AF lda FAC_LAST
00CBD1 1 49 FF eor #$FF
00CBD3 1 A8 tay
00CBD4 1 A5 AE lda FAC_LAST-1
00CBD6 1 49 FF eor #$FF
00CBD8 1 4C B5 CF jmp GIVAYF
00CBDB 1 L2D74:
00CBDB 1 C9 9E cmp #TOKEN_FN
00CBDD 1 D0 03 bne L2D7B
00CBDF 1 4C 12 D0 jmp L31F3
00CBE2 1 L2D7B:
00CBE2 1 C9 AD cmp #TOKEN_SGN
00CBE4 1 90 03 bcc PARCHK
00CBE6 1 4C 1B CC jmp UNARY
00CBE9 1 ; ----------------------------------------------------------------------------
00CBE9 1 ; EVALUATE "(EXPRESSION)"
00CBE9 1 ; ----------------------------------------------------------------------------
00CBE9 1 PARCHK:
00CBE9 1 20 F2 CB jsr CHKOPN
00CBEC 1 20 B5 CA jsr FRMEVL
00CBEF 1 CHKCLS:
00CBEF 1 A9 29 lda #$29
00CBF1 1 2C .byte $2C
00CBF2 1 CHKOPN:
00CBF2 1 A9 28 lda #$28
00CBF4 1 2C .byte $2C
00CBF5 1 CHKCOM:
00CBF5 1 A9 2C lda #$2C
00CBF7 1 ; ----------------------------------------------------------------------------
00CBF7 1 ; UNLESS CHAR AT TXTPTR = (A), SYNTAX ERROR
00CBF7 1 ; ----------------------------------------------------------------------------
00CBF7 1 SYNCHR: ; XXX all CBM code calls SYNCHR instead of CHKCOM
00CBF7 1 A0 00 ldy #$00
00CBF9 1 D1 C3 cmp (TXTPTR),y
00CBFB 1 D0 03 bne SYNERR
00CBFD 1 4C BC 00 jmp CHRGET
00CC00 1 ; ----------------------------------------------------------------------------
00CC00 1 SYNERR:
00CC00 1 A2 02 ldx #ERR_SYNTAX
00CC02 1 4C 4E C2 jmp ERROR
00CC05 1 ; ----------------------------------------------------------------------------
00CC05 1 MIN:
00CC05 1 A0 15 ldy #$15
00CC07 1 EQUL:
00CC07 1 68 pla
00CC08 1 68 pla
00CC09 1 4C 11 CB jmp L2CA4
00CC0C 1 ; ----------------------------------------------------------------------------
00CC0C 1 FRM_VARIABLE:
00CC0C 1 20 FF CC jsr PTRGET
00CC0F 1 FRM_VARIABLE_CALL = *-1
00CC0F 1 85 AE sta FAC_LAST-1
00CC11 1 84 AF sty FAC_LAST
00CC13 1 A6 5F ldx VALTYP
00CC15 1 F0 01 beq L2DB1
00CC17 1 ; bugfix?
00CC17 1 ; fixed on AppleSoft II, not on any CBM
00CC17 1 60 rts
00CC18 1 L2DB1:
00CC18 1 4C 3F D7 jmp LOAD_FAC_FROM_YA
00CC1B 1 ; ----------------------------------------------------------------------------
00CC1B 1 UNARY:
00CC1B 1 0A asl a
00CC1C 1 48 pha
00CC1D 1 AA tax
00CC1E 1 20 BC 00 jsr CHRGET
00CC21 1 E0 81 cpx #<(TOKEN_LEFTSTR*2-1)
00CC23 1 90 20 bcc L2DEF
00CC25 1 20 F2 CB jsr CHKOPN
00CC28 1 20 B5 CA jsr FRMEVL
00CC2B 1 20 F5 CB jsr CHKCOM
00CC2E 1 20 A6 CA jsr CHKSTR
00CC31 1 68 pla
00CC32 1 AA tax
00CC33 1 A5 AF lda FAC_LAST
00CC35 1 48 pha
00CC36 1 A5 AE lda FAC_LAST-1
00CC38 1 48 pha
00CC39 1 8A txa
00CC3A 1 48 pha
00CC3B 1 20 A2 D3 jsr GETBYT
00CC3E 1 68 pla
00CC3F 1 A8 tay
00CC40 1 8A txa
00CC41 1 48 pha
00CC42 1 4C 4A CC jmp L2DF4
00CC45 1 L2DEF:
00CC45 1 20 E9 CB jsr PARCHK
00CC48 1 68 pla
00CC49 1 A8 tay
00CC4A 1 L2DF4:
00CC4A 1 B9 DE BF lda UNFNC+($80-TOKEN_SGN)*2,y
00CC4D 1 85 A2 sta JMPADRS+1
00CC4F 1 B9 DF BF lda UNFNC+($80-TOKEN_SGN)*2+1,y
00CC52 1 85 A3 sta JMPADRS+2
00CC54 1 20 A1 00 jsr JMPADRS
00CC57 1 4C A4 CA jmp CHKNUM
00CC5A 1 ; ----------------------------------------------------------------------------
00CC5A 1 OR:
00CC5A 1 A0 FF ldy #$FF
00CC5C 1 2C .byte $2C
00CC5D 1 ; ----------------------------------------------------------------------------
00CC5D 1 TAND:
00CC5D 1 A0 00 ldy #$00
00CC5F 1 84 5D sty EOLPNTR
00CC61 1 20 F9 CD jsr AYINT
00CC64 1 A5 AE lda FAC_LAST-1
00CC66 1 45 5D eor EOLPNTR
00CC68 1 85 5B sta CHARAC
00CC6A 1 A5 AF lda FAC_LAST
00CC6C 1 45 5D eor EOLPNTR
00CC6E 1 85 5C sta ENDCHR
00CC70 1 20 8F D7 jsr COPY_ARG_TO_FAC
00CC73 1 20 F9 CD jsr AYINT
00CC76 1 A5 AF lda FAC_LAST
00CC78 1 45 5D eor EOLPNTR
00CC7A 1 25 5C and ENDCHR
00CC7C 1 45 5D eor EOLPNTR
00CC7E 1 A8 tay
00CC7F 1 A5 AE lda FAC_LAST-1
00CC81 1 45 5D eor EOLPNTR
00CC83 1 25 5B and CHARAC
00CC85 1 45 5D eor EOLPNTR
00CC87 1 4C B5 CF jmp GIVAYF
00CC8A 1 ; ----------------------------------------------------------------------------
00CC8A 1 ; PERFORM RELATIONAL OPERATIONS
00CC8A 1 ; ----------------------------------------------------------------------------
00CC8A 1 RELOPS:
00CC8A 1 20 A7 CA jsr CHKVAL
00CC8D 1 B0 13 bcs STRCMP
00CC8F 1 A5 B7 lda ARGSIGN
00CC91 1 09 7F ora #$7F
00CC93 1 25 B4 and ARG+1
00CC95 1 85 B4 sta ARG+1
00CC97 1 A9 B3 lda #<ARG
00CC99 1 A0 00 ldy #$00
00CC9B 1 20 EC D7 jsr FCOMP
00CC9E 1 AA tax
00CC9F 1 4C D5 CC jmp NUMCMP
00CCA2 1 ; ----------------------------------------------------------------------------
00CCA2 1 ; STRING COMPARISON
00CCA2 1 ; ----------------------------------------------------------------------------
00CCA2 1 STRCMP:
00CCA2 1 A9 00 lda #$00
00CCA4 1 85 5F sta VALTYP
00CCA6 1 C6 9B dec CPRTYP
00CCA8 1 20 AA D2 jsr FREFAC
00CCAB 1 85 AC sta FAC
00CCAD 1 86 AD stx FAC+1
00CCAF 1 84 AE sty FAC+2
00CCB1 1 A5 B5 lda ARG_LAST-1
00CCB3 1 A4 B6 ldy ARG_LAST
00CCB5 1 20 AE D2 jsr FRETMP
00CCB8 1 86 B5 stx ARG_LAST-1
00CCBA 1 84 B6 sty ARG_LAST
00CCBC 1 AA tax
00CCBD 1 38 sec
00CCBE 1 E5 AC sbc FAC
00CCC0 1 F0 08 beq L2E74
00CCC2 1 A9 01 lda #$01
00CCC4 1 90 04 bcc L2E74
00CCC6 1 A6 AC ldx FAC
00CCC8 1 A9 FF lda #$FF
00CCCA 1 L2E74:
00CCCA 1 85 B0 sta FACSIGN
00CCCC 1 A0 FF ldy #$FF
00CCCE 1 E8 inx
00CCCF 1 STRCMP1:
00CCCF 1 C8 iny
00CCD0 1 CA dex
00CCD1 1 D0 07 bne L2E84
00CCD3 1 A6 B0 ldx FACSIGN
00CCD5 1 NUMCMP:
00CCD5 1 30 0F bmi CMPDONE
00CCD7 1 18 clc
00CCD8 1 90 0C bcc CMPDONE
00CCDA 1 L2E84:
00CCDA 1 B1 B5 lda (ARG_LAST-1),y
00CCDC 1 D1 AD cmp (FAC+1),y
00CCDE 1 F0 EF beq STRCMP1
00CCE0 1 A2 FF ldx #$FF
00CCE2 1 B0 02 bcs CMPDONE
00CCE4 1 A2 01 ldx #$01
00CCE6 1 CMPDONE:
00CCE6 1 E8 inx
00CCE7 1 8A txa
00CCE8 1 2A rol a
00CCE9 1 25 63 and CPRMASK
00CCEB 1 F0 02 beq L2E99
00CCED 1 A9 FF lda #$FF
00CCEF 1 L2E99:
00CCEF 1 4C CF D7 jmp FLOAT
00CCF2 1 ; ----------------------------------------------------------------------------
00CCF2 1 ; "DIM" STATEMENT
00CCF2 1 ; ----------------------------------------------------------------------------
00CCF2 1 NXDIM:
00CCF2 1 20 F5 CB jsr CHKCOM
00CCF5 1 DIM:
00CCF5 1 AA tax
00CCF6 1 20 04 CD jsr PTRGET2
00CCF9 1 20 C2 00 jsr CHRGOT
00CCFC 1 D0 F4 bne NXDIM
00CCFE 1 60 rts
00CCFF 1 ; ----------------------------------------------------------------------------
00CCFF 1 ; PTRGET -- GENERAL VARIABLE SCAN
00CCFF 1 ;
00CCFF 1 ; SCANS VARIABLE NAME AT TXTPTR, AND SEARCHES THE
00CCFF 1 ; VARTAB AND ARYTAB FOR THE NAME.
00CCFF 1 ; IF NOT FOUND, CREATE VARIABLE OF APPROPRIATE TYPE.
00CCFF 1 ; RETURN WITH ADDRESS IN VARPNT AND Y,A
00CCFF 1 ;
00CCFF 1 ; ACTUAL ACTIVITY CONTROLLED SOMEWHAT BY TWO FLAGS:
00CCFF 1 ; DIMFLG -- NONZERO IF CALLED FROM "DIM"
00CCFF 1 ; ELSE = 0
00CCFF 1 ;
00CCFF 1 ; SUBFLG -- = $00
00CCFF 1 ; = $40 IF CALLED FROM "GETARYPT"
00CCFF 1 ; ----------------------------------------------------------------------------
00CCFF 1 PTRGET:
00CCFF 1 A2 00 ldx #$00
00CD01 1 20 C2 00 jsr CHRGOT
00CD04 1 PTRGET2:
00CD04 1 86 5E stx DIMFLG
00CD06 1 PTRGET3:
00CD06 1 85 93 sta VARNAM
00CD08 1 20 C2 00 jsr CHRGOT
00CD0B 1 20 75 CD jsr ISLETC
00CD0E 1 B0 03 bcs NAMOK
00CD10 1 4C 00 CC jmp SYNERR
00CD13 1 NAMOK:
00CD13 1 A2 00 ldx #$00
00CD15 1 86 5F stx VALTYP
00CD17 1 20 BC 00 jsr CHRGET
00CD1A 1 90 05 bcc L2ECD
00CD1C 1 20 75 CD jsr ISLETC
00CD1F 1 90 0B bcc L2ED8
00CD21 1 L2ECD:
00CD21 1 AA tax
00CD22 1 L2ECE:
00CD22 1 20 BC 00 jsr CHRGET
00CD25 1 90 FB bcc L2ECE
00CD27 1 20 75 CD jsr ISLETC
00CD2A 1 B0 F6 bcs L2ECE
00CD2C 1 L2ED8:
00CD2C 1 C9 24 cmp #$24
00CD2E 1 D0 0B bne L2EF9
00CD30 1 A9 FF lda #$FF
00CD32 1 85 5F sta VALTYP
00CD34 1 8A txa
00CD35 1 09 80 ora #$80
00CD37 1 AA tax
00CD38 1 20 BC 00 jsr CHRGET
00CD3B 1 L2EF9:
00CD3B 1 86 94 stx VARNAM+1
00CD3D 1 38 sec
00CD3E 1 05 61 ora SUBFLG
00CD40 1 E9 28 sbc #$28
00CD42 1 D0 03 bne L2F05
00CD44 1 4C 0B CE jmp ARRAY
00CD47 1 L2F05:
00CD47 1 A9 00 lda #$00
00CD49 1 85 61 sta SUBFLG
00CD4B 1 A5 7B lda VARTAB
00CD4D 1 A6 7C ldx VARTAB+1
00CD4F 1 A0 00 ldy #$00
00CD51 1 L2F0F:
00CD51 1 86 AB stx LOWTR+1
00CD53 1 L2F11:
00CD53 1 85 AA sta LOWTR
00CD55 1 E4 7E cpx ARYTAB+1
00CD57 1 D0 04 bne L2F1B
00CD59 1 C5 7D cmp ARYTAB
00CD5B 1 F0 22 beq NAMENOTFOUND
00CD5D 1 L2F1B:
00CD5D 1 A5 93 lda VARNAM
00CD5F 1 D1 AA cmp (LOWTR),y
00CD61 1 D0 08 bne L2F29
00CD63 1 A5 94 lda VARNAM+1
00CD65 1 C8 iny
00CD66 1 D1 AA cmp (LOWTR),y
00CD68 1 F0 61 beq SET_VARPNT_AND_YA
00CD6A 1 88 dey
00CD6B 1 L2F29:
00CD6B 1 18 clc
00CD6C 1 A5 AA lda LOWTR
00CD6E 1 69 06 adc #BYTES_PER_VARIABLE
00CD70 1 90 E1 bcc L2F11
00CD72 1 E8 inx
00CD73 1 D0 DC bne L2F0F
00CD75 1 ; ----------------------------------------------------------------------------
00CD75 1 ; CHECK IF (A) IS ASCII LETTER A-Z
00CD75 1 ;
00CD75 1 ; RETURN CARRY = 1 IF A-Z
00CD75 1 ; = 0 IF NOT
00CD75 1 ; ----------------------------------------------------------------------------
00CD75 1 ISLETC:
00CD75 1 C9 41 cmp #$41
00CD77 1 90 05 bcc L2F3C
00CD79 1 E9 5B sbc #$5B
00CD7B 1 38 sec
00CD7C 1 E9 A5 sbc #$A5
00CD7E 1 L2F3C:
00CD7E 1 60 rts
00CD7F 1 ; ----------------------------------------------------------------------------
00CD7F 1 ; VARIABLE NOT FOUND, SO MAKE ONE
00CD7F 1 ; ----------------------------------------------------------------------------
00CD7F 1 NAMENOTFOUND:
00CD7F 1 68 pla
00CD80 1 48 pha
00CD81 1 C9 0E cmp #<FRM_VARIABLE_CALL
00CD83 1 D0 07 bne MAKENEWVARIABLE
00CD85 1 A9 8A lda #<C_ZERO
00CD87 1 A0 CD ldy #>C_ZERO
00CD89 1 60 rts
00CD8A 1 ; ----------------------------------------------------------------------------
00CD8A 1 C_ZERO:
00CD8A 1 00 00 .byte $00,$00
00CD8C 1 ; ----------------------------------------------------------------------------
00CD8C 1 ; MAKE A NEW SIMPLE VARIABLE
00CD8C 1 ;
00CD8C 1 ; MOVE ARRAYS UP 7 BYTES TO MAKE ROOM FOR NEW VARIABLE
00CD8C 1 ; ENTER 7-BYTE VARIABLE DATA IN THE HOLE
00CD8C 1 ; ----------------------------------------------------------------------------
00CD8C 1 MAKENEWVARIABLE:
00CD8C 1 A5 7D lda ARYTAB
00CD8E 1 A4 7E ldy ARYTAB+1
00CD90 1 85 AA sta LOWTR
00CD92 1 84 AB sty LOWTR+1
00CD94 1 A5 7F lda STREND
00CD96 1 A4 80 ldy STREND+1
00CD98 1 85 A6 sta HIGHTR
00CD9A 1 84 A7 sty HIGHTR+1
00CD9C 1 18 clc
00CD9D 1 69 06 adc #BYTES_PER_VARIABLE
00CD9F 1 90 01 bcc L2F68
00CDA1 1 C8 iny
00CDA2 1 L2F68:
00CDA2 1 85 A4 sta HIGHDS
00CDA4 1 84 A5 sty HIGHDS+1
00CDA6 1 20 CF C1 jsr BLTU
00CDA9 1 A5 A4 lda HIGHDS
00CDAB 1 A4 A5 ldy HIGHDS+1
00CDAD 1 C8 iny
00CDAE 1 85 7D sta ARYTAB
00CDB0 1 84 7E sty ARYTAB+1
00CDB2 1 A0 00 ldy #$00
00CDB4 1 A5 93 lda VARNAM
00CDB6 1 91 AA sta (LOWTR),y
00CDB8 1 C8 iny
00CDB9 1 A5 94 lda VARNAM+1
00CDBB 1 91 AA sta (LOWTR),y
00CDBD 1 A9 00 lda #$00
00CDBF 1 C8 iny
00CDC0 1 91 AA sta (LOWTR),y
00CDC2 1 C8 iny
00CDC3 1 91 AA sta (LOWTR),y
00CDC5 1 C8 iny
00CDC6 1 91 AA sta (LOWTR),y
00CDC8 1 C8 iny
00CDC9 1 91 AA sta (LOWTR),y
00CDCB 1 ; ----------------------------------------------------------------------------
00CDCB 1 ; PUT ADDRESS OF VALUE OF VARIABLE IN VARPNT AND Y,A
00CDCB 1 ; ----------------------------------------------------------------------------
00CDCB 1 SET_VARPNT_AND_YA:
00CDCB 1 A5 AA lda LOWTR
00CDCD 1 18 clc
00CDCE 1 69 02 adc #$02
00CDD0 1 A4 AB ldy LOWTR+1
00CDD2 1 90 01 bcc L2F9E
00CDD4 1 C8 iny
00CDD5 1 L2F9E:
00CDD5 1 85 95 sta VARPNT
00CDD7 1 84 96 sty VARPNT+1
00CDD9 1 60 rts
00CDDA 1 ; ----------------------------------------------------------------------------
00CDDA 1 ; COMPUTE ADDRESS OF FIRST VALUE IN ARRAY
00CDDA 1 ; ARYPNT = (LOWTR) + #DIMS*2 + 5
00CDDA 1 ; ----------------------------------------------------------------------------
00CDDA 1 GETARY:
00CDDA 1 A5 5D lda EOLPNTR
00CDDC 1 0A asl a
00CDDD 1 69 05 adc #$05
00CDDF 1 65 AA adc LOWTR
00CDE1 1 A4 AB ldy LOWTR+1
00CDE3 1 90 01 bcc L2FAF
00CDE5 1 C8 iny
00CDE6 1 L2FAF:
00CDE6 1 85 A4 sta HIGHDS
00CDE8 1 84 A5 sty HIGHDS+1
00CDEA 1 60 rts
00CDEB 1 ; ----------------------------------------------------------------------------
00CDEB 1 NEG32768:
00CDEB 1 90 80 00 00 .byte $90,$80,$00,$00
00CDEF 1 ; ----------------------------------------------------------------------------
00CDEF 1 ; EVALUATE NUMERIC FORMULA AT TXTPTR
00CDEF 1 ; CONVERTING RESULT TO INTEGER 0 <= X <= 32767
00CDEF 1 ; IN FAC+3,4
00CDEF 1 ; ----------------------------------------------------------------------------
00CDEF 1 MAKINT:
00CDEF 1 20 BC 00 jsr CHRGET
00CDF2 1 20 A1 CA jsr FRMNUM
00CDF5 1 ; ----------------------------------------------------------------------------
00CDF5 1 ; CONVERT FAC TO INTEGER
00CDF5 1 ; MUST BE POSITIVE AND LESS THAN 32768
00CDF5 1 ; ----------------------------------------------------------------------------
00CDF5 1 MKINT:
00CDF5 1 A5 B0 lda FACSIGN
00CDF7 1 30 0D bmi MI1
00CDF9 1 ; ----------------------------------------------------------------------------
00CDF9 1 ; CONVERT FAC TO INTEGER
00CDF9 1 ; MUST BE -32767 <= FAC <= 32767
00CDF9 1 ; ----------------------------------------------------------------------------
00CDF9 1 AYINT:
00CDF9 1 A5 AC lda FAC
00CDFB 1 C9 90 cmp #$90
00CDFD 1 90 09 bcc MI2
00CDFF 1 A9 EB lda #<NEG32768
00CE01 1 A0 CD ldy #>NEG32768
00CE03 1 20 EC D7 jsr FCOMP
00CE06 1 MI1:
00CE06 1 D0 74 bne IQERR
00CE08 1 MI2:
00CE08 1 4C 25 D8 jmp QINT
00CE0B 1 ; ----------------------------------------------------------------------------
00CE0B 1 ; LOCATE ARRAY ELEMENT OR CREATE AN ARRAY
00CE0B 1 ; ----------------------------------------------------------------------------
00CE0B 1 ARRAY:
00CE0B 1 A5 5E lda DIMFLG
00CE0D 1 48 pha
00CE0E 1 A5 5F lda VALTYP
00CE10 1 48 pha
00CE11 1 A0 00 ldy #$00
00CE13 1 L2FDE:
00CE13 1 98 tya
00CE14 1 48 pha
00CE15 1 A5 94 lda VARNAM+1
00CE17 1 48 pha
00CE18 1 A5 93 lda VARNAM
00CE1A 1 48 pha
00CE1B 1 20 EF CD jsr MAKINT
00CE1E 1 68 pla
00CE1F 1 85 93 sta VARNAM
00CE21 1 68 pla
00CE22 1 85 94 sta VARNAM+1
00CE24 1 68 pla
00CE25 1 A8 tay
00CE26 1 BA tsx
00CE27 1 BD 02 01 lda STACK+2,x
00CE2A 1 48 pha
00CE2B 1 BD 01 01 lda STACK+1,x
00CE2E 1 48 pha
00CE2F 1 A5 AE lda FAC_LAST-1
00CE31 1 9D 02 01 sta STACK+2,x
00CE34 1 A5 AF lda FAC_LAST
00CE36 1 9D 01 01 sta STACK+1,x
00CE39 1 C8 iny
00CE3A 1 20 C2 00 jsr CHRGOT
00CE3D 1 C9 2C cmp #$2C
00CE3F 1 F0 D2 beq L2FDE
00CE41 1 84 5D sty EOLPNTR
00CE43 1 20 EF CB jsr CHKCLS
00CE46 1 68 pla
00CE47 1 85 5F sta VALTYP
00CE49 1 68 pla
00CE4A 1 85 5E sta DIMFLG
00CE4C 1 ; ----------------------------------------------------------------------------
00CE4C 1 ; SEARCH ARRAY TABLE FOR THIS ARRAY NAME
00CE4C 1 ; ----------------------------------------------------------------------------
00CE4C 1 A6 7D ldx ARYTAB
00CE4E 1 A5 7E lda ARYTAB+1
00CE50 1 L301F:
00CE50 1 86 AA stx LOWTR
00CE52 1 85 AB sta LOWTR+1
00CE54 1 C5 80 cmp STREND+1
00CE56 1 D0 04 bne L302B
00CE58 1 E4 7F cpx STREND
00CE5A 1 F0 39 beq MAKE_NEW_ARRAY
00CE5C 1 L302B:
00CE5C 1 A0 00 ldy #$00
00CE5E 1 B1 AA lda (LOWTR),y
00CE60 1 C8 iny
00CE61 1 C5 93 cmp VARNAM
00CE63 1 D0 06 bne L303A
00CE65 1 A5 94 lda VARNAM+1
00CE67 1 D1 AA cmp (LOWTR),y
00CE69 1 F0 16 beq USE_OLD_ARRAY
00CE6B 1 L303A:
00CE6B 1 C8 iny
00CE6C 1 B1 AA lda (LOWTR),y
00CE6E 1 18 clc
00CE6F 1 65 AA adc LOWTR
00CE71 1 AA tax
00CE72 1 C8 iny
00CE73 1 B1 AA lda (LOWTR),y
00CE75 1 65 AB adc LOWTR+1
00CE77 1 90 D7 bcc L301F
00CE79 1 ; ----------------------------------------------------------------------------
00CE79 1 ; ERROR: BAD SUBSCRIPTS
00CE79 1 ; ----------------------------------------------------------------------------
00CE79 1 SUBERR:
00CE79 1 A2 10 ldx #ERR_BADSUBS
00CE7B 1 2C .byte $2C
00CE7C 1 ; ----------------------------------------------------------------------------
00CE7C 1 ; ERROR: ILLEGAL QUANTITY
00CE7C 1 ; ----------------------------------------------------------------------------
00CE7C 1 IQERR:
00CE7C 1 A2 08 ldx #ERR_ILLQTY
00CE7E 1 JER:
00CE7E 1 4C 4E C2 jmp ERROR
00CE81 1 ; ----------------------------------------------------------------------------
00CE81 1 ; FOUND THE ARRAY
00CE81 1 ; ----------------------------------------------------------------------------
00CE81 1 USE_OLD_ARRAY:
00CE81 1 A2 12 ldx #ERR_REDIMD
00CE83 1 A5 5E lda DIMFLG
00CE85 1 D0 F7 bne JER
00CE87 1 20 DA CD jsr GETARY
00CE8A 1 A5 5D lda EOLPNTR
00CE8C 1 A0 04 ldy #$04
00CE8E 1 D1 AA cmp (LOWTR),y
00CE90 1 D0 E7 bne SUBERR
00CE92 1 4C 18 CF jmp FIND_ARRAY_ELEMENT
00CE95 1 ; ----------------------------------------------------------------------------
00CE95 1 ; CREATE A NEW ARRAY, UNLESS CALLED FROM GETARYPT
00CE95 1 ; ----------------------------------------------------------------------------
00CE95 1 MAKE_NEW_ARRAY:
00CE95 1 20 DA CD jsr GETARY
00CE98 1 20 1F C2 jsr REASON
00CE9B 1 A9 00 lda #$00
00CE9D 1 A8 tay
00CE9E 1 85 BB sta STRNG2+1
00CEA0 1 A2 04 ldx #BYTES_PER_ELEMENT
00CEA2 1 86 BA stx STRNG2
00CEA4 1 A5 93 lda VARNAM
00CEA6 1 91 AA sta (LOWTR),y
00CEA8 1 C8 iny
00CEA9 1 A5 94 lda VARNAM+1
00CEAB 1 91 AA sta (LOWTR),y
00CEAD 1 A5 5D lda EOLPNTR
00CEAF 1 C8 iny
00CEB0 1 C8 iny
00CEB1 1 C8 iny
00CEB2 1 91 AA sta (LOWTR),y
00CEB4 1 L308A:
00CEB4 1 A2 0B ldx #$0B
00CEB6 1 A9 00 lda #$00
00CEB8 1 24 5E bit DIMFLG
00CEBA 1 50 08 bvc L309A
00CEBC 1 68 pla
00CEBD 1 18 clc
00CEBE 1 69 01 adc #$01
00CEC0 1 AA tax
00CEC1 1 68 pla
00CEC2 1 69 00 adc #$00
00CEC4 1 L309A:
00CEC4 1 C8 iny
00CEC5 1 91 AA sta (LOWTR),y
00CEC7 1 C8 iny
00CEC8 1 8A txa
00CEC9 1 91 AA sta (LOWTR),y
00CECB 1 20 70 CF jsr MULTIPLY_SUBSCRIPT
00CECE 1 86 BA stx STRNG2
00CED0 1 85 BB sta STRNG2+1
00CED2 1 A4 71 ldy INDEX
00CED4 1 C6 5D dec EOLPNTR
00CED6 1 D0 DC bne L308A
00CED8 1 65 A5 adc HIGHDS+1
00CEDA 1 B0 5D bcs GME
00CEDC 1 85 A5 sta HIGHDS+1
00CEDE 1 A8 tay
00CEDF 1 8A txa
00CEE0 1 65 A4 adc HIGHDS
00CEE2 1 90 03 bcc L30BD
00CEE4 1 C8 iny
00CEE5 1 F0 52 beq GME
00CEE7 1 L30BD:
00CEE7 1 20 1F C2 jsr REASON
00CEEA 1 85 7F sta STREND
00CEEC 1 84 80 sty STREND+1
00CEEE 1 A9 00 lda #$00
00CEF0 1 E6 BB inc STRNG2+1
00CEF2 1 A4 BA ldy STRNG2
00CEF4 1 F0 05 beq L30D1
00CEF6 1 L30CC:
00CEF6 1 88 dey
00CEF7 1 91 A4 sta (HIGHDS),y
00CEF9 1 D0 FB bne L30CC
00CEFB 1 L30D1:
00CEFB 1 C6 A5 dec HIGHDS+1
00CEFD 1 C6 BB dec STRNG2+1
00CEFF 1 D0 F5 bne L30CC
00CF01 1 E6 A5 inc HIGHDS+1
00CF03 1 38 sec
00CF04 1 A5 7F lda STREND
00CF06 1 E5 AA sbc LOWTR
00CF08 1 A0 02 ldy #$02
00CF0A 1 91 AA sta (LOWTR),y
00CF0C 1 A5 80 lda STREND+1
00CF0E 1 C8 iny
00CF0F 1 E5 AB sbc LOWTR+1
00CF11 1 91 AA sta (LOWTR),y
00CF13 1 A5 5E lda DIMFLG
00CF15 1 D0 58 bne RTS9
00CF17 1 C8 iny
00CF18 1 ; ----------------------------------------------------------------------------
00CF18 1 ; FIND SPECIFIED ARRAY ELEMENT
00CF18 1 ;
00CF18 1 ; (LOWTR),Y POINTS AT # OF DIMS IN ARRAY DESCRIPTOR
00CF18 1 ; THE SUBSCRIPTS ARE ALL ON THE STACK AS INTEGERS
00CF18 1 ; ----------------------------------------------------------------------------
00CF18 1 FIND_ARRAY_ELEMENT:
00CF18 1 B1 AA lda (LOWTR),y
00CF1A 1 85 5D sta EOLPNTR
00CF1C 1 A9 00 lda #$00
00CF1E 1 85 BA sta STRNG2
00CF20 1 L30F6:
00CF20 1 85 BB sta STRNG2+1
00CF22 1 C8 iny
00CF23 1 68 pla
00CF24 1 AA tax
00CF25 1 85 AE sta FAC_LAST-1
00CF27 1 68 pla
00CF28 1 85 AF sta FAC_LAST
00CF2A 1 D1 AA cmp (LOWTR),y
00CF2C 1 90 0E bcc FAE2
00CF2E 1 D0 06 bne GSE
00CF30 1 C8 iny
00CF31 1 8A txa
00CF32 1 D1 AA cmp (LOWTR),y
00CF34 1 90 07 bcc FAE3
00CF36 1 ; ----------------------------------------------------------------------------
00CF36 1 GSE:
00CF36 1 4C 79 CE jmp SUBERR
00CF39 1 GME:
00CF39 1 4C 4C C2 jmp MEMERR
00CF3C 1 ; ----------------------------------------------------------------------------
00CF3C 1 FAE2:
00CF3C 1 C8 iny
00CF3D 1 FAE3:
00CF3D 1 A5 BB lda STRNG2+1
00CF3F 1 05 BA ora STRNG2
00CF41 1 18 clc
00CF42 1 F0 0A beq L3124
00CF44 1 20 70 CF jsr MULTIPLY_SUBSCRIPT
00CF47 1 8A txa
00CF48 1 65 AE adc FAC_LAST-1
00CF4A 1 AA tax
00CF4B 1 98 tya
00CF4C 1 A4 71 ldy INDEX
00CF4E 1 L3124:
00CF4E 1 65 AF adc FAC_LAST
00CF50 1 86 BA stx STRNG2
00CF52 1 C6 5D dec EOLPNTR
00CF54 1 D0 CA bne L30F6
00CF56 1 06 BA asl STRNG2
00CF58 1 2A rol a
00CF59 1 B0 DB bcs GSE
00CF5B 1 06 BA asl STRNG2
00CF5D 1 2A rol a
00CF5E 1 B0 D6 bcs GSE
00CF60 1 A8 tay
00CF61 1 A5 BA lda STRNG2
00CF63 1 65 A4 adc HIGHDS
00CF65 1 85 95 sta VARPNT
00CF67 1 98 tya
00CF68 1 65 A5 adc HIGHDS+1
00CF6A 1 85 96 sta VARPNT+1
00CF6C 1 A8 tay
00CF6D 1 A5 95 lda VARPNT
00CF6F 1 RTS9:
00CF6F 1 60 rts
00CF70 1 ; ----------------------------------------------------------------------------
00CF70 1 ; MULTIPLY (STRNG2) BY ((LOWTR),Y)
00CF70 1 ; LEAVING PRODUCT IN A,X. (HI-BYTE ALSO IN Y.)
00CF70 1 ; USED ONLY BY ARRAY SUBSCRIPT ROUTINES
00CF70 1 ; ----------------------------------------------------------------------------
00CF70 1 MULTIPLY_SUBSCRIPT:
00CF70 1 84 71 sty INDEX
00CF72 1 B1 AA lda (LOWTR),y
00CF74 1 85 76 sta RESULT_LAST-2
00CF76 1 88 dey
00CF77 1 B1 AA lda (LOWTR),y
00CF79 1 85 77 sta RESULT_LAST-1
00CF7B 1 A9 10 lda #$10
00CF7D 1 85 A8 sta INDX
00CF7F 1 A2 00 ldx #$00
00CF81 1 A0 00 ldy #$00
00CF83 1 L3163:
00CF83 1 8A txa
00CF84 1 0A asl a
00CF85 1 AA tax
00CF86 1 98 tya
00CF87 1 2A rol a
00CF88 1 A8 tay
00CF89 1 B0 AE bcs GME
00CF8B 1 06 BA asl STRNG2
00CF8D 1 26 BB rol STRNG2+1
00CF8F 1 90 0B bcc L317C
00CF91 1 18 clc
00CF92 1 8A txa
00CF93 1 65 76 adc RESULT_LAST-2
00CF95 1 AA tax
00CF96 1 98 tya
00CF97 1 65 77 adc RESULT_LAST-1
00CF99 1 A8 tay
00CF9A 1 B0 9D bcs GME
00CF9C 1 L317C:
00CF9C 1 C6 A8 dec INDX
00CF9E 1 D0 E3 bne L3163
00CFA0 1 60 rts
00CFA1 1 ; ----------------------------------------------------------------------------
00CFA1 1 ; "FRE" FUNCTION
00CFA1 1 ;
00CFA1 1 ; COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT
00CFA1 1 ; ----------------------------------------------------------------------------
00CFA1 1 FRE:
00CFA1 1 A5 5F lda VALTYP
00CFA3 1 F0 03 beq L3188
00CFA5 1 20 AA D2 jsr FREFAC
00CFA8 1 L3188:
00CFA8 1 20 3B D1 jsr GARBAG
00CFAB 1 38 sec
00CFAC 1 A5 81 lda FRETOP
00CFAE 1 E5 7F sbc STREND
00CFB0 1 A8 tay
00CFB1 1 A5 82 lda FRETOP+1
00CFB3 1 E5 80 sbc STREND+1
00CFB5 1 ; FALL INTO GIVAYF TO FLOAT THE VALUE
00CFB5 1 ; NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE
00CFB5 1 ; ----------------------------------------------------------------------------
00CFB5 1 ; FLOAT THE SIGNED INTEGER IN A,Y
00CFB5 1 ; ----------------------------------------------------------------------------
00CFB5 1 GIVAYF:
00CFB5 1 A2 00 ldx #$00
00CFB7 1 86 5F stx VALTYP
00CFB9 1 85 AD sta FAC+1
00CFBB 1 84 AE sty FAC+2
00CFBD 1 A2 90 ldx #$90
00CFBF 1 4C D7 D7 jmp FLOAT1
00CFC2 1 POS:
00CFC2 1 A4 0E ldy POSX
00CFC4 1 ; ----------------------------------------------------------------------------
00CFC4 1 ; FLOAT (Y) INTO FAC, GIVING VALUE 0-255
00CFC4 1 ; ----------------------------------------------------------------------------
00CFC4 1 SNGFLT:
00CFC4 1 A9 00 lda #$00
00CFC6 1 F0 ED beq GIVAYF
00CFC8 1 ; ----------------------------------------------------------------------------
00CFC8 1 ; CHECK FOR DIRECT OR RUNNING MODE
00CFC8 1 ; GIVING ERROR IF DIRECT MODE
00CFC8 1 ; ----------------------------------------------------------------------------
00CFC8 1 ERRDIR:
00CFC8 1 A6 88 ldx CURLIN+1
00CFCA 1 E8 inx
00CFCB 1 D0 A2 bne RTS9
00CFCD 1 A2 16 ldx #ERR_ILLDIR
00CFCF 1 L31AF:
00CFCF 1 4C 4E C2 jmp ERROR
00CFD2 1 DEF:
00CFD2 1 20 FF CF jsr FNC
00CFD5 1 20 C8 CF jsr ERRDIR
00CFD8 1 20 F2 CB jsr CHKOPN
00CFDB 1 A9 80 lda #$80
00CFDD 1 85 61 sta SUBFLG
00CFDF 1 20 FF CC jsr PTRGET
00CFE2 1 20 A4 CA jsr CHKNUM
00CFE5 1 20 EF CB jsr CHKCLS
00CFE8 1 A9 AB lda #TOKEN_EQUAL
00CFEA 1 20 F7 CB jsr SYNCHR
00CFED 1 A5 96 lda VARPNT+1
00CFEF 1 48 pha
00CFF0 1 A5 95 lda VARPNT
00CFF2 1 48 pha
00CFF3 1 A5 C4 lda TXTPTR+1
00CFF5 1 48 pha
00CFF6 1 A5 C3 lda TXTPTR
00CFF8 1 48 pha
00CFF9 1 20 00 C7 jsr DATA
00CFFC 1 4C 6E D0 jmp L3250
00CFFF 1 FNC:
00CFFF 1 A9 9E lda #TOKEN_FN
00D001 1 20 F7 CB jsr SYNCHR
00D004 1 09 80 ora #$80
00D006 1 85 61 sta SUBFLG
00D008 1 20 06 CD jsr PTRGET3
00D00B 1 85 9C sta FNCNAM
00D00D 1 84 9D sty FNCNAM+1
00D00F 1 4C A4 CA jmp CHKNUM
00D012 1 L31F3:
00D012 1 20 FF CF jsr FNC
00D015 1 A5 9D lda FNCNAM+1
00D017 1 48 pha
00D018 1 A5 9C lda FNCNAM
00D01A 1 48 pha
00D01B 1 20 E9 CB jsr PARCHK
00D01E 1 20 A4 CA jsr CHKNUM
00D021 1 68 pla
00D022 1 85 9C sta FNCNAM
00D024 1 68 pla
00D025 1 85 9D sta FNCNAM+1
00D027 1 A0 02 ldy #$02
00D029 1 A2 20 ldx #ERR_UNDEFFN
00D02B 1 B1 9C lda (FNCNAM),y
00D02D 1 F0 A0 beq L31AF
00D02F 1 85 95 sta VARPNT
00D031 1 AA tax
00D032 1 C8 iny
00D033 1 B1 9C lda (FNCNAM),y
00D035 1 85 96 sta VARPNT+1
00D037 1 L3219:
00D037 1 B1 95 lda (VARPNT),y
00D039 1 48 pha
00D03A 1 88 dey
00D03B 1 10 FA bpl L3219
00D03D 1 A4 96 ldy VARPNT+1
00D03F 1 20 6C D7 jsr STORE_FAC_AT_YX_ROUNDED
00D042 1 A5 C4 lda TXTPTR+1
00D044 1 48 pha
00D045 1 A5 C3 lda TXTPTR
00D047 1 48 pha
00D048 1 B1 9C lda (FNCNAM),y
00D04A 1 85 C3 sta TXTPTR
00D04C 1 C8 iny
00D04D 1 B1 9C lda (FNCNAM),y
00D04F 1 85 C4 sta TXTPTR+1
00D051 1 A5 96 lda VARPNT+1
00D053 1 48 pha
00D054 1 A5 95 lda VARPNT
00D056 1 48 pha
00D057 1 20 A1 CA jsr FRMNUM
00D05A 1 68 pla
00D05B 1 85 9C sta FNCNAM
00D05D 1 68 pla
00D05E 1 85 9D sta FNCNAM+1
00D060 1 20 C2 00 jsr CHRGOT
00D063 1 F0 03 beq L324A
00D065 1 4C 00 CC jmp SYNERR
00D068 1 L324A:
00D068 1 68 pla
00D069 1 85 C3 sta TXTPTR
00D06B 1 68 pla
00D06C 1 85 C4 sta TXTPTR+1
00D06E 1 L3250:
00D06E 1 A0 00 ldy #$00
00D070 1 68 pla
00D071 1 91 9C sta (FNCNAM),y
00D073 1 68 pla
00D074 1 C8 iny
00D075 1 91 9C sta (FNCNAM),y
00D077 1 68 pla
00D078 1 C8 iny
00D079 1 91 9C sta (FNCNAM),y
00D07B 1 68 pla
00D07C 1 C8 iny
00D07D 1 91 9C sta (FNCNAM),y
00D07F 1 60 rts
00D080 1 ; ----------------------------------------------------------------------------
00D080 1 ; "STR$" FUNCTION
00D080 1 ; ----------------------------------------------------------------------------
00D080 1 STR:
00D080 1 20 A4 CA jsr CHKNUM
00D083 1 A0 00 ldy #$00
00D085 1 20 64 D9 jsr FOUT1
00D088 1 68 pla
00D089 1 68 pla
00D08A 1 A9 FF lda #$FF
00D08C 1 A0 00 ldy #$00
00D08E 1 F0 12 beq STRLIT
00D090 1 ; ----------------------------------------------------------------------------
00D090 1 ; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
00D090 1 ; ADDRESS IS IN FAC+3,4 AND WHOSE LENGTH IS IN A-REG
00D090 1 ; ----------------------------------------------------------------------------
00D090 1 STRINI:
00D090 1 A6 AE ldx FAC_LAST-1
00D092 1 A4 AF ldy FAC_LAST
00D094 1 86 9E stx DSCPTR
00D096 1 84 9F sty DSCPTR+1
00D098 1 ; ----------------------------------------------------------------------------
00D098 1 ; GET SPACE AND MAKE DESCRIPTOR FOR STRING WHOSE
00D098 1 ; ADDRESS IS IN Y,X AND WHOSE LENGTH IS IN A-REG
00D098 1 ; ----------------------------------------------------------------------------
00D098 1 STRSPA:
00D098 1 20 09 D1 jsr GETSPA
00D09B 1 86 AD stx FAC+1
00D09D 1 84 AE sty FAC+2
00D09F 1 85 AC sta FAC
00D0A1 1 60 rts
00D0A2 1 ; ----------------------------------------------------------------------------
00D0A2 1 ; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
00D0A2 1 ; AND TERMINATED BY $00 OR QUOTATION MARK
00D0A2 1 ; RETURN WITH DESCRIPTOR IN A TEMPORARY
00D0A2 1 ; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
00D0A2 1 ; ----------------------------------------------------------------------------
00D0A2 1 STRLIT:
00D0A2 1 A2 22 ldx #$22
00D0A4 1 86 5B stx CHARAC
00D0A6 1 86 5C stx ENDCHR
00D0A8 1 ; ----------------------------------------------------------------------------
00D0A8 1 ; BUILD A DESCRIPTOR FOR STRING STARTING AT Y,A
00D0A8 1 ; AND TERMINATED BY $00, (CHARAC), OR (ENDCHR)
00D0A8 1 ;
00D0A8 1 ; RETURN WITH DESCRIPTOR IN A TEMPORARY
00D0A8 1 ; AND ADDRESS OF DESCRIPTOR IN FAC+3,4
00D0A8 1 ; ----------------------------------------------------------------------------
00D0A8 1 STRLT2:
00D0A8 1 85 B8 sta STRNG1
00D0AA 1 84 B9 sty STRNG1+1
00D0AC 1 85 AD sta FAC+1
00D0AE 1 84 AE sty FAC+2
00D0B0 1 A0 FF ldy #$FF
00D0B2 1 L3298:
00D0B2 1 C8 iny
00D0B3 1 B1 B8 lda (STRNG1),y
00D0B5 1 F0 0C beq L32A9
00D0B7 1 C5 5B cmp CHARAC
00D0B9 1 F0 04 beq L32A5
00D0BB 1 C5 5C cmp ENDCHR
00D0BD 1 D0 F3 bne L3298
00D0BF 1 L32A5:
00D0BF 1 C9 22 cmp #$22
00D0C1 1 F0 01 beq L32AA
00D0C3 1 L32A9:
00D0C3 1 18 clc
00D0C4 1 L32AA:
00D0C4 1 84 AC sty FAC
00D0C6 1 98 tya
00D0C7 1 65 B8 adc STRNG1
00D0C9 1 85 BA sta STRNG2
00D0CB 1 A6 B9 ldx STRNG1+1
00D0CD 1 90 01 bcc L32B6
00D0CF 1 E8 inx
00D0D0 1 L32B6:
00D0D0 1 86 BB stx STRNG2+1
00D0D2 1 A5 B9 lda STRNG1+1
00D0D4 1 D0 0B bne PUTNEW
00D0D6 1 98 tya
00D0D7 1 20 90 D0 jsr STRINI
00D0DA 1 A6 B8 ldx STRNG1
00D0DC 1 A4 B9 ldy STRNG1+1
00D0DE 1 20 8C D2 jsr MOVSTR
00D0E1 1 ; ----------------------------------------------------------------------------
00D0E1 1 ; STORE DESCRIPTOR IN TEMPORARY DESCRIPTOR STACK
00D0E1 1 ;
00D0E1 1 ; THE DESCRIPTOR IS NOW IN FAC, FAC+1, FAC+2
00D0E1 1 ; PUT ADDRESS OF TEMP DESCRIPTOR IN FAC+3,4
00D0E1 1 ; ----------------------------------------------------------------------------
00D0E1 1 PUTNEW:
00D0E1 1 A6 65 ldx TEMPPT
00D0E3 1 E0 71 cpx #TEMPST+9
00D0E5 1 D0 05 bne PUTEMP
00D0E7 1 A2 1C ldx #ERR_FRMCPX
00D0E9 1 JERR:
00D0E9 1 4C 4E C2 jmp ERROR
00D0EC 1 PUTEMP:
00D0EC 1 A5 AC lda FAC
00D0EE 1 95 00 sta 0,x
00D0F0 1 A5 AD lda FAC+1
00D0F2 1 95 01 sta 1,x
00D0F4 1 A5 AE lda FAC+2
00D0F6 1 95 02 sta 2,x
00D0F8 1 A0 00 ldy #$00
00D0FA 1 86 AE stx FAC_LAST-1
00D0FC 1 84 AF sty FAC_LAST
00D0FE 1 88 dey
00D0FF 1 84 5F sty VALTYP
00D101 1 86 66 stx LASTPT
00D103 1 E8 inx
00D104 1 E8 inx
00D105 1 E8 inx
00D106 1 86 65 stx TEMPPT
00D108 1 60 rts
00D109 1 ; ----------------------------------------------------------------------------
00D109 1 ; MAKE SPACE FOR STRING AT BOTTOM OF STRING SPACE
00D109 1 ; (A)=# BYTES SPACE TO MAKE
00D109 1 ;
00D109 1 ; RETURN WITH (A) SAME,
00D109 1 ; AND Y,X = ADDRESS OF SPACE ALLOCATED
00D109 1 ; ----------------------------------------------------------------------------
00D109 1 GETSPA:
00D109 1 46 60 lsr DATAFLG
00D10B 1 L32F1:
00D10B 1 48 pha
00D10C 1 49 FF eor #$FF
00D10E 1 38 sec
00D10F 1 65 81 adc FRETOP
00D111 1 A4 82 ldy FRETOP+1
00D113 1 B0 01 bcs L32FC
00D115 1 88 dey
00D116 1 L32FC:
00D116 1 C4 80 cpy STREND+1
00D118 1 90 11 bcc L3311
00D11A 1 D0 04 bne L3306
00D11C 1 C5 7F cmp STREND
00D11E 1 90 0B bcc L3311
00D120 1 L3306:
00D120 1 85 81 sta FRETOP
00D122 1 84 82 sty FRETOP+1
00D124 1 85 83 sta FRESPC
00D126 1 84 84 sty FRESPC+1
00D128 1 AA tax
00D129 1 68 pla
00D12A 1 60 rts
00D12B 1 L3311:
00D12B 1 A2 0C ldx #ERR_MEMFULL
00D12D 1 A5 60 lda DATAFLG
00D12F 1 30 B8 bmi JERR
00D131 1 20 3B D1 jsr GARBAG
00D134 1 A9 80 lda #$80
00D136 1 85 60 sta DATAFLG
00D138 1 68 pla
00D139 1 D0 D0 bne L32F1
00D13B 1 ; ----------------------------------------------------------------------------
00D13B 1 ; SHOVE ALL REFERENCED STRINGS AS HIGH AS POSSIBLE
00D13B 1 ; IN MEMORY (AGAINST HIMEM), FREEING UP SPACE
00D13B 1 ; BELOW STRING AREA DOWN TO STREND.
00D13B 1 ; ----------------------------------------------------------------------------
00D13B 1 GARBAG:
00D13B 1 A6 85 ldx MEMSIZ
00D13D 1 A5 86 lda MEMSIZ+1
00D13F 1 FINDHIGHESTSTRING:
00D13F 1 86 81 stx FRETOP
00D141 1 85 82 sta FRETOP+1
00D143 1 A0 00 ldy #$00
00D145 1 84 9D sty FNCNAM+1
00D147 1 A5 7F lda STREND
00D149 1 A6 80 ldx STREND+1
00D14B 1 85 AA sta LOWTR
00D14D 1 86 AB stx LOWTR+1
00D14F 1 A9 68 lda #TEMPST
00D151 1 A2 00 ldx #$00
00D153 1 85 71 sta INDEX
00D155 1 86 72 stx INDEX+1
00D157 1 L333D:
00D157 1 C5 65 cmp TEMPPT
00D159 1 F0 05 beq L3346
00D15B 1 20 CD D1 jsr CHECK_VARIABLE
00D15E 1 F0 F7 beq L333D
00D160 1 L3346:
00D160 1 A9 06 lda #BYTES_PER_VARIABLE
00D162 1 85 A0 sta DSCLEN
00D164 1 A5 7B lda VARTAB
00D166 1 A6 7C ldx VARTAB+1
00D168 1 85 71 sta INDEX
00D16A 1 86 72 stx INDEX+1
00D16C 1 L3352:
00D16C 1 E4 7E cpx ARYTAB+1
00D16E 1 D0 04 bne L335A
00D170 1 C5 7D cmp ARYTAB
00D172 1 F0 05 beq L335F
00D174 1 L335A:
00D174 1 20 C7 D1 jsr CHECK_SIMPLE_VARIABLE
00D177 1 F0 F3 beq L3352
00D179 1 L335F:
00D179 1 85 A4 sta HIGHDS
00D17B 1 86 A5 stx HIGHDS+1
00D17D 1 A9 03 lda #$03 ; OSI GC bugfix -> $04 ???
00D17F 1 85 A0 sta DSCLEN
00D181 1 L3367:
00D181 1 A5 A4 lda HIGHDS
00D183 1 A6 A5 ldx HIGHDS+1
00D185 1 L336B:
00D185 1 E4 80 cpx STREND+1
00D187 1 D0 07 bne L3376
00D189 1 C5 7F cmp STREND
00D18B 1 D0 03 bne L3376
00D18D 1 4C 0C D2 jmp MOVE_HIGHEST_STRING_TO_TOP
00D190 1 L3376:
00D190 1 85 71 sta INDEX
00D192 1 86 72 stx INDEX+1
00D194 1 A0 01 ldy #$01
00D196 1 B1 71 lda (INDEX),y
00D198 1 08 php
00D199 1 C8 iny
00D19A 1 B1 71 lda (INDEX),y
00D19C 1 65 A4 adc HIGHDS
00D19E 1 85 A4 sta HIGHDS
00D1A0 1 C8 iny
00D1A1 1 B1 71 lda (INDEX),y
00D1A3 1 65 A5 adc HIGHDS+1
00D1A5 1 85 A5 sta HIGHDS+1
00D1A7 1 28 plp
00D1A8 1 10 D7 bpl L3367
00D1AA 1 C8 iny
00D1AB 1 B1 71 lda (INDEX),y
00D1AD 1 0A asl a
00D1AE 1 69 05 adc #$05
00D1B0 1 65 71 adc INDEX
00D1B2 1 85 71 sta INDEX
00D1B4 1 90 02 bcc L33A7
00D1B6 1 E6 72 inc INDEX+1
00D1B8 1 L33A7:
00D1B8 1 A6 72 ldx INDEX+1
00D1BA 1 L33A9:
00D1BA 1 E4 A5 cpx HIGHDS+1
00D1BC 1 D0 04 bne L33B1
00D1BE 1 C5 A4 cmp HIGHDS
00D1C0 1 F0 C3 beq L336B
00D1C2 1 L33B1:
00D1C2 1 20 CD D1 jsr CHECK_VARIABLE
00D1C5 1 F0 F3 beq L33A9
00D1C7 1 ; ----------------------------------------------------------------------------
00D1C7 1 ; PROCESS A SIMPLE VARIABLE
00D1C7 1 ; ----------------------------------------------------------------------------
00D1C7 1 CHECK_SIMPLE_VARIABLE:
00D1C7 1 C8 iny
00D1C8 1 B1 71 lda (INDEX),y
00D1CA 1 10 30 bpl CHECK_BUMP
00D1CC 1 C8 iny
00D1CD 1 ; ----------------------------------------------------------------------------
00D1CD 1 ; IF STRING IS NOT EMPTY, CHECK IF IT IS HIGHEST
00D1CD 1 ; ----------------------------------------------------------------------------
00D1CD 1 CHECK_VARIABLE:
00D1CD 1 B1 71 lda (INDEX),y
00D1CF 1 F0 2B beq CHECK_BUMP
00D1D1 1 C8 iny
00D1D2 1 B1 71 lda (INDEX),y
00D1D4 1 AA tax
00D1D5 1 C8 iny
00D1D6 1 B1 71 lda (INDEX),y
00D1D8 1 C5 82 cmp FRETOP+1
00D1DA 1 90 06 bcc L33D5
00D1DC 1 D0 1E bne CHECK_BUMP
00D1DE 1 E4 81 cpx FRETOP
00D1E0 1 B0 1A bcs CHECK_BUMP
00D1E2 1 L33D5:
00D1E2 1 C5 AB cmp LOWTR+1
00D1E4 1 90 16 bcc CHECK_BUMP
00D1E6 1 D0 04 bne L33DF
00D1E8 1 E4 AA cpx LOWTR
00D1EA 1 90 10 bcc CHECK_BUMP
00D1EC 1 L33DF:
00D1EC 1 86 AA stx LOWTR
00D1EE 1 85 AB sta LOWTR+1
00D1F0 1 A5 71 lda INDEX
00D1F2 1 A6 72 ldx INDEX+1
00D1F4 1 85 9C sta FNCNAM
00D1F6 1 86 9D stx FNCNAM+1
00D1F8 1 A5 A0 lda DSCLEN
00D1FA 1 85 A2 sta Z52
00D1FC 1 ; ----------------------------------------------------------------------------
00D1FC 1 ; ADD (DSCLEN) TO PNTR IN INDEX
00D1FC 1 ; RETURN WITH Y=0, PNTR ALSO IN X,A
00D1FC 1 ; ----------------------------------------------------------------------------
00D1FC 1 CHECK_BUMP:
00D1FC 1 A5 A0 lda DSCLEN
00D1FE 1 18 clc
00D1FF 1 65 71 adc INDEX
00D201 1 85 71 sta INDEX
00D203 1 90 02 bcc L33FA
00D205 1 E6 72 inc INDEX+1
00D207 1 L33FA:
00D207 1 A6 72 ldx INDEX+1
00D209 1 A0 00 ldy #$00
00D20B 1 60 rts
00D20C 1 ; ----------------------------------------------------------------------------
00D20C 1 ; FOUND HIGHEST NON-EMPTY STRING, SO MOVE IT
00D20C 1 ; TO TOP AND GO BACK FOR ANOTHER
00D20C 1 ; ----------------------------------------------------------------------------
00D20C 1 MOVE_HIGHEST_STRING_TO_TOP:
00D20C 1 A6 9D ldx FNCNAM+1
00D20E 1 F0 F7 beq L33FA
00D210 1 A5 A2 lda Z52
00D212 1 29 04 and #$04
00D214 1 4A lsr a
00D215 1 A8 tay
00D216 1 85 A2 sta Z52
00D218 1 B1 9C lda (FNCNAM),y
00D21A 1 65 AA adc LOWTR
00D21C 1 85 A6 sta HIGHTR
00D21E 1 A5 AB lda LOWTR+1
00D220 1 69 00 adc #$00
00D222 1 85 A7 sta HIGHTR+1
00D224 1 A5 81 lda FRETOP
00D226 1 A6 82 ldx FRETOP+1
00D228 1 85 A4 sta HIGHDS
00D22A 1 86 A5 stx HIGHDS+1
00D22C 1 20 D6 C1 jsr BLTU2
00D22F 1 A4 A2 ldy Z52
00D231 1 C8 iny
00D232 1 A5 A4 lda HIGHDS
00D234 1 91 9C sta (FNCNAM),y
00D236 1 AA tax
00D237 1 E6 A5 inc HIGHDS+1
00D239 1 A5 A5 lda HIGHDS+1
00D23B 1 C8 iny
00D23C 1 91 9C sta (FNCNAM),y
00D23E 1 4C 3F D1 jmp FINDHIGHESTSTRING
00D241 1 ; ----------------------------------------------------------------------------
00D241 1 ; CONCATENATE TWO STRINGS
00D241 1 ; ----------------------------------------------------------------------------
00D241 1 CAT:
00D241 1 A5 AF lda FAC_LAST
00D243 1 48 pha
00D244 1 A5 AE lda FAC_LAST-1
00D246 1 48 pha
00D247 1 20 94 CB jsr FRM_ELEMENT
00D24A 1 20 A6 CA jsr CHKSTR
00D24D 1 68 pla
00D24E 1 85 B8 sta STRNG1
00D250 1 68 pla
00D251 1 85 B9 sta STRNG1+1
00D253 1 A0 00 ldy #$00
00D255 1 B1 B8 lda (STRNG1),y
00D257 1 18 clc
00D258 1 71 AE adc (FAC_LAST-1),y
00D25A 1 90 05 bcc L3454
00D25C 1 A2 1A ldx #ERR_STRLONG
00D25E 1 4C 4E C2 jmp ERROR
00D261 1 L3454:
00D261 1 20 90 D0 jsr STRINI
00D264 1 20 7E D2 jsr MOVINS
00D267 1 A5 9E lda DSCPTR
00D269 1 A4 9F ldy DSCPTR+1
00D26B 1 20 AE D2 jsr FRETMP
00D26E 1 20 90 D2 jsr MOVSTR1
00D271 1 A5 B8 lda STRNG1
00D273 1 A4 B9 ldy STRNG1+1
00D275 1 20 AE D2 jsr FRETMP
00D278 1 20 E1 D0 jsr PUTNEW
00D27B 1 4C CF CA jmp FRMEVL2
00D27E 1 ; ----------------------------------------------------------------------------
00D27E 1 ; GET STRING DESCRIPTOR POINTED AT BY (STRNG1)
00D27E 1 ; AND MOVE DESCRIBED STRING TO (FRESPC)
00D27E 1 ; ----------------------------------------------------------------------------
00D27E 1 MOVINS:
00D27E 1 A0 00 ldy #$00
00D280 1 B1 B8 lda (STRNG1),y
00D282 1 48 pha
00D283 1 C8 iny
00D284 1 B1 B8 lda (STRNG1),y
00D286 1 AA tax
00D287 1 C8 iny
00D288 1 B1 B8 lda (STRNG1),y
00D28A 1 A8 tay
00D28B 1 68 pla
00D28C 1 ; ----------------------------------------------------------------------------
00D28C 1 ; MOVE STRING AT (Y,X) WITH LENGTH (A)
00D28C 1 ; TO DESTINATION WHOSE ADDRESS IS IN FRESPC,FRESPC+1
00D28C 1 ; ----------------------------------------------------------------------------
00D28C 1 MOVSTR:
00D28C 1 86 71 stx INDEX
00D28E 1 84 72 sty INDEX+1
00D290 1 MOVSTR1:
00D290 1 A8 tay
00D291 1 F0 0A beq L3490
00D293 1 48 pha
00D294 1 L3487:
00D294 1 88 dey
00D295 1 B1 71 lda (INDEX),y
00D297 1 91 83 sta (FRESPC),y
00D299 1 98 tya
00D29A 1 D0 F8 bne L3487
00D29C 1 68 pla
00D29D 1 L3490:
00D29D 1 18 clc
00D29E 1 65 83 adc FRESPC
00D2A0 1 85 83 sta FRESPC
00D2A2 1 90 02 bcc L3499
00D2A4 1 E6 84 inc FRESPC+1
00D2A6 1 L3499:
00D2A6 1 60 rts
00D2A7 1 ; ----------------------------------------------------------------------------
00D2A7 1 ; IF (FAC) IS A TEMPORARY STRING, RELEASE DESCRIPTOR
00D2A7 1 ; ----------------------------------------------------------------------------
00D2A7 1 FRESTR:
00D2A7 1 20 A6 CA jsr CHKSTR
00D2AA 1 ; ----------------------------------------------------------------------------
00D2AA 1 ; IF STRING DESCRIPTOR POINTED TO BY FAC+3,4 IS
00D2AA 1 ; A TEMPORARY STRING, RELEASE IT.
00D2AA 1 ; ----------------------------------------------------------------------------
00D2AA 1 FREFAC:
00D2AA 1 A5 AE lda FAC_LAST-1
00D2AC 1 A4 AF ldy FAC_LAST
00D2AE 1 ; ----------------------------------------------------------------------------
00D2AE 1 ; IF STRING DESCRIPTOR WHOSE ADDRESS IS IN Y,A IS
00D2AE 1 ; A TEMPORARY STRING, RELEASE IT.
00D2AE 1 ; ----------------------------------------------------------------------------
00D2AE 1 FRETMP:
00D2AE 1 85 71 sta INDEX
00D2B0 1 84 72 sty INDEX+1
00D2B2 1 20 DF D2 jsr FRETMS
00D2B5 1 08 php
00D2B6 1 A0 00 ldy #$00
00D2B8 1 B1 71 lda (INDEX),y
00D2BA 1 48 pha
00D2BB 1 C8 iny
00D2BC 1 B1 71 lda (INDEX),y
00D2BE 1 AA tax
00D2BF 1 C8 iny
00D2C0 1 B1 71 lda (INDEX),y
00D2C2 1 A8 tay
00D2C3 1 68 pla
00D2C4 1 28 plp
00D2C5 1 D0 13 bne L34CD
00D2C7 1 C4 82 cpy FRETOP+1
00D2C9 1 D0 0F bne L34CD
00D2CB 1 E4 81 cpx FRETOP
00D2CD 1 D0 0B bne L34CD
00D2CF 1 48 pha
00D2D0 1 18 clc
00D2D1 1 65 81 adc FRETOP
00D2D3 1 85 81 sta FRETOP
00D2D5 1 90 02 bcc L34CC
00D2D7 1 E6 82 inc FRETOP+1
00D2D9 1 L34CC:
00D2D9 1 68 pla
00D2DA 1 L34CD:
00D2DA 1 86 71 stx INDEX
00D2DC 1 84 72 sty INDEX+1
00D2DE 1 60 rts
00D2DF 1 ; ----------------------------------------------------------------------------
00D2DF 1 ; RELEASE TEMPORARY DESCRIPTOR IF Y,A = LASTPT
00D2DF 1 ; ----------------------------------------------------------------------------
00D2DF 1 FRETMS:
00D2DF 1 C4 67 cpy LASTPT+1
00D2E1 1 D0 0C bne L34E2
00D2E3 1 C5 66 cmp LASTPT
00D2E5 1 D0 08 bne L34E2
00D2E7 1 85 65 sta TEMPPT
00D2E9 1 E9 03 sbc #$03
00D2EB 1 85 66 sta LASTPT
00D2ED 1 A0 00 ldy #$00
00D2EF 1 L34E2:
00D2EF 1 60 rts
00D2F0 1 ; ----------------------------------------------------------------------------
00D2F0 1 ; "CHR$" FUNCTION
00D2F0 1 ; ----------------------------------------------------------------------------
00D2F0 1 CHRSTR:
00D2F0 1 20 A5 D3 jsr CONINT
00D2F3 1 8A txa
00D2F4 1 48 pha
00D2F5 1 A9 01 lda #$01
00D2F7 1 20 98 D0 jsr STRSPA
00D2FA 1 68 pla
00D2FB 1 A0 00 ldy #$00
00D2FD 1 91 AD sta (FAC+1),y
00D2FF 1 68 pla
00D300 1 68 pla
00D301 1 4C E1 D0 jmp PUTNEW
00D304 1 ; ----------------------------------------------------------------------------
00D304 1 ; "LEFT$" FUNCTION
00D304 1 ; ----------------------------------------------------------------------------
00D304 1 LEFTSTR:
00D304 1 20 63 D3 jsr SUBSTRING_SETUP
00D307 1 D1 9E cmp (DSCPTR),y
00D309 1 98 tya
00D30A 1 SUBSTRING1:
00D30A 1 90 04 bcc L3503
00D30C 1 B1 9E lda (DSCPTR),y
00D30E 1 AA tax
00D30F 1 98 tya
00D310 1 L3503:
00D310 1 48 pha
00D311 1 SUBSTRING2:
00D311 1 8A txa
00D312 1 SUBSTRING3:
00D312 1 48 pha
00D313 1 20 98 D0 jsr STRSPA
00D316 1 A5 9E lda DSCPTR
00D318 1 A4 9F ldy DSCPTR+1
00D31A 1 20 AE D2 jsr FRETMP
00D31D 1 68 pla
00D31E 1 A8 tay
00D31F 1 68 pla
00D320 1 18 clc
00D321 1 65 71 adc INDEX
00D323 1 85 71 sta INDEX
00D325 1 90 02 bcc L351C
00D327 1 E6 72 inc INDEX+1
00D329 1 L351C:
00D329 1 98 tya
00D32A 1 20 90 D2 jsr MOVSTR1
00D32D 1 4C E1 D0 jmp PUTNEW
00D330 1 ; ----------------------------------------------------------------------------
00D330 1 ; "RIGHT$" FUNCTION
00D330 1 ; ----------------------------------------------------------------------------
00D330 1 RIGHTSTR:
00D330 1 20 63 D3 jsr SUBSTRING_SETUP
00D333 1 18 clc
00D334 1 F1 9E sbc (DSCPTR),y
00D336 1 49 FF eor #$FF
00D338 1 4C 0A D3 jmp SUBSTRING1
00D33B 1 ; ----------------------------------------------------------------------------
00D33B 1 ; "MID$" FUNCTION
00D33B 1 ; ----------------------------------------------------------------------------
00D33B 1 MIDSTR:
00D33B 1 A9 FF lda #$FF
00D33D 1 85 AF sta FAC_LAST
00D33F 1 20 C2 00 jsr CHRGOT
00D342 1 C9 29 cmp #$29
00D344 1 F0 06 beq L353F
00D346 1 20 F5 CB jsr CHKCOM
00D349 1 20 A2 D3 jsr GETBYT
00D34C 1 L353F:
00D34C 1 20 63 D3 jsr SUBSTRING_SETUP
00D34F 1 CA dex
00D350 1 8A txa
00D351 1 48 pha
00D352 1 18 clc
00D353 1 A2 00 ldx #$00
00D355 1 F1 9E sbc (DSCPTR),y
00D357 1 B0 B8 bcs SUBSTRING2
00D359 1 49 FF eor #$FF
00D35B 1 C5 AF cmp FAC_LAST
00D35D 1 90 B3 bcc SUBSTRING3
00D35F 1 A5 AF lda FAC_LAST
00D361 1 B0 AF bcs SUBSTRING3
00D363 1 ; ----------------------------------------------------------------------------
00D363 1 ; COMMON SETUP ROUTINE FOR LEFT$, RIGHT$, MID$:
00D363 1 ; REQUIRE ")"; POP RETURN ADRS, GET DESCRIPTOR
00D363 1 ; ADDRESS, GET 1ST PARAMETER OF COMMAND
00D363 1 ; ----------------------------------------------------------------------------
00D363 1 SUBSTRING_SETUP:
00D363 1 20 EF CB jsr CHKCLS
00D366 1 68 pla
00D367 1 85 A2 sta JMPADRS+1
00D369 1 68 pla
00D36A 1 85 A3 sta JMPADRS+2
00D36C 1 68 pla
00D36D 1 68 pla
00D36E 1 68 pla
00D36F 1 AA tax
00D370 1 68 pla
00D371 1 85 9E sta DSCPTR
00D373 1 68 pla
00D374 1 85 9F sta DSCPTR+1
00D376 1 A0 00 ldy #$00
00D378 1 8A txa
00D379 1 F0 21 beq GOIQ
00D37B 1 E6 A2 inc JMPADRS+1
00D37D 1 6C A2 00 jmp (JMPADRS+1)
00D380 1 ; ----------------------------------------------------------------------------
00D380 1 ; "LEN" FUNCTION
00D380 1 ; ----------------------------------------------------------------------------
00D380 1 LEN:
00D380 1 20 86 D3 jsr GETSTR
00D383 1 SNGFLT1:
00D383 1 4C C4 CF jmp SNGFLT
00D386 1 ; ----------------------------------------------------------------------------
00D386 1 ; IF LAST RESULT IS A TEMPORARY STRING, FREE IT
00D386 1 ; MAKE VALTYP NUMERIC, RETURN LENGTH IN Y-REG
00D386 1 ; ----------------------------------------------------------------------------
00D386 1 GETSTR:
00D386 1 20 A7 D2 jsr FRESTR
00D389 1 A2 00 ldx #$00
00D38B 1 86 5F stx VALTYP
00D38D 1 A8 tay
00D38E 1 60 rts
00D38F 1 ; ----------------------------------------------------------------------------
00D38F 1 ; "ASC" FUNCTION
00D38F 1 ; ----------------------------------------------------------------------------
00D38F 1 ASC:
00D38F 1 20 86 D3 jsr GETSTR
00D392 1 F0 08 beq GOIQ
00D394 1 A0 00 ldy #$00
00D396 1 B1 71 lda (INDEX),y
00D398 1 A8 tay
00D399 1 4C 83 D3 jmp SNGFLT1
00D39C 1 ; ----------------------------------------------------------------------------
00D39C 1 GOIQ:
00D39C 1 4C 7C CE jmp IQERR
00D39F 1 ; ----------------------------------------------------------------------------
00D39F 1 ; SCAN TO NEXT CHARACTER AND CONVERT EXPRESSION
00D39F 1 ; TO SINGLE BYTE IN X-REG
00D39F 1 ; ----------------------------------------------------------------------------
00D39F 1 GTBYTC:
00D39F 1 20 BC 00 jsr CHRGET
00D3A2 1 ; ----------------------------------------------------------------------------
00D3A2 1 ; EVALUATE EXPRESSION AT TXTPTR, AND
00D3A2 1 ; CONVERT IT TO SINGLE BYTE IN X-REG
00D3A2 1 ; ----------------------------------------------------------------------------
00D3A2 1 GETBYT:
00D3A2 1 20 A1 CA jsr FRMNUM
00D3A5 1 ; ----------------------------------------------------------------------------
00D3A5 1 ; CONVERT (FAC) TO SINGLE BYTE INTEGER IN X-REG
00D3A5 1 ; ----------------------------------------------------------------------------
00D3A5 1 CONINT:
00D3A5 1 20 F5 CD jsr MKINT
00D3A8 1 A6 AE ldx FAC_LAST-1
00D3AA 1 D0 F0 bne GOIQ
00D3AC 1 A6 AF ldx FAC_LAST
00D3AE 1 4C C2 00 jmp CHRGOT
00D3B1 1 ; ----------------------------------------------------------------------------
00D3B1 1 ; "VAL" FUNCTION
00D3B1 1 ; ----------------------------------------------------------------------------
00D3B1 1 VAL:
00D3B1 1 20 86 D3 jsr GETSTR
00D3B4 1 D0 03 bne L35AC
00D3B6 1 4C E5 D4 jmp ZERO_FAC
00D3B9 1 L35AC:
00D3B9 1 A6 C3 ldx TXTPTR
00D3BB 1 A4 C4 ldy TXTPTR+1
00D3BD 1 86 BA stx STRNG2
00D3BF 1 84 BB sty STRNG2+1
00D3C1 1 A6 71 ldx INDEX
00D3C3 1 86 C3 stx TXTPTR
00D3C5 1 18 clc
00D3C6 1 65 71 adc INDEX
00D3C8 1 85 73 sta DEST
00D3CA 1 A6 72 ldx INDEX+1
00D3CC 1 86 C4 stx TXTPTR+1
00D3CE 1 90 01 bcc L35C4
00D3D0 1 E8 inx
00D3D1 1 L35C4:
00D3D1 1 86 74 stx DEST+1
00D3D3 1 A0 00 ldy #$00
00D3D5 1 B1 73 lda (DEST),y
00D3D7 1 48 pha
00D3D8 1 A9 00 lda #$00
00D3DA 1 91 73 sta (DEST),y
00D3DC 1 20 C2 00 jsr CHRGOT
00D3DF 1 20 7B D8 jsr FIN
00D3E2 1 68 pla
00D3E3 1 A0 00 ldy #$00
00D3E5 1 91 73 sta (DEST),y
00D3E7 1 ; ----------------------------------------------------------------------------
00D3E7 1 ; COPY STRNG2 INTO TXTPTR
00D3E7 1 ; ----------------------------------------------------------------------------
00D3E7 1 POINT:
00D3E7 1 A6 BA ldx STRNG2
00D3E9 1 A4 BB ldy STRNG2+1
00D3EB 1 86 C3 stx TXTPTR
00D3ED 1 84 C4 sty TXTPTR+1
00D3EF 1 60 rts
00D3F0 1 ; ----------------------------------------------------------------------------
00D3F0 1 ; EVALUATE "EXP1,EXP2"
00D3F0 1 ;
00D3F0 1 ; CONVERT EXP1 TO 16-BIT NUMBER IN LINNUM
00D3F0 1 ; CONVERT EXP2 TO 8-BIT NUMBER IN X-REG
00D3F0 1 ; ----------------------------------------------------------------------------
00D3F0 1 GTNUM:
00D3F0 1 20 A1 CA jsr FRMNUM
00D3F3 1 20 FC D3 jsr GETADR
00D3F6 1 ; ----------------------------------------------------------------------------
00D3F6 1 ; EVALUATE ",EXPRESSION"
00D3F6 1 ; CONVERT EXPRESSION TO SINGLE BYTE IN X-REG
00D3F6 1 ; ----------------------------------------------------------------------------
00D3F6 1 COMBYTE:
00D3F6 1 20 F5 CB jsr CHKCOM
00D3F9 1 4C A2 D3 jmp GETBYT
00D3FC 1 ; ----------------------------------------------------------------------------
00D3FC 1 ; CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM
00D3FC 1 ; ----------------------------------------------------------------------------
00D3FC 1 GETADR:
00D3FC 1 A5 B0 lda FACSIGN
00D3FE 1 30 9C bmi GOIQ
00D400 1 A5 AC lda FAC
00D402 1 C9 91 cmp #$91
00D404 1 B0 96 bcs GOIQ
00D406 1 20 25 D8 jsr QINT
00D409 1 A5 AE lda FAC_LAST-1
00D40B 1 A4 AF ldy FAC_LAST
00D40D 1 84 11 sty LINNUM
00D40F 1 85 12 sta LINNUM+1
00D411 1 60 rts
00D412 1 ; ----------------------------------------------------------------------------
00D412 1 ; "PEEK" FUNCTION
00D412 1 ; ----------------------------------------------------------------------------
00D412 1 PEEK:
00D412 1 20 FC D3 jsr GETADR
00D415 1 A0 00 ldy #$00
00D417 1 ; disallow PEEK between $C000 and $DFFF
00D417 1 B1 11 lda (LINNUM),y
00D419 1 A8 tay
00D41A 1 4C C4 CF jmp SNGFLT
00D41D 1 ; ----------------------------------------------------------------------------
00D41D 1 ; "POKE" STATEMENT
00D41D 1 ; ----------------------------------------------------------------------------
00D41D 1 POKE:
00D41D 1 20 F0 D3 jsr GTNUM
00D420 1 8A txa
00D421 1 A0 00 ldy #$00
00D423 1 91 11 sta (LINNUM),y
00D425 1 60 rts
00D426 1 ; ----------------------------------------------------------------------------
00D426 1 ; "WAIT" STATEMENT
00D426 1 ; ----------------------------------------------------------------------------
00D426 1 WAIT:
00D426 1 20 F0 D3 jsr GTNUM
00D429 1 86 97 stx FORPNT
00D42B 1 A2 00 ldx #$00
00D42D 1 20 C2 00 jsr CHRGOT
00D430 1 F0 03 beq L3628
00D432 1 20 F6 D3 jsr COMBYTE
00D435 1 L3628:
00D435 1 86 98 stx FORPNT+1
00D437 1 A0 00 ldy #$00
00D439 1 L362C:
00D439 1 B1 11 lda (LINNUM),y
00D43B 1 45 98 eor FORPNT+1
00D43D 1 25 97 and FORPNT
00D43F 1 F0 F8 beq L362C
00D441 1 RTS3:
00D441 1 60 rts
00D442 1 TEMP1X = TEMP1+(5-BYTES_FP)
00D442 1 ; ----------------------------------------------------------------------------
00D442 1 ; ADD 0.5 TO FAC
00D442 1 ; ----------------------------------------------------------------------------
00D442 1 FADDH:
00D442 1 A9 8A lda #<CON_HALF
00D444 1 A0 DA ldy #>CON_HALF
00D446 1 4C 60 D4 jmp FADD
00D449 1 ; ----------------------------------------------------------------------------
00D449 1 ; FAC = (Y,A) - FAC
00D449 1 ; ----------------------------------------------------------------------------
00D449 1 FSUB:
00D449 1 20 41 D6 jsr LOAD_ARG_FROM_YA
00D44C 1 ; ----------------------------------------------------------------------------
00D44C 1 ; FAC = ARG - FAC
00D44C 1 ; ----------------------------------------------------------------------------
00D44C 1 FSUBT:
00D44C 1 A5 B0 lda FACSIGN
00D44E 1 49 FF eor #$FF
00D450 1 85 B0 sta FACSIGN
00D452 1 45 B7 eor ARGSIGN
00D454 1 85 B8 sta SGNCPR
00D456 1 A5 AC lda FAC
00D458 1 4C 63 D4 jmp FADDT
00D45B 1 ; ----------------------------------------------------------------------------
00D45B 1 ; Commodore BASIC V2 Easter Egg
00D45B 1 ; ----------------------------------------------------------------------------
00D45B 1 ; ----------------------------------------------------------------------------
00D45B 1 ; SHIFT SMALLER ARGUMENT MORE THAN 7 BITS
00D45B 1 ; ----------------------------------------------------------------------------
00D45B 1 FADD1:
00D45B 1 20 6F D5 jsr SHIFT_RIGHT
00D45E 1 90 3C bcc FADD3
00D460 1 ; ----------------------------------------------------------------------------
00D460 1 ; FAC = (Y,A) + FAC
00D460 1 ; ----------------------------------------------------------------------------
00D460 1 FADD:
00D460 1 20 41 D6 jsr LOAD_ARG_FROM_YA
00D463 1 ; ----------------------------------------------------------------------------
00D463 1 ; FAC = ARG + FAC
00D463 1 ; ----------------------------------------------------------------------------
00D463 1 FADDT:
00D463 1 D0 03 bne L365B
00D465 1 4C 8F D7 jmp COPY_ARG_TO_FAC
00D468 1 L365B:
00D468 1 A6 B9 ldx FACEXTENSION
00D46A 1 86 A3 stx ARGEXTENSION
00D46C 1 A2 B3 ldx #ARG
00D46E 1 A5 B3 lda ARG
00D470 1 FADD2:
00D470 1 A8 tay
00D471 1 F0 CE beq RTS3
00D473 1 38 sec
00D474 1 E5 AC sbc FAC
00D476 1 F0 24 beq FADD3
00D478 1 90 12 bcc L367F
00D47A 1 84 AC sty FAC
00D47C 1 A4 B7 ldy ARGSIGN
00D47E 1 84 B0 sty FACSIGN
00D480 1 49 FF eor #$FF
00D482 1 69 00 adc #$00
00D484 1 A0 00 ldy #$00
00D486 1 84 A3 sty ARGEXTENSION
00D488 1 A2 AC ldx #FAC
00D48A 1 D0 04 bne L3683
00D48C 1 L367F:
00D48C 1 A0 00 ldy #$00
00D48E 1 84 B9 sty FACEXTENSION
00D490 1 L3683:
00D490 1 C9 F9 cmp #$F9
00D492 1 30 C7 bmi FADD1
00D494 1 A8 tay
00D495 1 A5 B9 lda FACEXTENSION
00D497 1 56 01 lsr 1,x
00D499 1 20 86 D5 jsr SHIFT_RIGHT4
00D49C 1 FADD3:
00D49C 1 24 B8 bit SGNCPR
00D49E 1 10 4C bpl FADD4
00D4A0 1 A0 AC ldy #FAC
00D4A2 1 E0 B3 cpx #ARG
00D4A4 1 F0 02 beq L369B
00D4A6 1 A0 B3 ldy #ARG
00D4A8 1 L369B:
00D4A8 1 38 sec
00D4A9 1 49 FF eor #$FF
00D4AB 1 65 A3 adc ARGEXTENSION
00D4AD 1 85 B9 sta FACEXTENSION
00D4AF 1 B9 03 00 lda 3,y
00D4B2 1 F5 03 sbc 3,x
00D4B4 1 85 AF sta FAC+3
00D4B6 1 B9 02 00 lda 2,y
00D4B9 1 F5 02 sbc 2,x
00D4BB 1 85 AE sta FAC+2
00D4BD 1 B9 01 00 lda 1,y
00D4C0 1 F5 01 sbc 1,x
00D4C2 1 85 AD sta FAC+1
00D4C4 1 ; ----------------------------------------------------------------------------
00D4C4 1 ; NORMALIZE VALUE IN FAC
00D4C4 1 ; ----------------------------------------------------------------------------
00D4C4 1 NORMALIZE_FAC1:
00D4C4 1 B0 03 bcs NORMALIZE_FAC2
00D4C6 1 20 2B D5 jsr COMPLEMENT_FAC
00D4C9 1 NORMALIZE_FAC2:
00D4C9 1 A0 00 ldy #$00
00D4CB 1 98 tya
00D4CC 1 18 clc
00D4CD 1 L36C7:
00D4CD 1 A6 AD ldx FAC+1
00D4CF 1 D0 3E bne NORMALIZE_FAC4
00D4D1 1 A6 AE ldx FAC+2
00D4D3 1 86 AD stx FAC+1
00D4D5 1 A6 AF ldx FAC+3
00D4D7 1 86 AE stx FAC+2
00D4D9 1 A6 B9 ldx FACEXTENSION
00D4DB 1 86 AF stx FAC+3
00D4DD 1 84 B9 sty FACEXTENSION
00D4DF 1 69 08 adc #$08
00D4E1 1 ; bugfix?
00D4E1 1 ; fix does not exist on AppleSoft 2
00D4E1 1 C9 18 cmp #MANTISSA_BYTES*8
00D4E3 1 D0 E8 bne L36C7
00D4E5 1 ; ----------------------------------------------------------------------------
00D4E5 1 ; SET FAC = 0
00D4E5 1 ; (ONLY NECESSARY TO ZERO EXPONENT AND SIGN CELLS)
00D4E5 1 ; ----------------------------------------------------------------------------
00D4E5 1 ZERO_FAC:
00D4E5 1 A9 00 lda #$00
00D4E7 1 STA_IN_FAC_SIGN_AND_EXP:
00D4E7 1 85 AC sta FAC
00D4E9 1 STA_IN_FAC_SIGN:
00D4E9 1 85 B0 sta FACSIGN
00D4EB 1 60 rts
00D4EC 1 ; ----------------------------------------------------------------------------
00D4EC 1 ; ADD MANTISSAS OF FAC AND ARG INTO FAC
00D4EC 1 ; ----------------------------------------------------------------------------
00D4EC 1 FADD4:
00D4EC 1 65 A3 adc ARGEXTENSION
00D4EE 1 85 B9 sta FACEXTENSION
00D4F0 1 A5 AF lda FAC+3
00D4F2 1 65 B6 adc ARG+3
00D4F4 1 85 AF sta FAC+3
00D4F6 1 A5 AE lda FAC+2
00D4F8 1 65 B5 adc ARG+2
00D4FA 1 85 AE sta FAC+2
00D4FC 1 A5 AD lda FAC+1
00D4FE 1 65 B4 adc ARG+1
00D500 1 85 AD sta FAC+1
00D502 1 4C 1C D5 jmp NORMALIZE_FAC5
00D505 1 ; ----------------------------------------------------------------------------
00D505 1 ; FINISH NORMALIZING FAC
00D505 1 ; ----------------------------------------------------------------------------
00D505 1 NORMALIZE_FAC3:
00D505 1 69 01 adc #$01
00D507 1 06 B9 asl FACEXTENSION
00D509 1 26 AF rol FAC+3
00D50B 1 26 AE rol FAC+2
00D50D 1 26 AD rol FAC+1
00D50F 1 NORMALIZE_FAC4:
00D50F 1 10 F4 bpl NORMALIZE_FAC3
00D511 1 38 sec
00D512 1 E5 AC sbc FAC
00D514 1 B0 CF bcs ZERO_FAC
00D516 1 49 FF eor #$FF
00D518 1 69 01 adc #$01
00D51A 1 85 AC sta FAC
00D51C 1 NORMALIZE_FAC5:
00D51C 1 90 0C bcc L3764
00D51E 1 NORMALIZE_FAC6:
00D51E 1 E6 AC inc FAC
00D520 1 F0 36 beq OVERFLOW
00D522 1 66 AD ror FAC+1
00D524 1 66 AE ror FAC+2
00D526 1 66 AF ror FAC+3
00D528 1 66 B9 ror FACEXTENSION
00D52A 1 L3764:
00D52A 1 60 rts
00D52B 1 ; ----------------------------------------------------------------------------
00D52B 1 ; 2'S COMPLEMENT OF FAC
00D52B 1 ; ----------------------------------------------------------------------------
00D52B 1 COMPLEMENT_FAC:
00D52B 1 A5 B0 lda FACSIGN
00D52D 1 49 FF eor #$FF
00D52F 1 85 B0 sta FACSIGN
00D531 1 ; ----------------------------------------------------------------------------
00D531 1 ; 2'S COMPLEMENT OF FAC MANTISSA ONLY
00D531 1 ; ----------------------------------------------------------------------------
00D531 1 COMPLEMENT_FAC_MANTISSA:
00D531 1 A5 AD lda FAC+1
00D533 1 49 FF eor #$FF
00D535 1 85 AD sta FAC+1
00D537 1 A5 AE lda FAC+2
00D539 1 49 FF eor #$FF
00D53B 1 85 AE sta FAC+2
00D53D 1 A5 AF lda FAC+3
00D53F 1 49 FF eor #$FF
00D541 1 85 AF sta FAC+3
00D543 1 A5 B9 lda FACEXTENSION
00D545 1 49 FF eor #$FF
00D547 1 85 B9 sta FACEXTENSION
00D549 1 E6 B9 inc FACEXTENSION
00D54B 1 D0 0A bne RTS12
00D54D 1 ; ----------------------------------------------------------------------------
00D54D 1 ; INCREMENT FAC MANTISSA
00D54D 1 ; ----------------------------------------------------------------------------
00D54D 1 INCREMENT_FAC_MANTISSA:
00D54D 1 E6 AF inc FAC+3
00D54F 1 D0 06 bne RTS12
00D551 1 E6 AE inc FAC+2
00D553 1 D0 02 bne RTS12
00D555 1 E6 AD inc FAC+1
00D557 1 RTS12:
00D557 1 60 rts
00D558 1 OVERFLOW:
00D558 1 A2 0A ldx #ERR_OVERFLOW
00D55A 1 4C 4E C2 jmp ERROR
00D55D 1 ; ----------------------------------------------------------------------------
00D55D 1 ; SHIFT 1,X THRU 5,X RIGHT
00D55D 1 ; (A) = NEGATIVE OF SHIFT COUNT
00D55D 1 ; (X) = POINTER TO BYTES TO BE SHIFTED
00D55D 1 ;
00D55D 1 ; RETURN WITH (Y)=0, CARRY=0, EXTENSION BITS IN A-REG
00D55D 1 ; ----------------------------------------------------------------------------
00D55D 1 SHIFT_RIGHT1:
00D55D 1 A2 74 ldx #RESULT-1
00D55F 1 SHIFT_RIGHT2:
00D55F 1 B4 03 ldy 3,x
00D561 1 84 B9 sty FACEXTENSION
00D563 1 B4 02 ldy 2,x
00D565 1 94 03 sty 3,x
00D567 1 B4 01 ldy 1,x
00D569 1 94 02 sty 2,x
00D56B 1 A4 B2 ldy SHIFTSIGNEXT
00D56D 1 94 01 sty 1,x
00D56F 1 ; ----------------------------------------------------------------------------
00D56F 1 ; MAIN ENTRY TO RIGHT SHIFT SUBROUTINE
00D56F 1 ; ----------------------------------------------------------------------------
00D56F 1 SHIFT_RIGHT:
00D56F 1 69 08 adc #$08
00D571 1 30 EC bmi SHIFT_RIGHT2
00D573 1 F0 EA beq SHIFT_RIGHT2
00D575 1 E9 08 sbc #$08
00D577 1 A8 tay
00D578 1 A5 B9 lda FACEXTENSION
00D57A 1 B0 12 bcs SHIFT_RIGHT5
00D57C 1 LB588:
00D57C 1 16 01 asl 1,x
00D57E 1 90 02 bcc LB58E
00D580 1 F6 01 inc 1,x
00D582 1 LB58E:
00D582 1 76 01 ror 1,x
00D584 1 76 01 ror 1,x
00D586 1 ; ----------------------------------------------------------------------------
00D586 1 ; ENTER HERE FOR SHORT SHIFTS WITH NO SIGN EXTENSION
00D586 1 ; ----------------------------------------------------------------------------
00D586 1 SHIFT_RIGHT4:
00D586 1 76 02 ror 2,x
00D588 1 76 03 ror 3,x
00D58A 1 6A ror a
00D58B 1 C8 iny
00D58C 1 D0 EE bne LB588
00D58E 1 SHIFT_RIGHT5:
00D58E 1 18 clc
00D58F 1 60 rts
00D590 1 ; ----------------------------------------------------------------------------
00D590 1 CON_ONE:
00D590 1 81 00 00 00 .byte $81,$00,$00,$00
00D594 1 POLY_LOG:
00D594 1 02 .byte $02
00D595 1 80 19 56 62 .byte $80,$19,$56,$62
00D599 1 80 76 22 F3 .byte $80,$76,$22,$F3
00D59D 1 82 38 AA 40 .byte $82,$38,$AA,$40
00D5A1 1 CON_SQR_HALF:
00D5A1 1 80 35 04 F3 .byte $80,$35,$04,$F3
00D5A5 1 CON_SQR_TWO:
00D5A5 1 81 35 04 F3 .byte $81,$35,$04,$F3
00D5A9 1 CON_NEG_HALF:
00D5A9 1 80 80 00 00 .byte $80,$80,$00,$00
00D5AD 1 CON_LOG_TWO:
00D5AD 1 80 31 72 18 .byte $80,$31,$72,$18
00D5B1 1 ; ----------------------------------------------------------------------------
00D5B1 1 ; "LOG" FUNCTION
00D5B1 1 ; ----------------------------------------------------------------------------
00D5B1 1 LOG:
00D5B1 1 20 BE D7 jsr SIGN
00D5B4 1 F0 02 beq GIQ
00D5B6 1 10 03 bpl LOG2
00D5B8 1 GIQ:
00D5B8 1 4C 7C CE jmp IQERR
00D5BB 1 LOG2:
00D5BB 1 A5 AC lda FAC
00D5BD 1 E9 7F sbc #$7F
00D5BF 1 48 pha
00D5C0 1 A9 80 lda #$80
00D5C2 1 85 AC sta FAC
00D5C4 1 A9 A1 lda #<CON_SQR_HALF
00D5C6 1 A0 D5 ldy #>CON_SQR_HALF
00D5C8 1 20 60 D4 jsr FADD
00D5CB 1 A9 A5 lda #<CON_SQR_TWO
00D5CD 1 A0 D5 ldy #>CON_SQR_TWO
00D5CF 1 20 BE D6 jsr FDIV
00D5D2 1 A9 90 lda #<CON_ONE
00D5D4 1 A0 D5 ldy #>CON_ONE
00D5D6 1 20 49 D4 jsr FSUB
00D5D9 1 A9 94 lda #<POLY_LOG
00D5DB 1 A0 D5 ldy #>POLY_LOG
00D5DD 1 20 62 DB jsr POLYNOMIAL_ODD
00D5E0 1 A9 A9 lda #<CON_NEG_HALF
00D5E2 1 A0 D5 ldy #>CON_NEG_HALF
00D5E4 1 20 60 D4 jsr FADD
00D5E7 1 68 pla
00D5E8 1 20 06 D9 jsr ADDACC
00D5EB 1 A9 AD lda #<CON_LOG_TWO
00D5ED 1 A0 D5 ldy #>CON_LOG_TWO
00D5EF 1 ; ----------------------------------------------------------------------------
00D5EF 1 ; FAC = (Y,A) * FAC
00D5EF 1 ; ----------------------------------------------------------------------------
00D5EF 1 FMULT:
00D5EF 1 20 41 D6 jsr LOAD_ARG_FROM_YA
00D5F2 1 ; ----------------------------------------------------------------------------
00D5F2 1 ; FAC = ARG * FAC
00D5F2 1 ; ----------------------------------------------------------------------------
00D5F2 1 FMULTT:
00D5F2 1 F0 4C beq L3903
00D5F4 1 20 67 D6 jsr ADD_EXPONENTS
00D5F7 1 A9 00 lda #$00
00D5F9 1 85 75 sta RESULT
00D5FB 1 85 76 sta RESULT+1
00D5FD 1 85 77 sta RESULT+2
00D5FF 1 A5 B9 lda FACEXTENSION
00D601 1 20 16 D6 jsr MULTIPLY1
00D604 1 A5 AF lda FAC+3
00D606 1 20 16 D6 jsr MULTIPLY1
00D609 1 A5 AE lda FAC+2
00D60B 1 20 16 D6 jsr MULTIPLY1
00D60E 1 A5 AD lda FAC+1
00D610 1 20 1B D6 jsr MULTIPLY2
00D613 1 4C 30 D7 jmp COPY_RESULT_INTO_FAC
00D616 1 ; ----------------------------------------------------------------------------
00D616 1 ; MULTIPLY ARG BY (A) INTO RESULT
00D616 1 ; ----------------------------------------------------------------------------
00D616 1 MULTIPLY1:
00D616 1 D0 03 bne MULTIPLY2
00D618 1 4C 5D D5 jmp SHIFT_RIGHT1
00D61B 1 MULTIPLY2:
00D61B 1 4A lsr a
00D61C 1 09 80 ora #$80
00D61E 1 L38A7:
00D61E 1 A8 tay
00D61F 1 90 13 bcc L38C3
00D621 1 18 clc
00D622 1 A5 77 lda RESULT+2
00D624 1 65 B6 adc ARG+3
00D626 1 85 77 sta RESULT+2
00D628 1 A5 76 lda RESULT+1
00D62A 1 65 B5 adc ARG+2
00D62C 1 85 76 sta RESULT+1
00D62E 1 A5 75 lda RESULT
00D630 1 65 B4 adc ARG+1
00D632 1 85 75 sta RESULT
00D634 1 L38C3:
00D634 1 66 75 ror RESULT
00D636 1 66 76 ror RESULT+1
00D638 1 ; this seems to be a bad byte in the dump
00D638 1 66 77 ror RESULT+2
00D63A 1 66 B9 ror FACEXTENSION
00D63C 1 98 tya
00D63D 1 4A lsr a
00D63E 1 D0 DE bne L38A7
00D640 1 L3903:
00D640 1 60 rts
00D641 1 ; ----------------------------------------------------------------------------
00D641 1 ; UNPACK NUMBER AT (Y,A) INTO ARG
00D641 1 ; ----------------------------------------------------------------------------
00D641 1 LOAD_ARG_FROM_YA:
00D641 1 85 71 sta INDEX
00D643 1 84 72 sty INDEX+1
00D645 1 A0 03 ldy #BYTES_FP-1
00D647 1 B1 71 lda (INDEX),y
00D649 1 85 B6 sta ARG+3
00D64B 1 88 dey
00D64C 1 B1 71 lda (INDEX),y
00D64E 1 85 B5 sta ARG+2
00D650 1 88 dey
00D651 1 B1 71 lda (INDEX),y
00D653 1 85 B7 sta ARGSIGN
00D655 1 45 B0 eor FACSIGN
00D657 1 85 B8 sta SGNCPR
00D659 1 A5 B7 lda ARGSIGN
00D65B 1 09 80 ora #$80
00D65D 1 85 B4 sta ARG+1
00D65F 1 88 dey
00D660 1 B1 71 lda (INDEX),y
00D662 1 85 B3 sta ARG
00D664 1 A5 AC lda FAC
00D666 1 60 rts
00D667 1 ; ----------------------------------------------------------------------------
00D667 1 ; ADD EXPONENTS OF ARG AND FAC
00D667 1 ; (CALLED BY FMULT AND FDIV)
00D667 1 ;
00D667 1 ; ALSO CHECK FOR OVERFLOW, AND SET RESULT SIGN
00D667 1 ; ----------------------------------------------------------------------------
00D667 1 ADD_EXPONENTS:
00D667 1 A5 B3 lda ARG
00D669 1 ADD_EXPONENTS1:
00D669 1 F0 1F beq ZERO
00D66B 1 18 clc
00D66C 1 65 AC adc FAC
00D66E 1 90 04 bcc L393C
00D670 1 30 1D bmi JOV
00D672 1 18 clc
00D673 1 2C .byte $2C
00D674 1 L393C:
00D674 1 10 14 bpl ZERO
00D676 1 69 80 adc #$80
00D678 1 85 AC sta FAC
00D67A 1 D0 03 bne L3947
00D67C 1 4C E9 D4 jmp STA_IN_FAC_SIGN
00D67F 1 L3947:
00D67F 1 A5 B8 lda SGNCPR
00D681 1 85 B0 sta FACSIGN
00D683 1 60 rts
00D684 1 ; ----------------------------------------------------------------------------
00D684 1 ; IF (FAC) IS POSITIVE, GIVE "OVERFLOW" ERROR
00D684 1 ; IF (FAC) IS NEGATIVE, SET FAC=0, POP ONE RETURN, AND RTS
00D684 1 ; CALLED FROM "EXP" FUNCTION
00D684 1 ; ----------------------------------------------------------------------------
00D684 1 OUTOFRNG:
00D684 1 A5 B0 lda FACSIGN
00D686 1 49 FF eor #$FF
00D688 1 30 05 bmi JOV
00D68A 1 ; ----------------------------------------------------------------------------
00D68A 1 ; POP RETURN ADDRESS AND SET FAC=0
00D68A 1 ; ----------------------------------------------------------------------------
00D68A 1 ZERO:
00D68A 1 68 pla
00D68B 1 68 pla
00D68C 1 4C E5 D4 jmp ZERO_FAC
00D68F 1 JOV:
00D68F 1 4C 58 D5 jmp OVERFLOW
00D692 1 ; ----------------------------------------------------------------------------
00D692 1 ; MULTIPLY FAC BY 10
00D692 1 ; ----------------------------------------------------------------------------
00D692 1 MUL10:
00D692 1 20 9F D7 jsr COPY_FAC_TO_ARG_ROUNDED
00D695 1 AA tax
00D696 1 F0 10 beq L3970
00D698 1 18 clc
00D699 1 69 02 adc #$02
00D69B 1 B0 F2 bcs JOV
00D69D 1 A2 00 ldx #$00
00D69F 1 86 B8 stx SGNCPR
00D6A1 1 20 70 D4 jsr FADD2
00D6A4 1 E6 AC inc FAC
00D6A6 1 F0 E7 beq JOV
00D6A8 1 L3970:
00D6A8 1 60 rts
00D6A9 1 ; ----------------------------------------------------------------------------
00D6A9 1 CONTEN:
00D6A9 1 84 20 00 00 .byte $84,$20,$00,$00
00D6AD 1 ; ----------------------------------------------------------------------------
00D6AD 1 ; DIVIDE FAC BY 10
00D6AD 1 ; ----------------------------------------------------------------------------
00D6AD 1 DIV10:
00D6AD 1 20 9F D7 jsr COPY_FAC_TO_ARG_ROUNDED
00D6B0 1 A9 A9 lda #<CONTEN
00D6B2 1 A0 D6 ldy #>CONTEN
00D6B4 1 A2 00 ldx #$00
00D6B6 1 ; ----------------------------------------------------------------------------
00D6B6 1 ; FAC = ARG / (Y,A)
00D6B6 1 ; ----------------------------------------------------------------------------
00D6B6 1 DIV:
00D6B6 1 86 B8 stx SGNCPR
00D6B8 1 20 3F D7 jsr LOAD_FAC_FROM_YA
00D6BB 1 4C C1 D6 jmp FDIVT
00D6BE 1 ; ----------------------------------------------------------------------------
00D6BE 1 ; FAC = (Y,A) / FAC
00D6BE 1 ; ----------------------------------------------------------------------------
00D6BE 1 FDIV:
00D6BE 1 20 41 D6 jsr LOAD_ARG_FROM_YA
00D6C1 1 ; ----------------------------------------------------------------------------
00D6C1 1 ; FAC = ARG / FAC
00D6C1 1 ; ----------------------------------------------------------------------------
00D6C1 1 FDIVT:
00D6C1 1 F0 68 beq L3A02
00D6C3 1 20 AE D7 jsr ROUND_FAC
00D6C6 1 A9 00 lda #$00
00D6C8 1 38 sec
00D6C9 1 E5 AC sbc FAC
00D6CB 1 85 AC sta FAC
00D6CD 1 20 67 D6 jsr ADD_EXPONENTS
00D6D0 1 E6 AC inc FAC
00D6D2 1 F0 BB beq JOV
00D6D4 1 A2 FD ldx #-MANTISSA_BYTES
00D6D6 1 A9 01 lda #$01
00D6D8 1 L39A1:
00D6D8 1 A4 B4 ldy ARG+1
00D6DA 1 C4 AD cpy FAC+1
00D6DC 1 D0 0A bne L39B7
00D6DE 1 A4 B5 ldy ARG+2
00D6E0 1 C4 AE cpy FAC+2
00D6E2 1 D0 04 bne L39B7
00D6E4 1 A4 B6 ldy ARG+3
00D6E6 1 C4 AF cpy FAC+3
00D6E8 1 L39B7:
00D6E8 1 08 php
00D6E9 1 2A rol a
00D6EA 1 90 09 bcc L39C4
00D6EC 1 E8 inx
00D6ED 1 95 77 sta RESULT_LAST-1,x
00D6EF 1 F0 2A beq L39F2
00D6F1 1 10 2C bpl L39F6
00D6F3 1 A9 01 lda #$01
00D6F5 1 L39C4:
00D6F5 1 28 plp
00D6F6 1 B0 0C bcs L39D5
00D6F8 1 L39C7:
00D6F8 1 06 B6 asl ARG_LAST
00D6FA 1 26 B5 rol ARG+2
00D6FC 1 26 B4 rol ARG+1
00D6FE 1 B0 E8 bcs L39B7
00D700 1 30 D6 bmi L39A1
00D702 1 10 E4 bpl L39B7
00D704 1 L39D5:
00D704 1 A8 tay
00D705 1 A5 B6 lda ARG+3
00D707 1 E5 AF sbc FAC+3
00D709 1 85 B6 sta ARG+3
00D70B 1 A5 B5 lda ARG+2
00D70D 1 E5 AE sbc FAC+2
00D70F 1 85 B5 sta ARG+2
00D711 1 A5 B4 lda ARG+1
00D713 1 E5 AD sbc FAC+1
00D715 1 85 B4 sta ARG+1
00D717 1 98 tya
00D718 1 4C F8 D6 jmp L39C7
00D71B 1 L39F2:
00D71B 1 A9 40 lda #$40
00D71D 1 D0 D6 bne L39C4
00D71F 1 L39F6:
00D71F 1 0A asl a
00D720 1 0A asl a
00D721 1 0A asl a
00D722 1 0A asl a
00D723 1 0A asl a
00D724 1 0A asl a
00D725 1 85 B9 sta FACEXTENSION
00D727 1 28 plp
00D728 1 4C 30 D7 jmp COPY_RESULT_INTO_FAC
00D72B 1 L3A02:
00D72B 1 A2 14 ldx #ERR_ZERODIV
00D72D 1 4C 4E C2 jmp ERROR
00D730 1 ; ----------------------------------------------------------------------------
00D730 1 ; COPY RESULT INTO FAC MANTISSA, AND NORMALIZE
00D730 1 ; ----------------------------------------------------------------------------
00D730 1 COPY_RESULT_INTO_FAC:
00D730 1 A5 75 lda RESULT
00D732 1 85 AD sta FAC+1
00D734 1 A5 76 lda RESULT+1
00D736 1 85 AE sta FAC+2
00D738 1 A5 77 lda RESULT+2
00D73A 1 85 AF sta FAC+3
00D73C 1 4C C9 D4 jmp NORMALIZE_FAC2
00D73F 1 ; ----------------------------------------------------------------------------
00D73F 1 ; UNPACK (Y,A) INTO FAC
00D73F 1 ; ----------------------------------------------------------------------------
00D73F 1 LOAD_FAC_FROM_YA:
00D73F 1 85 71 sta INDEX
00D741 1 84 72 sty INDEX+1
00D743 1 A0 03 ldy #MANTISSA_BYTES
00D745 1 B1 71 lda (INDEX),y
00D747 1 85 AF sta FAC+3
00D749 1 88 dey
00D74A 1 B1 71 lda (INDEX),y
00D74C 1 85 AE sta FAC+2
00D74E 1 88 dey
00D74F 1 B1 71 lda (INDEX),y
00D751 1 85 B0 sta FACSIGN
00D753 1 09 80 ora #$80
00D755 1 85 AD sta FAC+1
00D757 1 88 dey
00D758 1 B1 71 lda (INDEX),y
00D75A 1 85 AC sta FAC
00D75C 1 84 B9 sty FACEXTENSION
00D75E 1 60 rts
00D75F 1 ; ----------------------------------------------------------------------------
00D75F 1 ; ROUND FAC, STORE IN TEMP2
00D75F 1 ; ----------------------------------------------------------------------------
00D75F 1 STORE_FAC_IN_TEMP2_ROUNDED:
00D75F 1 A2 A8 ldx #TEMP2
00D761 1 2C .byte $2C
00D762 1 ; ----------------------------------------------------------------------------
00D762 1 ; ROUND FAC, STORE IN TEMP1
00D762 1 ; ----------------------------------------------------------------------------
00D762 1 STORE_FAC_IN_TEMP1_ROUNDED:
00D762 1 A2 A4 ldx #TEMP1X
00D764 1 A0 00 ldy #$00
00D766 1 F0 04 beq STORE_FAC_AT_YX_ROUNDED
00D768 1 ; ----------------------------------------------------------------------------
00D768 1 ; ROUND FAC, AND STORE WHERE FORPNT POINTS
00D768 1 ; ----------------------------------------------------------------------------
00D768 1 SETFOR:
00D768 1 A6 97 ldx FORPNT
00D76A 1 A4 98 ldy FORPNT+1
00D76C 1 ; ----------------------------------------------------------------------------
00D76C 1 ; ROUND FAC, AND STORE AT (Y,X)
00D76C 1 ; ----------------------------------------------------------------------------
00D76C 1 STORE_FAC_AT_YX_ROUNDED:
00D76C 1 20 AE D7 jsr ROUND_FAC
00D76F 1 86 71 stx INDEX
00D771 1 84 72 sty INDEX+1
00D773 1 A0 03 ldy #MANTISSA_BYTES
00D775 1 A5 AF lda FAC+3
00D777 1 91 71 sta (INDEX),y
00D779 1 88 dey
00D77A 1 A5 AE lda FAC+2
00D77C 1 91 71 sta (INDEX),y
00D77E 1 88 dey
00D77F 1 A5 B0 lda FACSIGN
00D781 1 09 7F ora #$7F
00D783 1 25 AD and FAC+1
00D785 1 91 71 sta (INDEX),y
00D787 1 88 dey
00D788 1 A5 AC lda FAC
00D78A 1 91 71 sta (INDEX),y
00D78C 1 84 B9 sty FACEXTENSION
00D78E 1 60 rts
00D78F 1 ; ----------------------------------------------------------------------------
00D78F 1 ; COPY ARG INTO FAC
00D78F 1 ; ----------------------------------------------------------------------------
00D78F 1 COPY_ARG_TO_FAC:
00D78F 1 A5 B7 lda ARGSIGN
00D791 1 MFA:
00D791 1 85 B0 sta FACSIGN
00D793 1 A2 04 ldx #BYTES_FP
00D795 1 L3A7A:
00D795 1 B5 B2 lda SHIFTSIGNEXT,x
00D797 1 95 AB sta EXPSGN,x
00D799 1 CA dex
00D79A 1 D0 F9 bne L3A7A
00D79C 1 86 B9 stx FACEXTENSION
00D79E 1 60 rts
00D79F 1 ; ----------------------------------------------------------------------------
00D79F 1 ; ROUND FAC AND COPY TO ARG
00D79F 1 ; ----------------------------------------------------------------------------
00D79F 1 COPY_FAC_TO_ARG_ROUNDED:
00D79F 1 20 AE D7 jsr ROUND_FAC
00D7A2 1 MAF:
00D7A2 1 A2 05 ldx #BYTES_FP+1
00D7A4 1 L3A89:
00D7A4 1 B5 AB lda EXPSGN,x
00D7A6 1 95 B2 sta SHIFTSIGNEXT,x
00D7A8 1 CA dex
00D7A9 1 D0 F9 bne L3A89
00D7AB 1 86 B9 stx FACEXTENSION
00D7AD 1 RTS14:
00D7AD 1 60 rts
00D7AE 1 ; ----------------------------------------------------------------------------
00D7AE 1 ; ROUND FAC USING EXTENSION BYTE
00D7AE 1 ; ----------------------------------------------------------------------------
00D7AE 1 ROUND_FAC:
00D7AE 1 A5 AC lda FAC
00D7B0 1 F0 FB beq RTS14
00D7B2 1 06 B9 asl FACEXTENSION
00D7B4 1 90 F7 bcc RTS14
00D7B6 1 ; ----------------------------------------------------------------------------
00D7B6 1 ; INCREMENT MANTISSA AND RE-NORMALIZE IF CARRY
00D7B6 1 ; ----------------------------------------------------------------------------
00D7B6 1 INCREMENT_MANTISSA:
00D7B6 1 20 4D D5 jsr INCREMENT_FAC_MANTISSA
00D7B9 1 D0 F2 bne RTS14
00D7BB 1 4C 1E D5 jmp NORMALIZE_FAC6
00D7BE 1 ; ----------------------------------------------------------------------------
00D7BE 1 ; TEST FAC FOR ZERO AND SIGN
00D7BE 1 ;
00D7BE 1 ; FAC > 0, RETURN +1
00D7BE 1 ; FAC = 0, RETURN 0
00D7BE 1 ; FAC < 0, RETURN -1
00D7BE 1 ; ----------------------------------------------------------------------------
00D7BE 1 SIGN:
00D7BE 1 A5 AC lda FAC
00D7C0 1 F0 09 beq RTS15
00D7C2 1 L3AA7:
00D7C2 1 A5 B0 lda FACSIGN
00D7C4 1 SIGN2:
00D7C4 1 2A rol a
00D7C5 1 A9 FF lda #$FF
00D7C7 1 B0 02 bcs RTS15
00D7C9 1 A9 01 lda #$01
00D7CB 1 RTS15:
00D7CB 1 60 rts
00D7CC 1 ; ----------------------------------------------------------------------------
00D7CC 1 ; "SGN" FUNCTION
00D7CC 1 ; ----------------------------------------------------------------------------
00D7CC 1 SGN:
00D7CC 1 20 BE D7 jsr SIGN
00D7CF 1 ; ----------------------------------------------------------------------------
00D7CF 1 ; CONVERT (A) INTO FAC, AS SIGNED VALUE -128 TO +127
00D7CF 1 ; ----------------------------------------------------------------------------
00D7CF 1 FLOAT:
00D7CF 1 85 AD sta FAC+1
00D7D1 1 A9 00 lda #$00
00D7D3 1 85 AE sta FAC+2
00D7D5 1 A2 88 ldx #$88
00D7D7 1 ; ----------------------------------------------------------------------------
00D7D7 1 ; FLOAT UNSIGNED VALUE IN FAC+1,2
00D7D7 1 ; (X) = EXPONENT
00D7D7 1 ; ----------------------------------------------------------------------------
00D7D7 1 FLOAT1:
00D7D7 1 A5 AD lda FAC+1
00D7D9 1 49 FF eor #$FF
00D7DB 1 2A rol a
00D7DC 1 ; ----------------------------------------------------------------------------
00D7DC 1 ; FLOAT UNSIGNED VALUE IN FAC+1,2
00D7DC 1 ; (X) = EXPONENT
00D7DC 1 ; C=0 TO MAKE VALUE NEGATIVE
00D7DC 1 ; C=1 TO MAKE VALUE POSITIVE
00D7DC 1 ; ----------------------------------------------------------------------------
00D7DC 1 FLOAT2:
00D7DC 1 A9 00 lda #$00
00D7DE 1 85 AF sta FAC+3
00D7E0 1 86 AC stx FAC
00D7E2 1 85 B9 sta FACEXTENSION
00D7E4 1 85 B0 sta FACSIGN
00D7E6 1 4C C4 D4 jmp NORMALIZE_FAC1
00D7E9 1 ; ----------------------------------------------------------------------------
00D7E9 1 ; "ABS" FUNCTION
00D7E9 1 ; ----------------------------------------------------------------------------
00D7E9 1 ABS:
00D7E9 1 46 B0 lsr FACSIGN
00D7EB 1 60 rts
00D7EC 1 ; ----------------------------------------------------------------------------
00D7EC 1 ; COMPARE FAC WITH PACKED # AT (Y,A)
00D7EC 1 ; RETURN A=1,0,-1 AS (Y,A) IS <,=,> FAC
00D7EC 1 ; ----------------------------------------------------------------------------
00D7EC 1 FCOMP:
00D7EC 1 85 73 sta DEST
00D7EE 1 ; ----------------------------------------------------------------------------
00D7EE 1 ; SPECIAL ENTRY FROM "NEXT" PROCESSOR
00D7EE 1 ; "DEST" ALREADY SET UP
00D7EE 1 ; ----------------------------------------------------------------------------
00D7EE 1 FCOMP2:
00D7EE 1 84 74 sty DEST+1
00D7F0 1 A0 00 ldy #$00
00D7F2 1 B1 73 lda (DEST),y
00D7F4 1 C8 iny
00D7F5 1 AA tax
00D7F6 1 F0 C6 beq SIGN
00D7F8 1 B1 73 lda (DEST),y
00D7FA 1 45 B0 eor FACSIGN
00D7FC 1 30 C4 bmi L3AA7
00D7FE 1 E4 AC cpx FAC
00D800 1 D0 1A bne L3B0A
00D802 1 B1 73 lda (DEST),y
00D804 1 09 80 ora #$80
00D806 1 C5 AD cmp FAC+1
00D808 1 D0 12 bne L3B0A
00D80A 1 C8 iny
00D80B 1 B1 73 lda (DEST),y
00D80D 1 C5 AE cmp FAC+2
00D80F 1 D0 0B bne L3B0A
00D811 1 C8 iny
00D812 1 A9 7F lda #$7F
00D814 1 C5 B9 cmp FACEXTENSION
00D816 1 B1 73 lda (DEST),y
00D818 1 E5 AF sbc FAC_LAST
00D81A 1 F0 28 beq L3B32
00D81C 1 L3B0A:
00D81C 1 A5 B0 lda FACSIGN
00D81E 1 90 02 bcc L3B10
00D820 1 49 FF eor #$FF
00D822 1 L3B10:
00D822 1 4C C4 D7 jmp SIGN2
00D825 1 ; ----------------------------------------------------------------------------
00D825 1 ; QUICK INTEGER FUNCTION
00D825 1 ;
00D825 1 ; CONVERTS FP VALUE IN FAC TO INTEGER VALUE
00D825 1 ; IN FAC+1...FAC+4, BY SHIFTING RIGHT WITH SIGN
00D825 1 ; EXTENSION UNTIL FRACTIONAL BITS ARE OUT.
00D825 1 ;
00D825 1 ; THIS SUBROUTINE ASSUMES THE EXPONENT < 32.
00D825 1 ; ----------------------------------------------------------------------------
00D825 1 QINT:
00D825 1 A5 AC lda FAC
00D827 1 F0 4A beq QINT3
00D829 1 38 sec
00D82A 1 E9 98 sbc #120+8*BYTES_FP
00D82C 1 24 B0 bit FACSIGN
00D82E 1 10 09 bpl L3B27
00D830 1 AA tax
00D831 1 A9 FF lda #$FF
00D833 1 85 B2 sta SHIFTSIGNEXT
00D835 1 20 31 D5 jsr COMPLEMENT_FAC_MANTISSA
00D838 1 8A txa
00D839 1 L3B27:
00D839 1 A2 AC ldx #FAC
00D83B 1 C9 F9 cmp #$F9
00D83D 1 10 06 bpl QINT2
00D83F 1 20 6F D5 jsr SHIFT_RIGHT
00D842 1 84 B2 sty SHIFTSIGNEXT
00D844 1 L3B32:
00D844 1 60 rts
00D845 1 QINT2:
00D845 1 A8 tay
00D846 1 A5 B0 lda FACSIGN
00D848 1 29 80 and #$80
00D84A 1 46 AD lsr FAC+1
00D84C 1 05 AD ora FAC+1
00D84E 1 85 AD sta FAC+1
00D850 1 20 86 D5 jsr SHIFT_RIGHT4
00D853 1 84 B2 sty SHIFTSIGNEXT
00D855 1 60 rts
00D856 1 ; ----------------------------------------------------------------------------
00D856 1 ; "INT" FUNCTION
00D856 1 ;
00D856 1 ; USES QINT TO CONVERT (FAC) TO INTEGER FORM,
00D856 1 ; AND THEN REFLOATS THE INTEGER.
00D856 1 ; ----------------------------------------------------------------------------
00D856 1 INT:
00D856 1 A5 AC lda FAC
00D858 1 C9 98 cmp #120+8*BYTES_FP
00D85A 1 B0 1E bcs RTS17
00D85C 1 20 25 D8 jsr QINT
00D85F 1 84 B9 sty FACEXTENSION
00D861 1 A5 B0 lda FACSIGN
00D863 1 84 B0 sty FACSIGN
00D865 1 49 80 eor #$80
00D867 1 2A rol a
00D868 1 A9 98 lda #120+8*BYTES_FP
00D86A 1 85 AC sta FAC
00D86C 1 A5 AF lda FAC_LAST
00D86E 1 85 5B sta CHARAC
00D870 1 4C C4 D4 jmp NORMALIZE_FAC1
00D873 1 QINT3:
00D873 1 85 AD sta FAC+1
00D875 1 85 AE sta FAC+2
00D877 1 85 AF sta FAC+3
00D879 1 A8 tay
00D87A 1 RTS17:
00D87A 1 60 rts
00D87B 1 ; ----------------------------------------------------------------------------
00D87B 1 ; CONVERT STRING TO FP VALUE IN FAC
00D87B 1 ;
00D87B 1 ; STRING POINTED TO BY TXTPTR
00D87B 1 ; FIRST CHAR ALREADY SCANNED BY CHRGET
00D87B 1 ; (A) = FIRST CHAR, C=0 IF DIGIT.
00D87B 1 ; ----------------------------------------------------------------------------
00D87B 1 FIN:
00D87B 1 A0 00 ldy #$00
00D87D 1 A2 09 ldx #SERLEN-TMPEXP
00D87F 1 L3B6F:
00D87F 1 94 A8 sty TMPEXP,x
00D881 1 CA dex
00D882 1 10 FB bpl L3B6F
00D884 1 90 0F bcc FIN2
00D886 1 C9 2D cmp #$2D
00D888 1 D0 04 bne L3B7E
00D88A 1 86 B1 stx SERLEN
00D88C 1 F0 04 beq FIN1
00D88E 1 L3B7E:
00D88E 1 C9 2B cmp #$2B
00D890 1 D0 05 bne FIN3
00D892 1 FIN1:
00D892 1 20 BC 00 jsr CHRGET
00D895 1 FIN2:
00D895 1 90 5B bcc FIN9
00D897 1 FIN3:
00D897 1 C9 2E cmp #$2E
00D899 1 F0 2E beq FIN10
00D89B 1 C9 45 cmp #$45
00D89D 1 D0 30 bne FIN7
00D89F 1 20 BC 00 jsr CHRGET
00D8A2 1 90 17 bcc FIN5
00D8A4 1 C9 A4 cmp #TOKEN_MINUS
00D8A6 1 F0 0E beq L3BA6
00D8A8 1 C9 2D cmp #$2D
00D8AA 1 F0 0A beq L3BA6
00D8AC 1 C9 A3 cmp #TOKEN_PLUS
00D8AE 1 F0 08 beq FIN4
00D8B0 1 C9 2B cmp #$2B
00D8B2 1 F0 04 beq FIN4
00D8B4 1 D0 07 bne FIN6
00D8B6 1 L3BA6:
00D8B6 1 66 AB ror EXPSGN
00D8B8 1 FIN4:
00D8B8 1 20 BC 00 jsr CHRGET
00D8BB 1 FIN5:
00D8BB 1 90 5C bcc GETEXP
00D8BD 1 FIN6:
00D8BD 1 24 AB bit EXPSGN
00D8BF 1 10 0E bpl FIN7
00D8C1 1 A9 00 lda #$00
00D8C3 1 38 sec
00D8C4 1 E5 A9 sbc EXPON
00D8C6 1 4C D1 D8 jmp FIN8
00D8C9 1 ; ----------------------------------------------------------------------------
00D8C9 1 ; FOUND A DECIMAL POINT
00D8C9 1 ; ----------------------------------------------------------------------------
00D8C9 1 FIN10:
00D8C9 1 66 AA ror LOWTR
00D8CB 1 24 AA bit LOWTR
00D8CD 1 50 C3 bvc FIN1
00D8CF 1 ; ----------------------------------------------------------------------------
00D8CF 1 ; NUMBER TERMINATED, ADJUST EXPONENT NOW
00D8CF 1 ; ----------------------------------------------------------------------------
00D8CF 1 FIN7:
00D8CF 1 A5 A9 lda EXPON
00D8D1 1 FIN8:
00D8D1 1 38 sec
00D8D2 1 E5 A8 sbc INDX
00D8D4 1 85 A9 sta EXPON
00D8D6 1 F0 12 beq L3BEE
00D8D8 1 10 09 bpl L3BE7
00D8DA 1 L3BDE:
00D8DA 1 20 AD D6 jsr DIV10
00D8DD 1 E6 A9 inc EXPON
00D8DF 1 D0 F9 bne L3BDE
00D8E1 1 F0 07 beq L3BEE
00D8E3 1 L3BE7:
00D8E3 1 20 92 D6 jsr MUL10
00D8E6 1 C6 A9 dec EXPON
00D8E8 1 D0 F9 bne L3BE7
00D8EA 1 L3BEE:
00D8EA 1 A5 B1 lda SERLEN
00D8EC 1 30 01 bmi L3BF3
00D8EE 1 60 rts
00D8EF 1 L3BF3:
00D8EF 1 4C E3 DA jmp NEGOP
00D8F2 1 ; ----------------------------------------------------------------------------
00D8F2 1 ; ACCUMULATE A DIGIT INTO FAC
00D8F2 1 ; ----------------------------------------------------------------------------
00D8F2 1 FIN9:
00D8F2 1 48 pha
00D8F3 1 24 AA bit LOWTR
00D8F5 1 10 02 bpl L3BFD
00D8F7 1 E6 A8 inc INDX
00D8F9 1 L3BFD:
00D8F9 1 20 92 D6 jsr MUL10
00D8FC 1 68 pla
00D8FD 1 38 sec
00D8FE 1 E9 30 sbc #$30
00D900 1 20 06 D9 jsr ADDACC
00D903 1 4C 92 D8 jmp FIN1
00D906 1 ; ----------------------------------------------------------------------------
00D906 1 ; ADD (A) TO FAC
00D906 1 ; ----------------------------------------------------------------------------
00D906 1 ADDACC:
00D906 1 48 pha
00D907 1 20 9F D7 jsr COPY_FAC_TO_ARG_ROUNDED
00D90A 1 68 pla
00D90B 1 20 CF D7 jsr FLOAT
00D90E 1 A5 B7 lda ARGSIGN
00D910 1 45 B0 eor FACSIGN
00D912 1 85 B8 sta SGNCPR
00D914 1 A6 AC ldx FAC
00D916 1 4C 63 D4 jmp FADDT
00D919 1 ; ----------------------------------------------------------------------------
00D919 1 ; ACCUMULATE DIGIT OF EXPONENT
00D919 1 ; ----------------------------------------------------------------------------
00D919 1 GETEXP:
00D919 1 A5 A9 lda EXPON
00D91B 1 C9 0A cmp #MAX_EXPON
00D91D 1 90 09 bcc L3C2C
00D91F 1 A9 64 lda #$64
00D921 1 24 AB bit EXPSGN
00D923 1 30 11 bmi L3C3A
00D925 1 4C 58 D5 jmp OVERFLOW
00D928 1 L3C2C:
00D928 1 0A asl a
00D929 1 0A asl a
00D92A 1 18 clc
00D92B 1 65 A9 adc EXPON
00D92D 1 0A asl a
00D92E 1 18 clc
00D92F 1 A0 00 ldy #$00
00D931 1 71 C3 adc (TXTPTR),y
00D933 1 38 sec
00D934 1 E9 30 sbc #$30
00D936 1 L3C3A:
00D936 1 85 A9 sta EXPON
00D938 1 4C B8 D8 jmp FIN4
00D93B 1 ; ----------------------------------------------------------------------------
00D93B 1 ; these values are /1000 of what the labels say
00D93B 1 CON_99999999_9:
00D93B 1 91 43 4F F8 .byte $91,$43,$4F,$F8
00D93F 1 CON_999999999:
00D93F 1 94 74 23 F7 .byte $94,$74,$23,$F7
00D943 1 CON_BILLION:
00D943 1 94 74 24 00 .byte $94,$74,$24,$00
00D947 1 ; ----------------------------------------------------------------------------
00D947 1 ; PRINT "IN <LINE #>"
00D947 1 ; ----------------------------------------------------------------------------
00D947 1 INPRT:
00D947 1 A9 8D lda #<QT_IN
00D949 1 A0 C1 ldy #>QT_IN
00D94B 1 20 5F D9 jsr GOSTROUT2
00D94E 1 A5 88 lda CURLIN+1
00D950 1 A6 87 ldx CURLIN
00D952 1 ; ----------------------------------------------------------------------------
00D952 1 ; PRINT A,X AS DECIMAL INTEGER
00D952 1 ; ----------------------------------------------------------------------------
00D952 1 LINPRT:
00D952 1 85 AD sta FAC+1
00D954 1 86 AE stx FAC+2
00D956 1 A2 90 ldx #$90
00D958 1 38 sec
00D959 1 20 DC D7 jsr FLOAT2
00D95C 1 20 62 D9 jsr FOUT
00D95F 1 GOSTROUT2:
00D95F 1 4C B7 C8 jmp STROUT
00D962 1 ; ----------------------------------------------------------------------------
00D962 1 ; CONVERT (FAC) TO STRING STARTING AT STACK
00D962 1 ; RETURN WITH (Y,A) POINTING AT STRING
00D962 1 ; ----------------------------------------------------------------------------
00D962 1 FOUT:
00D962 1 A0 01 ldy #$01
00D964 1 ; ----------------------------------------------------------------------------
00D964 1 ; "STR$" FUNCTION ENTERS HERE, WITH (Y)=0
00D964 1 ; SO THAT RESULT STRING STARTS AT STACK-1
00D964 1 ; (THIS IS USED AS A FLAG)
00D964 1 ; ----------------------------------------------------------------------------
00D964 1 FOUT1:
00D964 1 A9 20 lda #$20
00D966 1 24 B0 bit FACSIGN
00D968 1 10 02 bpl L3C73
00D96A 1 A9 2D lda #$2D
00D96C 1 L3C73:
00D96C 1 99 FF 00 sta $FF,y
00D96F 1 85 B0 sta FACSIGN
00D971 1 84 BA sty STRNG2
00D973 1 C8 iny
00D974 1 A9 30 lda #$30
00D976 1 A6 AC ldx FAC
00D978 1 D0 03 bne L3C84
00D97A 1 4C 7D DA jmp FOUT4
00D97D 1 L3C84:
00D97D 1 A9 00 lda #$00
00D97F 1 E0 80 cpx #$80
00D981 1 F0 02 beq L3C8C
00D983 1 B0 09 bcs L3C95
00D985 1 L3C8C:
00D985 1 A9 43 lda #<CON_BILLION
00D987 1 A0 D9 ldy #>CON_BILLION
00D989 1 20 EF D5 jsr FMULT
00D98C 1 A9 FA lda #-6 ; exponent adjustment
00D98E 1 L3C95:
00D98E 1 85 A8 sta INDX
00D990 1 ; ----------------------------------------------------------------------------
00D990 1 ; ADJUST UNTIL 1E8 <= (FAC) <1E9
00D990 1 ; ----------------------------------------------------------------------------
00D990 1 L3C97:
00D990 1 A9 3F lda #<CON_999999999
00D992 1 A0 D9 ldy #>CON_999999999
00D994 1 20 EC D7 jsr FCOMP
00D997 1 F0 1E beq L3CBE
00D999 1 10 12 bpl L3CB4
00D99B 1 L3CA2:
00D99B 1 A9 3B lda #<CON_99999999_9
00D99D 1 A0 D9 ldy #>CON_99999999_9
00D99F 1 20 EC D7 jsr FCOMP
00D9A2 1 F0 02 beq L3CAD
00D9A4 1 10 0E bpl L3CBB
00D9A6 1 L3CAD:
00D9A6 1 20 92 D6 jsr MUL10
00D9A9 1 C6 A8 dec INDX
00D9AB 1 D0 EE bne L3CA2
00D9AD 1 L3CB4:
00D9AD 1 20 AD D6 jsr DIV10
00D9B0 1 E6 A8 inc INDX
00D9B2 1 D0 DC bne L3C97
00D9B4 1 L3CBB:
00D9B4 1 20 42 D4 jsr FADDH
00D9B7 1 L3CBE:
00D9B7 1 20 25 D8 jsr QINT
00D9BA 1 ; ----------------------------------------------------------------------------
00D9BA 1 ; FAC+1...FAC+4 IS NOW IN INTEGER FORM
00D9BA 1 ; WITH POWER OF TEN ADJUSTMENT IN TMPEXP
00D9BA 1 ;
00D9BA 1 ; IF -10 < TMPEXP > 1, PRINT IN DECIMAL FORM
00D9BA 1 ; OTHERWISE, PRINT IN EXPONENTIAL FORM
00D9BA 1 ; ----------------------------------------------------------------------------
00D9BA 1 A2 01 ldx #$01
00D9BC 1 A5 A8 lda INDX
00D9BE 1 18 clc
00D9BF 1 69 07 adc #3*BYTES_FP-5
00D9C1 1 30 09 bmi L3CD3
00D9C3 1 C9 08 cmp #3*BYTES_FP-4
00D9C5 1 B0 06 bcs L3CD4
00D9C7 1 69 FF adc #$FF
00D9C9 1 AA tax
00D9CA 1 A9 02 lda #$02
00D9CC 1 L3CD3:
00D9CC 1 38 sec
00D9CD 1 L3CD4:
00D9CD 1 E9 02 sbc #$02
00D9CF 1 85 A9 sta EXPON
00D9D1 1 86 A8 stx INDX
00D9D3 1 8A txa
00D9D4 1 F0 02 beq L3CDF
00D9D6 1 10 13 bpl L3CF2
00D9D8 1 L3CDF:
00D9D8 1 A4 BA ldy STRNG2
00D9DA 1 A9 2E lda #$2E
00D9DC 1 C8 iny
00D9DD 1 99 FF 00 sta $FF,y
00D9E0 1 8A txa
00D9E1 1 F0 06 beq L3CF0
00D9E3 1 A9 30 lda #$30
00D9E5 1 C8 iny
00D9E6 1 99 FF 00 sta $FF,y
00D9E9 1 L3CF0:
00D9E9 1 84 BA sty STRNG2
00D9EB 1 ; ----------------------------------------------------------------------------
00D9EB 1 ; NOW DIVIDE BY POWERS OF TEN TO GET SUCCESSIVE DIGITS
00D9EB 1 ; ----------------------------------------------------------------------------
00D9EB 1 L3CF2:
00D9EB 1 A0 00 ldy #$00
00D9ED 1 A2 80 ldx #$80
00D9EF 1 L3CF6:
00D9EF 1 A5 AF lda FAC_LAST
00D9F1 1 18 clc
00D9F2 1 79 90 DA adc DECTBL+2,y
00D9F5 1 85 AF sta FAC+3
00D9F7 1 A5 AE lda FAC+2
00D9F9 1 79 8F DA adc DECTBL+1,y
00D9FC 1 85 AE sta FAC+2
00D9FE 1 A5 AD lda FAC+1
00DA00 1 79 8E DA adc DECTBL,y
00DA03 1 85 AD sta FAC+1
00DA05 1 E8 inx
00DA06 1 B0 04 bcs L3D1A
00DA08 1 10 E5 bpl L3CF6
00DA0A 1 30 02 bmi L3D1C
00DA0C 1 L3D1A:
00DA0C 1 30 E1 bmi L3CF6
00DA0E 1 L3D1C:
00DA0E 1 8A txa
00DA0F 1 90 04 bcc L3D23
00DA11 1 49 FF eor #$FF
00DA13 1 69 0A adc #$0A
00DA15 1 L3D23:
00DA15 1 69 2F adc #$2F
00DA17 1 C8 iny
00DA18 1 C8 iny
00DA19 1 C8 iny
00DA1A 1 84 95 sty VARPNT
00DA1C 1 A4 BA ldy STRNG2
00DA1E 1 C8 iny
00DA1F 1 AA tax
00DA20 1 29 7F and #$7F
00DA22 1 99 FF 00 sta $FF,y
00DA25 1 C6 A8 dec INDX
00DA27 1 D0 06 bne L3D3E
00DA29 1 A9 2E lda #$2E
00DA2B 1 C8 iny
00DA2C 1 99 FF 00 sta $FF,y
00DA2F 1 L3D3E:
00DA2F 1 84 BA sty STRNG2
00DA31 1 A4 95 ldy VARPNT
00DA33 1 8A txa
00DA34 1 49 FF eor #$FF
00DA36 1 29 80 and #$80
00DA38 1 AA tax
00DA39 1 C0 12 cpy #DECTBL_END-DECTBL
00DA3B 1 D0 B2 bne L3CF6
00DA3D 1 ; ----------------------------------------------------------------------------
00DA3D 1 ; NINE DIGITS HAVE BEEN STORED IN STRING. NOW LOOK
00DA3D 1 ; BACK AND LOP OFF TRAILING ZEROES AND A TRAILING
00DA3D 1 ; DECIMAL POINT.
00DA3D 1 ; ----------------------------------------------------------------------------
00DA3D 1 A4 BA ldy STRNG2
00DA3F 1 L3D4E:
00DA3F 1 B9 FF 00 lda $FF,y
00DA42 1 88 dey
00DA43 1 C9 30 cmp #$30
00DA45 1 F0 F8 beq L3D4E
00DA47 1 C9 2E cmp #$2E
00DA49 1 F0 01 beq L3D5B
00DA4B 1 C8 iny
00DA4C 1 L3D5B:
00DA4C 1 A9 2B lda #$2B
00DA4E 1 A6 A9 ldx EXPON
00DA50 1 F0 2E beq L3D8F
00DA52 1 10 08 bpl L3D6B
00DA54 1 A9 00 lda #$00
00DA56 1 38 sec
00DA57 1 E5 A9 sbc EXPON
00DA59 1 AA tax
00DA5A 1 A9 2D lda #$2D
00DA5C 1 L3D6B:
00DA5C 1 99 01 01 sta STACK+1,y
00DA5F 1 A9 45 lda #$45
00DA61 1 99 00 01 sta STACK,y
00DA64 1 8A txa
00DA65 1 A2 2F ldx #$2F
00DA67 1 38 sec
00DA68 1 L3D77:
00DA68 1 E8 inx
00DA69 1 E9 0A sbc #$0A
00DA6B 1 B0 FB bcs L3D77
00DA6D 1 69 3A adc #$3A
00DA6F 1 99 03 01 sta STACK+3,y
00DA72 1 8A txa
00DA73 1 99 02 01 sta STACK+2,y
00DA76 1 A9 00 lda #$00
00DA78 1 99 04 01 sta STACK+4,y
00DA7B 1 F0 08 beq L3D94
00DA7D 1 FOUT4:
00DA7D 1 99 FF 00 sta $FF,y
00DA80 1 L3D8F:
00DA80 1 A9 00 lda #$00
00DA82 1 99 00 01 sta STACK,y
00DA85 1 L3D94:
00DA85 1 A9 00 lda #$00
00DA87 1 A0 01 ldy #$01
00DA89 1 60 rts
00DA8A 1 ; ----------------------------------------------------------------------------
00DA8A 1 CON_HALF:
00DA8A 1 80 00 00 00 .byte $80,$00,$00,$00
00DA8E 1 ; ----------------------------------------------------------------------------
00DA8E 1 ; POWERS OF 10 FROM 1E8 DOWN TO 1,
00DA8E 1 ; AS 32-BIT INTEGERS, WITH ALTERNATING SIGNS
00DA8E 1 ; ----------------------------------------------------------------------------
00DA8E 1 DECTBL:
00DA8E 1 FE 79 60 .byte $FE,$79,$60 ; -100000
00DA91 1 00 27 10 .byte $00,$27,$10 ; 10000
00DA94 1 FF FC 18 .byte $FF,$FC,$18 ; -1000
00DA97 1 00 00 64 .byte $00,$00,$64 ; 100
00DA9A 1 FF FF F6 .byte $FF,$FF,$F6 ; -10
00DA9D 1 00 00 01 .byte $00,$00,$01 ; 1
00DAA0 1 DECTBL_END:
00DAA0 1 ; ----------------------------------------------------------------------------
00DAA0 1 ; "SQR" FUNCTION
00DAA0 1 ; ----------------------------------------------------------------------------
00DAA0 1 SQR:
00DAA0 1 20 9F D7 jsr COPY_FAC_TO_ARG_ROUNDED
00DAA3 1 A9 8A lda #<CON_HALF
00DAA5 1 A0 DA ldy #>CON_HALF
00DAA7 1 20 3F D7 jsr LOAD_FAC_FROM_YA
00DAAA 1 ; ----------------------------------------------------------------------------
00DAAA 1 ; EXPONENTIATION OPERATION
00DAAA 1 ;
00DAAA 1 ; ARG ^ FAC = EXP( LOG(ARG) * FAC )
00DAAA 1 ; ----------------------------------------------------------------------------
00DAAA 1 FPWRT:
00DAAA 1 F0 63 beq EXP
00DAAC 1 A5 B3 lda ARG
00DAAE 1 D0 03 bne L3DD5
00DAB0 1 4C E7 D4 jmp STA_IN_FAC_SIGN_AND_EXP
00DAB3 1 L3DD5:
00DAB3 1 A2 9C ldx #TEMP3
00DAB5 1 A0 00 ldy #$00
00DAB7 1 20 6C D7 jsr STORE_FAC_AT_YX_ROUNDED
00DABA 1 A5 B7 lda ARGSIGN
00DABC 1 10 0F bpl L3DEF
00DABE 1 20 56 D8 jsr INT
00DAC1 1 A9 9C lda #TEMP3
00DAC3 1 A0 00 ldy #$00
00DAC5 1 20 EC D7 jsr FCOMP
00DAC8 1 D0 03 bne L3DEF
00DACA 1 98 tya
00DACB 1 A4 5B ldy CHARAC
00DACD 1 L3DEF:
00DACD 1 20 91 D7 jsr MFA
00DAD0 1 98 tya
00DAD1 1 48 pha
00DAD2 1 20 B1 D5 jsr LOG
00DAD5 1 A9 9C lda #TEMP3
00DAD7 1 A0 00 ldy #$00
00DAD9 1 20 EF D5 jsr FMULT
00DADC 1 20 0F DB jsr EXP
00DADF 1 68 pla
00DAE0 1 4A lsr a
00DAE1 1 90 0A bcc L3E0F
00DAE3 1 ; ----------------------------------------------------------------------------
00DAE3 1 ; NEGATE VALUE IN FAC
00DAE3 1 ; ----------------------------------------------------------------------------
00DAE3 1 NEGOP:
00DAE3 1 A5 AC lda FAC
00DAE5 1 F0 06 beq L3E0F
00DAE7 1 A5 B0 lda FACSIGN
00DAE9 1 49 FF eor #$FF
00DAEB 1 85 B0 sta FACSIGN
00DAED 1 L3E0F:
00DAED 1 60 rts
00DAEE 1 ; ----------------------------------------------------------------------------
00DAEE 1 CON_LOG_E:
00DAEE 1 81 38 AA 3B .byte $81,$38,$AA,$3B
00DAF2 1 POLY_EXP:
00DAF2 1 06 .byte $06
00DAF3 1 74 63 90 8C .byte $74,$63,$90,$8C
00DAF7 1 77 23 0C AB .byte $77,$23,$0C,$AB
00DAFB 1 7A 1E 94 00 .byte $7A,$1E,$94,$00
00DAFF 1 7C 63 42 80 .byte $7C,$63,$42,$80
00DB03 1 7E 75 FE D0 .byte $7E,$75,$FE,$D0
00DB07 1 80 31 72 15 .byte $80,$31,$72,$15
00DB0B 1 81 00 00 00 .byte $81,$00,$00,$00
00DB0F 1 ; ----------------------------------------------------------------------------
00DB0F 1 ; "EXP" FUNCTION
00DB0F 1 ;
00DB0F 1 ; FAC = E ^ FAC
00DB0F 1 ; ----------------------------------------------------------------------------
00DB0F 1 EXP:
00DB0F 1 A9 EE lda #<CON_LOG_E
00DB11 1 A0 DA ldy #>CON_LOG_E
00DB13 1 20 EF D5 jsr FMULT
00DB16 1 A5 B9 lda FACEXTENSION
00DB18 1 69 50 adc #$50
00DB1A 1 90 03 bcc L3E4E
00DB1C 1 20 B6 D7 jsr INCREMENT_MANTISSA
00DB1F 1 L3E4E:
00DB1F 1 85 A3 sta ARGEXTENSION
00DB21 1 20 A2 D7 jsr MAF
00DB24 1 A5 AC lda FAC
00DB26 1 C9 88 cmp #$88
00DB28 1 90 03 bcc L3E5C
00DB2A 1 L3E59:
00DB2A 1 20 84 D6 jsr OUTOFRNG
00DB2D 1 L3E5C:
00DB2D 1 20 56 D8 jsr INT
00DB30 1 A5 5B lda CHARAC
00DB32 1 18 clc
00DB33 1 69 81 adc #$81
00DB35 1 F0 F3 beq L3E59
00DB37 1 38 sec
00DB38 1 E9 01 sbc #$01
00DB3A 1 48 pha
00DB3B 1 A2 04 ldx #BYTES_FP
00DB3D 1 L3E6C:
00DB3D 1 B5 B3 lda ARG,x
00DB3F 1 B4 AC ldy FAC,x
00DB41 1 95 AC sta FAC,x
00DB43 1 94 B3 sty ARG,x
00DB45 1 CA dex
00DB46 1 10 F5 bpl L3E6C
00DB48 1 A5 A3 lda ARGEXTENSION
00DB4A 1 85 B9 sta FACEXTENSION
00DB4C 1 20 4C D4 jsr FSUBT
00DB4F 1 20 E3 DA jsr NEGOP
00DB52 1 A9 F2 lda #<POLY_EXP
00DB54 1 A0 DA ldy #>POLY_EXP
00DB56 1 20 78 DB jsr POLYNOMIAL
00DB59 1 A9 00 lda #$00
00DB5B 1 85 B8 sta SGNCPR
00DB5D 1 68 pla
00DB5E 1 20 69 D6 jsr ADD_EXPONENTS1
00DB61 1 60 rts
00DB62 1 ; ----------------------------------------------------------------------------
00DB62 1 ; ODD POLYNOMIAL SUBROUTINE
00DB62 1 ;
00DB62 1 ; F(X) = X * P(X^2)
00DB62 1 ;
00DB62 1 ; WHERE: X IS VALUE IN FAC
00DB62 1 ; Y,A POINTS AT COEFFICIENT TABLE
00DB62 1 ; FIRST BYTE OF COEFF. TABLE IS N
00DB62 1 ; COEFFICIENTS FOLLOW, HIGHEST POWER FIRST
00DB62 1 ;
00DB62 1 ; P(X^2) COMPUTED USING NORMAL POLYNOMIAL SUBROUTINE
00DB62 1 ; ----------------------------------------------------------------------------
00DB62 1 POLYNOMIAL_ODD:
00DB62 1 85 BA sta STRNG2
00DB64 1 84 BB sty STRNG2+1
00DB66 1 20 62 D7 jsr STORE_FAC_IN_TEMP1_ROUNDED
00DB69 1 A9 A4 lda #TEMP1X
00DB6B 1 20 EF D5 jsr FMULT
00DB6E 1 20 7C DB jsr SERMAIN
00DB71 1 A9 A4 lda #TEMP1X
00DB73 1 A0 00 ldy #$00
00DB75 1 4C EF D5 jmp FMULT
00DB78 1 ; ----------------------------------------------------------------------------
00DB78 1 ; NORMAL POLYNOMIAL SUBROUTINE
00DB78 1 ;
00DB78 1 ; P(X) = C(0)*X^N + C(1)*X^(N-1) + ... + C(N)
00DB78 1 ;
00DB78 1 ; WHERE: X IS VALUE IN FAC
00DB78 1 ; Y,A POINTS AT COEFFICIENT TABLE
00DB78 1 ; FIRST BYTE OF COEFF. TABLE IS N
00DB78 1 ; COEFFICIENTS FOLLOW, HIGHEST POWER FIRST
00DB78 1 ; ----------------------------------------------------------------------------
00DB78 1 POLYNOMIAL:
00DB78 1 85 BA sta STRNG2
00DB7A 1 84 BB sty STRNG2+1
00DB7C 1 SERMAIN:
00DB7C 1 20 5F D7 jsr STORE_FAC_IN_TEMP2_ROUNDED
00DB7F 1 B1 BA lda (STRNG2),y
00DB81 1 85 B1 sta SERLEN
00DB83 1 A4 BA ldy STRNG2
00DB85 1 C8 iny
00DB86 1 98 tya
00DB87 1 D0 02 bne L3EBA
00DB89 1 E6 BB inc STRNG2+1
00DB8B 1 L3EBA:
00DB8B 1 85 BA sta STRNG2
00DB8D 1 A4 BB ldy STRNG2+1
00DB8F 1 L3EBE:
00DB8F 1 20 EF D5 jsr FMULT
00DB92 1 A5 BA lda STRNG2
00DB94 1 A4 BB ldy STRNG2+1
00DB96 1 18 clc
00DB97 1 69 04 adc #BYTES_FP
00DB99 1 90 01 bcc L3ECB
00DB9B 1 C8 iny
00DB9C 1 L3ECB:
00DB9C 1 85 BA sta STRNG2
00DB9E 1 84 BB sty STRNG2+1
00DBA0 1 20 60 D4 jsr FADD
00DBA3 1 A9 A8 lda #TEMP2
00DBA5 1 A0 00 ldy #$00
00DBA7 1 C6 B1 dec SERLEN
00DBA9 1 D0 E4 bne L3EBE
00DBAB 1 RTS19:
00DBAB 1 60 rts
00DBAC 1 ; ----------------------------------------------------------------------------
00DBAC 1 ; "RND" FUNCTION
00DBAC 1 ; ----------------------------------------------------------------------------
00DBAC 1 CONRND1:
00DBAC 1 98 35 44 7A .byte $98,$35,$44,$7A
00DBB0 1 CONRND2:
00DBB0 1 68 28 B1 46 .byte $68,$28,$B1,$46
00DBB4 1 RND:
00DBB4 1 20 BE D7 jsr SIGN
00DBB7 1 AA tax
00DBB8 1 30 18 bmi L3F01
00DBBA 1 A9 D4 lda #<RNDSEED
00DBBC 1 A0 00 ldy #>RNDSEED
00DBBE 1 20 3F D7 jsr LOAD_FAC_FROM_YA
00DBC1 1 8A txa
00DBC2 1 F0 E7 beq RTS19
00DBC4 1 A9 AC lda #<CONRND1
00DBC6 1 A0 DB ldy #>CONRND1
00DBC8 1 20 EF D5 jsr FMULT
00DBCB 1 A9 B0 lda #<CONRND2
00DBCD 1 A0 DB ldy #>CONRND2
00DBCF 1 20 60 D4 jsr FADD
00DBD2 1 L3F01:
00DBD2 1 A6 AF ldx FAC_LAST
00DBD4 1 A5 AD lda FAC+1
00DBD6 1 85 AF sta FAC_LAST
00DBD8 1 86 AD stx FAC+1
00DBDA 1 A9 00 lda #$00
00DBDC 1 85 B0 sta FACSIGN
00DBDE 1 A5 AC lda FAC
00DBE0 1 85 B9 sta FACEXTENSION
00DBE2 1 A9 80 lda #$80
00DBE4 1 85 AC sta FAC
00DBE6 1 20 C9 D4 jsr NORMALIZE_FAC2
00DBE9 1 A2 D4 ldx #<RNDSEED
00DBEB 1 A0 00 ldy #>RNDSEED
00DBED 1 GOMOVMF:
00DBED 1 4C 6C D7 jmp STORE_FAC_AT_YX_ROUNDED
00DBF0 1 ; ----------------------------------------------------------------------------
00DBF0 1 ; "COS" FUNCTION
00DBF0 1 ; ----------------------------------------------------------------------------
00DBF0 1 COS:
00DBF0 1 A9 6C lda #<CON_PI_HALF
00DBF2 1 A0 DC ldy #>CON_PI_HALF
00DBF4 1 20 60 D4 jsr FADD
00DBF7 1 ; ----------------------------------------------------------------------------
00DBF7 1 ; "SIN" FUNCTION
00DBF7 1 ; ----------------------------------------------------------------------------
00DBF7 1 SIN:
00DBF7 1 20 9F D7 jsr COPY_FAC_TO_ARG_ROUNDED
00DBFA 1 A9 70 lda #<CON_PI_DOUB
00DBFC 1 A0 DC ldy #>CON_PI_DOUB
00DBFE 1 A6 B7 ldx ARGSIGN
00DC00 1 20 B6 D6 jsr DIV
00DC03 1 20 9F D7 jsr COPY_FAC_TO_ARG_ROUNDED
00DC06 1 20 56 D8 jsr INT
00DC09 1 A9 00 lda #$00
00DC0B 1 85 B8 sta STRNG1
00DC0D 1 20 4C D4 jsr FSUBT
00DC10 1 ; ----------------------------------------------------------------------------
00DC10 1 ; (FAC) = ANGLE AS A FRACTION OF A FULL CIRCLE
00DC10 1 ;
00DC10 1 ; NOW FOLD THE RANGE INTO A QUARTER CIRCLE
00DC10 1 ;
00DC10 1 ; <<< THERE ARE MUCH SIMPLER WAYS TO DO THIS >>>
00DC10 1 ; ----------------------------------------------------------------------------
00DC10 1 A9 74 lda #<QUARTER
00DC12 1 A0 DC ldy #>QUARTER
00DC14 1 20 49 D4 jsr FSUB
00DC17 1 A5 B0 lda FACSIGN
00DC19 1 48 pha
00DC1A 1 10 0D bpl SIN1
00DC1C 1 20 42 D4 jsr FADDH
00DC1F 1 A5 B0 lda FACSIGN
00DC21 1 30 09 bmi L3F5B
00DC23 1 A5 63 lda CPRMASK
00DC25 1 49 FF eor #$FF
00DC27 1 85 63 sta CPRMASK
00DC29 1 ; ----------------------------------------------------------------------------
00DC29 1 ; IF FALL THRU, RANGE IS 0...1/2
00DC29 1 ; IF BRANCH HERE, RANGE IS 0...1/4
00DC29 1 ; ----------------------------------------------------------------------------
00DC29 1 SIN1:
00DC29 1 20 E3 DA jsr NEGOP
00DC2C 1 ; ----------------------------------------------------------------------------
00DC2C 1 ; IF FALL THRU, RANGE IS -1/2...0
00DC2C 1 ; IF BRANCH HERE, RANGE IS -1/4...0
00DC2C 1 ; ----------------------------------------------------------------------------
00DC2C 1 L3F5B:
00DC2C 1 A9 74 lda #<QUARTER
00DC2E 1 A0 DC ldy #>QUARTER
00DC30 1 20 60 D4 jsr FADD
00DC33 1 68 pla
00DC34 1 10 03 bpl L3F68
00DC36 1 20 E3 DA jsr NEGOP
00DC39 1 L3F68:
00DC39 1 A9 78 lda #<POLY_SIN
00DC3B 1 A0 DC ldy #>POLY_SIN
00DC3D 1 4C 62 DB jmp POLYNOMIAL_ODD
00DC40 1 ; ----------------------------------------------------------------------------
00DC40 1 ; "TAN" FUNCTION
00DC40 1 ;
00DC40 1 ; COMPUTE TAN(X) = SIN(X) / COS(X)
00DC40 1 ; ----------------------------------------------------------------------------
00DC40 1 TAN:
00DC40 1 20 62 D7 jsr STORE_FAC_IN_TEMP1_ROUNDED
00DC43 1 A9 00 lda #$00
00DC45 1 85 63 sta CPRMASK
00DC47 1 20 F7 DB jsr SIN
00DC4A 1 A2 9C ldx #TEMP3
00DC4C 1 A0 00 ldy #$00
00DC4E 1 20 ED DB jsr GOMOVMF
00DC51 1 A9 A4 lda #TEMP1+(5-BYTES_FP)
00DC53 1 A0 00 ldy #$00
00DC55 1 20 3F D7 jsr LOAD_FAC_FROM_YA
00DC58 1 A9 00 lda #$00
00DC5A 1 85 B0 sta FACSIGN
00DC5C 1 A5 63 lda CPRMASK
00DC5E 1 20 68 DC jsr TAN1
00DC61 1 A9 9C lda #TEMP3
00DC63 1 A0 00 ldy #$00
00DC65 1 4C BE D6 jmp FDIV
00DC68 1 TAN1:
00DC68 1 48 pha
00DC69 1 4C 29 DC jmp SIN1
00DC6C 1 ; ----------------------------------------------------------------------------
00DC6C 1 CON_PI_HALF:
00DC6C 1 81 49 0F DB .byte $81,$49,$0F,$DB
00DC70 1 CON_PI_DOUB:
00DC70 1 83 49 0F DB .byte $83,$49,$0F,$DB
00DC74 1 QUARTER:
00DC74 1 7F 00 00 00 .byte $7F,$00,$00,$00
00DC78 1 POLY_SIN:
00DC78 1 04 86 1E D7 .byte $04,$86,$1E,$D7,$FB,$87,$99,$26
00DC7C 1 FB 87 99 26
00DC80 1 65 87 23 34 .byte $65,$87,$23,$34,$58,$86,$A5,$5D
00DC84 1 58 86 A5 5D
00DC88 1 E1 83 49 0F .byte $E1,$83,$49,$0F,$DB
00DC8C 1 DB
00DC8D 1
00DC8D 1 ; ----------------------------------------------------------------------------
00DC8D 1 ; "ATN" FUNCTION
00DC8D 1 ; ----------------------------------------------------------------------------
00DC8D 1 ATN:
00DC8D 1 A5 B0 lda FACSIGN
00DC8F 1 48 pha
00DC90 1 10 03 bpl L3FDB
00DC92 1 20 E3 DA jsr NEGOP
00DC95 1 L3FDB:
00DC95 1 A5 AC lda FAC
00DC97 1 48 pha
00DC98 1 C9 81 cmp #$81
00DC9A 1 90 07 bcc L3FE9
00DC9C 1 A9 90 lda #<CON_ONE
00DC9E 1 A0 D5 ldy #>CON_ONE
00DCA0 1 20 BE D6 jsr FDIV
00DCA3 1 ; ----------------------------------------------------------------------------
00DCA3 1 ; 0 <= X <= 1
00DCA3 1 ; 0 <= ATN(X) <= PI/8
00DCA3 1 ; ----------------------------------------------------------------------------
00DCA3 1 L3FE9:
00DCA3 1 A9 BD lda #<POLY_ATN
00DCA5 1 A0 DC ldy #>POLY_ATN
00DCA7 1 20 62 DB jsr POLYNOMIAL_ODD
00DCAA 1 68 pla
00DCAB 1 C9 81 cmp #$81
00DCAD 1 90 07 bcc L3FFC
00DCAF 1 A9 6C lda #<CON_PI_HALF
00DCB1 1 A0 DC ldy #>CON_PI_HALF
00DCB3 1 20 49 D4 jsr FSUB
00DCB6 1 L3FFC:
00DCB6 1 68 pla
00DCB7 1 10 03 bpl L4002
00DCB9 1 4C E3 DA jmp NEGOP
00DCBC 1 L4002:
00DCBC 1 60 rts
00DCBD 1 ; ----------------------------------------------------------------------------
00DCBD 1 POLY_ATN:
00DCBD 1 08 .byte $08
00DCBE 1 78 3A C5 37 .byte $78,$3A,$C5,$37
00DCC2 1 7B 83 A2 5C .byte $7B,$83,$A2,$5C
00DCC6 1 7C 2E DD 4D .byte $7C,$2E,$DD,$4D
00DCCA 1 7D 99 B0 1E .byte $7D,$99,$B0,$1E
00DCCE 1 7D 59 ED 24 .byte $7D,$59,$ED,$24
00DCD2 1 7E 91 72 00 .byte $7E,$91,$72,$00
00DCD6 1 7E 4C B9 73 .byte $7E,$4C,$B9,$73
00DCDA 1 7F AA AA 53 .byte $7F,$AA,$AA,$53
00DCDE 1 81 00 00 00 .byte $81,$00,$00,$00
00DCE2 1 GENERIC_CHRGET:
00DCE2 1 E6 C3 inc TXTPTR
00DCE4 1 D0 02 bne GENERIC_CHRGOT
00DCE6 1 E6 C4 inc TXTPTR+1
00DCE8 1 GENERIC_CHRGOT:
00DCE8 1 GENERIC_TXTPTR = GENERIC_CHRGOT + 1
00DCE8 1 AD 60 EA lda $EA60
00DCEB 1 C9 3A cmp #$3A
00DCED 1 B0 0A bcs L4058
00DCEF 1 GENERIC_CHRGOT2:
00DCEF 1 C9 20 cmp #$20
00DCF1 1 F0 EF beq GENERIC_CHRGET
00DCF3 1 38 sec
00DCF4 1 E9 30 sbc #$30
00DCF6 1 38 sec
00DCF7 1 E9 D0 sbc #$D0
00DCF9 1 L4058:
00DCF9 1 60 rts
00DCFA 1 GENERIC_RNDSEED:
00DCFA 1 ; random number seed
00DCFA 1 80 4F C7 52 .byte $80,$4F,$C7,$52
00DCFE 1 GENERIC_CHRGET_END:
00DCFE 1 ; ----------------------------------------------------------------------------
00DCFE 1 PR_WRITTEN_BY:
00DCFE 1 A9 42 lda #<QT_WRITTEN_BY
00DD00 1 A0 DE ldy #>QT_WRITTEN_BY
00DD02 1 20 B7 C8 jsr STROUT
00DD05 1 COLD_START:
00DD05 1 A2 FF ldx #$FF
00DD07 1 86 88 stx CURLIN+1
00DD09 1 9A txs
00DD0A 1 A9 05 lda #<COLD_START
00DD0C 1 A0 DD ldy #>COLD_START
00DD0E 1 85 01 sta GORESTART+1
00DD10 1 84 02 sty GORESTART+2
00DD12 1 85 04 sta GOSTROUT+1
00DD14 1 84 05 sty GOSTROUT+2
00DD16 1 A9 F9 lda #<AYINT
00DD18 1 A0 CD ldy #>AYINT
00DD1A 1 85 06 sta GOAYINT
00DD1C 1 84 07 sty GOAYINT+1
00DD1E 1 A9 B5 lda #<GIVAYF
00DD20 1 A0 CF ldy #>GIVAYF
00DD22 1 85 08 sta GOGIVEAYF
00DD24 1 84 09 sty GOGIVEAYF+1
00DD26 1 A9 4C lda #$4C
00DD28 1 85 00 sta GORESTART
00DD2A 1 85 03 sta GOSTROUT
00DD2C 1 85 A1 sta JMPADRS
00DD2E 1 85 0A sta USR
00DD30 1 A9 7C lda #<IQERR
00DD32 1 A0 CE ldy #>IQERR
00DD34 1 85 0B sta USR+1
00DD36 1 84 0C sty USR+2
00DD38 1 A9 48 lda #WIDTH
00DD3A 1 85 0F sta Z17
00DD3C 1 A9 38 lda #WIDTH2
00DD3E 1 85 10 sta Z18
00DD40 1 A2 1C ldx #GENERIC_CHRGET_END-GENERIC_CHRGET
00DD42 1 L4098:
00DD42 1 BD E1 DC lda GENERIC_CHRGET-1,x
00DD45 1 95 BB sta CHRGET-1,x
00DD47 1 CA dex
00DD48 1 D0 F8 bne L4098
00DD4A 1 8A txa
00DD4B 1 85 B2 sta SHIFTSIGNEXT
00DD4D 1 85 67 sta LASTPT+1
00DD4F 1 85 0D sta Z15
00DD51 1 85 0E sta POSX
00DD53 1 48 pha
00DD54 1 85 64 sta Z14
00DD56 1 A9 03 lda #$03
00DD58 1 85 A0 sta DSCLEN
00DD5A 1 A9 2C lda #$2C
00DD5C 1 85 12 sta LINNUM+1
00DD5E 1 20 60 C8 jsr CRDO
00DD61 1 A2 68 ldx #TEMPST
00DD63 1 86 65 stx TEMPPT
00DD65 1 A9 66 lda #<QT_MEMORY_SIZE
00DD67 1 A0 DE ldy #>QT_MEMORY_SIZE
00DD69 1 20 B7 C8 jsr STROUT
00DD6C 1 20 3A C9 jsr NXIN
00DD6F 1 86 C3 stx TXTPTR
00DD71 1 84 C4 sty TXTPTR+1
00DD73 1 20 BC 00 jsr CHRGET
00DD76 1 C9 41 cmp #$41
00DD78 1 F0 84 beq PR_WRITTEN_BY
00DD7A 1 A8 tay
00DD7B 1 D0 21 bne L40EE
00DD7D 1 A9 00 lda #<RAMSTART2
00DD7F 1 A0 02 ldy #>RAMSTART2
00DD81 1 85 11 sta LINNUM
00DD83 1 84 12 sty LINNUM+1
00DD85 1 A0 00 ldy #$00
00DD87 1 L40D7:
00DD87 1 E6 11 inc LINNUM
00DD89 1 D0 02 bne L40DD
00DD8B 1 E6 12 inc LINNUM+1
00DD8D 1 L40DD:
00DD8D 1 A9 92 lda #$92 ; 10010010 / 00100100
00DD8F 1 91 11 sta (LINNUM),y
00DD91 1 D1 11 cmp (LINNUM),y
00DD93 1 D0 15 bne L40FA
00DD95 1 0A asl a
00DD96 1 91 11 sta (LINNUM),y
00DD98 1 D1 11 cmp (LINNUM),y
00DD9A 1 F0 EB beq L40D7; old: faster
00DD9C 1 D0 0C bne L40FA
00DD9E 1 L40EE:
00DD9E 1 20 C2 00 jsr CHRGOT
00DDA1 1 20 73 C7 jsr LINGET
00DDA4 1 A8 tay
00DDA5 1 F0 03 beq L40FA
00DDA7 1 4C 00 CC jmp SYNERR
00DDAA 1 L40FA:
00DDAA 1 A5 11 lda LINNUM
00DDAC 1 A4 12 ldy LINNUM+1
00DDAE 1 85 85 sta MEMSIZ
00DDB0 1 84 86 sty MEMSIZ+1
00DDB2 1 85 81 sta FRETOP
00DDB4 1 84 82 sty FRETOP+1
00DDB6 1 L4106:
00DDB6 1 A9 72 lda #<QT_TERMINAL_WIDTH
00DDB8 1 A0 DE ldy #>QT_TERMINAL_WIDTH
00DDBA 1 20 B7 C8 jsr STROUT
00DDBD 1 20 3A C9 jsr NXIN
00DDC0 1 86 C3 stx TXTPTR
00DDC2 1 84 C4 sty TXTPTR+1
00DDC4 1 20 BC 00 jsr CHRGET
00DDC7 1 A8 tay
00DDC8 1 F0 1C beq L4136
00DDCA 1 20 73 C7 jsr LINGET
00DDCD 1 A5 12 lda LINNUM+1
00DDCF 1 D0 E5 bne L4106
00DDD1 1 A5 11 lda LINNUM
00DDD3 1 C9 10 cmp #$10
00DDD5 1 90 DF bcc L4106
00DDD7 1 85 0F sta Z17
00DDD9 1 L4129:
00DDD9 1 E9 0E sbc #$0E
00DDDB 1 B0 FC bcs L4129
00DDDD 1 49 FF eor #$FF
00DDDF 1 E9 0C sbc #$0C
00DDE1 1 18 clc
00DDE2 1 65 0F adc Z17
00DDE4 1 85 10 sta Z18
00DDE6 1 L4136:
00DDE6 1 A2 00 ldx #<RAMSTART2
00DDE8 1 A0 02 ldy #>RAMSTART2
00DDEA 1 86 79 stx TXTTAB
00DDEC 1 84 7A sty TXTTAB+1
00DDEE 1 A0 00 ldy #$00
00DDF0 1 98 tya
00DDF1 1 91 79 sta (TXTTAB),y
00DDF3 1 E6 79 inc TXTTAB
00DDF5 1 D0 02 bne L4192
00DDF7 1 E6 7A inc TXTTAB+1
00DDF9 1 L4192:
00DDF9 1 A5 79 lda TXTTAB
00DDFB 1 A4 7A ldy TXTTAB+1
00DDFD 1 20 1F C2 jsr REASON
00DE00 1 20 60 C8 jsr CRDO
00DE03 1 A5 85 lda MEMSIZ
00DE05 1 38 sec
00DE06 1 E5 79 sbc TXTTAB
00DE08 1 AA tax
00DE09 1 A5 86 lda MEMSIZ+1
00DE0B 1 E5 7A sbc TXTTAB+1
00DE0D 1 20 52 D9 jsr LINPRT
00DE10 1 A9 81 lda #<QT_BYTES_FREE
00DE12 1 A0 DE ldy #>QT_BYTES_FREE
00DE14 1 20 B7 C8 jsr STROUT
00DE17 1 A9 B7 lda #<STROUT
00DE19 1 A0 C8 ldy #>STROUT
00DE1B 1 85 04 sta GOSTROUT+1
00DE1D 1 84 05 sty GOSTROUT+2
00DE1F 1 20 63 C4 jsr SCRTCH
00DE22 1 A9 74 lda #<RESTART
00DE24 1 A0 C2 ldy #>RESTART
00DE26 1 85 01 sta GORESTART+1
00DE28 1 84 02 sty GORESTART+2
00DE2A 1 6C 01 00 jmp (GORESTART+1)
00DE2D 1 ; OSI is compiled for ROM, but includes
00DE2D 1 ; this unused string
00DE2D 1 57 41 4E 54 .byte "WANT SIN-COS-TAN-ATN"
00DE31 1 20 53 49 4E
00DE35 1 2D 43 4F 53
00DE41 1 00 .byte 0
00DE42 1 QT_WRITTEN_BY:
00DE42 1 0D 0A 0C .byte CR,LF,$0C ; FORM FEED
00DE45 1 57 52 49 54 .byte "WRITTEN BY RICHARD W. WEILAND."
00DE49 1 54 45 4E 20
00DE4D 1 42 59 20 52
00DE63 1 0D 0A 00 .byte CR,LF,0
00DE66 1 QT_MEMORY_SIZE:
00DE66 1 4D 45 4D 4F .byte "MEMORY SIZE"
00DE6A 1 52 59 20 53
00DE6E 1 49 5A 45
00DE71 1 00 .byte 0
00DE72 1 QT_TERMINAL_WIDTH:
00DE72 1 54 45 52 4D .byte "TERMINAL WIDTH"
00DE76 1 49 4E 41 4C
00DE7A 1 20 57 49 44
00DE80 1 00 .byte 0
00DE81 1 QT_BYTES_FREE:
00DE81 1 20 42 59 54 .byte " BYTES FREE"
00DE85 1 45 53 20 46
00DE89 1 52 45 45
00DE8C 1 0D 0A 0D 0A .byte CR,LF,CR,LF
00DE90 1 4F 53 49 20 .byte "OSI 6502 BASIC VERSION 1.0 REV 3.2"
00DE94 1 36 35 30 32
00DE98 1 20 42 41 53
00DEB2 1 0D 0A .byte CR,LF
00DEB4 1 43 4F 50 59 .byte "COPYRIGHT 1977 BY MICROSOFT CO."
00DEB8 1 52 49 47 48
00DEBC 1 54 20 31 39
00DED3 1 0D 0A 00 .byte CR,LF,0
00DED6 1
00DED6 1 ; STARTUP AND SERIAL I/O ROUTINES ===========================================================
00DED6 1 ; BY G. SEARLE 2013 =========================================================================
00DED6 1 ACIA := $A000
00DED6 1 ACIAControl := ACIA+0
00DED6 1 ACIAStatus := ACIA+0
00DED6 1 ACIAData := ACIA+1
00DED6 1
00DED6 1 .segment "IOHANDLER"
000000r 1 .org $FF00
00FF00 1 Reset:
00FF00 1 A2 FC LDX #STACK_TOP
00FF02 1 9A TXS
00FF03 1
00FF03 1 A9 95 LDA #$95 ; Set ACIA baud rate, word size and Rx interrupt (to control RTS)
00FF05 1 8D 00 A0 STA ACIAControl
00FF08 1
00FF08 1 ; Display startup message
00FF08 1 A0 00 LDY #0
00FF0A 1 ShowStartMsg:
00FF0A 1 B9 56 FF LDA StartupMessage,Y
00FF0D 1 F0 06 BEQ WaitForKeypress
00FF0F 1 20 2A FF JSR MONCOUT
00FF12 1 C8 INY
00FF13 1 D0 F5 BNE ShowStartMsg
00FF15 1
00FF15 1 ; Wait for a cold/warm start selection
00FF15 1 WaitForKeypress:
00FF15 1 20 39 FF JSR MONRDKEY
00FF18 1 90 FB BCC WaitForKeypress
00FF1A 1
00FF1A 1 29 DF AND #$DF ; Make upper case
00FF1C 1 C9 57 CMP #'W' ; compare with [W]arm start
00FF1E 1 F0 07 BEQ WarmStart
00FF20 1
00FF20 1 C9 43 CMP #'C' ; compare with [C]old start
00FF22 1 D0 DC BNE Reset
00FF24 1
00FF24 1 4C 05 DD JMP COLD_START ; BASIC cold start
00FF27 1
00FF27 1 WarmStart:
00FF27 1 4C 74 C2 JMP RESTART ; BASIC warm start
00FF2A 1
00FF2A 1 MONCOUT:
00FF2A 1 48 PHA
00FF2B 1 SerialOutWait:
00FF2B 1 AD 00 A0 LDA ACIAStatus
00FF2E 1 29 02 AND #2
00FF30 1 C9 02 CMP #2
00FF32 1 D0 F7 BNE SerialOutWait
00FF34 1 68 PLA
00FF35 1 8D 01 A0 STA ACIAData
00FF38 1 60 RTS
00FF39 1
00FF39 1 MONRDKEY:
00FF39 1 AD 00 A0 LDA ACIAStatus
00FF3C 1 29 01 AND #1
00FF3E 1 C9 01 CMP #1
00FF40 1 D0 05 BNE NoDataIn
00FF42 1 AD 01 A0 LDA ACIAData
00FF45 1 38 SEC ; Carry set if key available
00FF46 1 60 RTS
00FF47 1 NoDataIn:
00FF47 1 18 CLC ; Carry clear if no key pressed
00FF48 1 60 RTS
00FF49 1
00FF49 1 MONISCNTC:
00FF49 1 20 39 FF JSR MONRDKEY
00FF4C 1 90 06 BCC NotCTRLC ; If no key pressed then exit
00FF4E 1 C9 03 CMP #3
00FF50 1 D0 02 BNE NotCTRLC ; if CTRL-C not pressed then exit
00FF52 1 38 SEC ; Carry set if control C pressed
00FF53 1 60 RTS
00FF54 1 NotCTRLC:
00FF54 1 18 CLC ; Carry clear if control C not pressed
00FF55 1 60 RTS
00FF56 1
00FF56 1 StartupMessage:
00FF56 1 0C 43 6F 6C .byte $0C,"Cold [C] or warm [W] start?",$0D,$0A,$00
00FF5A 1 64 20 5B 43
00FF5E 1 5D 20 6F 72
00FF75 1
00FF75 1 LOAD:
00FF75 1 60 RTS
00FF76 1
00FF76 1 SAVE:
00FF76 1 60 RTS
00FF77 1
00FF77 1 .segment "VECTS"
000000r 1 .org $FFFA
00FFFA 1 00 FF .word Reset ; NMI
00FFFC 1 00 FF .word Reset ; RESET
00FFFE 1 00 FF .word Reset ; IRQ
010000 1
010000 1
Reference in New Issue View Git Blame Copy Permalink