Apple-2-SW/msbasic
1
0
Fork 0
mirror of https://github.com/mist64/msbasic.git synced 2024-12-21 01:30:42 +00:00
Code Issues Projects Releases Wiki Activity

all code broken up

Browse Source
This commit is contained in:
Michael Steil 2008-10-13 02:14:07 +00:00
parent 76875ac392
commit babaa8be94
9 changed files with 1916 additions and 2028 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

580
flow.s Normal file
View File

@ -0,0 +1,580 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "FOR" STATEMENT
;
; FOR PUSHES 18 BYTES ON 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)
; ----------------------------------------------------------------------------
FOR:
lda #$80
sta SUBFLG
jsr LET
jsr GTFORPNT
bne L2619
txa
adc #FOR_STACK1
tax
txs
L2619:
pla
pla
lda #FOR_STACK2
jsr CHKMEM
jsr DATAN
clc
tya
adc TXTPTR
pha
lda TXTPTR+1
adc #$00
pha
lda CURLIN+1
pha
lda CURLIN
pha
lda #TOKEN_TO
jsr SYNCHR
jsr CHKNUM
jsr FRMNUM
lda FACSIGN
ora #$7F
and FAC+1
sta FAC+1
lda #<STEP
ldy #>STEP
sta INDEX
sty INDEX+1
jmp FRM_STACK3
; ----------------------------------------------------------------------------
; "STEP" PHRASE OF "FOR" STATEMENT
; ----------------------------------------------------------------------------
STEP:
lda #<CON_ONE
ldy #>CON_ONE
jsr LOAD_FAC_FROM_YA
jsr CHRGOT
cmp #TOKEN_STEP
bne L2665
jsr CHRGET
jsr FRMNUM
L2665:
jsr SIGN
jsr FRM_STACK2
lda FORPNT+1
pha
lda FORPNT
pha
lda #$81
pha
; ----------------------------------------------------------------------------
; PERFORM NEXT STATEMENT
; ----------------------------------------------------------------------------
NEWSTT:
jsr ISCNTC
lda TXTPTR
ldy TXTPTR+1
.ifdef CBM2_KBD
cpy #>INPUTBUFFER
.endif
.ifdef CBM2
nop
.endif
.ifdef CBM2_KBD
beq LC6D4
.else
beq L2683
.endif
sta OLDTEXT
sty OLDTEXT+1
LC6D4:
ldy #$00
L2683:
lda (TXTPTR),y
.ifndef CONFIG_11
beq LA5DC
cmp #$3A
beq NEWSTT2
SYNERR1:
jmp SYNERR
LA5DC:
.else
bne COLON
.endif
ldy #$02
lda (TXTPTR),y
clc
.ifdef CBM2_KBD
jeq L2701
.else
beq L2701
.endif
iny
lda (TXTPTR),y
sta CURLIN
iny
lda (TXTPTR),y
sta CURLIN+1
tya
adc TXTPTR
sta TXTPTR
bcc NEWSTT2
inc TXTPTR+1
NEWSTT2:
jsr CHRGET
jsr EXECUTE_STATEMENT
jmp NEWSTT
; ----------------------------------------------------------------------------
; EXECUTE A STATEMENT
;
; (A) IS FIRST CHAR OF STATEMENT
; CARRY IS SET
; ----------------------------------------------------------------------------
EXECUTE_STATEMENT:
.ifndef CONFIG_11_NOAPPLE
beq RET1
.ifndef APPLE
sec
.endif
.else
beq RET2
.endif
EXECUTE_STATEMENT1:
sbc #$80
.ifndef CONFIG_11
jcc LET
.else
bcc LET1
.endif
cmp #NUM_TOKENS
.ifdef CBM2_KBD
bcs LC721
.else
bcs SYNERR1
.endif
asl a
tay
lda TOKEN_ADDRESS_TABLE+1,y
pha
lda TOKEN_ADDRESS_TABLE,y
pha
jmp CHRGET
.ifdef CONFIG_11
LET1:
jmp LET
COLON:
cmp #$3A
beq NEWSTT2
SYNERR1:
jmp SYNERR
.endif
.ifdef CBM2_KBD
LC721:
.ifdef KBD
cmp #$45
.else
cmp #$4B
.endif
bne SYNERR1
jsr CHRGET
lda #TOKEN_TO
jsr SYNCHR
jmp GOTO
.endif
; ----------------------------------------------------------------------------
; "RESTORE" STATEMENT
; ----------------------------------------------------------------------------
RESTORE:
sec
lda TXTTAB
sbc #$01
ldy TXTTAB+1
bcs SETDA
dey
SETDA:
sta DATPTR
sty DATPTR+1
RET2:
rts
.ifndef CONFIG_CBM_ALL
; ----------------------------------------------------------------------------
; SEE IF CONTROL-C TYPED
; ----------------------------------------------------------------------------
ISCNTC:
.endif
.ifdef KBD
jsr LE8F3
bcc RET1
LE633:
jsr LDE7F
beq STOP
cmp #$03
bne LE633
.endif
.ifdef OSI
jmp MONISCNTC
nop
nop
nop
nop
lsr a
bcc RET2
jsr GETLN
cmp #$03
.endif
.ifdef APPLE
lda $C000
cmp #$83
beq L0ECC
rts
L0ECC:
jsr RDKEY
cmp #$03
.endif
.ifdef KIM
lda #$01
bit $1740
bmi RET2
ldx #$08
lda #$03
clc
cmp #$03
.endif
; ----------------------------------------------------------------------------
; "STOP" STATEMENT
; ----------------------------------------------------------------------------
STOP:
bcs END2
; ----------------------------------------------------------------------------
; "END" STATEMENT
; ----------------------------------------------------------------------------
END:
clc
END2:
bne RET1
lda TXTPTR
ldy TXTPTR+1
.ifdef CBM2_KBD
ldx CURLIN+1
inx
.endif
beq END4
sta OLDTEXT
sty OLDTEXT+1
CONTROL_C_TYPED:
lda CURLIN
ldy CURLIN+1
sta OLDLIN
sty OLDLIN+1
END4:
pla
pla
L2701:
lda #<QT_BREAK
ldy #>QT_BREAK
.ifndef KBD
ldx #$00
stx Z14
.endif
bcc L270E
jmp PRINT_ERROR_LINNUM
L270E:
jmp RESTART
.ifdef KBD
LE664:
tay
jmp SNGFLT
.endif
; ----------------------------------------------------------------------------
; "CONT" COMMAND
; ----------------------------------------------------------------------------
CONT:
bne RET1
ldx #ERR_CANTCONT
ldy OLDTEXT+1
bne L271C
jmp ERROR
L271C:
lda OLDTEXT
sta TXTPTR
sty TXTPTR+1
lda OLDLIN
ldy OLDLIN+1
sta CURLIN
sty CURLIN+1
RET1:
rts
.ifdef KBD
PRT:
jsr GETBYT
txa
ror a
ror a
ror a
sta $8F
rts
LE68C:
ldy #$12
LE68E:
lda LEA30,y
sta $03A2,y
dey
bpl LE68E
rts
.endif
.if .def(CONFIG_NULL) || .def(CBM1)
; CBM1 has the keyword removed,
; but the code is, still here
NULL:
jsr GETBYT
bne RET1
inx
cpx #NULL_MAX
bcs L2739
dex
stx Z15
rts
L2739:
jmp IQERR
.endif
.ifndef CONFIG_11_NOAPPLE
CLEAR:
bne RET1
jmp CLEARC
.endif
.ifdef APPLE
.include "apple_loadsave.s"
.endif
.ifdef KIM
.include "kim_loadsave.s"
.endif
; ----------------------------------------------------------------------------
; "RUN" COMMAND
; ----------------------------------------------------------------------------
RUN:
bne L27CF
jmp SETPTRS
L27CF:
jsr CLEARC
jmp L27E9
; ----------------------------------------------------------------------------
; "GOSUB" STATEMENT
;
; LEAVES 7 BYTES ON STACK:
; 2 -- RETURN ADDRESS (NEWSTT)
; 2 -- TXTPTR
; 2 -- LINE #
; 1 -- GOSUB TOKEN
; ----------------------------------------------------------------------------
GOSUB:
lda #$03
jsr CHKMEM
lda TXTPTR+1
pha
lda TXTPTR
pha
lda CURLIN+1
pha
lda CURLIN
pha
lda #TOKEN_GOSUB
pha
L27E9:
jsr CHRGOT
jsr GOTO
jmp NEWSTT
; ----------------------------------------------------------------------------
; "GOTO" STATEMENT
; ALSO USED BY "RUN" AND "GOSUB"
; ----------------------------------------------------------------------------
GOTO:
jsr LINGET
jsr REMN
lda CURLIN+1
cmp LINNUM+1
bcs L2809
tya
sec
adc TXTPTR
ldx TXTPTR+1
bcc L280D
inx
bcs L280D
L2809:
lda TXTTAB
ldx TXTTAB+1
L280D:
.ifdef KBD
jsr LF457
bne UNDERR
.else
jsr FL1
bcc UNDERR
.endif
lda LOWTRX
sbc #$01
sta TXTPTR
lda LOWTRX+1
sbc #$00
sta TXTPTR+1
L281E:
rts
; ----------------------------------------------------------------------------
; "POP" AND "RETURN" STATEMENTS
; ----------------------------------------------------------------------------
POP:
bne L281E
lda #$FF
.ifdef CBM2_KBD
sta FORPNT+1 ; bugfix, wrong in AppleSoft
.else
sta FORPNT
.endif
jsr GTFORPNT
txs
cmp #TOKEN_GOSUB
beq RETURN
ldx #ERR_NOGOSUB
.byte $2C
UNDERR:
ldx #ERR_UNDEFSTAT
jmp ERROR
; ----------------------------------------------------------------------------
SYNERR2:
jmp SYNERR
; ----------------------------------------------------------------------------
RETURN:
pla
pla
sta CURLIN
pla
sta CURLIN+1
pla
sta TXTPTR
pla
sta TXTPTR+1
; ----------------------------------------------------------------------------
; "DATA" STATEMENT
; EXECUTED BY SKIPPING TO NEXT COLON OR EOL
; ----------------------------------------------------------------------------
DATA:
jsr DATAN
; ----------------------------------------------------------------------------
; ADD (Y) TO TXTPTR
; ----------------------------------------------------------------------------
ADDON:
tya
clc
adc TXTPTR
sta TXTPTR
bcc L2852
inc TXTPTR+1
L2852:
rts
; ----------------------------------------------------------------------------
; SCAN AHEAD TO NEXT ":" OR EOL
; ----------------------------------------------------------------------------
DATAN:
ldx #$3A
.byte $2C
REMN:
ldx #$00
stx CHARAC
ldy #$00
sty ENDCHR
L285E:
lda ENDCHR
ldx CHARAC
sta CHARAC
stx ENDCHR
L2866:
lda (TXTPTR),y
beq L2852
cmp ENDCHR
beq L2852
iny
cmp #$22
.ifndef CONFIG_11
beq L285E
bne L2866
.else
bne L2866
beq L285E
.endif
; ----------------------------------------------------------------------------
; "IF" STATEMENT
; ----------------------------------------------------------------------------
IF:
jsr FRMEVL
jsr CHRGOT
cmp #TOKEN_GOTO
beq L2884
lda #TOKEN_THEN
jsr SYNCHR
L2884:
lda FAC
bne L288D
; ----------------------------------------------------------------------------
; "REM" STATEMENT, OR FALSE "IF" STATEMENT
; ----------------------------------------------------------------------------
REM:
jsr REMN
beq ADDON
L288D:
jsr CHRGOT
bcs L2895
jmp GOTO
L2895:
jmp EXECUTE_STATEMENT
; ----------------------------------------------------------------------------
; "ON" STATEMENT
;
; ON <EXP> GOTO <LIST>
; ON <EXP> GOSUB <LIST>
; ----------------------------------------------------------------------------
ON:
jsr GETBYT
pha
cmp #TOKEN_GOSUB
beq L28A4
L28A0:
cmp #TOKEN_GOTO
bne SYNERR2
L28A4:
dec FAC_LAST
bne L28AC
pla
jmp EXECUTE_STATEMENT1
L28AC:
jsr CHRGET
jsr LINGET
cmp #$2C
beq L28A4
pla
L28B7:
rts

352
memory.s
View File

@ -1,242 +1,150 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "DIM" STATEMENT
; ----------------------------------------------------------------------------
NXDIM:
jsr CHKCOM
DIM:
tax
jsr PTRGET2
jsr CHRGOT
bne NXDIM
rts
; ----------------------------------------------------------------------------
; PTRGET -- GENERAL VARIABLE SCAN
; CALLED BY "NEXT" AND "FOR" TO SCAN THROUGH
; THE STACK FOR A FRAME WITH THE SAME VARIABLE.
;
; SCANS VARIABLE NAME AT TXTPTR, AND SEARCHES THE
; VARTAB AND ARYTAB FOR THE NAME.
; IF NOT FOUND, CREATE VARIABLE OF APPROPRIATE TYPE.
; RETURN WITH ADDRESS IN VARPNT AND Y,A
; (FORPNT) = ADDRESS OF VARIABLE IF "FOR" OR "NEXT"
; = $XXFF IF CALLED FROM "RETURN"
; <<< BUG: SHOULD BE $FFXX >>>
;
; ACTUAL ACTIVITY CONTROLLED SOMEWHAT BY TWO FLAGS:
; DIMFLG -- NONZERO IF CALLED FROM "DIM"
; ELSE = 0
; RETURNS .NE. IF VARIABLE NOT FOUND,
; (X) = STACK PNTR AFTER SKIPPING ALL FRAMES
;
; SUBFLG -- = $00
; = $40 IF CALLED FROM "GETARYPT"
; .EQ. IF FOUND
; (X) = STACK PNTR OF FRAME FOUND
; ----------------------------------------------------------------------------
PTRGET:
ldx #$00
jsr CHRGOT
PTRGET2:
stx DIMFLG
PTRGET3:
sta VARNAM
jsr CHRGOT
jsr ISLETC
bcs NAMOK
SYNERR3:
jmp SYNERR
NAMOK:
ldx #$00
stx VALTYP
.ifndef CONFIG_SMALL
stx VALTYP+1
.endif
jsr CHRGET
bcc L2ECD
jsr ISLETC
bcc L2ED8
L2ECD:
tax
L2ECE:
jsr CHRGET
bcc L2ECE
jsr ISLETC
bcs L2ECE
L2ED8:
cmp #$24
.ifdef CONFIG_SMALL
bne L2EF9
.else
bne L2EE2
.endif
lda #$FF
sta VALTYP
.ifndef CONFIG_SMALL
bne L2EF2
L2EE2:
cmp #$25
bne L2EF9
lda SUBFLG
bne SYNERR3
lda #$80
sta VALTYP+1
ora VARNAM
sta VARNAM
L2EF2:
.endif
txa
ora #$80
tax
jsr CHRGET
L2EF9:
stx VARNAM+1
sec
ora SUBFLG
sbc #$28
bne L2F05
jmp ARRAY
L2F05:
lda #$00
sta SUBFLG
lda VARTAB
ldx VARTAB+1
ldy #$00
L2F0F:
stx LOWTR+1
L2F11:
sta LOWTR
cpx ARYTAB+1
bne L2F1B
cmp ARYTAB
beq NAMENOTFOUND
L2F1B:
lda VARNAM
cmp (LOWTR),y
bne L2F29
lda VARNAM+1
iny
cmp (LOWTR),y
beq SET_VARPNT_AND_YA
dey
L2F29:
clc
lda LOWTR
adc #BYTES_PER_VARIABLE
bcc L2F11
inx
bne L2F0F
; ----------------------------------------------------------------------------
; CHECK IF (A) IS ASCII LETTER A-Z
;
; RETURN CARRY = 1 IF A-Z
; = 0 IF NOT
; ----------------------------------------------------------------------------
ISLETC:
cmp #$41
bcc L2F3C
sbc #$5B
sec
sbc #$A5
L2F3C:
rts
; ----------------------------------------------------------------------------
; VARIABLE NOT FOUND, SO MAKE ONE
; ----------------------------------------------------------------------------
NAMENOTFOUND:
pla
pha
cmp #<FRM_VARIABLE_CALL
bne MAKENEWVARIABLE
.ifdef CONFIG_SAFE_NAMENOTFOUND
GTFORPNT:
tsx
inx
inx
inx
inx
L2279:
lda STACK+1,x
cmp #$81
bne L22A1
lda FORPNT+1
bne L228E
lda STACK+2,x
cmp #>FRM_VARIABLE_CALL
bne MAKENEWVARIABLE
.endif
LD015:
lda #<C_ZERO
ldy #>C_ZERO
sta FORPNT
lda STACK+3,x
sta FORPNT+1
L228E:
cmp STACK+3,x
bne L229A
lda FORPNT
cmp STACK+2,x
beq L22A1
L229A:
txa
clc
adc #BYTES_PER_FRAME
tax
bne L2279
L22A1:
rts
; ----------------------------------------------------------------------------
.ifndef CBM2_KBD
C_ZERO:
.byte $00,$00
.endif
; ----------------------------------------------------------------------------
; MAKE A NEW SIMPLE VARIABLE
; MOVE BLOCK OF MEMORY UP
;
; MOVE ARRAYS UP 7 BYTES TO MAKE ROOM FOR NEW VARIABLE
; ENTER 7-BYTE VARIABLE DATA IN THE HOLE
; ON ENTRY:
; (Y,A) = (HIGHDS) = DESTINATION END+1
; (LOWTR) = LOWEST ADDRESS OF SOURCE
; (HIGHTR) = HIGHEST SOURCE ADDRESS+1
; ----------------------------------------------------------------------------
MAKENEWVARIABLE:
.ifdef CONFIG_CBM_ALL
lda VARNAM
ldy VARNAM+1
cmp #$54
bne LD02F
cpy #$C9
beq LD015
cpy #$49
bne LD02F
LD02C:
jmp SYNERR
LD02F:
cmp #$53
bne LD037
cpy #$54
beq LD02C
LD037:
.endif
lda ARYTAB
ldy ARYTAB+1
sta LOWTR
sty LOWTR+1
lda STREND
ldy STREND+1
BLTU:
jsr REASON
sta STREND
sty STREND+1
BLTU2:
sec
lda HIGHTR
sbc LOWTR
sta INDEX
tay
lda HIGHTR+1
sbc LOWTR+1
tax
inx
tya
beq L22DD
lda HIGHTR
sec
sbc INDEX
sta HIGHTR
sty HIGHTR+1
clc
adc #BYTES_PER_VARIABLE
bcc L2F68
iny
L2F68:
sta HIGHDS
sty HIGHDS+1
jsr BLTU
bcs L22C6
dec HIGHTR+1
sec
L22C6:
lda HIGHDS
ldy HIGHDS+1
iny
sta ARYTAB
sty ARYTAB+1
ldy #$00
lda VARNAM
sta (LOWTR),y
iny
lda VARNAM+1
sta (LOWTR),y
lda #$00
iny
sta (LOWTR),y
iny
sta (LOWTR),y
iny
sta (LOWTR),y
iny
sta (LOWTR),y
.ifndef CONFIG_SMALL
iny
sta (LOWTR),y
.endif
sbc INDEX
sta HIGHDS
bcs L22D6
dec HIGHDS+1
bcc L22D6
L22D2:
lda (HIGHTR),y
sta (HIGHDS),y
L22D6:
dey
bne L22D2
lda (HIGHTR),y
sta (HIGHDS),y
L22DD:
dec HIGHTR+1
dec HIGHDS+1
dex
bne L22D6
rts
; ----------------------------------------------------------------------------
; PUT ADDRESS OF VALUE OF VARIABLE IN VARPNT AND Y,A
; CHECK IF ENOUGH ROOM LEFT ON STACK
; FOR "FOR", "GOSUB", OR EXPRESSION EVALUATION
; ----------------------------------------------------------------------------
SET_VARPNT_AND_YA:
lda LOWTR
clc
adc #$02
ldy LOWTR+1
bcc L2F9E
iny
L2F9E:
sta VARPNT
sty VARPNT+1
CHKMEM:
asl a
adc #SPACE_FOR_GOSUB
bcs MEMERR
sta INDEX
tsx
cpx INDEX
bcc MEMERR
rts
; ----------------------------------------------------------------------------
; CHECK IF ENOUGH ROOM BETWEEN ARRAYS AND STRINGS
; (Y,A) = ADDR ARRAYS NEED TO GROW TO
; ----------------------------------------------------------------------------
REASON:
cpy FRETOP+1
bcc L231E
bne L22FC
cmp FRETOP
bcc L231E
L22FC:
pha
ldx #FAC-TEMP1-1
tya
L2300:
pha
lda TEMP1,x
dex
bpl L2300
jsr GARBAG
ldx #TEMP1-FAC+1
L230B:
pla
sta FAC,x
inx
bmi L230B
pla
tay
pla
cpy FRETOP+1
bcc L231E
bne MEMERR
cmp FRETOP
bcs MEMERR
L231E:
rts

229
misc1.s Normal file
View File

@ -0,0 +1,229 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; CONVERT LINE NUMBER
; ----------------------------------------------------------------------------
LINGET:
ldx #$00
stx LINNUM
stx LINNUM+1
L28BE:
bcs L28B7
sbc #$2F
sta CHARAC
lda LINNUM+1
sta INDEX
cmp #$19
bcs L28A0
; <<<<<DANGEROUS CODE>>>>>
; NOTE THAT IF (A) = $AB ON THE LINE ABOVE,
; ON.1 WILL COMPARE = AND CAUSE A CATASTROPHIC
; JUMP TO $22D9 (FOR GOTO), OR OTHER LOCATIONS
; FOR OTHER CALLS TO LINGET.
;
; YOU CAN SEE THIS IS YOU FIRST PUT "BRK" IN $22D9,
; THEN TYPE "GO TO 437761".
;
; ANY VALUE FROM 437760 THROUGH 440319 WILL CAUSE
; THE PROBLEM. ($AB00 - $ABFF)
; <<<<<DANGEROUS CODE>>>>>
lda LINNUM
asl a
rol INDEX
asl a
rol INDEX
adc LINNUM
sta LINNUM
lda INDEX
adc LINNUM+1
sta LINNUM+1
asl LINNUM
rol LINNUM+1
lda LINNUM
adc CHARAC
sta LINNUM
bcc L28EC
inc LINNUM+1
L28EC:
jsr CHRGET
jmp L28BE
; ----------------------------------------------------------------------------
; "LET" STATEMENT
;
; LET <VAR> = <EXP>
; <VAR> = <EXP>
; ----------------------------------------------------------------------------
LET:
jsr PTRGET
sta FORPNT
sty FORPNT+1
lda #TOKEN_EQUAL
jsr SYNCHR
.ifndef CONFIG_SMALL
lda VALTYP+1
pha
.endif
lda VALTYP
pha
jsr FRMEVL
pla
rol a
jsr CHKVAL
bne LETSTRING
.ifndef CONFIG_SMALL
pla
LET2:
bpl L2923
jsr ROUND_FAC
jsr AYINT
ldy #$00
lda FAC+3
sta (FORPNT),y
iny
lda FAC+4
sta (FORPNT),y
rts
L2923:
.endif
; ----------------------------------------------------------------------------
; REAL VARIABLE = EXPRESSION
; ----------------------------------------------------------------------------
jmp SETFOR
LETSTRING:
.ifndef CONFIG_SMALL
pla
; ----------------------------------------------------------------------------
; INSTALL STRING, DESCRIPTOR ADDRESS IS AT FAC+3,4
; ----------------------------------------------------------------------------
PUTSTR:
.endif
.ifdef CONFIG_CBM_ALL
ldy FORPNT+1
.ifdef CBM1
cpy #$D0
.else
cpy #$DE
.endif
bne LC92B
jsr FREFAC
cmp #$06
.ifdef CBM2_KBD
bne IQERR1
.else
beq LC8E2
jmp IQERR
LC8E2:
.endif
ldy #$00
sty FAC
sty FACSIGN
LC8E8:
sty STRNG2
jsr LC91C
jsr MUL10
inc STRNG2
ldy STRNG2
jsr LC91C
jsr COPY_FAC_TO_ARG_ROUNDED
tax
beq LC902
inx
txa
jsr LD9BF
LC902:
ldy STRNG2
iny
cpy #$06
bne LC8E8
jsr MUL10
jsr QINT
ldx #$02
sei
LC912:
lda FAC+2,x
.ifdef CBM2
sta $8D,x
.else
sta $0200,x
.endif
dex
bpl LC912
cli
rts
LC91C:
lda (INDEX),y
jsr L00CF
bcc LC926
IQERR1:
jmp IQERR
LC926:
sbc #$2F
jmp ADDACC
LC92B:
.endif
ldy #$02
lda (FAC_LAST-1),y
cmp FRETOP+1
bcc L2946
bne L2938
dey
lda (FAC_LAST-1),y
cmp FRETOP
bcc L2946
L2938:
ldy FAC_LAST
cpy VARTAB+1
bcc L2946
bne L294D
lda FAC_LAST-1
cmp VARTAB
bcs L294D
L2946:
lda FAC_LAST-1
ldy FAC_LAST
jmp L2963
L294D:
ldy #$00
lda (FAC_LAST-1),y
jsr STRINI
lda DSCPTR
ldy DSCPTR+1
sta STRNG1
sty STRNG1+1
jsr MOVINS
lda #FAC
ldy #$00
L2963:
sta DSCPTR
sty DSCPTR+1
jsr FRETMS
ldy #$00
lda (DSCPTR),y
sta (FORPNT),y
iny
lda (DSCPTR),y
sta (FORPNT),y
iny
lda (DSCPTR),y
sta (FORPNT),y
rts
.ifdef CONFIG_CBM_ALL
PRINTH:
jsr CMD
jmp LCAD6
CMD:
jsr GETBYT
beq LC98F
lda #$2C
jsr SYNCHR
LC98F:
php
jsr CHKOUT
stx Z03
plp
jmp PRINT
.endif

174
misc2.s Normal file
View File

@ -0,0 +1,174 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "FRE" FUNCTION
;
; COLLECTS GARBAGE AND RETURNS # BYTES OF MEMORY LEFT
; ----------------------------------------------------------------------------
FRE:
lda VALTYP
beq L3188
jsr FREFAC
L3188:
jsr GARBAG
sec
lda FRETOP
sbc STREND
tay
lda FRETOP+1
sbc STREND+1
; FALL INTO GIVAYF TO FLOAT THE VALUE
; NOTE THAT VALUES OVER 32767 WILL RETURN AS NEGATIVE
; ----------------------------------------------------------------------------
; FLOAT THE SIGNED INTEGER IN A,Y
; ----------------------------------------------------------------------------
GIVAYF:
ldx #$00
stx VALTYP
sta FAC+1
sty FAC+2
ldx #$90
jmp FLOAT1
POS:
ldy Z16
; ----------------------------------------------------------------------------
; FLOAT (Y) INTO FAC, GIVING VALUE 0-255
; ----------------------------------------------------------------------------
SNGFLT:
lda #$00
beq GIVAYF
; ----------------------------------------------------------------------------
; CHECK FOR DIRECT OR RUNNING MODE
; GIVING ERROR IF DIRECT MODE
; ----------------------------------------------------------------------------
ERRDIR:
ldx CURLIN+1
inx
bne RTS9
ldx #ERR_ILLDIR
.ifdef CBM2_KBD
.byte $2C
LD288:
ldx #ERR_UNDEFFN
.endif
L31AF:
jmp ERROR
DEF:
jsr FNC
jsr ERRDIR
jsr CHKOPN
lda #$80
sta SUBFLG
jsr PTRGET
jsr CHKNUM
jsr CHKCLS
lda #TOKEN_EQUAL
jsr SYNCHR
.ifndef CONFIG_SMALL
pha
.endif
lda VARPNT+1
pha
lda VARPNT
pha
lda TXTPTR+1
pha
lda TXTPTR
pha
jsr DATA
jmp L3250
FNC:
lda #TOKEN_FN
jsr SYNCHR
ora #$80
sta SUBFLG
jsr PTRGET3
sta FNCNAM
sty FNCNAM+1
jmp CHKNUM
L31F3:
jsr FNC
lda FNCNAM+1
pha
lda FNCNAM
pha
jsr PARCHK
jsr CHKNUM
pla
sta FNCNAM
pla
sta FNCNAM+1
ldy #$02
.ifndef CBM2_KBD
ldx #ERR_UNDEFFN
.endif
lda (FNCNAM),y
.ifndef CBM2_KBD
beq L31AF
.endif
sta VARPNT
tax
iny
lda (FNCNAM),y
.ifdef CBM2_KBD
beq LD288
.endif
sta VARPNT+1
.ifndef CONFIG_SMALL
iny
.endif
L3219:
lda (VARPNT),y
pha
dey
bpl L3219
ldy VARPNT+1
jsr STORE_FAC_AT_YX_ROUNDED
lda TXTPTR+1
pha
lda TXTPTR
pha
lda (FNCNAM),y
sta TXTPTR
iny
lda (FNCNAM),y
sta TXTPTR+1
lda VARPNT+1
pha
lda VARPNT
pha
jsr FRMNUM
pla
sta FNCNAM
pla
sta FNCNAM+1
jsr CHRGOT
beq L324A
jmp SYNERR
L324A:
pla
sta TXTPTR
pla
sta TXTPTR+1
L3250:
ldy #$00
pla
sta (FNCNAM),y
pla
iny
sta (FNCNAM),y
pla
iny
sta (FNCNAM),y
pla
iny
sta (FNCNAM),y
.ifndef CONFIG_SMALL
pla
iny
sta (FNCNAM),y
.endif
rts

108
misc3.s Normal file
View File

@ -0,0 +1,108 @@
.segment "CODE"
.ifdef KBD
LF422:
lda VARTAB
sec
sbc #$02
ldy VARTAB+1
bcs LF42C
dey
LF42C:
rts
LF42D:
lda Z00,x
LF430:
cmp #$61
bcc LF43A
cmp #$7B
bcs LF43A
LF438:
sbc #$1F
LF43A:
rts
LF43B:
ldx #$5D
LF43D:
txa
and #$7F
cmp $0340
beq LF44D
sta $0340
lda #$03
jsr LDE48
LF44D:
jsr LDE7F
bne RTS4
cpx #$80
bcc LF44D
RTS4:
rts
LF457:
lda TXTTAB
ldx TXTTAB+1
LF45B:
sta JMPADRS+1
stx JMPADRS+2
ldy #$01
lda (JMPADRS+1),y
beq LF438
iny
iny
lda (JMPADRS+1),y
dey
cmp $14
bne LF472
lda (JMPADRS+1),y
cmp $13
LF472:
bcs LF43A
dey
lda (JMPADRS+1),y
tax
dey
lda (JMPADRS+1),y
bcc LF45B
LF47D:
jmp (JMPADRS+1)
.else
; ----------------------------------------------------------------------------
; EVALUATE "EXP1,EXP2"
;
; CONVERT EXP1 TO 16-BIT NUMBER IN LINNUM
; CONVERT EXP2 TO 8-BIT NUMBER IN X-REG
; ----------------------------------------------------------------------------
GTNUM:
jsr FRMNUM
jsr GETADR
; ----------------------------------------------------------------------------
; EVALUATE ",EXPRESSION"
; CONVERT EXPRESSION TO SINGLE BYTE IN X-REG
; ----------------------------------------------------------------------------
COMBYTE:
jsr CHKCOM
jmp GETBYT
; ----------------------------------------------------------------------------
; CONVERT (FAC) TO A 16-BIT VALUE IN LINNUM
; ----------------------------------------------------------------------------
GETADR:
lda FACSIGN
.ifdef APPLE
nop
nop
.else
bmi GOIQ
.endif
lda FAC
cmp #$91
bcs GOIQ
jsr QINT
lda FAC_LAST-1
ldy FAC_LAST
sty LINNUM
sta LINNUM+1
rts
.endif

1815
msbasic.s
View File

File diff suppressed because it is too large Load Diff

76
poke.s Normal file
View File

@ -0,0 +1,76 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "PEEK" FUNCTION
; ----------------------------------------------------------------------------
PEEK:
.ifdef CBM2_KBD
lda $12
pha
lda $11
pha
.endif
jsr GETADR
ldy #$00
.ifdef CBM1
cmp #$C0
bcc LD6F3
cmp #$E1
bcc LD6F6
LD6F3:
.endif
.ifdef CBM2_KBD
nop ; patch that disables the compares above
nop
nop
nop
nop
nop
nop
nop
.endif
lda (LINNUM),y
tay
.ifdef CBM2_KBD
pla
sta $11
pla
sta $12
.endif
LD6F6:
jmp SNGFLT
; ----------------------------------------------------------------------------
; "POKE" STATEMENT
; ----------------------------------------------------------------------------
POKE:
jsr GTNUM
txa
ldy #$00
sta (LINNUM),y
rts
; ----------------------------------------------------------------------------
; "WAIT" STATEMENT
; ----------------------------------------------------------------------------
WAIT:
jsr GTNUM
stx FORPNT
ldx #$00
jsr CHRGOT
.ifdef CBM2
beq EASTER_EGG
.else
beq L3628
.endif
jsr COMBYTE
L3628:
stx FORPNT+1
ldy #$00
L362C:
lda (LINNUM),y
eor FORPNT+1
and FORPNT
beq L362C
RTS3:
rts

368
print.s Normal file
View File

@ -0,0 +1,368 @@
.segment "CODE"
PRSTRING:
jsr STRPRT
L297E:
jsr CHRGOT
; ----------------------------------------------------------------------------
; "PRINT" STATEMENT
; ----------------------------------------------------------------------------
PRINT:
beq CRDO
PRINT2:
beq L29DD
cmp #TOKEN_TAB
beq L29F5
cmp #TOKEN_SPC
.ifdef CBM2_KBD
clc
.endif
beq L29F5
cmp #','
.ifdef KIM
clc
.endif
beq L29DE
cmp #$3B
beq L2A0D
jsr FRMEVL
bit VALTYP
bmi PRSTRING
jsr FOUT
jsr STRLIT
.ifndef CONFIG_CBM_ALL
ldy #$00
lda (FAC_LAST-1),y
clc
adc Z16
.ifdef KBD
cmp #$28
.else
cmp Z17
.endif
bcc L29B1
jsr CRDO
L29B1:
.endif
jsr STRPRT
.ifdef KBD
jmp L297E
LE86C:
pla
jmp CONTROL_C_TYPED
LE870:
jsr GETBYT
txa
LE874:
beq LE878
bpl LE8F2
LE878:
jmp IQERR
CRDO:
lda #$0A
sta $10
jsr OUTDO
LE882:
lda #$0D
jsr OUTDO
PRINTNULLS:
lda #$00
sta $10
eor #$FF
.else
jsr OUTSP
bne L297E
L29B9:
.ifdef CBM2
lda #$00
sta INPUTBUFFER,x
ldx #<(INPUTBUFFER-1)
ldy #>(INPUTBUFFER-1)
.else
.ifndef APPLE
ldy #$00
sty INPUTBUFFER,x
ldx #LINNUM+1
.endif
.endif
.ifdef CONFIG_CBM_ALL
lda Z03
bne L29DD
LC9D2:
.endif
CRDO:
.ifdef CBM1
lda Z03
bne LC9D8
sta $05
LC9D8:
.endif
lda #$0D
.ifndef CONFIG_CBM_ALL
sta Z16
.endif
jsr OUTDO
.ifdef APPLE
lda #$80
.else
lda #$0A
.endif
jsr OUTDO
PRINTNULLS:
.ifdef CBM1
lda Z03
bne L29DD
.endif
.if .def(CONFIG_NULL) || .def(CBM1)
txa
pha
ldx Z15
beq L29D9
lda #$00
L29D3:
jsr OUTDO
dex
bne L29D3
L29D9:
stx Z16
pla
tax
.else
.ifdef APPLE
lda #$00
sta $50
.endif
eor #$FF
.endif
.endif
L29DD:
rts
L29DE:
lda Z16
.ifndef CONFIG_CBM_ALL
.ifdef KBD
cmp #$1A
.else
cmp Z18
.endif
bcc L29EA
jsr CRDO
jmp L2A0D
L29EA:
.endif
sec
L29EB:
.ifdef CONFIG_CBM_ALL
sbc #$0A
.else
.ifdef KBD
sbc #$0D
.else
sbc #$0E
.endif
.endif
bcs L29EB
eor #$FF
adc #$01
bne L2A08
L29F5:
.ifdef CONFIG_11_NOAPPLE
php
.else
pha
.endif
jsr GTBYTC
cmp #$29
.ifndef CONFIG_11_NOAPPLE
.ifdef APPLE
beq L1185
jmp SYNERR
L1185:
.else
bne SYNERR4
.endif
pla
cmp #TOKEN_TAB
.ifdef APPLE
bne L2A09
.else
bne L2A0A
.endif
.else
.ifdef CBM2_KBD
bne SYNERR4
.else
beq @1
jmp SYNERR
@1:
.endif
plp ;; XXX c64 has this
bcc L2A09
.endif
txa
sbc Z16
bcc L2A0D
.ifndef CONFIG_11
beq L2A0D
.endif
L2A08:
tax
.ifdef CONFIG_11
L2A09:
inx
.endif
L2A0A:
.ifndef CONFIG_11
jsr OUTSP
.endif
dex
.ifndef CONFIG_11
bne L2A0A
.else
bne L2A13
.endif
L2A0D:
jsr CHRGET
jmp PRINT2
.ifdef CONFIG_11
L2A13:
jsr OUTSP
bne L2A0A
.endif
; ----------------------------------------------------------------------------
; PRINT STRING AT (Y,A)
; ----------------------------------------------------------------------------
STROUT:
jsr STRLIT
; ----------------------------------------------------------------------------
; PRINT STRING AT (FACMO,FACLO)
; ----------------------------------------------------------------------------
STRPRT:
jsr FREFAC
tax
ldy #$00
inx
L2A22:
dex
beq L29DD
lda (INDEX),y
jsr OUTDO
iny
cmp #$0D
bne L2A22
jsr PRINTNULLS
jmp L2A22
; ----------------------------------------------------------------------------
OUTSP:
.ifdef CBM2
lda $0E
beq LCA40
lda #$20
.byte $2C
LCA40:
.endif
.ifdef CONFIG_CBM_ALL
lda #$1D
.else
lda #$20
.endif
.byte $2C
OUTQUES:
lda #$3F
; ----------------------------------------------------------------------------
; PRINT CHAR FROM (A)
; ----------------------------------------------------------------------------
OUTDO:
.ifndef KBD
bit Z14
bmi L2A56
.endif
.ifndef CBM2_KBD
pha
.endif
.ifdef CBM1
cmp #$1D
beq LCA6A
cmp #$9D
beq LCA5A
cmp #$14
bne LCA64
LCA5A:
lda $05
beq L2A4E
lda Z03
bne L2A4E
dec $05
LCA64:
and #$7F
.endif
.ifndef CBM2
cmp #$20
bcc L2A4E
.endif
LCA6A:
.ifdef CONFIG_CBM1_PATCHES
lda Z03
jsr PATCH6
nop
.endif
.ifdef CONFIG_PRINT_CR
lda Z16
cmp Z17
bne L2A4C
.ifdef APPLE
nop ; PATCH!
nop ; don't print CR
nop
.else
jsr CRDO
.endif
L2A4C:
.endif
.ifndef CONFIG_CBM_ALL
inc Z16
.endif
L2A4E:
.ifndef CBM2_KBD
pla
.endif
.ifdef KIM
sty DIMFLG
.endif
.ifdef APPLE
ora #$80
.endif
jsr MONCOUT
.ifdef APPLE
and #$7F
.endif
.ifdef KIM
ldy DIMFLG
.endif
.ifdef OSI
nop
nop
nop
nop
.endif
L2A56:
and #$FF
LE8F2:
rts
.ifdef KBD
LE8F3:
pha
lda $047F
clc
beq LE900
lda #$00
sta $047F
sec
LE900:
pla
rts
.endif

242
var.s Normal file
View File

@ -0,0 +1,242 @@
.segment "CODE"
; ----------------------------------------------------------------------------
; "DIM" STATEMENT
; ----------------------------------------------------------------------------
NXDIM:
jsr CHKCOM
DIM:
tax
jsr PTRGET2
jsr CHRGOT
bne NXDIM
rts
; ----------------------------------------------------------------------------
; PTRGET -- GENERAL VARIABLE SCAN
;
; SCANS VARIABLE NAME AT TXTPTR, AND SEARCHES THE
; VARTAB AND ARYTAB FOR THE NAME.
; IF NOT FOUND, CREATE VARIABLE OF APPROPRIATE TYPE.
; RETURN WITH ADDRESS IN VARPNT AND Y,A
;
; ACTUAL ACTIVITY CONTROLLED SOMEWHAT BY TWO FLAGS:
; DIMFLG -- NONZERO IF CALLED FROM "DIM"
; ELSE = 0
;
; SUBFLG -- = $00
; = $40 IF CALLED FROM "GETARYPT"
; ----------------------------------------------------------------------------
PTRGET:
ldx #$00
jsr CHRGOT
PTRGET2:
stx DIMFLG
PTRGET3:
sta VARNAM
jsr CHRGOT
jsr ISLETC
bcs NAMOK
SYNERR3:
jmp SYNERR
NAMOK:
ldx #$00
stx VALTYP
.ifndef CONFIG_SMALL
stx VALTYP+1
.endif
jsr CHRGET
bcc L2ECD
jsr ISLETC
bcc L2ED8
L2ECD:
tax
L2ECE:
jsr CHRGET
bcc L2ECE
jsr ISLETC
bcs L2ECE
L2ED8:
cmp #$24
.ifdef CONFIG_SMALL
bne L2EF9
.else
bne L2EE2
.endif
lda #$FF
sta VALTYP
.ifndef CONFIG_SMALL
bne L2EF2
L2EE2:
cmp #$25
bne L2EF9
lda SUBFLG
bne SYNERR3
lda #$80
sta VALTYP+1
ora VARNAM
sta VARNAM
L2EF2:
.endif
txa
ora #$80
tax
jsr CHRGET
L2EF9:
stx VARNAM+1
sec
ora SUBFLG
sbc #$28
bne L2F05
jmp ARRAY
L2F05:
lda #$00
sta SUBFLG
lda VARTAB
ldx VARTAB+1
ldy #$00
L2F0F:
stx LOWTR+1
L2F11:
sta LOWTR
cpx ARYTAB+1
bne L2F1B
cmp ARYTAB
beq NAMENOTFOUND
L2F1B:
lda VARNAM
cmp (LOWTR),y
bne L2F29
lda VARNAM+1
iny
cmp (LOWTR),y
beq SET_VARPNT_AND_YA
dey
L2F29:
clc
lda LOWTR
adc #BYTES_PER_VARIABLE
bcc L2F11
inx
bne L2F0F
; ----------------------------------------------------------------------------
; CHECK IF (A) IS ASCII LETTER A-Z
;
; RETURN CARRY = 1 IF A-Z
; = 0 IF NOT
; ----------------------------------------------------------------------------
ISLETC:
cmp #$41
bcc L2F3C
sbc #$5B
sec
sbc #$A5
L2F3C:
rts
; ----------------------------------------------------------------------------
; VARIABLE NOT FOUND, SO MAKE ONE
; ----------------------------------------------------------------------------
NAMENOTFOUND:
pla
pha
cmp #<FRM_VARIABLE_CALL
bne MAKENEWVARIABLE
.ifdef CONFIG_SAFE_NAMENOTFOUND
tsx
lda STACK+2,x
cmp #>FRM_VARIABLE_CALL
bne MAKENEWVARIABLE
.endif
LD015:
lda #<C_ZERO
ldy #>C_ZERO
rts
; ----------------------------------------------------------------------------
.ifndef CBM2_KBD
C_ZERO:
.byte $00,$00
.endif
; ----------------------------------------------------------------------------
; MAKE A NEW SIMPLE VARIABLE
;
; MOVE ARRAYS UP 7 BYTES TO MAKE ROOM FOR NEW VARIABLE
; ENTER 7-BYTE VARIABLE DATA IN THE HOLE
; ----------------------------------------------------------------------------
MAKENEWVARIABLE:
.ifdef CONFIG_CBM_ALL
lda VARNAM
ldy VARNAM+1
cmp #$54
bne LD02F
cpy #$C9
beq LD015
cpy #$49
bne LD02F
LD02C:
jmp SYNERR
LD02F:
cmp #$53
bne LD037
cpy #$54
beq LD02C
LD037:
.endif
lda ARYTAB
ldy ARYTAB+1
sta LOWTR
sty LOWTR+1
lda STREND
ldy STREND+1
sta HIGHTR
sty HIGHTR+1
clc
adc #BYTES_PER_VARIABLE
bcc L2F68
iny
L2F68:
sta HIGHDS
sty HIGHDS+1
jsr BLTU
lda HIGHDS
ldy HIGHDS+1
iny
sta ARYTAB
sty ARYTAB+1
ldy #$00
lda VARNAM
sta (LOWTR),y
iny
lda VARNAM+1
sta (LOWTR),y
lda #$00
iny
sta (LOWTR),y
iny
sta (LOWTR),y
iny
sta (LOWTR),y
iny
sta (LOWTR),y
.ifndef CONFIG_SMALL
iny
sta (LOWTR),y
.endif
; ----------------------------------------------------------------------------
; PUT ADDRESS OF VALUE OF VARIABLE IN VARPNT AND Y,A
; ----------------------------------------------------------------------------
SET_VARPNT_AND_YA:
lda LOWTR
clc
adc #$02
ldy LOWTR+1
bcc L2F9E
iny
L2F9E:
sta VARPNT
sty VARPNT+1
rts