; ; Source code for the Tandy MC10 computer. ; ; Assembles using the asm11 68HC11 assembler from ; http://www.aspisys.com/asm11.htm ; ; Based on code from ; https://github.com/RevCurtisP/MC10/blob/master/disasm/MC10%20Disassembly.txt ; and edited to get it assembling. ; This file has not been checked against a known-good binary ; but is a starting point for doing so. ; ; 2022-11-21 Assembles with addresses matching labels. ; ; Disable macros used in a different project. ; asm11 uses a syntax that differs from the online assembler wwww.asm80 ; so they need editing anyway. ; ; asm11 says #IF 0 ; is a fatal error, ; hence the Orwellian expression. ; #IF 2+2 = 5 MACRO ldd_std ldd %1 std %2 ENDM MACRO ldd_zp_std_zp ldd_zp %%1 std_zp %%2 ENDM MACRO ldaa_staa ldaa %%1 staa %%2 ENDM MACRO ldab_stab ldab %%1 stab %%2 ENDM MACRO ldaa_jsr ldaa %%1 jsr %%2 ENDM MACRO ldaa_jmp ldaa %%1 jmp %%2 ENDM MACRO ldab_jsr ldab %%1 jsr %%2 ENDM MACRO ldab_jmp ldab %%1 jmp %%2 ENDM MACRO jsr_staa jsr %%1 staa %%2 ENDM MACRO jsr_stab jsr %%1 stab %%2 ENDM MACRO pula_pulb pula pulb ENDM MACRO pula_pulb_std_ix pula pulb std_ix %%1,x ENDM MACRO suba_staa suba %%1 staa %%2 ENDM MACRO ldaa_mul ldaa %%1 mul ENDM MACRO ldab_mul ldab %%1 mul ENDM MACRO asla_thrice asla asla asla ENDM MACRO aslb_thrice aslb aslb aslb ENDM MACRO asld_thrice asld asld asld ENDM MACRO lsrd_thrice lsrd lsrd lsrd ENDM MACRO asra_rorb asra rorb ENDM MACRO ldd_im_std_zp ldd_im %%1 std_zp %%2 ENDM MACRO asrb_asld asrb asld ENDM MACRO ldx_stx ldx %%1 stx %%2 ENDM MACRO dec_bne dec %%1 bne %%2 ENDM MACRO ldd_zp_addd_zp_std_zp ldd_zp %%1 addd_zp %%2 std_zp %%3 ENDM MACRO addd_zp_std_zp addd_zp %%1 std_zp %%2 ENDM #ENDIF ; ; constants: ; ;CR EQU $0D LF EQU $0A SP EQU $20 bits_per_byte EQU 8 mask_bit_0_set equ %00000001 mask_bit_1_set equ %00000010 mask_bit_2_set equ %00000100 mask_bit_3_set equ %00001000 mask_bit_4_set equ %00010000 mask_bit_5_set equ %00100000 mask_bit_6_set equ %01000000 mask_bit_7_set equ %10000000 mask_bit_0_clr equ %11111110 mask_bit_1_clr equ %11111101 mask_bit_2_clr equ %11111011 mask_bit_3_clr equ %11110111 mask_bit_4_clr equ %11101111 mask_bit_5_clr equ %11011111 mask_bit_6_clr equ %10111111 mask_bit_7_clr equ %01111111 ; ARREND ARREND equ 0 ; unknown for now ; ; Radio Shack MC-10 ROM Disassembly ; Modified to use Canonical Microsoft Label Names where possible ; by Curtis F Kaylor May 2020 ; From http://www.roust-it.dk/coco/mc10/romlist.txt ;; Radio Shack MC-10 Disassembly ;; (C) Copyright 1999 Kevin Timmerman ;; Additional annotation by Greg D. ;; Fixed and modified by James Tamer for use with TASM cross-assembler ; References: ; MBASIC.ASM - Microsoft BASIC for 6502 Original Source Code [1978] ; https://www.pagetable.com/?p=774 ; mapping_64.txt - Mapping the Commodore 64 ; https://www.commodore.ca/manuals/funet/cbm/c64/manuals/mapping-c64.txt.gz ; color-basic-unravelled.pdf - Color Basic Unraveled II ; color-basic-unravelled.pdf - Color Basic Unraveled II ; http://techheap.packetizer.com/computers/coco/unravelled_series/color-basic-unravelled.pdf ; mbasic.zip - Microsoft Basic-80 5.2 Source ; https://winworldpc.com/download/c2bfc380-c2b2-c2b4-7d00-11c3a7c29d25 ; https://zachowajto.pl/file/T72AzBwyeCot/microsoft-basic-80-5-2-source-7z ; A few handy defines to make TASM more like typcial ; motorola syntax ;.MSFIRST ; Most Significant byte first ; .ADDINSTR inst args opcode nbytes rule class shift binor ; .ADDINSTR JSR_E * BD 3 SWAP 1 shift binor ; JSR_E forces a 16-bit address JSR_E macro fcb $BD fdb ~1~ endm ; #define equ .EQU ; #define ORG .ORG ; #define RMB .BLOCK ; #define FCB .BYTE ; #define FCC .TEXT ; #define FDB .WORD ; #define equ .EQU ; #define org .ORG ; #define rmb .BLOCK ; #define fcb .BYTE ; #define fcc .TEXT ; #define fdb .WORD ; end a few handy defines ;ACRLF (Canonical Label) CR EQU $0D ; Carriage Return DDR1 equ $00 ; Port 1 Data Direction Register (1=Output, 0=Input) DDR2 equ $01 ; Port 2 Data Direction Register PORT1 equ $02 ; Port 1 Data Register PORT2 equ $03 ; Port 2 Data Register TIMER equ $08 ; Timer control and status register COUNTER equ $09 ; Counter (2 bytes) COMPARE equ $0B ; Output Compare (2 bytes) CHARAC equ $80 ; number build store MSB ENDCHR equ $81 ; number build store LSB COUNT equ $82 ; Index into Text Input Buffer/Number of Array Subscripts ; logic AND/OR function store DIMFLG equ $83 ; Array Variable Flags VALTYP equ $84 ; vartype flag ram85 equ $85 ; data token flag SUBFLG equ $86 ram87 equ $87 ; READ cmd status flag TANSGN equ $88 ; Used to Determine Sign of Tangent DOMASK equ $88 ; Mask Used by Relational Operations TEMPADR equ $89 ; address temp store RES equ $8C ; Floating-Point Result RESHO equ $8D ; Result Mantissa RESMOH equ $8E RESMO equ $8F RESLO equ $90 INDEX equ $91 ; stack pointer store TXTTAB equ $93 ; start of TXTTAB memory VARTAB equ $95 ; start of variable space ARYTAB equ $97 ; start of dimensioned variable space ; (Non-Canonical from Color Basic Unraveled) ARYEND equ $99 ; end of variables. FRETOP equ $9B ; start of string space FRESPC equ $9D ; next free string store ram9F equ $9F ; address build store MEMSIZ equ $A1 ; top of string storage ramA3 equ $A3 LINNUM equ $A5 ; Integer Line Number Value BRKADR equ $A7 ; program break address MSB OLDTXT equ $A9 ; Pointer to Address of Current BASIC Statement ramAB equ $AB DATPTR equ $AD ; DATA pointer ramAF equ $AF ; LIST command end line no. VARNAM equ $B1 ; Variable Name ; $B2 ramB3 equ $B3 FORPNT equ $B5 ; FOR-NEXT var pointer OPPTR equ $B7 ; Pointer to Entry in Operator Table OPMASK equ $B9 ; Relational Operator Mask FPTMP equ $BA ; EXPONENT FPTMPM equ $BB ; DIGIT 4-3 HIGHTR equ $BD ; Source of Highest Element to Move FPTMPS equ $BF ; SIGN DPTFLG equ $C0 TENEXP equ $C1 ramC2 equ $C2 TBL00C4 equ $C4 ramC5 equ $C5 ramC7 equ $C7 DSCTMP equ $C9 ; Temporary Descriptor FAC equ $C9 ; Floating Point Accumulator FACEXP equ $C9 ; Exponent FACHO equ $CA ; DIGIT 4 MSB FACMOH equ $CB ; DIGIT 3 FACMO equ $CC ; DIGIT 2 FACLO equ $CD ; DIGIT 1 LSB FACSGN equ $CE ; SIGN KH: not $CE$CE SGNFLG equ $CF ramD0 equ $D0 ramD2 equ $D2 ramD5 equ $D5 ARGEXP equ $D6 ; EXPONENT [FPA1] ARGH0 equ $D7 ; DIGIT 4 MSB ARGMOH equ $D8 ; DIGIT 3 ARGMO equ $D9 ; DIGIT 2 ARGLO equ $DA ; DIGIT 1 LSB ARGSGN equ $DB ; SIGN ARISGN equ $DC ; Floating Point Result Sign STRNG1 equ $DC ; Pointer to String or Descriptor FACOV equ $DD ; Floating Point Overflow ramDE equ $DE ; end of string address MSB ramDF equ $DF ; end of string address LSB CURLIN equ $E2 ; Current Line # ramE4 equ $E4 ; i/o tab field ramE5 equ $E5 ; i/o last tab field ramE6 equ $E6 ; max line length MSB ramE7 equ $E7 ; max line length LSB CHANNEL equ $E8 ; I/O select 0=screen -1=printer ramE9 equ $E9 ramEA equ $EA ; warm start setup flag =$55 CHRGET equ $EB ; INC TXTPTR+1 ; $EE BNE CHRGOT ; $F0 INC TXTPTR CHRGOT equ $F3 ; LDAA {next two bytes} TXTPTR equ $F4 ; Pointer to BASIC character ; $F6 ; JMP $E1C8 SCREEN equ $4000 ; start of screen mem TBL41FD equ $41FD ; start clearing. USR equ $4215 ; JMP Instruction for USR() USRADD equ $4216 ; Address of USR Routine {Mapping the C64} RNDX equ $4218 ; RND Function Seed Value ram421C equ $421C ; upcase flag KCOUNT equ $421D ; keyboard debounce delay $045E EXEADR equ $421F ; default EXEC address $EC2E ram4221 equ $4221 PBDELAY equ $4223 ; printer baud rate $0080 CRDELAY equ $4225 ; cr. delay count $0001 TABSIZE equ $4227 ; tab field width 16 PLINLEN equ $4229 ; last tab zone 112 ram422A equ $422A ; printer line length max MSB 88 FLSHCNT equ $422B ; printer line length max LSB 132 ram422C equ $422C ; cassette 1200/2400Hz partition 21 ($15) ram422D equ $422D ; upper limit of 1200 Hz ram422E equ $422E ; lower limit of 2400 Hz LDRCNT equ $422F ; number of 55's in leader MSB SCANBUF equ $4230 ; number of 55's in leader LSB 128; kyboard scan buff 4231-8. KEYSTRB equ $4239 ; keyboard strobe store CTLFLAG equ $423A ; keyboard control key flag BRKFLAG equ $423B ; keyboard break flag ram423C equ $423C LASTPT equ $423D ; Pointer to Address of Last String in Temporary String Stack TEMPST equ $423F ; Descriptor Stack for Temporary Strings STRBUFF equ $4241 ; string buffer RAMTOP equ $4250 ; end of memory pointer ram4252 equ $4252 ram4253 equ $4253 ram4254 equ $4254 ; random number store 1 ram4255 equ $4255 ; random number store 2 FNLEN equ $4256 ; File Name Length FNAM equ $4257 ; Cassette File Name Buffer {CBU} CASBUF equ $425F ; TAPE file name block FNAME equ $425F FTYPE equ $4267 ; File Type 0=Basic, 4=Variable DTYPE equ $4268 ; Data Type 0=Binary GAPFLG equ $4269 ; Gap Between Blocks Flag: 0=No XOFS equ $426A ; EXEC address offset LAL equ $426C ; LOAD address ram426E equ $426E ; NEW command status flag SAL equ $426F ; Start Address for Load/Save EAL equ $4271 ; End Address for Load/Save SKPFLG equ $4273 ram4274 equ $4274 BLKTYP equ $4275 ; Cassette Block Type: 0=Header, 1=Data, $FF=EOF BLKLEN equ $4276 ; Cassette Block Length ; $4277 ; Unused CBUFAD equ $4278 ; Cassette Buffer Address CCKSUM equ $427A ; Cassette Block Checksum LOADSTS equ $427B ; Cassette load status flag BITCNTR equ $427C ; cass byte load bit counter DURCNTR equ $427D ; tone duration counter ram427E equ $427E ; cass polarity flag LASTKEY equ $427F ; last keyboard input char CRSRADR equ $4280 ; cursor address MSB ; cursor address LSB CRSRCLR equ $4282 ; cursor color BRKSTS equ $4283 ; break status flag ram4284 equ $4284 ; LIST command status flag X_INCHAR equ $4285 ; input char command extension LBL4288 equ $4288 ; output char command extension LBL428B equ $428B ; output char command extension X_NEW equ $428E ; NEW command extension X_CMDLN equ $4291 ; build command line extension XMATHS equ $4294 ; maths command extension X_ERR1 equ $4297 ; error return extension 1 X_ERR2 equ $429A ; error return extension 2 XFIN equ $429D ; fp-acc number transfer extension X_RUN equ $42A0 ; RUN command extension X_TOKEN equ $42A3 ; command token lookup extension X_LIST equ $42A6 ; LIST command extension LBL42A9 equ $42A9 LBL42AC equ $42AC ram42AF equ $42AF SAVLIN equ $42B0 ; Line Number of Tokenized Line TBL42B1 equ $42B1 BUF equ $42B2 ; command line buffer LOFBUF equ $4333 ; Low FAC Buffer - Copyable FBUFFR equ $4335 ; binary-decimal conversion buffer TBL4346 equ $4346 ioBFFF equ $BFFF org $E000 ;$E000 Function Dispatch Vector Table FUNDSP: #IF 2+2 = 4 FDB SGN ; $F2BA SGN FDB INT ; $F335 INT FDB ABS ; $F2D5 ABS FDB USR ; $4215 USR FDB F_RND ; $F62A RND FDB F_SQR ; $F54D SQR FDB F_LOG ; $F0B9 LOG FDB EXP ; $F5C9 EXP FDB F_SIN ; $F68C SIN FDB F_COS ; $F686 COS FDB F_TAN ; $F6D2 TAN FDB F_PEEK ; $EF5F PEEK FDB F_LEN ; $EE82 LEN FDB STR ; $ECED STR$ FDB F_VAL ; $EF1C VAL FDB F_ASC ; $EEA2 ASC FDB F_CHR ; $EE8E CHR$ FDB F_LEFT ; $EEAD LEFT$ FDB F_RIGHT ; $EEC8 RIGHT$ FDB F_MID ; $EECF MID$ FDB F_POINT ; $FB9C POINT FDB F_VARPTR ; $FC11 VARPTR FDB F_INKEY ; $FBED INKEY$ FDB MEM ; $ECDB MEM ;$E030 Operator Dispatch Vector Table OPTAB: FCB $79 FDB FP_ADD ; $EF80 + FCB $79 FDB FP_SUB ; $EF75 - FCB $7B FDB FP_MUL ; $F0F1 * FCB $7B FDB FDIVT ; $F1C8 / FCB $7F FDB FP_POW ; $F556 ^ FCB $50 FDB FP_OR+1 ; $EA8E AND (FP_AND) FCB $46 FDB FP_OR ; $EA8D OR ;$E045 List of Keywords RESLST: FCB "FO",'R'+$80 ; FOR 80 FCB "GOT",'O'+$80 ; GOTO 81 FCB "GOSU",'B'+$80 ; GOSUB 82 FCB "RE",'M'+$80 ; REM 83 FCB "I",'F'+$80 ; IF 84 FCB "DAT",'A'+$80 ; DATA 85 FCB "PRIN",'T'+$80 ; PRINT 86 FCB "O",'N'+$80 ; ON 87 FCB "INPU",'T'+$80 ; INPUT 88 FCB "EN",'D'+$80 ; END 89 FCB "NEX",'T'+$80 ; NEXT 8A FCB "DI",'M'+$80 ; DIM 8B FCB "REA",'D'+$80 ; READ 8C FCB "LE",'T'+$80 ; LET 8D FCB "RU",'N'+$80 ; RUN 8E FCB "RESTOR",'E'+$80 ; RESTORE 8F FCB "RETUR",'N'+$80 ; RETURN 90 FCB "STO",'P'+$80 ; STOP 91 FCB "POK",'E'+$80 ; POKE 92 FCB "CON",'T'+$80 ; CONT 93 FCB "LIS",'T'+$80 ; LIST 94 FCB "CLEA",'R'+$80 ; CLEAR 95 FCB "NE",'W'+$80 ; NEW 96 FCB "CLOA",'D'+$80 ; CLOAD 97 FCB "CSAV",'E'+$80 ; CSAVE 98 FCB "LLIS",'T'+$80 ; LLIST 99 FCB "LPRIN",'T'+$80 ; LPRINT 9A FCB "SE",'T'+$80 ; SET 9B FCB "RESE",'T'+$80 ; RESET 9C FCB "CL",'S'+$80 ; CLS 9D FCB "SOUN",'D'+$80 ; SOUND 9E FCB "EXE",'C'+$80 ; EXEC 9F FCB "SKIP",'F'+$80 ; SKIPF A0 FCB "TAB",'('+$80 ; TAB( A1 FCB "T",'O'+$80 ; TO A2 FCB "THE",'N'+$80 ; THEN A3 FCB "NO",'T'+$80 ; NOT A4 FCB "STE",'P'+$80 ; STEP A5 FCB "OF",'F'+$80 ; OFF A6 FCB '+'+$80 ; + A7 FCB '-'+$80 ; - A8 FCB '*'+$80 ; * A9 FCB '/'+$80 ; / AA FCB '^'+$80 ; ^ AB FCB "AN",'D'+$80 ; AND AC FCB "O",'R'+$80 ; OR AD FCB '>'+$80 ; > AE FCB '='+$80 ; = AF FCB '<'+$80 ; < B0 FCB "SG",'N'+$80 ; SGN B1 FCB "IN",'T'+$80 ; INT B2 FCB "AB",'S'+$80 ; ABS B3 FCB "US",'R'+$80 ; USR B4 FCB "RN",'D'+$80 ; RND B5 FCB "SQ",'R'+$80 ; SQR B6 FCB "LO",'G'+$80 ; LOG B7 FCB "EX",'P'+$80 ; EXP B8 FCB "SI",'N'+$80 ; SIN B9 FCB "CO",'S'+$80 ; COS BA FCB "TA",'N'+$80 ; TAN BB FCB "PEE",'K'+$80 ; PEEK BC FCB "LE",'N'+$80 ; LEN BD FCB "STR",'$'+$80 ; STR$ BE FCB "VA",'L'+$80 ; VAL BF FCB "AS",'C'+$80 ; ASC C0 FCB "CHR",'$'+$80 ; CHR$ C1 FCB "LEFT",'$'+$80 ; LEFT$ C2 FCB "RIGHT",'$'+$80 ; RIGHT$ C3 FCB "MID",'$'+$80 ; MID$ C4 FCB "POIN",'T'+$80 ; POINT C5 FCB "VARPT",'R'+$80 ; VARPTR C6 FCB "INKEY",'$'+$80 ; INKEY$ C7 FCB "ME",'M'+$80 ; MEM C8 FCB $00 ;$E148 Statement Dispatch Vector Table STMDSP FDB FOR ; $E4C4 FOR FDB C_GOTO ; $E61A GOTO FDB C_GOSUB ; $E604 GOSUB FDB REM ; $E685 REM FDB IF ; $E672 IF FDB DATA ; $E651 DATA FDB C_PRINT ; $E71F PRINT FDB C_ON ; $E692 ON FDB C_INPUT ; $E7DE INPUT FDB END ; $E57F END FDB C_NEXT ; $E8BB NEXT FDB C_DIM ; $EB12 DIM FDB C_READ ; $E80E READ FDB LET ; $E6D3 LET FDB C_RUN ; $E5FA RUN FDB RESTOR ; $E560 RESTORE FDB C_RETURN ; $E631 RETURN FDB STOP ; $E57E STOP FDB C_POKE ; $EF66 POKE FDB CONT ; $E5A6 CONT FDB LIST ; $E40D LIST FDB C_CLEAR ; $E5B8 CLEAR FDB SCRATH ; $E3CD NEW FDB CLOAD ; $FD5C CLOAD FDB CSAVE ; $FC3B CSAVE FDB LLIST ; $E40B LLIST FDB LPRINT ; $E71C LPRINT FDB C_SET ; $FB25 SET FDB C_RESET ; $FB55 RESET FDB C_CLS ; $FBBF CLS FDB C_SOUND ; $FFA5 SOUND FDB EXEC ; $FC04 EXEC FDB C_SKIPF ; $FE2F SKIPF ;$E18A ASCII Text of TXTTAB Error Messages ERRTAB: FCB "NF" ; $00 NF NEXT without FOR FCB "SN" ; $02 SN Syntax Error FCB "RG" ; $04 RG RETURN without GOSUB FCB "OD" ; $06 OD Out of Data FCB "FC" ; $08 FC Illegal Function Call FCB "OV" ; $0A OV Overflow FCB "OM" ; $0C OM Out of Memory FCB "UL" ; $0E UL Undefined Line FCB "BS" ; $20 BS Bad Subscript FCB "DD" ; $22 DD Double Dimensioned Array FCB "/0" ; $24 /0 Division by 0 FCB "ID" ; $26 ID Illegal Direct Statement FCB "TM" ; $28 TM Type Mismatch FCB "OS" ; $2A OS Out of String Space FCB "LS" ; $2C LS Long String (exceeds 255 characters) FCB "ST" ; $2E ST String Formula Too Complex ? ""+(""+(""+"")) FCB "CN" ; $30 CN Can't Continue FCB "IO" ; $32 IO Input/Output Error FCB "FM" ; $34 FM File Mode Error #ELSE #ENDIF ;$E1B0 Miscellaneous Messages ERR: ; (Canonical Label) ERRTXT FCB " ERROR",0 INTXT FCB " IN ",0 REDDY FCB CR,"OK",CR,0 BRKTXT FCB CR,"BREAK",0 ;$E1C8 Continuation of CHRGET/CHRGOT QNUM CMPA #':' ; Leave if non-numeric. Z=':' or NULL BHS CHRRTS ; C=Numeric CMPA #SP ; skip whitespace BNE LBLE1D3 JMP CHRGET LBLE1D3 SUBA #$30 SUBA #$D0 ; Set Carry if numeric. CHRRTS RTS ;$E1D8 Find FOR on Stack FNDFOR TSX LDAB #$04 ABX FFLOOP LDAB #$12 STX TEMPADR LDAA 0,X ; SP+0==return addr. SP+2==?. SP+4->A SUBA #$80 BNE ADDFRS LDX 1,X STX TEMPADR+1 LDX FORPNT BEQ ADDFR1 CPX TEMPADR+1 BEQ ADDFRS BSR LBLE22F BRA FFLOOP ADDFR1 LDX TEMPADR+1 ; (Non-Canonical Label) STX FORPNT ADDFRS LDX TEMPADR TSTA RTS ; -- copy [C1:BD]->[bf:BB] LBLE1FE BSR GETSTD; see if D bytes fit on stack LBLE200 TPA PSHA STS INDEX SEI LDS FPTMPM ; store in [BB] LDX HIGHTR ; start at [BD] INX LBLE20A DEX LDAA 0,X PSHA CPX TENEXP ; stop at [C1] BNE LBLE20A INS STS FPTMPS ; store end in [BF] LDS INDEX PULA TAP RTS ;$E21A Check for Space on Stack GETSTK CLRA ; return with 2*B+#$3A+ARYEND ASLB ; ADDD ARREND ; check if 2*B+3A+ARYEND>0xffff ;$E21E See if D Bytes fit on Stack (Non-Canonical Label) GETSTD ADDD #$003A BLO OMERR ; ?OM error STS INDEX SUBD INDEX BHS OMERR ; ?OM if greater than stack ADDD INDEX RTS LBLE22C CLRA ; B+X->D,X LBLE22D STX TEMPADR ; D+X->D,X (save old X in 89. New X,D in 8B) LBLE22F ADDD TEMPADR ; D+TEMPADR->D,X. STD TEMPADR+1 LDX TEMPADR+1 RTS ;$E236 OUT OF MEMORY Error Handler OMERR LDAB #$0C ; ?OM error ;$E238 General Error Handler ERROR JSR X_ERR1 ; error return extension 1 JSR X_ERR2 ; error return extension 2 JSR LBLFC86 LDAA ram426E BEQ LBLE249 JSR LBLE3CF LBLE249 JSR LBLE3EE CLR CHANNEL ; turn off printer JSR LBLE76A JSR LBLE7BC LDX #ERRTAB ; Error table ABX LDAA 0,X JSR LBLE7BE ; A->SCN LDAA 1,X JSR LBLE7BE ; A->SCN LDX #ERRTXT-1 ; "ERROR" ;$E266 Print "ERROR" or "ERROR IN line" ERRFIN JSR STROUT ; Write string LDX CURLIN INX BEQ READY JSR LBLF412 ; ' IN ' line ;$E271 Print "READY" and Return to Direct Mode READY JSR LBLE76A LDX #REDDY ; "OK" JSR STROUT ; Write string ;$E27A Main Loop - Direct Mode MAIN LDX #$FFFF STX CURLIN JSR LBLFAA4 ; Get Command Line BLO MAIN ; Try again if carry set (BREAK) STX TXTPTR @JSR_E CHRGET ; BEQ MAIN ; Try again if blank line BLO MAIN1 JSR CRUNCH ; immediate mode - CRUNCH line. JMP GONE MAIN1 JSR LINGET ; get line number->LINNUM LDX LINNUM STX SAVLIN ; store line number (for extensions?) JSR CRUNCH ; CRUNCH line STAB COUNT ; length of line JSR FNDLIN ; find first line greater than line number BLO NODEL ; none found, insert at end. LDD TENEXP SUBD 0,X ADDD VARTAB STD VARTAB TPA PSHA STS INDEX SEI LDS 0,X DES LBLE2B5 PULA STAA 0,X INX CPX VARTAB BNE LBLE2B5 LDS INDEX PULA TAP ;$E2C1 Add Line to End of Program NODEL LDAA BUF BEQ LBLE2EB LDD VARTAB STD HIGHTR ADDB COUNT ADCA #$00 STD FPTMPM JSR LBLE1FE ; copy [C1:BD]->[bf:BB] TPA PSHA STS INDEX SEI LDS #$42AD LBLE2DB PULA STAA 0,X INX CPX FPTMPS BNE LBLE2DB LDS INDEX PULA TAP LDX FPTMPM STX VARTAB LBLE2EB JSR LBLE3D9 ; reset variables BSR LBLE2F3 ; adjust next statement pointers JMP MAIN ; get command line ; adjust next statement pointers LBLE2F3 LDX TXTTAB ; start of TXTTAB LBLE2F5 LDD 0,X ; return if last statement. BNE LBLE2FA RTS LBLE2FA PSHX ; push address of statement LDAB #$04 ABX LBLE2FE INX LDAA 0,X BNE LBLE2FE INX PSHX ; push address of next statement TSX LDD 0,X ; addr of next statement -> D LDX 2,X ; addr of prev statement -> X STD 0,X ; update addr of prev statment to point to next statement. PULX INS INS BRA LBLE2F5 CRUNCH CLR ram85 ; clear DATA token flag LDX TXTPTR ; reset pointer back to start of line. DEX STX TXTPTR LDX #TBL42B1 ; start of command line buffer-1 STX ramDE STS INDEX TPA ; save interrupt flag STAA ram87 LBLE323 NOP SEI ; disable interrupts LDS TXTPTR PULB CMPB #SP BEQ LBLE364 STAB ENDCHR CMPB #'"' BEQ LBLE38D LDAA ram85 BNE LBLE364 CMPB #'?' BNE LBLE33E LDAB #$86 ; 'PRINT' code BRA LBLE364 LBLE33E CMPB #'0' BLO LBLE346 CMPB #'<' BLO LBLE364 LBLE346 TSTB ; use ! for non-printing input chars BMI LBLE362 LDX #RESLST -1 ; start matching RESLST LDS TXTPTR CLRB LBLE34F INX LBLE350 PULA CMPA #SP ; skip whitespace when matching RESLST BEQ LBLE350 SUBA 0,X BEQ LBLE34F CMPA #$80 BNE LBLE392 ORAB #$80 ; found match, store token. LBLE35F LDX ramDE FCB $CB ; CPX # LBLE362 LDAB #'!' LBLE364 STS TXTPTR LDS INDEX LDAA ram87 ; restore interrupt TAP INX STX ramDE STAB 0,X BEQ LBLE3AA SUBB #':' BEQ LBLE37A CMPB #$4B ; 'DATA' encountered BNE LBLE37C LBLE37A STAB ram85 ; set DATA token flag LBLE37C SUBB #$49 ; 'REM' BNE LBLE323 ; get next char. STAB ENDCHR ; 'REM' found, clear ENDCHR SEI LDS TXTPTR LBLE385 PULB ; copy until 0 or ENDCHR encountered. TSTB BEQ LBLE364 CMPB ENDCHR BEQ LBLE364 LBLE38D INX STAB 0,X BRA LBLE385 LBLE392 LDS TXTPTR ; token failed match INCB ; inc token count LBLE395 LDAA 0,X INX BPL LBLE395 LDAA 0,X BNE LBLE350 STS TXTPTR ; no RESLST matched. LDS INDEX JSR X_TOKEN LDS TXTPTR PULB BRA LBLE35F LBLE3AA STAB 1,X ; clear next two bytes STAB 2,X LDD ramDE SUBD #$42AD ; length of buff in D. LDX #TBL42B1 STX TXTPTR RTS ;$E3B9 Get Pointer to Line in LINNUM FNDLIN LDX TXTTAB ;$E3BB Get Pointer to Line in X FNDLNC LDD 0,X BEQ FLNFND ; Line Found LDD LINNUM SUBD 2,X BLS FLINRT LDX 0,X BRA FNDLNC FLNFND SEC ; (Non-Canonical Label) FLINRT STX TENEXP RTS ;#E3CD NEW command --- SCRATH BNE FLINRT ; cause syntax error LBLE3CF LDX TXTTAB ; start of TXTTAB CLR 0,X ; clear line INX CLR 0,X INX STX VARTAB ; end of TXTTAB LBLE3D9 LDX TXTTAB ; transfer control to program DEX STX TXTPTR ; read pointer LBLE3DE JSR X_NEW ; NEW command extension LDX MEMSIZ ; top of string storage STX FRESPC ; avail string storage. JSR RESTOR LDX VARTAB ; end of TXTTAB STX ARYTAB ; DATA pointer STX ARREND ; LBLE3EE LDX #STRBUFF ; string buff. STX LASTPT ; string ptr. PULX LDS FRETOP ; bottom of system stack CLRA PSHA STAA BRKADR ; program BREAK address STAA BRKADR+1 ; program BREAK address STAA SUBFLG ; ? STAA ram426E ; NEW command status flag JMP 0,X ; RTS ;$E404 ; Set CHANNEL to Printer (Non-Canonical Labels) LPCHAN LDAB #$FE ; select printer STAB CHANNEL ; turn on printer LCHGOT JMP CHRGOT ; LLIST command LLIST BSR LPCHAN ; Set CHANNEL to Printer ; LIST command LIST TPA PSHA BSR LCHGOT ; Get char JSR LINGET ; Get line number BSR FNDLIN ; Find line number in program PULA TAP PSHX BEQ LBLE431 @JSR_E CHRGOT ; BEQ LBLE436 CMPA #'-' BNE LBLE42E @JSR_E CHRGET ; BEQ LBLE431 JSR LINGET BEQ LBLE436 LBLE42E JMP SNERR ; ?SN ERROR LBLE431 LDX #$FFFF STX LINNUM LBLE436 PULX INS INS LBLE439 JSR LBLE76A JSR ISCNTC LDD 0,X BNE LBLE449 LBLE443 CLR CHANNEL ; set output to printer JMP READY LBLE449 LDD 2,X SUBD LINNUM BHI LBLE443 LDD 2,X PSHX JSR LINPRT PULX INX INX INX INX STX TEMPADR CLR ram4284 LDAA #$20 FCB $CB ; CPX # LBLE462 LDAA #'!' LBLE464 LDX TEMPADR ANDA #$7F LBLE468 JSR LBLE7BE ; A->SCN LDAA 0,X INX TSTA BEQ LBLE439 LDAB ram4284 CMPA #'"' BNE LBLE47D EORB #$01 STAB ram4284 LBLE47D CMPA #':' BNE LBLE48A BITB #$01 BNE LBLE48A ANDB #$FD STAB ram4284 LBLE48A TSTA BPL LBLE468 TSTB BNE LBLE468 CMPA #$85 ; 'DATA' BNE LBLE496 ORAB #$02 LBLE496 CMPA #$83 ; 'REM' BNE LBLE49C ORAB #$04 LBLE49C STAB ram4284 JSR X_LIST CMPA #$C8 ; 'MEM' BHI LBLE462 ; write ! for unknown print BSR TOKADR LBLE4A8 LDAA 0,X ; write token BMI LBLE464 INX JSR LBLE7BE;A->SCN BRA LBLE4A8 TOKADR SUBA #$7F ; Find address of matching token->X STX TEMPADR ; save X into TEMPADR LDX #RESLST LBLE4B9 DECA BNE LBLE4BD RTS LBLE4BD TST 0,X INX BPL LBLE4BD BRA LBLE4B9 ; --- FOR Command --- FOR LDAA #$80 STAA SUBFLG JSR LET JSR FNDFOR PULX BNE NOTOL LDX TEMPADR ABX TXS NOTOL LDAB #$09 ; Precision JSR GETSTK ; Verify 9 words will fit on stack JSR DATAN ; ignore rest of line until ':' seen PSHX LDX CURLIN PSHX LDAB #$A2 ; 'TO' index JSR SYNCHR JSR CHKNUM ; expect numeric JSR FRMNUM ; Get numeric value LDAB FACSGN ORAB #$7F ANDB FACHO STAB FACHO LDX #LBLE4FA ; push C9-CA onto stack JMP LBLE9A4 LBLE4FA LDX #TBLF08B ; 1.0 JSR MOVFM ; X->C9-E @JSR_E CHRGOT ; JSR_E CMPA #$A5 ; 'STEP' index BNE LBLE50D @JSR_E CHRGET ; JSR_E JSR FRMNUM ; Get numeric value LBLE50D JSR SIGN ; Sign C9-E -> B -1 0 1 JSR LBLE9A2 LDX FORPNT PSHX LDAA #$80 PSHA LBLE519 BSR ISCNTC ; check for BREAK or PAUSE LDX TXTPTR STX OLDTXT LDAA 0,X BEQ LBLE52A CMPA #$3A ; ':' BEQ GONE SNERRF JMP SNERR ; ?SN ERROR LBLE52A INX ; check for next line LDAA 0,X INX ORAA 0,X STAA BRKSTS ; 0 if at last line number BEQ LBLE589 ; Implicit END if no next line. INX LDD 0,X STD CURLIN ; Otherwise store current line in E2. INX STX TXTPTR ;$E53D Read and Execute Next Statement GONE @JSR_E CHRGET ; get token ; JSR_E BSR GONE3 BRA LBLE519 ; continue executing line ;E544 GONE3 BEQ CONTRT ; RTS if 0 encountered. ;$E546 GONE2 JSR X_RUN ; Run command extension TSTA BMI NOTLET ; Command encountered. (Non-Canonical Label) JMP LET ; otherwise, this must be an assignment. NOTLET CMPA #$A0 ; SKIPF is the last valid command. BHI SNERRF ; ?SN ERROR ASLA ; lookup command. TAB LDX #STMDSP ABX LDX 0,X @JSR_E CHRGET ; prefetch next character. ; JSR_E JMP 0,X ; GO! [to command] ;$E560 RESTORE command RESTOR LDX TXTTAB DEX RESFIN STX DATPTR ; DATA pointer RTS ;$E566 Check for Ctrl-C ISCNTC JSR LBLF879 BEQ ISCRTS ; Loop after Pause (Non-Canonical Label) ISCNTL CMPA #$03 ; 'break pressed? BEQ STOP CMPA #$13 ; 'shift+@ pressed (pause) BEQ ISCNTW ; wait for next key. STAA LASTKEY ISCRTS RTS ; Wait fotr Key Press (Non-Canonical Label) ISCNTW JSR SCANKBD BEQ ISCNTW BRA ISCNTL ;$E57E STOP command STOP SEC ;$E57F END command END BNE CONTRT LDX TXTPTR STX OLDTXT LBLE585 ROR BRKSTS ; break status flag PULX LBLE589 LDX CURLIN INX BEQ LBLE595 DEX STX ramA3 LDX OLDTXT STX BRKADR LBLE595 CLR CHANNEL ; turn off printing LDX #BRKTXT-1 ; 'BREAK' TST BRKSTS BPL LBLE5A3 JMP ERRFIN ; in program LBLE5A3 JMP READY ; not in program ;$E5A6 CONT command CONT BNE CONTRT LDAB #$20 ; ?CN error LDX BRKADR BNE CONT1 JMP ERROR ; write ?CN error CONT1 STX TXTPTR ; (Non-Canonical Label) LDX ramA3 STX CURLIN CONTRT RTS ; --- CLEAR command --- C_CLEAR: BEQ LBLE5F4 JSR LBLEBBD PSHB PSHA LDX MEMSIZ ; top of string storage STX FACMO @JSR_E CHRGOT ; JSR_E BEQ LBLE5DA JSR CHKCOM ; get ',' JSR INTIDX LDX FACMO DEX STX FACMO LDD RAMTOP ; end of memory pointer SUBD FACMO BLO LBLE5F7 ; ?OM error LBLE5DA LDD FACMO PSHB PSHA TSX SUBD 2,X BLO LBLE5F7 ; ?OM error STD 2,X SUBD #$003A BLO LBLE5F7 ; ?OM error SUBD VARTAB BLO LBLE5F7 ; ?OM error PULX STX MEMSIZ ; top of string storage PULX STX FRETOP ; bottom of system stack LBLE5F4 JMP LBLE3DE ; reset variables LBLE5F7 JMP OMERR ; ?OM ERROR ; --- RUN command --- C_RUN: BNE LBLE5FF JMP LBLE3D9 ; transfer control to program / reset variables LBLE5FF JSR LBLE3DE ; reset data variables BRA LBLE612 ; --- GOSUB command --- C_GOSUB: LDAB #$03 JSR GETSTK ; verify 3 words on stack LDX TXTPTR PSHX LDX CURLIN PSHX LDAA #$82 PSHA LBLE612 @JSR_E CHRGOT ; JSR_E BSR C_GOTO JMP LBLE519 ; Continue executing line ; --- GOTO command --- C_GOTO: JSR LINGET BSR REMN INX LDD LINNUM SUBD CURLIN BHI LBLE628 LDX TXTTAB LBLE628 JSR FNDLNC BLO ULERR ; ?UL error DEX STX TXTPTR LBLE630 RTS ; --- RETURN command --- C_RETURN: BNE LBLE630 ; will ultimately result in ?SN error LDAA #$FF STAA FORPNT JSR FNDFOR TXS CMPA #$02 BEQ LBLE64A LDAB #$04 ; ?RG error FCB $CB ; CPX # ;$E642 Undefined Line Error Handler (Non-Canonical Label) ULERR LDAB #$0E ; ?UL error JMP ERROR ; Write error ;$E647 SNERRR JMP SNERR ; ?SN error LBLE64A PULA PULX STX CURLIN PULX STX TXTPTR ; DATA command DATA BSR DATAN ; ignore rest of line until ':' or 0 reached. STX TXTPTR REMRTS RTS ;$E656 DATAN LDAB #':' ; ignore rest of line until ':' or 0 reached. FCB $86 ; LDAA #... REMN CLRB STAB CHARAC CLRB LDX TXTPTR EXCHQT TBA LDAB CHARAC STAA CHARAC REMER LDAA 0,X BEQ REMRTS CBA BEQ REMRTS INX CMPA #'"' BEQ EXCHQT BRA REMER ;$E672 IF command --- IF JSR FRMNUM ; Get numeric value @JSR_E CHRGOT ; JSR_E CMPA #$81 ; GOTO BEQ OKGOTO LDAB #$A3 ; THEN JSR SYNCHR OKGOTO LDAA FAC BNE DOCOND ;$E685 REM command REM BSR REMN STX TXTPTR RTS DOCOND @JSR_E CHRGOT ; JSR_E BLO C_GOTO JMP GONE3 ; --- ON command ---- C_ON JSR LBLEF0D ; Arg->FACLO PSHA CMPA #$82 ; GOSUB BEQ LBLE69E CMPA #$81 ; GOTO SNERRO BNE SNERRR ; ?SN ERROR LBLE69E DEC FACLO BNE LBLE6A7 PULA JMP GONE2 LBLE6A7 @JSR_E CHRGET ; JSR_E BSR LINGET ; get line number->A5 CMPA #$2C ; ',' BEQ LBLE69E INS ONGRTS RTS ; bug -- "0 ON 2 GOTO 4,#,4,4#" hangs the MC-10 on RUN. ;$E6B2 Read a Line Number into LINNUM LINGET LDX #$0000 ; initialize line number to zero STX LINNUM MORLIN BHS ONGRTS ; if not a digit, return SUBA #$30 ; convert ASCII to digit STAA CHARAC ; and save it LDD LINNUM ; load line number CMPA #$18 ; if > 6399 BHI SNERRO ; issue ?SN ERROR ASLD ; multiply line number by ten ASLD ADDD LINNUM ASLD ADDB CHARAC ; add digit ADCA #$00 STD LINNUM ; and save it @JSR_E CHRGET ; read next character ; JSR_E BRA MORLIN ; and loop ; LET command LET JSR PTRGET ; get pointer to variable STX FORPNT ; and save it LDAB #$AF JSR SYNCHR LDAA VALTYP ; vartype flag PSHA JSR FRMEVL PULA RORA JSR LBLE910 ; check for ?TM and get next number BEQ LBLE719 LBLE6EA LDX FACMO LDD FRETOP ; bottom of system stack SUBD 2,X BHS LBLE705 LDD VARTAB SUBD FACMO BHI LBLE705 LDAB 0,X JSR LBLECFC LDX ramC7 JSR LBLEE38 LDX #ramD0 LBLE705 STX ramC7 JSR FRETMS LDX ramC7 LDAA 0,X PSHA LDD 2,X LDX FORPNT STD 2,X PULA STAA 0,X RTS LBLE719 JMP LBLF270 ;E71C LPRINT command --- LPRINT JSR LPCHAN ; --- PRINT command --- C_PRINT: BSR LBLE725 CLR CHANNEL; turn off printing RTS LBLE725 BEQ LBLE766 CMPA #$40 ; '@' BNE LBLE736 JSR LBLFC29 @JSR_E CHRGOT ; JSR_E BEQ LBLE766 JSR CHKCOM ; get ',' LBLE736 BEQ LBLE773 LBLE738 CMPA #$A1 BEQ LBLE78C CMPA #$2C BEQ LBLE774 CMPA #$3B BEQ LBLE7A2 JSR FRMEVL LDAA VALTYP ; vartype flag PSHA BNE LBLE752 JSR FOUT JSR LBLED05 LBLE752 BSR LBLE7AB PULB TSTB BNE LBLE761 @JSR_E CHRGOT ; JSR_E CMPA #$2C BEQ LBLE774 BSR LBLE7B9 LBLE761 @JSR_E CHRGOT ; JSR_E BNE LBLE738 LBLE766 LDAA #$0D BRA LBLE7BE ; A->SCN LBLE76A JSR LBLFA7B BEQ LBLE766 LDAA ramE6 BNE LBLE766 LBLE773 RTS LBLE774 JSR LBLFA7B BEQ LBLE783 LDAB ramE6 CMPB ramE5 BLO LBLE785 BSR LBLE766 BRA LBLE7A2 LBLE783 LDAB ramE6 LBLE785 SUBB ramE4 BHS LBLE785 NEGB BRA LBLE79D LBLE78C JSR LBLEF0A CMPA #$29 BEQ LBLE796 JMP SNERR ; ?SN ERROR LBLE796 JSR LBLFA7B SUBB ramE6 BLS LBLE7A2 LBLE79D BSR LBLE7B9 DECB BNE LBLE79D LBLE7A2 @JSR_E CHRGET ; JSR_E JMP LBLE736 ; --- Write string to screen --- STROUT JSR STRLIT ; Calc string length LBLE7AB JSR FREFAC ; Get length to B, start address to X INCB LBLE7AF DECB ; Dec char count BEQ LBLE773 ; RTS LDAA 0,X ; Get char INX ; Inc char ptr BSR LBLE7BE ; A->SCN Write char BRA LBLE7AF ; Next char LBLE7B9 LDAA #$20 FCB $CB ; CPX # LBLE7BC LDAA #$3F LBLE7BE JMP OUTCH ; A->SCN TBLE7C1 FCB "?REDO",CR,0 ; ?REDO LBLE7C8 LDAA ram87 BEQ LBLE7D3 LDX ramAB STX CURLIN JMP SNERR ; ?SN ERROR LBLE7D3 LDX #TBLE7C1-1 JSR STROUT LDX OLDTXT STX TXTPTR LBLE7DD RTS ; --- INPUT command --- C_INPUT: LDAB #$16 ; ?ID error LDX CURLIN INX BNE LBLE7E8 JMP ERROR ; write ?ID error LBLE7E8 CMPA #$22 ; check for "Prompt" ; BNE LBLE7F7 JSR STRTXT ; scan string until '"' reached. LDAB #$3B JSR SYNCHR ; expect and skip ' ;' JSR LBLE7AB ; write string to screen. LBLE7F7 BSR LBLE7FF ; "? " and get command line LDAB #$2C STAB 0,X BRA LBLE810+1 LBLE7FF JSR LBLE7BC ; "?"->SCN JSR LBLE7B9 ; " "->SCN JSR LBLFAA4 ; get command line BHS LBLE7DD PULX JMP LBLE585 ; break pressed - abort prog ; --- READ command --- C_READ: LDX DATPTR ; DATA pointer LBLE810 LDAA #$4F ; CLRA [used during INPUT command] STAA ram87 STX ramAF LBLE816 JSR PTRGET ; Get Var STX FORPNT LDX TXTPTR STX LINNUM LDX ramAF LDAA 0,X BNE LBLE82E LDAA ram87 BNE LBLE877 JSR LBLE7BC BSR LBLE7FF LBLE82E STX TXTPTR @JSR_E CHRGET ; JSR_E LDAB VALTYP ; vartype flag BEQ LBLE853 LDX TXTPTR STAA CHARAC CMPA #$22 BEQ LBLE846 DEX LDAA #$3A STAA CHARAC LDAA #$2C LBLE846 STAA ENDCHR JSR LBLED0C JSR ST2TXT JSR LBLE6EA BRA LBLE859 LBLE853 @JSR_E FIN @JSR_E LBLF270 LBLE859 @JSR_E CHRGOT ; JSR_E BEQ LBLE865 CMPA #$2C BEQ LBLE865 JMP LBLE7C8 LBLE865 LDX TXTPTR STX ramAF LDX LINNUM STX TXTPTR @JSR_E CHRGOT ; JSR_E BEQ LBLE897 JSR CHKCOM ; get ',' BRA LBLE816 LBLE877 STX TXTPTR JSR DATAN ; ignore rest of line thru ':' INX TSTA BNE LBLE88F LDAB #$06 LDAA 0,X ORAA 1,X BEQ LBLE8CE LDD 2,X STD ramAB LDAB #$04 ABX LBLE88F LDAA 0,X CMPA #$85 BNE LBLE877 BRA LBLE82E LBLE897 LDX ramAF LDAB ram87 BEQ LBLE8A0 JMP RESFIN LBLE8A0 LDAA 0,X BEQ LBLE8AA LDX #LBLE8AB-1 JMP STROUT LBLE8AA RTS LBLE8AB FCB "?EXTRA IGNORED",CR,0 ; ; --- NEXT command --- C_NEXT: BNE LBLE8C2 LDX #$0000 BRA LBLE8C5 LBLE8C2 JSR PTRGET ; Get Var LBLE8C5 STX FORPNT JSR FNDFOR BEQ LBLE8D0 LDAB #$00 ; ?NF error LBLE8CE BRA LBLE917 ; write error LBLE8D0 TXS INX INX INX JSR MOVFM ; X->C9-E TSX LDAA $08,X STAA FACSGN LDX FORPNT JSR LBLEF7D JSR LBLF270 TSX LDAB #$09 ABX JSR LBLF2D9 TSX SUBB $08,X BEQ LBLE8FC LDX $0E,X STX CURLIN TSX LDX $10,X STX TXTPTR LBLE8F9 JMP LBLE519 ; continue executing line LBLE8FC LDAB #$12 ABX TXS @JSR_E CHRGOT ; JSR_E CMPA #$2C ; ',' BNE LBLE8F9 ; continue executing line @JSR_E CHRGET ; JSR_E BSR LBLE8C2 ;$E90C Evaluate a Numeric Expression FRMNUM BSR FRMEVL ;$E90E ; Require Numeric Expression CHKNUM FCB $6D ; TST $0D,X ;$E90F ; Require String Expression CHKSTR SEC E-expect numeric? F-expect string? LBLE910 ROR VALTYP ; vartype flag BVC LBLE8AA ; RTS LDAB #$18 ; ?TM error LBLE917 JMP ERROR ;$E91A Evaluate Expression FRMEVL LDX TXTPTR DEX STX TXTPTR CLRA LDAB #$37 ; PSHB LOPER PSHA LDAB #$01 JSR GETSTK ; see if 1 word fits on stack JSR EVAL CLR OPMASK TSTOP @JSR_E CHRGOT ; JSR_E LOPREL SUBA #$AE ; '>' ; + - * / ^ AND OR > = < BLO ENDREL CMPA #$03 ; SGN BHS ENDREL CMPA #$01 ROLA EORA OPMASK CMPA OPMASK BLO SNERR5 STAA OPMASK @JSR_E CHRGET ; JSR_E BRA LOPREL ENDREL LDAB OPMASK BNE FINREL BHS QOP ADDA #$07 ; + - * / ^ AND OR > = < BHS QOP ADCA VALTYP ; vartype flag BNE LBLE95A JMP LBLEE06 LBLE95A ADCA #$FF TAB ; B = A*3 ASLA ABA TAB LDX #OPTAB ABX LBLE964 PULA CMPA 0,X BHS QCHNUM BSR CHKNUM ; expect numeric LBLE96B PSHA BSR LBLE991 LDX OPPTR PULA BNE LBLE98B TSTA BEQ QOPRTS BRA PULSTK FINREL ASL VALTYP ROLB LDX TXTPTR DEX STX TXTPTR LDX #TBLE988 STAB OPMASK BRA LBLE964 TBLE988 FCB $64,$EA,$AE LBLE98B CMPA 0,X BHS PULSTK BRA LBLE96B LBLE991 LDD 1,X PSHB ; push binary fp operation onto stack. PSHA BSR LBLE99E ; push CE onto stack. LDAB OPMASK BRA LOPER ;$E99B Branch Targer - Issue Syntax Error SNERR5 JMP SNERR ; Issue ?SN ERROR LBLE99E LDAB FACSGN ; push C9-CE onto stack. LDAA 0,X LBLE9A2 PULX PSHB LBLE9A4 LDAB FACLO ; push C9 onto stack and return. PSHB LDAB FACMO PSHB LDAB FACMOH PSHB LDAB FACHO PSHB LDAB FAC PSHB JMP 0,X ;$E9B5 Not an Operator QOP LDX #$0000 PULA ; Get High Precedence Of Last Op. TSTA ; If None BEQ QOPRTS ; Return QCHNUM CMPA #$64 ; If Relational Operator BEQ UNPSTK JSR CHKNUM ; Parse Numeric Value UNPSTK STX OPPTR ;$E9C5 PULSTK PULB CMPA #$5A BEQ UNPRTS ; RTS CMPA #$7D BEQ UNPRTS ; RTS LSRB STAB DOMASK PULA PULB STD ARGEXP PULX STX ARGMOH PULB STAB ARGLO PULB STAB ARGSGN EORB FACSGN STAB ARISGN ;$E9E2 Return Floating-Point Accumulator Exponent QOPRTS LDAB FACEXP ;$E9E4 Branch Target: Return UNPRTS RTS ;E9E5 Evaluate ASCII Number as Floating-Point Value EVAL JSR XMATHS ; maths command extension CLR VALTYP ; vartype flag BSR JCHGET ; get next char BHS EVAL2 ; go if not numeric EVAL1 JMP FIN ; get FP number EVAL2 JSR ISLETC ; is_alpha()? BHS ISVAR ; go if alpha() QDOT CMPA #'.' BEQ EVAL1 CMPA #'-' BEQ LBLEA41 CMPA #'+' BEQ EVAL CMPA #'"' BNE EVAL3 ;$EA07 Scan String STRTXT LDX TXTPTR JSR STRLIT JMP ST2TXT EVAL3 CMPA #$A4 ; NOT Token BNE EVAL4 LDAA #$5A JSR LOPER JSR LBLEBC7 ; get result into D COMA ; perform bitwise negation COMB JMP LBLECE3 ; return D EVAL4 SUBA #$B1 ; start of function RESLST [SGN()] BHS ISFUN ; go if a function ;$EA24 Evaluate Expression Within Parentheses PARCHK BSR CHKOPN ; otherwise, must be a parenthetical expression JSR FRMEVL ;$EA29 Check for and Skip Closing Parentheses CHKCLS LDAB #')' FCB $CB ; CPX # ;$EA2C Check for and Skip Opening Parentheses CHKOPN LDAB #'(' FCB $CB ; CPX # ;EA2F Check for and Skip Comma CHKCOM LDAB #',' ;$EA31 Validate Character SYNCHR PSHX LDX TXTPTR ; compare current character CMPB 0,X ; with B Register PULX BNE SNERR ; ?SN error if not equal JCHGET JMP CHRGET ; get next character and return ;$EA3C Print Syntax Error Message SNERR LDAB #$02 ; ?SN error JMP ERROR LBLEA41 LDAA #$7D JSR LOPER JMP NEGOP ;LEA49 ISVAR JSR PTRGET ; :get/init var STX FACMO LDAA VALTYP ; vartype flag BNE UNPRTS JMP MOVFM ; X->C9-E ;$EA55 Dispatch and Evaluate a Function ISFUN TAB ASLB BSR JCHGET ; get next char PSHB CMPB #$22 ; '"' BLO LBLEA7F CMPB #$2C ; ',' BHS LBLEA81 BSR CHKOPN ; get '(' PULB CMPB #$28 ; '(' BHS LBLEA82 PSHB JSR FRMEVL BSR CHKCOM ; get ',' JSR CHKSTR ; expect string PULA LDX FACMO PSHX PSHA JSR LBLEF0D PULA PSHB TAB BRA LBLEA82 LBLEA7F BSR PARCHK LBLEA81 PULB LBLEA82 LDX #FUNDSP ABX LDX 0,X JSR 0,X JMP CHKNUM ; expect numeric FP_OR LDAA #$4F ; perform fp OR. CLRA -- perform FP_AND. STAA COUNT JSR LBLEBC7 ; get result->D STD CHARAC JSR LBLF28B ; copy D6->C9. Clear DD. JSR LBLEBC7 ; get result->D TST COUNT BNE LBLEAA7 ANDA CHARAC ; perform the AND ANDB ENDCHR BRA LBLEAAB LBLEAA7 ORAA CHARAC ; perform the OR ORAB ENDCHR LBLEAAB JMP LBLECE3 ; return D. ; probably < = > ?? FP_EAAE JSR LBLE910 ; check for ?TM and get next number BNE LBLEAC3 LDAA ARGSGN ORAA #$7F ANDA ARGH0 STAA ARGH0 LDX #ARGEXP JSR LBLF2D9 BRA LBLEB03 LBLEAC3 CLR VALTYP ; vartype flag DEC OPMASK JSR FREFAC STAB ramD0 STX ramD2 LDX ARGMO JSR FRETMP LDAA ramD0 SBA BEQ LBLEAE1 LDAA #$01 BHS LBLEAE1 LDAB ramD0 NEGA LBLEAE1 STAA FACSGN TPA PSHA STS INDEX SEI TXS LDX ramD2 INCB DEX LBLEAED DECB BNE LBLEAF4 LDAB FACSGN BRA LBLEAFF LBLEAF4 PULA INX CMPA 0,X BEQ LBLEAED LDAB #$FF BHS LBLEAFF NEGB LBLEAFF LDS INDEX PULA TAP LBLEB03 ADDB #$01 ROLB ANDB DOMASK BEQ LBLEB0C LDAB #$FF LBLEB0C JMP FLOAT LBLEB0F JSR CHKCOM ; get ',' ; --- DIM command --- C_DIM: TAB BSR PTRGT1 @JSR_E CHRGOT ; JSR_E BNE LBLEB0F RTS ;$EB1B Read Variable Name and Set VARPTR PTRGET CLRB @JSR_E CHRGOT ; Get current char ; JSR_E PTRGT1 STAB DIMFLG ; Save Array Flag STAA VARNAM ; Store First Character of Variable Name @JSR_E CHRGOT ; Get First Character Again ; JSR_E BSR ISLETC ; Check for Letter BHS PTRGT3 ; If Not A-Z JMP SNERR ; Issue ?SN error PTRGT3 CLRB ; Preset Second Character to NUL STAB VALTYP ; Set Type to 0 (Numeric) @JSR_E CHRGET ; Set Next Character ; JSR_E BLO ISSEC ; If 0-9 BSR ISLETC BLO NOSEC ; or A-Z ISSEC TAB ; Set as Second Character EATEM @JSR_E CHRGET ; Get Next Character ; JSR_E BLO EATEM ; Skip If Numeric BSR ISLETC BHS EATEM ; Skip if Letter NOSEC CMPA #'$' ; Check for String BNE STRNAM ; If '$' COM VALTYP ; Set Type to $FF (String) ADDB #$80 ; Set High Bit od Second Character @JSR_E CHRGET ; Skip Dollar Sign ; JSR_E STRNAM STAB VARNAM+1 ; Store Second Character of Variable Name LDAB SUBFLG ; 01 if in CSAVE* or CLOAD* 80 if in FOR 0 else? DECB BNE LBLEB59 JMP LBLEC07 LBLEB59 ADDA SUBFLG SUBA #$28 ; '(' BNE LBLEB62 JMP ISARY LBLEB62 CLR SUBFLG LDX VARTAB ; start of variable space LBLEB67 CPX ARYTAB ; start of dim variable space BEQ LBLEB7F ; go if varname not found LDD VARNAM SUBD 0,X BEQ LBLEBB0 ; go if varname found LDAB #$07 ABX BRA LBLEB67 ; try again ;$EB76 Test for a Letter ISLETC CMPA #$41 ; 'A' BLO ISLRTS SUBA #$5B ; 'Z' SUBA #$A5 ; -'Z' ISLRTS RTS LBLEB7F PULX ; Varname not found. find caller PSHX CPX #$EA4C ; were we called from EA49? BNE LBLEB8A ; yes, insert variable LDX #TBLEBB7 ; [X]=0 RTS LBLEB8A LDD ARREND ; end of ARYTAB STD HIGHTR ; ADDD #$0007 ; length of var STD FPTMPM ; LDX ARYTAB ; start of ARYTAB STX TENEXP ; JSR LBLE1FE ; copy [C1:BD]->[bf:BB] LDX FPTMPM ; STX ARREND ; bump end of ARYTAB LDX FPTMPS ; STX ARYTAB ; bump start of ARYTAB LDX TENEXP ; get destination of variable LDD VARNAM ; get varname STD 0,X ; store varname CLRA CLRB STD 2,X ; initialize variable to zero STD 4,X STAA 6,X LBLEBB0 INX INX STX ramB3 ; ?start of array data RTS TBLEBB5 FCB $90 FCB $80 TBLEBB7 FCB $00 FCB $00 FCB $00 ;$EBBA Read and Convert Floating Point Number to Positive Integer ;Returns: X=Parsed Unteger INTIDX: @JSR_E CHRGET ; JSR_E LBLEBBD JSR FRMNUM LBLEBC0 JSR CHKNUM ; expect numeric LDAA FACSGN BMI FCERR ; ?FC error LBLEBC7 JSR CHKNUM ; expect numeric LDAA FAC CMPA #$90 BLO LBLEBD8 LDX #TBLEBB5 ; -32768.0 JSR LBLF2D9 ; compare [X] with C9-E. BNE FCERR ; ?FC error LBLEBD8 JSR QINT ; C9-x -> integer LDD FACMO LBLEBDD RTS ;$EBDE Find Array Element or Create New Array ISARY LDX DIMFLG ; Array detected... PSHX CLRB INDLOP PSHB LDX VARNAM PSHX BSR INTIDX PULX STX VARNAM PULB INCB STAB COUNT PULA PULB LDX FACMO PSHX PSHB PSHA LDAB COUNT @JSR_E CHRGOT ; JSR_E CMPA #$2C BEQ INDLOP JSR CHKCLS; get ')' PULX STX DIMFLG LDAB #$FF LBLEC07 PSHB LDX ARYTAB LBLEC0A CPX ARYEND BEQ LBLEC33 ; go if not found LDD VARNAM ; get varname SUBD 0,X BEQ LBLEC1B ; go if found LDD 2,X ; get length of current var JSR LBLE22D ; D+X->D,X BRA LBLEC0A LBLEC1B LDAB #$12 ; ?DD error PULA TSTA BEQ LBLEBDD ; RTS - if found and 0 on stack LDAA DIMFLG BNE ERRGO3 ; write error if in a DIM command on a previously alloc'd var. LDAB COUNT CMPB 4,X BEQ LBLEC87 ;EC2B Print Bad Subsript Error Message BSERR LDAB #$10 ; ?BS error FCB $CB ; CPX # ; $EC2D Print Runction Call Error Message FCERR LDAB #$08 ?FC error ERRGO3 JMP ERROR LBLEC33 PULA TSTA BEQ FCERR ; ?FC error LDD #$0005 STD ramDE LDD VARNAM STD 0,X LDAB COUNT STAB 4,X JSR GETSTK ; see if B words fit on stack STX FPTMPM LBLEC49 LDAB #$0B CLRA TST DIMFLG BEQ LBLEC56 PULA PULB ADDD #$0001 LBLEC56 STD 5,X BSR LBLECB9 STD ramDE INX INX DEC COUNT BNE LBLEC49 JSR LBLE22D ; D+X->D,X BHS LBLEC6B JMP OMERR ; ?OM ERROR LBLEC6B JSR GETSTD ; see if D bytes fit on stack SUBD #$0035 STD ARYEND CLRA LBLEC74 DEX STAA 5,X CPX TEMPADR BNE LBLEC74 LDX FPTMPM LDAA ARYEND SUBD FPTMPM STD 2,X LDAA DIMFLG BNE LBLECB8 LBLEC87 LDAB 4,X STAB COUNT CLRA CLRB LBLEC8D STD ramDE PULA PULB STD FACMO PSHB PSHA SUBD 5,X BHS LBLECD8 LDD ramDE PULA PULB BEQ LBLECA3 BSR LBLECB9 ADDD FACMO LBLECA3 INX INX DEC COUNT BNE LBLEC8D STD TEMPADR ASLD ASLD ADDD TEMPADR ADDD #$0005 JSR LBLE22D ; D+X->D,X STX ramB3 LBLECB8 RTS LBLECB9 LDAA #$10 STAA FPTMPS LDD 5,X STD INDEX CLRA CLRB LBLECC3 ASLD BLO LBLECD8 ASL ramDF ROL ramDE BHS LBLECD2 ADDD INDEX BLO LBLECD8 LBLECD2 DEC FPTMPS BNE LBLECC3 RTS LBLECD8 JMP BSERR ;ECDA MEM function MEM STS INDEX LDD INDEX SUBD ARYEND FCB $21 ; "BRN CLRA" LBLECE2 CLRA ; return value of B. LBLECE3 CLR VALTYP; vartype flag = 0 (numeric) STD FACHO LDAB #$90 JMP FLOATS ; --- STR$ function --- STR JSR CHKNUM ; expect numeric LDX #FBUFFR-1 JSR FOUTC PULX LDX #LOFBUF BRA STRLIT LBLECFC STX ramC7 LBLECFE BSR LBLED5F LBLED00 STX ramD2 STAB ramD0 RTS LBLED05 DEX ;$ED06 STRLIT LDAA #'"' STAA CHARAC ; String term char #1 STAA ENDCHR ; String term char #2 LBLED0C INX STX STRNG1 STX ramD2 LDAB #$FF LBLED13 INCB LDAA 0,X BEQ LBLED26 ; Null char term INX CMPA CHARAC BEQ LBLED21 CMPA ENDCHR BNE LBLED13 LBLED21 CMPA #$22 BEQ LBLED26 DEX LBLED26 STX ramDE ; Points to non-null, non-" term char. STAB ramD0 ; stringsize->D0 PSHB LDD ARISGN SUBD #$4334 ; See if in command buffer PULB BHI LBLED3A ; Jump if in program BSR LBLECFC LDX ARISGN JSR LBLEE3A LBLED3A LDX LASTPT ; string buff pointer CPX #$4250 ; end of pointer space BNE LBLED47 LDAB #$1E ; ?ST error LBLED44 JMP ERROR LBLED47 LDAA ramD0 ; stringsize STAA 0,X LDD ramD2 STD 2,X LDAA #$FF STAA VALTYP ; vartype flag STX TEMPST ; temp str buff ptr STX FACMO LDAB #$05 ABX STX LASTPT ; string buff pointer RTS LBLED5F CLR ram85 LBLED62 PSHB CLRA STD TEMPADR LDD FRESPC SUBD TEMPADR SUBD FRETOP ; bottom of system stack BLO LBLED79 ADDD FRETOP ; bottom of system stack STD FRESPC LDX FRESPC INX STX ram9F PULB RTS LBLED79 LDAB #$1A ; ?OS error COM ram85 BEQ LBLED44 ; write error BSR LBLED85 PULB BRA LBLED62 LBLED85 LDX MEMSIZ LBLED87 STX FRESPC CLRA CLRB STD ramC5 LDX FRETOP ; bottom of system stack STX TENEXP LDX #STRBUFF LBLED94 CPX LASTPT ; string buff pointer BEQ LBLED9D BSR LBLEDCD BRA LBLED94 LBLED9D LDX VARTAB LBLED9F CPX ARYTAB BEQ LBLEDA7 BSR LBLEDC7 BRA LBLED9F LBLEDA7 STX FPTMPM LBLEDA9 LDX FPTMPM LBLEDAB CPX ARYEND BEQ LBLEDE7 LDD 2,X ADDD FPTMPM STD FPTMPM LDAA 1,X BPL LBLEDA9 LDAB 4,X ASLB ADDB #$05 ABX LBLEDBF CPX FPTMPM BEQ LBLEDAB BSR LBLEDCD BRA LBLEDBF LBLEDC7 LDAA 1,X INX INX BPL LBLEDE3 LBLEDCD LDAB 0,X BEQ LBLEDE3 LDD 2,X SUBD FRESPC BHI LBLEDE3 LDD 2,X SUBD TENEXP BLS LBLEDE3 STX ramC5 LDD 2,X STD TENEXP LBLEDE3 LDAB #$05 ABX LBLEDE6 RTS LBLEDE7 LDX ramC5 BEQ LBLEDE6 CLRA LDAB 0,X DECB ADDD TENEXP STD HIGHTR LDX FRESPC STX FPTMPM JSR LBLE200 LDX ramC5 LDD FPTMPS STD 2,X LDX FPTMPS DEX JMP LBLED87 LBLEE06 LDX FACMO PSHX JSR EVAL JSR CHKSTR ; expect string PULX STX ARISGN LDAB 0,X LDX FACMO ADDB 0,X BHS LBLEE1F LDAB #$1C ; ?LS error JMP ERROR LBLEE1F JSR LBLECFC LDX ARISGN LDAB 0,X BSR LBLEE38 LDX ramC7 BSR FRETMP BSR LBLEE3A LDX ARISGN BSR FRETMP JSR LBLED3A JMP TSTOP LBLEE38 LDX 2,X LBLEE3A TPA PSHA STS INDEX SEI TXS LDX ram9F INCB BRA LBLEE49 LBLEE45 PULA STAA 0,X INX LBLEE49 DECB BNE LBLEE45 STX ram9F LDS INDEX PULA TAP RTS ;$EE53 Discard a Temporary String FRESTR JSR CHKSTR ; expect string ;$EE56 FREFAC LDX FACMO ;$EE58 FRETMP LDAB 0,X BSR FRETMS BNE LBLEE6D LDX 7,X DEX CPX FRESPC ; next free string store BNE LBLEE6B PSHB ADDD FRESPC STD FRESPC PULB LBLEE6B INX RTS LBLEE6D LDX 2,X RTS ;$EE70 Remove an Entry from the String Descriptor Stack FRETMS CPX TEMPST ; tmp str buff ptr BNE FRERTS STX LASTPT ; string buff pointer DEX DEX DEX DEX DEX STX TEMPST ; tmp str buff ptr CLRA FRERTS RTS ; --- LEN function --- F_LEN: BSR LBLEE87 ; stringlen->B LBLEE84 JMP LBLECE2 LBLEE87 BSR FRESTR CLR VALTYP ; vartype flag TSTB RTS ; --- CHR$ function --- F_CHR: JSR LBLEF10 LBLEE91 LDAB #$01 JSR LBLED5F LDAA FACLO JSR LBLED00 STAA 0,X LBLEE9D INS INS LBLEE9F JMP LBLED3A ; --- ASC function --- F_ASC: BSR LBLEEA6 BRA LBLEE84 LBLEEA6 BSR LBLEE87 BEQ LBLEF07 ; ?FC error LDAB 0,X RTS ; --- LEFT$ function --- F_LEFT: BSR LBLEEF2 CLRA LBLEEB0 CMPB 0,X BLS LBLEEB7 LDAB 0,X CLRA LBLEEB7 PSHB PSHA JSR LBLECFE LDX ramC7 BSR FRETMP PULB ABX PULB JSR LBLEE3A BRA LBLEE9F ; --- RIGHT$ function --- F_RIGHT: BSR LBLEEF2 LDAA 0,X SBA BRA LBLEEB0 ; --- MID$ function --- F_MID: LDAB #$FF STAB FACLO BSR LBLEF19 CMPA #$29 ; ')' BEQ LBLEEDC JSR LBLEF47 LBLEEDC BSR LBLEEF2 BEQ LBLEF07 ; ?FC error CLRB DECA CMPA 0,X BHS LBLEEB7 TAB SUBB 0,X NEGB CMPB FACLO BLS LBLEEB7 LDAB FACLO BRA LBLEEB7 LBLEEF2 JSR CHKCLS; get ')' TSX LDD 5,X STD ramC7 LDD 0,X STD 5,X INS INS INS INS PULA LDX ramC7 TAB RTS LBLEF07 JMP FCERR ; ?FC error LBLEF0A @JSR_E CHRGET ; JSR_E ;get arg -> B LBLEF0D JSR FRMNUM LBLEF10 JSR LBLEBC0 LDAA FACMO ; err if result >255 BNE LBLEF07 ; ?FC error LDAB FACLO LBLEF19 JMP CHRGOT ; --- VAL function --- F_VAL: JSR LBLEE87 BNE LBLEF24 JMP LBLEFF4 LBLEF24 JSR LBLE22C LDAA 0,X PSHA CLR 0,X LDX TXTPTR STX ramDE LDX TEMPADR STX TXTPTR BSR LBLEF19 JSR FIN ; get FP number PULA LDX TEMPADR+1 STAA 0,X ST2TXT LDX ramDE STX TXTPTR RTS LBLEF43 BSR INTIDX_ ; STX LINNUM LBLEF47 JSR CHKCOM ; get ',' BRA LBLEF0D ; get arg into B ;$EF4C Read Positive Integer into X INTIDX_: JSR FRMNUM ; get numeric var. ;$EF4F Convert FAC to Positive Integer LBLEF4F LDAA FACSGN BMI LBLEF07 ; ?FC error LDAA FAC CMPA #$90 BHI LBLEF07 ; ?FC error JSR QINT ; C9->integer LDX FACMO RTS ; --- PEEK function --- F_PEEK: BSR LBLEF4F LDAB 0,X JMP LBLECE2 ; return B ; --- POKE function --- C_POKE: BSR LBLEF43 LDX LINNUM STAB 0,X RTS LBLEF6D LDX #TBLF524 BRA LBLEF7D LBLEF72 JSR LBLF160 ; perform fp - FP_SUB COM FACSGN COM ARISGN BRA FP_ADD LBLEF7D JSR LBLF160 ; peform fp + FP_ADD TSTB BNE LBLEF86 JMP LBLF28B ; copy D6->C9. Clear DD. LBLEF86 LDX #ARGEXP LBLEF89 TAB BEQ LBLEFF9 ; RTS SUBB FAC BEQ LBLEFFA BMI LBLEF9C STAA FAC LDAA ARGSGN STAA FACSGN LDX #FAC NEGB LBLEF9C CMPB #$F8 BLE LBLEFFA CLRA LSR 1,X JSR LBLF080 LBLEFA6 LDAB ARISGN BPL LBLEFB5 COM 1,X COM 2,X COM 3,X COM 4,X COMA ADCA #$00 LBLEFB5 STAA FACOV LDAA FACLO ADCA ARGLO STAA FACLO LDAA FACMO ADCA ARGMO STAA FACMO LDAA FACMOH ADCA ARGMOH STAA FACMOH LDAA FACHO ADCA ARGH0 STAA FACHO TBA BPL LBLF019 ;$EFD2 FADFLT BLO LBLEFD6 BSR NEGFAC ; negate C9-E LBLEFD6 CLRB LBLEFD7 LDAA FACHO BNE LBLF00F LDAA FACMOH ; shift digits left by one byte STAA FACHO LDAA FACMO STAA FACMOH LDAA FACLO STAA FACMO LDAA FACOV STAA FACLO CLR FACOV ADDB #$08 CMPB #$28 BLT LBLEFD7 LBLEFF4 CLRA LBLEFF5 STAA FAC LBLEFF7 STAA FACSGN LBLEFF9 RTS LBLEFFA BSR LBLF074 ; shift digits right by -B bits CLC BRA LBLEFA6 LBLEFFF INCB ASL FACOV ROL FACLO ROL FACMO ROL FACMOH ROL FACHO LBLF00F BPL LBLEFFF LDAA FAC SBA STAA FAC BLS LBLEFF4 FCB $CB ; CPX # LBLF019 BLO LBLF024 ASL FACOV LDAA #$00 STAA FACOV BRA LBLF035 LBLF024 INC FAC ; mul by 2 BEQ OVERR ; ?OV ERROR ROR FACHO ; div digits by 2 ROR FACMOH ROR FACMO ROR FACLO LBLF035 BHS LBLF03B ; leave if we don't need to round up BSR INCFAC ; Increment FACMO,FACHO BEQ LBLF024 ; adjust exponenent if we broke the bank LBLF03B RTS ;$F03C Negate FAC NEGFAC COM FACSGN ;$F03F Negate FAC Mantissa Only NEGFCH COM FACHO COM FACMOH COM FACMO COM FACLO ;$F04B Increment FACMO,FACHO INCFAC LDX FACMO INX STX FACMO BNE INCFRT LDX FACHO INX STX FACHO INCFRT RTS ;$F058 Overflow Error OVERR LDAB #$0A ; ?OV error JMP ERROR LBLF05D LDX #RES LBLF060 LDAA 4,X ; shift digits right one byte. STAA FACOV LDAA 3,X STAA 4,X LDAA 2,X STAA 3,X LDAA 1,X STAA 2,X LDAA ramD5 STAA 1,X LBLF074 ADDB #$08 ; if B<-8, shift digits right one byte. BLE LBLF060 LDAA FACOV SUBB #$08 BEQ LBLF08A LBLF07E ASR 1,X ; if B<0 shift digits right one bit LBLF080 ROR 2,X ROR 3,X ROR 4,X RORA INCB BNE LBLF07E LBLF08A RTS TBLF08B FCB $81,$00,$00,$00,$00 ; 1.0 TBLF090 FCB $03 FCB $7F,$5E,$56,$CB,$79 ; 0.43425594 FCB $80,$13,$9B,$0B,$64 ; 0.57658454 FCB $80,$76,$38,$93,$16 ; 0.96180076 FCB $82,$38,$AA,$3B,$20 ; 2.88539007 TBLF0A5 FCB $80,$35,$04,$F3,$34 ; SQR(0.5) TBLF0AA FCB $81,$35,$04,$F3,$34 ; SQR(2.0) TBLF0AF FCB $80,$80,$00,$00,$00 ; -0.5 TBLF0B4 FCB $80,$31,$72,$17,$F8 ; LOG(2.0) F_LOG: ; --- LOG function --- JSR SIGN ; Test C9-E BGT LBLF0C1 JMP FCERR ; ?FC error LBLF0C1 LDX #TBLF0A5 LDAA FAC SUBA #$80 PSHA LDAA #$80 STAA FAC JSR LBLEF7D LDX #TBLF0AA JSR FDIV LDX #TBLF08B ; 1.0 JSR LBLEF72 LDX #TBLF090 JSR LBLF5F8 LDX #TBLF0AF JSR LBLEF7D PULB JSR LBLF3E9 LDX #TBLF0B4 LBLF0EF BSR LBLF160 ; perform fp * FP_MUL BEQ LBLF15F JSR LBLF179 LBLF0F6 LDAA #$00 STAA RESHO STAA RESMOH STAA RESMO STAA RESLO LDAB FACLO BSR LBLF12A LDAB FACOV STAB ram4255 LDAB FACMO BSR LBLF12A LDAB FACOV STAB ram4254 LDAB FACMOH BSR LBLF12A LDAB FACOV STAB ram4253 LDAB FACHO BSR LBLF12F LDAB FACOV STAB ram4252 JSR MOVFR JMP LBLEFD6 LBLF12A BNE LBLF12F JMP LBLF05D LBLF12F SEC LBLF130 LDAA RESHO RORB BEQ LBLF15F BHS LBLF14D LDAA RESLO ADDA ARGLO STAA RESLO LDAA RESMO ADCA ARGMO STAA RESMO LDAA RESMOH ADCA ARGMOH STAA RESMOH LDAA RESHO ADCA ARGH0 LBLF14D RORA STAA RESHO ROR RESMOH ROR RESMO ROR RESLO ROR FACOV CLC BRA LBLF130 LBLF15F RTS LBLF160 LDD 1,X STAA ARGSGN ORAA #$80 STD ARGH0 LDAB ARGSGN EORB FACSGN STAB ARISGN LDD 3,X STD ARGMO LDAA 0,X STAA ARGEXP LDAB FAC RTS LBLF179 TSTA BEQ LBLF195 ADDA FAC RORA ROLA BVC LBLF195 ADDA #$80 STAA FAC BNE LBLF18B JMP LBLEFF7 LBLF18B LDAA ARISGN STAA FACSGN RTS LBLF190 LDAA FACSGN COMA BRA LBLF197 LBLF195 PULA PULA LBLF197 BMI GOOVER JMP LBLEFF4 GOOVER JMP OVERR ; Overflow Error LBLF19F JSR MOVAF ; copy fp C9->D6 BEQ LBLF1B3 ; RTS ADDA #$02 BLO GOOVER ; ?OV ERROR CLR ARISGN JSR LBLEF89 INC FAC BEQ GOOVER ; ?OV ERROR LBLF1B3 RTS ;$F1B4 TENZC FCB $84,$20,$00,$00,$00 ; 10.0 ;$F1B9 Divide FAC by 10 DIV10 JSR MOVAF ; copy fp C9->D6 LDX #TENZC ; 10.0 CLRB LBLF1C0 STAB ARISGN JSR MOVFM ; X->C9-E #IF 2+2 = 5 CPX #$8D98 #ELSE nop #ENDIF ;$F1C5 FDIV BSR LBLF160 ; perform fp / FDIVT BEQ DV0ERR ; ?/0 error NEG FAC BSR LBLF179 INC FACEXP BEQ GOOVER LDX #RESHO LDAB #$04 STAB COUNT LDAB #$01 LBLF1DD LDAA FACHO CMPA ARGH0 BNE SAVQUO LDAA FACMOH CMPA ARGMOH BNE SAVQUO LDAA FACMO CMPA ARGMO BNE SAVQUO LDAA FACLO CMPA ARGLO BNE SAVQUO SEC SAVQUO TPA ROLB BHS QSHFT STAB 0,X INX DEC COUNT BMI DIVNRM BEQ LD100 LDAB #$01 QSHFT TAP BLO DIVSUB SHFARG ASL ARGLO ROL ARGMO ROL ARGMOH ROL ARGH0 BLO SAVQUO BMI LBLF1DD BRA SAVQUO DIVSUB LDAA ARGLO SUBA FACLO STAA ARGLO LDAA ARGMO SBCA FACMO STAA ARGMO LDAA ARGMOH SBCA FACMOH STAA ARGMOH LDAA ARGH0 SBCA FACHO STAA ARGH0 BRA SHFARG LD100 LDAB #$40 BRA QSHFT DIVNRM RORB RORB RORB STAB FACOV BSR MOVFR JMP LBLEFD6 ;$F243 Divide by 0 Error DV0ERR LDAB #$14 ; ?/0 error JMP ERROR ;$F248 Move RES to FAC MOVFR LDX RESHO STX FACHO LDX RESMO STX FACMO RTS ;$F251 Move Floating Point Number from Memory to FAC MOVFM: #IF 2+2 = 5 ; SHA #ELSE nop #ENDIF LDD 1,X STAA FACSGN ORAA #$80 STD FACHO CLR FACOV LDAB 0,X LDX 3,X STX FACMO STAB FAC PULA RTS LBLF267 LDX #FPTMPS BRA STFPACC ; FPA->X LBLF26C LDX #FPTMP FCB $CB ; CPX # LBLF270 LDX FORPNT STFPACC LDAA FAC ; Load floating-point ACOI storage-> X. STAA 0,X LDAA FACSGN ORAA #$7F ANDA FACHO STAA 1,X LDAA FACMOH STAA 2,X LDAA FACMO STAA 3,X LDAA FACLO STAA 4,X RTS ; copy D6->C9. Clear DD. LBLF28B LDAA ARGSGN LBLF28D STAA FACSGN LDX ARGEXP STX FAC CLR FACOV LDX ARGMOH STX FACMOH LDX ARGMO STX FACMO RTS ;$F29F Move FAC into ARG MOVAF LDD FAC STD ARGEXP LDX FACMOH STX ARGMOH LDX FACLO STX ARGLO TSTA RTS ;$F2AD Return Sign of Floating-Point Accumulator SIGN LDAB FACEXP ; If Exponent is 0 BEQ SIGNRT ; Return 0 in B FCSIGN LDAB FACSGN ; Else FCOMPS ROLB ; If Sign is Negative LDAB #$FF ; Return -1 in B BLO SIGNRT ; Else NEGB ; Return 1 in B. SIGNRT RTS ;$F2BA SGN Function SGN: BSR SIGN ; Get Sign of FAC in B ;$F2BC Convert Signed Value in B to Floating-Point FLOAT STAB FACHO CLR FACMOH LDAB #$88 ;$F2C3 Convert Signed Integer in FAC to Floating-Point FLOATS LDAA FACHO SUBA #$80 ;$F2C7 FLOATB STAB FACEXP LDAA #$00 TAB STD FACMO STAA FACOV STAA FACSGN JMP FADFLT ;$F2D6 ABS Function ABS CLR FACSGN ; clear sign bit RTS ; Compare C9-E with X, returning in B ; =1 if C>X, =-1 if CB if equal LBLF306 RORB EORB FACSGN BRA FCOMPS ;$F30B Convert FAC to 24-Bit Integer QINT LDAB FACEXP BEQ CLRFAC SUBB #$A0 LDAA FACSGN ; test sign byte BPL QISHFT COM ramD5 JSR NEGFCH ; negate CA-CD QISHFT LDX #FAC CMPB #$F8 BGT LBLF329 JSR LBLF074 ; shift digits right by -B bits CLR ramD5 RTS LBLF329 CLR ramD5 LDAA FACSGN ROLA ROR FACHO JMP LBLF080 ; divide CA-CD by 2^($100-B). ;$F335 INT Function INT LDAB FAC CMPB #$A0 BHS INTRTS BSR QINT ; C9-x -> integer STAB FACOV LDAA FACSGN STAB FACSGN SUBA #$80 LDAA #$A0 STAA FAC LDAA FACLO STAA CHARAC JMP FADFLT ;$F350 Clear FAC Mantissa (Set All Bytes to B) CLRFAC STAB FACHO STAB FACMOH STAB FACMO STAB FACLO INTRTS RTS ;$F359 Floating Point Input Routine FIN JSR XFIN ; fp-acc number transfer extension LDX #$0000 STX FACSGN ; Clear Floating-Point Accumulator STX FAC STX FACMOH STX FACMO STX TENEXP ; clear C1 STX FPTMPS BLO FINDIG ; Branch if Digit CMPA #'-' ; If Unary Minus BNE QPLUS COM SGNFLG ; Set Sign to -1 BRA FINC QPLUS CMPA #'+' BNE FIN1 FINC @JSR_E CHRGET ; JSR_E BLO FINDIG FIN1 CMPA #'.' BEQ FINDP CMPA #$45 ; 'E' BNE FINE @JSR_E CHRGET ; JSR_E BLO LBLF3F5 CMPA #$A8 ; '-' BEQ LBLF39E CMPA #$2D ; '-' BEQ LBLF39E CMPA #$A7 ; '+' BEQ LBLF3A1 CMPA #$2B ; '+' BEQ LBLF3A1 BRA LBLF3A6 LBLF39E COM ramC2 LBLF3A1 @JSR_E CHRGET ; JSR_E BLO LBLF3F5 LBLF3A6 TST ramC2 BEQ FINE NEG TENEXP BRA FINE FINDP COM DPTFLG BNE FINC FINE LDAA TENEXP SUBA FPTMPS STAA TENEXP BEQ FINQNG BPL FINMUL FINDIV JSR DIV10 INC TENEXP BNE FINDIV BRA FINQNG FINMUL JSR LBLF19F DEC TENEXP BNE FINMUL FINQNG LDAA SGNFLG BPL INTRTS JMP NEGOP ;$F3D8 FINDIG LDAB FPTMPS SUBB DPTFLG STAB FPTMPS PSHA JSR LBLF19F PULB SUBB #$30 BSR LBLF3E9 BRA FINC LBLF3E9 JSR LBLF26C ; C9->BA JSR FLOAT LDX #FPTMP JMP LBLEF7D ; TENEXP = 10*TENEXP+(A-$30). LBLF3F5 LDAB TENEXP ASLB ASLB ADDB TENEXP ASLB SUBA #$30 ABA STAA TENEXP BRA LBLF3A1 TBLF403 FCB $9B,$3E,$BC,$1F,$FD ; 99999999.90625 TBLF408 FCB $9E,$6E,$6B,$27,$FD ; 999999999.25000 TBLF40D FCB $9E,$6E,$6B,$28,$00 ; 1000000000.00000 LBLF412 LDX #INTXT -1; ' IN ' BSR STROU2 LDD CURLIN ; line number ;$F419 Output a Number in ASCII Decimal Digits LINPRT STD FACHO LDAB #$90 SEC JSR FLOATB BSR FOUT STROU2 JMP STROUT ;$F426 Convert FAC1 to ASCII String FOUT LDX #FBUFFR ;$F429 FOUTC LDAA #' ' LDAB FACSGN BPL LBLF431 LDAA #$2D LBLF431 STAA 0,X STAA FACSGN STX ramDE INX LDAA #$30 LDAB FAC BNE LBLF441 JMP LBLF51C LBLF441 CLRA CMPB #$80 BHI LBLF44E LDX #TBLF40D JSR LBLF0EF LDAA #$F7 LBLF44E STAA FPTMPS LBLF450 LDX #TBLF408 JSR LBLF2E3 BGT LBLF468 LBLF458 LDX #TBLF403 JSR LBLF2E3 BGT LBLF470 JSR LBLF19F DEC FPTMPS BRA LBLF458 LBLF468 JSR DIV10 INC FPTMPS BRA LBLF450 LBLF470 JSR LBLEF6D JSR QINT ; C9-x -> integer LDAB #$01 LDAA FPTMPS ADDA #$0A BMI LBLF486 CMPA #$0B BHS LBLF486 DECA TAB LDAA #$02 LBLF486 DECA DECA STAA TENEXP STAB FPTMPS BGT LBLF49F LDX ramDE LDAA #$2E INX STAA 0,X TSTB BEQ LBLF49D LDAA #$30 INX STAA 0,X LBLF49D STX ramDE LBLF49F LDX #TBLF529 LDAB #$80 LBLF4A4 LDAA FACLO ADDA 3,X STAA FACLO LDAA FACMO ADCA 2,X STAA FACMO LDAA FACMOH ADCA 1,X STAA FACMOH LDAA FACHO ADCA 0,X STAA FACHO INCB RORB ROLB BVC LBLF4A4 BHS LBLF4C6 SUBB #$0B NEGB LBLF4C6 ADDB #$2F INX INX INX INX STX ramB3 LDX ramDE INX TBA ANDA #$7F STAA 0,X DEC FPTMPS BNE LBLF4E0 LDAA #$2E INX STAA 0,X LBLF4E0 STX ramDE LDX ramB3 COMB ANDB #$80 CPX #$F54D BNE LBLF4A4 LDX ramDE LBLF4EE LDAA 0,X DEX CMPA #$30 ; '0' BEQ LBLF4EE CMPA #$2E ; '.' BEQ LBLF4FA INX LBLF4FA LDAA #$2B ; '+' LDAB TENEXP BEQ LBLF51E BPL LBLF505 LDAA #$2D ; '-' NEGB LBLF505 STAA 2,X LDAA #$45 STAA 1,X LDAA #$2F LBLF50D INCA SUBB #$0A BHS LBLF50D ADDB #$3A STAA 3,X STAB 4,X CLR 5,X BRA LBLF520 LBLF51C STAA 0,X LBLF51E CLR 1,X LBLF520 LDX #FBUFFR LBLF523 RTS TBLF524 FCB $80,$00,$00,$00,$00 ; 0.5 TBLF529 FCB $FA,$0A,$1F,$00 ; -100,000,000 FCB $00,$98,$96,$80 ; 10,000,000 FCB $FF,$F0,$BD,$C0 ; -1,000,000 FCB $00,$01,$86,$A0 ; 100,000 FCB $FF,$FF,$D8,$F0 ; -10,000 FCB $00,$00,$03,$E8 ; 1,000 FCB $FF,$FF,$FF,$9C ; -100 FCB $00,$00,$00,$0A ; 10 FCB $FF,$FF,$FF,$FF ; -1 ; --- SQR function --- F_SQR: JSR MOVAF ; copy fp C9->D6 LDX #TBLF524 ; 0.5 JSR MOVFM ; X->C9-E ; perform fp ^ FP_POW BEQ EXP TSTA BNE LBLF565 LDAA FACSGN BPL LBLF562 JMP DV0ERR ; ?/0 error LBLF562 JMP LBLEFF5 LBLF565 LDX #TBL00C4 JSR STFPACC ; FPA->X CLRB LDAA ARGSGN BPL LBLF580 JSR INT ; LBLF335 LDX #TBL00C4 LDAA ARGSGN JSR LBLF2E3 BNE LBLF580 COMA LDAB CHARAC ; TBL0080 LBLF580 JSR LBLF28D PSHB JSR F_LOG ; LBLF0B9 LDX #TBL00C4 JSR LBLF0EF BSR EXP PULA RORA BHS LBLF523 ;$F593 Negate Floating-Point Accumulator NEGOP LDAA FACEXP BEQ NEGRTS COM FACSGN NEGRTS RTS ;$F59B CF = Correction Factor for EXP Function (Non-Canonical Label) EXPCOR FCB $81,$38,$AA,$3B,$29 ; 1.44269504 ;$F5A0 Tchebyshev Modified Taylor Series Coefficients for EXP(X) EXPCON FCB $07 ; eight coefficients FCB $71,$34,$58,$3E,$56 ; 0.00002150 1/(7! * CF^7) FCB $74,$16,$7E,$B3,$1B ; 0.00014352 1/(6! * CF^6) FCB $77,$2F,$EE,$E3,$85 ; 0.00134226 1/(5! * CF^5) FCB $7A,$1D,$84,$1C,$2A ; 0.00961402 1/(4! * CF^4) FCB $7C,$63,$59,$58,$0A ; 0.05550513 1/(3! * CF^3) FCB $7E,$75,$FD,$E7,$C6 ; 0.24022638 1/(2! * CF^2) FCB $80,$31,$72,$18,$10 ; 0.69314719 1/(1! * CF^1) FCB $81,$00,$00,$00,$00 ; 1.0 ;$F5C9 ; EXP Function EXP LDX #EXPCOR ; Get correction factor BSR LBLF604 ; Multiply FPA0 by X JSR LBLF26C ; pack fpa0 and store in fpa3 LDAA FAC ; get exponent of fpa0 and compare to max value CMPA #$88 ; (128) BLO LBLF5DA ; br if fpa0 < 128 LBLF5D7 JMP LBLF190 ; set fpa0 = 0 or ?OV ERROR LBLF5DA JSR INT ; convert fpa0 to integer LDAA CHARAC ; get least significant byte of integer ADDA #$81 ; =127? BEQ LBLF5D7 ; ?OV ERROR DECA ; adds bias of 80 (since 81 used above) PSHA ; save exponent on stack LDX #FPTMP ; point (x) to FPa3 JSR LBLEF72 ; subtract fpa0 from (x) LDX #EXPCON ; point x to coeffs BSR LBLF607 ; eval polynomial for frac part CLR ARISGN ; force mantissa to be positive PULA JSR LBLF179 ; calc exp of new fpa0 by adding exps of integer and frac'l parts. RTS LBLF5F8 STX ramDE JSR LBLF26C BSR LBLF604 BSR LBLF609 LDX #FPTMP LBLF604 JMP LBLF0EF LBLF607 STX ramDE LBLF609 JSR LBLF267 LDX ramDE LDAB 0,X STAB SGNFLG INX STX ramDE LBLF615 BSR LBLF604 LDX ramDE LDAB #$05 ABX STX ramDE JSR LBLEF7D LDX #FPTMPS DEC SGNFLG BNE LBLF615 RTS ; --- RND function --- F_RND: JSR SIGN ; Test C9-E BMI LBLF650 BEQ LBLF646 BSR LBLF643 JSR LBLF26C BSR LBLF646 LDX #FPTMP BSR LBLF604 LDX #TBLF08B ; 1.0 JSR LBLEF7D LBLF643 JMP INT LBLF646 LDX RNDX STX FACHO LDX RNDX+2 STX FACMO LBLF650 LDX CONF682 STX ARGH0 LDX CONF684 STX ARGMO JSR LBLF0F6 LDD ram4254 ADDD #$658B STD RNDX+2 STD FACMO LDD ram4252 ADCB #$B0 ADCA #$05 STD RNDX STD FACHO CLR FACSGN LDAA #$80 STAA FAC LDAA RESMO STAA FACOV JMP LBLEFD6 CONF682 FDB $40E6 CONF684 FDB $4DAB ; --- COS function --- F_COS: LDX #TBLF6F6 ; Pi/2 JSR LBLEF7D ; --- SIN function --- F_SIN: JSR MOVAF ; copy FPA0 to FPA1 LDX #TBLF6FB ; point X to 2*Pi LDAB ARGSGN ; get mantissa sign of fpa1 JSR LBLF1C0 ; divide fpa0 by X JSR MOVAF ; copy FPA0 to FPA1 JSR INT ; convert FPA0 to integer CLR ARISGN ; set result sign to positive LDAA ARGEXP ; get exponent of fpa1 LDAB FAC ; get exponent of fpa0 JSR FP_SUB ; subtract fpa0 from fpa1 LDX #TBLF700 ; point X to 0.25 JSR LBLEF72 ; subtract fpa0 from 0.25 (pi/2) LDAA FACSGN ; get mantissa sign of fpa0 PSHA ; save on stack BPL LBLF6BC ; branch if mantissa positive JSR LBLEF6D ; add 0.5 (pi) to fpa0 LDAA FACSGN ; get sign of fpa0 BMI LBLF6BF ; branch if negative COM TANSGN ; com if 3pi/2 > arg > pi/2 [quadrant flag] LBLF6BC JSR NEGOP ; toggle mantissa sign of fpa0 LBLF6BF LDX #TBLF700 ; point X to 0.25 JSR LBLEF7D ; add it to fpa0 PULA ; get the old sign TSTA ; BPL LBLF6CC ; branch if old sign was positve JSR NEGOP ; toggle mantissa sign LBLF6CC LDX #TBLF705 ; point x to table of coeff's JMP LBLF5F8 ; calculate polynomial value ; --- TAN function --- F_TAN: JSR LBLF26C CLR TANSGN BSR F_SIN LDX #TBL00C4 JSR STFPACC ; FPA->X LDX #FPTMP JSR MOVFM ; X->C9-E CLR FACSGN LDAA TANSGN BSR LBLF6F3 LDX #TBL00C4 JMP FDIV LBLF6F3 PSHA BRA LBLF6BC TBLF6F6 FCB $81,$49,$0F,$DA,$A2 ; 1.57079632 Pi/2 TBLF6FB FCB $83,$49,$0F,$DA,$A2 ; 6.28318531 2*Pi TBLF700 FCB $7F,$00,$00,$00,$00 ; 0.25 1/4 TBLF705 FCB $05 FCB $84,$E6,$1A,$2D,$1B ; -14.38139067 -(2*Pi)^11/11! should be -15.094642578 ($84,$F1,$83,$A7,$EF) FCB $86,$28,$07,$FB,$F8 ; 42.00779712 (2*Pi)^9 / 9! should be 42.058693944 ($86,$28,$3C,$1A,$44) FCB $87,$99,$68,$89,$01 ; -76.70417026 -(2*Pi)^7 / 7! should be -76.705859753 ($87,$99,$69,$66,$73) FCB $87,$23,$35,$DF,$E1 ; 81.60522369 (2*Pi)^5 / 5! should be 81.605249276 ($87,$23,$35,$E3,$3C) FCB $86,$A5,$5D,$E7,$28 ; -41.34170210 -(2*Pi)^3 / 3! should be -41.341702240 ($86,$A5,$5D,$E7,$31) FCB $83,$49,$0F,$DA,$A2 ; 6.28318531 (2*Pi)^1 / 1! should be 6.283185307 ($86,$49,$0F,$DA,$A2) FCB $A1,$54,$46,$8F,$13 ; 7122787878.0 unused? FCB $8F,$52,$43,$89,$CD ; 26913.76914 unused? ; --- Reset Vector --- ; Reset I/O LBLF72E LDAA #$FF STAA DDR1 LDAA #$01 STAA DDR2 LDAA #$01 STAA PORT2 LDAA ramEA ; Check for warm boot flag CMPA #$55 BNE LBLF74A ; Not warm boot LDX ram4221 LDAA 0,X DECA BNE LBLF74A JMP 0,X ; Warm boot ; Cold boot LBLF74A LDX #$0080 ; Clear 6803 RAM LBLF74D CLR 0,X INX CPX #$0100 BNE LBLF74D LDX #TBL41FD ; Size and clear external RAM LBLF758 INX LDAA 2,X ; Get a byte COM 2,X ; Complement LDAB 2,X ; Get the complement CLR 2,X ; Clear COMA CBA ; Complement successful? BEQ LBLF758 ; Next... STX RAMTOP ; Save top of RAM STX MEMSIZ STX FRESPC LDD FRESPC SUBD #100 ; Reserve 100 bytes for string space STD FRETOP ; bottom of system stack LDS FRETOP LDX #TBLF7CF ; Init 6803 RAM LDD #$00EB BSR CPYTBL LDX #TBLF7DE ; Init external RAM LDD #$4200 BSR CPYTBL LDAA #$39 ; ==RTS LDX #X_INCHAR ; 4285 to 42AE set to RTS LBLF78A STAA 0,X INX CPX #$42AF BNE LBLF78A COM ram42AF ; ??? LDX #TBL4346 ; init start of prog mem. STX TXTTAB JSR LBLE3CF ; NEW command JSR CLRSCRN+1 ; Clear screen LDX #INITMSG-1 ; Copyright message JSR STROUT LDAA #$55 ; Flag warm boot STAA ramEA LBLF7AA JMP READY ;#F7AD ; Copy block of memory from [X+1] to [D], length at [X] CPYTBL STD FPTMPS ; Save destination LDAB 0,X ; Get length ;$F7B2 CPYMEN INX ; Inc start ;$F7B2 Copy block of memory from [X] to [$00BF], length in B CPYMEM LDAA 0,X ; Get byte STX TENEXP ; Save source LDX FPTMPS ; Get dest STAA 0,X ; Put byte INX ; Inc dest STX FPTMPS ; Save dest LDX TENEXP ; Get source DECB ; Dec count BNE CPYMEN ; More... RTS ;DEFAULT RESET WARM-BOOT (F7C3) NOP CLR CHANNEL ; turn off printing JSR LBLE3EE JSR CLRSCRN+1 ; Clear screen BRA LBLF7AA ; Copied to $00EB TBLF7CF FCB 14 ; 14 bytes to copy INC TXTPTR+1 BNE LBLF7D8 INC TXTPTR LBLF7D8 LDAA >DDR1 JMP QNUM ; Copied to $4200 TBLF7DE FCB 49 ; 49 bytes to copy RTI FCB $00 FCB $00 RTI FCB $00 FCB $00 RTI FCB $00 FCB $00 RTI FCB $00 FCB $00 RTI FCB $00 FCB $00 RTI FCB $00 FCB $00 RTI FCB $00 FCB $00 JMP FCERR ; ?FC error FCB $4F,$C7,$52,$59,$FF,$04,$5E,$EC,$2E,$F7,$C3,$00,$76,$00,$01,$10 FCB $70,$84,$00,$01,$15,$1A,$0B,$00,$80 INITMSG FCB $4D,$49,$43,$52,$4F,$43,$4F,$4C,$4F,$52,$20,$42,$41,$53,$49,$43 ; MICROCOLOR TXTTAB FCB $20,$31,$2E,$30,CR ; 1.0 FCB $43,$4F,$50,$59,$52,$49,$47,$48,$54,$20,$31,$39,$38,$32,$20 ; COPYRIGHT 1982 MCROSFT FCB $4D,$49,$43,$52,$4F,$53,$4F,$46,$54,CR,$00 ; MICROSOFT ; --- Flash cursor --- FLASH DEC FLSHCNT ; cursor flash delay counter BNE FDELAY LDAA CRSRCLR ; cursor color EORA #$0F STAA CRSRCLR ORAA #$80 LDX CRSRADR STAA 0,X LDAB #$16 ANDA #$0F BEQ LBLF85B LDAB #$58 ; flash color longer than black. LBLF85B STAB FLSHCNT ;$F85E Delay ? Cycles for Cursor Flash FDELAY LDX #$03FA ;$F861 Delay X*? Cycles DELAY DEX BNE DELAY RTS ; --- Idle loop --- LBLF865 JSR X_INCHAR ; input char command extension PSHX PSHB LBLF86A BSR FLASH ; Flash cursor BSR SCANKBD ; Scan keyboard BEQ LBLF86A ; Repeat if no key pressed LDAB #$60 LDX CRSRADR ; cursor address STAB 0,X BRA LBLF8CB LBLF879 CLRA BSR LBLF8D0 BNE SCANKBD BSR LBLF8E4 INCA BEQ LBLF8CD ; --- Scan keyboard --- SCANKBD JSR LBL42A9 ; Keyscan command extension PSHX PSHB LDAA #$FB ; Port code for BREAK key. BSR LBLF8D0 TAB BEQ LBLF892 EORB BRKFLAG ; keyboard BREAK flag. LBLF892 STAA BRKFLAG TSTB BEQ LBLF89E BSR KDELAY ; delay BSR LBLF8D2 ; still a break? BNE LBLF8C8 ; return BREAK code 03 LBLF89E LDX #SCANBUF CLRB DECB STAB KEYSTRB LBLF8A6 ROLB BHS LBLF8C6 INC KEYSTRB BSR LBLF8E2 PSHB TAB INX EORA 0,X ANDA 0,X STAB 0,X PULB TSTA SEC BEQ LBLF8A6 PSHA BSR KDELAY BSR LBLF8E4 CMPA 0,X PULA BNE LBLF8EA LBLF8C6 CLRA FCB $CB ; CPX # LBLF8C8 LDAA #$03 LBLF8CA TSTA LBLF8CB PULB ; Restore clobbered registers PULX LBLF8CD RTS ; End Scan Keyboard subroutine LBLF8CE LDAA #$7F ; Port code for SHIFT key LBLF8D0 STAA PORT1 ; Keyboard port i/o sequence LBLF8D2 LDAA PORT2 ; A=0x00=found COMA ; A=0xff=not found ANDA #$02 BEQ LBLF8DB LDAA #$FF LBLF8DB RTS ;$F8DC Delay for Keybounce KDELAY LDX KCOUNT ; Get Keyboard Debounce Delay JMP DELAY ; Delay and Return LBLF8E2 STAB PORT1 LBLF8E4 LDAA ioBFFF ORAA #$C0 RTS LBLF8EA LDAB #$F8 LBLF8EC ADDB #$08 LSRA BHS LBLF8EC ADDB KEYSTRB ; keyboard strobe store LDAA #$FE ; Port code for CONTROL key BSR LBLF8D0 STAA CTLFLAG ; keyboard control key flag JSR LBL42AC ; keyboard control extension BEQ LBLF911 LDX #TBLF97C CMPB #$20 BNE LBLF92E LDAA CRSRCLR ADDA #$10 STAA CRSRCLR BRA LBLF8C6 LBLF911 TBA BEQ LBLF919 CMPB #$1A BLS LBLF933 FCB $CB ; CPX # LBLF919 LDAB #$1D LDX #TBLF956-$1D BSR LBLF8CE BEQ LBLF92E LDX #TBLF969-$1D CMPB #$20 BNE LBLF92E COM ram421C BRA LBLF8C6 LBLF92E ABX LDAA 0,X BRA LBLF8CA LBLF933 BSR LBLF8CE EORA ram421C BNE LBLF941 LDAA ram421C BNE LBLF946 ORAB #$20 LBLF941 TBA ORAA #$40 LBLF944 BRA LBLF8CA LBLF946 LDX #TBLF9AB ABX LDAA 0,X BPL LBLF944 LDAB CRSRCLR ANDB #$70 ABA BRA LBLF944 TBLF956 FCB $40,$0D,$20 ; @- FCB $30,$31,$32,$33,$34,$35,$36,$37 ; 01234567 FCB $38,$39,$3A,$3B,$2C,$2D,$2E,$2F ; 89:;,-./ TBLF969 FCB $13,$0D,$20 ; -- FCB $00,$21,$22,$23,$24,$25,$26,$27 ; -!"#$%&' FCB $28,$29,$2A,$2B,$3C,$3D,$3E,$3F ; ()*+<=>? ; RESLST TBLF97C FCB $88,$08,$B3,$B2,$82,$9B,$90,$84 ; -------- FCB $A3,$8A,$81,$9E,$BC,$BA,$B9,$A5 ; -------- FCB $C7,$15,$9C,$09,$8C,$80,$B5,$5E ; -------^ FCB $B1,$8F,$0A,$00,$00,$00,$0D,$20 ; ------- FCB $00,$8E,$93,$98,$97,$96,$94,$95 ; -------- FCB $9D,$86,$89,$92,$BB,$91,$B7 ; ------- ; Graphic chars TBLF9AB FCB $B6,$89,$80,$82,$87,$8D,$86,$85 ; -------- FCB $48,$49,$4A,$4B,$4C,$4D,$4E,$4F ; HIJKLMNO FCB $50,$8F,$8C,$88,$8B,$55,$81,$8E ; P----U-- FCB $83,$8A,$84 ; --- ;$F9CE Write Character to Output Device OUTCH JSR LBL4288 PSHX PSHB PSHA LDAB CHANNEL ; Ouput device # BEQ OUTSCR ; Video... ; Assume printer TAB TPA PSHA SEI TBA LBLF9D5 LDAB PORT2 ; Wait for handshake ANDB #$04 BNE LBLF9D5 BSR LBLFA0A ; Idle bit CLRB BSR LBLFA0C ; Start bit LDAB #$08 LBLF9E2 PSHB CLRB LSRA ROLB BSR LBLFA0C ; Bit out PULB DECB BNE LBLF9E2 ; Next bit BSR LBLFA0A ; Stop bit PULA TAP PULA CMPA #$0D BEQ LBLFA00 INC ram422A LDAB ram422A CMPB PLINLEN BLO LBLFA07 LBLFA00 CLR ram422A BSR LBLFA15 BSR LBLFA15 LBLFA07 PULB PULX RTS LBLFA0A LDAB #$01 LBLFA0C STAB PORT2 ; Printer bit output BSR LBLFA10 LBLFA10 LDX PBDELAY BRA LBLFA18 LBLFA15 LDX CRDELAY LBLFA18 JMP DELAY ;FA1B Write Character to Screen OUTSCR LDX CRSRADR CMPA #$08 ; backspace BNE NOTBS CPX #$4000 BEQ LBLFA77 LDAA #$60 DEX STAA 0,X BRA LBLFA5C NOTBS CMPA #CR ; carriage return BNE NOTCR LDX CRSRADR LBLFA35 LDAA #$60 STAA 0,X INX STX CRSRADR LDAB CRSRADR+1 BITB #$1F BNE LBLFA35 BRA LBLFA5C NOTCR CMPA #$20 BLO LBLFA77 TSTA BMI LBLFA59 CMPA #$40 BLO LBLFA57 CMPA #$60 BLO LBLFA59 ANDA #$DF LBLFA57 EORA #$40 LBLFA59 STAA 0,X INX LBLFA5C STX CRSRADR CPX #$4200 BNE LBLFA77 LDX #$4000 ; scroll up LBLFA67 LDD $20,X STD 0,X INX INX CPX #$41E0 BNE LBLFA67 LDAB #$60 JSR LBLFBD9 LBLFA77 PULA PULB PULX RTS LBLFA7B JSR LBL428B ; I/O pointer setup command extenstion PSHX PSHB PSHA LDAA CHANNEL ; Get device output 0=screen, -1 printer BEQ LBLFA8D ; go if on screen LDX TABSIZE ; tab field width 16/last tab zone 112 LDD PLINLEN ; printer line length max BRA LBLFA97 LBLFA8D LDAB CRSRADR+1 ; cursor address lsb ANDB #$1F LDX #$1010 LDAA #$20 LBLFA97 STX ramE4 ; i/o tab and last tab field STAB ramE6 ; max line length msb STAA ramE7 ; max line length lsb PULA PULB PULX RTS LBLFAA1 JSR CLRSCRN+1 ; Clear screen LBLFAA4 JSR X_CMDLN ; build command line extension LBLFAA7 CLR LASTKEY ; last keyboard input char LDX #BUF ; command line buffer LDAB #$01 LBLFAAF JSR LBLF865 ; Cursor loop return with KEY->A TST ramE9 ; Punt if set. (by cmd extension?) BNE LBLFB04 TST CHANNEL ; check output flag BNE LBLFB00 ; go if printer TSTA BPL LBLFADD TST CTLFLAG ; control key flag BEQ LBLFADD JSR TOKADR ; address of token->X (save X->TEMPADR) LBLFAC7 LDAA 0,X INX PSHX PSHA ANDA #$7F LDX TEMPADR BSR LBLFB1A STX TEMPADR PULA PULX TSTA BPL LBLFAC7 LDX TEMPADR BRA LBLFAAF LBLFADD CMPA #$0C ; unimplemented clearscreen key? BEQ LBLFAA1 CMPA #$08 ; backspace BNE LBLFAED DECB BEQ LBLFAA7 ; don't go before stop DEX BSR LBLFB22 ; A->SCN BRA LBLFAAF LBLFAED CMPA #$15 ; L. DEL BNE LBLFAFB LBLFAF1 DECB ; keep backspacing until stop BEQ LBLFAA7 LDAA #$08 JSR OUTCH ; A->SCN BRA LBLFAF1 LBLFAFB CMPA #$03 ; break SEC BEQ LBLFB05 LBLFB00 CMPA #CR ; ENTER key BNE LBLFB12 LBLFB04 CLRA ; clear carry flag LBLFB05 TPA PSHA JSR LBLE766 ; #0D->SCN CLR 0,X ; terminate scratch LDX #TBL42B1 ; command line buff-1 PULA ; carry set if BREAK'd. TAP LBLFB11 RTS LBLFB12 CMPA #$20 BLO LBLFAAF ; ignore any non-printing char's BSR LBLFB1A BRA LBLFAAF LBLFB1A CMPB #$80 ; don't go more than 128 chars. BHS LBLFB11 STAA 0,X ; store char into command line buffer INX INCB LBLFB22 JMP OUTCH ; A->SCN ; --- SET command --- C_SET: BSR LBLFB6A ; get (x,y arg into memloc into X PSHX JSR LBLEF47 ; get ,c (B holds color code ) PULX CMPB #$08 BHI LBLFB67 ; ?FC error if color > 8 DECB BMI LBLFB38 LDAA #$10 ; LSLB LSLB LSLB LSLB MUL BRA LBLFB40 LBLFB38 LDAB 0,X ; Get color from screen BPL LBLFB3F ; Set to zero if text encountered ANDB #$70 FCB $21 ; "BRN CLRB" LBLFB3F CLRB LBLFB40 STAB COUNT ; save color BSR LBLFBB4 ; get trailing ')' LDAA 0,X BMI LBLFB49 ; make sure its graphics CLRA ; clear if a text char LBLFB49 ANDA #$0F ; ignore color bits ORAA ram423C ; holds desired bit ORAA COUNT ; get color LBLFB50 ORAA #$80 ; make a graphics char STAA 0,X ; write value to screen RTS ; --- RESET command --- C_RESET: BSR LBLFB6A ; get (x,y arg into memloc into X BSR LBLFBB4 ; get trailing ')' CLRA LDAB 0,X BPL LBLFB50 ; clear if it's a text char COM ram423C ANDB ram423C STAB 0,X RTS LBLFB67 JMP FCERR ; ?FC error LBLFB6A JSR CHKOPN ; get '(' LBLFB6D JSR LBLEF0D ; get x position CMPB #$3F BHI LBLFB67 ; ?FC error if > 63 PSHB ; push x on stack JSR LBLEF47 ; get y position CMPB #$1F BHI LBLFB67 ; ?FC error if > 31 PSHB ; push y on stack LSRB ; y=y/2 LDAA #$20 MUL ADDD #$4000 ; get address of left side of screen from y PSHB ; push onto stack PSHA TSX LDAB 3,X ; take x/2 and add to left side of screen LSRB PULX ABX PULA ; now construct mask for char block and store in 423C PULB ANDA #$01 RORB ROLA ; A holds 2's complement of bit pos LDAB #$10 ; start B with bit 4 LBLFB94 LSRB ; shift right until A is zero DECA BPL LBLFB94 STAB ram423C ; done, store into 423C RTS ; --- POINT command --- F_POINT: BSR LBLFB6D ; get '(x,y' into X and mask into 423C LDAB #$FF LDAA 0,X BPL LBLFBB2 ; need to return -1 if text char ANDA ram423C BEQ LBLFBB1 ; not set, return 0 LDAB 0,X LSRB LSRB LSRB LSRB ANDB #$07 LBLFBB1 INCB LBLFBB2 BSR LBLFBB7 ; return B (sign extended) LBLFBB4 JMP CHKCLS ; get ')' LBLFBB7 CLRA ; return B (sign extended) TSTB BPL LBLFBBC COMA LBLFBBC JMP LBLECE3 ; return D ; --- CLS command --- C_CLS: BEQ CLRSCRN+1 ; No args - default clear JSR LBLEF0D ; Get integer arg into B between 0-255. CMPB #$08 BHI CLRMSFT ; If > 8 - Clear screen and print Microsoft message TSTB BEQ LBLFBD1 ; CLS 0... DECB LDAA #$10 MUL ORAB #$0F LBLFBD1 ORAB #$80 ; 0=$80, 1=$8F, 2=$9F, 3=$AF, 4=$BF, 5=$CF, 6=$DF, 7=$EF, 8=$FF CLRSCRN CPX #$C660 ; ==LDAB #$60 - Default clear char LDX #SCREEN ; Start of video memory LBLFBD9 STX CRSRADR CLRLOOP STAB 0,X ; Set mem INX ; Next CPX #$4200 ; Done? BNE CLRLOOP ; More... RTS CLRMSFT BSR CLRSCRN+1 ; Clear screen LDX #MCROSFT-1 ; Microsoft message JMP STROUT ; Write string ; --- INKEY$ function --- F_INKEY: LDAA LASTKEY ; last keyboard input char BNE LBLFBF5 JSR SCANKBD LBLFBF5 CLR LASTKEY STAA FACLO BEQ LBLFBFF JMP LBLEE91 LBLFBFF STAA ramD0 JMP LBLEE9D ;$FC04 EXEC Command EXEC BEQ LBLFC0C ; If Not End of Statement JSR INTIDX ; Get address to X STX EXEADR LBLFC0C LDX EXEADR JMP 0,X ; --- VARPTR function --- F_VARPTR: LDX ARYEND PSHX JSR PTRGET JSR CHKCLS ; get ')' STX TEMPADR PULX LDD TEMPADR CPX ARYEND BEQ LBLFC26 JMP FCERR ; ?FC error LBLFC26 JMP LBLECE3 ; return D ; --- PRINT @expression --- LBLFC29 JSR INTIDX SUBD #$01FF BLS LBLFC34 JMP FCERR ; ?FC error LBLFC34 ADDD #$41FF STD CRSRADR RTS ;$FC3B CSAVE command CSAVE: LDX TXTTAB ; Set Start Address for SAVE STX SAL ; to Beginning of Program LDX VARTAB ; Set End Address for SAVE STX EAL ; end ; to End of Program CLRB ; Set File Type to BAS CMPA #$A9 ; If CSAVE* BNE CSAVE1 JSR CSAVEV ; Set SAL and EAL to Array Start amd End LDAB #$04 ; and File Type to VAR CSAVE1 STAB FTYPE ; Store File Type LDD EAL ; Calculate File Length SUBD SAL ; and STD LAL ; Store as LOAD Address BSR HWRITE LDX SAL ; Get Save Start Address ;FC60 ; Write File Data to Tape CSAVED STX CBUFAD ; Set Cassette Buffer Address LDAA #$FF ; Set Cassette Block Length STAA BLKLEN ; to 255 LDD EAL ; Calculate File Length SUBD CBUFAD BLS LBLFC7E TSTA BNE LBLFC7A CMPB #$FF BEQ LBLFC7A STAB BLKLEN ; cass block length LBLFC7A BSR BLKOUT ; write cassette block BRA CSAVED LBLFC7E NEG BLKTYP ; cass block type flag CLR BLKLEN ; cass block length BSR BLKOUT ; write cassette block LBLFC86: LDAA #$01 STAA PORT2 RTS ;FC8B Parse File Name and Write Header to Cassette HWRITE JSR CHKFN LDX #CASBUF ; tape filename block STX CBUFAD ; cass buffer address STX FPTMPS CLR $09,X ; Set DTYPE t0 0 CLR $0A,X ; Set GAPFLG to 0 ; Copy File Name to Cassette Buffer and Write to Cassette HDROUT LDX #FNAME ; skip/load filename LDAB #$08 JSR CPYMEM ; Copy B bytes from [X] to [$BF] CLR BLKTYP ; Set Cassette Block Type to Header LDAA #$0F STAA BLKLEN ; cass block length BSR WRLDR ; write cassette leader BSR BLKOUT ; write cassette block INC BLKTYP ; cass block type flag LDX #$0000 JSR DELAY ;$FCB7 Write Cassette Leader - (LDRCNT) SYNC Characters WRLDR LDX LDRCNT ; numer of $55's in leader ;$FCBA Write X SYNC Characters to Cassette WRSYN BSR SYNOUT DEX BNE WRSYN RTS ;$FCC0 Write cassette block BLKOUT NOP ; SEI LDAB BLKLEN ; cass block length STAB LOADSTS ; cass load status flag LDAA BLKLEN ; cass block length BEQ BLKOU2 LDX CBUFAD ; cass buffer address BLKOU1 ADDA 0,X INX DECB BNE BLKOU1 BLKOU2 ADDA BLKTYP ; cass block type flag STAA CCKSUM ; cass sumcheck LDX CBUFAD ; cass buffer address BSR SYNOUT LDAA #$3C BSR CASOUT LDAA BLKTYP BSR CASOUT LDAA BLKLEN ; cass block length BSR CASOUT TSTA BEQ BLKOU4 BLKOU3 LDAA 0,X INX BSR CASOUT DEC LOADSTS ; cass load status flag BNE BLKOU3 BLKOU4 LDAA CCKSUM ; cass sumcheck BSR CASOUT ;$FD01 Write Sync Character to Tape SYNOUT LDAA #$55 ;$FD03 Write Character to Cassette CASOUT PSHX ; Save Pointer to Byte PSHA ; Save Character on Stack PSHA ; Push onto Stack to be Rotated LDAB #$08 ; Writing 8 Bite ;$FD08 Write Bits to Cassette BTSOUT TSX ; Set Index to Byte on Stack LSR 0,X ; Rotate High Bit Out LDX #$0020 ; Set Pulse Length for Zero BLO PLSOUT ; If Bit was 1 LDX #$0040 ; Set Pulse Length for One ;$FD13 Write Pulse to Cassette PLSOUT PSHX ; Save Pulse Length LDAA #$01 ; Set Output High STAA PORT2 PLSOU1 DEX ; Count Down the Pulse Length BNE PLSOU1 CLRA STAA PORT2 ; Set Output Low PULX ; Restore Pulse Length PLSOU2 DEX ; and Count it Down BNE PLSOU2 DECB ; BNE BTSOUT ; Write Next Bit PULA PULA PULX PLSRTS RTS ;$FD29 Require Filename CHKFN BSR GETFN @JSR_E CHRGOT ; JSR_E BEQ PLSRTS JMP SNERR ; ?SN ERROR ;FD33 Get File Name GETFN LDX #FNLEN CLR 0,X ; Set Filename Length to 0 LDAA #$20 ; Fill Filename with Spaces PADFN INX STAA 0,X CPX #$425F ; tape filename block BNE PADFN @JSR_E CHRGOT ; load input char ; JSR_E BEQ PLSRTS ; return if no filename JSR FRMEVL ; Evaluate Expression JSR FRESTR ; Check if it's String STAB FNLEN ; Set Filename Length to String Length BEQ PLSRTS ; If it's 0, Return PSHB ; Save Filename Length LDD #$4257 ; skip/load filename STD FPTMPS PULB JMP CPYMEM ; Copy block of memory from [X] to [$00BF], length in B ; CLOAD command CLOAD CMPA #$A9 ; If Token is CLOAD* BNE CLOAD1 JMP CLOADV ; Execute CLOADV Routine CLOAD1 CMPA #$4D ; If Token is CLOADM BNE CLOAD2 ; Execute CLOADM Routine JMP CLOADM CLOAD2 CLRA ; File Type Program BSR LBLFD8F JSR LBLE3CF ; NEW command status flag COM ram426E ; unset new command flag LDD LAL ; LOAD address ADDD TXTTAB JSR GETSTD ; see if D bytes fit on stack LDX TXTTAB LBLFD7D STX CBUFAD ; cass buffer address BSR LBLFDD0 BPL LBLFD7D STX VARTAB LDX #REDDY -1 ; "OK" JSR STROUT ; Write string JMP LBLE2EB ; adjust next line pointers, and return to command mode LBLFD8F PSHA ; Save File Type 00=program 02=machine code 04=array data BSR LBLFDA2 PULA ; Restore File Type TST ram4274 BNE CLORTS CMPA FTYPE ; If File Type Doesn't Match BEQ CLORTS FMERR: LDAB #$24 ; Issue ?FM error JMP ERROR LBLFDA2 BSR GETFN ; Parse File Name JSR CREAD BNE LBLFDAC ; ?IO error JMP LBLFF4E ; Read cassette leader LBLFDAC LDAB #$22 ; ?IO error JMP ERROR ;CLOAD* CLOADV BSR CSAVEV LDAA #$04 ; array data BSR LBLFD8F LDD EAL ; end SUBD SAL ; start SUBD LAL ; LOAD address BHS LBLFDC5 JMP OMERR ; ?OM error LBLFDC5 LDX SAL LBLFDC8 STX CBUFAD ; cass buffer address BSR LBLFDD0 BPL LBLFDC8 CLORTS RTS LBLFDD0 JSR BLKIN ; disable blocklength limit, enable writing, read block->X LBLFDD3 BNE LBLFDAC ; ?IO error LDAA BLKTYP ; Cass block type flag BEQ LBLFDAC ; ?IO error RTS ;FDDB Set up for CSAVE* (Non-Canonical Label) CSAVEV @JSR_E CHRGET ; Skip CSAVE* Tokn ; JSR_E LDAB #$01 STAB SUBFLG ; Set Array Flag JSR PTRGET ; Get Pointer to Variable CLR SUBFLG ; Clear Array Flag JSR CHKNUM ; Parse Numeric Expression LDD 2,X ; JSR LBLE22D ; D+X->D,X STX EAL ; Store as End Address LDX TEMPADR LDAB 4,X ASLB ADDB #$05 ABX STX SAL ; Store as Save Addeess @JSR_E CHRGOT ; JSR_E BEQ CLORTS Return JMP CHKCOM ; Require Comma and Return ;$FE06 Load Machine Language Program from Cassette CLOADM @JSR_E CHRGET ; Get next input char ; JSR_E LDAA #$02 ; machine code BSR LBLFD8F LDX #$0000 @JSR_E CHRGOT ; BEQ LBLFE1B JSR CHKCOM ; get ',' JSR INTIDX ; get address offset to X LBLFE1B STX TEMPADR LDD XOFS ; EXEC address offset ADDD TEMPADR STD EXEADR ; default EXEC address LDD LAL ; LOAD address ADDD TEMPADR PSHB PSHA PULX BRA LBLFDC8 ; --- SKIPF command --- C_SKIPF: JSR LBLFDA2 BSR LBLFE8A BNE LBLFDD3 RTS ;$FE37 Read File from Cassette CREAD LDAA CURLIN INCA BNE LBLFE46 JSR CLRSCRN+1 ; Clear screen LDAA #'S' ; write 'S' to screen BSR LBLFE81 JSR LBLE7B9 LBLFE46 BSR LBLFEAA ORAA BLKTYP ; Cass block type flag BNE LBLFE80 CLRB PSHB LBLFE4F LDX #CASBUF ; tape filename block ABX LDAA 0,X LDX CURLIN INX BNE LBLFE5C BSR LBLFE81 LBLFE5C LDX #FNAME ; skip/load filename ABX SUBA 0,X TSX ORAA 0,X STAA 0,X INCB CMPB #$08 BNE LBLFE4F PULA TSTA BEQ LBLFE7B TST FNLEN BEQ LBLFE7B BSR LBLFE87 BNE LBLFE80 BRA CREAD LBLFE7B LDAA #$46 BSR LBLFEA1 CLRA LBLFE80 RTS LBLFE81 CLR CHANNEL ; turn off printer JMP OUTCH ; A->SCN LBLFE87 JSR LBLFF4E ; Read cassette leader LBLFE8A LDAA #$FF ; disable blocklength limit TAB ; disable writing (B=$FF) BSR BLKRD BNE LBLFE98 LDAA BLKTYP ; cass block type flag NEGA BMI LBLFE8A DECA LBLFE98 STAA LOADSTS ; cass load status flag RTS LBLFE9C LDAA SCREEN EORA #$40 LBLFEA1 LDAB CURLIN INCB BNE LBLFEA9 STAA SCREEN LBLFEA9 RTS LBLFEAA JSR LBLFF4E ; Read cassette leader LDX #CASBUF ; tape filename block STX CBUFAD ; cass buffer address LDAA #$0F ; 15 byte block length limit FCB $CB ; CPX # ;$FEB6 Load Block from Cassette BLKIN LDAA #$FF ; (disable blocklength limit) CLRB ; Enable Write to Memory (Load Block) ;$FEB9 Read Block from Cassette BLKRD PSHA ; Read cassette block STAB SKPFLG ; NOP SEI BSR LBLFE9C LDX CBUFAD ; cass buffer address CLRA LBLFEC5 BSR BITIN ; Read cassette bit RORA CMPA #$3C ; 00111100 BNE LBLFEC5 BSR CASIN ; Read cassette char STAA BLKTYP ; cass block type flag BSR CASIN ; Read cassette char STAA BLKLEN ; cass block length PULB CBA BHI LBLFF0B ADDA BLKTYP ; cass block type flag STAA CCKSUM ; cass sumcheck LDAA BLKLEN ; cass block length STAA LOADSTS ; cass load status flag BEQ LBLFF01 LBLFEE8 BSR CASIN ; Read cassette char TST SKPFLG BNE LBLFEF6 ; don't write if set STAA 0,X CMPA 0,X BNE LBLFF0E INX LBLFEF6 ADDA CCKSUM ; cass sumcheck STAA CCKSUM ; cass sumcheck DEC LOADSTS ; cass load status flag BNE LBLFEE8 LBLFF01 BSR CASIN ; Read cassette char SUBA CCKSUM ; cass sumcheck BEQ LBLFF10 LDAA #$01 ; #$01 - bad sumcheck FCB $CB ; CPX # LBLFF0B LDAA #$03 ; unexpected block length FCB $CB ; CPX # LBLFF0E LDAA #$02 ; store failed LBLFF10 STAA LOADSTS ; cass load status flag RTS ;$FF14 CASIN LDAA #$08 ; Read cassette char->A BTSIN STAA BITCNTR ; cass byte load bit counter BTCIN BSR BITIN ; read cassette bit RORA DEC BITCNTR ; cass byte load bit counter BNE BTCIN RTS ;$FF22 BITIN BSR LBLFF2C ; Read cassette bit->C LDAB DURCNTR ; tone duration counter DECB CMPB ram422C ; cassette 1200/2400Hz partition RTS LBLFF2C CLR DURCNTR ; tone duration counter TST ram427E ; cass polarity flag BNE LBLFF45 ; get 1->0 transition ; get 0->1 transition LBLFF34 BSR LBLFF3D ; Inc duration until 0 BNE LBLFF34 LBLFF38 BSR LBLFF3D ; Inc duration until 1 BEQ LBLFF38 RTS LBLFF3D INC DURCNTR ; tone duration counter LDAB PORT2 ANDB #$10 RTS ; get 1->0 transition LBLFF45 BSR LBLFF3D ; Inc duration until 1 BEQ LBLFF45 LBLFF49 BSR LBLFF3D ; Inc duration until 0 BNE LBLFF49 RTS LBLFF4E NOP ; Read cassette leader SEI CLR BITCNTR ; cass byte load bit counter LBLFF53 BSR LBLFF34 ; get 0->1 xsition LBLFF55 BSR LBLFF84 ; clear counter, count until 0, compare counter against limit BHI LBLFF6B LBLFF59 BSR LBLFF7D ; clear counter, count until 1, compare counter against limit BLO LBLFF6F DEC BITCNTR ; cass byte load bit counter LDAA BITCNTR ; cass byte load bit counter CMPA #$A0 LBLFF65 BNE LBLFF53 STAA ram427E ; cass polarity flag RTS LBLFF6B BSR LBLFF7D ; clear counter, count until 1, compare counter against limit BHI LBLFF55 LBLFF6F BSR LBLFF84 ; clear counter, count until 0, compare counter against limit BLO LBLFF59 INC BITCNTR ; cass byte load bit counter LDAA BITCNTR ; cass byte load bit counter SUBA #$60 BRA LBLFF65 LBLFF7D CLR DURCNTR ; tone duration counter BSR LBLFF38 ; incr duration until 1 BRA LBLFF89 LBLFF84 CLR DURCNTR ; tone duration counter BSR LBLFF49 ; incr duration until 0 LBLFF89 LDAB DURCNTR ; tone duration counter CMPB ram422D ; upper limit of 1200 Hz BHI LBLFF95 CMPB ram422E ; lower limit of 2400 Hz RTS LBLFF95 CLR BITCNTR ; cass byte load bit counter RTS LBLFF99 JSR CHKCOM ; get ',' LBLFF9C JSR LBLEF0D ; get num->B TSTB BNE LBLFFD1 JMP FCERR ; ?FC error if B=0 ; --- SOUND command --- C_SOUND: BSR LBLFF9C ; get num->B PSHB BSR LBLFF99 ; get ,num->B PULA LBLFFAB PSHA ; A=PITCH, B=DURATION PSHB CLRA LBLFFAE LDX COUNTER ; 4; read counter LDAB TIMER ; 3; read timer control and status reg [req'd to clear OCF flag] (ICF OCF TOF EICI EOCI ETOI IEDG OLVL) STX COMPARE ; 4; store counter to output compare register LBLFFB4 EORA #$80 ; 2; toggle speaker coil output STAA ioBFFF ; 4; TSX ; 3; LDAB 1,X ; 4; get pitch LBLFFBC INX ; 3; timewaste INX ; 3; timewaste INCB ; 2; BNE LBLFFBC ; 3; (11 cycles per loop) LDAB TIMER ; 3; ANDB #$40 ; 2; get output compare flag BEQ LBLFFB4 ; 3; toggle again if still clear... (freq = 1MHz/(11*(256-PITCH)+21)) TSX ; 4; DEC 0,X ; 6; dec duration (=DURATION * 65.56ms) BNE LBLFFAE ; 3; CLRA STAA ioBFFF PULX LBLFFD1 RTS FCB $6E,$69,$6C,$72,$65,$62,$6D,$61,$68,$43 ; nilrebmahC (spell it backwards) ; --- User ROM routines--- FDB SCANKBD ; Scan keyboard FDB OUTCH ; Write char to screen FDB LBLFF4E ; Read cassette leader FDB BLKRD ; Read cassette block FDB BLKOUT ; Write cassette block FDB LBLFFAB ; Sound FDB WRLDR ; Write cassette leader FDB LBLECE3 ; return D to TXTTAB FDB LBLEBC7 ; get result -> D FCB $00,$C9 ; 6803 vectors FDB $4200 ; SCI (TDRE + RDRF + ORFE) FDB $4203 ; TOF Timer overflow interrupt FDB $4206 ; OCF Output compare interrupt FDB $4209 ; ICF Input capture interrupt FDB $420C ; IRQ1 Maskable interrupt req 1. FDB $420F ; SWI Software interrupt FDB $4212 ; NMI Non-maskable interrupt FDB LBLF72E ; Reset ; { 0xE000, VECTOR }, ; { 0xE030, TABLE }, ; { 0xE045, TABLE_ASCII }, ; { 0xE148, VECTOR }, ; { 0xE18A, TABLE_ASCII }, ; { 0xE1C8, CODE }, ; { 0xE7C1, TABLE_ASCII }, ; { 0xE7C8, CODE }, ; { 0xE8AB, TABLE_ASCII }, ; { 0xE8BB, CODE }, ; { 0xE988, TABLE }, ; { 0xE98B, CODE }, ; { 0xF08B, TABLE }, ; { 0xF0B9, CODE }, ; { 0xF403, TABLE }, ; { 0xF412, CODE }, ; { 0xF524, TABLE }, ; { 0xF54D, CODE }, ; { 0xF59B, TABLE }, ; { 0xF5C9, CODE }, ; { 0xF682, TABLE_WORD }, ; { 0xF686, CODE }, ; { 0xF6F6, TABLE }, ; { 0xF72E, CODE }, ; { 0xF7F7, TABLE }, ; { 0xF810, TABLE_ASCII }, ; { 0xF83F, CODE }, ; { 0xF956, TABLE_ASCII }, ; { 0xF9C6, CODE }, ; { 0xFFD2, TABLE_ASCII }, ; { 0xFFDC, VECTOR }, ; { 0xFFEE, TABLE }, ; { 0xFFF0, TABLE_WORD }, ; { 0x10000, DISASM_END }, .end