; ==============================================================================
; Disassembly of the Apple II Plus Emulator APPLE2.ROM image file:
; RAM ($B000-$BFFF), I/O & Slot-RAM/ROM ($C000-$CFFF), & ROM Space ($D000-$FFFF)
; ==============================================================================
; Thanks to Andy McFadden for his 6502bench SourceGen Disassembler which greatly
; helped in the creation of this document. And, for his pertinent disassemblies
; (made with it), which also helped. And, for CiderPress, too!
; ==============================================================================
; Project by James P. Davis Last updated 2020/04/21
; ------------------------------------------------------------------------------
; This APPLE2.ROM image file (3/27/1995) was obtained from AppleWin v.1.11.2.1.
; [It is identical to the APPLE2.ROM image (3/26/1995) from ApplePC v2.52 by
; David Ellsworth (based on Randy Spurlock's Apl2Emu)]. It has errors in it!
; (Especially at the very end, using an Old Monitor Reset Vector.) All errors
; detected will be Noted.
; ==============================================================================
; My analysis of this ROM is complete, but I may have made mistakes, so I will
; fix them as others, such as you, find them and let me know about them. Fixes
; will be in future releases as/if we continue on.
; ------------------------------------------------------------------------------
; The Polynomial LOG & ATN Coeficiaents are Still a Mystery to me!
; ==============================================================================
; Notes: I made this verbose for future newbies & amateur 6502 programmers.
; ------------------------------------------------------------------------------
; All symbols, labels, & comments, are adapted from works by Apple Computer
; Inc., David T Craig, William F. Luebbert, Jim Sather, Bob Sander-Cederlof,
; Michael Pohoreski, Andy McFadden, (& most likely) many more other persons,
; and by me, the Editor of this document. Actually, I've changed a lot of them!
; ------------------------------------------------------------------------------
; Some Applesoft comments are by David T Craig, originally; some are by Bob
; Sander-Cederlof; most of those have been edited by me; others are just by me
; (for my verbose analysis)! Again, I've changed a lot of them!
; ==============================================================================
; Sources:
; ------------------------------------------------------------------------------
; 1. "Apple II+ Memory Equates for Assembly Programmers" by me (Unpublished)
; 2. Various "DIS65" & "SYM65" files & disassembly listings by Andy McFadden
; (faddenSoft).
; 3. Various AppleWin "SYM" files by Michael Pohoreski & Tom Charlesworth.
; 4. "Understanding the Apple II" and "Understanding the Apple IIe" (both) by
; Jim Sather.
; 5. "What's Where in the Apple" by William F. Luebbert.
; 6. "S-C DocuMentor: Applesoft" by Bob Sander-Cederlof.
; 7. "AppleSoft BASIC Source (DTCA2DOC-007)" by David T Craig.
; 8. "AppleSoft", Rev. 4/27/1984, Assembly Listing from diskette accompanying
; "Call-A.P.P.L.E. In Depth #1: All About Applesoft" (IIRC).
; 9. "Apple II Monitors Peeled" (c) 1981 by Apple Computer Inc.
; A. Other Apple II ROMs {Known FTP Sources}:
; = ftp://ftp.apple.asimov.net/pub/apple_II/emulators/rom_images/
; = ftp://public.asimov.net/pub/apple_II/emulators/rom_images/
; ==============================================================================
;
;
; ==============================================================================
; Equate Table:
; ==============================================================================
;
ERR_NOFOR EQU $00 {const} ;"?Next Without For" Error Index
CTRLCL EQU $03 {const} ;Low ASCII Ctrl+C Character
RTNL EQU $0D {const} ;Low ASCII Ctrl-M: Carriage Return
ERR_SYNTAX EQU $10 {const} ;"?Syntax" Error Index
ERR_NOGOSUB EQU $16 {const} ;"?Return Without Gosub" Error Index
BIT_ZP EQU $24 {const} ;BIT OpCode for a Zero-Page Address
ERR_NODATA EQU $2A {const} ;"?Out Of Data" Error Index
BIT_ABS EQU $2C {const} ;BIT OpCode for an Absolute Address
SIZE EQU $30 {const} ;Maximum Size of Lo-Res Screen (48 x 48)
ERR_ILLQTY EQU $35 {const} ;"?Illegal Quantity" Error Index
ERR_OVERFLOW EQU $45 {const} ;"?Overflow" Error Index
P_OR EQU $46 {const} ;Math Operator: "OR" Precedence Code
ERR_MEMFULL EQU $4D {const} ;"?Out Of Memory" Error Index
P_AND EQU $50 {const} ;Math Operator: "AND" Precedence Code
ERR_UNDEFSTAT EQU $5A {const} ;"?Undef'd Statement" Error Index
P_REL EQU $64 {const} ;Math Operator: "REL" Precedence Code
ERR_BADSUBS EQU $6B {const} ;"?Bad Subscript" Error Index
ERR_REDIMD EQU $78 {const} ;"?Redim'd Array" Error Index
P_ADD EQU $79 {const} ;Math Operator: "ADD" Precedence Code
P_MUL EQU $7B {const} ;Math Operator: "MUL" Precedence Code
P_PWR EQU $7D {const} ;Math Operator: "PWR" Precedence Code
P_NEQ EQU $7F {const} ;Math Operator: "NEQ" Precedence Code
TOK_FOR EQU $81 {const} ;Token: "FOR" Program Control Statement
CTRLCH EQU $83 {const} ;High ASCII Ctrl+C Character
TOK_DATA EQU $83 {const} ;Token: "DATA" Data Assignment Statement
ERR_ZERODIV EQU $85 {const} ;"?Division By Zero" Error Index
BELL_H EQU $87 {const} ;High ASCII Ctrl-G: Sound Bell Character
BSH EQU $88 {const} ;High ASCII Ctrl-H: Backspace
LFH EQU $8A {const} ;High ASCII Ctrl-J: Line Feed
RTNH EQU $8D {const} ;High ASCII Ctrl-M: Carriage Return
BCC EQU $90 {const} ;Branch if Carry is Clear OpCode
CTRLSH EQU $93 {const} ;High ASCII Ctrl+S Character
ERR_ILLDIR EQU $95 {const} ;"?Illegal Direct" Error Index
PICK EQU $95 {const} ;Right-Arrow Key Code: Ctrl-U (NAK)
CTRLXH EQU $98 {const} ;High ASCII Cancel Character (Ctrl+X)
ESCH EQU $9B {const} ;High ASCII Escape Character (Ctrl+[)
ERR_BADTYPE EQU $A3 {const} ;"?Type Mismatch" Error Index
TOK_GOTO EQU $AB {const} ;Token: "GOTO" Program Control Statement
ERR_STRLONG EQU $B0 {const} ;"?String Too Long" Error Index
TOK_GOSUB EQU $B0 {const} ;Token: "GOSUB" Program Control Statement
TOK_REM EQU $B2 {const} ;Token: "REM" Prgrm-Documentation Statement
TOK_PRINT EQU $BA {const} ;Token: "PRINT" Output Statement
ERR_FRMCPX EQU $BF {const} ;"?Formula Too Complex" Error Index
HGRHIGH EQU $C0 {const} ;Hi-Res Graphics Screens Height: 192 Pixels
TOK_TAB EQU $C0 {const} ;Token: "TAB(" Cursor Position Statement
TOK_TO EQU $C1 {const} ;Token: "TO" Program Control Statement
TOK_FN EQU $C2 {const} ;Token: "FN" Function Assignment Statement
TOK_SPC EQU $C3 {const} ;Token: "SPC(" Cursor Position Statement
TOK_THEN EQU $C4 {const} ;Token: "THEN" Conditional Statement
TOK_AT EQU $C5 {const} ;Token: "AT" Graphics Drawing Statement
TOK_NOT EQU $C6 {const} ;Token: "NOT" Conditional Statement
TOK_STEP EQU $C7 {const} ;Token: "STEP" Conditional Statement
TOK_PLUS EQU $C8 {const} ;Token: "+" (Plus) Math Function
TOK_MINUS EQU $C9 {const} ;Token: "-" (Minus) Math Function
TOK_GREATER EQU $CF {const} ;Token: ">" (Greater Than) Cond. Statement
TOK_EQUAL EQU $D0 {const} ;Token: "=" (Equal To) Cond. Statement
ERR_CANTCONT EQU $D2 {const} ;"?Can't Continue" Error Index
TOK_SGN EQU $D2 {const} ;Token: "SGN" Math Function
TOK_SCRN EQU $D7 {const} ;Token: "SCRN(" LoRes (X,Y) Color Statement
ERR_UNDEFFUNC EQU $E0 {const} ;"?Undef'd Function" Error Index
CIOPG EQU $FD {const} ;Monitor Char I/O S/R Vectors Page Address
ERR_BADRESP EQU $FE {const} ;'Bad Response to Input' Error Code
CTRLCIRQ EQU $FF {const} ;"CTRL C INTERUPT ATTEMPTED" ONERR Code
DELETE EQU $FF {const} ;High ASCII "DELETE" character
HGRWIDE EQU $0118 {const} ;Hi-Res Graphics Screens Width: 280 Pixels
IOADR EQU $C000 {const} ;Hardware I/O Addresses & Soft Switches
LOC0 EQU $00 ;Preset to JMP OpCode [$4C] (3B) ;AKA: GOWARM
LOC1 EQU $01 ;Preset to BASIC Soft/Warm/Ctrl-C Entry (2B)
LOC2 EQU $02 ;Used in Shifting Right (ROR) LOC1-4,X (1B)
LOC3 EQU $03 ;=GOSTROUT; Preset to JMP OpCode ($4C)
LOC4 EQU $04 ;=GOSTROUT+1
BAS_USRVEC EQU $0A ;Applesoft USR() Command Vector (JMP) (3B)
BAS_USRPTR EQU $0B ;Applesoft USR() Command Pointer (2B)
CHARAC EQU $0D ;Applesoft String Terminator, Alternate
ENDCHR EQU $0E ;Applesoft String Terminator, Primary
NUMDIM EQU $0F ;Number of Applesoft Array Dimensions
TKNCNTR EQU $0F ;Holds Current Token - $80
DIMFLG EQU $10 ;Array Dimension Flag (DIM Call <> 0)
VALTYP EQU $11 ;Applesoft Variable Type ($00=Num, $FF=Str)
INTFLG EQU $12 ;Negative for Integer Variable (%)
DATAFLG EQU $13 ;Applesoft DATA Statement Flag
GARFLG EQU $13 ;Applesoft Garbage Collection Flag
SUBFLG EQU $14 ;Subscript Flag ($00=Allowed, $80=NOT)
INPUTFLG EQU $15 ;Input Flag ($00=INPUT, $40=GET, $98=READ)
CPRMASK EQU $16 ;Applesoft Compare Mask [(CPRTYP)<-FRMEVL]
SIGNFLG EQU $16 ;Applesoft Trig Functions Sign Flag (1B)
HSHAPE EQU $1A ;Applesoft Hi-Res Screen Byte Pointer
HCOLOR1 EQU $1C ;Applesoft Hi-Res Color Mask
HCOUNT EQU $1D ;Applesoft Hi-Res Line Step (2B)
WNDLFT EQU $20 ;Left Column of Scroll Window
WNDWDTH EQU $21 ;Width of Scroll Window
WNDTOP EQU $22 ;Top of Scroll Window
WNDBTM EQU $23 ;Bottom of Scroll Window
CH EQU $24 ;Cursor Horizontal Displacement
CV EQU $25 ;Cursor Vertical Displacement
GBASL EQU $26 ;Graphics Base Address, Low
IWMDATAPTR EQU $26 ;IWM: Pointer to Boot1 Data Buffer
GBASH EQU $27 ;Graphics Base Address, High
BASL EQU $28 ;Text Base Address, Low
BASH EQU $29 ;Text Base Address, High
BAS2L EQU $2A ;Scrolling Destination Line Pointer, Low
BAS2H EQU $2B ;Scrolling Destination Line Pointer, High
IWMSLTNDX EQU $2B ;IWM: Slot Number << 4
H2 EQU $2C ;Right End of Horizontal Line (HLINE)
LMNEM EQU $2C ;Instruction Display Mnemonic Left Byte
RMNEM EQU $2D ;Instruction Display Mnemonic Right Byte
V2 EQU $2D ;Bottom End of Vertical Line (VLINE)
CHKSUM EQU $2E ;Cassette Tape Input Accumulated Checksum
FORMAT EQU $2E ;Disassembler Instruction Display Format
MASK EQU $2E ;Lo-Res Graphics Color Mask (Apple IIc)
LASTIN EQU $2F ;Cassette Input Voltage Change Detector
LENGTH EQU $2F ;Disassembler Instruction Display Length
HMASK EQU $30 ;Graphics On-the-Fly Color Bit Mask Safe
MODE EQU $31 ;Monitor Mode Flag
INVFLG EQU $32 ;Text Mask (Normal=$FF, Flash=$7F, Inv=$3F)
PROMPT EQU $33 ;Command Prompt Character
YSAV EQU $34 ;Y-Reg Safe For Monitor Command Processing
YSAV1 EQU $35 ;Y-Reg Safe; Save across JSR VIDOUT/VIDWAIT
CSWL EQU $36 ;Character Output Hook, Low
KSWL EQU $38 ;Character Input Hook, Low
PCL EQU $3A ;Program Counter Safe, Low
PCH EQU $3B ;Program Counter Safe, High
A1L EQU $3C ;Monitor General Purpose A1-Reg, Low
IWMBITS EQU $3C ;IWM: Temp Storage for Bit Manipulation
A1H EQU $3D ;Monitor General Purpose A1-Reg, High
IWMSECTOR EQU $3D ;IWM: Sector to Read
A2L EQU $3E ;Monitor General Purpose A2-Reg, Low
A2H EQU $3F ;Monitor General Purpose A2-Reg, High
A3L EQU $40 ;Monitor General Purpose A3-Reg, Low
IWMTRKFND EQU $40 ;IWM: Track Found
A3H EQU $41 ;Monitor General Purpose A3-Reg, High
IWMTRACK EQU $41 ;IWM: Track to Read
A4L EQU $42 ;Monitor General Purpose A4-Reg, Low
A4H EQU $43 ;Monitor General Purpose A4-Reg, High
A5L EQU $44 ;Monitor General Purpose A5-Reg, Low
ACC EQU $45 ;A-Reg Safe (Accumulator) [Destroys A5H!]
XREG EQU $46 ;X-Reg Safe (Index Register X)
YREG EQU $47 ;Y-Reg Safe (Index Register Y)
STATUS EQU $48 ;P-Reg Safe (Status Register)
SPNT EQU $49 ;S-Reg Safe (Stack Pointer)
SAVE6502 EQU $4A ;6502 Registers Safe (Save Locations)+5
RNDL EQU $4E ;Keyin Random Counter Value, Low
RNDH EQU $4F ;Keyin Random Counter Value, High
LINNUM EQU $50 ;Applesoft Line Number (2B)
TEMPPT EQU $52 ;SD Stack: Next Temp Descriptor Ptr (1B)
LASTPT EQU $53 ;SD Stack: Last Temp Descriptor Ptr (1B)
TEMPST EQU $55 ;~$5D: Holds up to 3 Descriptors (9B)
INDEX EQU $5E ;Move Strings Index Pointer (2B)
LINPTR EQU $5E ;Move Strings Line Pointer (2B)
SRCPTR EQU $5E ;Move Strings Source Pointer (2B)
STKPTR EQU $5E ;Move Strings Stack Pointer (2B)
DSTPTR EQU $60 ;Move Strings Destination Pointer (2B)
RESULT EQU $62 ;~$66: FP Result of Last Mult* or Div/ (5B)
TXTTAB EQU $67 ;Applesoft Start of Program Pointer (2B)
VARTAB EQU $69 ;Applesoft Start of Variables Pointer (2B)
ARYTAB EQU $6B ;Applesoft Start of Arrays Pointer (2B)
STREND EQU $6D ;End of Variables & Pointers Storage (2B)
FRETOP EQU $6F ;FreSpcEnd & StringStorageStart Ptr (2B)
FRESPC EQU $71 ;Applesoft String Routines' Temp Ptr (2B)
MEMSIZ EQU $73 ;Applesoft End of String Space (HIMEM) (2B)
CURLIN EQU $75 ;Current Applesoft Line Number (2B)
OLDLIN EQU $77 ;Last Applesoft Line Executed, Address (2B)
OLDTEXT EQU $79 ;Applesoft Old Text Pointer (2B)
DATLIN EQU $7B ;Line Number of Current DATA Statement (2B)
DATPTR EQU $7D ;Address of Current DATA Statement (2B)
INPTR EQU $7F ;Applesoft Input Pointer (2B)
VARNAM EQU $81 ;Last-Used Variable Name Pointer (2B)
VARPTR EQU $83 ;Last-Used Variable Value Pointer (2B)
FORPTR EQU $85 ;Applesoft General Purpose Pointer (2B)
LASTOP EQU $87 ;Applesoft FRMEVL Scratch Flag (1B)
TXPSV EQU $87 ;TXTPTR Safe: Used in INPUT routine (2B)
CPRTYP EQU $89 ;Applesoft FRMEVL Compare Flag (>,=,<) (1B)
FNCNAM EQU $8A ;Applesoft Function Name Pointer (2B)
TEMP3 EQU $8A ;~$8E: Applesoft Temporary FAC #3 (5B)
DSCPTR EQU $8C ;Applesoft String Descriptor Pointer (2B)
DSCLEN EQU $8F ;Applesoft String Descriptor Length (1B)
JMPADRS EQU $90 ;Applesoft Jump (from ZP) to <Address> (3B)
GARLEN EQU $91 ;Applesoft Garbage Collection Length (1B)
ARGEXT EQU $92 ;ARG Extra Precision Byte for FP Op's (1B)
TEMP1 EQU $93 ;Applesoft FP Math Register (1B)
ARYPTR EQU $94 ;Applesoft Array Pointer (2B)
HIGHDS EQU $94 ;Copy Ptr: Highest Destination Adrs +1 (2B)
HIGHTR EQU $96 ;Copy Ptr: Highest Source Address +1 (2B)
TEMP2 EQU $98 ;Applesoft FP Math Register (2B)
INDX EQU $99 ;Used by Applesoft Array Returns (1B)
TMPEXP EQU $99 ;Used in Applesoft FIN (Eval) Routine (1B)
EXPON EQU $9A ;Applesoft Exponent Safe (1B)
DPFLG EQU $9B ;Applesoft Decimal Point Flag (1B)
LOWTR EQU $9B ;Copy Ptr: Lowest Source Address (2B)
EXPSGN EQU $9C ;Applesoft Exponent Sign Safe (1B)
DSCTMP EQU $9D ;Temp Descriptor, String Length (1B)
FAC EQU $9D ;Primary Floating Point Accumulator (6B)
DSCTMPL EQU $9E ;Temp Descriptor, String Addr, Low (1B)
DSCTMPH EQU $9F ;Temp Descriptor, String Addr, High (1B)
TMPVPTR EQU $A0 ;Temporary Variable Pointer (FAC+3,4) (2B)
FACSIGN EQU $A2 ;Primary FAC Unpacked Sign (msb) (1B)
SERLEN EQU $A3 ;Holds Length of Series-1 (1B)
SHFTSGNX EQU $A4 ;FAC Right Shift Sign Extension (1B)
ARG EQU $A5 ;Secondary Floating Point Accumulator (6B)
ARGVPTR EQU $A8 ;Applesoft Temporary Variable Pointer (2B)
ARGSIGN EQU $AA ;Secondary FAC Unpacked Sign (msb) (1B)
SGNCPR EQU $AB ;Applesoft Sign Flag for Comparing (1B)
STRNG1 EQU $AB ;Applesoft String Pointer #1 (2B)
FACEXT EQU $AC ;FAC Extra Precision Byte for FP Op's (1B)
SERPTR EQU $AD ;Pointer to Series Data in FP Op's (2B)
STRNG2 EQU $AD ;Applesoft String Pointer #2 (2B)
PRGEND EQU $AF ;Applesoft End of Program Pointer (2B)
CHRGET EQU $B1 ;~$C8: Get Next Char/Token ZP-Routine (24B)
CHRGOT EQU $B7 ;~$C8: CHRGET w/o advancing TXTPTR (18B)
TXTPTR EQU $B8 ;CHRGET's Next Char/Token Pointer (2B)
RNDSEED EQU $C9 ;~$CD: Applesoft FP Random Number Seed (5B)
HGRDX EQU $D0 ;Hi-Res Drawing Horizontal X-Position (2B)
HGRDY EQU $D2 ;Hi-Res Drawing Vertical Y-Position (1B)
HGRQUAD EQU $D3 ;Hi-Res Graphics Drawing Quadrant (1B)
HGRE EQU $D4 ;Used in Hi-Res Graphics Drawing (2B)
AUTORUN EQU $D6 ;AutoRun/Lock: No User Access If >=$80 (1B)
ERRFLG EQU $D8 ;ONERR GOTO is Active If = #$80 (1B)
ERRLIN EQU $DA ;Applesoft Line# Where ERROR Occurred (2B)
ERRPOS EQU $DC ;Applesoft Error Handler TXTPTR Safe (2B)
ERRNUM EQU $DE ;Current Applesoft Error Number Safe (1B)
ERRSTK EQU $DF ;Applesoft Stack Ptr before Error Safe (1B)
HGRX EQU $E0 ;Hi-Res Graphics X-Coordinate (H-POSN) (2B)
HGRY EQU $E2 ;Hi-Res Graphics Y-Coordinate (V-POSN) (2B)
HGRCOLOR EQU $E4 ;Hi-Res Graphics Color Flag/Safe (1B)
HGRHORIZ EQU $E5 ;Hi-Res Byte Horiz. Index from GBASL,H (1B)
HGRPAGE EQU $E6 ;Hi-Res Base Page (HPg1=$20, HPg2=$40) (1B)
HGRSCALE EQU $E7 ;Hi-Res Graphics Drawing Scale Factor (1B)
HGRSHPTR EQU $E8 ;Hi-Res Graphics Shape Pointer (2B)
HGRCLSN EQU $EA ;Hi-Res Graphics Collision Counter (2B)
FIRST EQU $F0 ;Lo-Res Plot Coordinates (1B)
SPDBYT EQU $F1 ;Text Output Speed Limiter (1B)
TRCFLG EQU $F2 ;Trace OFF/ON Flag (<128/>127)~(bit-7) (1B)
FLASHBIT EQU $F3 ;Flash Text? (Flash=$40, Else=$00) (1B)
TXTPSV EQU $F4 ;Applesoft Char/Token Pointer Safe (2B)
CURLSV EQU $F6 ;Applesoft Current Line Safe (2B)
REMSTK EQU $F8 ;Stack Ptr Before Each Statement Safe (1B)
HGRROT EQU $F9 ;Hi-Res Graphics Rotation Value (1B)
FOUTBUFF EQU $FF ;Start String at STACK-1 ($FF) (1B)
STACK EQU $0100 ;Apple-II 6502 Microprocessor Stack
LINEIMAGE EQU $01FB ;Program's New Line Image (should be zero)
IMGNXLNPTR EQU $01FC ;New Line Image's Next Line Pointer
IMGLINNUM EQU $01FE ;New Line Image's Line Number
INBUFF EQU $0200 ;Input Buffer [Range:(512~767)=($200~$2FF)]
TWOSBUFF EQU $0300 ;Holds the 6+2 2-bit Chunks of Data
CNVTBL EQU $0356 ;6+2 Conversion Table (128 Bytes of Memory)
GOBRKV EQU $03EF ;Set by DOS to JMP for User BRK Vector
BRKV EQU $03F0 ;User BRK Vector (Address of Break Handler)
SOFTEV EQU $03F2 ;Soft Entry (Warm Start) Vector
PWREDUP EQU $03F4 ;Power-Up Reset CHKSUM [(SOFTEV+1)EOR #$A5]
AMPERV EQU $03F5 ;Ampersand (&) Command Vector (JMP)
USRADDR EQU $03F8 ;Monitor User Command (Ctrl-Y) Vector
NMI EQU $03FB ;Non-Maskable Interrupt (NMI) Vector
IRQADDR EQU $03FE ;Address of IRQ Handler
LINE1 EQU $0400 ;Text Screen Start Address
MSLOT EQU $07F8 ;Slot Number ($CS) of Peripheral Card
BOOT1 EQU $0800 ;DOS Buffer for Next Stage of Loader
PRGMEM EQU $0800 ;Initial Start of Program Memory
HGR1SCRN EQU $2000 ;~$3FFF: Hi-Res Screen Pg.1 (Base-Address)
HGR2SCRN EQU $4000 ;~$5FFF: Hi-Res Screen Pg.2 (Base-Address)
TKADTBL EQU $D000 ;Applesoft Tokens Branch Address Table
UNFNC EQU $D080 ;Unary Functions Branch Address Table
MATHTBL EQU $D0B2 ;Math Operator Branch Address Table
TKNMTBL EQU $D0D0 ;Token Names Branch Address Table
ERR_MSGS EQU $D260 ;Applesoft Error Messages Table
XLTBASE EQU $FA48 ;XLTBL Base Address [XLTBL-("I"=$C9=201)]
ORG $B000
;
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
; ==============================================================================
; RAM [ROM Image file] Space ($B000-$BFFF): This is RAM on a real Apple II Plus.
; ==============================================================================
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
;
; ==============================================================================
; Empty Address Space (MTSPC1)=($B000-$B5FF)
; ==============================================================================
;
B000: 00 00 00 00+ MTSPC1 DS 1536,$00 ;6 empty pgs of RAM/ROM-Image ($B000-$B5FF)
;
; ==============================================================================
; The following Address Space ($B600-$B6FF) is a copy (or vice-versa) of the
; Slot 6 Address Space (SLOT6)=($C600-$C6FF). [See below to read it.]
; ------------------------------------------------------------------------------
; This code does not need to analyzed twice, so it is densely packed here.
; ==============================================================================
;
B600: A2 20 A0 00+ DISK2RAM HEX A220A000A203863C8A0A243CF010053C49FF297EB0084AD0FB989D5603C8E810
+ E52058FFBABD00010A0A0A0A852BAABD8EC0BD8CC0BD8AC0BD89C0A050BD80C0
+ 9829030A052BAABD81C0A95620A8FC8810EB8526853D8541A90885271808BD8C
+ C010FB49D5D0F7BD8CC010FBC9AAD0F3EABD8CC010FBC996F0092890DF49ADF0
+ 25D0D9A0038540BD8CC010FB2A853CBD8CC010FB253C88D0EC28C53DD0BEA540
+ C541D0B8B0B7A056843CBC8CC010FB59D602A43C88990003D0EE843CBC8CC010
+ FB59D602A43C9126C8D0EFBC8CC010FB59D602D087A000A256CA30FBB1265E00
+ 032A5E00032A9126C8D0EEE627E63DA53DCD0008A62B90DB4C01080000000000
;
; ==============================================================================
; Empty Address Space (MTSPC2)=($B700-$BFFF)
; ==============================================================================
;
B700: 00 00 00 00+ MTSPC2 DS 2304,$00 ;9 empty pgs of RAM/ROM-Image ($B700-$BFFF)
;
; ==============================================================================
; Hardware Input/Output Address Space (IOADR)=($C000-$C0FF) & (CLRROM)=($CFFF)
; ==============================================================================
; SLOT0 EQU $C000 ;I/O or Slot ROM Space (Only in ROM image), Empty!
; ------------------------------------------------------------------------------
; IOADR EQU $C000 ;Hardware I/O Addresses & Soft Switches:
; ;Range [(49152~49183)=($C000~$C01F)];
; ;#IOADR/256=$C0 is used to Set RAM I/O Vectors.
; ==============================================================================
; KBD EQU $C000 ;=($C00X); Keyboard Input Register: Gets set to a Key's
; ;High-ASCII Value when a Key is pressed (e.g., KBD > 127
; ;if any Key has been pressed since last cleared via
; ;KBDSTRB).
; KBDSTRB EQU $C010 ;=($C01X); Clear Keyboard Strobe: Resets Keyboard Input
; ;Register's high bit (from 1 to 0) so that the next
; ;keypress can set KBD again.
; TAPEOUT EQU $C020 ;=($C02X); Cassette Data Out: Digital to Analog Audio
; ;Output Toggle; Read Only!--Do NOT Write to these
; ;addresses [(49184~49199)= ($C020~$C02F)] (which are
; ;decoded {hard-wired} as the same single bit location);
; ;Toggles Audio Output
; ;(creates a 'click' on Cassette-Tape recordings).
; SPKR EQU $C030 ;=($C03X); Speaker Data Out: Digital to Analog Audio
; ;Output Toggle; Read Only!--Do NOT Write to these
; ;addresses [(49200~49215)=($C030~ $C03F)] (which are
; ;decoded {hard-wired} as the same single bitlocation);
; ;Toggles Audio Output
; ;(Your Apple's speaker' clicks' once).
; STROBE EQU $C040 ; =($C04X); Outputs Strobe Pulse to Game I/O Connector;
; ;Any one of these 16 locations
; ;[(49216~49231)=($C040~$C04F)] has the same effect
; ==============================================================================
; TXTCLR EQU $C050 ;Sets Graphics Mode without Clearing Screen;
; ;Resets from Text Mode.
; TXTSET EQU $C051 ;Sets Text Mode without Resetting Scrolling Window;
; ;Resets from Graphics Mode.
; MIXCLR EQU $C052 ;Sets Full-Screen Graphics Mode;
; ;Resets from Mixed Graphics Mode
; ;(with 4 lines of text at the bottom of the screen).
; MIXSET EQU $C053 ;Sets Mixed Text & Graphics Mode
; ;(with 4 lines of text at the bottom of the screen).
; LOWSCR EQU $C054 ;Displays Page 1 without Clearing the Screen.
; HISCR EQU $C055 ;Displays Page 2 without Clearing the Screen.
; LORES EQU $C056 ;Resets Page from Hi-Res to Lo-Res/Text Mode.
; HIRES EQU $C057 ;Resets Page from Lo-Res/Text to Hi-Res Mode.
; ==============================================================================
; Uncorrected Annunciator Labels [1st. of 3 Choices]
; [See: Tech Info Library Article No. 1062: Apple II Hardware:
; Errata in Apple II Reference Manual (Part 2 of 2)]
; ------------------------------------------------------------------------------
; ;SETAN0 EQU $C058 ;[R/W] * Set AN0: Toggle OFF (0VDC): WRONG!
; ;CLRAN0 EQU $C059 ;[R/W] Reset AN0: Toggle ON (+5VDC): WRONG!
; ;SETAN1 EQU $C05A ;[R/W] * Set AN1: Toggle OFF (0VDC): WRONG!
; ;CLRAN1 EQU $C05B ;[R/W] Reset AN1: Toggle ON (+5VDC): WRONG!
; ;SETAN2 EQU $C05C ;[R/W] * Set AN2: Toggle OFF (0VDC): WRONG!
; ;CLRAN2 EQU $C05D ;[R/W] Reset AN2: Toggle ON (+5VDC): WRONG!
; ;SETAN3 EQU $C05E ;[R/W] * Set AN3: Toggle OFF (0VDC): WRONG!
; ;CLRAN3 EQU $C05F ;[R/W] Reset AN3: Toggle ON (+5VDC): WRONG!
; ==============================================================================
; Corrected Annunciator Labels [2nd. of 3 Choices]
; [See: Tech Info Library Article No. 1062: Apple II Hardware:
; Errata in Apple II Reference Manual (Part 2 of 2)]
; ------------------------------------------------------------------------------
; ;CLRAN0 EQU $C058 ;[R/W] Reset AN0: Toggle OFF (0VDC)
; ;SETAN0 EQU $C059 ;[R/W] * Set AN0: Toggle ON (+5VDC)
; ;CLRAN1 EQU $C05A ;[R/W] Reset AN1: Toggle OFF (0VDC)
; ;SETAN1 EQU $C05B ;[R/W] * Set AN1: Toggle ON (+5VDC)
; ;CLRAN2 EQU $C05C ;[R/W] Reset AN2: Toggle OFF (0VDC)
; ;SETAN2 EQU $C05D ;[R/W] * Set AN2: Toggle ON (+5VDC)
; ;CLRAN3 EQU $C05E ;[R/W] Reset AN3: Toggle OFF (0VDC)
; ;SETAN3 EQU $C05F ;[R/W] * Set AN3: Toggle ON (+5VDC)
; ==============================================================================
; Renamed Corrected Annunciator Labels [3rd. of 3 Choices]
; [See: Tech Info Library Article No. 1062: Apple II Hardware:
; Errata in Apple II Reference Manual (Part 2 of 2)]
; ------------------------------------------------------------------------------
; AN0OFF EQU $C058 ;[R/W] CLRAN0: Reset AN0: Toggle OFF (0VDC)
; AN0ON EQU $C059 ;[R/W] SETAN0: * Set AN0: Toggle ON (+5VDC)
; AN1OFF EQU $C05A ;[R/W] CLRAN1: Reset AN1: Toggle OFF (0VDC)
; AN1ON EQU $C05B ;[R/W] SETAN1: * Set AN1: Toggle ON (+5VDC)
; AN2OFF EQU $C05C ;[R/W] CLRAN2: Reset AN2: Toggle OFF (0VDC)
; AN2ON EQU $C05D ;[R/W] SETAN2: * Set AN2: Toggle ON (+5VDC)
; AN3OFF EQU $C05E ;[R/W] CLRAN3: Reset AN3: Toggle OFF (0VDC)
; AN3ON EQU $C05F ;[R/W] SETAN3: * Set AN3: Toggle ON (+5VDC)
; ==============================================================================
; TAPEIN EQU $C060 ;=($C068); Cassette Data In:
; ;Digital State of Analog Audio Input Signal:
; ;HIGH/ON IF >127, LOW/OFF IF <128.
; ==============================================================================
; PB0 EQU $C061 ;=($C069); Paddle 0 PushButton Switch;
; ;Digital Input 0; HIGH/ON IF >127, LOW/OFF IF <128.
; PB1 EQU $C062 ;=($C06A); Paddle 1 PushButton Switch;
; ;Digital Input 1; HIGH/ON IF >127, LOW/OFF IF <128.
; PB2 EQU $C063 ;=($C06B); Paddle 2 PushButton Switch;
; ;Digital Input 2; HIGH/ON IF >127, LOW/OFF IF <128.
; ------------------------------------------------------------------------------
; PADDL0 EQU $C064 ;=($C06C); Paddle 0 Timer Digital Output State:
; ;Set >127 until Timer expires;
; ;Used To Set Paddl#,X ($C064+X).
; PADDL1 EQU $C065 ;=($C06D); Paddle 1 Timer Digital Output State:
; ;Set >127 until Timer expires.
; PADDL2 EQU $C066 ;=($C06E); Paddle 2 Timer Digital Output State:
; ;Set >127 until Timer expires.
; PADDL3 EQU $C067 ;=($C06F); Paddle 3 Timer Digital Output STATE:
; ;Set >127 until Timer expires.
; ------------------------------------------------------------------------------
; PTRIG EQU $C070 ;=($C07X); ALL Paddles Trigger;
; ;Restarts ALL Paddle Timers: Sets ALL >127.
; ==============================================================================
; Integrated WOZ Machine (IWM) I/O Locations & Soft Switches
; ------------------------------------------------------------------------------
; IWMPH0OFF EQU $C080 ;Stepper Motor Control
; IWMPH0ON EQU $C081 ;Stepper Motor Control
; IWMMOTORON EQU $C089 ;Starts Drive Motor Spinning
; IWMSELDRV1 EQU $C08A ;Selects Drive 1
; IWMQ6OFF EQU $C08C ;Read
; IWMQ7OFF EQU $C08E ;Write Protect Sense/Read
; ==============================================================================
; CLRROM EQU $CFFF ;Signals Peripheral Cards in ALL Slots
; ;to Disable their $C800-$CFFF Extension ROM.
; ==============================================================================
;
; I wonder (by JPD):
;
; What if these Slot ROM Address Spaces (Slot-0 to Slot-7 below) were NOT Empty?
; Like the Disk II (5.25" Floppy Disk Drive) Controller Card ROM image in Slot
; 6! Could we put our own Peripheral Card ROM images in these spaces? And,
; would they be used by emulators, or ignored by them? I'm sure that other
; software running on an emulator could use them.
;
; For example: A Parallel Printer interface card ROM image in Slot 1? Or, a
; Super Serial Card ROM image in Slot 2? Or, both? And, a 3.5" Floppy Disk
; Drive Controller Card ROM image in Slot 5? [Would an Integer BASIC Language
; or Slot 0 RAM/ROM Card image work?--Or, would Emulator Hardware I/O implemen-
; tations interfere with it?]
;
; Also: Do Apple II Plus emulators (like the Agat Emulator or AppleWin) put ROM
; images corresponding to the user's configuation choices in these spaces while
; they are running?
;
; Another idea: What if the Apple II RAM/ROM image was for the full 64K of
; Memory?--Filled with eveything you want your emulated Apple II to start with?
; The image in the memory of your modern computer running your Apple II Emulator
; of choice would then just need to be manipulated.--Your emulator would be
; manipulating the bits and bytes in this Apple II RAM/ROM image in memory like
; a real Apple II 6502 microprocessor does with its RAM space (48K of Main RAM
; +16K of Aux RAM/ROM {SW/HW/FW}).--[Is this how emulators really work?]
;
; ==============================================================================
; Input/Output Address Space (IOADR)=($C000-$C0FF) [See also: APPLE2.ROM.sym65]
; OR--> Slot 0 Address Space (SLOT0)=($C000-$C0FF) [Only in APPLE2.ROM image]
; ==============================================================================
C000: 00 00 00 00+ KBD DS 16,$00 ;~($C00X)[R] Keyboard Input Register
C010: 00 00 00 00+ KBDSTRB DS 16,$00 ;~($C01X)[W] Clear KBD Strobe (KBD<128)
C020: 00 00 00 00+ TAPEOUT DS 16,$00 ;~($C02X)[R] Toggle Cassette Data Output
C030: 00 00 00 00+ SPKR DS 16,$00 ;~($C03X)[R/W] Toggle Speaker Data Output
C040: 00 00 00 00+ STROBE DS 16,$00 ;~($C04X) Output Game Socket Strobe Pulse
; ==============================================================================
; $C05X I/O Space:
; ==============================================================================
C050: 00 TXTCLR DFB $00 ;[R/W] Set Graphics Display Mode
C051: 00 TXTSET DFB $00 ;[R/W] Set Text Only Display Mode
C052: 00 MIXCLR DFB $00 ;[R/W] Set Full Screen Graphics/Text Mode
C053: 00 MIXSET DFB $00 ;[R/W] Set Mixed Graphics & Text Mode
C054: 00 TXTPAGE1 DFB $00 ;[R/W] Display Text Page1 (R/W Main V-RAM)
C055: 00 TXTPAGE2 DFB $00 ;[R/W] Display Text Page2 (R/W Aux V-RAM)
C056: 00 LORES DFB $00 ;[R/W] Reset HiRes Mode to LoRes/Text Mode
C057: 00 HIRES DFB $00 ;[R/W] Reset LoRes/Text Mode to HiRes Mode
; ==============================================================================
; Renamed Corrected Annunciator Labels [3rd. of 3 Choices]--[See Above]
; [See: Tech Info Library Article No. 1062: Apple II Hardware:
; Errata in Apple II Reference Manual (Part 2 of 2)]
; ------------------------------------------------------------------------------
C058: 00 AN0OFF DFB $00 ;[R/W] CLRAN0: Reset AN0: Toggle OFF (0VDC)
C059: 00 AN0ON DFB $00 ;[R/W] SETAN0: * Set AN0: Toggle ON (+5VDC)
C05A: 00 AN1OFF DFB $00 ;[R/W] CLRAN1: Reset AN1: Toggle OFF (0VDC)
C05B: 00 AN1ON DFB $00 ;[R/W] SETAN1: * Set AN1: Toggle ON (+5VDC)
C05C: 00 AN2OFF DFB $00 ;[R/W] CLRAN2: Reset AN2: Toggle OFF (0VDC)
C05D: 00 AN2ON DFB $00 ;[R/W] SETAN2: * Set AN2: Toggle ON (+5VDC)
C05E: 00 AN3OFF DFB $00 ;[R/W] CLRAN3: Reset AN3: Toggle OFF (0VDC)
C05F: 00 AN3ON DFB $00 ;[R/W] SETAN3: * Set AN3: Toggle ON (+5VDC)
; ==============================================================================
; $C06X I/O Space:
; ==============================================================================
C060: 00 TAPEIN DFB $00 ;+($C068)[R] Cassette Data Input
C061: 00 PB0 DFB $00 ;+($C069)[R] Paddle 0 Pushbutton Switch
C062: 00 PB1 DFB $00 ;+($C06A)[R] Paddle 1 Pushbutton Switch
C063: 00 PB2 DFB $00 ;+($C06B)[R] Paddle 2 Pushbutton Switch
C064: 00 PADDL0 DFB $00 ;+($C06C)[R] Paddle 0 Analog Input
C065: 00 PADDL1 DFB $00 ;+($C06D)[R] Paddle 1 Analog Input
C066: 00 PADDL2 DFB $00 ;+($C06E)[R] Paddle 2 Analog Input
C067: 00 PADDL3 DFB $00 ;+($C06F)[R] Paddle 3 Analog Input
; ------------------------------------------------------------------------------
C068: 00 TAPEIN_X DFB $00 ;+($C060)[R] Cassette Data Input
C069: 00 PB0_X DFB $00 ;+($C061)[R] Paddle 0 Pushbutton Switch
C06A: 00 PB1_X DFB $00 ;+($C062)[R] Paddle 1 Pushbutton Switch
C06B: 00 PB2_X DFB $00 ;+($C063)[R] Paddle 2 Pushbutton Switch
C06C: 00 PADDL0_X DFB $00 ;+($C064)[R] Paddle 0 Analog Input
C06D: 00 PADDL1_X DFB $00 ;+($C065)[R] Paddle 1 Analog Input
C06E: 00 PADDL2_X DFB $00 ;+($C066)[R] Paddle 2 Analog Input
C06F: 00 PADDL3_X DFB $00 ;+($C067)[R] Paddle 3 Analog Input
; ==============================================================================
;
C070: 00 00 00 00+ PTRIG DS 16,$00 ;~($C07X)[R/W] Reset All Paddles Trigger
;
; ==============================================================================
; Integrated WOZ Machine (IWM) I/O Locations & Soft Switches
; ==============================================================================
;
C080: 00 IWMPH0OFF DFB $00 ;Stepper Motor Control
C081: 00 IWMPH0ON DFB $00 ;Stepper Motor Control
C082: 00 00 00 00+ MTSPC3 DS 7,$00 ;ROM Image Empty Space (MTSPC3)!
C089: 00 IWMMOTORON DFB $00 ;Starts Drive Motor Spinning
C08A: 00 IWMSELDRV1 DFB $00 ;Selects Drive 1
C08B: 00 MTSPC4 DFB $00 ;ROM Image Empty Space (MTSPC4)!
C08C: 00 IWMQ6OFF DFB $00 ;Read
C08D: 00 MTSPC5 DFB $00 ;ROM Image Empty Space (MTSPC5)!
C08E: 00 IWMQ7OFF DFB $00 ;Write Protect Sense/Read
C08F: 00 00 00 00+ MTSPC6 DS 113,$00 ;ROM Image Empty Space (MTSPC6)!
;
; ==============================================================================
; Slot 1 Address Space (SLOT1)=($C100-$C1FF)
; ==============================================================================
;
C100: 00 00 00 00+ SLOT1 DS 256,$00 ;Slot ROM Space, Empty!
;
; ==============================================================================
; Slot 2 Address Space (SLOT2)=($C200-$C2FF)
; ==============================================================================
;
C200: 00 00 00 00+ SLOT2 DS 256,$00 ;Slot ROM Space, Empty!
;
; ==============================================================================
; Slot 3 Address Space (SLOT3)=($C300-$C3FF)
; ==============================================================================
;
C300: 00 00 00 00+ SLOT3 DS 256,$00 ;Slot ROM Space, Empty!
;
; ==============================================================================
; Slot 4 Address Space (SLOT4)=($C400-$C4FF)
; ==============================================================================
;
C400: 00 00 00 00+ SLOT4 DS 256,$00 ;Slot ROM Space, Empty!
;
; ==============================================================================
; Slot 5 Address Space (SLOT5)=($C500-$C5FF)
; ==============================================================================
;
C500: 00 00 00 00+ SLOT5 DS 256,$00 ;Slot ROM Space, Empty!
;
; ==============================================================================
; Slot 6 Address Space (SLOT6)=($C600-$C6FF)
; ==============================================================================
; Disk II (5.25" Floppy Disk Drive) Controller Card ROM (BOOT0 Code)
; Reads the BOOT1 code from track 0, sector 0, and jumps to it.
; ------------------------------------------------------------------------------
; This code is a copy (or vice-versa) of the $B600-$B6FF Address Space. It does
; not need to be analyzed twice, so it is densely packed there (above).
; ------------------------------------------------------------------------------
; [Comments in this section were mostly by Andy McFadden (appended by me: JPD)]
; ==============================================================================
;
; SLOT6 EQU $C600 ;Slot 6 Address Space (SLOT6)=($C600-$C6FF)
;
; ==============================================================================
;
C600: A2 20 DISK2ROM LDX #$20 ;AKA: SLOT6; SLOT6ROM; & DISK2ROM
C602: A0 00 LDY #$00 ;"$20 $00 $03" is the controller signature
C604: A2 03 LDX #$03
;
; ==============================================================================
; Generate a decoder table for 6+2 encoded data.
;
; This stores the values $00-$3F in a table on page 3. The byte values that
; will be decoded are non-consecutive, so the decoder entries occupy various
; locations from $36C to $3D5. Nearby bytes are left unchanged.
;
; We want 64 values that have the high bit set and don't have two consecutive 0
; bits. This is required by the disk hardware. There are 70 possible values,
; so we also mandate that there are two adjacent 1 bits, excluding bit 7. (Note
; that $D5 and $AA, used to identify sector headers, do not meet these criteria,
; which means they never appear in the encoded data.)
;
; In the code below, a ASL+BIT+BCS test checks for adjacent 1 bits: if no two
; are adjacent, the BIT test will be zero. If the high bit is set, ASL will set
; the carry.
;
; When we ORA the original and shifted values together, if there were three
; adjacent 0 bits, there will still be at least two adjacent 0 bits. We EOR to
; invert the bits, and then look for two adjacent 1 bits. We do this by just
; shifting right until a 1 bit shifts into the carry, and if the A-Reg is
; nonzero we know there were at least two 1 bits. We need to ignore the bits on
; the ends: the nonzero MSB (high bit) was handled earlier, and the LSB (low
; bit) can false-positive because ASL always shifts a 0 in (making it look like
; a 0 in the low bit is adjacent to another 0), so we just mask those off with
; the AND.
;
; For example, we want to decode $A6 to $07. Y=$07 when X=$26...
;
; TXA --> 0010 0110
; ASL --> 0100 1100 C=0 (high bit is clear)
; BIT --> Z=0 (only possible with adjacent bits)
; ORA --> 0110 1110 (adjacent 0 bits become visible)
; EOR --> 1001 0001 (turn them into 1 bits)
; AND --> 0001 0000 (ignore the hi/lo)
; LSR --> 0000 1000 (repeat until A=0 C=1)
; ==============================================================================
;
; ------------------------------------------------------------------------------
; Make Decoder/Conversion Table
; ------------------------------------------------------------------------------
;
C606: 86 3C MKDCTBL STX IWMBITS ;Save Bits for Bit Comparison
C608: 8A TXA ;Gets incremented (but it started at #3)
C609: 0A ASL A ;Shift High-Bit Left into Carry Flag
C60A: 24 3C BIT IWMBITS ;Does shifted version overlap?
C60C: F0 10 BEQ REJECT ;NO: Doesn't have two adjacent 1 bits
C60E: 05 3C ORA IWMBITS ;YES, continue on: Merge
C610: 49 FF EOR #%11111111 ;Invert Bits
C612: 29 7E AND #%01111110 ;Clear High & Low Bits
;
; ------------------------------------------------------------------------------
; Check for Double Zeroes
; ------------------------------------------------------------------------------
;
C614: B0 08 CHKDBL0S BCS REJECT ;Initial High- or Adjacent 0-Bits were Set
C616: 4A LSR A ;Shift Low-Bit Right into Carry Flag
C617: D0 FB BNE CHKDBL0S ;Loop If more 1 Bits are in the Byte
; ------------------------------------------------------------------------------
; Loops while Z-Flag=0 (or while resultant A-Reg<>0), or [logically equivalent]
; Loops until Z-Flag=1 (or until resultant A-Reg=0).
; ------------------------------------------------------------------------------
; Shouldn't this branch be based on the Carry flag, too? Yes & No! ...
; BCS starts the loop, so is effectively tested next, after BNE. The loop is
; done (exited) when BNE drops through or BCS branches out of (or over) it.
; ------------------------------------------------------------------------------
C619: 98 TYA ;We have a winner! Store Y-Reg in memory.
C61A: 9D 56 03 STA CNVTBL,X ;Actual lookup will be on Hi-Bit Set Bytes,
C61D: C8 INY ; so they will be read from CNVTBL-128
C61E: E8 REJECT INX ;Try next candidate!?
C61F: 10 E5 BPL MKDCTBL ;Loop If [0=<(X-Reg)<128]; it started at #3
;
; ------------------------------------------------------------------------------
; Prepare the Hardware
; ------------------------------------------------------------------------------
;
C621: 20 58 FF JSR IORTS ;JSR to RTS: Puts Our Address on the STACK
C624: BA TSX ;Get STACK Pointer
C625: BD 00 01 LDA STACK,X ;Get Our Address (High Byte) from STACK
C628: 0A ASL A ;(Assuming no interrupts have happened)
C629: 0A ASL A ;Multiply by 16
C62A: 0A ASL A ;(Puts Low Nibble into High Nibble)
C62B: 0A ASL A ;[(%nnnn0000)<-(%XXXXnnnn)]~[($60)<-($C6)]
C62C: 85 2B STA IWMSLTNDX ;Keep it [(%SLOT0000)~($60)] Safe!
C62E: AA TAX ;Put 16*SLOT# ($60) into X-Reg
C62F: BD 8E C0 LDA IWMQ7OFF,X ;Set to Read Mode (Write Protect Sense/Read)
C632: BD 8C C0 LDA IWMQ6OFF,X ;Set to Read Mode (Read)
C635: BD 8A C0 LDA IWMSELDRV1,X ;Select Drive 1
C638: BD 89 C0 LDA IWMMOTORON,X ;Start Motor & Spin it Up to Speed
;
; ------------------------------------------------------------------------------
; Blind-Seek to Track Zero
; ------------------------------------------------------------------------------
;
C63B: A0 50 LDY #80 ;80 Phases (40 Tracks)
C63D: BD 80 C0 FINDT0S0 LDA IWMPH0OFF,X ;Turn OFF Phase N
C640: 98 TYA ;Get Phase {2 Phases/Track}
C641: 29 03 AND #3 ;MOD the Phase Number to get 0-3
C643: 0A ASL A ;Double it to 0/2/4/6
C644: 05 2B ORA IWMSLTNDX ;Add in the Slot Index
C646: AA TAX ;Put result into X-Reg
C647: BD 81 C0 LDA IWMPH0ON,X ;Turn ON Phase 0, 1, 2, or 3
C64A: A9 56 LDA #86 ;Delay for (26+27*Acc+5*(Acc*Acc))/2 Cycles
C64C: 20 A8 FC JSR MON_WAIT ;Wait 19664 Cycles
C64F: 88 DEY ;Next Phase
C650: 10 EB BPL FINDT0S0 ;Loop If [0=<(Y)<128]; it started at #80
; ;A-Reg is 0 when MON_WAIT Returns
; ;So we're looking for Track=0 Sector=0
C652: 85 26 STA IWMDATAPTR ;Data Destination Ptr, Low; (Write Output)
C654: 85 3D STA IWMSECTOR ;IWM: Sector to Read
C656: 85 41 STA IWMTRACK ;IWM: Track to Read
C658: A9 08 LDA #>BOOT1 ;DOS Load Buffer Address ($0800), High Byte
C65A: 85 27 STA IWMDATAPTR+1 ;Data Destination Ptr, High; (Write Output)
;
; ------------------------------------------------------------------------------
; Sector Read routine.
;
; Read bytes until we find an address header (D5 AA 96) or
; data header (D5 AA AD), depending on which mode we're in.
;
; This will also be called by the BOOT1 code read from the floppy disk.
;
; On entry:
; X: slot * 16
; $26-27: data pointer
; $3d: desired sector
; $41: desired track
; ------------------------------------------------------------------------------
;
C65C: 18 RDSECT CLC ;Find the Sector to Read
C65D: 08 RDSECT0 PHP ;Find Data; Rentry for Correct T/S found
C65E: BD 8C C0 RDSECT1 LDA IWMQ6OFF,X ;Wait for a byte; Loop-Back Reentry Point
C661: 10 FB BPL RDSECT1 ;No byte yet if [0=<(A-Reg)<128], Loop
C663: 49 D5 RDSECT2 EOR #$D5 ;Is it $D5?
C665: D0 F7 BNE RDSECT1 ;NO, keep looking, Loop
C667: BD 8C C0 RDSECT3 LDA IWMQ6OFF,X ;YES, grab another byte
C66A: 10 FB BPL RDSECT3 ;No byte yet if [0=<(A-Reg)<128], Loop
C66C: C9 AA CMP #$AA ;Is it $AA?
C66E: D0 F3 BNE RDSECT2 ;NO, Loop: check if it is another $D5
C670: EA NOP ;YES, Delay 2 Cycles
C671: BD 8C C0 RDSECT4 LDA IWMQ6OFF,X ;Grab a third byte
C674: 10 FB BPL RDSECT4 ;No byte yet if [0=<(A-Reg)<128], Loop
C676: C9 96 CMP #$96 ;Is it $96?
C678: F0 09 BEQ RDSAD ;YES, Read sector's Address Data next
C67A: 28 PLP ;Upon entry, did we want Data?
C67B: 90 DF BCC RDSECT ;NO, keep looking, Loop
C67D: 49 AD EOR #$AD ;YES, is it Data Prologue?
C67F: F0 25 BEQ RDF62ESD ;YES if [(A-Reg)=0], Read the Found Data
C681: D0 D9 BNE RDSECT ;NO, keep looking, Loop
; ------------------------------------------------------------------------------
; Read the Sector Address Data
; Four fields, in 4+4 encoding: Volume, Track, Sector, Cecksum
; ------------------------------------------------------------------------------
;
; Found Address:
C683: A0 03 RDSAD LDY #$03 ;Sector # is the 3rd item in Header
; Address Header Loop:
C685: 85 40 RDSAD1 STA IWMTRKFND ;Store $96, then Volume, then Track
C687: BD 8C C0 RDSAD2 LDA IWMQ6OFF,X ;Read 1st Part, Wait for a byte
C68A: 10 FB BPL RDSAD2 ;No byte yet if [0=<(A-Reg)<128], Loop
C68C: 2A ROL A ;1st Byte has Bits 7/5/3/1
C68D: 85 3C STA IWMBITS ;Save it for Merging
C68F: BD 8C C0 RDSAD3 LDA IWMQ6OFF,X ;Read 2nd Part, Wait for a byte
C692: 10 FB BPL RDSAD3 ;No byte yet if [0=<(A-Reg)<128], Loop
C694: 25 3C AND IWMBITS ;Merge the Bytes/Bits
C696: 88 DEY ;Is this the 3rd item?
C697: D0 EC BNE RDSAD1 ;NO, keep looking, Loop
C699: 28 PLP ;YES, pull P-Reg to keep STACK in balance
C69A: C5 3D CMP IWMBITS+1 ;Is this the Sector we want?
C69C: D0 BE BNE RDSECT ;NO, go back to looking for addresses
C69E: A5 40 LDA IWMTRKFND ;YES, this is the Sector we want!
C6A0: C5 41 CMP A3H ;But, is this the Track we want?
C6A2: D0 B8 BNE RDSECT ;NO, go back to looking for addresses
C6A4: B0 B7 BCS RDSECT0 ;YES, Correct T/S, Go Find Data; Always
;
; ------------------------------------------------------------------------------
; Read the 6+2 encoded sector data.
;
; Values range from $96 - $FF. They must have the high bit set, and must not
; have three consecutive zeroes.
;
; The data bytes are written to disk with a rolling XOR to compute a checksum,
; so we read them back the same way. We keep this in the A-Reg for the
; duration. The actual value is always in the range [$00 to $3F=(%00111111)]
; (six-bits).
;
; On entry:
; (A-Reg)=($00)
; ------------------------------------------------------------------------------
;
C6A6: A0 56 RDF62ESD LDY #$56 ;Read the Found 6+2 Encoded Sector Data
;
; ------------------------------------------------------------------------------
; Read Twos Loop: ;Read 86 Bytes of Data into $0300-$0355
; ;Each byte has 3 sets of 2 bits, encoded
; ------------------------------------------------------------------------------
;
C6A8: 84 3C RDTWOS STY IWMBITS ;Save Byte-Counter
C6AA: BC 8C C0 RDTWOS1 LDY IWMQ6OFF,X ;Wait for a byte
C6AD: 10 FB BPL RDTWOS1 ;No byte yet if [0=<(Y-Reg)<128], Loop
C6AF: 59 D6 02 EOR CNVTBL-128,Y ;Conversion-Data XOR A-Reg --> A-Reg
; [($2D6)=($356-$80)=(CNVTBL-128)] ;1st Entry is at [($2D6+$96)=($36C)]
C6B2: A4 3C LDY IWMBITS ;Get Byte-Counter from Safe
C6B4: 88 DEY ;Count Down to Zero (from 86)
C6B5: 99 00 03 STA TWOSBUFF,Y ;Save A-Reg in the Page 3 Buffer
C6B8: D0 EE BNE RDTWOS ;Loop if (Y-Reg)<>0
;
; ------------------------------------------------------------------------------
; Read Sixes Loop: ;Read 256 Bytes of Data into $800-$8FF
; ;Each byte has the high 6 bits, encoded
; ------------------------------------------------------------------------------
;
C6BA: 84 3C RDSIXES STY IWMBITS ;Save Byte-Counter
C6BC: BC 8C C0 RDSIXES1 LDY IWMQ6OFF,X ;Wait for a byte
C6BF: 10 FB BPL RDSIXES1 ;No byte yet if [0=<(Y-Reg)<128], Loop
C6C1: 59 D6 02 EOR CNVTBL-128,Y ;Conversion-Data XOR A-Reg --> A-Reg
; [($2D6)=($356-$80)=(CNVTBL-128)] ;1st Entry is at [($2D6+$96)=($36C)]
C6C4: A4 3C LDY IWMBITS ;Get Byte-Counter from Safe
C6C6: 91 26 STA (IWMDATAPTR),Y ;Save A-Reg in the Eventual Data Buffer
C6C8: C8 INY ;Count Up to 256 (Zero: 256 MOD 256 = 0)
C6C9: D0 EF BNE RDSIXES ;Loop if (Y-Reg)<>0
;
; ------------------------------------------------------------------------------
; Read Checksum Loop: ;Read the Checksum Byte
; ------------------------------------------------------------------------------
;
C6CB: BC 8C C0 RDCHKSUM LDY IWMQ6OFF,X ;Wait for a byte
C6CE: 10 FB BPL RDCHKSUM ;No byte yet if [0=<(Y-Reg)<128], Loop
C6D0: 59 D6 02 EOR CNVTBL-128,Y ;Conversion-Data XOR A-Reg --> A-Reg
; [($2D6)=($356-$80)=(CNVTBL-128)] ;1st Entry is at [($2D6+$96)=($36c)]
; ;Does Checksum Byte match A-Reg Byte?
; ;NO, BNE: Try to find an Undamaged Sector
; ;YES, BNE does not happen: Drop Through
C6D3: D0 87 RDF62ESDX BNE RDSECT ;Loop if (A)<>(0)
;
; ------------------------------------------------------------------------------
; Decode the 6+2 encoding. The high 6 bits of each byte are in place, now we
; just need to shift the low 2 bits of each in.
; ------------------------------------------------------------------------------
;
C6D5: A0 00 LDY #$00 ;Update 256 Bytes
C6D7: A2 56 DCD62ENC LDX #$56 ;Run through the 2-bit pieces 3x (86*3=258)
; Decode 6+2 Encoding Loop:
C6D9: CA DCD62ENC1 DEX ;Count Down to Zero (from 86)
C6DA: 30 FB BMI DCD62ENC ;If we hit $02FF, go back to $0355
C6DC: B1 26 LDA (IWMDATAPTR),Y ;For each Byte in the Data Buffer...
C6DE: 5E 00 03 LSR TWOSBUFF,X ;Grab Low Two Bits from 2sBuff ($300-$355)
C6E1: 2A ROL A ;Roll them into the Low Two Bits of the Byte
C6E2: 5E 00 03 LSR TWOSBUFF,X ;[Doesn't this modify Data in Twos Buffer?]
C6E5: 2A ROL A ;[Won't we be using this 2sBuff Data again?]
C6E6: 91 26 STA (IWMDATAPTR),Y ;Save each Modified Byte in the Data Buffer
C6E8: C8 INY ;Count Up to 256 (Zero: 256 MOD 256 = 0)
C6E9: D0 EE BNE DCD62ENC1 ;Loop if (Y-Reg)<>0
; ------------------------------------------------------------------------------
; Advance the data pointer and sector number, and check to see if the sector
; number matches the first byte of BOOT1. If it does, we're done. If not, go
; read the next sector.
; ------------------------------------------------------------------------------
C6EB: E6 27 INC IWMDATAPTR+1 ;Advance the Data Pointer
C6ED: E6 3D INC IWMSECTOR ;Advance the Sector Number
C6EF: A5 3D LDA IWMSECTOR ;The Sector we would read next
C6F1: CD 00 08 CMP BOOT1 ;Is next Sector < BOOT1?
C6F4: A6 2B LDX IWMSLTNDX ;Put Slot Number in X-Reg
C6F6: 90 DB BCC RDF62ESDX ;YES, get another Sector; Branches again!
; ------------------------------------------------------------------------------
; Boot-Strapping of the BOOT code is done; Now execute the BOOT code
; ------------------------------------------------------------------------------
C6F8: 4C 01 08 JMP BOOT1+1 ;All done, jump to BOOT1
C6FB: 00 00 00 00+ HEX 0000000000 ;Spare Bytes
;
; ==============================================================================
; Slot 7 Address Space (SLOT7)=($C700-$C7FF)
; ==============================================================================
;
C700: 00 00 00 00+ SLOT7 DS 256,$00 ;Slot ROM Space, Empty!
;
; ==============================================================================
; All Peripheral Card Slots' Shared $C800-$CFFF Extension RAM/ROM Memory Space
; ==============================================================================
;
C800: 00 00 00 00+ ALLSLOTS DS 1534,$00 ;All Slots RAM/ROM Space, Empty
CDFE: 00 00 00 00+ SLTVTAB DS 341,$00
CF53: 00 00 00 00+ SLTGOERR DS 137,$00
CFDC: 00 00 00 00+ JMPADRTBL DS 35,$00 ;Empty Space; Base Address (UNFNC-164) for
; ; Index into Unary Functions Address Table
CFFF: 00 CLRROM DFB $00 ;Tell Slots to Disable their Extension ROM
;
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
; ==============================================================================
; ROM Space ($D000-$D7FF): ROM Socket $D0 on a real Apple II Plus.
; ==============================================================================
; The $D0 ROM was Programmmers Aid #1 ROM in Apple II (not in Apple II Plus)!
; ------------------------------------------------------------------------------
; The AGAT emulator APPLE2.ROM image (12.0 KB, 7/4/1996) starts here; it is
; identical to AppleWin's APPLE2.ROM image (20.0 KB, 3/27/1995) from here on.
; ==============================================================================
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
;
;
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
; ==============================================================================
; Applesoft: Floating Point BASIC for the Apple II
; Copyright (c) 1978 by Apple Computer, Inc. All Rights Reserved.
; Written by Microsoft, Inc. and Extended by R. Wigginton.
; ==============================================================================
; Part A, $D000-$DD66: Input Parsing, Routine Addressing, For-Next Loops, etc.
; Part B, $DD67-$E79F: Formula Evaluation, Pointer Locating, & String Handling
; Part C, $E7A0-$F1D4: Floating Point Math Routines
; Part D, $F1D5-$F7FF: Graphics Display Routines, etc.
; ==============================================================================
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
;
;
; YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY
; ==============================================================================
; To see: "How Applesoft BASIC Programs Are Arranged In Memory",
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", pages 5 to 8
; ------------------------------------------------------------------------------
; To see: "How Applesoft BASIC Program Lines Are Constructed",
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", page 15
; ------------------------------------------------------------------------------
; To see: "How Applesoft BASIC Program Varables* Are Structured"
; *(Reals {Floating Point}, Integers, Strings, Functions, and Arrays),
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", pages 21 to 24
; ------------------------------------------------------------------------------
; To see: "How Applesoft BASIC Floating Point Math, Constants, & FAC Behave",
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", pages 52 to 54
; ==============================================================================
; YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY
;
;
; ==============================================================================
; Applesoft Zero Page Usage Map:
; ==============================================================================
;
; Key: X = General usage
; . = Not used
; C = Set by cold start but not used
; H = Used by high resolution grraphics only
; G = Used by low resolution grraphics only
; T = Used by tape routines only
; D = Important DOS use
; $ = Used by STR$ routine only
; U = Set up for USR, not otherwise used
; 8 = Used by some 80 column cards
;
; ==============================================================================
;
; 0 1 2 3 4 5 6 7 8 9 A B C D E F
; -------------------------------
; 0X: C C C C C C . . . . U U U X X X
; 1X: X X X X X X X . . . H H H H 8 8
; 2X: X X X X X X H H X X X X G G X T
; 3X: G . X X . X X X X X . . T T T T
; 4X: D D D D D D D D D D . . . . X X
; 5X: X X X X X X X X X X X X X X X X
; 6X: X X X X X X X X X X X X X X X X
; 7X: X X X X X X X X X X X X X X X X
; 8X: X X X X X X X X X X X X X X . X
; 9X: X X X X X X X X X X X X X X X X
; AX: X X X X X X X X X X X X X X X X
; BX: X X X X X X X X X X X X X X X X
; CX: X X X X X X X X X X X X X X . .
; DX: H H H H H H X . X . X X X X X X
; EX: H H H H H H H H H H H . . . . .
; FX: X X X X X X X X X H . . . . . $
; -------------------------------
; 0 1 2 3 4 5 6 7 8 9 A B C D E F
;
; ==============================================================================
;
;
; ==============================================================================
; Preamble about the Applesoft Floating Point Accumulators
; [FAC & ARG (6 Bytes each)]:
; ------------------------------------------------------------------------------
; To see: "How Applesoft BASIC Floating Point Math, Constants, & FAC Behave",
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", pages 52 to 54
; ------------------------------------------------------------------------------
; Significand is the Most Significant Part of a Number; Mantissa is the
; fractional part of a Decimal Number, to the right of the decimal point:
; ==============================================================================
; FAC EQU $9D ;Primary Floating Point Accumulator (6B)
; ;FACX EQU $9D ;1st FAC Exponent [Signed =(-128..+0..+127)]
; ;FACT EQU $9E ;1st FAC Mantissa, Top [Signed = (-128..+0..+127)]
; ;FACH EQU $9F ;1st FAC Mantissa, High [Unsigned = (+0..+255)]
; ;FACM EQU $A0 ;1st FAC Mantissa, Middle [Unsigned = (+0..+255)]
; ;FACL EQU $A1 ;1st FAC Mantissa, Low [Unsigned = (+0..+255)]
; FACSIGN EQU $A2 ;1st FAC Unpacked Sign (msb) [Used by FP Math Package]
; ;Packed format does not use FACSIGN; the Binary Mantissa msb holds the sign;
; ;but, to print a minus sign when Printing FAC ($ED2EG), its msb must be set.
; ------------------------------------------------------------------------------
; ARG EQU $A5 ;Secondary Floating Point Accumulator (6B)
; ;ARGX EQU $A5 ;2nd FAC Exponent [Signed = (-128..+0..+127)]
; ;ARGT EQU $A6 ;2nd FAC Mantissa, Top [Signed = (-128..+0..+127)]
; ;ARGH EQU $A7 ;2nd FAC Mantissa, High [Unsigned = (+0..+255)]
; ;ARGM EQU $A8 ;2nd FAC Mantissa, Middle [Unsigned = (+0..+255)]
; ;ARGL EQU $A9 ;2nd FAC Mantissa, Low [Unsigned = (+0..+255)]
; ARGSIGN EQU $AA ;2nd FAC Unpacked Sign (msb) [Used by FP Math Package]
; ;Packed format does not use ARGSIGN; the Binary Mantissa msb holds the sign.
; ==============================================================================
; ARGEXT EQU $92 ;----- ARG Extra Precision Byte for FP Op's (1B)
; TEMP1 EQU $93 ;~$97: Packed FAC Temp Save Area & FP Math Register
; TEMP2 EQU $98 ;~$9C: Packed FAC Temp Save Area & FP Math Register
; TEMP3 EQU $8A ;~$8E: Packed FAC Temp Save Area & FP Math Register
; FACEXT EQU $AC ;----- FAC Extra Precision Byte for FP Op's (1B)
; RNDSEED EQU $C9 ;~$CD: Packed FAC Floating Point Random Number Seed
; ==============================================================================
; Packed FAC Numberic Constant Exanples:
; ==============================================================================
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; | Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific |
; | ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec |
; |========================|=====|================|===========|==============|
; |NRM_QTR HEX 7F00000000 |(00) |$7F-$80=$FF= -1 |$.00000000 |+2.50000000E-1|
; |POS_QTR HEX 7F80000000 |(00) |$7F-$80=$FF= -1 |$.80000000 |+2.50000000E-1|
; |NEG_QTR HEX 7F80000000 |(FF) |$7F-$80=$FF= -1 |$.80000000 |-2.50000000E-1|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_HALF HEX 8000000000 |(00) |$80-$80=$00= +0 |$.00000000 |+5.00000000E-1|
; |POS_HALF HEX 8080000000 |(00) |$80-$80=$00= +0 |$.80000000 |+5.00000000E-1|
; |NEG_HALF HEX 8080000000 |(FF) |$80-$80=$00= +0 |$.80000000 |-5.00000000E-1|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_ONE HEX 8100000000 |(00) |$81-$80=$01= +1 |$.00000000 |+1.00000000E+0|
; |POS_ONE HEX 8180000000 |(00) |$81-$80=$01= +1 |$.80000000 |+1.00000000E+0|
; |NEG_ONE HEX 8180000000 |(FF) |$81-$80=$01= +1 |$.80000000 |-1.00000000E+0|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_TEN HEX 8420000000 |(00) |$84-$80=$04= +4 |$.20000000 |+1.00000000E+1|
; |POS_TEN HEX 84A0000000 |(00) |$84-$80=$04= +4 |$.A0000000 |+1.00000000E+1|
; |NEG_TEN HEX 84A0000000 |(FF) |$84-$80=$04= +4 |$.A0000000 |-1.00000000E+1|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_SQRH HEX 803504F334 |(00) |$80-$80=$00= +0 |$.3504F334 |+2.07106781E-1|
; |POS_SQRH HEX 80B504F334 |(00) |$80-$80=$00= +0 |$.B504F334 |+7.07106781E-1|
; |NEG_SQRH HEX 80B504F334 |(FF) |$80-$80=$00= +0 |$.B504F334 |-7.07106781E-1|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_SQR2 HEX 813504F334 |(00) |$81-$80=$01= +1 |$.3504F334 |+0.41421356E+0|
; |POS_SQR2 HEX 81B504F334 |(00) |$81-$80=$01= +1 |$.B504F334 |+1.41421356E+0|
; |NEG_SQR2 HEX 81B504F334 |(FF) |$81-$80=$01= +1 |$.B504F334 |-1.41421356E+0|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_LN2 HEX 80317217F8 |(00) |$80-$80=$00= +0 |$.317217F8 |+1.93147181E-1|
; |POS_LN2 HEX 80B17217F8 |(00) |$80-$80=$00= +0 |$.B17217F8 |+6.93147181E-1|
; |NEG_LN2 HEX 80B17217F8 |(FF) |$80-$80=$00= +0 |$.B17217F8 |-6.93147181E-1|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_LOGE HEX 8138AA3B29 |(00) |$81-$80=$01= +1 |$.38AA3B29 |+0.44269504E+0|
; |POS_LOGE HEX 81B8AA3B29 |(00) |$81-$80=$01= +1 |$.B8AA3B29 |+1.44269504E+0|
; |NEG_LOGE HEX 81B8AA3B29 |(FF) |$81-$80=$01= +1 |$.B8AA3B29 |-1.44269504E+0|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_PID2 HEX 81490FDAA2 |(00) |$81-$80=$01= +1 |$.490FDAA2 |+0.57079633E+0|
; |POS_PID2 HEX 81C90FDAA2 |(00) |$81-$80=$01= +1 |$.C90FDAA2 |+1.57079633E+0|
; |NEG_PID2 HEX 81C90FDAA2 |(FF) |$81-$80=$01= +1 |$.C90FDAA2 |-1.57079633E+0|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_PI HEX 82490FDAA2 |(00) |$82-$80=$02= +2 |$.490FDAA2 |+1.14159265E+0|
; |POS_PI HEX 82C90FDAA2 |(00) |$82-$80=$02= +2 |$.C90FDAA2 |+3.14159266E+0|
; |NEG_PI HEX 82C90FDAA2 |(FF) |$82-$80=$02= +2 |$.C90FDAA2 |-3.14159266E+0|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_PIM2 HEX 83490FDAA2 |(00) |$83-$80=$03= +3 |$.490FDAA2 |+2.28318531E+0|
; |POS_PIM2 HEX 83C90FDAA2 |(00) |$83-$80=$03= +3 |$.C90FDAA2 |+6.28318531E+0|
; |NEG_PIM2 HEX 83C90FDAA2 |(FF) |$83-$80=$03= +3 |$.C90FDAA2 |-6.28318531E+0|
; |------------------------|-----|----------------|-----------|--------------|
; |BAD32768 HEX 9080000020 |(FF) |$90-$80=$10=+16 |$.80000020 |-3.27680005E+4|
; |POS32768 HEX 9080000000 |(00) |$90-$80=$10=+16 |$.80000000 |+3.27680000E+4|
; |NEG32768 HEX 9080000000 |(FF) |$90-$80=$10=+16 |$.80000000 |-3.27680000E+4|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_E8M1 HEX 9B3EBC1FFD |(00) |$9B-$80=$18=+24 |$.3EBC1FFD |+3.28911359E+7|
; |POS_E8M1 HEX 9BBEBC1FFD |(00) |$9B-$80=$18=+24 |$.BEBC1FFD |+9.99999999E+7|
; |NEG_E8M1 HEX 9BBEBC1FFD |\FF) |$9B-$80=$18=+24 |$.BEBC1FFD |-9.99999999E+7|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_E9M1 HEX 9E6E6B27FD |(00) |$9E-$80=$1E=+30 |$.6E6B27FD |+4.63129087E+8|
; |POS_E9M1 HEX 9EEE6B27FD |(00) |$9E-$80=$1E=+30 |$.EE6B27FD |+9.99999999E+8|
; |NEG_E9M1 HEX 9EEE6B27FD |(FF) |$9E-$80=$1E=+30 |$.EE6B27FD |-9.99999999E+8|
; |------------------------|-----|----------------|-----------|--------------|
; |NRM_E9 HEX 9E6E6B2800 |(00) |$9E-$80=$1E=+30 |$.6E6B2800 |+4.63129088E+8|
; |POS_E9 HEX 9EEE6B2800 |(00) |$9E-$80=$1E=+30 |$.EE6B2800 |+1.00000000E+9|
; |NEG_E9 HEX 9EEE6B2800 |(FF) |$9E-$80=$1E=+30 |$.EE6B2800 |-1.00000000E+9|
; ------------------------------------------------------------------------------
; * FACSIGN msb must be set ($80-$FF) to print a minus sign before a result #.
; ==============================================================================
; pi/2 = 1.570796327; pi = 3.141592654; 2*pi = 6.283185308
; pi = 4*ATN(1)-(1E-9) = 3.14159265 <> 4*ATN(1) = 3.14159266
; ==============================================================================
; Plugging NRM_CONS into & Printing FAC [*9D:XX XX XX XX XX XX <CR> *ED2EG]--
; [You can use the AppleWin Monitor (CALL -151) or Debugger (F7) to do this.]
; ------------------------------------------------------------------------------
; Seems that there is a problem printing numbers when the mantissa is zero.
; Setting the Mantissa sign bit (adding $80000000) fixes all these problems:
; ------------------------------------------------------------------------------
; Plugging in NRM_QTR #'s results in nothing being printed!
; Plugging in NRM_HALF #'s results in nothing being printed!
; Plugging in NRM_ONE #'s results in a Blank Line being printed, not a 1!
; Plugging in NRM_TEN #'s results in a 2 being printed, not a 10!
; Plugging in NRM_SQRH #'s results in (SQR(1/2))-(1/2) being printed!
; Plugging in NRM_SQR2 #'s results in (SQR(2))-(1) being printed!
; Plugging in NRM_LN2 #'s results in (LN(2))-(1/2) being printed!
; Plugging in NRM_LOGE #'s results in (LOG(base 2)(e))-(1) being printed!
; Plugging in NRM_PID2 #'s results in (PI/2)-(1) being printed!
; Plugging in NRM_PI #'s results in (PI)-(2) being printed!
; Plugging in NRM_PIM2 #'s results in (PI*2)-(4) being printed!
; Plugging in BAD32768 #'s results in a non-integer FP value being printed!
; Plugging in NRM_E8M1 #'s results in a non-integer FP value being printed!
; Plugging in NRM_E9M1 #'s results in a non-integer FP value being printed!
; Plugging in NRM_E9 #'s results in a non-integer FP value being printed!
; ------------------------------------------------------------------------------
; Apparently, all NRM_Constant Mantissas have had 1/2 subtracted from them.
; They are the actual (renamed) Normalized Contants used in Applesoft BASIC!
; IIRC, this was done to facilitate proper rounding of Floating Point numbers.
; ==============================================================================
;
;
; ==============================================================================
; Applesoft BASIC Tokens: [AKA: TKNMTBL; (Count = 107)]
; [Keywords, Statements, and (Math, String, & other types of) Functions]
; ==============================================================================
; Constants EQU $nn ;These are Constants, NOT Zero Page Equates
; TOK_* EQU $nn ;Originally: TOKEN.*
; ==============================================================================
; TOK_END EQU $80 ;Token: "END" Program Control Statement
; TOK_FOR EQU $81 ;Token: "FOR" Program Control Statement
; TOK_NEXT EQU $82 ;Token: "NEXT" Program Control Statement
; TOK_DATA EQU $83 ;Token: "DATA" Data Assignment Statement
; TOK_INPUT EQU $84 ;Token: "INPUT" Input Statement
; TOK_DEL EQU $85 ;Token: "DEL" Prgrm-Lines Removal Statement
; TOK_DIM EQU $86 ;Token: "DIM" Assignment Statement
; TOK_READ EQU $87 ;Token: "READ" Data Input Statement
; TOK_GR EQU $88 ;Token: "GR" Graphics Display Statement
; TOK_TEXT EQU $89 ;Token: "TEXT" Text Display Statement
; TOK_PR EQU $8A ;Token: "PR#" Set Output Statement
; TOK_IN EQU $8B ;Token: "IN#" Set Input Statement
; TOK_CALL EQU $8C ;Token: "CALL" Program Control Statement
; TOK_PLOT EQU $8D ;Token: "PLOT" Graphics Drawing Statement
; TOK_HLIN EQU $8E ;Token: "HLIN" Graphics Drawing Statement
; TOK_VLIN EQU $8F ;Token: "VLIN" Graphics Drawing Statement
; TOK_HGR2 EQU $90 ;Token: "HGR2" Graphics Display Statement
; TOK_HGR EQU $91 ;Token: "HGR" Graphics Display Statement
; TOK_HCOLOR EQU $92 ;Token: "HCOLOR=" Assignment Statement
; TOK_HPLOT EQU $93 ;Token: "HPLOT" Graphics Drawing Statement
; TOK_DRAW EQU $94 ;Token: "DRAW" Graphics Drawing Statement
; TOK_XDRAW EQU $95 ;Token: "XDRAW" Graphics Drawing Statement
; TOK_HTAB EQU $96 ;Token: "HTAB" Cursor Position Statement
; TOK_HOME EQU $97 ;Token: "HOME" Text Display Statement
; TOK_ROT EQU $98 ;Token: "ROT=" Assignment Statement
; TOK_SCALE EQU $99 ;Token: "SCALE=" Assignment Statement
; TOK_SHLOAD EQU $9A ;Token: "SHLOAD" Data Input Statement
; TOK_TRACE EQU $9B ;Token: "TRACE" Debugging ON Statement
; TOK_NOTRACE EQU $9C ;Token: "NOTRACE" Debugging OFF Statement
; TOK_NORMAL EQU $9D ;Token: "NORMAL" Text Display Statement
; TOK_INVERSE EQU $9E ;Token: "INVERSE" Text Display Statement
; TOK_FLASH EQU $9F ;Token: "FLASH" Text Display Statement
; TOK_COLOR EQU $A0 ;Token: "COLOR=" Assignment Statement
; TOK_POP EQU $A1 ;Token: "POP" Program Control Statement
; TOK_VTAB EQU $A2 ;Token: "VTAB" Cursor Position Statement
; TOK_HIMEM EQU $A3 ;Token: "HIMEM:" Assignment Statement
; TOK_LOMEM EQU $A4 ;Token: "LOMEM:" Assignment Statement
; TOK_ONERR EQU $A5 ;Token: "ONERR" Program Control Statement
; TOK_RESUME EQU $A6 ;Token: "RESUME" Program Control Statement
; TOK_RECALL EQU $A7 ;Token: "RECALL" Arrays from Tape Statement
; TOK_STORE EQU $A8 ;Token: "STORE" Arrays to Tape Statement
; TOK_SPEED EQU $A9 ;Token: "SPEED=" Assignment Statement
; TOK_LET EQU $AA ;Token: "LET" Assignment Statement
; TOK_GOTO EQU $AB ;Token: "GOTO" Program Control Statement
; TOK_RUN EQU $AC ;Token: "RUN" Program Control Statement
; TOK_IF EQU $AD ;Token: "IF" Conditional Statement
; TOK_RESTORE EQU $AE ;Token: "RESTORE" Data Reset Statement
; TOK_AMPER EQU $AF ;Token: "&" (Ampersand) User-Cmd. Statement
; TOK_GOSUB EQU $B0 ;Token: "GOSUB" Program Control Statement
; TOK_RETURN EQU $B1 ;Token: "RETURN" Program Control Statement
; TOK_REM EQU $B2 ;Token: "REM" Prgrm-Documentation Statement
; TOK_STOP EQU $B3 ;Token: "STOP" Program Control Statement
; TOK_ON EQU $B4 ;Token: "ON" Program Control Statement
; TOK_WAIT EQU $B5 ;Token: "WAIT" Program Control Statement
; TOK_LOAD EQU $B6 ;Token: "LOAD" Programs from Tape Statement
; TOK_SAVE EQU $B7 ;Token: "SAVE" Programs to Tape Statement
; TOK_DEF EQU $B8 ;Token: "DEF" Function Assignment Statement
; TOK_POKE EQU $B9 ;Token: "POKE" Set Memory Address Function
; TOK_PRINT EQU $BA ;Token: "PRINT" Output Statement
; TOK_CONT EQU $BB ;Token: "CONT" Statement
; TOK_LIST EQU $BC ;Token: "LIST" Pgm-Lines Display Statement
; TOK_CLEAR EQU $BD ;Token: "CLEAR" Reset Everything Statement
; TOK_GET EQU $BE ;Token: "GET" Input Statement
; TOK_NEW EQU $BF ;Token: "NEW" Program Creation Statement
; TOK_TAB EQU $C0 ;Token: "TAB(" Cursor Position Statement
; TOK_TO EQU $C1 ;Token: "TO" Program Control Statement
; TOK_FN EQU $C2 ;Token: "FN" Function Assignment Statement
; TOK_SPC EQU $C3 ;Token: "SPC(" Cursor Position Statement
; TOK_THEN EQU $C4 ;Token: "THEN" Conditional Statement
; TOK_AT EQU $C5 ;Token: "AT" Graphics Drawing Statement
; TOK_NOT EQU $C6 ;Token: "NOT" Conditional Statement
; TOK_STEP EQU $C7 ;Token: "STEP" Conditional Statement
; TOK_PLUS EQU $C8 ;Token: "+" (Plus) Math Function
; TOK_MINUS EQU $C9 ;Token: "-" (Minus) Math Function
; TOK_MULT EQU $CA ;Token: "*" (Multiply) Math Function
; TOK_DIV EQU $CB ;Token: "/" (Division) Math Function
; TOK_EXPOP EQU $CC ;Token: "^" (Exponent) Math Function
; TOK_AND EQU $CD ;Token: "AND" Conditional Statement
; TOK_OR EQU $CE ;Token: "OR" Conditional Statement
; TOK_GREATER EQU $CF ;Token: ">" (Greater Than) Cond. Statement
; TOK_EQUAL EQU $D0 ;Token: "=" (Equal To) Cond. Statement
; TOK_LESSER EQU $D1 ;Token: "<" (Less Than) Cond. Statement
; TOK_SGN EQU $D2 ;Token: "SGN" Math Function
; TOK_INT EQU $D3 ;Token: "INT" Math Function
; TOK_ABS EQU $D4 ;Token: "ABS" Math Function
; TOK_USR EQU $D5 ;Token: "USR" User-Command Statement
; TOK_FRE EQU $D6 ;Token: "FRE" Free Memory Statement
; TOK_SCRN EQU $D7 ;Token: "SCRN(" LoRes (X,Y) Color Statement
; TOK_PDL EQU $D8 ;Token: "PDL" Input Statement
; TOK_POS EQU $D9 ;Token: "POS" Get Cursor Position Statement
; TOK_SQR EQU $DA ;Token: "SQR" Math Function
; TOK_RND EQU $DB ;Token: "RND" Math Function
; TOK_LOG EQU $DC ;Token: "LOG" Math Function
; TOK_EXP EQU $DD ;Token: "EXP" Math Function
; TOK_COS EQU $DE ;Token: "COS" Math Function
; TOK_SIN EQU $DF ;Token: "SIN" Math Function
; TOK_TAN EQU $E0 ;Token: "TAN" Math Function
; TOK_ATN EQU $E1 ;Token: "ATN" Math Function
; TOK_PEEK EQU $E2 ;Token: "PEEK" Read Memory Address Function
; TOK_LEN EQU $E3 ;Token: "LEN" String Length Function
; TOK_STR EQU $E4 ;Token: "STR$" String Function
; TOK_VAL EQU $E5 ;Token: "VAL" String Conversion Function
; TOK_ASC EQU $E6 ;Token: "ASC" String Conversion Function
; TOK_CHR EQU $E7 ;Token: "CHR$" String Function
; TOK_LEFT EQU $E8 ;Token: "LEFT$" String Function
; TOK_RIGHT EQU $E9 ;Token: "RIGHT$" String Function
; TOK_MID EQU $EA ;Token: "MID$" String Function
; ==============================================================================
;
;
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
; ==============================================================================
; Applesoft - Part A, $D000-$DD66:
; Input Parsing, Routine Addressing, For-Next Loops, etc.
; ==============================================================================
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
;
;
; ==============================================================================
; Applesoft Token Address Table:
; ==============================================================================
;
; TKADTBL EQU $D000 ;[Entries are ADDRESS-1]
;
; [The unused TA_* Labels I added are Global and Exported, & for future use.]
;
D000: 6F D8 TA_END DW END-1 ;$80...128...END
D002: 65 D7 TA_FOR DW FOR-1 ;$81...129...FOR
D004: F8 DC TA_NEXT DW NEXT-1 ;$82...130...NEXT
D006: 94 D9 TA_DATA DW DATA-1 ;$83...131...DATA
D008: B1 DB TA_INPUT DW INPUT-1 ;$84...132...INPUT
D00A: 30 F3 TA_DEL DW DEL-1 ;$85...133...DEL
D00C: D8 DF TA_DIM DW DIM-1 ;$86...134...DIM
D00E: E1 DB TA_READ DW BAS_READ-1 ;$87...135...READ
D010: 8F F3 TA_GR DW GR-1 ;$88...136...GR
D012: 98 F3 TA_TEXT DW TEXT-1 ;$89...137...TEXT
D014: E4 F1 TA_PR DW PR_NUMBER-1 ;$8A...138...PR#
D016: DD F1 TA_IN DW IN_NUMBER-1 ;$8B...139...IN#
D018: D4 F1 TA_CALL DW CALL-1 ;$8C...140...CALL
D01A: 24 F2 TA_PLOT DW BAS_PLOT-1 ;$8D...141...PLOT
D01C: 31 F2 TA_HLIN DW HLIN-1 ;$8E...142...HLIN
D01E: 40 F2 TA_VLIN DW VLIN-1 ;$8F...143...VLIN
D020: D7 F3 TA_HGR2 DW HGR2-1 ;$90...144...HGR2
D022: E1 F3 TA_HGR DW HGR-1 ;$91...145...HGR
D024: E8 F6 TA_HCOLOR DW HCOLOR-1 ;$92...146...HCOLOR=
D026: FD F6 TA_HPLOT DW HPLOT-1 ;$93...147...HPLOT
D028: 68 F7 TA_DRAW DW DRAW-1 ;$94...148...DRAW
D02A: 6E F7 TA_XDRAW DW XDRAW-1 ;$95...149...XDRAW
D02C: E6 F7 TA_HTAB DW HTAB-1 ;$96...150...HTAB
; The HOME command goes directly to the Autostart F8 Monitor HOME routine:
D02E: 57 FC TA_HOME DW HOME-1 ;$97...151...HOME
D030: 20 F7 TA_ROT DW ROT-1 ;$98...152...ROT=
D032: 26 F7 TA_SCALE DW SCALE-1 ;$99...153...SCALE=
D034: 74 F7 TA_SHLOAD DW SHLOAD-1 ;$9A...154...SHLOAD
D036: 6C F2 TA_TRACE DW TRACE-1 ;$9B...155...TRACE
D038: 6E F2 TA_NOTRACE DW NOTRACE-1 ;$9C...156...NOTRACE
D03A: 72 F2 TA_NORMAL DW NORMAL-1 ;$9D...157...NORMAL
D03C: 76 F2 TA_INVERSE DW INVERSE-1 ;$9E...158...INVERSE
D03E: 7F F2 TA_FLASH DW FLASH-1 ;$9F...159...FLASH
D040: 4E F2 TA_COLOR DW COLOR-1 ;$A0...160...COLOR=
; The POP command and the RETURN command (below), both go to the POPRTN handler:
D042: 6A D9 TA_POP DW POPRTN-1 ;$A1...161...POP
D044: 55 F2 TA_VTAB DW VTAB-1 ;$A2...162...VTAB
D046: 85 F2 TA_HIMEM DW HIMEM-1 ;$A3...163...HIMEM:
D048: A5 F2 TA_LOMEM DW LOMEM-1 ;$A4...164...LOMEM:
D04A: CA F2 TA_ONERR DW ONERR-1 ;$A5...165...ONERR
D04C: 17 F3 TA_RESUME DW RESUME-1 ;$A6...166...RESUME
D04E: BB F3 TA_RECALL DW RECALL-1 ;$A7...167...RECALL
D050: 9E F3 TA_STORE DW STORE-1 ;$A8...168...STORE
D052: 61 F2 TA_SPEED DW SPEED-1 ;$A9...169...SPEED=
D054: 45 DA TA_LET DW LET-1 ;$AA...170...LET
D056: 3D D9 TA_GOTO DW GOTO-1 ;$AB...171...GOTO
D058: 11 D9 TA_RUN DW RUN-1 ;$AC...172...RUN
D05A: C8 D9 TA_IF DW IF-1 ;$AD...173...IF
D05C: 48 D8 TA_RESTORE DW RESTORE-1 ;$AE...174...RESTORE
; The Ampersand ("&") command jumps directly to the Page 3 Ampersand Vector:
D05E: F4 03 TA_AMPERV DW AMPERV-1 ;$AF...175...&
D060: 20 D9 TA_GOSUB DW GOSUB-1 ;$B0...176...GOSUB
; The RETURN command and the POP command (above), both go to the POPRTN handler:
D062: 6A D9 TA_RETURN DW POPRTN-1 ;$B1...177...RETURN
D064: DB D9 TA_REM DW REM-1 ;$B2...178...REM
D066: 6D D8 TA_STOP DW STOP-1 ;$B3...179...STOP
D068: EB D9 TA_ONGOTO DW ONGOTO-1 ;$B4...180...ON
D06A: 83 E7 TA_WAIT DW WAIT-1 ;$B5...181...WAIT
D06C: C8 D8 TA_LOAD DW BAS_LOAD-1 ;$B6...182...LOAD
D06E: AF D8 TA_SAVE DW BAS_SAVE-1 ;$B7...183...SAVE
D070: 12 E3 TA_DEF DW DEF-1 ;$B8...184...DEF
D072: 7A E7 TA_POKE DW POKE-1 ;$B9...185...POKE
D074: D4 DA TA_PRINT DW PRINT-1 ;$BA...186...PRINT
D076: 95 D8 TA_CONT DW CONT-1 ;$BB...187...CONT
D078: A4 D6 TA_LIST DW LIST-1 ;$BC...188...LIST
D07A: 69 D6 TA_CLEAR DW CLEAR-1 ;$BD...189...CLEAR
D07C: 9F DB TA_GET DW GET-1 ;$BE...190...GET
D07E: 48 D6 TA_NEW DW NEW-1 ;$BF...191...NEW
;
; ==============================================================================
; There are no direct pointers for $C0~C7:
; ==============================================================================
; xxxx ?? ?? TA_TAB DW TAB-1 ;$C0...192...TAB(
; xxxx ?? ?? TA_TO DW TO-1 ;$C1...193...TO
; xxxx ?? ?? TA_FN DW FN-1 ;$C2...194...FN
; xxxx ?? ?? TA_SPC DW SPC-1 ;$C3...195...SPC(
; xxxx ?? ?? TA_THEN DW THEN-1 ;$C4...196...THEN
; xxxx ?? ?? TA_AT DW AT-1 ;$C5...197...AT
; xxxx ?? ?? TA_NOT DW NOT-1 ;$C6...198...NOT
; xxxx ?? ?? TA_STEP DW STEP-1 ;$C7...199...STEP
; ==============================================================================
; Math Operator addresses are in the Branch Address Table (MATHTBL) below.
; Token constants $C8~$D1 are used in it as Math Operator Precedence Codes.
; ==============================================================================
;
;
; ==============================================================================
; Unary Functions Branch Address Table:
; ==============================================================================
;
; UNFNC EQU $D080 ;Same Addres as TN_END (next)
;
D080: 90 EB TA_SGN DW SGN ;$D2...210...SGN
D082: 23 EC TA_INT DW INT ;$D3...211...INT
D084: AF EB TA_ABS DW ABS ;$D4...212...ABS
D086: 0A 00 TA_USR DW BAS_USRVEC ;$D5...213...USR
D088: DE E2 TA_FRE DW FRE ;$D6...214...FRE
D08A: 12 D4 TA_ERROR DW ERROR ;$D7...215...SCRN(...done special
D08C: CD DF TA_PDL DW PDL ;$D8...216...PDL
D08E: FF E2 TA_POS DW POS ;$D9...217...POS
D090: 8D EE TA_SQR DW SQR ;$DA...218...SQR
D092: AE EF TA_RND DW RND ;$DB...219...RND
D094: 41 E9 TA_LOG DW LOG ;$DC...220...LOG
D096: 09 EF TA_EXP DW EXP ;$DD...221...EXP
D098: EA EF TA_COS DW COS ;$DE...222...COS
D09A: F1 EF TA_SIN DW SIN ;$DF...223...SIN
D09C: 3A F0 TA_TAN DW TAN ;$E0...224...TAN
D09E: 9E F0 TA_ATN DW ATN ;$E1...225...ATN
D0A0: 64 E7 TA_PEEK DW PEEK ;$E2...226...PEEK
D0A2: D6 E6 TA_LEN DW LEN ;$E3...227...LEN
D0A4: C5 E3 TA_STR DW STR ;$E4...228...STR$
D0A6: 07 E7 TA_VAL DW VAL ;$E5...229...VAL
D0A8: E5 E6 TA_ASC DW ASC ;$E6...230...ASC
D0AA: 46 E6 TA_CHR DW CHRSTR ;$E7...231...CHR$
D0AC: 5A E6 TA_LEFT DW LEFTSTR ;$E8...232...LEFT$
D0AE: 86 E6 TA_RIGHT DW RIGHTSTR ;$E9...233...RIGHT$
D0B0: 91 E6 TA_MID DW MIDSTR ;$EA...234...MID$
;
; ==============================================================================
; Math Operator Branch Address Table
; ==============================================================================
;
; [The unused MO_* Labels I added are Global and Exported, & for future use.]
;
; ==============================================================================
; Math Operator Precedence Codes (MO-PC):
; ==============================================================================
; Label MO-PC Description
; ----- ----- --------------------------------------------------------------
; P_OR = $46 Logical "OR" Operator (is lowest precedence)
; P_AND = $50 Logical "AND" Operator (is next higher precedence, etc...)
; P_REL = $64 Relational (">"), ("="), & ("<") Operators
; P_ADD = $79 Binary Addition ("+") and Subtraction ("-") Operators
; P_MUL = $7B Multiplication ("*") and Division ("/") Operators
; P_PWR = $7D Exponentiation ("^") [Power] Operator
; P_NEQ = $7F Unary Negative ("-") and Comparison ("=") Operators
; ==============================================================================
; Each entry consists of: a one-byte Precedence Code <--(its Token constant),
; followed by: a two-byte Function/Operator Address (minus one)
; ==============================================================================
;
; MATHTBL EQU $D0B2 ;Math Operator Branch Address Table
;
D0B2: 79 MO_ADD DFB P_ADD ;$C8...200...+
D0B3: C0 E7 TA_ADD DW FADDT-1 ;ADD Function Address
D0B5: 79 MO_SUB DFB P_ADD ;$C9...201...-
D0B6: A9 E7 TA_SUB DW FSUBT-1 ;SUBTRACT Function Address
D0B8: 7B MO_MUL DFB P_MUL ;$CA...202...*
D0B9: 81 E9 TA_MUL DW FMULTT-1 ;MULTIPLY Function Address
D0BB: 7B MO_DIV DFB P_MUL ;$CB...203.../
D0BC: 68 EA TA_DIV DW FDIVT-1 ;DIVIDE Function Address
D0BE: 7D MO_PWR DFB P_PWR ;$CC...204...^
D0BF: 96 EE TA_PWR DW FPWRT-1 ;EXPONENT (POWER) Function Address
D0C1: 50 MO_AND DFB P_AND ;$CD...205...AND
D0C2: 54 DF TA_AND DW AND-1 ;AND Operator Address
D0C4: 46 MO_OR DFB P_OR ;$CE...206...OR
D0C5: 4E DF TA_OR DW OR-1 ;OR Operator Address
D0C7: 7F MO_UMNS_GTLT DFB P_NEQ ;$CF...207...>...Unary Minus ("-")
D0C8: CF EE TA_UMNS_GTLT DW NEGOP-1 ;(GREATER-THAN)->-(LESS-THAN) Op Address
D0CA: 7F MO_UNOT_EQUL DFB P_NEQ ;$D0...208...=...Unary NOT
D0CB: 97 DE TA_UNOT_EQUL DW EQUOP-1 ;(EQUAL-TO) Operator Address
D0CD: 64 MO_UPLS_LTGT DFB P_REL ;$D1...209...<...Unary Plus ("+")
D0CE: 64 DF TA_UPLS_LTGT DW RELOPS-1 ;(LESS-THAN)-<-(GREATER-THAN) Op Address
;
; ==============================================================================
; Applesoft Token Names Branch Address Table: ($190 = 400 Bytes)
; ==============================================================================
;
; [The unused TN_* Labels I added are Global and Exported, & for future use.]
;
; ==============================================================================
;
; TKNMTBL EQU $D0D0 ;Dextral Character Inverted (DCI) Names
; ;Same Addres as TN_END (next)
D0D0: 45 4E C4 TN_END DCI "END" ;$80...128...END
D0D3: 46 4F D2 TN_FOR DCI "FOR" ;$81...129...FOR
D0D6: 4E 45 58 D4 TN_NEXT DCI "NEXT" ;$82...130...NEXT
D0DA: 44 41 54 C1 TN_DATA DCI "DATA" ;$83...131...DATA
D0DE: 49 4E 50 55+ TN_INPUT DCI "INPUT" ;$84...132...INPUT
D0E3: 44 45 CC TN_DEL DCI "DEL" ;$85...133...DEL
D0E6: 44 49 CD TN_DIM DCI "DIM" ;$86...134...DIM
D0E9: 52 45 41 C4 TN_READ DCI "READ" ;$87...135...READ
D0ED: 47 D2 TN_GR DCI "GR" ;$88...136...GR
D0EF: 54 45 58 D4 TN_TEXT DCI "TEXT" ;$89...137...TEXT
D0F3: 50 52 A3 TN_PR DCI "PR#" ;$8A...138...PR#
D0F6: 49 4E A3 TN_IN DCI "IN#" ;$8B...139...IN#
D0F9: 43 41 4C CC TN_CALL DCI "CALL" ;$8C...140...CALL
D0FD: 50 4C 4F D4 TN_PLOT DCI "PLOT" ;$8D...141...PLOT
D101: 48 4C 49 CE TN_HLIN DCI "HLIN" ;$8E...142...HLIN
D105: 56 4C 49 CE TN_VLIN DCI "VLIN" ;$8F...143...VLIN
D109: 48 47 52 B2 TN_HGR2 DCI "HGR2" ;$90...144...HGR2
D10D: 48 47 D2 TN_HGR DCI "HGR" ;$91...145...HGR
D110: 48 43 4F 4C+ TN_HCOLOR DCI "HCOLOR=" ;$92...146...HCOLOR=
D117: 48 50 4C 4F+ TN_HPLOT DCI "HPLOT" ;$93...147...HPLOT
D11C: 44 52 41 D7 TN_DRAW DCI "DRAW" ;$94...148...DRAW
D120: 58 44 52 41+ TN_XDRAW DCI "XDRAW" ;$95...149...XDRAW
D125: 48 54 41 C2 TN_HTAB DCI "HTAB" ;$96...150...HTAB
D129: 48 4F 4D C5 TN_HOME DCI "HOME" ;$97...151...HOME
D12D: 52 4F 54 BD TN_ROT DCI "ROT=" ;$98...152...ROT=
D131: 53 43 41 4C+ TN_SCALE DCI "SCALE=" ;$99...153...SCALE=
D137: 53 48 4C 4F+ TN_SHLOAD DCI "SHLOAD" ;$9A...154...SHLOAD
D13D: 54 52 41 43+ TN_TRACE DCI "TRACE" ;$9B...155...TRACE
D142: 4E 4F 54 52+ TN_NOTRACE DCI "NOTRACE" ;$9C...156...NOTRACE
D149: 4E 4F 52 4D+ TN_NORMAL DCI "NORMAL" ;$9D...157...NORMAL
D14F: 49 4E 56 45+ TN_INVERSE DCI "INVERSE" ;$9E...158...INVERSE
D156: 46 4C 41 53+ TN_FLASH DCI "FLASH" ;$9F...159...FLASH
D15B: 43 4F 4C 4F+ TN_COLOR DCI "COLOR=" ;$A0...160...COLOR=
D161: 50 4F D0 TN_POP DCI "POP" ;$A1...161...POP
D164: 56 54 41 C2 TN_VTAB DCI "VTAB" ;$A2...162...VTAB
D168: 48 49 4D 45+ TN_HIMEM DCI "HIMEM:" ;$A3...163...HIMEM:
D16E: 4C 4F 4D 45+ TN_LOMEM DCI "LOMEM:" ;$A4...164...LOMEM:
D174: 4F 4E 45 52+ TN_ONERR DCI "ONERR" ;$A5...165...ONERR
D179: 52 45 53 55+ TN_RESUME DCI "RESUME" ;$A6...166...RESUME
D17F: 52 45 43 41+ TN_RECALL DCI "RECALL" ;$A7...167...RECALL
D185: 53 54 4F 52+ TN_STORE DCI "STORE" ;$A8...168...STORE
D18A: 53 50 45 45+ TN_SPEED DCI "SPEED=" ;$A9...169...SPEED=
D190: 4C 45 D4 TN_LET DCI "LET" ;$AA...170...LET
D193: 47 4F 54 CF TN_GOTO DCI "GOTO" ;$AB...171...GOTO
D197: 52 55 CE TN_RUN DCI "RUN" ;$AC...172...RUN
D19A: 49 C6 TN_IF DCI "IF" ;$AD...173...IF
D19C: 52 45 53 54+ TN_RESTORE DCI "RESTORE" ;$AE...174...RESTORE
D1A3: A6 TN_AMPERSAND DFB '&' | $80 ;$AF...175...&
D1A4: 47 4F 53 55+ TN_GOSUB DCI "GOSUB" ;$B0...176...GOSUB
D1A9: 52 45 54 55+ TN_RETURN DCI "RETURN" ;$B1...177...RETURN
D1AF: 52 45 CD TN_REM DCI "REM" ;$B2...178...REM
D1B2: 53 54 4F D0 TN_STOP DCI "STOP" ;$B3...179...STOP
D1B6: 4F CE TN_ON DCI "ON" ;$B4...180...ON
D1B8: 57 41 49 D4 TN_WAIT DCI "WAIT" ;$B5...181...WAIT
D1BC: 4C 4F 41 C4 TN_LOAD DCI "LOAD" ;$B6...182...LOAD
D1C0: 53 41 56 C5 TN_SAVE DCI "SAVE" ;$B7...183...SAVE
D1C4: 44 45 C6 TN_DEF DCI "DEF" ;$B8...184...DEF
D1C7: 50 4F 4B C5 TN_POKE DCI "POKE" ;$B9...185...POKE
D1CB: 50 52 49 4E+ TN_PRINT DCI "PRINT" ;$BA...186...PRINT
D1D0: 43 4F 4E D4 TN_CONT DCI "CONT" ;$BB...187...CONT
D1D4: 4C 49 53 D4 TN_LIST DCI "LIST" ;$BC...188...LIST
D1D8: 43 4C 45 41+ TN_CLEAR DCI "CLEAR" ;$BD...189...CLEAR
D1DD: 47 45 D4 TN_GET DCI "GET" ;$BE...190...GET
D1E0: 4E 45 D7 TN_NEW DCI "NEW" ;$BF...191...NEW
D1E3: 54 41 42 A8 TN_TAB DCI "TAB(" ;$C0...192...TAB(
D1E7: 54 CF TN_TO DCI "TO" ;$C1...193...TO
D1E9: 46 CE TN_FN DCI "FN" ;$C2...194...FN
D1EB: 53 50 43 A8 TN_SPC DCI "SPC(" ;$C3...195...SPC(
D1EF: 54 48 45 CE TN_THEN DCI "THEN" ;$C4...196...THEN
D1F3: 41 D4 TN_AT DCI "AT" ;$C5...197...AT
D1F5: 4E 4F D4 TN_NOT DCI "NOT" ;$C6...198...NOT
D1F8: 53 54 45 D0 TN_STEP DCI "STEP" ;$C7...199...STEP
D1FC: AB TN_ADD DFB '+' | $80 ;$C8...200...+
D1FD: AD TN_SUB DFB '-' | $80 ;$C9...201...-
D1FE: AA TN_MUL DFB '*' | $80 ;$CA...202...*
D1FF: AF TN_DIV DFB '/' | $80 ;$CB...203.../
D200: DE TN_PWR DFB '^' | $80 ;$CC...204...^
D201: 41 4E C4 TN_AND DCI "AND" ;$CD...205...AND
D204: 4F D2 TN_OR DCI "OR" ;$CE...206...OR
D206: BE TN_NEG DFB '>' | $80 ;$CF...207...>
D207: BD TN_EQU DFB '=' | $80 ;$D0...208...=
D208: BC TN_REL DFB '<' | $80 ;$D1...209...<
D209: 53 47 CE TN_SGN DCI "SGN" ;$D2...210...SGN
D20C: 49 4E D4 TN_INT DCI "INT" ;$D3...211...INT
D20F: 41 42 D3 TN_ABS DCI "ABS" ;$D4...212...ABS
D212: 55 53 D2 TN_USR DCI "USR" ;$D5...213...USR
D215: 46 52 C5 TN_FRE DCI "FRE" ;$D6...214...FRE
D218: 53 43 52 4E+ TN_SCRN DCI "SCRN(" ;$D7...215...SCRN(
D21D: 50 44 CC TN_PDL DCI "PDL" ;$D8...216...PDL
D220: 50 4F D3 TN_POS DCI "POS" ;$D9...217...POS
D223: 53 51 D2 TN_SQR DCI "SQR" ;$DA...218...SQR
D226: 52 4E C4 TN_RND DCI "RND" ;$DB...219...RND
D229: 4C 4F C7 TN_LOG DCI "LOG" ;$DC...220...LOG
D22C: 45 58 D0 TN_EXP DCI "EXP" ;$DD...221...EXP
D22F: 43 4F D3 TN_COS DCI "COS" ;$DE...222...COS
D232: 53 49 CE TN_SIN DCI "SIN" ;$DF...223...SIN
D235: 54 41 CE TN_TAN DCI "TAN" ;$E0...224...TAN
D238: 41 54 CE TN_ATN DCI "ATN" ;$E1...225...ATN
D23B: 50 45 45 CB TN_PEEK DCI "PEEK" ;$E2...226...PEEK
D23F: 4C 45 CE TN_LEN DCI "LEN" ;$E3...227...LEN
D242: 53 54 52 A4 TN_STR DCI "STR$" ;$E4...228...STR$
D246: 56 41 CC TN_VAL DCI "VAL" ;$E5...229...VAL
D249: 41 53 C3 TN_ASC DCI "ASC" ;$E6...230...ASC
D24C: 43 48 52 A4 TN_CHR DCI "CHR$" ;$E7...231...CHR$
D250: 4C 45 46 54+ TN_LEFT DCI "LEFT$" ;$E8...232...LEFT$
D255: 52 49 47 48+ TN_RIGHT DCI "RIGHT$" ;$E9...233...RIGHT$
D25B: 4D 49 44 A4 TN_MID DCI "MID$" ;$EA...234...MID$
D25F: 00 TOKNAMEND DFB $00 ;End of Token Name Table
;
; ==============================================================================
; Error Messages
; ==============================================================================
;
; [The unused Labels I added are Global and Exported, & for future use.--JPD]
;
; ==============================================================================
; (The code uses error message constants that are defined by subtracting the
; start of the table from the address of the error. Currently, there is no way
; to do that in SourceGen, so the constants are project symbols instead.)
; ==============================================================================
;
; ERR_MSGS EQU $D260 ;Applesoft Error Messages Table
;
D260: 4E 45 58 54+ NOFOR_ERR DCI "NEXT WITHOUT FOR" ;ERR_NOFOR = *-ERR_MSGS = #$00
D270: 53 59 4E 54+ SYNTAXERR DCI "SYNTAX" ;ERR_SYNTAX = *-ERR_MSGS = #$10
D276: 52 45 54 55+ NOGOSUBERR DCI "RETURN WITHOUT GOSUB" ;ERR_NOGOSUB = *-ERR_MSGS = #$16
D28A: 4F 55 54 20+ NODATAERR DCI "OUT OF DATA" ;ERR_NODATA = *-ERR_MSGS = #$2A
D295: 49 4C 4C 45+ ILLQTYERR DCI "ILLEGAL QUANTITY" ;ERR_ILLQTY = *-ERR_MSGS = #$35
D2A5: 4F 56 45 52+ OVERFLOWERR DCI "OVERFLOW" ;ERR_OVERFLOW = *-ERR_MSGS = #$45
D2AD: 4F 55 54 20+ MEMFULLERR DCI "OUT OF MEMORY" ;ERR_MEMFULL = *-ERR_MSGS = #$4D
D2BA: 55 4E 44 45+ UNDEFSTATERR DCI "UNDEF'D STATEMENT" ;ERR_UNDEFSTAT = *-ERR_MSGS = #$5A
D2CB: 42 41 44 20+ BADSUBSERR DCI "BAD SUBSCRIPT" ;ERR_BADSUBS = *-ERR_MSGS = #$6B
D2D8: 52 45 44 49+ REDIMDERR DCI "REDIM'D ARRAY" ;ERR_REDIMD = *-ERR_MSGS = #$78
D2E5: 44 49 56 49+ ZERODIVERR DCI "DIVISION BY ZERO" ;ERR_ZERODIV = *-ERR_MSGS = #$85
D2F5: 49 4C 4C 45+ ILLDIRERR DCI "ILLEGAL DIRECT" ;ERR_ILLDIR = *-ERR_MSGS = #$95
D303: 54 59 50 45+ BADTYPEERR DCI "TYPE MISMATCH" ;ERR_BADTYPE = *-ERR_MSGS = #$A3
D310: 53 54 52 49+ STRLONGERR DCI "STRING TOO LONG" ;ERR_STRLONG = *-ERR_MSGS = #$B0
D31F: 46 4F 52 4D+ FRMCPXERR DCI "FORMULA TOO COMPLEX" ;ERR_FRMCPX = *-ERR_MSGS = #$BF
D332: 43 41 4E 27+ CANTCONTERR DCI "CAN'T CONTINUE" ;ERR_CANTCONT = *-ERR_MSGS = #$D2
D340: 55 4E 44 45+ UNDEFFUNCERR DCI "UNDEF'D FUNCTION" ;ERR_UNDEFFUNC = *-ERR_MSGS = #$E0
D350: 20 45 52 52+ QT_ERROR .ZSTR " ERROR",$07 ;Ring BELL; Null-Terminated String
D358: 20 49 4E 20+ QT_IN .ZSTR " IN " ;<--------- Null-Terminated String
D35D: 0D 42 52 45+ QT_BREAK .ZSTR $0D,"BREAK",$07 ;Ring BELL; Null-Terminated String
;
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
; ==============================================================================
; Start of Applesoft BASIC ROM Image (Part A) Executable Code [End of Tables]
; ==============================================================================
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
;
;
; ==============================================================================
; Get FOR/NEXT Pointer from STACK <<< Buggy! >>>
; Called by FOR and NEXT to scan the STACK for a Frame with the Same Variable:
; ==============================================================================
;
; (FORPTR) = Address of Variable if FOR or NEXT
; = $xxFF when Called from POPRTN <<< BUG: should be $FFxx >>>
; <<< BUG can be fixed in (Apple II Plus) Emulator ROM images! >>>
;
; Returns: .NE. If Variable is Not Found,
; ^^^^ (Not Equal to Zero: P-Reg Z-Flag=0)
; (X) = Stack Pointer after scanning all Frames
;
; .EQ. If Variable is Found,
; ^^^^ (Equal to Zero: P-Reg Z-Flag=1)
; (X) = Stack Pointer of Frame Found
;
; ==============================================================================
;
D365: BA GETFORPTR TSX ;First, calculate our Stack Pointer Index:
D366: E8 INX ;We put (S-Reg) into (X-Reg); Now Add 4
D367: E8 INX ;(X-Reg) will be (S-Reg) + 4 <and/or>
D368: E8 INX ;(X-Reg) will be (Stack Pointer) + 4
D369: E8 INX ;Now, (X-Reg) is our Stack Pointer Index
; ----------------------------------- ;Is there a FOR Frame here?
D36A: BD 01 01 FORFRAME LDA STACK+1,X ;Get Byte from STACK
D36D: C9 81 CMP #TOK_FOR ;Is it a FOR Statement (Token)?
D36F: D0 21 BNE BAS_RTS00 ;NOT a FOR Statement; Return to Caller
D371: A5 86 LDA FORPTR+1 ;YES; Does its NEXT have a Variable?
D373: D0 0A BNE SAMEVARPTR ;YES, a Variable is Specified
; ----------------------------------- ;NO Variable; So use this FOR Frame
D375: BD 02 01 LDA STACK+2,X ;Get its Variable Pointer, Low (from STACK)
D378: 85 85 STA FORPTR ;Set our FOR Pointer, Low
D37A: BD 03 01 LDA STACK+3,X ;Get its Variable Pointer, High (from STACK)
D37D: 85 86 STA FORPTR+1 ;Set our FOR Pointer, High
; --------------------- ;Is Same Variable (as Caller's) specified in this Frame?
D37F: DD 03 01 SAMEVARPTR CMP STACK+3,X ;Compare Variable Pointers, High
D382: D0 07 BNE NEXTFRAME ;NO; So try next Frame (if any)
D384: A5 85 LDA FORPTR ;MAYBE; Get Variable Pointer, Low
D386: DD 02 01 CMP STACK+2,X ;Compare Variable Pointers, Low
D389: F0 07 BEQ BAS_RTS00 ;YES, Pointers are Equal; Return to Caller
; ----------------------------------- ;NO, So try next Frame (if any)
D38B: 8A NEXTFRAME TXA ;Get our Stack Pointer Index
D38C: 18 CLC ;Clear Carry for Add (to Increment our SPI)
D38D: 69 12 ADC #18 ;(A-Reg) = (X-Reg) + (18 bytes per Frame)
D38F: AA TAX ;Set (Increment) our Stack Pointer Index
D390: D0 D8 BNE FORFRAME ;Loop until our SPI is Zero (256 MOD 256)
; ------------------------------------------------------------------------------
; If FOR loops are nested > 10 deep, the Memory Full Error message is displayed.
; 10 frames at 18 bytes/frame is 180 bytes of stack space. So, this condition
; can never happen; hense, this branch is Always Taken! [Barring overhead, the
; maximum number of stack frames possible would be: INT(256/18) = 14.]
; ------------------------------------------------------------------------------
D392: 60 BAS_RTS00 RTS ;Return to Caller (See "Returns:" above)
; ==============================================================================
; Move Memory Block Upward
; ==============================================================================
; On Entry: [(A,{X|Y})={Low,High}] = (HIGHDS) = Highest Destination Address +1
; _______________|_______________ (LOWTR) = Lowest Source Address
; {Depends on Caller/Entry-Point} (HIGHTR) = Highest Source Address +1
; ==============================================================================
;
; First, get setup to move upward LOWTR through HIGHTR-1 to just below HIGHDS:
D393: 20 E3 D3 MVBLKUP1 JSR REASON ;Assure [(HIGHDS)=(A,Y)={Low,High}]<(FRETOP)
D396: 85 6D STA STREND ;Set Top of Array Storage, Low (from A-Reg)
D398: 84 6E STY STREND+1 ;Set Top of Array Storage, High (from Y-Reg)
; Move Memory Block Upward, 2nd Entry Point (Bypasses MVBLKUP1 Stuff)
D39A: 38 MVBLKUP2 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
; ----------------------------------- ;Compute Number of Bytes to be Moved
; ; (from LOWTR through HIGHTR-1)
D39B: A5 96 LDA HIGHTR ;Get Highest Source Address +1, Low
D39D: E5 9B SBC LOWTR ;Subtract Lowest Source Address, Low
D39F: 85 5E STA INDEX ;Save Number of Bytes in Partial Page
D3A1: A8 TAY ;Save Number of Bytes in Partial Page
D3A2: A5 97 LDA HIGHTR+1 ;Get Highest Source Address +1, High
D3A4: E5 9C SBC LOWTR+1 ;Subtract Lowest Source Address, High
D3A6: AA TAX ;Set X-Reg = Number of Whole Pages
D3A7: E8 INX ;Set X-Reg = Number of Whole Pages +1
D3A8: 98 TYA ;Retrieve Number of Bytes in Partial Page
D3A9: F0 23 BEQ NXTMVBLKUP ;Taken if NO Partial Page Bytes
; ;Move Partial Page 1st to maximize speed!
; ----------------------------------- ;Back Up: HIGHTR-(Partial Page Bytes)
D3AB: A5 96 MVBKPHSA LDA HIGHTR ;Get Highest Source Address +1, Low
D3AD: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
D3AE: E5 5E SBC INDEX ;Subtract Number of Bytes in Partial Page
D3B0: 85 96 STA HIGHTR ;Set Highest Source Address +1, Low
D3B2: B0 03 BCS MVBKPHDA ;If NO Borrow, Skip Setting High Byte
D3B4: C6 97 DEC HIGHTR+1 ;Set Highest Source Address +1, High
D3B6: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
; ----------------------------------- ;Back Up: HIGHDS-(Partial Page Bytes)
D3B7: A5 94 MVBKPHDA LDA HIGHDS ;Get Highest Destination Address +1, low
D3B9: E5 5E SBC INDEX ;Subtract Number of Bytes in Partial Page
D3BB: 85 94 STA HIGHDS ;Set Highest Destination Address +1, low
D3BD: B0 08 BCS DOMVBLKUP2 ;If NO Borrow, Skip Setting High Byte
D3BF: C6 95 DEC HIGHDS+1 ;Set Highest Destination Address +1, High
D3C1: 90 04 BCC DOMVBLKUP2 ;Always Taken
; ----------------------------------- ;Do it NOW: Move a Page of Bytes (256)
D3C3: B1 96 DOMVBLKUP1 LDA (HIGHTR),Y ;Get Byte at Highest Source Address +1
D3C5: 91 94 STA (HIGHDS),Y ;Set Byte at Highest Destination Address +1
D3C7: 88 DOMVBLKUP2 DEY ;Move the Remainder of the Page of Bytes
D3C8: D0 F9 BNE DOMVBLKUP1 ;Loop until End of this Page of 256 bytes
; ----------------------------------- ;Move one more byte (the last one of 256)
D3CA: B1 96 LDA (HIGHTR),Y ;Get Byte at Highest Source Address +1
D3CC: 91 94 STA (HIGHDS),Y ;Set Byte at Highest Destination Address +1
; ----------------------------------- ;Down to NEXT Block of 256 Bytes
D3CE: C6 97 NXTMVBLKUP DEC HIGHTR+1 ;Reduce Highest Source Address +1, High
D3D0: C6 95 DEC HIGHDS+1 ;Reduce Highest Destination Address +1, High
D3D2: CA DEX ;Move another Block of 256 Bytes?
D3D3: D0 F2 BNE DOMVBLKUP2 ;YES; Move NEXT Page of Bytes (256)
D3D5: 60 RTS ;NO, Finished; Return to Caller
; ==============================================================================
; Assure sufficient Stack space to do FOR, GOSUB, or Expression Evaluation
; ==============================================================================
; Upon Entry, the Accumulator (A-Reg) should contain the number of Address
; Pointers and/or half the number of bytes required to be put on the STACK
; ------------------------------------------------------------------------------
; Entered with A-Reg = (9, 3, or 1) for (FOR, GOSUB, or FRMEVL), respectivly.
; ==============================================================================
;
D3D6: 0A CHKMEM ASL A ;Double it (* 2 bytes/Address-Pointer)
; ;Carry is also Cleared for A-Reg < 128
D3D7: 69 36 ADC #$36 ;(Acc) * 2 + 54 : (54 Overhead bytes/page)
; ------------------------------------------------------------------------------
; Do the Math: >>-----------> ;(Acc) * 2 + 54 >= 256 ;To set the carry flag
; > ;(Acc) * 2 >= 256 - 54 ;- Overhead bytes/page
; Conclusion: <---<< > ;(Acc) * 2 >= 202 ;= Maximum STACK bytes
; ($64)>=(Acc)>=($65) > ;(Acc) >= 202 / 2 ;/ 2-bytes/Adr.Pointer
; CC | CS > ;(Acc) >= 101 ;To set the carry flag
; ------------------------------------------------------------------------------
D3D9: B0 35 BCS MEMERR ;Deficient Stack-Space, Do Mem Full Error
; ;Never Happens: (A-Reg)=(72, 60, or 56) so
; ; Carry is Always Clear
D3DB: 85 5E STA STKPTR ;Save Result in Stack Pointer Index Safe
D3DD: BA TSX ;Put Stack Pointer in X-Reg
D3DE: E4 5E CPX STKPTR ;Compare Stack Pointer to Result Saved
D3E0: 90 2E BCC MEMERR ;Deficient Stack-Space, Do Memory Full Error
D3E2: 60 RTS ;Else, Enough Stack-Space, Return to Caller
; ==============================================================================
; Assure sufficient Arrays-to-Strings Free-Space
; [(A,Y)={Low,High}] = Address to which Array Space needs to grow
; ==============================================================================
;
D3E3: C4 70 REASON CPY FRETOP+1 ;Assure Y-Reg < FRETOP, High
D3E5: 90 28 BCC BAS_RTS01 ;Enough Free-Space, Return to Caller
D3E7: D0 04 BNE MAXFRESPC ;Deficient Free-Space, Collect Garbage
D3E9: C5 6F CMP FRETOP ;Assure A-Reg < FRETOP, Low
D3EB: 90 22 BCC BAS_RTS01 ;Enough Free-Space, Return to Caller
; ;Else, Deficient Free-Spc, Collect Garbage
; ------------------------------------------------------------------------------
; Save [(A,Y)={Low,High}], TEMP1, & TEMP2 to STACK (12 Bytes)
; [See also (below): "Preamble about the Applesoft Floating Point Accumulators"]
; ------------------------------------------------------------------------------
D3ED: 48 MAXFRESPC PHA ;Save/Push (A-Reg) Byte on STACK
D3EE: A2 09 LDX #$09 ;[+9]=[(FAC-TEMP1-1)=($9D-$93-1)=($09)]
D3F0: 98 TYA ;Save (Y-Reg) on the STACK next
D3F1: 48 PUSHNINE PHA ;Save/Push (A-Reg) Byte on STACK
D3F2: B5 93 LDA TEMP1,X ;Save TEMP1 & TEMP2 on the STACK
D3F4: CA DEX ;... (Temporary Save Areas for FAC & ARG)
D3F5: 10 FA BPL PUSHNINE ;Loop-Back until X<0
; ------------------------------------------------------------------------------
D3F7: 20 84 E4 JSR GARBAGE ;Maximize Free-Space, Collect Garbage ...
; ------------------------------------------------------------------------------
; Restore TEMP2, TEMP1, & [(A,Y)={Low,High}] from STACK (12 Bytes)
; [See also (below): "Preamble about the Applesoft Floating Point Accumulators"]
; ------------------------------------------------------------------------------
D3FA: A2 F7 LDX #$F7 ;[-9]=[(TEMP1-FAC+1)=($93-$9D+1)=($F7)]
D3FC: 68 PULLNINE PLA ;Pull Byte off STACK
D3FD: 95 9D STA FAC,X ;Restore TEMP2 & TEMP1 from the STACK
D3FF: E8 INX ;... (Temporary Save Areas for ARG & FAC)
D400: 30 FA BMI PULLNINE ;Loop-Back until X=0
D402: 68 PLA ;Pull Byte off STACK
D403: A8 TAY ;Restore Y-Reg with it (from STACK)
D404: 68 PLA ;Restore A-Reg (Pull Byte off STACK)
; ----------------------------------- ;[Next is similar to REASON (above)]
D405: C4 70 CPY FRETOP+1 ;Assure Y-Reg < FRETOP, High
D407: 90 06 BCC BAS_RTS01 ;Enough Free-Space, Return to Caller
D409: D0 05 BNE MEMERR ;Deficient Free-Space, Do Memory Full Error
D40B: C5 6F CMP FRETOP ;Assure A-Reg < FRETOP, Low
D40D: B0 01 BCS MEMERR ;Deficient Free-Space, Do Memory Full Error
D40F: 60 BAS_RTS01 RTS ;Enooough Free-Space, Return to Caller
; ==============================================================================
; Error Handler (Parts preceding Warm Restart):
; ==============================================================================
;
; ==============================================================================
; Error Handler (Part 0): Insufficient Free-Space, Do Memory Full Error
; ==============================================================================
;
; ----------------------------------- ;Error Entry Point; Also User-Callable:
D410: A2 4D MEMERR LDX #ERR_MEMFULL ;Get "?Out Of Memory" Error Message Index
;
; ==============================================================================
; "ERROR" Function: Error Handler (Part 1)
; ==============================================================================
; Print Error Message based on X-Reg
; ----------------------------------------------------------------------------
; (X)=Offset In Error Message Table
; (ERRFLG) > 128 If ON ERR is turned ON
; (CURLINH) = (CURLIN+1) = $FF If in Direct Mode
; ==============================================================================
;
D412: 24 D8 ERROR BIT ERRFLG ;Is ONERR turned ON?
D414: 10 03 BPL DOERRMSG ;YES, ONERR is turned ON
D416: 4C E9 F2 JMP ERRHNDLR ;NO, ONERR is turned OFF; Goto (Part 2)
; ==============================================================================
; Error Handler (Part 3): ON ERR is turned ON, so Print an Error Message
; ==============================================================================
D419: 20 FB DA DOERRMSG JSR CRDO ;Print a Carriage <Return> Character
D41C: 20 5A DB JSR OUTQUES ;Print a Qustion Mark ("?") Character
D41F: BD 60 D2 PRERRMSG LDA ERR_MSGS,X ;Get a Char from the Error Messages Table
D422: 48 PHA ;Save Char on STACK
D423: 20 5C DB JSR OUTDO ;Print Error Message (one Char at a time)
D426: E8 INX ;Get set for next Char
D427: 68 PLA ;Restore Character (Pull Byte off STACK)
D428: 10 F5 BPL PRERRMSG ;Loop-Back until Char has its high bit set
D42A: 20 83 D6 JSR STKINI ;Reset/Initialize STACK to start at $01F8
D42D: A9 50 LDA #<QT_ERROR ;Get set to ...
D42F: A0 D3 LDY #>QT_ERROR ;Print " ERROR" & Ring BELL
; ==============================================================================
; Error Handler (Final Part): Print Error Line Number then Do Warm Restart
; ==============================================================================
D431: 20 3A DB PRERRLINO JSR STROUT ;Print String at [(A,Y)={Low,High}]
D434: A4 76 LDY CURLIN+1 ;Which Program Mode: Running or Direct?
D436: C8 INY ;Print Current Line # if NOT in Direct Mode
D437: F0 03 BEQ RESTART ;If Direct (Y was $FF), Do Warm RESTART
D439: 20 19 ED JSR INPRT ;If Running (Y was NOT $FF), Print Line #
;
; ==============================================================================
; Warm RESTART Entry Point (Monitor commands: Ctrl-C, 0G, 3D0G, or E003G)
; ==============================================================================
;
D43C: 20 FB DA RESTART JSR CRDO ;Print a Carriage <Return> Character
D43F: A2 DD LDX #']' | $80 ;Print the Applesoft Prompt Character
D441: 20 2E D5 JSR INLIN2 ;Get/Read a Line of Direct Input
; ----------------------------------- ;CHRGET: Get Next Character/Token ZP-S/R
D444: 86 B8 STX TXTPTR ;Set up CHRGET to Scan the Input Line
D446: 84 B9 STY TXTPTR+1 ;[(X,Y)={Low,High}]= CHRGET Next Chr/Tok Ptr
D448: 46 D8 LSR ERRFLG ;Defeat ONERR: Clear the Error Flag
D44A: 20 B1 00 JSR CHRGET ;Get a Character
D44D: AA TAX ;Character Got; Null is last char + 1
D44E: F0 EC BEQ RESTART ;Loop-Back until finished scanning (A-Reg=0)
; ;Also, if NO Input (<Return> key pressed)
; ----------------------------------- ;Else, Process the Line Input Directly:
D450: A2 FF LDX #$FF ;Set Direct Mode flag
D452: 86 76 STX CURLIN+1 ; = Current Line Number, High
; ; Line Numbers Allowed: 0-63999
; ; < (64000 = $FA00) < ($FFxx >= 65280)
; ; is Too Big, so used as Direct Mode flag
D454: 90 06 BCC NMBRDLN ;If CHRGET saw #, Input is new Prgm Line
D456: 20 59 D5 JSR PARSELINE ;Else, (CS) NO Number, So Parse the Line
D459: 4C 05 D8 JMP TRACEQ ;And, Try Executing the Line
; ------------------------------------------------------------------------------
; Numbered Line Handler (Input is a new Program Line)
; ------------------------------------------------------------------------------
; To see: "How Applesoft BASIC Programs Are Arranged In Memory",
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", pages 5 to 8
; ------------------------------------------------------------------------------
; To see: "How Applesoft BASIC Program Lines Are Constructed",
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", page 15
; ------------------------------------------------------------------------------
D45C: A6 AF NMBRDLN LDX PRGEND ;Get End-of-Program Pointer [EOP +(1 or 2)?]
D45E: 86 69 STX VARTAB ;Save as Start-of-Variables Pointer
D460: A6 B0 LDX PRGEND+1 ;Do Pointers' High bytes, too
D462: 86 6A STX VARTAB+1 ;That Resets Start of Variable Table (LOMEM)
; Effectively wiping out any routines you may have installed between PRGEND and
; VARTAB (after using LOMEM: to move VARTAB up, to make space for the routines)!
; ------------------------------------------------------------------------------
; vvvvvv Alternative Entry Point? Just an idea! Not actually used:
D464: 20 0C DA NMBRDLN2 JSR LINGET ;Get Line Number
D467: 20 59 D5 JSR PARSELINE ;And Parse the Input Line
D46A: 84 0F STY TKNCNTR ;Save InBuff Index as End-of-Line Pointer
D46C: 20 1A D6 JSR FNDLIN ;Is this Line # already in the program?
D46F: 90 44 BCC NEWLINE ;No; Put New-Line into program
; ----------------------------------- ;Yes; Delete Old-Line (LOWTR is Pointer)
D471: A0 01 LDY #$01 ;Set Y=1 (for High values)
D473: B1 9B LDA (LOWTR),Y ;Get Next-Line's Address, High
D475: 85 5F STA SRCPTR+1 ;Set Source Pointer, High
D477: A5 69 LDA VARTAB ;Get EOP/Start-of-Variables Pointer, Low
D479: 85 5E STA SRCPTR ;Set Source Pointer, Low
D47B: A5 9C LDA LOWTR+1 ;Get Old-Line Pointer, High
D47D: 85 61 STA DSTPTR+1 ;Set Destination Pointer, High
D47F: A5 9B LDA LOWTR ;Get Old-Line Pointer, Low
D481: 88 DEY ;Y goes from 1 to 0 (for Low values)
D482: F1 9B SBC (LOWTR),Y ;Subtract Next-Line's Address, Low
D484: 18 CLC ;Prepare for Add with Carry
D485: 65 69 ADC VARTAB ;Add EOP/Start-of-Variables Pointer, Low
; ----------------------------------- ;Result is New Program End (EOP)
D487: 85 69 STA VARTAB ;Set EOP/Start-of-Variables Pointer, Low
D489: 85 60 STA DSTPTR ;Set Destination Pointer, Low
D48B: A5 6A LDA VARTAB+1 ;Get EOP/Start-of-Variables Pointer, High
D48D: 69 FF ADC #$FF ;Subtract 1
D48F: 85 6A STA VARTAB+1 ;Set EOP/Start-of-Variables Pointer, High
D491: E5 9C SBC LOWTR+1 ;Subtract Old-Line Pointer, High
; ----------------------------------- ;Result is Index to Move Whole Memry Pages
D493: AA TAX ;Save Result in X-Reg
D494: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
D495: A5 9B LDA LOWTR ;Get Old-Line Pointer, Low
D497: E5 69 SBC VARTAB ;Subtract EOP/Start-of-Variables Ptr, Low
; ----------------------------------- ;Result is Index to Move Partial Page
D499: A8 TAY ;Save Result in Y-Reg
D49A: B0 03 BCS DECSRCPTR ;No borrow, so skip changing High values
D49C: E8 INX ;Increment Index to Move Whole Memory Pages
D49D: C6 61 DEC DSTPTR+1 ;Decrement Destination Pointer, High
D49F: 18 DECSRCPTR CLC ;Prepare for Add with Carry
D4A0: 65 5E ADC SRCPTR ;Add Source Pointer, Low
D4A2: 90 03 BCC DOMVBLKDWN ;No carry, so skip changing High values
D4A4: C6 5F DEC SRCPTR+1 ;Decrement Source Pointer, High
D4A6: 18 CLC ;We're done with it, so clear it
; ------------------------------------------------------------------------------
; Move Block Down: Move Higher Program Lines Down, Over Deleted & Prior Lines
; ------------------------------------------------------------------------------
; ;Do it NOW: Move ALL Bytes & Pages Down
D4A7: B1 5E DOMVBLKDWN LDA (SRCPTR),Y ;Get Byte at Source Address
D4A9: 91 60 STA (DSTPTR),Y ;Set Byte at Destination Address
D4AB: C8 INY ;Incerment Index to Move Partial Page
D4AC: D0 F9 BNE DOMVBLKDWN ;Loop until Done: (Byte Counter)=0
D4AE: E6 5F INC SRCPTR+1 ;Increment Source Pointer
D4B0: E6 61 INC DSTPTR+1 ;Increment Destination Pointer
D4B2: CA DEX ;Decrement Index to Move Whole Memory Pages
D4B3: D0 F2 BNE DOMVBLKDWN ;Loop until Done: (Page Counter)=0
; ------------------------------------------------------------------------------
; Insert a New Line into the Program [*]=[(A,Y)={Low,High}]
; ------------------------------------------------------------------------------
; To see: "How Applesoft BASIC Programs Are Arranged In Memory",
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", pages 5 to 8
; ------------------------------------------------------------------------------
; To see: "How Applesoft BASIC Program Lines Are Constructed",
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", page 15
; ------------------------------------------------------------------------------
D4B5: AD 00 02 NEWLINE LDA INBUFF ;Any Characters After Line Number?
D4B8: F0 38 BEQ FIXLINKS ;No (INBUFF is empty), so nothing to insert
; ----------------------------------- ;Yes, so make room to insert New-Line [*]:
; Clean String Area, first (Strings are stored from MEMSIZ downward to FRETOP):
D4BA: A5 73 LDA MEMSIZ ;Get String-Space-Top (HIMEM), Low
D4BC: A4 74 LDY MEMSIZ+1 ;Get String-Space-Top (HIMEM), High
D4BE: 85 6F STA FRETOP ;Set Free-Spc-End/String-Space-Bottom, Low
D4C0: 84 70 STY FRETOP+1 ;Set Free-Spc-End/String-Space-Bottom, High
; ;That Resets String-Storage (FRETOP=HIMEM)
; ----------------------------------- ;Prepare to move memory block up [*]:
D4C2: A5 69 LDA VARTAB ;Get EOP/Start-of-Variables, Low
D4C4: 85 96 STA HIGHTR ;Set Source Pointer, Low
; ;Carry is already Clear
D4C6: 65 0F ADC TKNCNTR ;Add End-of-Line Pointer
D4C8: 85 94 STA HIGHDS ;Set Destination Pointer, Low
D4CA: A4 6A LDY VARTAB+1 ;Get EOP/Start-of-Variables, High
D4CC: 84 97 STY HIGHTR+1 ;Set Source Pointer, High
D4CE: 90 01 BCC MVPRGM ;No carry, so skip changing High values
D4D0: C8 INY ;Increment EOP/Start-of-Variables, High
D4D1: 84 95 MVPRGM STY HIGHDS+1 ;Set Destination Pointer, High
; ----------------------------------- ;Do it NOW: Move Memory Block Upward
D4D3: 20 93 D3 JSR MVBLKUP1 ;Move Block Up: to make room for New-Line
; ----------------------------------- ;Put Line-Number into New-Line-Image [*]:
D4D6: A5 50 LDA LINNUM ;Get Line-Number, Low
D4D8: A4 51 LDY LINNUM+1 ;Get Line-Number, High
D4DA: 8D FE 01 STA IMGLINNUM ;Set New-Line-Image's Line-Number, Low
D4DD: 8C FF 01 STY IMGLINNUM+1 ;Set New-Line-Image's Line-Number, High
; ----------------------------------- ;Move EOP Up (Ptr); Clears Variables [*]:
D4E0: A5 6D LDA STREND ;Get End-of-Variables/Free-Space-Start, Low
D4E2: A4 6E LDY STREND+1 ;Get End-of-Variables/Free-Space-Start, High
D4E4: 85 69 STA VARTAB ;Set EOP/Start-of-Variables, Low
D4E6: 84 6A STY VARTAB+1 ;Set EOP/Start-of-Variables, High
; ;Reseting Variables Ups EOP (LOMEM=FRESPC)
; ----------------------------------- ;Copy New-Line-Image into Program:
; ;LOWTR is Pointer to the New-Line-Area
D4E8: A4 0F LDY TKNCNTR ;Get End-of-Line Pointer for countdown
D4EA: B9 FB 01 INSERTLINE LDA LINEIMAGE,Y ;Get New-Line-Image (byte) [EOL..INBUFF-4]
D4ED: 88 DEY ;Count Down [EOL-1..INBUFF-5]
D4EE: 91 9B STA (LOWTR),Y ;Put New-Line (byte) into Program
D4F0: D0 F8 BNE INSERTLINE ;Loop until done [INBUFF-5 is not copied!]
; ==============================================================================
; Clear All Variables & Re-Establish All Forward Links [*]=[(A,Y)={Low,High}]
; ==============================================================================
; Forward Links are the Next-Line Address-Pointers at the start of each Program-
; Line that point to the NEXT Program-Line; Prgm-Lines are Numbered & Tokenized!
; ==============================================================================
; FIXLINKS is aldo called when a Line Number alone is typed (e.g., ]0<Return>)
; ==============================================================================
D4F2: 20 65 D6 FIXLINKS JSR SETPTRS ;Reset Start-of-Program & Clear All Vars
; ;Point to Start-of-Program [*]:
D4F5: A5 67 LDA TXTTAB ;Get Start-of-Program, Low
D4F7: A4 68 LDY TXTTAB+1 ;Get Start-of-Program, High
D4F9: 85 5E STA LINPTR ;Set Line Pointer, Low
D4FB: 84 5F STY LINPTR+1 ;Set Line Pointer, High
D4FD: 18 CLC ;Prepare for Add with Carry?
D4FE: A0 01 NXTLNK LDY #1 ;Hi-Byte of Next Forward Link
D500: B1 5E LDA (LINPTR),Y ;At End-of-Program yet?
D502: D0 0B BNE PUTLNK ;NO, KEEP GOING! [(Forward Link)>(EOP=0)]
; ;YES, Reset End-of-Program to (LOMEM) [*]:
D504: A5 69 LDA VARTAB ;Get Start-of-Variables, Low
D506: 85 AF STA PRGEND ;Set End-of-Program Pointer, Low
D508: A5 6A LDA VARTAB+1 ;Get Start-of-Variables, High
D50A: 85 B0 STA PRGEND+1 ;Set End-of-Program Pointer, High
D50C: 4C 3C D4 JMP RESTART ;Do Warm RESTART
; ----------------------------------- ;Setup Forward Links:
D50F: A0 04 PUTLNK LDY #4 ;Find End of this Line (Max Length < 256)
; ;Skip first 4: Forward Link & Line Number
D511: C8 FNDEOL INY ;Fifth is First BASIC Token in Line
D512: B1 5E LDA (LINPTR),Y ;Scan Tokenized Line (EOL=0)
D514: D0 FB BNE FNDEOL ;Loop until a zero is found
D516: C8 INY ;Compute Address of Next Line:
D517: 98 TYA ;Get this Line's Length +1
D518: 65 5E ADC LINPTR ;Add it to this Line's Address, Low
D51A: AA TAX ;Save Address of Next Line, Low, in X-Reg
D51B: A0 00 LDY #0 ;Store Forward Link, Low, in this Line:
D51D: 91 5E STA (LINPTR),Y ;Set Address of Next Line, Low
D51F: A5 5F LDA LINPTR+1 ;Get this Line's Address, High
D521: 69 00 ADC #0 ;Add the Carry bit; This also Clears it
D523: C8 INY ;Store Forward Link, High, too:
D524: 91 5E STA (LINPTR),Y ;Set Address of Next Line, High
; ;Advance Line Address Ptr to Next Line:
D526: 86 5E STX LINPTR ;Set Line Pointer to Next-Line, Low
D528: 85 5F STA LINPTR+1 ;Set Line Pointer to Next-Line, High
D52A: 90 D2 BCC NXTLNK ;Always Taken; Do the Next Forward Link
;
; ==============================================================================
; Read a Line and Strip Off Sign Bits to make Characters Low ASCII
; ==============================================================================
;
D52C: A2 80 INLIN LDX #$80 ;Get High ASCII Null Character
D52E: 86 33 INLIN2 STX PROMPT ;Set Command Prompt Character
D530: 20 6A FD JSR GETLN ;Get a Line of Input
D533: E0 EF CPX #$EF ;Is Line's Length <= Maximum Line Length?
D535: 90 02 BCC LENGTHOK ;YES, Line's Length <= 239 Characters
D537: A2 EF LDX #$EF ;NO, Truncate Line at 239 Characters
D539: A9 00 LENGTHOK LDA #$00 ;End-Of-Line Markers are Null Characters
D53B: 9D 00 02 STA INBUFF,X ;Set End-Of-Line Marker in Input Buffer
D53E: 8A TXA ;Is Line's Length = 0?
D53F: F0 0B BEQ NOINPUT ;YES, it is an Empty Input Line
D541: BD FF 01 STRIP LDA INBUFF-1,X ;NO, Strip Off each Character's Sign Bit
D544: 29 7F AND #%01111111 ;Mask Off Sign Bit; Make Character Low ASCII
D546: 9D FF 01 STA INBUFF-1,X ;Put Character back in its place
D549: CA DEX ;Are all Characters Naked yet? ;-)
D54A: D0 F5 BNE STRIP ;NO, Loop-back; Keep Stripping them! :-D
D54C: A9 00 NOINPUT LDA #$00 ;YES; Set A=0, ...
D54E: A2 FF LDX #<INBUFF-1 ;Set X=$FF = [(INBUFF, Low)-1: (0 - 1 = -1)]
D550: A0 01 LDY #>INBUFF-$100 ;Set Y=$01 = [(INBUFF, High)-1: (2 - 1 = 1)]
; ^^^^^^^^^^^ ;Why does this display this way?
; ;It should be minus one!
D552: 60 RTS ;[(X,Y)={Low,High}] Ptr = (Input-Buffer)-1
; ==============================================================================
; Read a Charater and Strip Off its Sign Bit to make it Low ASCII
; ==============================================================================
;
; ------------------------------------------------------------------------------
; *** Why should this be, "INCHR BIT $C010", instead of "INCHR JSR RDKEY"? ***
; The following looks pretty straight forward to me. Anyone could call this:
; ------------------------------------------------------------------------------
D553: 20 0C FD INCHR JSR RDKEY ;Get in (A) & Make Cursor Character Flash
D556: 29 7F AND #%01111111 ;Mask Off Sign Bit; Make Character Low ASCII
D558: 60 RTS ;Return to Caller
; ==============================================================================
; Parse and Tokenize the Input Line? Or, AUTORUN the Applesoft Program?
; ==============================================================================
;
D559: A6 B8 PARSELINE LDX TXTPTR ;Get CHRGET's Next Char/Token Pointer
; ; as Index into Unparsed Line
D55B: CA DEX ;Prepare for INX at PARSE
D55C: A0 04 LDY #4 ;Prep Index to Parsed Output Line, too
D55E: 84 13 STY DATAFLG ;& Clear DATA Statement Flag (sign-bit)
D560: 24 D6 BIT AUTORUN ;Is this program locked (AUTORUN=$80)?
D562: 10 08 BPL PARSE ;NO, AUTORUN Flag<128, Parse the Input Line
; ;YES, AUTORUN Flag>127, Ignore Input
; ; and AUTORUN the Applesoft Program:
D564: 68 PLA ;Pull/Discard Return Address, Low
D565: 68 PLA ;Pull/Discard Return Address, High
D566: 20 65 D6 JSR SETPTRS ;Clear All Variables
D569: 4C D2 D7 JMP NEWSTT ;Start the Program Running
; ------------------------------------------------------------------------------
; Parse and Tokenize the Input Line
; ------------------------------------------------------------------------------
D56C: E8 PARSE INX ;Increment Poiter to Next Input Character
D56D: BD 00 02 NXCHR LDA INBUFF,X ;Get Next Input Character
D570: 24 13 BIT DATAFLG ;Is Input flagged as a Data Statement?
D572: 70 04 BVS DATASTATE ;YES (DATAFLG = $49)
D574: C9 20 CMP #' ' ;NO; Is Char a Space?
D576: F0 F4 BEQ PARSE ;YES, Ignore Blanks, Loop
D578: 85 0E DATASTATE STA ENDCHR ;Save Character to Set Literal Flag
D57A: C9 22 CMP #'"' ;Is this the start of a Quotation?
D57C: F0 74 BEQ QUOTATION ;YES, Handle the Quotation
D57E: 70 4D BVS PUTIN ;NO; Branch If in Data Statement
D580: C9 3F CMP #'?' ;Is Input Character a Question Mark?
D582: D0 04 BNE ISITATOKEN ;NO, Continue checking Input Character
D584: A9 BA LDA #TOK_PRINT ;YES, Replace Question Mark w/ Print Token
D586: D0 45 BNE PUTIN ;Always Taken
; Is it a Token?
D588: C9 30 ISITATOKEN CMP #'0' ;Is it a Digit, Colon, Or Semi-Colon?
D58A: 90 04 BCC ISATOKEN ;BLT: NO, It's Punctuation !"#$%&'()*+,-./
D58C: C9 3C CMP #'<' ;Is it a Digit, Colon, Or Semi-Colon?
D58E: 90 3D BCC PUTIN ;BLT: YES, So it is Not a Token
; ------------------------------------------------------------------------------
; Search Token Name Table for match, starting with current Char from Input Line
; ------------------------------------------------------------------------------
D590: 84 AD ISATOKEN STY STRNG2 ;Save Index to Output Line
D592: A9 D0 LDA #<TKNMTBL ;Get Token-Name-Table's Address-1, Low
D594: 85 9D STA FAC ;Set Search Pointer, Low
D596: A9 CF LDA #>TKNMTBL-$100 ;Get Token-Name-Table's Address-1, High
; ^^^^^^^^^^^^ ;Why does this display this way?
; ;It should be minus one!
D598: 85 9E STA FAC+1 ;Set Search Pointer, High
D59A: A0 00 LDY #0 ;Use Y-Reg with FAC to address Table
D59C: 84 0F STY TKNCNTR ;Holds Current Token - $80
D59E: 88 DEY ;Prepare for INY a few lines down
D59F: 86 B8 STX TXTPTR ;Save Position in Input Line
D5A1: CA DEX ;Prepare for INX a few lines down
D5A2: C8 INC_Y INY ;Advance Pointer to Token Table
D5A3: D0 02 BNE INC_X ;If No Carry Over, No Need to Bump the Page
D5A5: E6 9E INC FAC+1 ;If Carry Over, Need to Bump the Page
D5A7: E8 INC_X INX ;Advance Pointer into Input Line
D5A8: BD 00 02 LIN LDA INBUFF,X ;Get next Character from Input Line
D5AB: C9 20 CMP #' ' ;Is Character a Blank?
D5AD: F0 F8 BEQ INC_X ;YES, Ignore All Blanks
D5AF: 38 SEC ;NO, Compare to Character in Table
D5B0: F1 9D SBC (FAC),Y ;Same as next Character of Token Name?
D5B2: F0 EE BEQ INC_Y ;YES, Continue Matching
D5B4: C9 80 CMP #$80 ;MAYBE; Was it same except for bit 7?
D5B6: D0 41 BNE NXTTOKNAM ;NO, Skip to Next Token
D5B8: 05 0F ORA TKNCNTR ;YES, End of Token Name; Get Token Number
D5BA: C9 C5 CMP #TOK_AT ;Did we match AT?
D5BC: D0 0D BNE PUTTOK ;NO, So No Ambiguity
D5BE: BD 01 02 LDA INBUFF+1,X ;AT could be ATN or "A TO"
D5C1: C9 4E CMP #'N' ;ATN has precedence over AT
D5C3: F0 34 BEQ NXTTOKNAM ;It is ATN, Find It The Hard Way
D5C5: C9 4F CMP #'O' ;TO has precedence over AT
D5C7: F0 30 BEQ NXTTOKNAM ;It is "A To", Find It The Hard Way
D5C9: A9 C5 LDA #TOK_AT ;Not ATN Or "A TO", So Use AT
; ------------------------------------------------------------------------------
; Store Character or Token in Output Line
; ------------------------------------------------------------------------------
D5CB: A4 AD PUTTOK LDY STRNG2 ;Get Index to Output Line
D5CD: E8 PUTIN INX ;Advance Input Index
D5CE: C8 INY ;Advance Output Index
D5CF: 99 FB 01 STA LINEIMAGE,Y ;Store Character or Token
D5D2: B9 FB 01 LDA LINEIMAGE,Y ;Reload it to Test for EOL or EOS
D5D5: F0 39 BEQ LINEND ;Branch if at End Of Line
D5D7: 38 SEC ;Prepare to Subtract & do it (next)
D5D8: E9 3A SBC #':' ;Is it the End of a Statement?
D5DA: F0 04 BEQ SDF ;YES, at EOS: Clear DATAFLG (=0)
D5DC: C9 49 CMP #TOK_DATA-58 ;(-':'); Is it a "DATA" Token?
D5DE: D0 02 BNE ISITAREM ;NO, Keep DATAFLG as is
D5E0: 85 13 SDF STA DATAFLG ;Set DATAFLG [(=0) or ($83-$3A=$49)]
D5E2: 38 ISITAREM SEC ;Prepare to Subtract & do it (next)
D5E3: E9 78 SBC #TOK_REM-58 ;(-':'); Is it a "REM" Token?
D5E5: D0 86 BNE NXCHR ;NO, Continue Parsing Line
D5E7: 85 0E STA ENDCHR ;YES, Save Result (=0): Clear Literal Flag
; ------------------------------------------------------------------------------
; Handle Literals, Characters between Quotes, or Remarks, by copying the
; Characters up to the Closing Quote or to the End of Line Character
; ------------------------------------------------------------------------------
; This is routine's Drop-Down-Into Entry Point (for Reminders: ENDCHR = 0)
; and its Loop-Back Reentry Point (for processing Literals: copying characters):
D5E9: BD 00 02 COPYCHARS LDA INBUFF,X ;Get Next Input Character
D5EC: F0 DF BEQ PUTIN ;Branch if at End of Line (=0)
; ^^^^^^^^^^^^ ;<< NOT NEEDED; ENDCHR = 0 or '"', ONLY! >
D5EE: C5 0E CMP ENDCHR ;Branch if at Closing Quote ('"')
D5F0: F0 DB BEQ PUTIN ;Found ENDCHR ('"') <<< or EOL (=0)! >>>
; This is routines Entry Point from PARSE routine BEQ, way above: ENDCHR = '"'
D5F2: C8 QUOTATION INY ;Next Output Char
D5F3: 99 FB 01 STA LINEIMAGE,Y ;Set (Put Back) Output Character
D5F6: E8 INX ;Next Input Char
D5F7: D0 F0 BNE COPYCHARS ;Loop until Literal is done; Always Taken
; ------------------------------------------------------------------------------
; Advance Pointer to Next Token Name
; ------------------------------------------------------------------------------
D5F9: A6 B8 NXTTOKNAM LDX TXTPTR ;Get Pointer to Input Line
D5FB: E6 0F INC TKNCNTR ;Advance Token Counter (Token #'s - $80)
; ;Skip Over Current Keyword:
D5FD: B1 9D SKIPOVER LDA (FAC),Y ;Scan Table for High ASCII Characters
D5FF: C8 INY ;Next Token, one beyond that,
D600: D0 02 BNE CHKTNCHR ;It is usually enough to just INC Y-Reg
D602: E6 9E INC FAC+1 ;Next Set of 256 Token Name Characters
D604: 0A CHKTNCHR ASL A ;Is Character's Sign Bit Set?
D605: 90 F6 BCC SKIPOVER ;NO, Loop until Next Token Name reached
D607: B1 9D LDA (FAC),Y ;YES, We're at Next Name; End Of Table?
D609: D0 9D BNE LIN ;NO, Loop until End of TN Table reached
D60B: BD 00 02 LDA INBUFF,X ;YES, So Not a Keyword
D60E: 10 BB BPL PUTTOK ;Copy Char "As Is"; Always Taken
;
; ------------------------------------------------------------------------------
; End of Line (In case we're in Direct Mode)
; ------------------------------------------------------------------------------
D610: 99 FD 01 LINEND STA LINEIMAGE+2,Y ;Set End of Input Line to $00
D613: C6 B9 DEC TXTPTR+1 ;Set Next Input Character, High
D615: A9 FF LDA #$FF ;Set TXTPTR = INPUT_BUFFER - 1 = $01FF
D617: 85 B8 STA TXTPTR ;Set Next Input Character, Low
D619: 60 RTS ;Return to Caller
; ==============================================================================
; Search for a Specific Line
; ==============================================================================
; On Entry: Search the Program for the Line whose Number is in LINNUM.
; On Exit: Carry is Set If Found, or Clear If Not Found, &
; LOWTR points to Line If Found, or to Next Line If Not Found.
; ==============================================================================
; LINNUM = Line # to Find:
; If Not Found: Carry = 0; LOWTR Points at Next Line
; If Found: Carry = 1; LOWTR Points at Line Specified
; ==============================================================================
;
; Search for Line # (from Start of Program):
D61A: A5 67 FNDLIN LDA TXTTAB ;Get Start of Program, Low
D61C: A6 68 LDX TXTTAB+1 ;Get Start of Program, High
; ;Start Search from: [(A,X)={Low,High}]=[*]
D61E: A0 01 FNDLIN2 LDY #1 ;Set Indirect Addressing Index to +1
D620: 85 9B STA LOWTR ;Set Line Pointer, Low [*]
D622: 86 9C STX LOWTR+1 ;Set Line Pointer, High
D624: B1 9B LDA (LOWTR),Y ;Get 2nd byte in Program Line
D626: F0 1F BEQ FL_NOTFND ;Branch If End of Program (=0)
D628: C8 INY ;Set Indirect Addressing Index to +2
D629: C8 INY ;Set Indirect Addressing Index to +3
D62A: A5 51 LDA LINNUM+1 ;Get Line # to Find, High
D62C: D1 9B CMP (LOWTR),Y ;Compare # to Program Line Number, High
D62E: 90 18 BCC BAS_RTS02 ;BLT: If Not Found, Return to Caller
D630: F0 03 BEQ FL_CHKLO ;If Found, Check Program Line Number, Low
D632: 88 DEY ;Set Indirect Addressing Index to +2
D633: D0 09 BNE FL_NXTLIN ;Always Taken
D635: A5 50 FL_CHKLO LDA LINNUM ;Get Line # to Find, Low
D637: 88 DEY ;Set Indirect Addressing Index to +2
D638: D1 9B CMP (LOWTR),Y ;Compare # to Program Line Number, Low
D63A: 90 0C BCC BAS_RTS02 ;BLT: If Not Found, Return to Caller
D63C: F0 0A BEQ BAS_RTS02 ;If Found (Carry Set), Return to Caller
D63E: 88 FL_NXTLIN DEY ;Set Indirect Addressing Index to +1
D63F: B1 9B LDA (LOWTR),Y ;Get Next Line Address (Forward Link), High
D641: AA TAX ;X-Reg is Line Pointer, High [*]
D642: 88 DEY ;Set Indirect Addressing Index to +0
D643: B1 9B LDA (LOWTR),Y ;Get Next Line Address (Forward Link), Low
D645: B0 D7 BCS FNDLIN2 ;A-Reg is Line Pointer, Low; Always Taken
D647: 18 FL_NOTFND CLC ;Return Carry Clear (=0)
D648: 60 BAS_RTS02 RTS ;Return to Caller
; ==============================================================================
; "NEW" Statement: Immediate and Deferred; No parameters; Deletes current
; program and all variables. [Initializes for a NEW Program!]
; ==============================================================================
;
D649: D0 FD NEW BNE BAS_RTS02 ;Return to Caller if more to Statement
D64B: A9 00 SCRTCH LDA #$00 ;No more to it, so do it!
D64D: 85 D6 STA AUTORUN ;Clear AutoRun: UNLOCK/Enable User Commands
D64F: A8 TAY ;Clear Indirect Addressing Index
D650: 91 67 STA (TXTTAB),Y ;Clear Forward Link, Low, at Program Start
D652: C8 INY ;Set Indirect Addressing Index to +1
D653: 91 67 STA (TXTTAB),Y ;Clear Forward Link, High, at Program Start
D655: A5 67 LDA TXTTAB ;Get Start of Program Pointer, Low
; ;The Carry Flag is not Cleared here,
; ;so NEW usually adds 3, whereas FP adds 2:
D657: 69 02 ADC #$02 ;Carry is (what it was at entry) Not Known!
D659: 85 69 STA VARTAB ;Set Start of Variables Pointer, Low
D65B: 85 AF STA PRGEND ;Set End of Program Pointer, Low
D65D: A5 68 LDA TXTTAB+1 ;Get Start of Program Pointer, High
D65F: 69 00 ADC #$00 ;Add in the Carry bit (Should be Clear!)
D661: 85 6A STA VARTAB+1 ;Set Start of Variables Pointer, High
D663: 85 B0 STA PRGEND+1 ;Set End of Program Pointer, High
; ------------------------------------------------------------------------------
D665: 20 97 D6 SETPTRS JSR CLRTXTPTR ;Reset TXTPTR to TXTTAB-1, Start of Program
D668: A9 00 LDA #$00 ;Clear the Accumulator Register
; ;This could have been DFB $2C, a fake BIT
; ;OpCode to skip the next line, but this
; ;way also prevents next branch from being
; ;taken
;
; ==============================================================================
; "CLEAR" Statement: Immediate and Deferred; No parameters; Zeroes all
; variables, arrays and strings; Resets pointers and stacks
; ==============================================================================
;
D66A: D0 2A CLEAR BNE BAS_RTS03 ;Return to Caller if NOT at Statement End
; ;NOT Statement End; more to it, so do it!
; ;Clear String Area: [(A,Y)={Low,High}]=[*]
D66C: A5 73 CLEARC LDA MEMSIZ ;Get End of String Space (HIMEM), Low [*]
D66E: A4 74 LDY MEMSIZ+1 ;Get End of String Space (HIMEM), High
D670: 85 6F STA FRETOP ;Set Start of String Storage Pointer, Low
D672: 84 70 STY FRETOP+1 ;Set Start of String Storage Pointer, High
; ;Clear Array Area:
D674: A5 69 LDA VARTAB ;Get Start of Variables Pointer, Low [*]
D676: A4 6A LDY VARTAB+1 ;Get Start of Variables Pointer, High
D678: 85 6B STA ARYTAB ;Set Start of Arrays Pointer, Low [*]
D67A: 84 6C STY ARYTAB+1 ;Set Start of Arrays Pointer, High
; ;Clear StorageEnd/FreeSpaceStart Pointer:
D67C: 85 6D STA STREND ;Set StorageEnd/FreSpcStrt Ptr, Low [*]
D67E: 84 6E STY STREND+1 ;Set StorageEnd/FreSpcStrt Ptr, High
D680: 20 49 D8 JSR RESTORE ;Reset Data List Pointer back to its Start
; ==============================================================================
; Initialize Stack Pointer: Reset STACK to start at $01F8
; ==============================================================================
D683: A2 55 STKINI LDX #TEMPST ;Get Start Addrs of Temp String Descriptors
D685: 86 52 STX TEMPPT ;Set SD Stack: Next Temp Descriptor Pointer
; ------------------------------------------------------------------------------
; Reset/Move (Top of) Stack Pointer & Keep/Move current Return Address, too:
; ------------------------------------------------------------------------------
D687: 68 PLA ;Pull Return Address, Low [*]
D688: A8 TAY ;Save it in Y-Reg
D689: 68 PLA ;Pull Return Address, High [*]
; ;Save it in A-Reg
; ------------------------------------------------------------------------------
; Keep Top of Stack for Input Line Image: Forward Link & Line Number (4 bytes)+1
; ------------------------------------------------------------------------------
D68A: A2 F8 LDX #$F8 ;Start Stack at $1F8 (Could have used $FB)
D68C: 9A TXS ;leaving room for Parsing Input Lines
; ;[Bill said this was a typographical input
; ;error, because $FB looks a lot like $F8!]
; ------------------------------------------------------------------------------
; Restore current Return Address at new Top of Stack:
; ------------------------------------------------------------------------------
; ;Restore from A-Reg:
D68D: 48 PHA ;Push Return Address, High [*]
D68E: 98 TYA ;Restore from Y-Reg:
D68F: 48 PHA ;Push Return Address, Low [*]
; ------------------------------------------------------------------------------
; Finish Stack Init:
; ------------------------------------------------------------------------------
D690: A9 00 LDA #$00 ;Clear the Accumulator Register
D692: 85 7A STA OLDTEXT+1 ;Clear Pointer, High: Defeats CONT Command
D694: 85 14 STA SUBFLG ;Allow Subscripting
D696: 60 BAS_RTS03 RTS ;Return to Caller
; ==============================================================================
; Reset TXTPTR to TXTTAB-1, Start of Program
; ==============================================================================
;
D697: 18 CLRTXTPTR CLC ;Prepare for Add with Carry
D698: A5 67 LDA TXTTAB ;Get Start of Program Pointer, Low
D69A: 69 FF ADC #$FF ;Add -1 (or Subtract 1)
D69C: 85 B8 STA TXTPTR ;Set CHRGET's Next Char/Token Pointer, Low
D69E: A5 68 LDA TXTTAB+1 ;Get Start of Program Pointer, High
D6A0: 69 FF ADC #$FF ;Add -1 (or Subtract 1)
D6A2: 85 B9 STA TXTPTR+1 ;Set CHRGET's Next Char/Token Pointer, High
D6A4: 60 RTS ;Return to Caller
; ==============================================================================
; "LIST" Statement: Immediate and Deferred; Parms: [LineNum1] [[-|,] LineNum2];
; Lists the current Applesoft BASIC program or any part of it
; ==============================================================================
;
D6A5: 90 0A LIST BCC STRTRNG ;BLT: Branch if No Line Number Specified
D6A7: F0 08 BEQ STRTRNG ;(<|=) Branch if No Line Number Specified
D6A9: C9 C9 CMP #TOK_MINUS ;Is it a Dash?
D6AB: F0 04 BEQ STRTRNG ;It is a Dash, Start at Line 0
D6AD: C9 2C CMP #',' ;Is it a Comma?
D6AF: D0 E5 BNE BAS_RTS03 ;NOT a Comma, Error, Return to Caller
; ----------------------------------- ;Start at Line 0
D6B1: 20 0C DA STRTRNG JSR LINGET ;Set LINNUM to Start of Range
D6B4: 20 1A D6 JSR FNDLIN ;Find, Convert, & Point LOWTR at 1st Line
D6B7: 20 B7 00 JSR CHRGOT ;Get Character Got; Is a Range Specified?
D6BA: F0 10 BEQ MAINLST ;Branch if a Range is Not specified
D6BC: C9 C9 CMP #TOK_MINUS ;Is it a Dash?
D6BE: F0 04 BEQ ENDRNG ;It is a Dash, End at Line Number Specified
D6C0: C9 2C CMP #',' ;Is it a Comma?
D6C2: D0 84 BNE BAS_RTS02 ;NOT a Comma, Error, Return to Caller
; ------------------------------------------------------------------------------
D6C4: 20 B1 00 ENDRNG JSR CHRGET ;Get Next Character: End Line Number
D6C7: 20 0C DA JSR LINGET ;Set LINNUM to End of Range
D6CA: D0 CA BNE BAS_RTS03 ;Branch If Syntax Err
; ------------------------------------------------------------------------------
D6CC: 68 MAINLST PLA ;Pull/Discard Return Address, Lo then Hi
D6CD: 68 PLA ;(Will Return via JMP NEWSTT)
D6CE: A5 50 LDA LINNUM ;Check for a Second Number
D6D0: 05 51 ORA LINNUM+1 ;Any bit set? [(Low>0) OR (High>0)]<>0
D6D2: D0 06 BNE LSTNXTLIN ;YES, there is a Second Number
D6D4: A9 FF LDA #$FF ;NO Second Number; Maximize End Range
D6D6: 85 50 STA LINNUM ;Set Line Number, Low
D6D8: 85 51 STA LINNUM+1 ;Set Line Number, High
; ------------------------------------------------------------------------------
D6DA: A0 01 LSTNXTLIN LDY #1 ;Set Indirect Addressing Index to 1
D6DC: B1 9B LDA (LOWTR),Y ;High Byte of Link
D6DE: F0 44 BEQ LISTED ;End of Program
D6E0: 20 58 D8 JSR ISCTRLCH ;Check if Ctrl+C has been typed
D6E3: 20 FB DA JSR CRDO ;NO, Print a Carriage <Return> Character
D6E6: C8 INY ;Set Indirect Addressing Index to 2
D6E7: B1 9B LDA (LOWTR),Y ;Get Line Number, Low
D6E9: AA TAX ;Set X-Reg with it
D6EA: C8 INY ;Set Indirect Addressing Index to 3
D6EB: B1 9B LDA (LOWTR),Y ;Get Line Number, High
D6ED: C5 51 CMP LINNUM+1 ;Compare it to End of Range, High
D6EF: D0 04 BNE LSTD ;Range Done?
D6F1: E4 50 CPX LINNUM ;Compare X-Reg to End of Range, Low
D6F3: F0 02 BEQ LST1 ;On Last Line of Range
D6F5: B0 2D LSTD BCS LISTED ;BGE: Range Done
; ==============================================================================
; LIST ONE LINE
; ------------------------------------------------------------------------------
D6F7: 84 85 LST1 STY FORPTR ;Save Indirect Addressing Index (=3)
D6F9: 20 24 ED JSR LINPRT ;Print Line Number from (X,A)
D6FC: A9 20 LDA #' ' ;Get a SPACE Character
D6FE: A4 85 LISTLINE LDY FORPTR ;Restore Indirect Addressing Index (=3)
D700: 29 7F AND #%01111111 ;Assure character is Low ASCII
D702: 20 5C DB SNDCHR JSR OUTDO ;Print Character in A-Reg
; ;If Past Column 33, Start a New Line:
D705: A5 24 LDA CH ;Get Horizontal Cursor Position
D707: C9 21 CMP #33 ;If CH is over 32, Print a CR & Tab(5)
D709: 90 07 BCC NOCRTAB ;BLT: Else, Branch (if less than 33)
D70B: 20 FB DA JSR CRDO ;Print a Carriage <Return> Character
D70E: A9 05 LDA #5 ;Indent Cursor 5 spaces
D710: 85 24 STA CH ;Set Horizontal Cursor Position
D712: C8 NOCRTAB INY ;Advance Indirect Addressing Index
D713: B1 9B LDA (LOWTR),Y ;Get Next Char/Token in Line being listed
D715: D0 1D BNE TOKEN ;Branch if Not End of Line yet
; ----------------------------------- ;End of Line (A-Reg=0)
D717: A8 TAY ;Set Indirect Addressing Index to 0
D718: B1 9B LDA (LOWTR),Y ;Get Link to Next Line, Low
D71A: AA TAX ;Save it in X-Reg: Forward Link, Low
D71B: C8 INY ;Set Indirect Addressing Index to 1
D71C: B1 9B LDA (LOWTR),Y ;Get Link to Next Line, High
D71E: 86 9B STX LOWTR ;Set Pointer to Next Line, Low
D720: 85 9C STA LOWTR+1 ;Set Pointer to Next Line, High
D722: D0 B6 BNE LSTNXTLIN ;If Not at Last Line, List Next Line
; ;Branch if Not End of Program
; ----------------------------------- ;End of Program, Put Cursor on a New Line
D724: A9 0D LISTED LDA #RTNL ;Get a Carriage Return Character
D726: 20 5C DB JSR OUTDO ;Print Character in A-Reg
D729: 4C D2 D7 JMP NEWSTT ;Execute a New Statement
; ==============================================================================
; Get Character from Table; Pointer is (FAC)
; ------------------------------------------------------------------------------
D72C: C8 GETCHAR INY ;Advance Indirect Addressing Index
D72D: D0 02 BNE GC1 ;Skip Advancing Pointer, High
D72F: E6 9E INC FAC+1 ;Advance Table Pointer, High
D731: B1 9D GC1 LDA (FAC),Y ;Get Character from Table
D733: 60 RTS ;Return to Caller
; ==============================================================================
; Is it a Token?
; ------------------------------------------------------------------------------
; There are 107 Applesoft BASIC Tokens ranging in value from 128 to 234 ($80 to
; $EA). Hexadecimally these Token values are negative numbers with their
; highest bit set. Subtracing 127 ($7F) from those values gives them ordinal
; values from 1 to 107 ($01 to $6B). Hexadecimally these ordinal values are
; positive numbers with their highest bit clear. Token Names in the Token Name
; Table vary in length, but they are Dextral Character Inverted (DCI), meaning
; that their characters are all low ASCII except for the last character in each
; Token Name, which is high ASCII. This routine uses these facts to scan
; through the Token Name Table to find the location of a Token Name based on its
; Token value converted to its ordinal value. Also, to help with this task, it
; uses the GETCHAR subroutine just above. The FAC is used to hold the location.
; ------------------------------------------------------------------------------
D734: 10 CC TOKEN BPL SNDCHR ;If Not a Token, Send Character (Branch)
D736: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
D737: E9 7F SBC #$7F ;Convert Token value to an ordinal Index
D739: AA TAX ;Save Count-Down-Index
D73A: 84 85 STY FORPTR ;Save Line Pointer
D73C: A0 D0 LDY #<TKNMTBL ;Get Table Address, Low
D73E: 84 9D STY FAC ;Point FAC to Table, Low
D740: A0 CF LDY #>TKNMTBL-$100 ;Get Table Address, High
; ^^^^^^^^^^^^ ;Why does this display this way?
; ;It should be minus one!
D742: 84 9E STY FAC+1 ;Point FAC to Table, High
; ------------------------------------------------------------------------------
; Skip through Token Names until Count-Down-Index depletes itself, thus
; loacating the Token Name needed:
; ------------------------------------------------------------------------------
D744: A0 FF LDY #$FF ;Initialize Token Names Character Counter
D746: CA SKPTK DEX ;Count down Token Names via X-Reg
D747: F0 07 BEQ PT ;Branch when Token Name needed is reached
D749: 20 2C D7 TOKL JSR GETCHAR ;Inc(Y), Get Char from Table; Ptr is (FAC)
D74C: 10 FB BPL TOKL ;Names are Dextral Character Inverted (DCI)
D74E: 30 F6 BMI SKPTK ;Do Next Token Name; Always Taken
; ------------------------------------------------------------------------------
; Print a Space, then the Token Name:
; ------------------------------------------------------------------------------
D750: A9 20 PT LDA #' ' ;Get a Space Character
D752: 20 5C DB JSR OUTDO ;Print the Space Character
D755: 20 2C D7 TOKLP JSR GETCHAR ;Inc(Y), Get Char from Table; Ptr is (FAC)
D758: 30 05 BMI TOKDUN ;Got Last Character of Token Name
D75A: 20 5C DB JSR OUTDO ;Print Character in A-Reg
D75D: D0 F6 BNE TOKLP ;Names are Dextral Character Inverted (DCI)
D75F: 20 5C DB TOKDUN JSR OUTDO ;Print Last Character of Token Name
D762: A9 20 LDA #' ' ;Get a SPACE Character to End TN with
D764: D0 98 BNE LISTLINE ;Continue Listing the Line; Always Taken
; ==============================================================================
; "FOR" Statement: Immediate and Deferred; Parameters:
; FOR real avar = aexpr1 TO aexpr2 [STEP aexpr3];
; See also: "TO Phrase", "STEP Phrase", & "NEXT Statement"
; ==============================================================================
; FOR Pushes 18 bytes onto the STACK:
; ------------------------------------------------------------------------------
; 2 - TXTPTR
; 2 - Line Number
; 5 - Initial (Current) FOR Variable Value
; 1 - Step Sign
; 5 - Step Value
; 2 - Address of FOR Variable in VARTAB
; 1 - FOR Token ($81)
; ==============================================================================
D766: A9 80 FOR LDA #$80 ;Prepare to Set a Flag
D768: 85 14 STA SUBFLG ;Set Subscripts Not Allowed
D76A: 20 46 DA JSR LET ;Do <Var> = <Exp>, Store Addr In FORPTR
D76D: 20 65 D3 JSR GETFORPTR ;Is this FOR Variable Active?
D770: D0 05 BNE FOR2 ;NO, it is Inactive;
; ;(X)=(S) after scanning all Frames; Branch
D772: 8A TXA ;YES, Cancel It and Enclosed Loops;
; ;(X)=(S) of Frame Found
D773: 69 0F ADC #$0F ;Carry is Set, so this adds 16 [How know?]
D775: AA TAX ;X was already S+2 [How do you know this?]
D776: 9A TXS ;Reset Stack Pointer anyway
D777: 68 FOR2 PLA ;Pull/Discard Return Address, Lo then Hi
D778: 68 PLA ;(FOR will Return to Caller Indirectly!)
D779: A9 09 LDA #9 ;Assure sufficient STACK Space:
D77B: 20 D6 D3 JSR CHKMEM ;Check Stack Pointer >= $48 (72=9*2+54)
; Point to next Statement and Push Statement Address onto Stack:
D77E: 20 A3 D9 JSR DATA_END ;Get offset in Y-Reg to next ":" or EOL
D781: 18 CLC ;Prepare for Add with Carry
D782: 98 TYA ;Get offset in A-Reg to next ":" or EOL
D783: 65 B8 ADC TXTPTR ;Add Next Char/Token Pointer, Low
D785: 48 PHA ;Push Next Statement Address, Low
D786: A5 B9 LDA TXTPTR+1 ;Get Next Char/Token Pointer, High
D788: 69 00 ADC #$00 ;Add the Carry bit
D78A: 48 PHA ;Push Next Statement Address, High
D78B: A5 76 LDA CURLIN+1 ;Get Line Number, High
D78D: 48 PHA ;Push Line Number, High
D78E: A5 75 LDA CURLIN ;Get Line Number, Low
D790: 48 PHA ;Push Line Number, Low
; ==============================================================================
; TO Phrase: Required Second Part of FOR Statement; Parameters:
; FOR real avar = aexpr1 TO aexpr2 [STEP aexpr3];
; See also: "FOR Statement", "STEP Statement", &
; "NEXT Statement"
; ==============================================================================
D791: A9 C1 LDA #TOK_TO ;Get TO Token value
D793: 20 C0 DE JSR SYNCHR ;Require TO: Check Current Char & Get Next
D796: 20 6A DD JSR CHKNUM ;<Var> = <Exp> Must be Numeric
D799: 20 67 DD JSR FRMNUM ;Get Final Value, Must be Numeric
; ----------------------------------- ;Pack Sign into FAC Mantissa:
D79C: A5 A2 LDA FACSIGN ;Get FAC Unpacked Sign (msb)
D79E: 09 7F ORA #%01111111 ;Prepare to apply FAC Sign bit
D7A0: 25 9E AND FAC+1 ;Apply to FAC Mantissa, Top
D7A2: 85 9E STA FAC+1 ;Set Packed FAC Mantissa, Signed Top
; ------------------------------------------------------------------------------
; [See also (below): "Preamble about the Applesoft Floating Point Accumulators"]
; ------------------------------------------------------------------------------
; <<< BUG: Resulting TO values (above) are packed BEFORE being rounded (by PUSH-
; FAC). This can result in a positive number being converted into a negative
; one (-1). E.g., "10 FOR I=0 TO 2^35-1: PRINT I: NEXT" executes only once! >>>
; ------------------------------------------------------------------------------
; ;Prep for Return to STEP via JMP (INDEX):
D7A4: A9 AF LDA #<STEP ;Get STEP Statement Address, Low
D7A6: A0 D7 LDY #>STEP ;Get STEP Statement Address, High
D7A8: 85 5E STA INDEX ;Set for JMP (Indirect): STEP Address, Low
D7AA: 84 5F STY INDEX+1 ;Set for JMP (Indirect): STEP Address, High
D7AC: 4C 20 DE JMP PUSHFAC ;Push FAC on STACK; Returns via JMP (INDEX)
; ==============================================================================
; STEP Phrase: Optional Third Part of FOR Statement; Parameters:
; FOR real avar = aexpr1 TO aexpr2 [STEP aexpr3];
; See also: "FOR Statement", "TO Phrase", & "NEXT Statement"
; ==============================================================================
D7AF: A9 13 STEP LDA #<CON_ONE ;Get Constant One (1) Address, Low
D7B1: A0 E9 LDY #>CON_ONE ;Get Constant One (1) Address, High
; ;Put STEP Default (1) in FAC ($8100000000)
D7B3: 20 F9 EA JSR UPAY2FAC ;Unpack FP# at [(A,Y)={Low,High}] into FAC
D7B6: 20 B7 00 JSR CHRGOT ;Get last Character Got
D7B9: C9 C7 CMP #TOK_STEP ;Is STEP Specified?
D7BB: D0 06 BNE ONESTEP ;NO, Do One Step per Iteration
D7BD: 20 B1 00 JSR CHRGET ;YES, Get Step Amount Specified
D7C0: 20 67 DD JSR FRMNUM ;Evaluate & Assure it is Numeric
D7C3: 20 82 EB ONESTEP JSR SIGN ;Check its Sign:
; ;FAC Sign (Neg|0|Pos) Returns (A)=(-1|0|1)
D7C6: 20 15 DE JSR PSHFACX ;Push Step Amount; Returns via JMP (INDEX)
D7C9: A5 86 LDA FORPTR+1 ;Get [<Var> = <Exp>] Address, High
D7CB: 48 PHA ;Push FOR Variable Pointer, High
D7CC: A5 85 LDA FORPTR ;Get [<Var> = <Exp>] Address, Low
D7CE: 48 PHA ;Push FOR Variable Pointer, Low
D7CF: A9 81 LDA #TOK_FOR ;Get FOR Token
D7D1: 48 PHA ;Push FOR Token
; ==============================================================================
; Execute a New Statement: Immediate or Deferred
; ==============================================================================
; Executes the Next Statement in a BASIC Program, if any. (This does not mean
; the "NEXT" Statement in a FOR..NEXT Loop. But, the Next Statement in a BASIC
; Program, could be the "NEXT" Statement in a FOR..NEXT Loop. See also: "FOR
; Statement" & "NEXT Statement")
; ==============================================================================
D7D2: BA NEWSTT TSX ;Get Stack Pointer
D7D3: 86 F8 STX REMSTK ;Remember it: Save in Stack Pointer Safe
D7D5: 20 58 D8 JSR ISCTRLCH ;See if Control-C was typed
D7D8: A5 B8 LDA TXTPTR ;Get Next Char/Token Pointer, Low
D7DA: A4 B9 LDY TXTPTR+1 ;Get Next Char/Token Pointer, High
D7DC: A6 76 LDX CURLIN+1 ;Are we in Direct Mode?
D7DE: E8 INX ;Line Number is $FF if we're in Direct Mode
D7DF: F0 04 BEQ DIR ;YES, Do Not Save these:
D7E1: 85 79 STA OLDTEXT ;Save Next Char/Token Pointer, Low
D7E3: 84 7A STY OLDTEXT+1 ;Save Next Char/Token Pointer, High
D7E5: A0 00 DIR LDY #0 ;Clear Indirect Addressing Index
D7E7: B1 B8 LDA (TXTPTR),Y ;Is it the End of the Line?
D7E9: D0 57 BNE COLONQ ;NO, Branch to see if it is a Colon
; ;YES, EOL; Is Forward Link a 0?
D7EB: A0 02 LDY #2 ;Set Indirect Addressing Index
D7ED: B1 B8 LDA (TXTPTR),Y ;Get Forward Link, High
D7EF: 18 CLC ;Prepare for Add with Carry
D7F0: F0 34 BEQ GOEND ;YES, Forward Link is a 0, So we're Done!
; ;NO, Fwd Link is Not a 0, So Not Done!
; ;Save Line No. and Bump CHRGET's TXTPTR:
D7F2: C8 INY ;Advance Indirect Addressing Index
D7F3: B1 B8 LDA (TXTPTR),Y ;Get Line Number, Low
D7F5: 85 75 STA CURLIN ;Set Current Line Number, Low
D7F7: C8 INY ;Advance Indirect Addressing Index
D7F8: B1 B8 LDA (TXTPTR),Y ;Get Line Number, High
D7FA: 85 76 STA CURLIN+1 ;Set Current Line Number, High
D7FC: 98 TYA ;Prepare to Add (+2) with Carry Clear
D7FD: 65 B8 ADC TXTPTR ;Advance Next Char/Token Pointer, Low
D7FF: 85 B8 STA TXTPTR ;Set Next Char/Token Pointer, Low
;
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
; ==============================================================================
; ROM Space ($D800-$DFFF): ROM Socket $D8 on a real Apple II Plus.
; ==============================================================================
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
;
D801: 90 02 BCC TRACEQ ;Skip High Byte if NO Carry
D803: E6 B9 INC TXTPTR+1 ;Advance Next Char/Token Pointer, High
D805: 24 F2 TRACEQ BIT TRCFLG ;Is TRACE ON? [(bit7)=(OFF<128/ON>127)]
D807: 10 14 BPL EXECUTE ;NO, TRACE is OFF, Go Execute Statements
; ;YES, TRACE is ON; Are we in Direct Mode?
D809: A6 76 LDX CURLIN+1 ;Get Current Line Number, High
D80B: E8 INX ;Line Number is $FF if in Direct Mode
D80C: F0 0F BEQ EXECUTE ;YES, Direct Command, Go Execute Statements
; ;NO, Deferred Command, Print Tracing Info:
D80E: A9 23 LDA #'#' ;Get '#' Character in A-Reg
D810: 20 5C DB JSR OUTDO ;Print '#' Character in A-Reg
D813: A6 75 LDX CURLIN ;Get Current Line Number, Low
D815: A5 76 LDA CURLIN+1 ;Get Current Line Number, High
D817: 20 24 ED JSR LINPRT ;Print the Line Number [(X,A)={Low,High}]
D81A: 20 57 DB JSR OUTSP ;Print a Space (' ') Character
D81D: 20 B1 00 EXECUTE JSR CHRGET ;Get first Character of Statement
D820: 20 28 D8 JSR EXECSTMNT ;And, Execute Statement
D823: 4C D2 D7 JMP NEWSTT ;Then, Execute a New Statement
D826: F0 62 GOEND BEQ END4 ;Forward Link is a 0, So we're Done!
; ==============================================================================
; Execute a Statement:
; ==============================================================================
; On Entry: A-Reg contains first character of statement & Carry is Set
; At Exit: Y-Reg contains Token Ordinal Doubled & Carry is Clear
; ==============================================================================
D828: F0 2D EXECSTMNT BEQ BAS_RTS05 ;Branch if Null Statement or at End of Line
; Entry Point to continue processing: ON GOTO/GOSUB
D82A: E9 80 EXECSTMNT1 SBC #$80 ;Is First Character a Token? [($80-$EA)]
; ;NOT a Token if Borrow used: [(A)<($80)]
D82C: 90 11 BCC ASSIGNMENT ;BLT: If NOT Token, MUST BE an Assignment
; ;YES, First Char is a Token [($80-$EA)]
; ;(C=1), (A)=(Token Ordinal) [($00-$6A)]
D82E: C9 40 CMP #$40 ;Is it a Routine-Statement? [($00-$3F)]
D830: B0 14 BCS SYNERR ;BGE: NO; Do Syntax Error
; ------------------------------------------------------------------------------
; Following is a very important part of Applesoft BASIC: It is the way we get to
; the Keyword/Command subroutines (via the Token Address Table) to Execute them!
; ------------------------------------------------------------------------------
; ;(C=0), (A)=(Token Ordinal) [($00-$6A)]
D832: 0A ASL A ;YES, Double A-Reg to get Index
D833: A8 TAY ;Set Indirect Addressing Index
D834: B9 01 D0 LDA TKADTBL+1,Y ;Get Routine Address, High
D837: 48 PHA ;Push Routine Address, High [High 1st]
D838: B9 00 D0 LDA TKADTBL,Y ;Get Routine Address, Low
D83B: 48 PHA ;Push Routine Address, Low [Low 2nd]
D83C: 4C B1 00 JMP CHRGET ;Go get Next Char/Token; RTS to Routine
; ------------------------------------------------------------------------------
D83F: 4C 46 DA ASSIGNMENT JMP LET ;Handle the Assignment
; ==============================================================================
; Does A-Reg contain a Colon (Statement Separator)?
; ==============================================================================
D842: C9 3A COLONQ CMP #':' ;Is A-Reg a Colon (:)?
D844: F0 BF BEQ TRACEQ ;YES, Go see if TRACE is ON
D846: 4C C9 DE SYNERR JMP SYNERROR ;NO, Syntax Error
; ==============================================================================
; "RESTORE" Statement: Immediate and Deferred; No Parameters or Options;
; Resets the Data Pointer back to the beginning of all Data
; ==============================================================================
; [(A,Y)={Low,High}]=[*]
D849: 38 RESTORE SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
D84A: A5 67 LDA TXTTAB ;Get Start of Program, Low [*]
D84C: E9 01 SBC #1 ;[(A)=(Program Start)-1]=(Data Start), Low
D84E: A4 68 LDY TXTTAB+1 ;Get Start of Program, High [*]
D850: B0 01 BCS SETDA ;No Borrow, So Skip High Byte
D852: 88 DEY ;[(A)=(Program Start)-1]=(Data Start), High
D853: 85 7D SETDA STA DATPTR ;Set Data Pointer, Low [*]
D855: 84 7E STY DATPTR+1 ;Set Data Pointer, High [*]
D857: 60 BAS_RTS05 RTS ;Return to Caller
; ==============================================================================
; Ctrl-C KeyPress: Immediate Only; No Parameters or Options; Causes a program
; to cease execution (with an Error Message) immediately
; after the statement that is currently being executed
; ==============================================================================
D858: AD 00 C0 ISCTRLCH LDA KBD ;See if Control-C was typed
D85B: C9 83 CMP #CTRLCH ;Compare Key/Character to High ASCII Ctrl-C
D85D: F0 01 BEQ GETLOWKEY ;A Control-C was typed, Branch over RTS
D85F: 60 RTS ;Control-C was Not typed, Return to Caller
D860: 20 53 D5 GETLOWKEY JSR INCHR ;Read a Key/Character and make it Low ASCII
; <<< This is NOT A BUG! It has a purpose. It should NOT be: "BIT $C010" as
; per Bob Sander-Cederlof's "S-C DocuMentor: Applesoft" (see ** below). >>>
; ------------------------------------------------------------------------------
; Entry Point to continue processing INPUT Statement when the input is a Ctrl-C:
D863: A2 FF ISONERRON LDX #CTRLCIRQ ;Get "CTRL C INTERUPT ATTEMPTED" ONERR Code
D865: 24 D8 BIT ERRFLG ;Is ONERR GOTO Enabled?
D867: 10 03 BPL ISCTRLCL ;NO, ONERR GOTO is Disabled, Jump over JMP
D869: 4C E9 F2 JMP ERRHNDLR ;YES, Go to ONERR Handler, ONERR Code = 255
; ** Double check if Control-C was typed; This is final for both entry points!
D86C: C9 03 ISCTRLCL CMP #CTRLCL ;Compare Key/Character to Low ASCII Ctrl-C
; ------------------------------------------------------------------------------
; "ISCTRLC LDA KBD" got CTRLCH & "GETLOWKEY JSR INCHR" made it CTRLCL, so should
; pass both "STOP BCS END2" & "END2 BNE BAS_RTS06" tests below & STOP a program!
; ==============================================================================
;
;
; ==============================================================================
; "STOP" Statement: Immediate and Deferred; No Parameters or Options;
; Causes a program to cease execution (with an Error Message)
; ==============================================================================
;
D86E: B0 01 STOP BCS END2 ;If Carry Set, Don't Clear it, Skip next OP
;
; ==============================================================================
; "END" Statement: Immediate and Deferred; No Parameters or Options;
; Causes a program to cease execution (w/o an Error Message)
; ==============================================================================
;
D870: 18 END CLC ;Clear the Carry Flag to END, Not to STOP!
D871: D0 3C END2 BNE BAS_RTS06 ;Return if not Ctrl-C, STOP or END commands
D873: A5 B8 LDA TXTPTR ;Get Next Char/Token Pointer, Low
D875: A4 B9 LDY TXTPTR+1 ;Get Next Char/Token Pointer, High
D877: A6 76 LDX CURLIN+1 ;Are we in Direct Mode?
D879: E8 INX ;Line Number is $FF if we're in Direct Mode
D87A: F0 0C BEQ END3 ;YES, Skip this Line Number Stuff:
D87C: 85 79 STA OLDTEXT ;Save Next Char/Token Pointer, Low
D87E: 84 7A STY OLDTEXT+1 ;Save Next Char/Token Pointer, High
D880: A5 75 LDA CURLIN ;Get Current Line Number, Low
D882: A4 76 LDY CURLIN+1 ;Get Current Line Number, High
D884: 85 77 STA OLDLIN ;Save Current Line Number, Low
D886: 84 78 STY OLDLIN+1 ;Save Current Line Number, High
D888: 68 END3 PLA ;Pull/Discard Return Address, Low
D889: 68 PLA ;Pull/Discard Return Address, High
D88A: A9 5D END4 LDA #<QT_BREAK ;Get " BREAK" & Bell Error Message, Low
D88C: A0 D3 LDY #>QT_BREAK ;Get " BREAK" & Bell Error Message, High
D88E: 90 03 BCC GOSTART ;If Carry Clear, END Program & Restart Warm
; ;If Carry Set, STOP Program:
D890: 4C 31 D4 JMP PRERRLINO ;Print Error Message & Restart Warm
D893: 4C 3C D4 GOSTART JMP RESTART ;Do Warm Restart
; ==============================================================================
; "CONT" Statement: Immediate and Deferred; No Parameters or Options;
; Causes a program to resume execution at the next instruction
; ==============================================================================
;
D896: D0 17 CONT BNE BAS_RTS06 ;Return to Caller if ? not CONT command
D898: A2 D2 LDX #ERR_CANTCONT ;Get "?Can't Continue" Error Message Index
D89A: A4 7A LDY OLDTEXT+1 ;Get Old Char/Token Pointer, High
D89C: D0 03 BNE CANCONT ;Not at EOL/EOP: No Error, Jump over JMP
D89E: 4C 12 D4 JMP ERROR ;Go Print Error Message based on X-Reg
D8A1: A5 79 CANCONT LDA OLDTEXT ;Get Old Char/Token Pointer, Low
D8A3: 85 B8 STA TXTPTR ;Set Next Char/Token Pointer, Low
D8A5: 84 B9 STY TXTPTR+1 ;Set Next Char/Token Pointer, High
D8A7: A5 77 LDA OLDLIN ;Get Address of Last Line Executed, Low
D8A9: A4 78 LDY $78 ;Get Address of Last Line Executed, High
D8AB: 85 75 STA CURLIN ;Reset Address of Current Line, Low
D8AD: 84 76 STY CURLIN+1 ;Reset Address of Current Line, High
D8AF: 60 BAS_RTS06 RTS ;Return to Caller
; ==============================================================================
; "SAVE" Command Statement: Immediate and Deferred; No Parameters or Options;
; Writes Program onto a Cassette Tape (Audio Output)
; ==============================================================================
; ;Compute Program Length:
D8B0: 38 BAS_SAVE SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
D8B1: A5 AF LDA PRGEND ;Get End of Program Pointer, Low
D8B3: E5 67 SBC TXTTAB ;Subtract Start of Program Pointer, Low
D8B5: 85 50 STA LINNUM ;Save Length of Program, Low
D8B7: A5 B0 LDA PRGEND+1 ;Get End of Program Pointer, High
D8B9: E5 68 SBC TXTTAB+1 ;Subtract Start of Program Pointer, High
D8BB: 85 51 STA LINNUM+1 ;Save Length of Program, High
D8BD: 20 F0 D8 JSR VARTIO ;Prepare to Write 3-Byte Header
D8C0: 20 CD FE JSR MON_WRITE ;Write 3-Byte Header (Length & Lock Byte)
D8C3: 20 01 D9 JSR PROGIO ;Prepare to Write the Program
D8C6: 4C CD FE JMP MON_WRITE ;Write the Program
; ==============================================================================
; "LOAD" Command Statement: Immediate and Deferred; No Parameters or Options;
; Reads a Program from a Cassette Tape (Audio Input)
; ==============================================================================
D8C9: 20 F0 D8 BAS_LOAD JSR VARTIO ;Prepare to Read 3-Byte Header
D8CC: 20 FD FE JSR MON_READ ;Read 3-Byte Header (Length & Lock Byte)
; ;Compute Program End Address:
D8CF: 18 CLC ;Prepare for Add with Carry
D8D0: A5 67 LDA TXTTAB ;Get Start of Program Pointer, Low
D8D2: 65 50 ADC LINNUM ;Add Length of Program, Low
D8D4: 85 69 STA VARTAB ;Set Start of Variables Pointer, Low
D8D6: A5 68 LDA TXTTAB+1 ;Get Start of Program Pointer, High
D8D8: 65 51 ADC LINNUM+1 ;Add Length of Program, High
D8DA: 85 6A STA VARTAB+1 ;Set Start of Variables Pointer, High
D8DC: A5 52 LDA TEMPPT ;Get Flag: If Set, Load Program from Tape
D8DE: 85 D6 STA AUTORUN ;Save Flag: If Set, Auto-Run after Loading
D8E0: 20 01 D9 JSR PROGIO ;Prepare to Read the Program
D8E3: 20 FD FE JSR MON_READ ;Read the Program
D8E6: 24 D6 BIT AUTORUN ;If Negative, Auto-Run the Program
D8E8: 10 03 BPL BAS_LOADED ;If Positive, Do NOT Auto-Run the Program;
; ;(Wait for Next Cmd at Applesoft Prompt)
D8EA: 4C 65 D6 JMP SETPTRS ;Auto-Run is ON, Run Program Now
D8ED: 4C F2 D4 BAS_LOADED JMP FIXLINKS ;Auto-Run is OFF, Just Fix Forward Pointers
; ------------------------------------------------------------------------------
; Prepare to Read/Write a 3-Byte Header from/to a Cassette Tape (Audio I/O)
; ------------------------------------------------------------------------------
; ;Point A1/A2 at LINNUM/TEMPPT ZP-Pointers:
D8F0: A9 50 VARTIO LDA #LINNUM ;Get ZP-Address of Line Number Pointer, Low
D8F2: A0 00 LDY #$00 ;Get Address of All ZP-Objects, High
; ;Set General Purpose A1-Reg:
D8F4: 85 3C STA A1L ;Save Address of Line Number Pointer, Low
D8F6: 84 3D STY A1H ;Save Address of Line Number Pointer, High
D8F8: A9 52 LDA #TEMPPT ;Get ZP-Address of Temp Pointer, Low
; ;Set General Purpose A2-Reg:
D8FA: 85 3E STA A2L ;Save Address of Temp Pointer, Low
D8FC: 84 3F STY A2H ;Save Address of Temp Pointer, High
D8FE: 84 D6 STY AUTORUN ;Clear the Auto-Run Flag
D900: 60 RTS ;Return to Caller
; ------------------------------------------------------------------------------
; Prepare to Read/Write a Program from/to a Cassette Tape (Audio I/O)
; ------------------------------------------------------------------------------
; ;Copy SOP/EOP Pointers into A1/A2:
D901: A5 67 PROGIO LDA TXTTAB ;Get Start of Program Pointer, Low
D903: A4 68 LDY TXTTAB+1 ;Get Start of Program Pointer, High
; ;Set General Purpose A1-Reg:
D905: 85 3C STA A1L ;Save Start of Program Pointer, Low
D907: 84 3D STY A1H ;Save Start of Program Pointer, High
D909: A5 69 LDA VARTAB ;Get Start of Variables Pointer, Low
D90B: A4 6A LDY VARTAB+1 ;Get Start of Variables Pointer, High
; ;Set General Purpose A2-Reg:
D90D: 85 3E STA A2L ;Save Start of Variables Pointer, Low
D90F: 84 3F STY A2H ;Save Start of Variables Pointer, High
D911: 60 RTS ;Return to Caller
; ==============================================================================
; "RUN" Command Statement: Immediate and Deferred; Optional Parameter: [LineNum]
; ==============================================================================
; Clears all variables, pointers, and stacks, then runs the program from its
; start, or from the line number given, or returns control to the user if there
; is no program in memory.
; ==============================================================================
D912: 08 RUN PHP ;Save Processor Status while subtracting
D913: C6 76 DEC CURLIN+1 ;If in Direct Mode ($FF), make it Run Mode
D915: 28 PLP ;Restore Processor Status
D916: D0 03 BNE RUNLIN ;Branch if Given a Line Number
D918: 4C 65 D6 JMP SETPTRS ;Else, Run from Program Start
D91B: 20 6C D6 RUNLIN JSR CLEARC ;Clear Variables
D91E: 4C 35 D9 JMP GO_TO_LINE ;Run from Line Number Given
; ==============================================================================
; "GOSUB" Statement: Immediate and Deferred; Parameter: LineNum;
; Goes to a Subroutine at the line number given
; ==============================================================================
; Leaves 7 bytes on Stack:
; 2 -- Return Address (NEWSTT)
; 2 -- TXTPTR
; 2 -- Line #
; 1 -- Gosub Token ($B0)
; ==============================================================================
D921: A9 03 GOSUB LDA #$03 ;Check Stack Pointer >= $3C
D923: 20 D6 D3 JSR CHKMEM ;Assure sufficient Stack space to do GOSUB
D926: A5 B9 LDA TXTPTR+1 ;Get CHRGET's Next Char/Token Pointer, High
D928: 48 PHA ;Push Next Char/Token Pointer, High
D929: A5 B8 LDA TXTPTR ;Get CHRGET's Next Char/Token Pointer, Low
D92B: 48 PHA ;Push Next Char/Token Pointer, Low
; ;CURLIN = $FFXX if in Direct Mode
D92C: A5 76 LDA CURLIN+1 ;Get Current Line Number, High
D92E: 48 PHA ;Push Current Line Number, High
D92F: A5 75 LDA CURLIN ;Get Current Line Number, Low
D931: 48 PHA ;Push Current Line Number, Low
D932: A9 B0 LDA #TOK_GOSUB ;Get Gosub Token ($B0)
D934: 48 PHA ;Push Gosub Token
D935: 20 B7 00 GO_TO_LINE JSR CHRGOT ;Get Char/Token Got w/o advancing TXTPTR
D938: 20 3E D9 JSR GOTO ;Run Subroutine at Line Number Given
D93B: 4C D2 D7 JMP NEWSTT ;Execute a New Statement
; ==============================================================================
; "GOTO" Statement: Immediate and Deferred; Parameter: LineNum; Goes to the line
; number given; Also used by RUN & GOSUB Statements
; ==============================================================================
D93E: 20 0C DA GOTO JSR LINGET ;Get GOTO Line
D941: 20 A6 D9 JSR REM_END ;Point Y-Reg at EOL
D944: A5 76 LDA CURLIN+1 ;Get Current Line's Page Pointer
D946: C5 51 CMP LINNUM+1 ;Is Current Page < GOTO Page?
D948: B0 0B BCS GOTO_1 ;NO, Search from Program Start
D94A: 98 TYA ;YES, Search from Next Line
D94B: 38 SEC ;Prepare for Add with Carry Set (Adds 1)
D94C: 65 B8 ADC TXTPTR ;Increment Next Char/Token Pointer, Low
D94E: A6 B9 LDX TXTPTR+1 ;Set Index (Next Char/Token Pointer, High)
; ;Was a Page boundary crossed?
D950: 90 07 BCC GOTO_2 ;NO; Always Taken unless crossing boundary
; ;YES, Page boundary crossed
D952: E8 INX ;Inc Index (Next Char/Token Pointer, High)
D953: B0 04 BCS GOTO_2 ;Always Taken
D955: A5 67 GOTO_1 LDA TXTTAB ;Get Start of Program Pointer, Low
D957: A6 68 LDX TXTTAB+1 ;Get Start of Program Pointer, High
D959: 20 1E D6 GOTO_2 JSR FNDLIN2 ;Search for GOTO Line
D95C: 90 1E BCC UNDFSTERR ;If NOT There, Do Undefined Statement Error
; ;Else, Point TXTPTR at GOTO Line:
; ;Carry is Set for Subtract without Borrow
D95E: A5 9B LDA LOWTR ;Get General Purpose Pointer, Low
D960: E9 01 SBC #1 ;Subtract One, w/o Borrow [A-Data-!C]
D962: 85 B8 STA TXTPTR ;Set Next Char/Token Pointer, Low
D964: A5 9C LDA EXPSGN ;Get General Purpose Pointer, High
D966: E9 00 SBC #0 ;Subtract Zero with Borrow, if any
D968: 85 B9 STA TXTPTR+1 ;Set Next Char/Token Pointer, High
D96A: 60 BAS_RTS07 RTS ;Return to Caller (NEWSTT or GOSUB)
; ==============================================================================
; "POP" & "RETURN" Statements: Immediate and Deferred; No Parameters or Options
; (Both commands come here to this handler)
; ==============================================================================
; POP removes return address from top of stack only; RETURN removes return
; address from top of stack & uses it to go to statement following last GOSUB
; ==============================================================================
;
D96B: D0 FD POPRTN BNE BAS_RTS07 ;Return to Caller if A-Reg <> 0 upon entry
D96D: A9 FF LDA #$FF ;Prepare to Set FOR Pointer Flag
D96F: 85 85 STA FORPTR ;Set FOR Pointer Flag; <<< WRONG HALF! >>>
;
; ==============================================================================
; <<< BUG: Should be FORPTR+1 ($86); Should be $FFXX, Not $XXFF >>>
; <<< SEE "ALL ABOUT APPLESOFT", PAGES 100-101 >>>
; <<<<<<<<< You can change it in (Apple II Plus) Emulator ROM images! >>>>>>>>>>
; ==============================================================================
; POP & RETURN Statements - BUG Serendipity Analysis:
; ==============================================================================
; Cornelis Bongers would never have discovered this bug if his subroutine was
; programmed correctly; like this below: | NOT as he did it; like this below:
; +--------------------------------------+-------------------------------------+
; | 100 FOR I = 1 TO 100 | 100 FOR I = 1 TO 100 |
; | 110 IF A(I) = K THEN I = 100 | 110 IF A(I) = K THEN RETURN |
; | 120 NEXT I : I = K : REM ALWAYS SO | 120 NEXT I |
; | 130 RETURN : REM NATURE OF PROGRAM | 130 RETURN |
; +--------------------------------------+-------------------------------------+
; A FOR/NEXT loop needs to finish properly to not leave garbage behind. -- JPD
; ==============================================================================
;
D971: 20 65 D3 JSR GETFORPTR ;To cancel FOR/NEXT in Subroutine
D974: 9A TXS ;Set Stack Pointer (from X Returned)
D975: C9 B0 CMP #TOK_GOSUB ;Last GOSUB Found?
D977: F0 0B BEQ RETURN ;NO, Do Return Routine
; ----------------------------------- ;User-Callable Error Entry Point:
D979: A2 16 NOGSBERR LDX #ERR_NOGOSUB ;Throw a "?Return Without Gosub" Error
D97B: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
; ----------------------------------- ;Error Entry Point; Also User-Callable:
D97C: A2 5A UNDFSTERR LDX #ERR_UNDEFSTAT ;Throw an "?Undef'd Statement" Error
D97E: 4C 12 D4 JMP ERROR ;Go Print Error Message based on X-Reg
; ----------------------------------- ;Relay Error Entry Point; User-Callable:
D981: 4C C9 DE SYNERR2 JMP SYNERROR ;Go Throw a "?Syntax" Error
; ------------------------------------------------------------------------------
D984: 68 RETURN PLA ;Discard GOSUB Token
D985: 68 PLA ;Pull Current Line Number Pointer, Low
D986: C0 42 CPY #$42 ;(Should be #TOK_POP*2 = $142) <<< BUG? >>>
D988: F0 3B BEQ PULL3 ;Branch if POP: Pull Line Number, High; &
; ;Pull Next Char/Token Pointer, Low & High;
; ;Then, Return to Caller from POP3.
; ;Else, Not POP, Restore Ptrs from Stack:
D98A: 85 75 STA CURLIN ;Restore Current Line Number Pointer, Low
D98C: 68 PLA ;Pull Current Line Number Pointer, High
D98D: 85 76 STA CURLIN+1 ;Restore Current Line Number Pointer, High
D98F: 68 PLA ;Pull Next Char/Token Pointer, Low
D990: 85 B8 STA TXTPTR ;Restore Next Char/Token Pointer, Low
D992: 68 PLA ;Pull Next Char/Token Pointer, High
D993: 85 B9 STA TXTPTR+1 ;Restore Next Char/Token Pointer, High
; ==============================================================================
; "DATA" Statement: Skips to next COLON or EOL; Deferred Only; Parameters:
; DATA [literal|string|real|integer] [{, [literal|string|real|integer]}]
; ==============================================================================
; DATA Statements create a list of elements to be used by READ Statements
; ==============================================================================
D995: 20 A3 D9 DATA JSR DATA_END ;Get Offset to Next ":" or EOL (into Y-Reg)
; ------------------------------------------------------------------------------
; Advance Next Char/Token Pointer by Adding Offset to Next ":" or EOL to it:
; ------------------------------------------------------------------------------
D998: 98 ADDON TYA ;Get Offset to Next ":" or EOL (into A-Reg)
D999: 18 CLC ;Prepare for Add with Carry
D99A: 65 B8 ADC TXTPTR ;Add Next Char/Token Pointer, Low
D99C: 85 B8 STA TXTPTR ;Reset Next Char/Token Pointer, Low
D99E: 90 02 BCC BAS_RTS08 ;If No Carry-Over, Return to Caller
D9A0: E6 B9 INC TXTPTR+1 ;Advance Next Char/Token Pointer, High
D9A2: 60 BAS_RTS08 RTS ;Return to Caller
; ==============================================================================
; Scan ahead & Get offset in Y-Reg to next ":" or EOL
; ==============================================================================
D9A3: A2 3A DATA_END LDX #':' ;Get BASIC Inline Instruction Separator
D9A5: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
; ==============================================================================
; REM_END: Scan ahead & Get offset in Y-Reg to next EOL [Nothing else matters!]
; ==============================================================================
; Clear/Set Primary & Alternate String Terminators and Character/Offset Couter:
; ------------------------------------------------------------------------------
D9A6: A2 00 REM_END LDX #0 ;Get End of BASIC Program Line Char (EOL=0)
D9A8: 86 0D STX CHARAC ;Set CHARAC: String Terminator, Alternate
D9AA: A0 00 LDY #0 ;Clear Character (Offset) Couter
D9AC: 84 0E STY ENDCHR ;Clear ENDCHR: String Terminator, Primary
; ------------------------------------------------------------------------------
; Swap Primary & Alternate String Terminators (Swap ENDCHR with CHARAC):
; ------------------------------------------------------------------------------
; This is some kind of trick to count quote parity. How does that work?
; It only works for the DATA_END Entry Point! (See: 1,2,3 Before/Afters below.)
; ------------------------------------------------------------------------------
D9AE: A5 0E END_SWAP LDA ENDCHR ;Get String Terminator, Primary
; ;-------------------------- DATA or REM --
; ;1. Before Quote Swap = ( 0 or 0)
; ;2. After 1st. Quote Swap = (':' or 0)
; ;3. After 2nd. Quote Swap = ( 0 or 0)
; ;-----------------------------------------
D9B0: A6 0D LDX CHARAC ;Get String Terminator, Alternate
D9B2: 85 0D STA CHARAC ;Set String Terminator, Alternate
; ;-------------------------- DATA or REM --
; ;1. Before Quote Swap = (':' or 0)
; ;2. After 1st. Quote Swap = ( 0 or 0)
; ;3. After 2nd. Quote Swap = (':' or 0)
; ;-----------------------------------------
D9B4: 86 0E STX ENDCHR ;Set String Terminator, Primary
; ------------------------------------------------------------------------------
; Scan ahead & Get offset in Y-Reg to next ":" or EOL:
; ------------------------------------------------------------------------------
D9B6: B1 B8 END_SCAN LDA (TXTPTR),Y ;Get Next Character/Token
D9B8: F0 E8 BEQ BAS_RTS08 ;EOL: A-Reg=0, Y=Offset; Return to Caller
D9BA: C5 0E CMP ENDCHR ;Is it the End Character (':' or 0)?
D9BC: F0 E4 BEQ BAS_RTS08 ;EOS: A-Reg=ENDCHR, Y=Offset; Rtn to Caller
D9BE: C8 INY ;Advance Character (Offset) Couter
D9BF: C9 22 CMP #'"' ;Is A-Reg a Quote Character?
D9C1: D0 F3 BNE END_SCAN ;NO, Loop-Back (Inner Loop)
; ;YES, Switch (Quote) parity & continue:
D9C3: F0 E9 BEQ END_SWAP ; ... Loop-Back (Outer Loop); Always Taken
; ==============================================================================
; Pull Three Bytes Off of the Stack (Discards first two & Returns third):
; ==============================================================================
D9C5: 68 PULL3 PLA ;Pull & Discard this byte
D9C6: 68 PLA ;Pull & Discard this byte
D9C7: 68 PLA ;Pull & Return this byte
D9C8: 60 RTS ;Return to Caller
; ==============================================================================
; "IF" Statement: Immediate and Deferred; Parameters:
; IF expression THEN instruction [{: instruction}]
; IF expression THEN [GOTO] linenumber
; IF expression [THEN] GOTO linenumber
; ==============================================================================
; If expression evaluates to False (conditions = 0), instructions following THEN
; are ignored & program execution continues from the next numbered line; If
; expression evaluates to True (conditions <> 0), instructions following THEN
; are executed.
; ==============================================================================
D9C9: 20 7B DD IF JSR FRMEVL ;Evaluate expression & put result in FAC
D9CC: 20 B7 00 JSR CHRGOT ;Get last Character Got
D9CF: C9 AB CMP #TOK_GOTO ;Is it a "GOTO" Token?
D9D1: F0 05 BEQ QTF ;YES; Done checking token
D9D3: A9 C4 LDA #TOK_THEN ;NO; Is it a "THEN" Token?
D9D5: 20 C0 DE JSR SYNCHR ;NO; So (Maybe), Throw a "?Syntax" Error
D9D8: A5 9D QTF LDA FAC ;YES; Is the IF Condition True or False?
D9DA: D0 05 BNE IF_TRUE ;Branch if True
; ==============================================================================
; "REM" (or False IF) Statement: Immediate and Deferred; Parameters: {Char|"}
; ==============================================================================
; Allows text of any sort to be inserted into a program as a Reminder;
; Statement-Separators (":") are ignored in Reminder statements;
; Reminder statements are teminated only by a Return (CR/Null=EOL) character!
; ==============================================================================
D9DC: 20 A6 D9 REM JSR REM_END ;(IF is False, so) Skip over rest of Line!
D9DF: F0 B7 BEQ ADDON ;Always Taken
;
; ==============================================================================
; IF Statement (Continued)
; ==============================================================================
D9E1: 20 B7 00 IF_TRUE JSR CHRGOT ;Get last Character Got
; ;Is it a Command Token or a Line Number?
D9E4: B0 03 BCS JGOCMD ;Branch if Command Token
D9E6: 4C 3E D9 JMP GOTO ;Else, Go to Line Number given
D9E9: 4C 28 D8 JGOCMD JMP EXECSTMNT ;Execute Command
; ==============================================================================
; "ONGOTO" or "ONGOSUB" Statements: Deferred Only; Applesoft "CASE" Statements
; Parameters: ON aexpr GOTO linenum {[, linenum]}
; or: ON aexpr GOSUB linenum {[, linenum]}
; ==============================================================================
D9EC: 20 F8 E6 ONGOTO JSR GETBYT ;Convert (A) to Integer in (FAC+4) & (X)
D9EF: 48 PHA ;Push Integer Result (Token?) onto Stack
D9F0: C9 B0 CMP #TOK_GOSUB ;Is it a "GOSUB" token?
D9F2: F0 04 BEQ ONGOCASE ;YES, Done checking tokens
D9F4: C9 AB ONGOTOK CMP #TOK_GOTO ;NO; Is it a "GOTO" token?
D9F6: D0 89 BNE SYNERR2 ;NO; So, Throw a "?Syntax" Error
D9F8: C6 A1 ONGOCASE DEC FAC+4 ;YES; Counted to right Case Line # yet?
D9FA: D0 04 BNE ONGOFIND ;NO; Keep looking
D9FC: 68 PLA ;YES; Retrieve GOTO/GOSUB Code from Stack
D9FD: 4C 2A D8 JMP EXECSTMNT1 ;And Execute it
; ;Find correct Case Line #
DA00: 20 B1 00 ONGOFIND JSR CHRGET ;Get Next Char/Token from Program Line
DA03: 20 0C DA JSR LINGET ;Convert ASC # to HEX # in LINNUM
DA06: C9 2C CMP #',' ;Is Character a comma?
DA08: F0 EE BEQ ONGOCASE ;YES; Loop until Case found
DA0A: 68 PLA ;Not found, so ignore ON...GOTO/GOSUB
DA0B: 60 BAS_RTS09 RTS ;Return to Caller
; ==============================================================================
; Convert ASC Number to HEX Number in LINNUM:
; ==============================================================================
; Enter with: Carry Set to just reset LINNUM to $0000;
; Carry Clear to Convert ASCII Digits to BIN/HEX Number in LINNUM;
; & First Digit of ASCII Number in A-Reg & TXTPTR pointing to next
; (e.g., CHR just GOT by CHRGET).
; ==============================================================================
DA0C: A2 00 LINGET LDX #0 ;Prepare to Clear Line Number
DA0E: 86 50 STX LINNUM ;Reset Line Number, Low
DA10: 86 51 STX LINNUM+1 ;Reset Line Number, High
DA12: B0 F7 ASCHEX BCS BAS_RTS09 ;Exit Loop if Not a Digit; Return to Caller
; ;(NXTDGT JSR CHRGET below does the carry)
; ;Else; Subtract w/o Carry:
DA14: E9 2F SBC #'/' ;(#s after it) Convert Digit to Binary/Hex
DA16: 85 0D STA CHARAC ;Save Binary/Hex Digit
; ;Check Range:
DA18: A5 51 LDA LINNUM+1 ;Get Line Number, High
DA1A: 85 5E STA INDEX ;Save Line Number, High; (for Multiplying)
DA1C: C9 19 CMP #$19 ;Line # too large (>63999)?
; ;[(64,000=$FA00)/10]=[(6400=$1900)]
; ------------------------------------------------------------------------------
; Why is LINNUM already divided by 10? Because, with each iteration, we are
; reading the most significant digit of a decimal line number (characters from
; left to right); which then gets multiplied by 10 before adding the next deci-
; mal digit to its value (all the while, converting ASC/decimal to BIN/hex).
; ------------------------------------------------------------------------------
DA1E: B0 D4 BCS ONGOTOK ;BGE: YES, Indirectly throw a Syntax Error
; ==============================================================================
; I could not reproduce the problem said to exist here, so I deduced why!--JPD:
; ==============================================================================
; This branches when LINNUM+1 (Line Number, High) gets up to $19. It never goes
; past $19, so it can never reach $AB [which would cause catastrophe (below)];
; hense, this is not "<<< DANGEROUS CODE >>>" as said in the past! Except, ...
; ------------------------------------------------------------------------------
; Supposedly, if (A)=$AB on the line above, ONGOTOK will compare equal and cause
; a catastrophic jump to [some location that does not make sense was given here]
; (for GOTO), or to other locations for other calls to LINGET. You can see this
; if you first put BRK in [the location that does not make sense], then type
; GOTO 43776. Any value in the range: 43776~44031 ($AB00~$ABFF) will cause the
; problem. [Logically, this seems correct, but it doesn't happen! ON (1)
; GOSUB/GOTO 43776 works fine as long as line 43776 exists in the program.]
; ------------------------------------------------------------------------------
; ... It will happen if you accidentally type a line number (in your list of
; line numbers) that is in the Range times 10: (437760~440310)=($6AE00~$6B7F6)]
; which are illegal line numbers > 63999. [Who does that? Shakey Fingers!]
; ------------------------------------------------------------------------------
; NEW
; 5 REM ONGO.TEST
; 10 TT = 1: ON 1 GOSUB 43750 : REM BELOW RANGE
; 20 TT = 2: ON 1 GOTO 43760 : REM BELOW RANGE
; 30 TT = 3: ON 1 GOSUB 44040 : REM ABOVE RANGE
; 40 TT = 4: ON 1 GOTO 44050 : REM ABOVE RANGE
; 50 TT = 5: ON 1 GOSUB 44000 : REM INSIDE RANGE
; 60 TT = 6: ON 1 GOTO 44010 : REM INSIDE RANGE
; 63 TT = 7: ON 1 GOSUB 440600 : REM ILLEGAL LINE NO. INSIDE 10*RANGE
; 66 TT = 8: ON 1 GOTO 440700 : REM ILLEGAL LINE NO. INSIDE 10*RANGE
; 70 PRINT "PASSED ALL TESTS"
; 99 STOP
; 43750 PRINT "(";TT;") 1ST TEST ON GOSUB" : GET A$: RETURN
; 43760 PRINT "(";TT;") 1ST TEST ON GOTO" : GET A$: GOTO 30
; 44000 PRINT "(";TT;") 3RD TEST ON GOSUB" : GET A$: RETURN
; 44010 PRINT "(";TT;") 3RD TEST ON GOTO" : GET A$: GOTO 63
; 44040 PRINT "(";TT;") 2ND TEST ON GOSUB" : GET A$: RETURN
; 44050 PRINT "(";TT;") 2ND TEST ON GOTO" : GET A$: GOTO 50
; 44060 PRINT "(";TT;") 4TH TEST ON GOSUB" : GET A$: RETURN
; 44070 PRINT "(";TT;") 4TH TEST ON GOTO" : GET A$: GOTO 70
; ==============================================================================
; ;Multiply by Ten:
DA20: A5 50 LDA LINNUM ;Get Line Number, Low
DA22: 0A ASL A ;Double Temp Line Number, Low [2x]
DA23: 26 5E ROL INDEX ;Double & Add Carry to Temp Line Num, High
DA25: 0A ASL A ;Double Temp Line Number, Low [4x]
DA26: 26 5E ROL INDEX ;Double & Add Carry to Temp Line Num, High
DA28: 65 50 ADC LINNUM ;Add Result back into Real Line Number, Low
DA2A: 85 50 STA LINNUM ;Set Real Line Number, Low [4x+1x=5x]
DA2C: A5 5E LDA INDEX ;Get Temp Line Number, High [4x]
DA2E: 65 51 ADC LINNUM+1 ;Add it to Real Line Number, High
DA30: 85 51 STA LINNUM+1 ;Set Real Line Number, High [4x+1x=5x]
DA32: 06 50 ASL LINNUM ;Double Real Line Number, Low [2(5x)=10x]
DA34: 26 51 ROL LINNUM+1 ;Double & Add Carry to Real Line Num, High
DA36: A5 50 LDA LINNUM ;Get Line Number, Low
DA38: 65 0D ADC CHARAC ;Add Digit (saved above)
DA3A: 85 50 STA LINNUM ;Set Line Number, Low
DA3C: 90 02 BCC NXTDGT ;If no Carry, Skip High Byte
DA3E: E6 51 INC LINNUM+1 ;Else, Add Carry (1) to Line Number, High
; ; (INC = 3 cycles vs. ADC = 5 cycles)
DA40: 20 B1 00 NXTDGT JSR CHRGET ;Get Next Char/Token
DA43: 4C 12 DA JMP ASCHEX ;Convert Next Char/Token; (Exit if Not #)
; ==============================================================================
; "LET" Statement: Immediate & Deferred;
; Parameters: [LET] avar[subscript] = aexp; [LET] svar[subscript] = sexp
; ==============================================================================
; The Variable Name (on the left) is assigned the Value of the Number or String
; Expression (on the right); the LET is optional.
; ==============================================================================
; ;Do Var = Exp, Store Address In FORPTR:
DA46: 20 E3 DF LET JSR PTRGET ;Locate Variable: Returns Address
; ; in VARPTR & [(A,Y)={Low,High}]
DA49: 85 85 STA FORPTR ;Save Address of Variable In FORPTR, Lows
DA4B: 84 86 STY FORPTR+1 ;Save Address of Variable In FORPTR, Highs
DA4D: A9 D0 LDA #TOK_EQUAL ;Get Token for Equal Sign ("=")
DA4F: 20 C0 DE JSR SYNCHR ;If = Chr Got, Get Next; Else, Syntax Error
DA52: A5 12 LDA INTFLG ;Get Integer Flag (Negative if Integer)
DA54: 48 PHA ;Push/Save Integer Flag
DA55: A5 11 LDA VALTYP ;Get Variable Type ($00=Num, $FF=Str)
DA57: 48 PHA ;Push/Save Variable Type
DA58: 20 7B DD JSR FRMEVL ;Evaluate Expression Format; Result-->FAC
DA5B: 68 PLA ;Pull/Retrieve ValTyp ($00=Num, $FF=Str)
DA5C: 2A ROL A ;Rotate ValTyp Sign into Carry Flag
DA5D: 20 6D DD JSR CHKVAL ;Is FAC Type Numeric ($00) or String ($FF)?
DA60: D0 18 BNE LETSTR ;If Not Numeric, Do Let for Strings
DA62: 68 PLA ;Pull/Retrieve Integer Flag (Neg if Int)
; ------------------------------------------------------------------------------
; LET Integer Variable = Expression (Parameters: [LET] avar[subscript] = aexp)
; ------------------------------------------------------------------------------
DA63: 10 12 LETINT BPL LETREAL ;Branch if Var is Flagged as Real Variable
; ----------------------------------- ;Else, Assure Packed FAC Integer Format:
DA65: 20 72 EB JSR ROUND_FAC ;Round FAC up to next 32-bit Integer
DA68: 20 0C E1 JSR AYINT ;Truncate to 16-bits & Normalize Integer
; ----------------------------------- ;Store Packed FAC Integer Value in Var:
DA6B: A0 00 LDY #$00 ;Clear Indirect Addressing Index
DA6D: A5 A0 LDA FAC+3 ;Get FAC Integer Value, Low
DA6F: 91 85 STA (FORPTR),Y ;Save FAC Integer Value in Variable, Lows
DA71: C8 INY ;Advance Indirect Addressing Index
DA72: A5 A1 LDA FAC+4 ;Get FAC Integer Value, High
DA74: 91 85 STA (FORPTR),Y ;Save FAC Integer Value in Variable, Highs
; ----------------------------------- ;LET for Integers is done:
DA76: 60 RTS ;Return to Caller
; ------------------------------------------------------------------------------
; LET Real Variable = Expression (Parameters: [LET] avar[subscript] = aexp)
; ------------------------------------------------------------------------------
; ;Store Packed FAC Real/FP Value in Var:
DA77: 4C 27 EB LETREAL JMP SETFOR ;Round FAC, & store where FORPNT points
; ------------------------------------------------------------------------------
; LET String Variable = Expression (Parameters: [LET] svar[subscript] = sexp)
; ------------------------------------------------------------------------------
; Structure of a String Pointer Variable:
; Byte 0: Variable Name, Character 1 (positive)
; 1: Variable Name, Character 2 (negative)
; 2: String Length ]<
; 3: String Address, Low ]<--<< String Descriptor
; 4: String Address, High ]<
; 5: Not Used
; 6: Not Used
; ------------------------------------------------------------------------------
DA7A: 68 LETSTR PLA ;Pull/Discard Integer Flag
; ------------------------------------------------------------------------------
; Install String: ;Descriptor Adrs is in TMPVPTR (FAC+3,4)
; ;Is String Data already in Storage Area?
; ----------------------------------- ;Test String Data Address, High:
DA7B: A0 02 PUTSTR LDY #2 ;Set Indirect Addressing Index to High Byte
DA7D: B1 A0 LDA (TMPVPTR),Y ;Get String Data Address, High (FRETOP<It?)
DA7F: C5 70 CMP FRETOP+1 ;Compare to Top of Free Space, High
; ;^(AKA: Bottom or Start of String Space)
DA81: 90 17 BCC COPSTRDSC ;YES, String Data is already in Storage Area
DA83: D0 07 BNE STRDSC ;NO, String Data is NOT in Storage Area!
; ----------------------------------- ;MAYBE, Test String Data Address, Low:
DA85: 88 DEY ;Set Indirect Addressing Index to Low Byte
DA86: B1 A0 LDA (TMPVPTR),Y ;Get String Data Address, Low (FRETOP<It?)
DA88: C5 6F CMP FRETOP ;Compare to Top of Free Space, Low
; ;^(AKA: Bottom or Start of String Space)
DA8A: 90 0E BCC COPSTRDSC ;YES, String Data is already in Storage Area
; ----------------------------------- ;NO, String Data is NOT in Storage Area!
; ;(String Data may be inside the Program)
; Descriptor Exist? ;Does a String Descriptor/Variable exist?
; ----------------------------------- ;Test Descriptor Adrs, High: (VARTAB>It?)
DA8C: A4 A1 STRDSC LDY TMPVPTR+1 ;Get Descriptor Address Pointer, High
DA8E: C4 6A CPY VARTAB+1 ;Compare to Start of Variables Pointer, High
DA90: 90 08 BCC COPSTRDSC ;NO, String Descriptor/Variable NonExistant
DA92: D0 0D BNE NEWSTRDSC ;YES, String Descriptor is among Variables
; ----------------------------------- ;MAYBE, Test Descriptor Address, Low:
DA94: A5 A0 LDA TMPVPTR ;Get Descriptor Address Pointer, Low
DA96: C5 69 CMP VARTAB ;Compare to Start of Variables Pointer, Low
DA98: B0 07 BCS NEWSTRDSC ;YES, String Descriptor is among Variables
; ----------------------------------- ;NO, Str Descriptor/Variable NonExistant
; ;Either: String Data is already in Storage
; Copy Descriptor ;Or: String Descriptor is NOT a Variable
; ----------------------------------- ;So, just Store String Descriptor:
DA9A: A5 A0 COPSTRDSC LDA TMPVPTR ;Get Descriptor Address Pointer, Low
DA9C: A4 A1 LDY TMPVPTR+1 ;Get Descriptor Address Pointer, High
DA9E: 4C B7 DA JMP SAVSTRDSC ;Store String Descriptor
; ----------------------------------- ;The String Descriptor is a Variable
; ;But, String Data is not in String Area
; Make New Descriptor ;(String Data may be inside the Program)
; ----------------------------------- ;So, Make New String Descriptor:
DAA1: A0 00 NEWSTRDSC LDY #$00 ;Clear Indirect Addressing Index
DAA3: B1 A0 LDA (TMPVPTR),Y ;Get String's Length from Descriptor
DAA5: 20 D5 E3 JSR STRINI ;Init Space to receive Descriptor & String
DAA8: A5 8C LDA DSCPTR ;Get String Descriptor Pointer, Low
DAAA: A4 8D LDY DSCPTR+1 ;Get String Descriptor Pointer, High
DAAC: 85 AB STA STRNG1 ;Set MOVINS String Descriptor Pointer, Low
DAAE: 84 AC STY STRNG1+1 ;Set MOVINS String Descriptor Pointer, High
DAB0: 20 D4 E5 JSR MOVINS ;Move/Install String in Storage Area
; ----------------------------------- ;FAC = Temp Descriptor, String Length
; Store Descriptor ;FAC+1 = Temp Descriptor, String Addr, Lo
; ----------------------------------- ;FAC+2 = Temp Descriptor, String Addr, Hi
DAB3: A9 9D LDA #FAC ;Get FAC Address (Descriptor to Free), Low
DAB5: A0 00 LDY #>FAC ;Get FAC Address (Descriptor to Free), High
; --------- Save Descriptor --------- ;Temp Descriptor Adrs: [(A,Y)={Low,High}]
DAB7: 85 8C SAVSTRDSC STA DSCPTR ;Save Descriptor Address Pointer, Low
DAB9: 84 8D STY DSCPTR+1 ;Save Descriptor Address Pointer, High
DABB: 20 35 E6 JSR FRETMS ;Free Descriptor w/o Freeing up String
; --------- Move Descriptor --------- ;Copy Descriptor into String Ptr Variable:
DABE: A0 00 LDY #$00 ;Clear Indirect Addressing Index
DAC0: B1 8C LDA (DSCPTR),Y ;Get String Length from Descriptor
DAC2: 91 85 STA (FORPTR),Y ;Set Descriptor Variable, String Length
DAC4: C8 INY ;Advance Indirect Addressing Index
DAC5: B1 8C LDA (DSCPTR),Y ;Get String Address, Low, from Descriptor
DAC7: 91 85 STA (FORPTR),Y ;Set Descriptor Variable, String Addr, Low
DAC9: C8 INY ;Advance Indirect Addressing Index
DACA: B1 8C LDA (DSCPTR),Y ;Get String Address, High, from Descriptor
DACC: 91 85 STA (FORPTR),Y ;Set Descriptor Var, String Addr, High
DACE: 60 RTS ;Return to Caller
; ------------------------------------------------------------------------------
; Print String
; ------------------------------------------------------------------------------
DACF: 20 3D DB PRSTR JSR STRPRT ;Print String at TMPVPTR (FAC+3,4)
DAD2: 20 B7 00 JSR CHRGOT ;Get Next Char/Token w/o advancing TXTPTR
; ==============================================================================
; "PRINT" Statement: Immediate & Deferred; Alias: "?" <- lists as PRINT;
; Parameters: PRINT|? [{expression} [{,|; [{expression}] }] ] [,|;]
; PRINT|? <- a LF+CR is printed last unless followed by ","|";"
; PRINT|? {expression;} <- ";" concatenates next [{expression}]
; PRINT|? {;} <- followed by list of ";" is same as PRINT alone
; PRINT|? {,} <- followed by list of "," tabs 1 field per comma
; ==============================================================================
DAD5: F0 24 PRINT BEQ CRDO ;If Z=1, End of Statement: Print a <Return>
; Loop ;Continue processing Print Statement:
DAD7: F0 29 PRINT2 BEQ BAS_RTS10 ;If Z=1, End of Statement: Return to Caller
DAD9: C9 C0 CMP #TOK_TAB ;(A)=>[TAB( Token]? If so, sets C=1
DADB: F0 39 BEQ PRTABSPC ;If == then Go Print Spaces: TAB(X-Reg)
DADD: C9 C3 CMP #TOK_SPC ;(A)=>[SPC( Token]? If so, sets C=1
DADF: 18 CLC ;Countermand Comparison: Set C=0 for SPC(
DAE0: F0 34 BEQ PRTABSPC ;If == then Go Print Spaces: SPC(X-Reg)
DAE2: C9 2C CMP #',' ;(A)=>","? If so, sets C=1
DAE4: 18 CLC ;Countermand Comparison: Set C=0 for ","
; ;<<< Clear Carry is unnecessary here! >>>
DAE5: F0 1C BEQ PRCOMMA ;If == then Go TAB to Next Comma Column
DAE7: C9 3B CMP #';' ;(A)=>";"? If so, sets C=1 for ";"
DAE9: F0 44 BEQ PRNXTCHR ;If == then Go Print Next Character
DAEB: 20 7B DD JSR FRMEVL ;Evaluate Expression
DAEE: 24 11 BIT VALTYP ;Bit Variable Type ($00=Num, $FF=Str)
DAF0: 30 DD BMI PRSTR ;If String Variable Type, Go Print String
DAF2: 20 34 ED JSR FOUT ;Else, Number: Convert FAC into FOUT-Buffer
DAF5: 20 E7 E3 JSR STRLTRL ;Make FOUT-Buffer into a Literal "String"
DAF8: 4C CF DA JMP PRSTR ;Go Print the String
; ------------------------------------------------------------------------------
; Print a Carriage <Return> Character:
; ------------------------------------------------------------------------------
DAFB: A9 0D CRDO LDA #RTNL ;Get a Carriage Return (Ctrl-M) Character
DAFD: 20 5C DB JSR OUTDO ;Print Character in A-Reg
; ------------------------------------------------------------------------------
DB00: 49 FF NEGATE EOR #%11111111 ;Invert All Bits in A-Reg << Why? Because:
; ;1. It is used as a Subroutine by STRPRT
; ;2. It's a good place, it does no harm! >>
; ------------------------------------------------------------------------------
DB02: 60 BAS_RTS10 RTS ;Return to Caller
; ------------------------------------------------------------------------------
; TAB to Next Comma Column:
; ------------------------------------------------------------------------------
DB03: A5 24 PRCOMMA LDA CH ;Get Cursor's Horizontal Displacement
DB05: C9 18 CMP #24 ;(40-16)=24 to keep cursor on screen
; ------------------------------------------------------------------------------
; <<< BUG: It Should be 32; It's a BUG if the Window Width is less than 33! >>>
; <<< So, it should be based on Window Width (WNDWDTH=$21) less 16 columns. >>>
; <<<<<<<<< You can change it in (Apple II Plus) Emulator ROM images! >>>>>>>>>>
; ------------------------------------------------------------------------------
DB07: 90 05 BCC PRCMMA ;Print NxtChr at Next Tab Column, Same Line
DB09: 20 FB DA JSR CRDO ;Print a Carriage <Return> Character
DB0C: D0 21 BNE PRNXTCHR ;Print NxtChr at Start of Next Line; Always
;
; ------------------------------------------------------------------------------
; Advance Cursor to Next Comma Column:
; ------------------------------------------------------------------------------
DB0E: 69 10 PRCMMA ADC #16 ;Advance 16 Columns, Same Line
DB10: 29 F0 AND #%11110000 ;Truncate to Column 16 or 32, Same Line
; ;[%00110000=$30=48 would limit Cols more]
DB12: 85 24 STA CH ;Set Cursor's New Horizontal Displacement
DB14: 90 19 BCC PRNXTCHR ;Print NxtChr at Column 16|32; Always Taken
;
; ------------------------------------------------------------------------------
; Evaluate Formula & Format of TAB(X) or SPC(X) Function:
; ------------------------------------------------------------------------------
DB16: 08 PRTABSPC PHP ;Remember: C=0 for SPC(X) or C=1 for TAB(X)
DB17: 20 F5 E6 JSR GTBYTC ;Get NxtChr & Eval Formula into FAC & X-Reg
DB1A: C9 29 CMP #')' ;Should be last ChrGot for TAB(X) or SPC(X)
DB1C: F0 03 BEQ PRTAB ;If == Go Print: TAB(X) or SPC(X)?
DB1E: 4C C9 DE JMP SYNERROR ;Else, Throw a "?Syntax" Error
; ------------------------------------------------------------------------------
; Print: TAB(X) or SPC(X)?
; ------------------------------------------------------------------------------
DB21: 28 PRTAB PLP ;Retrieve: C=0 for SPC(X) or C=1 for TAB(X)
DB22: 90 07 BCC PRSPC ;Branch if C=0; Print SPC(X-Reg)
; ;Else, ... C=1; Print TAB(X-Reg)
; ;[X-Reg was set via JSR GTBYTC (above)]
DB24: CA DEX ;Reduce Column Counter to Prior Column
DB25: 8A TXA ;Calculate Space needed for TAB(X)
DB26: E5 24 SBC CH ;Subtract without Borrow [(A)=(X-CH-!C)]
DB28: 90 05 BCC PRNXTCHR ;If [(CH)<(A)], Already past that Column
DB2A: AA TAX ;SPC([(X)=(A)]) to the specified Column
DB2B: E8 PRSPC INX ;Advance Column Counter
DB2C: CA NXTSPC DEX ;Reduce Column Counter
DB2D: D0 06 BNE DOSPC ;Go Print a Space
; ------------------------------------------------------------------------------
; Print Next Character:
; ------------------------------------------------------------------------------
DB2F: 20 B1 00 PRNXTCHR JSR CHRGET ;Get Next Char/Token to Print
DB32: 4C D7 DA JMP PRINT2 ;Continue processing Print Statement (Loop)
; ------------------------------------------------------------------------------
; Print a Space:
; ------------------------------------------------------------------------------
DB35: 20 57 DB DOSPC JSR OUTSP ;Print a Space via COUT
DB38: D0 F2 BNE NXTSPC ;Reduce Column Counter & Print Next Space
; ;Always Taken
;
; ==============================================================================
; Print String at [(A,Y)={Low,High}]; String Must End with a Zero or a Quote:
; ==============================================================================
DB3A: 20 E7 E3 STROUT JSR STRLTRL ;Make FOUT-Buffer into a Literal "String"
; ==============================================================================
; Print String at TMPVPTR (FAC+3,4)
; ==============================================================================
DB3D: 20 00 E6 STRPRT JSR FREFAC ;Free up TMPVPTR & a Temp String to use
; ;Returns Address in INDEX & Length in (A)
DB40: AA TAX ;Set (X) = (Temp String Length); [counter]
DB41: A0 00 LDY #$00 ;Clear Indirect Addressing Index; [scanner]
DB43: E8 INX ;Advance (X) = (Temp String Length)
DB44: CA STRPRT_1 DEX ;Reduce (X) = (Temp String Length)
DB45: F0 BB BEQ BAS_RTS10 ;Return to Caller when Done: (X)=(0)
DB47: B1 5E LDA (INDEX),Y ;Get Next Character from Temp String
DB49: 20 5C DB JSR OUTDO ;Print the Character
DB4C: C8 INY ;Advance Indirect Addressing Index
DB4D: C9 0D CMP #RTNL ;Was it a Carriage Return Character?
DB4F: D0 F3 BNE STRPRT_1 ;NO; (Loop) Do Next Character
DB51: 20 00 DB JSR NEGATE ;Invert Bits [EOR #$FF would do it, too!]
DB54: 4C 44 DB JMP STRPRT_1 ;(Loop) Do Next Character
; ==============================================================================
; Print a Space Character:
; ==============================================================================
DB57: A9 20 OUTSP LDA #' ' ;Print a Space via COUT
DB59: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
; ==============================================================================
; Print a Question Mark Character:
; ==============================================================================
DB5A: A9 3F OUTQUES LDA #'?' ;Print a Question Mark via COUT
;
; ==============================================================================
; Print Character in A-Reg
; ==============================================================================
; Note: POKE 243,32 [$20 in $F3 (FLASHBIT)] will convert output to lower case.
; This can be cancelled by: POKE 243,0 ($00), NORMAL ($00), INVERSE ($00);
; or FLASH ($40), POKE 243,64.
; ==============================================================================
DB5C: 09 80 OUTDO ORA #%10000000 ;Set High Bit; Make Character High ASCII
DB5E: C9 A0 CMP #' ' | $80 ;Is it a Control or Visible Character?
DB60: 90 02 BCC OUTDOCTRL ;BLT: Branch if it is a Control Character
DB62: 05 F3 ORA FLASHBIT ;Show (Flash=$40, Lowercase=$20, Else=$00)
DB64: 20 ED FD OUTDOCTRL JSR COUT ;Print A-Reg (via Output Device)
DB67: 29 7F AND #%01111111 ;Clear High Bit; Make Character Low ASCII
DB69: 48 PHA ;Push/Save/Protect Character, temporarily
DB6A: A5 F1 LDA SPDBYT ;Get Output Speed Limit
DB6C: 20 A8 FC JSR MON_WAIT ;Limit Output Speed
DB6F: 68 PLA ;Pull/Retieve Saved/Protected Character
DB70: 60 RTS ;Return to Caller
; ==============================================================================
; Input Conversion Error: Illegal character in numeric field
; ==============================================================================
; ;Must resolve INPUT, READ, & GET
DB71: A5 15 INPUTERR LDA INPUTFLG ;Get Type ($00=INPUT, $40=GET, $98=READ)
DB73: F0 12 BEQ RESPERR ;Taken if INPUT
DB75: 30 04 BMI READERR ;Taken if READ
DB77: A0 FF LDY #$FF ;Else, from a GET
DB79: D0 04 BNE ERRLINE ;Always Taken
; ------------------------------------------------------------------------------
; ;Tell where DATA is, rather than READ:
DB7B: A5 7B READERR LDA DATLIN ;Get Now DATA Statement Line Number, Low
DB7D: A4 7C LDY DATLIN+1 ;Get Now DATA Statement Line Number, High
; ------------------------------------------------------------------------------
DB7F: 85 75 ERRLINE STA CURLIN ;Set Current Applesoft Line Number, Low
DB81: 84 76 STY CURLIN+1 ;Set Current Applesoft Line Number, High
DB83: 4C C9 DE JMP SYNERROR ;Go Throw a "?Syntax" Error
; ==============================================================================
; Input Error:
; ==============================================================================
DB86: 68 INPERR PLA ;Pull/Retrieve Last Character Got
; ------------------------------------------------------------------------------
DB87: 24 D8 RESPERR BIT ERRFLG ;Is ON ERR turned on?
DB89: 10 05 BPL DOREENTRY ;NO, Give Reentry a try
; ----------------------------------- ;User-Callable Error Entry Point:
DB8B: A2 FE BADRESPERR LDX #ERR_BADRESP ;Get 'Bad Response to Input' Error Code
DB8D: 4C E9 F2 JMP ERRHNDLR ;Go to Error Handler (Part 2)
; ------------------------------------------------------------------------------
DB90: A9 EF DOREENTRY LDA #<ERR_REENTRY ;Get REENTER INPUT Error Message Addr, Low
DB92: A0 DC LDY #>ERR_REENTRY ;Get REENTER INPUT Error Message Addr, High
DB94: 20 3A DB JSR STROUT ;Print String at [(A,Y)={Low,High}]
DB97: A5 79 LDA OLDTEXT ;Get Applesoft Old Text Pointer, Low
DB99: A4 7A LDY OLDTEXT+1 ;Get Applesoft Old Text Pointer, High
DB9B: 85 B8 STA TXTPTR ;Set CHRGET's Next Char/Token Pointer, Low
DB9D: 84 B9 STY TXTPTR+1 ;Set CHRGET's Next Char/Token Pointer, High
DB9F: 60 RTS ;Return to Caller
; ==============================================================================
; "GET" Statement: Deferred Only; Parameter: GET var (one Applesoft variable)
; ==============================================================================
; Fetches one character from the keyboard w/o showing it on the screen & w/o
; requiring that the RETURN key be pressed. (Best if var is a string variable.)
; ==============================================================================
;
DBA0: 20 06 E3 GET JSR ERRDIR ;Illegal if in Direct Mode
; ;Simulate Input [(X,Y)={Low,High}]:
DBA3: A2 01 LDX #<INBUFF+1 ;Get Input String Address, Low
DBA5: A0 02 LDY #>INBUFF ;Get Input String Address, High
DBA7: A9 00 LDA #$00 ;Get Zero (End of Line Marker); Prepare to:
DBA9: 8D 01 02 STA INBUFF+1 ;Reset Input Buffer w/ EOL Marker at start
DBAC: A9 40 LDA #$40 ;Setup for GET; (Not for INPUT nor READ)
DBAE: 20 EB DB JSR PRCSINLST ;Then, Process Input List
; ;<<< Could save a byte here with JMP >>>
DBB1: 60 RTS ;Return to Caller
; ==============================================================================
; "INPUT" Statement: Deferred Only; Parameters: INPUT [string ;] var [{, var}];
; Reads a line of input from the current input device.
; ==============================================================================
DBB2: C9 22 INPUT CMP #'"' ;Check for Optional Prompt String
DBB4: D0 0E BNE QOUT ;Taken if No Prompt String Found
DBB6: 20 81 DE JSR STRTEXT ;Make Prompt String Printable
DBB9: A9 3B LDA #';' ;Must have a Semicolon (';') NOW!
DBBB: 20 C0 DE JSR SYNCHR ;Else: Throw a "?Syntax" Error
DBBE: 20 3D DB JSR STRPRT ;Print the Prompt String
DBC1: 4C C7 DB JMP DIRINERR ;Skip over next line
DBC4: 20 5A DB QOUT JSR OUTQUES ;Print Question Mark ("?") Prompt Character
DBC7: 20 06 E3 DIRINERR JSR ERRDIR ;Illegal if in Direct Mode
DBCA: A9 2C LDA #',' ;Get a Comma to:
DBCC: 8D FF 01 STA INBUFF-1 ;Prime the Input Buffer
DBCF: 20 2C D5 JSR INLIN ;Read a Line & make Characters Low ASCII
DBD2: AD 00 02 LDA INBUFF ;Get first input character again to check:
DBD5: C9 03 CMP #CTRLCL ;Compare Key/Character to Low ASCII Ctrl-C
DBD7: D0 10 BNE INFLAG0 ;Setup for INPUT; Then, Process Input List
DBD9: 4C 63 D8 JMP ISONERRON ;Go to "Is ONERR GOTO Enabled?"
; ==============================================================================
; This subroutine is only used once by the Process Input List subroutine:
; ==============================================================================
DBDC: 20 5A DB NEXTIN JSR OUTQUES ;Print Question Mark ("?") Prompt Character
DBDF: 4C 2C D5 JMP INLIN ;Go Read a Line & make Characters Low ASCII
; ==============================================================================
; "READ" Statement: Immediate & Deferred; Parameters: READ var [{,var}];
; Reads values from DATA statements in the body of the program
; ==============================================================================
; ;[(X,Y)={Low,High}]
DBE2: A6 7D BAS_READ LDX DATPTR ;Get Next DATA Statement Address, Low
DBE4: A4 7E LDY DATPTR+1 ;Get Next DATA Statement Address, High
DBE6: A9 98 LDA #$98 ;Setup for READ; Then, Process Input List:
DBE8: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line (2 bytes)
; ==============================================================================
; Process Input List (for INPUT only; Not for GET nor READ):
; ==============================================================================
;
DBE9: A9 00 INFLAG0 LDA #$00 ;Get a Zero; for INPUT Processing only
;
; ==============================================================================
; Process Input List (for INPUT, GET, or READ):
; ==============================================================================
; Upon Entry: (A) = Input Type = [INPUT=($00), GET=($40), READ=($98)]
; [(X,Y)={Low,High}] = Input String Address
; ==============================================================================
;
DBEB: 85 15 PRCSINLST STA INPUTFLG ;Set Input Type Flag
DBED: 86 7F STX INPTR ;Set Input Pointer, Low
DBEF: 84 80 STY INPTR+1 ;Set Input Pointer, High
;
; ==============================================================================
; Process Input Item:
; ==============================================================================
;
DBF1: 20 E3 DF PRCSINITM JSR PTRGET ;Locate Variable: Returns Address in
; ; VARPTR & [(A,Y)={Low,High}]
DBF4: 85 85 STA FORPTR ;Set General Purpose Pointer, Low
DBF6: 84 86 STY FORPTR+1 ;Set General Purpose Pointer, High
; ----------------------------------- ;Save CHRGET's TXTPTR:
DBF8: A5 B8 LDA TXTPTR ;Get Next Char/Token Pointer, Low
DBFA: A4 B9 LDY TXTPTR+1 ;Get Next Char/Token Pointer, High
DBFC: 85 87 STA TXPSV ;Set TXTPTR Safe, Low
DBFE: 84 88 STY TXPSV+1 ;Set TXTPTR Safe, High
; ----------------------------------- ;Point CHRGET/TXTPTR at Input Device:
DC00: A6 7F LDX INPTR ;Get Input Pointer, Low
DC02: A4 80 LDY INPTR+1 ;Get Input Pointer, High
DC04: 86 B8 STX TXTPTR ;Set Next Char/Token Pointer, Low
DC06: 84 B9 STY TXTPTR+1 ;Set Next Char/Token Pointer, High
; ----------------------------------- ;Check the Type of Input:
DC08: 20 B7 00 JSR CHRGOT ;Get Last Char/Token w/o advancing TXTPTR
DC0B: D0 1E BNE INSTART ;Char is NOT an End of Line or a Colon
DC0D: 24 15 BIT INPUTFLG ;Get Type ($00=INPUT, $40=GET, $98=READ)
DC0F: 50 0E BVC PRCNOTGET ;Branch if NOT a GET [($40)=(%01000000)]
; ----------------------------------- ;GET:
DC11: 20 0C FD JSR RDKEY ;Get in (A) & Make Cursor Character Flash
DC14: 29 7F AND #%01111111 ;Assure Character is Low ASCII
DC16: 8D 00 02 STA INBUFF ;Put Character at Start of Input Buffer
DC19: A2 FF LDX #<INBUFF-1 ;Get (Input Buffer, Low)-1 Address
DC1B: A0 01 LDY #>INBUFF-$100 ;Get (Input Buffer, High)-1 Address
; ^^^^^^^^^^^ ;Why does this display this way?
; ;It should be minus one!
DC1D: D0 08 BNE PRCTXTPTR ;Always Taken
; ----------------------------------- ;Check the Type of Input (continued):
DC1F: 30 7F PRCNOTGET BMI FINDATA ;Branch if doing a READ
DC21: 20 5A DB JSR OUTQUES ;Else, doinig INPUT: Print "?" Prompt Char
DC24: 20 DC DB JSR NEXTIN ;Print another "?" & Finish Input Line
; ;[(X,Y)={Low,High}] Ptr = (Input-Buffer)-1
; ----------------------------------- ;Point CHRGET/TXTPTR at [(X,Y)={Lo,Hi}]:
DC27: 86 B8 PRCTXTPTR STX TXTPTR ;Set Next Char/Token Pointer, Low
DC29: 84 B9 STY TXTPTR+1 ;Set Next Char/Token Pointer, High
; ----------------------------------- ;Input Start
DC2B: 20 B1 00 INSTART JSR CHRGET ;Get Next Input Char/Token
DC2E: 24 11 BIT VALTYP ;Bit Variable Type ($00=Num, $FF=Str)
DC30: 10 31 BPL NUMIN ;Branch if Numeric
DC32: 24 15 BIT INPUTFLG ;Get Type ($00=INPUT, $40=GET, $98=READ)
DC34: 50 09 BVC PUTCHR ;Branch if NOT a GET [($40)=(%01000000)]
; ----------------------------------- ;GET:
DC36: E8 INX ;Advance Input Character Counter
DC37: 86 B8 STX TXTPTR ;Set Next Char/Token Pointer, Low
DC39: A9 00 LDA #0 ;Get a Zero; No other Terminators
DC3B: 85 0D STA CHARAC ;Set Alternate String Terminator
DC3D: F0 0C BEQ PPENDCHR ;Always Taken
; ----------------------------------- ;Set Terminatrs: Zero, Quote, Colon, Comma
DC3F: 85 0D PUTCHR STA CHARAC ;Set Alternate String Terminator
DC41: C9 22 CMP #'"' ;Terminate on Zero or Quote
DC43: F0 07 BEQ PUTENDCHR ;Branch if (A) = (Quote Character)
DC45: A9 3A LDA #':' ;Terminate on Zero or Colon
DC47: 85 0D STA CHARAC ;Set Alternate String Terminator
DC49: A9 2C LDA #',' ;Terminate on Zero or Comma
DC4B: 18 PPENDCHR CLC ;Prepare for Add with Carry
DC4C: 85 0E PUTENDCHR STA ENDCHR ;Set Primary String Terminator
; ;Skip over Quotation Mark, If there was 1:
DC4E: A5 B8 LDA TXTPTR ;Get Next Char/Token Pointer, Low
DC50: A4 B9 LDY TXTPTR+1 ;Get Next Char/Token Pointer, High
DC52: 69 00 ADC #0 ;Add in the Quote-Carry, If there was one
DC54: 90 01 BCC SKIPHIGH ;If no Carry now, Skip Uping High Address
DC56: C8 INY ;Advance Input Address, High
DC57: 20 ED E3 SKIPHIGH JSR STRLTRL2 ;Make Input into a Literal "String"
DC5A: 20 3D E7 JSR POINT ;Point TXTPTR at String
DC5D: 20 7B DA JSR PUTSTR ;Install the String/Variable
DC60: 4C 72 DC JMP INMORE ;Skip over Number/Data Input lines
; ----------------------------------- ;Numeric Input?
DC63: 48 NUMIN PHA ;Push/Save Last Character Got
DC64: AD 00 02 LDA INBUFF ;Anything in Input Buffer?
DC67: F0 30 BEQ INPFIN ;NO; See if READ or INPUT
; ----------------------------------- ;READ/DATA Input
DC69: 68 DATIN PLA ;Pull/Retrieve Last Character Got
DC6A: 20 4A EC JSR FIN ;Get FP Number at TXTPTR
DC6D: A5 12 LDA INTFLG ;Negative for Integer Variable (%)
DC6F: 20 63 DA JSR LETINT ;Store Result in Variable
; ----------------------------------- ;Input More?
DC72: 20 B7 00 INMORE JSR CHRGOT ;Get Last Character Got
DC75: F0 07 BEQ SWAPPTRS ;Branch if End of Line or Colon
DC77: C9 2C CMP #',' ;Comma in Input?
DC79: F0 03 BEQ SWAPPTRS ;YES; Go Swap Pointers
DC7B: 4C 71 DB JMP INPUTERR ;NO; Nothing else will do
; ----------------------------------- ;Swap Pointers:
; ----------------------------------- ;Save Position in Input Buffer
DC7E: A5 B8 SWAPPTRS LDA TXTPTR ;Get Next Char/Token Pointer, Low
DC80: A4 B9 LDY TXTPTR+1 ;Get Next Char/Token Pointer, High
DC82: 85 7F STA INPTR ;Set Input Pointer, Low
DC84: 84 80 STY INPTR+1 ;Set Input Pointer, High
; ----------------------------------- ;Restore Program Pointer
DC86: A5 87 LDA TXPSV ;Retrieve old TXTPTR from Safe, Low
DC88: A4 88 LDY TXPSV+1 ;Retrieve old TXTPTR from Safe, High
DC8A: 85 B8 STA TXTPTR ;Set Next Char/Token Pointer, Low
DC8C: 84 B9 STY TXTPTR+1 ;Set Next Char/Token Pointer, High
; ----------------------------------- ;Get Character Last Got from Program:
DC8E: 20 B7 00 JSR CHRGOT ;Get Last Character Got (from new old ptr)
DC91: F0 33 BEQ INPDONE ;Branch if End of Statement
DC93: 20 BE DE JSR CHKCOM ;Else: See if it is a Comma
DC96: 4C F1 DB JMP PRCSINITM ;Loop-Back to Process Next Input Item
; ----------------------------------- ;READ/DATA Input?
DC99: A5 15 INPFIN LDA INPUTFLG ;Get Type ($00=INPUT, $40=GET, $98=READ)
DC9B: D0 CC BNE DATIN ;YES: Go right back up, to READ/DATA Input
DC9D: 4C 86 DB JMP INPERR ;NO: Process Input Error; ReEntry Possible?
; ----------------------------------- ;Doing a READ; Find the Data:
DCA0: 20 A3 D9 FINDATA JSR DATA_END ;Get offset in Y-Reg to next ":" or EOL
DCA3: C8 INY ;Advance to Start of Next Statement or Line
DCA4: AA TAX ;Is it an EOL or a Colon?
DCA5: D0 12 BNE NXTSTT ;Branch if it is a Colon
DCA7: A2 2A LDX #ERR_NODATA ;Else, EOL: Might be Out Of Data
DCA9: C8 INY ;Advance Indirect Addressing Index to:
DCAA: B1 B8 LDA (TXTPTR),Y ;Get High-Byte of Forward Link/Pointer
DCAC: F0 5F BEQ GERR ;Branch if at End of the Program
; ;^(Print Error Message based on X-Reg)
; ----------------------------------- ;Else, We are Out of Data; Point to first
; ;Text Character in Next Statement or Line:
DCAE: C8 INY ;Advance Indirect Addressing Index
DCAF: B1 B8 LDA (TXTPTR),Y ;Get the Line Number, Low
DCB1: 85 7B STA DATLIN ;Set Current DATA Statement Line #, Low
DCB3: C8 INY ;Advance Indirect Addressing Index
DCB4: B1 B8 LDA (TXTPTR),Y ;Get the Line Number, High
DCB6: C8 INY ;Advance Indirect Addressing Index
DCB7: 85 7C STA DATLIN+1 ;Set Current DATA Statement Line #, High
; ----------------------------------- ;Do Next Statement or Line:
DCB9: B1 B8 NXTSTT LDA (TXTPTR),Y ;Get first Token of Statement
DCBB: AA TAX ;Save Token in X-Reg
DCBC: 20 98 D9 JSR ADDON ;Add Y-Reg to TXTPTR
DCBF: E0 83 CPX #TOK_DATA ;Did we find a DATA Statement?
DCC1: D0 DD BNE FINDATA ;NOT yet! (Branch if doing a READ)
DCC3: 4C 2B DC JMP INSTART ;YES: GO Read it, too!
; ----------------------------------- ;No more INPUT requested
DCC6: A5 7F INPDONE LDA INPTR ;Get Input Pointer, Low
DCC8: A4 80 LDY INPTR+1 ;Get Input Pointer, High
DCCA: A6 15 LDX INPUTFLG ;Get Type ($00=INPUT, $40=GET, $98=READ)
DCCC: 10 03 BPL INDNSKIP ;Done if INPUT (or GET); Skip over JMP:
DCCE: 4C 53 D8 JMP SETDA ;Set Data Pointer to [(A,Y)={Low,High}]
; ----------------------------------- ;INPUT: Any more Characters in Line?
DCD1: A0 00 INDNSKIP LDY #0 ;Clear Indirect Addressing Index
DCD3: B1 7F LDA (INPTR),Y ;Get Next Input Charcter in Line
DCD5: F0 07 BEQ BAS_RTS11 ;NO, All is Well (Branch if at End of Line)
; ;YES; Throw Extra Ignored Input Error:
DCD7: A9 DF LDA #<ERR_EXTRA ;Get Error Message Address, Low
DCD9: A0 DC LDY #>ERR_EXTRA ;Get Error Message Address, High
DCDB: 4C 3A DB JMP STROUT ;Print Z-String at [(A,Y)={Low,High}]
DCDE: 60 BAS_RTS11 RTS ;Return to Caller
DCDF: 3F 45 58 54+ ERR_EXTRA .ZSTR "?EXTRA IGNORED",$0D ;GET/INPUT Error
DCEF: 3F 52 45 45+ ERR_REENTRY .ZSTR "?REENTER",$0D ;INPUT Error
; ==============================================================================
; "NEXT" Statement: Immediate and Deferred; Parameters: NEXT [avar [{,avar}]];
; Required Fourth Part of FOR/TO/STEP/NEXT Loop Statements;
; See also: "FOR Statement", "TO Phrase", & "STEP Phrase"
; ==============================================================================
DCF9: D0 04 NEXT BNE VARNXT ;Branch if Variable after NEXT is specified
DCFB: A0 00 LDY #0 ;Flag "None" by setting FORPNT+1 = 0
DCFD: F0 03 BEQ SKPV ;Always Taken
DCFF: 20 E3 DF VARNXT JSR PTRGET ;Locate Variable: Returns Address
; ; in VARPTR & [(A,Y)={Low,High}]
DD02: 85 85 SKPV STA FORPTR ;Save Pointer to FOR Variable, Low
DD04: 84 86 STY FORPTR+1 ;Save Pointer to FOR Variable, High
DD06: 20 65 D3 JSR GETFORPTR ;Find Variable's FOR-Frame on the STACK
DD09: F0 04 BEQ GOTFOR ;Branch if FOR-Frame Found
; ----------------------------------- ;User-Callable Error Entry Point:
DD0B: A2 00 NOFORERR LDX #ERR_NOFOR ;Else: Throw a "?Next Without For" Error
DD0D: F0 69 GERR BEQ JERROR ;Always Taken: Print Error based on X-Reg
; ----------------------------------- ;X-Reg is our Stack Pointer Index Safe:
DD0F: 9A GOTFOR TXS ;Set STACK Pointer to Variable's FOR-Frame
; ; (This trims off any inner loops)
DD10: E8 INX ;+ Add 4 to get STEP Value STACK Address
DD11: E8 INX ;+
DD12: E8 INX ;+
DD13: E8 INX ;+
DD14: 8A TXA ;Get STEP Value STACK Address, Low
DD15: E8 INX ;+ Add 6 to get FOR Value STACK Address
DD16: E8 INX ;+
DD17: E8 INX ;+
DD18: E8 INX ;+
DD19: E8 INX ;+
DD1A: E8 INX ;+
DD1B: 86 60 STX DSTPTR ;Save FOR Value STACK Address, Low
; ;(for Comparison to FAC via FCOMP2, below)
; ----------------------------------- ;Load FAC from [(A,Y)={Low,High}]
; ; = STEP Value STACK Address:
DD1D: A0 01 LDY #>STACK ;Get STACK Page Address (=1)
DD1F: 20 F9 EA JSR UPAY2FAC ;Unpack STEP Value [(A,Y)={LO,HI}] into FAC
; ----------------------------------- ;Calculate New/Current FOR Value:
DD22: BA TSX ;Retrieve FOR Value STACK Address, Low
DD23: BD 09 01 LDA STACK+9,X ;Get STEP Sign [(-1,0,1)=(Direction)]
DD26: 85 A2 STA FACSIGN ;Save STEP Sign [(-1,0,1) for (-,0,+)]
DD28: A5 85 LDA FORPTR ;Retrieve Pointer to FOR Variable, Low
DD2A: A4 86 LDY FORPTR+1 ;Retrieve Pointer to FOR Variable, High
DD2C: 20 BE E7 JSR FADD ;Add STEP (+/- Amout) to FOR Value
DD2F: 20 27 EB JSR SETFOR ;Put back New/Current FOR Value
; ----------------------------------- ;Q: Is New FOR Value at/beyond End/TO Val?
DD32: A0 01 LDY #>STACK ;Get STACK Page Address (=1)
; ;[(A,Y)={Low,High}]=FOR Value STACK Adrs
DD34: 20 B4 EB JSR FCOMP2 ;Q: Compare FAC with Packed Number at (A,Y)
; ;Rtns: (A)=(1|0|-1)<--(A,Y)=[(<|=|>) FAC]
DD37: BA TSX ;Retrieve FOR Value STACK Address, Low
DD38: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
DD39: FD 09 01 SBC STACK+9,X ;Subtract STEP Sign [(-1,0,1)=(Direction)]
DD3C: F0 17 BEQ ENDFOR ;Branch if FOR/NEXT Loop is Done
; ----------------------------------- ;Else, Setup FOR Line Number:
DD3E: BD 0F 01 LDA STACK+15,X ;Get FOR Statement's Line Number, Low
DD41: 85 75 STA CURLIN ;Set Current Applesoft Line Number, Low
DD43: BD 10 01 LDA STACK+16,X ;Get FOR Statement's Line Number, High
DD46: 85 76 STA CURLIN+1 ;Set Current Applesoft Line Number, High
; ----------------------------------- ;Set TXTPTR to just after FOR Statement:
DD48: BD 12 01 LDA STACK+18,X ;Get STACK Address of Statement after, Low
DD4B: 85 B8 STA TXTPTR ;Set CHRGET's Next Char/Token Pointer, Low
DD4D: BD 11 01 LDA STACK+17,X ;Get STACK Address of Statement after, High
DD50: 85 B9 STA TXTPTR+1 ;Set CHRGET's Next Char/Token Pointer, High
; ----------------------------------- ;Go Do New/Next Statement:
DD52: 4C D2 D7 GONEWST JMP NEWSTT ;Execute a New Statement (This is the EXIT)
; ----------------------------------- ;Loop is Done: Pull FOR-Frame from STACK:
DD55: 8A ENDFOR TXA ;Get Stack Pointer Index from Safe
DD56: 69 11 ADC #17 ;Carry is Set, so Adds 18 to Stack Pointer
DD58: AA TAX ;Set Stack Pointer Index Safe
DD59: 9A TXS ;Set Stack Pointer from Index Safe
DD5A: 20 B7 00 JSR CHRGOT ;Get Last Character GOT w/o Uping TXTPTR
DD5D: C9 2C CMP #',' ;Was Char after Last NEXT Variable a Comma?
DD5F: D0 F1 BNE GONEWST ;NO: Go Execute a New Statement
DD61: 20 B1 00 JSR CHRGET ;YES: Prime for Next FOR Variable to do:
DD64: 20 FF DC JSR VARNXT ;Do Next (Outer Loop) FOR Variable
; ----------------------------------- ;(Does Not Return!)
;
;
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
; ==============================================================================
; Applesoft - Part B, $DD67-$E79F:
; Formula Evaluation, Pointer Locating, & String Handling
; ==============================================================================
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
;
;
; YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY
; ==============================================================================
; To see: "How Applesoft BASIC Program Varables* Are Structured"
; *(Reals {Floating Point}, Integers, Strings, Functions, and Arrays),
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", pages 21 to 24
; ==============================================================================
; YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY
;
;
; ==============================================================================
; Evaluate & Assure Expression is Numeric
; ==============================================================================
;
DD67: 20 7B DD FRMNUM JSR FRMEVL ;Is it a Number? If so, put it in the FAC
;
; ==============================================================================
; Assure (FAC) Type is Numeric (VALTYP=$00)
; ==============================================================================
;
DD6A: 18 CHKNUM CLC ;Assume (FAC) Type is Numeric (VALTYP=$00)
DD6B: 24 DFB BIT_ZP ;Fake BIT OpCode to skip next line
; ==============================================================================
; Assure (FAC) Type is String (VALTYP=$FF)
; ==============================================================================
;
DD6C: 38 CHKSTR SEC ;Assume (FAC) Type is String (VALTYP=$FF)
;
; ==============================================================================
; Determine (FAC) Type: Numeric (VALTYP=$00) or String (VALTYP=$FF)?
; Returns: Numeric (Carry)=(0) or String (Carry)=(1)
; ==============================================================================
;
DD6D: 24 11 CHKVAL BIT VALTYP ;Is (FAC) Type Numeric or String?
DD6F: 30 03 BMI NOTNUMSTR ;If VALTYP<0, Type is NOT Numeric
DD71: B0 03 BCS MISMATCH ;If C=1, Type is String, NOT Numeric
DD73: 60 BAS_RTS12 RTS ;If C=0, Type is Numeric; Return to Caller
DD74: B0 FD NOTNUMSTR BCS BAS_RTS12 ;If C=1, Type is String; Return to Caller
; ----------------------------------- ;Error Entry Point; Also User-Callable:
DD76: A2 A3 MISMATCH LDX #ERR_BADTYPE ;Else, Throw a "?Type Mismatch" Error:
DD78: 4C 12 D4 JERROR JMP ERROR ;Go Print Error Message based on X-Reg
; ==============================================================================
; Expression Format Evaluator
; ==============================================================================
; Evaluate the Expression at TXTPTR; Leave the Result in the FAC
; (This subroutine works for both String & Numeric Expressions)
; ==============================================================================
;
; Main Formula Evaluation Routine: On entry TXTPTR points to 1st chr of Formula:
DD7B: A6 B8 FRMEVL LDX TXTPTR ;Get Next Char/Token Pointer, Low
DD7D: D0 02 BNE FESKPHI ;If Not Zero ($00), Skip High Byte:
DD7F: C6 B9 DEC TXTPTR+1 ;Reduce Next Char/Token Pointer, High
DD81: C6 B8 FESKPHI DEC TXTPTR ;Reduce Next Char/Token Pointer, Low
DD83: A2 00 LDX #$00 ;Clear Initial Preference Index
DD85: 24 DFB BIT_ZP ;Fake BIT OpCode to skip next line
; ------------------------------------------------------------------------------
; Prepare to Check for Relational Operators (<,=,>)
; ------------------------------------------------------------------------------
DD86: 48 FRMEVL1 PHA ;Push Last Comparison Type (CMPTYP)
DD87: 8A TXA ;Get Last Preference Index
DD88: 48 PHA ;Push Last Preference Index
DD89: A9 01 LDA #1 ;Get Number of Address Pointers Needed
DD8B: 20 D6 D3 JSR CHKMEM ;Assure sufficient Stack space
DD8E: 20 60 DE JSR GETVAL ;Get an Element
DD91: A9 00 LDA #$00 ;Get Compare Type (1,0,-1): Zero
DD93: 85 89 STA CPRTYP ;Set Compare Flag (>,=,<): Is Equal To
; ------------------------------------------------------------------------------
; Check for Relational Operators (<,=,>)
; ------------------------------------------------------------------------------
DD95: 20 B7 00 FRMEVL2 JSR CHRGOT ;Get Last Char/Token Got
; ------------------------------------------------------------------------------
; Check for Relational Operators (<,=,>) Loop
; ------------------------------------------------------------------------------
; Tokens: | Hexadecinal | ">" is $CF | "=" is $D0 | "<" is $D1 |
; | Decinal | ">" is 207 | "=" is 208 | "<" is 209 |
; | Zero-Ordinal | ">" is 0 | "=" is 1 | "<" is 2 |
; ------------------------------------------------------------------------------
DD98: 38 FE2LOOP SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
DD99: E9 CF SBC #TOK_GREATER ;Is it a ">" Token?
; ;Now (A)=[(0|1|2) for (">"|"="|"<")]
DD9B: 90 17 BCC FE2CONT ;BLT: NO, it's NOT a Relational Operator
DD9D: C9 03 CMP #3 ;Is it an "=" or a "<" Token?
DD9F: B0 13 BCS FE2CONT ;BGE: NO, it's NOT a Relational Operator
DDA1: C9 01 CMP #1 ;Token is "=" or "<"! Is it an "=" Token?
; ;If >= "=" Token, Carry is Set
DDA3: 2A ROL A ;Double & Put Carry in LSB [(2A+C)-->(A)]
; ;Now (A)=[(0|3|5) for (">"|"="|"<")]
DDA4: 49 01 EOR #%00000001 ;Now (A)=[(1|2|4) for (">"|"="|"<")]
DDA6: 45 89 EOR CPRTYP ;Set CPRTYP bit (00000<=>)~(4|2|1)
; ;Check for Illegal Combinations:
DDA8: C5 89 CMP CPRTYP ;1st Pass (00000000); 2nd Pass (00000<=>)
DDAA: 90 61 BCC SNTXERR ;BLT: Branch If a Rel Op was Repeated;
; ;^(Go Throw a "?Syntax" Error!) [Exit]
DDAC: 85 89 STA CPRTYP ;Set bits of CPRTYP (00000<=>)
DDAE: 20 B1 00 JSR CHRGET ;Get Next Char/Token
; ;Is it another Rel Op (<,=,>)?
DDB1: 4C 98 DD JMP FE2LOOP ;Check for a 2nd Relational Operator
; ------------------------------------------------------------------------------
; Is it a Relational Operator (<,=,>)?
; ------------------------------------------------------------------------------
; ;Now (A)=[(0|1|2) for (">"|"="|"<")]
DDB4: A6 89 FE2CONT LDX CPRTYP ;Were Relational Operators Found?
DDB6: D0 2C BNE FRMREL ;YES, Rel Ops were Found, So Evaluate Math
DDB8: B0 7B BCS NOTMATH ;BGE: NO, Branch if [(A)>(2)];
; ;Rel Ops Not Found, So Not an Equation
; ;& Char/Token is [(A+207)>("<":$D1=209)]
; ------------------------------------------------------------------------------
; ;Now (A)<(0); Add Difference:
DDBA: 69 07 ADC #7 ;[(TOK_GREATER)-(TOK_PLUS)=($CF-$C8)=(7)]
; ;Now (A)<=[(0|1|2|3) : ("+"|"-"|"*"|"/")]
DDBC: 90 77 BCC NOTMATH ;BLT: Branch if [(A)<(0)];
; ;Rel Ops Not Found, So Not an Equation,
; ;& Char/Token is [(A+207)<("+":$C8=200)]
; ------------------------------------------------------------------------------
; ;Now (A)=[(0|1|2|3) for ("+"|"-"|"*"|"/")]
; ;& Char/Token is [(A+207)>=("+":$C8=200)]
; ;-----------------------------------------
; ;If Last Result was a String, Concatenate:
DDBE: 65 11 ADC VALTYP ;Add w/C=1: Variable Type ($00=Num, $FF=Str)
DDC0: D0 03 BNE FE2NUM ;(A)=(1|2|3|4): Last Result was a Number
DDC2: 4C 97 E5 JMP CAT ;(A)=(0): Last Result was a String
; ------------------------------------------------------------------------------
; It is NOT a Relational Operator (<,=,>); Nor is it a Concatenation of Strings!
; ------------------------------------------------------------------------------
; ;Now (A)=(1|2|3|4): Last VALTYP was a Num
DDC5: 69 FF FE2NUM ADC #$FF ;Add (-1) w/C=0: Now (A)=[(0|1|2|3) again
; ;Multiply it by 3:
DDC7: 85 5E STA INDEX ;Save (A)
DDC9: 0A ASL A ;Double (A)
DDCA: 65 5E ADC INDEX ;Now (A)=[(0|3|6|9) for ("+"|"-"|"*"|"/")]
DDCC: A8 TAY ;Now (Y)=[(0|3|6|9) for ("+"|"-"|"*"|"/")]
; ------------------------------------------------------------------------------
; Check Form & Precedence Test
; ------------------------------------------------------------------------------
DDCD: 68 PREFTEST PLA ;Get Last Precedence
DDCE: D9 B2 D0 CMP MATHTBL,Y ;Is (Last Precedence)>("+"|"-"|"*"|"/")?
DDD1: B0 67 BCS DOMATHNOW ;YES, if Higher Precedence: Do it Now!
DDD3: 20 6A DD JSR CHKNUM ;NO; Was Last VALTYP a Number?
; ;YES; Rtns here if Type is Numeric (C=0)
; ;Else, NO Rtn; Does Type Mismatch Error!
; ------------------------------------------------------------------------------
DDD6: 48 NXTOP PHA ;Form correct: Push Last Precedence
DDD7: 20 FD DD SAVOP JSR FRM_RECURSE ;Push Rest of OP, Call FRMEVL Recursively
DDDA: 68 PLA ;Pull Last Precedence
DDDB: A4 87 LDY LASTOP ;Get Last FRMEVL Scratch Flag Saved
DDDD: 10 17 BPL PREFNC ;Branch if [(0)<(Y)<(128)]
DDDF: AA TAX ;Set (X)=(Last Precedence)
DDE0: F0 56 BEQ GOEX ;Exit if (X)=(A)=(0): NO Math in Expression
DDE2: D0 5F BNE DOMATH ;Else, [(X)=(A)]<>(0): Math in Expr; Always
; ------------------------------------------------------------------------------
; Found one or more Relational Operators (<,=,>); Evaluate Math Equation:
; ------------------------------------------------------------------------------
DDE4: 46 11 FRMREL LSR VALTYP ;Variable Type ($00=Num, $FF=Str) LSB -> C
DDE6: 8A TXA ;Now (A)=[(X)=(CPRTYP)=(00000<=>)] Rel Ops
DDE7: 2A ROL A ;Now (A)=(0000<=>C)]: [(C)=(0|1)=(Num|Str)]
DDE8: A6 B8 LDX TXTPTR ;Get Next Char/Token Pointer, Low
DDEA: D0 02 BNE FRSKPGR ;Skip Page Reduction if <> 0
DDEC: C6 B9 DEC TXTPTR+1 ;Decrement Next Char/Token Pointer, High
DDEE: C6 B8 FRSKPGR DEC TXTPTR ;Decrement Next Char/Token Pointer, Low
DDF0: A0 1B LDY #$1B ;Point at Rel Ops ("<") Unary Plus entry
; ;(MO_UPLS_LTGT-MTHTBL)=($D0CD-$D0B2)=($1B)
DDF2: 85 89 STA CPRTYP ;Set Comparison Type to (0000<=>C)
DDF4: D0 D7 BNE PREFTEST ;Loop-Back; Always Taken
; ------------------------------------------------------------------------------
DDF6: D9 B2 D0 PREFNC CMP MATHTBL,Y ;Is (Last Precedence)>("+"|"-"|"*"|"/")?
DDF9: B0 48 BCS DOMATH ;YES, if Higher Precedence: Do it Now!
DDFB: 90 D9 BCC NXTOP ;Loop-Back; Always Taken
; ------------------------------------------------------------------------------
; Stack this Operation and call FRMEVL for another one (Recursive)
; ------------------------------------------------------------------------------
; ;Now (Y)=[(0|3|6|9) for ("+"|"-"|"*"|"/")]
; ;Push Rest of OP:
DDFD: B9 B4 D0 FRM_RECURSE LDA MATHTBL+2,Y ;Get Math Operator's S/R Address, High
DE00: 48 PHA ;Push Math Operator's S/R Address, High
DE01: B9 B3 D0 LDA MATHTBL+1,Y ;Get Math Operator's S/R Address, Low
DE04: 48 PHA ;Push Math Operator's S/R Address, Low
DE05: 20 10 DE JSR PSHFAC ;Returns via JMP (INDEX)
DE08: A5 89 LDA CPRTYP ;Get FRMEVL Compare Flag (0000<=>C)
DE0A: 4C 86 DD JMP FRMEVL1 ;Call FRMEVL Recursively
; ------------------------------------------------------------------------------
DE0D: 4C C9 DE SNTXERR JMP SYNERROR ;Go Throw a "?Syntax" Error! [Exit]
; ==============================================================================
; Stack (FAC): Set INDEX for Return & Push FAC (Values & Sign Bytes [2 kinds])
; ==============================================================================
; | Three entry points: | None return across a page boundary: |
; | ------------------- | ----------------------------------- |
; | PSHFAC, from FRMEVL | Above at $DE05; Returns to $DE08 |
; | PSHFACX, from STEP | Above at $D7C6; Returns to $D7C9 |
; | PUSHFAC, from FOR | Above at $D7AC; Returns to $D7AF |
; ==============================================================================
;
; ------------------------------------------------------------------------------
; FRMEVL Entry Point, to Push FAC (Values & Sign Byte [MSB]):
; ------------------------------------------------------------------------------
DE10: A5 A2 PSHFAC LDA FACSIGN ;Get SIGN of FAC (>127 = Neg | <128 = Pos)
DE12: BE B2 D0 LDX MATHTBL,Y ;Get Precedence Code (Token constant)
; ------------------------------------------------------------------------------
; STEP Entry Point, to Push STEP Amount (Value in FAC & Sign in (A)=(-1|0|1):
; ------------------------------------------------------------------------------
DE15: A8 PSHFACX TAY ;Save SIGN of {FAC|STEP} Value
; ;Prepare for Return via JMP (Indirect):
DE16: 68 PLA ;Pull Return Address, Low
DE17: 85 5E STA INDEX ;Set Return Address, Low [for JMP (INDEX)]
DE19: E6 5E INC INDEX ; & Add one (like an RTS does)
DE1B: 68 PLA ;Pull Return Address, High
DE1C: 85 5F STA INDEX+1 ;Set Return Address, High [for JMP (INDEX)]
; ;None cross page boundary, so NO INC here!
DE1E: 98 TYA ;Retrieve SIGN of {FAC|STEP} Value
DE1F: 48 PHA ;Push SIGN Byte [1 of 2 types]
; ------------------------------------------------------------------------------
; FOR Entry Point, with INDEX = STEP, to Push Initial Value of FOR Variable:
; ------------------------------------------------------------------------------
DE20: 20 72 EB PUSHFAC JSR ROUND_FAC ;Round FAC to 32 bits
; ----------------------------------- ;Push FAC (L,M,H,T,X):
DE23: A5 A1 LDA FAC+4 ;Get FAC Mantissa, Low
DE25: 48 PHA ;Push FAC Mantissa, Low
DE26: A5 A0 LDA FAC+3 ;Get FAC Mantissa, Middle
DE28: 48 PHA ;Push FAC Mantissa, Middle
DE29: A5 9F LDA FAC+2 ;Get FAC Mantissa, High
DE2B: 48 PHA ;Push FAC Mantissa, High
DE2C: A5 9E LDA FAC+1 ;Get FAC Mantissa, Top
DE2E: 48 PHA ;Push FAC Mantissa, Top
DE2F: A5 9D LDA FAC ;Get FAC Exponent
DE31: 48 PHA ;Push FAC Exponent
DE32: 6C 5E 00 JMP (INDEX) ;Return to Caller (Indirectly)
; ------------------------------------------------------------------------------
; If NO Relative Operators were Found, this Statement is Not an Equation!
; ------------------------------------------------------------------------------
DE35: A0 FF NOTMATH LDY #$FF ;Set NO Math Exit Code
DE37: 68 PLA ;Pull Precedence (Last Preference Index)
DE38: F0 23 GOEX BEQ EXIT ;Exit if NO Math to do
; ------------------------------------------------------------------------------
; ELSE, Statement is a Stacked Operation, so Execute the Stacked Operation:
; ------------------------------------------------------------------------------
; A-Reg = Precedence byte
; Stack (# of bytes): 1 - CPRMASK
; 5 - ARG
; 2 - Address of Subroutine to Execute
; ------------------------------------------------------------------------------
DE3A: C9 64 DOMATHNOW CMP #P_REL ;Was it a Relational Operator (<|=|>)?
DE3C: F0 03 BEQ SKPNUMCHK ;YES: Allow String Comparison; Skip Next Op
DE3E: 20 6A DD JSR CHKNUM ;NO: Assure (FAC) Type is Numeric
; ;(Y)=[(-1)|(0|3|6|9) : ("+"|"-"|"*"|"/")]
DE41: 84 87 SKPNUMCHK STY LASTOP ;Save Y-Reg in FRMEVL Scratch Flag
; ------------------------------------------------------------------------------
; Pull & Put Stacked FAC into ARG (Secondary FAC); Then go to Math subroutine
; (whose Address was already pushed onto the Stack) via an RTS; Note that
; Relative Ops (<|=|>) all go to RELOPS ($DF65):
; ------------------------------------------------------------------------------
DE43: 68 DOMATH PLA ;Pull Compare Flag [(CPRTYP)=(0000<=>C)]
DE44: 4A LSR A ;Retore Carry Flag; Now (A)=(00000<=>)
DE45: 85 16 STA CPRMASK ;Set Comparison Mask (from Comparison Type)
DE47: 68 PLA ;Pull FAC Exponent
DE48: 85 A5 STA ARG ;Set ARG Exponent
DE4A: 68 PLA ;Pull FAC Mantissa, Top
DE4B: 85 A6 STA ARG+1 ;Set ARG Mantissa, Top
DE4D: 68 PLA ;Pull FAC Mantissa, High
DE4E: 85 A7 STA ARG+2 ;Set ARG Mantissa, High
DE50: 68 PLA ;Pull FAC Mantissa, Middle
DE51: 85 A8 STA ARG+3 ;Set ARG Mantissa, Middle
DE53: 68 PLA ;Pull FAC Mantissa, Low
DE54: 85 A9 STA ARG+4 ;Set ARG Mantissa, Low
DE56: 68 PLA ;Pull SIGN Byte [1 of 2 types]
DE57: 85 AA STA ARGSIGN ;Set ARG SIGN Byte [1 of 2 types]
DE59: 45 A2 EOR FACSIGN ;XOR Signs of Ops (for Multiply/Divide)
DE5B: 85 AB STA SGNCPR ;Set Sign Comparison Flag
DE5D: A5 9D EXIT LDA FAC ;Get FAC Exponent (Status if FACX=0)
DE5F: 60 RTS ;Do Math Operation
; ==============================================================================
; Get an Element from Expression:
; ==============================================================================
; This is the "Kernel" subroutine of FRMEVL (for Evaluating Expression Formats)
; (It also Evaluates Expressions in Parenthesis via Recursive calls to FRMEVL)
; ==============================================================================
; Get Value of Variable or Number at TXTPTR & put it in the FAC
; If it is a String, put pointer to String Descriptor in the FAC
; ------------------------------------------------------------------------------
DE60: A9 00 GETVAL LDA #$00 ;Assume Numeric:
DE62: 85 11 STA VALTYP ;Set Variable Type ($00=Num, $FF=Str)
DE64: 20 B1 00 SKIP JSR CHRGET ;Get Next Char/Token
DE67: B0 03 BCS VARIABLE ;BGE: It is Not a Number If Carry is Set
DE69: 4C 4A EC NUMBER JMP FIN ;BLT: It is a Number If Carry is Clear
DE6C: 20 7D E0 VARIABLE JSR ISLETC ;Is it a Variable Name?
DE6F: B0 64 BCS FNDNUMVAR ;YES: It is a Variable Name!
DE71: C9 2E CMP #'.' ;NO; Is it a Decimal Point?
DE73: F0 F4 BEQ NUMBER ;YES: So it IS a Numeric Constant!
DE75: C9 C9 CMP #TOK_MINUS ;NO; Is it a Unary Minus ("-") Sign?
DE77: F0 55 BEQ UMINUS ;YES: It is a Minus Sign!
DE79: C9 C8 CMP #TOK_PLUS ;NO; Is it a Unary Plus ("+") Sign?
DE7B: F0 E7 BEQ SKIP ;YES (Loop-Back): It is a Plus Sign!
DE7D: C9 22 CMP #'"' ;Is it a String Constant (Quotation Mark)?
DE7F: D0 0F BNE TOKNOT ;NO (Skip Fwd): It is NOT a String (Quote)!
; ;YES: Processes Literal String;
; ;Set [(A,Y)={Low,High}]=(TXTPTR+C):
DE81: A5 B8 STRTEXT LDA TXTPTR ;Get Next Char/Token Pointer, Low
DE83: A4 B9 LDY TXTPTR+1 ;Get Next Char/Token Pointer, High
DE85: 69 00 ADC #$00 ;Add in the Carry Flag
DE87: 90 01 BCC TEXTSTR ;Skip INY (High byte) if Carry was Cleared
DE89: C8 INY ;Advance Char/Token Pointer, High
DE8A: 20 E7 E3 TEXTSTR JSR STRLTRL ;Build String Descriptor & Put it in FAC
DE8D: 4C 3D E7 JMP POINT ;Point (TXTPTR) to after Closing Quote
; ==============================================================================
DE90: C9 C6 TOKNOT CMP #TOK_NOT ;Is it a "NOT" Token?
DE92: D0 10 BNE TOKFN ;NO (Skip Fwd): NOT a "NOT" Token!
DE94: A0 18 LDY #$18 ;YES: Point at Rel Ops ("=") Unary Not entry
; ;(MO_UNOT_EQUL-MTHTBL)=($D0CA-$D0B2)=($18)
DE96: D0 38 BNE EQUL ;Always: Pull RA, Stack Op, & Recurse FRMEVL
; ==============================================================================
; "EQUOP" [EQUAL-TO ("=") Operator] Function
; ==============================================================================
;
; ==============================================================================
; Comparison for Equality (EQUAL-TO) [Rel Ops ("=") Unary Not entry]:
; ==============================================================================
; From MATHTBL: MO_UNOT_EQUL DFB P_NEQ ;$D0...208...=...Unary NOT
; TA_UNOT_EQUL DW EQUOP-1 ;(EQUAL-TO) Operator Address
; ------------------------------------------------------------------------------
; Also used to evaluate NOT function:
; This routine is called only by NOT through the preceding branch to EQUL.
; ==============================================================================
;
; EQU * ;(Math Operator Table Branch Address +1)
DE98: A5 9D EQUOP LDA FAC ;Get FAC Exponent
DE9A: D0 03 BNE EQUOP1 ;If FACX<>0, Set as FALSE
DE9C: A0 01 LDY #$01 ;Else, FACX=0: Set as TRUE
DE9E: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
DE9F: A0 00 EQUOP1 LDY #$00 ;FACX<>0: Set as FALSE
; ----------------------------------- ;Convert Y-Reg to Real/FP Number in FAC:
DEA1: 4C 01 E3 JMP SNGFLT ;Float Unsigned Integer & Flag as a Number
; ==============================================================================
; TOKFN Check
; ==============================================================================
;
DEA4: C9 C2 TOKFN CMP #TOK_FN ;Is it an "FN" (Function Assignment) Token?
DEA6: D0 03 BNE TOKSGN ;NO (Skip Fwd): NOT an "FN" Token!
DEA8: 4C 54 E3 JMP FN_CALL ;Go do FN (Function Assignment) Call
; ==============================================================================
; TOKSGN Check
; ==============================================================================
;
DEAB: C9 D2 TOKSGN CMP #TOK_SGN ;Is it a "SGN" (Math Function) Token?
DEAD: 90 03 BCC PARCHK ;NO [(BLT)=(Skip Fwd)]: NOT a "SGN" Token!
DEAF: 4C 0C DF JMP UNARY ;MAYBE it's a SGN Token, MAYBE NOT!
; ==============================================================================
; Evaluate "(Expression)" [within Parentheses]
; ==============================================================================
;
DEB2: 20 BB DE PARCHK JSR CHKOPN ;Is there a "(" at TXTPTR?
DEB5: 20 7B DD JSR FRMEVL ;YES: Evaluate Expression (in Parentheses)
DEB8: A9 29 CHKCLS LDA #')' ;NO; Is there a ")" at TXTPTR?
DEBA: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
DEBB: A9 28 CHKOPN LDA #'(' ;Is there a "(" at TXTPTR?
DEBD: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
DEBE: A9 2C CHKCOM LDA #',' ;Is there a "," at TXTPTR?
;
; ==============================================================================
; Check Current Char & Get Next
; ==============================================================================
;
DEC0: A0 00 SYNCHR LDY #0 ;Clear Indirect Addressing Index
DEC2: D1 B8 CMP (TXTPTR),Y ;Is Char at TXTPTR = A-Reg?
DEC4: D0 03 BNE SYNERROR ;NO; So Throw a "?Syntax" Error
DEC6: 4C B1 00 JMP CHRGET ;YES; Get Next Char & Return to Caller
; ==============================================================================
; Print Syntax Error
; ==============================================================================
;
; ----------------------------------- ;User-Callable Error Entry Point:
DEC9: A2 10 SYNERROR LDX #ERR_SYNTAX ;Throw a "?Syntax" Error
DECB: 4C 12 D4 JMP ERROR ;Go Print Error Message based on X-Reg
; ==============================================================================
; Comparison for Greater-Than->-Less-Than [Rel Ops (">") Unary Minus entry]:
; ==============================================================================
; From MATHTBL: MO_UMNS_GTLT DFB P_NEQ ;$CF...207...>...Unary Minus ("-")
; TA_UMNS_GTLT DW NEGOP-1 ;(GREATER-THAN)->-(LESS-THAN) Op Adrs
; ==============================================================================
;
DECE: A0 15 UMINUS LDY #$15 ;Point at Rel Ops (">") Unary Minus entry
; ;(MO_UMNS_GTLT-MTHTBL)=($D0C7-$D0B2)=($15)
; ==============================================================================
;
; ==============================================================================
DED0: 68 EQUL PLA ;Pull Return Address off Stack, Low
DED1: 68 PLA ;Pull Return Address off Stack, High
DED2: 4C D7 DD JMP SAVOP ;Stack this Op & call FRMEVL Recursively
; ==============================================================================
; Locate & Point to a Specific Variable:
; ==============================================================================
; ;YES: It's a Variable Name! Locate Var:
DED5: 20 E3 DF FNDNUMVAR JSR PTRGET ;Get Address in VARPTR & [(A,Y)={Low,High}]
; ------------------------------------------------------------------------------
; ;Returns (from SETVARPTRYA) with:
; ;(A)=(VARPTR) Ptr to Var's Value, Low
; ;(Y)=(VARPTR+1) Ptr to Var's Value, High
; ------------------------------------------------------------------------------
DED8: 85 A0 STA TMPVPTR ;Set Temp Variable Pointer, Low (FAC+3)
DEDA: 84 A1 STY TMPVPTR+1 ;Set Temp Variable Pointer, High (FAC+4)
DEDC: A6 11 LDX VALTYP ;Get Variable Type ($00=Num, $FF=Str)
DEDE: F0 05 BEQ FNDINTVAR ;Branch if Variable Type is Numeric (==0)
DEE0: A2 00 LDX #$00 ;Else, Variable Type is Not Numeric (<>0)
DEE2: 86 AC STX FACEXT ;Flag it: Clear FAC Extension Byte Safe
DEE4: 60 RTS ;Return to Caller
; ------------------------------------------------------------------------------
; Get Signed Integer at [(TMPVPTR)=(FAC+3,4)] into [(Y,A)={Low,High}], Then
; Float (Y,A) into FAC; Skip it ALL if the Number is already a Real/FP Number!
; ------------------------------------------------------------------------------
; ;Variable Type is Number (=0)
DEE5: A6 12 FNDINTVAR LDX INTFLG ;Negative for Integer Variable (%)
DEE7: 10 0D BPL FNDFPVAR ;Branch if Number is Not an Integer!
; ;Else, it is an Integer, Get its Value ...
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ;Ptr,Lo/Hi-->Value,Hi/Lo Swap Occurs Here:
DEE9: A0 00 LDY #0 ;Clear Indirect Addressing Index (Y=0)
DEEB: B1 A0 LDA (TMPVPTR),Y ;Get from Pointer, Lo: Variable Value, High
DEED: AA TAX ;Save Variable Value, High; From: (FAC+3),Y
DEEE: C8 INY ;Advance Indirect Addressing Index (Y=1)
DEEF: B1 A0 LDA (TMPVPTR),Y ;Get from Pointer, Hi: Variable Value, Low
DEF1: A8 TAY ;Save Variable Value, Low; From: (FAC+3),Y
DEF2: 8A TXA ;Retrieve Variable Value, High
DEF3: 4C F2 E2 JMP GIVAYF ;Float Signed Integer in [(Y,A)={Low,High}]
; ------------------------------------------------------------------------------
; Unpack FP Number at [(A,Y)={Low,High}] into FAC
; ------------------------------------------------------------------------------
; ;Variable Type is Number (=0)
; ;But, the Number is FP, Not an Integer!
; ;(A) is Temp Variable Ptr, Low (FAC+3)
; ;(Y) is Temp Variable Ptr, High (FAC+4)
DEF6: 4C F9 EA FNDFPVAR JMP UPAY2FAC ;Unpack FP# at [(A,Y)={Low,High}] into FAC
; ==============================================================================
; Handle "SCRN(" Token
; ==============================================================================
DEF9: 20 B1 00 SCREEN JSR CHRGET ;Get Next Char/Token
DEFC: 20 EC F1 JSR PLOTFNS ;Get Column,Row Coordinates [(0-47),(0-47)]
DEFF: 8A TXA ;Get Row Coordinate [Set (A)=(X)=(0-47)]
DF00: A4 F0 LDY FIRST ;Get Column Coordinate [Set (Y)=(0-47)]
DF02: 20 71 F8 JSR SCRN ;Get 4-bit Color at Column,Row Coordinates
DF05: A8 TAY ;Set [(Y)=(A)]=[(%0000nnnn)=($0-$F)=(0-16)]
; ----------------------------------- ;Convert (Y) to Real/FP Number in FAC:
DF06: 20 01 E3 JSR SNGFLT ;Float Unsigned Integer & Flag as a Number
DF09: 4C B8 DE JMP CHKCLS ;Require a Closing Parenthesis [")"]
; ==============================================================================
; Process Unary Operators (Functions):
; ==============================================================================
; Continue TOKSGN Check: Is it a "SGN" (Math Function) Token?
; ------------------------------------------------------------------------------
; ;If Not Unary, Do Special:
DF0C: C9 D7 UNARY CMP #TOK_SCRN ;Is it a "SCRN(" Token?
DF0E: F0 E9 BEQ SCREEN ;YES, It's a "SCRN(" Token!
; ------------------------------------------------------------------------------
DF10: 0A ASL A ;NO: Double Token to get Index
DF11: 48 PHA ;Push/Save Routine Pointer Index
DF12: AA TAX ;Put Index in X-Reg, too [(X)=(Token*2)]
DF13: 20 B1 00 JSR CHRGET ;Get Next Char/Token
DF16: E0 CF CPX #>UNFNC-$100 ;Is (Index/2)=(LEFT$|RIGHT$|MID$) Token?
; ;[(TOK_LEFT*2-1)=($E8*2-1)=($D0-1)=($CF)]
; -----------------------------------------------------------------
; AKA: #>JMPADRTBL ;Empty Space AT $CFDC (UNFNC-164)
; [Base Address for Index into Unary Functions Address Table]
; -----------------------------------------------------------------
DF18: 90 20 BCC UNARY1 ;BLT: NO, Branch if NOT a String Function
; ----------------------------------- ;YES, String Function (LEFT$|RIGHT$|MID$):
DF1A: 20 BB DE JSR CHKOPN ;Require an Opening Parenthesis ["("]
DF1D: 20 7B DD JSR FRMEVL ;(Recurse) Evaluate Expression for String
; ; & Leave the Result for a String in FAC]
; ;^[This String Expression (Sexpr) is the
; ; 1st Parameter of the String Function]
DF20: 20 BE DE JSR CHKCOM ;Require a Comma (between 1st & 2nd Parms)
DF23: 20 6C DD JSR CHKSTR ;Assure (FAC) Type is String (VALTYP=$FF)
DF26: 68 PLA ;Pull/Retrieve Routine Pointer Index
DF27: AA TAX ;Put Index in X-Reg, too [(X)=(Token*2)]
; ;Stack String Descriptor Adrs (TMPVPTR):
DF28: A5 A1 LDA TMPVPTR+1 ;Get Temp Variable Pointer, High (FAC+4)
DF2A: 48 PHA ;Push Temp Variable Pointer, High
DF2B: A5 A0 LDA TMPVPTR ;Get Temp Variable Pointer, Low (FAC+3)
DF2D: 48 PHA ;Push Temp Variable Pointer, Low
DF2E: 8A TXA ;Get Routine Pointer Index [(A)=(Token*2)]
DF2F: 48 PHA ;Push Routine Pointer Index (Doubled Token)
DF30: 20 F8 E6 JSR GETBYT ;Convert Next Expression to a Byte in X-Reg
; ;^[This Next Expression (Aexpr) is the
; ; 2nd Parameter of the String Function]
DF33: 68 PLA ;Get Routine Pointer Index [(A)=(Token*2)]
DF34: A8 TAY ;Set Indirect Addressing Index to Jump with
DF35: 8A TXA ;Get Value of 2nd Parameter
DF36: 48 PHA ;Push Value of 2nd Parameter
DF37: 4C 3F DF JMP UNARY2 ;Join Unary Functions
; ----------------------------------- ;NOT a String Function (ReEntry Point)
DF3A: 20 B2 DE UNARY1 JSR PARCHK ;Require "(Expression)" [in Parentheses]
DF3D: 68 PLA ;Get Index to Unary Functions Address Table
DF3E: A8 TAY ;Set Indirect Addressing Index into ^ Table
; ----------------------------------- ;Join Unary Functions (ReEntry Point)
DF3F: B9 DC CF UNARY2 LDA UNFNC-164,Y ;Get Jump Vector, Low, from Address Table
; ;(UNFNC-TOK_SGN*2+$100)=($D080-$D2*2+$100)
DF42: 85 91 STA JMPADRS+1 ;Set Jump from ZP to <Address>, Low
DF44: B9 DD CF LDA UNFNC-163,Y ;Get Jump Vector, High, from Address Table
; ;(UNFNC-TOK_SGN*2+$101)=($D080-$D2*2+$101)
DF47: 85 92 STA JMPADRS+2 ;Set Jump from ZP to <Address>, High
DF49: 20 90 00 JSR JMPADRS ;JMPADRS in Zero-Page is used by functions
; ----------------------------------- ;NO Return for CHR$, LEFT$, RIGHT$, or
; MID$
DF4C: 4C 6A DD JMP CHKNUM ;Require Numeric Result
; ==============================================================================
; "OR" Conditional Statement
; ==============================================================================
;
; EQU * ;(Math Operator Table Branch Address +1)
DF4F: A5 A5 OR LDA ARG ;Get 2nd FAC Exponent (ARGX)
DF51: 05 9D ORA FAC ;OR w/ 1st FAC Exponent (FACX)
DF53: D0 0B BNE TRUE ;Branch if [(ARGX)|(FACX)]<>0
;
; ==============================================================================
; "AND" Conditional Statement
; ==============================================================================
;
; EQU * ;(Math Operator Table Branch Address +1)
DF55: A5 A5 AND LDA ARG ;Get 2nd FAC Exponent (ARGX)
DF57: F0 04 BEQ FALSE ;Branch if [(A)=(ARGX)]==0
DF59: A5 9D LDA FAC ;Else, Get 1st FAC Exponent (FACX)
DF5B: D0 03 BNE TRUE ;Branch if [(A)=(FACX)]<>0
;
; ------------------------------------------------------------------------------
; Flag "FALSE" Condition
; ------------------------------------------------------------------------------
;
DF5D: A0 00 FALSE LDY #$00 ;Set to FALSE [(Y)=(0)]
DF5F: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
;
; ------------------------------------------------------------------------------
; Flag "TRUE" Condition
; ------------------------------------------------------------------------------
;
DF60: A0 01 TRUE LDY #$01 ;Set to TRUE [(Y)=(1)]
; ----------------------------------- ;Convert Y-Reg to Real/FP Number in FAC:
DF62: 4C 01 E3 JMP SNGFLT ;Float Unsigned Integer & Flag as a Number
;
; ==============================================================================
; "RELOPS" [Less-Than ("<") Operator] Function:
; ==============================================================================
; Common Routine for <, =, > Comparisons
; ==============================================================================
; Comparison for (LESS-THAN)-<-(GREATER-THAN) [Rel Ops ("<") Unary Plus entry]:
; ==============================================================================
; From MATHTBL: MO_UPLS_LTGT DFB P_REL ;$D1...209...<...Unary Plus ("+")
; TA_UPLS_LTGT DW RELOPS-1 ;(LESS-THAN)-<-(GREATER-THAN) Op Adrs
; ==============================================================================
;
; EQU * ;(Math Operator Table Branch Address +1)
DF65: 20 6D DD RELOPS JSR CHKVAL ;Is FAC Type Numeric ($00) or String ($FF)?
DF68: B0 13 BCS STRCMP ;Branch if C=1: Type is String, NOT Numeric
; ----------------------------------- ;Do a Numeric Comparison [ARG(<|=|>)FAC]:
DF6A: A5 AA LDA ARGSIGN ;Get ARG's Unpacked Sign (msb)
DF6C: 09 7F ORA #%01111111 ;Set (AND Mask msb)=(ARGSGN msb)
; ;Repack Value in ARG for FCOMP:
DF6E: 25 A6 AND ARG+1 ;Set in (A): Sign Bit of ARG Mantissa, Top
DF70: 85 A6 STA ARG+1 ;Save Signed ARG Mantissa, Top
DF72: A9 A5 LDA #ARG ;Get ARG Address, Low
DF74: A0 00 LDY #0 ;Get ARG Address, High; [(A,Y)={Low,High}]
DF76: 20 B2 EB JSR FCOMP ;Compare FAC with Packed Number at (A,Y) ^
; ;Rtns: (A)=(-1|0|1)<--(A,Y)=[(>|=|<) FAC]
DF79: AA TAX ;Save [(X)=(A)] as Sign Value for finishing
DF7A: 4C B0 DF JMP NUMCMP ;Finish Numeric Comparison (below)
; ----------------------------------- ;Do a String Comparison:
DF7D: A9 00 STRCMP LDA #$00 ;Clear Accumulator
DF7F: 85 11 STA VALTYP ;Set Variable Type ($00=Num, $FF=Str)
DF81: C6 89 DEC CPRTYP ;Make FRMEVL Compare Flag = (0000<=>0)
DF83: 20 00 E6 JSR FREFAC ;Free up TMPVPTR & a Temp String
DF86: 85 9D STA DSCTMP ;Set (FAC) Temp Descriptor, String Length
DF88: 86 9E STX DSCTMPL ;Set (FAC+1) Tmp Dscrptr, Str Addr, Low
DF8A: 84 9F STY DSCTMPH ;Set (FAC+2) Tmp Dscrptr, Str Addr, High
DF8C: A5 A8 LDA ARGVPTR ;Get (ARG+3) Temp Variable Pointer, Low
DF8E: A4 A9 LDY ARGVPTR+1 ;Get (ARG+4) Temp Variable Pointer, High
DF90: 20 04 E6 JSR FRETMP ;Free up a Temp String [Address in (A,Y)]
DF93: 86 A8 STX ARGVPTR ;Set (ARG+3) Temp String Pointer, Low
DF95: 84 A9 STY ARGVPTR+1 ;Set (ARG+4) Temp String Pointer, High
DF97: AA TAX ;Set to (ARG) Temp String Length
DF98: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
DF99: E5 9D SBC DSCTMP ;Deduce Lesser of (ARG|FAC) String Lenghts
DF9B: F0 08 BEQ SCFS ;Flag (0) for (ARG=FAC) String Lenghts
DF9D: A9 01 LDA #1 ;Set Accumulator
DF9F: 90 04 BCC SCFS ;Flag (+1) for (ARG<FAC) String Lenghts
DFA1: A6 9D LDX DSCTMP ;Get (FAC) Temp Descriptor, String Length
DFA3: A9 FF LDA #$FF ;Flag (-1) for (ARG>FAC) String Lenghts
DFA5: 85 A2 SCFS STA FACSIGN ;Flag Shortest [(FAC|==|ARG)-->(-1|0|+1)]
DFA7: A0 FF LDY #$FF ;Set to counter following Advance
DFA9: E8 INX ;Set to counter following Reduction
DFAA: C8 CMPLOOP INY ;Advance Indirect Addressing Index
DFAB: CA DEX ;Count Down for (FAC) String Length
DFAC: D0 07 BNE DOCMP ;Branch if more Chars in both Strings
DFAE: A6 A2 LDX FACSIGN ;If Str(ARG=FAC) so far, decide by Length
DFB0: 30 0F NUMCMP BMI CMPDONE ;Branch if (ARG>FAC) String Lenghts
DFB2: 18 CLC ;Clear Carry to force following Branch:
DFB3: 90 0C BCC CMPDONE ;Always Taken
; ----------------------------------- ;Do another String Character Comparison:
DFB5: B1 A8 DOCMP LDA (ARGVPTR),Y ;Get an (ARG) Temp String Character
DFB7: D1 9E CMP (DSCTMPL),Y ;Compare it to (FAC) Temp String Character
DFB9: F0 EF BEQ CMPLOOP ;Loop: Keep Comparing if Chars are Equal
DFBB: A2 FF LDX #$FF ;Set for (ARG>FAC) String Lenghts
DFBD: B0 02 BCS CMPDONE ;Branch if (ARG>FAC) String Lenghts
DFBF: A2 01 LDX #1 ;Set for (ARG<FAC) String Lenghts
; ----------------------------------- ;Done with String Comparison;
; ;Convert (FAC|==|ARG):
DFC1: E8 CMPDONE INX ;Convert from (-1|0|1) to (0,1,2):[A=X+1];
DFC2: 8A TXA ;Then, if C=0, Convert to (0,2,4):[A*2+C];
DFC3: 2A ROL A ;Else, if C=1, Convert to (1,2,5):[A*2+C]
DFC4: 25 16 AND CPRMASK ;(00000<=>):[8421,8421]
DFC6: F0 02 BEQ CMPFINFLT ;Branch if NO Match: (A=0) indicates False
DFC8: A9 01 LDA #$01 ;Else, Matches >= 1: (A=1) indicates True
DFCA: 4C 93 EB CMPFINFLT JMP FLOAT ;Float Signed Integer in (A) into FAC
; ==============================================================================
; "PDL" (Paddle) Statement: Immediate and Deferred; Parameter: PDL (Aexpr)
; ==============================================================================
; Function: Converts Analog Resistance Input to Digital Numeric Output
; Input: (Aexpr)=(0|1|2|3) is the number of a game controller (potentiometer)
; Output: (0 to 255) corresponding to a variable resistance of (0 to 150 Kohms)
; ==============================================================================
;
DFCD: 20 FB E6 PDL JSR CONINT ;Convert FAC to Number in (X) & (FAC+4)
; ;<<< Validity [(X)<(4)] is NOT Checked! >>
DFD0: 20 1E FB JSR PREAD ;Read Paddle (X); Returns Time-Count in (Y)
; ;Float Unsigned Integer & Flag as Number:
DFD3: 4C 01 E3 JMP SNGFLT ;Convert (Y) to Real Number in FAC
; ==============================================================================
; "DIM" Statement: Immediate and Deferred;
; Parameters: DIM Var Subscript [{,Var Subscript}]
; ==============================================================================
; Function: Array Dimensional Assignment; Allocates Space for Array Variables
; ==============================================================================
;
; ----------------------------------- ;Next Dimension (Loop-Back) Entry Point:
DFD6: 20 BE DE NXDIM JSR CHKCOM ;Require a Comma (Data Separator)
; ----------------------------------- ;DIM Statement (Main) Entry Point:
DFD9: AA DIM TAX ;Set [(X)=(A)]: Next Character after Comma
; ----------------------------------- ;[(X<>0)] & Entry Point Flags DIM calling:
DFDA: 20 E8 DF JSR PTRGET2 ;Allocate the Array
DFDD: 20 B7 00 JSR CHRGOT ;Get (A): Last Character Got
DFE0: D0 F4 BNE NXDIM ;Loop if NOT at End of Line/Program
DFE2: 60 RTS ;Return to Caller
; ==============================================================================
; Pointer Get: Locates or Creates a Specific Variable.
; ==============================================================================
; PTRGET reads a variable name from CHRGET & finds it in memory. On entry,
; TXTPTR must point to the first character of the variable name. On exit, the
; address to the value of the variable is in VARPTR & [(A,Y)={Low,High}]. If
; PTRGET cannot find a simple variable, it creates one. If PTRGET cannot find
; an array variable, it creats an array, dimensioned from 0 to 10, with all
; elements cleared to zero.
; ==============================================================================
DFE3: A2 00 PTRGET LDX #$00 ;Clear X-Reg
DFE5: 20 B7 00 JSR CHRGOT ;Get Last Char/Token Got w/o uping TXTPTR
; ----------------------------------- ;Subroutine Entry Point for DIM Statement:
DFE8: 86 10 PTRGET2 STX DIMFLG ;Set Array Dimension Flag (DIM Call <> 0)
; ;Set to Zero unless called frm DIM (above)
; ----------------------------------- ;Subroutine Entry Point for FN Statements:
DFEA: 85 81 PTRGET3 STA VARNAM ;Save 1st Character of Variable Name
; ;VARNAM: Last-Used Variable Name Pointer
; ;is being used here to store the Var Name
; ;(Bytes)=($:+-;%:--;Real:++;Function:-+)
DFEC: 20 B7 00 JSR CHRGOT ;Get Last Char/Token Got w/o uping TXTPTR
DFEF: 20 7D E0 JSR ISLETC ;Is it a Letter?
DFF2: B0 03 BCS NAMOK ;YES, it is a Letter!
DFF4: 4C C9 DE BADNAM JMP SYNERROR ;NO, Not a Letter; Throw a "?SYNTAX" Error!
DFF7: A2 00 NAMOK LDX #$00 ;Clear X-Reg
DFF9: 86 11 STX VALTYP ;Clear Variable Type ($00=Num, $FF=Str)
DFFB: 86 12 STX INTFLG ;Clear Integer Flag (Negative if Integer)
DFFD: 4C 07 E0 JMP PTRGETMOR ;Branch Across BASIC Entry Points
;
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
; ==============================================================================
; ROM Space ($E000-$E7FF): ROM Socket $E0 on a real Apple II Plus.
; ==============================================================================
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
;
;
; ==============================================================================
; APPLESOFT (BASIC) ENTRY POINTS:
; ==============================================================================
;
E000: 4C 28 F1 BASIC JMP COLD_START ;Hard/Cold/Ctrl-B (Reinitialize BASIC) Entry Point
E003: 4C 3C D4 BASIC2 JMP RESTART ;Soft/Warm/Ctrl-C (Don't Reinit BASIC) Entry Point
E006: 00 BRK ;<<< Why not "Waste a Byte!"? >>>
; ==============================================================================
; Pointer Get (continued): General Variable Scan
; ==============================================================================
; PTRGET scans the variable name at TXTPTR, and searches the variable table
; (VARTAB) & array table (ARYTAB) for the name. If not found, PTRGET creates a
; variable of the appropriate type. PTRGET returns with the address in VARPTR &
; [(A,Y)={Low,High}].
;
; Actual activity controlled somewhat by two flags:
;
; DIMFLG - Array Dimension Flag: Nonzero if called from DIM; Else = 0
; SUBFLG - Subscripts Flag: $00 = Allowed; $80 = NOT Allowed;
; = $40 if called from GETARYPT;
; = $80 if called from DEF FN;
; = $C1-DA if called from FN
; ==============================================================================
;
E007: 20 B1 00 PTRGETMOR JSR CHRGET ;Get 2nd Character of Variable Name
E00A: 90 05 BCC PTRGETNUM ;Branch if it's Numeric
E00C: 20 7D E0 JSR ISLETC ;Is it a Letter (A-Z)?
E00F: 90 0B BCC PTRGETSTR ;Branch if NOT a Letter: End of Name
E011: AA PTRGETNUM TAX ;Save 2nd Character of Variable Name
E012: 20 B1 00 PTRGETNLP JSR CHRGET ;Scan to End of Variable Name
E015: 90 FB BCC PTRGETNLP ;Loop if it's Numeric
E017: 20 7D E0 JSR ISLETC ;Is it a Letter (A-Z)?
E01A: B0 F6 BCS PTRGETNLP ;Loop if it's a Letter
; ----------------------------------- ;Setup Variable Type Flags:
E01C: C9 24 PTRGETSTR CMP #'$' ;Is it a String Symbol (Dollar Sign)?
E01E: D0 06 BNE PTRGETINT ;Branch if NOT a String Symbol ("$")
E020: A9 FF LDA #$FF ;Else: Flag as a String
E022: 85 11 STA VALTYP ;Set Variable Type ($00=Num, $FF=Str)
E024: D0 10 BNE PTRGETNIN ;Always Taken
E026: C9 25 PTRGETINT CMP #'%' ;Is it an Integer Variable?
E028: D0 13 BNE PTRGET2ND ;Branch if NOT an Integer Variable
E02A: A5 14 LDA SUBFLG ;Get Subscript Flag ($00=Allowed, $80=NOT)
E02C: 30 C6 BMI BADNAM ;Branch if Integer Variable NOT Allowed;
; ;^(Throws a "?SYNTAX" Error!)
; ------------------------------------------------------------------------------
; Flag Var & Name as Integer (%) ;VARNAM: Last-Used Variable Name Pointer
; ;is being used here to store the Var Name
; ;(Bytes)=($:+-;%:--;Real:++;Function:-+)
E02E: A9 80 LDA #$80 ;Flag as Integer Variable (%:--):
E030: 85 12 STA INTFLG ;Set Negative for an Integer Variable
E032: 05 81 ORA VARNAM ;Set Negative: 1st Var Name Character
E034: 85 81 STA VARNAM ;Save 1st Character of Variable Name
E036: 8A PTRGETNIN TXA ;Retrieve 2nd Character of Variable Name
E037: 09 80 ORA #$80 ;Set Negative: 2nd Var Name Character
E039: AA TAX ;Save 2nd Character of Variable Name
; ------------------------------------------------------------------------------
E03A: 20 B1 00 JSR CHRGET ;Get Next (Var Name Terminating) Character
E03D: 86 82 PTRGET2ND STX VARNAM+1 ;Store 2nd Character of Variable Name
E03F: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
E040: 05 14 ORA SUBFLG ;Are Subscripts Allowed? [YES if ($00|$40)]
E042: E9 28 SBC #'(' ;And, is it an Array Variable?
E044: D0 03 BNE PTRGETNVC ;Branch if NOT[[(SUBFLG)=($00)]&["("]]
E046: 4C 1E E1 PTRGETARY JMP ARRAY ;Else, Go Handle the Array
E049: 24 14 PTRGETNVC BIT SUBFLG ;Check Top 2 Bits (NV) of SUBFLG
E04B: 30 02 BMI PTRGETIVP ;($80): Branch if from FOR, DEF or FN
E04D: 70 F7 BVS PTRGETARY ;($40): Branch if called from GETARYPTR
; ----------------------------------- ;Initialize Variable Pointer:
E04F: A9 00 PTRGETIVP LDA #$00 ;Clear Accumulator
E051: 85 14 STA SUBFLG ;Clear SUBFLG
E053: A5 69 LDA VARTAB ;Get Start of Variables Pointer, Low
E055: A6 6A LDX VARTAB+1 ;Get Start of Variables Pointer, High
; ----------------------------------- ;Search Loops:
E057: A0 00 LDY #0 ;Clear Indirect Addressing Index
E059: 86 9C PTRGETLP1 STX LOWTR+1 ;Set Var Name Search Pointer, High
E05B: 85 9B PTRGETLP2 STA LOWTR ;Set Var Name Search Pointer, Low
E05D: E4 6C CPX ARYTAB+1 ;At End of Simple Variables & Pointers?
; ; (Start of Arrays Pointer, High)
E05F: D0 04 BNE PTRGETFND ;NO, Continue Searching
E061: C5 6B CMP ARYTAB ;At End of Simple Variables & Pointers?
; ; (Start of Arrays Pointer, Low)
E063: F0 22 BEQ NAMNOTFND ;YES, Var Name Not Found, Make One
; ----------------------------------- ;Search for Varible Name/Pointer:
E065: A5 81 PTRGETFND LDA VARNAM ;Get Last-Used Variable Name Pointer, Low
E067: D1 9B CMP (LOWTR),Y ;Is it the Same 1st Letter?
E069: D0 08 BNE PTRGET4_13 ;Branch if NOT
E06B: A5 82 LDA VARNAM+1 ;Get Last-Used Variable Name Pointer, High
E06D: C8 INY ;Advance Indirect Addressing Index
E06E: D1 9B CMP (LOWTR),Y ;Is it the Same 2nd Letter?
E070: F0 6C BEQ SETVARPTRYA ;Branch if YES: Same Variable Name Found
; ----------------------------------- ;Else, Advance to next Var Name/Pointer:
E072: 88 DEY ;Reduce Indirect Addressing Index
E073: 18 PTRGET4_13 CLC ;Prepare to Add without Carry
E074: A5 9B LDA LOWTR ;Get Var Name Search Pointer, Low
E076: 69 07 ADC #7 ;Advance Var Name Search Pointer, Low
E078: 90 E1 BCC PTRGETLP2 ;Inner Loob Back: Branch if Not Next Page
E07A: E8 INX ;Advance Var Name Search Pointer, High
E07B: D0 DC BNE PTRGETLP1 ;Outer Loob Back; Always Taken
;
; ==============================================================================
; Check if (A) Contains ASCII Letter ("A"~"Z")
; ------------------------------------------------------------------------------
; Return: Carry Set (C=1) if (A)==("A"~"Z")
; Carry Clear (C=0) if (A)<>("A"~"Z")
; ==============================================================================
; <<< NOTE: Faster & Shorter Code! >>> [Easier to Understand!]
; ------------------------------------------------------------------------------
; CMP #'[' ;Compare High End
; BCS GTE ;Branch if (A)>("Z")
; CMP #'A' ;Compare Low End
; RTS ;(C=0) if (A)<("A")
; ;(C=1) if (A)=("A"~"Z")
; GTE CLC ;(C=0) if (A)>("Z")
; RTS ;Return to Caller
; ==============================================================================
; <<< NOTE: Original (Slower & Longer) Code >>> [Harder to Understand!]
; ------------------------------------------------------------------------------
E07D: C9 41 ISLETC CMP #'A' ;Compare Low End
E07F: 90 05 BCC BAS_RTS13 ;BLT: Branch if (C=0): (A)<("A")
; ;Else (C=1), Compare High End:
E081: E9 5B SBC #'[' ;Subtract w/o Borrow [A-Data-!C]
; ;BGE: If (A)>("Z"), (C=0) Carry is Cleared
E083: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
E084: E9 A5 SBC #$A5 ;Restore A-Reg; ($100-"[")=($100-$5B)=($A5)
; ;-----------------------------------------
; ;If (A)<>("A"~"Z"), (C=0) Carry is Clear;
; ;If (A)==("A"~"Z"), (C=1) Carry is Set:
E086: 60 BAS_RTS13 RTS ;Return to Caller
; ==============================================================================
; Variable (& Name) Not Found, So Make New Variable (With Variable Name Sought)
; ==============================================================================
; ;Assure Called from (FRMVAR JSR PTRGET):
E087: 68 NAMNOTFND PLA ;Pull Caller's Return Address, Low
E088: 48 PHA ;Then Push-It-Back to Reset Stack Pointer
; ----------------------------------- ;*[Return Address-1 is Caller's Address+2;
; ;JSR: (PC)+2->Stack; RTS: Stack+1->(PC)]:
E089: C9 D7 CMP #<FNDNUMVAR+2 ;Called from FRMVAR [($DED5)+2, Low]*?
E08B: D0 0F BNE MKNEWVAR ;Branch (Exit) if NOT: Make New Variable
E08D: BA TSX ;Get Stack Pointer for X-Indexed Addressing
E08E: BD 02 01 LDA STACK+2,X ;Get Caller's Return Address, High
E091: C9 DE CMP #>FNDNUMVAR ;Called from FRMVAR [($DED5)+2, High]*?
E093: D0 07 BNE MKNEWVAR ;Branch (Exit) if NOT: Make New Variable
; ----------------------------------- ;Else: Called from (FRMVAR JSR PTRGET)!
; ;It isn't an Assignment (LET), so use Fake
; ;Variable Address to Return Value of Zero
; ;for New Variable Name used in Expression:
E095: A9 9A LDA #<CON_ZERO ;Point to Constant Zero, Low
E097: A0 E0 LDY #>CON_ZERO ;Point to Constant Zero, High
E099: 60 RTS ;Return CON_ZERO (A,Y) Address to FRMVAR
E09A: 00 00 CON_ZERO DW $0000 ;Integer or Real Zero, or Null String
; ==============================================================================
; Make New Variable
; ==============================================================================
; To make a New Simple Variable, move Arrays up 7 bytes to make room for a New
; Simple Variable, then enter 7 bytes of New Variable Data into the hole:
; ==============================================================================
; ;Set to Move Array Table 7 bytes higher:
; ------------------------------------------------------------------------------
; ;Set (LOWTR) = Lowest Source Address:
E09C: A5 6B MKNEWVAR LDA ARYTAB ;Get Start of Arrays Pointer, Low
E09E: A4 6C LDY ARYTAB+1 ;Get Start of Arrays Pointer, High
E0A0: 85 9B STA LOWTR ;Set Block Copy Source Start Pointer, Low
E0A2: 84 9C STY LOWTR+1 ;Set Block Copy Source Start Pointer, High
; ----------------------------------- ;Set (HIGHTR) = Highest Source Address +1:
E0A4: A5 6D LDA STREND ;Get End of Arrays Pointer, Low
E0A6: A4 6E LDY STREND+1 ;Get End of Arrays Pointer, Low
E0A8: 85 96 STA HIGHTR ;Set as End of Arrays Pointer, Low
E0AA: 84 97 STY HIGHTR+1 ;Set as End of Arrays Pointer, High
; ----------------------------------- ;Set (HIGHDS) = Highest Dest Adrs +1:
E0AC: 18 CLC ;Prepare for Add with Carry
E0AD: 69 07 ADC #7 ;Add 7 bytes to the Top Address
E0AF: 90 01 BCC MNVSPA ;If (C=0), NO Carry Over, Skip Page Advance
E0B1: C8 INY ;If (C=1), Carry Over, Advance Page
; ;(HIGHDS) = Highest Destination Adrs +1:
E0B2: 85 94 MNVSPA STA HIGHDS ;Set Block Copy Destination Pointer, Low
E0B4: 84 95 STY HIGHDS+1 ;Set Block Copy Destination Pointer, High
; ------------------------------------------------------------------------------
E0B6: 20 93 D3 JSR MVBLKUP1 ;Move Memory Block Upward
; ;Returns (HIGHDS) Reduced to (LOWTR+8):
; ;(HIGHDS-1)=(LOWTR+7); (HIGHTR-1)=(LOWTR)
; ------------------------------------------------------------------------------
; ;Store (LOWTR+8) = New Start of Arrays:
E0B9: A5 94 LDA HIGHDS ;Get Block Copy Destination Pointer, Low
E0BB: A4 95 LDY HIGHDS+1 ;Get Block Copy Destination Pointer, High
E0BD: C8 INY ;Advance Page: MVBLKUP1 leaves it 1 too low
E0BE: 85 6B STA ARYTAB ;Set Start of Arrays Pointer, Low
E0C0: 84 6C STY ARYTAB+1 ;Set Start of Arrays Pointer, High
; ----------------------------------- ;Set New Variable Pointer Data (7 bytes):
; ;VARNAM: Last-Used Variable Name Pointer
; ;is being used here to store the Var Name
; ;(Bytes)=($:+-;%:--;Real:++;Function:-+)
E0C2: A0 00 LDY #0 ;Clear Indirect Addressing Index
E0C4: A5 81 LDA VARNAM ;Get Last-Used Variable Name, Low
E0C6: 91 9B STA (LOWTR),Y ;Set New Variable Name, Low (Byte 0)
E0C8: C8 INY ;Advance Indirect Addressing Index
E0C9: A5 82 LDA VARNAM+1 ;Get Last-Used Variable Name, High (Byte 1)
E0CB: 91 9B STA (LOWTR),Y ;Set New Variable Name, High
E0CD: A9 00 LDA #0 ;Clear Accumulator (for Real # Components)
E0CF: C8 INY ;Advance Indirect Addressing Index
E0D0: 91 9B STA (LOWTR),Y ;Clear Exponent (Byte 2)
E0D2: C8 INY ;Advance Indirect Addressing Index
E0D3: 91 9B STA (LOWTR),Y ;Clear Mantissa, Top (Byte 3)
E0D5: C8 INY ;Advance Indirect Addressing Index
E0D6: 91 9B STA (LOWTR),Y ;Clear Mantissa, High (Byte 4)
E0D8: C8 INY ;Advance Indirect Addressing Index
E0D9: 91 9B STA (LOWTR),Y ;Clear Mantissa, Middle (Byte 5)
E0DB: C8 INY ;Advance Indirect Addressing Index
E0DC: 91 9B STA (LOWTR),Y ;Clear Mantissa, Low (Byte 6)
; ----------------------------------- ;Set VARPTR & [(A,Y)={Low,High}] to New
; ;Variable's Real # Value Address (Byte 2):
E0DE: A5 9B SETVARPTRYA LDA LOWTR ;Get New Start of Arrays Pointer, Low
E0E0: 18 CLC ;Prepare for Add with Carry
E0E1: 69 02 ADC #2 ;Point to Real # Components
E0E3: A4 9C LDY LOWTR+1 ;Get New Start of Arrays Pointer, High
E0E5: 90 01 BCC SETVARPTR ;If (C=0), NO Carry Over, Skip Page Advance
E0E7: C8 INY ;If (C=1), Carry Over, Advance Page
E0E8: 85 83 SETVARPTR STA VARPTR ;Set Last-Used Variable Value Pointer, Low
E0EA: 84 84 STY VARPTR+1 ;Set Last-Used Variable Value Pointer, High
; ;Now: Points to 1st Byte of Value
E0EC: 60 RTS ;Return to Caller
; ==============================================================================
; Compute Address of First Value in Array: [(ARYPTR)=(LOWTR)+((Dims)*2)+(5)]
; ==============================================================================
; NOTE: (ARYPTR) = (HIGHDS)
; ------------------------------------------------------------------------------
; (ARYPTR) = Applesoft Array Pointer
; (HIGHDS) = Highest Destination Adrs +1
; ------------------------------------------------------------------------------
E0ED: A5 0F GETARY LDA NUMDIM ;Get Number of Array Dimensions
E0EF: 0A GETARY2 ASL A ;Double it
E0F0: 69 05 ADC #5 ;& Add 5 Bytes for: Name, Offset, # of Dims
E0F2: 65 9B ADC LOWTR ;Add Start of Arrays (New Var) Ptr, Low
E0F4: A4 9C LDY LOWTR+1 ;Get Start of Arrays (New Var) Ptr, High
E0F6: 90 01 BCC GETARY3 ;If (C=0), NO Carry Over, Skip Page Advance
E0F8: C8 INY ;If (C=1), Carry Over, Advance Page
; ----------------------------------- ;Set Array Pointer (ARYPTR):
E0F9: 85 94 GETARY3 STA ARYPTR ;Set as Array's First Value Pointer, Low
E0FB: 84 95 STY ARYPTR+1 ;Set as Array's First Value Pointer, High
; ;Now: Points to 1st Value in Array
; ;Holding: Size of Last Array Dimension, Hi
; ;Returns [(ARYPTR)=(LOWTR)+((Dims)*2)+(5)]
; ; [(ARYPTR)=[(A,Y)={Low,High}]]
E0FD: 60 RTS ;Return to Caller
; ==============================================================================
; The Number -32768 [(Deficient) Packed FAC Constant]
; ==============================================================================
; <<< Meant to be -32768, which would be $9080000000, but it's 1 Byte short, so
; it picks up $20 from next instruction, making it $9080000020, -32768.00049 >>>
; ------------------------------------------------------------------------------
;
E0FE: 90 80 00 00 NEG32768 HEX 90800000 ;The Number -32768.00049
; ==============================================================================
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; (?) BAD32768 HEX 9080000020 |(FF) |$90-$80=$10=+16 |$.80000020 |-3.27680005E+4
; (!) POS32768 HEX 9080000000 |(00) |$90-$80=$10=+16 |$.80000000 |+3.27680000E+4
; (!) NEG32768 HEX 9080000000 |(FF) |$90-$80=$10=+16 |$.80000000 |-3.27680000E+4
; ------------------------------------------------------------------------------
; Hexadecimal point moves +16 bits (4 nibbles) & $8000.0020 = 32768.00049
; Decimal point moves 4 digits to the right: $8000.0000 = 32768.00000
; ------------------------------------------------------------------------------
; Plugging it into & Printing FAC ($ED2EG) results in +32768, not -32768, unless
; * FACSIGN msb is also set ($80-$FF), which causes printing of the minus sign!
; ==============================================================================
;
; <<< ====================================================================== >>>
; <<< BUG in Constant NEG32768: >>>
; <<< ====================================================================== >>>
; <<< Another mistake(?) here in Billy-Boy's (Microsoft?/Applesoft!) BASIC >>>
; <<< ---------------------------------------------------------------------- >>>
; <<< BUG: 10 A=-32768.00049 : A%=A : REM This is accepted >>>
; <<< 20 PRINT A,A% : REM But this shows that: >>>
; <<< 30 REM A=-32768.0005 (OK), A%=32767 [No Error?] >>>
; <<< 40 REM WRONG! WRONG! WRONG! [See above] >>>
; <<< ---------------------------------------------------------------------- >>>
; <<< You cannot change this in (Apple II Plus) Emulator ROM images! >>>
; <<< ====================================================================== >>>
;
;
; ==============================================================================
; Evaluate Numeric Formula at TXTPTR
; Converting Result to Integer (0 <= X <= 32767) in TMPVPTR (FAC+3,4)
; ==============================================================================
;
E102: 20 B1 00 MAKINT JSR CHRGET ;Get Next Char/Token
E105: 20 67 DD JSR FRMNUM ;Evaluate & Assure Expression is Numeric
; ==============================================================================
; Convert FAC to Integer; Must be positive and less than 32768
; ==============================================================================
E108: A5 A2 MKINT LDA FACSIGN ;Get FAC Unpacked Sign (msb)
E10A: 30 0D BMI IQERROR ;Throw Illegal Quantity Error if Negative
; ==============================================================================
; Convert FAC to an integer; Must be -32767 <= FAC <= 32767
; ==============================================================================
E10C: A5 9D AYINT LDA FAC ;Exponent of Value in FAC
E10E: C9 90 CMP #$90 ;(NEG32768's Exponent): Abs(Value) < 32768?
E110: 90 09 BCC CNVRT2INT ;YES, OK for Integer Conversion
; ------------------------------------------------------------------------------
; The Next few lines are supposed to allow -32768 ($8000), but do not because
; compared to -32768.00049 [Really? Look at the Limits. Maybe it's by design!]
; ------------------------------------------------------------------------------
E112: A9 FE LDA #<NEG32768 ;NO; Get Address of Number to compare, Low
E114: A0 E0 LDY #>NEG32768 ;Get Address of Number to compare, High
; --------------- ;[See above: "BUG in Constant NEG32768"]:
E116: 20 B2 EB JSR FCOMP ;Compare FAC with Packed Number at (A,Y) ^
; ;Rtns: (A)=(-1|0|1)<--(A,Y)=[(>|=|<) FAC]
E119: D0 7E IQERROR BNE IQERR ;Go Print "?Illegal Quantity" Error Message
; ------------------------------------------------------------------------------
; Go to Quick Greatest Integer Function:
; Converts FP Value in FAC to Integer Value in FAC Mantissa.
; ------------------------------------------------------------------------------
E11B: 4C F2 EB CNVRT2INT JMP QINT ;Convert FAC to (4 Byte) Integer
; ==============================================================================
; Locate an Array Element or Create an Array
; ==============================================================================
E11E: A5 14 ARRAY LDA SUBFLG ;Get Subscript Flag ($00=Allowed, $80=NOT)
E120: D0 47 BNE FNDARY ;Branch if Subscripts NOT Allowed
; ----------------------------------- ;Subscripts Given, Parse Subscript List:
; ;Save Array [(DIMFLG) & (INTFLG)]:
E122: A5 10 LDA DIMFLG ;Get Array Dimension Flag (DIM Call <> 0)
E124: 05 12 ORA INTFLG ;Set to Negative if Integer Variable (%)
E126: 48 PHA ;Push Array Dimension Flag
; ----------------------------------- ;Save Variable Type ($00=Num, $FF=Str):
E127: A5 11 LDA VALTYP ;Get Variable Type
E129: 48 PHA ;Push Variable Type
; ----------------------------------- ;Parse Subscript List:
E12A: A0 00 LDY #0 ;Init Dimension/Subscript/Loop Counter
; ----------------------------------- ;Save Dimension/Subscript/Loop Counter:
E12C: 98 NXTDIM TYA ;Get Number of Dimensions Counted
E12D: 48 PHA ;Push Number of Dimensions Counted
; ----------------------------------- ;Save Variable Name:
E12E: A5 82 LDA VARNAM+1 ;Get Last-Used Variable Name, High
E130: 48 PHA ;Push Last-Used Variable Name, High
E131: A5 81 LDA VARNAM ;Get Last-Used Variable Name, Low
E133: 48 PHA ;Push Last-Used Variable Name, Low
; ----------------------------------- ;Evaluate Subcript as Integer:
E134: 20 02 E1 JSR MAKINT ;Evaluate Numeric Formula at TXTPTR
; ;Converts Result to an Integer in TMPVPTR
; ----------------------------------- ;Restore Variable Name:
E137: 68 PLA ;Pull Last-Used Variable Name, Low
E138: 85 81 STA VARNAM ;Set Last-Used Variable Name, Low
E13A: 68 PLA ;Pull Last-Used Variable Name, High
E13B: 85 82 STA VARNAM+1 ;Set Last-Used Variable Name, High
; ----------------------------------- ;Restore Loop Counter:
E13D: 68 PLA ;Pull Number of Dimensions Counted
E13E: A8 TAY ;Set Number of Dimensions Counter
; ----------------------------------- ;Duplicate VALTYP & DIMFLG on the Stack &
; ;Put Subscript where they were on Stack:
E13F: BA TSX ;Get Stack Pointer for X-Indexed Addressing
E140: BD 02 01 LDA STACK+2,X ;Copy VALTYP from Stack (Not Pulled)
E143: 48 PHA ;Push it back on Top of Stack
E144: BD 01 01 LDA STACK+1,X ;Copy DIMFLG from Stack (Not Pulled)
E147: 48 PHA ;Push it back on Top of Stack
E148: A5 A0 LDA TMPVPTR ;Get Subscript Value, Low (FAC+3)
E14A: 9D 02 01 STA STACK+2,X ;Place on the Stack where VALTYP was
E14D: A5 A1 LDA TMPVPTR+1 ;Get Subscript Value, High (FAC+4)
E14F: 9D 01 01 STA STACK+1,X ;Place on the Stack where DIMFLG was
E152: C8 INY ;Count the Dimension/Subscript/Iteration
; ----------------------------------- ;More Dimensions/Subscripts?
E153: 20 B7 00 JSR CHRGOT ;Get Last Character/Token Got
E156: C9 2C CMP #',' ;Is it a Comma?
E158: F0 D2 BEQ NXTDIM ;YES, Loop until all Dims/Subs put on Stack
; ----------------------------------- ;NO more Dimensions/Subscripts; Finish Up:
E15A: 84 0F STY NUMDIM ;Save Count of Dimensions/Subscripts
E15C: 20 B8 DE JSR CHKCLS ;Check for Closing Parenthesis [")"]
E15F: 68 PLA ;Pull VALTYP from Top of Stack
E160: 85 11 STA VALTYP ;Restore Variable Type
E162: 68 PLA ;Pull DIMFLG from Top of Stack
E163: 85 12 STA INTFLG ;Restore Integer Variable Flag (msb)
E165: 29 7F AND #%01111111 ;Mask off Integer Variable Flag (msb)
E167: 85 10 STA DIMFLG ;Restore Array Dimension Flag
;
; ==============================================================================
; Search Array Table for this Array Name
; ==============================================================================
;
E169: A6 6B FNDARY LDX ARYTAB ;Get Start of Arrays Pointer, Low
E16B: A5 6C LDA ARYTAB+1 ;Get Start of Arrays Pointer, High
; ;[(X,A)={Low,High}] = Search Pointer
E16D: 86 9B ARYLOOP STX LOWTR ;Set Array Variable Search Pointer, Low
E16F: 85 9C STA LOWTR+1 ;Set Array Variable Search Pointer, High
E171: C5 6E CMP STREND+1 ;Compare to End of Arrays Pointer, High
E173: D0 04 BNE ARYNAME ;Branch if Not at End of Array Table
E175: E4 6D CPX STREND ;Compare to End of Arrays Pointer, Low
E177: F0 3F BEQ NEWARYVAR ;Make New Array Variable if at End of Table
; ;Else, Found Array Var Name, Check it:
E179: A0 00 ARYNAME LDY #0 ;Point at 1st Character of Array Name
E17B: B1 9B LDA (LOWTR),Y ;Get 1st Character of Array Name
E17D: C8 INY ;Point at 2nd Character of Array Name
E17E: C5 81 CMP VARNAM ;Are Variable Names' 1st Characters Equal?
E180: D0 06 BNE NXTARY ;Keep Searching if Not a Match
E182: A5 82 LDA VARNAM+1 ;Get 2nd Character of Array Name
E184: D1 9B CMP (LOWTR),Y ;Are Variable Names' 2nd Characters Equal?
E186: F0 16 BEQ ARYVARFND ;Use Old Array Variable if Match Found
; ;Else, Not a Match, Keep Searching:
E188: C8 NXTARY INY ;Point at Offset to Next Array, Low
E189: B1 9B LDA (LOWTR),Y ;Get Offset to Next Array, Low
E18B: 18 CLC ;Prepare for Add with Carry
E18C: 65 9B ADC LOWTR ;Add Array Variable Search Pointer, Low
E18E: AA TAX ;Save Array Variable Search Pointer, Low
E18F: C8 INY ;Point at Offset to Next Array, High
E190: B1 9B LDA (LOWTR),Y ;Get Offset to Next Array, High
E192: 65 9C ADC LOWTR+1 ;Add Array Variable Search Pointer, High
; ;[(X,A)={Low,High}] = Search Pointer
E194: 90 D7 BCC ARYLOOP ;Loop-Back; Always Taken; If Not Taken,
; ;"Something is Wrong with the Universe!"
;
; ==============================================================================
; Print "Bad Subscript" or "Illegal Quantity" Error Message
; ==============================================================================
;
; ----------------------------------- ;Error Entry Point; Also User-Callable:
E196: A2 6B SUBERR LDX #ERR_BADSUBS ;Print "?Bad Subscript" Error Message
E198: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
; ----------------------------------- ;Error Entry Point; Also User-Callable:
E199: A2 35 IQERR LDX #ERR_ILLQTY ;Print "?Illegal Quantity" Error Message
E19B: 4C 12 D4 JMPERR JMP ERROR ;Go Print Error Message based on X-Reg
; ==============================================================================
; Match Found: Use Old Array Variable
; ==============================================================================
;
; ----------------------------------- ;Error Entry Point; NOT so User-Callable:
E19E: A2 78 ARYVARFND LDX #ERR_REDIMD ;Get "?Redim'd Array" Error Message Index
E1A0: A5 10 LDA DIMFLG ;Get Array Dimension Flag (DIM Call <> 0)
E1A2: D0 F7 BNE JMPERR ;Do Error if Called from DIM Statement
; ;^(Print Error Message based on X-Reg)
E1A4: A5 14 LDA SUBFLG ;Get Subscript Flag ($00=Allowed, $80=NOT)
E1A6: F0 02 BEQ CHKDIM ;If Allowed, Check if # of Dimensions Match
E1A8: 38 SEC ;Else, NOT Allowed; So Signal Array Found!
; ;\[Required by "STORE" Arrays to Tape Stt]
E1A9: 60 RTS ;Return to Caller (Exit if from GETARYPTR)
; ----------------------------------- ;Prepare to Find Array Element Specified:
E1AA: 20 ED E0 CHKDIM JSR GETARY ;Point to 1st Value in Array:
; ;Holding: Size of Last Array Dim, High
; ;Rtns: [(ARYPTR)=(LOWTR)+((Dims)*2)+(5)]
; ; [(ARYPTR)=[(A,Y)={Low,High}]]
;
; ----------------------------------- ;Check if Number of Dimensions Match:
E1AD: A5 0F LDA NUMDIM ;Get Number of Array Dimensions Specified
E1AF: A0 04 LDY #4 ;Point at Number of Array Dimensions (Old)
E1B1: D1 9B CMP (LOWTR),Y ;Do Arrays' Numbers of Dimensions Match?
E1B3: D0 E1 BNE SUBERR ;NO: Print "?Bad Subscript" Error Message
E1B5: 4C 4B E2 JMP FNDARYELM ;YES: Find Array Element Specified
;
; ==============================================================================
; Match NOT Found: Make New Array Variable?
; ==============================================================================
; ;Check if Called from GETARYPTR:
E1B8: A5 14 NEWARYVAR LDA SUBFLG ;Get Subscript Flag ($00=Allowed, $80=NOT)
E1BA: F0 05 BEQ MAKARY ;If Allowed, Create a New Array
; ;Else, Error!--Called from GETARYPTR:
; ----------------------------------- ;User-Callable Error Entry Point:
E1BC: A2 2A NODATERR LDX #ERR_NODATA ;Throw an "?Out Of Data" Error
E1BE: 4C 12 D4 JMP ERROR ;Go Print Error Message based on X-Reg
; ==============================================================================
; Make New Array Variable!
; ==============================================================================
E1C1: 20 ED E0 MAKARY JSR GETARY ;Point to 1st Value in Array:
; ;Holding: Size of Last Array Dimension, Hi
; ;Rtns: [(ARYPTR)=(LOWTR)+((Dims)*2)+(5)]
E1C4: 20 E3 D3 JSR REASON ;Assure: [(ARYPTR)=(A,Y)={Lo,Hi}]<(FRETOP)
; ------------------------------------------------------------------------------
; Point at Variable Name & Start Element Size Calculation:
; ------------------------------------------------------------------------------
; Here, Element Size (in bytes) is the Variable's Descriptor Part.
; In a Simple Variable Pointer, it is preceded by the Variable Name (2 bytes), &
; may be succeeded by a number of unused bytes, for a total of seven bytes.
; For Array Variables, the Dimension Size Elements (2 bytes each) succeed the
; Variable's Descriptor Part & the Pointer may exceed seven bytes in total
; length. These will also be added into the Element Size (below), which then
; becomes more than just the Variable's Descriptor, & is referred to as the
; "Total Bytes of all Array Elements."
; [Add two for the Array Varibles's Name at the beginning & you have the whole
; Array Variable Pointer length! So, why not just subtract 2 for the total?]
; ------------------------------------------------------------------------------
E1C7: A9 00 LDA #0 ;Clear Accumulator
E1C9: A8 TAY ;Clear Indirect Addressing Index
; ;^(Point at 1st Char of Variable Name)
E1CA: 85 AE STA STRNG2+1 ;Clear Size: Number of Array Elements, High
; ------------------------------------------------------------------
; <<< NOTE: The 3 OP lines above could have been written as 2: >>>
; ------------------------------------------------------------------
; LDY #0 ;Clear Indirect Addressing Index
; ;^(Point at 1st Char of Variable Name)
; STY STRNG2+1 ;Clear Size: No. of Array Elements, High
; ------------------------------------------------------------------
E1CC: A2 05 LDX #5 ;Assume Real Array Element Size: = 5 bytes
; ;VARNAM: Last-Used Variable Name Pointer
; ;is being used here to store the Var Name
; ;(Bytes)=($:+-;%:--;Real:++;Function:-+)
E1CE: A5 81 LDA VARNAM ;Get Last-Used Variable Name, Low (1st Chr)
E1D0: 91 9B STA (LOWTR),Y ;Set New Array Variable Name, Low (1st Chr)
E1D2: 10 01 BPL ARYNOTINT ;Branch if Not an Integer Array
E1D4: CA DEX ;Integer Array: Reduce Size to 4 Bytes
E1D5: C8 ARYNOTINT INY ;Advance Indirect Addressing Index to 1
; ;^(Point at 2nd Char of Variable Name)
E1D6: A5 82 LDA VARNAM+1 ;Get Last-Used Variable Name, High (2nd Chr)
E1D8: 91 9B STA (LOWTR),Y ;Set New Array Variable Name, High (2nd Chr)
E1DA: 10 02 BPL ARYISREAL ;Real Array: Keep Size of 5 bytes
E1DC: CA DEX ;String Array: Reduce Size to 3 Bytes
E1DD: CA DEX ;Integer Array: Reduce Size to 2 Bytes
; ------------------------------------------------------------------------------
; Now: (X)=(5|3|2)=(Real|String|Integer)=[Size of Var's Descriptor Part (bytes)]
; (Unused)=(0|2|3)=(Real|String|Integer)=[Latter bytes of Variable Pointer]
; (VarPtrLen)=(VarNameLen)+(X)+(Unused)=(2)+(X)+(Unused)=(7)
; (X)=(VarPtrLen)-(VarNameLen)-(Unused)=(7-2)-(Unused)=(5)-(Unused)
; ------------------------------------------------------------------------------
E1DE: 86 AD ARYISREAL STX STRNG2 ;Store Size: Number of Array Elements, Low
; ------------------------------------------------------------------------------
E1E0: A5 0F LDA NUMDIM ;Get Number of Dimensions
; ;Bypass Offset to Next Array (set later):
E1E2: C8 INY ;Advance Indirect Addressing Index to 2
E1E3: C8 INY ;Advance Indirect Addressing Index to 3
E1E4: C8 INY ;Advance Indirect Addressing Index to 4
E1E5: 91 9B STA (LOWTR),Y ;Store # of Dims in 5Th Byte of Array Ptr
; ------------------------------------------------------------------------------
; Save Dimensions LOOP: Stores Dimension Elements in Array Variable Pointer
; ------------------------------------------------------------------------------
E1E7: A2 0B SAVDIM LDX #11 ;Default Dimension, Low (10+1=11 Elements)
E1E9: A9 00 LDA #0 ;Default Dimension, High (Zero)
E1EB: 24 10 BIT DIMFLG ;Check Array Dimension Flag (DIM Call <> 0)
E1ED: 50 08 BVC DFLTDIM ;Use Default Value if NOT Dimensioned Array
; ----------------------------------- ;Put Specified DIM in [(X,A)={Low,High}]:
E1EF: 68 PLA ;Pull Specified Array Dimension, Low
E1F0: 18 CLC ;Prepare for Add with Carry
E1F1: 69 01 ADC #1 ;Size: [(Elements)=(Specified Dimension)+1]
E1F3: AA TAX ;Set (X) to Number of Dim Elements, Low
E1F4: 68 PLA ;Pull Specified Array Dimension, High
E1F5: 69 00 ADC #0 ;Set (A) to Number of Dim Elements, High
; ------------------------------------------------------------------------------
; Build Dimension Table within Array Variable:
; ------------------------------------------------------------------------------
; DIMs start with the last one & go down to first (N, N-1, N-2, ..., 2, 1, 0);
; Each DIM is 2 bytes long & in {High,Low} (vs. the normal {Low,High}) format!
; ------------------------------------------------------------------------------
; ;Add Dimension Size to Array Descriptor:
E1F7: C8 DFLTDIM INY ;Advance Indirect Addressing Index
; ;^(Point at Next Dimension Size, High)
E1F8: 91 9B STA (LOWTR),Y ;Set Size: Number of Dim Elements, High
E1FA: C8 INY ;Advance Indirect Addressing Index
; ;^(Point at Next Dimension Size, Low)
E1FB: 8A TXA ;Get Size: Number of Dim Elements, Low
E1FC: 91 9B STA (LOWTR),Y ;Set Size: Number of Dim Elements, Low
; ;-----------------------------------------
E1FE: 20 AD E2 JSR MULTSUBS ;Multiply this Dimension by Running Size
; ;-----------------------------------------
E201: 86 AD STX STRNG2 ;Store Running Size, Low
E203: 85 AE STA STRNG2+1 ;Store Running Size, High
E205: A4 5E LDY INDEX ;Retrieve (Y) saved by MULTSUBS
; ;^(Point at Last-Used Dimension Size, Low)
E207: C6 0F DEC NUMDIM ;Count Down: Number of Dimensions
E209: D0 DC BNE SAVDIM ;Loop until Done: Count Down to Zero
; ------------------------------------------------------------------------------
; Now: Total Bytes of all Array Elements (Running Size) is [(X,A)={Low,High}]
; ==============================================================================
; Get Address at End of Array & Assure sufficient Arrays-to-Strings Free-Space:
; ------------------------------------------------------------------------------
; ;Point to End of Array (Compute Address):
E20B: 65 95 ADC ARYPTR+1 ;Add Address of 1st Value in Array, High
E20D: B0 5D BCS GME ;Do "?Out Of Memory" Error if too large
E20F: 85 95 STA ARYPTR+1 ;Save as Array End Address, High
E211: A8 TAY ;Save High End Address in (Y), too
E212: 8A TXA ;Get Total Bytes of all Array Elements, Low
E213: 65 94 ADC ARYPTR ;Add Address of 1st Value in Array, Low
E215: 90 03 BCC CHKARYSPC ;Skip Advancing High Byte if NO Carryover
E217: C8 INY ;Add Carry to (Y): Array End Address, High
E218: F0 52 BEQ GME ;Do "?Out Of Memory" Error if too large
; ------------------------------------------------------------------------------
; Now: [(A,Y)={Low,High}] = Address to which Array Space needs to grow
; ------------------------------------------------------------------------------
E21A: 20 E3 D3 CHKARYSPC JSR REASON ;Assure [(ARYPTR)=(A,Y)={Low,High}]<(FRETOP)
E21D: 85 6D STA STREND ;Set End of Array Vars & Ptrs Storage, Low
E21F: 84 6E STY STREND+1 ;Set End of Array Vars & Ptrs Storage, High
; ----------------------------------- ;Prepare to Clear the Array:
E221: A9 00 LDA #0 ;Prepare to Zero the Array Elements
; ;Compensate for Reduction at Top of Loop:
E223: E6 AE INC STRNG2+1 ;Advance Count: Running Size, High
E225: A4 AD LDY STRNG2 ;Get Count: Running Size, Low
E227: F0 05 BEQ CLRNXTPG ;Branch if No Partial Page to Clear
; ----------------------------------- ;Clear the Array (from Top to Bottom):
E229: 88 CLRARY DEY ;Reduce Count: Running Size, Low
E22A: 91 94 STA (ARYPTR),Y ;Clear a Page of 256 Bytes or less
E22C: D0 FB BNE CLRARY ;Loop until Done with Page
; ----------------------------------- ;Clear the Array (Full Pages Entry Point):
E22E: C6 95 CLRNXTPG DEC ARYPTR+1 ;Reduce Page: Array End Address, High
E230: C6 AE DEC STRNG2+1 ;Reduce Count: Running Size, High
E232: D0 F5 BNE CLRARY ;Loop until Done with All Pages
; ------------------------------------------------------------------------------
; Compute Offset to Next Variable (End Of Arrays) & Store in Array Descriptor:
; ------------------------------------------------------------------------------
; ;Point at this Array's 1st Element:
E234: E6 95 INC ARYPTR+1 ;Advance Page: Array End Address, High
E236: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
E237: A5 6D LDA STREND ;Get End of Array Vars & Ptrs Storage, Low
E239: E5 9B SBC LOWTR ;Subtract this Array Variable Address, Low
E23B: A0 02 LDY #2 ;Point at Offset to Next Variable, low
E23D: 91 9B STA (LOWTR),Y ;Set Offset to NxtVar (End Of Arrays), low
E23F: A5 6E LDA STREND+1 ;Get End of Array Vars & Ptrs Storage, High
E241: C8 INY ;Point at Offset to Next Variable, High
E242: E5 9C SBC LOWTR+1 ;Subtract this Array Variable Address, High
E244: 91 9B STA (LOWTR),Y ;Set Offset to NxtVar (End Of Arrays), High
; ----------------------------------- ;Was this S/R Called from a DIM Statement?
E246: A5 10 LDA DIMFLG ;Get Array Dimension Flag (DIM Call <> 0)
E248: D0 62 BNE BAS_RTS14 ;YES: We Are Finished!
; ;NO: Now we need to find the Element
;
; ==============================================================================
; Find Array Element Specified
; ==============================================================================
; (LOWTR),Y Points at Number of Dimensions in the Array Descriptor.
; The Dimension Subscripts are all on the Stack as Integers.
; ==============================================================================
;
E24A: C8 INY ;Point at Number of Dimensions
E24B: B1 9B FNDARYELM LDA (LOWTR),Y ;Get Number of Dimensions
E24D: 85 0F STA NUMDIM ;Save Number of Dimensions
E24F: A9 00 LDA #0 ;Clear Accumulator
E251: 85 AD STA STRNG2 ;Clear Subscript Accumulator, Low; & High:
; ----------------------------------- ;Dimension {Check/Look-Up/Search} Loop:
E253: 85 AE DIMLUP STA STRNG2+1 ;Set Subscript Accumulator, High
E255: C8 INY ;Point at Last Dimension Size, High
E256: 68 PLA ;Pull Next Subscript, Low
E257: AA TAX ;Save it in X-Reg as Current Subscript, Low
E258: 85 A0 STA TMPVPTR ;Set (FAC+3) as Current Subscript, Low
E25A: 68 PLA ;Pull Next Subscript, High
E25B: 85 A1 STA TMPVPTR+1 ;Set (FAC+4) as Current Subscript, High
E25D: D1 9B CMP (LOWTR),Y ;Compare it with Dimensioned Size, High
E25F: 90 0E BCC DIMOK ;Branch if Subscript is Not Too Large
E261: D0 06 BNE GSE ;Branch if Subscript is Too Large (Error!)
E263: C8 INY ;Point at Last Dimension Size, Low
E264: 8A TXA ;Retrieve Current Subscript, Low
E265: D1 9B CMP (LOWTR),Y ;Compare it with Dimensioned Size, Low
E267: 90 07 BCC DIMOK1 ;Branch if Subscript is Not Too Large
; ;Else, Subscript is Too Large (Error!)
;
; ------------------------------------------------------------------------------
; Error Vectors:
; ------------------------------------------------------------------------------
;
E269: 4C 96 E1 GSE JMP SUBERR ;Print "?Bad Subscript" Error Message
E26C: 4C 10 D4 GME JMP MEMERR ;Do "?Out Of Memory" Error
; ------------------------------------------------------------------------------
; Find Array Element Specified (continued)
; ------------------------------------------------------------------------------
;
; ;Determine if 1st time through S/R:
E26F: C8 DIMOK INY ;Point at Last Dimension Size, Low
E270: A5 AE DIMOK1 LDA STRNG2+1 ;Get Subscript from Sub Accumulator, High
E272: 05 AD ORA STRNG2 ;Get Subscript from Sub Accumulator, Low
; ;(A)=(High OR Low)=(0) if Subscript is 0
E274: 18 CLC ;Prepare for Add with Carry
E275: F0 0A BEQ NEXTDIM ;Branch if (A)=(0): 1st time through
; ;^ Also prevents Multiplying by Zero
E277: 20 AD E2 JSR MULTSUBS ;Not Zero, So Multiply Subscripts
; ;---- Multiplies: [(STRNG2)*[(LOWTR),Y]]
; ;Returns Product: [(X,(A=Y))={Low,High}]
E27A: 8A TXA ;Get from (X): Product of Subscripts, Low
; ;^[Overwrites (A): Product of Subs, High)
E27B: 65 A0 ADC TMPVPTR ;Add Current Subscript, Low (FAC+3)
E27D: AA TAX ;Save Result in X-Reg
E27E: 98 TYA ;Get from (Y): Product of Subscripts, High
E27F: A4 5E LDY INDEX ;Retrieve (Y): Saved by MULTSUBS
; ;^(Points at Last Dimension Size, Low)
E281: 65 A1 NEXTDIM ADC TMPVPTR+1 ;Add Current Subscript, High (FAC+4)
E283: 86 AD STX STRNG2 ;Store Accumulated Offset, Low
E285: C6 0F DEC NUMDIM ;Reduce Loop Counter: Number of Dimensions
E287: D0 CA BNE DIMLUP ;Loop until All Subscripts are Done
; ;Now Multiply by Element Size:
E289: 85 AE STA STRNG2+1 ;Store Accumulated Offset, High
E28B: A2 05 LDX #5 ;Real Array: Start with Size of 5 Bytes
E28D: A5 81 LDA VARNAM ;Get Last-Used Variable Name Pointer, Low
E28F: 10 01 BPL DIMNOTINT ;Branch if Not Integer Variable
E291: CA DEX ;Else, Integer: Reduce Size to 4 Bytes
E292: A5 82 DIMNOTINT LDA VARNAM+1 ;Get Last-Used Variable Name Pointer, High
E294: 10 02 BPL DIMISREAL ;Branch if Real: Keep Size of {5|4} Bytes
E296: CA DEX ;String Array: Reduce Size to 3 Bytes
E297: CA DEX ;Integer Array: Reduce Size to 2 Bytes
E298: 86 64 DIMISREAL STX RESULT+2 ;Set Multiplier: Size of Each Entry, Low
E29A: A9 00 LDA #0 ;Set Multiplier: Size of Each Entry, High
E29C: 20 B6 E2 JSR MULTSUBS1 ;Multiply Product of Dimensions (STRNG2) by
; ;Size of Each Element [(X,A)={Low,High}]
; ;Returns Product: [(X,(A=Y))={Low,High}]
E29F: 8A TXA ;Get from (X): Accumulated Offset, Low
; ;^[Overwrites (A): Accumulated Offset, Hi]
E2A0: 65 94 ADC ARYPTR ;Add Address of 1st Array Element, Low
E2A2: 85 83 STA VARPTR ;Set Specified Element Pointer, Low
E2A4: 98 TYA ;Get from (Y): Accumulated Offset, High
E2A5: 65 95 ADC ARYPTR+1 ;Add Address of 1st Array Element, High
E2A7: 85 84 STA VARPTR+1 ;Set Specified Element Pointer, High
E2A9: A8 TAY ;Set (Y): Specified Element Pointer, High
E2AA: A5 83 LDA VARPTR ;Set (A): Specified Element Pointer, Low
; ;--- (X): Accumulated Offset, Low
E2AC: 60 BAS_RTS14 RTS ;Return [(A,Y)={Low,High}] & (X) to Caller
; ==============================================================================
; 16-bit Integer Multiplication Routine: (Used Only by Array Subscript Routines)
; ==============================================================================
;
; ------------------------------------------------------------------------------
; 1st Entry Point Returns Product: [(X,(A=Y))={Low,High}]=[(STRNG2)*[(LOWTR),Y]]
; ------------------------------------------------------------------------------
E2AD: 84 5E MULTSUBS STY INDEX ;Save (Y) for Caller to Retieve after RTS
E2AF: B1 9B LDA (LOWTR),Y ;Get Multiplier, Low
E2B1: 85 64 STA RESULT+2 ;Save Multiplier, Low
E2B3: 88 DEY ;Point at Multiplier, High
E2B4: B1 9B LDA (LOWTR),Y ;Get Multiplier, High
; ------------------------------------------------------------------------------
; 2nd Entry Point Returns Product: [(X,(A=Y))={Low,High}]=[(STRNG2)*(X,A)]
; ------------------------------------------------------------------------------
E2B6: 85 65 MULTSUBS1 STA RESULT+3 ;Save Multiplier, High
E2B8: A9 10 LDA #16 ;Get Index for 16-bit Multiplication
E2BA: 85 99 STA INDX ;Set Index for 16-bit Multiplication
; ;Initialize Product:
E2BC: A2 00 LDX #0 ;Clear Product, Low
E2BE: A0 00 LDY #0 ;Clear Product, High
; ----------------------------------- ;Multiply Subs Loop:
E2C0: 8A MLTSBSLOOP TXA ;Get Product, Low
E2C1: 0A ASL A ;Double Product, Low
E2C2: AA TAX ;Save Product, Low
E2C3: 98 TYA ;Get Product, High
E2C4: 2A ROL A ;Double Product (& Add Carry), High
E2C5: A8 TAY ;Save Product, High
E2C6: B0 A4 BCS GME ;Do "?Out Of Memory" Error if too large
E2C8: 06 AD ASL STRNG2 ;Double Subscript Accumulated Offset, Low
E2CA: 26 AE ROL STRNG2+1 ;Double Subs Accumulated Offset (+C), High
E2CC: 90 0B BCC MULTSUBS1_2 ;BLT: Branch if Not too large
; ;Else: Add into Partial Product:
E2CE: 18 CLC ;Prepare for Add with Carry
E2CF: 8A TXA ;Get Product, Low
E2D0: 65 64 ADC RESULT+2 ;Add (with Carry) Multiplier, Low
E2D2: AA TAX ;Save Product, Low
E2D3: 98 TYA ;Get Product, High
E2D4: 65 65 ADC RESULT+3 ;Add (with Carry) Multiplier, High
E2D6: A8 TAY ;Save Product, High
E2D7: B0 93 BCS GME ;Do "?Out Of Memory" Error if too large
E2D9: C6 99 MULTSUBS1_2 DEC INDX ;Reduce Bit Counter Index
E2DB: D0 E3 BNE MLTSBSLOOP ;Loop Untill All 16-bits are Done
E2DD: 60 RTS ;Return [(X,(A=Y))={Low,High}] to Caller
; ==============================================================================
; "FRE" Statement: Immediate & Deferred; Parameter: FRE (Any Legal Expression);
; E.g., X=FRE(0); Collects Garbage & Returns Number of Bytes of Free Memory left
; ==============================================================================
;
E2DE: A5 11 FRE LDA VALTYP ;Get Variable Type ($00=Num, $FF=Str)
E2E0: F0 03 BEQ FREESPACE ;Branch if Variable Type is Numeric
E2E2: 20 00 E6 JSR FREFAC ;Free up TMPVPTR & a Temp String
E2E5: 20 84 E4 FREESPACE JSR GARBAGE ;Maximize Free-Space, Collect Garbage ...
E2E8: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
E2E9: A5 6F LDA FRETOP ;Get FreSpcEnd & StringStorageStart, Low
E2EB: E5 6D SBC STREND ;Subtract End of Vars & Ptrs Storage, Low
E2ED: A8 TAY ;Now: (Y) is Free Space, Low
E2EE: A5 70 LDA FRETOP+1 ;Get FreSpcEnd & StringStorageStart, High
E2F0: E5 6E SBC STREND+1 ;Subtract End of Vars & Ptrs Storage, High
; ;Now: (A) is Free Space, High
;
; ------------------------------------------------------------------------------
; Float Signed Integer in [(Y,A)={Low,High}] into FAC
; ------------------------------------------------------------------------------
;
E2F2: A2 00 GIVAYF LDX #0 ;Clear X-Index Register
E2F4: 86 11 STX VALTYP ;Set Variable Type as Numeric (=0)
E2F6: 85 9E STA FAC+1 ;Save (A) in FAC Mantissa, Top; (A)={High}
E2F8: 84 9F STY FAC+2 ;Save (Y) in FAC Mantissa, High; (Y)={Low}
; ;<<< Don't FAC+3,4 Need to be Cleared? >>>
E2FA: A2 90 LDX #$90 ;Set Exponent to 2^16 = 65,536 = %0001,0000
; ;FAC FP#, So Set High Bit: $90=%1001,0000
; ;(Shifts Decimal Pt. 16-bits to the Right)
E2FC: 4C 9B EB JMP FLOAT1 ;Convert to Signed Real/FP Number in FAC
; ==============================================================================
; "POS" Position Function
; ==============================================================================
;
E2FF: A4 24 POS LDY CH ;Get Current Cursor Horizontal Displacement
;
; ------------------------------------------------------------------------------
; Convert Number in Y-Index Register to Real/FP Number in FAC
; ------------------------------------------------------------------------------
;
; ;Float Unsigned Integer & Flag as Number:
E301: A9 00 SNGFLT LDA #0 ;Clear Accumulator; for: [(Y,A)={Low,High}]
E303: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
; ;<< SEC has no purpose whatsoever here! >>
; ;Float Signed Integer in [(Y,A)={Lo,Hi}]:
E304: F0 EC BEQ GIVAYF ;Always Taken
; ==============================================================================
; Print "?Illegal Direct" or "?Undef'd Function" Error Message
; ==============================================================================
;
E306: A6 76 ERRDIR LDX CURLIN+1 ;Which Program Mode: Running or Direct?
E308: E8 INX ;If in Direct Mode: (X)=[($FF)-->(0)]
E309: D0 A1 BNE BAS_RTS14 ;Branch If in Direct Mode [(X)=(0)]
; ----------------------------------- ;User-Callable Error Entry Point:
E30B: A2 95 IDERR LDX #ERR_ILLDIR ;Throw an "?Illegal Direct" Error
E30D: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
; ----------------------------------- ;Error Entry Point; Also User-Callable:
E30E: A2 E0 UNDFNCERR LDX #ERR_UNDEFFUNC ;Throw an "?Undef'd Function" Error
E310: 4C 12 D4 JMP ERROR ;Go Print Error Message based on X-Reg
; ==============================================================================
; "DEF" Statement: Deferred Only; Defines User Functions in Applesoft Programs
; ==============================================================================
; Parameters: DEF FN Name (real avar) = aexpr1
; FN Name (aexpr2)
; ==============================================================================
; "FN" Statement: Immediate & Deferred; Puts User Functions to Work [see below]
; ==============================================================================
; Structure of a User Defined Function Variable Pointer:
; ------------------------------------------------------------------------------
; Byte 0: Varible Name Character 1 (Negative):
; 1: Varible Name Character 2 (Postive):
; ^ [A Function Name is a Simple Variable]
; 2: Address of Definition, Low:
; 3: Address of Definition, High:
; ^ [Program Memory Address of 1st Character of Expression (after "=")]
; 4: Address of Argument Variable, Low:
; 5: Address of Argument Variable, High:
; ^ [Address of the Real Variable after the Function Name: FN Name (RV)]
; 6: First Character of Definition:
; ^ [1st Character of Expression (after "=")]
; ==============================================================================
;
; ;Setup Function Name Variable:
E313: 20 41 E3 DEF JSR FN_NAME ;Parse FN, Function Name
E316: 20 06 E3 JSR ERRDIR ;Do Illegal Direct Error if in Direct Mode
E319: 20 BB DE JSR CHKOPN ;Must have Opening Parenthesis ["("] Now!
; ----------------------------------- ;Flag PRTGET that Call's frm here, DEF FN:
E31C: A9 80 LDA #$80 ;Flag for Subscripts NOT Allowed
E31E: 85 14 STA SUBFLG ;Set Subscript Flag ($00=Allowed, $80=NOT)
; ----------------------------------- ;Get Pointer to Argument:
E320: 20 E3 DF JSR PTRGET ;Locate Variable: Returns Address
; ;in VARPTR & [(A,Y)={Low,High}]
; ----------------------------------- ;Assure Proper Form: DEF FN Name (Var)=Exp
E323: 20 6A DD JSR CHKNUM ;Assure (FAC) Type is Numeric (VALTYP=$00)
E326: 20 B8 DE JSR CHKCLS ;Must have Closing Parenthesis [")"] Now!
E329: A9 D0 LDA #TOK_EQUAL ;Must have "Equal To" Char/Token ("=") Now!
E32B: 20 C0 DE JSR SYNCHR ;Check Current Char & Get Next Char/Token
; ----------------------------------- ;[See Next: Common Parse FN_NAME Routine]
; ;Save 1st Character of Definition:
E32E: 48 PHA ;Push Char/Token after Equal Sign ("=")
; ----------------------------------- ;Save Pointer to Argument:
E32F: A5 84 LDA VARPTR+1 ;Get Last-Used Variable Value Pointer, High
E331: 48 PHA ;Push Last-Used Variable Value Pointer, High
E332: A5 83 LDA VARPTR ;Get Last-Used Variable Value Pointer, Low
E334: 48 PHA ;Push Last-Used Variable Value Pointer, Low
; ----------------------------------- ;Save CHRGET's Next Char/Token Pointer:
E335: A5 B9 LDA TXTPTR+1 ;Get Next Char/Token Pointer, High
E337: 48 PHA ;Push Next Char/Token Pointer, High
E338: A5 B8 LDA TXTPTR ;Get Next Char/Token Pointer, Low
E33A: 48 PHA ;Push Next Char/Token Pointer, Low
E33B: 20 95 D9 JSR DATA ;Advance TXTPTR to Next ":" or EOL
E33E: 4C AF E3 JMP FN_DATA ;Store 5 bytes Pushed above into FN "Value"
; ==============================================================================
; Common Routine for DEF FN & FN, to Parse the Function & the Function Name
; ==============================================================================
;
E341: A9 C2 FN_NAME LDA #TOK_FN ;Must have "FN" Token Now!
E343: 20 C0 DE JSR SYNCHR ;Check Current Char & Get Next Char/Token
; ;^[Throw Syntax Error If CurChr Not "FN"]
E346: 09 80 ORA #$80 ;Set Sign Bit on 1st Character of FN Name,
E348: 85 14 STA SUBFLG ;Making $C0 < SUBFLG < $DB,
E34A: 20 EA DF JSR PTRGET3 ;Which tells PTRGET who Called
; ;Found Valid Function Name; Save Address:
E34D: 85 8A STA FNCNAM ;Set Function Name Pointer, Low
E34F: 84 8B STY FNCNAM+1 ;Set Function Name Pointer, High
; ;Adrs now in FNCNAM & [(A,Y)={Low,High}]
E351: 4C 6A DD JMP CHKNUM ;Assure (FAC) Type is Numeric (VALTYP=$00)
; ==============================================================================
; "FN" Statement: Immediate & Deferred; Puts Defined User Functions to Work
; ==============================================================================
; Parameters: FN Name (aexpr2)
; ==============================================================================
; [See above: "Structure of a User Defined Function Variable Pointer"]
; ==============================================================================
;
E354: 20 41 E3 FN_CALL JSR FN_NAME ;Parse FN, Function Name
; ----------------------------------- ;Stack FN Address for Nested FN Calls:
E357: A5 8B LDA FNCNAM+1 ;Get Function Name Pointer, High
E359: 48 PHA ;Push Function Name Pointer, High
E35A: A5 8A LDA FNCNAM ;Get Function Name Pointer, Low
E35C: 48 PHA ;Push Function Name Pointer, Low
; ----------------------------------- ;May have Nested FN Calls:
E35D: 20 B2 DE JSR PARCHK ;Must have "(Expression)" Now; Eval to FAC
E360: 20 6A DD JSR CHKNUM ;Assure (FAC) Type is Numeric (VALTYP=$00)
; ----------------------------------- ;Restore FN Address for Nested FN Calls:
E363: 68 PLA ;Pull Function Name Pointer, Low
E364: 85 8A STA FNCNAM ;Set Function Name Pointer, Low
E366: 68 PLA ;Pull Function Name Pointer, High
E367: 85 8B STA FNCNAM+1 ;Set Function Name Pointer, High
; ------------------------------------;Set Old-Variable Value Pointer:
E369: A0 02 LDY #2 ;Point at Argument Variable Pointer, Low
E36B: B1 8A LDA (FNCNAM),Y ;Get Argument Variable Pointer, Low
E36D: 85 83 STA VARPTR ;Set Old-Variable Value Pointer, Low
E36F: AA TAX ;Save Argument Variable Pointer, Low
E370: C8 INY ;Point at Argument Variable Pointer, High
E371: B1 8A LDA (FNCNAM),Y ;Get Argument Variable Pointer, High
E373: F0 99 BEQ UNDFNCERR ;Throw an "?Undef'd Function" Error if Null
E375: 85 84 STA VARPTR+1 ;Else: Set Old-Variable Value Pointer, High
; ;Now AVP is in VARPTR & [(X,A)={Low,High}]
; ----------------------------------- ;Push Value of any pre-existing Old-Var
; ;with the same Name as Argument Variable:
E377: C8 INY ;Now: (Y)=(4)
E378: B1 83 SAVOLD LDA (VARPTR),Y ;Get Old-Variable Value
E37A: 48 PHA ;Push Old-Variable Value
E37B: 88 DEY ;Count Down (Pushes 5 bytes)
E37C: 10 FA BPL SAVOLD ;Loop until Done [(Y)=(0)]
E37E: A4 84 LDY VARPTR+1 ;Get Old-Variable Value Pointer, High
; ----------------------------------- ;Now Old-Var Valu is in [(X,Y)={Low,High}]
E380: 20 2B EB JSR FACRND2XY ;Store FAC (Rounded) in Old-Variable
; ----------------------------------- ;Save Program Position:
; ;Save CHRGET's Next Char/Token Pointer
; ;(Remember TXTPTR for after FN call):
E383: A5 B9 LDA TXTPTR+1 ;Get Next Char/Token Pointer, High
E385: 48 PHA ;Push Next Char/Token Pointer, High
E386: A5 B8 LDA TXTPTR ;Get Next Char/Token Pointer, Low
E388: 48 PHA ;Push Next Char/Token Pointer, Low
; ----------------------------------- ;Point CHRGET at Function Definition:
; ;Now, still: [(Y)=(0)] from FACRND2XY
E389: B1 8A LDA (FNCNAM),Y ;Get Function Definition Pointer, Low
E38B: 85 B8 STA TXTPTR ;Set Next Char/Token Pointer, Low
E38D: C8 INY ;Advance Indirect Addressing Index
E38E: B1 8A LDA (FNCNAM),Y ;Get Function Definition Pointer, High
E390: 85 B9 STA TXTPTR+1 ;Set Next Char/Token Pointer, High
; ----------------------------------- ;Save Address of Argument Variable:
E392: A5 84 LDA VARPTR+1 ;Get Argument Variable Pointer, High
E394: 48 PHA ;Push Address of Argument Variable, High
E395: A5 83 LDA VARPTR ;Get Argument Variable Pointer, Low
E397: 48 PHA ;Push Address of Argument Variable, Low
; ----------------------------------- ;AVP is stl in VARPTR & [(X,A)={Low,High}]
E398: 20 67 DD JSR FRMNUM ;Evaluate Function
; ----------------------------------- ;Pull & Save Address of Argument Variable:
E39B: 68 PLA ;Pull Address of Argument Variable, Low
E39C: 85 8A STA FNCNAM ;Save Argument Variable Pointer, Low
E39E: 68 PLA ;Pull Address of Argument Variable, High
E39F: 85 8B STA FNCNAM+1 ;Save Argument Variable Pointer, Low
; ----------------------------------- ;Are we Done with the Definition?
E3A1: 20 B7 00 JSR CHRGOT ;Get Last Char/Token Gotten
E3A4: F0 03 BEQ GETOLD ;TXTPTR Must be at Next ":" or EOL
E3A6: 4C C9 DE JMP SYNERROR ;Throw a "?Syntax" Error if it is Not there
; ----------------------------------- ;Retrieve Program Position:
; ;Retrieve CHRGET's Next Char/Token Pointer
; ;(TXTPTR Remembered for after FN call):
E3A9: 68 GETOLD PLA ;Pull Next Char/Token Pointer, Low
E3AA: 85 B8 STA TXTPTR ;Restore Next Char/Token Pointer, Low
E3AC: 68 PLA ;Pull Next Char/Token Pointer, High
E3AD: 85 B9 STA TXTPTR+1 ;Restore Next Char/Token Pointer, High
; ----------------------------------- ;Retrieve Old-Variable Valu; Pull 5 bytes:
E3AF: A0 00 FN_DATA LDY #0 ;Clear Indirect Addressing Index (=0)
; <<< Why No Count Down Loop here, too; Inverted as in SAVOLD above? >>>
E3B1: 68 PLA ;Pull Old-Variable Value
E3B2: 91 8A STA (FNCNAM),Y ;Restore Old-Variable Value
E3B4: 68 PLA ;Pull Old-Variable Value
E3B5: C8 INY ;Advance Indirect Addressing Index (=1)
E3B6: 91 8A STA (FNCNAM),Y ;Restore Old-Variable Value
E3B8: 68 PLA ;Pull Old-Variable Value
E3B9: C8 INY ;Advance Indirect Addressing Index (=2)
E3BA: 91 8A STA (FNCNAM),Y ;Restore Old-Variable Value
E3BC: 68 PLA ;Pull Old-Variable Value
E3BD: C8 INY ;Advance Indirect Addressing Index (=3)
E3BE: 91 8A STA (FNCNAM),Y ;Restore Old-Variable Value
E3C0: 68 PLA ;Pull Old-Variable Value
E3C1: C8 INY ;Advance Indirect Addressing Index (=4)
E3C2: 91 8A STA (FNCNAM),Y ;Restore Old-Variable Value
E3C4: 60 RTS ;Return to Caller
; ==============================================================================
; "STR$" String Function: Immediate & Deferred; Parameter: STR$(aexpr)
; ==============================================================================
; Converts a Number (aexpr) into a String representing its Value.
; The Number is evaluated before it is converted into a String.
; If the Number exceeds the limit for Reals, an Overflow Error occurs.
; ==============================================================================
;
E3C5: 20 6A DD STR JSR CHKNUM ;Assure (FAC) Type is Numeric (VALTYP=$00)
E3C8: A0 00 LDY #>FOUTBUFF ;Starts String at STACK-1 ($00FF)
E3CA: 20 36 ED JSR FOUT1 ;Convert FAC to Z-String in FOUT-Buffer
; <<< How do we know there wasn't a collision with the Top of the Stack? >>>
E3CD: 68 PLA ;Pull/Discard Return Address, Low
E3CE: 68 PLA ;Pull/Discard Return Address, High
E3CF: A9 FF LDA #FOUTBUFF ;Point to STACK-1, Low
E3D1: A0 00 LDY #>FOUTBUFF ;Point to STACK-1, High {Zero-Page}
E3D3: F0 12 BEQ STRLTRL ;Make FOUT-Buffer into a Literal "String"
; ==============================================================================
; Initialize String Space & Set String Descriptors for a Character String:
; ==============================================================================
E3D5: A6 A0 STRINI LDX TMPVPTR ;Get Temp Variable Pointer, Low (FAC+3)
E3D7: A4 A1 LDY TMPVPTR+1 ;Get Temp Variable Pointer, High (FAC+4)
E3D9: 86 8C STX DSCPTR ;Set String Descriptor Pointer, Low
E3DB: 84 8D STY DSCPTR+1 ;Set String Descriptor Pointer, High
; ==============================================================================
; Make String Space & Set the Temporary Descriptor for a Character String:
; ==============================================================================
E3DD: 20 52 E4 STRSPC JSR GETSPACE ;Get Space for the Character String
E3E0: 86 9E STX DSCTMPL ;Set Temp Descriptor, Str Ptr, Low (FAC+1)
E3E2: 84 9F STY DSCTMPH ;Set Temp Descriptor, Str Ptr, High (FAC+2)
E3E4: 85 9D STA DSCTMP ;Set Temp Descriptor, String Length (FAC+0)
E3E6: 60 RTS ;Retun to Caller
; ==============================================================================
; String Literal #1: Make String {AY/INPUT/STACK} Buffer into a Literal "String"
; ==============================================================================
; Build a Descriptor for String starting at [(A,Y)={Low,High}] terminated only
; by a Zero or a Quotation Mark [built ins]. Return with a Temporary Descriptor
; and its Address in DSCTMP (FAC+0,1,2) and TMPVPTR (FAC+3,4), respectively; and
; Flag as String Variable (VALTYP = $FF).
; ==============================================================================
; Setup Literal Scan Delimiters to Stop STRLTRL2 only on a Zero or a Quote Mark:
; ------------------------------------------------------------------------------
E3E7: A2 22 STRLTRL LDX #'"' ;Get a Quotation Mark/Character
E3E9: 86 0D STX CHARAC ;Store Quote so STRLTRL2 will stop on it
E3EB: 86 0E STX ENDCHR ;Store Quote so STRLTRL2 will stop on it
; ==============================================================================
; String Literal #2: Make String {AY/INPUT/STACK} Buffer into a Literal "String"
; ==============================================================================
; Build Descriptor for String starting at [(A,Y)={Low,High}] terminated by Zero
; or Quote Mark [built ins], & CHARAC or ENDCHR [caller/user must-be presets].
; Return with a Temp Descriptor and its Address in DSCTMP (FAC+0,1,2) and
; TMPVPTR (FAC+3,4), respectively; and Flag as String Variable (VALTYP = $FF).
; ==============================================================================
E3ED: 85 AB STRLTRL2 STA STRNG1 ;Set Start of String: TmpStrPtr#1, Low
E3EF: 84 AC STY STRNG1+1 ;Set Start of String: TmpStrPtr#1, High
E3F1: 85 9E STA DSCTMPL ;Set Temp Descriptor, String Pointer, Low
E3F3: 84 9F STY DSCTMPH ;Set Temp Descriptor, String Pointer, High
; ----------------------------------- ;Find End of String:
E3F5: A0 FF LDY #$FF ;Preset Indirect Addressing Index
E3F7: C8 STRFNDEND INY ;Advance Indirect Addressing Index
E3F8: B1 AB LDA (STRNG1),Y ;Get Next String Character
E3FA: F0 0C BEQ STRZNDFND ;Branch if [Z=1] End of Zero-String Found
E3FC: C5 0D CMP CHARAC ;Else [Z=0]: Is it Alternate Terminator #1?
E3FE: F0 04 BEQ STRENDFND ;Branch if [Z=1] End of String Found
E400: C5 0E CMP ENDCHR ;Else [Z=0]: Is it Alternate Terminator #2?
E402: D0 F3 BNE STRFNDEND ;Loop if [Z=0] End of String NOT Found
; ----------------------------------- ;Else [Z=1]: End of String Found
E404: C9 22 STRENDFND CMP #'"' ;Is it a Quotation Mark?
E406: F0 01 BEQ STRQNDFND ;Branch if [Z=1] Quote Found [C=1]
; ;Else [Z=0]: Quote NOT Found [C=(A>='"')]
; ----------------------------------- ;Calculate End of String Address:
E408: 18 STRZNDFND CLC ;Prepare to Add with NO Carry (No Quote!)
; ;Else [C=1]: Includes '"' in Str (Length)
E409: 84 9D STRQNDFND STY DSCTMP ;Set Temp Descriptor, String Length
E40B: 98 TYA ;Get Temp Descriptor, String Length
E40C: 65 AB ADC STRNG1 ;Add Start of String: TmpStrPtr#1, Low
E40E: 85 AD STA STRNG2 ;Set End of String: TmpStrPtr#2, Low
E410: A6 AC LDX STRNG1+1 ;Get Start of String: TmpStrPtr#1, High
E412: 90 01 BCC STRLTRLNC ;If NO Carry, Skip incrementing High Byte:
E414: E8 INX ;Inc Start of String: TmpStrPtr#1, High
E415: 86 AE STRLTRLNC STX STRNG2+1 ;Set End of String: TmpStrPtr#2, High
; ------------------------------------------------------------------------------
; Where does the String start? The String must be moved if it starts at the End
; of Page 0 ($FF), or if it is in the Input Buffer (Page 2):
; ------------------------------------------------------------------------------
E417: A5 AC LDA STRNG1+1 ;Get Start of String: TmpStrPtr#1, High
E419: F0 04 BEQ STRLTRLZP ;Page 0! (Must be from STR$ Function)
E41B: C9 02 CMP #>INBUFF ;Is it in the Input Buffer (Page 2)?
E41D: D0 0B BNE PUTNEW ;NO, Not Page 0 or 2; So just do Descriptor
; ----------------------------------- ;YES, Page 0 or 2:
E41F: 98 STRLTRLZP TYA ;Get Temp Descriptor, String Length
E420: 20 D5 E3 JSR STRINI ;Make Space for the String
E423: A6 AB LDX STRNG1 ;Get Start of String: TmpStrPtr#1, Low
E425: A4 AC LDY STRNG1+1 ;Get Start of String: TmpStrPtr#1, High
E427: 20 E2 E5 JSR MOVSTR ;Move the Character String
; ------------------------------------------------------------------------------
; Assure Temporary "String Descriptors" Stack is not full:
; ------------------------------------------------------------------------------
; ;When Stack is Full: [(TEMPPT|X)=#INDEX]!
E42A: A6 52 PUTNEW LDX TEMPPT ;Get SD Stack: Next Temp Descriptor Pointer
; ;Str Descriptor Stack ($55~$5D)=(9 bytes)
; ; Holds up to 3 Descriptors (3 bytes each)
E42C: E0 5E CPX #INDEX ;Is Stack Full: Too many Temp Descriptors?
E42E: D0 05 BNE PUTEMP ;NO; There is room for another one
; ------------------------------------------------------------------------------
; <<< BUG if ever [(TEMPPT|X) > #INDEX]! BCC|BLT would be better here; followed
; by CPX #TEMPST & BCS|BGE PUTTEMP to assure (TEMPPT|X) is within the stack. >>>
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;User-Callable Error Entry Point:
E430: A2 BF FRM2CPXERR LDX #ERR_FRMCPX ;YES; Throw a "?Formula Too Complex" Error:
E432: 4C 12 D4 JERR JMP ERROR ;Go Print Error Message based on X-Reg
; ------------------------------------------------------------------------------
; Copy Temp Descriptor [in DSCTMP (FAC+0,1,2)] into the Temp Descriptor Stack.
; Put its ZP-Address there into the Temp Variable Pointer [TMPVPTR (FAC+3,4)].
; ------------------------------------------------------------------------------
E435: A5 9D PUTEMP LDA DSCTMP ;Get Temp Descriptor, String Length
E437: 95 00 STA LOC0,X ;Set SD Stack: Tmp Descriptor, StrLen
E439: A5 9E LDA DSCTMPL ;Get Temp Descriptor, String Address, Low
E43B: 95 01 STA LOC0+1,X ;Set SD Stack: Tmp Descriptor, StrAdr, Low
E43D: A5 9F LDA DSCTMPH ;Get Temp Descriptor, String Address, High
E43F: 95 02 STA LOC0+2,X ;Set SD Stack: Tmp Descriptor, StrAdr, High
E441: A0 00 LDY #$00 ;Get Zero to Clear:
E443: 86 A0 STX TMPVPTR ;Set Temp Variable Pointer, Low (FAC+3)
E445: 84 A1 STY TMPVPTR+1 ;Set Temp Variable Pointer, High (FAC+4)
E447: 88 DEY ;Get String Variable Type ($FF)
E448: 84 11 STY VALTYP ;Flag as String: Set Variable Type to ($FF)
E44A: 86 53 STX LASTPT ;Set SD Stack: Last Temp Descriptor Pointer
E44C: E8 INX
E44D: E8 INX ;Add 3 bytes (per Descriptor) to it
E44E: E8 INX
E44F: 86 52 STX TEMPPT ;Set SD Stack: Next Temp Descriptor Pointer
; ;When Stack's Full: [(TEMPPT|X)=#INDEX]!
E451: 60 RTS ;Return to Caller
; ==============================================================================
; Get/Make Space for a Character String at the Bottom of String Storage:
; ==============================================================================
; Enter with: A-Reg Set to String Length (Number of Bytes) Desired/Needed
; Return with: [(X,Y)={Low,High}] Set to the Address of the New Space Allocated
; (A-Reg remains unchanged)
; ==============================================================================
;
E452: 46 13 GETSPACE LSR GARFLG ;Enable Garbage Collection
; ;^(Clears Sign Bit of Flag)
E454: 48 GETSPC PHA ;Save String Length (Bytes) Desired/Needed
; ----------------------------------- ;Compute New Bottom/Start of String Space)
; ;^(AKA: Free Space End|Top of Free Space)
; ;[Actuly Subtracts: (FRETOP)-(NewStrLen)]:
E455: 49 FF EOR #%11111111 ;Invert Bits
E457: 38 SEC ;Prepare for Add with Carry Set (Adds 1)
E458: 65 6F ADC FRETOP ;Add Top of Free Space, Low
E45A: A4 70 LDY FRETOP+1 ;Get Top of Free Space, High
E45C: B0 01 BCS GETSPC2 ;BGE: Branch if in Same Page of Memory
E45E: 88 DEY ;Else, Reduce Page Address, too
; ----------------------------------- ;Does it Fit in Remaining Memory?:
E45F: C4 6E GETSPC2 CPY STREND+1 ;CMP to End of Vars & Ptrs Storage, High
E461: 90 11 BCC MEMFULL ;NO: Try Garbage Collection to Free Memory
E463: D0 04 BNE GOTSPACE ;YES: It Fits in Memory Remaining
E465: C5 6D CMP STREND ;CMP to End of Vars & Ptrs Storage, Low
E467: 90 0B BCC MEMFULL ;NO: Try Garbage Collection to Free Memory
; ;YES: It Fits in Memory Remaining
; ----------------------------------- ;Save New Top of Free Space:
; ;^(AKA: Bottom or Start of String Space)
E469: 85 6F GOTSPACE STA FRETOP ;Set Top of Free Space, Low
E46B: 84 70 STY FRETOP+1 ;Set Top of Free Space, High
E46D: 85 71 STA FRESPC ;Set Temporary String Pointer, Low
E46F: 84 72 STY FRESPC+1 ;Set Temporary String Pointer, High
E471: AA TAX ;Save Top of Free Space, Low
; ----------------------------------- ;Now: (FRETOP)=(FRESPC)=[(X,Y)={Low,High}]
E472: 68 PLA ;Pull String Length Aquired [into (A)], too
E473: 60 RTS ;Return to Caller (w/ all these things set)
; ----------------------------------- ;Error Entry Point; NOT so User-Callable:
E474: A2 4D MEMFULL LDX #ERR_MEMFULL ;Get "?Out Of Memory" Error Message Index
E476: A5 13 LDA GARFLG ;Get Garbage Collection Flag; Done Yet?
E478: 30 B8 BMI JERR ;YES: Print Error Message based on X-Reg
E47A: 20 84 E4 JSR GARBAGE ;NO: Maximize Free-Space, Collect Garbage
E47D: A9 80 LDA #$80 ;Flag Garbage Collection Done
E47F: 85 13 STA GARFLG ;Set Garbage Collection Flag
E481: 68 PLA ;Pull String Length (Bytes) Desired/Needed
E482: D0 D0 BNE GETSPC ;Branch if String Space still Needed
; ------------------------------------------------------------------------------
; Maximize Free-Space, Collect Garbage from Top to Bottom:
; ------------------------------------------------------------------------------
; Shove all Referenced Strings as high as possible in memory (against HIMEM),
; freeing up space below String-Area down to Top End of Variables & Pointers
; Storage (STREND).
; ------------------------------------------------------------------------------
; [(String-Area)=(HIMEM)-(FRETOP)] & [(Free-Space)=(FRETOP)-(STREND)]
; ------------------------------------------------------------------------------
E484: A6 73 GARBAGE LDX MEMSIZ ;Get End of String Space (HIMEM) Ptr, Low
E486: A5 74 LDA MEMSIZ+1 ;Get End of String Space (HIMEM) Ptr, High
; ----------------------------------- ;Find Highest String:
; ;1 Pass thru All Vars for each Active Str
E488: 86 6F FNDVAR STX FRETOP ;Set Top of Free Space, Low
E48A: 85 70 STA FRETOP+1 ;Set Top of Free Space, High
; ;^(AKA: Bottom or Start of String Space)
; ;That Resets String-Storage (FRETOP=HIMEM)
E48C: A0 00 LDY #0 ;Clear Y-Index Register
E48E: 84 8B STY FNCNAM+1 ;Clear Address of Descriptor, High
; ;^(Flag: "Still have Strings to Collect")
; ----------------------------------- ;Point to Bottom of Free Space:
E490: A5 6D LDA STREND ;Get End of Array Vars & Ptrs Storage, Low
E492: A6 6E LDX STREND+1 ;Get End of Array Vars & Ptrs Storage, High
E494: 85 9B STA LOWTR ;Set as Bottom of Free Space, Low
E496: 86 9C STX LOWTR+1 ;Set as Bottom of Free Space, High
; ----------------------------------- ;Start by Collecting Temp Descriptors:
E498: A9 55 LDA #TEMPST ;Get Address of Next Temp Dscrptr Ptr, Low
E49A: A2 00 LDX #>TEMPST ;Get Address of Next Temp Dscrptr Ptr, High
E49C: 85 5E STA INDEX ;Set String Variable Index Pointer, Low
E49E: 86 5F STX INDEX+1 ;Set String Variable Index Pointer, High
E4A0: C5 52 TVAR CMP TEMPPT ;Done Collecting Temporary Descriptors?
E4A2: F0 05 BEQ SVARS ;YES: Go Do Simple Variables; EXIT LOOP
E4A4: 20 23 E5 JSR CHKVAR ;NO: Check Temporary String Descriptor
E4A7: F0 F7 BEQ TVAR ;Loop-Back; Always Taken
; ----------------------------------- ;Now Collect Simple Variables:
E4A9: A9 07 SVARS LDA #7 ;Get Standard Length of Simple Variables
E4AB: 85 8F STA DSCLEN ;Set String Descriptor Length
; ----------------------------------- ;Start at beginning of Variable Table:
E4AD: A5 69 LDA VARTAB ;Get Start of Variables Pointer, Low
E4AF: A6 6A LDX VARTAB+1 ;Get Start of Variables Pointer, High
E4B1: 85 5E STA INDEX ;Set String Variable Index Pointer, Low
E4B3: 86 5F STX INDEX+1 ;Set String Variable Index Pointer, High
; ----------------------------------- ;Done Collecting Simple Variables?
E4B5: E4 6C SVAR CPX ARYTAB+1 ;Reached Start of Arrays Pointer, High?
E4B7: D0 04 BNE SVARGO ;NO: Continue ...
E4B9: C5 6B CMP ARYTAB ;Reached Start of Arrays Pointer, Low
E4BB: F0 05 BEQ ARYVAR ;YES: Go Collect Array Variables; EXIT LOOP
E4BD: 20 19 E5 SVARGO JSR CHKSMPLVAR ;NO: Check Simple Variable
E4C0: F0 F3 BEQ SVAR ;Loop-Back; Always Taken
; ----------------------------------- ;Collect Array Variables:
E4C2: 85 94 ARYVAR STA HIGHDS ;Set as Now Variable Pointer, Low
E4C4: 86 95 STX HIGHDS+1 ;Set as Now Variable Pointer, High
E4C6: A9 03 LDA #3 ;Get Standard Length of String Descriptors
E4C8: 85 8F STA DSCLEN ;Set String Descriptor Length
; ----------------------------------- ;Scan Array Variables LOOP:
; ;CMP [(A,X)={Low,High}] to End of Arrays:
E4CA: A5 94 ARYVAR2 LDA HIGHDS ;Get Next Variable Pointer, Low
E4CC: A6 95 LDX HIGHDS+1 ;Get Next Variable Pointer, High
; ----------------------------------- ;Done Collecting Array Variables?
E4CE: E4 6E ARYVAR3 CPX STREND+1 ;Reached End of Vars & Ptrs Storage High?
E4D0: D0 07 BNE ARYVARGO ;NO: Continue ...
E4D2: C5 6D CMP STREND ;Reached End of Vars & Ptrs Storage, Low?
E4D4: D0 03 BNE ARYVARGO ;NO: Continue ...
; ;YES: Done Collecting Array Variables;
E4D6: 4C 62 E5 JMP GRBGPASS ;Go Move Highest String to Top; EXIT LOOP
; ----------------------------------- ;Setup Pointer to Start of Array:
E4D9: 85 5E ARYVARGO STA INDEX ;Set Array Variable Index Pointer, Low
E4DB: 86 5F STX INDEX+1 ;Set Array Variable Index Pointer, High
E4DD: A0 00 LDY #0 ;Point at 1st Character of Array Name
E4DF: B1 5E LDA (INDEX),Y ;Get 1st Character of Array Name
E4E1: AA TAX ;Save 1st Character of Array Name
E4E2: C8 INY ;Point at 2nd Character of Array Name
E4E3: B1 5E LDA (INDEX),Y ;Get 2nd Character of Array Name
; ;Now (X,A)=(Array Name)
; ----------------------------------- ;Prepare for Variable Type Check:
E4E5: 08 PHP ;Push Status of 2nd Array Name Character
; ;^[(N) {2nd Char})=($:+-;%:--;Real:++)]
; ----------------------------------- ;Advance Pointer to Next Variable:
E4E6: C8 INY ;Point at Offset to Next Array, Low
E4E7: B1 5E LDA (INDEX),Y ;Get Offset to Next Array, Low
; ----------------------------------- ;Calculate Start of Next Array:
; ;(Here, Carry's always Clear, for Add w/C)
E4E9: 65 94 ADC HIGHDS ;Add Now Variable Pointer, Low
E4EB: 85 94 STA HIGHDS ;Set as Next Variable Pointer, Low
E4ED: C8 INY ;Point at Offset to Next Array, High
E4EE: B1 5E LDA (INDEX),Y ;Get Offset to Next Array, High
E4F0: 65 95 ADC HIGHDS+1 ;Add Now Variable Pointer, High
E4F2: 85 95 STA HIGHDS+1 ;Set as Next Variable Pointer, High
; ----------------------------------- ;Assure Array is a String Array:
E4F4: 28 PLP ;Pull Status of 2nd Array Name Character
; ;^[(N) {2nd Char})=($:+-;%:--;Real:++)]
E4F5: 10 D3 BPL ARYVAR2 ;Loop-Back if Real/FP Array (VarName)^
E4F7: 8A TXA ;Retrieve 1st Character of Array Name
E4F8: 30 D0 BMI ARYVAR2 ;Loop-Back if Integer Array (VarName)^
; ----------------------------------- ;Array is a String Array:
E4FA: C8 INY ;Point at Number of Array Dimensions
E4FB: B1 5E LDA (INDEX),Y ;Get Number of Array Dimensions
E4FD: A0 00 LDY #0 ;Clear Indirect Addressing Index
E4FF: 0A ASL A ;Double Number of Array Dimensions
E500: 69 05 ADC #5 ;& Add Five; Result: (A)=(2*Dims+5)
; ;Now (A)=(Size of this Array Variable)
; ----------------------------------- ;Point at 1st Array Element:
E502: 65 5E ADC INDEX ;Add Array Variable Index Pointer, Low
E504: 85 5E STA INDEX ;Set Array Variable Index Pointer, Low
E506: 90 02 BCC AVGSKPADV ;Skip Page Advance if Carry Clear
E508: E6 5F INC INDEX+1 ;Else, Carry Set, Advance Page Address
; ----------------------------------- ;Step through each Element in Str Array:
E50A: A6 5F AVGSKPADV LDX INDEX+1 ;Get Array Variable Index Pointer, High
E50C: E4 95 ARYSTR CPX HIGHDS+1 ;Has Pointer Reached Next Variable, High?
E50E: D0 04 BNE GOGO ;NO: Process Next Element
E510: C5 94 CMP HIGHDS ;Has Pointer Reached Next Variable, Low?
E512: F0 BA BEQ ARYVAR3 ;YES, Loop-Back: Do Next Array Variable
E514: 20 23 E5 GOGO JSR CHKVAR ;NO: Continue Processing Array
E517: F0 F3 BEQ ARYSTR ;Loop-Back: Do Next Element; Always Taken
;
; ==============================================================================
; Check Simple Variable: Assure Variable is a String
; ==============================================================================
; Upon Entry here: (Y)=(0) Always, (INDEX)=(String Variable Index Pointer);
; & from SVARGO: (INDEX),Y Points at Variable's Name
; ------------------------------------------------------------------------------
E519: B1 5E CHKSMPLVAR LDA (INDEX),Y ;Get 1st Character of Variable Name
E51B: 30 35 BMI CHKBUMP ;Branch if Not a String Variable
; ;^[It's Integer Var ($:+-;%:--;Real:++)]
E51D: C8 INY ;Point at 2nd Character of Variable Name
E51E: B1 5E LDA (INDEX),Y ;Get 2nd Character of Variable Name
E520: 10 30 BPL CHKBUMP ;Branch if Not a String Variable
; ;^[It's a Real/FP Var ($:+-;%:--;Real:++)]
;
; ==============================================================================
; Check Variable: If String is Not Empty, Check if it is Highest
; ==============================================================================
E522: C8 INY ;Point at String Length
; ------------------------------------------------------------------------------
; Upon Entry here: (Y)=(0) & (INDEX)=(String Variable Index Pointer);
; & from TVAR: (INDEX),Y Points at Variable's Descriptor;
; & from GOGO: (INDEX),Y Points at Variable's Current Element [Doesn't Jibe]
; ------------------------------------------------------------------------------
E523: B1 5E CHKVAR LDA (INDEX),Y ;Get String Length
E525: F0 2B BEQ CHKBUMP ;Skip it if it is a Null String
E527: C8 INY ;Point at String Address, Low
E528: B1 5E LDA (INDEX),Y ;Get String Address, Low
E52A: AA TAX ;Save (for CPX) String Address, Low
E52B: C8 INY ;Point at String Address, High
E52C: B1 5E LDA (INDEX),Y ;Get String Address, High
; ;(FRETOP AKA: Bottom/Start of String Spc)
E52E: C5 70 CMP FRETOP+1 ;Reached Top of Free Space, High?
E530: 90 06 BCC CHKVAR1 ;NO, Below Top of Free Space, High
E532: D0 1E BNE CHKBUMP ;YES, Above Top of Free Space, High
E534: E4 6F CPX FRETOP ;Reached Top of Free Space, Low?
E536: B0 1A BCS CHKBUMP ;YES, Above Top of Free Space, Low
; ;^^^: Garbage Collected already, Skip it
; ----------------------------------- ;Above Highest String Found?
E538: C5 9C CHKVAR1 CMP LOWTR+1 ;Reached Bottom of Free Space, High?
E53A: 90 16 BCC CHKBUMP ;NO, Ignore for Now, Skip it
E53C: D0 04 BNE CHKVAR2 ;YES, This is the new Highest String
E53E: E4 9B CPX LOWTR ;Reached Bottom of Free Space, Low?
E540: 90 10 BCC CHKBUMP ;NO, Ignore for Now, Skip it
; ----------------------------------- ;YES, Make it new Highest String:
E542: 86 9B CHKVAR2 STX LOWTR ;Save as Pointer to Highest String, Low
E544: 85 9C STA LOWTR+1 ;Save as Pointer to Highest String, High
; ----------------------------------- ;Save Address of Descriptor too:
E546: A5 5E LDA INDEX ;Get Address of Descriptor, Low
E548: A6 5F LDX INDEX+1 ;Get Address of Descriptor, High
E54A: 85 8A STA FNCNAM ;Save as Address of Descriptor, Low
E54C: 86 8B STX FNCNAM+1 ;Save as Address of Descriptor, High
; ;^(Flag: "Still have Strings to Collect")
E54E: A5 8F LDA DSCLEN ;Get String Descriptor Length
E550: 85 91 STA GARLEN ;Set as String Descriptor Length
; ;^(Length for Garbage Collection)
; ----------------------------------- ;Advance to Next Variable:
E552: A5 8F CHKBUMP LDA DSCLEN ;Get String Descriptor Length
E554: 18 CLC ;Prepare for Add with Carry
E555: 65 5E ADC INDEX ;Add Address of Descriptor, Low
E557: 85 5E STA INDEX ;Set Address of Descriptor, Low
E559: 90 02 BCC CHKEXIT ;Skip Advancing Page if No Carry Over
E55B: E6 5F INC INDEX+1 ;Advance Address of Descriptor, High
E55D: A6 5F CHKEXIT LDX INDEX+1 ;Return (INDEX)=[(A,X)={Low,High}]
E55F: A0 00 LDY #0 ;Return (Y)=(0)
E561: 60 RTS ;Return to Caller
; ==============================================================================
; Move Highest String to Top
; ==============================================================================
;
E562: A6 8B GRBGPASS LDX FNCNAM+1 ;Retrieve Address of Descriptor, High
; ;^(Flag: "Still have Strings to Collect")
E564: F0 F7 BEQ CHKEXIT ;Collection Ends if Flag is still Zero
; <<< ---------------------------------------------------------------------- >>>
; Any attemp to collect a temp string will abort collection. This BUG is rarely
; a problem, but could be if collection is forced by a concatination and the
; string space just has room for the new string after collection. For example:
; LOMEM:10000: HIMEM:10012: A$="A": A$=A$+"B": A$=A$+"C": PRINT A$ prints "ABA"
; [in immediate mode, but in deferred mode, prints "ABC", in AppleWin 1.29.3.0].
; <<< ====================================================================== >>>
;
; ----------------------------------- ;Compute Y-Index to Point at String Length
; ; & String Pointer, Variable Elements:
E566: A5 91 LDA GARLEN ;Get String Descriptor Length
E568: 29 04 AND #%00000100 ;If it was 3 or 7, make it 0 or 4
; ;^(4 is Simple Variable, else 0)
E56A: 4A LSR A ;Make it 0 or 2; Name precedes Descriptor
E56B: A8 TAY ;Point at String Length in Descriptor
; ;^(2 is Simple Variable, else 0)
E56C: 85 91 STA GARLEN ;Save to Set Y-Index into Variable later
; ----------------------------------- ;String is between Bottom of Free Space
; ;(LOWTR) & Top-End of Arrays (HIGHTR):
E56E: B1 8A LDA (FNCNAM),Y ;Get String Length from Descriptor
; ;Carry was Cleared by LSR (for Add w/C)
E570: 65 9B ADC LOWTR ;Add Bottom of Free Space, Low
E572: 85 96 STA HIGHTR ;Set as new Top-End of Arrays, Low
E574: A5 9C LDA LOWTR+1 ;Get Bottom of Free Space, High
E576: 69 00 ADC #0 ;Add Carry to Bottom of Free Space, High
E578: 85 97 STA HIGHTR+1 ;Set as new Top-End of Arrays, High
; ----------------------------------- ;Set High End Destination:
E57A: A5 6F LDA FRETOP ;Get Top of Free Space, Low
E57C: A6 70 LDX FRETOP+1 ;Get Top of Free Space, High
; ;^(AKA: Bottom or Start of String Space)
E57E: 85 94 STA HIGHDS ;Save as Start of String Space, Low
E580: 86 95 STX HIGHDS+1 ;Save as Start of String Space, High
; ----------------------------------- ;Move String Up:
; ;(HIGHDS) = Highest Destination Address +1
; ; (LOWTR) = Lowest Source Address
; ;(HIGHTR) = Highest Source Address +1
E582: 20 9A D3 JSR MVBLKUP2 ;Move Memory Block Upward
; ----------------------------------- ;Fix String's Descriptor:
E585: A4 91 LDY GARLEN ;Retrieve to Set Y-Index into Variable
E587: C8 INY ;Point at Descriptor String Pointer, Low
; ;Store New Address:
E588: A5 94 LDA HIGHDS ;Get Start of String Space, Low
E58A: 91 8A STA (FNCNAM),Y ;Set Descriptor String Pointer, Low
E58C: AA TAX ;Save Pointer to Moved String, Low
; ----------------------------------- ;Correct MVBLKUP2's Overshoot:
E58D: E6 95 INC HIGHDS+1 ;Advance Start of String Space, High
E58F: A5 95 LDA HIGHDS+1 ;Get Start of String Space, High
E591: C8 INY ;Point at Descriptor String Pointer, High
E592: 91 8A STA (FNCNAM),Y ;Set Descriptor String Pointer, High
; ;[(X,A)={Low,High}] Points at Moved String
E594: 4C 88 E4 JMP FNDVAR ;Find Next Variable to Collect
; ==============================================================================
; Concatenate Two Strings
; ==============================================================================
;
; ----------------------------------- ;Save 1st String's Descriptor Address:
E597: A5 A1 CAT LDA TMPVPTR+1 ;Get Temp Variable Pointer, High (FAC+4)
E599: 48 PHA ;Push Address of 1st Descriptor, High
E59A: A5 A0 LDA TMPVPTR ;Get Temp Variable Pointer, Low (FAC+3)
E59C: 48 PHA ;Push Address of 1st Descriptor, Low
; ----------------------------------- ;Save 2nd String's Descriptor Address:
E59D: 20 60 DE JSR GETVAL ;Put Pointer to String Descriptor in FAC
E5A0: 20 6C DD JSR CHKSTR ;Assure (FAC) Type is String (VALTYP=$FF)
; ----------------------------------- ;Retrieve 1st String's Descriptor Address:
E5A3: 68 PLA ;Pull Address of 1st Descriptor, Low
E5A4: 85 AB STA STRNG1 ;Set Pointer to 1st String, Low
E5A6: 68 PLA ;Pull Address of 1st Descriptor, High
E5A7: 85 AC STA STRNG1+1 ;Set Pointer to 1st String, High
; ----------------------------------- ;Get Concatenated Size, Add Lenghts:
E5A9: A0 00 LDY #0 ;Clear Indirect Addressing Index
E5AB: B1 AB LDA (STRNG1),Y ;Get Length of 1st String
E5AD: 18 CLC ;Prepare for Add with Carry
E5AE: 71 A0 ADC (TMPVPTR),Y ;Add Length of 2nd String (FAC+3,4)
E5B0: 90 05 BCC CAT1 ;Branch if < $100; Total Length is OK
; ----------------------------------- ;User-Callable Error Entry Point:
E5B2: A2 B0 STR2LGERR LDX #ERR_STRLONG ;Throw a "?String Too Long" Error
E5B4: 4C 12 D4 JMP ERROR ;Print Error based on X-Reg
; ------------------------------------------------------------------------------
; Concatenate the Two Strings
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Get Space for Concatenated Strings
E5B7: 20 D5 E3 CAT1 JSR STRINI ;Initialize String Space & Descriptors
E5BA: 20 D4 E5 JSR MOVINS ;Move in 1st String
; ----------------------------------- ;Free up 2nd String:
E5BD: A5 8C LDA DSCPTR ;Get String Descriptor Pointer, Low
E5BF: A4 8D LDY DSCPTR+1 ;Get String Descriptor Pointer, High
E5C1: 20 04 E6 JSR FRETMP ;Free up a Temporary String
E5C4: 20 E6 E5 JSR MOVSTR1 ;Move in 2nd String
; ----------------------------------- ;Free up 1st String:
E5C7: A5 AB LDA STRNG1 ;Get String Descriptor Pointer, Low
E5C9: A4 AC LDY STRNG1+1 ;Get String Descriptor Pointer, High
E5CB: 20 04 E6 JSR FRETMP ;Free up a Temporary String
E5CE: 20 2A E4 JSR PUTNEW ;Setup Descriptor
E5D1: 4C 95 DD JMP FRMEVL2 ;Finish Expression Evaluation
; ------------------------------------------------------------------------------
; Get String Descriptor at (STRNG1) & Move Described String to (FRESPC)
; ------------------------------------------------------------------------------
;
E5D4: A0 00 MOVINS LDY #0 ;Point at String Length
E5D6: B1 AB LDA (STRNG1),Y ;Get String Length (* from its Descriptor)
E5D8: 48 PHA ;Push String Length
E5D9: C8 INY ;Point at String Pointer, Low
E5DA: B1 AB LDA (STRNG1),Y ;Get String Pointer, Low (*)
E5DC: AA TAX ;Save String Pointer, Low
E5DD: C8 INY ;Point at String Pointer, High
E5DE: B1 AB LDA (STRNG1),Y ;Get String Pointer, High (*)
E5E0: A8 TAY ;Save String Pointer, High
E5E1: 68 PLA ;Pull String Length
;
; ------------------------------------------------------------------------------
; Move String at [(X,Y)={Low,High}] w/ Length in (A) to Destination at (FRESPC)
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Put Pointer in INDEX:
E5E2: 86 5E MOVSTR STX INDEX ;Save String Pointer, Low
E5E4: 84 5F STY INDEX+1 ;Save String Pointer, High
; ----------------------------------- ;Move String (2nd Entry Point):
E5E6: A8 MOVSTR1 TAY ;Save String Length as Count Down Index
E5E7: F0 0A BEQ MOVSTR2 ;Done if Count Down Index is Zero
E5E9: 48 PHA ;Push String Length
; ----------------------------------- ;Move String (Loop):
E5EA: 88 MOVESTR DEY ;Reduce String Length Count Down Index
E5EB: B1 5E LDA (INDEX),Y ;Get Old String Character Byte
E5ED: 91 71 STA (FRESPC),Y ;Set New String Character Byte
; ;Test if any more Bytes to Move:
E5EF: 98 TYA ;Get String Length Count Down Index
E5F0: D0 F8 BNE MOVESTR ;Loop-Back if Not Done
; ----------------------------------- ;Get Length & Add to FRESPC [Point to Next
; ; Higher Byte (for use by Concatenation)]:
E5F2: 68 PLA ;Pull String Length
E5F3: 18 MOVSTR2 CLC ;Prepare for Add with Carry
E5F4: 65 71 ADC FRESPC ;Add Temporary String Pointer, Low
E5F6: 85 71 STA FRESPC ;Set Temporary String Pointer, Low
E5F8: 90 02 BCC MOVSTR3 ;Skip Advancing High Byte if NO Carryover
E5FA: E6 72 INC FRESPC+1 ;Add Carry & Set Temp String Pointer, High
E5FC: 60 MOVSTR3 RTS ;Return to Caller
; ==============================================================================
; Release Temporary String Descriptor (in FAC)
; ==============================================================================
;
; =================================== ;[1st Entry Pt: from "LEN" Statement S/R]
; Release String Descriptor if String is a Temporary String & is Lowest in RAM:
; ----------------------------------- ;Assure (FAC) Points to a Str Descriptor:
E5FD: 20 6C DD FRESTR JSR CHKSTR ;Assure (FAC) Type is String (VALTYP=$FF)
; =================================== ;[2nd Entry Pt: from STRPRT|STRCMP|FRE]
; Free up String Descriptor [(TMPVPTR)=(FAC+3,4)] & a Temp String if Lowest:
; ----------------------------------- ;Get String Descriptor Pointer:
E600: A5 A0 FREFAC LDA TMPVPTR ;Get Temp Variable Pointer, Low (FAC+3)
E602: A4 A1 LDY TMPVPTR+1 ;Get Temp Variable Pointer, High (FAC+4)
; ================================= ;[3rd Entry Pt: from STRCMP|CAT1|LEFTSTR]
; Free up a Temporary String if it is Lowest in RAM (Highest on String Stack):
; ----------------------------------- ;Put String Descriptor Pointer in INDEX:
E604: 85 5E FRETMP STA INDEX ;Save Pointer to String Descriptor, Low
E606: 84 5F STY INDEX+1 ;Save Pointer to String Descriptor, High
E608: 20 35 E6 JSR FRETMS ;Free Temp Descriptor w/o Freeing up String
E60B: 08 PHP ;Push Status: Remember if Temp (Z=1) or Not
; ----------------------------------- ;Get Descriptor Data:
E60C: A0 00 LDY #0 ;Point at String Length in Descriptor
E60E: B1 5E LDA (INDEX),Y ;Get String Length
E610: 48 PHA ;Push String Length
E611: C8 INY ;Point at String Pointer, Low
E612: B1 5E LDA (INDEX),Y ;Get String Pointer, Low
E614: AA TAX ;Save String Pointer, Low
E615: C8 INY ;Point at String Pointer, High
E616: B1 5E LDA (INDEX),Y ;Get String Pointer, High
E618: A8 TAY ;Save String Pointer, High
E619: 68 PLA ;Pull String Length
; ;Now: String Length is in Accumulator (A)
; ;& String Pointer is in [(X,Y)={Low,High}]
; ----------------------------------- ;Free up Space if String is Temp & Lowest:
E61A: 28 PLP ;Pull Status: Retrieve if Temp (Z=1) or Not
E61B: D0 13 BNE FRETMP2 ;Branch if Not Temporary String (Z=0)
; ----------------------------------- ;Is it THE Lowest String?
; ;Compare to Bottom/Start of String Space:
E61D: C4 70 CPY FRETOP+1 ;Compare to Top of Free Space, High
E61F: D0 0F BNE FRETMP2 ;NO: Branch if Not Lowest String
E621: E4 6F CPX FRETOP ;Compare to Top of Free Space, Low
E623: D0 0B BNE FRETMP2 ;NO: Branch if Not Lowest String
; ;YES, it is THE Lowest String
; ----------------------------------- ;Delete Lowest String (Move FRETOP Up):
E625: 48 PHA ;Push String Length
E626: 18 CLC ;Prepare for Add with Carry
E627: 65 6F ADC FRETOP ;Add Top of Free Space, Low
E629: 85 6F STA FRETOP ;Set Top of Free Space, Low
E62B: 90 02 BCC FRETMP1 ;Skip Advancing High Byte if NO Carryover
E62D: E6 70 INC FRETOP+1 ;Add Carry & Set Top of Free Space, High
E62F: 68 FRETMP1 PLA ;Pull String Length
; ----------------------------------- ;Put String Pointer in INDEX:
E630: 86 5E FRETMP2 STX INDEX ;Set as Address of String, Low
E632: 84 5F STY INDEX+1 ;Set as Address of String, High
; ----------------------------------- ;Return String's New Descriptor Data:
; ;String Length in Accumulator (A)
; ;String Ptr in INDEX=[(X,Y)={Low,High}]
E634: 60 RTS ;Return to Caller
; ==============================================================================
; Free Temp Descriptor w/o Freeing up String
; ==============================================================================
;
; Release TD from SD Stack if [(A,Y)={Low,High}]=(LASTPT):
;
E635: C4 54 FRETMS CPY LASTPT+1 ;Compare to SD Stack: Last TD Pointer, High
E637: D0 0C BNE FRETMS1 ;Cannot Release if NOT Same One
E639: C5 53 CMP LASTPT ;Compare to SD Stack: Last TD Pointer, Low
E63B: D0 08 BNE FRETMS1 ;Cannot Release if NOT Same One
E63D: 85 52 STA TEMPPT ;Set SD Stack: Next TD Pointer
E63F: E9 03 SBC #3 ;Reduce SD Stack: Last TD Pointer, Low
E641: 85 53 STA LASTPT ;Set SD Stack: Last TD Pointer, Low
E643: A0 00 LDY #0 ;Set SD Stack: Last TD Pointer, High
E645: 60 FRETMS1 RTS ;Return to Caller
; ==============================================================================
; ** Unary String Operator Functions (CHR$, LEFT$, RIGHT$, & MID$) Start Here **
; ==============================================================================
;
;
; ==============================================================================
; "CHR$" Character String Function:
; Immediate & Deferred; Parameters: CHR$ (Aexpr);
; Returns ASCII Character of an Integer Number (from 0 to 255)
; (Real Numbers are Converted to Integer Numbers)
; ==============================================================================
;
E646: 20 FB E6 CHRSTR JSR CONINT ;Evaluate Formula at TXTPTR into (X) & FAC
E649: 8A TXA ;Get Result; ^[Real]-->[Integer (0..255)]
E64A: 48 PHA ;Push Result
E64B: A9 01 LDA #1 ;Get Space for a Single-Character String
E64D: 20 DD E3 JSR STRSPC ;Make String Space & Set Temp Descriptor
E650: 68 PLA ;Pull Result
E651: A0 00 LDY #0 ;Clear Indirect Addressing Index
E653: 91 9E STA (DSCTMPL),Y ;Set Temp Descriptor, Str Adrs, Low (FAC+1)
; ----------------------------------- ;Pop/Discard Return Address:
; ;(NO Return to UNARY2 for CHR$)
E655: 68 PLA ;Pull/Discard UNARY2 Return Address, Low
E656: 68 PLA ;Pull/Discard UNARY2 Return Address, High
E657: 4C 2A E4 JMP PUTNEW ;Make it a Temporary String
; ==============================================================================
; "LEFT$" Left String Function:
; ==============================================================================
; Immediate & Deferred; Parameters: LEFT$ (Sexpr, Aexpr);
; Returns first (Numeric Expression) Characters of (String Expression)
; (Real Numbers are Converted to Integer Numbers)
; ==============================================================================
;
E65A: 20 B9 E6 LEFTSTR JSR INSTRING ;Do Common Setup for LEFT$|RIGHT$|MID$
; Returns --> ;(Y=0) & (A=X)=(2nd Parmeter of Function)=
; ; [Specified Length of Substring (Aexpr)]=
E65D: D1 8C CMP (DSCPTR),Y ;[(2nd Parameter)<(Original Length)]?
E65F: 98 TYA ;Clear (A)=[(Y=0): Start Point in String]
;
; ==============================================================================
; Routine End Code for LEFT$, RIGHT$, & MID$ Functions
; ==============================================================================
;
; ----------------------------------- ;Drop-Down Entry-Pt from LEFT$ Function &
; ;Jump-Back Entry-Pt from RIGHT$ Function:
; ;Now: (A)=[Starting Point in String]
E660: 90 04 RGHTSTR BCC INSTR ;BLT: 2nd Parameter is Smaller, Use It
E662: B1 8C LDA (DSCPTR),Y ;Else, Original Length is Smaller, Use It
E664: AA TAX ;Save Original String Length
E665: 98 TYA ;Clear (A)=[(Y=0): Start Point in String]
E666: 48 INSTR PHA ;Push Starting Point in Original String
; ----------------------------------- ;2 Branch-Bak Entry-Pts frm MID$ Function:
; ;Entry Point for Offset > Original Length:
E667: 8A MIDSTR2 TXA ;Retrieve Length (or Width) of Substring
; ;Entry Point for using Smallest Length:
E668: 48 MIDSTR3 PHA ;Push Length (or Width) of Substring
E669: 20 DD E3 JSR STRSPC ;Make String Space & Set Temp Descriptor
E66C: A5 8C LDA DSCPTR ;Get String Descriptor Pointer, Low
E66E: A4 8D LDY DSCPTR+1 ;Get String Descriptor Pointer, High
E670: 20 04 E6 JSR FRETMP ;Release Parameter String if Temporary
E673: 68 PLA ;Pull Length (Width) of Substring
E674: A8 TAY ;Save Length (Width) of Substring
; ---------------------- ;Add Offset to Move Strings INDEX Pointer:
E675: 68 PLA ;Pull Starting Point in Original String,
; ;for LEFT$ & RIGHT$ Functions, or Offset
; ;[(Specified Start)-1] for MID$ Function
E676: 18 CLC ;Prepare for Add with Carry
E677: 65 5E ADC INDEX ;Add Move Strings Index Pointer
E679: 85 5E STA INDEX ;Set Move Strings Index Pointer
E67B: 90 02 BCC INSTRSKP ;Skip Advancing High Byte if NO Carryover
E67D: E6 5F INC INDEX+1 ;Add Carry to Move Strings Index Ptr, High
E67F: 98 INSTRSKP TYA ;Retrieve Length (Width) of Substring
E680: 20 E6 E5 JSR MOVSTR1 ;Move Substring to String Space
E683: 4C 2A E4 JMP PUTNEW ;Go Make it a Temporary String
; ==============================================================================
; "RIGHT$" Right String Function:
; ==============================================================================
; Immediate & Deferred; Parameters: RIGHT$ (Sexpr, Aexpr);
; Returns last (Numeric Expression) Characters of (String Expression)
; (Real Numbers are Converted to Integer Numbers)
; ==============================================================================
;
E686: 20 B9 E6 RIGHTSTR JSR INSTRING ;Do Common Setup for LEFT$|RIGHT$|MID$
; Returns --> ;(Y=0) & (A=X)=(2nd Parmeter of Function)=
; ; [Specified Length of Substring (Aexpr)]=
; ----------------------------------- ;Compute (Length)-(Width of SubString)
; ;to get Starting Point in String:
E689: 18 CLC ;Prepare to Subtract w/ Borrow [A-Data-!C]
E68A: F1 8C SBC (DSCPTR),Y ;Subtract Original String Length [A-Len-1]
E68C: 49 FF EOR #%11111111 ;Invert Bits [Negate(A-Len-1)=(Len+1-A)]
; ; [(Length of Remainder)=(Len+1-A)]
; ; [(Starting Point in String)=(Len+1-A)]
E68E: 4C 60 E6 JMP RGHTSTR ;Goto End Code for RIGHT$
; ==============================================================================
; "MID$" Middle String Function:
; ==============================================================================
; Immediate & Deferred; Parameters: MID$ (Sexpr, Aexpr1 [, Aexpr2]);
; Returns (Numeric Expression 2) Middle Characters of (String Expression)
; from the (Numeric Expression 1) Character to the Right
; (Real Numbers are Converted to Integer Numbers)
; ==============================================================================
;
E691: A9 FF MIDSTR LDA #$FF ;Setup Large Fake Length for 3rd Parameter
E693: 85 A1 STA FAC+4 ;Set FAC Mantissa, Low
E695: 20 B7 00 JSR CHRGOT ;Get Last Char/Token Got
E698: C9 29 CMP #')' ;Was it a Closing Parenthsis [")"]?
E69A: F0 06 BEQ MIDSTR1 ;YES, Then there is No 3rd Parameter
E69C: 20 BE DE JSR CHKCOM ;NO, Then a Comma is Required
; ;(between 2nd & 3rd Parameters)
E69F: 20 F8 E6 JSR GETBYT ;Evaluate 3rd Parameter into FAC+4
; ;^[Specified Length of Substring (Aexpr2)]
E6A2: 20 B9 E6 MIDSTR1 JSR INSTRING ;Do Common Setup for LEFT$|RIGHT$|MID$
; Returns --> ;(Y=0) & (A=X)=(2nd Parmeter of Function)=
; ; [Specified Start of Substring (Aexpr1)]=
E6A5: CA DEX ;Reduce 2nd Parameter [(Specified Start)-1]
E6A6: 8A TXA ;Get it as Specified Offset [^]
E6A7: 48 PHA ;Push it as Specified Offset [^]
; ----------------------------------- ;Compute (Length)-[(Specified Start)-1]
; ;to get Length of Remainder of String:
E6A8: 18 CLC ;Prepare to Subtract w/ Borrow [A-Data-!C]
E6A9: A2 00 LDX #0 ;Clear X-Reg (before Branch-Backs occur)
E6AB: F1 8C SBC (DSCPTR),Y ;Subtract Original String Length [A-Len-1]
E6AD: B0 B8 BCS MIDSTR2 ;BGE: Branch if Offset > Original Length
; ;Exit: Goto End Code for MID$
; ;Else: Use Smaller of Two Lengths:
E6AF: 49 FF EOR #%11111111 ;Invert Bits [Negate(A-Len-1)=(Len+1-A)]
; ; [(Length of Remainder)=(Len+1-A)]
E6B1: C5 A1 CMP FAC+4 ;[(Remainder Length)<(Specified Length)]?
E6B3: 90 B3 BCC MIDSTR3 ;BLT: Goto End Code for MID$ if So
E6B5: A5 A1 LDA FAC+4 ;Retrieve 2nd Parameter, Specified (Aexpr1)
E6B7: B0 AF BCS MIDSTR3 ;Goto End Code for MID$; Always Taken
; ==============================================================================
; Common Setup Routine for LEFT$, RIGHT$, & MID$ Functions:
; ==============================================================================
;
E6B9: 20 B8 DE INSTRING JSR CHKCLS ;Require Closing Parenthsis [")"] at TXTPTR
; ----------------------------------- ;Save Return Address [in (Y,GARLEN)]:
E6BC: 68 PLA ;Pull Return Address, Low
E6BD: A8 TAY ;Save Return Address, Low
E6BE: 68 PLA ;Pull Return Address, High
E6BF: 85 91 STA GARLEN ;Save Return Address, High
; ----------------------------------- ;Pop/Discard previous Return Address:
; ;(NO Rtn to UNARY2 for LEFT$|RIGHT$|MID$)
E6C1: 68 PLA ;Pull/Discard UNARY2 Return Address, Low
E6C2: 68 PLA ;Pull/Discard UNARY2 Return Address, High
; ----------------------------------- ;Retrieve 2nd Parameter of Command:
; ;^[Pushed at $DF36 in UNARY Op's Routine]
; ;^[2ndParm is Specified [Aexpr(1)]: Length
; ;of Substring for LEFT$ & RIGHT$ Functions
; ;& Start of Substring for MID$ Function]
E6C3: 68 PLA ;Pull 2nd Parameter of Command
E6C4: AA TAX ;Save 2nd Parameter of Command
; ----------------------------------- ;Restore String Descriptor Pointer:
; ;^[Pushed at $DF2A,2D in UNARY Op's S/R]
; ;^[String Descriptor Adrs (from TMPVPTR)]
; ;^[Usually Pts at FAC for TmpStrDsc (3B)]
E6C5: 68 PLA ;Get String Descriptor Address, Low
; ;^[This was from (FAC+3) TMPVPTR, Low]
E6C6: 85 8C STA DSCPTR ;Set String Descriptor Pointer, Low
E6C8: 68 PLA ;Get String Descriptor Address, High
; ;^[This was from (FAC+4) TMPVPTR, High]
E6C9: 85 8D STA DSCPTR+1 ;Set String Descriptor Pointer, High
; ----------------------------------- ;Restore Return Address [from (Y,GARLEN)]:
E6CB: A5 91 LDA GARLEN ;Get Return Address, High
E6CD: 48 PHA ;Push Return Address, High
E6CE: 98 TYA ;Get Return Address, Low
E6CF: 48 PHA ;Push Return Address, Low
; ----------------------------------- ;Setup for Return to Caller:
E6D0: A0 00 LDY #0 ;Clear Indirect Addressing Index
E6D2: 8A TXA ;Retrieve 2nd Parameter of Command
E6D3: F0 1D BEQ GOIQ ;If Zero, Throw "?Illegal Quantity" Error
E6D5: 60 RTS ;Else, Return to Caller
; ==============================================================================
; "LEN" String Length Function: Imediate & Deferred; Parameter: LEN (Aexpr);
; Returns the Number of Characters in a String
; ==============================================================================
;
E6D6: 20 DC E6 LEN JSR GETSTR ;Get Length in Y-Reg, Make FAC Numeric
; ----------------------------------- ;Convert Y-Reg to Real/FP Number in FAC:
E6D9: 4C 01 E3 JMP SNGFLT ;Float Unsigned Integer & Flag as a Number
; ------------------------------------------------------------------------------
; Get String Length (GETSTR): If Last Result is a Temporary String, Free It;
; Make Valtyp Numeric; & Return String Length In Y-Reg.
; ------------------------------------------------------------------------------
E6DC: 20 FD E5 GETSTR JSR FRESTR ;If Last Result is a Temp String, Free It
E6DF: A2 00 LDX #0 ;Clear X-Reg
E6E1: 86 11 STX VALTYP ;Make Variable Type Numeric
E6E3: A8 TAY ;Return Length In Y-Reg
E6E4: 60 RTS ;Return to Caller
; ==============================================================================
; "ASC" ASCII Character Function
; ==============================================================================
;
E6E5: 20 DC E6 ASC JSR GETSTR ;Put String Pointer in INDEX, Length in (A)
E6E8: F0 08 BEQ GOIQ ;If Zero, Throw "?Illegal Quantity" Error
E6EA: A0 00 LDY #0 ;Clear Indirect Addressing Index
E6EC: B1 5E LDA (INDEX),Y ;Get 1st Character of String
E6EE: A8 TAY ;Prepare to Float 1st Character of String
; ----------------------------------- ;Convert Y-Reg to Real/FP Number in FAC:
E6EF: 4C 01 E3 JMP SNGFLT ;Float Unsigned Integer & Flag as a Number
; ==============================================================================
; Print "Illegal Quantity" Error Message
; ==============================================================================
;
; ----------------------------------- ;Error Entry Point; Also User-Callable:
E6F2: 4C 99 E1 GOIQ JMP IQERR ;Print "?Illegal Quantity" Error Message
; ==============================================================================
; Evaluate Formula at TXTPTR into FAC;
; Then Convert FAC to a Single Byte, Integer (0-255), in X-Reg:
; ==============================================================================
;
; Scan to Next Character, Evaluate Expression at TXTPTR, Assure its Numeric,
; Put it in FAC, & Convert FAC to a Single Byte, Integer (0-255), in X-Reg:
;
E6F5: 20 B1 00 GTBYTC JSR CHRGET ;Get Next Char/Token
;
; Evaluate Expression at TXTPTR, Assure its Numeric, Put it in FAC,
; & Convert FAC to a Single Byte, Integer (0-255), in X-Reg:
;
E6F8: 20 67 DD GETBYT JSR FRMNUM ;Eval & Assure: Put in FAC if it's a Number
;
; Convert FAC to a Single-Byte, Integer (0-255), in X-Reg:
;
E6FB: 20 08 E1 CONINT JSR MKINT ;Convert FAC to Integer in (FAC+3,4) & (X)
; ;^[# Must be Positive & less than 32768]
E6FE: A6 A0 LDX FAC+3 ;FAC Mantissa, Middle (FAC+3) must be Zero!
; ;^[So, really, Number Must be 0-255 !]
E700: D0 F0 BNE GOIQ ;Print "?Illegal Quantity" Error Message
E702: A6 A1 LDX FAC+4 ;Get FAC Mantissa, Low (FAC+4)
E704: 4C B7 00 JMP CHRGOT ;Get Last Char/Token Got
; ==============================================================================
; "VAL" Value Function: Immediate & Deferred; Parameter: VAL (Sexpr); Attempts
; to convert a String into a Number
; ==============================================================================
;
E707: 20 DC E6 VAL JSR GETSTR ;Put String Pointer in INDEX, Length in (A)
E70A: D0 03 BNE VALGO ;Branch if [(A)=(String Length)]<>(0)
; ;Else, Return [(A)=(String Length)]=(0):
E70C: 4C 4E E8 JMP ZFACEXPSGN ;Goto Zero FAC Signed Exponent & Sign
; ----------------------------------- ;Save CHRGET's TXTPTR Now:
E70F: A6 B8 VALGO LDX TXTPTR ;Get Next Char/Token Pointer, Low
E711: A4 B9 LDY TXTPTR+1 ;Get Next Char/Token Pointer, High
E713: 86 AD STX STRNG2 ;Set String Pointer #2, Low
E715: 84 AE STY STRNG2+1 ;Set String Pointer #2, High
; ----------------------------------- ;Point TXTPTR to Start of String, Low:
E717: A6 5E LDX INDEX ;Get String Pointer, Low
E719: 86 B8 STX TXTPTR ;Set Next Char/Token Pointer, Low
; ---------------------- ;Add Start of String, Low to Str Length:
E71B: 18 CLC ;Prepare for Add with Carry
E71C: 65 5E ADC INDEX ;Add String Pointer, Low
; ---------------------- ;Point DSTPTR to End of String +1, Low:
E71E: 85 60 STA DSTPTR ;Set Move Strings Destination Pointer, Low
; ----------------------------------- ;Point TXTPTR to Start of String, High:
E720: A6 5F LDX INDEX+1 ;Get String Pointer, High
E722: 86 B9 STX TXTPTR+1 ;Set Next Char/Token Pointer, High
; ---------------------- ;Add Start of String, High to Str Length:
E724: 90 01 BCC VALSKP ;Skip Advancing High Byte if NO Carryover
E726: E8 INX ;Add String Pointer, High
; ---------------------- ;Point DSTPTR to End of String +1, High:
E727: 86 61 VALSKP STX DSTPTR+1 ;Set Move Strings Destination Pointer, High
; ----------------------------------- ;Save Byte after Str & Replace with Zero:
E729: A0 00 LDY #0 ;Clear Indirect Addressing Index
E72B: B1 60 LDA (DSTPTR),Y ;Get Byte after String
E72D: 48 PHA ;Push Byte after String
E72E: A9 00 LDA #0 ;Clear Accumulator
E730: 91 60 STA (DSTPTR),Y ;Clear Byte after String
; ----------------------------------- ;No BUG here! Strings start at HIMEM-1 &
; ;build downward! HIMEM=$BFFF IS the Byte
; ;above the 1st String, NOT KBD=$C000!
; ----------------------------------- ;Setup 6502 Registers & Evaluate String:
E732: 20 B7 00 JSR CHRGOT ;Get Last Char/Token Got (Does the Setup)
E735: 20 4A EC JSR FIN ;Evaluate String to FP Value in FAC
; ----------------------------------- ;Retrieve & Restore Byte after String:
E738: 68 PLA ;Pull Byte after String
E739: A0 00 LDY #0 ;Clear Indirect Addressing Index
E73B: 91 60 STA (DSTPTR),Y ;Set Byte after String
; ----------------------------------- ;Retrieve & Restore CHRGET's TXTPTR Saved:
; ;**(Copy STRNG2 into TXTPTR Subroutine)**
E73D: A6 AD POINT LDX STRNG2 ;Get String Pointer #2, Low
E73F: A4 AE LDY STRNG2+1 ;Get String Pointer #2, High
E741: 86 B8 STX TXTPTR ;Set Next Char/Token Pointer, Low
E743: 84 B9 STY TXTPTR+1 ;Set Next Char/Token Pointer, High
; ----------------------------------- ;Finished:
E745: 60 RTS ;Return to Caller
; <<< BUG if KBD ? >>>
; ==============================================================================
; <<< Another mistake(?) here in Billy-Boy's (Microsoft?/Applesoft!) BASIC >>>
; ==============================================================================
; E730: STA (DSTPTR),Y ;Set Byte after String <<< BUG if KBD >>>
; ------------------------------------------------------------------------------
; <<< That causes a BUG if HIMEM = $BFFF, because storing $00 at $C000 is no
; use; $C000 will always be last char typed, so FIN won't terminate until it
; sees a zero at $C010! >>>
; ------------------------------------------------------------------------------
; Raises the quesion: Can HIMEM ever actually be $BFFF?
; ==============================================================================
; That's all Nonsense! Strings start at HIMEM-1 & build downward!
; HIMEM=$BFFF IS the Byte above the 1st String, NOT KBD=$C000!
; ==============================================================================
;
;
; ==============================================================================
; Evalute "EXP1,EXP2": Convert EXP1 to 16-bit Number in LINNUM;
; Convert EXP2 to 8-bit Number in X-Index Register
; ==============================================================================
;
E746: 20 67 DD GTNUM JSR FRMNUM ;Eval Syntax & Assure Expression is Numeric
E749: 20 52 E7 JSR GETADR ;Convert FAC to a 16-bit Value in LINNUM
;
; ==============================================================================
; Evalute ",Expression": Convert Expression to Single Byte in X-Index Register
; ==============================================================================
;
E74C: 20 BE DE COMBYTE JSR CHKCOM ;Require a (Data Separator) Comma 1st
E74F: 4C F8 E6 JMP GETBYT ;Convert Expression to a Byte in X-Reg
; ==============================================================================
; Convert FAC to a 16-bit Value in LINNUM
; ==============================================================================
;
E752: A5 9D GETADR LDA FAC ;Get FAC Exponent
E754: C9 91 CMP #$91 ;[(FACX)<=($FFFF)<(2^16)]?
; ^^^^^---------- ;Get Exponent to 2^16=65,536=%0001,0000
; ;Add 1 for Branch Greater Than or Equal To
; ;FAC FP#, So Set High Bit: $91=%1001,0001
; ;(Shifts Decimal Pt 16-bits to the Right)
; ----------------------------------- ;Error if Not Less Than:
E756: B0 9A BCS GOIQ ;Print "?Illegal Quantity" Error Message
; ----------------------------------- ;Convert FAC to a 16-bit Value in LINNUM:
E758: 20 F2 EB JSR QINT ;Convert FAC to (4 Byte) Integer
E75B: A5 A0 LDA FAC+3 ;Get FAC Mantissa, Middle (FAC+3)
E75D: A4 A1 LDY FAC+4 ;Get FAC Mantissa, Low (FAC+4)
E75F: 84 50 STY LINNUM ;Set Line Number Pointer, Low
E761: 85 51 STA LINNUM+1 ;Set Line Number Pointer, High
E763: 60 RTS ;Return to Caller
; ==============================================================================
; "PEEK" Function: Immediate & Deferred; Parameter: PEEK (Aexpr); Returns the
; decimal content of the byte at the address of the numeric expression (Aexpr)
; ==============================================================================
;
; ----------------------------------- ;Save LINNUM on Stack during PEEK:
E764: A5 50 PEEK LDA LINNUM ;Get Line Number Pointer, Low
E766: 48 PHA ;Push Line Number Pointer, Low
E767: A5 51 LDA LINNUM+1 ;Get Line Number Pointer, High
E769: 48 PHA ;Push Line Number Pointer, High
; ----------------------------------- ;Get the Address we're PEEKing at:
E76A: 20 52 E7 JSR GETADR ;Convert FAC to a 16-bit Value in LINNUM
; ----------------------------------- ;PEEK at the Address:
E76D: A0 00 LDY #0 ;Clear Indirect Addressing Index
E76F: B1 50 LDA (LINNUM),Y ;Get Value at the PEEK Address
E771: A8 TAY ;Set with Value from the PEEK Address
; ----------------------------------- ;Retrieve LINNUM from Stack after PEEK:
E772: 68 PLA ;Pull Line Number Pointer, High
E773: 85 51 STA LINNUM+1 ;Set Line Number Pointer, High
E775: 68 PLA ;Pull Line Number Pointer, Low
E776: 85 50 STA LINNUM ;Set Line Number Pointer, Low
; ----------------------------------- ;Convert Y-Reg to Real/FP Number in FAC:
E778: 4C 01 E3 JMP SNGFLT ;Float Unsigned Integer & Flag as a Number
; ==============================================================================
; "POKE" Statement: Immediate & Deferred; Parameters: POKE Aexpr1, Aexpr2;
; Stores an 8-bit Byte Value (Aexpr2) into a 16-bit Memory Location (Aexpr1)
; ==============================================================================
;
E77B: 20 46 E7 POKE JSR GTNUM ;Get Address in LINNUM & Value in X-Reg
E77E: 8A TXA ;Set (A)=(X)=(Byte Value to Store)
E77F: A0 00 LDY #0 ;Clear Indirect Addressing Index
E781: 91 50 STA (LINNUM),Y ;Set Value at the POKE Address
E783: 60 RTS ;Return to Caller
; ==============================================================================
; "WAIT" (Conditional Pause) Statement: Immediate & Deferred;
; Parameters: WAIT Aexpr1, Aexpr2 [, Aexpr3]
; ==============================================================================
;
; ----------------------------------- ;Only a Reset can Interupt a WAIT!
E784: 20 46 E7 WAIT JSR GTNUM ;Get Address in LINNUM & AND-Mask in X-Reg
E787: 86 85 STX FORPTR ;Store AND-Mask in FORPTR, Low
E789: A2 00 LDX #0 ;Clear XOR-Mask (Default Value = %00000000)
E78B: 20 B7 00 JSR CHRGOT ;Is an XOR-Mask Specified?
E78E: F0 03 BEQ WAITSKIP ;NO, Skip Getting It
E790: 20 4C E7 JSR COMBYTE ;YES, Get Specified XOR-Mask in X-Reg
E793: 86 86 WAITSKIP STX FORPTR+1 ;Store XOR-Mask in FORPTR, High
E795: A0 00 LDY #0 ;Clear Indirect Addressing Index
; ----------------------------------- ;Do WAIT Address, AND-Mask, XOR-Mask:
E797: B1 50 WAITLOOP LDA (LINNUM),Y ;Get Byte at Specified Address
E799: 45 86 EOR FORPTR+1 ;Invert Specified Bits by XOR-Mask
E79B: 25 85 AND FORPTR ;Select Specified Bits by AND-Mask
E79D: F0 F8 BEQ WAITLOOP ;Loop Until Bits NOT %00000000
E79F: 60 BAS_RTS15 RTS ;Return to Caller
;
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
; ==============================================================================
; Applesoft - Part C, $E7A0-$F1D4: Floating Point Math Routines
; ==============================================================================
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
;
;
; YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY
; ==============================================================================
; To see: "How Applesoft BASIC Program Varables* Are Structured"
; *(Reals {Floating Point}, Integers, Strings, Functions, and Arrays),
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", pages 21 to 24
; ==============================================================================
; YYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYYY
;
;
; ==============================================================================
; Add 0.5 to FAC ;FAC+[(1/2):(Packed FAC Constant)] -> FAC:
; ==============================================================================
;
E7A0: A9 64 FADDH LDA #<CON_HALF ;Get Low Address of (The Number One Half)
E7A2: A0 EE LDY #>CON_HALF ;Get High Address of (The Number One Half)
E7A4: 4C BE E7 JMP FADD ;Go Add 0.5 to FAC
; ==============================================================================
; "SUBTRACT" ("-") Function:
; ==============================================================================
;
; ----------------------------------- ;Subtract FAC frm (A,Y) & Put Back in FAC:
E7A7: 20 E3 E9 FSUB JSR UPAY2ARG ;Unpack FP# at [(A,Y)={Low,High}] into ARG
; ------------------------------------------------------------------------------
; FSUBT is Main Entry Point: ;(Math Operator Table Branch Address +1)
; ----------------------------------- ;Subtract FAC from ARG & Put back in FAC
; ;(Complement FAC & Add):
E7AA: A5 A2 FSUBT LDA FACSIGN ;Get FAC Unpacked Sign (msb)
E7AC: 49 FF EOR #%11111111 ;Invert Bits (Negate)
E7AE: 85 A2 STA FACSIGN ;Set FAC Unpacked Sign (msb)
E7B0: 45 AA EOR ARGSIGN ;XOR ARG Unpacked Sign (msb)
E7B2: 85 AB STA SGNCPR ;Set Sign Comparison Flag
; ;Make Status Show FAC Exponent:
E7B4: A5 9D LDA FAC ;Get FAC Exponent (Status if FACX=0)
E7B6: 4C C1 E7 JMP FADDT ;Go Add ARG to -FAC; Result: FAC=ARG-FAC
; ==============================================================================
; "ADD" ("+") Function:
; ==============================================================================
;
; ----------------------------------- ;Shift Smaller Argument More Than 7 Bits:
E7B9: 20 F0 E8 FADD1 JSR SHFTRGHT ;Align Radix (Bits) by Shifting Byte Right
; ;^[Radix = Number System Base (Binary =2)]
E7BC: 90 3C BCC FADD3 ;Always Taken
;
; ----------------------------------- ;Add FAC to (A,Y) & Put back in FAC:
E7BE: 20 E3 E9 FADD JSR UPAY2ARG ;Unpack FP# at [(A,Y)={Low,High}] into ARG
; ------------------------------------------------------------------------------
; FADDT is Main Entry Point: ;(Math Operator Table Branch Address +1)
; ----------------------------------- ;Add FAC to ARG & Put back in FAC:
E7C1: D0 03 FADDT BNE FADDFAC ;Branch if FAC is Not Zero (FAC<>0)
E7C3: 4C 53 EB JMP CPYARG2FAC ;Else, Go Copy ARG into FAC (FAC=0+ARG)
; ----------------------------------- ;Add Non-Zero FAC to ARG & Put Bak in FAC:
E7C6: A6 AC FADDFAC LDX FACEXT ;Get FAC Extra Precision Byte for FP Op's
E7C8: 86 92 STX ARGEXT ;Set ARG Extra Precision Byte for FP Op's
E7CA: A2 A5 LDX #ARG ;Get Set to Shift ARG
E7CC: A5 A5 LDA ARG ;Get ARG Exponent (ARGX)
E7CE: A8 FADD2 TAY ;Set Y-Reg = ARG Exponent (ARGX)
E7CF: F0 CE BEQ BAS_RTS15 ;EXIT if ARG=0 (FAC=FAC+0)
; ;^[Mantissas Ignored if FAC|ARG Exp's=0]
E7D1: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
E7D2: E5 9D SBC FAC ;Subtract FACX from ARGX
E7D4: F0 24 BEQ FADD3 ;Go Add if Exponents Equal (FACX=ARGX)
E7D6: 90 12 BCC FARGLESS ;Branch if ARG has Smaller Exponent
; ;Else, FAC has Smaller Exponent:
E7D8: 84 9D STY FAC ;Set FAC Exponent = ARG Exponent
E7DA: A4 AA LDY ARGSIGN ;Get ARG Unpacked Sign (msb)
E7DC: 84 A2 STY FACSIGN ;Set FAC Unpacked Sign (msb)
; ;Complement Shift Count (FACSIGN):
E7DE: 49 FF EOR #%11111111 ;Invert Bits (Negate)
E7E0: 69 00 ADC #0 ;Add with Carry still Set, Adds 1
E7E2: A0 00 LDY #0 ;Clear Y-Reg
E7E4: 84 92 STY ARGEXT ;Clear ARG Extra Precision Byte for FP Op's
E7E6: A2 9D LDX #FAC ;Get Set to Shift FAC
E7E8: D0 04 BNE FBITSHFT ;Always Taken
; ;ARG has Smaller Exponent:
E7EA: A0 00 FARGLESS LDY #0 ;Clear Y-Reg
E7EC: 84 AC STY FACEXT ;Clear FAC Extra Precision Byte for FP Op's
; ;Determine How Many Bits to Shift:
E7EE: C9 F9 FBITSHFT CMP #$F9 ;=(-7); Shifting more than 7 bits?
; ;^[Negative of Shift Count]
E7F0: 30 C7 BMI FADD1 ;Branch if Shifting more than 7 bits
E7F2: A8 TAY ;Set Number of Shifts Index (Counter)
E7F3: A5 AC LDA FACEXT ;Get FAC Extra Precision Byte for FP Op's
; ----------------------------------- ;Shift Right Smaller of FAC & ARG:
; ;SHFTPTR=(Base Address for FAC & ARG)=LOC1
; ;(X)=(Address of Smaller of FAC & ARG)
E7F5: 56 01 LSR LOC1,X ;Start Shifting... [(LOC1..LOC4) then (A)]
E7F7: 20 07 E9 JSR SHFTRGHT4 ;...Complete Shifting [(LOC2..LOC4) & (A)]
; ----------------------------------- ;What to do next:
E7FA: 24 AB FADD3 BIT SGNCPR ;Do FAC & ARG Have Same Signs?
E7FC: 10 57 BPL ADDMANTS ;YES, Go Add Mantissas
E7FE: A0 9D LDY #FAC ;NO, Subtract Smaller from Larger
;
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
; ==============================================================================
; ROM Space ($E800-$EFFF): ROM Socket $E8 on a real Apple II Plus.
; ==============================================================================
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
;
E800: E0 A5 CPX #ARG ;[(X)=(#FAC)] Which was Shifted Right?
E802: F0 02 BEQ SUBMANTS ;If ARG was Shifted Right, Do FAC-ARG
E804: A0 A5 LDY #ARG ;If FAC was Shifted Right, Do ARG-FAC
; ----------------------------------- ;Subtract Smaller from Larger [might be
; ;Larger from Smaller if Exponents Equal];
; ---------------------- ;1st, Subtr Smaller Extra Precision Byte:
; ;(A)=(Extra Precision Byte from SHFTRGHT4)
E806: 38 SUBMANTS SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
; ;or to Add with Carry Set (Adds 1)
E807: 49 FF EOR #%11111111 ;Invert Bits [Negate (A)]
E809: 65 92 ADC ARGEXT ;Add ARG Extra Precision Byte for FP Op's
E80B: 85 AC STA FACEXT ;Set FAC Extra Precision Byte for FP Op's
; ;^[Remember: It all gets put back in FAC]
; ---------------------- ;2nd, Subtract Smaller Mantissa:
; ;SHFTPTR=(Base Addrs for FAC & ARG)=LOC1
; ;(Y)=(Address of Larger of FAC & ARG)
; ;(X)=(Address of Smaller of FAC & ARG)
E80D: B9 04 00 LDA LOC4,Y ;Get Larger Mantissa, Low
E810: F5 04 SBC LOC4,X ;Subtract Smaller Mantissa, Low
E812: 85 A1 STA FAC+4 ;Set FAC Mantissa, Low
E814: B9 03 00 LDA LOC3,Y ;Get Larger Mantissa, Middle
E817: F5 03 SBC LOC3,X ;Subtract Smaller Mantissa, Middle
E819: 85 A0 STA FAC+3 ;Set FAC Mantissa, Middle
E81B: B9 02 00 LDA LOC2,Y ;Get Larger Mantissa, High
E81E: F5 02 SBC LOC2,X ;Subtract Smaller Mantissa, High
E820: 85 9F STA FAC+2 ;Set FAC Mantissa, High
E822: B9 01 00 LDA LOC1,Y ;Get Larger Mantissa, Top
E825: F5 01 SBC LOC1,X ;Subtract Smaller Mantissa, Top
E827: 85 9E STA FAC+1 ;Set FAC Mantissa, Top
; ----------------------------------- ;Normalize Value in FAC:
E829: B0 03 NRMLZFAC1 BCS NRMLZFAC2 ;Branch if Different Position Values
E82B: 20 9E E8 JSR TWSCMPFAC ;Else, Two's Compliment FAC
E82E: A0 00 NRMLZFAC2 LDY #0 ;Clear Y-Reg
E830: 98 TYA ;Clear Shift Up Counter (A-Reg)
E831: 18 CLC ;Prepare for Add with Carry
E832: A6 9E NRMLZLOOP LDX FAC+1 ;Get FAC Mantissa, Top
E834: D0 4A BNE FNRMLZFAC ;Finish Normalizing FAC if any 1-Bits here
; ---------------------- ;Else, Zero, So Do a Fast 8-Bit Shuffle:
E836: A6 9F LDX FAC+2 ;Get FAC Mantissa, High
E838: 86 9E STX FAC+1 ;Set FAC Mantissa, Top
E83A: A6 A0 LDX FAC+3 ;Get FAC Mantissa, Middle
E83C: 86 9F STX FAC+2 ;Set FAC Mantissa, High
E83E: A6 A1 LDX FAC+4 ;Get FAC Mantissa, Low
E840: 86 A0 STX FAC+3 ;Set FAC Mantissa, Middle
E842: A6 AC LDX FACEXT ;Get FAC Extra Precision Byte for FP Op's
E844: 86 A1 STX FAC+4 ;Set FAC Mantissa, Low
E846: 84 AC STY FACEXT ;Zero FAC Extra Precision Byte for FP Op's
E848: 69 08 ADC #8 ;Advance Shift Count (Add 8 Bits)
E84A: C9 20 CMP #32 ;Done 4 times yet? [(4*(8 Bits))=(4 Bytes)]
E84C: D0 E4 BNE NRMLZLOOP ;NO, Still might be some 1's; LOOP-Back
; ----------------------------------- ;Zero FAC: (Only need do Exponent & Sign):
E84E: A9 00 ZFACEXPSGN LDA #0 ;Clear Accumulator
E850: 85 9D ZFACSGNEXP STA FAC ;Set FAC Signed Exponent
E852: 85 A2 ZFACSGN STA FACSIGN ;Set FAC Sign
E854: 60 RTS ;Return to Caller
; ----------------------------------- ;Add Mantissas of FAC & ARG into FAC:
; ;(A) FAC Extra Precision Byte for FP Op's
E855: 65 92 ADDMANTS ADC ARGEXT ;Add ARG Extra Precision Byte for FP Op's
E857: 85 AC STA FACEXT ;Set FAC Extra Precision Byte for FP Op's
E859: A5 A1 LDA FAC+4 ;Get FAC Mantissa, Low
E85B: 65 A9 ADC ARG+4 ;Add ARG Mantissa, Low
E85D: 85 A1 STA FAC+4 ;Set FAC Mantissa, Low
E85F: A5 A0 LDA FAC+3 ;Get FAC Mantissa, Middle
E861: 65 A8 ADC ARG+3 ;Add ARG Mantissa, Middle
E863: 85 A0 STA FAC+3 ;Set FAC Mantissa, Middle
E865: A5 9F LDA FAC+2 ;Get FAC Mantissa, High
E867: 65 A7 ADC ARG+2 ;Add ARG Mantissa, High
E869: 85 9F STA FAC+2 ;Set FAC Mantissa, High
E86B: A5 9E LDA FAC+1 ;Get FAC Mantissa, Top
E86D: 65 A6 ADC ARG+1 ;Add ARG Mantissa, Top
E86F: 85 9E STA FAC+1 ;Set FAC Mantissa, Top
E871: 4C 8D E8 JMP FRBCC ;Go See if Matissa Carried
; ----------------------------------- ;Finish Normalizing FAC:
E874: 69 01 FRLOOP ADC #1 ;Count Bits Shifted
E876: 06 AC ASL FACEXT ;Shift Left: FAC Extra Precision Byte
E878: 26 A1 ROL FAC+4 ;Shift Left: FAC Mantissa, Low
E87A: 26 A0 ROL FAC+3 ;Shift Left: FAC Mantissa, Middle
E87C: 26 9F ROL FAC+2 ;Shift Left: FAC Mantissa, High
E87E: 26 9E ROL FAC+1 ;Shift Left: FAC Mantissa, Top
E880: 10 F2 FNRMLZFAC BPL FRLOOP ;Repeat until FAC-Top becomes Negative
; ----------------------------------- ;Two's Complement FAC
; ;(Adjust Exponent by Bits Shifted):
E882: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
E883: E5 9D SBC FAC ;Subtract FAC Exponent from Bits Shifted
E885: B0 C7 BCS ZFACEXPSGN ;Branch if Underflow; Return FAC Zeroed
E887: 49 FF EOR #%11111111 ;Invert Bits (Negate)
E889: 69 01 ADC #1 ;Two's Complement (A)
E88B: 85 9D STA FAC ;Set FAC Exponent (Two's Complemented)
; ----------------------------------- ;Carry is Clear here; Return to Caller
E88D: 90 0E FRBCC BCC BAS_RTS16 ;Return to Caller if Carry is Clear
; ;Else, Carry is Set, So Mantissa Carried:
E88F: E6 9D FROUND INC FAC ;Advance FAC Exponent; Add Carry (+1)
E891: F0 42 BEQ OVERFLOW ;Throw Overflow Error if Exponent Too Big
; ----------------------------------- ;Shift FAC Mantissa Right:
E893: 66 9E ROR FAC+1 ;Shift Right: FAC Mantissa, Top
E895: 66 9F ROR FAC+2 ;Shift Right: FAC Mantissa, High
E897: 66 A0 ROR FAC+3 ;Shift Right: FAC Mantissa, Middle
E899: 66 A1 ROR FAC+4 ;Shift Right: FAC Mantissa, Low
E89B: 66 AC ROR FACEXT ;Shift Right: FAC Extra Precision Byte
E89D: 60 BAS_RTS16 RTS ;Return to Caller
; ----------------------------------- ;Two's Complement FAC:
; ;1st, One's Complement FAC:
E89E: A5 A2 TWSCMPFAC LDA FACSIGN ;Get FAC Sign
E8A0: 49 FF EOR #%11111111 ;Invert Bits (Negate)
E8A2: 85 A2 STA FACSIGN ;Set FAC Sign
; ---------------------- ;Two's Complement FAC Mantissa (only):
; ;1st, One's Complement FAC Mantissa:
E8A4: A5 9E TCFACMANT LDA FAC+1 ;Get FAC Mantissa, Top
E8A6: 49 FF EOR #%11111111 ;Invert Bits (Negate)
E8A8: 85 9E STA FAC+1 ;Set FAC Mantissa, Top
E8AA: A5 9F LDA FAC+2 ;Get FAC Mantissa, High
E8AC: 49 FF EOR #%11111111 ;Invert Bits (Negate)
E8AE: 85 9F STA FAC+2 ;Set FAC Mantissa, High
E8B0: A5 A0 LDA FAC+3 ;Get FAC Mantissa, Middle
E8B2: 49 FF EOR #%11111111 ;Invert Bits (Negate)
E8B4: 85 A0 STA FAC+3 ;Set FAC Mantissa, Middle
E8B6: A5 A1 LDA FAC+4 ;Get FAC Mantissa, Low
E8B8: 49 FF EOR #%11111111 ;Invert Bits (Negate)
E8BA: 85 A1 STA FAC+4 ;Set FAC Mantissa, Low
E8BC: A5 AC LDA FACEXT ;Get FAC Extra Precision Byte
E8BE: 49 FF EOR #%11111111 ;Invert Bits (Negate)
E8C0: 85 AC STA FACEXT ;Set FAC Extra Precision Byte
; ----------------------------------- ;2nd, Add a Bit to get Two's Complement:
; ;(Start Advancing FAC Mantissa):
E8C2: E6 AC INC FACEXT ;Advance FAC Extra Precision Byte
E8C4: D0 0E BNE BAS_RTS17 ;Return to Caller if No Carryover
; ---------------------- ;Advance FAC Mantissa:
; ;(Add Carry frm FAC Extra Precision Byte):
E8C6: E6 A1 INCFACMAN INC FAC+4 ;Advance FAC Mantissa, Low
E8C8: D0 0A BNE BAS_RTS17 ;Return to Caller if No Carryover
E8CA: E6 A0 INC FAC+3 ;Advance FAC Mantissa, Middle
E8CC: D0 06 BNE BAS_RTS17 ;Return to Caller if No Carryover
E8CE: E6 9F INC FAC+2 ;Advance FAC Mantissa, High
E8D0: D0 02 BNE BAS_RTS17 ;Return to Caller if No Carryover
E8D2: E6 9E INC FAC+1 ;Advance FAC Mantissa, Top
E8D4: 60 BAS_RTS17 RTS ;Return to Caller
; ----------------------------------- ;Error Entry Point; Also User-Callable:
E8D5: A2 45 OVERFLOW LDX #ERR_OVERFLOW ;Throw an "?Overflow" Error:
E8D7: 4C 12 D4 JMP ERROR ;Go Print Error Message based on X-Reg
; ==============================================================================
; Shift Right (Subroutine)
; ==============================================================================
; SHFTRGHT1 is Auxiliary Entry Point: Entered from FMULT Function
; ------------------------------------------------------------------------------
; ;Shift RESULT Right [(LOC1..LOC4),X]:
; Entry from "MULTIPLY" Function: ;Carry should be Set!
; ;A-Reg = Negative Shift Count [+0 <-- $F9]
; ;X-Reg = Pointer to Bytes to be Shifted
; ;Returns: Y=0, Carry=0, A=(Extension Bits)
; ------------------------------------------------------------------------------
E8DA: A2 61 SHFTRGHT1 LDX #RESULT-1 ;Get Pointer to Bytes to be Shifted
E8DC: B4 04 SR1LOOP LDY LOC4,X ;Get RESULT Mantissa, Low
E8DE: 84 AC STY FACEXT ;Set FAC Extra Precision Byte
E8E0: B4 03 LDY LOC3,X ;Get RESULT Mantissa, Middle
E8E2: 94 04 STY LOC4,X ;Set RESULT Mantissa, Low
E8E4: B4 02 LDY LOC2,X ;Get RESULT Mantissa, High
E8E6: 94 03 STY LOC3,X ;Set RESULT Mantissa, Middle
E8E8: B4 01 LDY LOC1,X ;Get RESULT Mantissa, Top
E8EA: 94 02 STY LOC2,X ;Set RESULT Mantissa, High
E8EC: A4 A4 LDY SHFTSGNX ;Get FAC Right Shift Sign Extension
; ;^[$00 if Positive, $FF if Negative]
; ;^[Also Negative ($FF) if from QINT]
E8EE: 94 01 STY LOC1,X ;Set RESULT Mantissa, Top ($00 or $FF)
; ------------------------------------------------------------------------------
; SHFTRGHT is Main Entry Point: Entered from FADDT & QINT Functions
; ------------------------------------------------------------------------------
; ;Shift Right [(LOC1..LOC4),X then (A)]:
; Entry from "ADD" Function: ;SHFTPTR=(Base Address for FAC & ARG)=LOC1
; ;(X)=(Address of Smaller of FAC & ARG)
; ------------------------------------------------------------------------------
; ;Shift Rght [($100)-(A)] Bits, Long (>7b):
E8F0: 69 08 SHFTRGHT ADC #8 ;Reduce Negative Shift Count (Add 8 Bits)
E8F2: 30 E8 BMI SR1LOOP ;Repeat if Neg Shift Count < 0 still
; ;^(Still more than 8 Bits to go)
E8F4: F0 E6 BEQ SR1LOOP ;Repeat if Neg Shift Count = 0 also
; ;^(Exactly 8 more Bits to go)
E8F6: E9 08 SBC #8 ;Advance Neg Shift Count (Subtract 8 Bits)
; ;^(Undoes Reduction Above)
E8F8: A8 TAY ;Save Remaining Negative Shift Count
E8F9: A5 AC LDA FACEXT ;Get FAC Extra Precision Byte
E8FB: B0 14 BCS SHFTRGHT5 ;EXIT if Shift Right Finished
; ----------------------------------- ;Shift Right (LOOP) [Lower 7 Bits Only]:
; ;1st, Get Sign of RESULT into Carry Flag:
E8FD: 16 01 SRLOOP ASL LOC1,X ;Shift Left: RESULT Mantissa, Top
; ;^[Puts Sign in (C) {Sign Extension Bit}]
E8FF: 90 02 BCC SRSKP ;Skip Advancing Top Byte if NO Carry
E901: F6 01 INC LOC1,X ;Advance (+1) Result, Top; Adds Carry
; ;^[Puts Sign Extension Bit into LSB]
; ;^[Forces next OP to Set Carry Flag]
E903: 76 01 SRSKP ROR LOC1,X ;Shift Right: RESULT Mantissa, Top (1st)
; ;^[Restores Value w/ Sign still in Carry]
; ----------------------------------- ;Shift Right [(LOC1..LOC4),X then (A)]:
E905: 76 01 ROR LOC1,X ;Shift Right: RESULT Mantissa, Top (2nd)
; ;^[Start Right Shift, inserting Sign]
; ------------------------------------------------------------------------------
; SHFTRGHT4 is Auxiliary Entry Point: Also Entered from FADDT & QINT Functions;
; Enter Here for Short Shifts with No Sign Extension:
; ------------------------------------------------------------------------------
E907: 76 02 SHFTRGHT4 ROR LOC2,X ;Shift Right: RESULT Mantissa, High
E909: 76 03 ROR LOC3,X ;Shift Right: RESULT Mantissa, Middle
E90B: 76 04 ROR LOC4,X ;Shift Right: RESULT Mantissa, Low
E90D: 6A ROR A ;Shift Right: Extension Byte (A)
E90E: C8 INY ;Reduce Negative Shift Count (Add a Bit)
E90F: D0 EC BNE SRLOOP ;LOOP: Shift Right Until All Bits Done
; ------------------------------------------------------------------------------
E911: 18 SHFTRGHT5 CLC ;Return with Carry Clear
E912: 60 RTS ;Return to Caller
; ==============================================================================
; The Number One (1) (Packed FAC Constant)
; ==============================================================================
;
E913: 81 00 00 00+ CON_ONE HEX 8100000000 ;<-[Normalized]; The Number One (1)
;
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ONE HEX 8100000000 |(00) |$81-$80=$01= +1 |$.00000000 |+1.00000000E+0
; (!) POS_ONE HEX 8180000000 |(00) |$81-$80=$01= +1 |$.80000000 |+1.00000000E+0
; (!) NEG_ONE HEX 8180000000 |(FF) |$81-$80=$01= +1 |$.80000000 |-1.00000000E+0
; ------------------------------------------------------------------------------
; <<< Plugging CON_ONE into & Printing FAC ($ED2EG) results in BLANK LINE, not 1
; --Seems that when the mantissa is zero there's a problem printing numbers! >>>
; ------------------------------------------------------------------------------
; * FACSIGN msb must be set ($80-$FF) to print a minus sign before a result #.
; ==============================================================================
;
;
; ==============================================================================
; Polynomial Log Coefficients (Packed FAC Constants adjusted for accuracy)
; ==============================================================================
; Logarithm Formulas:
; ------------------------------------------------------------------------------
; Log (base b) N = ln(N) / ln(b)
; Log (base 2) N = ln(N) / ln(2)
; ==============================================================================
; How do these "*X^N+" Poly Logs work? We're not talking about baby frogs here!
; ------------------------------------------------------------------------------
; According to Michael Pohoreski (AppleWin Debugger Developer), "Applesoft uses
; Horner's Rule [a polynomial evaluation method] when it calculates a partial
; Taylor Series. See: <https://en.wikipedia.org/wiki/horner's_method>"
; ------------------------------------------------------------------------------
; According to Kent Dicky, "A useful approximation to many functions over
; limited ranges is something like: f(x) = A*x + B*x^2 + C*x^3 + D*x^4, etc.
; where 'x' is the input number, and A,B,C,D are constants that depend on the
; function being evaluated. [Which seems to fit here.] For example, the Taylor
; series: sin(x) = [x=(x^1)/(1!)] - (x^3)/(3!) + (x^5)/(5!) - (x^7)/(7!) + ...."
; ==============================================================================
;
E918: 03 POLY_LOG DFB $03 ;Number of Log Coefficients - 1
NOTE: Packed FAC Constants or Not? Still a Mystery!
E919: 7F 5E 56 CB+ POLY_LOG_7 HEX 7F5E56CB79 ;* X^7 + :[10^7 = 10,000,000]
E91E: 80 13 9B 0B+ POLY_LOG_5 HEX 80139B0B64 ;* X^5 + :[10^5 = 100,000]
E923: 80 76 38 93+ POLY_LOG_3 HEX 8076389316 ;* X^3 + :[10^3 = 1,000]
E928: 82 38 AA 3B+ POLY_LOG_1 HEX 8238AA3B20 ;* X^1 + :[10^1 = 10]
;
; [Packed FAC Constants or Not? These do NOT print the numbers expected!]
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; NRM_PLOG_7 HEX 7F5E56CB79 |(00) |$7F-$80=$FF= -1 |$.5E56CB79 |+1.84255942E-1
; POS_PLOG_7 HEX 7FDE56CB79 |(00) |$7F-$80=$FF= -1 |$.DE56CB79 |+4.34255942E-1
; NEG_PLOG_7 HEX 7FDE56CB79 |(FF) |$7F-$80=$FF= -1 |$.DE56CB79 |-4.34255942E-1
; ----------------------------|-----|----------------|-----------|--------------
; NRM_PLOG_5 HEX 80139B0B64 |(00) |$80-$80=$00= +0 |$.139B0B64 |+7.65845413E-2
; POS_PLOG_5 HEX 80939B0B64 |(00) |$80-$80=$00= +0 |$.939B0B64 |+5.76584541E-1
; NEG_PLOG_5 HEX 80939B0B64 |(FF) |$80-$80=$00= +0 |$.939B0B64 |-5.76584541E-1
; ----------------------------|-----|----------------|-----------|--------------
; NRM_PLOG_3 HEX 8076389316 |(00) |$80-$80=$00= +0 |$.76389316 |+4.61800759E-1
; POS_PLOG_3 HEX 80F6389316 |(00) |$80-$80=$00= +0 |$.F6389316 |+9.61800759E-1
; NEG_PLOG_3 HEX 80F6389316 |(FF) |$80-$80=$00= +0 |$.F6389316 |-9.61800759E-1
; ----------------------------|-----|----------------|-----------|--------------
; NRM_PLOG_1 HEX 8238AA3B20 |(00) |$82-$80=$02= +2 |$.38AA3B20 |+8.85390073E-1
; POS_PLOG_1 HEX 82B8AA3B20 |(00) |$82-$80=$02= +2 |$.B8AA3B20 |+2.88539007E+0
; NEG_PLOG_1 HEX 82B8AA3B20 |(FF) |$82-$80=$02= +2 |$.B8AA3B20 |-2.88539007E+0
; ------------------------------------------------------------------------------
; * FACSIGN msb must be set ($80-$FF) to print a minus sign before a result #.
; ==============================================================================
;
;
; ==============================================================================
; Miscellaneous Coefficients (Packed FAC Constants)
; ==============================================================================
;
E92D: 80 35 04 F3+ CON_SQRHALF HEX 803504F334 ;SQR(1/2) = 0.707106781
E932: 81 35 04 F3+ CON_SQRTWO HEX 813504F334 ; SQR(2) = 1.414213562
E937: 80 80 00 00+ CON_NEGHALF HEX 8080000000 ; -1/2 = -.500000000
E93C: 80 31 72 17+ CON_LOGTWO HEX 80317217F8 ; ln(2) = 0.693147181; {<> POLY_EXP_LN2}
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_SQRH HEX 803504F334 |(00) |$80-$80=$00= +0 |$.3504F334 |+2.07106781E-1
; (!) POS_SQRH HEX 80B504F334 |(00) |$80-$80=$00= +0 |$.B504F334 |+7.07106781E-1
; (!) NEG_SQRH HEX 80B504F334 |(FF) |$80-$80=$00= +0 |$.B504F334 |-7.07106781E-1
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_SQR2 HEX 813504F334 |(00) |$81-$80=$01= +1 |$.3504F334 |+0.41421356E+0
; (!) POS_SQR2 HEX 81B504F334 |(00) |$81-$80=$01= +1 |$.B504F334 |+1.41421356E+0
; (!) NEG_SQR2 HEX 81B504F334 |(FF) |$81-$80=$01= +1 |$.B504F334 |-1.41421356E+0
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_HALF HEX 8000000000 |(00) |$80-$80=$00= +0 |$.00000000 |+5.00000000E-1
; (!) POS_HALF HEX 8080000000 |(00) |$80-$80=$00= +0 |$.80000000 |+5.00000000E-1
; (!) NEG_HALF HEX 8080000000 |(FF) |$80-$80=$00= +0 |$.80000000 |-5.00000000E-1
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_LN2 HEX 80317217F8 |(00) |$80-$80=$00= +0 |$.317217F8 |+1.93147181E-1
; (!) POS_LN2 HEX 80B17217F8 |(00) |$80-$80=$00= +0 |$.B17217F8 |+6.93147181E-1
; (!) NEG_LN2 HEX 80B17217F8 |(FF) |$80-$80=$00= +0 |$.B17217F8 |-6.93147181E-1
; ==============================================================================
;
;
; ==============================================================================
; "LOG" Function: Immediate & Deffered; Parameter: LOG (Aexpr);
; Returns the Natural Logarithm (ln) of a Positive Number (Aexpr)
; [(e=2.71828183...) is Euler's Constant, the Base for Natural Logarithms]
; ==============================================================================
;
E941: 20 82 EB LOG JSR SIGN ;FAC Sign (Neg|0|Pos) Returns (A)=(-1|0|1)
E944: F0 02 BEQ GIQ ;Do Illegal Quantity Error if Not Positive
E946: 10 03 BPL LOG2 ;Do Natural Logarithm if Number is Positive
E948: 4C 99 E1 GIQ JMP IQERR ;Print "?Illegal Quantity" Error Message
; ------------------------------------------------------------------------------
; Compute Natural Logarithm via Series of Odd Powers of (SQR(2)X-1)/(SQR(2)X+1):
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;AHA! So this is how Normalization is done
E94B: A5 9D LOG2 LDA FAC ;Get FAC Exponent [Log (base 2)]
E94D: E9 7F SBC #$7F ;Subtract with Borrow [A-Data-!C]:(!C=1)
E94F: 48 PHA ;Push FAC Exponent [Unbiased (FACX-$80)]
E950: A9 80 LDA #$80 ;Normalize between .5 & 1
E952: 85 9D STA FAC ;Set FAC Exponent [Normalized]
; ----------------------------------- ;Compute Natural Logarithm:
; ;[(A,Y)={Low,High}] in these OPs:
E954: A9 2D LDA #<CON_SQRHALF ;Get Address of Constant [SQR(1/2)], Low
E956: A0 E9 LDY #>CON_SQRHALF ;Get Address of Constant [SQR(1/2)], High
E958: 20 BE E7 JSR FADD ;Add FAC to (A,Y) & Put back in FAC
E95B: A9 32 LDA #<CON_SQRTWO ;Get Address of Constant [SQR(2)], Low
E95D: A0 E9 LDY #>CON_SQRTWO ;Get Address of Constant [SQR(2)], High
E95F: 20 66 EA JSR FDIV ;Divide FAC into (A,Y) & Put back in FAC
E962: A9 13 LDA #<CON_ONE ;Get Address of Constant [One (1)], Low
E964: A0 E9 LDY #>CON_ONE ;Get Address of Constant [One (1)], High
E966: 20 A7 E7 JSR FSUB ;Subtract FAC from (A,Y) & Put back in FAC
E969: A9 18 LDA #<POLY_LOG ;Get Address of Log Coefficients, Low
E96B: A0 E9 LDY #>POLY_LOG ;Get Address of Log Coefficients, High
E96D: 20 5C EF JSR POLY_ODD ;Compute [LOG (base 2) of (+.5)]:
; ;Computes ax+bx^3+cx^5+... where
; ;(A,Y) points to Coeficients ...c,b,a
E970: A9 37 LDA #<CON_NEGHALF ;Get Address of Constant [(-.5)], Low
E972: A0 E9 LDY #>CON_NEGHALF ;Get Address of Constant [(-.5)], High
E974: 20 BE E7 JSR FADD ;Add FAC to (A,Y) & Put back in FAC
E977: 68 PLA ;Pull FAC Exponent [Unbiased (FACX-$80)]
E978: 20 D5 EC JSR ADDACC ;Add FAC to (A) & Put back in FAC
; ;Multiply by LOG(2) to get Natural Log
E97B: A9 3C LDA #<CON_LOGTWO ;Get Address of Constant [ln(2)], Low
E97D: A0 E9 LDY #>CON_LOGTWO ;Get Address of Constant [ln(2)], High
;
; ==============================================================================
; "MULTIPLY" ("*") Function:
; ==============================================================================
;
; ----------------------------------- ;Multiply FAC by (A,Y) & Put back in FAC:
E97F: 20 E3 E9 FMULT JSR UPAY2ARG ;Unpack FP# at [(A,Y)={Low,High}] into ARG
; ------------------------------------------------------------------------------
; FMULTT is Main Entry Point: ;(Math Operator Table Branch Address +1):
; ----------------------------------- ;Multiply FAC by ARG & Put back in FAC:
E982: D0 03 FMULTT BNE FMULTT1 ;Branch if FAC is Not Zero (FAC<>0)
; <<< Could be RTS here! >>> ;Else: Multiplying by Zero produces Zero!
E984: 4C E2 E9 JMP BAS_RTS18 ;So, just Return if FAC is Zero (FAC=0)
E987: 20 0E EA FMULTT1 JSR ADDEXPS ;Add ARG & FAC Exponents [FACX=ARGX+FACX]
; ;^[Checks for Overflow & Sets RESULT Sign]
E98A: A9 00 LDA #0 ;Initialize Product = 0
; ----------------------------------- ;Clear/Zero FP RESULT of Last Mult or Div:
E98C: 85 62 STA RESULT ;Set RESULT Mantissa, Top
E98E: 85 63 STA RESULT+1 ;Set RESULT Mantissa, High
E990: 85 64 STA RESULT+2 ;Set RESULT Mantissa, Middle
E992: 85 65 STA RESULT+3 ;Set RESULT Mantissa, Low
; ----------------------------------- ;Multiply FAC by ARG & Add to RESULT:
E994: A5 AC LDA FACEXT ;Get FAC Extra Precision Byte
E996: 20 B0 E9 JSR MULT1 ;Multiply (A) by ARG & Add to RESULT
E999: A5 A1 LDA FAC+4 ;Get FAC Mantissa, Low
E99B: 20 B0 E9 JSR MULT1 ;Multiply (A) by ARG & Add to RESULT
E99E: A5 A0 LDA FAC+3 ;Get FAC Mantissa, Middle
E9A0: 20 B0 E9 JSR MULT1 ;Multiply (A) by ARG & Add to RESULT
E9A3: A5 9F LDA FAC+2 ;Get FAC Mantissa, High
E9A5: 20 B0 E9 JSR MULT1 ;Multiply (A) by ARG & Add to RESULT
E9A8: A5 9E LDA FAC+1 ;Get FAC Mantissa, Top
E9AA: 20 B5 E9 JSR MULT2 ;Multiply ARG by (A) & Add to RESULT
; ;^[Assumes Multipliand is Not Zero (A<>0)]
E9AD: 4C E6 EA JMP CPY2FAC ;Go Move RESULT into FAC & Normalize
; ----------------------------------- ;Multiply (A) by ARG & Add to RESULT:
E9B0: D0 03 MULT1 BNE MULT2 ;Branch if Multipliand is Not Zero (A<>0)
; ;^[Do 8-Bit Multiply if (A) is Not Zero]
; ;Else: Multiplying by Zero produces Zero!
; <<< ---------------------------------------------------------------------- >>>
; BUG: There should be a SEC here. Usually it is set since MULT2 leaves it that
; way, but SHFTRGHT1 leaves it clear. Using SHFTRGHT1 from the MULT1 entry
; assumes carry set. Thus, if SHFTRGHT1 is used twice in a row, the calculation
; will be off in the last 8 bits! This happens when FAC+2 & FAC+3 are both 0
; but FAC+4 is not 0. For example, try PRINT 1.998244415 or PRINT 1*10.0000009
; <<< ---------------------------------------------------------------------- >>>
E9B2: 4C DA E8 JMP SHFTRGHT1 ;Go Shift RESULT Right 1 Byte (Speedier!)
; ------------------> SHFTRGHT1 <---- ;^[Shifts Low to FAC Extra Precision Byte]
; ^^^^^^^^^------ ;<<< Because of bug in FMULT, ... >>>
;
; ----------------------------------- ;Multiply ARG by (A) & Add to RESULT:
; ;^[Assumes Multipliand is Not Zero (A<>0)]
; ;^[This S/R Does an 8-Bit Multiply]
E9B5: 4A MULT2 LSR A ;Shift Multipliand LS-Bit into Carry
E9B6: 09 80 ORA #%10000000 ;Supply a Guard MS-Bit (to LOOP 8 times)
E9B8: A8 M2ADDLOOP TAY ;Save Remaining Multipliand with Guard Bit
E9B9: 90 19 BCC MULT2SHFT ;Branch if Multipliand LS-Bit is Zero (C=0)
; ---------------------- ;Else (C=1), So Mult Bit by ARG to RESULT;
; ;(or put simply) Add ARG (once) to RESULT:
E9BB: 18 CLC ;Prepare for Add with Carry
E9BC: A5 65 LDA RESULT+3 ;Get RESULT Mantissa, Low
E9BE: 65 A9 ADC ARG+4 ;Add ARG Mantissa, Low
E9C0: 85 65 STA RESULT+3 ;Set RESULT Mantissa, Low
E9C2: A5 64 LDA RESULT+2 ;Get RESULT Mantissa, Middle
E9C4: 65 A8 ADC ARG+3 ;Add ARG Mantissa, Middle
E9C6: 85 64 STA RESULT+2 ;Set RESULT Mantissa, Middle
E9C8: A5 63 LDA RESULT+1 ;Get RESULT Mantissa, High
E9CA: 65 A7 ADC ARG+2 ;Add ARG Mantissa, High
E9CC: 85 63 STA RESULT+1 ;Set RESULT Mantissa, High
E9CE: A5 62 LDA RESULT ;Get RESULT Mantissa, Top
E9D0: 65 A6 ADC ARG+1 ;Add ARG Mantissa, Top
E9D2: 85 62 STA RESULT ;Set RESULT Mantissa, Top
; ---------------------- ;Shift Right: RESULT (Product) 1 Bit:
E9D4: 66 62 MULT2SHFT ROR RESULT ;Shift Right: RESULT Mantissa, Top
E9D6: 66 63 ROR RESULT+1 ;Shift Right: RESULT Mantissa, High
E9D8: 66 64 ROR RESULT+2 ;Shift Right: RESULT Mantissa, Middle
E9DA: 66 65 ROR RESULT+3 ;Shift Right: RESULT Mantissa, Low
E9DC: 66 AC ROR FACEXT ;Shift Right: FAC Extra Precision Byte
E9DE: 98 TYA ;Retrieve Remaining Multipliand & Guard Bit
E9DF: 4A LSR A ;Shift Multipliand LS-Bit into Carry & ...
; ;Shift Zero into MSB, to Left of Guard Bit
E9E0: D0 D6 BNE M2ADDLOOP ;LOOP if Multipliand is Not Zero (A<>0) YET
; ;^[Loops 8 times (via Guard Bit)]
; ;<<< Does Guard Bit cause Extra ADD? >>>
E9E2: 60 BAS_RTS18 RTS ;Return to Caller
; ==============================================================================
; Unpack Floating Point Number at [(A,Y)={Low,High}]
; into ARG (Secondary Floating Point Accumulator)
; ==============================================================================
; [Wouldn't a general purpose copier S/R (using pointers & loops) be better?
; --Especially for all the Applesoft S/R's that move things like this one?]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Unpack FP# at [(A,Y)={Lo,Hi}] into ARG:
E9E3: 85 5E UPAY2ARG STA INDEX ;Set as NUMBER Pointer, Low
E9E5: 84 5F STY INDEX+1 ;Set as NUMBER Pointer, High
E9E7: A0 04 LDY #4 ;Set Y-Index [=4] to Count Down Moves
E9E9: B1 5E LDA (INDEX),Y ;Get NUMBER Mantissa, Low
E9EB: 85 A9 STA ARG+4 ;Set ARG Mantissa, Low
E9ED: 88 DEY ;Reduce Y-Index [=3]
E9EE: B1 5E LDA (INDEX),Y ;Get NUMBER Mantissa, Middle
E9F0: 85 A8 STA ARG+3 ;Set ARG Mantissa, Middle
E9F2: 88 DEY ;Reduce Y-Index [=2]
E9F3: B1 5E LDA (INDEX),Y ;Get NUMBER Mantissa, High
E9F5: 85 A7 STA ARG+2 ;Set ARG Mantissa, High
E9F7: 88 DEY ;Reduce Y-Index [=1]
E9F8: B1 5E LDA (INDEX),Y ;Get NUMBER Mantissa, Top
; ;Setup Combined Sign for Multiply/Divide:
E9FA: 85 AA STA ARGSIGN ;Set ARG Unpacked Sign (msb), too
E9FC: 45 A2 EOR FACSIGN ;XOR with FAC Unpacked Sign (msb)
E9FE: 85 AB STA SGNCPR ;Set Sign Flag for Comparing as M/D Sign
; ;Complete ARG Mantissa, Top:
EA00: A5 AA LDA ARGSIGN ;Get ARG Unpacked Sign (msb) to...
EA02: 09 80 ORA #%10000000 ;Set Normalized Invisible Bit (msb)
EA04: 85 A6 STA ARG+1 ;Set ARG Mantissa, Top
EA06: 88 DEY ;Reduce Y-Index [=0]
EA07: B1 5E LDA (INDEX),Y ;Get NUMBER Exponent
EA09: 85 A5 STA ARG ;Set ARG Exponent
EA0B: A5 9D LDA FAC ;Get FAC Exponent (to Check Zero Status)
; ;^[Users: FADDT, FMULTT, FDIVT, Not FSUBT]
EA0D: 60 RTS ;Return [(A)=(FAC Exponent)] to Caller
; ==============================================================================
; Add Exponents of ARG and FAC (called by FMULT and FDIV)
; ==============================================================================
; Also check for overflow, and set result sign
; ==============================================================================
EA0E: A5 A5 ADDEXPS LDA ARG ;Get ARG Exponent
EA10: F0 1F ADDEXPS1 BEQ ZERO ;Branch if ARG=0, Result is Zero
EA12: 18 CLC ;Prepare for Add with Carry
EA13: 65 9D ADC FAC ;Add FAC Exponent
EA15: 90 04 BCC ADDEXPS2 ;Branch if In Range
EA17: 30 1D BMI JOV ;Branch if Overflow
EA19: 18 CLC ;Prepare for Add with Carry
EA1A: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
EA1B: 10 14 ADDEXPS2 BPL ZERO ;Branch if Underflow, Result is Zero
EA1D: 69 80 ADC #$80 ;Add to Re-Bias Exponent
; ;^[Correct for $80 Displacement]
EA1F: 85 9D STA FAC ;Set FAC Exponent with Result
EA21: D0 03 BNE ADDEXPS3 ;Branch if FAC<>0, Result is In Range
EA23: 4C 52 E8 JMP ZFACSGN ;GO Zero FAC Sign
; ==============================================================================
; <<< Another mistake(?) here in Billy-Boy's (Microsoft?/Applesoft!) BASIC >>>
; ------------------------------------------------------------------------------
; About code above: <<< Crazy to jump way back there! Same identical code is
; below! Instead of BNE ADDEXPS3 & JMP ZFACSGN, only need BEQ ADDEXPS4 * >>>
; ------------------------------------------------------------------------------
; EA21: D0 03 BNE ADDEXPS3 ;<* Instead of this, replace w/ following line,>
; EA21: F0 02 BEQ ADDEXPS4 ;Branch if Result is Zero <* Do this!>
; EA23: 4C 52 E8 JMP ZFACSGN ;Result is Zero <* & Remove this line!>
; ------------------------------------------------------------------------------
; <<<<<<<< * You can change it in (Apple II Plus) Emulator ROM images! >>>>>>>>
; ==============================================================================
;
EA26: A5 AB ADDEXPS3 LDA SGNCPR ;Get Sign Flag for Comparing
EA28: 85 A2 ADDEXPS4 STA FACSIGN ;Use it to Set Sign of Result in FAC
EA2A: 60 RTS ;Return to Caller <* from here, not via JMP>
; ==============================================================================
; OUT OF RANGE; Called from EXP Function
; ==============================================================================
; If (FAC) is Positive, Give OVERFLOW Error
; If (FAC) Is Negative, Set FAC=0, POP one Return, and RTS
; ==============================================================================
EA2B: A5 A2 OUTOFRNG LDA FACSIGN ;Get FAC Unpacked Sign (msb)
EA2D: 49 FF EOR #%11111111 ;Invert Bits (Negate)
EA2F: 30 05 BMI JOV ;Overflow Error if was Positive Number
EA31: 68 ZERO PLA ;Pull/Discard Return Address, Low
EA32: 68 PLA ;Pull/Discard Return Address, High
EA33: 4C 4E E8 JMP ZFACEXPSGN ;Return Zero if was Negative Number
EA36: 4C D5 E8 JOV JMP OVERFLOW ;Go Throw an "?Overflow" Error
; ==============================================================================
; Multiply FAC by Ten (10):
; ==============================================================================
; Using FAC & ARG Exponents (FACX & ARGX): Adding Powers Multiplies Values;
; Adding 1 Power Multiplies a Value by its Power Base (e.g., Binary = Base 2);
; Hense, the formula used here: [10x = (2*(5x)) = (2*((4x)+x)) = (2*((2*2x)+x))]
; ==============================================================================
;
EA39: 20 63 EB MUL10 JSR FACRND2ARG ;Copy FAC to ARG (Rounded)
EA3C: AA TAX ;Test FAC Eponent:
EA3D: F0 10 BEQ MUL10RTN ;EXIT if FACX=0
EA3F: 18 CLC ;Prepare for Add with Carry
EA40: 69 02 ADC #2 ;FACX+2 = [(2^2)*FACX] = 4*FACX
EA42: B0 F2 BCS JOV ;Throw an "?Overflow" Error if Carry is Set
EA44: A2 00 LDX #0 ;Set as Flag for Adding Same Signed Values:
EA46: 86 AB STX SGNCPR ;Set Sign Flag for Comparing
EA48: 20 CE E7 JSR FADD2 ;Makes FAC*5: [FACX=(4*FACX)+ARGX]
EA4B: E6 9D INC FAC ;Makes FAC*10: [FACX=2*(FACX*5)]
EA4D: F0 E7 BEQ JOV ;Throw an "?Overflow" Error if FACX=0
EA4F: 60 MUL10RTN RTS ;Return to Caller
; ==============================================================================
; The Number Ten (10) [or Two (2)!?] (Packed FAC Constant)
; ==============================================================================
;
EA50: 84 20 00 00+ CON_TEN HEX 8420000000 ;<-[Normalized]; The Number Ten (10)
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_TEN HEX 8420000000 |(00) |$84-$80=$04= +4 |$.20000000 |+1.00000000E+1
; (!) POS_TEN HEX 84A0000000 |(00) |$84-$80=$04= +4 |$.A0000000 |+1.00000000E+1
; (!) NEG_TEN HEX 84A0000000 |(FF) |$84-$80=$04= +4 |$.A0000000 |-1.00000000E+1
; ------------------------------------------------------------------------------
; <<< Plugging NRM_TEN into & Printing FAC ($ED2EG) results in a 2, not a 10 >>>
; Plugging 84A000000000 into & Printing FAC ($ED2EG) results in +10.
; Plugging 84A0000000FF into & Printing FAC ($ED2EG) results in -10.
; ------------------------------------------------------------------------------
; * FACSIGN msb must be set ($80-$FF) to print a minus sign before a result #.
; ==============================================================================
;
;
; ==============================================================================
; Divide ABS(FAC) by Ten (10):
; ==============================================================================
; Using FAC & ARG Exponents (FACX & ARGX): Subtracting Powers Divides Values;
; Subtracting 1 Power Divides a Value by its Power Base (e.g., Binary = Base 2);
; Hense, the formula used here: [x/10]=[x/(2*5) = x/(2*(4+1)) = x/(2*((2*2)+1))]
; ==============================================================================
;
EA55: 20 63 EB DIV10 JSR FACRND2ARG ;Copy FAC to ARG (Rounded)
; ;Setup to Set FAC=10:
EA58: A9 50 LDA #<CON_TEN ;Get Address of Constant Ten (10), Low
EA5A: A0 EA LDY #>CON_TEN ;Get Address of Constant Ten (10), High
; ----------------------------------- ;Compute FAC = ARG / [(A,Y)={Low,High}]:
EA5C: A2 00 LDX #0 ;Set as Flag for Adding Same Signed Values:
EA5E: 86 AB DIV STX SGNCPR ;Set Sign Flag for Comparing
EA60: 20 F9 EA NON_SEQUITUR JSR UPAY2FAC ;Unpack #@[(A,Y)={Low,High}] into FAC (=10)
EA63: 4C 69 EA JMP FDIVT ;Divide ARG by FAC
; ------------------------------------------------------------------------------
; NON_SEQUITUR is an address used in the Generic CHRGET/CHRGOT subroutine that
; gets copied to Zero Page. It changes on ZP, so it has no real meaning here.
; ------------------------------------------------------------------------------
;
;
; ==============================================================================
; "DIVIDE" ("/") Function
; ==============================================================================
;
; Divide (Y,A) by FAC: ;Compute FAC = (Y,A) / FAC:
EA66: 20 E3 E9 FDIV JSR UPAY2ARG ;Unpack FP# at [(A,Y)={Low,High}] into ARG
; ------------------------------------------------------------------------------
; FDIVT is Main Entry Point ;(Math Operator Table Branch Address +1):
; ------------------------------------------------------------------------------
; Divide ARG by FAC: ;Compute FAC = ARG / FAC:
EA69: F0 76 FDIVT BEQ DOZDIVERR ;Throw a "?Division by Zero" Error if FAC=0
EA6B: 20 72 EB JSR ROUND_FAC ;Else, Round FAC using MSB of FACEXT
; ----------------------------------- ;Negate FAC Exponent, so that ...
; ;Add Exponents S/R forms Difference:
EA6E: A9 00 LDA #0 ;Clear Accumulator
EA70: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
EA71: E5 9D SBC FAC ;Subtract FACX from Zero to get -FACX
EA73: 85 9D STA FAC ;Set FACX = -FACX
; ----------------------------------- ;Divide ARG by FAC [(FACX)=(ARGX)+(-FACX)]
EA75: 20 0E EA JSR ADDEXPS ;Add ARG & FAC Exponents [FACX=ARGX+FACX]
; ;^[Checks for Overflow & Sets RESULT Sign]
EA78: E6 9D INC FAC ;Advance FAC Exponent [FACX=FACX+1]
EA7A: F0 BA BEQ JOV ;Throw an "?Overflow" Error if FACX=0
EA7C: A2 FC LDX #$FC ;Get/Set as Loop Index [($FC)=(-4)]
EA7E: A9 01 LDA #1 ;Get/Set as Bit Count & Partial Quotient
; ----------------------------------- ;Get Answer: Is ARG >= FAC?
; ; (Can FAC Be Subtracted?)
; ; (Can ARG be Divided by FAC?)
EA80: A4 A6 FDIVT1 LDY ARG+1 ;Get ARG Mantissa, Top
EA82: C4 9E CPY FAC+1 ;Compare to FAC Mantissa, Top
EA84: D0 10 BNE FDIVT2 ;Branch if Not Equal .. (ARGT <> FACT)
EA86: A4 A7 LDY ARG+2 ;Get ARG Mantissa, High
EA88: C4 9F CPY FAC+2 ;Compare to FAC Mantissa, High
EA8A: D0 0A BNE FDIVT2 ;Branch if Not Equal .. (ARGH <> FACH)
EA8C: A4 A8 LDY ARG+3 ;Get ARG Mantissa, Middle
EA8E: C4 A0 CPY FAC+3 ;Compare to FAC Mantissa, Middle
EA90: D0 04 BNE FDIVT2 ;Branch if Not Equal .. (ARGM <> FACM)
EA92: A4 A9 LDY ARG+4 ;Get ARG Mantissa, Low
EA94: C4 A1 CPY FAC+4 ;Compare to FAC Mantissa, Low
; ;NO Branch Here! [for: (ARGL <> FACL)]
; ----------------------------------- ;Postpone Answer to: Is ARG >= FAC?
EA96: 08 FDIVT2 PHP ;Push Processor Status
; ;^[Carry is Set (C=1) if ARG >= FAC!] or
; ;^[Carry is Set (C=1) if ARG Overflows!]
EA97: 2A ROL A ;Shift Left: Bit Count & Partial Quotient
EA98: 90 09 BCC FDIVT3 ;Skip Following Until 8 Bits Done (C=1)
; ----------------------------------- ;Do Next Byte? Or, almost completely Done?
EA9A: E8 INX ;Advance Loop Index
EA9B: 95 65 STA RESULT+3,X ;Store a Quotient Byte
EA9D: F0 32 BEQ FDIVT6 ;Branch if Completed 5 Bytes (32 Bits)
; ;^[Do Left Shfts into FAC Extensiion Byte]
EA9F: 10 34 BPL FDIVT7 ;EXIT if (X=1): Left Justify Extension Bits
; ----------------------------------- ;Get Answer: Is ARG >= FAC?
; ; (Can FAC Be Subtracted?)
; ; (Can ARG be Divided by FAC?)
EAA1: A9 01 LDA #1 ;Reset Bit Count & Partial Quotient
EAA3: 28 FDIVT3 PLP ;Pull Processor Status
EAA4: B0 0E BCS FDIVT5 ;BGE: Branch if ARG >= FAC (C=1)
; ;^[YES, Go Subtract Divisor!]
; ----------------------------------- ;Else, Shift ARG Mantissa Left 1 Bit:
EAA6: 06 A9 FDIVT4 ASL ARG+4 ;Shift Left: ARG Mantissa, Low
EAA8: 26 A8 ROL ARG+3 ;Shift Left: ARG Mantissa, Middle
EAAA: 26 A7 ROL ARG+2 ;Shift Left: ARG Mantissa, High
EAAC: 26 A6 ROL ARG+1 ;Shift Left: ARG Mantissa, Top
; ----------------------------------- ;Next, LOOP-Back for More Processing:
EAAE: B0 E6 BCS FDIVT2 ;LOOP if (New) ARG Mantissa Overflows
EAB0: 30 CE BMI FDIVT1 ;LOOP if Further Comparison Needed
; ;^[No Answer Yet: Is ARG >= FAC?
; ; (Can FAC Be Subtracted?)
; ; (Can ARG be Divided by FAC?)
EAB2: 10 E2 BPL FDIVT2 ;LOOP if No Comparison Needed; Always Taken
; ----------------------------------- ;Subtract Divisor
; ; (Subtract FAC from ARG, Once!)
; ; [(ARG >= FAC) & (C=1)]:
EAB4: A8 FDIVT5 TAY ;Save Bit Count & Partial Quotient
; ---------------------- ;Subtract w/o Borrow [A-Data-!C]:
EAB5: A5 A9 LDA ARG+4 ;Get ARG Mantissa, Low
EAB7: E5 A1 SBC FAC+4 ;Subtract FAC Mantissa, Low
EAB9: 85 A9 STA ARG+4 ;Set ARG Mantissa, Low
; ---------------------- ;Subtract with Borrow [A-Data-!C]:
EABB: A5 A8 LDA ARG+3 ;Get ARG Mantissa, Middle
EABD: E5 A0 SBC FAC+3 ;Subtract FAC Mantissa, Middle
EABF: 85 A8 STA ARG+3 ;Set ARG Mantissa, Middle
; ---------------------- ;Subtract with Borrow [A-Data-!C]:
EAC1: A5 A7 LDA ARG+2 ;Get ARG Mantissa, High
EAC3: E5 9F SBC FAC+2 ;Subtract FAC Mantissa, High
EAC5: 85 A7 STA ARG+2 ;Set ARG Mantissa, High
; ---------------------- ;Subtract with Borrow [A-Data-!C]:
EAC7: A5 A6 LDA ARG+1 ;Get ARG Mantissa, Top
EAC9: E5 9E SBC FAC+1 ;Subtract FAC Mantissa, Top
EACB: 85 A6 STA ARG+1 ;Set ARG Mantissa, Top
; ---------------------- ;Do Next:
EACD: 98 TYA ;Retrieve Bit Count & Partial Quotient
EACE: 4C A6 EA JMP FDIVT4 ;LOOP: Shift ARG Mantissa Left 1 Bit & LOOP
; ----------------------------------- ;Completed 5 Bytes (32 Bits):
EAD1: A9 40 FDIVT6 LDA #%01000000 ;Set Extension Bit Count; (Two Left Shifts
; ;into the FAC Extensiion Byte for the Last
; ;Subtraction to Complete Division [x/4])
EAD3: D0 CE BNE FDIVT3 ;Always Taken
; ----------------------------------- ;Left Justify Extension Bits [in (Acc)];
; ;(a 6 Bit Shift) [%XX000000<-%000000XX]:
EAD5: 0A FDIVT7 ASL A ;1. Shift Left: Accumulator
EAD6: 0A ASL A ;2. Shift Left: Accumulator
EAD7: 0A ASL A ;3. Shift Left: Accumulator
EAD8: 0A ASL A ;4. Shift Left: Accumulator
EAD9: 0A ASL A ;5. Shift Left: Accumulator
EADA: 0A ASL A ;6. Shift Left: Accumulator
EADB: 85 AC STA FACEXT ;Set FAC Extra Precision Byte
EADD: 28 PLP ;Pull Processor Status
; ----------------------------------- ;Finish with Final Quotient:
EADE: 4C E6 EA JMP CPY2FAC ;Copy RESULT into FAC Mantissa, & Normalize
; ----------------------------------- ;Error Entry Point; Also User-Callable:
EAE1: A2 85 DOZDIVERR LDX #ERR_ZERODIV ;Throw a "?Division by Zero" Error:
EAE3: 4C 12 D4 JMP ERROR ;Go Print Error Message based on X-Reg
; ==============================================================================
; Copy RESULT (another Mantissa) into FAC Mantissa, & Normalize
; ==============================================================================
;
EAE6: A5 62 CPY2FAC LDA RESULT ;Get RESULT Mantissa, Top
EAE8: 85 9E STA FAC+1 ;Set FAC Mantissa, Top
EAEA: A5 63 LDA RESULT+1 ;Get RESULT Mantissa, High
EAEC: 85 9F STA FAC+2 ;Set FAC Mantissa, High
EAEE: A5 64 LDA RESULT+2 ;Get RESULT Mantissa, Middle
EAF0: 85 A0 STA FAC+3 ;Set FAC Mantissa, Middle
EAF2: A5 65 LDA RESULT+3 ;Get RESULT Mantissa, Low
EAF4: 85 A1 STA FAC+4 ;Set FAC Mantissa, Low
EAF6: 4C 2E E8 JMP NRMLZFAC2 ;Go Normalize Value in FAC
; ==============================================================================
; Unpack Floating Point Number at [(A,Y)={Low,High}]
; into FAC (Primary Floating Point Accumulator)
; ==============================================================================
; [Wouldn't a general purpose copier S/R (using pointers & loops) be better?
; --Especially for all the Applesoft S/R's that move things like this one?]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Unpack FP# at [(A,Y)={Lo,Hi}] into FAC:
EAF9: 85 5E UPAY2FAC STA INDEX ;Set as NUMBER Pointer, Low
EAFB: 84 5F STY INDEX+1 ;Set as NUMBER Pointer, High
EAFD: A0 04 LDY #4 ;Set Y-Index [=4] to Count Down Moves
EAFF: B1 5E LDA (INDEX),Y ;Get NUMBER Mantissa, Low
EB01: 85 A1 STA FAC+4 ;Set FAC Mantissa, Low
EB03: 88 DEY ;Reduce Y-Index [=3]
EB04: B1 5E LDA (INDEX),Y ;Get NUMBER Mantissa, Middle
EB06: 85 A0 STA FAC+3 ;Set FAC Mantissa, Middle
EB08: 88 DEY ;Reduce Y-Index [=2]
EB09: B1 5E LDA (INDEX),Y ;Get NUMBER Mantissa, High
EB0B: 85 9F STA FAC+2 ;Set FAC Mantissa, High
EB0D: 88 DEY ;Reduce Y-Index [=1]
EB0E: B1 5E LDA (INDEX),Y ;Get NUMBER Mantissa, Top
; ;Unpack Floating Point Number:
EB10: 85 A2 STA FACSIGN ;Set FAC Unpacked Sign (msb)
; ;Complete FAC Mantissa, Top:
EB12: 09 80 ORA #%10000000 ;Set Normalized Invisible Bit (msb)
EB14: 85 9E STA FAC+1 ;Set FAC Mantissa, Top
EB16: 88 DEY ;Reduce Y-Index [=0]
EB17: B1 5E LDA (INDEX),Y ;Get NUMBER Exponent
EB19: 85 9D STA FAC ;Set FAC Exponent
EB1B: 84 AC STY FACEXT ;Clear FAC Extra Precision Byte
EB1D: 60 RTS ;Return [(A)=(FAC Exponent)] to Caller
; ==============================================================================
; Pack FAC into TEMP2 [FAC/ARG Save Area ($98~$9B)]: Store FAC Rounded in TEMP2
; ==============================================================================
;
; ----------------------------------- ;Get Destination Address:
EB1E: A2 98 FACRND2TMP2 LDX #TEMP2 ;Get Zero-Page Address of TEMP2, Low
EB20: 2C DFB BIT_ABS ;Fake BIT OpCode to skip next line
; ==============================================================================
; Pack FAC into TEMP1 [FAC/ARG Save Area ($93~$97)]: Store FAC Rounded in TEMP1
; ==============================================================================
;
; ----------------------------------- ;Get Destination Address:
EB21: A2 93 FACRND2TMP1 LDX #TEMP1 ;Get Zero-Page Address of TEMP1, Low
EB23: A0 00 LDY #>TEMP1 ;Get Zero-Page Address of TEMP1, High
; ;^[(TEMP1, Hi)=(TEMP2, Hi)=(Zero-Page)]
EB25: F0 04 BEQ FACRND2XY ;Always Taken
; ==============================================================================
; Pack FAC into (FORPNT): Store FAC Rounded at (FORPNT)
; ==============================================================================
;
; ----------------------------------- ;Called by LET & NEXT:
EB27: A6 85 SETFOR LDX FORPTR ;Get Destination Address, Low
EB29: A4 86 LDY FORPTR+1 ;Get Destination Address, High
;
; ==============================================================================
; Pack FAC into [(X,Y)={Low,High}]: Store FAC Rounded at [(X,Y)={Low,High}]
; ==============================================================================
;
EB2B: 20 72 EB FACRND2XY JSR ROUND_FAC ;Round FAC using MS-Bit of FACEXT
EB2E: 86 5E STX INDEX ;Set as Destination Pointer, Low
EB30: 84 5F STY INDEX+1 ;Set as Destination Pointer, High
EB32: A0 04 LDY #$04 ;Set Y-Index [=4] to Count Down Moves
EB34: A5 A1 LDA FAC+4 ;Get FAC Mantissa, Low
EB36: 91 5E STA (INDEX),Y ;Set Destination Mantissa, Low
EB38: 88 DEY ;Reduce Y-Index [=3]
EB39: A5 A0 LDA FAC+3 ;Get FAC Mantissa, Middle
EB3B: 91 5E STA (INDEX),Y ;Set Destination Mantissa, Middle
EB3D: 88 DEY ;Reduce Y-Index [=2]
EB3E: A5 9F LDA FAC+2 ;Get FAC Mantissa, High
EB40: 91 5E STA (INDEX),Y ;Set Destination Mantissa, High
EB42: 88 DEY ;Reduce Y-Index [=1]
; ---------------------- ;Pack Sign into Destination Mantissa, Top:
EB43: A5 A2 LDA FACSIGN ;Get FAC Unpacked Sign (msb)
EB45: 09 7F ORA #%01111111 ;Set (AND Mask msb)=(FACSGN msb)
; ;Pack Sign into FAC Value:
EB47: 25 9E AND FAC+1 ;Set in (A): Sign Bit of FAC Mantissa, Top
EB49: 91 5E STA (INDEX),Y ;Set Destination Mantissa, Signed Top
; ---------------------- ;Do Exponent:
EB4B: 88 DEY ;Reduce Y-Index [=0]
EB4C: A5 9D LDA FAC ;Get FAC Exponent
EB4E: 91 5E STA (INDEX),Y ;Set Destination Exponent
EB50: 84 AC STY FACEXT ;Clear FAC Extra Precision Byte
EB52: 60 RTS ;Return [(A)=(FAC Exponent)] to Caller
; ==============================================================================
; Copy ARG into FAC
; ==============================================================================
;
EB53: A5 AA CPYARG2FAC LDA ARGSIGN ;Get ARG Unpacked Sign (msb)
; Entry from "EXPONENT" (POWER) Function [to do Absolute Value (ABS) 1st]:
EB55: 85 A2 CPYARGFAC STA FACSIGN ;Set FAC Unpacked Sign (msb)
EB57: A2 05 LDX #5 ;Set X-Index [=5] to Count Down Moves
EB59: B5 A4 CA2FLOOP LDA ARG-1,X ;Get ARG Value
EB5B: 95 9C STA FAC-1,X ;Set FAC Value
EB5D: CA DEX ;Count Down Move
EB5E: D0 F9 BNE CA2FLOOP ;LOOP Until Done (X=0)
EB60: 86 AC STX FACEXT ;Clear FAC Extra Precision Byte
EB62: 60 RTS ;Return to Caller
; ==============================================================================
; Copy FAC into ARG (Rounded)
; ==============================================================================
;
EB63: 20 72 EB FACRND2ARG JSR ROUND_FAC ;Round FAC using MS-Bit of FACEXT
; Entry from "EXP" (Exponent) Function [to Not Round FAC 1st]:
EB66: A2 06 FAC2ARG LDX #6 ;Set X-Index [=6] to Count Down Moves
EB68: B5 9C F2ALOOP LDA FAC-1,X ;Get FAC Value
EB6A: 95 A4 STA ARG-1,X ;set ARG Value
EB6C: CA DEX ;Count Down Move
EB6D: D0 F9 BNE F2ALOOP ;LOOP Until Done (X=0)
EB6F: 86 AC STX FACEXT ;Clear FAC Extra Precision Byte
EB71: 60 BAS_RTS19 RTS ;Return to Caller
; ==============================================================================
; Round FAC using Most Significant Bit of FAC Extension Byte
; ==============================================================================
;
; ----------------------------------- ;Round FAC using MS-Bit of FACEXT:
EB72: A5 9D ROUND_FAC LDA FAC ;Get FAC Exponent
EB74: F0 FB BEQ BAS_RTS19 ;Branch if FACX=0 (Which means FAC=0 too!)
EB76: 06 AC ASL FACEXT ;Else, Shift Left: FAC Extra Precision Byte
EB78: 90 F7 BCC BAS_RTS19 ;Return to Caller if No Carryover into FAC
EB7A: 20 C6 E8 INCMAN JSR INCFACMAN ;Else, Advance FAC Mantissa (Add Carryover)
EB7D: D0 F2 BNE BAS_RTS19 ;Return to Caller if No Carryover
EB7F: 4C 8F E8 JMP FROUND ;Else, Advance FAC Exponent (Add Carryover)
; ==============================================================================
; FAC Sign (Neg|0|Pos) Returns (A)=(-1|0|1)
; ==============================================================================
;
EB82: A5 9D SIGN LDA FAC ;Get FAC Exponent
EB84: F0 09 BEQ BAS_RTS20 ;Return (A = 0) to Caller if (FAC = 0)
EB86: A5 A2 SIGN1 LDA FACSIGN ;Get FAC Unpacked Sign (msb)
EB88: 2A SIGN2 ROL A ;Shift Sign (msb) Left into Carry
EB89: A9 FF LDA #$FF ;Get a Negative One (-1) for (FAC < 0)
EB8B: B0 02 BCS BAS_RTS20 ;Return (A = -1) to Caller if (FAC < 0)
EB8D: A9 01 LDA #1 ;Get a Positive One (+1) for (FAC > 0)
EB8F: 60 BAS_RTS20 RTS ;Return (A = +1) to Caller (FAC > 0)
; ==============================================================================
; "SGN" (Sign) Function: Immediate & Deferred; Parameter SGN (Aexpr); Returns
; Sign of a Number (Aexpr); Sign of [(Neg|0|Pos) Aexpr], Returns (A)=(-1|0|1)
; ==============================================================================
;
EB90: 20 82 EB SGN JSR SIGN ;FAC Sign (Neg|0|Pos) Returns (A)=(-1|0|1)
; ------------------------------------------------------------------------------
; Float Signed Integer in (A) into FAC:
; ------------------------------------------------------------------------------
EB93: 85 9E FLOAT STA FAC+1 ;Set FAC Mantissa, Top
EB95: A9 00 LDA #0 ;Clear Accumulator
EB97: 85 9F STA FAC+2 ;Clear FAC Mantissa, High
EB99: A2 88 LDX #$88 ;Use Exponent 2^9 (to Move DP 8 Bits Right)
; ------------------------------------------------------------------------------
; Float Unsigned Value in FAC+1,2: ;Enter with: X-Reg = Exponent
; ------------------------------------------------------------------------------
; ;Get (-FAC) Sign Bit into Carry Flag:
EB9B: A5 9E FLOAT1 LDA FAC+1 ;Get FAC Mantissa, High
EB9D: 49 FF EOR #%11111111 ;Invert Bits (Negate)
EB9F: 2A ROL A ;Set Carry if FAC is a Positive Number
; ------------------------------------------------------------------------------
; Float Unsigned Value in FAC+1,2: ;Enter with: X-Reg = Exponent,
; ;C=0 to Make Value Negative, or
; ;C=1 to Make Value Positive
; ------------------------------------------------------------------------------
EBA0: A9 00 FLOAT2 LDA #0 ;Clear Accumulator
EBA2: 85 A1 STA FAC+4 ;Clear FAC Mantissa, Low
EBA4: 85 A0 STA FAC+3 ;Clear FAC Mantissa, Middle
EBA6: 86 9D STX FAC ;Set FAC Exponent (to Move DP 8 Bits Right)
EBA8: 85 AC STA FACEXT ;Clear FAC Extra Precision Byte
EBAA: 85 A2 STA FACSIGN ;Clear FAC Unpacked Sign (msb)
EBAC: 4C 29 E8 JMP NRMLZFAC1 ;Go Normalize Value in FAC
; ==============================================================================
; "ABS" (Absolute Value) Function: Immediate & Deferred; Parameter ABS (Aexpr);
; Returns the Absolute Value of a Number (Aexpr):
; Absolute Value of [(Neg|Pos) Aexpr], Returns (A)=[(Pos) Aexpr]
; ==============================================================================
;
EBAF: 46 A2 ABS LSR FACSIGN ;Make FAC [Unpacked Sign (msb)] Positive
EBB1: 60 RTS ;Return to Caller
; ==============================================================================
; Compare FAC with Packed Number at [(A,Y)={Low,High}];
; Return (A)=(-1|0|1) as [(A,Y)={Low,High}] is (>|=|<) FAC, respectively
; ==============================================================================
;
EBB2: 85 60 FCOMP STA DSTPTR ;Set as NUMBER Pointer, Low
EBB4: 84 61 FCOMP2 STY DSTPTR+1 ;Set as NUMBER Pointer, High
; ------------------------------------------------------------------------------
; ^^^^ Special Entry from NEXT [with NUMBER Pointer, Low (DSTPTR), already Set
; to FOR Value STACK Address (in A-Reg) & STACK Page Address (1 in Y-Reg)]:
; ------------------------------------------------------------------------------
;
; ==============================================================================
; Compare NUMBER to FAC:
; ==============================================================================
;
EBB6: A0 00 LDY #0 ;Clear Indirect Addressing Index (=0)
EBB8: B1 60 LDA (DSTPTR),Y ;Get NUMBER Exponent
EBBA: C8 INY ;Advance Indirect Addressing Index (=1)
EBBB: AA TAX ;Save NUMBER Exponent (to Compare with FAC)
EBBC: F0 C4 BEQ SIGN ;Branch if NUMBER Exponent is Zero
; ;^[This means the whole NUMBER = 0, too!]
; ;^(SIGN S/R is Sufficient for Comparison)
; ---------------------- ;Unpack & Compare Mantissas:
EBBE: B1 60 LDA (DSTPTR),Y ;Get NUMBER Mantissa, Top
EBC0: 45 A2 EOR FACSIGN ;XOR with FAC Unpacked Sign (msb)
EBC2: 30 C2 BMI SIGN1 ;Branch if Signs Not Equal
EBC4: E4 9D CPX FAC ;Compare NUMBER to FAC, Exponents
EBC6: D0 21 BNE FCFINISH ;Branch if Exponents Not Equal
EBC8: B1 60 LDA (DSTPTR),Y ;Get NUMBER Mantissa, Top
EBCA: 09 80 ORA #%10000000 ;Make NUMBER Negative
EBCC: C5 9E CMP FAC+1 ;Compare NUMBER to FAC, Mantissa Tops
EBCE: D0 19 BNE FCFINISH ;Branch if Mantissa Tops Not Equal
EBD0: C8 INY ;Advance Indirect Addressing Index (=2)
EBD1: B1 60 LDA (DSTPTR),Y ;Get NUMBER Mantissa, High
EBD3: C5 9F CMP FAC+2 ;Compare NUMBER to FAC, Mantissa Highs
EBD5: D0 12 BNE FCFINISH ;Branch if Mantissa Highs Not Equal
EBD7: C8 INY ;Advance Indirect Addressing Index (=3)
EBD8: B1 60 LDA (DSTPTR),Y ;Get NUMBER Mantissa, Middle
EBDA: C5 A0 CMP FAC+3 ;Compare NUMBER to FAC, Mantissa Middles
EBDC: D0 0B BNE FCFINISH ;Branch if Mantissa Middles Not Equal
EBDE: C8 INY ;Advance Indirect Addressing Index (=4)
; ---------------------- ;Determine Carry for last Compare:
EBDF: A9 7F LDA #%01111111 ;FAKE Extra Precision Byte (for NUMBER)
EBE1: C5 AC CMP FACEXT ;Compare FAKE to FAC, Extra Precision Bytes
; ---------------------- ;Subtract with|without Borrow [A-Data-!C]:
EBE3: B1 60 LDA (DSTPTR),Y ;Get NUMBER Mantissa, Low
EBE5: E5 A1 SBC FAC+4 ;Compare NUMBER to FAC, Mantissa Lows
EBE7: F0 28 BEQ BAS_RTS21 ;Branch if Mantissa Lows are Equal
; ;^[EXIT]: Both Numbers are Equal!
; ; (NUMBER=FAC), Return: (A=0)
; ---------------------- ;^[Else]: The Numbers are Not Equal:
EBE9: A5 A2 FCFINISH LDA FACSIGN ;Get FAC Unpacked Sign (msb)
EBEB: 90 02 BCC FCDONE ;BLT: ABS(FAC) is Larger: Skip Negation
EBED: 49 FF EOR #%11111111 ;Else, ABS(FAC) is Smaller: Invert Bits
; <<< ====================================================================== >>>
; <<< Above three lines can be shortened: >>>
; <<< ---------------------------------------------------------------------- >>>
; <<< FCFINISH ROR ;Put Carry into Sign Bit >>>
; <<< EOR FAC_SIGN ;Toggle with Sign of FAC >>>
; <<< ====================================================================== >>>
EBEF: 4C 88 EB FCDONE JMP SIGN2 ;Go Convert (A) to (+1) or (-1)
; ==============================================================================
; Quick Greatest Integer Function: Convert Real in FAC to just its Integer Part!
; ==============================================================================
; Converts FP Value in FAC to an Integer Value in FAC Mantissa (FAC+1,2,3,4), by
; Shifting Right with FAC Sign Extension until all Fractional Bits are outed.
; ------------------------------------------------------------------------------
; Assumes FAC < (2^31 = $8000,0000): FAC Binary Mantissa's Most Significant Bit
; (msb) is Sign Bit, leaving 31 Value Bits, hense FAC's Upper Limit is (2^31).
; ------------------------------------------------------------------------------
; The Initial Exponent (of 2^31) for 32 Bits is [($20)+($80)]=($A0), so the FAC
; Exponent (FACX) must be less than ($A0). Hense, if (FACX>=$A0) there are NO
; Fractional Bits to Shift Right, but if (FACX<$A0) there are, & (FACX-$A0)
; determines how many there are [as a Single Byte Negative Number; e.g., if
; (FACX=$99), (FACX-$A0)=($F9)=(-7), there are Seven Bits to Shift Right].
; ==============================================================================
; To see: "How Applesoft BASIC Floating Point Math, Constants, & FAC Behave",
; see: "Call-A.P.P.L.E. In Depth #1: All About Applesoft", pages 52 to 54
; ==============================================================================
;
EBF2: A5 9D QINT LDA FAC ;Get FAC Exponent
EBF4: F0 4A BEQ QINT3 ;EXIT if FAC Exponent is Zero
; ;^[This means the whole number = 0, too!]
; ----------------------------------- ;Get (-# Fractional Bits) for Shift Count:
EBF6: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
EBF7: E9 A0 SBC #$A0 ;Subtract #$A0 from FACX for Shift Count
EBF9: 24 A2 BIT FACSIGN ;Check FAC Unpacked Sign (msb)
EBFB: 10 09 BPL QINT1 ;Branch if Positive
; ;Else, Negative, So Complement Mantissa
; ; & Set Sign Extension for Shift:
EBFD: AA TAX ;Save (-# Fractional Bits) Shift Count
EBFE: A9 FF LDA #%11111111 ;Set All Bits in Byte (A) [for Shifting]
EC00: 85 A4 STA SHFTSGNX ;Set FAC Right Shift Sign Extension
EC02: 20 A4 E8 JSR TCFACMANT ;Two's Complement FAC Mantissa (only)
EC05: 8A TXA ;Retrieve (-# Fractional Bits) Shift Count
EC06: A2 9D QINT1 LDX #FAC ;Point at FAC for Shift Right Subroutine
EC08: C9 F9 CMP #$F9 ;More than 7 Bits to Shift?
; ; (-# Fractional Bits)>[($F9)=(-7)]
EC0A: 10 06 BPL QINT2 ;NO: Do Short (<8b) Shift Right Subroutine
EC0C: 20 F0 E8 JSR SHFTRGHT ;YES: Do Long (>7b) Shift Right Subroutine
EC0F: 84 A4 STY SHFTSGNX ;Y=0: Clear FAC Right Shift Sign Extension
EC11: 60 BAS_RTS21 RTS ;Return to Caller
; ------------------------------------------------------------------------------
; QINT2: Short (< 8-Bits) Shift Right Subroutine
; ------------------------------------------------------------------------------
EC12: A8 QINT2 TAY ;Save (-# Fractional Bits) Shift Count
EC13: A5 A2 LDA FACSIGN ;Get FAC Unpacked Sign (msb)
EC15: 29 80 AND #%10000000 ;Get Sign Bit (msb) Only [in (A)]
; ;Start Right Shift & Merge with Sign:
EC17: 46 9E LSR FAC+1 ;Shift Right: FAC Mantissa, Top
EC19: 05 9E ORA FAC+1 ;Merge with Sign: FAC Mantissa, Top
EC1B: 85 9E STA FAC+1 ;Set FAC Mantissa, Top
EC1D: 20 07 E9 JSR SHFTRGHT4 ;Finsh Shifting FAC (Mantissa-H/M/L, etc.)
EC20: 84 A4 STY SHFTSGNX ;Y=0: Clear FAC Right Shift Sign Extension
EC22: 60 RTS ;Return to Caller
; ==============================================================================
; "INT" Function: Immediate & Deferred; Parameter: INT (Aexpr);
; Returns largest Integer <= Number (Aexpr) specified
; ==============================================================================
; Uses QINT to Convert FAC to Integer form, & then Floats the Integer again.
; <<< Faster: Why not simply Clear the Fractional Bits by Zeroing them? >>>
; ==============================================================================
;
EC23: A5 9D INT LDA FAC ;Get FAC Exponent
EC25: C9 A0 CMP #$A0 ;Is (FACX<$A0) [32 Bit Mantissa Exponent]?
EC27: B0 20 BCS BAS_RTS22 ;BGE: EXIT if NOT (FACX<$A0)
; ;^[NO Fractional Bits if (FACX>=$A0)]
EC29: 20 F2 EB JSR QINT ;Else, Convert FAC to (4 Byte) Integer
EC2C: 84 AC STY FACEXT ;Y=0: Clear FAC Extra Precision Byte
EC2E: A5 A2 LDA FACSIGN ;Get [into (A)] FAC Unpacked Sign (msb)
EC30: 84 A2 STY FACSIGN ;Y=0: Clear FAC Unpacked Sign (msb)
EC32: 49 80 EOR #%10000000 ;Invert [in (A)] Sign Bit (msb) ONLY!
EC34: 2A ROL A ;Shift Sign Bit (msb) Left into Carry Flag
EC35: A9 A0 LDA #$A0 ;Get Initial 32 Bit Mantissa Exponent
EC37: 85 9D STA FAC ;Set FAC Exponent [for NO Fractional Bits]
EC39: A5 A1 LDA FAC+4 ;Get FAC Mantissa [Integer Form], Low
EC3B: 85 0D STA CHARAC ;Save for EXP & POWER (FPWRT) Functions
; ;Finish Conversion:
EC3D: 4C 29 E8 JMP NRMLZFAC1 ;Go Normalize Value in FAC
; ==============================================================================
; Clear FAC Mantissa [& (Y)] to Prepare it for the Integer Form:
; [(A=0); FAC Exponent is Zero, so the whole number is too!]
; ==============================================================================
;
EC40: 85 9E QINT3 STA FAC+1 ;Clear FAC Mantissa, Top
EC42: 85 9F STA FAC+2 ;Clear FAC Mantissa, High
EC44: 85 A0 STA FAC+3 ;Clear FAC Mantissa, Middle
EC46: 85 A1 STA FAC+4 ;Clear FAC Mantissa, Low
EC48: A8 TAY ;Clear Y-Index Register
EC49: 60 BAS_RTS22 RTS ;Return to Caller
; ==============================================================================
; Evaluate Floating Point Number at TXTPTR: Convert String to FP Value in FAC
; ==============================================================================
; String is Pointed to by TXTPTR with its First Char Already Scanned by CHRGET;
; A-Reg = First Char & C=0 if Char [in (A)] is a Numeral
; ==============================================================================
;
EC4A: A0 00 FIN LDY #0 ;Clear Y-Index Register
EC4C: A2 0A LDX #10 ;Get Range to Clear Working Area ($99..A3):
EC4E: 94 99 FINLOOP STY TMPEXP,X ;TMPEXP, EXPON, DPFLG, EXPSGN, FAC, SERLEN
EC50: CA DEX ;Reduce Range (X-Index Register)
EC51: 10 FB BPL FINLOOP ;LOOP Until All Clear
EC53: 90 0F BCC FIN2NMRL ;Branch if Char is a Numeral (C=0)
EC55: C9 2D CMP #'-' ;Is First Char [in (A)] a Minus Sign?
EC57: D0 04 BNE FINPLUS? ;NO (Leading Sign), Number is NOT Negative
; ;YES (Leading Sign), Number is Negative:
EC59: 86 A3 STX SERLEN ;X=$FF: SERLEN Holds Length of Series-1
EC5B: F0 04 BEQ FIN1EVAL ;Always Taken
EC5D: C9 2B FINPLUS? CMP #'+' ;Is First Char [in (A)] a Plus Sign?
EC5F: D0 05 BNE FIN3PDP? ;NO (Leading Sign), but Number is Positive!
; ;YES (Leading Sign), Number is Positive:
EC61: 20 B1 00 FIN1EVAL JSR CHRGET ;Get Next Char/Token of String
EC64: 90 5B FIN2NMRL BCC FIN9NMRL ;Branch if Char is a Numeral (C=0)
EC66: C9 2E FIN3PDP? CMP #'.' ;Is Char [in (A)] a Decimal Point?
EC68: F0 2E BEQ FINADJX ;YES (Leading DP), Number is a Fraction:
EC6A: C9 45 CMP #'E' ;NO, Is Char [in (A)] an Exponent Token?
EC6C: D0 30 BNE FIN7POSX ;NO, So End of Number; EXIT
EC6E: 20 B1 00 JSR CHRGET ;YES, Get Next Char/Token of String
EC71: 90 17 BCC FIN5NMRL ;Branch if Char is a Numeral (C=0)
EC73: C9 C9 CMP #TOK_MINUS ;Is Char [in (A)] a Minus Token?
EC75: F0 0E BEQ FIN3NEGX ;YES (Minus Token), Exponent is Negative
EC77: C9 2D CMP #'-' ;NO, Is Char [in (A)] a Minus Sign?
EC79: F0 0A BEQ FIN3NEGX ;YES (Minus Sign), Exponent is Negative
EC7B: C9 C8 CMP #TOK_PLUS ;NO, Is Char [in (A)] a Plus Token?
EC7D: F0 08 BEQ FIN4POSX ;YES (Plus Token), Exponent is Positive
EC7F: C9 2B CMP #'+' ;NO, Is Char [in (A)] a Plus Sign?
EC81: F0 04 BEQ FIN4POSX ;YES (Plus Sign), Exponent is Positive
EC83: D0 07 BNE FIN6SGNX ;NO, So End of Exponent; EXIT; Always Taken
EC85: 66 9C FIN3NEGX ROR EXPSGN ;C=1: Flag Negative Exponent
; ;Else, Exponent is Positive:
EC87: 20 B1 00 FIN4POSX JSR CHRGET ;Get Next Char/Token of Exponent
EC8A: 90 5C FIN5NMRL BCC GETEXP ;Branch if Char is a Numeral (C=0)
EC8C: 24 9C FIN6SGNX BIT EXPSGN ;Else, End of Number, Test Sign of Exponent
EC8E: 10 0E BPL FIN7POSX ;Branch if Exponent is Positive
; ;Else, Exponent is Negative; Negate it:
EC90: A9 00 LDA #0 ;Clear Accumulator
EC92: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
EC93: E5 9A SBC EXPON ;Subtract Saved Exponent
EC95: 4C A0 EC JMP FIN8ADJX ;Go Complete Exponent Adjustment
; Found Decimal Point, so Number is a Fraction; Adjust Exponent & EXIT:
;
EC98: 66 9B FINADJX ROR DPFLG ;C=1, Set Decimal Point Flag
EC9A: 24 9B BIT DPFLG ;Test Flag for prior Decimal Point
EC9C: 50 C3 BVC FIN1EVAL ;LOOP if NO prior Decimal Point
; <<< ====================================================================== >>>
; <<< There should be a jump to to error here! Multiple decimal points give >>>
; <<< strange results in PRINT statements. Variable assignments correctly >>>
; <<< give syntax errors; e.g., "A=11..22" will give a syntax error, because >>>
; <<< it is two numbers with no operator in between. But, in a numeric >>>
; <<< string, a second decimal point is taken as a terminator; e.g., >>>
; <<< "PRINT 11..22" gives no error, because it is just the concatenation of >>>
; <<< two numbers. >>>
; <<< ====================================================================== >>>
EC9E: A5 9A FIN7POSX LDA EXPON ;Get Saved Exponent
; ;Get Count of Numerals after Decimal Pt:
ECA0: 38 FIN8ADJX SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
ECA1: E5 99 SBC TMPEXP ;Subtract Current Exponent Shift Count
ECA3: 85 9A STA EXPON ;Complete/Save Current Adjusted Exponent
ECA5: F0 12 BEQ FIN8EVDN? ;Branch if Exponent=0: No Adjust Needed
ECA7: 10 09 BPL FIN8DPR ;Branch if Exponent>0: Multiply by Ten
ECA9: 20 55 EA FIN8DPL JSR DIV10 ;Else, Exponent<0, Divide by Ten
ECAC: E6 9A INC EXPON ;Advance Exponent
ECAE: D0 F9 BNE FIN8DPL ;Branch Until Exponent=0
ECB0: F0 07 BEQ FIN8EVDN? ;Done; Always Taken
ECB2: 20 39 EA FIN8DPR JSR MUL10 ;Exponent>0: Multiply by Ten
ECB5: C6 9A DEC EXPON ;Reduce Exponent
ECB7: D0 F9 BNE FIN8DPR ;Branch Until Exponent=0
ECB9: A5 A3 FIN8EVDN? LDA SERLEN ;Is Whole Number Negative/Positive?
ECBB: 30 01 BMI FIN8EVD ;Negative Number: Negate FAC
ECBD: 60 RTS ;Positive Number: All Done! Return to Caller
ECBE: 4C D0 EE FIN8EVD JMP NEGOP ;Negative Number: Go Negate FAC
; ;Accumulate a Numeral into FAC:
ECC1: 48 FIN9NMRL PHA ;Push Numeral
ECC2: 24 9B BIT DPFLG ;Was there a Decimal Point?
ECC4: 10 02 BPL FIN9X10 ;Branch if NOT
ECC6: E6 99 INC TMPEXP ;Else, Advance Exponent Shift Count
ECC8: 20 39 EA FIN9X10 JSR MUL10 ;Multiply by Ten (FAC=10*FAC)
ECCB: 68 PLA ;Pull Numeral; Compensate for ASCII:
ECCC: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
; <<< Shorter here to just "AND #$0F" to Convert ASCII to Binary Form: >>>
ECCD: E9 30 SBC #'0' ;Subtract Low ASCII Zero; Mask
ECCF: 20 D5 EC JSR ADDACC ;Accumulate (Add) Numeral
ECD2: 4C 61 EC JMP FIN1EVAL ;LOOP: Evaluate Next Char/Token of String
; ==============================================================================
; Accumulate Numeral into FAC Mantissa: Add FAC to (A) & Put back in FAC
; ==============================================================================
;
ECD5: 48 ADDACC PHA ;Push Addend
ECD6: 20 63 EB JSR FACRND2ARG ;Copy FAC to ARG (Rounded)
ECD9: 68 PLA ;Pull Addend
ECDA: 20 93 EB JSR FLOAT ;Float Signed Integer in (A) into FAC
ECDD: A5 AA LDA ARGSIGN ;Get ARG Unpacked Sign (msb)
ECDF: 45 A2 EOR FACSIGN ;XOR FAC Unpacked Sign (msb)
ECE1: 85 AB STA SGNCPR ;Set Sign Flag for Comparing
ECE3: A6 9D LDX FAC ;Get Fax Exponent to Signal if FAC <>|= 0
ECE5: 4C C1 E7 JMP FADDT ;Go Add FAC to ARG & Put back in FAC
; ==============================================================================
; Accumulate Numeral into FAC Exponent: Add FACX to (A) & Put back in FACX
; ==============================================================================
;
ECE8: A5 9A GETEXP LDA EXPON ;Get Saved Exponent
ECEA: C9 0A CMP #10 ;Is its Current Value > 2 Digits
ECEC: 90 09 BCC GETEXP1 ;NO, This is 1st or 2nd Digit
ECEE: A9 64 LDA #100 ;Exponent Too Big
ECF0: 24 9C BIT EXPSGN ;Unless it is Negative
ECF2: 30 11 BMI GETEXP2 ;Large Negative Exponent makes FAC=0
ECF4: 4C D5 E8 JMP OVERFLOW ;Large Positive Exponent is Error
; ;Exponent Times 10:
ECF7: 0A GETEXP1 ASL A ;Exponent Times 2 . . . . . . . . . [2X]
ECF8: 0A ASL A ;Exponent Times 2 . . . . . . . . . [4X]
ECF9: 18 CLC ;Prepare for Add with Carry
ECFA: 65 9A ADC EXPON ;Add Exponent . . . . . . . . . . . [5X]
ECFC: 0A ASL A ;Exponent Times 2 . . . . . . . . . [10X]
ECFD: 18 CLC ;Prepare for Add with Carry
ECFE: A0 00 LDY #0 ;Clear Indirect Addressing Index
ED00: 71 B8 ADC (TXTPTR),Y ;Add the New Digit; Compensate for ASCII:
ED02: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
; <<< Shorter here to just "AND #$0F" to Convert ASCII to Binary Form: >>>
ED03: E9 30 SBC #'0' ;Subtract Low ASCII Zero; Mask
; ;REF:(Large Negative Exponent makes FAC=0)
ED05: 85 9A GETEXP2 STA EXPON ;Set Saved Exponent
ED07: 4C 87 EC JMP FIN4POSX ;Go Get Next Char/Token of Exponent
; ==============================================================================
; Really BIG Numbers (Packed FAC Constants)
; ==============================================================================
;
ED0A: 9B 3E BC 1F+ CON_1E8M1 HEX 9B3EBC1FFD ;[Normalized]; ((10^8)-.1)=(99,999,999.9)
; 1E8M1 ;<-[M1 means -.1, 9 nines: 99,999,999.9]
ED0F: 9E 6E 6B 27+ CON_1E9M1 HEX 9E6E6B27FD ;[Normalized]; ((10^9)-1) = (999,999,999)
; 1E9M1 ;<-[M1 means -1, nine nines: 999,999,999]
ED14: 9E 6E 6B 28+ CON_1E9 HEX 9E6E6B2800 ;[Normalized]; (10^9) =(1,000,000,000)
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_E8M1 HEX 9B3EBC1FFD |(00) |$9B-$80=$18=+24 |$.3EBC1FFD |+3.28911359E+7
; (!) POS_E8M1 HEX 9BBEBC1FFD |(00) |$9B-$80=$18=+24 |$.BEBC1FFD |+9.99999999E+7
; (!) NEG_E8M1 HEX 9BBEBC1FFD |(FF) |$9B-$80=$18=+24 |$.BEBC1FFD |-9.99999999E+7
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_E9M1 HEX 9E6E6B27FD |(00) |$9E-$80=$1E=+30 |$.6E6B27FD |+4.63129087E+8
; (!) POS_E9M1 HEX 9EEE6B27FD |(00) |$9E-$80=$1E=+30 |$.EE6B27FD |+9.99999999E+8
; (!) NEG_E9M1 HEX 9EEE6B27FD |(FF) |$9E-$80=$1E=+30 |$.EE6B27FD |-9.99999999E+8
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_E9 HEX 9E6E6B2800 |(00) |$9E-$80=$1E=+30 |$.6E6B2800 |+4.63129088E+8
; (!) POS_E9 HEX 9EEE6B2800 |(00) |$9E-$80=$1E=+30 |$.EE6B2800 |+1.00000000E+9
; (!) NEG_E9 HEX 9EEE6B2800 |(FF) |$9E-$80=$1E=+30 |$.EE6B2800 |-1.00000000E+9
; ------------------------------------------------------------------------------
; * FACSIGN msb must be set ($80-$FF) to print a minus sign before a result #.
; ==============================================================================
;
;
; ==============================================================================
; Print Line Number
; ==============================================================================
;
; ----------------------------------- ;Print " IN <LINE #>":
ED19: A9 58 INPRT LDA #<QT_IN ;Get " IN " Zero-String Address, Low
ED1B: A0 D3 LDY #>QT_IN ;Get " IN " Zero-String Address, High
ED1D: 20 31 ED JSR PRINTSTR ;Print String starting at [(A,Y)={Low,High}]
ED20: A5 76 LDA CURLIN+1 ;Get Current Applesoft Line Number, High
ED22: A6 75 LDX CURLIN ;Get Current Applesoft Line Number, Low
; ----------------------------------- ;Print Decimal Integer at [(X,A)={Lo,Hi}]
ED24: 85 9E LINPRT STA FAC+1 ;Set FAC Mantissa, Top
ED26: 86 9F STX FAC+2 ;Set FAC Mantissa, High
; ;^[FLOAT2 Clears FAC Mantissa, Mid & Low]
ED28: A2 90 LDX #$90 ;Set Exponent to 2^16 =65,536 =%0001,0000
; ;FAC FP#, So Set High Bit: $90=%1001,0000
; ;(Shifts Decimal Pt 16-bits to the Right)
ED2A: 38 SEC ;Flag to Float (FAC+1,2) as Positive Number
ED2B: 20 A0 EB JSR FLOAT2 ;Float Unsigned: [(X)->(FACX), (FAC+1,2)]
; ----------------------------------- ;Print FAC (User-Callable Entry Point):
ED2E: 20 34 ED PRINTFAC JSR FOUT ;Convert Number in FAC to String & Print It
ED31: 4C 3A DB PRINTSTR JMP STROUT ;Print String starting at [(A,Y)={Low,High}]
; ==============================================================================
; Convert FAC to a Zero-String starting at STACK [or at FOUTBUFF (STACK-1)];
; Return with [(A,Y)={Low,High}] Pointing at Zero-String:
; ==============================================================================
;
; ------------------------------------------------------------------------------
; Normal Entry Point, so that resultant Zero-String starts at STACK [$100]:
; ------------------------------------------------------------------------------
;
ED34: A0 01 FOUT LDY #1 ;Set Indirect Addressing Index, Advanced 1
;
; ------------------------------------------------------------------------------
; STR$ Function Enters Here, with (Y=0), so that resultant Zero-String starts at
; FOUTBUFF (STACK-1) [$FF] {to Force movment of the String to String-Space}
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Convert FAC to Zero-String in FOUT-Buff:
ED36: A9 2D FOUT1 LDA #'-' ;Flag (Sign) in case FAC is Negative
ED38: 88 DEY ;Reduce Indirect Addressing Y-Index
; ;^[Entry at FOUT, (Y)=(1 -> 0):(STACK);
; ; Entry at FOUT1, (Y)=(0 -> -1):(STACK-1)]
ED39: 24 A2 BIT FACSIGN ;Test FAC Unpacked Sign (msb)
ED3B: 10 04 BPL FOUTPOS ;Branch if FAC is Positive
; ;Else, FAC is Negative:
ED3D: C8 INY ;Advance Indirect Addressing Y-Index
; ;^[Entry at FOUT, (Y)=( 0 -> 1):(STACK);
; ; Entry at FOUT1, (Y)=(-1 -> 0):(STACK-1)]
ED3E: 99 FF 00 STA FOUTBUFF,Y ;Make Minus Sign 1st Char of String
; ;^[Forces move to String-Space if Y=0]
ED41: 85 A2 FOUTPOS STA FACSIGN ;Set FAC Unpacked Sign (msb) [$2D=Positive]
ED43: 84 AD STY STRNG2 ;Save Indirect Addressing Y-Index
; ;^[Index into Output String (BEING BUILT)]
ED45: C8 INY ;Advance Indirect Addressing Y-Index
ED46: A9 30 LDA #'0' ;Get a Low ASCII Zero in case FAC=0
ED48: A6 9D LDX FAC ;Get FAC Exponent [FAC<>|=0?]
ED4A: D0 03 BNE FOUTNOT0 ;Branch if FAC (Exponent) is NOT Zero
ED4C: 4C 57 EE JMP FOUTFIN ;Else, FAC (Exponent) is Zero, So Finish Up
ED4F: A9 00 FOUTNOT0 LDA #0 ;Clear (A) [Starting Value for TMPEXP]
; ; ^[TMPEXP is Exponent Shift Counter]
ED51: E0 80 CPX #$80 ; Is the FAC Exponent>=128? [FAC>=1?]
ED53: F0 02 BEQ FOUTIS1 ;Branch if FAC Exponent =128. [FAC =1.]
ED55: B0 09 BCS FOUTMORE ;Branch if FAC Exponent>=128. [FAC>=1.]
; ;Else, the FAC Exponent< 128. [FAC< 1.]
ED57: A9 14 FOUTIS1 LDA #<CON_1E9 ;Get Address of Constant 1E9, Low
ED59: A0 ED LDY #>CON_1E9 ;Get Address of Constant 1E9, High
ED5B: 20 7F E9 JSR FMULT ;Move Decimal Point: FAC=FAC*[(A,Y)={L,H}]
; ^^^^^---------- ;<<< Because of bug in FMULT, ... >>>
ED5E: A9 F7 LDA #$F7 ;Fix Exponent for more speed: [(Exp)=(-9)]
ED60: 85 99 FOUTMORE STA TMPEXP ;Set Shift Counter: (TMPEXP)=[(0) or (-9)]
; ----------------------------------- ;Adjust until 1E8<=FAC<1E9; Normalize
; (Outer Loop) ;between [100,000,000 & 999,999,999]:
ED62: A9 0F FOUTADJ1 LDA #<CON_1E9M1 ;Get Address of Constant 1E9-1, Low
ED64: A0 ED LDY #>CON_1E9M1 ;Get Address of Constant 1E9-1, High
ED66: 20 B2 EB JSR FCOMP ;Compare FAC with Packed Number at (A,Y) ^
; ;Rtns: (A)=(-1|0|1)<--[FAC (<|=|>) (A,Y)]
ED69: F0 1E BEQ FOUTINRNG2 ;Branch if FAC=1E9-1; In Range, EXIT LOOP
ED6B: 10 12 BPL FOUTLARGE ;Branch if FAC>1E9-1; Too Large, Do FAC/10
; (Inner Loop) ---------------------- ;Else, ... FAC<1E9-1; Test Lower Limit:
ED6D: A9 0A FOUTADJ2 LDA #<CON_1E8M1 ;Get Address of Constant 1E8-.1, Low
ED6F: A0 ED LDY #>CON_1E8M1 ;Get Address of Constant 1E8-.1, High
ED71: 20 B2 EB JSR FCOMP ;Compare FAC with Packed Number at (A,Y) ^
; ;Rtns: (A)=(-1|0|1)<--[FAC (<|=|>) (A,Y)]
ED74: F0 02 BEQ FOUTSMALL ;Branch if FAC=1E8-.1; Too Small, Do FAC*10
ED76: 10 0E BPL FOUTINRNG1 ;Branch if FAC>1E8-.1; In Range, EXIT LOOP
; ---------------------- ;Else, FAC<1E8-.1; Too Small, Do FAC*10:
ED78: 20 39 EA FOUTSMALL JSR MUL10 ;Too Small, Multiply FAC by Ten
ED7B: C6 99 DEC TMPEXP ;Keep Track of Multiplies (Shift Count)
ED7D: D0 EE BNE FOUTADJ2 ;LOOP until 1E8 <= FAC < 1E9; Always Taken
; ---------------------- ;Else, FAC>1E9-1; Too Large, Do FAC/10:
ED7F: 20 55 EA FOUTLARGE JSR DIV10 ;Too Large, Divide FAC by Ten
ED82: E6 99 INC TMPEXP ;Keep Track of Divisions (Shift Count)
ED84: D0 DC BNE FOUTADJ1 ;LOOP until 1E8 <= FAC < 1E9; Always Taken
; ------------------------------------------------------------------------------
; Round, Convert, & Print (Long Integer) FAC:
; ------------------------------------------------------------------------------
ED86: 20 A0 E7 FOUTINRNG1 JSR FADDH ;Round FAC
ED89: 20 F2 EB FOUTINRNG2 JSR QINT ;Convert FAC to (4 Byte) Integer
; ------------------------------------------------------------------------------
; FAC Mantissa is now in Integer Form with Power of Ten Adjustment in TMPEXP;
; If -10 < TMPEXP < 1, Print in Decimal Form; Else, Print in Exponential Form:
; ------------------------------------------------------------------------------
ED8C: A2 01 LDX #1 ;Preset Decimal Point Pointer
; ;^[Assume 1 Numeral before Decimal Point]
; ;Check Range: [(-10)<(TMPEXP)<(1)]
ED8E: A5 99 LDA TMPEXP ;Get FAC Exponent Shift Count
ED90: 18 CLC ;Prepare for Add with Carry
ED91: 69 0A ADC #10 ;Add Ten [(A)=(TMPEXP+10)]:[(0)<(A)<(11)]?
ED93: 30 09 BMI FOUTXF1 ;Branch if [(TMPEXP)<=(-10)]:[(A)<(0)]
; ;^[(FAC<.01): Use Exponential Form]
ED95: C9 0B CMP #11 ;Is [(-10)<(TMPEXP)<(1)]:[(0)<(A)<(11)]?
ED97: B0 06 BCS FOUTXF2 ;Branch if [(TMPEXP)>=(1)]:[(A)>=(11)]
; ;^[(FAC>=1E10): Use Exponential Form]
; ;C=0: Subtract with Borrow [A-Data-!C]
; ; or: Add with Carry [A+Data+C] (same):
ED99: 69 FF ADC #$FF ;Subtract 1 to Get Decimal Point Pointer
ED9B: AA TAX ;Set Decimal Point Pointer
; ----------------------------------- ;Compute Correct/Remaining Exponent:
ED9C: A9 02 LDA #2 ;Preset Remaining Exponent, Advanced
ED9E: 38 FOUTXF1 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
ED9F: E9 02 FOUTXF2 SBC #2 ;Subtract Advanced Preset
EDA1: 85 9A STA EXPON ;Set Remaining Exponent = 0
EDA3: 86 99 STX TMPEXP ;Save Decimal Point Pointer
; ;^[Replaces FACX Shift Count]
EDA5: 8A TXA ;Get Decimal Point Pointer
; ;^[Number of Numerals before Decimal Pt]
EDA6: F0 02 BEQ FOUTPDP ;Branch if Decimal Point is 1st (at Start)
EDA8: 10 13 BPL FOUTMKS ;Branch if NO Decimal Point at Start
; ----------------------------------- ;Place Decimal Point in String:
EDAA: A4 AD FOUTPDP LDY STRNG2 ;Retrieve Saved Indirect Addressing Y-Index
; ;^[Index into Output String (BEING BUILT)]
EDAC: A9 2E LDA #'.' ;Get a Decimal Point Character
EDAE: C8 INY ;Advance Indirect Addressing Y-Index
EDAF: 99 FF 00 STA FOUTBUFF,Y ;Place a Decimal Point Character in String
EDB2: 8A TXA ;Get Decimal Point Pointer
EDB3: F0 06 BEQ FOUTSVY ;Branch if Decimal Point is 1st (at Start)
EDB5: A9 30 LDA #'0' ;Get a Zero Character
EDB7: C8 INY ;Advance Indirect Addressing Y-Index
EDB8: 99 FF 00 STA FOUTBUFF,Y ;Place a Zero Character in String
; ----------------------------------- ;Decimal Point is 1st (at Start):
EDBB: 84 AD FOUTSVY STY STRNG2 ;Save Indirect Addressing Y-Index
; ;^[Output String Character Pointer]
; ----------------------------------- ;NO Decimal Point at Start:
; Make String ;Zero in on Number while Building String:
EDBD: A0 00 FOUTMKS LDY #0 ;Clear Indirect Addressing Y-Index
; ;Y-Index = Pointer to Powers
EDBF: A2 80 LDX #$80 ;Starting Value for Numeral [w/o (msb)]
; ;^[& (+|-) Direction/Instruction (msb)]:
; ;^[& (+|-) Add-to/Subtract-frm FAC Mant]
; ----------------------------------- ;Divide by Powers of 10 to get Numerals:
; Make String Loop ;Start by Adding -1E8 (from DECTBL) until
; ;Overshoot; Then Add +1E7, Then Add -1E6,
; ;Then Add +1E5, & ... (Alternating Signs);
; ;The Number of times each Power is Added
; ;is 1 more than corresponding Numeral (*);
; ;Get 4 Power-Data-Bytes/Cycle in sequence:
EDC1: A5 A1 FOUT2LOOP LDA FAC+4 ;Get FAC Mantissa, Low
EDC3: 18 CLC ;Prepare for Add with Carry
EDC4: 79 6C EE ADC DECTBL+3,Y ;Add Power Data, Low
EDC7: 85 A1 STA FAC+4 ;Set FAC Mantissa, Low
EDC9: A5 A0 LDA FAC+3 ;Get FAC Mantissa, Middle
EDCB: 79 6B EE ADC DECTBL+2,Y ;Add Power Data, Middle
EDCE: 85 A0 STA FAC+3 ;Set FAC Mantissa, Middle
EDD0: A5 9F LDA FAC+2 ;Get FAC Mantissa, High
EDD2: 79 6A EE ADC DECTBL+1,Y ;Add Power Data, High
EDD5: 85 9F STA FAC+2 ;Set FAC Mantissa, High
EDD7: A5 9E LDA FAC+1 ;Get FAC Mantissa, Top
EDD9: 79 69 EE ADC DECTBL,Y ;Add Power Data, Top
EDDC: 85 9E STA FAC+1 ;Set FAC Mantissa, Top
; -------- NEXT -------- ;Carry & X Now Control (+|-) Loop Activity
EDDE: E8 INX ;Advance Counter: Numeral Value [w/o (msb)]
; ---------------------- ;(C=1); Stop Adding If X is Positive:
EDDF: B0 04 BCS FOUT2LPND ;(C=1); Branch if FAC Mantissa Overflowed
; ---------------------- ;(C=0); Keep Adding If X is Positive:
EDE1: 10 DE BPL FOUT2LOOP ;(C=0); LOOP if [(X)>=(0)]
; ---------------------- ;(C=0); Stop Adding If X is Negative:
; ; [Overshot Lower Limit]
EDE3: 30 02 BMI FOUTCNTD ;(C=0); Branch if [(X)<(0)]; Always Taken
; ---------------------- ;FAC Mantissa Overflowed:
; ;(C=1); Keep Adding If X is Negative:
EDE5: 30 DA FOUT2LPND BMI FOUT2LOOP ;(C=1); LOOP if [(X)<(0)]
; ;(C=1); Stop Adding If X is Positive:
; ; [Overshot Upper Limit]
; ----------------------------------- ;End of Inner Make String Loop (FOUT2LOOP)
; Counted ;Make X into a Numeral;
; ;How depends on last Direction:
EDE7: 8A FOUTCNTD TXA ;Get Count: Numeral Value [w/o (msb)]
EDE8: 90 04 BCC FOUTNMRL ;Branch if Overshot Lower Limit
; ;Else, Overshot Upper Limit;
; ;Adjust Count for Positive case:
EDEA: 49 FF EOR #%11111111 ;Invert Bits (Negate)
; ;Add with Carry Set (C=1):
EDEC: 69 0A ADC #10 ;Numeral=10+C-X; (*) Remember X is One Up!
EDEE: 69 2F FOUTNMRL ADC #'/' ;Convert Count to ASCII Numeral
; ;Advance to Next Smaller Power of Ten:
EDF0: C8 INY ;Advance Indirect Addressing Y-Index (*4)
EDF1: C8 INY ;[4 times to get 4 Power Data Bytes/Cycle
EDF2: C8 INY ;Sequencially from the Powers of 10
EDF3: C8 INY ;(Decimal/Hexadecimal Constants) Table]
EDF4: 84 83 STY VARPTR ;Save Y-Index: Pointer to Powers
EDF6: A4 AD LDY STRNG2 ;Get Output String Character Pointer
EDF8: C8 INY ;Advance Output String Character Pointer
EDF9: AA TAX ;Save ASCII Numeral, (msb) is Direction
EDFA: 29 7F AND #%01111111 ;Assure it's Low ASCII, $30..39, for String
EDFC: 99 FF 00 STA FOUTBUFF,Y ;Place Low ASCII Numeral into Output String
EDFF: C6 99 DEC TMPEXP ;Count Numeral; Adjust Decimal Point Pointer
EE01: D0 06 BNE FOUTSKPDP ;Branch if Not yet Time for Decimal Point
EE03: A9 2E LDA #'.' ;Else, Time for Decimal Point, Get One
EE05: C8 INY ;Advance Output String Character Pointer
EE06: 99 FF 00 STA FOUTBUFF,Y ;Place Decimal Point into Output String
EE09: 84 AD FOUTSKPDP STY STRNG2 ;Save Output String Character Pointer
EE0B: A4 83 LDY VARPTR ;Retrieve Saved Pointer to Powers
EE0D: 8A TXA ;Retrieve ASCII Numeral, (msb) is Direction
; ;Change Dir: Adding=0, Subtracting=$80
; ;(Invert Specified Bits by XOR-Mask):
EE0E: 49 FF EOR #%11111111 ;Invert Bits (Negate) [Toggle Sign]
; ;(Select Specified Bits by AND-Mask):
EE10: 29 80 AND #%10000000 ;Keep Negated Sign & Discard Negated Value
EE12: AA TAX ;Save Direction: Adding=0, Subtracting=$80
; ;Done Adding & Subtracting Yet?
EE13: C0 24 CPY #36 ;[DECTBLEND-DECTBL]=[$EE8D-$EE69]=[$24]=[36]
; ;Also: [4 Bytes/Const * 9 Cons]=[36]
EE15: D0 AA BNE FOUT2LOOP ;LOOP Until Done Adding & Subtracting
; ----------------------------------- ;End of Outer Make String Loop (FOUT2LOOP)
; ;Nine Numerals were Placeed in String;
; ;Truncate Trailing: Zeroes & Decimal Point
EE17: A4 AD LDY STRNG2 ;Retrieve Output String Character Pointer
EE19: B9 FF 00 FOUTMVBK LDA FOUTBUFF,Y ;Get (Y) Character Placed in Output String
EE1C: 88 DEY ;Reduce Output String Character Pointer
EE1D: C9 30 CMP #'0' ;Was Last Character Got a Zero?
EE1F: F0 F8 BEQ FOUTMVBK ;Branch to Suppress Trailing Zero
EE21: C9 2E CMP #'.' ;Was Last Character Got a Decimal Point?
EE23: F0 01 BEQ FOUTNEEDX ;Branch to Overwrite Trailing Decimal Point
; ;Else, Not Decimal Point, so Keep Numeral:
EE25: C8 INY ;Advance Output String Character Pointer
EE26: A9 2B FOUTNEEDX LDA #'+' ;Prepare for Positive Exponent "E+##"
EE28: A6 9A LDX EXPON ;Get Exponent from Safe
EE2A: F0 2E BEQ FOUTMKND ;Branch if NO Exponent (A=0)
EE2C: 10 08 BPL FOUTPUTX ;Branch if Exponent is Positive (A>0)
; ;Else, Exponent is Negative (A<0)
EE2E: A9 00 LDA #0 ;Prepare to Negate Exponent (0-EXPON)
EE30: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
EE31: E5 9A SBC EXPON ;Subtract to Negate Exponent (0-EXPON)
EE33: AA TAX ;Save Negated Exponent: (X)=(-EXPON)
EE34: A9 2D LDA #'-' ;Get a Minus Sign
EE36: 99 01 01 FOUTPUTX STA FOUTBUFF+2,Y ;Place Minus Sign into Output String [E-##]
EE39: A9 45 LDA #'E' ;Get an "E" (Exponent) Sign
EE3B: 99 00 01 STA FOUTBUFF+1,Y ;Place "E" Sign into Output String [E-##]
EE3E: 8A TXA ;Retrieve Negated Exponent: (A=X)=(-EXPON)
EE3F: A2 2F LDX #'/' ;=("0"-1); Convert to Decimal [Lower Limit]
; ;[ASCII Sequence: /,0,1,2,3,4,5,6,7,8,9,:]
EE41: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
EE42: E8 FOUTWHATX INX ;Count Subtraction (from Negated Exponent)
EE43: E9 0A SBC #10 ;Subtract 10 (for Exponent Ten's Place)
EE45: B0 FB BCS FOUTWHATX ;BGT: Branch if More Tens to Subtract
; ;Do Remainder (for Exponent One's Place):
EE47: 69 3A ADC #':' ;=("9"+1); Convert to Decimal [Upper Limit]
; ;[ASCII Sequence: /,0,1,2,3,4,5,6,7,8,9,:]
EE49: 99 03 01 STA FOUTBUFF+4,Y ;Place into String at Exponent One's Place
EE4C: 8A TXA ;Get Exponent Ten's Place Subtraction Count
EE4D: 99 02 01 STA FOUTBUFF+3,Y ;Place into String at Exponent Ten's Place
EE50: A9 00 LDA #$00 ;Get a Zero ($00) to Terminate Z-String
EE52: 99 04 01 STA FOUTBUFF+5,Y ;Place Zero at End of String
EE55: F0 08 BEQ FOUTPTSTK ;Always Taken
; ;FAC (Exponent) is Zero, So Finish Up:
EE57: 99 FF 00 FOUTFIN STA FOUTBUFF,Y ;Place ASCII "0" into String at (Y) Position
; ;Just Mark End of String:
EE5A: A9 00 FOUTMKND LDA #$00 ;Get a Zero ($00) to Terminate Z-String
EE5C: 99 00 01 STA FOUTBUFF+1,Y ;Place Zero at End of String
; ;Point at Start of String:
EE5F: A9 00 FOUTPTSTK LDA #<STACK ;Apple-II 6502 Microprocessor Stack, Low
EE61: A0 01 LDY #>STACK ;Apple-II 6502 Microprocessor Stack, High
; ;-----------------------------------------
; ;^ STR$ Starts STRING at FOUTBUFF (STK-1),
; ; but STR$ doesn't use [(A,Y)={Lo,Hi}],
; ; so using STACK here is okay!
; ;-----------------------------------------
EE63: 60 RTS ;Return to Caller
; ==============================================================================
; The Number One Half (1/2) (Packed FAC Constant)
; ==============================================================================
;
EE64: 80 00 00 00+ CON_HALF HEX 8000000000 ;<-[Normalized]; (1/2)=(0.500)
;
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_HALF HEX 8000000000 |(00) |$80-$80=$00= +0 |$.00000000 |+5.00000000E-1
; (!) POS_HALF HEX 8080000000 |(00) |$80-$80=$00= +0 |$.80000000 |+5.00000000E-1
; (!) NEG_HALF HEX 8080000000 |(FF) |$80-$80=$00= +0 |$.80000000 |-5.00000000E-1
; ------------------------------------------------------------------------------
; <<< Plugging NRM_HALF into & Printing FAC ($ED2EG) results in nothing printed!
; --Seems that when the mantissa is zero there's a problem printing numbers. >>>
; ==============================================================================
;
;
; ==============================================================================
; Powers of 10: (Decimal/Hexadecimal Constants) <<<[NOT Packed FAC Constants]>>>
; ==============================================================================
; From 1E+8 down to 1, as 32-bit integers, with alternating signs:
; %(s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Hexadecimal Constant | Decimal | ^Exp | Qword | Word
; ------------------------------------|------------|------|-----------|---------
EE69: FA 0A 1F 00 DECTBL HEX FA0A1F00 ;-100,000,000= -1E+8 =$FFFF,FFFF,FA0A,1F00
EE6D: 00 98 96 80 HEX 00989680 ; +10,000,000= +1E+7 =$0000,0000,0098,9680
EE71: FF F0 BD C0 HEX FFF0BDC0 ;. -1,000,000= -1E+6 =$FFFF,FFFF,FFF0,BDC0
EE75: 00 01 86 A0 HEX 000186A0 ;... +100,000= +1E+5 =$0000,0000,0001,86A0
EE79: FF FF D8 F0 HEX FFFFD8F0 ;.... -10,000= -1E+4 =$FFFF,FFFF,FFFF,D8F0
EE7D: 00 00 03 E8 HEX 000003E8 ;..... +1,000= +1E+3 =$0000,0000,0000,03E8
EE81: FF FF FF 9C HEX FFFFFF9C ;....... -100= -1E+2 =$FFFF,FFFF,FFFF,FF9C
EE85: 00 00 00 0A HEX 0000000A ;........ +10= +1E+1 =$0000,0000,0000,000A
EE89: FF FF FF FF HEX FFFFFFFF ;......... -1= -1E+0 =$FFFF,FFFF,FFFF,FFFF
; ------------------------------------------------------------------------------
; DECTBLEND EQU * ;$EE8D
; ==============================================================================
;
; ==============================================================================
; "SQR" Square Root Function: Immediate & Deferred; Parameter: SQR (Aexpr);
; Returns Positive Square Root of a Number (Aexpr); This uses exponentiation
; SQR(x) = x^.5, rather than a Newton-Raphson iteration, but this special
; implementation is faster than the normal one.
; ==============================================================================
;
EE8D: 20 63 EB SQR JSR FACRND2ARG ;Copy FAC to ARG (Rounded)
; ;Point at Constant: (1/2)=(0.500)
EE90: A9 64 LDA #<CON_HALF ;Get Address for Constant, Low
EE92: A0 EE LDY #>CON_HALF ;Get Address for Constant, High
EE94: 20 F9 EA JSR UPAY2FAC ;Unpack FP# at [(A,Y)={Low,High}] into FAC
; ;[Drop into Power Function]
;
; ==============================================================================
; "EXPONENT" [POWER] Function: FAC=ARG^FAC
; ==============================================================================
; This is the Exponentiation ("^") Operator, NOT the "EXP" Exponent Function!
; But, if the accumulator is zero upon entry here, this routine branches to the
; "EXP" Exponent Function routine.
; ==============================================================================
;
; EQU * ;(Math Operator Table Branch Address +1)
EE97: F0 70 FPWRT BEQ EXP ;Branch to "EXP" Function if (A=0)
; ;^[if FAC=0, ARG^FAC=EXP(0)]
EE99: A5 A5 LDA ARG ;Get ARG Exponent
EE9B: D0 03 BNE FPWRT1 ;Branch if ARG (Exponent) is Not Zero
; ;Else [if ARG=0, ARG^FAC=0], ...
EE9D: 4C 50 E8 JMP ZFACSGNEXP ;Go Set FAC Signed Exponent & Sign
; ------------------------------------------------------------------------------
; Exponentiation Operation:
; [BASE^POWER]=[ARG^FAC]=[EXP((LOG(ABS(ARG))*FAC)*ARGSIGN)]
; ------------------------------------------------------------------------------
;
; ---------------------- ;Save FAC [POWER] in TEMP3:
EEA0: A2 8A FPWRT1 LDX #TEMP3 ;Get Destination Address, Low
EEA2: A0 00 LDY #>TEMP3 ;Get Destination Address, High
EEA4: 20 2B EB JSR FACRND2XY ;Pack FAC (Rounded) into [(X,Y)={Low,High}]
; ---------------------- ;Normally, ARG [BASE] must be Positive:
EEA7: A5 AA LDA ARGSIGN ;Get ARG Unpacked Sign (msb)
EEA9: 10 0F BPL FPWRT2 ;Branch if ARG is Positive (OK)
; ---------------------- ;Else, ARG is Negative (OK if Int Power)
; ;Check if it's an Integer Power:
EEAB: 20 23 EC JSR INT ;Get Integer Part in FAC = Float[INT(FAC)]
; ;Does INT(FAC)=FAC?
EEAE: A9 8A LDA #TEMP3 ;Get Comparand Address, Low
EEB0: A0 00 LDY #>TEMP3 ;Get Comparand Address, High
EEB2: 20 B2 EB JSR FCOMP ;Compare FAC with Packed Number at (A,Y) ^
; ;Rtns: (A)=(-1|0|1)<--(A,Y)=[(>|=|<) FAC]
EEB5: D0 03 BNE FPWRT2 ;Branch if Not Integer Power (FAC)<>(TEMP3)
; ;^[Not Integer Power would cause Error!]
; ---------------------- ;Else, it is an Int Power (FAC)=(TEMP3);
; ;So allow Negtive ARG by making it Postive
; ;when moved to FAC for Calculation:
EEB7: 98 TYA ;Clear Accumulator (A=Y=0)
EEB8: A4 0D LDY CHARAC ;Get Parity [(lsb) of (CHARAC)] (from INT)
; ;^[Saved FAC Mantissa (Integer Form), Low]
; ----------------------------------- ;Now, ARG is Positive, or is Negative & an
; ;Integer Power, fixable for Calculation,
; ;or Not an Integer Power; [(A=0) Sets FAC
; ;Unpacked Sign (msb)], Next:
EEBA: 20 55 EB FPWRT2 JSR CPYARGFAC ;Copy ARG into FAC [FAC=ABS(ARG)]
EEBD: 98 TYA ;Get to Save [Y=0 or Y=(CHARAC)] on STACK:
EEBE: 48 PHA ;Push (Y) as Flag for Negative ARG [0=(+)]
; ---------------------- ;Get Natural Logarithm of ABS(ARG):
EEBF: 20 41 E9 JSR LOG ;Do LOG(FAC) [ABS(ARG) was copied into FAC]
; ---------------------- ;Now, Multiply by Power (Exponent):
EEC2: A9 8A LDA #TEMP3 ;Get TEMP3 (Safe FAC [POWER]) Address, Low
EEC4: A0 00 LDY #>TEMP3 ;Get TEMP3 (Safe FAC [POWER]) Address, High
EEC6: 20 7F E9 JSR FMULT ;Multiply FAC by POWER [FAC=FAC*(A,Y)]
; ^^^^^---------- ;<<< Because of bug in FMULT, ... >>>
EEC9: 20 09 EF JSR EXP ;Raise to Power of Natural Base (e=2.718282)
; ---------------------- ;Is Exponent [POWER] a Negative Odd Int?
EECC: 68 PLA ;Pull Flag for Negative ARG [0=(+)]
EECD: 4A LSR A ;Put Negative ARG Flag (lsb) into Carry
EECE: 90 0A BCC BAS_RTS23 ;Return to Caller if NOT; Else, Do NEGOP
;
; ==============================================================================
; "NEGOP" [Greater-Than (">") Operator] Function: Negates Value in FACSIGN
; ==============================================================================
;
; ==============================================================================
; Comparison for (GREATER-THAN)->-(LESS-THAN) [Rel Ops (">") Unary Minus entry]:
; ==============================================================================
; From MATHTBL: MO_UMNS_GTLT DFB P_NEQ ;$CF...207...>...Unary Minus ("-")
; TA_UMNS_GTLT DW NEGOP-1 ;(GREATER-THAN)->-(LESS-THAN) Op Adrs
; ==============================================================================
;
; EQU * ;(Math Operator Table Branch Address +1)
EED0: A5 9D NEGOP LDA FAC ;Get FAC Exponent
EED2: F0 06 BEQ BAS_RTS23 ;Branch if FAC=0; No need to Complement
EED4: A5 A2 LDA FACSIGN ;Get FAC Unpacked Sign (msb)
EED6: 49 FF EOR #%11111111 ;Invert Bits (Negate)
EED8: 85 A2 STA FACSIGN ;Set FAC Unpacked Sign (msb)
EEDA: 60 BAS_RTS23 RTS ;Return to Caller
; ==============================================================================
; LOG (base 2) of (e):(The Base for Natural Logarithms) (Packed FAC Constant)
; ==============================================================================
; The Base for Natural Logarithms (e) [Euler's] Constant & Formula:
; ------------------------------------------------------------------------------
; e = 2.718281828
; Exp(1) = 2.71828183
; ==============================================================================
; Logarithm Base Conversion Formulas & Constants:
; ------------------------------------------------------------------------------
; Log (base b) N = ln(N) / ln(b) | ln(2) = 0.693147181
; Log (base 2) N = ln(N) / ln(2) | ^--(Using AppleWin & Applesoft)
; ------------------------------------------------------------------------------
; ln(10) = 2.30258509 | Log(2) = 0.30102999566398119521373889472449
; ^---(Using A/W & A/S) | ^--(Using Calculator in Windows 7)
; ------------------------------------------------------------------------------
; Log(2) = [(ln(2))/(ln(10))] = [(0.693147181)/(2.30258509)] = (0.301029996)
; ^-------(Using AppleWin & Applesoft)-------^
; ==============================================================================
; The Values Indicated here (CON_LOG_E) & below (POLY_EXP, POLY_EXP_L2, &
; POLY_ONE), are NOT EXACT since the Coefficients are Adjusted for Accuracy:
; ------------------------------------------------------------------------------
;
EEDB: 81 38 AA 3B+ CON_LOG_E HEX 8138AA3B29 ;[Normalized]; LOG(base2)(e) = 1.442695042
;
; Proof: LOG(base 2)(e) = [(ln(e))/(ln(2))] = [(1)/(0.693147181)] = 1.44269504
; ------------------------------------------------------------------------------
;
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_LOGE HEX 8138AA3B29 |(00) |$81-$80=$01= +1 |$.38AA3B29 |+0.44269504E+0
; (!) POS_LOGE HEX 81B8AA3B29 |(00) |$81-$80=$01= +1 |$.B8AA3B29 |+1.44269504E+0
; (!) NEG_LOGE HEX 81B8AA3B29 |(FF) |$81-$80=$01= +1 |$.B8AA3B29 |-1.44269504E+0
; ------------------------------------------------------------------------------
; * FACSIGN msb must be set ($80-$FF) to print a minus sign before a result #.
; ==============================================================================
;
;
; ==============================================================================
; Polynomial Coeficients (Packed FAC Constants adjusted for accuracy)
; ==============================================================================
;
EEE0: 07 POLY_EXP DFB $07 ;Index: (Polynomial Coeficients)-1
EEE1: 71 34 58 3E+ HEX 7134583E56 ;<-[Normalized]; (LOG(2)^7)/7!
EEE6: 74 16 7E B3+ HEX 74167EB31B ;<-[Normalized]; (LOG(2)^6)/6!
EEEB: 77 2F EE E3+ HEX 772FEEE385 ;<-[Normalized]; (LOG(2)^5)/5!
EEF0: 7A 1D 84 1C+ HEX 7A1D841C2A ;<-[Normalized]; (LOG(2)^4)/4!
EEF5: 7C 63 59 58+ HEX 7C6359580A ;<-[Normalized]; (LOG(2)^3)/3!
EEFA: 7E 75 FD E7+ HEX 7E75FDE7C6 ;<-[Normalized]; (LOG(2)^2)/2!
;
EEFF: 80 31 72 18+ POLY_EXP_L2 HEX 8031721810 ;<-[Normalized]; (LOG(2)^1)/1! {<> ln(2)}
; << Is this a BUG? {POLY_EXP_L2 == ln(2)+(0.5E-8)} <> {CON_LOGTWO == ln(2)} >>
;
EF04: 81 00 00 00+ POLY_ONE HEX 8100000000 ;<-[Normalized]; The Number One (1), again
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_L2_7 HEX 7134583E56 |(00) |$71-$80=$F1=-15 |$.34583E56 |+6.23997465E-6
; (!) POS_L2_7 HEX 71B4583E56 |(00) |$71-$80=$F1=-15 |$.B4583E56 |+2.14987637E-5
; (!) NEG_L2_7 HEX 71B4583E56 |(FF) |$71-$80=$F1=-15 |$.B4583E56 |-2.14987637E-5
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_L2_6 HEX 74167EB31B |(00) |$74-$80=$F4=-12 |$.167EB31B |+2.14528279E-5
; (!) POS_L2_6 HEX 74967EB31B |(00) |$74-$80=$F4=-12 |$.967EB31B |+1.43523140E-4
; (!) NEG_L2_6 HEX 74967EB31B |(FF) |$74-$80=$F4=-12 |$.967EB31B |-1.43523140E-4
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_L2_5 HEX 772FEEE385 |(00) |$77-$80=$F7= -9 |$.2FEEE385 |+3.65700983E-4
; (!) POS_L2_5 HEX 77AFEEE385 |(00) |$77-$80=$F7= -9 |$.AFEEE385 |+1.34556348E-3
; (!) NEG_L2_5 HEX 77AFEEE385 |(FF) |$77-$80=$F7= -9 |$.AFEEE385 |-1.34556348E-3
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_L2_4 HEX 7A1D841C2A |(00) |$7A-$80=$FA= -6 |$.1D841C2A |+1.80151701E-3
; (!) POS_L2_4 HEX 7A9D841C2A |(00) |$7A-$80=$FA= -6 |$.9D841C2A |+9.61401701E-3
; (!) NEG_L2_4 HEX 7A9D841C2A |(FF) |$7A-$80=$FA= -6 |$.9D841C2A |-9.61401701E-3
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_L2_3 HEX 7C6359580A |(00) |$7C-$80=$FC= -4 |$.6359580A |+2.42551269E-2
; (!) POS_L2_3 HEX 7CE359580A |(00) |$7C-$80=$FC= -4 |$.E359580A |+5.55051269E-2
; (!) NEG_L2_3 HEX 7CE359580A |(FF) |$7C-$80=$FC= -4 |$.E359580A |-5.55051269E-2
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_L2_2 HEX 7E75FDE7C6 |(00) |$7E-$80=$FE= -2 |$.75FDE7C6 |+1.15226385E-1
; (!) POS_L2_2 HEX 7EF5FDE7C6 |(00) |$7E-$80=$FE= -2 |$.F5FDE7C6 |+2.40226385E-1
; (!) NEG_L2_2 HEX 7EF5FDE7C6 |(FF) |$7E-$80=$FE= -2 |$.F5FDE7C6 |-2.40226385E-1
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_L2_1 HEX 8031721810 |(00) |$80-$80=$00= +0 |$.31721810 |+1.93147186E-1
; (!) POS_L2_1 HEX 80B1721810 |(00) |$80-$80=$00= +0 |$.B1721810 |+6.93147186E-1
; (!) NEG_L2_1 HEX 80B1721810 |(FF) |$80-$80=$00= +0 |$.B1721810 |-6.93147186E-1
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_LN2 HEX 80317217F8 |(00) |$80-$80=$00= +0 |$.317217F8 |+1.93147181E-1
; (!) POS_LN2 HEX 80B17217F8 |(00) |$80-$80=$00= +0 |$.B17217F8 |+6.93147181E-1
; (!) NEG_LN2 HEX 80B17217F8 |(FF) |$80-$80=$00= +0 |$.B17217F8 |-6.93147181E-1
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ONE HEX 8100000000 |(00) |$81-$80=$01= +1 |$.00000000 |+1.00000000E+0
; (!) POS_ONE HEX 8180000000 |(00) |$81-$80=$01= +1 |$.80000000 |+1.00000000E+0
; (!) NEG_ONE HEX 8180000000 |(FF) |$81-$80=$01= +1 |$.80000000 |-1.00000000E+0
; ------------------------------------------------------------------------------
; <<< Plugging NRM_ONE into & Printing FAC ($ED2EG) results in BLANK LINE!
; --Seems that when the mantissa is zero there's a problem printing numbers. >>>
; ------------------------------------------------------------------------------
; * FACSIGN msb must be set ($80-$FF) to print a minus sign before a result #.
; ==============================================================================
;
;
; ==============================================================================
; "EXP" Exponent Function: Immediate & Deferred; Parameter: EXP (Aexpr);
; Raises (e), Euler's Constant, the Base for Natural Logarithms,
; (to 6 Places, e=2.718282) to the POWER (Aexpr) Specified
; ==============================================================================
; Computes FAC = e^FAC = 2^[FAC*Log2(e)]
; ==============================================================================
; This is NOT the Exponentiation ("^") [Power] Operator! [But, if (A) is zero
; upon entry there, this routine is branched to immediately]
; ==============================================================================
; "Convert to Power of Two Problem"
; ------------------------------------------------------------------------------
;
; ;Setup to compute e^FAC = 2^[FAC*Log2(e)]:
EF09: A9 DB EXP LDA #<CON_LOG_E ;Get Constant [Log2(e)] Address, Low
EF0B: A0 EE LDY #>CON_LOG_E ;Get Constant [Log2(e)] Address, High
EF0D: 20 7F E9 JSR FMULT ;Multiply: FAC = FAC * [(A,Y)={Low,High}]
; ^^^^^---------- ;<<< Because of bug in FMULT, EXP(x) is
; ;off for approximately 1<x<1.00000012 and
; ;many other values; e.g., near any integer
; ;(not too large), half integer, etc. >>>
EF10: A5 AC LDA FACEXT ;Get FAC Extra Precision Byte
EF12: 69 50 ADC #$50 ;1st Range Test; Add to Round Up
; ;^[Non-Standard Rounding here]
EF14: 90 03 BCC EXP1 ;Branch if No Carryover
; ;Else, Round Up (FACEXT > $AF)
EF16: 20 7A EB JSR INCMAN ;Advance FAC (Add Carryover)
EF19: 85 92 EXP1 STA ARGEXT ;Set ARG Extra Precision Byte
; ;^[Strange Value]
EF1B: 20 66 EB JSR FAC2ARG ;Copy FAC to ARG
EF1E: A5 9D LDA FAC ;Get FAC Exponent
EF20: C9 88 CMP #$88 ;Within Range? [Maximum Exponent < 128]
EF22: 90 03 BCC EXP3 ;BLT: Branch if within Range [< 136]
EF24: 20 2B EA EXP2LOOP JSR OUTOFRNG ;Else, Out of Range, Make Zero or Overflow
EF27: 20 23 EC EXP3 JSR INT ;Get Integer Part in FAC = Float[INT(FAC)]
EF2A: A5 0D LDA CHARAC ;Get Integer Part of POWER
EF2C: 18 CLC ;Prepare for Add with Carry
EF2D: 69 81 ADC #$81 ;2nd Range Test; Add to Exponent Bias + 1
EF2F: F0 F3 BEQ EXP2LOOP ;[0-$81=$7F] Branch if Overflow
; ;Get Back to Normal Bias:
EF31: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
EF32: E9 01 SBC #1 ;Subtract 1 from Exponent Bias + 1
EF34: 48 PHA ;Save Exponent
; ;Swap ARG and FAC:
EF35: A2 05 LDX #5 ;Get Count: Number of Bytes to Swap
; <<< Why Swap? It's doing -(A-B) when (B-A) is the same thing! >>>
EF37: B5 A5 EXP4LOOP LDA ARG,X ;Get ARG Byte to Swap
EF39: B4 9D LDY FAC,X ;Get FAC Byte to Swap
EF3B: 95 9D STA FAC,X ;Set FAC Byte being Swapped
EF3D: 94 A5 STY ARG,X ;Set ARG Byte being Swapped
EF3F: CA DEX ;Reduce Byte Counter
EF40: 10 F5 BPL EXP4LOOP ;LOOP Until Done
EF42: A5 92 LDA ARGEXT ;Get ARG Extra Precision Byte
; ;^[Strange Value]
EF44: 85 AC STA FACEXT ;Set FAC Extra Precision Byte
EF46: 20 AA E7 JSR FSUBT ;Subtract Integer Part [POWER-INT(POWER)]
; ;Remainder is Fractional Part
EF49: 20 D0 EE JSR NEGOP ;Negate Value in FAC (Invert FACSIGN Bits)
EF4C: A9 E0 LDA #<POLY_EXP ;Get Polynomial Coeficients Address, Low
EF4E: A0 EE LDY #>POLY_EXP ;Get Polynomial Coeficients Address, High
EF50: 20 72 EF JSR POLYNOMIAL ;Compute Series F(x) on Fractional Part
EF53: A9 00 LDA #0 ;Clear Accumulator
EF55: 85 AB STA SGNCPR ;Clear Sign Flag for Comparing
EF57: 68 PLA ;Retrieve Exponent
EF58: 20 10 EA JSR ADDEXPS1 ;Add Exponent of Integer Part
; <<< Wasted byte here (below), could have just jumped there (above) >>>
EF5B: 60 RTS ;Return to Caller
; ==============================================================================
; Odd Polynomial Subroutine
;
; F(x) = x * P(x^2)
;
; Where: x is Value in FAC
; [(A,Y)={Low,High}] Points at Coefficient Table
; 1st Byte of Coefficient Table is Index: (Polynomial Coeficients)-1
; Coefficients follow, Highest Power 1st
;
; P(x^2) Series Computed using Normal Polynomial Subroutine
;
; ==============================================================================
; Computes ax+bx^3+cx^5+... where SERPTR (A,Y) points to Coeficients ...c,b,a.
; ==============================================================================
;
EF5C: 85 AD POLY_ODD STA SERPTR ;Save Series Pointer, Low
EF5E: 84 AE STY SERPTR+1 ;Save Series Pointer, High
EF60: 20 21 EB JSR FACRND2TMP1 ;Store FAC Rounded in TEMP1
EF63: A9 93 LDA #TEMP1 ;Get TEMP1 ZP Address, Low
; ;Y=0: TEMP1 ZP Address, High; x=(TEMP1)
EF65: 20 7F E9 JSR FMULT ;Square x; Then Do Series in (x^2):
; ^^^^^---------- ;<<< Because of bug in FMULT, ... >>>
EF68: 20 76 EF JSR SERMAIN ;Calc: a+bx+cx^2+...; Coef's: ...c,b,a.
EF6B: A9 93 LDA #TEMP1 ;Get TEMP1 ZP Address, Low
EF6D: A0 00 LDY #>TEMP1 ;Get TEMP1 ZP Address, High
; --------------- ;<<< Because of bug in FMULT, ... >>>
EF6F: 4C 7F E9 JMP FMULT ;Multiply by P(x^2) Series (& Exit)
; ==============================================================================
; Normal Polynomial Subroutine
;
; P(x) = C(0)*x^n + C(1)*x^(n-1) + ... + C(n)
;
; Where: x is Value in FAC
; [(A,Y)={Low,High}] Points at Coefficient Table
; 1st Byte of Coefficient Table is Index: (Polynomial Coeficients)-1
; Coefficients follow, Highest Power 1st
;
; ==============================================================================
; Computes a+bx+cx^2+... where SERPTR (A,Y) points to Coeficients ...c,b,a.
; ==============================================================================
;
EF72: 85 AD POLYNOMIAL STA SERPTR ;Save Series Pointer, Low
EF74: 84 AE STY SERPTR+1 ;Save Series Pointer, High
; ----------------------------------- ;Calc: a+bx+cx^2+...; Coef's: ...c,b,a.
EF76: 20 1E EB SERMAIN JSR FACRND2TMP2 ;Store FAC Rounded (x) in TEMP2
EF79: B1 AD LDA (SERPTR),Y ;Get PC Index: (Polynomial Coeficients)-1
EF7B: 85 A3 STA SERLEN ;Save PC Index as Series Length
; ---------------------- ;Point to last Coefficient (1st in Table):
EF7D: A4 AD LDY SERPTR ;Get Pointer to Series Data, Low
EF7F: C8 INY ;Advance Y-Index: Series Data Pointer, Low
EF80: 98 TYA ;Get Series Data Pointer, Low
EF81: D0 02 BNE SERMAIN1 ;Branch if Not Crossing Page Boundary
EF83: E6 AE INC SERPTR+1 ;Advance Pointer to Series Data, High
EF85: 85 AD SERMAIN1 STA SERPTR ;Set Pointer to Series Data, Low
EF87: A4 AE LDY SERPTR+1 ;Get Pointer to Series Data, High
; ---------------------- ;Accumulate Series Terms:
EF89: 20 7F E9 SERMAIN2 JSR FMULT ;Multiply: FAC = FAC * [(A,Y)={Low,High}]
; ^^^^^---------- ;<<< Because of bug in FMULT, ... >>>
; ---------------------- ;Advance Pointer to Next Coefficient:
EF8C: A5 AD LDA SERPTR ;Get Pointer to Series Data, Low
EF8E: A4 AE LDY SERPTR+1 ;Get Pointer to Series Data, High
EF90: 18 CLC ;Prepare for Add with Carry
EF91: 69 05 ADC #5 ;Add 5 Bytes/Coefficient
EF93: 90 01 BCC SERMAIN3 ;Branch if No Carryover
EF95: C8 INY ;Advance Y-Index: Series Data Pointer, High
EF96: 85 AD SERMAIN3 STA SERPTR ;Set Pointer to Series Data, Low
EF98: 84 AE STY SERPTR+1 ;Set Pointer to Series Data, High
; ---------------------- ;Add Next Coefficient:
EF9A: 20 BE E7 JSR FADD ;Add: FAC = FAC + [(A,Y)={Low,High}]
; ---------------------- ;Point at x again:
EF9D: A9 98 LDA #TEMP2 ;Get Address of TEMP2 FAC Safe, Low
EF9F: A0 00 LDY #>TEMP2 ;Get Address of TEMP2 FAC Safe, High
; ---------------------- ;If Series Not Done, Add Another Term:
EFA1: C6 A3 DEC SERLEN ;Reduce Series Length
EFA3: D0 E4 BNE SERMAIN2 ;LOOP Until Done
EFA5: 60 BAS_RTS24 RTS ;Return to Caller
; ==============================================================================
; RND Floating-Point Numbers (Packed FAC Constants)
; ==============================================================================
; <<< The missing fifth bytes here account for a known bug in RND >>>
; ------------------------------------------------------------------------------
;
EFA6: 98 35 44 7A CON_RND1 HEX 9835447A ;<<< Missing one byte for a FP value! >>>
EFAA: 68 28 B1 46 CON_RND2 HEX 6828B146 ;<<< Missing one byte for a FP value! >>>
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; CON_RND1 HEX 9835447A |(00) |$98-$80=$18=+24 |$.35447A68 |+3.49093841e+6
; | | Taken as a 32-bit Integer: -1,741,339,526
; ----------------------------|-----|----------------|-----------|--------------
; CON_RND2 HEX 6828B146 |(00) |$68-$80=$E8=-24 |$.28B14620 |+9.47445545e-9
; | | Taken as a 32-bit Integer: +1,747,497,286
; ------------------------------------------------------------------------------
; Since these are missing one byte each for a FP value, \
; I am using the next byte in sequence for the final byte of each "$.mantissa"!
; ------------------------------------------------------------------------------
; * FACSIGN msb must be set ($80-$FF) to print a minus sign before a result #.
; ==============================================================================
;
;
; ==============================================================================
; "RND" Random Number Function: Immediate & Deferred; Parameter: RND (Aexpr);
; Returns a Random Real Number between Zero & One: RND(Aexpr)=[(0)=<(RND#)<(1)]
; ==============================================================================
;
EFAE: 20 82 EB RND JSR SIGN ;FAC Sign (Neg|0|Pos) Returns (A)=(-1|0|1)
EFB1: AA TAX ;Save Sign of FAC (as Potential RND Seed)
EFB2: 30 18 BMI RNDFACNEG ;Branch if Sign of FAC (Seed) is Negative
; ---------------------- ;Else, Move Current RND Seed into FAC:
EFB4: A9 C9 LDA #RNDSEED ;Get Pointer to FP Random Number Seed, Low
EFB6: A0 00 LDY #>RNDSEED ;Get Pointer to FP Random Number Seed, High
EFB8: 20 F9 EA JSR UPAY2FAC ;Unpack FP# at [(A,Y)={Low,High}] into FAC
EFBB: 8A TXA ;Retrieve Sign of FAC (Potential RND Seed)
; ---------------------- ;EXIT if RND(0):
EFBC: F0 E7 BEQ BAS_RTS24 ;Branch if FAC=0, Return Seed=0 Unchanged
; ----------------------------------- ;Else, Do Random Number Function:
; ;<<< "Very Poor RND Algorithm"--BS-C >>>
; ---------------------- ;Mix It Up!
EFBE: A9 A6 LDA #<CON_RND1 ;Get RND FP Number Constant #1, Low
EFC0: A0 EF LDY #>CON_RND1 ;Get RND FP Number Constant #1, High
; --------------- ;<<< BUG: Constants are Truncated >>>
EFC2: 20 7F E9 JSR FMULT ;Multiply: FAC = FAC * [(A,Y)={Low,High}]
; ^^^^^---------- ;<<< Because of bug in FMULT, ... >>>
; ---------------------- ;Mix It Up More!
EFC5: A9 AA LDA #<CON_RND2 ;Get RND FP Number Constant #2, Low
EFC7: A0 EF LDY #>CON_RND2 ;Get RND FP Number Constant #2, High
; --------------- ;<<< BUG: Constants are Truncated; & Due
; ;to Small Exponent, JSR Does Nothing: >>>
EFC9: 20 BE E7 JSR FADD ;Add: FAC = FAC + [(A,Y)={Low,High}]
; ---------------------- ;Mix It Up More Still!
; ;Swap Most & Least Significant Bytes:
EFCC: A6 A1 RNDFACNEG LDX FAC+4 ;Get FAC Mantissa, Low
EFCE: A5 9E LDA FAC+1 ;Get FAC Mantissa, Top
EFD0: 85 A1 STA FAC+4 ;Set FAC Mantissa, Low
EFD2: 86 9E STX FAC+1 ;Set FAC Mantissa, Top
; ---------------------- ;Take Absolute Value; Make It Positive:
EFD4: A9 00 LDA #0 ;Clear Accumulator
EFD6: 85 A2 STA FACSIGN ;Clear FAC Unpacked Sign (msb)
; ---------------------- ;Setup Extra Bit "Randomly":
EFD8: A5 9D LDA FAC ;Get FAC Exponent
EFDA: 85 AC STA FACEXT ;Set FAC Extra Precision Byte
EFDC: A9 80 LDA #$80 ;Adjust Range: Set FACX to be between 0 & 1
EFDE: 85 9D STA FAC ;Set FAC Exponent
EFE0: 20 2E E8 JSR NRMLZFAC2 ;Normalize Value in FAC
; ---------------------- ;Move FAC To RND Number Seed:
EFE3: A2 C9 LDX #RNDSEED ;Get Pointer to FP Random Number Seed, Low
EFE5: A0 00 LDY #>RNDSEED ;Get Pointer to FP Random Number Seed, High
EFE7: 4C 2B EB GO_MOVMF JMP FACRND2XY ;Pack FAC (Rounded) into [(X,Y)={Low,High}]
; ==============================================================================
; "COS" Cosine Function: Immediate & Deferred; Parameter: COS (Aexpr);
; Returns the Cosine of (Aexpr) Radians; Computes COS(FAC)=SIN(FAC+pi/2)
; ==============================================================================
; XY-Coordinates: [Background]
; Y=SIN[(+|-)Angle],X=COS[(+|-)Angle]
; X=SIN[pi/2-[(+|-)Angle]]
; X=SIN[pi/2 (-|+) Angle], so COS(FAC)=SIN(FAC+pi/2) is OK!
; ==============================================================================
; <<< Because of BUG in FMULT, COS(x) is off for approximately >>>
; <<< -.000000184 < x < .000000184, X not 0, and many other values >>>
; ==============================================================================
;
EFEA: A9 66 COS LDA #<PI_HALVED ;Get Pi Halved (pi/2) Coefficient, Low
EFEC: A0 F0 LDY #>PI_HALVED ;Get Pi Halved (pi/2) Coefficient, High
; ;[Full Circle = 2*pi radians =360 degrees]
; ;[ 1/4 Circle = pi/2 radians = 90 degrees]
EFEE: 20 BE E7 JSR FADD ;Add: FAC = FAC + [(A,Y)={Low,High}]
;
; ==============================================================================
; "SIN" Sine Function: Immediate & Deferred; Parameter: SIN (Aexpr);
; Returns the Sine of (Aexpr) Radians; Computes SIN(FAC)
; ==============================================================================
; XY-Coordinates: [Background]
; Y=SIN[(+|-)Angle],X=COS[(+|-)Angle]
; X=SIN[pi/2-[(+|-)Angle]]
; X=SIN[pi/2 (-|+) Angle], so COS(FAC)=SIN(FAC+pi/2) is OK!
; ==============================================================================
; <<< Because of BUG in FMULT, SIN(x) is off for x near pi/2 >>>
; <<< (but not = pi/2) and many other places >>>
; ==============================================================================
;
; ;COS Function drops in with FAC=FAC+pi/2
; ----------------------------------- ;Remove Multiples of 2*pi by Dividing &
; ;Saving Fractional Part [the Remainder]:
EFF1: 20 63 EB SIN JSR FACRND2ARG ;Copy FAC to ARG (Rounded)
EFF4: A9 6B LDA #<PI_DOUBLED ;Get Pi Doubled (2*pi) Coefficient, Low
EFF6: A0 F0 LDY #>PI_DOUBLED ;Get Pi Doubled (2*pi) Coefficient, High
; ;[Full Circle =2*pi radians =360 degrees]
EFF8: A6 AA LDX ARGSIGN ;Get ARG Unpacked Sign (msb) to use in DIV
EFFA: 20 5E EA JSR DIV ;Divide by 2*pi: FAC=ARG/[(A,Y)={Low,High}]
EFFD: 20 63 EB JSR FACRND2ARG ;Copy FAC to ARG (Rounded)
;
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
; ==============================================================================
; ROM Space ($F000-$F7FF): ROM Socket $F0 on a real Apple II Plus.
; ==============================================================================
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
;
F000: 20 23 EC JSR INT ;Get Integer Part in FAC = Float[INT(FAC)]
F003: A9 00 LDA #0 ;Clear Accumulator
F005: 85 AB STA SGNCPR ;Clear Sign Flag for Comparing
; <<< Wasted lines (above), because FSUBT (below) changes SGNCPR again! >>>
F007: 20 AA E7 JSR FSUBT ;Subtract Integer Part [FAC-INT(FAC)] to
; ;Get Fractional Part [Remainder=mod(2*pi)]
; ----------------------------------> ;Now, FAC=Angle as Fraction of Full Circle
; Circle /2|1\ |1\ |1\ ;^[Full Circle = 2*pi rads = 360 degrees]
; Folding |--+--| -> +--| -> +--| ;^[ 1/2 Circle = pi rads = 180 degrees]
; Diagram \3|4/ |4/ ;^[ 1/4 Circle = pi/2 rads = 90 degrees]
; ----------------------------------> ;Fold FAC into 1st Quad [pi/2, 0 ~90 ]:
F00A: A9 70 LDA #<QUARTER ;Get Address of Constant (1/4)=(0.25), Low
F00C: A0 F0 LDY #>QUARTER ;Get Address of Constant (1/4)=(0.25), High
; <<< There are much simpler ways to do this! >>>
F00E: 20 A7 E7 JSR FSUB ;Subtract: FAC=[(A,Y)={Low,High}]-FAC
; ;Folds Circle on 90 degree Y-Axis, Left to
; ;Right, which puts Angle from 2nd or 3rd
; ;Quad into 1st or 4th Quad, respectively
; ---------------------- ;Test & Save Sign for later unfolding:
F011: A5 A2 LDA FACSIGN ;Get FAC Unpacked Sign (msb)
F013: 48 PHA ;Push FAC Unpacked Sign (msb)
F014: 10 0D BPL SIN1 ;Branch if FACSIGN is Positive, which means
; ;Angle is OK, & is now in the 1st Quadrant
; ---------------------- ;Else, FACSIGN is Negative, which means
; ;Angle is NOT OK, it's in the 4th Quadrant
; ;Add 1/2 to Fold FAC into 1st Quadrant:
F016: 20 A0 E7 JSR FADDH ;Round Up to Add 1/2: FAC = FAC + 1/2
; ;Folds Circle on 0 degree X-Axis, Bottom
; ;to Top, which puts Angle from 4th into
; ;1st Quadrant
; ----------------------------------- ;Test Sign for unfolding:
F019: A5 A2 LDA FACSIGN ;Get FAC Unpacked Sign (msb)
F01B: 30 09 BMI SIN2 ;Branch if FACSIGN is Negative [Angle's OK]
; ---------------------- ;Else, FACSIGN is Postive [Angle's NOT OK]
F01D: A5 16 LDA SIGNFLG ;Get Trig Functions Sign Flag
; ;^[Cleared in TAN Function]
F01F: 49 FF EOR #%11111111 ;Invert Bits (Negate)
F021: 85 16 STA SIGNFLG ;Set Trig Functions Sign Flag
; ----------------------------------- ;TAN Function Entry Point to Get COS:
F023: 20 D0 EE SIN1 JSR NEGOP ;Negate Value in FAC (Invert FACSIGN Bits)
; ---------------------- ;Angle is OK, & is now in the 1st Quadrant
F026: A9 70 SIN2 LDA #<QUARTER ;Get Address of Constant (1/4)=(0.25), Low
F028: A0 F0 LDY #>QUARTER ;Get Address of Constant (1/4)=(0.25), High
F02A: 20 BE E7 JSR FADD ;Add: FAC = FAC + [(A,Y)={Low,High}]
F02D: 68 PLA ;Pull (A): FAC Unpacked Sign (msb)
; ;^[or: Trig Func's Sign Flag if from TAN]
F02E: 10 03 BPL SIN3 ;Branch if (A) is Positive
F030: 20 D0 EE JSR NEGOP ;Negate Value in FAC (Invert FACSIGN Bits)
; ----------------------------------- ;Unfolding Complete; Compute SIN:
F033: A9 75 SIN3 LDA #<POLY_SIN ;Get Address of Sin Coefficients, Low
F035: A0 F0 LDY #>POLY_SIN ;Get Address of Sin Coefficients, High
F037: 4C 5C EF JMP POLY_ODD ;Go do Standard Sin Series: Compute SIN
; ==============================================================================
; "TAN" Tangent Function: Immediate & Deferred; Parameter: TAN (Aexpr);
; Returns the Tangent of (Aexpr) Radians;
; Computes [TAN(FAC)]=[SIN(FAC)/COS(FAC)]
; ==============================================================================
;
F03A: 20 21 EB TAN JSR FACRND2TMP1 ;Save FAC Rounded in TEMP1
F03D: A9 00 LDA #0 ;Clear Accumulator
F03F: 85 16 STA SIGNFLG ;Clear Trig Functions Sign Flag [will be
; ;Toggled for 2nd or 3rd Quadrant]
F041: 20 F1 EF JSR SIN ;Get SIN(FAC)
; ---------------------- ;Store SIN at TEMP3:
F044: A2 8A LDX #TEMP3 ;Get Address of Temp FAC #3, Low
F046: A0 00 LDY #>TEMP3 ;Get Address of Temp FAC #3, High
; <<< A Strange Way to Call FACRND2XY! >>>
F048: 20 E7 EF JSR GO_MOVMF ;Pack FAC (Rounded) into [(X,Y)={Low,High}]
; ---------------------- ;Retrieve FAC:
F04B: A9 93 LDA #TEMP1 ;Get Address of Temp FAC #1, Low
F04D: A0 00 LDY #>TEMP1 ;Get Address of Temp FAC #1, High
; ---------------------- ;Compute COS:
F04F: 20 F9 EA JSR UPAY2FAC ;Unpack FP# at [(A,Y)={Low,High}] into FAC
F052: A9 00 LDA #0 ;Clear Accumulator
F054: 85 A2 STA FACSIGN ;Clear FAC Unpacked Sign (msb)
F056: A5 16 LDA SIGNFLG ;Get Trig Functions Sign Flag
; <<< A "Weird & Dangerous Way [Why?] to Get into SIN" -- BS-C >>>
F058: 20 62 F0 JSR TAN1 ;Get COS
; ---------------------- ;Retrieve SIN:
F05B: A9 8A LDA #TEMP3 ;Get Address of Temp FAC #3, Low
F05D: A0 00 LDY #>TEMP3 ;Get Address of Temp FAC #3, High
; ---------------------- ;Compute SIN/COS:
F05F: 4C 66 EA JMP FDIV ;Divide: (A,Y)-->(ARG)/(FAC)-->(FAC)
; <<< Shame, Shame! -- BS-C
; Why not just put this 'in-line' above with a JSR instead of JMP? >>>
F062: 48 TAN1 PHA ;Push Trig Functions Sign Flag
F063: 4C 23 F0 JMP SIN1 ;Go Get COS
; ==============================================================================
; Pi Coefficients (Packed FAC Constants adjusted for accuracy)
; ==============================================================================
; Pi Constant & Formulas:
; ------------------------------------------------------------------------------
; pi = ............... = 3.141592654 | 2*pi = ............ = 6.283185308
; pi = 4*ATN(1)-(1E-9) = 3.14159265 | 2*(4*ATN(1)-(1E-9)) = 6.28318530
; <> [4*ATN(1) = .... = 3.14159266] | [2*(4*ATN(1)) = .... = 6.28318532]
; ==============================================================================
;
F066: 81 49 0F DA+ PI_HALVED HEX 81490FDAA2 ;<-[Normalized]; (pi/2)
F06B: 83 49 0F DA+ PI_DOUBLED HEX 83490FDAA2 ;<-[Normalized]; (2*pi); = PI2_1 (below)
F070: 7F 00 00 00+ QUARTER HEX 7F00000000 ;<-[Normalized]; (1/4)=(0.250000000)
; ----------------------------------- ;Alternating Sin Series:
F075: 05 POLY_SIN DFB $05 ;Index: (Pi Coefficients)-1
; ----------------------------------- ;32-bit numbers, with alternating signs:
F076: 84 E6 1A 2D+ PI2_11 HEX 84E61A2D1B ;(2*pi)^11/11!
F07B: 86 28 07 FB+ PI2_9 HEX 862807FBF8 ;(2*pi)^9/9!
F080: 87 99 68 89+ PI2_7 HEX 8799688901 ;(2*pi)^7/7!
F085: 87 23 35 DF+ PI2_5 HEX 872335DFE1 ;(2*pi)^5/5!
F08A: 86 A5 5D E7+ PI2_3 HEX 86A55DE728 ;(2*pi)^3/3!
F08F: 83 49 0F DA+ PI2_1 HEX 83490FDAA2 ;<-[Normalized]; (2*pi); = PI_DOUBLED (^)
;
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_PID2 HEX 81490FDAA2 |(00) |$81-$80=$01= +1 |$.490FDAA2 |+0.57079633E+0
; (!) POS_PID2 HEX 81C90FDAA2 |(00) |$81-$80=$01= +1 |$.C90FDAA2 |+1.57079633E+0
; (!) NEG_PID2 HEX 81C90FDAA2 |(FF) |$81-$80=$01= +1 |$.C90FDAA2 |-1.57079633E+0
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_PI HEX 82490FDAA2 |(00) |$82-$80=$02= +2 |$.490FDAA2 |+1.14159265E+0
; (!) POS_PI HEX 82C90FDAA2 |(00) |$82-$80=$02= +2 |$.C90FDAA2 |+3.14159266E+0
; (!) NEG_PI HEX 82C90FDAA2 |(FF) |$82-$80=$02= +2 |$.C90FDAA2 |-3.14159266E+0
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_PIM2 HEX 83490FDAA2 |(00) |$83-$80=$03= +3 |$.490FDAA2 |+2.28318531E+0
; (!) POS_PIM2 HEX 83C90FDAA2 |(00) |$83-$80=$03= +3 |$.C90FDAA2 |+6.28318531E+0
; (!) NEG_PIM2 HEX 83C90FDAA2 |(FF) |$83-$80=$03= +3 |$.C90FDAA2 |-6.28318531E+0
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_QTR HEX 7F00000000 |(00) |$7F-$80=$FF= -1 |$.00000000 |+2.50000000E-1
; (!) POS_QTR HEX 7F80000000 |(00) |$7F-$80=$FF= -1 |$.80000000 |+2.50000000E-1
; (!) NEG_QTR HEX 7F80000000 |(FF) |$7F-$80=$FF= -1 |$.80000000 |-2.50000000E-1
; ------------------------------------------------------------------------------
; <<< Plugging NRM_QTR into & Printing FAC ($ED2EG) results in nothing printed!
; --Seems that when the mantissa is zero there's a problem printing numbers. >>>
; ------------------------------------------------------------------------------
; Alternating Sin Series:
; ------------------------------------------------------------------------------
; (2*pi)^11/11! = ((2*(3.141592654))^11/(11*10*9*8*7*6*5*4*3*2)) |+1.50946426E+1
; (?) NRM_PI2B HEX 84E61A2D1B |(FF) |$84-$80=$04= +4 |$.E61A2D1B |-1.43813907E+1
; (!) POS_PI2B HEX 84661A2D1B |(00) |$84-$80=$04= +4 |$.661A2D1B |+6.38139068E+0
; (!) NEG_PI2B HEX 84661A2D1B |(FF) |$84-$80=$04= +4 |$.661A2D1B |-6.38139068E+0
; ----------------------------|-----|----------------|-----------|--------------
; (2*pi)^9/9! = ((2*(3.141592654))^9/(9*8*7*6*5*4*3*2)) = .... |+4.20586940E+1
; (?) NRM_PI29 HEX 862807FBF8 |(00) |$86-$80=$06= +6 |$.2807FBF8 |+1.00077971E+1
; (!) POS_PI29 HEX 86A807FBF8 |(00) |$86-$80=$06= +6 |$.A807FBF8 |+4.20077971E+1
; (!) NEG_PI29 HEX 86A807FBF8 |(FF) |$86-$80=$06= +6 |$.A807FBF8 |-4.20077971E+1
; ----------------------------|-----|----------------|-----------|--------------
; (2*pi)^7/7! = ((2*(3.141592654))^7/(7*6*5*4*3*2)) = ........ |+7.67058598E+1
; (?) NRM_PI27 HEX 8799688901 |(FF) |$87-$80=$07= +7 |$.99688901 |-7.67041703E+1
; (!) POS_PI27 HEX 8719688901 |(00) |$87-$80=$07= +7 |$.19688901 |+1.27041702E+1
; (!) NEG_PI27 HEX 8719688901 |(FF) |$87-$80=$07= +7 |$.19688901 |-1.27041702E+1
; ----------------------------|-----|----------------|-----------|--------------
; (2*pi)^5/5! = ((2*(3.141592654))^5/(5*4*3*2)) = ............ |+8.16052493E+1
; (?) NRM_PI25 HEX 872335DFE1 |(00) |$87-$80=$07= +7 |$.2335DFE1 |+1.76052237E+1
; (!) POS_PI25 HEX 87A335DFE1 |(00) |$87-$80=$07= +7 |$.A335DFE1 |+8.16052237E+1
; (!) NEG_PI25 HEX 87A335DFE1 |(FF) |$87-$80=$07= +7 |$.A335DFE1 |-8.16052237E+1
; ----------------------------|-----|----------------|-----------|--------------
; (2*pi)^3/3! = ((2*(3.141592654))^3/(3*2)) = ................ |+4.13417023E+1
; (?) NRM_PI23 HEX 86A55DE728 |(FF) |$86-$80=$06= +6 |$.A55DE728 |-4.13417021E+1
; (!) POS_PI23 HEX 86255DE728 |(00) |$86-$80=$06= +6 |$.255DE728 |+9.34170211E+0
; (!) NEG_PI23 HEX 86255DE728 |(FF) |$86-$80=$06= +6 |$.255DE728 |-9.34170211E+0
; ----------------------------|-----|----------------|-----------|--------------
; (2*pi) = (2*(3.141592654)) = .......................... |+6.28318531E+0
; (?) NRM_PI21 HEX 83490FDAA2 |(00) |$83-$80=$03= +3 |$.490FDAA2 |+2.28318531E+0
; (!) POS_PI21 HEX 83C90FDAA2 |(00) |$83-$80=$03= +3 |$.C90FDAA2 |+6.28318531E+0
; (!) NEG_PI21 HEX 83C90FDAA2 |(FF) |$83-$80=$03= +3 |$.C90FDAA2 |-6.28318531E+0
; ------------------------------------------------------------------------------
; * FACSIGN msb must be set ($80-$FF) to print a minus sign before a result #.
; ==============================================================================
;
;
; ==============================================================================
; HIDDEN EASTER EGG by James P. Davis
; ==============================================================================
; Supposedly, this proves that Applesoft is a Bill Gates / Microsoft product:
; ------------------------------------------------------------------------------
; Easter Egg = "MICROSOFT!" Backward
; XOR each byte with $87 to convert the character codes to ASCII
; ------------------------------------------------------------------------------
; [$A6 D3 C1 C8 D4 C8 D5 C4 CE CA] XOR $87 = ASCII: "!TFOSORCIM";
; [$CA CE C4 D5 C8 D4 C8 C1 D3 A6] XOR $87 = ASCII: "MICROSOFT!":
; ------------------------------------------------------------------------------
; $A6 D3 C1 C8 D4 C8 D5 C4 CE CA reversed is $CA CE C4 D5 C8 D4 C8 C1 D3 A6
; ============================== <----+----> ==============================
; $A6 XOR $87 = $21 = 33 = "!" \\\\\|///// $CA XOR $87 = $4D = 77 = "M"
; $D3 XOR $87 = $54 = 84 = "T" \\\\|//// $CE XOR $87 = $49 = 73 = "I"
; $C1 XOR $87 = $46 = 70 = "F" \\\|/// $C4 XOR $87 = $43 = 67 = "C"
; $C8 XOR $87 = $4F = 79 = "O" \\|// $D5 XOR $87 = $52 = 82 = "R"
; $D4 XOR $87 = $53 = 83 = "S" A \|/ | $C8 XOR $87 = $4F = 79 = "O"
; $C8 XOR $87 = $4F = 79 = "O" | /|\ V $D4 XOR $87 = $53 = 83 = "S"
; $D5 XOR $87 = $52 = 82 = "R" //|\\ $C8 XOR $87 = $4F = 79 = "O"
; $C4 XOR $87 = $43 = 67 = "C" ///|\\\ $C1 XOR $87 = $46 = 70 = "F"
; $CE XOR $87 = $49 = 73 = "I" ////|\\\\ $D3 XOR $87 = $54 = 84 = "T"
; $CA XOR $87 = $4D = 77 = "M" /////|\\\\\ $A6 XOR $87 = $21 = 33 = "!"
; ------------------------------------------------------------------------------
; See: "Bill Gates' Personal Easter Eggs in 8 Bit BASIC"
; <https://www.pagetable.com/?p=43>
; ==============================================================================
; <<< THE NEXT TEN BYTES ARE NEVER REFERENCED >>>
; <<<<<<<< You can change them in (Apple II Plus) Emulator ROM images! >>>>>>>>>
; ==============================================================================
;
F094: A6 D3 C1 C8+ EASTER_EGG1 HEX A6D3C1C8D4 ;XOR $87 = ASCII: "!TFOS"
F099: C8 D5 C4 CE+ EASTER_EGG0 HEX C8D5C4CECA ;XOR $87 = ASCII: "ORCIM"
; ==============================================================================
; "ATN" Arctangent Function: [ARCTAN(FAC)]
; ==============================================================================
; A Modified Gregory Series is used here. (Gregory converges too slowly!)
; ------------------------------------------------------------------------------
; Gregory's Series (published first by Leibniz) is one of the series which, when
; summed to infinity, yields a value of pi [pi=4*ATN(1)-(1E-9)=3.141592654...]:
; pi=4*ATN(1)=4*[1-(1/3)+(1/5)-(1/7)+(1/9)-...+((-1)^(n-1))/(2n-1){+/-}...]
; ------------------------------------------------------------------------------
; pi/4=ATN(1)=4*[1-(1/3)+(1/5)-(1/7)+(1/9)-...+((-1)^(n-1))/(2n-1){+/-}...]/4
; =4*[(1/4)-(1/12)+(1/20)-(1/28)+(1/36)-...+((-1)^(n-1))/(8n-4){+/-}...]
; ------------------------------------------------------------------------------
; pi/8=ATN(1)/2=4*[1-(1/3)+(1/5)-(1/7)+(1/9)-...+((-1)^(n-1))/(2n-1){+/-}...]/8
; =4*[(1/8)-(1/24)+(1/40)-(1/56)+(1/72)-...+((-1)^(n-1))/(16n-8){+/-}...]
; ==============================================================================
;
F09E: A5 A2 ATN LDA FACSIGN ;Fold the Argument Range first:
F0A0: 48 PHA ;Save FAC Sign for later unfolding
F0A1: 10 03 BPL ATN_1 ;BGE: If Not Negative; Else, Complement:
F0A3: 20 D0 EE JSR NEGOP ;Negate Value in FAC (Invert FACSIGN Bits)
F0A6: A5 9D ATN_1 LDA FAC ;If x >= 1, Form Reciprocal; (x = FACEXP)
F0A8: 48 PHA ;Save for later unfolding
F0A9: C9 81 CMP #$81 ;(Exp for FAC >= 1) Normalize between 0 & 1
F0AB: 90 07 BCC ATN_2 ;BLT: If x < 1, Skip:
F0AD: A9 13 LDA #<CON_ONE ;Form Reciprocal (1/x)
F0AF: A0 E9 LDY #>CON_ONE ;The Number One (1), Normalized
F0B1: 20 66 EA JSR FDIV ;Divide: (A,Y)-->(ARG)/(FAC)-->(FAC)
; ; 0 <= x <= 1
; ; 0 <= ATN(x) <= PI/8
F0B4: A9 CE ATN_2 LDA #<POLYATN ;Compute Polynomial Approximation
F0B6: A0 F0 LDY #>POLYATN ;using Polynomial ATN Coeficients:
F0B8: 20 5C EF JSR POLY_ODD ;Calc: ax+bx^3+cx^5+...; Coef's: ...c,b,a.
F0BB: 68 PLA ;Start to unfold:
F0BC: C9 81 CMP #$81 ;(Exp for FAC >= 1) Was x >= 1?
F0BE: 90 07 BCC ATN_3 ;BLT: NO, x < 1, Skip:
F0C0: A9 66 LDA #<PI_HALVED ;YES, Compensate for Normalization,
F0C2: A0 F0 LDY #>PI_HALVED ;Subtract from pi/2:
F0C4: 20 A7 E7 JSR FSUB ;Subtract: (A,Y)-->(ARG)-(FAC)-->(FAC)
F0C7: 68 ATN_3 PLA ;Was FACSIGN Negative?
F0C8: 10 03 BPL BAS_RTS25 ;BGE: NO, FACSIGN is Positive; Skip next:
F0CA: 4C D0 EE JMP NEGOP ;Negate Value in FAC (Invert FACSIGN Bits)
F0CD: 60 BAS_RTS25 RTS ;Return to Caller
NOTE: Polynomial ATN Coeficients? Still a Mystery!
; ==============================================================================
; Polynomial ATN Coeficients (Packed FAC Constants adjusted for accuracy)
; ==============================================================================
; A Modified Gregory Series is used here. (Gregory converges too slowly!)
; ------------------------------------------------------------------------------
; Gregory's Series (published first by Leibniz) is one of the series which, when
; summed to infinity, yields a value of pi [pi=4*ATN(1)-(1E-9)=3.141592654...]:
; pi=4*ATN(1)=4*[1-(1/3)+(1/5)-(1/7)+(1/9)-...+((-1)^(n-1))/(2n-1){+/-}...]
; ------------------------------------------------------------------------------
; pi/4=ATN(1)=4*[1-(1/3)+(1/5)-(1/7)+(1/9)-...+((-1)^(n-1))/(2n-1){+/-}...]/4
; =4*[(1/4)-(1/12)+(1/20)-(1/28)+(1/36)-...+((-1)^(n-1))/(8n-4){+/-}...]
; ------------------------------------------------------------------------------
; pi/8=ATN(1)/2=4*[1-(1/3)+(1/5)-(1/7)+(1/9)-...+((-1)^(n-1))/(2n-1){+/-}...]/8
; =4*[(1/8)-(1/24)+(1/40)-(1/56)+(1/72)-...+((-1)^(n-1))/(16n-8){+/-}...]
; ==============================================================================
; Q1: Do these
; Polynomial ATN Coeficients [POLYATN (Alternating ATN Series)] (below)
; have simple formulas like the
; Pi Coefficients [POLY_SIN (Alternating SIN Series)] (above) have?
; Q2: What is the Modification to the Gregory Series used here?
; Q3: -- A distributed divide by 4 or by 8, more or less, or something else?
; Q4: Do these numbers represent the fractions in the alternating series?
; Q5: How are these coeficients adjusted for accuracy?
; ------------------------------------------------------------------------------
; I am looking for a pattern (mathematical equation for each coeficient) here;
; This is all I have deduced so far: vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv -- JPD
; ==============================================================================
;
F0CE: 0B POLYATN DFB 11 ;Index: (Polynomial ATN Coeficients)-1
; -----------------------------------------------------------------------------
; vvvvvvvv ;32-bit numbers, with alternating signs:
; vvvvvvvvvv ;[All are Adjusted then Normalized]
; ------------------------------------------------------------------------------
; ;n=12: [+((-1)^(n-1))/(2n-1) = -1/23]:
F0CF: 76 B3 83 BD+ POLYATN_C HEX 76B383BDD3 ;-1.96512662E-4 =~ -(1/5089)
; ;-----------------------------------------
; ;n=11: [+((-1)^(n-1))/(2n-1) = +1/21]:
F0D4: 79 1E F4 A6+ POLYATN_B HEX 791EF4A6F5 ;+4.85094216E-3 =~ +(1/206)
; ;-----------------------------------------
; ;n=10: [+((-1)^(n-1))/(2n-1) = -1/19]:
F0D9: 7B 83 FC B0+ POLYATN_A HEX 7B83FCB010 ;-4.86701843E-4 =~ -(1/2055)
; ;-----------------------------------------
; ;n=9: [+((-1)^(n-1))/(2n-1) = +1/17]:
F0DE: 7C 0C 1F 67+ POLYATN_9 HEX 7C0C1F67CA ;+3.42096380E-2 =~ +(1/29)
; ;-----------------------------------------
; ;n=8: [+((-1)^(n-1))/(2n-1) = -1/15]:
F0E3: 7C DE 53 CB+ POLYATN_8 HEX 7CDE53CBC1 ;-2.30291328E-2 =~ -(1/43)
; ;-----------------------------------------
; ;n=7: [+((-1)^(n-1))/(2n-1) = +1/13]:
F0E8: 7D 14 64 70+ POLYATN_7 HEX 7D1464704C ;+7.24571965E-2 =~ +(1/14)
; ;-----------------------------------------
; ;n=6: [+((-1)^(n-1))/(2n-1) = -1/11]:
F0ED: 7D B7 EA 51+ POLYATN_6 HEX 7DB7EA517A ;-2.73023954E-2 =~ -(1/37)
; ;-----------------------------------------
; ;n=5: [+((-1)^(n-1))/(2n-1) = +1/9]:
F0F2: 7D 63 30 88+ POLYATN_5 HEX 7D6330887E ;+1.10932413E-1 =~ +(1/9)
; ;-----------------------------------------
; ;n=4: [+((-1)^(n-1))/(2n-1) = -1/7]:
F0F7: 7E 92 44 99+ POLYATN_4 HEX 7E9244993A ;-1.78398077E-2 =~ -(1/56) = -1/(7*8)
; ;-----------------------------------------
; ;n=3: [+((-1)^(n-1))/(2n-1) = +1/5]:
F0FC: 7E 4C CC 91+ POLYATN_3 HEX 7E4CCC91C7 ;+1.99999120E-1 =~ +(1/5)
; ;-----------------------------------------
; ;n=2: [+((-1)^(n-1))/(2n-1) = -1/3]:
F101: 7F AA AA AA+ POLYATN_2 HEX 7FAAAAAA13 ;-8.33333157E-2 =~ -(1/12) = -1/(3*4)
; ; = -((1/8)-(1/24))
; ;-----------------------------------------
; ;n=1: [+((-1)^(n-1))/(2n-1) = +1]:
F106: 81 00 00 00+ POLYATN_1 HEX 8100000000 ;The Number One (1), again!
; ------------------------------------------------------------------------------
; Plugging into & Printing FAC ($ED2EG)
; ------------------------------------------------------------------------------
; FAC Signed Exponents have had $80 added & binary Mantissa msb is sign bit:
; %(1.s)xxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx,xxxx <--(32 bits)
; ------------------------------------------------------------------------------
; Plug into & Print FAC |FAC- | Exponent |$.Mantissa |sn Scientific
; ($ED2EG)* vvvvvvvvvv |SIGN | Hex Dec | | Notation Dec
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATNC HEX 76B383BDD3 |(FF) |$76-$80=$F6=-10 |$.B383BDD3 |-6.84793912E-4
; (!) POS_ATNC HEX 763383BDD3 |(00) |$76-$80=$F6=-10 |$.3383BDD3 |+1.96512662E-4
; (!) NEG_ATNC HEX 763383BDD3 |(FF) |$76-$80=$F6=-10 |$.3383BDD3 |-1.96512662E-4
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATNB HEX 791EF4A6F5 |(00) |$79-$80=$F9= -7 |$.1EF4A6F5 |+9.44692156E-4
; (!) POS_ATNB HEX 799EF4A6F5 |(00) |$79-$80=$F9= -7 |$.9EF4A6F5 |+4.85094216E-3
; (!) NEG_ATNB HEX 799EF4A6F5 |(FF) |$79-$80=$F9= -7 |$.9EF4A6F5 |-4.85094216E-3
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATNA HEX 7B83FCB010 |(FF) |$7B-$80=$FB= -5 |$.83FCB010 |-1.61117018E-6
; (!) POS_ATNA HEX 7B03FCB010 |(00) |$7B-$80=$FB= -5 |$.03FCB010 |+4.86701843E-4
; (!) NEG_ATNA HEX 7B03FCB010 |(FF) |$7B-$80=$FB= -5 |$.03FCB010 |-4.86701843E-4
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATN9 HEX 7C0C1F67CA |(00) |$7C-$80=$FC= -4 |$.0C1F67CA |+2.95963805E-3
; (!) POS_ATN9 HEX 7C8C1F67CA |(00) |$7C-$80=$FC= -4 |$.8C1F67CA |+3.42096380E-2
; (!) NEG_ATN9 HEX 7C8C1F67CA |(FF) |$7C-$80=$FC= -4 |$.8C1F67CA |-3.42096380E-2
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATN8 HEX 7CDE53CBC1 |(FF) |$7C-$80=$FC= -4 |$.DE53CBC1 |-5.42791328E-2
; (!) POS_ATN8 HEX 7C5E53CBC1 |(00) |$7C-$80=$FC= -4 |$.5E53CBC1 |+2.30291328E-2
; (!) NEG_ATN8 HEX 7C5E53CBC1 |(FF) |$7C-$80=$FC= -4 |$.5E53CBC1 |-2.30291328E-2
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATN7 HEX 7D1464704C |(00) |$7D-$80=$FD= -3 |$.1464704C |+9.95719654E-3
; (!) POS_ATN7 HEX 7D9464704C |(00) |$7D-$80=$FD= -3 |$.9464704C |+7.24571965E-2
; (!) NEG_ATN7 HEX 7D9464704C |(FF) |$7D-$80=$FD= -3 |$.9464704C |-7.24571965E-2
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATN6 HEX 7DB7EA517A |(FF) |$7D-$80=$FD= -3 |$.B7EA517A |-8.98023954E-2
; (!) POS_ATN6 HEX 7D37EA517A |(00) |$7D-$80=$FD= -3 |$.37EA517A |+2.73023954E-2
; (!) NEG_ATN6 HEX 7D37EA517A |(FF) |$7D-$80=$FD= -3 |$.37EA517A |-2.73023954E-2
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATN5 HEX 7D6330887E |(00) |$7D-$80=$FD= -3 |$.6330887E |+4.84324134E-2
; (!) POS_ATN5 HEX 7DE330887E |(00) |$7D-$80=$FD= -3 |$.E330887E |+1.10932413E-1
; (!) NEG_ATN5 HEX 7DE330887E |(FF) |$7D-$80=$FD= -3 |$.E330887E |-1.10932413E-1
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATN4 HEX 7E9244993A |(FF) |$7E-$80=$FE= -2 |$.9244993A |-1.42839808E-1
; (!) POS_ATN4 HEX 7E1244993A |(00) |$7E-$80=$FE= -2 |$.1244993A |+1.78398077E-2
; (!) NEG_ATN4 HEX 7E1244993A |(FF) |$7E-$80=$FE= -2 |$.1244993A |-1.78398077E-2
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATN3 HEX 7E4CCC91C7 |(00) |$7E-$80=$FE= -2 |$.4CCC91C7 |+7.49991205E-2
; (!) POS_ATN3 HEX 7ECCCC91C7 |(00) |$7E-$80=$FE= -2 |$.CCCC91C7 |+1.99999120E-1
; (!) NEG_ATN3 HEX 7ECCCC91C7 |(FF) |$7E-$80=$FE= -2 |$.CCCC91C7 |-1.99999120E-1
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATN2 HEX 7FAAAAAA13 |(FF) |$7F-$80=$FF= -1 |$.AAAAAA13 |-3.33333316E-1
; (!) POS_ATN2 HEX 7F2AAAAA13 |(00) |$7F-$80=$FF= -1 |$.2AAAAA13 |+8.33333157E-2
; (!) NEG_ATN2 HEX 7F2AAAAA13 |(FF) |$7F-$80=$FF= -1 |$.2AAAAA13 |-8.33333157E-2
; ----------------------------|-----|----------------|-----------|--------------
; (?) NRM_ATN1 HEX 8100000000 |(00) |$81-$80=$01= +1 |$.00000000 |+1.00000000E+0
; (!) POS_ATN1 HEX 8180000000 |(00) |$81-$80=$01= +1 |$.80000000 |+1.00000000E+0
; (!) NEG_ATN1 HEX 8180000000 |(FF) |$81-$80=$01= +1 |$.80000000 |-1.00000000E+0
; ------------------------------------------------------------------------------
; <<< Plugging NRM_ATN1 into & Printing FAC ($ED2EG) results in BLANK LINE!
; --Seems that when the mantissa is zero there's a problem printing numbers. >>>
; ------------------------------------------------------------------------------
; * FACSIGN msb must be set ($80-$FF) to print a minus sign before a result #.
; ==============================================================================
;
;
; ==============================================================================
; GENERIC CHRGET [See it here!]
; ==============================================================================
; Generic copy of CHRGET/CHRGOT subroutine, which is copied into $00B1...$00C8
; during initialization
; ==============================================================================
; Cornelis Bongers described several improvements to CHRGET in Micro Magazine or
; Call-A.P.P.L.E. (I don't remember which or exactly when) -- BS-C
; ==============================================================================
;
F10B: E6 B8 GENCHRGET INC TXTPTR ;Advance Next Char/Token Pointer, Low
F10D: D0 02 BNE GENCHRGOT ;Skip Advancing Pointer, High
F10F: E6 B9 INC TXTPTR+1 ;Advance Next Char/Token Pointer, High
F111: AD 60 EA GENCHRGOT LDA NON_SEQUITUR ;NON_SEQUITUR is TXTPTR in Zero-Page
; ------------------------------------------------------------------------------
; Clear Carry if Numeric, Set Carry if Not Numeric, & leave A-Reg as found:
; ------------------------------------------------------------------------------
F114: C9 3A CMP #':' ;Is A-Reg a Number, a Colon/EOS, EOL/EOP?
F116: B0 0A BCS GENCGRTS ;BGE: Return Carry Set if Not a Number &
; ; Z-Flag Set if a Colon/EOS or EOL/EOP
; ;-----------------------------------------
; ;[This should've been 1st after CHRGOT!]:
F118: C9 20 CMP #' ' ;Is A-Reg a Space Character?
F11A: F0 EF BEQ GENCHRGET ;YES, Ignore it; Get Next Character/Token
; ;-----------------------------------------
F11C: 38 SEC ;Prep to Subtract w/o Borrow [A-Data-!C]
F11D: E9 30 SBC #'0' ;Subtract Low ASCII Zero ('0') Character
F11F: 38 SEC ;Prep to Subtract w/o Borrow [A-Data-!C]
F120: E9 D0 SBC #$D0 ;Subtract $100-'0' Lo-ASCII Zero Character
; ------------------------------------------------------------------------------
F122: 60 GENCGRTS RTS ;Return to Caller
; ==============================================================================
; Randome Number Seed: Initial value for random number, also copied in along
; with CHRGET, but erroneously: <<< BUG: The last byte is not copied >>>
; ==============================================================================
F123: 80 4F C7 52+ RND_SEED HEX 804FC75258 ;Approximately = .811635157
; ==============================================================================
; GENERIC.END & COLD.START [*]=[(A,Y)={Low,High}]
; ==============================================================================
F128: A2 FF COLD_START LDX #$FF ;Initialize Direct Mode:
F12A: 86 76 STX CURLIN+1 ;Set Direct Mode Flag
F12C: A2 FB LDX #$FB ;Initialize Stack Pointer:
F12E: 9A TXS ;Set Stack Pointer Register [S-Reg)=(-5)]
; Upper 4 bytes of STACK used for Forward Link & Line Number in New Line Input
; ==============================================================================
; We must finish COLD_START! So, as a precaution: Set GOWARM and GOSTROUT to
; (restart) COLD_START until COLD_START is completed; then properly reset them!
; ------------------------------------------------------------------------------
; GOWARM (LOC0, LOC1 & LOC2) is setup by COLD_START, but is not used anywhere
; GOSTROUT (LOC3, LOC4 & LOC5) is setup by COLD_START, but is not used anywhere
; ------------------------------------------------------------------------------
F12F: A9 28 LDA #<COLD_START ;Get Cold Start Address, Low [*]
F131: A0 F1 LDY #>COLD_START ;Get Cold Start Address, High
F133: 85 01 STA LOC1 ;Set GOWARM+1; =LOC0+1 [*]
F135: 84 02 STY LOC1+1 ;Set GOWARM+2; =LOC0+2; =LOC1+1; =LOC2
F137: 85 04 STA LOC4 ;Set GOSTROUT+1; =LOC3+1 [*]
F139: 84 05 STY LOC4+1 ;Set GOSTROUT+2; =LOC3+2; =LOC4+1; =LOC5
F13B: 20 73 F2 JSR NORMAL ;Set Normal Display Mode
F13E: A9 4C LDA #$4C ;Set JMP OpCode for 4 Vectors:
F140: 85 00 STA LOC0 ;Set GOWARM : (LOC0, LOC1 & LOC2)
F142: 85 03 STA LOC3 ;Set GOSTROUT : (LOC3, LOC4 & LOC5)
F144: 85 90 STA JMPADRS ;Set Applesoft Jump from ZP to <Address>
F146: 85 0A STA BAS_USRVEC ;Set Applesoft USR() Command Vector (JMP)
; ;Point USR() Command Vector to Illegal
; ;Quantity Error, until User sets it up
F148: A9 99 LDA #<IQERR ;Get Print IQ-Error, Low [*]
F14A: A0 E1 LDY #>IQERR ;Get Print IQ-Error, High
F14C: 85 0B STA BAS_USRPTR ;Set USR() Command Ptr, Low [*]
F14E: 84 0C STY BAS_USRPTR+1 ;Set USR() Command Ptr, High
; ------------------------------------------------------------------------------
; Copy CHRGET subroutine & RND Seed to Zero-Page ($B1-$CC) [NOT last byte ($CD)]
; ------------------------------------------------------------------------------
F150: A2 1C LDX #$1C ;COLD_START-GENCHRGET-1=$1C=28 [is WRONG!]
; <<< BUG: Should be COLD_START-GENCHRGET=$1D=29! Includes RND_SEED! >>>
F152: BD 0A F1 CPYCHRGET LDA GENCHRGET-1,X ;Get a Byte; <<< No -1 would fix BUG & >>>
F155: 95 B0 STA $B0,X ;Set a Byte; <<< No -1 would fix BUG ! >>>
F157: 86 F1 STX SPDBYT ;Initialize Speed (on last pass SPDBYT = 1)
; ;Serves as clue to where (which iteration)
; ;if loop fails to complete (is inerupted)!
F159: CA DEX ;Count Down
F15A: D0 F6 BNE CPYCHRGET ;Loop Until Done; <<< BPL would fix BUG >>>
; ------------------------------------------------------------------------------
F15C: 86 F2 STX TRCFLG ;Set NOTRACE (X-Reg=0)
F15E: 8A TXA ;Reset A-Reg to Zero, too (from X-Reg)
F15F: 85 A4 STA SHFTSGNX ;Clear Sign Extension Right Shifter
; ; (holds 0 except in INT routine)
F161: 85 54 STA LASTPT+1 ;Clear Last Used Temp String Pointer, High
; ------------------------------------------------------------------------------
F163: 48 PHA ;Push a Zero onto STACK at $1FB; The Zero
; here signifies the Start of a New Input Line to Parse or the Start of a New
; Program for the first Input Line, but it's never moved, copied, or used for
; anything more than the target of the LINEIMAGE (Indexed Addressing) Pointer!
; ------------------------------------------------------------------------------
F164: A9 03 LDA #3 ;Get 3 to set TSD Length:
F166: 85 8F STA DSCLEN ;Set Temporary String Descriptor Length
F168: 20 FB DA JSR CRDO ;Print a Carriage <Return> Character
; ----------------------------------- ;Setup Fake Forward Link:
F16B: A9 01 LDA #$01 ;Initialize Input Line's Next Line Pointer
F16D: 8D FD 01 STA IMGNXLNPTR+1 ;Set Input Line's Next Line Pointer, High
F170: 8D FC 01 STA IMGNXLNPTR ;Set Input Line's Next Line Pointer, Low
F173: A2 55 LDX #TEMPST ;Holds up to 3 Descriptors [($55~$5D)=(9B)]
F175: 86 52 STX TEMPPT ;Set SD Stack: Next Temp Descriptor Pointer
; ==============================================================================
; Find High End of RAM: [*]=[(A,Y)={Low,High}]
; ==============================================================================
; ;Setup Pointer to Low End of RAM:
F177: A9 00 LDA #<PRGMEM ;Get Start of Program Memory, Low (=0) [*]
F179: A0 08 LDY #>PRGMEM ;Get Start of Program Memory, High
F17B: 85 50 STA LINNUM ;Set Memory Scan Pointer, Low, for Zip! [*]
F17D: 84 51 STY LINNUM+1 ;Set Memory Scan Pointer, High, for Paging
; ------------------------------------------------------------------------------
; Test First Byte of each Page until ROM or an Empty Ram Socket is Found:
; ------------------------------------------------------------------------------
F17F: A0 00 LDY #$00 ;Set for Indirect Addressing of Mem Pages
F181: E6 51 FNDMEM INC LINNUM+1 ;Incement Memory Scan Paging Pointer
F183: B1 50 LDA (LINNUM),Y ;Test 1st.Byte on Page
F185: 49 FF EOR #%11111111 ;Invert Bits: Test if RAM|ROM|MT-RAM-SKT
F187: 91 50 STA (LINNUM),Y ;Can change RAM
F189: D1 50 CMP (LINNUM),Y ;Cannot change ROM/MT-RAM-SKT
F18B: D0 08 BNE MEMFND ;ROM/MT-RAM-SKT found!
F18D: 49 FF EOR #%11111111 ;Invert Bits: Put back in RAM as found
F18F: 91 50 STA (LINNUM),Y ;Can change/fix RAM
F191: D1 50 CMP (LINNUM),Y ;Cannot change/fix ROM/MT-RAM-SKT
F193: F0 EC BEQ FNDMEM ;Test & Fix RAM until ROM/MT-RAM-SKT found
; ------------------------------------------------------------------------------
; ROM or an empty RAM socket has been Found; Initialize All for a NEW Program:
; ------------------------------------------------------------------------------
; ; Assure RAM is a multiple of 4 KB
; ;(bad RAM may've yielded a non-multiple):
; ; ------ [*]=[(Y,A)={Low,High}] ------- v
; ; ^[opposite of normal]^ v
F195: A4 50 MEMFND LDY LINNUM ;Get Memory Scan Pointer, Low (=0) [*]
F197: A5 51 LDA LINNUM+1 ;Get Memory Scan Pointer, High
F199: 29 F0 AND #$F0 ;Keep High Nibble and Zero Low Nibble
F19B: 84 73 STY MEMSIZ ;Set End of String Space (HIMEM), Low [*]
F19D: 85 74 STA MEMSIZ+1 ;Set End of String Space (HIMEM), High
F19F: 84 6F STY FRETOP ;Set Top of Free Space, Low [*]
F1A1: 85 70 STA FRETOP+1 ;Set Top of Free Space, High
; ;^(AKA: Bottom or Start of String Space)
; ;That Resets String-Storage (FRETOP=HIMEM)
; ;-----------------------------------------
; ; Reset Start of Program (Ptr) to $800:
; ; ------ [*]=[(X,Y)={Low,High}] ------- v
F1A3: A2 00 LDX #<PRGMEM ;Get Start of Program Memory, Low (=0) [*]
F1A5: A0 08 LDY #>PRGMEM ;Get Start of Program Memory, High (=8)
F1A7: 86 67 STX TXTTAB ;Set Start of Program Pointer, Low [*]
F1A9: 84 68 STY TXTTAB+1 ;Set Start of Program Pointer, High
; ;-----------------------------------------
F1AB: A0 00 LDY #$00 ;Both Index Registers (X & Y) are now Zero
F1AD: 84 D6 STY AUTORUN ;Initialize Lock Byte; Turn Off Auto-Run
F1AF: 98 TYA ;The Accumulator Register is now Zero
F1B0: 91 67 STA (TXTTAB),Y ;Start of Program ($800) is now Zero
F1B2: E6 67 INC TXTTAB ;Point at $801 as Start of Program
F1B4: D0 02 BNE INITPRGM ;Skip High Byte; Always Happens
F1B6: E6 68 INC TXTTAB+1 ;Never Happens <-\-< [Wasted 4 Bytes Here!]
; Continue to Initialize for a NEW Program: [*]=[(A,Y)={Low,High}]
F1B8: A5 67 INITPRGM LDA TXTTAB ;Get Start of Program Pointer, Low (=1) [*]
F1BA: A4 68 LDY TXTTAB+1 ;Get Start of Program Pointer, High (=8)
F1BC: 20 E3 D3 JSR REASON ;Assure enough Arrays-to-Strings Free-Space
F1BF: 20 4B D6 JSR SCRTCH ;Initialize NEW Program
; ------------------------------------------------------------------------------
; Properly Reset GOWARM and GOSTROUT ("Wasting Prime Real Estate at 0-5!"):
; ------------------------------------------------------------------------------
; GOWARM (LOC0, LOC1 & LOC2) is setup by COLD_START, but is not used anywhere
; GOSTROUT (LOC3, LOC4 & LOC5) is setup by COLD_START, but is not used anywhere
; ------------------------------------------------------------------------------
; Setup GOSTROUT to Print the String at [(A,Y)={Low,High}] when called:
F1C2: A9 3A LDA #<STROUT ;Get String Out Routine Address, Low
F1C4: A0 DB LDY #>STROUT ;Get String Out Routine Address, High
F1C6: 85 04 STA LOC4 ;Set GOSTROUT+1; =LOC3+1
F1C8: 84 05 STY LOC4+1 ;Set GOSTROUT+2; =LOC3+2; =LOC4+1; =LOC5
; Set GOWARM to BASIC Soft/Warm/Ctrl-C [& Mon Cmd: 0G] Entry Point
F1CA: A9 3C LDA #<RESTART ;Get BASIC Warm Start Address, Low
F1CC: A0 D4 LDY #>RESTART ;Get BASIC Warm Start Address, High
F1CE: 85 01 STA LOC1 ;Set GOWARM+1; =LOC0+1
F1D0: 84 02 STY LOC1+1 ;Set GOWARM+2; =LOC0+2; =LOC1+1; =LOC2
F1D2: 6C 01 00 JMP (LOC1) ;DO WARM START
;
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
; ==============================================================================
; Applesoft - Part D, $F1D5-$F7FF: Graphics Display Routines, etc.
; ==============================================================================
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
;
;
; ==============================================================================
; "CALL" Statement: Immediate & Deferred; Parameter: CALL Aexpr;
; ==============================================================================
; Causes execution of a machine language subroutine at the memeory location
; whose decimal address is specified (Aexpr)
; ------------------------------------------------------------------------------
; Effectively: Performs a JSR to the specified address; Called routines can
; return with RTS; & Applesoft will continue with the next statement
; ------------------------------------------------------------------------------
; Note: Applesoft's CALL does not set up registers like Integer BASIC's does;
; On a CALL: Y = CALL Adrs, Low; A = CALL Adrs, High; & X = FAC Adrs ($9D)
; ==============================================================================
;
F1D5: 20 67 DD CALL JSR FRMNUM ;Evaluate & Assure Expression is Numeric
F1D8: 20 52 E7 JSR GETADR ;Convert FAC to a 16-bit Value in LINNUM
F1DB: 6C 50 00 JMP (LINNUM) ;Jump to 6502 Memory Address in Line Number
; ==============================================================================
; "IN#" Statement: Immediate & Deferred; Parameter: IN# Aexpr
; ==============================================================================
; Sets Vector to get Input from Slot Number (1~7) specified (Aexpr)
; ------------------------------------------------------------------------------
; Note: There's No Check for a Valid Slot Number; As long as the Value is < 256
; it is Accepted; But the Monitor Masks the Value to 4 Bits (0-15)
; ==============================================================================
;
F1DE: 20 F8 E6 IN_NUMBER JSR GETBYT ;Convert Expression to a Byte in X-Reg
F1E1: 8A TXA ;Get Value of Expression (0~255)
; ;Install in Character Input Hook
; ;^[Vector at KSW ($38,$39)={Low,High}]:
F1E2: 4C 8B FE JMP INPORT ;Go Set Slot for Input (Monitor S/R)
; ==============================================================================
; "PR#" Statement: Immediate & Deferred; Parameter: PR# Aexpr;
; ==============================================================================
; Sets Vector to direct Output to Slot Number (1~7) specified (Aexpr)
; ------------------------------------------------------------------------------
; Note: There's No Check for a Valid Slot Number; As long as the Value is < 256
; it is Accepted; But the Monitor Masks the Value to 4 Bits (0-15)
; ==============================================================================
;
F1E5: 20 F8 E6 PR_NUMBER JSR GETBYT ;Convert Expression to a Byte in X-Reg
F1E8: 8A TXA ;Get Value of Expression (0~255)
; ;Install in Character Output Hook
; ;^[Vector at CSW ($36,$37)={Low,High}]:
F1E9: 4C 95 FE JMP OUTPORT ;Go Set Slot for Output (Monitor S/R)
;
; ==============================================================================
; Low Resolution (Lo-Res) Graphics Subroutines
; ==============================================================================
; Lo-Res Screen SIZE is 48 or 80 by 48:
; 48 Hard-Coded below, in Apple II Plus machines;
; 48 for < Apple IIc, in machines without 80-Column Capability;
; 80 for >= Apple IIc, but coding it created a Dangerous BUG in those machines!
; [Enhanced Apple IIe is THE BEST Apple II machine! -- JPD]
; ==============================================================================
;
;
; ==============================================================================
; Cartesian Coordinator: Subroutine to Get Cartesian ("#,#") Coordinates
; ==============================================================================
; Gets Two Values < 48, with Comma Separator
; ------------------------------------------------------------------------------
; Called for PLOT X,Y; HLIN A,B at Y; & VLIN A,B at X
; ==============================================================================
;
; ----------------------------------- ;Get 1st Coordinate:
F1EC: 20 F8 E6 PLOTFNS JSR GETBYT ;Convert Expression to a Byte in X-Reg
F1EF: E0 30 CPX #SIZE ;Assure (X)<(Max Size of Lo-Res Screen)
F1F1: B0 13 BCS BAS_GOERR ;BGE: IQ ERROR if it is Not < SIZE
F1F3: 86 F0 STX FIRST ;Save 1st Lo-Res Plot Coordinate
F1F5: A9 2C LDA #',' ;Must have a Comma next
F1F7: 20 C0 DE JSR SYNCHR ;If = Chr Got, Get Next; Else, Syntax Error
; ----------------------------------- ;Get 2nd Coordinate:
F1FA: 20 F8 E6 JSR GETBYT ;Convert Expression to a Byte in X-Reg
F1FD: E0 30 CPX #SIZE ;Assure (X)<(Max Size of Lo-Res Screen)
F1FF: B0 05 BCS BAS_GOERR ;BGE: IQ ERROR if it is Not < SIZE
F201: 86 2C STX H2 ;Set Right End of Horizontal Line (HLINE)
F203: 86 2D STX V2 ;Set Bottom End of Vertical Line (VLINE)
F205: 60 RTS ;Return [(FIRST),(X=H2=V2)] to Caller
F206: 4C 99 E1 BAS_GOERR JMP IQERR ;Go Print "?Illegal Quantity" Error Message
; ==============================================================================
; Line Coordinator: Subroutine to Get Lo-Res Line ("#,# at #") Coordinates
; ==============================================================================
; Gets "A,B at C" Values < 48, with Comma & "at" Separators, for HLIN and VLIN;
; Puts Smaller of (A,B) in FIRST, and Larger of (A,B) in H2 & V2;
; Returns X-Reg = (C) Value
; ------------------------------------------------------------------------------
; Called for HLIN A,B at Y; & VLIN A,B at X
; ==============================================================================
;
F209: 20 EC F1 LINCOOR JSR PLOTFNS ;Get Cartesian ("A,B") Coordinates
F20C: E4 F0 CPX FIRST ;Is B < A? [Plot Coordinates (PC)]
F20E: B0 08 BCS LINAT ;BGE: Branch if B >= A
; ;Else, B < A; Swap (A,B) -> (B,A):
F210: A5 F0 LDA FIRST ;Get B, 2nd Lo-Res PC, & Smaller of (A,B)
F212: 85 2C STA H2 ;Set Right End of Horizontal Line (HLINE)
F214: 85 2D STA V2 ;Set Bottom End of Vertical Line (VLINE)
F216: 86 F0 STX FIRST ;Save X as 1st Lo-Res Plot Coordinate
; ;Was (A,B) -> Now (B,A)
F218: A9 C5 LINAT LDA #TOK_AT ;Get "AT" Token
F21A: 20 C0 DE JSR SYNCHR ;If = Chr Got, Get Next; Else, Syntax Error
F21D: 20 F8 E6 JSR GETBYT ;Convert Next Expression to a Byte in X-Reg
F220: E0 30 CPX #SIZE ;Assure (X)<(Max Size of Lo-Res Screen)
F222: B0 E2 BCS BAS_GOERR ;BGE: IQ ERROR if it is Not < SIZE
F224: 60 RTS ;Return to Caller
; ==============================================================================
; "PLOT" Statement: Immediate & Deferred; Parameters: PLOT Aexpr1, Aexpr2
; ==============================================================================
; Plots a Point of current COLOR at [(X,Y)={Aexpr1,Aexpr2}] on the Lo-Res Screen
; ==============================================================================
;
F225: 20 EC F1 BAS_PLOT JSR PLOTFNS ;Get Cartesian ("X,Y") Coordinates
F228: 8A TXA ;Get 2nd (Y) Coordinate
F229: A4 F0 LDY FIRST ;Get 1st (X) Coordinate
F22B: C0 28 CPY #40 ;Is 1st (X) Coordinate < 40?
F22D: B0 D7 BCS BAS_GOERR ;BGE: IQ ERROR if 1st (X) Coordinate >= 40
F22F: 4C 00 F8 JMP MON_PLOT ;Go Let Monitor Plot Point on Lo-Res Screen
; ==============================================================================
; "HLIN" Statement: Immediate & Deferred; Parms: HLIN Aexpr1, Aexpr2 AT Aexpr3
; ==============================================================================
; Draws a Horizontal Line of current COLOR on the Lo-Res Screen
; from [(X,Y)=(Aexpr1,Aexpr3)] to [(X,Y)=(Aexpr2,Aexpr3)]
; ==============================================================================
F232: 20 09 F2 HLIN JSR LINCOOR ;Get Lo-Res Line ("A,B at Y") Coordinates
F235: 8A TXA ;Get 3rd (Y) Horizontal Line Coordinate
F236: A4 2C LDY H2 ;Get Right End (B) of Horizontal Line
F238: C0 28 CPY #40 ;Is Right End (B) of Horizontal Line < 40?
F23A: B0 CA BCS BAS_GOERR ;BGE: IQ ERROR if Right End of Line >= 40
F23C: A4 F0 LDY FIRST ;Get Left End (A) of Horizontal Line
F23E: 4C 19 F8 JMP HLINE ;Go Let Monitor Draw Line on Lo-Res Screen
; ==============================================================================
; "VLIN" Statement: Immediate & Deferred; Parms: VLIN Aexpr1, Aexpr2 AT Aexpr3
; ==============================================================================
; Draws a Vertical Line of current COLOR on the Lo-Res Screen
; from [(X,Y)=(Aexpr1,Aexpr3)] to [(X,Y)=(Aexpr2,Aexpr3)]
; ==============================================================================
;
F241: 20 09 F2 VLIN JSR LINCOOR ;Get Lo-Res Line ("A,B at X") Coordinates
F244: 8A TXA ;Get 3rd (X) Vertical Column Coordinate
F245: A8 TAY ;Get Bottom End (B) of Vertical Line
F246: C0 28 CPY #40 ;Is Bottom End (B) of Vertical Line < 40?
F248: B0 BC BCS BAS_GOERR ;BGE: IQ ERROR if Bottom End of Line >= 40
F24A: A5 F0 LDA FIRST ;Get Top End (A) of Vertical Line
F24C: 4C 28 F8 JMP VLINE ;Go Let Monitor Draw Line on Lo-Res Screen
; ==============================================================================
; "COLOR=" Statement: Immediate & Deferred; Parameter: COLOR = Aexpr1
; ==============================================================================
; Set the Color for Lo-Res Plotting of Points (Dots) & Lines
; ==============================================================================
;
F24F: 20 F8 E6 COLOR JSR GETBYT ;Convert Expression to a Byte in X-Reg
F252: 8A TXA ;Get Color for Lo-Res (Dot/Line) Plotting
F253: 4C 64 F8 JMP SETCOL ;Go Let Monitor Set Color for Lo-Res Plots
;
; ==============================================================================
; Non-Graphics Subroutines
; ==============================================================================
;
;
; ==============================================================================
; "VTAB" Statement: Immediate & Deferred; Parameter: VTAB Aexpr1
; ==============================================================================
; Moves the Cursor to the Line (1~24) that is Aexpr1 Lines down the screen
; ==============================================================================
;
F256: 20 F8 E6 VTAB JSR GETBYT ;Convert Expression to a Byte in X-Reg
F259: CA DEX ;Reduce Line Number [from (1~24) to (0~23)]
F25A: 8A TXA ;Get Line Number to Check Range
F25B: C9 18 CMP #24 ;Is Line Number < 24?
F25D: B0 A7 BCS BAS_GOERR ;BGE: IQ ERROR if Line Number >= 24
F25F: 4C 5B FB JMP TABV ;Go Let Monitor Set Vertical Cursor Position
; ==============================================================================
; "SPEED=" Statement: Immediate & Deferred; Parameter: SPEED = Aexpr1
; ==============================================================================
; Sets the Speed at which Characters are to be sent to the Screen or to other
; Input/Output Devices
; ==============================================================================
;
F262: 20 F8 E6 SPEED JSR GETBYT ;Convert Expression to a Byte in X-Reg
F265: 8A TXA ;Get Input/Output Speed Specified (0~255)
F266: 49 FF EOR #%11111111 ;Invert Bits (Negate) -(0~255)
F268: AA TAX ;Get Negated I/O Speed (-255~0)
F269: E8 INX ;Advance I/O Speed [1+(-255~0)=(-254~1)]
F26A: 86 F1 STX SPDBYT ;=$100-Speed+1, So SPEED=255 is Fastest[?]
F26C: 60 RTS ;Return to Caller
; ==============================================================================
; "TRACE" Statement: Immediate & Deferred; No Parameters; Enables DeBug Mode
; ==============================================================================
;
F26D: 38 TRACE SEC ;To Set Sign Bit in TRCFLG
; ;Trace OFF/ON Flag (<128/>127)~(bit-7)
F26E: 90 DFB BCC ;Never Taken; Fake BCC to skip next OpCode
; ==============================================================================
; "NOTRACE" Statement: Immediate & Deferred; No Parameters; Disables DeBug Mode
; ==============================================================================
;
F26F: 18 NOTRACE CLC ;To Clear Sign Bit in TRCFLG
; ;Trace OFF/ON Flag (<128/>127)~(bit-7)
F270: 66 F2 ROR TRCFLG ;Shift CARRY into TRCFLG
F272: 60 RTS ;Return to Caller
; ==============================================================================
; "NORMAL" Statement: Immediate & Deferred; No Parameters
; ==============================================================================
; Sets Normal Video Input/Output Mode: White Letters on Black Background
; ==============================================================================
;
F273: A9 FF NORMAL LDA #$FF ;For INVFLG Text Mask
; ;(Normal=$FF, Flash=$7F, Inverse=$3F)
F275: D0 02 BNE NRMINV ;Always Taken
; ==============================================================================
; "INVERSE" Statement: Immediate & Deferred; No Parameters
; ==============================================================================
; Sets Inverse Video Input/Output Mode: Black Letters on White Background
; ==============================================================================
;
F277: A9 3F INVERSE LDA #$3F ;For INVFLG Text Mask
F279: A2 00 NRMINV LDX #$00 ;For FLASHBIT Text Mask
F27B: 85 32 NRMINVFLSH STA INVFLG ;Text Mask (Normal=$FF, Flash=$7F, Inverse=$3F)
F27D: 86 F3 STX FLASHBIT ;Text Mask (Flash=$40, Lowercase=$20, Else=$00)
F27F: 60 RTS ;Return to Caller
; ==============================================================================
; "FLASH" Statement: Immediate & Deferred; No Parameters
; ==============================================================================
; Sets Flashing Video Input/Output Mode: Alternating Normal (White Letters on
; Black Background) with Inverse (Black Letters on White Background) Modes
; [about two times per second]
; ==============================================================================
;
F280: A9 7F FLASH LDA #$7F ;For INVFLG Text Mask
; ;(Normal=$FF, Flash=$7F, Inverse=$3F)
F282: A2 40 LDX #$40 ;For FLASHBIT Text Mask
; ;(Flash=$40, Lowercase=$20, Else=$00)
F284: D0 F5 BNE NRMINVFLSH ;Always Taken
; ==============================================================================
; "HIMEM:" Statement: Immediate & Deferred; Parameter: HIMEM: Aexpr1
; ==============================================================================
; Sets Highest Memory Address Available to a BASIC Program, including Variables,
; to Protect Memory above IT for Data, Graphics, or Machine Language Routines;
; Automatically Set during Cold Start to Maximum RAM Memory Address in System;
; Reset by RESET CTRL-B RETURN, which also Erases Any Stored Program; Not Reset
; by CLEAR, RUN, NEW, DEL, Changing or Adding a Program Line, or RESET alone;
; Resets String Variable Pointers to Zero Difference, which is effectively the
; same as Clearing String Variables!
; ==============================================================================
;
F286: 20 67 DD HIMEM JSR FRMNUM ;Get Value Specified as 16-Bit Integer
F289: 20 52 E7 JSR GETADR ;Convert FAC to a 16-bit Value in LINNUM
; ----------------------------------- ;Is HIMEM above Variables & Arrays?
F28C: A5 50 LDA LINNUM ;Get HIMEM Value Specified, Low
F28E: C5 6D CMP STREND ;Subtract Start of Free Space, Low
F290: A5 51 LDA LINNUM+1 ;Get HIMEM Value Specified, High
F292: E5 6E SBC STREND+1 ;Subtract Start of Free Space, High
F294: B0 03 BCS SETHI ;BGE: Branch if HIMEM is above them
F296: 4C 10 D4 JMM JMP MEMERR ;ERROR if NOT, Do "?Out Of Memory" Error
; ----------------------------------- ;Store New HIMEM Value:
F299: A5 50 SETHI LDA LINNUM ;Get HIMEM Value Specified, Low
F29B: 85 73 STA MEMSIZ ;Set Top End of String Space (HIMEM), Low
F29D: 85 6F STA FRETOP ;Set Bottom End of String Space, Low
; ;^(AKA: Top of Free Space, Low)
F29F: A5 51 LDA LINNUM+1 ;Get HIMEM Value Specified, High
F2A1: 85 74 STA MEMSIZ+1 ;Set Top End of String Space (HIMEM), High
F2A3: 85 70 STA FRETOP+1 ;Set Bottom End of String Space, High
; ;^(AKA: Top of Free Space, High)
; ;That Resets String-Storage (FRETOP=HIMEM)
F2A5: 60 RTS ;Return to Caller
; ==============================================================================
; <<< HIMEM: Does Not Clear String Variables, which could be Disastrous! >>>
; ------------------------------------------------------------------------------
; But, it does Reset String Variable Pointers to Zero Difference, which is
; effectively the same as Clearing String Variables!
; ==============================================================================
;
;
; ==============================================================================
; "LOMEM:" Statement: Immediate & Deferred; Parameter: LOMEM: Aexpr1
; ==============================================================================
; Sets Lowest Memory Address Available to a BASIC Program; Automatically Set to
; End of Program, Start of Simple BASIC Variables, before Program Execution;
; Reset by NEW, DEL, & by Adding or Changing a Program Line; Reset by RESET
; CTRL-B, which also Deletes any Stored Program; Not Reset by RUN, RESET CTRL-C
; RETURN, or RESET 0G RETURN; Can Protect Variables from High-Resolution
; Graphics
; ==============================================================================
;
F2A6: 20 67 DD LOMEM JSR FRMNUM ;Get Value Specified as 16-Bit Integer
F2A9: 20 52 E7 JSR GETADR ;Convert FAC to a 16-bit Value in LINNUM
; ----------------------------------- ;Is LOMEM below HIMEM?
F2AC: A5 50 LDA LINNUM ;Get LOMEM Value Specified, Low
F2AE: C5 73 CMP MEMSIZ ;Subtract Top of String Space (HIMEM), Low
F2B0: A5 51 LDA LINNUM+1 ;Get LOMEM Value Specified, High
F2B2: E5 74 SBC MEMSIZ+1 ;Subtract Top of String Space (HIMEM), High
F2B4: B0 E0 BCS JMM ;BGE: Do "?Out Of Memory" ERROR if NOT
; ----------------------------------- ;Is LOMEM above End of Program (EOP)?
F2B6: A5 50 LDA LINNUM ;Get LOMEM Value Specified, Low
F2B8: C5 69 CMP VARTAB ;Subtract Start of Variables (EOP+1), Low
F2BA: A5 51 LDA LINNUM+1 ;Get LOMEM Value Specified, High
F2BC: E5 6A SBC VARTAB+1 ;Subtract Start of Variables (EOP+1), High
F2BE: 90 D6 BCC JMM ;BLT: Do "?Out Of Memory" ERROR if NOT
; ----------------------------------- ;Store New LOMEM Value:
F2C0: A5 50 LDA LINNUM ;Get LOMEM Value Specified, Low
F2C2: 85 69 STA VARTAB ;Set Start of Variables (EOP+1), Low
F2C4: A5 51 LDA LINNUM+1 ;Get LOMEM Value Specified, High
F2C6: 85 6A STA VARTAB+1 ;Set Start of Variables (EOP+1), High
F2C8: 4C 6C D6 JMP CLEARC ;Go Clear Variables & Arrays
; ==============================================================================
; "ONERR GOTO" Statements: Deferred Only; Parameter: ONERR GOTO LineNumber
; ==============================================================================
; Prevents having an Error Message Printed & Execution Halted when an Error
; Occurs during Program Execution; ONERR GOTO must be Executed before the
; occurance of an Error to avoid Program Interruption; Sets a Flag that causes
; an Unconditional Jump to LineNumber (if an Error Occurs during Program
; Execution); POKE 216, 0 (*$D8:0) Resets the Error-Detection Flag so that
; Normal Error Messages will be Printed.
; ==============================================================================
;
F2CB: A9 AB ONERR LDA #TOK_GOTO ;Get GOTO Token
F2CD: 20 C0 DE JSR SYNCHR ;If = Chr Got, Get Next; Else, Syntax Error
; ----------------------------------- ;Save TXTPTR for ERRHNDLR:
F2D0: A5 B8 LDA TXTPTR ;Get Next Char/Token Pointer, Low
F2D2: 85 F4 STA TXTPSV ;Set Char/Token Pointer Safe, Low
F2D4: A5 B9 LDA TXTPTR+1 ;Get Next Char/Token Pointer, High
F2D6: 85 F5 STA TXTPSV+1 ;Set Char/Token Pointer Safe, High
F2D8: 38 SEC ;Set Sign Bit of ERRFLG
F2D9: 66 D8 ROR ERRFLG ;Activate ONERR GOTO (ERRFLG=#$80)
; ----------------------------------- ;Save Current Line Number:
F2DB: A5 75 LDA CURLIN ;Get Current Line Number, Low
F2DD: 85 F6 STA CURLSV ;Set Current Line Safe, Low
F2DF: A5 76 LDA CURLIN+1 ;Get Current Line Number, High
F2E1: 85 F7 STA CURLSV+1 ;Set Current Line Safe, High
; ----------------------------------- ;Ignore Rest of Line: <<< Why? >>>
; ;[Anything after ONERR GOTO LineNumber
; ; is treated like a REM & Ignored !!!]
F2E3: 20 A6 D9 JSR REM_END ;Set (Y)=(Offset to Next ":" or EOL)
; ---------------------- ;Advance TXTPTR by adding (Y):
F2E6: 4C 98 D9 JMP ADDON ;Continue Program at Next Line
; ==============================================================================
; Error Handler (Part 2): Routine to Handle errors if ONERR GOTO is Active
; ==============================================================================
;
F2E9: 86 DE ERRHNDLR STX ERRNUM ;Set Current Error Number Safe
; ----------------------------------- ;Get & Save Stack Pointer Saved at NEWSTT:
F2EB: A6 F8 LDX REMSTK ;Get Stack Ptr Saved Before Each Statement
F2ED: 86 DF STX ERRSTK ;Set Stack Pointer Before Error Safe
; <<< Could also have done TXS here; See ONERR Correction in Applesoft Manual >>
; ----------------------------------- ;Save Line Number of Offending Statement:
F2EF: A5 75 LDA CURLIN ;Get Current Line Number, Low
F2F1: 85 DA STA ERRLIN ;Set Line Number Where ERROR Occurred, Low
F2F3: A5 76 LDA CURLIN+1 ;Get Current Line Number, High
F2F5: 85 DB STA ERRLIN+1 ;Set Line Number Where ERROR Occurred, High
; ----------------------------------- ;Get Position in Line to RESUME:
F2F7: A5 79 LDA OLDTEXT ;Get Old Text Pointer, Low
F2F9: 85 DC STA ERRPOS ;Set Error Handler TXTPTR Safe, Low
F2FB: A5 7A LDA OLDTEXT+1 ;Get Old Text Pointer, High
F2FD: 85 DD STA ERRPOS+1 ;Set Error Handler TXTPTR Safe, High
; ----------------------------------- ;Setup for "ON ERR GO TO <Line #>" Msg:
F2FF: A5 F4 LDA TXTPSV ;Get Char/Token Pointer Safe, Low
F301: 85 B8 STA TXTPTR ;Set Next Char/Token Pointer, Low
F303: A5 F5 LDA TXTPSV+1 ;Get Char/Token Pointer Safe, High
F305: 85 B9 STA TXTPTR+1 ;Set Next Char/Token Pointer, High
; ----------------------------------- ;Save Line Number of "ON ERR" Statement:
F307: A5 F6 LDA CURLSV ;Get Current Line Safe, Low
F309: 85 75 STA CURLIN ;Set Current Line Number, Low
F30B: A5 F7 LDA CURLSV+1 ;Get Current Line Safe, High
F30D: 85 76 STA CURLIN+1 ;Set Current Line Number, High
; ----------------------------------- ;Start Conversion:
F30F: 20 B7 00 JSR CHRGOT ;Get Char/Token Got w/o advancing TXTPTR
F312: 20 3E D9 JSR GOTO ;Goto Specified ONERR GOTO Line Number
F315: 4C D2 D7 JMP NEWSTT ;Execute a New Statement
; ==============================================================================
; "RESUME" Statement: Deferred; No Parameters
; ==============================================================================
; RESUMEs Program Execution at Beginning of Statement where ERROR occurred when
; used after Error Handling; Dangerous if used in Immediate Mode
; ==============================================================================
;
; ----------------------------------- ;Restore Line Number:
F318: A5 DA RESUME LDA ERRLIN ;Get Line Number Where ERROR Occurred, Low
F31A: 85 75 STA CURLIN ;Set Current Line Number, Low
F31C: A5 DB LDA ERRLIN+1 ;Get Line Number Where ERROR Occurred, High
F31E: 85 76 STA CURLIN+1 ;Set Current Line Number, High
; ----------------------------------- ;Restore Next Char/Token Pointer:
F320: A5 DC LDA ERRPOS ;Get Error Handler TXTPTR Safe, Low
F322: 85 B8 STA TXTPTR ;Set Next Char/Token Pointer, Low
F324: A5 DD LDA ERRPOS+1 ;Get Error Handler TXTPTR Safe, High
F326: 85 B9 STA TXTPTR+1 ;Set Next Char/Token Pointer, High
; ----------------------------------- ;Restore Stack Pointer:
F328: A6 DF LDX ERRSTK ;Get Stack Pointer Before Error Safe
F32A: 9A TXS ;Set Stack Pointer
; ----------------------------------- ;Re-try Offending Line:
F32B: 4C D2 D7 JMP NEWSTT ;Execute Offending Statement, Again
; ==============================================================================
; "DEL" Statement: Immediate & Deferred; Parameters: DEL LineNuml , LineNum2
; ==============================================================================
; Deletes a Range of Lines from LineNuml to LineNum2, inclusively; Respectively,
; if LineNuml/LineNum2 is NOT an Existing Program Line Number, the Next Larger/-
; /Smaller Line Number in the Program is used in lieu of LineNuml/LineNum2
; ==============================================================================
;
F32E: 4C C9 DE JSYN JMP SYNERROR ;Relay Point to Throw a "?Syntax" Error
; ==============================================================================
; "DEL" Statement - Main Entry Point:
; ==============================================================================
;
F331: B0 FB DEL BCS JSYN ;BGE: ERROR If Line Number NOT Specified
; ----------------------------------- ;Synchronize LOMEM Pointers:
F333: A6 AF LDX PRGEND ;Get End of Program Pointer, Low
F335: 86 69 STX VARTAB ;Set Start of Variables Pointer, Low
F337: A6 B0 LDX PRGEND+1 ;Get End of Program Pointer, High
F339: 86 6A STX VARTAB+1 ;Set Start of Variables Pointer, High
; ----------------------------------- ;Is Range START Line Number in Program?
F33B: 20 0C DA JSR LINGET ;Get Range START Line Number (LINNUM)
; ;^[Rtns 0 if Line Number is NOT Specified]
F33E: 20 1A D6 JSR FNDLIN ;Find, Convert, & Point LOWTR at Line/Next
F341: A5 9B LDA LOWTR ;Get Address of Line or Next Line, Low
F343: 85 60 STA DSTPTR ;Set Move Destination Pointer, Low
F345: A5 9C LDA LOWTR+1 ;Get Address of Line or Next Line, High
F347: 85 61 STA DSTPTR+1 ;Set Move Destination Pointer, High
; ----------------------------------> ;Upper Program will move down to (DSTPTR)
F349: A9 2C LDA #',' ;Require a Comma Separator Character next:
F34B: 20 C0 DE JSR SYNCHR ;If = Chr Got, Get Next; Else, Syntax Error
; ----------------------------------- ;Is Range END Line Number in Program?
F34E: 20 0C DA JSR LINGET ;Get Range END Line Number (LINNUM)
; ;^[Rtns 0 if Line Number is NOT Specified]
; ----------------------------------- ;Point 1 Line Past Range END Line Number:
F351: E6 50 INC LINNUM ;Advance Range END Line Number, Low
F353: D0 02 BNE DELSKIP1 ;Branch if No Page Carryover
F355: E6 51 INC LINNUM+1 ;Advance Range END Line Number, High
; ----------------------------------- ;Is Range Valid (START < END):
F357: 20 1A D6 DELSKIP1 JSR FNDLIN ;Find, Convert, & Point LOWTR at Line/Next
F35A: A5 9B LDA LOWTR ;Get Address of Line or Next Line, Low
F35C: C5 60 CMP DSTPTR ;Subtract Move Destination Pointer, Low
F35E: A5 9C LDA LOWTR+1 ;Get Address of Line or Next Line, High
F360: E5 61 SBC DSTPTR+1 ;Subtract Move Destination Pointer, High
F362: B0 01 BCS DELMVDWN ;BGE: Branch if Range Valid (START < END)
F364: 60 RTS ;Else, Nothing to Delete; Return to Caller
; ------------------------------------------------------------------------------
; Delete Specified Section:
; Move Upper Program Section Down [(LOWTR~VARTAB) to (DSTPTR)]
; ------------------------------------------------------------------------------
;
F365: A0 00 DELMVDWN LDY #0 ;Clear Indirect Addressing Index
; ----------------------------------- ;Move a Byte (Delete Loop):
F367: B1 9B DELMVLOOP LDA (LOWTR),Y ;Get a Byte from (Source Address),Y
F369: 91 60 STA (DSTPTR),Y ;Copy Byte to (Destination Address),Y
; ----------------------------------- ;Advance to Next Source Address:
F36B: E6 9B INC LOWTR ;Advance Source Address, Low
F36D: D0 02 BNE DELMVSKP1 ;Branch if No Page Boundary Reached
F36F: E6 9C INC LOWTR+1 ;Advance Source Address, High
; ----------------------------------- ;Advance to Next Destination Address:
F371: E6 60 DELMVSKP1 INC DSTPTR ;Advance Destination Address, Low
F373: D0 02 BNE DELMVSKP2 ;Branch if No Page Boundary Reached
F375: E6 61 INC DSTPTR+1 ;Advance Destination Address, High
; ----------------------------------- ;Move Next Byte? Or Finish Up?
F377: A5 69 DELMVSKP2 LDA VARTAB ;Get Start of Variables Ptr (EOP+1), Low
F379: C5 9B CMP LOWTR ;Subtract Source Address, Low
F37B: A5 6A LDA VARTAB+1 ;Get Start of Variables Ptr (EOP+1), High
F37D: E5 9C SBC LOWTR+1 ;Subtract Source Address, High
F37F: B0 E6 BCS DELMVLOOP ;BGE: LOOP if Not Done Moving Bytes
; ;^[Done when LOWTR move-up reaches VARTAB]
; ;^[Variables will be Cleared, Not Moved!]
; ----------------------------------- ;Else, Finish Up; Reverse Last Advance:
; ;Point End of Program (EOP) to Last Byte
; ;Moved [(Destination Address)-1]:
F381: A6 61 LDX DSTPTR+1 ;Get Destination Address, High
F383: A4 60 LDY DSTPTR ;Get Destination Address, Low
F385: D0 01 BNE DELMVSKP3 ;Branch if No Page Boundary Reached
F387: CA DEX ;Reduce Destination Address, High
F388: 88 DELMVSKP3 DEY ;Reduce Destination Address, Low
; <<< Seems like there is a one byte overlap here now that would wipe out the
; last byte of an Applesoft BASIC program! Should this last reduction really
; have been done? -- JPD >>>
; ----------------------------------- ;Reset Start of Variables Pointer (LOMEM):
F389: 86 6A STX VARTAB+1 ;Set Start of Variables Ptr (EOP+1), High
F38B: 84 69 STY VARTAB ;Set Start of Variables Ptr (EOP+1), Low
F38D: 4C F2 D4 JMP FIXLINKS ;Go Clear Vars, Fix Fwd Links, Restart Warm
; ==============================================================================
; "GR" Statement: Immediate & Deferred; No Parameters
; ==============================================================================
; Sets Low-Resolution GRaphics Mode (40 by 40) for Screen, leaving Four Lines
; for Text at Bottom; Screen is Cleared to Black, & Cursor is Moved to Text
; Window; Can be Converted to Full-Screen (40 by 48) Graphics, after executing
; GR, with command POKE -16302,0 or equivalent command POKE 49234,0; If GR
; follows a Full-Screen POKE command, Mixed Graphics-Plus-Text Mode is Reset;
; After a GR command, COLOR has been set to Zero
; ==============================================================================
;
F390: AD 56 C0 GR LDA LORES ;Reset HiRes Mode to LoRes/Text Mode
F393: AD 53 C0 LDA MIXSET ;Set Mixed Graphics & Text Mode
F396: 4C 40 FB JMP SETGR ;Go Set Screen to Graphics Mode
; ==============================================================================
; "TEXT" Statement: Immediate & Deferred; No Parameters
; ==============================================================================
; Sets Screen to Full-Screen Text Mode (40 characters per line, 24 lines) from
; Low-Resolution Graphics Mode or either of two High-Resolution Graphics Modes;
; Prompt & Cursor are moved to last line of Screen; Same as VTAB 24 in Text Mode
; ==============================================================================
;
; JMP TEXT02 ;(=$FB36) Would've done both these things:
F399: AD 54 C0 TEXT LDA TXTPAGE1 ;Display Text Page1; R/W Main V-RAM
F39C: 4C 39 FB JMP SETTXT ;Go Set Screen to Text Mode
; <<< ;Better code would be:
; TEXT LDA MIXSET ;Set Mixed Graphics & Text Mode
; JMP TEXT01 ;(=$FB33) Reset HiRes to LoRes/Text Mode
; ; -- BS-C >>>
; ==============================================================================
;
;
; ==============================================================================
; Tape Array STORE & RECALL Routines:
; ==============================================================================
; (There are No Corresponding Routines for Diskette Storage in Applesoft)
; ==============================================================================
; STORE & RECALL Arrays via Cassette Tape (using Apple II Audio Input/Output)
; System; [Did anybody ever use these?]; Array Names are Not Stored with their
; Values, So an Array may be Recalled using a Different Name than that used when
; Stored; Dimensions of arrays recalled should be identical to Dimensions of
; Original Arrays Stored; Failure to observe this will result in Scrambled
; Numbers, Extra Zeros, or ?Out of Memory Erors, in Recalled Arrays
; ==============================================================================
;
; ==============================================================================
; "STORE" Statement: Immediate & Deferred; Parameter: STORE Avar
; ==============================================================================
;
; ----------------------------------- ;Prepare to Read/Write a 3-Byte Header
; ;from/to a Cassette Tape (Audio I/O):
F39F: 20 D9 F7 STORE JSR GETARYPTR ;If Found, Point LOWTR at Array Specified
; ----------------------------------- ;Compute [(Array Size)=(Fwd Offset)-1]:
F3A2: A0 03 LDY #3 ;Point to Forward Offset Pointer, High
; ;^[Data within Array Variable Pointer]
F3A4: B1 9B LDA (LOWTR),Y ;Get Forward Offset, High
F3A6: AA TAX ;Save Forward Offset, High
F3A7: 88 DEY ;Point to Forward Offset Pointer, Low
; ;^[Data within Array Variable Pointer]
F3A8: B1 9B LDA (LOWTR),Y ;Get Forward Offset, Low
F3AA: E9 01 SBC #1 ;Reduce Forward Offset, Low
; ;^[C=0: Subtract with Borrow (A-Data-!C)]
; ;^[C=1: Subtract w/o Borrow (A-Data-!C)]
F3AC: B0 01 BCS STORESKP1 ;BGE: Branch if Borrowed [(A)>=(Data)]
F3AE: CA DEX ;Else, LT: Reduce Forward Offset, High
F3AF: 85 50 STORESKP1 STA LINNUM ;Save Array Size, Low
F3B1: 86 51 STX LINNUM+1 ;Save Array Size, High
; ----------------------------------- ;STORE Array on Tape:
F3B3: 20 CD FE JSR MON_WRITE ;Write 3-Byte Header (Length & Lock Byte)
F3B6: 20 BC F7 JSR TAPEPTR ;Point at 1st Value in Array
F3B9: 4C CD FE JMP MON_WRITE ;Go Write Array Data to Tape
; ==============================================================================
; "RECALL" Statement: Immediate & Deferred; Parameter: RECALL Avar
; ==============================================================================
;
; ----------------------------------- ;Prepare to Read/Write a 3-Byte Header
; ;from/to a Cassette Tape (Audio I/O):
F3BC: 20 D9 F7 RECALL JSR GETARYPTR ;If Found, Point LOWTR at Array Specified
; ----------------------------------- ;RECALL 3-Byte Header from Tape:
F3BF: 20 FD FE JSR MON_READ ;Read 3-Byte Header (Length & Lock Byte)
; ----------------------------------- ;Compute [(Fwd Offset)-(Tape Array Size)]:
F3C2: A0 02 LDY #2 ;Point to Forward Offset Pointer, Low
; ;^[Data within Array Variable Pointer]
F3C4: B1 9B LDA (LOWTR),Y ;Get Forward Offset, Low
F3C6: C5 50 CMP LINNUM ;Subtract Tape Array Size, Low (A-Data):NZC
; ;^[Carry gets Set when [(A)>=(Data)]]
F3C8: C8 INY ;Point to Forward Offset Pointer, High
F3C9: B1 9B LDA (LOWTR),Y ;Get Forward Offset, High
F3CB: E5 51 SBC LINNUM+1 ;Subtract Tape Array Size, High
; ;^[C=0: Subtract with Borrow (A-Data-!C)]
; ;^[C=1: Subtract w/o Borrow (A-Data-!C)]
; ;Now've Adrs where Tape Array would Start
; ;^[OK if >, but sh'd be = Spec'd Start+1]
F3CD: B0 03 BCS RECALLDATA ;BGE: Branch if Borrowed [(A)>=(Data)]
F3CF: 4C 10 D4 JMP MEMERR ;Else, LT: Throw an "?Out Of Memory" Error
; ----------------------------------- ;RECALL Array Data from Tape:
F3D2: 20 BC F7 RECALLDATA JSR TAPEPTR ;Point at 1st Value in Array
F3D5: 4C FD FE JMP MON_READ ;Go Read Array Data from Tape
; ==============================================================================
; High-Resolution Graphics Mode (Hi-Res) Initialization Routines:
; ==============================================================================
;
; ==============================================================================
; "HGR2" Statement: Immediate & Deferred; No Parameters; Init & Clear HIRES Pg.2
; ==============================================================================
; Sets Full-Screen High-Resolution Graphics Mode (280 by 192), Displaying Screen
; Page 2 of Memory (16K-24K), Cleared to Black
; ==============================================================================
;
F3D8: 2C 55 C0 HGR2 BIT TXTPAGE2 ;Display Text Page 2
; ;Default to:
F3DB: 2C 52 C0 BIT MIXCLR ;Set Full Screen Graphics & Text Mode
F3DE: A9 40 LDA #>HGR2SCRN ;Get Hi-Res Screen Pg.2 Base-Address, High
F3E0: D0 08 BNE SETHPG ;Go Set Hi-Res Graphics Mode; Always Taken
; ==============================================================================
; "HGR" Statement: Immediate & Deferred; No Parameters; Init & Clear HIRES Pg.1
; ==============================================================================
; Sets Mixed-Screen High-Resolution Graphics Mode (280 by 160), Displaying
; Screen Page 1 of Memory (8K-16K), Cleared to Black, Leaving 4 Lines of Text
; Visible at Bottom of Screen, & 20 Lines of Text Invisible at Top of Screen,
; Overlayed with Graphics but Still Functional Underneath, with Cursor
; Unrestricted but Only Visible at Bottom of Screen
; ==============================================================================
;
F3E2: A9 20 HGR LDA #>HGR1SCRN ;Get Hi-Res Screen Pg.1 Base-Address, High
F3E4: 2C 54 C0 BIT TXTPAGE1 ;Display Text Page1; R/W Main V-RAM
; ;Default to:
F3E7: 2C 53 C0 BIT MIXSET ;Set Mixed Graphics & Text Mode
;
; ==============================================================================
; Common High-Resolution Graphics Mode (Hi-Res) Initialization Routine:
; ==============================================================================
;
F3EA: 85 E6 SETHPG STA HGRPAGE ;Set Hi-Res Base Page (HPg1=$20, HPg2=$40)
F3EC: AD 57 C0 LDA HIRES ;Reset Lo-Res/Text Mode to Hi-Res Mode
F3EF: AD 50 C0 LDA TXTCLR ;Set Graphics Display Mode
; ----------------------------------- ;Setup to Initialize Hi-Res Screen Memory:
F3F2: A9 00 HCLR LDA #0 ;Clear Accumulator
F3F4: 85 1C STA HCOLOR1 ;Clear Hi-Res Color Mask (Black Background)
F3F6: A5 E6 LDA HGRPAGE ;Get Hi-Res Base Page (HPg1=$20, HPg2=$40)
F3F8: 85 1B STA HSHAPE+1 ;Clear Hi-Res Screen Byte Pointer, High
F3FA: A0 00 LDY #0 ;Clear Indirect Addressing Index
F3FC: 84 1A STY HSHAPE ;Clear Hi-Res Screen Byte Pointer, Low
; ----------------------------------- ;Initialize Loop; Color Hi-Res Background:
F3FE: A5 1C BGLOOP LDA HCOLOR1 ;Get Hi-Res Color Mask
F400: 91 1A STA (HSHAPE),Y ;Clear Hi-Res Screen to Mask Color
F402: 20 7E F4 JSR COLORSHIFT ;Correct for Color Shift
; ;(Slows Clear by Factor of 2)
F405: C8 INY ;Advance Indirect Addressing Index
F406: D0 F6 BNE BGLOOP ;LOOP if Not at Page Boundary
F408: E6 1B INC HSHAPE+1 ;Advance Hi-Res Screen Byte Pointer, High
F40A: A5 1B LDA HSHAPE+1 ;Get Hi-Res Screen Byte Pointer, High
F40C: 29 1F AND #%00011111 ;Done? <-[Done at Hi-Res Page End +1, High:
; ;Pg1:$40=(%01000000); Pg2:$60=(%01100000)
F40E: D0 EE BNE BGLOOP ;LOOP if Not Done
F410: 60 RTS ;Else, Return to Caller
; ==============================================================================
; High-Resolution Graphics Mode (Hi-Res) Position And Plot Subroutines:
; ==============================================================================
;
; ==============================================================================
; Set Hi-Res Cursor Position Subroutine: [Called by HPLOT0 & SCALE]
; ==============================================================================
; Enter with: [(X,Y)={Low,High}] = Horizontal (Cartesian) X-Coordinate (0-279)
; (Accumulator) = Vertical (Cartesian) Y-Coordinate (0-191)
; ------------------------------------------------------------------------------
; Note: X-Coordinate = X-Position = Column; Y-Coordinate = Y-Position = Row
; ==============================================================================
;
; ----------------------------------- ;Save Spec'd Cartesian (X,Y) Coordinates:
F411: 85 E2 HPOSN STA HGRY ;Save Vertical Y-Position
F413: 86 E0 STX HGRX ;Save Horizontal X-Position, Low
F415: 84 E1 STY HGRX+1 ;Save Horizontal X-Position, High
; ----------------------------------- ;Compute Base Address for Y-Position
; ;^[to access Screen Memory via (GBASL),Y]:
F417: 48 PHA ;*** BITS IN: A|Y=ABCDEFGH; Push Y-Position
F418: 29 C0 AND #%11000000 ;Retain A|Y=AB000000, Negative & Overflow Bits
F41A: 85 26 STA GBASL ;Set Graphics Base Address, Low
F41C: 4A LSR A ;Shift Right: A|Y=0AB00000
F41D: 4A LSR A ;Shift Right: A|Y=00AB0000
F41E: 05 26 ORA GBASL ;*** BITS OUT: GBASL=ABAB0000
F420: 85 26 STA GBASL ;Set Graphics Base Address, Low
; ----------------------------------- ;-----------------------------------------
; ;Bit A|Y GBASH GBASL A|Y = Row
F422: 68 PLA ;| -------- -------- -------- Pull Y-Pos
F423: 85 27 STA GBASH ;Y=ABCDEFGH (ABCDEFGH) ABAB0000 <Set GBASH
F425: 0A ASL A ;A-BCDEFGH0< ABCDEFGH ABAB0000 Shift Left
F426: 0A ASL A ;B-CDEFGH00< ABCDEFGH ABAB0000 Shift Left
F427: 0A ASL A ;C-DEFGH000< ABCDEFGH ABAB0000 Shift Left
F428: 26 27 ROL GBASH ;A-DEFGH000 BCDEFGHC< ABAB0000 Sets GBASH
F42A: 0A ASL A ;D-EFGH0000< BCDEFGHC ABAB0000 Shift Left
F42B: 26 27 ROL GBASH ;B-EFGH0000 CDEFGHCD< ABAB0000 Sets GBASH
F42D: 0A ASL A ;E-FGH00000< CDEFGHCD ABAB0000 Shift Left
F42E: 66 26 ROR GBASL ;0-FGH00000 CDEFGHCD >EABAB000 Sets GBASL
F430: A5 27 LDA GBASH ;0-CDEFGHCD (CDEFGHCD) EABAB000 <Get GBASH
F432: 29 1F AND #%00011111 ;0-000FGHCD& CDEFGHCD EABAB000 Rtn 5 LSBs
F434: 05 E6 ORA HGRPAGE ;0-PPPFGHCD+ CDEFGHCD EABAB000 +($20,$40)
F436: 85 27 STA GBASH ;0-PPPFGHCD (PPPFGHCD) EABAB000 <Set GBASH
; ;-----------------------------------------
; ;Hi-Res Page1: PPP=001 for $2000-$3FFF
; ;Hi-Res Page2: PPP=010 for $4000-$5FFF
; ----------------------------------- ;-----------------------------------------
; ;Divide X-Position by 7 for Index frm Base
; ;Address (Quotient) & BIT within Screen
; ;Memry Byte (Mask Specified by Remainder):
F438: 8A TXA ;Retrieve Horizontal X-Position, Low
F439: C0 00 CPY #0 ;Is Horizontal X-Position, High a Zero?
F43B: F0 05 BEQ HPOSN2 ;Branch if So: Horizontal X-Position < 256
; ;Else, Horizontal X-Position >= 256:
; ;256/7 = 36, Remainder = 4; & Carry = 1,
; ;So ADC #4 is Too Large; However, ADC #4
; ;Clears Carry which makes SBC #7 only -6,
; ;balancing it out ...
F43D: A0 23 LDY #35 ;Following INY will make Y=36
F43F: 69 04 ADC #4 ;Addvance Horizontal X-Position, Low
F441: C8 HPOSN1 INY ;Addvance Horizontal X-Position, High
; ---------------------- ;Horizontal X-Position < 256:
F442: E9 07 HPOSN2 SBC #7 ;Reduce Horizontal X-Position, Low
; ;^[C=0: Subtract with Borrow (A-Data-!C)]
; ;^[C=1: Subtract w.o Borrow (A-Data-!C)]
F444: B0 FB BCS HPOSN1 ;BGE: LOOP if Borrowed [(A)>=(Data)]
F446: 84 E5 STY HGRHORIZ ;Store Horizontal Byte Index (Counted)
F448: AA TAX ;Use Remainder -7 to look up Color Bit Mask:
F449: BD B9 F4 LDA MSKTBL-249,X ;[Should be MSKTBL-$100+7,X] Get Bit Mask
F44C: 85 30 STA HMASK ;Save H/GR On-the-Fly Color Bit Mask
F44E: 98 TYA ;Retrieve Horizontal Byte Index (Quotient)
F44F: 4A LSR A ;Shift Right (lsb->C): Even or Odd Column?
F450: A5 E4 LDA HGRCOLOR ;Get Specified Hi-Res Graphics Color
F452: 85 1C STA HCOLOR1 ;Set Hi-Res Color Mask (Color Specified)
F454: B0 28 BCS COLORSHIFT ;Branch if Odd Column: Fix Odd Color
F456: 60 RTS ;Return to Caller if Even Column: No Fix
; ==============================================================================
; High-Resolution Graphics Mode (Hi-Res) Plot Subroutine: [Called by HPLOT]
; ==============================================================================
; Enter with: [(X,Y)={Low,High}] = Horizontal (Cartesian) X-Coordinate (0-279)
; (Accumulator) = Vertical (Cartesian) Y-Coordinate (0-191)
; ------------------------------------------------------------------------------
; Note: X-Coordinate = X-Position = Column; Y-Coordinate = Y-Position = Row
; ==============================================================================
;
; ----------------------------------- ;Plot a Dot (w/ current Color Specified):
F457: 20 11 F4 HPLOT0 JSR HPOSN ;Set Hi-Res Cursor Position
; ;^[Computes Bit Position in GBASL/GBASH &
; ;HGRHORIZ, + HMASK, from Y-Coordinate in
; ;A-Reg & X-Coordinate in X-Reg & Y-Reg]
F45A: A5 1C LDA HCOLOR1 ;Get Hi-Res Color Mask (Color Specified)
; ;For any 1-bits in HCOLOR1,
; ;Substitute Corresponding Bit of HMASK:
F45C: 51 26 EOR (GBASL),Y ;XOR with Dot at Cursor Position
F45E: 25 30 AND HMASK ;AND with H/GR On-the-Fly Color Bit Mask
F460: 51 26 EOR (GBASL),Y ;XOR with Dot at Cursor Position
F462: 91 26 STA (GBASL),Y ;Plot a Dot: Set Color at Cursor Position
F464: 60 RTS ;Return to Caller
; ==============================================================================
; High-Resolution Graphics Mode (Hi-Res) Left, Right, Up, Down Subroutines:
; ==============================================================================
;
; ==============================================================================
; Move Left or Right One Pixel (1 Dot):
; ==============================================================================
; If Status is Positive, Move Right; If is Negative, Move Left; If already at
; Left or Right Edge, Wrap Around
; ==============================================================================
; Remember Bits in Hi-Res Byte are Backwards Order: Byte N Byte N+1
; S7654321 SEDCBA98
; ==============================================================================
;
F465: 10 23 MVLFTRGT BPL MVRIGHT ;Go Move Right If Status is Positive
; ----------------------------------- ;Else, Move Left: Status is Negative:
F467: A5 30 MVLEFT LDA HMASK ;Get H/GR On-the-Fly Color Bit Mask
; ---------------------- ;Shifting Mask Right, Moves Dot Left:
F469: 4A LSR A ;Shift Right (lsb->C): Bit = 0 or 1?
F46A: B0 05 BCS MVLEFT1 ;Branch if Bit Set: Dot Moved to Next Byte
F46C: 49 C0 EOR #%11000000 ;Move Sign bit back to where it was (msb)
F46E: 85 30 MVLFTRGT1 STA HMASK ;Set New H/GR On-the-Fly Color Bit Mask
F470: 60 RTS ;Return to Caller
; ----------------------------------- ;Dot Moved to Next Byte:
F471: 88 MVLEFT1 DEY ;Reduce Horizontal Byte Index
F472: 10 02 BPL MVLEFT2 ;Branch if still Not Past Edge
F474: A0 27 LDY #39 ;Else, Off Left Edge, So Wrap Around Scrn:
F476: A9 C0 MVLEFT2 LDA #%11000000 ;New HMASK, Rightmost Bit on Screen, ...
; ; ... is Overflow Bit in Byte
F478: 85 30 MVLEFT3 STA HMASK ;Set New H/GR On-the-Fly Color Bit Mask
F47A: 84 E5 STY HGRHORIZ ;Set New Horizontal Byte Index
; ----------------------------------- ;Correct for Color Shift:
F47C: A5 1C LDA HCOLOR1 ;Get Hi-Res Color Mask: Black Bits = 1
F47E: 0A COLORSHIFT ASL A ;Shift/Rotate/Fix Even/Odd Color
F47F: C9 C0 CMP #%11000000 ;(Black1|White1|Black2|White2)=(0|3|4|7)?
F481: 10 06 BPL BAS_RTS26 ;Return to Caller if Black or White
; ;Else, Shifted Hi-Res Color is Negative:
F483: A5 1C LDA HCOLOR1 ;Get Hi-Res Color Mask: Black Bits = 1
F485: 49 7F EOR #%01111111 ;Keep Sign Bit & Invert 7 Color Bits
F487: 85 1C STA HCOLOR1 ;Set Hi-Res Color Mask
F489: 60 BAS_RTS26 RTS ;Return to Caller
; ----------------------------------- ;Move Right: Status is Positive:
F48A: A5 30 MVRIGHT LDA HMASK ;Get H/GR On-the-Fly Color Bit Mask
; ---------------------- ;Shifting Mask Left, Moves Dot Right:
F48C: 0A ASL A ;Shift Left (N->S): Bit = 0 or 1?
F48D: 49 80 EOR #%10000000 ;Invert Sign Bit & Keep 7 Color Bits
F48F: 30 DD BMI MVLFTRGT1 ;Branch if Finished [(N->S): Bit was = 0]
; ----------------------------------- ;Else, Not Done yet [(N->S): Bit was = 1],
; ;Dot Moved to Next Byte:
F491: A9 81 LDA #%10000001 ;Get New H/GR On-the-Fly Color Bit Mask
F493: C8 INY ;Advance Horizontal Byte Index
F494: C0 28 CPY #40 ;Is Horizontal Byte Index Off Right Edge?
F496: 90 E0 BCC MVLEFT3 ;BLT: Branch if Not Past Edge; Else:
F498: A0 00 LDY #0 ;Wrap Around Scrn: Zero Horiz. Byte Index
F49A: B0 DC BCS MVLEFT3 ;Now, Go Finish Up; Always Taken
; ==============================================================================
; More High-Resolution Graphics Mode (Hi-Res) Left, Right, Up, Down Subroutines:
; ==============================================================================
;
; ==============================================================================
; "XDRAW" One Bit: [Same as DRAW, but this Compliments Color (It happens here!)]
; ==============================================================================
;
; ----------------------------------- ;Entry Point for No 90 Degree Rotation:
F49C: 18 LRUDX1 CLC ;Clear Carry Flag (C=0)
; ----------------------------------- ;Entry Point to Rotate 90 Degrees:
; ;^[Carry Flag should already be Set (C=1)]
F49D: A5 D1 LRUDX2 LDA HGRDX+1 ;Get Hi-Res Drawing Column, High
F49F: 29 04 AND #%00000100 ;Is (Bit 2 = 0)?
F4A1: F0 25 BEQ LRUD4 ;YES, (Bit2 = 0), Don't Plot
; ;NO, (Bit2 = 1), See what's already there:
; ---------------------- ;[Start of Color Complemnting Section]:
F4A3: A9 7F LDA #%01111111 ;Clear Sign Bit & Keep 7 Color Bits:
F4A5: 25 30 AND HMASK ;AND with H/GR On-the-Fly Color Bit Mask
F4A7: 31 26 AND (GBASL),Y ;Get Dot at Cursor Position
; ;Is Screen Bit Set (=1)?
F4A9: D0 19 BNE LRUD3 ;YES, Go Clear Screen Bit
F4AB: E6 EA INC HGRCLSN ;NO, Count Collision
F4AD: A9 7F LDA #%01111111 ;& Turn Bit On
; ---------------------- ;[End of Color Complemnting Section]
F4AF: 25 30 AND HMASK ;And with H/GR On-the-Fly Color Bit Mask
F4B1: 10 11 BPL LRUD3 ;Go Plot Bit; Always Taken
;
; ==============================================================================
; "DRAW" One Bit: [Same as XDRAW, but it Compliments Color (happens just above)]
; ==============================================================================
;
; ----------------------------------- ;Entry Point for No 90 Degree Rotation:
F4B3: 18 LRUD1 CLC ;Clear Carry Flag (C=0)
; ----------------------------------- ;Entry Point to Rotate 90 Degrees:
; ;^[Carry Flag should already be Set (C=1)]
F4B4: A5 D1 LRUD2 LDA HGRDX+1 ;Get Hi-Res Drawing Column, High
F4B6: 29 04 AND #%00000100 ;Is (Bit 2 = 0)?
F4B8: F0 0E BEQ LRUD4 ;YES, (Bit 2 = 0), Don't Plot
; ;NO, (Bit2 = 1), See what's already there:
; ---------------------- ;[Start of NonColorComplemnting Section]:
F4BA: B1 26 LDA (GBASL),Y ;Get Dot at Cursor Position
; ;Set Screen Bit to corresponding HCOLOR:
F4BC: 45 1C EOR HCOLOR1 ;XOR with Hi-Res Color Mask: Black Bits = 1
; ---------------------- ;[End of Non Color Complemnting Section]
; ;Look at just this Bit Position:
F4BE: 25 30 AND HMASK ;AND with H/GR On-the-Fly Color Bit Mask
F4C0: D0 02 BNE LRUD3 ;Plot Bit if it was Zero
F4C2: E6 EA INC HGRCLSN ;Else, Bit is already 1: Count Collision
; ----------------------------------- ;Plot Bit - Toggle Bit on Screen with (A):
F4C4: 51 26 LRUD3 EOR (GBASL),Y ;XOR with Dot at Cursor Position
F4C6: 91 26 STA (GBASL),Y ;Set Dot at Cursor Position
; ----------------------------------- ;Don't Plot - Determine where next Point
; ; will be, and Move there:
; ---------------------- ;Calculate Direction to Move:
; ;Add Quadrant to Specified Vector & Move
; ;Left/Right/Up/Down based on Sign & Carry:
F4C8: A5 D1 LRUD4 LDA HGRDX+1 ;Get Hi-Res Drawing Column, High
F4CA: 65 D3 ADC HGRQUAD ;Add Hi-Res Drawing Quadrant
F4CC: 29 03 CON3 AND #%00000011 ;Wrap Around Circle
; ;| 0 = %00 : Up | 1 = %01 : Down |
; ;| 2 = %10 : Right | 3 = %11 : Left |
F4CE: C9 02 CMP #2 ;C=0 if 0 or 1, C=1 if 2 or 3
F4D0: 6A ROR A ;Put C into Sign, Odd/Even into C
F4D1: B0 92 BCS MVLFTRGT ;BGE: Branch if C >= 2: Move Left or Right
; ;Else, C < 2, Move Up or Down:
F4D3: 30 30 MVUPDWN0 BMI MVDWN ;Branch if Sign = 1: Move Down
; ;Else, Sign = 0, Move Up:
;
; ==============================================================================
; Move Up One Pixel (1 Dot): If already at Top, go to Bottom
; ==============================================================================
; ----------------------------------- ;Note: X-Coordinate = X-Position = Column
; ; Y-Coordinate = Y-Position = Row
; ----------------------------------- ;Remember: Row GBASH GBASL
; ; ABCDEFGH PPPFGHCD EABAB000
; ----------------------------------- ;Compute Base Adrs for HR Line Above; Put
; MVUP [Drop-In] ;Result in (GBAS) w/ 192-Line Wrap Around:
; ----------------------------------- ;-----------------------------------------
F4D5: 18 CLC ;Prepare for Add with Carry
F4D6: A5 27 LDA GBASH ;Get Graphics Base Address, High
F4D8: 2C B9 F5 BIT CON_1C ;&-Mask for "FGH" bits [($1C)=(%00011100)]
F4DB: D0 22 BNE MVUP5 ;Branch if FGH Bits <> 0; Go Do FGH=FGH-1
; ;^[GBASH=PPP000CD, GBASL=EABAB000]
F4DD: 06 26 ASL GBASL ;Else, Put GBASL Sign (E) Bit into Carry
; ----------------------------------- ;Move Left/Right/Up/Down based on Sign:
F4DF: B0 1A BCS MVUP3 ;Branch if Sign (E) Bit was Set (=1)
; ;^[Do EFGH=EFGH-1 [Really: FGHCD-1]]
; ---------------------- ;Finished?
; ;Test Bit2 of GBASH for Carry [(H)<-(CD)]:
F4E1: 2C CD F4 BIT CON3+1 ;(Constant=3)[SourceGen Mission Impossible]
F4E4: F0 05 BEQ MVUP1 ;Finished if No Carryover [(H=0)<-(CD)]
; ;^[Y-Position Form is AB000000]?
; ---------------------- ;Else, Not Finished, GBASH [(H=1)<-(CD)]:
F4E6: 69 1F ADC #%00011111 ;^[Do CDEFGH=CDEFGH-1 for Row = ABCDEFGH]
F4E8: 38 SEC ;Force Following Branch:
F4E9: B0 12 BCS MVUP4 ;Always Taken
; ----------------------------------- ;No Carry, Finish:
; ;Y-Position Form is AB000000
F4EB: 69 23 MVUP1 ADC #$23 ;Add enough to make GBASH=PPP11111 later
F4ED: 48 PHA ;Push Modified GBASH: Save it for Later
; ---------------------- ;Is Wrap-Around Needed?
F4EE: A5 26 LDA GBASL ;GBASL is now ABAB0000 (AB=00,01,10)
F4F0: 69 B0 ADC #%10110000 ;Add to GBASL [High Nibble]
; ;GBASL = ABAB + 1011:
; ; 0000 + 1011 = 1011 & Clrs Carry
; ; or 0101 + 1011 = 0000 & Sets Carry
; ; or 1010 + 1011 = 0101 & Sets Carry
F4F2: B0 02 BCS MVUP2 ;Branch if C=1: No Wrap-Around Needed
; ---------------------- ;Else, ... C=0, So Wrap-Around Needed:
F4F4: 69 F0 ADC #%11110000 ;Add to Fix GBASL [High Nibble]->[1010]
F4F6: 85 26 MVUP2 STA GBASL ;Set Graphics Base Address, Low
; ;^[Form is still ABAB0000]
; ---------------------- ;Do CDEFGH=CDEFGH-1 for Row = ABCDEFGH:
F4F8: 68 PLA ;Pull Modified GBASH: Saved for later Mod
F4F9: B0 02 BCS MVUP4 ;Always Taken
;
; ----------------------------------- ;Do EFGH=EFGH-1 [Really: FGHCD-1]:
F4FB: 69 1F MVUP3 ADC #%00011111 ;Add to GBASH=PPPFGHCD
; ----------------------------------- ;Do CDEFGH=CDEFGH-1 for Row = ABCDEFGH:
F4FD: 66 26 MVUP4 ROR GBASL ;Shift (E) back in to get GBASL=EABAB000
; ----------------------------------- ;Finish GBASH Modifications, Do FGH=FGH-1:
; ;^[GBASH=PPP000CD, GBASL=EABAB000]
F4FF: 69 FC MVUP5 ADC #%11111100 ;Add to GBASH=PPPFGHCD [Really^: PPPFGH-1]
; ----------------------------------- ;Finished:
F501: 85 27 MVUPDWN1 STA GBASH ;Set Graphics Base Address, High
F503: 60 RTS ;Return to Caller
; ==============================================================================
; Move Down One Pixel (1 Dot): If already at Bottom, go to Top
; ==============================================================================
; ----------------------------------- ;Note: X-Coordinate = X-Position = Column
; ; Y-Coordinate = Y-Position = Row
; ----------------------------------- ;Remember: Row GBASH GBASL
; ; ABCDEFGH PPPFGHCD EABAB000
; ----------------------------------- ;Compute Base Adrs for HR Line Below; Put
; MVDOWN [No Drop-In] ;Result in (GBAS) w/ 192-Line Wrap Around:
; ----------------------------------- ;-----------------------------------------
F504: 18 CLC ;Prepare for Add with Carry <(Never Used)>
; ----------------------------------- ;-----------------------------------------
F505: A5 27 MVDWN LDA GBASH ;Get Graphics Base Address, High
F507: 69 04 CON4 ADC #%00000100 ;Add to GBASH=PPPFGHCD; Do FGH=FGH+1
F509: 2C B9 F5 BIT CON_1C ;&-Mask for "FGH" bits [($1C)=(%00011100)]
F50C: D0 F3 BNE MVUPDWN1 ;Branch if FGH Bits <> 0: Finished
F50E: 06 26 ASL GBASL ;Else, Put GBASL Sign (E) Bit into Carry
; ----------------------------------- ;Move Left/Right/Up/Down based on Sign:
F510: 90 18 BCC MVDWN2 ;Branch if Sign (E) Bit was Clear (=0)
; ---------------------- ;Finished?
F512: 69 E0 ADC #%11100000 ;Add to GBASH=PPPFGHCD; Do PPP=PPP-1
F514: 18 CLC ;Prepare for Add with Carry
; ;Test Bit2 of GBASH for Carry [(H)<-(CD)]:
F515: 2C 08 F5 BIT CON4+1 ;(Constant=4)[SourceGen Mission Impossible]
F518: F0 12 BEQ MVDWN3 ;Finished if No Carryover [(H=0)<-(CD)]
; ;Else, Not Finished, GBASH [(H=1)<-(CD)]:
; ---------------------- ;Is Wrap-Around Needed?
F51A: A5 26 LDA GBASL ;Get Graphics Base Address, Low
F51C: 69 50 ADC #%01010000 ;Advance GBASL (AB)'s [High Nibble]:
; ;GBASL = ABAB + 0101:
; ; 0000 + 0101 = 0101 & No Carry
; ; or 0101 + 0101 = 1010 & No Carry
; ; or 1010 + 0101 = 1111 & No Carry
; ; & 1010 --> Wrap Around Up to Line 0
F51E: 49 F0 EOR #%11110000 ;Invert GBASL (AB)'s [High Nibble]
F520: F0 02 BEQ MVDWN1 ;Branch if GBASL is Zero: Wrap Needed
; ;^[Wrap Around to Line Zero of Group]
; ;Else, Wrap-Around Not Needed:
F522: 49 F0 EOR #%11110000 ;Invert GBASL (AB)'s [High Nibble], Again
; ;^[Get it Back to what was, to Not Wrap]
; ----------------------------------- ;Finish Move:
F524: 85 26 MVDWN1 STA GBASL ;Set New Graphics Base Address, Low
F526: A5 E6 LDA HGRPAGE ;Get Hi-Res Base Page (HPg1=$20, HPg2=$40)
F528: 90 02 BCC MVDWN3 ;Always Taken
;
; ----------------------------------- ;Finish GBASH Modifications:
F52A: 69 E0 MVDWN2 ADC #%11100000 ;Add to GBASH=PPPFGHCD; Do PPP=PPP-1
; ----------------------------------- ;Fix GBASL, Reverse Shift Left:
F52C: 66 26 MVDWN3 ROR GBASL ;Shift (E) back in to get GBASL=EABAB000
F52E: 90 D1 BCC MVUPDWN1 ;Finished, Go Set GBASH; Always Taken
;
; ==============================================================================
; High-Resolution Graphics Mode (Hi-Res) Line Drawing Subroutines:
; ==============================================================================
;
; ==============================================================================
; HLINRL: Clear Current Point [(X0L, X0H), Y0] so HGLIN will act Relatively
; to draw line from it to [{(X0L + DXL), (X0H + DXH)}, (Y0 + DY)]
; ==============================================================================
; HLINRL ;Enter with: (A,X) = DX from Current Point
; ^(Never Called by Applesoft) ; (Y) = DY from Current Point
; ------------------------------------------------------------------------------
; Note: X-Coordinate = X-Position = Column; Y-Coordinate = Y-Position = Row
; ==============================================================================
;
; ------------------------------------------------------------------------------
; HLINRL [Drop-In Only] ;Never Referenced [Can Never Happen]
; (Only Exception: User-Callable Entry Point; BASIC: CALL -2,768 or CALL 62,768;
; But Need to Set A,X & Y Registers 1st; How? POKES & Pg.3 S/R)
; ------------------------------------------------------------------------------
F530: 48 HLINRL PHA ;Push Accumulator
F531: A9 00 LDA #0 ;Clear Accumulator
F533: 85 E0 STA HGRX ;Clear Horizontal X-Position, Low
F535: 85 E1 STA HGRX+1 ;Clear Horizontal X-Position, High
F537: 85 E2 STA HGRY ;Clear Vertical Y-Position, Low
F539: 68 PLA ;Pull Accumulator
; ------------------------------------------------------------------------------
;
; ==============================================================================
; Hi-Res Line Drawing Subroutine: Draw Line from Last Plotted Point to [(A,X),Y]
; ==============================================================================
; HGLIN [Can Drop-In Too] ;Enter with: (A,X) = X of Target Point {L,H}
; ; (Y) = Y of Target Point
; ------------------------------------------------------------------------------
; Note: X-Coordinate = X-Position = Column; Y-Coordinate = Y-Position = Row
; ==============================================================================
; Delta: the 4th letter of the Greek alphabet (D or d); is used here, with X & Y
; (DX & DY), to mean the amount by which one number or quantity differs from an-
; other, the amount of change; e.g., Delta X = [DX=X1-X0] & Delta Y = [DY=Y1-Y0]
; ==============================================================================
;
; ----------------------------------- ;Compute Delta X = (X - X0):
F53A: 48 HGLIN PHA ;Push Target Point X-Coordinate, Low
F53B: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
F53C: E5 E0 SBC HGRX ;Subtract Horizontal X-Position, Low
F53E: 48 PHA ;Push Delta X, Low
F53F: 8A TXA ;Get Target Point X-Coordinate, High
F540: E5 E1 SBC HGRX+1 ;Subtract Horizontal X-Position, High
; ;Now Carry's Direction of Change in X-Pos
F542: 85 D3 STA HGRQUAD ;Set Hi-Res Drawing Quadrant (w/ DXH)
; ;^[Saves DX Dir (Pos=Right, Neg=Left)]
F544: B0 0A BCS HGLIN1 ;BGE: Branch if Borrowed
F546: 68 PLA ;Else, Pull Delta X, Low; &
; ----------------------------------- ;Compute Magnitude of Delta X
; ;[(DXL,DXH)=(ABS(X-X0))={& Twos Comp}]:
F547: 49 FF EOR #%11111111 ;Invert Bits (Negate)
F549: 69 01 ADC #1 ;Add to Get New Delta X, Low [DXL=(1-DXL)]
F54B: 48 PHA ;Push New Delta X, Low
F54C: A9 00 LDA #0 ;Prep to Subtract to Get [DXH=(1-DXH-!C)]
F54E: E5 D3 SBC HGRQUAD ;Subtract Hi-Res Drawing Quadrant (w/ DXH)
F550: 85 D1 HGLIN1 STA HGRDX+1 ;Set Hi-Res Drawing Column, High [ABS(DXH)]
F552: 85 D5 STA HGRE+1 ;Set Magnitude of Delta X, High [ABS(DXH)]
F554: 68 PLA ;Pull New Delta X, Low
F555: 85 D0 STA HGRDX ;Set Hi-Res Drawing Column, Low [ABS(DXL)]
F557: 85 D4 STA HGRE ;Set Magnitude of Delta X, Low [ABS(DXL)]
; ----------------------------------- ;Set Pointer to End of Line; Target X Pt:
F559: 68 PLA ;Pull Target Point X-Coordinate, Low
F55A: 85 E0 STA HGRX ;Set Horizontal X-Position, Low
F55C: 86 E1 STX HGRX+1 ;Set Horizontal X-Position, High
; ----------------------------------- ;Set Pointer to End of Line; Target Y Pt:
; ---------------------- ;Compute Delta Y = (Y - Y0):
F55E: 98 TYA ;Get Target Point Y-Coordinate [Low < 256]
F55F: 18 CLC ;Prepare to Subtract w/ Borrow [A-Data-!C]
F560: E5 E2 SBC HGRY ;Subtract Vertical Y-Position [DY=Y-Y0-1]
; ;Now Carry's Direction of Change in Y-Pos
F562: 90 04 BCC HGLIN2 ;BLT: Branch if No Borrow
; ---------------------- ;Else, Compute Magnitude of Delta Y
; ;[(DY)=(ABS(Y-Y0))={& Twos Compliment}]:
F564: 49 FF EOR #%11111111 ;Invert Bits (Negate)
F566: 69 FE ADC #%11111110 ;Add to Get New Delta Y [DY=(254+{C=1}-DY)]
F568: 85 D2 HGLIN2 STA HGRDY ;Set Hi-Res Drawing Row, Low [DY=(-1-DY)]
; ;^[-(Magnitude of Delta Y, Lo) [-ABS(DY)]]
F56A: 84 E2 STY HGRY ;Set Vertical Y-Position = Target Y Point
; ----------------------------------- ;Add Y-Dir to Hi-Res Drawing Quadrant:
F56C: 66 D3 ROR HGRQUAD ;Shift Carry Right into HGRQUAD Bit 7
; ;^[Saves DY Direction (Pos=Up, Neg=Down)]
; ;^[Shifts DX Direction into HGRQUAD Bit 6]
; ----------------------------------- ;Initialize HCOUNT to [-DX-DY-1]:
; ;^[HCount = Number of Dots needed]
F56E: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
F56F: E5 D0 SBC HGRDX ;Subtract Drawing Column, Low [ABS(DXL)]
F571: AA TAX ;Save Result [-ABS(DY)-ABS(DXL)]
F572: A9 FF LDA #%11111111 ;Get -1
F574: E5 D1 SBC HGRDX+1 ;Subtract Drawing Column, High [ABS(DXH)]
F576: 85 1D STA HCOUNT ;Set Hi-Res Line Step [-1-ABS(DXH)]
; ----------------------------------- ;Draw Line:
F578: A4 E5 LDY HGRHORIZ ;Get Hi-Res Byte Horiz. Index from GBASH,L
F57A: B0 05 BCS MOVEX2 ;BGE: Branch if Borrowed; Always Taken
;
; ----------------------------------- ;Move Left or Right One Pixel;
; ;A-Reg Bit 6 has Direction
; ;MOVE X Loop 1 [Overlaps MOVE X Loop 2]:
F57C: 0A MOVEX1L1 ASL A ;Shift Column Direction into Sign Bit
F57D: 20 65 F4 JSR MVLFTRGT ;Move Left or Right One Pixel (1 Dot)
; ---------------------- ;Draw Line Now:
F580: 38 SEC ;Prepare to Add with Carry Set (Adds 1)
F581: A5 D4 MOVEX2 LDA HGRE ;(C=1): Get Magnitude of Delta X, Low
F583: 65 D2 ADC HGRDY ;Add Hi-Res Drawing Row, Low [DY=(-1-DY)]
F585: 85 D4 STA HGRE ;Set Magnitude of Delta X, Low
F587: A5 D5 LDA HGRE+1 ;Get Magnitude of Delta X, High
; ;Carry Clear if HGRE {L,H} goes Negative
F589: E9 00 SBC #0 ;Subtract Zero with Borrow [A-Data-!C]
; ;MOVE X Loop 2 [Overlaps MOVE X Loop 1]:
F58B: 85 D5 MOVEX3L2 STA HGRE+1 ;Set Magnitude of Delta X, High
; ---------------------- ;Plot A Dot:
F58D: B1 26 LDA (GBASL),Y ;Get Dot at Cursor Position
F58F: 45 1C EOR HCOLOR1 ;XOR with Hi-Res Color Mask
F591: 25 30 AND HMASK ;AND with H/GR On-the-Fly Color Bit Mask
F593: 51 26 EOR (GBASL),Y ;XOR with Dot at Cursor Position
F595: 91 26 STA (GBASL),Y ;Set Dot at Cursor Position
F597: E8 INX ;Count Dot Plotted
; ---------------------- ;Finished All Dots?
F598: D0 04 BNE MOVEX4 ;Branch if All Dots Not Done
; ;Else, Test Rest of Count:
F59A: E6 1D INC HCOUNT ;Advance Hi-Res Line Step [-Dots Needed]
; ;HCount = [-DX-DY-1] = No. of Dots needed
F59C: F0 62 BEQ BAS_RTS27 ;EXIT if All Dots Done: Return to Caller
; ---------------------- ;Else, Test Direction:
F59E: A5 D3 MOVEX4 LDA HGRQUAD ;Get Hi-Res Drawing Quadrant
; ;^Bit 7 = DY Dir (Pos=Up, Neg=Down);
; ;^Bit 6 = DX Dir (Pos=Right, Neg=Left)
F5A0: B0 DA BCS MOVEX1L1 ;[LOOP] BGE: Do Next Column (X Dir) Move
F5A2: 20 D3 F4 JSR MVUPDWN0 ;Else, Do Next Row (Y Direction) Move
; ---------------------- ;Advance Hi-Res Horiz Cursor Position:
F5A5: 18 CLC ;Prepare for Add with Carry
F5A6: A5 D4 LDA HGRE ;Get Magnitude of Delta X, Low
F5A8: 65 D0 ADC HGRDX ;Add Hi-Res Drawing Column, Low
F5AA: 85 D4 STA HGRE ;Set Magnitude of Delta X, Low
F5AC: A5 D5 LDA HGRE+1 ;Get Magnitude of Delta X, High
F5AE: 65 D1 ADC HGRDX+1 ;Add Hi-Res Drawing Column, High
; ---------------------- ;(A)=(Magnitude of Delta X, Hi); Next Dot:
F5B0: 50 D9 BVC MOVEX3L2 ;[LOOP] Branch if NO Overflow; Always Taken
;
; ==============================================================================
; Graphics On-the-Fly Color Bit Mask Table (Binary Constants)
; ==============================================================================
; Remember Bits in Hi-Res Byte are Backwards Order: Byte N Byte N+1
; S7654321 SEDCBA98
; ==============================================================================
;
F5B2: 81 MSKTBL DFB %10000001 ;Mask Hi-Res Byte Sign Bit & Column Bit 1
F5B3: 82 DFB %10000010 ;Mask Hi-Res Byte Sign Bit & Column Bit 2
F5B4: 84 DFB %10000100 ;Mask Hi-Res Byte Sign Bit & Column Bit 3
F5B5: 88 DFB %10001000 ;Mask Hi-Res Byte Sign Bit & Column Bit 4
F5B6: 90 DFB %10010000 ;Mask Hi-Res Byte Sign Bit & Column Bit 5
F5B7: A0 DFB %10100000 ;Mask Hi-Res Byte Sign Bit & Column Bit 6
F5B8: C0 DFB %11000000 ;Mask Hi-Res Byte Sign Bit & Column Bit 7
;
; ==============================================================================
F5B9: 1C CON_1C DFB %00011100 ;Mask for "FGH" Bits [($1C)=(%00011100)]
; ; Y-Coord GBASH GBASL
; ;ABCDEFGH (PPPFGHCD) EABAB000
; ------------------------------------------------------------------------------
; Note: X-Coordinate = X-Position = Column; Y-Coordinate = Y-Position = Row
; ==============================================================================
;
;
; ==============================================================================
; Cosine Table (Used by DRAW and XDRAW as Defined Words)
; ==============================================================================
; COS(90*X/16 Degrees)*$100-1; with one-byte precision, X=0 ~ (+/-)16 (17 Bytes)
; ------------------------------------------------------------------------------
; Indexed via DRAW & XDRAW [for Cosines (DX's) & Sines (DY's)] like so:
; LDY COSTBL,X where X is a Positive Low Nibble Value, X=0 ~ +16 (for COS's)
; & LDY COSTBL+1,X where X is a Negative Low Nibble Value, X=0 ~ -16 (for SIN's)
; ==============================================================================
;
; Values
; ----------------------------------------------------------
; Hex ; Decimal & {Low,High}
; --------------- ;-------------------|---------------------
F5BA: FF FE COSTBL DW $FEFF ;=(65,279)=( -257)|(255,254)=( -1, -2)
F5BC: FA F4 DW $F4FA ;=(62,714)=( -2,822)|(250,244)=( -6, -12)
F5BE: EC E1 DW $E1EC ;=(57,836)=( -7,700)|(236,225)=( -20, -31)
F5C0: D4 C5 DW $C5D4 ;=(50,644)=(-14,892)|(212,197)=( -44, -59)
F5C2: B4 A1 DW $A1B4 ;=(41,396)=(-24,140)|(180,161)=( -76, -95)
F5C4: 8D 78 DW $788D ;=(30,861)=(-34,675)|(141,120)=(-115,-136)
F5C6: 61 49 DW $4961 ;=(18,785)=(-46,751)|( 97, 73)=(-159,-183)
F5C8: 31 18 DW $1831 ;=( 6,193)=(-59,343)|( 49, 24)=(-207,-232)
F5CA: FF DFB $FF ;=( 255)=(-65,281)|(255,n/a)=( -1, n/a)
; ==============================================================================
; High-Resolution Graphics Mode (Hi-Res) Coordinate Restore Subroutine:
; ==============================================================================
; HFIND (Never Called by Applesoft): Computes Current Position of Hi-Res Cursor;
; Y-Coordinate from GBASH,GBASL & X-Coordinate from HGRHORIZ & HMASK
; ------------------------------------------------------------------------------
; Note: X-Coordinate = X-Position = Column; Y-Coordinate = Y-Position = Row
; ==============================================================================
;
; ------------------------------------------------------------------------------
; HFIND [Drop-In Only] ;Never Referenced [Can Never Happen]
; (Only Exception: User-Callable Entry Point; BASIC: CALL -2,613 or CALL 62,923
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Convert Base Address to Y-Coordinate;
; ;For: GBASL=EABAB000, GBASH=PPPFGHCD;
; ;Generate: Y-Coordinate=ABCDEFGH:
F5CB: A5 26 HFIND LDA GBASL ;EABAB000; Get Graphics Base Address, Low
F5CD: 0A ASL A ;EABAB000; Shift Sign (E) Bit into Carry
F5CE: A5 27 LDA GBASH ;PPPFGHCD; Get Graphics Base Address, High
F5D0: 29 03 AND #%00000011 ;000000CD; AND Graphics Base Address, High
F5D2: 2A ROL A ;00000CDE; Rotate Left: Carry, Sign (E) Bit
F5D3: 05 26 ORA GBASL ;EABABCDE; OR Graphics Base Address, Low
F5D5: 0A ASL A ;ABABCDE0; Shift Left
F5D6: 0A ASL A ;BABCDE00; Shift Left
F5D7: 0A ASL A ;ABCDE000; Shift Left
F5D8: 85 E2 STA HGRY ;ABCDE000; Save in Vertical Y-Position, Low
F5DA: A5 27 LDA GBASH ;PPPFGHCD; Get Graphics Base Address, High
; ;^(PPP=Screen Page)
F5DC: 4A LSR A ;0PPPFGHC; Shift Right
F5DD: 4A LSR A ;00PPPFGH; Shift Right
F5DE: 29 07 AND #%00000111 ;00000FGH; AND with Seven
F5E0: 05 E2 ORA HGRY ;ABCDEFGH; OR with Vertical Y-Position, Low
F5E2: 85 E2 STA HGRY ;ABCDEFGH; Set Vertical Y-Position, Low
; ----------------------------------- ;Convert HGRHORIZ & HMASK to X-Coordinate
; ;[X = 7 * HGRHORIZ + (HMASK Bit Position)]
; ;[Range 0-$133]:
F5E4: A5 E5 LDA HGRHORIZ ;Get Hi-Res Byte Horizontal Index (I*1)
F5E6: 0A ASL A ;Double (A): Horizontal Index (I*2)
F5E7: 65 E5 ADC HGRHORIZ ;Add Hi-Res Byte Horizontal Index (I*3)
F5E9: 0A ASL A ;Double (A): Horizontal Index (I*6)
; ---------------------- ;Since (I*7) might not fit in 1 byte,
; ; wait till later for last add:
F5EA: AA TAX ;Save (I*6) Horizontal Index
F5EB: CA DEX ;[Loop Prep] Reduce (I*6) Hrz.Index (I*6)-1
; ;Find HMASK Bit Position:
F5EC: A5 30 LDA HMASK ;Get H/GR On-the-Fly Color Bit Mask
F5EE: 29 7F AND #%01111111 ;Discard Sign Bit; Keep 7 Lower Bits (LSBs)
; ;^[Sign Bit = 0 will Stop Loop if reached]
F5F0: E8 HFNDLOOP INX ;Advance (Loop) Shift Counter (I*6) 1st.
; ;^[Saved (I*6) Horizontl Index] (I*6)+1..N
F5F1: 4A LSR A ;Shift LSB Right into Carry
F5F2: D0 FC BNE HFNDLOOP ;LOOP if LSB was Set; Else, Exit Loop:
F5F4: 85 E1 STA HGRX+1 ;Set Horizontal X-Position, High (=0)
; ;Compute HGRHORIZ*7+LOG2(HMASK):
F5F6: 8A TXA ;Get Shift Count
; ;^[Saved (I*6) Horizontl Index] (I*6)+N
; ---------------------- ;Add HGRHORIZ One More Time:
F5F7: 18 CLC ;Prepare for Add with Carry
F5F8: 65 E5 ADC HGRHORIZ ;Add Hi-Res Byte Horizontal Index (I*7)+N
F5FA: 90 02 BCC HFNDFIN ;Branch if No Carryover
F5FC: E6 E1 INC HGRX+1 ;Advance Horizontal X-Position, High
F5FE: 85 E0 HFNDFIN STA HGRX ;Set Horizontal X-Position, Low (I*7)+N
F600: 60 BAS_RTS27 RTS ;Return to Caller
; ==============================================================================
; High-Resolution Graphics Mode (Hi-Res) Shape Drawing Subroutines:
; ==============================================================================
;
; ==============================================================================
; DRAW0: Sets Hi-Res Screen Byte Pointer
; ==============================================================================
; DRAW0 ;Enter: (X,Y) = Shape Starting Address {L,H}
; ^(Never Called by Applesoft) ; (A) = Rotation ($00-$3F)
; ==============================================================================
;
; ------------------------------------------------------------------------------
; DRAW0 [No Drop-In] ;Never Referenced [Can Never Happen]
; (Only Exception: User-Callable Entry Point; BASIC: CALL -2,559 or CALL 62,977;
; But Need to Set A,X & Y Registers 1st; How? POKES & Pg.3 S/R)
; ------------------------------------------------------------------------------
;
F601: 86 1A DRAW0 STX HSHAPE ;Set Hi-Res Screen Byte Pointer, Low
F603: 84 1B STY HSHAPE+1 ;Set Hi-Res Screen Byte Pointer, High
;
; ------------------------------------------------------------------------------
;
; ==============================================================================
; Draw A Shape: Continues "DRAW" Statement
; ==============================================================================
; DRAW1 [Can Drop-In Too] ;Enter: (X,Y) = Shape Starting Address {L,H}
; ; (A) = Rotation ($00-$3F)
; ------------------------------------------------------------------------------
; Note: X-Coordinate = X-Position = Column; Y-Coordinate = Y-Position = Row
; ==============================================================================
;
; ;[Same as XDRAW, but it Compliments Color]
F605: AA DRAW1 TAX ;Save Rotation Angle [($00-$3F)=(0-63)]
; ---------------------- ;Divide Rotation by 16 to Get Quadrant:
F606: 4A LSR A ;Shift Right: (A)=(A/2); NOW
F607: 4A LSR A ;Shift Right: (A)=(A/2); (A/4)
F608: 4A LSR A ;Shift Right: (A)=(A/2); (A/8)
F609: 4A LSR A ;Shift Right: (A)=(A/2); (A/16)
F60A: 85 D3 STA HGRQUAD ;Set HGR Drawing Quadrant
; ;^(Dir: Up=0, Right=1, Down=2, Left=3)
; ---------------------- ;Use Rotation Angle to Index Trig Table
; ;^[to Get COS & SIN, (X,Y) Distances]:
F60C: 8A TXA ;Retrieve Rotation Angle [($00-$3F)=(0-63)]
F60D: 29 0F AND #%00001111 ;AND w/ Rotation to Get Index (Low Nibble)
F60F: AA TAX ;Set Positive Index into Trig Table for DX
F610: BC BA F5 LDY COSTBL,X ;Get COS(90*X/16 Degrees)*$100-1, Low
F613: 84 D0 STY HGRDX ;Save COS in HGRDX, Drawing Column, Low
F615: 49 0F EOR #%00001111 ;Invert (Negate) Low Nibble Bits of Index
F617: AA TAX ;Set Negative Index into Trig Table for DY
F618: BC BB F5 LDY COSTBL+1,X ;Get COS(90*X/16 Degrees)*$100-1, High
F61B: C8 INY ;Advance Value Got; Now have SIN, too
F61C: 84 D2 STY HGRDY ;Save SIN in HGRDY, Drawing Row
; ---------------------- ;Prepare to DRAW One Bit:
F61E: A4 E5 LDY HGRHORIZ ;Get HGR Hrz.Index frm GBAS to Current Byte
F620: A2 00 LDX #0 ;Clear Index into Trig Table
F622: 86 EA STX HGRCLSN ;Clear HGR Collision Counter
F624: A1 1A LDA (HSHAPE,X) ;Get 1st Byte of SHAPE Definition
F626: 85 D1 DRWLP2 STA HGRDX+1 ;Store SHAPE Byte in Drawing Column, High
F628: A2 80 LDX #$80 ;Get Initial Value for Fractional Vectors:
F62A: 86 D4 STX HGRE ;Set .5 in COS X-Component
F62C: 86 D5 STX HGRE+1 ;Set .5 in SIN Y-Component
F62E: A6 E7 LDX HGRSCALE ;Get Drawing Scale Factor
; ---------------------- ;Advance COS X-Component:
F630: A5 D4 DRWLP3 LDA HGRE ;Get COS X-Component
F632: 38 SEC ;Prepare for Add w/ Carry Set (Adds 1)
F633: 65 D0 ADC HGRDX ;Add COS X-Component to Drawing Column
F635: 85 D4 STA HGRE ;Set COS X-Component
; ;^[Save Fraction Part, No Integer Part]
F637: 90 04 BCC DRW4 ;BLT: Branch if No Carryover; Else, ...*
F639: 20 B3 F4 JSR LRUD1 ;* DRAW One Bit (w/o 90 Degree Rotation)
; ;^[Same as XDRAW <- Compliments Color]
; ---------------------- ;Advance SIN Y-Component:
F63C: 18 CLC ;Prepare for Add w/ Carry Clear (Adds 0)
F63D: A5 D5 DRW4 LDA HGRE+1 ;Get SIN Y-Component
F63F: 65 D2 ADC HGRDY ;Add SIN Y-Component to Drawing Row
F641: 85 D5 STA HGRE+1 ;Set SIN Y-Component
; ;^[Save Fraction Part, No Integer Part]
F643: 90 03 BCC DRW5 ;BLT: Branch if No Carryover; Else, ...*
F645: 20 B4 F4 JSR LRUD2 ;* DRAW One Bit (w/ 90 Degree Rotation)
; ;^[Same as XDRAW <- Compliments Color]
; ---------------------- ;Next Iteration:
F648: CA DRW5 DEX ;Reduce Drawing Scale Factor
F649: D0 E5 BNE DRWLP3 ;LOOP if Still on Same SHAPE Item
F64B: A5 D1 LDA HGRDX+1 ;Get Next SHAPE Item
; ;Go to Next 3-Bit Vector:
F64D: 4A LSR A ;Shift Right: 1st Bit Out
F64E: 4A LSR A ;Shift Right: 2nd Bit Out
F64F: 4A LSR A ;Shift Right: 3rd Bit Out
F650: D0 D4 BNE DRWLP2 ;LOOP if More in this SHAPE Byte
F652: E6 1A INC HSHAPE ;Advance to Next SHAPE Byte, Low
F654: D0 02 BNE DRW6 ;Branch Until Page Boundary Reached
F656: E6 1B INC HSHAPE+1 ;Advance to Next SHAPE Byte, High
F658: A1 1A DRW6 LDA (HSHAPE,X) ;Get Next Byte of SHAPE Definition
F65A: D0 CA BNE DRWLP2 ;LOOP if SHAPE Definition <> 0
F65C: 60 RTS ;Else, Finished, Return to Caller
; ==============================================================================
; High-Resolution Graphics Mode (Hi-Res) Shape XDRAW Subroutine:
; ==============================================================================
;
; ==============================================================================
; XDRAW0: Sets Hi-Res Screen Byte Pointer
; ==============================================================================
; XDRAW0 ;Enter: (X,Y) = Shape Starting Address {L,H}
; ^(Never Called by Applesoft) ; (A) = Rotation ($00-$3F)
; ==============================================================================
;
; ------------------------------------------------------------------------------
; XDRAW0 [No Drop-In] ;Never Referenced [Can Never Happen]
; (Only Exception: User-Callable Entry Point; BASIC: CALL -2,467 or CALL 63,069;
; But Need to Set A,X & Y Registers 1st; How? POKES & Pg.3 S/R)
; ------------------------------------------------------------------------------
;
F65D: 86 1A XDRAW0 STX HSHAPE ;Set Hi-Res Screen Byte Pointer, Low
F65F: 84 1B STY HSHAPE+1 ;Set Hi-Res Screen Byte Pointer, High
;
; ------------------------------------------------------------------------------
;
; ==============================================================================
; XDraw A Shape: Continues "XDRAW" Statement
; ==============================================================================
; XDRAW1 [Can Drop-In Too] ;Enter: (X,Y) = Shape Starting Address {L,H}
; ; (A) = Rotation ($00-$3F)
; ------------------------------------------------------------------------------
; Note: X-Coordinate = X-Position = Column; Y-Coordinate = Y-Position = Row
; ==============================================================================
;
; ;[Same as DRAW, but Compliments Color]
F661: AA XDRAW1 TAX ;Save Rotation Angle [($00-$3F)=(0-63)]
; ---------------------- ;Divide Rotation by 16 to Get Quadrant:
F662: 4A LSR A ;Shift Right: (A)=(A/2); NOW
F663: 4A LSR A ;Shift Right: (A)=(A/2); (A/4)
F664: 4A LSR A ;Shift Right: (A)=(A/2); (A/8)
F665: 4A LSR A ;Shift Right: (A)=(A/2); (A/16)
F666: 85 D3 STA HGRQUAD ;Set HGR Drawing Quadrant
; ;^(Dir: Up=0, Right=1, Down=2, Left=3)
; ---------------------- ;Use Rotation Angle to Index Trig Table
; ;^[to Get COS & SIN, (X,Y) Distances]:
F668: 8A TXA ;Retrieve Rotation Angle [($00-$3F)=(0-63)]
F669: 29 0F AND #%00001111 ;AND w/ Rotation to Get Index (Low Nibble)
F66B: AA TAX ;Set Positive Index into Trig Table for DX
F66C: BC BA F5 LDY COSTBL,X ;Get COS(90*X/16 Degrees)*$100-1, Low
F66F: 84 D0 STY HGRDX ;Save COS in HGRDX, Drawing Column, Low
F671: 49 0F EOR #%00001111 ;Invert (Negate) Low Nibble Bits of Index
F673: AA TAX ;Set Negative Index into Trig Table for DY
F674: BC BB F5 LDY COSTBL+1,X ;Get COS(90*X/16 Degrees)*$100-1, High
F677: C8 INY ;Advance Value Got; Now have SIN, too
F678: 84 D2 STY HGRDY ;Save SIN in HGRDY, Drawing Row
; ---------------------- ;Prepare to DRAW One Bit:
F67A: A4 E5 LDY HGRHORIZ ;Get HGR Hrz.Index frm GBAS to Current Byte
F67C: A2 00 LDX #0 ;Clear Index into Trig Table
F67E: 86 EA STX HGRCLSN ;Clear HGR Collision Counter
F680: A1 1A LDA (HSHAPE,X) ;Get 1st Byte of SHAPE Definition
F682: 85 D1 XDRWLP2 STA HGRDX+1 ;Store SHAPE Byte in Drawing Column, High
F684: A2 80 LDX #$80 ;Get Initial Value for Fractional Vectors:
F686: 86 D4 STX HGRE ;Set .5 in COS X-Component
F688: 86 D5 STX HGRE+1 ;Set .5 in SIN Y-Component
F68A: A6 E7 LDX HGRSCALE ;Get Drawing Scale Factor
; ---------------------- ;Advance COS X-Component:
F68C: A5 D4 XDRWLP3 LDA HGRE ;Get COS X-Component
F68E: 38 SEC ;Prepare for Add w/ Carry Set (Adds 1)
F68F: 65 D0 ADC HGRDX ;Add COS X-Component to Drawing Column
F691: 85 D4 STA HGRE ;Set COS X-Component
; ;^[Save Fraction Part, No Integer Part]
F693: 90 04 BCC XDRW4 ;BLT: Branch if No Carryover; Else, ...*
F695: 20 9C F4 JSR LRUDX1 ;* XDRAW One Bit (w/o 90 Degree Rotation)
; ;^[Same as DRAW, but Compliments Color]
; ---------------------- ;Advance SIN Y-Component:
F698: 18 CLC ;Prepare for Add w/ Carry Clear (Adds 0)
F699: A5 D5 XDRW4 LDA HGRE+1 ;Get SIN Y-Component
F69B: 65 D2 ADC HGRDY ;Add SIN Y-Component to Drawing Row
F69D: 85 D5 STA HGRE+1 ;Set SIN Y-Component
; ;^[Save Fraction Part, No Integer Part]
F69F: 90 03 BCC XDRW5 ;BLT: Branch if No Carryover; Else, ...*
F6A1: 20 9D F4 JSR LRUDX2 ;* XDRAW One Bit (w/ 90 Degree Rotation)
; ;^[Same as DRAW, but Compliments Color]
; ---------------------- ;Next Iteration:
F6A4: CA XDRW5 DEX ;Reduce Drawing Scale Factor
F6A5: D0 E5 BNE XDRWLP3 ;LOOP if Still on Same SHAPE Item
F6A7: A5 D1 LDA HGRDX+1 ;Get Next SHAPE Item
; ;Go to Next 3-Bit Vector:
F6A9: 4A LSR A ;Shift Right: 1st Bit Out
F6AA: 4A LSR A ;Shift Right: 2nd Bit Out
F6AB: 4A LSR A ;Shift Right: 3rd Bit Out
F6AC: D0 D4 BNE XDRWLP2 ;LOOP if More in this SHAPE Byte
F6AE: E6 1A INC HSHAPE ;Advance to Next SHAPE Byte, Low
F6B0: D0 02 BNE XDRW6 ;Branch Until Page Boundary Reached
F6B2: E6 1B INC HSHAPE+1 ;Advance to Next SHAPE Byte, High
F6B4: A1 1A XDRW6 LDA (HSHAPE,X) ;Get Next Byte of SHAPE Definition
F6B6: D0 CA BNE XDRWLP2 ;LOOP if SHAPE Definition <> 0
F6B8: 60 RTS ;Else, Finished, Return to Caller
; ==============================================================================
; Parsing Routines used by BASIC for Hi-Res Access:
; ==============================================================================
;
; ==============================================================================
; HFNS Subroutine: Get Hi-Res Plotting Coordinates (0-279,0-191) from TXTPTR
; Leave Registers set for HPOSN: (X,Y) = X-Coordinate (Column)
; (A) = Y-Coordinate (Row)
; ==============================================================================
;
; ---------------------- ;Evaluate Expression; Must be Numeric:
F6B9: 20 67 DD HFNS JSR FRMNUM ;Get Value Specified as 16-Bit Integer
F6BC: 20 52 E7 JSR GETADR ;Convert FAC to a 16-bit Value in LINNUM
; ---------------------- ;Get Column-Coord in (X,Y)={Low,High}:
F6BF: A4 51 LDY LINNUM+1 ;Get Horizontal-Column X-Coordinate, High
F6C1: A6 50 LDX LINNUM ;Get Horizontal-Column X-Coordinate, Low
F6C3: C0 01 CPY #>HGRWIDE ;< 280 Pixels: HGR Screens Width, High?
F6C5: 90 06 BCC HFNS1 ;BLT: Branch if in Range, < 280 Pixels
F6C7: D0 1D BNE GGERR ;Branch if Too Big (>=280); Throw IQ ERROR
F6C9: E0 18 CPX #<HGRWIDE ;< 280 Pixels: HGR Screens Width, Low?
F6CB: B0 19 BCS GGERR ;Branch if Too Big (>=280); Throw IQ ERROR
; ;Else, in Range, < 280 Pixels ...
; ---------------------- ;Stack Column-Coordinate:
F6CD: 8A HFNS1 TXA ;Get Horizontal-Column X-Coordinate, Low
F6CE: 48 PHA ;Push Horizontal-Column X-Coordinate, Low
F6CF: 98 TYA ;Get Horizontal-Column X-Coordinate, High
F6D0: 48 PHA ;Push Horizontal-Column X-Coordinate, High
; ---------------------- ;Get Row-Coordinate in Accumulator (A):
F6D1: A9 2C LDA #',' ;Require a Comma (at TXTPTR)
F6D3: 20 C0 DE JSR SYNCHR ;If = Chr Got, Get Next; Else, Syntax Error
F6D6: 20 F8 E6 JSR GETBYT ;Convert Expression to a Byte in X-Reg
F6D9: E0 C0 CPX #HGRHIGH ;< 192 Pixels: HGR Screens Height?
F6DB: B0 09 BCS GGERR ;Branch if Too Big (>=192); Throw IQ ERROR
F6DD: 86 9D STX FAC ;Save Vertical-Row Y-Coordinate in FAC
; ---------------------- ;Retrieve Column & Row Coordinates:
F6DF: 68 PLA ;Pull Horizontal-Column X-Coordinate, High
F6E0: A8 TAY ;Set Horizontal-Column X-Coordinate, High
F6E1: 68 PLA ;Pull Horizontal-Column X-Coordinate, Low
F6E2: AA TAX ;Set Horizontal-Column X-Coordinate, Low
F6E3: A5 9D LDA FAC ;Set Vertical-Row Y-Coordinate from FAC
; ---------------------- ;Finished (with Registers set for HPOSN):
F6E5: 60 RTS ;Return to Caller
F6E6: 4C 06 F2 GGERR JMP BAS_GOERR ;Go Print "?Illegal Quantity" Error Message
; ==============================================================================
; "HCOLOR=" Statement: Immediate & Deferred; Parameter: HCOLOR = Aexpr; (0~7)
; ==============================================================================
; Sets High-Resolution Graphics Color; Color Names & Associated Values:
; +------------+-------------+---------------------------+---------------------+
; | 0 Blackl | 4 Black2 _/ 1 Green (depends on TV) | 5 (depends on TV) |
; | 3 Whitel | 7 White2 \ 2 Blue (depends on TV) | 6 (depends on TV) |
; +------------+-------------+---------------------------+---------------------+
; A High-Resolution Dot plotted with HCOLOR=3 (White) will be Blue if the
; X-Coordinate of the Dot is Even, Green if the X-Coordinate is Odd, and White
; only if both (X,Y) & (X+1,Y) are plotted; This is due to the way home TVs work
; [the Technology of the Time (late 1970s)--JPD]
; ==============================================================================
;
F6E9: 20 F8 E6 HCOLOR JSR GETBYT ;Convert Expression to a Byte in X-Reg
F6EC: E0 08 CPX #$08 ;Value must be 0~7
F6EE: B0 F6 BCS GGERR ;Branch if Too Big (>=8); Throw IQ ERROR
F6F0: BD F6 F6 LDA COLORTBL,X ;Get Color Pattern from Table
F6F3: 85 E4 STA HGRCOLOR ;Save Hi-Res Graphics Color
F6F5: 60 BAS_RTS28 RTS ;Return to Caller
; ==============================================================================
; High Resolution Graphics Colors Table
; ==============================================================================
;
F6F6: 00 COLORTBL DFB %00000000 ;Black1
F6F7: 2A DFB %00101010 ;Green
F6F8: 55 DFB %01010101 ;Violet
F6F9: 7F DFB %01111111 ;White1
F6FA: 80 DFB %10000000 ;Black2
F6FB: AA DFB %10101010 ;Orange
F6FC: D5 DFB %11010101 ;Cyan (Light-Blue)
F6FD: FF DFB %11111111 ;White2
; ==============================================================================
; "HPLOT" Statement: Immediate & Deferred
; ==============================================================================
; Parameters: HPLOT Aexprl, Aexpr2 [{TO Aexpr3, Aexpr4}]
; -----------------------------------------------------------------------------
; HPLOT Plots a High-Resolution Dot, or a Line from the Last Dot Plotted, & may
; be Extended (Subject to Screen Limits & Character Instruction Limits)
; ==============================================================================
;
F6FE: C9 C1 HPLOT CMP #TOK_TO ;Continue Plotting "TO" Requested?
F700: F0 0D BEQ HPLOT2 ;YES, Start from Current Location
F702: 20 B9 F6 JSR HFNS ;NO, Get Starting Point of Line
F705: 20 57 F4 JSR HPLOT0 ;Plot Point & Prep to Draw a Line from it
F708: 20 B7 00 HPLOTLOOP JSR CHRGOT ;Get Character at End of Expression
F70B: C9 C1 CMP #TOK_TO ;Is a Line Specified?
F70D: D0 E6 BNE BAS_RTS28 ;NO, Exit: a Line is Not Specified
; ;YES, Advance TXTPTR
; ;(Why Not CHRGET? A: CMP Sets Carry)
F70F: 20 C0 DE HPLOT2 JSR SYNCHR ;If = Chr Got, Get Next; Else, Syntax Error
F712: 20 B9 F6 JSR HFNS ;Get Point Coordinates at End of Line
; ;Prepare to Continue Plotting "TO" Line:
F715: 84 9D STY DSCTMP ;Swap (Y) into (T)
F717: A8 TAY ;Swap (A) into (Y)
F718: 8A TXA ;Swap (X) into (A)
F719: A6 9D LDX DSCTMP ;Swap (T) into (X)
F71B: 20 3A F5 JSR HGLIN ;Plot Line
F71E: 4C 08 F7 JMP HPLOTLOOP ;LOOP Until No More "TO" Phrases
; ==============================================================================
; "ROT=" Statement: Immediate & Deferred; Parameter: ROT = Aexpr
; ==============================================================================
; Sets Angular Rotation for SHAPE to be Drawn by DRAW or XDRAW
; ==============================================================================
;
F721: 20 F8 E6 ROT JSR GETBYT ;Convert Expression to a Byte in X-Reg
F724: 86 F9 STX HGRROT ;Set Hi-Res Graphics Rotation Value
F726: 60 RTS ;Return to Caller
; ==============================================================================
; "SCALE=" Statement: Immediate & Deferred; Parameter: SCALE = Aexpr
; ==============================================================================
; Sets SCALE Size for SHAPE to be Drawn by DRAW or XDRAW
; ==============================================================================
;
F727: 20 F8 E6 SCALE JSR GETBYT ;Convert Expression to a Byte in X-Reg
F72A: 86 E7 STX HGRSCALE ;Set Hi-Res Graphics Drawing Scale Factor
F72C: 60 RTS ;Return to Caller
; ==============================================================================
; DRWPTR Subroutine: Prepares for DRAW & XDRAW:
; ==============================================================================
;
; ----------------------------------- ;Find & Check SHAPE Number Specified:
F72D: 20 F8 E6 DRWPTR JSR GETBYT ;Convert Expression to a Byte in X-Reg
; ;Setup Pointer to SHAPE Table Start:
F730: A5 E8 LDA HGRSHPTR ;Get HGR SHAPE Pointer, Low
F732: 85 1A STA HSHAPE ;Set SHAPE Table Start Pointer, Low
F734: A5 E9 LDA HGRSHPTR+1 ;Get HGR SHAPE Pointer, High
F736: 85 1B STA HSHAPE+1 ;Set SHAPE Table Start Pointer, High
F738: 8A TXA ;Get SHAPE Number Specified
; ---------------------- ;Compare to Total No. of SHAPEs in Table:
F739: A2 00 LDX #0 ;Clear (Indexed Indirect) Addressing Index
F73B: C1 1A CMP (HSHAPE,X) ;Subtract Total Number of SHAPE Definitions
F73D: F0 02 BEQ DRWPTR1 ;Branch if Both Numbers of SHAPEs are Equal
F73F: B0 A5 BCS GGERR ;Else, Branch if Spec Too Big; Throw IQ ERR
; ----------------------------------- ;Else, Find Address of SHAPE in Table:
F741: 0A DRWPTR1 ASL A ;Double SHAPE Number Specified for Index
F742: 90 03 BCC DRWPTR2 ;Branch if SHAPE Number Specified < 128
F744: E6 1B INC HSHAPE+1 ;Advance SHAPE Table Start Pointer, High
; ---------------------- ;Get Offset frm SHAPE Table Offsets Index:
F746: 18 CLC ;Prepare for Add with Carry
F747: A8 DRWPTR2 TAY ;Get Index into SHAPE Table Offsets Index
F748: B1 1A LDA (HSHAPE),Y ;Get SHAPE Offset, Low
F74A: 65 1A ADC HSHAPE ;Add SHAPE Table Start Pointer, Low
F74C: AA TAX ;Save Low Address of SHAPE in Table
F74D: C8 INY ;INC Index into SHAPE Table Offsets Index
F74E: B1 1A LDA (HSHAPE),Y ;Get SHAPE Offset, High
F750: 65 E9 ADC HGRSHPTR+1 ;Add HGR SHAPE Pointer, High
; ---------------------- ;Save Address of SHAPE in Table:
F752: 85 1B STA HSHAPE+1 ;Set SHAPE Start Pointer, High
F754: 86 1A STX HSHAPE ;Set SHAPE Start Pointer, Low
; ----------------------------------- ;Any More "AT" Position Coordinates?
F756: 20 B7 00 JSR CHRGOT ;Get Last Char/Token Got
F759: C9 C5 CMP #TOK_AT ;Is it an "AT" Phrase?
F75B: D0 09 BNE DRWPTR3 ;Branch if Not: DRAW at Current Position
; ---------------------- ;Else, Scan "AT" Position Coordinates:
F75D: 20 C0 DE JSR SYNCHR ;If = Chr Got, Get Next; Else, Syntax Error
F760: 20 B9 F6 JSR HFNS ;Get Column & Row to Start Drawing SHAPE
F763: 20 11 F4 JSR HPOSN ;Set Hi-Res Cursor at Position Coordinates
; ----------------------------------- ;DRAW at Current Position:
F766: A5 F9 DRWPTR3 LDA HGRROT ;Get Rotation Value
F768: 60 RTS ;Return to Caller
; ==============================================================================
; "DRAW" Statement: Immediate & Deferred;
; Parameters: DRAW Aexprl [AT Aexpr2, Aexpr3]
; ==============================================================================
; DRAWs a SHAPE (Aexprl)=(0~255) in High-Resolution Graphics at (X,Y)=(Aexpr2,
; Aexpr3)=(0~278,0~191) from a SHAPE Table previously loaded into Memeory using
; SHLOAD (from Tape) or BLOAD (from Disk), or typed in using Apple's F8 Monitor
; Program.
; ==============================================================================
;
; ;[Same as XDRAW, but it Compliments Color]
F769: 20 2D F7 DRAW JSR DRWPTR ;Prepare for DRAW|XDRAW
F76C: 4C 05 F6 JMP DRAW1 ;Go DRAW 1 Shape
; ==============================================================================
; "XDRAW" Statement: Immediate & Deferred;
; Parameters: XDRAW Aexprl [AT Aexpr2, Aexpr3]
; ==============================================================================
; Provides a way to Erase SHAPEs previously Drawn: XDRAWing a SHAPE at the same
; Location, Rotation, & Scale previously Drawn will Erase it without Erasing its
; Background; Same as DRAW, except Color used to XDRAW SHAPE is Complement of
; Color already existing at each Point plotted; Pairs of Complementary Colors
; are: Black & White; Cyan (or Light-Blue) & Green; and Violet & Orange
; ==============================================================================
;
; ;[Same as DRAW, but Compliments Color]
F76F: 20 2D F7 XDRAW JSR DRWPTR ;Prepare for DRAW|XDRAW
F772: 4C 61 F6 JMP XDRAW1 ;Go XDRAW 1 Shape
; ==============================================================================
; "SHLOAD" Command Statement: Immediate & Deferred; No Parameters or Options
; ==============================================================================
; Reads/Loads a SHAPE Table from Cassette Tape to a Position just below HIMEM,
; which is then moved to just below the SHAPE Table LOADed
; ==============================================================================
;
; ----------------------------------- ;Prepare to Load Shape Table from Tape:
; ---------------------- ;Prepare to Read 2 Bytes into LINNUM:
F775: A9 00 SHLOAD LDA #0 ;Clear Accumulator
F777: 85 3D STA A1H ;Clear Monitor General Purpose A1-Reg, High
F779: 85 3F STA A2H ;Clear Monitor General Purpose A2-Reg, High
F77B: A0 50 LDY #LINNUM ;Get ZP Address of LINNUM
F77D: 84 3C STY A1L ;Set Monitor General Purpose A1-Reg, Low
F77F: C8 INY ;Get ZP Address of LINNUM+1
F780: 84 3E STY A2L ;Set Monitor General Purpose A2-Reg, Low
; ---------------------- ;Read Length into LINNUM:
F782: 20 FD FE JSR MON_READ ;Go Read 2 Bytes of Data from Tape
; ---------------------- ;Prepare to Read LINNUM Bytes, Starting at
;
; ;(HIMEM)-(LINNUM) & Ending at (HIMEM)-1:
F785: 18 CLC ;Prepare to Subtract w/ Borrow [A-Data-!C]
F786: A5 73 LDA MEMSIZ ;Get Top End of String Space (HIMEM), Low
F788: AA TAX ;Set (X)=[String Space End (HIMEM), Low]
F789: CA DEX ;(X)=[(HIMEM)-1] Forming End Pointer, Low
F78A: 86 3E STX A2L ;Set Monitor General Purpose A2-Reg, Low
F78C: E5 50 SBC LINNUM ;[(HIMEM)-(LINNUM)] Forming Start Ptr, Low
F78E: 48 PHA ;Push Start Pointer, Low
F78F: A5 74 LDA MEMSIZ+1 ;Get Top End of String Space (HIMEM), High
F791: A8 TAY ;Set (Y)=[String Space End (HIMEM), High]
F792: E8 INX ;Set (X)=[String Space End (HIMEM), Low]
F793: D0 01 BNE SHLOAD1 ;Branch if Not at Page Boundary
F795: 88 DEY ;(Y)=[(HIMEM)-1] Forming End Pointer, High
F796: 84 3F SHLOAD1 STY A2H ;Set Monitor General Purpose A2-Reg, High
F798: E5 51 SBC LINNUM+1 ;[(HIMEM)-(LINNUM)] Forming Start Ptr, High
F79A: C5 6E CMP STREND+1 ;Subtract End of Vars & Ptrs Storage, High
; ;^[AKA: Bottom/Start of Free Space]
F79C: 90 02 BCC SHLOAD2 ;Branch if SHLOAD would clobber Vars & Ptrs
F79E: D0 03 BNE SHLOAD3 ;Branch if SHLOAD has sufficient Free Space
F7A0: 4C 10 D4 SHLOAD2 JMP MEMERR ;Throw an "?Out Of Memory" Error
; ----------------------------------- ;Load Shape Table from Tape:
; ---------------------- ;(A)=[(HIMEM)-(LINNUM)] Start Ptr, High:
F7A3: 85 74 SHLOAD3 STA MEMSIZ+1 ;Set Top End of String Space (HIMEM), High
F7A5: 85 70 STA FRETOP+1 ;Set FreSpcEnd/StringStorageStart Ptr, High
F7A7: 85 3D STA A1H ;Set Monitor General Purpose A1-Reg, High
F7A9: 85 E9 STA HGRSHPTR+1 ;Set Hi-Res Graphics Shape Pointer, High
F7AB: 68 PLA ;Pull [(HIMEM)-(LINNUM)] Start Pointer, Low
F7AC: 85 E8 STA HGRSHPTR ;Set Hi-Res Graphics Shape Pointer, Low
F7AE: 85 73 STA MEMSIZ ;Set Top End of String Space (HIMEM), Low
F7B0: 85 6F STA FRETOP ;Set FreSpcEnd/StringStorageStart Ptr, Low
F7B2: 85 3C STA A1L ;Set Monitor General Purpose A1-Reg, Low
F7B4: 20 FA FC JSR RD2BIT ;Read Two Bits, Tape Transitions; Find Edge
F7B7: A9 03 LDA #3 ;Create Short Delay for Intermediate Header
F7B9: 4C 02 FF JMP MON_READ2 ;Go Read Shape Table into (A1-Reg)
;
; ==============================================================================
; Non-Graphics Subroutines:
; ==============================================================================
;
; ==============================================================================
; Tape Array STORE & RECALL Routines:
; ==============================================================================
;
; ==============================================================================
; Called by STORE & RECALL:
; Point Tape Array Data Pointers at First Value in Specified Array
; ==============================================================================
; NOTE: (ARYPTR) = (HIGHDS)
; ------------------------------------------------------------------------------
; (ARYPTR) = Applesoft Array Pointer
; (HIGHDS) = Highest Destination Adrs +1
; ==============================================================================
;
; ----------------------------------- ;Compute Offset to Next Variable:
F7BC: 18 TAPEPTR CLC ;Prepare for Add with Carry
F7BD: A5 9B LDA LOWTR ;Get Specified Array Variable Pointer, Low
F7BF: 65 50 ADC LINNUM ;Add Array Size, Low
F7C1: 85 3E STA A2L ;Set Monitor General Purpose A2-Reg, Low
F7C3: A5 9C LDA LOWTR+1 ;Get Specified Array Variable Pointer, High
F7C5: 65 51 ADC LINNUM+1 ;Add Array Size, High
F7C7: 85 3F STA A2H ;Set Monitor General Purpose A2-Reg, High
; ;A2 Now has Offset to Next Variable
; ----------------------------------- ;Get Address of 1st Value in Array:
F7C9: A0 04 LDY #4 ;Point to Number of Array Dimensions
; ;^[Data within Array Variable Pointer]
F7CB: B1 9B LDA (LOWTR),Y ;Get Number of Array Dimensions
F7CD: 20 EF E0 JSR GETARY2 ;Compute Address of 1st Value in Array
; ;ARYPTR Now has Adrs of 1st Value in Array
F7D0: A5 94 LDA ARYPTR ;Get Array Pointer, Low
F7D2: 85 3C STA A1L ;Set Monitor General Purpose A1-Reg, Low
F7D4: A5 95 LDA ARYPTR+1 ;Get Array Pointer, High
F7D6: 85 3D STA A1H ;Set Monitor General Purpose A1-Reg, High
; ;A1 Now has Address of 1st Value in Array
F7D8: 60 RTS ;Return to Caller
; ==============================================================================
; Called by STORE & RECALL: Points LOWTR at Array Specified if Found
; ==============================================================================
;
; ;Get an Array Pointer:
F7D9: A9 40 GETARYPTR LDA #$40 ;Prepare to Flag "Called from GETARYPTR"
F7DB: 85 14 STA SUBFLG ;Set Subscript Flag ($00=Allowed, $80=NOT)
F7DD: 20 E3 DF JSR PTRGET ;Locate Variable: Returns Address
; ; in VARPTR & [(A,Y)={Low,High}]
F7E0: A9 00 LDA #$00 ;Prepare to Allow Subscripts
F7E2: 85 14 STA SUBFLG ;Set Subscript Flag ($00=Allowed, $80=NOT)
; ;Prepare to Read/Write a 3-Byte Header
; ;from/to a Cassette Tape (Audio I/O):
F7E4: 4C F0 D8 JMP VARTIO ;Point A1/A2 at LINNUM/TEMPPT ZP-Pointers
; ==============================================================================
; "HTAB" Statement: Immediate & Deferred; Parameter: HTAB Aexprl
; ==============================================================================
; Moves the Cursor to the Column Position Specified (Aexprl), on the Current
; Screen Line, Relative to the Left Margin of the Text Window, but Independent
; of the Line Width
; ==============================================================================
;
; ;Get Column Position Specified:
F7E7: 20 F8 E6 HTAB JSR GETBYT ;Convert Expression to a Byte in X-Reg
F7EA: CA DEX ;Reduce Column Position Specified (-1)
F7EB: 8A TXA ;Get Text Screen Position (0~255)
; <<< If WNDLFT <> (0), HTAB can Print Outside of Screen, within Program! >>>
F7EC: C9 28 HTABLOOP CMP #BASL ;Is it More or Less than Text Screen Width?
F7EE: 90 0A BCC HTABEXIT ;BLT: Branch if it is < 1 Screen Width
F7F0: E9 28 SBC #BASL ;Else, Subtract 1 Screen Width & Add a Line
F7F2: 48 PHA ;Push Reduced HTAB Value
F7F3: 20 FB DA JSR CRDO ;Print a Carriage <Return> Character
F7F6: 68 PLA ;Pull Reduced HTAB Value
F7F7: 4C EC F7 JMP HTABLOOP ;LOOP Until it is < 1 Screen Width
F7FA: 85 24 HTABEXIT STA CH ;Set Cursor Horizontal Displacement
F7FC: 60 RTS ;Return to Caller
; ==============================================================================
; Someone's initials? K? R? W? Richard Weiland?
; ==============================================================================
; IIRC, I read, or heard somewhere, long ago, that this was a plea inserted by
; one of the authors because he had cancer, meaning: "Kill Ric Weiland!"
;
; RIP: Richard W. "Ric" Weiland (April 21, 1953 - June 24, 2006)
;
; But, it is not in any of these . . .
;
; References:
;
; Applesoft BASIC <https://en.wikipedia.org/wiki/Applesoft_BASIC>
; Ric Weiland <https://en.wikipedia.org/wiki/Ric_Weiland> <--[Most likely!]
; Steve Wozniak <https://en.wikipedia.org/wiki/Steve_Wozniak>
; Randy Wigginton <https://en.wikipedia.org/wiki/Randy_Wigginton>
; ==============================================================================
F7FD: CB D2 D7 KRW ASC ^"KRW" ;Someone's initials? K? R? W?
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
; ==============================================================================
; Applesoft - End of all Parts
; ==============================================================================
; XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
;
; <---[$F8 Page Boundary]
;
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
; ==============================================================================
; ROM Space ($F800-$FFFF): ROM Socket $F8 on a real Apple II Plus.
; ==============================================================================
; ZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZZ
;
; ==============================================================================
; ORIGIN EQU $F800 ;Old Monitor ROM or New Autostart Monitor ROM Start Address.
; ;Or, Language Card Additional ROM/RAM:
; ;When Language Card {ROM/RAM} is Deselected, {RAM/ROM} on
; ;Card is Active, {respectively}.
; ==============================================================================
;
;
; ==============================================================================
; New Monitor ROM (Modified AutoStart Image):
; ==============================================================================
; Apple II Monitor II by Steve Wozniak. Modified Nov 1978 by John A
; Copyright 1978 by Apple Computer, Inc. All Rights Reserved.
; ==============================================================================
;
; ==============================================================================
; Monitor Low Resolution Graphics Plotting Routines:
; ==============================================================================
;
; ----------------------------------- ;Plot a Point on Lo-Res Screen:
; ;[Enter with (A)=Row; (Y)=Column]
F800: 4A MON_PLOT LSR A ;(A)=(Y-Coordinate/2)
F801: 08 PHP ;Push Status (P-Reg); Save Carry (LSB)
F802: 20 47 F8 JSR GBASCALC ;Calculate Base Address in GBASL,H
F805: 28 PLP ;Pull Status (P-Reg); Retrieve Carry (LSB)
F806: A9 0F LDA #%00001111 ;Mask $0F if Even
F808: 90 02 BCC RTMASK ;Branch if LSB (in Carry) is a Zero
F80A: 69 E0 ADC #%11100000 ;Mask $F0 if Odd; (Adds 1 with Carry Set)
; ;^[($0F+$01)+($E0) = ($10)+($E0) = ($F0)]
F80C: 85 2E RTMASK STA MASK ;Store AND Mask (for High/Low Nibble)
;
; ----------------------------------- ;Plot a Square Point on Lo-Res Screen:
; ;[I/O: (GBASL,H & MASK)=Row; (Y)=Column]
F80E: B1 26 PLOT1 LDA (GBASL),Y ;Get Data
F810: 45 30 EOR HMASK ;XOR with Color; [Set HMASK 1st!]
F812: 25 2E AND MASK ;AND with Nibble Mask
F814: 51 26 EOR (GBASL),Y ;XOR with Data
F816: 91 26 STA (GBASL),Y ;Set Data
F818: 60 RTS ;Return to Caller
; ----------------------------------- ;Draw Horizontal Line on Lo-Res Screen:
; ;[Enter with (A)=Row; (Y)~(H2)=Column
; Ends]
F819: 20 00 F8 HLINE JSR MON_PLOT ;Plot Square
;
; ----------------------------------- ;Draw Horizontal Line on Lo-Res Screen:
; ;[(GBASL,H & MASK)=Row
; ; (Y)~(H2)=Column Ends]
F81C: C4 2C HLINE1 CPY H2 ;Done?
F81E: B0 11 BCS MON_RTS1 ;YES, Return to Caller
F820: C8 INY ;NO, Advance Index (X-Coordinate)
F821: 20 0E F8 JSR PLOT1 ;Plot Next Square
F824: 90 F6 BCC HLINE1 ;Loop; Always Taken
;
; ----------------------------------- ;Draw Vertical Line on Lo-Res Screen:
; LOOP ;[(A+1+Carry)~(V2)=Row Ends; (Y)=Column]
F826: 69 01 VLINEZ ADC #1 ;(A)=[Next Row (Y-Coordinate)]
;
; ----------------------------------- ;Draw Vertical Line on Lo-Res Screen:
; ;[Enter w/ (A)~(V2)=Row Ends; (Y)=Column]
F828: 48 VLINE PHA ;Push Next Row
F829: 20 00 F8 JSR MON_PLOT ;Plot Square
F82C: 68 PLA ;Pull Next Row
; vvv ------------------ ;"Apple II Monitors Peeled" Entry Point:
; vvv ;[(A+1)~(V2)=Row Ends; (Y)=Column]
F82D: C5 2D VLINE2 CMP V2 ;Done?
F82F: 90 F5 BCC VLINEZ ;NO, LOOP
F831: 60 MON_RTS1 RTS ;Return to Caller
; ----------------------------------- ;Clear Full (48 Lines on) Lo-Res Screen:
F832: A0 2F CLRSCR LDY #47 ;Maximize Y for Full Screen
F834: D0 02 BNE CLRSCR2 ;Always Taken
; ----------------------------------- ;Clear Top (40 Lines on) Lo-Res Screen:
F836: A0 27 CLRTOP LDY #39 ;Maximize Y for Top Screen
;
; ----------------------------------- ;Clear Partial Lo-Res Screen:
; ;^[(0~Y) Lines, 40 Columns]
F838: 84 2D CLRSCR2 STY V2 ;Store as Bottom Coordinate for VLINE Calls
; vvv ------------------ ;"Apple II Monitors Peeled" Entry Point:
; vvv ;^[(0~V2) Lines, 40 Columns]
F83A: A0 27 CLRSCR4 LDY #39 ;Rightmost X-Coordinate (Column)
;
; ----------------------------------- ;Clear Partial Lo-Res Screen:
; ;^[(0~V2) Lines, (0~Y) Columns]
F83C: A9 00 CLRSCR3 LDA #0 ;Top Coordinate for VLINE Calls
F83E: 85 30 STA HMASK ;Clear Color (to Black)
; vvv ---------------- ;"Apple II Monitors Peeled" Entry Point:
; vvv ;Clear Color to whatever HMASK is upon entry
; vvv ;^[(A) Must be Preset to Zero]
F840: 20 28 F8 CLRSCR5 JSR VLINE ;Draw VLINE
F843: 88 DEY ;Next Leftmost X-Coordinate
F844: 10 F6 BPL CLRSCR3 ;Loop Until Done
F846: 60 RTS ;Return to Caller
; ==============================================================================
; Calculate Graphics Base Address (BASH,BASL) for Left End of Screen Line Number
; (Not Lo-Res GR Line Number) in A-Reg [Range: (0~23)=($00~$17)=(%00000~%10111)]
; ==============================================================================
; GBASCALC [to set Graphics Base Address (GBASH,GBASL)] is almost identical to
; BASCALC [to set Text Line Base Address (BASH,BASL)]
; ---------------------------vv-------------------------vv----------vv----vv----
; F847: 48 4A 29 03 09 04 85 27 68 29 18 90 02 69 7F 85 26 0A 0A 05 26 85 26 60
; FBC1: 48 4A 29 03 09 04 85 29 68 29 18 90 02 69 7F 85 28 0A 0A 05 28 85 28 60
; ------------------------------------------------------------------------------
; Note: Indexed Addressing of the Base Address ZP Pointers would allow S/R's
; to be combined into one S/R with one or two different Entry Points to preset
; which task is being processed (e.g., GBASL,X & GBASH,X & X=0 or X=2)
; ------------------------------------------------------------------------------
; GBASL EQU $26 ;Graphics Base Address, Low
; GBASH EQU $27 ;Graphics Base Address, High
; BASL EQU $28 ;Text Base Address, Low
; BASH EQU $29 ;Text Base Address, High
; ==============================================================================
;
; ----------------------------------- ;Set Graphics Base Address (GBASH,GBASL):
; ;^[RAM Address of Plotting Line Specified]
F847: 48 GBASCALC PHA ;Push (A)=(GR_Line/2)=[(GBASL) for Input]
; ;^[...(A)=(Text Screen Line # {0~23})]
; ;^[...(A)=((Lo-Res Graphics Line #)/2)]
; ;^[GBASH=ABCDEFGH; GBASL=IJKLMNOP]
; ---------------------- ;Set Graphics Base Address, High (GBASH):
F848: 4A LSR A ;Set (A)=(GR_Line/4) [GBASH=0ABCDEFG; C=H]
F849: 29 03 AND #%00000011 ;Generate GBASH=000000FG
F84B: 09 04 ORA #%00000100 ;Generate GBASH=000001FG
F84D: 85 27 STA GBASH ;Set Graphics Base Address, High (GBASH)
; ---------------------- ;Set Graphics Base Address, Low (GBASL):
F84F: 68 PLA ;Pull (A)=(GBASL=IJKLMNOP)
F850: 29 18 AND #%00011000 ;Generate GBASL=000LM000
F852: 90 02 BCC GBCALC ;Skip Next Op if Carry is Clear (C=H=0)
F854: 69 7F ADC #%01111111 ;Generate GBASL=I00LM000 (C=H=1: Adds 1)
; ;^[%00011000 + (%01111111 + 1)= %10011000]
; ;^[%00011000 + (%10000000) = %10011000]
F856: 85 26 GBCALC STA GBASL ;Set Graphics Base Address, Low (GBASL)
; ; ^[GBASL=(000LM000 | I00LM000)]
F858: 0A ASL A ;Generate GBASL=(00LM0000 = 00LM0000; C=I)
F859: 0A ASL A ;Generate GBASL=(0LM00000 = 0LM00000; C=0)
F85A: 05 26 ORA GBASL ;Generate GBASL=(0LMLM000 | ILMLM000)
F85C: 85 26 STA GBASL ;Set Graphics Base Address, Low (GBASL)
; ---------------------- ;Now (GBASH,GBASL)=[%0000,01FG,ILML,M000]
;
; ;------------+---------+---------+
; ; Lo-Res GR Line Base Addresses: |
; ;------------+---------+---------+
; ; | GBASH | GBASL |
; ;------------+---------+---------+
; ; Top 3rd of GR Screen: |
; ;------------+---------+---------+
; ;$400, 1024, %0000,0100,0000,0000;
; ;$480, 1152, %0000,0100,1000,0000;
; ;$500, 1280, %0000,0101,0000,0000;
; ;$580, 1408, %0000,0101,1000,0000;
; ;$600, 1536, %0000,0110,0000,0000;
; ;$680, 1664, %0000,0110,1000,0000;
; ;$700, 1792, %0000,0111,0000,0000;
; ;$780, 1920, %0000,0111,1000,0000;
; ;------------+---------+---------+
; ; Middle 3rd of GR Screen: |
; ;------------+---------+---------+
; ;$428, 1064, %0000,0100,0010,1000;
; ;$4A8, 1192, %0000,0101,1010,1000;
; ;$528, 1320, %0000,0101,0010,1000;
; ;$5A8, 1448, %0000,0100,1010,1000;
; ;$628, 1576, %0000,0110,0010,1000;
; ;$6A8, 1704, %0000,0110,1010,1000;
; ;$728, 1832, %0000,0111,0010,1000;
; ;$7A8, 1960, %0000,0111,1010,1000;
; ;------------+---------+---------+
; ; Bottom 3rd of GR Screen: |
; ;------------+---------+---------+
; ;$450, 1104, %0000,0100,0101,0000;
; ;$4D0, 1232, %0000,0100,1101,0000;
; ;$550, 1360, %0000,0101,0101,0000;
; ;$5D0, 1488, %0000,0101,1101,0000;
; ;$650, 1616, %0000,0110,0101,0000;
; ;$6D0, 1744, %0000,0110,1101,0000;
; ;$750, 1872, %0000,0111,0101,0000;
; ;$7D0, 2000, %0000,0111,1101,0000;
; ;------------+---------+---------+
; ; GBASH,L: %0000,01FG,ILML,M000;
; ;------------+---------+---------+
;
; ----------------------------------- ;Returns: GBASH=000001FG; GBASL=ILMLM000
F85E: 60 RTS ;Return to Caller
; ------------------------------------------------------------------------------
; NEXTCOLOR is Not in the New Monitor listing; NXTCOL is the Label here in the
; Old Monitor listing, but it is used elsewhere in this listing; (See below)
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Next Color: Increment Plotting Color by 3
F85F: A5 30 NEXTCOLOR LDA HMASK ;Get Graphics On-the-Fly Color Bit Mask
F861: 18 CLC ;Prepare for Add with Carry
F862: 69 03 ADC #3 ;Advance Plotting Color to Color+3
; ----------------------------------- ;Set Plotting Color to (A)=(0~16,0~16):
F864: 29 0F SETCOL AND #%00001111 ;Discard High Nibble & Keep Low Nibble
; ;^[Math'ly: Sets Color = 17*A Mod 16]
F866: 85 30 STA HMASK ;Set Graphics On-the-Fly Color Bit Mask
; --<Undocumented User Entry Point>-- ;Shift Low Nibble to High Nibble:
F868: 0A NIBLOHI ASL A ;Make Both Nibbles of Plotting Color Equal
F869: 0A ASL A ;Shift Low Nibble to High Nibble
F86A: 0A ASL A ;(%####,0000 <-- <-- <-- <-- %0000,####)
F86B: 0A ASL A ;Now High Nibble is what Low Nibble was
F86C: 05 30 ORA HMASK ;OR with Graphics On-the-Fly Color Bit Mask
; ;(%####,0000 OR %0000,#### = %####,####)
F86E: 85 30 STA HMASK ;Set Graphics On-the-Fly Color Bit Mask
F870: 60 RTS ;Return to Caller
; ==============================================================================
; Miniassembler/Disassembler Instruction Display Subroutines
; ==============================================================================
; For an explanation about how this works (sort of), see:
; A 6502 Disassembler from Apple, Dr. Dobbs Journal, 09/76;
; FTP://Public.Asimov.Net/Pub/Apple_II/Documentation/Programming/6502Assembly/65
; 02%20Disassembler%20-%201976.PDF
; ==============================================================================
;
; ----------------------------------- ;Get 4-bit Color at Column,Row Coord's:
; ;[Enter with (A)=Row; (Y)=Column]
F871: 4A SCRN LSR A ;(A)=(Y-Coordinate/2)
F872: 08 PHP ;Push Status (P-Reg); Save Carry (LSB)
F873: 20 47 F8 JSR GBASCALC ;Calculate Base Address in GBASL,H
F876: B1 26 LDA (GBASL),Y ;Get Colors Byte at Column,Row Coordinates
F878: 28 PLP ;Pull Status (P-Reg); Retrieve Carry (LSB)
; ;Get Right or Left Half-Byte on Carry;
; ;AKA: Low or High Nibble, Respectively:
; ;[SCRN2--Used by Mini-/Dis-Assembler]
F879: 90 04 SCRN2 BCC RTMSKZ ;If Even, use Low Nibble
; --<Undocumented User Entry Point>-- ;Shift High Nibble to Low Nibble:
F87B: 4A NIBHILO LSR A ;If Odd, use High Nibble
F87C: 4A LSR A ;Shift High Nibble
F87D: 4A LSR A ;... to Low Nibble
F87E: 4A LSR A ;Now Low Nibble is what High Nibble was
F87F: 29 0F RTMSKZ AND #%00001111 ;Mask 4-Bit Color at Column,Row Coordinates
F881: 60 RTS ;Return to Caller
; ==============================================================================
; Disassembler Instruction Display Subroutine: Prints Program Counter, followed
; by a Blank; Gets an OpCode; Then Generates FORMAT & LENGTH Bytes:
; ==============================================================================
;
; ----------------------------------- ;Display Instruction Line Address:
F882: A6 3A INSDS1 LDX PCL ;Get Program Counter, Low
F884: A4 3B LDY PCH ;Get Program Counter, High
F886: 20 96 FD JSR PRYX2 ;Print Program Counter [(Y,X)={High,Low}]
; ;Followed by a Dash
F889: 20 48 F9 JSR PRBLNK ;Followed by a Blank (3 Spaces)
; ----------------------------------- ;Get OpCode, Instruction FORMAT & LENGTH,
; ;& Index into Mnemonic Table:
F88C: A1 3A LDA (PCL,X) ;Get OpCode
F88E: A8 INSDS2 TAY ;Save OpCode
F88F: 4A LSR A ;Even/Odd Test: Put LSB (Bit 0) into (C)
F890: 90 09 GET816LEN BCC IEVEN ;Branch if OpCode is (=%#######0) Even
; ;^[OpCode Before Shifting & Rotatng Right]
; ---------------------- ;Else, OpCode is (=%#######1) Odd
; ;^[OpCode Before Shifting & Rotatng Right]
; ;& Now (C=1) & (A)=(%0#######):
F892: 6A ROR A ;Bit 1 Test: Put (C=1) in MSB & LSB in (C)
F893: B0 10 BCS ERR ;Branch if OpCode is (=%######11) Invalid
; ;^[OpCode Before Shifting & Rotatng Right]
; ---------------------- ;Else, OpCode is (=%######01) Odd
; ;^[OpCode Before Shifting & Rotatng Right]
; ;& Now (C=0) & (A)=(%10######):
F895: C9 A2 CMP #%10100010 ;Is OpCode a NOP? (%10001001=$89=137):(?)
; ;^[OpCode Before Shifting & Rotatng Right]
; ;================= FMT1,X ================
; ;(?) = %10001001=$89=137
; ;LSR = %01000100=$44=68 ->(C=1)
; ;ROR = (C=1)-> %10100010=$A2=162 ->(C=0)
; ;================= FMT2,X ================
; ;NOP = %11101010=$EA=234
; ;LSR = %01110101=$75=117 ->(C=0)
; ;ROR = (C=0)-> %00111010=$3A=58 ->(C=1)
; ;Relative <- = %10011101=$9D=157 ->(C=0)
; ;=========================================
F897: F0 0C BEQ ERR ;Branch if OpCode is Invalid (=$89)
; ---------------------- ;Else, OpCode is (=%######01) Odd & Valid
; ;& Now (C=?) & (A)=(%10######):
F899: 29 87 AND #%10000111 ;Mask Bits: Keep Sign & 3 LSBs
; ;& Discard the Rest [(A)=(%10000###)]
F89B: 4A IEVEN LSR A ;Put LSB into Carry for Left/Right Test
; ;Also Sets (A)=(A/2) for Absolute,X-Index:
F89C: AA TAX ;Set Absolute,X-Index [(X=A)=(%0#######)]
; ;^[For Odd OpCodes: (X=A)=(%010000##)=
; ;{(%01000000=$40=64)~(%01000011=$43=67)}]
F89D: BD 62 F9 LDA FMT1,X ;Get Instruction Display Format Index Byte
; ;^[See also (below): FMT1 NOTE]
F8A0: 20 79 F8 JSR SCRN2 ;Get Right or Left Nibble Based on Carry
F8A3: D0 04 BNE GETFMT ;Branch if Low Nibble <> 0: OpCode is Valid
F8A5: A0 80 ERR LDY #$80 ;Else, Substitute $80 for Invalid OpCodes
F8A7: A9 00 LDA #0 ;Clear Accumulator
F8A9: AA GETFMT TAX ;Set Absolute,X-Index
F8AA: BD A6 F9 LDA FMT2,X ;Get Instruction Display Print Format Byte
; ;^[See also (below): FMT1 NOTE]
F8AD: 85 2E STA FORMAT ;Save for Address Field Formatting
F8AF: 29 03 AND #%00000011 ;Mask to Get 2-Bit LENGTH (OpCodeBytes-1:
; ; 0=1 Byte, 1=2 Byte, 2=3 Byte)
;
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; *** [The following section is different in the Apple IIE Autostart ROM] ***
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
F8B1: 85 2F STA LENGTH ;Save Length (Number of OpCode Bytes -1)
;
; ==============================================================================
; Form an Index into the Mnemonic Table from an OpCode: (A)=[(OpCode)-->(Index)]
; ==============================================================================
; OpCode -> Index for OpCd-Form; Example OpCodes & Exceptions
; -- -------- --------- --- ---------- -----------------------------------------
; 1) 1XXX1010->00101XXX ~ %1###1010; $8A,$9A,$AA,$BA,$CA,$DA,$EA,$FA.
; 2) XXXYYY01->00111XXX ~ %######01; Not $#3~$#4; $#1,$#5,$#9,$#D.
; 3) XXXYYY10->00110XXX ~ %######10; Not $#0~$#1; $#2,$#6,$#A,$#E.
; 4) XXXYY100->00100XXX ~ %#####100; Not $#0~$#3; $#4,$#C.
; 5) XXXXX000->000XXXXX ~ %#####000; Not $#1~$#7; $#0,$#8.
; -- -------- --------- --- ---------- -----------------------------------------
; ^^^^^^^^ Bits: X's, 0's, & 1's are Shifted Right; Y's are Discarded.
; #'s are Bits: 0 or 1; or Hexadecimal Numbers: 0~9,A~F
; ==============================================================================
;
F8B3: 98 TYA ;Get Saved {Valid or Invalid ($80)} OpCode
F8B4: 29 8F AND #%10001111 ;Mask for 6502 Bit Mapping Test (%1###1010)
F8B6: AA TAX ;Save Masked Byte for Test
F8B7: 98 TYA ;Get Saved OpCode Again
F8B8: A0 03 LDY #3 ;Set Loop Counter
F8BA: E0 8A CPX #%10001010 ;Is Masked Byte for an OpCode=(%1###1010)?
; ; ^[1 in Chart above]^
F8BC: F0 0B BEQ MNNDX3 ;YES, Form an Index into the Mnemonic Table
; ;NO, Masked Byte's for OpCode<>(%1###1010)
; ; ^[2~5 in Chart above]^
F8BE: 4A MNNDX1 LSR A ;Even/Odd Test: Put LSB into (C)
; ---------------------- ;Shift until LSB was Odd or (Y) = 0:
F8BF: 90 08 BCC MNNDX3 ;Branch if LSB was Even; Else:
; ---------------------- ;LSB was Odd, Discard & Set Bits:
F8C1: 4A LSR A ;Put Next LSB into Carry (C) [Discarded]
F8C2: 4A MNNDX2 LSR A ;Put Next LSB into Carry (C) [Discarded]
F8C3: 09 20 ORA #%00100000 ;Set Current Bit 5
F8C5: 88 DEY ;Reduce Loop Counter
F8C6: D0 FA BNE MNNDX2 ;Loop until Y=0
F8C8: C8 INY ;Advance to Compensate for Next Reduction
; ---------------------- ;LSB was Even, Check Next:
F8C9: 88 MNNDX3 DEY ;Reduce Loop Counter
F8CA: D0 F2 BNE MNNDX1 ;Loop until Y=0; Else:
; ---------------------- ;Now: (A) = Index into the Mnemonic Table;
; ; (X) = Masked OpCode; & (Y) = 0
F8CC: 60 RTS ;Return to Caller
; ------------------------------------------------------------------------------
F8CD: FF FF FF DS 3,$FF ;Filler
; ==============================================================================
; Disassemble & Print Instruction at Program Counter
; ==============================================================================
;
F8D0: 20 82 F8 INSTDSP JSR INSDS1 ;Display Instruction Line Address &
; ;Get Instruction FORMAT & LENGTH, & MTI:
F8D3: 48 PHA ;Push/Save Index into Mnemonic Table ^
; ---------------------- ;Print (1-3) OpCode Bytes [as Hex: "## "]
; ;(in a 12 Char Field, Ending w/ Spaces)
; ;=[4 Fields of 3 Characters each]:
F8D4: B1 3A PRNTOP LDA (PCL),Y ;Get Byte at (Program Counter),Y
F8D6: 20 DA FD JSR PRBYTE ;Print (A) as Two-Digit Hex Number
F8D9: A2 01 LDX #1 ;Prepare to Print One Space
F8DB: 20 4A F9 PRNTBL JSR PRBL2 ;Print a Blank [(X) Spaces]
F8DE: C4 2F CPY LENGTH ;Subtract (Number of OpCode Bytes -1)
F8E0: C8 INY ;Advance OpCode Bytes Counter
F8E1: 90 F1 BCC PRNTOP ;BLT: Loop if Byte Count < LENGTH (^)
; ;End 12 Char Field w/ Spaces; =[4*3]:
F8E3: A2 03 LDX #3 ;Get Blank Char Count (for No OpCode Byte)
; ;^[Also used below for Mnemonic Chars]
F8E5: C0 04 CPY #4 ;Ending with (Y) Blanks of (X) Spaces each
F8E7: 90 F2 BCC PRNTBL ;BLT: Loop if OpCode Bytes Counter < 4
; ---------------------- ;Fetch 3-Char Mnemonic (Packed In 2-Bytes)
F8E9: 68 PLA ;Pull/Retrieve Index into Mnemonic Table
F8EA: A8 TAY ;Set Indirect Addressing Index
F8EB: B9 C0 F9 LDA MNEML,Y ;Get 1st Packed Byte of Mnemonic
F8EE: 85 2C STA LMNEM ;Set Left (ZP) Byte of Mnemonic
F8F0: B9 00 FA LDA MNEMR,Y ;Get 2nd Packed Byte of Mnemonic
F8F3: 85 2D STA RMNEM ;Set Right (ZP) Byte of Mnemonic
;
; ------------------------------------------------------------------------------
; Note about NXTCOL here & there: NXTCOL is the Label used here in the New
; Monitor listing; NXTCOL was used elsewhere in the Old Monitor listing (See
; NEXTCOLOR above); PRMN1 was the Label used here in the Old Monitor listing.
; ------------------------------------------------------------------------------
;
F8F5: A9 00 NXTCOL LDA #0 ;PRMN1: Clear Accumulator
F8F7: A0 05 LDY #5 ;Set to Shift 5 Bits into (A)
; ;[(%###CHAR1)<--(%CHAR1,CHA ~ %R2,CHAR3#)=(MNEML,MNEMR)]
; ------------------------------------------------------------------------------
; These are the Two Packed Bytes of the Mnemonics: There are 3 Packed Chars per
; 2 Byte Mnemonic [5 Bits/Char: (%CHAR1,CHA ~ %R2,CHAR3#) & a Trailing Bit];
; Each Mnemonic Character is a 5 Bit Number + High ASCII "?" [=(5 Bit #)+($BF)]
; ------------------------------------------------------------------------------
F8F9: 06 2D PRMN2 ASL RMNEM ;Shift Left 5 Bits of
F8FB: 26 2C ROL LMNEM ;Packed Mnemonic Characters [^^^]
F8FD: 2A ROL A ;into the Accumulator (Clears Carry)
F8FE: 88 DEY ;Reduce Bit Counter
F8FF: D0 F8 BNE PRMN2 ;Branch Until Shifted All 5 Bits
; <---[Page Boundary] (in the middle of the DWord above)
F901: 69 BF ADC #'?' | $80 ;Add Offset to make Char High ASCII (>="?")
F903: 20 ED FD JSR COUT ;Output 1 Character of Mnemonic
F906: CA DEX ;Reduce Mnemonic Character Counter
F907: D0 EC BNE NXTCOL ;Loop Until 3 Packed Mnemonic Chars Printed
F909: 20 48 F9 JSR PRBLNK ;Print a Blank [(3) Spaces]
F90C: A4 2F LDY LENGTH ;Get LENGTH (Number of OpCode Bytes -1)
F90E: A2 06 LDX #6 ;Count for 6 Format Bits
F910: E0 03 PRADR1 CPX #3 ;3 Packed Mnemonic Chars Printed?
F912: F0 1C BEQ PRADR5 ;YES, Branch if X=3: Do Address Field
; ----------------------------------- ;Else, Do Address Field Formatting,
; ;Print Addressing Field CHARS 1 & 2:
F914: 06 2E PRADR2 ASL FORMAT ;Shift Addressing Field Format MSB->(C)
F916: 90 0E BCC PRADR3 ;Branch if Shifted MSB is Zero; Else:
; ;Address Printout CHAR1 Bytes: ",),#($"
F918: BD B3 F9 LDA CHAR1-1,X ;[-1 OK Here] Get Address Printout Byte
F91B: 20 ED FD JSR COUT ;Print Addressing CHAR1 Byte
; ;Address Printout CHAR2 Bytes: "Y0X$$0"
F91E: BD B9 F9 LDA CHAR2-1,X ;[-1 OK Here] Get Address Printout Byte
F921: F0 03 BEQ PRADR3 ;Branch if CHAR2 is a Zero (0)
F923: 20 ED FD JSR COUT ;Else, Print Addressing CHAR2 Byte
F926: CA PRADR3 DEX ;Reduce Format Bit Count
F927: D0 E7 BNE PRADR1 ;Loop Until 6 Format Bits Counted
F929: 60 RTS ;Else, Done, Return to Caller
; ----------------------------------- ;Do Addressing Field (Not a Branch):
F92A: 88 PRADR4 DEY ;Reduce (Number of OpCode Bytes -1) Count
F92B: 30 E7 BMI PRADR2 ;Loop if All Instruction Bytes Processed
F92D: 20 DA FD JSR PRBYTE ;Else, Print (A) as Two-Digit Hex Number
; ;^[Jumps to (CSW); Does NOT Return Here!]
;
; ----------------------------------- ;Do Addressing Field (Entry Point):
F930: A5 2E PRADR5 LDA FORMAT ;Get Addressing Field Format
F932: C9 E8 CMP #$E8 ;Subtract $E8 [(A)-Data -> NZC]
; ;^[FORMAT for Relative = $9D = %10011101;
; ;FORMAT for Rel ASL *3 = $E8 = %11101000]
F934: B1 3A LDA (PCL),Y ;Get Byte at (Program Counter),Y
F936: 90 F2 BCC PRADR4 ;Branch if Addressing Mode is Not Relative
; ----------------------------------- ;Handle Relative Addressing Mode Special,
; ;for BCC|BCS|BEQ|BMI|BNE|BPL|BVC|BVS,
; ;Print Branch Target, Not Offset Value:
F938: 20 56 F9 RELADR JSR PCADJ3 ;Add (A+C) to Instruction Address (PCL,H)
; ;Set Target=1+[(PCL,H)+(Offset)+1]->(A,Y):
F93B: AA TAX ;Get (Target Address -1), Low
F93C: E8 INX ;Add 1 to (Target Address -1), Low
F93D: D0 01 BNE PRNTYX ;Branch if Not Crossing Page Boundary
F93F: C8 INY ;Else, Add 1 to (Target Address -1), High
; ----------------------------------- ;Output Target Address of Branch
; ;& Return to Caller:
F940: 98 PRNTYX TYA ;Get Target Address, High
F941: 20 DA FD PRNTAX JSR PRBYTE ;Print A-Reg as Two-Digit Hex Number
F944: 8A PRNTX TXA ;Get Target Address, Low
F945: 4C DA FD JMP PRBYTE ;Print A-Reg as Two-Digit Hex Number
; ------------------------------------------------------------------------------
; Print Blank Spaces Subroutine:
; ------------------------------------------------------------------------------
;
F948: A2 03 PRBLNK LDX #3 ;Print a Blank [(3) Spaces]
F94A: A9 A0 PRBL2 LDA #' ' | $80 ;Print a Blank [(X) Spaces]
; ;Print (A) Char + Blank [(X) Spaces]:
F94C: 20 ED FD PRBL3 JSR COUT ;Print (A) to Output Device
F94F: CA DEX ;Reduce Character Count
F950: D0 F8 BNE PRBL2 ;LOOP Until All Characters are Done
F952: 60 RTS ;Return to Caller
; ------------------------------------------------------------------------------
; Add (A+C) to Instruction Address (PCL,H) Subroutines:
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Add Length+1 to Instruction Adrs (PCL,H):
F953: 38 PCADJ SEC ;Prepare for Add with Carry Set (Adds 1)
; ----------------------------------- ;Add Length+(C) to Instr Adrs (PCL,H):
F954: A5 2F PCADJ2 LDA LENGTH ;Get LENGTH (Number of OpCode Bytes -1)
; ;... ^[0=1-Byte, 1=2-Bytes, 2=3-Bytes]
; ----------------------------------- ;Add (A+C) to Instruction Address (PCL,H):
F956: A4 3B PCADJ3 LDY PCH ;Get Instruction Address, High
; ;Test Relative Branch Displacement Sign:
F958: AA TAX ;Get Offset to Target Address
F959: 10 01 BPL PCADJ4 ;Branch if Offset to Target is Positive
F95B: 88 DEY ;Else, Extend Negative Target Offset
F95C: 65 3A PCADJ4 ADC PCL ;Add Offset to Instruction Address, Low
F95E: 90 01 BCC MON_RTS2 ;Branch if No Carryover (or Page Crossed)
F960: C8 INY ;Else, Add 1 to Instruction Address, High
F961: 60 MON_RTS2 RTS ;Return to Caller
; ==============================================================================
; Miniassembler/Disassembler Instruction Display Tables
; ==============================================================================
;
; ============================= | ==============================================
; FMT1 Index Bytes: | Format Index Byte: XXXXXXY0 Instructions
; ========================v====-+-===v=====================^====================
; [*] Use: Left Nibble if Y=1 | If Y=1 then Left Half Byte | 68 Bytes/2 |
; Right Nibble if Y=0 | If Y=0 then Right Half Byte | + 68 Bytes/2 |
; [For: 14 Print Formats] | [(X)=(Index into Table)] | = 136 Nibbles |
; ------------------------------------------------------------------------------
; [*] These are opposite of what the Old Monitor listing shows in A2 Ref Manual!
; ==============================================================================
; FMT1 NOTE
; ==============================================================================
; Used to get an Index into the next table to get FORMAT & LENGTH frm an OpCode;
; Noticeable Patterns: Alternating groups of 4 Defined Bytes (4 DFB lines);
; Nibble Comments are adapted from OpCodes(*) & the following table's Comments;
; The Nibble (sequence number) for an Even Operation Code (Instruction) is:
; Nibble=(OpCode/2)+1-(2*Y): where Y is Bit 1 of the OpCode = (0 or 1);
; OpCode=(Nibble-1+(2*Y))*2: " " " " (Ditto) " " " "; <-[The way back!];
; The Nibble (sequence number) for an Odd OpCode is limited to the last group of
; eight nibbles [(X)=(64~67)]; Undefined Operations: ??? [All are still NOP's];
; (*) See a "6502 Hex to Instruction Conversion Chart" [& maybe: "UnDocumented
; 6502 OpCodes" by Nick Westgate (for Undefined Operations: ???)]
; ==============================================================================
;
; ----------------------------- | ----------------------------------------------
; | Nibble Op Address Mode | Bytes | Examples
; ----------------------------- | ----------------------------\-----/-----------
F962: 04 FMT1 DFB $04 ;$00: ??? Error/Unknown | 1 | {Empty}
; ;$01: BRK Implied | 1 | {Empty}
F963: 20 DFB $20 ;$02: ASL Zero-Page [ZP] | 2 | $NN
; ;$03: ??? Error/Unknown | 1 | {Empty}
F964: 54 DFB $54 ;$04: ASL Accumulator | 1 | {Empty}
; ;$05: PHP Implied | 1 | {Empty}
F965: 30 DFB $30 ;$06: ASL Absolute | 3 | $NNNN
; ;$07: ??? Error/Unknown | 1 | {Empty}
; ------------------------------------------------------------------------------
F966: 0D DFB $0D ;$08: ??? Error/Unknown | 1 | {Empty}
; ;$09: BPL Relative | 2 | $NN
F967: 80 DFB $80 ;$0A: ASL Zero-Page,X | 2 | $NN,X
; ;$0B: ??? Error/Unknown | 1 | {Empty}
F968: 04 DFB $04 ;$0C: ??? Error/Unknown | 1 | {Empty}
; ;$0D: CLC Implied | 1 | {Empty}
F969: 90 DFB $90 ;$0E: ASL Absolute,X | 3 | $NNNN,X
; ;$0F: ??? Error/Unknown | 1 | {Empty}
; ------------------------------------------------------------------------------
F96A: 03 DFB $03 ;$10: ??? Error/Unknown | 1 | {Empty}
; ;$11: JSR Absolute | 3 | $NNNN
F96B: 22 DFB $22 ;$12: ROL Zero-Page [ZP] | 2 | $NN
; ;$13: BIT Zero-Page [ZP] | 2 | $NN
F96C: 54 DFB $54 ;$14: ROL Accumulator | 1 | {Empty}
; ;$15: PLP Implied | 1 | {Empty}
F96D: 33 DFB $33 ;$16: ROL Absolute | 3 | $NNNN
; ;$17: BIT Absolute | 3 | $NNNN
; ------------------------------------------------------------------------------
F96E: 0D DFB $0D ;$18: ??? Error/Unknown | 1 | {Empty}
; ;$19: BMI Relative | 2 | $NN
F96F: 80 DFB $80 ;$1A: ROL Zero-Page,X | 2 | $NN,X
; ;$1B: ??? Error/Unknown | 1 | {Empty}
F970: 04 DFB $04 ;$1C: ??? Error/Unknown | 1 | {Empty}
; ;$1D: SEC Implied | 1 | {Empty}
F971: 90 DFB $90 ;$1E: ROL Absolute,X | 3 | $NNNN,X
; ;$1F: ??? Error/Unknown | 1 | {Empty}
; ------------------------------------------------------------------------------
F972: 04 DFB $04 ;$20: ??? Error/Unknown | 1 | {Empty}
; ;$21: RTI Implied | 1 | {Empty}
F973: 20 DFB $20 ;$22: LSR Zero-Page [ZP] | 2 | $NN
; ;$23: ??? Error/Unknown | 1 | {Empty}
F974: 54 DFB $54 ;$24: LSR Accumulator | 1 | {Empty}
; ;$25: PHA Implied | 1 | {Empty}
F975: 33 DFB $33 ;$26: LSR Absolute | 3 | $NNNN
; ;$27: JMP Absolute | 3 | $NNNN
; ------------------------------------------------------------------------------
F976: 0D DFB $0D ;$28: ??? Error/Unknown | 1 | {Empty}
; ;$29: BVC Relative | 2 | $NN
F977: 80 DFB $80 ;$2A: LSR Zero-Page,X | 2 | $NN,X
; ;$2B: ??? Error/Unknown | 1 | {Empty}
F978: 04 DFB $04 ;$2C: ??? Error/Unknown | 1 | {Empty}
; ;$2D: CLI Implied | 1 | {Empty}
F979: 90 DFB $90 ;$2E: LSR Absolute,X | 3 | $NNNN,X
; ;$2F: ??? Error/Unknown | 1 | {Empty}
; ------------------------------------------------------------------------------
F97A: 04 DFB $04 ;$30: ??? Error/Unknown | 1 | {Empty}
; ;$31: RTS Implied | 1 | {Empty}
F97B: 20 DFB $20 ;$32: ROR Zero-Page [ZP] | 2 | $NN
; ;$33: ??? Error/Unknown | 1 | {Empty}
F97C: 54 DFB $54 ;$34: ROR Accumulator | 1 | {Empty}
; ;$35: PLA Implied | 1 | {Empty}
F97D: 3B DFB $3B ;$36: ROR Absolute | 3 | $NNNN
; ;$37: JMP (Abs.Indirect) | 3 | ($NNNN)
; ------------------------------------------------------------------------------
F97E: 0D DFB $0D ;$38: ??? Error/Unknown | 1 | {Empty}
; ;$39: BVS Relative | 2 | $NN
F97F: 80 DFB $80 ;$3A: ROR Zero-Page,X | 2 | $NN,X
; ;$3B: ??? Error/Unknown | 1 | {Empty}
F980: 04 DFB $04 ;$3C: ??? Error/Unknown | 1 | {Empty}
; ;$3D: SEI Implied | 1 | {Empty}
F981: 90 DFB $90 ;$3E: ROR Absolute,X | 3 | $NNNN,X
; ;$3F: ??? Error/Unknown | 1 | {Empty}
; ------------------------------------------------------------------------------
F982: 00 DFB $00 ;$40: ??? Error/Unknown | 1 | {Empty}
; ;$41: ??? Error/Unknown | 1 | {Empty}
F983: 22 DFB $22 ;$42: STX Zero-Page [ZP] | 2 | $NN
; ;$43: STY Zero-Page [ZP] | 2 | $NN
F984: 44 DFB $44 ;$44: TYA Implied | 1 | {Empty}
; ;$45: DEY Implied | 1 | {Empty}
F985: 33 DFB $33 ;$46: STX Absolute | 3 | $NNNN
; ;$47: STY Absolute | 3 | $NNNN
; ------------------------------------------------------------------------------
F986: 0D DFB $0D ;$48: ??? Error/Unknown | 1 | {Empty}
; ;$49: BCC Relative | 2 | $NN
F987: C8 DFB $C8 ;$4A: STX Zero-Page,Y | 2 | $NN,Y
; ;$4B: STY Zero-Page,X | 2 | $NN,X
F988: 44 DFB $44 ;$4C: TXS Implied | 1 | {Empty}
; ;$4D: TYA Implied | 1 | {Empty}
F989: 00 DFB $00 ;$4E: ??? Error/Unknown | 1 | {Empty}
; ;$4F: ??? Error/Unknown | 1 | {Empty}
; ------------------------------------------------------------------------------
F98A: 11 DFB $11 ;$50: LDX Immediate | 2 | #$NN
; ;$51: LDY Immediate | 2 | #$NN
F98B: 22 DFB $22 ;$52: LDX Zero-Page [ZP] | 2 | $NN
; ;$53: LDY Zero-Page [ZP] | 2 | $NN
F98C: 44 DFB $44 ;$54: TAX Implied | 1 | {Empty}
; ;$55: TAY Implied | 1 | {Empty}
F98D: 33 DFB $33 ;$56: LDX Absolute | 3 | $NNNN
; ;$57: LDY Absolute | 3 | $NNNN
; ------------------------------------------------------------------------------
F98E: 0D DFB $0D ;$58: ??? Error/Unknown | 1 | {Empty}
; ;$59: BCS Relative | 2 | $NN
F98F: C8 DFB $C8 ;$5A: LDX Zero-Page,Y | 2 | $NN,Y
; ;$5B: LDY Zero-Page,X | 2 | $NN,X
F990: 44 DFB $44 ;$5C: TSX Implied | 1 | {Empty}
; ;$5D: CLV Implied | 1 | {Empty}
F991: A9 DFB $A9 ;$5E: LDX Absolute,Y | 3 | $NNNN,Y
; ;$5F: LDY Absolute,X | 3 | $NNNN,X
; ------------------------------------------------------------------------------
F992: 01 DFB $01 ;$60: ??? Error/Unknown | 1 | {Empty}
; ;$61: CPY Immediate | 2 | #$NN
F993: 22 DFB $22 ;$62: DEC Zero-Page [ZP] | 2 | $NN
; ;$63: CPY Zero-Page [ZP] | 2 | $NN
F994: 44 DFB $44 ;$64: DEX Implied | 1 | {Empty}
; ;$65: INY Implied | 1 | {Empty}
F995: 33 DFB $33 ;$66: DEC Absolute | 3 | $NNNN
; ;$67: CPY Absolute | 3 | $NNNN
; ------------------------------------------------------------------------------
F996: 0D DFB $0D ;$68: ??? Error/Unknown | 1 | {Empty}
; ;$69: BNE Relative | 2 | $NN
F997: 80 DFB $80 ;$6A: DEC Zero-Page,X | 2 | $NN,X
; ;$6B: ??? Error/Unknown | 1 | {Empty}
F998: 04 DFB $04 ;$6C: ??? Error/Unknown | 1 | {Empty}
; ;$6D: CLD Implied | 1 | {Empty}
F999: 90 DFB $90 ;$6E: DEC Absolute,X | 3 | $NNNN,X
; ;$6F: ??? Error/Unknown | 1 | {Empty}
; ------------------------------------------------------------------------------
F99A: 01 DFB $01 ;$70: ??? Error/Unknown | 1 | {Empty}
; ;$71: CPX Immediate | 2 | #$NN
F99B: 22 DFB $22 ;$72: INC Zero-Page [ZP] | 2 | $NN
; ;$73: CPX Zero-Page [ZP] | 2 | $NN
F99C: 44 DFB $44 ;$74: NOP Implied | 1 | {Empty}
; ;$75: INX Implied | 1 | {Empty}
F99D: 33 DFB $33 ;$76: INC Absolute | 3 | $NNNN
; ;$77: CPX Absolute | 3 | $NNNN
; ------------------------------------------------------------------------------
F99E: 0D DFB $0D ;$78: ??? Error/Unknown | 1 | {Empty}
; ;$79: BEQ Relative | 2 | $NN
F99F: 80 DFB $80 ;$7A: INC Zero-Page,X | 2 | $NN,X
; ;$7B: ??? Error/Unknown | 1 | {Empty}
F9A0: 04 DFB $04 ;$7C: ??? Error/Unknown | 1 | {Empty}
; ;$7D: SED Implied | 1 | {Empty}
F9A1: 90 DFB $90 ;$7E: INC Absolute,X | 3 | $NNNN,X
; ;$7F: ??? Error/Unknown | 1 | {Empty}
; ------------------------------------------------------------------------------
; Last 8 for Odd OpCode Mnemonics *** [ORA, AND EOR, ADC, STA, LDA, CMP, & SBC]:
; ------------------------------------------------------------------------------
F9A2: 26 DFB $26 ;$80: *** Zero-Page [ZP] | 2 | $NN
; ; ^ $(Even)5:Zero-Page
; ;$81: *** (Zero-Page,X) | 2 | ($NN,X)
; ; ^ $(Even)1 [(Indexed-Indirect)]
F9A3: 31 DFB $31 ;$82: *** Absolute | 3 | $NNNN
; ; ^ $(Even)D
; ;$83: *** Immediate | 2 | #$NN
; ; ^ $(Even)9 [No STA Immediate!]
F9A4: 87 DFB $87 ;$84: *** Zero-Page,X | 2 | $NN,X
; ; ^ $(Odd)5
; ;$85: *** (Zero-Page),Y | 2 | ($NN),Y
; ; ^ $(Odd)1 [(Indirect)-Indexed]
F9A5: 9A DFB $9A ;$86: *** Absolute,X | 3 | $NNNN,X
; ; ^ $(Odd)D
; ;$87: *** Absolute,Y | 3 | $NNNN,Y
; ; ^ $(Odd)9
; ------------------------------------------------------------------------------
;
; ============================= | ==============================================
; FMT2 Index Bytes (*): | Print Format Index Byte $ZZXXXY01 Instructions
; ============================= | ==============================================
; [(X)=(Index into Table)] | Address Mode | Bytes | Notes & Examples
; ----------------------------- | -------------------\-----/--------------------
F9A6: 00 FMT2 DFB %00000000 ;Error/Unknown | 1 | {MT}[All are NOP's]
F9A7: 21 DFB %00100001 ;Immediate | 2 | #$NN
F9A8: 81 DFB %10000001 ;Zero-Page [ZP] | 2 | $NN
F9A9: 82 DFB %10000010 ;Absolute | 3 | $NNNN
F9AA: 00 DFB %00000000 ;Implied | 1 | {Empty} [& $EA=NOP]
F9AB: 00 DFB %00000000 ;Accumulator | 1 | {Empty}
F9AC: 59 DFB %01011001 ;(Zero-Page,X) | 2 | ($NN,X) [NDXD-NDRCT]
F9AD: 4D DFB %01001101 ;(Zero-Page),Y | 2 | ($NN),Y [NDRCT-NDXD]
F9AE: 91 DFB %10010001 ;Zero-Page,X | 2 | $NN,X
F9AF: 92 DFB %10010010 ;Absolute,X | 3 | $NNNN,X
F9B0: 86 DFB %10000110 ;Absolute,Y | 3 | $NNNN,Y
F9B1: 4A DFB %01001010 ;(Indirect) *1 | 3 | JMP (Absolute)
F9B2: 85 DFB %10000101 ;Zero-Page,Y *2 | 2 | LDX ZP,Y & STX ZP,Y
F9B3: 9D DFB %10011101 ;Relative | 2 | $NN
; ----------------------------- | ----------------------------------------------
; (*) Bytes will be Saved for | Only those Noted: *1=One Op; *2=Two Ops
; Address Field Formatting -> Mask Gets 2-Bit LENGTH: FMT2,X AND #%00000011
; [See also (above): FMT1 NOTE] | (OpCodeBytes-1: 0=1 Byte, 1=2 Byte, 2=3 Byte)
; ============================= | ==============================================
;
; ============================= | ==============================================
; Address Printout | Apple II Reference Manual Listings:
; CHAR1 Bytes: ",),#($" | New Monitor <> Old Monitor: ASC ",),#($"
; ============================= | ==============================================
;
F9B4: AC CHAR1 DFB ',' | $80 ;ASCII ","
F9B5: A9 DFB ')' | $80 ;ASCII ")"
F9B6: AC DFB ',' | $80 ;ASCII ","
F9B7: A3 DFB '#' | $80 ;ASCII "#"
F9B8: A8 DFB '(' | $80 ;ASCII "("
F9B9: A4 DFB '$' | $80 ;ASCII "$"
;
; ============================= | ==============================================
; Address Printout | Apple II Reference Manual Listings:
; CHAR2 Bytes: "Y0X$$0" | New Monitor = Old Monitor: "Y",0,"X$$",0
; ============================= | ==============================================
F9BA: D9 CHAR2 DFB 'Y' | $80 ;ASCII "Y"
F9BB: 00 DFB $00 ;VALUE "0"
F9BC: D8 DFB 'X' | $80 ;ASCII "X"
F9BD: A4 DFB '$' | $80 ;ASCII "$"
F9BE: A4 DFB '$' | $80 ;ASCII "$"
F9BF: 00 DFB $00 ;VALUE "0"
;
; ============================= | ==============================================
; Mnemonic Forms: | MNEML & MNEMR Instruction Formats
; (A) XXXXX000 |
; (B) XXXYY100 | [(X)=(Index into Table)]
; (C) 1XXX1010 |
; (D) XXXYYY10 |
; (E) XXXYYY01 |
; ============================= | ==============================================
; Mnemonic Left Bytes | MNEML Instruction Formats (64)
; ============================= | ==============================================
;
; ------------------------------------------------------------------------------
; These are the 1st Packed Bytes of the Mnemonics: There are 3 Packed Chars per
; 2 Byte Mnemonic [5 Bits/Char: (%CHAR1,CHA ~ %R2,CHAR3#) & a Trailing Bit];
; Each Mnemonic Character is a 5 Bit Number + High ASCII "?" [=(5 Bit #)+($BF)]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;(A)-Format Instructions (32)
; ; | vvv---------[MNEML+MNEMR]--------
; ; | v CHAR1 CHAR2 CHAR3
; ;--- --- -------- -------- --------
F9C0: 1C MNEML DFB %00011100 ;(A) BRK: %00011=B; %10011=R; %01100=K
F9C1: 8A DFB %10001010 ;(A) PHP: %10001=P; %01001=H; %10001=P
F9C2: 1C DFB %00011100 ;(A) BPL: %00011=B; %10001=P; %01101=L
F9C3: 23 DFB %00100011 ;(A) CLC: %00100=C; %01101=L; %00100=C
F9C4: 5D DFB %01011101 ;(A) JSR: %01011=J; %10100=S; %10011=R
F9C5: 8B DFB %10001011 ;(A) PLP: %10001=P; %01101=L; %10001=P
F9C6: 1B DFB %00011011 ;(A) BMI: %00011=B; %01110=M; %01010=I
F9C7: A1 DFB %10100001 ;(A) SEC: %10100=S; %00110=E; %00100=C
F9C8: 9D DFB %10011101 ;(A) RTI: %10011=R; %10101=T; %01010=I
F9C9: 8A DFB %10001010 ;(A) PHA: %10001=P; %01001=H; %00010=A
F9CA: 1D DFB %00011101 ;(A) BVC: %00011=B; %10111=V; %00100=C
F9CB: 23 DFB %00100011 ;(A) CLI: %00100=C; %01101=L; %01010=I
F9CC: 9D DFB %10011101 ;(A) RTS: %10011=R; %10101=T; %10100=S
F9CD: 8B DFB %10001011 ;(A) PLA: %10001=P; %01101=L; %00010=A
F9CE: 1D DFB %00011101 ;(A) BVS: %00011=B; %10111=V; %10100=S
F9CF: A1 DFB %10100001 ;(A) SEI: %10100=S; %00110=E; %01010=I
F9D0: 00 DFB %00000000 ;(A) ???: %00000=?; %00000=?; %00000=?
F9D1: 29 DFB %00101001 ;(A) DEY: %00101=D; %00110=E; %11010=Y
F9D2: 19 DFB %00011001 ;(A) BCC: %00011=B; %00100=C; %00100=C
F9D3: AE DFB %10101110 ;(A) TYA: %10101=T; %11010=Y; %00010=A
F9D4: 69 DFB %01101001 ;(A) LDY: %01101=L; %00101=D; %11010=Y
F9D5: A8 DFB %10101000 ;(A) TAY: %10101=T; %00010=A; %11010=Y
F9D6: 19 DFB %00011001 ;(A) BCS: %00011=B; %00100=C; %10100=S
F9D7: 23 DFB %00100011 ;(A) CLV: %00100=C; %01101=L; %10111=V
F9D8: 24 DFB %00100100 ;(A) CPY: %00100=C; %10001=P; %11010=Y
F9D9: 53 DFB %01010011 ;(A) INY: %01010=I; %01111=N; %11010=Y
F9DA: 1B DFB %00011011 ;(A) BNE: %00011=B; %01111=N; %00110=E
F9DB: 23 DFB %00100011 ;(A) CLD: %00100=C; %01101=L; %00101=D
F9DC: 24 DFB %00100100 ;(A) CPX: %00100=C; %10001=P; %11001=X
F9DD: 53 DFB %01010011 ;(A) INX: %01010=I; %01111=N; %11001=X
F9DE: 19 DFB %00011001 ;(A) BEQ: %00011=B; %00110=E; %10010=Q
F9DF: A1 DFB %10100001 ;(A) SED: %10100=S; %00110=E; %00101=D
; ----------------------------------- ;(B)-Format Instructions (8)
F9E0: 00 DFB %00000000 ;(B) ???: %00000=?; %00000=?; %00000=?
F9E1: 1A DFB %00011010 ;(B) BIT: %00011=B; %01010=I; %10101=T
F9E2: 5B DFB %01011011 ;(B) JMP: %01011=J; %01110=M; %10001=P
F9E3: 5B DFB %01011011 ;(B) JMP: %01011=J; %01110=M; %10001=P
F9E4: A5 DFB %10100101 ;(B) STY: %10100=S; %10101=T; %11010=Y
F9E5: 69 DFB %01101001 ;(B) LDY: %01101=L; %00101=D; %11010=Y
F9E6: 24 DFB %00100100 ;(B) CPY: %00100=C; %10001=P; %11010=Y
F9E7: 24 DFB %00100100 ;(B) CPX: %00100=C; %10001=P; %11001=X
; ----------------------------------- ;(C)-Format Instructions (8)
F9E8: AE DFB %10101110 ;(C) TXA: %10101=T; %11001=X; %00010=A
F9E9: AE DFB %10101110 ;(C) TXS: %10101=T; %11001=X; %10100=S
F9EA: A8 DFB %10101000 ;(C) TAX: %10101=T; %00010=A; %11001=X
F9EB: AD DFB %10101101 ;(C) TSX: %10101=T; %10100=S; %11001=X
F9EC: 29 DFB %00101001 ;(C) DEX: %00101=D; %00110=E; %11001=X
F9ED: 00 DFB %00000000 ;(C) ???: %00000=?; %00000=?; %00000=?
F9EE: 7C DFB %01111100 ;(C) NOP: %01111=N; %10000=O; %10001=P
F9EF: 00 DFB %00000000 ;(C) ???: %00000=?; %00000=?; %00000=?
; ----------------------------------- ;(D)-Format Instructions (8)
F9F0: 15 DFB %00010101 ;(D) ASL: %00010=A; %10100=S; %01101=L
F9F1: 9C DFB %10011100 ;(D) ROL: %10011=R; %10000=O; %01101=L
F9F2: 6D DFB %01101101 ;(D) LSR: %01101=L; %10100=S; %10011=R
F9F3: 9C DFB %10011100 ;(D) ROR: %10011=R; %10000=O; %10011=R
F9F4: A5 DFB %10100101 ;(D) STX: %10100=S; %10101=T; %11001=X
F9F5: 69 DFB %01101001 ;(D) LDX: %01101=L; %00101=D; %11001=X
F9F6: 29 DFB %00101001 ;(D) DEC: %00101=D; %00110=E; %00100=C
F9F7: 53 DFB %01010011 ;(D) INC: %01010=I; %01111=N; %00100=C
; ----------------------------------- ;(E)-Format Instructions (8)
F9F8: 84 DFB %10000100 ;(E) ORA: %10000=O; %10011=R; %00010=A
F9F9: 13 DFB %00010011 ;(E) AND: %00010=A; %01111=N; %00101=D
F9FA: 34 DFB %00110100 ;(E) EOR: %00110=E; %10000=O; %10011=R
F9FB: 11 DFB %00010001 ;(E) ADC: %00010=A; %00101=D; %00100=C
F9FC: A5 DFB %10100101 ;(E) STA: %10100=S; %10101=T; %00010=A
F9FD: 69 DFB %01101001 ;(E) LDA: %01101=L; %00101=D; %00010=A
F9FE: 23 DFB %00100011 ;(E) CMP: %00100=C; %01110=M; %10001=P
F9FF: A0 DFB %10100000 ;(E) SBC: %10100=S; %00011=B; %00100=C
;
; <---[Page Boundary]
;
; ============================= | ==============================================
; Mnemonic Right Bytes | MNEMR Instruction Formats (64)
; ============================= | ==============================================
;
; ------------------------------------------------------------------------------
; These are the 2nd Packed Bytes of the Mnemonics: There are 3 Packed Chars per
; 2 Byte Mnemonic [5 Bits/Char: (%CHAR1,CHA ~ %R2,CHAR3#) & a Trailing Bit];
; Each Mnemonic Character is a 5 Bit Number + High ASCII "?" [=(5 Bit #)+($BF)]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;(A)-Format Instructions (32)
; ; | vvv---------[MNEML+MNEMR]--------
; ; | v CHAR1 CHAR2 CHAR3
; ;--- --- -------- -------- --------
FA00: D8 MNEMR DFB %11011000 ;(A) BRK: %00011=B; %10011=R; %01100=K
FA01: 62 DFB %01100010 ;(A) PHP: %10001=P; %01001=H; %10001=P
FA02: 5A DFB %01011010 ;(A) BPL: %00011=B; %10001=P; %01101=L
FA03: 48 DFB %01001000 ;(A) CLC: %00100=C; %01101=L; %00100=C
FA04: 26 DFB %00100110 ;(A) JSR: %01011=J; %10100=S; %10011=R
FA05: 62 DFB %01100010 ;(A) PLP: %10001=P; %01101=L; %10001=P
FA06: 94 DFB %10010100 ;(A) BMI: %00011=B; %01110=M; %01010=I
FA07: 88 DFB %10001000 ;(A) SEC: %10100=S; %00110=E; %00100=C
FA08: 54 DFB %01010100 ;(A) RTI: %10011=R; %10101=T; %01010=I
FA09: 44 DFB %01000100 ;(A) PHA: %10001=P; %01001=H; %00010=A
FA0A: C8 DFB %11001000 ;(A) BVC: %00011=B; %10111=V; %00100=C
FA0B: 54 DFB %01010100 ;(A) CLI: %00100=C; %01101=L; %01010=I
FA0C: 68 DFB %01101000 ;(A) RTS: %10011=R; %10101=T; %10100=S
FA0D: 44 DFB %01000100 ;(A) PLA: %10001=P; %01101=L; %00010=A
FA0E: E8 DFB %11101000 ;(A) BVS: %00011=B; %10111=V; %10100=S
FA0F: 94 DFB %10010100 ;(A) SEI: %10100=S; %00110=E; %01010=I
FA10: 00 DFB %00000000 ;(A) ???: %00000=?; %00000=?; %00000=?
FA11: B4 DFB %10110100 ;(A) DEY: %00101=D; %00110=E; %11010=Y
FA12: 08 DFB %00001000 ;(A) BCC: %00011=B; %00100=C; %00100=C
FA13: 84 DFB %10000100 ;(A) TYA: %10101=T; %11010=Y; %00010=A
FA14: 74 DFB %01110100 ;(A) LDY: %01101=L; %00101=D; %11010=Y
FA15: B4 DFB %10110100 ;(A) TAY: %10101=T; %00010=A; %11010=Y
FA16: 28 DFB %00101000 ;(A) BCS: %00011=B; %00100=C; %10100=S
FA17: 6E DFB %01101110 ;(A) CLV: %00100=C; %01101=L; %10111=V
FA18: 74 DFB %01110100 ;(A) CPY: %00100=C; %10001=P; %11010=Y
FA19: F4 DFB %11110100 ;(A) INY: %01010=I; %01111=N; %11010=Y
FA1A: CC DFB %11001100 ;(A) BNE: %00011=B; %01111=N; %00110=E
FA1B: 4A DFB %01001010 ;(A) CLD: %00100=C; %01101=L; %00101=D
FA1C: 72 DFB %01110010 ;(A) CPX: %00100=C; %10001=P; %11001=X
FA1D: F2 DFB %11110010 ;(A) INX: %01010=I; %01111=N; %11001=X
FA1E: A4 DFB %10100100 ;(A) BEQ: %00011=B; %00110=E; %10010=Q
FA1F: 8A DFB %10001010 ;(A) SED: %10100=S; %00110=E; %00101=D
; ----------------------------------- ;(B)-Format Instructions (8)
FA20: 00 DFB %00000000 ;(B) ???: %00000=?; %00000=?; %00000=?
FA21: AA DFB %10101010 ;(B) BIT: %00011=B; %01010=I; %10101=T
FA22: A2 DFB %10100010 ;(B) JMP: %01011=J; %01110=M; %10001=P
FA23: A2 DFB %10100010 ;(B) JMP: %01011=J; %01110=M; %10001=P
FA24: 74 DFB %01110100 ;(B) STY: %10100=S; %10101=T; %11010=Y
FA25: 74 DFB %01110100 ;(B) LDY: %01101=L; %00101=D; %11010=Y
FA26: 74 DFB %01110100 ;(B) CPY: %00100=C; %10001=P; %11010=Y
FA27: 72 DFB %01110010 ;(B) CPX: %00100=C; %10001=P; %11001=X
; ----------------------------------- ;(C)-Format Instructions (8)
FA28: 44 DFB %01000100 ;(C) TXA: %10101=T; %11001=X; %00010=A
FA29: 68 DFB %01101000 ;(C) TXS: %10101=T; %11001=X; %10100=S
FA2A: B2 DFB %10110010 ;(C) TAX: %10101=T; %00010=A; %11001=X
FA2B: 32 DFB %00110010 ;(C) TSX: %10101=T; %10100=S; %11001=X
FA2C: B2 DFB %10110010 ;(C) DEX: %00101=D; %00110=E; %11001=X
FA2D: 00 DFB %00000000 ;(C) ???: %00000=?; %00000=?; %00000=?
FA2E: 22 DFB %00100010 ;(C) NOP: %01111=N; %10000=O; %10001=P
FA2F: 00 DFB %00000000 ;(C) ???: %00000=?; %00000=?; %00000=?
; ----------------------------------- ;(D)-Format Instructions (8)
FA30: 1A DFB %00011010 ;(D) ASL: %00010=A; %10100=S; %01101=L
FA31: 1A DFB %00011010 ;(D) ROL: %10011=R; %10000=O; %01101=L
FA32: 26 DFB %00100110 ;(D) LSR: %01101=L; %10100=S; %10011=R
FA33: 26 DFB %00100110 ;(D) ROR: %10011=R; %10000=O; %10011=R
FA34: 72 DFB %01110010 ;(D) STX: %10100=S; %10101=T; %11001=X
FA35: 72 DFB %01110010 ;(D) LDX: %01101=L; %00101=D; %11001=X
FA36: 88 DFB %10001000 ;(D) DEC: %00101=D; %00110=E; %00100=C
FA37: C8 DFB %11001000 ;(D) INC: %01010=I; %01111=N; %00100=C
; ----------------------------------- ;(E)-Format Instructions (8)
FA38: C4 DFB %11000100 ;(E) ORA: %10000=O; %10011=R; %00010=A
FA39: CA DFB %11001010 ;(E) AND: %00010=A; %01111=N; %00101=D
FA3A: 26 DFB %00100110 ;(E) EOR: %00110=E; %10000=O; %10011=R
FA3B: 48 DFB %01001000 ;(E) ADC: %00010=A; %00101=D; %00100=C
FA3C: 44 DFB %01000100 ;(E) STA: %10100=S; %10101=T; %00010=A
FA3D: 44 DFB %01000100 ;(E) LDA: %01101=L; %00101=D; %00010=A
FA3E: A2 DFB %10100010 ;(E) CMP: %00100=C; %01110=M; %10001=P
FA3F: C8 DFB %11001000 ;(E) SBC: %10100=S; %00011=B; %00100=C
; ==============================================================================
; End of Miniassembler/Disassembler Instruction Display Tables
; ==============================================================================
;
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Start of Section (FA40-FA61): Moved Here from FA86-FAA4 in Old Monitor ROM
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ==============================================================================
; IRQ/BRK Handler:
; ==============================================================================
; In this ROM Image, IRQ NEVER HAPPENS!...because OLDRST Vector ($FF59) is used:
; ------------------------------------------------------------------------------
; What Should & Should Not Be: <-[From end of this ROM Image listing]
; ------------------------------------------------------------------------------
; FFFE: 40 FA DW IRQ ;IRQ Vector ($FA40) IS Right;
; FFFE: 59 FF DW OLDRST ;OLDRST Vector ($FF59) IS Wrong! << BUG >>
; ------------------------------------------------------------------------------
; <<< BUG can be fixed in (Apple II Plus) Emulator ROM images! >>>
; ==============================================================================
;
; ----------------------------------- ;IRQ Handler
FA40: 85 45 IRQ STA ACC ;Save (A) in Accumulator Safe
; ;^[Destroys General Purpose A5-Reg, High]
FA42: 68 PLA ;Pull Processor Status from Top of STACK
FA43: 48 PHA ;Restore STACK Top: Push Processor Status
FA44: 0A ASL A ;Shift Break Flag (Bit 4)
FA45: 0A ASL A ;over into the
FA46: 0A ASL A ;Negative Flag (Bit 7)
FA47: 30 03 BMI BREAK ;Branch if Break Flag (Bit 4) was Set
FA49: 6C FE 03 JMP (IRQADDR) ;Else, Go to (User Routine Vector) in RAM
; ----------------------------------- ;BRK Handler
FA4C: 28 BREAK PLP ;Retrieve Processor Status
FA4D: 20 4C FF JSR SAV1 ;Save All 6502 Registers
; ;Including Program Counter:
; ;<<< BUG: SAV1 Does Not Save A-Reg! >>>
FA50: 68 PLA ;Pull Program Counter, Low
FA51: 85 3A STA PCL ;Save in Program Counter Safe, Low
FA53: 68 PLA ;Pull Program Counter, High
FA54: 85 3B STA PCH ;Save in Program Counter Safe, High
FA56: 6C F0 03 JMP (BRKV) ;BRKV is Set to OLDBRK by Disk Bootup
; ----------------------------------- ;OLD BRK Handler
FA59: 20 82 F8 OLDBRK JSR INSDS1 ;New Monitor <> Old Monitor "XBRK"
FA5C: 20 DA FA JSR RGDSP1 ;Print User Program Counter & Registers
FA5F: 4C 65 FF JMP MON ;Go to Monitor
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; End of Section (FA40-FA61): Moved Here from FA86-FAA4 in Old Monitor ROM
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Start of Section (FA62-FAD6): New in Autostart [New Monitor] ROM
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ==============================================================================
; Autostart [New Monitor] "RESET"; <> [("OLDRST")=(Old Monitor "RESET")]
; ==============================================================================
;
FA62: D8 RESET CLD ;Do this 1st this time;
; ;"OLDRST" does NOT do it!
FA63: 20 84 FE JSR SETNORM ;Set Normal Video Mode & ...
FA66: 20 2F FB JSR INIT ;Init Keyboard & Screen as I/O Devices
FA69: 20 93 FE JSR SETVID ;Reset CSW Output Vector to COUT1 <--+/
FA6C: 20 89 FE JSR SETKBD ;Reset KSW Input Vector to KEYIN <--+/
; ------------------------------------------------------------------------------
; WARNING: Annunciator Terminology is/was Counter Intuitive!
; These New Mnemocics/Labels are NOT!
; ------------------------------------------------------------------------------
; ;Initialize Annunciator Outputs:
FA6F: AD 58 C0 INITAN LDA AN0OFF ; Turn OFF: AN0
FA72: AD 5A C0 LDA AN1OFF ; Turn OFF: AN1
FA75: AD 5D C0 LDA AN2ON ; Turn ON: AN2
FA78: AD 5F C0 LDA AN3ON ; Turn ON: AN3
; ------------------------------------------------------------------------------
FA7B: AD FF CF LDA CLRROM ;Tell slots to disable their extension ROM
FA7E: 2C 10 C0 BIT KBDSTRB ;Clear KBD Strobe (KBD<128)
FA81: D8 NEWMON CLD ;[As opposed to the Old MON @ $FF65]
FA82: 20 3A FF JSR BELL ;BELL Causes Delay if Key Bounces
FA85: AD F3 03 LDA SOFTEV+1 ;Soft Entry (Warm Start) Vector, High
FA88: 49 A5 EOR #$A5 ;PWREDUP must equal [(SOFTEV+1)EOR #$A5]
FA8A: CD F4 03 CMP PWREDUP ;Power-Up Reset CHKSUM
FA8D: D0 17 BNE PWRUP ;Not Equal, so in a Power-Up Reset cycle
FA8F: AD F2 03 LDA SOFTEV ;Equal, so has Cold Start been done yet?
FA92: D0 0F BNE NOFIX ;Cold Start done, so don't reset SOFTEV
FA94: A9 E0 LDA #>BASIC2 ;Soft/Warm/Ctrl-C Entry Point, High
; ;^(Do Not Reinitialize BASIC)
FA96: CD F3 03 CMP SOFTEV+1 ;Soft Entry (Warm Start) Vector
FA99: D0 08 BNE NOFIX ;Cold Start done, so don't reset SOFTEV
FA9B: A0 03 FIXSEV LDY #<BASIC2 ;Soft/Warm/Ctrl-C Entry Point, Low
; ;^(Do Not Reinitialize BASIC)
FA9D: 8C F2 03 STY SOFTEV ;Set Adrs of Reset Handler to Warm Start
; ;^(next time)
FAA0: 4C 00 E0 JMP BASIC ;Cold Start BASIC (Reinitialize)
FAA3: 6C F2 03 NOFIX JMP (SOFTEV) ;Go to Soft Entry (Warm Start) Address
; ==============================================================================
; Power-Up Reset
; ==============================================================================
;
FAA6: 20 60 FB PWRUP JSR APPLEII ;Display "Apple ]["
; ;centered on top line of Screen
;
; ------------------------------------------------------------------------------
; Set Page 3 Vectors:
; ------------------------------------------------------------------------------
; Set New BRK Vector (BRKV) to OLDBRK ($FA59);
; Set Soft Entry Vector (SOFTEV) to Cold Start BASIC Vector ($E000);
; Set Powered-Up Flag (PWREDUP) to $45 = (SOFTEV+1) EOR #$A5.
; ------------------------------------------------------------------------------
;
FAA9: A2 05 SETPG3 LDX #5 ;Number of bytes to copy
FAAB: BD FC FA SETPLP LDA PWRCON-1,X ;Get Page 3 Vectors
FAAE: 9D EF 03 STA GOBRKV,X ;Set Page 3 Vectors
FAB1: CA DEX
FAB2: D0 F7 BNE SETPLP ;Loop until X=0
;
; ------------------------------------------------------------------------------
; Find Disk Drive Controller Slot
; ------------------------------------------------------------------------------
;
FAB4: A9 C8 LDA #$C8 ;Load High Slot (7) Page Address ($C7) + 1
FAB6: 86 00 STX LOC0 ;Set Poiter, Low; X=0
FAB8: 85 01 STA LOC1 ;Set Poiter, High; (for JMP @ $FAD2 below)
FABA: A0 07 SLOOP LDY #$07 ;Y is Byte Pointer
FABC: C6 01 DEC LOC1 ;Decrement Slot Page Address
FABE: A5 01 LDA LOC1 ;Get Slot Page Address for comparison
FAC0: C9 C0 CMP #$C0 ;Down to last Slot yet?
FAC2: F0 D7 BEQ FIXSEV ;YES, it can't be a disk; Cold Start BASIC
FAC4: 8D F8 07 STA MSLOT ;NO, Save current Slot Page Address
FAC7: B1 00 NXTBYT LDA (LOC0),Y ;Fetch a Slot Byte
FAC9: D9 01 FB CMP DISKID-1,Y ;Is it a Disk?
FACC: D0 EC BNE SLOOP ;NO, so next Slot down
FACE: 88 DEY ;Skip over $FF bytes; See DISKID below
FACF: 88 DEY ;YES, so check next byte ...
FAD0: 10 F5 BPL NXTBYT ;Until 4 checked
FAD2: 6C 00 00 JMP (LOC0) ;Go there
; ------------------------------------------------------------------------------
FAD5: EA MON_NOP1 NOP ;Fill
FAD6: EA MON_NOP2 NOP ;Fuller ;-)
; ------------------------------------------------------------------------------
;
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; End of Section (FA62-FAD6): New in Autostart [New Monitor] ROM
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ==============================================================================
; Display User Register Contents with Labels
; ==============================================================================
; ACC EQU $45 ;A-Reg Safe (Accumulator) [Destroys A5H!]
; XREG EQU $46 ;X-Reg Safe (Index Register X)
; YREG EQU $47 ;Y-Reg Safe (Index Register Y)
; STATUS EQU $48 ;P-Reg Safe (Status Register)
; SPNT EQU $49 ;S-Reg Safe (Stack Pointer)
; ==============================================================================
;
; REGDSP Must ORG $FAD7 for New Monitor to remain equal to Old Mmonitor ROM
FAD7: 20 8E FD REGDSP JSR CROUT ;Print Carriage Return (Ctrl-M) Character
FADA: A9 45 RGDSP1 LDA #ACC ;A-Reg Safe (Accumulator)
FADC: 85 40 STA A3L ;Save ACC/A5H-Reg Address in A3-Reg
FADE: A9 00 LDA #>ACC ;ACC/A5H-Reg is a Zero Page Address
FAE0: 85 41 STA A3H ;Monitor General Purpose A3-Reg, High
; ;[A3-Reg ($40-$41)]=[(ACC)=($0045)]**
FAE2: A2 FB LDX #$FB ;Load Index (-5)
FAE4: A9 A0 RDSP1 LDA #' ' | $80 ;Print a Space character
FAE6: 20 ED FD JSR COUT ;Print A-Reg to Output Device
FAE9: BD 1E FA LDA RTBL-251,X ;^"AXYPS"; 6502 Registers (Letter-Names)
; ;^(X)=[($FB=251={-5})~($FF=255={-1})]
; ;^[RTBL-251]=[MNEMR+30]
FAEC: 20 ED FD JSR COUT ;Print A-Reg to Output Device
FAEF: A9 BD LDA #'=' | $80 ;Print an Equal-Sign character
FAF1: 20 ED FD JSR COUT ;Print A-Reg to Output Device
FAF4: B5 4A LDA SAVE6502,X ;6502 Registers Safe (Save Locations)+5
; ;^(X)=[($FB=251={-5})~($FF=255={-1})]
FAF6: 20 DA FD JSR PRBYTE ;Print A-Reg as Two-Digit Hex Number
FAF9: E8 INX ;Count UP
FAFA: 30 E8 BMI RDSP1 ;Loop until all 5 6502 Reg's are displayed
FAFC: 60 RTS ;**; Return to Caller
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Start of Section (FAFD-FB18): New in Autostart [New Monitor] ROM
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ==============================================================================
; Power-Up Reset Data
; ==============================================================================
;
FAFD: 59 FA PWRCON DW OLDBRK ;To Set New BRK Vector (BRKV)
FAFF: 00 E0 DW BASIC ;To Set Soft Entry Vector (SOFTEV)
; <---[Page Boundary] (in the middle of the DWord above)
FB01: 45 DFB $45 ;To Set Powered-Up Flag
; ;^(PWREDUP)=(SOFTEV+1)EOR(#$A5)
;
; ==============================================================================
; Disk Drive Controller ID-Bytes; For Slot (7 To 0) Scan [SLOOP/NXTBYT above]
; ==============================================================================
;
FB02: 20 DISKID DFB $20 ;20/00/03/3C is controller signature (**)
FB03: FF DFB $FF ;$FFs are Skipped over; See NXTBYT above
FB04: 00 DFB $00 ;** See DISK2ROM..MKDCTBL @ $C600..$C606
FB05: FF DFB $FF ;$FF bytes are substitutes for OpCodes
FB06: 03 DFB $03 ;that would otherwise make this data into
FB07: FF DFB $FF ;functional code identical to the first 7
FB08: 3C DFB $3C ;bytes of code on the disk drive control-
; ;ler, which would not be good!
;
; ==============================================================================
; Title to be displayed, centered on top line of Screen
; ==============================================================================
;
FB09: C1 D0 D0 CC+ TITLE ASC ^"APPLE ][" ;High ASCII "APPLE ]["
;
; ==============================================================================
; Cursor Keys Translation Table
; ==============================================================================
;
FB11: C4 XLTBL DFB 'D' | $80 ;High ASCII ($C4 = 196) "D"
FB12: C2 DFB 'B' | $80 ;High ASCII ($C2 = 194) "B"
FB13: C1 DFB 'A' | $80 ;High ASCII ($C1 = 193) "A"
FB14: FF DFB DELETE ;High ASCII ($FF = 255) "Delete"
FB15: C3 DFB 'C' | $80 ;High ASCII ($C3 = 195) "C"
FB16: FF DFB DELETE ;High ASCII ($FF = 255) "Delete"
FB17: FF DFB DELETE ;High ASCII ($FF = 255) "Delete"
FB18: FF DFB DELETE ;High ASCII ($FF = 255) "Delete"
;
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; End of Section (FAFD-FB18): New in Autostart [New Monitor] ROM
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ==============================================================================
; 6502 Registers (Letter-Names)
; ==============================================================================
;
; RTBL Must ORG $FB19 for New Monitor to remain equal to Old Mmonitor ROM
FB19: C1 RTBL DFB 'A' | $80 ;6502 Accumulator Register
FB1A: D8 DFB 'X' | $80 ;6502 X-Index Register
FB1B: D9 DFB 'Y' | $80 ;6502 Y-Index Register
FB1C: D0 DFB 'P' | $80 ;6502 Processor Status Register
FB1D: D3 DFB 'S' | $80 ;6502 Stack Pointer Register
; ==============================================================================
; Read Paddle (X-Reg), Return Time-Count in (Y-Reg)
; ==============================================================================
;
FB1E: AD 70 C0 PREAD LDA PTRIG ;~($C07X)[R/W]; Trigger/Reset All Paddles
FB21: A0 00 PREAD4 LDY #0 ;Initialize Time-Counter
FB23: EA NOP ;Compensate for First Time-Count: Do zip
FB24: EA NOP ;for (2 NOPs)*(2 cycles/NOP)=4 cycles
FB25: BD 64 C0 PREAD2 LDA PADDL0,X ;Read Paddle (X-Reg)
FB28: 10 04 BPL MON_RTS2D ;Timed-Out if (A) is positive [0<=(A)<128]
FB2A: C8 INY ;Count UP (Y) every 12 microseconds
FB2B: D0 F8 BNE PREAD2 ;Exit at (Y=0) for a Max Count of 255
FB2D: 88 DEY ;*: Return Last Time-Count in (Y)
FB2E: 60 MON_RTS2D RTS ;* [Time=~(Y)*12us]; Return to Caller
; ==============================================================================
; Initialize Video Screen for Text Mode
; ==============================================================================
;
FB2F: A9 00 INIT LDA #0 ;Clear Acc for Screen Initialization:
FB31: 85 48 STA STATUS ;Save Status Register in P-Reg Safe
FB33: AD 56 C0 TEXT01 LDA LORES ;Reset HiRes Mode to LoRes/Text Mode
FB36: AD 54 C0 TEXT02 LDA TXTPAGE1 ;Display Text Page1; R/W Main V-RAM
FB39: AD 51 C0 SETTXT LDA TXTSET ;Set Screen to Text Mode
FB3C: A9 00 LDA #0 ;Clear Accumulator (Again)
FB3E: F0 0B BEQ SETWND ;Always Taken
; ==============================================================================
; Initialize Video Screen for Mixed Graphics & Text Mode
; ==============================================================================
;
FB40: AD 50 C0 SETGR LDA TXTCLR ;Set Screen to Graphics Mode
FB43: AD 53 C0 LDA MIXSET ;Set Mixed Graphics & Text Mode
FB46: 20 36 F8 JSR CLRTOP ;Clear Top (40 Lines on) Lo-Res Screen
FB49: A9 14 LDA #20 ;Normal Mixed Graphics & Text Window Top
FB4B: 85 22 SETWND STA WNDTOP ;Set Top of Scroll Window
FB4D: A9 00 LDA #0 ;Normal Lo-Res/Text Window Left
FB4F: 85 20 STA WNDLFT ;Set Left Column of Scroll Window
FB51: A9 28 SETWND2 LDA #40 ;Normal Lo-Res/Text Window Width
FB53: 85 21 STA WNDWDTH ;Set Width of Scroll Window
FB55: A9 18 LDA #24 ;Normal Lo-Res/Text Window Bottom
FB57: 85 23 STA WNDBTM ;Set Bottom of Scroll Window
FB59: A9 17 LDA #23 ;Normal Text Window Bottom Line Number
FB5B: 85 25 TABV STA CV ;Place Cursor at Line (A) & Column (CH)
FB5D: 4C 22 FC JMP MON_VTAB ;TAB to ROW specified in (A)
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Start of Section (FB60-FBC0): New in Autostart [New Monitor] ROM
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ==============================================================================
; Display TITLE ("Apple ][") centered on top line of Screen
; ==============================================================================
;
FB60: 20 58 FC APPLEII JSR HOME ;Clear Text Display & Home Cursor
FB63: A0 08 LDY #8 ;Prepare to Display 8 Title Characters
FB65: B9 08 FB STITLE LDA TITLE-1,Y ;Get a Title Character to Display
FB68: 99 0E 04 STA LINE1+14,Y ;Put a Title Character in Display Memory
FB6B: 88 DEY ;Reduce Loop Character Counter
FB6C: D0 F7 BNE STITLE ;Loop until all Title Characters Displayed
FB6E: 60 RTS ;Return to Caller
; ==============================================================================
; Set Power-Up Reset CHKSUM [(SOFTEV+1)EOR #$A5] [Done differently above!]
; ==============================================================================
;
; ------------------------------------------------------------------------------
; SETPWRC [No Drop-In] ;Never Referenced [Can Never Happen]
; (Only Exception: User-Callable Entry Point; BASIC: CALL -1,169 or CALL 64,367
; ------------------------------------------------------------------------------
;
FB6F: AD F3 03 SETPWRC LDA SOFTEV+1 ;Get Soft Entry (Warm Start) Vector, High
FB72: 49 A5 EOR #$A5 ;Compute: [(SOFTEV+1)EOR #$A5]
FB74: 8D F4 03 STA PWREDUP ;Power-Up Reset CHKSUM
FB77: 60 RTS ;Return to Caller
; ==============================================================================
; Pause: Check for a Computer Operator Pause Request; if Requested, Pause until
; another Key is Pressed; then continue on, unless Stop (Ctrl-C) is Requested!
; ==============================================================================
;
FB78: C9 8D VIDWAIT CMP #RTNH ;Is (A)=(Carriage Return)?
FB7A: D0 18 BNE NOWAIT ;NO, Do Not Wait
FB7C: AC 00 C0 LDY KBD ;YES, Has a Key been Pressed?
FB7F: 10 13 BPL NOWAIT ;NO, Do Not Wait
FB81: C0 93 CPY #CTRLSH ;YES, was it a Ctrl+S Character?
FB83: D0 0F BNE NOWAIT ;NO, Do Not Wait
FB85: 2C 10 C0 BIT KBDSTRB ;YES, Clear KBD Strobe (Make KBD<128)
FB88: AC 00 C0 KBDWAIT LDY KBD ;Wait until next Key to Resume
FB8B: 10 FB BPL KBDWAIT ;Loop, Wait for Keypress
FB8D: C0 83 CPY #CTRLCH ;Key Pressed, was it a Ctrl+C Character?
FB8F: F0 03 BEQ NOWAIT ;YES, Do Not Wait
FB91: 2C 10 C0 BIT KBDSTRB ;NO, Clear KBD Strobe (Make KBD<128)
FB94: 4C FD FB NOWAIT JMP VIDOUT ;& Do as Before
; ==============================================================================
; Escape Character Handlers:
; ==============================================================================
;
; ----------------------------------- ;Old Escape Character Handler:
FB97: 38 ESCOLD SEC ;Prepare for Add with Carry Set (Adds 1)
FB98: 4C 2C FC JMP ESC1 ;Handle Escape Character
; ----------------------------------- ;New Escape Character Handler:
FB9B: A8 ESCNOW TAY ;Use Character as Index
FB9C: B9 48 FA LDA XLTBASE,Y ;Translate (I|J|K|M) to (C|B|A|D)
; >>>--> XLTBL EQU $FB11 ;^[XLTBL=(Cursor Keys Translation Table)]
; ;^[XLTBASE=XLTBL-("I"=$C9=201)=$FA48]
FB9F: 20 97 FB JSR ESCOLD ;Do Cursor Motion
FBA2: 20 0C FD JSR RDKEY ;& Get in (A) & Make Cursor Char Flash
FBA5: C9 CE ESCNEW CMP #'N' | $80 ;Was it an "N" Character?
FBA7: B0 EE BCS ESCOLD ;YES, "N" or Greater, Do it
FBA9: C9 C9 CMP #'I' | $80 ;Was it an "I" Character?
FBAB: 90 EA BCC ESCOLD ;YES, "I" or Less, Do it
FBAD: C9 CC CMP #'L' | $80 ;Was it an "L" Character?
FBAF: F0 E6 BEQ ESCOLD ;YES, Do it
FBB1: D0 E8 BNE ESCNOW ;Loop: Handle New Character; Always Taken
; ==============================================================================
; NOP Free Space [that can be changed in (Apple II Plus) Emulator ROM images]:
; ==============================================================================
;
FBB3: EA VERSION DFB $EA ;14 NOP Bytes . . .
FBB4: EA DFB $EA
FBB5: EA DFB $EA ;This space could be used
FBB6: EA DFB $EA ;by anyone if this were in
FBB7: EA DFB $EA ;LC RAM instead of MB ROM!
FBB8: EA DFB $EA
FBB9: EA DFB $EA ;This space (FBB3-FBBE) is used
FBBA: EA DFB $EA ;in the Apple IIE Autostart ROM
FBBB: EA DFB $EA
FBBC: EA DFB $EA
FBBD: EA DFB $EA
FBBE: EA DFB $EA
FBBF: EA ZIDBYTE2 DFB $EA ;(Not Used Yet)
FBC0: EA ZIDBYTE DFB $EA ;(Not Used Yet)
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; End of Section (FB60-FBC0): New in Autostart [New Monitor] ROM
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ==============================================================================
; Calculate Text Base Address (BASH,BASL) for Left End of Screen Line Number
; (Not Window Line Number) in A-Reg [# Range: (0~23)=($00~$17)=(%00000~%10111)]
; ==============================================================================
; BASCALC [to set Text Line Base Address (BASH,BASL)] is almost identical to
; GBASCALC [to set Graphics Base Address (GBASH,GBASL)]
; ---------------------------vv-------------------------vv----------vv----vv----
; F847: 48 4A 29 03 09 04 85 27 68 29 18 90 02 69 7F 85 26 0A 0A 05 26 85 26 60
; FBC1: 48 4A 29 03 09 04 85 29 68 29 18 90 02 69 7F 85 28 0A 0A 05 28 85 28 60
; ------------------------------------------------------------------------------
; Note: Indexed Addressing of the Base Address ZP Pointers would allow S/R's
; to be combined into one S/R with one or two different Entry Points to preset
; which task is being processed (e.g., GBASL,X & GBASH,X & X=0 or X=2)
; ------------------------------------------------------------------------------
; GBASL EQU $26 ;Graphics Base Address, Low
; GBASH EQU $27 ;Graphics Base Address, High
; BASL EQU $28 ;Text Base Address, Low
; BASH EQU $29 ;Text Base Address, High
; ==============================================================================
;
; BASCALC Must ORG $FBC1 for New Monitor to remain equal to Old Mmonitor ROM
;
; ----------------------------------- ;Set Line Base Address (BASH,BASL):
; ;^[RAM Address of Text Line Specified]
FBC1: 48 BASCALC PHA ;Push Line Number Specified [%000ABCDE]
; ---------------------- ;Compute Text Base Address, High (BASH):
FBC2: 4A LSR A ;Shift %000ABCDE->%0000ABCD & %E->(C)**
; ;[Shifts BASH->{%E->(C)**}->BASL, below]
FBC3: 29 03 AND #%00000011 ;Generate %000000CD
FBC5: 09 04 ORA #%00000100 ;Generate %000001CD
FBC7: 85 29 STA BASH ;Set Text Base Address, High [Pages 4~7]
; ---------------------- ;Compute Text Base Address, Low (BASL):
FBC9: 68 PLA ;Pull Line Number Specified [%000ABCDE]
FBCA: 29 18 AND #%00011000 ;Generate %000AB000
FBCC: 90 02 BCC BASCALC2 ;Branch if %E->(C=0)**; Skip Next (Add):
FBCE: 69 7F ADC #$7F ;Else, Add [$7F+(C=1)=$80]->[%100AB000]**
; ;[Shifts BASH->{%E->(C=1)**}->BASL]
; --------------- ;Generate: %E00AB000->%EABAB000:
FBD0: 85 28 BASCALC2 STA BASL ;Set Text Base Address, Low [%E00AB000]
FBD2: 0A ASL A ;[(A)=(A*2)]: Generate %00AB0000
FBD3: 0A ASL A ;[(A)=(A*2)]: Generate %0AB00000
FBD4: 05 28 ORA BASL ;Generate %EABAB000=[%0AB00000|%E00AB000]
FBD6: 85 28 STA BASL ;Set Text Base Address, Low [%EABAB000]
; ;^[(0~$78)=(0~120)|($80~$F8)=(128~248)]
; ;^[Off Screen Holes: $78~$7F & $F8~$FF]
; ---------------------- ;Now (BASH,BASL)=[%0000,01CD,EABA,B000]
;
; ;------------+---------+---------+
; ; Screen Line Base Addresses: |
; ;------------+---------+---------+
; ; | BASH | BASL |
; ;------------+---------+---------+
; ; Top 3rd of Text Screen: |
; ;------------+---------+---------+
; ;$400, 1024, %0000,0100,0000,0000;
; ;$480, 1152, %0000,0100,1000,0000;
; ;$500, 1280, %0000,0101,0000,0000;
; ;$580, 1408, %0000,0101,1000,0000;
; ;$600, 1536, %0000,0110,0000,0000;
; ;$680, 1664, %0000,0110,1000,0000;
; ;$700, 1792, %0000,0111,0000,0000;
; ;$780, 1920, %0000,0111,1000,0000;
; ;------------+---------+---------+
; ; Middle 3rd of Text Screen: |
; ;------------+---------+---------+
; ;$428, 1064, %0000,0100,0010,1000;
; ;$4A8, 1192, %0000,0101,1010,1000;
; ;$528, 1320, %0000,0101,0010,1000;
; ;$5A8, 1448, %0000,0100,1010,1000;
; ;$628, 1576, %0000,0110,0010,1000;
; ;$6A8, 1704, %0000,0110,1010,1000;
; ;$728, 1832, %0000,0111,0010,1000;
; ;$7A8, 1960, %0000,0111,1010,1000;
; ;------------+---------+---------+
; ; Bottom 3rd of Text Screen: |
; ;------------+---------+---------+
; ;$450, 1104, %0000,0100,0101,0000;
; ;$4D0, 1232, %0000,0100,1101,0000;
; ;$550, 1360, %0000,0101,0101,0000;
; ;$5D0, 1488, %0000,0101,1101,0000;
; ;$650, 1616, %0000,0110,0101,0000;
; ;$6D0, 1744, %0000,0110,1101,0000;
; ;$750, 1872, %0000,0111,0101,0000;
; ;$7D0, 2000, %0000,0111,1101,0000;
; ;------------+---------+---------+
; ; BASH,L: %0000,01CD,EABA,B000;
; ;------------+---------+---------+
;
; ----------------------------------- ;Returns: BASH=000001CD; BASL=EABAB000
FBD8: 60 RTS ;Return to Caller
; ==============================================================================
; Sound Bell [(*) BELLA & BELLB are Undocumented Entry Points]
; ==============================================================================
;
; ----------------------------------- ;Assure Sound Bell Character:
FBD9: C9 87 BELL1 CMP #BELL_H ;Is (A) a Bell (Cntrl-G) Character?
FBDB: D0 12 BNE MON_RTS2B ;NO, Return to Caller
;
; (*) ------------------------------- ;Sound Bell regardless of Output Device:
FBDD: A9 40 BELLA LDA #64 ;Delay .01 Second
FBDF: 20 A8 FC JSR MON_WAIT ;Delay (26+27*Acc+5*(Acc*Acc))/2 Cycles
;
; (*) ------------------------------- ;Sound Bell without first WAIT:
FBE2: A0 C0 BELLB LDY #192 ;Toggle Speaker at 1 Khz for .1 Second
;
; ---------------------- ;Sound Bell Loop:
FBE4: A9 0C BELL2 LDA #12 ;Toggle Speaker at 1 Khz for (Y) Time
FBE6: 20 A8 FC JSR MON_WAIT ;Delay (26+27*Acc+5*(Acc*Acc))/2 Cycles
FBE9: AD 30 C0 LDA SPKR ;Toggle Speaker Output
FBEC: 88 DEY ;Reduce Loop Counter
FBED: D0 F5 BNE BELL2 ;Loop Until Done
FBEF: 60 MON_RTS2B RTS ;Return to Caller
; ==============================================================================
; Output A-Reg as Text (Place Character in Screen Memory):
; ==============================================================================
;
FBF0: A4 24 STORADV LDY CH ;Set Y-Index to Cursor Horizontal (CH)
FBF2: 91 28 STA (BASL),Y ;Put Char (A) in (Base Adrs) Line at (CH)
FBF4: E6 24 ADVANCE INC CH ;Advance Cursor Horizontal (Move Right)
FBF6: A5 24 LDA CH ;Get Cursor Horizontal
FBF8: C5 21 CMP WNDWDTH ;Is Cursor Horizontal past Window Width?
FBFA: B0 66 BCS CARRETURN ;YES, Return Cursor (CR) to Next Line
FBFC: 60 MON_RTS3 RTS ;NO, Return to Caller
; ==============================================================================
; Output A-Reg as Text (Place in Screen Memory) or Process Control Character:
; ==============================================================================
;
FBFD: C9 A0 VIDOUT CMP #' ' | $80 ;Is (A) a Control Character [$80~$9F]?
FBFF: B0 EF BCS STORADV ;BGE: NO, Output Char (A) as Text
; <---[Page Boundary] (in the middle of the DWord above)
FC01: A8 TAY ;YES; Is Ctrl-Char an Inverse Video Char?
FC02: 10 EC BPL STORADV ;YES, Output Inverse Video Character
FC04: C9 8D CMP #RTNH ;NO; Is Ctrl-Char a Carriage Return (CR)?
FC06: F0 5A BEQ CARRETURN ;YES, Return Cursor (CR) to Next Line
FC08: C9 8A CMP #LFH ;NO; Is Ctrl-Char a Line Feed?
FC0A: F0 5A BEQ LINEFEED ;If YES, Go Do a Line Feed
FC0C: C9 88 CMP #BSH ;NO; Is Ctrl-Char a Back Space (Ctrl-H)?
FC0E: D0 C9 BNE BELL1 ;NO; Go Check if it is a BELL (Ctrl-G)?
; ----------------------------------- ;YES, Char (A) is a Back Space (Ctrl-H)
FC10: C6 24 BACKSPACE DEC CH ;Reduce Cursor Horizontal
FC12: 10 E8 BPL MON_RTS3 ;If Positive, Return to Caller; Else:
; ---------------------- ;Move to Rightmost Screen Column:
FC14: A5 21 LDA WNDWDTH ;Get Width of Scroll Window
FC16: 85 24 STA CH ;Set Cursor Horizontal (CH=WNDWDTH)
FC18: C6 24 DEC CH ;Reduce Cursor Horizontal (CH=CH-1)
; ---------------------- ;Move Up (at Rightmost Screen Column):
FC1A: A5 22 CURSORUP LDA WNDTOP ;Get Top of Scroll Window
FC1C: C5 25 CMP CV ;Is Cursor Vertical (CV) at Top of Window?
FC1E: B0 0B BCS MON_RTS4 ;If at Top Line, Return to Caller
FC20: C6 25 DEC CV ;Else, Reduce Cursor Vertical (CV=CV-1)
; ----------------------------------- ;TAB to ROW specified in A-Reg:
FC22: A5 25 MON_VTAB LDA CV ;Get Cursor Vertical
FC24: 20 C1 FB VTABZ JSR BASCALC ;Generate Base Address
FC27: 65 20 ADC WNDLFT ;Add Left Column of Scroll Window
FC29: 85 28 STA BASL ;Set Base Address, Low
; ;^[There shouldn't be any Carryover!]
FC2B: 60 MON_RTS4 RTS ;Return to Caller
; ==============================================================================
; Escape Character Handler:
; ==============================================================================
;
; ------------------------------------; Handle Escape Character
FC2C: 49 C0 ESC1 EOR #'@' | $80 ;Is Char (A)=("@")?
FC2E: F0 28 BEQ HOME ;Branch if Esc+@, Do Home & Clear
; ;^[("@"=$C0)XOR("@"=$C0)=(0)**]
FC30: 69 FD ADC #$FD ;Is Char (A)=("A"|"B")? [Adds (C=1)]
FC32: 90 C0 BCC ADVANCE ;Branch if Esc+A, Advance
; ;^[("@"=$C0)XOR("A"=$C1)=(1) ->
; ; (1)+($FD)+(C=1)=($FF)=(-1) ->(C=0)**]
FC34: F0 DA BEQ BACKSPACE ;Branch if Esc+B, Backspace
; ;^[("@"=$C0)XOR("B"=$C2)=(2) ->
; ; (2)+($FD)+(C=1)=(0)**]
FC36: 69 FD ADC #$FD ;Is Char (A)=("C"|"D")? [Adds (C=1)]
FC38: 90 2C BCC LINEFEED ;Branch if Esc+C, Down
; ;^[("@"=$C0)XOR("C"=$C3)=(3) ->
; ; (3)+($FD)+(C=1)=(1) ->(C=1)->
; ; (1)+($FD)+(C=1)=($FF)=(-1) ->(C=0)**]
FC3A: F0 DE BEQ CURSORUP ;Branch if Esc+D, Up
; ;^[("@"=$C0)XOR("D"=$C4)=(4) ->
; ; (4)+($FD)+(C=1)=(2) ->(C=1)->
; ; (2)+($FD)+(C=1)=(0)**]
FC3C: 69 FD ADC #$FD ;Is Char (A)=("E"|"F")? [Adds (C=1)]
FC3E: 90 5C BCC CLREOL ;Branch if Esc+E, Clear to End of Line
; ;^[("@"=$C0)XOR("E"=$C5)=(5) ->
; ; (5)+($FD)+(C=1)=(3) ->(C=1)->
; ; (3)+($FD)+(C=1)=(1) ->(C=1)->
; ; (1)+($FD)+(C=1)=($FF)=(-1) ->(C=0)**]
FC40: D0 E9 BNE MON_RTS4 ;Branch if Not Esc+F, Return to Caller
; ;^[("@"=$C0)XOR("F"=$C6)=(6) ->
; ; (6)+($FD)+(C=1)=(4) ->(C=1)->
; ; (4)+($FD)+(C=1)=(2) ->(C=1)->
; ; (2)+($FD)+(C=1)=(0)**]
; ----------------------------------- ;Else, Esc+F, Clear to End of Page
; ;[Unused, User-Callable Entry Point]:
FC42: A4 24 CLREOP LDY CH ;Get Cursor Horizontal (CH)
FC44: A5 25 LDA CV ;Get Cursor Vertical (CV)
; ----------------------------------- ;Clear to End of Page Loop
; ;[User-Callable Entry Point]:
FC46: 48 CLEOP1 PHA ;Push Current Line (Save on STACK)
FC47: 20 24 FC JSR VTABZ ;Set Base Address (Updates BASL)
FC4A: 20 9E FC JSR CLREOLZ ;Clear to End of Line (EOL) & Set Carry
FC4D: A0 00 LDY #0 ;Clear from Line Left End (CH=0) for Rest
FC4F: 68 PLA ;Pull Current Line (Retrieve from STACK)
FC50: 69 00 ADC #0 ;Advance Current Line [Adds (C=1)]
FC52: C5 23 CMP WNDBTM ;Cleared to Bottom of Window?
FC54: 90 F0 BCC CLEOP1 ;NO, Keep Clearing Lines
FC56: B0 CA BCS MON_VTAB ;YES, Tab to Current Line; Always Taken
; ==============================================================================
; "HOME" Statement: Immediate & Deferred; No Parameters
; ==============================================================================
; Moves Cursor to Upper Left Screen Position within Scrolling Window & Clears
; all Text within Window; Same as "CALL -936" & "ESC @ RETURN"
; ==============================================================================
;
; ----------------------------------- ;Initialize Cursor Vertical & Horizontal:
FC58: A5 22 HOME LDA WNDTOP ;Get Top of Scroll Window
FC5A: 85 25 STA CV ;Set Cursor Vertical (CV)
FC5C: A0 00 LDY #0 ;Clear Y-Index Register
FC5E: 84 24 STY CH ;Clear Cursor Horizontal (CH)
FC60: F0 E4 BEQ CLEOP1 ;Clear to End of Page; Always Taken
; ==============================================================================
; Return Cursor [Printer/Typewriter Carriage Return] (CR) to Start of Next Line:
; ==============================================================================
; Forget about Printer/Typewriter Carriage Returns; this is more about the
; Apple II Cursor (on Screen) than it is about those old mechanical devices!
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Return Cursor (CR) to Start of Next Line:
FC62: A9 00 CARRETURN LDA #0 ;Clear Accumulator
FC64: 85 24 STA CH ;Clear Cursor Horizontal to Start of Line
; ----------------------------------- ;Down (Esc+C/Ctrl+J), Do a Line Feed:
FC66: E6 25 LINEFEED INC CV ;Advance Cursor Verical to Next Line
FC68: A5 25 LDA CV ;Get Cursor Verical [Now Line # (0~23)]
FC6A: C5 23 CMP WNDBTM ;Is Cursor Vertical Off Screen (CV>23)?
FC6C: 90 B6 BCC VTABZ ;NO, Set Base Address (Updates BASL)
FC6E: C6 25 DEC CV ;YES, Reduce Cursor Vertical to Bottom
; ----------------------------------- ;Scroll Window Up (Line by Line)
; ;[Unused, User-Callable Entry Point]:
FC70: A5 22 SCROLL LDA WNDTOP ;Start at Top of Scroll Window
FC72: 48 PHA ;Push Scroll Window Top (Save on STACK)
FC73: 20 24 FC JSR VTABZ ;Set Base Address (Updates BASL)
; ----------------------------------- ;Scrolling Loop:
; --------------- ;Save Current Line Base Address;
; ;Copy Base Address [(BASL,H)->(BAS2L,H)]:
FC76: A5 28 SCRL1 LDA BASL ;Get Base Address (1), Low
FC78: 85 2A STA BAS2L ;Set Base Address Two, Low
FC7A: A5 29 LDA BASH ;Get Base Address (1), High
FC7C: 85 2B STA BAS2H ;Set Base Address Two, High
; --------------- ;Initialize Y-Index Register to
; ;Rightmost Column of Scrolling Window:
FC7E: A4 21 LDY WNDWDTH ;Get Window Width
FC80: 88 DEY ;Reduce to Rightmost Scroll Window Column
; --------------- ;Check if at Bottom of Scrolling Window:
FC81: 68 PLA ;Pull Scroll Window Top (Retrieve STACK)
FC82: 69 01 ADC #1 ;Advance Scroll Window Top (Now Line #)
FC84: C5 23 CMP WNDBTM ;Reached Bottom of Scroll Window, Done?
FC86: B0 0D BCS SCRL3 ;BGE [Exit Loop]: YES, Go Finish Up
FC88: 48 PHA ;NO, Push Scroll Window Top (Now Line #)
FC89: 20 24 FC JSR VTABZ ;Set Base Address (Updates BASL)
; ---------------------- ;Move Characters (A) Up One Line (Loop):
FC8C: B1 28 SCRL2 LDA (BASL),Y ;Get Character (on Now Line #) to Move Up
FC8E: 91 2A STA (BAS2L),Y ;Move Up: Set Character (on Now Line # -1)
FC90: 88 DEY ;Reduce Column [Going from Right to Left]
FC91: 10 F9 BPL SCRL2 ;Move Up: Next Characater
; ---------------------- ;Done with Chacracters on this Line
FC93: 30 E1 BMI SCRL1 ;Scroll Up: Next Line; Always Taken
; ----------------------------------- ;Scroll Window Up (Line by Line) Done;
; ;Fininsh Up; Clear Bottom Line of Window:
FC95: A0 00 SCRL3 LDY #0 ;Clear (Indirect Addressing),Y-Index for:
FC97: 20 9E FC JSR CLREOLZ ;Clear to End of Line & Set Carry
FC9A: B0 86 BCS MON_VTAB ;Always Taken
;
; ==============================================================================
; (Esc+E): Clear from Cursor [(BASL),(CH|Y)] to End of Line [(BASL),(WNDWDTH)]:
; ==============================================================================
;
; ----------------------------------- ;Clear from Cursor [(BASL),(CH)] to EOL:
FC9C: A4 24 CLREOL LDY CH ;Get Cursor Horizontal Position
; ----------------------------------- ;Clear from Cursor [(BASL),(Y)] to EOL:
FC9E: A9 A0 CLREOLZ LDA #' ' | $80 ;Get a Blank/Space Character to Fill with
; ----------------------------------- ;Chr Fill from Cursor [(BASL),(Y)] to EOL
; ;Loop [& User-Callable Entry Point]:
FCA0: 91 28 CLEOL2 STA (BASL),Y ;Set Char (A) at Line (BASL), Column (Y)
FCA2: C8 INY ;Advance Column Counter
FCA3: C4 21 CPY WNDWDTH ;Has End of Line been reached?
FCA5: 90 F9 BCC CLEOL2 ;BLT [Loop]: NO, Continue Filling Line
FCA7: 60 RTS ;YES, Done Filling; Return to Caller
; ==============================================================================
; Mon Wait Subroutine: [This is a Simple Algorithm for a Quadratic Equation!]
; ==============================================================================
; Wait Time is from Call (JSR MON_WAIT) to End of Return to Caller (End of RTS);
; Wait Time in Microseconds at the Non-Accelerated Speed of an Apple II Plus is:
; [Time]=[Delay (5*(Acc*Acc)+27*Acc+26)/2 Cycles]*[1.023 Microseconds/Cycle]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Delay (26+27*Acc+5*(Acc*Acc))/2 Cycles
; ;v--[Cycles/Operation]
; ;6: For "JSR MON_WAIT" to get here!
FCA8: 38 MON_WAIT SEC ;2: Prepare to Subtract w/o Borrow
FCA9: 48 MON_WAIT2 PHA ;3: Push Accumulator (Save on STACK)
FCAA: E9 01 MON_WAIT3 SBC #1 ;2: Subtract w/o Borrow [A-Data-!C]
FCAC: D0 FC BNE MON_WAIT3 ;2+ Loop Until (A=0) [5 cycles/iteration]
; ; ^[4 cycles/iteration when (A=0)]
FCAE: 68 PLA ;4: Pull Accumulator (Retrieve from STACK)
FCAF: E9 01 SBC #1 ;2: Subtract w/o Borrow [A-Data-!C]
FCB1: D0 F6 BNE MON_WAIT2 ;2+ Loop Until (A=0) [~5*(A)+12 cycles/it]
; ; ^[~5*(A)+11 cycles/it when (A=0)]
FCB3: 60 RTS ;6: Return to Caller
; ==============================================================================
; Next A4 & Next A1: Monitor General Purpose (16 Bit) Accumulator Registers
; ==============================================================================
;
FCB4: E6 42 NXTA4 INC A4L ;Increment General Purpose A4-Reg, Low
FCB6: D0 02 BNE NXTA1 ;Branch if Not yet up to Next Page
FCB8: E6 43 INC A4H ;Increment General Purpose A4-Reg, High
; ---------------------- ;Has A1 Reached A2?
FCBA: A5 3C NXTA1 LDA A1L ;Get General Purpose A1-Reg, Low
FCBC: C5 3E CMP A2L ;Subtract: (A)=(A1L-A2L)
FCBE: A5 3D LDA A1H ;Get General Purpose A1-Reg, High
FCC0: E5 3F SBC A2H ;Subtract: (A)=(A1H-A2H)
FCC2: E6 3C INC A1L ;Increment General Purpose A1-Reg, Low
FCC4: D0 02 BNE MON_RTS4B ;Branch if Not yet up to Next Page
FCC6: E6 3D INC A1H ;Increment General Purpose A1-Reg, High
; ---------------------- ;Caller should Check if A1 Has Reached A2:
FCC8: 60 MON_RTS4B RTS ;Return to Caller
; ==============================================================================
; Internal Cassette Tape Write (Output) & Read (Input) Routines: HEADER, WRBIT,
; RDBYTE, RD2BIT, RDBIT, WRBYTE (See: "Apple II Monitors Peeled" pgs.81~84)
; ==============================================================================
;
; ==============================================================================
; Cassette Tape Record Synchronization Header Subroutine:
; ==============================================================================
; Writes Synchronization Monotone to Audio-Out: The first part of every Tape
; Record is a 10 sec 770 hz (1300 usec/cycle) header tone (See TN/TIL# 495~496)
; ------------------------------------------------------------------------------
; (A)=[Synchronization Header Length (0.2~40 sec)]; (X)=[Audio Half-Cycle Toggle
; Count (Clear at Entry)]; (Y)=(Loop Duration Count); Writing to Tape/Audio-Out:
; (C)=[Clear for a Zero-Bit, or Set for a One-Bit (Set at Entry)]
; ------------------------------------------------------------------------------
; Write [(A)*256] 'Long-1' Half-Cycles (650 usec each); Then, Write a 'Short-0'
; Sync Bit, 2 Half-Cycles (200+250=450 usec/{1 cycle}); Normal (Not Short/Long)
; Half-Cycle Durations are 250 usec for a Zero-Bit & 500 usec for a One-Bit
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Write Tape Synchronization Monotone:
FCC9: A0 4B HEADER LDY #75 ;Get Time Count for Zero-Bit Delay Loop
; ;^[For 'Long-1' (650 usec) Half-Cycles]
FCCB: 20 DB FC JSR ZERODLY ;Write a Half-Cycle [Returns (Y=44)]
FCCE: D0 F9 BNE HEADER ;Branch Until Done <-[when (X=0)]
FCD0: 69 FE ADC #254 ;Decrement (A) {Add w/ Carry [A+Data+C]}
; ;^[Add to Subtract: {C=1}+{$FE=(-2)}=(-1)]
FCD2: B0 F5 BCS HEADER ;BGE: Branch Until Done <-[when (A=C=0)]
; ---------------------- ;Finish with Sync Bit:
FCD4: A0 21 LDY #33 ;Get Time Count for Zero-Bit Delay Loop
; ;^[For Sync Bit (200 usec) Half-Cycle]
; ----------------------------------- ;Write a Bit (2 Half-Cycles) to Tape:
FCD6: 20 DB FC WRBIT JSR ZERODLY ;Write a Half-Cycle [Returns (Y=44)]
FCD9: C8 INY ;Advance Time Count [Now (Y=Y+1=45)]
FCDA: C8 INY ;Advance Time Count [Now (Y=Y+2=46)]
; ;^[For Normal (250 usec) Half-Cycle]
; ---------------------- ;Zero-Bit Delay Loop: Write a Half-Cycle
FCDB: 88 ZERODLY DEY ;Reduce Time Count for Zero-Bit Delay Loop
FCDC: D0 FD BNE ZERODLY ;Loop Until Delay Period is Done <-(Y=0)
FCDE: 90 05 BCC WRTAPE ;Branch if Doing a Zero-Bit
; ;Else, Do a One-Bit, Add more Delay:
FCE0: A0 32 LDY #50 ;Get Time Count for One-Bit Delay Loop
; ;^[For Normal (250+250 usec) Half-Cycle]
; ---------------------- ;One-Bit Delay Loop: Write a Half-Cycle
FCE2: 88 ONEDLY DEY ;Reduce Time Count for One-Bit Delay Loop
FCE3: D0 FD BNE ONEDLY ;Loop Until Delay Period is Done <-(Y=0)
; ---------------------- ;Write (One Half-Cycle Only) to Tape:
FCE5: AC 20 C0 WRTAPE LDY TAPEOUT ;Toggle Audio Data Output [(Y)=(Unkown!)]
FCE8: A0 2C LDY #44 ;Return (Y=44) .. [Now (Y)=(Known Value)]
; ;^[Adds Time to 2nd WRBIT Zero-Bit Delay]
FCEA: CA DEX ;Reduce (X) Audio Half-Cycle Toggle Count
FCEB: 60 RTS ;Return to Caller; [Final (A=$FF):{A2RM}]
; ==============================================================================
; Read Byte Subroutine: Reads a Byte (8 Bits) from a Cassette Tape Record
; ==============================================================================
; The Duration between 2 Voltage Transitions from Tape determines whether a Bit
; is a Zero-Bit or a One-Bit; (Y) is used to Count this Period of Time; If it
; has Time to go Negative, the Duration is Longer, representing a One-Bit; If it
; does not go Negative, the Duration is Shorter, representing a Zero-Bit; Carry
; (C) is Set or Cleared, respectively, based on (Y), & Used to Rotate the Bit
; into the Accumulator (A); After 8 Bits, (A) represents a Byte Read from Tape
; ------------------------------------------------------------------------------
;
FCEC: A2 08 RDBYTE LDX #8 ;Prepare to Read a Byte (8 Bits) from Tape
FCEE: 48 RDBYT2 PHA ;Push Accumulator (Save on STACK)
FCEF: 20 FA FC JSR RD2BIT ;Read Two Transitions (Find Edge)
FCF2: 68 PLA ;Pull Accumulator (Retrieve from STACK)
FCF3: 2A ROL A ;Next Bit; Shift Carry into (A) Low Bit
; ;& Discard Old (A) High Bit into Carry
FCF4: A0 3A LDY #$3A ;Count for RD2BIT/RDBIT Sampling (58~0)
FCF6: CA DEX ;Reduce Bit Count
FCF7: D0 F5 BNE RDBYT2 ;Loop Until Done <-(X=0)
FCF9: 60 RTS ;Return to Caller
; ==============================================================================
; Read Bits Subroutines: Read Voltage Transitions (2 or 1) from a Tape Record
; ==============================================================================
; [See RDBYTE Description above]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Read 2 Transitions from Tape Record:
FCFA: 20 FD FC RD2BIT JSR RDBIT ;Read 1st of Two Voltage Transitions
; ----------------------------------- ;Read 1 Transition from Tape Record:
FCFD: 88 RDBIT DEY ;Reduce (Y) Until Voltage Transitions
FCFE: AD 60 C0 LDA TAPEIN ;Read Cassette Tape Data Input
; <---[Page Boundary] (in the middle of the DWord above)
FD01: 45 2F EOR LASTIN ;XOR with Last Input Voltage Detected
; ;<<< LASTIN Unkown 1st time through! >>>
FD03: 10 F8 BPL RDBIT ;Loop Until a Voltage Change is Detected
FD05: 45 2F EOR LASTIN ;XOR with Last Input Voltage Detected
FD07: 85 2F STA LASTIN ;Reset Last Input Voltage Detected
FD09: C0 80 CPY #$80 ;Set Carry on (Y):(58~0) becoming Negative
FD0B: 60 RTS ;Return to Caller
; ==============================================================================
; End Of Internal Cassette Tape Write (Output) & Read (Input) Routines
; ==============================================================================
;
;
; ==============================================================================
; Keyboard Character Input, Line Building, & Input Display Routines
; ==============================================================================
; Keyboard Input & Screen Output, Division Of Labor:
; ------------------------------------------------------------------------------
; Routines supporting Keyboard Input are designed to echo Keyboard Input to User
; Output (through COUT) to the Display Screen Scroll Window at the Current
; Cursor Position, & store the Characters Entered into the Keyboard Input Buffer
; ($0200~$02FF) for the convenience of the Calling Program, which may Position
; the Cursor anywhere (on Screen), before Calling the Keyboard Input Routines;
; on Entry of a Carriage Return from the Keyboard, the Keyboard Input Routines
; will Return back to the Calling Program, with the Character Count (plus one)
; in X-Reg & a Carriage Return in the Input Buffer as a Terminator; the Calling
; Program need not look within the Display Screen to Determine what was Entered;
; the X-Reg begins with a Zero, so if Five Characters are Entered, the X-Reg
; will reflect Four, although the Actual Value Returned will be Five--because
; the X-Reg is Incremented for the Carriage Return as well--[so X-Reg as the
; Character Count is actually accurate at plus one--as if (1) it started at One
; instead of Zero & (2) it is Not Counting the Carriage Return!].
; ==============================================================================
;
;
; ==============================================================================
; Read Key Subroutine: Makes Current Char Flash; & Puts it in (A) & (CH) in (Y)
; ==============================================================================
; RDKEY is the same as RDCHAR except that it bypasses Escape Key support--
; [because RDCHAR Calls RDKEY 1st, before doing the "ESC" Key Test!]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Get in (A) & Make Cursor Character Flash:
FD0C: A4 24 RDKEY LDY CH ;Get Cursor Horizontal
FD0E: B1 28 LDA (BASL),Y ;Get Char at (BASL,H) Line & Column (Y=CH)
FD10: 48 RDKEY0 PHA ;Push/Save Current Character at Cursor
FD11: 29 3F AND #%00111111 ;Truncate Character to 6 Lower Bits
FD13: 09 40 ORA #%01000000 ;Set Bit 6 of Character to Make it Flash
FD15: 91 28 STA (BASL),Y ;Set Char at (BASL,H) Line & Column (Y=CH)
FD17: 68 PLA ;Pull/Retrieve Current Character at Cursor
; ;Key Switch (KSW) Input Hook ...
FD18: 6C 38 00 RDKEY1 JMP (KSWL) ;Returns to Caller of RDKEY
; ==============================================================================
; KEYIN gets the Next Key Input from the Keyboard;
; KEYIN is usually the Target of the Key Switch (KSW) Character Input Hook
; ==============================================================================
;
; ----------------------------------- ;Get Key Press @ Keyboard Input Register:
FD1B: E6 4E KEYIN INC RNDL ;Advance Keyin Random Counter Value, Low
FD1D: D0 02 BNE KEYIN2 ;Branch if High Advance Not Needed Yet
FD1F: E6 4F INC RNDH ;Advance Keyin Random Counter Value, High
FD21: 2C 00 C0 KEYIN2 BIT KBD ;Check Keyboard Input Reg for a Key Press
FD24: 10 F5 BPL KEYIN ;Branch if No Key has been Pressed
FD26: 91 28 STA (BASL),Y ;Store (A) at (BASL,H) Line & Column (Y)
FD28: AD 00 C0 LDA KBD ;Read Keyboard Input Reg; Get Key Pressed
FD2B: 2C 10 C0 BIT KBDSTRB ;Clear KBD Strobe (KBD<128) for Next Key
FD2E: 60 RTS ;Return to Caller
; ==============================================================================
; Escape Character Handler:
; ==============================================================================
;
FD2F: 20 0C FD ESC JSR RDKEY ;Get in (A) & Make Cursor Character Flash
FD32: 20 A5 FB JSR ESCNEW ;Handle Escape Character [Doesn't Return!]
;
; ==============================================================================
; Read Character Subroutine: Read a Character into (A)
; ==============================================================================
;
FD35: 20 0C FD RDCHAR JSR RDKEY ;Get in (A) & Make Cursor Character Flash
FD38: C9 9B CMP #ESCH ;Is it The Escape Character?
FD3A: F0 F3 BEQ ESC ;YES, Handle The Escape Character
FD3C: 60 RTS ;NO, Return to Caller
; ==============================================================================
; NOTCR: Character Input is NOT a Carriage Return;
; So, send it as Non Inverse Character to COUT
; ==============================================================================
; Receives control w/ Character of Interest in Input Buffer at ($0200,X)
; ------------------------------------------------------------------------------
;
FD3D: A5 32 NOTCR LDA INVFLG ;Get Current Setting of INVFLG (Text-Mask)
; ;^[Normal=$FF, Flash=$7F, Inv=$3F]
FD3F: 48 PHA ;Push/Save Setting of INVFLG
FD40: A9 FF LDA #$FF ;Get Normal-Text Text-Mask Value
FD42: 85 32 STA INVFLG ;Set Invers Flag/Mask to Normal-Text Value
FD44: BD 00 02 LDA INBUFF,X ;Get Character of Interest as Normal-Text
FD47: 20 ED FD JSR COUT ;Print Char of Interest as Normal-Text
FD4A: 68 PLA ;Pull/Retrieve Prior Setting of INVFLG
FD4B: 85 32 STA INVFLG ;Restore Current Setting of INVFLG
; --<Undocumented User Entry Point>-- ;Backspace or Cancel Check:
FD4D: BD 00 02 NOTCR5 LDA INBUFF,X ;Get Character of Interest as was before
FD50: C9 88 CMP #BSH ;Is it a Ctrl-H: Backspace?
FD52: F0 1D BEQ BCKSPC ;Branch if it's a Backspace
FD54: C9 98 CMP #CTRLXH ;Is it a Ctrl-X: Cancelation?
FD56: F0 0A BEQ CANCEL ;Branch if it's a Cancelation
; --<Undocumented User Entry Point>-- ;Margin Check:
FD58: E0 F8 NOTCR4 CPX #248 ;Is Character Pointer Near End of INBUFF?
; --<Undocumented User Entry Point>-- ;Wait for Next Char or a Carriage Return:
FD5A: 90 03 NOTCR3 BCC NOTCR1 ;Branch if Not Near End of INBUFF
; --<Undocumented User Entry Point>-- ;Sound Warning Bell & Wait (as above):
FD5C: 20 3A FF NOTCR2 JSR BELL ;Else, Sound Bell, Warn: Near INBUFF End
FD5F: E8 NOTCR1 INX ;Advance to Next Character of Interest
FD60: D0 13 BNE NXTCHAR ;Branch if Not at Input Buffer End ($0300)
FD62: A9 DC CANCEL LDA #'\' | $80 ;Terminate Input w/ Backslash [Ctrl+X|EOL]
FD64: 20 ED FD JSR COUT ;Print the Terminal Backslash [)-:RIP:-(]
FD67: 20 8E FD GETLNZ JSR CROUT ;Print Carriage Return (Ctrl-M) Character
; ----------------------------------- ;Get Input with Prompt Entry Point:
FD6A: A5 33 GETLN LDA PROMPT ;Get Command Prompt Character
FD6C: 20 ED FD GETLN0 JSR COUT ;Print Command Prompt Character
; ----------------------------------- ;Get Input without Prompt Entry Point:
; ;Init Input Index & it will Reduce to 0:
FD6F: A2 01 GETLN1 LDX #1 ;Point to Start of Input Buffer +1
FD71: 8A BCKSPC TXA ;Get Current Ptr to Character of Interest
FD72: F0 F3 BEQ GETLNZ ;Branch if Char Ptr is at INBUFF Zero|End
FD74: CA DEX ;Else, Retreat to Prior Char of Interest
FD75: 20 35 FD NXTCHAR JSR RDCHAR ;Read Current Cursor Character into (A)
FD78: C9 95 CMP #PICK ;Is it a Right-Arrow [Ctrl-U (NAK)]?
FD7A: D0 02 BNE CAPTST ;Branch if NOT Right-Arrow [Ctrl-U (NAK)]
; ;Else, Use Screen Char under Right-Arrow:
FD7C: B1 28 LDA (BASL),Y ;Get Char at (BASL,H) Line & Column (Y)
FD7E: C9 E0 CAPTST CMP #'`' | $80 ;What is the Upper/Lower Case of Char (A)?
FD80: 90 02 BCC ADDINP ;BLT: Branch if Uppercase
FD82: 29 DF AND #%11011111 ;Else, GE: Change Lowercase to Uppercase
FD84: 9D 00 02 ADDINP STA INBUFF,X ;Set it in Input Line (to Uppercase)
FD87: C9 8D CMP #RTNH ;Is it a Carriage Return (Ctrl-M) Char?
FD89: D0 B2 BNE NOTCR ;Branch if Not a Carriage Return (Ctrl-M)
FD8B: 20 9C FC CROUT1 JSR CLREOL ;Else, it's a CR, Clear to End of Line
;
; ==============================================================================
; Print Carriage Return: Display Screen Scroll Window Output Routine
; ==============================================================================
;
FD8E: A9 8D CROUT LDA #RTNH ;Get a Carriage Return (Ctrl-M) Character
FD90: D0 5B BNE COUT ;Print (A) to Output Device; Always Taken
; ==============================================================================
; End Of Keyboard Character Input, Line Building, & Input Display Routines
; ==============================================================================
;
; ==============================================================================
; Memory Dump Routines:
; ==============================================================================
;
; ==============================================================================
; Print Memory Address:
; ==============================================================================
; Print Carriage Return & Monitor General Purpose A1-Reg or Progrram Counter as
; 16-Bit Integer [(Y,X)={High,Low}] in Hexadecimal
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Print Monitor General Purpose A1-Reg:
FD92: A4 3D PRA1 LDY A1H ;Get General Purpose A1-Reg, High
FD94: A6 3C LDX A1L ;Get General Purpose A1-Reg, Low
; ----------------------------------- ;Print Carriage Return & 16-Bit Integer:
FD96: 20 8E FD PRYX2 JSR CROUT ;Print Carriage Return (Ctrl-M) Character
; --<Undocumented User Entry Point>-- ;Sound Warning Bell & Wait (as above):
FD99: 20 40 F9 PRYX3 JSR PRNTYX ;Print 16-Bit Integer [(Y,X)={High,Low}]
FD9C: A0 00 LDY #0 ;Clear Y-Index Register
FD9E: A9 AD LDA #'-' | $80 ;Get a Dash
FDA0: 4C ED FD JMP COUT ;Print the Dash
; ==============================================================================
; Examine Eight Routine: Prints <= 8 Sequential Memory Locations Per Line in Hex
; ==============================================================================
;
; ----------------------------------- ;[Y-Reg Must Be Zero on Entry]
FDA3: A5 3C XAM8 LDA A1L ;Get Monitor General Purpose A1-Reg, Low
FDA5: 09 07 ORA #%00000111 ;Get [(A1)OR(#7)]->[(A1)MOD(8 Bytes)]
FDA7: 85 3E STA A2L ;Set Monitor General Purpose A2-Reg, Low
FDA9: A5 3D LDA A1H ;Get Monitor General Purpose A1-Reg, High
FDAB: 85 3F STA A2H ;Set Monitor General Purpose A2-Reg, High
; ----------------------------------- ;Modulus Check [(Adrs)MOD(8 Bytes)=(0)?]:
FDAD: A5 3C MOD8CHK LDA A1L ;Get Monitor General Purpose A1-Reg, Low
FDAF: 29 07 AND #%00000111 ;[(A1)&(#7)]->[(A1)MOD(8 Bytes)] = Zero?
FDB1: D0 03 BNE DATAOUT ;Branch if NOT at 1st of Mem Mod 8 Bytes
; ** Main Memory Dump Entry Point ** ;Examine Memory from (A1L,H) to (A2L,H):
FDB3: 20 92 FD XAM JSR PRA1 ;Else, Print Memory Address & a Dash, 1st
; ----------------------------------- ;Print Output Data to Output Device:
FDB6: A9 A0 DATAOUT LDA #' ' | $80 ;Get a Space Char to Print (between parts)
FDB8: 20 ED FD JSR COUT ;Print A-Reg to Output Device
FDBB: B1 3C LDA (A1L),Y ;Get a Memory Byte (1 of <= 8 in Sequence)
FDBD: 20 DA FD JSR PRBYTE ;Print A-Reg as Two-Digit Hex Number
FDC0: 20 BA FC JSR NXTA1 ;Increment A1 & Compare to A2
FDC3: 90 E8 BCC MOD8CHK ;BLT: Branch if (A1) has NOT Reached (A2)
FDC5: 60 RTS ;Return to Caller
; ==============================================================================
; "Is Monitor Mode: Examine, Add (Plus), or Subtract (Minus)?" (XAMPM) Routine:
; ==============================================================================
; For Mode Commands: Address Range Delimiter ("."); Add ("+"); or Subtract ("-")
; [Command Characters are converted to Command Tokens during the Input Process!]
; ------------------------------------------------------------------------------
;
FDC6: 4A XAMPM LSR A ;Shift (A*):LSB into Carry Flag
FDC7: 90 EA BCC XAM ;Branch if [A*:Bit 0 was 0]; Do XAM
; ;^[Examine Memory from (A1L,H) to (A2L,H)]
FDC9: 4A LSR A ;Shift LSB into Carry Flag (Discarded)
FDCA: 4A LSR A ;Shift LSB into Carry Flag
FDCB: A5 3E LDA A2L ;Get Monitor General Purpose A2-Reg, Low
FDCD: 90 02 BCC ADD ;Branch if [A*:Bit 2 was 0]; Do ADD (Plus)
; ;Else [A*:Bit 2 was 1] Do SUBTRACT (Minus)
FDCF: 49 FF EOR #%11111111 ;Negate (A) <-[from (A2L)]
FDD1: 65 3C ADD ADC A1L ;(A) = (A1L) + [{+|-}(A)<-(A2L)] + (C=1)
FDD3: 48 PHA ;Push Result
FDD4: A9 BD LDA #'=' | $80 ;Print "=", then Result:
FDD6: 20 ED FD JSR COUT ;Print (A) to Output Device
FDD9: 68 PLA ;Pull Result
;
; ==============================================================================
; Print A-Reg as Two-Digit Hex Number:
; ==============================================================================
;
FDDA: 48 PRBYTE PHA ;Push Accumulator (A); Save on STACK
FDDB: 4A LSR A ;Shift High Nibble
FDDC: 4A LSR A ;... to Low Nibble
FDDD: 4A LSR A ;These 4 Shifts also Clear High Nibble
FDDE: 4A LSR A ;Now Low Nibble is what High Nibble was
FDDF: 20 E5 FD JSR PRHEXZ ;Print Hi-Digit in Lo-Nibble as Hex Number
FDE2: 68 PLA ;Pull Accumulator (A); Retrieve from STACK
; <User Entry Point (Label Not Used)> ;Print Low Nibble as Hex Number [0~9,A~F]:
FDE3: 29 0F PRHEX AND #%00001111 ;Mask Off High Nibble & Keep Low Nibble
FDE5: 09 B0 PRHEXZ ORA #'0' | $80 ;Assure Byte is Hex Number Chr [0~9 & A~F]
FDE7: C9 BA CMP #':' | $80 ;Assure Byte is Dec Number Chr [0~9]<(":")
FDE9: 90 02 BCC COUT ;Print # Now if Dec Number Chr [0~9]<(":")
FDEB: 69 06 ADC #6 ;Else Assure Letter [A~F]>=[(":")+6+(C=1)]
;
; ==============================================================================
; Display Screen Scroll Window Output Routines:
; ==============================================================================
;
; ==============================================================================
; Character Output Routine: Jump (Indirectly via Vector) to User Output Routine
; ==============================================================================
;
FDED: 6C 36 00 COUT JMP (CSWL) ;Print Accumulator (A) to Output Device
; ==============================================================================
; End of Memory Dump Routines
; ==============================================================================
;
; ==============================================================================
; Character Output Routines:
; ==============================================================================
; COUT1 is usually the Target of the "Character Switch (CSW)" Output Hook/Vector
; ------------------------------------------------------------------------------
; COUT1: Write Byte in A-Reg to Display Screen at Current Cursor Position
; [(CV),(CH)] using Inverse Flag Mask & supporting Cursor Move:
; ------------------------------------------------------------------------------
; COUTZ: Write Byte in A-Reg to Display Screen at Current Cursor Position
; [(CV),(CH)] supporting Cursor Move but NOT using Inverse Flag Mask:
; ------------------------------------------------------------------------------
;
FDF0: C9 A0 COUT1 CMP #' ' | $80 ;Is Char (A) a Ctrl-Char or Printable?
FDF2: 90 02 BCC COUTZ ;BLT: Don't Output Ctrl Chars as Inverse
FDF4: 25 32 AND INVFLG ;Text Mask (Normal=$FF|Flash=$7F|Inv=$3F)
FDF6: 84 35 COUTZ STY YSAV1 ;Save Y-Reg
FDF8: 48 PHA ;Push/Save A-Reg
FDF9: 20 78 FB JSR VIDWAIT ;Go Check for Pause (Ctrl-S)
; --<Undocumented User Entry Point>-- ;Restore A-Reg & Y-Reg (frm STACK & YSAV1)
FDFC: 68 COUTA PLA ;Pull/Retrieve A-Reg
FDFD: A4 35 LDY YSAV1 ;Retrieve Y-Reg
FDFF: 60 RTS ;Return to Caller
; ==============================================================================
; End of Display Screen Scroll Window Output Routines
; ==============================================================================
;
; <---[Page Boundary]
;
; ==============================================================================
; Monitor Command Handlers: $FE is the High/Page Address of All Monitor Command
; Handlers Referenced via the Monitor Command Subroutine Address Table (@ $FFE3)
; ==============================================================================
;
; ==============================================================================
; More Memory Dump Routines:
; ==============================================================================
;
; ==============================================================================
; Monitor (& Miniassembler) "Blank" Command Handlers:
; ==============================================================================
;
; ----------------------------------- ;Handle Carriage Return as a Blank:
FE00: C6 34 BL1 DEC YSAV ;Reduce Monitor Command Processing Value
FE02: F0 9F BEQ XAM8 ;Branch if MCPV is Zero; Do Memory Dump
; ----------------------------------- ;Monitor Blank Space Command Handler;
; ;Referenced via Subroutine Address Table:
FE04: CA BLANK DEX ;Reduce X-Index Register Value
FE05: D0 16 BNE SETMDZ ;Branch if (X<>0); Save Token as Mode
FE07: C9 BA CMP #':' | $80 ;Are we in Data-Store/Fill-Memory Mode?
FE09: D0 BB BNE XAMPM ;NO, Do: "Examine|Add|Subtract Mode?"
FE0B: 85 31 STA MODE ;YES, Save ":" Token as Mode
FE0D: A5 3E LDA A2L ;Get Monitor General Purpose A2-Reg, Low
FE0F: 91 40 STA (A3L),Y ;Set (A3-Reg),Y
FE11: E6 40 INC A3L ;Up Monitor General Purpose A3-Reg, Low
FE13: D0 02 BNE MON_RTS5 ;Branch if No Carryover, yet
FE15: E6 41 INC A3H ;Up Monitor General Purpose A3-Reg, High
FE17: 60 MON_RTS5 RTS ;Return to Caller
; ==============================================================================
; Monitor Mode Commands Handler:
; ==============================================================================
; Subtract ("-"), Add ("+"), Fill Memory (":"), or Address Range Delimiter (".")
; [Command Characters are converted to Command Tokens during the Input Process!]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Mode ("-"|"+"|":"|".") Commands Handler;
; ;Referenced via Subroutine Address Table:
FE18: A4 34 SETMODE LDY YSAV ;Get Index for Monitor Command Processing
FE1A: B9 FF 01 LDA INBUFF-1,Y ;Get Command Token from Input Buffer
FE1D: 85 31 SETMDZ STA MODE ;Save Command Token as Monitor Mode
; ----------------------------------- ;JSR here to determine where one is:
; <User Entry Point (Label Not Used)> ;[A JSR to an RTS STACKs Current Address]
FE1F: 60 IDROUTINE RTS ;Return to Caller
; ==============================================================================
; End of More Memory Dump Routines:
; ==============================================================================
;
; ==============================================================================
; Monitor "<" Move/Verify Delimiter
; ==============================================================================
;
; ----------------------------------- ;Copy A2 (2 bytes) to A4 & A5;
; ;Referenced via Subroutine Address Table:
FE20: A2 01 LT LDX #1 ;Get Index to do High Bytes 1st
FE22: B5 3E LT2 LDA A2L,X ;Get Monitor General Purpose A2-Reg, Hi/Lo
FE24: 95 42 STA A4L,X ;5et Monitor General Purpose A4-Reg, Hi/Lo
FE26: 95 44 STA A5L,X ;5et Monitor General Purpose A5-Reg, Hi/Lo
FE28: CA DEX ;Reduce Index to do Low Bytes Last
FE29: 10 F7 BPL LT2 ;Loop Once to do Low Bytes Last
FE2B: 60 RTS ;Then, Return to Caller
; ==============================================================================
; Monitor Move Memory ("M") Command Handler: *Adrs1<Adrs2.Adrs3M
; ==============================================================================
;
; ----------------------------------- ;Copy/Move Bytes from (A1~A2),Y to (A4),Y;
; ;Referenced via Subroutine Address Table:
FE2C: B1 3C MOVE LDA (A1L),Y ;Get Byte at Source Address (A1)
FE2E: 91 42 STA (A4L),Y ;Set Byte at Destination Address (A4)
FE30: 20 B4 FC JSR NXTA4 ;Increment General Purpose A4 & A1 Regs
FE33: 90 F7 BCC MOVE ;BLT: Branch if A1 has NOT Reached A2
FE35: 60 RTS ;Return to Caller
; ==============================================================================
; Monitor Verify Memory ("V") Command Handler: *Adrs1<Adrs2.Adrs3V
; ==============================================================================
;
; ----------------------------------- ;Verify Bytes from (A1~A2),Y with (A4),Y;
; ;Referenced via Subroutine Address Table:
FE36: B1 3C VFY LDA (A1L),Y ;Get Byte at Source Address (A1)
FE38: D1 42 CMP (A4L),Y ;Compare Byte at Destination Address (A4)
FE3A: F0 1C BEQ VFYOK ;Branch if Both are Identical; Do Next
; ----------------------------------- ;Else, Verify Failed:
FE3C: 20 92 FD JSR PRA1 ;Print Memory Address
FE3F: B1 3C LDA (A1L),Y ;Get Byte at Source Address (A1)
FE41: 20 DA FD JSR PRBYTE ;Print A-Reg as Two-Digit Hex Number
FE44: A9 A0 LDA #' ' | $80 ;Get a Space Character
FE46: 20 ED FD JSR COUT ;Print Char (A) to Output Device
FE49: A9 A8 LDA #'(' | $80 ;Get an Opening Parenthesis
FE4B: 20 ED FD JSR COUT ;Print Char (A) to Output Device
FE4E: B1 42 LDA (A4L),Y ;Get Byte at Destination Address (A4)
FE50: 20 DA FD JSR PRBYTE ;Print A-Reg as Two-Digit Hex Number
FE53: A9 A9 LDA #')' | $80 ;Get an Closing Parenthesis
FE55: 20 ED FD JSR COUT ;Print Char (A) to Output Device
; ----------------------------------- ;Verify Succeeded; Do Next Byte:
FE58: 20 B4 FC VFYOK JSR NXTA4 ;Increment General Purpose A4 & A1 Regs
FE5B: 90 D9 BCC VFY ;BLT: Branch if A1 has NOT Reached A2
FE5D: 60 RTS ;Return to Caller
; ==============================================================================
; Monitor List ("L") Command Handler: *AdrsL
; ==============================================================================
; Disassembles 20 Instructions per List ("L") Command [e.g., *AdrsLL; *LL; *LLL]
; If User Specified an Address, then (X) is Not Zero (0) & should be One (1)!
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Disassemble 20 Instruction Lines;
; ;Referenced via Subroutine Address Table:
FE5E: 20 75 FE MON_LIST JSR A1PC ;Copy A1 (2 bytes) to PC if Specified
FE61: A9 14 LDA #20 ;Prepare to Disassemble 20 Lines
FE63: 48 MON_LIST2 PHA ;Push Line Count
FE64: 20 D0 F8 JSR INSTDSP ;Disassemble & Print Instruction at PC
FE67: 20 53 F9 JSR PCADJ ;Add (A+C) to Instruction Address (PCL,H)
FE6A: 85 3A STA PCL ;Save Updated Program Counter, Low
FE6C: 84 3B STY PCH ;Save Updated Program Counter, High
FE6E: 68 PLA ;Pull Line Count
FE6F: 38 SEC ;Prepare to Subtract w/o Borrow [A-Data-!C]
FE70: E9 01 SBC #1 ;Reduce Line Count
FE72: D0 EF BNE MON_LIST2 ;Loop Until Done: Disassembled 20 Lines
FE74: 60 RTS ;Return to Caller
; ==============================================================================
; Copy A1 (2 bytes) to PC if Specified (X=1): [<<< or Bug: if (0>X>1)! >>>]
; ==============================================================================
; If User Specified an Address, then (X) is Not Zero (0) & should be One (1)!
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Copy A1 (2 bytes) to PC if Specified;
; ;<<< (X) must be (0|1) upon Entry >>>:
FE75: 8A A1PC TXA ;Check Index to do High Bytes 1st
FE76: F0 07 BEQ A1PCRTS ;Return to Caller if (X) is Zero (<1)
; ;<<< Catastrophic to A1~ if (0>X>1) >>>:
FE78: B5 3C A1PCLP LDA A1L,X ;Get Monitor General Purpose A1-Reg, Hi/Lo
FE7A: 95 3A STA PCL,X ;5et Monitor General Purpose PC-Reg, Hi/Lo
FE7C: CA DEX ;Reduce Index to do Low Bytes Last
FE7D: 10 F9 BPL A1PCLP ;Loop Once to do Low Bytes Last
FE7F: 60 A1PCRTS RTS ;Return to Caller
; ==============================================================================
; Monitor Set Inverse Video ("I") Command Handler: Black Chr on White Background
; ==============================================================================
;
; ----------------------------------- ;Set Inverse Video;
; ;Referenced via Subroutine Address Table:
FE80: A0 3F SETINV LDY #$3F ;Get Text Mask (Invese=$3F)
FE82: D0 02 BNE SETIFLG ;Always Taken
; ==============================================================================
; Monitor Set Normal Video ("N") Command Handler: White Chr on Black Background
; ==============================================================================
;
; ----------------------------------- ;Set Normal Video;
; ;Referenced via Subroutine Address Table:
FE84: A0 FF SETNORM LDY #$FF ;Get Text Mask (Normal=$FF)
; ----------------------------------- ;Set Inverse Flag (from Y-Reg):
FE86: 84 32 SETIFLG STY INVFLG ;Set Text Mask
; ;^[Normal = $FF = %11111111: N=%1 & V=%1]
; ;^[Flash = $7F = %01111111: N=%0 & V=%1]
; ;^[Inverse = $3F = %00111111: N=%0 & V=%0]
FE88: 60 RTS ;Return to Caller
; ==============================================================================
; Reset "Key Switch (KSW)" Input Vector to KEYIN ($FD1B):
; ==============================================================================
;
FE89: A9 00 SETKBD LDA #>KSWL ;Get Zero-Page Address of KSW, High (=0)
FE8B: 85 3E INPORT STA A2L ;Set Monitor General Purpose A2-Reg, Low
;
; ==============================================================================
; Monitor Set IN# Slot ("Ctrl+K") Command Handler: *<Slot# {0~7}><Ctrl+K>
; ==============================================================================
;
; ----------------------------------- ;Set IN# Slot ("Ctrl-K");
; ;Referenced via Subroutine Address Table:
FE8D: A2 38 MON_INPRT LDX #KSWL ;Get Zero-Page Address of KSW, Low
FE8F: A0 1B LDY #<KEYIN ;Get Address of KEYIN, Low
FE91: D0 08 BNE IOPRT ;Always Taken
; ==============================================================================
; Reset "Character Switch (CSW)" Output Vector to COUT1 ($FDF0):
; ==============================================================================
;
FE93: A9 00 SETVID LDA #>CSWL ;Get Zero-Page Address of CSW, High (=0)
FE95: 85 3E OUTPORT STA A2L ;Set Monitor General Purpose A2-Reg, Low
;
; ==============================================================================
; Monitor Set PR# Slot ("Ctrl+P") Command Handler: *<Slot# {0~7}><Ctrl+P>
; ==============================================================================
;
; ----------------------------------- ;Set PR# Slot ("Ctrl+P");
; ;Referenced via Subroutine Address Table:
FE97: A2 36 OUTPRT LDX #CSWL ;Get Zero-Page Address of CSW, Low
FE99: A0 F0 LDY #<COUT1 ;Get Address of COUT1, Low
;
; ==============================================================================
; Set Input/Output Vector (Port/Slot):
; ==============================================================================
;
FE9B: A5 3E IOPRT LDA A2L ;Get Monitor General Purpose A2-Reg, Low
FE9D: 29 0F AND #%00001111 ;Clear High Nibble & Keep Low Nibble
FE9F: F0 06 BEQ IOPRT1 ;Branch if Result is Zero (Page/Slot)
FEA1: 09 C0 ORA #>IOADR ;Set to Slot I/O Addresses ($CS00), High
FEA3: A0 00 LDY #0 ;Clear Y-Index Register (Force Branch)
FEA5: F0 02 BEQ IOPRT2 ;Always Taken
FEA7: A9 FD IOPRT1 LDA #CIOPG ;Get Mon Char I/O S/R Vectors Page Adrs
; ;^[KEYIN ($FD1B) & COUT1 ($FDF0) S/Rs]
; <*** A Great User Entry Point! ***> ;Set Any 2 Byte ZP Location Based on (X);
; ;LOC0: Preset to JMP OpCode ($4C); (X=1):
FEA9: 94 00 IOPRT2 STY LOC0,X ;Set BASIC Soft/Warm/Ctrl-C Entry, Low
FEAB: 95 01 STA LOC1,X ;Set BASIC Soft/Warm/Ctrl-C Entry, High
FEAD: 60 RTS ;Return to Caller
; ==============================================================================
;
FEAE: EA MON_NOP3 NOP ;Fill
FEAF: EA MON_NOP4 NOP ;Fuller ;-)
;
; ==============================================================================
; Monitor Cold Start BASIC: ("Ctrl-B") Command Handler: *<Ctrl-B><Return>
; ==============================================================================
; Jump to [Integer/Applesoft] BASIC [Hard/Cold/Control-B Entry Point (With
; Complete Reinitialization)]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Referenced via Subroutine Address Table:
FEB0: 4C 00 E0 XBASIC JMP BASIC ;Cold Start BASIC ("Ctrl-B")
;
; ==============================================================================
; Monitor Warm Start BASIC: ("Ctrl-C") Command Handler: *<Ctrl-C><Return>
; ==============================================================================
; Jump to [Integer/Applesoft] BASIC [Soft/Warm/Control-C Entry Point (Without
; Reinitialization of Symbol-Table, Variables or Data)]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Referenced via Subroutine Address Table:
FEB3: 4C 03 E0 BASCONT JMP BASIC2 ;Warm Start BASIC ("Ctrl-C")
; ==============================================================================
; Monitor Execute a Program ("G") Command Handler: *AdrsG
; ==============================================================================
; Jumps to Address Specified in Program Counter (PC) with 6502 Registers
; Restored from Save Area
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Referenced via Subroutine Address Table:
FEB6: 20 75 FE GO JSR A1PC ;Copy A1 (2 bytes) to PC if Specified
; ---------------------- ;<Undocumented User Entry Point>:
FEB9: 20 3F FF GO1 JSR MON_RESTORE ;Restore (P), (A), (X), & (Y) Registers
; ---------------------- ;<Undocumented User Entry Point>:
FEBC: 6C 3A 00 GO2 JMP (PCL) ;Go to User Subroutine [(PCL,H)=($3A,$3B)]
; ==============================================================================
; Monitor Display Registers ("Ctrl-E") Command Handler: *<Ctrl-E>
; ==============================================================================
; Display Current Values of A-Reg, X-Reg, Y-Reg, P-Reg, & S-Reg
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Referenced via Subroutine Address Table:
FEBF: 4C D7 FA REGZ JMP REGDSP ;Show (A), (X), (Y), (P), & (S) Registers
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; Start of Section (FEC2-FEC9): New in Autostart [New Monitor] ROM
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ==============================================================================
; Monitor Trace "T" Command Handler: *AdrsT [NOT USED NOW!]
; ==============================================================================
;
; ----------------------------------- ;Referenced via Subroutine Address Table:
FEC2: 60 TRACE_RTS RTS ;TRACE is Gone; This RTS is Not Used!
FEC3: EA NOP ;TRACE is now like USR (via CHRTBL)*
;
; ==============================================================================
; Monitor Step "S" Command Handler: *AdrsS [NOT USED NOW!]
; ==============================================================================
;
FEC4: 60 STEPZ_RTS RTS ;STEP is Gone; This RTS is Not Used!
; ----------------------------------- ;Referenced via Subroutine Address Table:
FEC5: EA STEPZ_USR NOP ;STEP is now like USR (via CHRTBL)*
FEC6: EA NOP ;Now, the STEP (S) Command is the
FEC7: EA NOP ;same as the User (Ctrl-Y) Command
FEC8: EA NOP ;Do Nothing Else
FEC9: EA NOP ;*This whole S/T code block isn't used now!
;
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; End of Section (FEC2-FEC9): New in Autostart [New Monitor] ROM
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ==============================================================================
; Monitor User ("Ctrl-Y") Command Handler: *<Ctrl-Y>
; ==============================================================================
;
; ----------------------------------- ;Referenced via Subroutine Address Table:
FECA: 4C F8 03 USR JMP USRADDR ;JMP to Autostart User Vector ("Ctrl-Y")
;
; ==============================================================================
; Monitor WRITE to Audio Cassette Tape ("W") Command Handler: *Adrs1.Adrs2W
; ==============================================================================
; Writes 10 second Header Monotone to Audio-Out, followed by a Synchronization
; Bit, then the contents of the memory specified, then a one byte CheckSum
; ------------------------------------------------------------------------------
; Enter with: (A1L,A1H)=($3C,$3D)=(Address of first Data Byte)
; (A2L,A2H)=($3E,$3F)=(Address of last Data Byte)
; ------------------------------------------------------------------------------
; [See "A2 Monitors Peeled" pgs.81~84, TN/TIL# 495~496, & RDBYTE Description ^^]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Referenced via Subroutine Address Table:
FECD: A9 40 MON_WRITE LDA #64 ;Prep to Write [(A)*256] Half-Cycles
; ;^[For 'Long-1' (650 usec) Half-Cycles]
FECF: 20 C9 FC JSR HEADER ;Write 10 second Header [10,649,600 usec]
; ;^[A-Reg, X-Reg & Y-Reg are Altered!]
; ---------------------- ;Write Memory Data to Cassette Tape Record
FED2: A0 27 LDY #39 ;Set Half-Cycle Duration Counter
FED4: A2 00 WR1 LDX #0 ;Clear Indexed Indirect Addressing Index
FED6: 41 3C EOR (A1L,X) ;Get (A)=(A)XOR(A1L) [1st Time (A=$FF)]
FED8: 48 PHA ;Push XOR Result (Running CheckSum)
FED9: A1 3C LDA (A1L,X) ;Get a Memory Byte
FEDB: 20 ED FE JSR WRBYTE ;Write 8 Bit Byte to Cassette Tape Record
FEDE: 20 BA FC JSR NXTA1 ;Increment A1 & Compare to A2
FEE1: A0 1D LDY #29 ;Set Half-Cycle Duration Counter
FEE3: 68 PLA ;Pull XOR Result (Running CheckSum)
FEE4: 90 EE BCC WR1 ;BLT: Loop if A1 has NOT Reached A2
; ---------------------- ;Write CheckSum to Cassette Tape Record
FEE6: A0 22 LDY #34 ;Set Half-Cycle Duration Counter
FEE8: 20 ED FE JSR WRBYTE ;Write 8 Bit Byte to Cassette Tape Record
FEEB: F0 4D BEQ BELL ;(X=0): Always Taken
;
; ==============================================================================
; Internal Cassette Tape Write (Output) & Read (Input) Routines: HEADER, WRBIT,
; RDBYTE, RD2BIT, RDBIT, WRBYTE (See: "Apple II Monitors Peeled" pgs.81~84)
; ==============================================================================
;
; ==============================================================================
; Write Byte Subroutine: Writes a Byte (8 Bits) to a Cassette Tape Record
; ==============================================================================
; <---["Feed Me!"--From the 1960 (J.Nickolson) Movie: "Little Shop of Horrors"]
; [<Reminder>--Your Cassette Tape Recorder is hungry! Feed it a Byte. ;-D]
; ------------------------------------------------------------------------------
;
FEED: A2 10 WRBYTE LDX #16 ;Get (X) Audio Half-Cycle Toggle Count
FEEF: 0A WRBYT2 ASL A ;Shift High Bit into Carry
FEF0: 20 D6 FC JSR WRBIT ;Write a Bit [Returns: (X=X-2)]
FEF3: D0 FA BNE WRBYT2 ;Branch Until Done <-[when (X=0)]
FEF5: 60 RTS ;Return to Caller
; ==============================================================================
; 2nd End Of Internal Cassette Tape Write (Output) & Read (Input) Routines
; ==============================================================================
;
;
; ==============================================================================
; Monitor End Input ("Carriage Return") Command Handler: *<Some Input><Ctrl-M>
; ==============================================================================
;
; ----------------------------------- ;Referenced via Subroutine Address Table:
FEF6: 20 00 FE CRMON JSR BL1 ;Handle Carriage Return as a Blank
FEF9: 68 PLA ;Pull/Discard Return Address, Low
FEFA: 68 PLA ;Pull/Discard Return Address, High
FEFB: D0 6C BNE MONZ ;Restart Monitor ("*" Prompt) Silently
;
; ==============================================================================
; Monitor READ from Audio Cassette Tape ("R") Command Handler: *Adrs1.Adrs2R
; ==============================================================================
; Reads Tape Records from Audio-in, placing the input into the memory range
; specified, then a one byte CheckSum
; ------------------------------------------------------------------------------
; Enter with: (A1L,A1H)=($3C,$3D)=(Address of first Data Byte)
; (A2L,A2H)=($3E,$3F)=(Address of last Data Byte)
; ------------------------------------------------------------------------------
; [See "A2 Monitors Peeled" pgs.81~84, TN/TIL# 495~496, & RDBYTE Description ^^]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Referenced via Subroutine Address Table:
FEFD: 20 FA FC MON_READ JSR RD2BIT ;Read Two Transitions (Find Edge)
; <---[Page Boundary]
FF00: A9 16 LDA #22 ;Prep to Write [(A)*256] Half-Cycles
; ;^[For 'Long-1' (650 usec) Half-Cycles]
; ----------------------------------- ;Entry Point to Read Shape Table
; <<< DANGEROUS if Accidentally Tape Recording instead of Playing Tape! But,
; for a Program Tape, Accidentally Recording would be BAD all by itself! >>>:
FF02: 20 C9 FC MON_READ2 JSR HEADER ;Write used to Delay about 3.5 seconds
; ;Writes 3.7 second Header [3,660,800 usec]
; ;^[A-Reg, X-Reg & Y-Reg are Altered!]
FF05: 85 2E STA CHKSUM ;Initialize CheckSum (A=$FF):[A2RM]
FF07: 20 FA FC JSR RD2BIT ;Read Two Transitions (Find Edge)
; ;Find 'Short-0' Sync Bit:
FF0A: A0 24 MON_RD2 LDY #36 ;Set Half-Cycle Duration Counter
FF0C: 20 FD FC JSR RDBIT ;Read 1 Transition from Tape Record
FF0F: B0 F9 BCS MON_RD2 ;BGE: Loop Until 'Short-0' Sync Bit Found
FF11: 20 FD FC JSR RDBIT ;Skip Sync-Bit's 2nd Half-Cycle
FF14: A0 3B LDY #59 ;Set Half-Cycle Duration Counter
FF16: 20 EC FC MON_RD3 JSR RDBYTE ;Read 8 Bit Byte from Cassette Tape Record
FF19: 81 3C STA (A1L,X) ;Store Byte in Memory Range Specified
FF1B: 45 2E EOR CHKSUM ;Compute New Running CheckSum
FF1D: 85 2E STA CHKSUM ;Save New Running CheckSum
FF1F: 20 BA FC JSR NXTA1 ;Increment A1 & Compare to A2
FF22: A0 35 LDY #53 ;Set Half-Cycle Duration Counter
FF24: 90 F0 BCC MON_RD3 ;BLT: Loop if A1 has NOT Reached A2
FF26: 20 EC FC JSR RDBYTE ;Read CheckSum Byte from Tape Record
FF29: C5 2E CMP CHKSUM ;Do the two CheckSums Match?
FF2B: F0 0D BEQ BELL ;YES, Sound Bell & Return to Caller
; <User Entry Point (Label Not Used)> ;Print "ERR" & Bell to Outpud Device:
FF2D: A9 C5 MON_RDERR LDA #'E' | $80 ;Get 1st Letter Char to Print
FF2F: 20 ED FD JSR COUT ;Print A-Reg to Output Device
FF32: A9 D2 LDA #'R' | $80 ;Get 2nd & 3rd Letter Char to Print
FF34: 20 ED FD JSR COUT ;Print A-Reg to Output Device
FF37: 20 ED FD JSR COUT ;Print A-Reg to Output Device
FF3A: A9 87 BELL LDA #BELL_H ;BELL causes delay if Key bounces
FF3C: 4C ED FD JMP COUT ;Print A-Reg to Output Device
; ==============================================================================
; Restore (P), (A), (X), & (Y) Register Contents [Used for Debugging]
; ==============================================================================
;
FF3F: A5 48 MON_RESTORE LDA STATUS ;Retrieve Status from P-Reg Safe
FF41: 48 PHA ;Push Status
FF42: A5 45 LDA ACC ;Retrieve A-Reg from Safe
FF44: A6 46 LDX XREG ;Retrieve X-Reg from Safe
FF46: A4 47 LDY YREG ;Retrieve Y-Reg from Safe
FF48: 28 PLP ;Pull Status
FF49: 60 RTS ;Return to Caller
; ==============================================================================
; Save All 6502 Registers, Including Program Counter [(PCL,H)=($3A,$3B)]:
; ==============================================================================
;
; <User Entry Point (Label Not Used)> ;Save All Registers & Program Counter:
FF4A: 85 45 MON_SAVE STA ACC ;Save A-Reg in Safe
; ----------------------------------- ;Save Registers on Break Entry Point:
; ;<<< BUG: SAV1 Does Not Save A-Reg! >>>
FF4C: 86 46 SAV1 STX XREG ;Save X-Reg in Safe
FF4E: 84 47 STY YREG ;Save Y-Reg in Safe
FF50: 08 PHP ;Push Status Register
FF51: 68 PLA ;Pull Status Value
FF52: 85 48 STA STATUS ;Save Status in P-Reg Safe
FF54: BA TSX ;Get STACK Pointer
FF55: 86 49 STX SPNT ;Save STACK Pointer in Safe
FF57: D8 CLD ;Clear Decimal Flag; Sets Hex Mode
; ----------------------------------- ;JSR here to determine where one is:
; ;[A JSR to an RTS STACKs Current Address]
FF58: 60 IORTS RTS ;Return to Caller
; ==============================================================================
; Old Reset Routine:
; ==============================================================================
; Monitor "Cold Start" Entry Point [Referenced via Reset Vector]: All Resets are
; Vectored here; Sets Normal Text Screen Mode & Initializes Keyboard & Screen as
; the I/O Devices
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Referenced via Interrupt Vector Table:
; ;<< BUG: OLDRST Vector ($FF59) IS Wrong >>
FF59: 20 84 FE OLDRST JSR SETNORM ;Set Normal Video Mode
FF5C: 20 2F FB JSR INIT ;Initialize Video Screen for Text Mode
FF5F: 20 93 FE JSR SETVID ;Reset CSW Output Vector to COUT1 ($FDF0)
FF62: 20 89 FE JSR SETKBD ;Reset KSW Input Vector to KEYIN ($FD1B)
;
; ==============================================================================
; Monitor "Warm Start" ("Loud Reset") Entry Point: Sets Hexadecimal Mode & Beeps
; ==============================================================================
;
; ----------------------------------- ;Restart Monitor ("*" Prompt) Loudly:
FF65: D8 MON CLD ;Must Clear Decimal Flag; Sets Hex Mode
FF66: 20 3A FF JSR BELL ;Send BELL Char to Output Device
;
; ==============================================================================
; Monitor "Warm Start" ("Silent Reset") Entry Point (from BASIC):
; ==============================================================================
; Sets Monitor "Star" ('*') Prompt & Reads a Line of User Input
; [See also, "The 3D0G (3-Dog-Night) Command Returns A User To Basic"]
; ------------------------------------------------------------------------------
;
; ----------------------------------- ;Restart Monitor ("*" Prompt) Silently:
FF69: A9 AA MONZ LDA #'*' | $80 ;Get Monitor Prompt Character ("*")
FF6B: 85 33 STA PROMPT ;Set Monitor Prompt Character ("*")
FF6D: 20 67 FD JSR GETLNZ ;Prompt User for Input; Read a Line
; <User Entry Point (Label Not Used)> ;Scan IDX [Input Buffer ($200..$2FF)?]:
FF70: 20 C7 FF SCANIDX JSR ZMODE ;Clear Monitor Mode
; ----------------------------------- ;Process Monitor Commands; Get Next Item:
FF73: 20 A7 FF NXTITM JSR GETNUM ;Get Non-Hex Char; (X=0) If No Hex Input
FF76: 84 34 STY YSAV ;Save (Y) for Monitor Command Processing
FF78: A0 17 LDY #23 ;There are only 23 Monitor Commands
; ----------------------------------- ;Search Character Table (Loop)
; ;^[Used to Decode Keyboard Input]:
FF7A: 88 CHRSRCH DEY ;Reduce Monitor Command Search Counter
FF7B: 30 E8 BMI MON ;If Not Found, Go Restart Monitor Loudly
FF7D: D9 CC FF CMP CHRTBL,Y ;Else, Find Command Char in Char Table
FF80: D0 F8 BNE CHRSRCH ;Loop until Search Counter is Zero
FF82: 20 BE FF JSR TOSUB ;Cmd Found: Call Corresponding Subroutine
FF85: A4 34 LDY YSAV ;Save (Y) for Monitor Command Processing
FF87: 4C 73 FF JMP NXTITM ;Go Process Next Monitor Command
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; <<< ZMODE is NOT HERE (above) at $FF7C! ZMODE is actually at $FFC7! The
; $FF7C address, as documented in Luebbert's "What's Where in The Apple", is
; incorrect. He mistakenly transposed the last two hexadecimal digits of the
; real $FFC7 address to get $FF7C. [Or, was it on purpose, to confuse the enemy
; during the cold war? IIRC, Luebbert was a professor at Anapolis then.] >>>
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
;
; ==============================================================================
; Hexadecimal Digit Shifter:
; ==============================================================================
; Bit Map: <- (A2H)=(%ABCD,EFGH); <- (A2L)=(%IJKL,MNOP); <- (A)=(%QRST,UVWX) <-
; ------------------------------------------------------------------------------
;
FF8A: A2 03 DIGIT LDX #3 ;Set Index to Shift 4 Bits (Hi<-Lo Bytes)
FF8C: 0A ASL A ;Got Hex Digit, Shift it into A2:
FF8D: 0A ASL A ;1st Shift (A) Low Nibble into High Nibble
FF8E: 0A ASL A ;(4 ASL's Discard High Nibble Bits
FF8F: 0A ASL A ;& Zero Low Nibble Bits); (A)=(%UVWX,0000)
FF90: 0A NXTBIT ASL A ;2nd Shift (A) High Nibble
FF91: 26 3E ROL A2L ;into (A2L) Low Nibble; (A2L)=(%MNOP,UVWX)
FF93: 26 3F ROL A2H ;& (A2L) High Nibble into (A2H) Low Nibble
; ;(Discards A2H Hi Nib); (A2H)=(%EFGH,IJKL)
FF95: CA DEX ;Reduce Shift Count
FF96: 10 F8 BPL NXTBIT ;Branch Until All 4 Bits have been Shifted
; ;^[Leaves (X)=($FF)=(-1) & (A=0)]
; ------------------------------------------------------------------------------
; Note: If (0<=X<=$80) upon entry, NXTBIT could shift up to 128 bits left
; through A2 but, only the last 16 bits would be retained!
; ------------------------------------------------------------------------------
;
FF98: A5 31 NXTBAS LDA MODE ;Get Monitor Mode Flag [0 Mode = Mem Dump]
FF9A: D0 06 BNE NXTBS2 ;If Mode is Zero then Copy A2 to A1 & A3
FF9C: B5 3F LDA A2H,X ;Get A2-Reg, Low then High
FF9E: 95 3D STA A1H,X ;Set A1-Reg, Low then High
FFA0: 95 41 STA A3H,X ;Set A3-Reg, Low then High
FFA2: E8 NXTBS2 INX ;Advance Indexed Adressing X-Index (-1~0)
FFA3: F0 F3 BEQ NXTBAS ;Branch if Lows Done; Do Highs
FFA5: D0 06 BNE NXTCHR ;Else, Do Next Mon Cmd Char; Always Taken
; ==============================================================================
; Monitor Command Parser: Gets a Hexadecimal Digits from the Input Buffer
; ==============================================================================
; Get a Character from Input Buffer; If it is a Hexadecimal Digit, Branch to
; Digit; Else, Return to Caller
; ------------------------------------------------------------------------------
;
FFA7: A2 00 GETNUM LDX #0 ;Clear X-Index; Prepare to Clear A2
FFA9: 86 3E STX A2L ;Clear A2-Reg, Low
FFAB: 86 3F STX A2H ;Clear A2-Reg, High
FFAD: B9 00 02 NXTCHR LDA INBUFF,Y ;Get Next Char from Input Buffer
FFB0: C8 INY ;Advance Input Buffer Char Pointer
FFB1: 49 B0 EOR #'0' | $80 ;Is Char a Numeral >= 0?
FFB3: C9 0A CMP #10 ;Is Char a Numeral < 10?
FFB5: 90 D3 BCC DIGIT ;BLT: Branch if Hex/Dec Digit
FFB7: 69 88 ADC #$88 ;Is Char a Letter >=("A")? [Adds (C=1)]
; ;[($88)+("A"=$C1)+(C=1)]=($14A)->(C=1)
FFB9: C9 FA CMP #$FA ;Is Char a Letter <=("z") [A-Data->NZC]
; ;[($4A)]-($FA="z")=($50)] [A<Data];
; ; But (C=1) remains unchaged, so ...
FFBB: B0 CD BCS DIGIT ;BGE: Branch if Hex Digit
FFBD: 60 RTS ;Return to Caller
;
; ==============================================================================
; Monitor Command Found; Push & Return to Corresponding Subroutine:
; ==============================================================================
;
FFBE: A9 FE TOSUB LDA #>BL1 ;Get High Address of All Mon Cmd Handlers
; ; Referenced via Subroutine Address Table
FFC0: 48 PHA ;Push High-Order S/R Address
FFC1: B9 E3 FF LDA SUBTBL,Y ;Get Low Address from S/R Address Table
FFC4: 48 PHA ;Push Low-Order S/R Address
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
; This confirms the order of the return address pushed onto the stack during a
; subroutine call (JSR); the high-order subroutine address is pushed 1st and the
; low-order subroutine address is pushed 2nd (so, reverse order when pulling)
; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
FFC5: A5 31 LDA MODE ;Get Old Mode
; ----------------------------------- ;Clear/Zero Monitor Mode:
FFC7: A0 00 ZMODE LDY #$00 ;Clear Y-Index Register
FFC9: 84 31 STY MODE ;Clear Monitor Mode Flag
FFCB: 60 RTS ;Go To S/R via Return to Caller
; ==============================================================================
; Character Table: Used to Decode Keyboard Input (23 Monitor Commands)
; ==============================================================================
;
; DFB $NN = <-----> = ;F({[High ASCII of "Char"] XOR $B0}+$89)
; ========== ;=========================================
; \V/ \V/ ; Mon.Cmds Subroutines Actions
; --- --- ; -------- -------- -----------------
FFCC: BC CHRTBL DFB $BC ;F("Ctrl-C") ; BASCONT ; Warm Start BASIC
FFCD: B2 DFB $B2 ;F("Ctrl-Y") ; USR ; JMP to User Vector
FFCE: BE DFB $BE ;F("Ctrl-E") ; REGZ ; Display Registers
FFCF: B2 DFB $B2 ;F("T") ; TRACE ; CMD now like USR *
FFD0: EF DFB $EF ;F("V") ; VFY ; Verify Memory
FFD1: C4 DFB $C4 ;F("Ctrl-K") ; INPRT ; Set IN# Slot
FFD2: B2 DFB $B2 ;F("S") ; STEPZ ; CMD now like USR *
FFD3: A9 DFB $A9 ;F("Ctrl-P") ; OUTPRT ; Set PR# Slot
FFD4: BB DFB $BB ;F("Ctrl-B") ; XBASIC ; Cold Start BASIC
FFD5: A6 DFB $A6 ;F("-") ; SETMODE ; Subtract
FFD6: A4 DFB $A4 ;F("+") ; SETMODE ; Add
FFD7: 06 DFB $06 ;F("M") ; MOVE ; Move Memory
FFD8: 95 DFB $95 ;F("<") ; LT ; MOVE/VFY Delimiter
FFD9: 07 DFB $07 ;F("N") ; SETNORM ; Set Normal Video
FFDA: 02 DFB $02 ;F("I") ; SETINV ; Set Inverse Video
FFDB: 05 DFB $05 ;F("L") ; LIST ; Disassemble 20 Instrs
FFDC: F0 DFB $F0 ;F("W") ; WRITE ; Write to Audio Tape
FFDD: 00 DFB $00 ;F("G") ; GO ; Execute a Program
FFDE: EB DFB $EB ;F("R") ; READ ; Read from Audio Tape
FFDF: 93 DFB $93 ;F(":") ; SETMODE ; Fill Memory
FFE0: A7 DFB $A7 ;F(".") ; SETMODE ; Address Range Delimiter
FFE1: C6 DFB $C6 ;F("CR") ; CRMON ; End Input
FFE2: 99 DFB $99 ;F(" ") ; BLANK ; Space Character
;
; ==============================================================================
; Subroutine Address Table: Used by TOSUB to Push onto Stack for RTS;
; Index Program Counter (PC) with Table Item for Subroutine Entry;
; Addresses: (Subroutine)-1; (MSB)=(#$FE); (LSB)=(Table Entry)+1
; ==============================================================================
;
; LSB Subroutines ;Mon.Cmds Actions
; --- ----------- ;-------- ----------------
FFE3: B2 SUBTBL DFB <BASCONT-1 ;"Ctrl-C" ; Warm Start BASIC
FFE4: C9 DFB <USR-1 ;"Ctrl-Y" ; JMP to User Vector
FFE5: BE DFB <REGZ-1 ;"Ctrl-E" ; Display Registers
FFE6: C1 DFB <TRACE_RTS-1 ;"T" ; TRACE: Now an 'RTS'; [TRACE_RTN]
; ------------------------------------------------------------------------------
; STEP & TRACE are now like USR (via CHRTBL): The way it is coded now, the Apple
; II Plus Autostart TRACE (T) Command is the same as the USER (Ctrl-Y) Command *
; ------------------------------------------------------------------------------
FFE7: 35 DFB <VFY-1 ;"V" ; Verify Memory
FFE8: 8C DFB <MON_INPRT-1 ;"Ctrl-K" ; Set IN# Slot
FFE9: C4 DFB <STEPZ_USR-1 ;"S" ; STEPZ: Now an 'RTS'; [STEPZ_RTN]
; ------------------------------------------------------------------------------
; <<< BUG! -- Should Be: DFB $C3, Not DFB $C4; for STEPZ-1 ($FEC4-1 = $FEC3) >>>
; ------------------------------------------------------------------------------
; Turns out that this is not really a BUG. The way it is coded now, the Apple
; II Plus Autostart STEP (S) Command is the same as the USER (Ctrl-Y) Command *
; ------------------------------------------------------------------------------
FFEA: 96 DFB <OUTPRT-1 ;"Ctrl-P" ; Set PR# Slot
FFEB: AF DFB <XBASIC-1 ;"Ctrl-B" ; Cold Start BASIC
FFEC: 17 DFB <SETMODE-1 ;"-" ; Subtract
FFED: 17 DFB <SETMODE-1 ;"+" ; Add
FFEE: 2B DFB <MOVE-1 ;"M" ; Move Memory
FFEF: 1F DFB <LT-1 ;"<" ; MOVE/VFY Delimiter
FFF0: 83 DFB <SETNORM-1 ;"N" ; Set Normal Video
FFF1: 7F DFB <SETINV-1 ;"I" ; Set Inverse Video
FFF2: 5D DFB <MON_LIST-1 ;"L" ; Disassemble 20 Instrs
FFF3: CC DFB <MON_WRITE-1 ;"W" ; Write to Audio Tape
FFF4: B5 DFB <GO-1 ;"G" ; Execute a Program
FFF5: FC DFB <MON_READ-1 ;"R" ; Read from Audio Tape
FFF6: 17 DFB <SETMODE-1 ;":" ; Fill Memory
FFF7: 17 DFB <SETMODE-1 ;"." ; Address Range Delimiter
FFF8: F5 DFB <CRMON-1 ;"CR" ; End Input
FFF9: 03 DFB <BLANK-1 ;" " ; Space Character (BLANK)
;
; ==============================================================================
; 6502 Interrupt Vector Table
; ==============================================================================
;
FFFA: FB 03 DW NMI ;NMI Vector
FFFC: 62 FA DW RESET ;RESET Vector
; ==============================================================================
; WHAT THE FOLLOWING SHOULD & SHOULD NOT BE:
; ------------------------------------------------------------------------------
; DW IRQ ;IRQ Vector ($FA40) IS Right;
; DW OLDRST ;OLDRST Vector ($FF59) IS Wrong! << BUG >>
; ------------------------------------------------------------------------------
; <<< BUG can be fixed in (Apple II Plus) Emulator ROM images! >>>
; ==============================================================================
FFFE: 59 FF DW OLDRST ;OLDRST Vector ($FF59) IS Wrong! << BUG >>