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 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 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 #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 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 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 GOTO 00C753 1 ; ON GOSUB 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 ; <<<<>>>> 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 ; <<<<>>>> 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 = 00C7AD 1 ; = 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 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 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 #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 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 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 00D5C8 1 20 60 D4 jsr FADD 00D5CB 1 A9 A5 lda #CON_SQR_TWO 00D5CF 1 20 BE D6 jsr FDIV 00D5D2 1 A9 90 lda #CON_ONE 00D5D6 1 20 49 D4 jsr FSUB 00D5D9 1 A9 94 lda #POLY_LOG 00D5DD 1 20 62 DB jsr POLYNOMIAL_ODD 00D5E0 1 A9 A9 lda #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 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 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 " 00D947 1 ; ---------------------------------------------------------------------------- 00D947 1 INPRT: 00D947 1 A9 8D lda #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 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 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 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 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 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 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 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 00DBC8 1 20 EF D5 jsr FMULT 00DBCB 1 A9 B0 lda #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 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 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 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 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 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 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 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 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 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 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 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 00DD1A 1 85 06 sta GOAYINT 00DD1C 1 84 07 sty GOAYINT+1 00DD1E 1 A9 B5 lda #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 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 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 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 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 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 00DE14 1 20 B7 C8 jsr STROUT 00DE17 1 A9 B7 lda #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 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