3524 lines
68 KiB
ArmAsm
3524 lines
68 KiB
ArmAsm
*
|
|
* Amper Manager
|
|
*
|
|
* (c) 1987, Rick Sutcliffe
|
|
* (s) 2020, Antoine Vignau
|
|
*
|
|
|
|
xc
|
|
xc
|
|
mx %11
|
|
org $803
|
|
lst off
|
|
|
|
*-------------------------------
|
|
|
|
CMD EQU $06
|
|
CMD2 EQU $07
|
|
FLAG EQU $07
|
|
FLAG2 EQU $08
|
|
FLAGS EQU $09
|
|
USROP EQU $0A
|
|
ENDCHR EQU $0E
|
|
VARTYP EQU $11
|
|
COLDV0 EQU $19
|
|
CNTVAL EQU $1E
|
|
LCCNT EQU $1F
|
|
AWNDWDTH EQU $21
|
|
AWNDBTM EQU $23
|
|
CH EQU $24
|
|
CV EQU $25
|
|
BASL EQU $28
|
|
PROMPT EQU $33
|
|
YSAV EQU $34
|
|
YSAVE EQU $35
|
|
CSWL EQU $36
|
|
KSWL EQU $38
|
|
PCL EQU $3A
|
|
PCH EQU $3B
|
|
A2L EQU $3E
|
|
A2H EQU $3F
|
|
A3L EQU $40
|
|
A3H EQU $41
|
|
ZDEV EQU $43
|
|
ACC EQU $45
|
|
XSAV EQU $46
|
|
YREG EQU $47
|
|
STATUS EQU $48
|
|
SBUF1 EQU $4A
|
|
SBUF2 EQU $4C
|
|
LINNUM EQU $50
|
|
INDEX EQU $5E
|
|
TXTTAB EQU $67
|
|
STREND EQU $6D
|
|
HIMEML EQU $73
|
|
HIMEMH EQU $74
|
|
CURLIN EQU $75
|
|
VARNAM EQU $81
|
|
VARPNT EQU $83
|
|
FORPNT EQU $85
|
|
LOWTR EQU $9B
|
|
FEXP EQU $9D
|
|
DPTR EQU $A0 ;DESCRIPTOR POINTER
|
|
SIGN EQU $A2 ;OF FAC
|
|
CHRGETA EQU $B1
|
|
CHRGOTA EQU $B7
|
|
TXTPTR EQU $B8
|
|
BUFPT EQU $CE
|
|
USLIN EQU $E0
|
|
BLKBUF EQU $E0
|
|
FILEPOS EQU $E2
|
|
*E3 TO E5 AVAILABLE
|
|
ENDIG EQU $E7
|
|
STRPTSV EQU $EA
|
|
STRLEN EQU $EC
|
|
STRLO EQU $ED
|
|
STRHI EQU $EE
|
|
COUNT EQU $EF
|
|
SPDBYT EQU $F1
|
|
DECPTSV EQU $F9
|
|
NUMFLG EQU $F9
|
|
EXPSTRT EQU $FB
|
|
XCOUNT EQU $FB
|
|
EXPSV EQU $FC
|
|
IFLAG EQU $FD
|
|
CFLAG EQU $FE
|
|
HALFFLAG EQU $E3 ;SEEMS TO BE A GS CONFLICT
|
|
STTRK EQU $FE
|
|
LFLAG EQU $FF
|
|
ENTRK EQU $FF
|
|
FBUFFR EQU $100
|
|
STKOFF EQU $101
|
|
FACSV EQU $110
|
|
IN EQU $200
|
|
RESET3 EQU $3F2
|
|
AMPV EQU $3F5
|
|
MUSR EQU $3F8
|
|
HEIGHT EQU $4F8
|
|
PWDTH EQU $578
|
|
TWOECH EQU $57B
|
|
*
|
|
*BASIC.SYSTEM GLOBALS
|
|
BI_ENTRY EQU $BE00
|
|
DOSCMD EQU $BE03
|
|
EXTRNCMD EQU $BE06
|
|
ERROUT EQU $BE09
|
|
PRINTERR EQU $BE0C
|
|
ERRCODE EQU $BE0F
|
|
OUTVECT0 EQU $BE10
|
|
INVECT0 EQU $BE20
|
|
VECTOUT EQU $BE30
|
|
VECTIN EQU $BE32
|
|
VDOSIO EQU $BE34
|
|
DEFSLT EQU $BE3C
|
|
DEFDRV EQU $BE3D
|
|
PREGA EQU $BE3E
|
|
PREGX EQU $BE3F
|
|
PREGY EQU $BE40
|
|
DTRACE EQU $BE41
|
|
STATE EQU $BE42
|
|
XTRNADDR EQU $BE50
|
|
XLEN EQU $BE52
|
|
XCNUM EQU $BE53
|
|
PBITS EQU $BE54
|
|
FBITS EQU $BE56
|
|
GOSYSTEM EQU $BE70
|
|
BADCALL EQU $BE8B
|
|
OSYSBUF EQU $BECE
|
|
OREFNUM EQU $BED0
|
|
RWDATA EQU $BED7
|
|
RWCOUNT EQU $BED9
|
|
RWTRANS EQU $BEDB
|
|
CREFNUM EQU $BEDE
|
|
*
|
|
*
|
|
*PRODOS GLOBALS
|
|
ENTRY EQU $BF00
|
|
*
|
|
KBD EQU $C000
|
|
KBDSTRB EQU $C010
|
|
ISETYCOL EQU $C01E
|
|
TAPEOUT EQU $C020
|
|
SPKR EQU $C030
|
|
SHIFT EQU $C063
|
|
ROMIN EQU $C082
|
|
RAMIN EQU $C08B
|
|
MOTOFF EQU $C088
|
|
HGTBL EQU $C92C
|
|
PWDTBL EQU $C93C
|
|
TWOEOFF EQU $CDAA
|
|
ERROR EQU $D412
|
|
GDBUFS EQU $D539
|
|
FINDLIN EQU $D61A
|
|
NEW EQU $D64B
|
|
LISTA EQU $D6A5
|
|
NEWSTT EQU $D7D2
|
|
RESTORE1 EQU $D850
|
|
GOTOPL EQU $D941
|
|
APDATA EQU $D995
|
|
ADDON EQU $D998
|
|
LINGET EQU $DA0C
|
|
STROUT EQU $DB3A
|
|
STRPRT EQU $DB3D
|
|
OUTSPC EQU $DB57
|
|
OUTQST EQU $DB5A
|
|
OUTDO EQU $DB5C
|
|
FRMNUM EQU $DD67
|
|
CHKNUM EQU $DD6A
|
|
MMCH EQU $DD76
|
|
FRMEVAL EQU $DD7B
|
|
STRTXT EQU $DE81
|
|
CHKCLS EQU $DEB8
|
|
CHKOPN EQU $DEBB
|
|
CHKCOM EQU $DEBE
|
|
SYNCHR EQU $DEC0
|
|
PTRGET EQU $DFE3
|
|
ISLETC EQU $E07D
|
|
GIVAYF EQU $E2F2
|
|
SGNFLT EQU $E301
|
|
ERRDIR EQU $E306
|
|
GETSPA EQU $E452
|
|
MOVSTR EQU $E5E2
|
|
FRESTR EQU $E5FD
|
|
FREFAC EQU $E600
|
|
GETBYTC EQU $E6F5
|
|
GETBYT EQU $E6F8
|
|
CONINT EQU $E6FB
|
|
COMBYT EQU $E74C
|
|
GETADR EQU $E752
|
|
FADDH EQU $E7A0
|
|
MUL10 EQU $EA39
|
|
DIV10 EQU $EA55
|
|
MOVMF EQU $EB2B
|
|
RNDB EQU $EB72
|
|
ABS EQU $EBAF ;OF FAC
|
|
FCOMP EQU $EBB2
|
|
INT EQU $EC23 ;OF FAC
|
|
LINPRT EQU $ED24
|
|
FOUT EQU $ED34
|
|
PRNTFAC EQU $ED2E
|
|
NEGOP EQU $EED0 ;REVERSE SIGN ON FAC
|
|
VTABX1 EQU $F25D
|
|
RSHM EQU $F28C
|
|
HTABA EQU $F7EC
|
|
PRNTAX EQU $F941
|
|
PRNTX EQU $F944
|
|
PRBL2 EQU $F94A
|
|
SETWND EQU $FB39
|
|
SETPWRC EQU $FB6F
|
|
SIGBYTE EQU $FBB3 ;II 38, II+ EA, //E 06 ,SYS A0 THIS &FRK HAVE FC AT GETNUM+8
|
|
STORADV EQU $FBF0
|
|
ADVANCE EQU $FBF4
|
|
BS EQU $FC10
|
|
HOME EQU $FC58
|
|
WAIT EQU $FCA8
|
|
RDKEY EQU $FD0C
|
|
KEYIN EQU $FD1B
|
|
GETLN EQU $FD6A
|
|
BCKSPC EQU $FD71
|
|
NXTCHAR EQU $FD75
|
|
CROUT EQU $FD8E
|
|
PRBYTE EQU $FDDA
|
|
COUT EQU $FDED
|
|
COUT1 EQU $FDF0
|
|
COUTZ EQU $FDF9
|
|
SETKBD EQU $FE89
|
|
SETVID EQU $FE93
|
|
GO EQU $FEB6
|
|
PRERR EQU $FF2D
|
|
BELL EQU $FF3A
|
|
IOREST EQU $FF3F
|
|
IOSAVE EQU $FF4A
|
|
MON EQU $FF69
|
|
GETNUMM EQU $FFA7
|
|
TOSUB EQU $FFBE
|
|
ZMODE EQU $FFC7
|
|
CHRTBL EQU $FFCC
|
|
*
|
|
*
|
|
*
|
|
INITP LDX STATE ;IN DIRECT?
|
|
BNE INITR ;NO, PROGRAM, SO NO COPYRIGHT
|
|
INITB CLC ;ENTER HERE FORCES BOTH RESET(MI) WILL HAVE 00
|
|
ROR FLG
|
|
INITR CLC ;ENTERING HERE DOES RESET ONLY 01
|
|
DFB $24 ;HIDES NEXT
|
|
INITH SEC ;ENTERING HERE DOES A REHOOK BUT NOTHING ELSE
|
|
ROR FLG
|
|
INITC LDX #$08 ;AND HERE DOES COPYRIGHT ONLY
|
|
STX CNTVAL ;FOR ARROWS
|
|
LDA $FF7E ;PATCH FOR //C
|
|
STA CKTBL+1
|
|
INT1 LDA RESET3,X ;PART OF PAGE 3
|
|
CMP NEW3,X ; SAME AS OURS ALREADY?
|
|
BEQ INT2 ;YES SO DONE, AND SKIP
|
|
STA OLD3,X ;NO, SO SAVE FOR GRACEFUL EXIT
|
|
LDA NEW3,X ;PUT OURS THERE
|
|
STA RESET3,X
|
|
INT2 DEX ;NEXT ONE
|
|
BPL INT1 ;UNTIL 9
|
|
*
|
|
*THIS IS A GS PATCH
|
|
*
|
|
LDA $FF7E ;FIX CHKTBL REFERENCE
|
|
STA CKTBL+1
|
|
LDA $FF7F
|
|
STA CKTBL+2
|
|
SEC
|
|
JSR $FE1F ;SEE IF GS
|
|
BCS ITSA2E ;NOPE
|
|
LDA #$E6 ;YES, SO CHANGE TOBL REF
|
|
STA TOBL1+1
|
|
LDA #$D1
|
|
STA CNT+1 ;AND ZMODE REF
|
|
STA TOZ+1
|
|
ITSA2E JSR SETPWRC ;SET POWER UP BYTE
|
|
JSR PUTWWDTH
|
|
LDX #$02 ;YES,SO SET UP NEWV
|
|
INT3 LDA COLDVA,X ;SET UP COLD REHOOK
|
|
STA COLDV0,X ;ON ZERO PAGE
|
|
BIT FLG ;ON RECONNECT?
|
|
BPL INT4 ;NO SO SKIP
|
|
LDA AMPV,X
|
|
CMP AMPJ,X ;SEE IF &VECTOR SET UP FOR THIS
|
|
BEQ INT4 ;IF SO DONT DO IT AGAIN
|
|
STA NEWV,X
|
|
INT4 DEX
|
|
BPL INT3
|
|
BIT FLG ;DONE THIS?
|
|
BMI INITFIN ;YES SO DONT RESET HIMEM
|
|
* DO INITP-$803
|
|
*THIS ONE IF AT HIMEM
|
|
*RESET LDA #0
|
|
*STA LINNUM
|
|
*LDA #>INITP
|
|
*SEC
|
|
*SBC #$04 ;BACK DOWN BY 4
|
|
*STA LINNUM+1
|
|
*JSR RSHM
|
|
* ELSE
|
|
*
|
|
*THIS ONE IF AT LOMEM TO RESET
|
|
*APPLESOFT PROGRAM START
|
|
LDA #>ENDPROG
|
|
STA TXTTAB+1
|
|
LDA #<ENDPROG
|
|
STA TXTTAB
|
|
* FIN
|
|
BIT FLG
|
|
INITFIN BVS VRS2 ;NO, SKIP COPYRIGHT
|
|
JSR SETWND ;RESET WINDOW
|
|
VERSION JSR OUTSPC ;MAKE ProDOS HAPPY
|
|
JSR HOME
|
|
JSR ULTRAO
|
|
JSR ISULTRA
|
|
BNE VRS1 ;IF NOT ULTRATERM
|
|
JSR CROUT ;NEEDED TO RESTORE ULTRA AFTER HOME
|
|
LDA HEIGHT ;IF IT IS, CENTRE
|
|
SEC
|
|
SBC #$18
|
|
LSR A ; HALF OF DIFFERENCE TO NORMAL
|
|
CLC
|
|
ADC #$08
|
|
BNE VRS1A ;ALWAYS
|
|
VRS1 LDA #$08
|
|
VRS1A STA CV
|
|
JSR CROUT
|
|
LDA #$05
|
|
STA CH
|
|
LDX #>TITLIN
|
|
LDA #<TITLIN
|
|
JSR PRINTERC
|
|
JSR CROUT
|
|
LDA #$0B
|
|
STA CH
|
|
LDX #>AUTHOR
|
|
LDA #<AUTHOR
|
|
JSR PRINTERC
|
|
JSR CROUT
|
|
LDA #$09
|
|
STA CH
|
|
LDX #>VERNO
|
|
LDA #<VERNO
|
|
JSR PRINTERC
|
|
JSR CROUT
|
|
LDA #$09
|
|
STA CH
|
|
LDX #>CPRNOT
|
|
LDA #<CPRNOT
|
|
JSR PRINTERC
|
|
JSR CROUT
|
|
BIT FLG
|
|
VRS2 PHP ;SAVE IT
|
|
LDA #$BF
|
|
STA FLG
|
|
PLP ;UNTIL FLAG RESET
|
|
BMI RTSCHK ;THEN MOVE ALONG
|
|
* DO INITP-$803
|
|
* ELSE
|
|
VRS3 JSR NEW
|
|
JMP BI_ENTRY ;REHOOK DOS
|
|
* FIN
|
|
RTSCHK BIT FLG2 ;DID USER STORE A FLAG IN FLG2
|
|
BPL RTSCHK2 ;NO
|
|
JSR LCASERST ;YES SO COME ON IN LC
|
|
RTSCHK2 JMP ALLDONE1 ;NO SO WARM START
|
|
*
|
|
*RESET ROUTINE
|
|
RESETN JSR INITH
|
|
JMP BI_ENTRY
|
|
*
|
|
*ROUTINE TO KILL AMPERMANAGER
|
|
KILL LDX #$08
|
|
KILL1 LDA OLD3,X ;COPY BACK OLD P3
|
|
STA RESET3,X
|
|
DEX
|
|
BPL KILL1 ;ALL 9 BYTES
|
|
JSR CSSWOFF ;DOS OFF
|
|
JSR TWOEOFF0 ;CANCEL 80 COL
|
|
JSR CSSWON
|
|
* DO INITP-$803
|
|
* ELSE
|
|
LDA #$01
|
|
STA TXTTAB
|
|
LDA #$08
|
|
STA TXTTAB+1
|
|
BPL VRS3 ;ALWAYS
|
|
* FIN
|
|
JMP BI_ENTRY
|
|
*
|
|
*SERIAL JSR CROUT
|
|
* LDA #$0A
|
|
* STA CH
|
|
* LDX #>SERNO
|
|
* LDA #<SERNO
|
|
* JSR PRINTERC
|
|
* LDX SERDATA
|
|
* LDA SERDATA+1
|
|
* JMP LINPRT
|
|
*
|
|
***********DATA AREA BEGINS HERE************
|
|
*
|
|
SERDATA DW $0000
|
|
FLG DFB $BF
|
|
FLG2 DFB $00
|
|
DSTSV DFB $00
|
|
WNDWDTH DFB $28
|
|
WNDBTM DFB $18
|
|
MYLEFT DFB $00
|
|
********************************************
|
|
OLD3 EQU * ;STORAGE FOR OLD P3
|
|
OSOFTEV DFB $03,$E0,$45
|
|
OLDV JMP $FF58 ;NORM&VECTOR,LINK TO OLD &
|
|
OUSRADDR JMP $FF58
|
|
********************************************
|
|
NEW3 EQU * ;NEW PAGE 3 STUFF
|
|
NSOFTEV DW RESETN
|
|
DFB $0
|
|
AMPJ JMP PARSER
|
|
MONYV JMP $D9C6 ;PLA PLA RTS FOR GETTING BACK
|
|
********************************************
|
|
NEWV JMP $FF58 ;LINK TO NEW PROGRAM
|
|
COLDVA JMP INITP
|
|
*
|
|
**********DATA AREA FINISHED**************
|
|
*
|
|
***************SUBROUTINE STARTS HERE*************
|
|
*
|
|
PUTWWDTH LDX AWNDWDTH
|
|
JSR ISULTRA
|
|
PHP ;STORE ULTRA RESULT
|
|
BNE STORWND
|
|
LDX PWDTH
|
|
STORWND STX WNDWDTH
|
|
LDX AWNDBTM ;GET NORMAL BOTTOM
|
|
PLP ;RESTORE RESULT
|
|
BNE STORBTM
|
|
LDX HEIGHT
|
|
STORBTM STX WNDBTM
|
|
RTS
|
|
*
|
|
*******************PARSER STARTS HERE*************
|
|
*
|
|
PARSER TSX ;SAVE STACK POINTER
|
|
DEX
|
|
DEX ;ADJUST
|
|
STX DSTSV ;IN DOS SPOT
|
|
JSR VDS6 ;ENSURE EXTERNAL OK
|
|
LDA #$00 ;ZERO ALL FLAGS
|
|
TAY ;ENSURE Y ZEROD TOO
|
|
LDX #$01 ;MOSTLY IN PAIRS
|
|
CLRFLG STA COUNT,X
|
|
STA CMD,X
|
|
STA LINNUM,X
|
|
STA CFLAG,X
|
|
STA USLIN,X
|
|
DEX
|
|
BPL CLRFLG
|
|
STA FLAG2
|
|
STA LASTSV
|
|
JSR PUTWWDTH
|
|
JSR CHRGOT ;SEE IF EOL
|
|
BCS PARSER2 ;GO ON IF NOT #
|
|
JSR DECAD ;FETCH THAT NUMBER
|
|
TAY ;CHECK HI BYTE
|
|
BNE GODEC ;IF NOT ZERO THEN IS CONVERT
|
|
CPX #$0A ;JUST UP TO 9
|
|
BCS GODEC ;OR ALSO DEFAULT
|
|
TXA ;DO A DIGIT PROG
|
|
ASL A ;AND DOUBLE
|
|
TAX
|
|
JSR CHKCOM ;FOLLOW # WITH COMMA
|
|
LDA NUMTBL,X
|
|
LDY NUMTBL+1,X
|
|
JMP GORUT
|
|
GODEC JMP HEXOUT1
|
|
PARSER2 BEQ OLDV
|
|
CMP #$AF ;IS IT A DOUBLE & ?
|
|
BNE PARSER3 ;NO
|
|
LDX GOVECT+1 ;AND SET UP
|
|
LDY GOVECT+2 ;ALL REGS TO DO THE USUAL
|
|
JSR CHRGET ;YES SO GOBBLE
|
|
JMP GOVECT ;FORCED
|
|
PARSER3 TAX ;SEE IF TOKEN NEXT
|
|
BMI FIND0 ;AND SKIP THIS IF SO
|
|
LDX #$05
|
|
FIND LDA (TXTPTR),Y ;SEE IF = SIGN CLOSE
|
|
BEQ FIND0 ;END OF CMD SO NO
|
|
CMP #$D0 ;IS =
|
|
BEQ DEFGOV ;YES SO DO LET
|
|
INY ;NO SO MORE
|
|
DEX
|
|
BNE FIND
|
|
FIND0 LDX #$00
|
|
FIND1 LDY #$00
|
|
LOOP1 JSR LDFIX
|
|
AND #$7F ;STRIP HIGH BIT FROM TOKENS
|
|
EOR CMDTBL,X ;SAME AS TABLE?
|
|
ASL A ;EXCEPT FOR HIGH BIT
|
|
BNE NEXT1 ;NO SO TRY NEXT CMD
|
|
BCS FOUND ;NO SO HIGH BIT SET=> GOT IT
|
|
INX
|
|
INY
|
|
BNE LOOP1 ;ALWAYS IF WE GET THIS FAR
|
|
NEXTC INX
|
|
NEXT1 LDA CMDTBL,X
|
|
BEQ DEFGOV ;IF ZERO, NO MORE COMMANDS SO DO LET
|
|
BPL NEXTC ;FLUSH TO END OF CMD (HI BIT SET)
|
|
INX
|
|
INC CMD
|
|
BNE FIND1 ;ALWAYS TAKEN
|
|
FOUND JSR LDFIX ;WAS LAST CHR ON CMD LINE A LETTER?
|
|
BCS SHFT ;YES SO RESUME CHECK
|
|
ORA #$80 ;NO SO SIMULATE A TOKEN
|
|
*THE IDEA IS THAT SHORT SYMBOL COMMANDS*
|
|
*ARE ALLOWED TO BE FILLOWED BY LETTERS*
|
|
*AS ARE TOKENS, BUT ONLY LONG WORD ONES*
|
|
*CAN HAVE THIS SYNTAX*
|
|
SHFT ASL A ;GRAB HI BIT
|
|
INY ;POINT Y AFTER CMD
|
|
BCS ADD ;SKIP THIS IF TOKEN
|
|
CPY #$02 ;SEE IF MORE THAN TWO
|
|
BCS ADD ;LETTERS IN COMMAND, SKIP IF SO
|
|
LDA (TXTPTR),Y ;WHATS NEXT?
|
|
BMI ADD ;O.K. IF TOKEN
|
|
CMP #$41 ;SEE IF MORE LETTERS ON KBD
|
|
BCS NEXT1 ;YES, SO CMD ONLY STARTS LIKE OURS
|
|
ADD JSR ADDON ;ADD TO TEXTPTR
|
|
LDA CMD ;GET CMD
|
|
ASL A ;DOUBLE
|
|
TAX ;PUT IN X INDEX
|
|
LDA ADTBL,X
|
|
LDY ADTBL+1,X
|
|
GORUT STA GOVECT+1
|
|
STY GOVECT+2
|
|
TAX
|
|
JSR CHRGOT ;HOLD LAST CHR ON JUMP
|
|
GOVECT JMP $FF58 ;GETS CHANGED TO WHATEVER REQUIRED
|
|
DEFGOV JMP LET
|
|
*
|
|
*LOWER CASE INPUT ROUTINES
|
|
*
|
|
CHRGET JSR CHRGETA
|
|
JMP CHRGOT1
|
|
CHRGOT JSR CHRGOTA
|
|
CHRGOT1 PHP ;SAVE
|
|
JSR LCFIX ;CONVERT LCASE TO UCASE
|
|
PLP ;GET BACK THEIR FLAGS
|
|
RTS ;AND DONE
|
|
LDFIX LDA (TXTPTR),Y
|
|
*
|
|
LCFIX CMP #$7B ;IS LCASE?
|
|
BCS LCFXFIN2 ;NO
|
|
CMP #$41 ;MAYBE LOWER CASE
|
|
BCC LCFXFIN ;NO
|
|
AND #$DF ;YES
|
|
LCFXFIN RTS ;AND DONE
|
|
LCFXFIN2 CLC
|
|
RTS
|
|
*
|
|
CMDTBL DFB $D1 ;TOKEN FOR < TO OLDV
|
|
DFB $CF ;TOKEN FOR > TO NEWV
|
|
DFB $46,$AF ;TOKENS FOR NOT&
|
|
DFB $4E,$4F,$54,$AF ;not&
|
|
DFB $B5 ;WAIT TOKEN
|
|
DCI 'WAIT'
|
|
DCI 'BEEP'
|
|
DCI 'SET' ;TO ATTACH PROGRAMS
|
|
DFB $A4 ;$ FOR HEX ==>DEC
|
|
DFB $A5 ;% FOR DEC ==>HEX
|
|
DFB $CC ;L FOR LIST
|
|
DCI 'LIST'
|
|
DCI 'LF' ;FORMATTED LIST
|
|
DCI 'LL' ;LONG LIST
|
|
DFB $CD ;M FOR MONITOR
|
|
DCI 'REG' ;FOR REGS
|
|
DFB $C9 ;I FOR INVERSE
|
|
DFB $C6 ;F FOR FLASH
|
|
DFB $CE ;N FOR NORMAL
|
|
DFB $D4 ;T FOR TRACE
|
|
DFB $54,$D8 ;TX FOR TRACE OFF
|
|
DFB $D7 ;W FOR NORMAL WINDOW
|
|
DFB $57,$CE ;WN FOR NARROW WINDOW
|
|
DFB $D3 ;S FOR SHOW SWITCH
|
|
DCI 'SX' ;SX FOR NOSHOW
|
|
DCI 'V'
|
|
DCI 'LC' ;FOR LOWER CASE
|
|
DFB $85 ;CNTRL-E FOR ESC SEND
|
|
DCI 'FIX'
|
|
DCI 'SWAP'
|
|
DCI 'REV'
|
|
DCI 'CRT'
|
|
DCI 'MOVE'
|
|
DFB $AA ;LET
|
|
DCI 'LET'
|
|
DFB $8C ;CALL TOKEN
|
|
DCI 'CALL'
|
|
DFB $B9 ;POKE TOKEN
|
|
DCI 'POKE'
|
|
DFB $D0 ;P FOR PRINTER
|
|
DFB $AE ;RESTORE TOKEN
|
|
DCI 'RESTORE'
|
|
DFB $AB ;GOTO TOKEN
|
|
DCI 'GOTO'
|
|
DFB $B0 ;GOSUB TOKEN
|
|
DCI 'GOSUB'
|
|
DFB $BA ;TOKEN FOR PRINT
|
|
DCI 'PRINT' ;FOR LCASE
|
|
DFB $84 ;TOKEN FOR INPUT
|
|
DCI 'INPUT'
|
|
DFB $C4 ;D FOR DOS RECONNECT
|
|
DCI 'DX' ;FOR DOS OFF
|
|
DFB $C3 ;C FOR CAT
|
|
DCI 'CE' ;FOR CATALOG
|
|
DCI 'WRITE'
|
|
DCI 'OPEN'
|
|
DCI 'READ' ;CATCH LOWER CASE TOO
|
|
DFB $87 ;READ TOKEN
|
|
DCI 'TYPE'
|
|
DFB $AC ;COMMA FOR DRIVE,SLOT,ETC
|
|
DFB 203 ;/ FOR PATHNAME
|
|
* DCI 'FMTDSK'
|
|
DCI 'DUMP'
|
|
DCI 'ZAP' ;ZAP
|
|
DFB $CA ;* FOR PSEUDOMON
|
|
DCI 'VR' ;FOR VERSION
|
|
DFB $00
|
|
*
|
|
NUMTBL DW $0019 ;DICE REHOOK
|
|
DW OLDV
|
|
DW $208 ;2 FOR RBOOT ENTRY
|
|
DW $300 ;PAGE 3 ENTRY
|
|
DW $3D0 ;DOS WARMSTART
|
|
DW $970C ;PLE REENTRY
|
|
DW $8D00 ;6 IS CRAE REHOOK
|
|
DW $9500 ;SOFT 70 ENTRY
|
|
DW $803 ;STANDARD PAGE 8 ENTRY
|
|
DW $8D55 ;GHR2 REENTRY
|
|
*
|
|
ADTBL DW OLDV ;TO OLD &VECTOR
|
|
DW NEWV
|
|
DW KILL ;WIPE THIS PROGRAM
|
|
DW KILL ;WIPE THIS PROGRAM
|
|
DW WAITER
|
|
DW WAITER
|
|
DW BEEP
|
|
DW LOAD ;FOR USER PROGRAMS
|
|
DW DECOUT ;HEX=>DEC
|
|
DW HEXOUT ;DEC=>HEX
|
|
DW LIST
|
|
DW LIST
|
|
DW LISTF ;FORMATTED LIST
|
|
DW LISTA
|
|
DW MON ;MONITOR
|
|
DW $FADA ;REG DSP
|
|
DW $F277 ;INVERSE
|
|
DW $F280 ;FLASH
|
|
DW $F273 ;NORMAL
|
|
DW $F26D ;TRACE
|
|
DW $F26F ;NOTRACE
|
|
DW $FB39 ;WINDOW
|
|
DW WINDOW33
|
|
DW SHOWSW
|
|
DW NOSHOW ;RESTORE TO NOSHOW
|
|
DW ULTRA
|
|
DW LCASE
|
|
DW ESCSND
|
|
DW FIX
|
|
DW SWAP
|
|
DW REVERSE
|
|
DW CNVERT
|
|
DW MOVE
|
|
DW LET
|
|
DW LET
|
|
DW CALL
|
|
DW CALL
|
|
DW POKE
|
|
DW POKE
|
|
DW PRINTON
|
|
DW RESTOREN
|
|
DW RESTOREN
|
|
DW GOTO
|
|
DW GOTO
|
|
DW GOSUB
|
|
DW GOSUB
|
|
DW PRINT
|
|
DW PRINT
|
|
DW INPUT
|
|
DW INPUT
|
|
DW CSSWON
|
|
DW CSSWOFF
|
|
DW CAT
|
|
DW CATALOG
|
|
DW WRITE
|
|
DW OPEN
|
|
DW READ
|
|
DW READ
|
|
DW TYPE
|
|
DW PARSEP
|
|
DW PARSEP
|
|
* DW FORMAT
|
|
DW DUMP
|
|
DW ZAP
|
|
DW MON2
|
|
DW VERSION
|
|
*
|
|
*PRINTER FOR FOLLOWING FILE*
|
|
*ENTER HOLDING ADDRESS OF STRING AS
|
|
*A,X LO,HI
|
|
*
|
|
PRINTERC PHA ;USE TO CENTRE IF 80COL
|
|
LDA WNDWDTH ;FROM OUR STORAGE OF IT
|
|
SEC
|
|
SBC #$28
|
|
BCS WWDTH0 ;IF OK
|
|
LDA #$00 ;IF NOW NEG
|
|
WWDTH0 LSR A ;HALF AFTER NORMAL OFF
|
|
STA MYLEFT
|
|
CLC
|
|
ADC CH
|
|
STA CH
|
|
PLA
|
|
PRINTER LDY #$00
|
|
PRNTR1 STA INDEX ;ALTERNATE ENTRY Y>0
|
|
STX INDEX+1
|
|
PRNTR2 LDA (INDEX),Y
|
|
PHA
|
|
ORA #$80 ;SET HI BIT
|
|
JSR COUT
|
|
INY
|
|
CMP #$8D ;WAS IT CARRET?
|
|
BNE PRNTR3 ;NO
|
|
LDA MYLEFT ;YES, KEEP CENTERING
|
|
STA CH
|
|
PRNTR3 PLA
|
|
BPL PRNTR2 ;KEEP GOING IF NOT HIGH ASCII
|
|
RTS
|
|
|
|
*
|
|
*WORD FILE FOR ABOVE PRINTER*
|
|
*
|
|
|
|
CMDLIN DCI '<>+-Z'
|
|
CANTDU DCI 'CANT DUMP PAGE $C0'
|
|
TITLIN asc 'THE AMPER (SOFT&DOS) MANAGER'8a
|
|
AUTHOR asc 'BY R. SUTCLIFFE'8a
|
|
VERNO asc 'PRODOS VERSION 2.1GS'8a
|
|
CPRNOT asc 'COPYRIGHT 1983,84,87'0a0a0a0a
|
|
dci ' PTL'
|
|
|
|
*
|
|
****PROGRAMS START HERE****
|
|
*
|
|
*PROGRAM TO WAIT FOR X TENTHS OF A SECOND
|
|
*
|
|
WAITER JSR GETBYT ;HOW MANY
|
|
XLUP LDA #$1B ;TRIM WAITER HERE
|
|
STA COUNT
|
|
YLUP LDY #$57 ;OR HERE
|
|
ALUP LDA #$01
|
|
JSR WAIT
|
|
LDA KBD ;IS KEYPRESS?
|
|
BPL ALUP1 ;NO
|
|
BIT KBDSTRB ;YES, SO RESET STROBE
|
|
STA CFLAG
|
|
TXA
|
|
STA IFLAG ;AND STORE TIME LEFT
|
|
BNE WTFIN ;EXITING
|
|
ALUP1 DEY
|
|
BNE ALUP
|
|
DEC COUNT
|
|
BNE YLUP
|
|
DEX
|
|
BNE XLUP
|
|
WTFIN RTS
|
|
*
|
|
*BEEPS SPKR AND TAPEOUT
|
|
*SYNTAX BEEP PER,DUR
|
|
*
|
|
BEEP JSR GETBYT ;PERIOD
|
|
STX COUNT
|
|
JSR CHKCOM
|
|
JSR FRMNUM ;DUR CAN BE 2 BYTES
|
|
JSR GETADR
|
|
INC LINNUM+1
|
|
LDX COUNT
|
|
BEQ DECY ;NO TOGGLE IF PER=0 (REST)
|
|
TOG LDA SPKR
|
|
LDA TAPEOUT
|
|
DECY DEY ;COUNTER
|
|
BNE DECPER
|
|
DEC LINNUM ;ONLY IF Y=0
|
|
BNE DECPER
|
|
DEC LINNUM+1
|
|
BEQ WTFIN
|
|
DECPER DEX
|
|
BNE DECY
|
|
LDX COUNT ;GOING AGAIN
|
|
BEQ DECY ;NO TOGGLE IF PERIOD O
|
|
BNE TOG
|
|
*
|
|
*LOADS USER PROGRAMS FOR # COMMANDS
|
|
*
|
|
LOAD JSR GETBYT
|
|
TXA
|
|
CMP #$0C ;OR TOO LARGE
|
|
BCS LDERR
|
|
ASL A ;DOUBLE
|
|
TAX
|
|
INX ;AND ADD ONE
|
|
STX COUNT ;SAVE IT
|
|
JSR CHKCOM ;ALSO DOES CHRGET
|
|
GTADRS JSR INNUM ;X,A AND A2 HAVE #
|
|
ENTCMD LDY COUNT ;GET BACK CMD#
|
|
STA NUMTBL,Y ;HI BYTE
|
|
DEY
|
|
TXA
|
|
STA NUMTBL,Y ;LO BYTE
|
|
RTS
|
|
LDERR JMP ERR2
|
|
*
|
|
*HEX/DEC CONVERTER*
|
|
*
|
|
HEXOUT JSR FRMEVAL ;SEE WHAT IS THERE
|
|
HEXOUT0 JSR GETADR ;AND CONVERT FAC TO INTEGER
|
|
LDX LINNUM ;PICK IT BACK UP
|
|
HEXOUT1 LDA LINNUM+1
|
|
BEQ TWODIG ;IF HIGH BYTE IS ZERO DO'NT OUTPUT
|
|
JMP PRNTAX ;AND SEND IT OUT AS 4 DIGITS
|
|
TWODIG JMP PRNTX ;OR AS TWO
|
|
*
|
|
DECOUT JSR CONVERT2
|
|
JMP LINPRT ;AND OUTPUT IT
|
|
*
|
|
*
|
|
*
|
|
*THIS ROUTINE JUST LIKE APPLESOFT
|
|
*LISTER EXCEPT THAT IT DOES NOT
|
|
*PUT IN EXTRA SPACES
|
|
*FORMATTED OPTION PUTS EACH STATEMENT
|
|
*ON A NEW LINE WITH SPACE AFTER
|
|
*AND INDENTED LOOPS
|
|
*
|
|
*LFLAG IS ZEROED BY PARSER
|
|
LISTF PHP
|
|
LDX #$06 ;INITIAL MARGIN
|
|
STX COUNT
|
|
*IF DROPS TO ZERO BY NEXT W/O FOR
|
|
*LIST WILL REVERT TO SHORT TYPE
|
|
PLP ;NEED FOR NEXT
|
|
*
|
|
LIST JSR LININIT ;SET UP LINE#S
|
|
JSR CSSWOFF ;FASTER WITHOUT DOS
|
|
LIST1 LDY #$01
|
|
LDA (USLIN),Y ;GET LINE NUMBER
|
|
BEQ LSTFIN
|
|
JSR ISWAIT
|
|
BCS LSTFIN
|
|
JSR CROUT
|
|
INY
|
|
LDA (USLIN),Y ;PICK UP LINE#
|
|
TAX
|
|
JSR LINCHK2
|
|
BCS LSTFIN ;IF CARRY SET THEN DONE
|
|
STY FORPNT ;SAVE POS IN LINE
|
|
JSR LINPRT ;AND OUTPUT LINE#
|
|
JSR LSTFA ;FOR FORMAT LIST ;RETURNS IF NOT
|
|
LISTS LDY FORPNT
|
|
LDA #$20 ;SPACE
|
|
LIST1A JSR OUTDO ;AND PUT IT OUT
|
|
LIST1B INY ;UNLIKE APP, NO 33 SPACE LINE
|
|
LDA (USLIN),Y ;NEXT ITEM
|
|
JSR LSTFB ;RETURNS IF NOT FORMAT
|
|
BNE LIST2 ;IF<>0 CHECK FOR TOKEN
|
|
*NEW LINE IF ZERO
|
|
STA FLAG ;CLEAR TOKEN STORE
|
|
STA LFLAG ;AND QUOTE STATE
|
|
*ABOVE TWO LINES FOR FORMAT ONLY
|
|
TAY ;IF DONE GET NEW LINE
|
|
LDA (USLIN),Y ;Y IS 0 NOW
|
|
TAX
|
|
INY
|
|
LDA (USLIN),Y ;GET REST
|
|
STX USLIN
|
|
STA USLIN+1 ;NEW LINE READY
|
|
BNE LIST1
|
|
LSTFIN JSR OUTSPC
|
|
JSR CROUT
|
|
JMP CSSWON ;PUT DOS BACK
|
|
GTTOK INY
|
|
BNE GTTOK1
|
|
INC FEXP+1 ;NOW $DODO
|
|
GTTOK1 LDA (FEXP),Y
|
|
RTS
|
|
LIST2 BPL LIST1A ;THIS SECTION FOR TOKENS ONLY
|
|
JSR LSTFC ;NOTHING IF NOT FORMAT
|
|
SEC
|
|
SBC #$7F ;INDEX
|
|
TAX
|
|
STY FORPNT ;SAVE LINE INDEX
|
|
LDY #$D0
|
|
STY FEXP
|
|
LDY #$CF ;TOKEN TABLE-1
|
|
STY FEXP+1
|
|
LDY #$FF
|
|
TLUP0 DEX
|
|
BEQ TLUP2
|
|
TLUP1 JSR GTTOK
|
|
BPL TLUP1
|
|
BMI TLUP0
|
|
TLUP2 JSR GTTOK
|
|
BMI LPFIN
|
|
JSR OUTDO
|
|
BNE TLUP2
|
|
LPFIN JSR TOOUTDOA
|
|
*RECYCLE
|
|
LDY FORPNT
|
|
LDX COUNT
|
|
BEQ LIST1B ;SHORT, NO SPACE
|
|
BNE LISTS
|
|
*
|
|
*SUBROUTINES:
|
|
*FIRST THREE FOR FORMATTED
|
|
LSTFA LDX COUNT
|
|
INX ;SHORT IF
|
|
SETCNT DEX ;NOW ZERO
|
|
BEQ FAFIN ;FORGET IT IF ZERO
|
|
DEY
|
|
BPL SETCNT ;REDUCE BY LINNUMBER LENGTH
|
|
DEX
|
|
BEQ FAFIN
|
|
JMP PRBL2 ;AND MARGIN
|
|
*
|
|
LSTFB PHA
|
|
LDX COUNT
|
|
BEQ FBFIN ;SHORT
|
|
CMP #$22 ;IS IT QUOTE
|
|
BNE ISITFOR ;NO
|
|
EOR LFLAG ;YES
|
|
STA LFLAG ;TOGGLE QUOTE STATE
|
|
BPL PLPH ;ALWAYS
|
|
ISITFOR CMP #$81 ;IS IT FOR
|
|
BNE LSTFB1 ;NO
|
|
INC COUNT
|
|
INC COUNT ;INCREASE OFFSET
|
|
LDX #$02 ;2 SPACES IN CASE START OF LINE
|
|
JSR PRBL2
|
|
PLPH PLA
|
|
PHA
|
|
LSTFB1 LDX FLAG ;PICK UP LAST ITEM DONE
|
|
CPX #$3A ;WAS IT COLON?
|
|
BNE THISCOL ;NO
|
|
LDX #$00 ;YES SO
|
|
STX FLAG ;CLEAR TOKEN STORE
|
|
STX LFLAG ;CLEAR QUOTE STATE
|
|
BEQ MARG2 ;AND NEXTLINE
|
|
THISCOL CMP #$3A ;IS THIS ONE A COLON
|
|
BNE LSTFB2 ;NO
|
|
LSR LFLAG ;YES, CHECK STATE
|
|
ROL LFLAG ;IF ANYTHING THERE
|
|
BNE LSTFB2 ;YES, SO SKIP : STORE
|
|
STA FLAG ;NO ,TREAT LIKE TOKEN AND SAVE
|
|
LSTFB2 CPX #$82 ;WAS IT NEXT?
|
|
BNE MARG ;NO SO CHECK MARG
|
|
CMP #$2C ;YES, SO COMMA NOW?
|
|
BNE MARG ;NO
|
|
PLA ;YES SO DESTROY COMMA ON STACK
|
|
TXA ;AND REPLACE WITH NEXT
|
|
PHA ;AND PUT IT THERE
|
|
BNE MARG2 ;TREAT LIKE NEW STATEMENT
|
|
MARG LDX CH
|
|
PLA ;SEE IF TOKEN
|
|
PHA
|
|
BPL MARG1 ;NO
|
|
CPX #$21 ;YES, PAST POS 33? (LIKE APPLESOFT)
|
|
BCS MARG2 ;YES SO NEXT LINE; DONT SPLIT
|
|
MARG1 INX
|
|
CPX AWNDWDTH ;END OF SPACE?
|
|
BCC FBFIN ;NO
|
|
*SKIP TO NEW LINE ON PAGE
|
|
MARG2 JSR CROUT
|
|
LDX COUNT
|
|
JSR PRBL2 ;AND SET MARGIN
|
|
FBFIN PLA
|
|
FAFIN RTS
|
|
*
|
|
LSTFC LDX COUNT
|
|
BEQ FCFIN2 ;SHORT
|
|
PHA
|
|
LDA FLAG ;HAD A TOKEN YET THIS LINE?
|
|
BPL SKPSPC ;NO FIRST ONE SO NO SPACE
|
|
CMP #$82 ;WAS IT NEXT
|
|
BEQ SKPSPC ;YES SO NO SPACE
|
|
JSR OUTSPC ;OTHERWISE YES
|
|
SKPSPC PLA
|
|
CMP #$82 ;NEXT TOKEN?
|
|
BNE FCFIN ;NO
|
|
PHA ;YES SO
|
|
LDA FLAG ;SEE IF LAST TOKEN
|
|
CMP #$C4 ;WAS THEN
|
|
BEQ STRCNT1 ;NO
|
|
DEX
|
|
DEX ;YES REDUCE OFFSET
|
|
CPX #$06
|
|
BCS STRCNT ;OK TO PUT BACK
|
|
LDX #$06 ;DONT DROP BELOW MIN
|
|
STRCNT STX COUNT
|
|
STRCNT1 PLA
|
|
FCFIN STA FLAG ;SAVE TOKEN FOR NEXT TIME
|
|
FCFIN2 RTS
|
|
*
|
|
*GENERAL SUBROUTINES*
|
|
*
|
|
ISWAIT LDA KBD ;KEY PRESSED ON ENTRY
|
|
BPL WAITFIN ;NO SO QUIT
|
|
BIT KBDSTRB ;YES, CLEAR
|
|
CMP #$83 ;IS IT CNTRL C?
|
|
BEQ HNDLCC ;HANDLE IT
|
|
KBDWT2 LDA KBD ;NO,SO WAIT FOR ANOTHER ONE
|
|
BPL KBDWT2
|
|
BIT KBDSTRB ;CLEAR IT
|
|
CMP #$83 ;IS CNTRL C NOW?
|
|
BEQ HNDLCC ;YES
|
|
WAITFIN CLC ;NO BREAK CODE
|
|
RTS ;RETURN
|
|
*
|
|
HNDLCC JSR CROUT ;SEND A CARRIAGE RETURN,RETURNS WITH CARRY SET
|
|
SEC
|
|
RTS
|
|
*
|
|
*
|
|
*
|
|
LININIT BCC GTLN1 ;LINE # AT TXTPTR ON ENTRY
|
|
BEQ GTLN1 ;NO SO END OF COMMAND
|
|
CMP #$C9 ;NO SO IS DASH
|
|
BEQ GTLN1 ;YES
|
|
CMP #$2C ;IS COMMA
|
|
BNE ERFIN ;NO SO RETURN
|
|
GTLN1 JSR LINGET
|
|
JSR FINDLIN ;PUTS ADDRESS IN USLIN
|
|
LDA LOWTR ;STORE IT IN A BETTER PLACEW
|
|
STA USLIN
|
|
LDA LOWTR+1
|
|
STA USLIN+1
|
|
JSR CHRGOT ;WAS THIS EOL
|
|
BEQ CKLIN ;YES
|
|
CMP #$C9 ;DASH NOW
|
|
BEQ GTLN2 ;YES
|
|
CMP #$2C ;WAS COMMA
|
|
BNE ERFIN ;NO SO DONE
|
|
GTLN2 JSR CHRGET
|
|
JSR LINGET ;NEXT ONE
|
|
BEQ CKLIN ;OK IF EOL
|
|
JSR CHKCOM ;OTHERWISE COMMA
|
|
CKLIN LDA LINNUM
|
|
ORA LINNUM+1 ;WAS SECOND LINE NUMBER 0?
|
|
BNE LINFIN ;NO SO USE
|
|
LDA #$FF ;YES SO SET AT MAX
|
|
STA LINNUM
|
|
STA LINNUM+1
|
|
BMI LINFIN ;ALWAYS
|
|
ERFIN PLA
|
|
PLA
|
|
LINFIN RTS
|
|
*
|
|
LINCHK LDY #$01
|
|
LDA (USLIN),Y ;GET LINE NUMBER
|
|
BEQ QUIT ;END OF PROG
|
|
INY
|
|
LDA (USLIN),Y
|
|
TAX ;LOW OF LINNUMBER
|
|
LINCHK2 INY
|
|
LDA (USLIN),Y
|
|
CMP LINNUM+1 ;=LAST LINE HI?
|
|
BNE CKFIN ;NO
|
|
CPX LINNUM ;=LAST LO?
|
|
BEQ CKOK ;YES, DO LAST
|
|
CKFIN BCS QUIT ;IF> THEN DONE
|
|
CKOK CLC ;NOT DONE, CARRY CLEAR EXIT
|
|
DFB $24 ;HIDES
|
|
QUIT SEC
|
|
RTS ;CARRY SET EXIT
|
|
*MAKE WINDOW NARROW
|
|
WINDOW33 LDA #$21
|
|
STA AWNDWDTH
|
|
RTS
|
|
*
|
|
*
|
|
*SHOW CNTRL CHRS IN INVERSE SWITCH ON*
|
|
SHOWSW LDA #<COUT2
|
|
LDX #>COUT2
|
|
BNE HKSETO ;ALWAYS
|
|
NOSHOW LDA #<COUT1
|
|
LDX #>COUT1
|
|
JMP HKSETO
|
|
*ACTUAL SHOW ROUTINE*
|
|
COUT2 CMP #$8D ;RETURN
|
|
BEQ JCOUT
|
|
CMP #$88 ;BACKSPACE
|
|
BEQ JCOUT
|
|
CMP #$80
|
|
BCC JCOUT ;CNTRL CHRS BETWEEN #$80
|
|
CMP #$A0
|
|
BCS JCOUT ;AND $A0
|
|
PHA
|
|
STY YSAVE
|
|
SEC
|
|
SBC #$40 ;CNTRLS WILL BE INVERSE
|
|
JMP COUTZ ;SKIP PART OF COUT
|
|
JCOUT JMP COUT1 ;DO REGULAR
|
|
*
|
|
*ROUTINES FOR SETTING HOOKS
|
|
*ENTER WITH HI IN X, LO IN A
|
|
*
|
|
HKSETO STA VECTOUT
|
|
STX VECTOUT+1
|
|
RTS
|
|
*
|
|
HKSETI STA VECTIN
|
|
STX VECTIN+1
|
|
RTS
|
|
*
|
|
put t.ultra.s
|
|
*
|
|
*UPPER/LOWER CASE PROCESSOR
|
|
*WITH SHIFT MODIFICATION
|
|
*
|
|
*INITIALIZER
|
|
*
|
|
LCASE PHP ;SAVE STATUS
|
|
LDY #$00
|
|
STY FLAGS ;COME ON ALL UPPER CASE
|
|
DEY ;AND ALTER RESET FLAG
|
|
STY FLG2
|
|
PLP ;CHECK FOR EOC
|
|
BEQ LCASER
|
|
PHA ;IF NOT EOC
|
|
JSR CHRGET ;GOBBLE
|
|
PLA
|
|
SEC
|
|
SBC #$C8 ;CHECK FOR +
|
|
BEQ LCASE0 ;IF SO FORCE ORD
|
|
TAX
|
|
DEX ;NOW WAS IT -?
|
|
BEQ ENHANCE ;YES
|
|
LCASER LDA GETNUMM+8 ;NO, SO IS FRANKLIN
|
|
CMP #$FC
|
|
BEQ ENHANCE ;YES SO FORGET LC
|
|
LDA SIGBYTE ;OR //E
|
|
CMP #$06
|
|
BEQ ENHANCE ;SAME
|
|
LCASE0 LDA #<LCIN ;FOR KSWL
|
|
LDX #>LCIN
|
|
LCASE1 EQU *
|
|
TOHK JMP HKSETI ;AND GIVE TO DOS
|
|
*
|
|
LCASERST BIT FLG2 ;WAS IN - MODE?
|
|
BVS LCASE0 ;NO,RESET WITH ORDINARY
|
|
*
|
|
*SKIP ALL LC IF IN RIGHT MACHINE
|
|
*
|
|
ENHANCE LDA #$BF ;CANCEL VPART OF FLAG FOR RESET
|
|
AND FLG2
|
|
STA FLG2
|
|
LDA #<LCIN2
|
|
LDX #>LCIN2
|
|
SEC
|
|
BCS LCASE1
|
|
*
|
|
*
|
|
*
|
|
*ACTUAL INPUT ROUTINES
|
|
*
|
|
*IF A JSR FROM NEXTCHR ($FD77)
|
|
*IS ON THE STACK WE MUST CUT
|
|
*AROUND TO $FD83 TO ALLOW FOR
|
|
*LOWER CASE.
|
|
* IF FROM ESC THEN STACK HAS
|
|
*$FD31 AND IF FROM ESCNOW THEN
|
|
*$FBA4. FOR BOTH WE WILL SKIP
|
|
*ALL PARSING AND LET MONITOR DO
|
|
*IT.
|
|
*
|
|
*SINCE NEITHER FB77 NOR FDA4 CAN
|
|
*COME UP THIS METHOD IS SAFE
|
|
*
|
|
*
|
|
*
|
|
LCIN CLC ;ORD APPLE ENTRY
|
|
BCC LCIN3 ;ALWAYS
|
|
LCIN2 SEC ;FAKE APPLE AND //E ENTRY
|
|
LCIN3 JSR IOSAVE ;SAVE ALL
|
|
*NOTE: A IS IN ACC AT $45
|
|
LDA CNTVAL ;IN CASE ARROW
|
|
STA LCCNT
|
|
BCS FIXFIN ;IF ON FAKE
|
|
*NOW FIX STACK FOR REG APPLE
|
|
TSX ;GET STACK COUNTER
|
|
LDY #$02 ;COUNTER
|
|
STY STATUS ;SETS Z BIT FOR NORMAL FLAG
|
|
FIX0 LDA STKOFF+3,X
|
|
CMP #$FD ;WAS JSR FROM NXTCHR OR ESC?
|
|
BEQ CMPLO ;NO
|
|
CMP #$FB ;FROM ESCNOW?
|
|
BNE FIX1 ;NO
|
|
CMPLO LDA STKOFF+2,X ;MAYBE
|
|
CMP #$31 ;WAS IS FROM ESC?
|
|
BEQ SETP ;YES
|
|
CMP #$A4 ;MAYBE ESCNEW
|
|
BNE NXTCMP ;NO TRY NEXT
|
|
SETP LSR STATUS ;CLEARS Z FOR FLAG
|
|
NXTCMP CMP #$77 ;SO WAS FROM NEXTCHR?
|
|
BNE FIX1 ;NO SO GO ON
|
|
LDA #$83 ;YES SO FIX THAT RTS
|
|
STA STKOFF+2,X
|
|
FIX1 DEY ;CHECK TO SEE IF DONE
|
|
BEQ FIXFIN ;YES
|
|
INX ;NO SO DO AGAIN
|
|
INX
|
|
BNE FIX0 ;ALWAYS
|
|
FIXFIN JSR IOREST
|
|
*
|
|
*NOW SEE WHAT WE'VE GOT
|
|
PHP ;STORE THAT FLAG
|
|
CMP #$A0 ;IS CURSOR?
|
|
BNE NOTCUR ;NO
|
|
BIT FLAGS ;UPPER CASE
|
|
BPL TOSCRN ;YES
|
|
LDA #$FF ;NO SO LC CURSOR
|
|
BNE TOSCRN1
|
|
NOTCUR CMP #$E0 ;HOLDING LC?
|
|
BMI TOSCRN ;NO SO OK TO OUTPUT
|
|
EOR #$20 ;USE UPPER CASE UNDER CURSOR
|
|
TOSCRN AND #$3F ;CURSOR DOES NOT FLASH
|
|
TOSCRN1 STA (BASL),Y
|
|
LDA #$00
|
|
STA FLAG ;ZERO SHIFT FLAG
|
|
LDA ACC ;GET CHR BACK FOR SCREEN
|
|
JSR KEYIN
|
|
BIT SHIFT ;SHIFT PRESSED
|
|
BPL TOSCRN2 ;NO
|
|
DEC FLAG ;YES
|
|
TOSCRN2 PLP ;NOW GET THAT FLAG WE SET
|
|
BCS ISLEFT ;ON FAKE
|
|
BNE INFIN0 ;WE'RE ON ESC IF Z NOT SET
|
|
*
|
|
*
|
|
*NOW SEE IF IT IS A SHIFT
|
|
*
|
|
CMP #$9B ;IS IT ESC - OUR SHIFT KEY?
|
|
BNE NOTSHFT ;NO
|
|
*
|
|
*SHIFT, SO INCE NI NIBBLE IS 1001
|
|
*
|
|
BIT FLAGS ;WHAT IS OLD STATE OF FLAG?
|
|
BPL UC ;IF NOT LCASE
|
|
ASL FLAG ;IS ESC AND SHIFT?
|
|
BCC UCL ;YES SO LOCK UC
|
|
LSR A ;NOW 0100 FOR TEMP UC
|
|
UC BVC SHFTFIN ;IF LCASE OR UC LOCK BEFORE
|
|
UCL ASL A ;NOW 0010 AND UC LOCK
|
|
SHFTFIN STA FLAGS
|
|
*
|
|
TOKEY JMP RDKEY ;AND GO AROUND AGAIN
|
|
*
|
|
*RIGHT ARROW HAS ALSO BEEN CUT
|
|
*OUT AND MUST BE HANDLED HERE.
|
|
*
|
|
NOTSHFT CMP #$95 ;IS IT RIGHT ARROW
|
|
BNE NEWESC ;NO
|
|
LDA (BASL),Y ;YES SO USE SCREEN
|
|
RTS
|
|
*CNTRL-A IS CHANGED TO ESC AND
|
|
*RETURNED FOR THE MONITOR
|
|
*TO HANDLE AS USUAL
|
|
*
|
|
NEWESC CMP #$81 ;WAS IT CNTRL A
|
|
BNE ISLEFT ;NO
|
|
LDA #$9B ;AND RETURN HOLDING ESC
|
|
INFIN0 RTS
|
|
*
|
|
*ENHANCEMENTS:
|
|
*CNTRL-W WILL DO MULTIPLE RIGHT
|
|
*ARROWS, COPYING 16 CHARACTERS
|
|
*FROM THE SCREEN. CNTRL-Q WILL
|
|
*BACKSPACE EIGHT OR TO START OF
|
|
*LINE. USER CAN CHANGE THESE
|
|
*
|
|
*
|
|
ISLEFT CMP #$91 ;IS CNTRL Q FOR LEFT
|
|
BNE ISRIGHT ;NO
|
|
BAKLUP TXA ;TEST INPUT INDEX
|
|
BEQ TOKEY ;ANDQUIT IF N.G.
|
|
JSR BS ;BACKSPACVE CURSOR
|
|
DEX ;REDUCE INDEX
|
|
DEC LCCNT
|
|
BNE BAKLUP
|
|
BEQ TOKEY
|
|
*
|
|
ISRIGHT CMP #$97 ;IS CNTRL-W FOR RIGHT?
|
|
BNE ISEXIT ;NO
|
|
ASL LCCNT ;RIGHT IS DOUBLE LEFT
|
|
SCRPICK LDA (BASL),Y ;PATCH OVER OR OMIT IF
|
|
DEC LCCNT ;NOT WANTED
|
|
BEQ INFIN0 ;LET MONITOR DO LAST ONE
|
|
STA IN,X
|
|
JSR STORADV
|
|
LDY CH
|
|
INX
|
|
BNE SCRPICK ;ALWAYS
|
|
*
|
|
*CNTRL-N IS QUIT THIS MODE
|
|
*
|
|
ISEXIT CMP #$8E ;IS CNTRL-N?
|
|
BNE ISMON ;NO
|
|
JSR SETKBD
|
|
LDA #$00
|
|
STA FLG2 ;PUT RESET FLG BACK
|
|
JMP BI_ENTRY
|
|
*
|
|
*HOW ABOUT JUMP TO MONITOR?
|
|
*
|
|
ISMON CMP #$9D ;IS SHFT-CNTRL-M FOR MON?
|
|
BNE ISESC ;NO
|
|
JMP MON ;YES GO THERE
|
|
*
|
|
*ESC KEY SENDER
|
|
ISESC CMP #$85 ;IS CNTRL-E?
|
|
BNE ISREG ;NO
|
|
ESCSND LDA KBD ;WHAT CHR?
|
|
BPL ESCSND ;UNTIL WE GET IT
|
|
BIT KBDSTRB ;CLEAR
|
|
PHA
|
|
CMP #$AB ;IS IT +?
|
|
BNE ESND2 ;NO
|
|
JSR CROUT ;YES ,DO CR
|
|
PLA
|
|
BMI ESCSND ;AND GET ANOTHER ONE
|
|
ESND2 LDA #$9B ;ESC
|
|
JSR COUT ;SEND IT
|
|
PLA
|
|
ESND3 JSR COUT ;AND SEND THIS TOO
|
|
JMP RDKEY
|
|
*
|
|
ISREG CMP #$92 ;CNTRL-R FOR REGS
|
|
BNE ISKEY ;NO
|
|
JSR $FADA ;DISPLAY REGS
|
|
LDA #$8D ;AND THEN A RETURN BACK
|
|
JSR COUT
|
|
LDA PROMPT
|
|
BNE ESND3
|
|
*
|
|
*CHECKS FOR SPECIAL KEYS
|
|
*
|
|
ISKEY CMP #$8B ;IS CNTRL-K?
|
|
BNE LETTER ;NO
|
|
JSR RDKEY ;YES, WHAT FOLLOWS?
|
|
AND #$0F ;HI NIBBLE ONLY WANTED
|
|
ORA #$D0 ;NOW LOWER SET OF SPECIALS
|
|
ASL FLAG ;SHIFT MOD?
|
|
BIT FLAGS ;OR UPPER CASE?
|
|
*
|
|
BCC INFIN ;SHIFT SO USE THESE
|
|
BPL INFIN ;U.C.LOCK SO USE THESE
|
|
BMI INFINL ;LC SO USE NEXT SET
|
|
*
|
|
*NOT A SPECIAL CHARACTER SO MUST
|
|
*PROCESS AS A LETTER
|
|
*
|
|
LETTER PHA ;SAVE IT
|
|
LDA STATUS ;AND RECOVER ORIG STATUS FLAG
|
|
PHA
|
|
PLP
|
|
PLA
|
|
BCS INFIN ;QUIT IF FAKE ON
|
|
CMP #$C0 ;IS IT A LETTER?
|
|
BMI INFIN ;NO SO NORMAL
|
|
ASL FLAG ;CHECK FOR SHFT KEY MOD AND PRESSED
|
|
BIT FLAGS ;LC OR UC
|
|
BPL INFINU ;NOT LC SO TO UC SECTION
|
|
BCC INFINS ;IF LC AND SHFT
|
|
INFINL ORA #$E0 ;TO LC
|
|
INFINU BVC INFIN ;UC BUT NOT JUST TEMP
|
|
ASL FLAGS ;TEMP UC= > LC LOCK
|
|
RTS
|
|
INFINS CMP #$DB ;ONLY IF LC+SHIFT
|
|
BCS INFINE ;CHANGE SHFT M AND N TO UC
|
|
CMP #$C0 ;ALSO SHFT P
|
|
BNE INFIN ;IF NOT
|
|
INFINE EOR #$10
|
|
INFIN RTS
|
|
*
|
|
*
|
|
*
|
|
*FIX AFTER ONERR GOTO*
|
|
*APPLE MANUAL ROUTINE*
|
|
FIX PLA
|
|
TAY
|
|
PLA
|
|
LDX #$DF
|
|
TXS
|
|
PHA
|
|
TYA
|
|
PHA
|
|
RTS
|
|
*SWAP ROUTINE*
|
|
SWAP JSR PTRGET ;GET FIRST ONE IN A,Y
|
|
STA STRPTSV ;STORE IT
|
|
STY STRPTSV+1
|
|
LDA VARNAM
|
|
PHA ;SAVE NAME
|
|
LDA VARNAM+1
|
|
PHA
|
|
JSR CHKCOM
|
|
JSR PTRGET ;GET OTHER ONE
|
|
PLA
|
|
EOR VARNAM+1 ;CHECK TYPES
|
|
BMI ERR ;DONT MATCH
|
|
PLA
|
|
EOR VARNAM
|
|
BMI ERR
|
|
*FOLLOWING CHECK SAVES CYCLES WHEN DOING
|
|
*ORDINARY VARIABLES AND IS NECESSARY FOR
|
|
*ARRAYS BECAUSE OF THE DIFFERENT WAY THEY ARE STORED
|
|
LDY #$02 ;SET UP DEFAULT (STRING) COUNT
|
|
BIT VARNAM ;FIRST BYTE NEG?
|
|
BMI SWAP2 ;YES=>INTEGER AND USE 2 TO SWAP
|
|
BIT VARNAM+1 ;NO,SO SECOND BYTE NEG?
|
|
BMI SWAP1 ;YES =>STRING AND 3 TO SWAP
|
|
INY ;SWAP ALL FIVE FOR REALS
|
|
INY ;NOW 4
|
|
SWAP1 LDA (STRPTSV),Y
|
|
PHA
|
|
LDA (VARPNT),Y
|
|
STA (STRPTSV),Y
|
|
PLA
|
|
STA (VARPNT),Y
|
|
SWAP2 DEY
|
|
BPL SWAP1
|
|
RTS
|
|
ERR JMP MMCH
|
|
*
|
|
*MOVE A STRING TO A LOCATION*
|
|
* SYNTAX: CALL ADRS MID$ (A$,ST,LEN),ADDRSS
|
|
MOVE JSR FRMEVAL
|
|
JSR CHKCOM
|
|
JSR FRESTR
|
|
BEQ MVFIN ;DONT MOVE ZERO LENGTH STRINGS
|
|
STA STRLEN ;SAVE LENGTH
|
|
STX STRLO ;SSAVE POINTERS
|
|
STY STRHI
|
|
JSR INNUM ;GET ADDRESS TO MOVE IN A2
|
|
LDA #$03 ;DONT ALLOW MOVES TO LOMEM
|
|
CMP A2L+1 ;BELOW $400
|
|
BCS ERR2
|
|
LDY #$00 ;GET START
|
|
DOIT LDA (STRLO),Y
|
|
STA (A2L),Y
|
|
INY
|
|
CPY STRLEN
|
|
BNE DOIT
|
|
MVFIN RTS
|
|
ERR2 LDX #$31 ;DATA ERROR
|
|
JMP ERROR
|
|
*
|
|
* CHN ASDM2.0.1
|
|
*
|
|
*
|
|
*STRING SUBSTITUTER*
|
|
*SYNTAX: LET <STREXP1>=<STREXP2>
|
|
*OR LET <STREXP>=ADDRSS,LEN
|
|
*OR LET A =PEEK (#EXP)
|
|
*OR LET A= EXP
|
|
*OR LET <STREXP>=ADDRSS,
|
|
*WITH NO LEN IT ASSUMES A DCI WITH HI BIT SET AT END AND CALCULATES LEN
|
|
*LAST ONE SETS UP AN ARRAY OUT OF SOMEBODIES TABLE
|
|
*
|
|
LET JSR MIDETC
|
|
LDA #$D0 ;=SIGN
|
|
JSR SYNCHR ;MUST BE NEXT
|
|
BIT VARTYP ;STRINGS?
|
|
BPL LETNUM ;NO
|
|
CMP #$24 ;IS $ ?
|
|
BEQ GETPTR ;YES SO POINTER COMING
|
|
JSR FRMEVAL ;NO SO FORMULA
|
|
BIT VARTYP ;IS IT A STRING?
|
|
BMI SUBSTR ;YES CARRY ON THERE
|
|
JSR DECAD2 ;NO SO PART OF GETPTR
|
|
SEC
|
|
BCS GETPTR2 ;SO GO THERE
|
|
GETPTR JSR INNUM ;NO SO POINTER AT KBD
|
|
GETPTR2 STA COUNT+1
|
|
STX COUNT
|
|
LDY #$02
|
|
STA (STRPTSV),Y ;HI TO DESC
|
|
DEY
|
|
TXA ;NOW LO
|
|
STA (STRPTSV),Y
|
|
JSR CHKCOM ;COMMA
|
|
BNE KBDLEN ;IF NOT AT END OF CMD
|
|
TYA ;NOW ZERO
|
|
EXLP LDA (COUNT),Y ;SEE WHATS THERE
|
|
BMI FNDEND ;HI BIT SET, FOUND ONE
|
|
INY
|
|
BNE EXLP ;TILL WE GET IT
|
|
FNDEND INY
|
|
TYA
|
|
BNE KBDLEN1
|
|
KBDLEN JSR INNUM ;LENGTH
|
|
TXA
|
|
KBDLEN1 LDY #$00
|
|
STA (STRPTSV),Y ;SET UP LENGTH
|
|
RTS
|
|
JSR FRMEVAL ;GET STRING
|
|
SUBSTR JSR FRESTR ;AND POINTERS
|
|
CMP STRLEN ;IS SECOND LENGTH > FIRST?
|
|
BEQ PUTAX ;EQUAL IS O.K.
|
|
BCS ERR2 ;YES SO BAD DATA
|
|
PUTAX TAX
|
|
BEQ LETFIN ;NONE TO DO SO QUIT
|
|
LDY #$00
|
|
DOSUB LDA (INDEX),Y
|
|
STA (STRLO),Y
|
|
INY
|
|
DEX
|
|
BNE DOSUB
|
|
LETFIN RTS
|
|
LETNUM CMP #$8B ;IS IN# ?
|
|
BNE LETNUM0 ;NO
|
|
JSR CHRGET ;YES
|
|
JSR INSFN ;DO INSTRING FUNCTION
|
|
BCC LETNUM1 ;ALWAYS
|
|
LETNUM0 CMP #$E2 ;IS PEEK TOKEN
|
|
BNE LETNUM2 ;NO
|
|
JSR CHRGET ;YES
|
|
JSR PEEKFN ;DO IT
|
|
LETNUM1 LDY STRPTSV+1 ;GET POINTERS
|
|
LDX STRPTSV
|
|
JMP MOVMF
|
|
LETNUM2 JSR INNUM ;# EXPRESSION
|
|
LDY A2L ;WAS IN X,AND HIGH IS IN A
|
|
JSR GIVAYF ;FLOAT IT
|
|
SEC
|
|
BCS LETNUM1 ;ALWAYS
|
|
*
|
|
********REVERSE***********
|
|
*REVERSES A STRING IN MEMORY*
|
|
* SYNTAX: CALL ADRS A$ *
|
|
*PROGRAM STARTS HERE*
|
|
REVERSE JSR MIDETC
|
|
LDY #$01 ;CHECK LENGTH
|
|
CPY STRLEN ;OF STRING
|
|
BCS REVFIN ;AND IF <=1 DO NOTHING
|
|
DEY ;CHANGE TO ZERO
|
|
STY YSAVE ;INIT COUNTER
|
|
DEC STRLEN ;POINT TO EOS NOT LENGTH
|
|
DOIT2 LDY YSAVE
|
|
LDA (STRLO),Y ;GET FIRST
|
|
PHA ;AND PUSH IT
|
|
LDY STRLEN
|
|
LDA (STRLO),Y ;NOW GET LAST
|
|
TAX ;AND SAVE IT
|
|
PLA ;RETREIVE FIRST
|
|
STA (STRLO),Y ;PUT TO LAST PLACE
|
|
LDY YSAVE
|
|
TXA ;RETREIVE LAST
|
|
STA (STRLO),Y ;PUT IN FIRST
|
|
DEC STRLEN
|
|
INY
|
|
STY YSAVE
|
|
CPY STRLEN
|
|
BCC DOIT2 ;GO BACK IF COUNTERS DONT COLLIDE
|
|
REVFIN RTS
|
|
*
|
|
*CONVERT A PROGRAM UPPER CASE
|
|
*TO LOWER CASE AND VICE VERSA
|
|
*SYNTAX CRT+OFFSET TO UPPER
|
|
*AND CRT-OFFSET TO LOWER
|
|
*LOOKS FOR " AND SKIPS FIRST
|
|
*OFFSET CHRS IN EACH STRING
|
|
*
|
|
CNVERT CMP #$3B ;HOLDING SEMI?
|
|
BNE CVCKP ;NO
|
|
JMP CNVERT1 ;YES IS STRING
|
|
CVCKP CMP #$50 ;HOLDING A P
|
|
BEQ CVRTP ;YES
|
|
JMP CNVERT2 ;NO SO SINGLE STRING
|
|
CVRTP JSR CHRGET ;YES SO GOBBLE
|
|
CMP #$56 ;A V NEXT?
|
|
BNE CNVERT0 ;NO
|
|
JSR CHRGET ;YES GOBBLE
|
|
DEC CFLAG ;AND SET FLAG
|
|
CNVERT0 JSR CHRGOT ;NEED FLAGS SET UP
|
|
JSR LININIT ;AND SET UP LINENUMBERS
|
|
JSR CHRGOT
|
|
CMP #$C8 ;HOLDING +?
|
|
BNE ISLOW ;NO
|
|
LDA #$20 ;YES SO MASK
|
|
BPL CRTPRG ;AND GO TO IT
|
|
ISLOW CMP #$C9 ;IS - FOR LC
|
|
BEQ CRTPRG1 ;YES SO LEAVE MASK ZERO
|
|
JMP ERR4 ;NO SO ERROR
|
|
CRTPRG STA FLAG ;STORE MASK
|
|
CRTPRG1 LDX #$00
|
|
JSR CHRGET ;ADVANCE
|
|
BEQ PRG2 ;IF END OF CMD
|
|
JSR GETBYT ;GET OFFSET
|
|
PRG2 INX ;ADD ONE
|
|
STX COUNT ;AND SAVE IT
|
|
ISEND JSR LINCHK
|
|
BCS REVFIN ;DONE
|
|
LDY #$03 ;SKIP LINENUMBER
|
|
SEARCH2 INY ;LOOK FOR A QUOTE
|
|
SEARCH2A LDA (USLIN),Y
|
|
BEQ NEXTLN ;END OF LINE
|
|
CMP #$22 ;GOT ONE?
|
|
BEQ SETQTST ;YES
|
|
CMP #$B2 ;IS A REM
|
|
BEQ SETQTST ;YES SET STATE ALSO
|
|
LDA LFLAG ;NEITHER, SO QUOTESTATE ON?
|
|
BNE CRTPUT0 ;YES GO CHECK IF DO STRING
|
|
BIT CFLAG ;NO SO IS V STATE ON
|
|
BPL SEARCH2 ;NOT SO RECYCLE
|
|
BMI CRTPUT1 ;YES SO DO CONVERT
|
|
SETQTST EOR LFLAG
|
|
STA LFLAG ;TOGGLE STATE
|
|
BEQ SEARCH2 ;WAS ON NOW OFF SO RECYCLE
|
|
LDX COUNT ;TURNED ON SO GET SKIP COUNT
|
|
INX
|
|
CRTPUT0 LDA COUNT ;OFFSET 0
|
|
BEQ SEARCH2 ;GO AROUND UNTIL QUOTESTATE RESET
|
|
TXA ;CHECK X NOW
|
|
BEQ CRTPUT1 ;AND GO THROUGH IF 0
|
|
DEX ;OTHERWISE REDUCE
|
|
BNE SEARCH2 ;AND IF NOT SKIP TILL IT IS
|
|
CRTPUT1 LDA (USLIN),Y
|
|
CMP #$41 ;NO, SO IS IN RANGE OF
|
|
BCC SEARCH2 ;$21 TO $7F
|
|
CMP #$7F
|
|
BCS SEARCH2
|
|
ORA #$20 ;TO LC
|
|
EOR FLAG ;STAYS OR CONVERTS TO UC
|
|
STA (USLIN),Y ;PUT IT BACK
|
|
BNE SEARCH2 ;ALWAYS
|
|
NEXTLN LDY #$00
|
|
STY LFLAG ;RESET QUOTE STATE
|
|
LDA (USLIN),Y ;FROM OLD LINE
|
|
PHA ;GET NEW #
|
|
INY
|
|
LDA (USLIN),Y
|
|
STA USLIN+1
|
|
PLA
|
|
STA USLIN
|
|
SEC
|
|
BCS ISEND ;ALWAYS TAKEN
|
|
*
|
|
*
|
|
*********CONVERT************
|
|
*CONVERT A STRING IN MEMORY*
|
|
*TO A FORMAT DETERMINED BY *
|
|
*I,F,OR N AND FROM ANYTHING*
|
|
*SYNTAX: CALL ADRSS OR *
|
|
*CONVERTMID$(A$,ST,#),X WHERE THE *
|
|
*X IS LC=0,N=1,F=2,I=3,LOLC=4(LAST THREE MOD4)
|
|
*AND IF NEG >127 THEN FLASH*
|
|
*OR INV IN THE ORIGINAL STRING*
|
|
*
|
|
CNVERT1 JSR CHRGET ;GOBBLE ENTRY FOR SEMI
|
|
CNVERT2 JSR MIDETC
|
|
LDY #$FF
|
|
STY IFLAG ;$FF=NORMAL
|
|
JSR COMBYT ;GET FLAG
|
|
TXA
|
|
BPL CKLC ;NO HIGH BIT=>REG INPUT
|
|
LDY #$40 ;YES SO SET FLAG
|
|
STY CFLAG
|
|
CKLC AND #$07 ;SAVE LAST 3 BITS
|
|
CMP #$04 ;IS IT 4 FOR LO LC?
|
|
BNE CKLC2 ;NO
|
|
DEC FLAG ;SET FLAG FOR THIS
|
|
LSR IFLAG ;YES SO DO AS NORMAL
|
|
CKLC2 AND #$03 ;WIPE ALL BUT LAST TWO BITS
|
|
TAX ;AND PUT BACK IN X
|
|
DEX ;NOW IN RANGE -1 TO 2
|
|
BPL SET1 ;SKIP NEXT UNLESS LC (-1)
|
|
LDA #$20 ;LC GETS BOTH BITS SET
|
|
STA LFLAG
|
|
BPL GETFLG ;ALWAYS IF HERE
|
|
SET1 DEX
|
|
BMI GETFLG ;FINISHED IF NEG
|
|
LSR IFLAG ;$FF-$7F-$3FDEPENDING ON CONV TYPE
|
|
BNE SET1
|
|
GETFLG LDX IFLAG
|
|
LDY #$FF
|
|
GETCHR INY
|
|
CPY STRLEN ;UP TO LENGTH?
|
|
BEQ CRTFIN
|
|
LDA (STRLEN+1),Y
|
|
CMP #$20 ;IS<$20 (CNTRL INPUT, SAY)
|
|
BCC FIXC ;YES,SO DO THIS
|
|
CMP #$60 ;FLASH?
|
|
BCC TOHIGH ; NO, VALUES TOO LOW
|
|
CMP #$80
|
|
BCS TOHIGH ; NO AGAIN, TOO HIGH
|
|
BEQ TOHIGH
|
|
FIXC EOR CFLAG ; HIT WITH FLAG
|
|
*FLAG 0 ,STAYS CNTRL OR LCASE (REG KBD INPUT)
|
|
*FLAG $40 WAS FLASH OR INV AND WE DONT WANT*
|
|
*IT TO BECOME CNTRL OR LCASE *
|
|
TOHIGH ORA #$80 ;SET HIGH BIT(OR USE $A0 FOR LC)
|
|
CMP #$A1 ;IS CONTROL?
|
|
BCC PUTBACK ;YES SO DONT TOUCH
|
|
CMP #$E0 ;IS LC NOW?
|
|
BCC DOIFLG ;NO SO GO ON
|
|
CPX #$FF ;YES SO HEADING HI?
|
|
BNE DOIFLG ;NO SO GO ON
|
|
EOR #$20 ;YES SO MAKE NORMAL IN CASE NOT TO LC
|
|
DOIFLG AND IFLAG ;YES SO DO CONVERSION
|
|
ORA LFLAG
|
|
CPX #$7F ;TO FLASH?
|
|
BNE PUTBACK ;NO, SO DONE
|
|
BIT FLAG ;BUT IS LC4?
|
|
BMI PUTBACK ;YES, LEAVE NUMBERSS ALONE
|
|
ORA #$40 ;YES SO FLOP LETTERS AND NUMBERS
|
|
PUTBACK STA (STRLEN+1),Y ;AND GIVE IT BACK
|
|
BNE GETCHR ;ALWAYS
|
|
CRTFIN RTS ;YES SO ALL DONE
|
|
*SOME SUBROUTINES FOLLOW*
|
|
*
|
|
*MID$,LEFT$, AND RIGHT$ PARSER*
|
|
*NEED THIS WHEN OPERATING*
|
|
*ON THE STRING ITSELF AS *
|
|
*APPLESOFT CREATES A TEMP*
|
|
*STRING AND ERASES IT IF *
|
|
*FINISHED WITH IT. *
|
|
*
|
|
*
|
|
MIDETC JSR CHRGOT ;PICK UP LAST CHR
|
|
LDY #$00
|
|
STY YSAVE ;FOR DEFAULTS
|
|
JSR ISLETC ;LETTER NEXT?
|
|
BCC PARSE ;NO SO GO ON
|
|
JMP DOVAR ;YES EXIT WITH ORD PTRS
|
|
PARSE CMP #$E8 ;IS STR TOKEN?
|
|
BCC ERR4 ;NO SO ERROR
|
|
SBC #$E9 ;NOW Z=>RIGHT AND N=>LEFT (CARRY WAS SET)
|
|
PHP
|
|
JSR CHRGET ;YES SO GOBBLE IT
|
|
JSR CHKOPN ;AND OPEN (
|
|
JSR DOVAR ;GET BASIC POINTERS
|
|
JSR CHRGOT
|
|
CMP #$2C ;IS A COMMA NEXT
|
|
BNE CLS ;NO SO USE DEFAULTS
|
|
JSR GETBYTC ;YES SO GET FIRST NUMBER
|
|
PLP ;GET FLAG BACK
|
|
BEQ RIGHT
|
|
BMI LEFT
|
|
TXA ;CHECK FOR ZERO
|
|
BEQ HOWMANY ;IF SO, USE DEFAULT
|
|
DEX
|
|
CPX STRLEN ;IS > STRING LENGTH?
|
|
BCS ERR3 ;YES SO BAD DATA
|
|
STX YSAVE ;AND SAVE FOR LATER
|
|
TXA
|
|
JSR FIXSTRT ;O.K. SO USE
|
|
HOWMANY JSR CHRGOT
|
|
CMP #$2C ;IS THERE MORE?
|
|
BNE CLS ;NO SO USE STRING LENGTH
|
|
JSR GETBYTC ;YES, SO HOW MANY?
|
|
LEFT CPX STRLEN ;MORE THAN LENGTH?
|
|
BCS CLS ;YES SO USE LENGTH
|
|
STX STRLEN ;O.K. SO USE THIS NUMBER
|
|
BCC CLS ;ALWAYS
|
|
RIGHT STX YSAVE ;SAVE NUMBER
|
|
LDA STRLEN ;GET LENGTH
|
|
SEC
|
|
SBC YSAVE ;LESS THIS #
|
|
STA YSAVE
|
|
JSR FIXSTRT
|
|
CLS DEC VARTYP ;ENSURE THAT FLAG SET
|
|
JMP CHKCLS
|
|
*
|
|
*SUBROUTINES FOR ABOVE*
|
|
*
|
|
DOVAR JSR PTRGET
|
|
LDY #$02
|
|
SET LDA (VARPNT),Y
|
|
STA STRLEN,Y
|
|
LDA VARPNT,Y
|
|
STA STRPTSV,Y ;SAVE CONTENTS OF VARPNT TOO
|
|
DEY
|
|
BPL SET
|
|
RTS
|
|
*
|
|
FIXSTRT CLC ;ENTERS WITH REL. START IN A
|
|
ADC STRLEN+1
|
|
STA STRLEN+1 ;ADJUST START
|
|
BCC ADJLEN
|
|
INC STRLEN+2
|
|
ADJLEN LDA STRLEN
|
|
SEC
|
|
SBC YSAVE
|
|
BCC ERR3
|
|
STA STRLEN ;ADJUST LENGTH
|
|
RTS
|
|
*
|
|
ERR3 LDX #$35 ;ILLEGAL QUANTITY
|
|
PLA
|
|
PLA ;AND PULL THE LAST ADDRSS OFF STACK
|
|
DFB $2C ;HIDES NEXT
|
|
*
|
|
ERR4 LDX #$10 ;SYNTAX ERROR
|
|
DFB $2C ;HIDES
|
|
ERRUND LDX #$5A
|
|
JMP ERROR
|
|
*
|
|
*NEXT SAME AS CALL AND POKE IN SOFT
|
|
*EXCEPT CAN USE HEX OR HEXSTR IN
|
|
*
|
|
*PASS PARAMETERS IN $45-$48 AND GET THEM BACK THERE
|
|
*
|
|
CALL CMP #$E2 ;IS PEEK?
|
|
BNE CALL1 ;NO
|
|
JSR CHRGET ;YES
|
|
JSR PEEKFN ;GO DO IT
|
|
JSR GETADR
|
|
LDX LINNUM ;A HAS HI ALREADY
|
|
SEC
|
|
BCS CALL2
|
|
CALL1 JSR INNUM
|
|
CALL2 STX PCL ;ADDRESS IN MON GO
|
|
STA PCH
|
|
JSR GO+3 ;RESTORES REGS TOO
|
|
JMP IOSAVE ;NOW SAVE FOR USER
|
|
*
|
|
POKE JSR INNUM
|
|
LDY #$FF
|
|
STY YSAVE
|
|
STX COUNT
|
|
STA COUNT+1 ;ADDRESS TO POKE
|
|
GTPKNO JSR INNUMC
|
|
INC YSAVE
|
|
TXA ;LO BYTE
|
|
LDY YSAVE
|
|
STA (COUNT),Y
|
|
LDA A2H ;HI BYTE?
|
|
BEQ POKE2 ;NO
|
|
INY ;YES
|
|
STA (COUNT),Y
|
|
STY YSAVE
|
|
POKE2 JSR CHRGOT ;AT END OF COMMAND?
|
|
BNE GTPKNO ;NO,SO ANOTHER
|
|
RTS
|
|
*
|
|
*
|
|
*
|
|
*PRINTER TURN ON
|
|
*
|
|
PRINTON BCS ISSETUP ;NOSLOT#
|
|
JSR GETBYT ;OBTAIN SLOT
|
|
PHA ;SAVE NEXT
|
|
TXA ;TAKE SLOT
|
|
AND #$07 ;ENSURE 1-7
|
|
STA PSLOT ;STORE
|
|
PLA ;GET CHR
|
|
ISSETUP CMP #$2C ;COMMA NEXT
|
|
BNE PTRON ;NOSETUP SO DO IT
|
|
JSR CHRGET ;YES, GOBBLE
|
|
JSR FRMEVAL ;AND PARSE STRING
|
|
JSR FRESTR ;CHECKS FOR STRING
|
|
STA STRLEN ;SAVE LEN
|
|
LDX #$FF ;SET COUNTERS
|
|
LDY #$FF
|
|
SETUPLUP INY
|
|
INX
|
|
CPY STRLEN ;DONE SETUP STR
|
|
BLT CHKXTOO ;NO SO CARRY ON
|
|
LDA #$00 ;YES SO LAST ZERO
|
|
BEQ PUTINSTR
|
|
CHKXTOO CPX #$10 ;AT MAX
|
|
BEQ TOOLONG ;YES ERROR
|
|
LDA (INDEX),Y ;NEXT IN STR
|
|
CMP #$5E ;IS ^ FOR FLAG
|
|
BNE PUTINSTR ;NO
|
|
INY ;YES WHATS NEXT
|
|
LDA (INDEX),Y
|
|
CMP #$43 ;A C?
|
|
BNE CHKESC ;NO
|
|
INY ;YES, SO
|
|
LDA (INDEX),Y ;GET NEXT
|
|
AND #$1F ;UC AND LC BOTH TO CONTROL
|
|
BNE SPECX ;ALWAYS
|
|
CHKESC CMP #$45 ;IS E?
|
|
BNE PRERR2 ;NO ERROR
|
|
LDA #$1B ;REPLACE WITH ESC
|
|
SPECX CPY STRLEN ;PAST STRING?
|
|
BGE PRERR2 ;YES, WAS SYNTAX ERROR
|
|
PUTINSTR STA PRSTR,X ;PUT IT IN STRING
|
|
CPX #$10 ;TO PRESET LENGTH
|
|
BNE SETUPLUP ;NO, WILL FILL WITH ZEROS TILL DONE
|
|
PTRON LDA #$01 ;SET SLOT
|
|
PSLOT EQU PTRON+1 ;CAN BE CHANGED
|
|
ASL A ;DOUBLE FOR INDEX
|
|
TAX
|
|
LDA OUTVECT0,X
|
|
PHA ;PUSH LO
|
|
INX
|
|
LDA OUTVECT0,X ;GET HIGH
|
|
TAX
|
|
PLA
|
|
JSR HKSETO ;AND SET UP
|
|
LDA #<PRSTR ;NOW PRINT IT
|
|
LDY #>PRSTR
|
|
JMP STROUT
|
|
*
|
|
PRERR2 LDX #$10 ;SYNTAX
|
|
DFB $2C ;HIDES
|
|
TOOLONG LDX #$B0
|
|
JMP ERROR
|
|
TOERRUND JMP ERRUND
|
|
*
|
|
*STRINGS TO MOVE
|
|
PRNOSTR DCI 'PR#'
|
|
PRSTR DS $10,0
|
|
*
|
|
*
|
|
*RESTORE TO A LINE NUMBER
|
|
*
|
|
RESTOREN JSR FRMEVAL
|
|
JSR CHKNUM
|
|
JSR GETADR
|
|
JSR FINDLIN ;X AND A
|
|
LDY LOWTR+1
|
|
LDA LOWTR
|
|
SEC
|
|
SBC #$01
|
|
JMP RESTORE1 ;LET SSOFT FINISH
|
|
*
|
|
*CALCULATED GOTO AND GOSUB PROGRAMS
|
|
*
|
|
GOTO LDA #$FF
|
|
DFB $2C ;HIDES
|
|
GOSUB LDA #$00
|
|
PHA ;STORE A FLAG
|
|
JSR FRMEVAL ;EVALUATE LINE NUMBER
|
|
JSR CHKNUM
|
|
JSR GETADR ;AS AN ADDRESS
|
|
JSR FINDLIN ;FIND IT
|
|
PLA ;GET FLAG
|
|
BCC TOERRUND ;LINE NOT FOUND
|
|
BEQ GOSUB2 ;IF FLAG 0
|
|
JMP GOTOPL ;IF FLAG ><0
|
|
GOSUB2 LDA #$03 ;COPY OF APPLESOFT
|
|
JSR $D3D6 ;ROUTINE AT $D921
|
|
LDA TXTPTR+1
|
|
PHA
|
|
LDA TXTPTR
|
|
PHA
|
|
LDA CURLIN+1
|
|
PHA
|
|
LDA CURLIN
|
|
PHA
|
|
LDA #$B0
|
|
PHA
|
|
JSR CHRGOT ;DOWN TO HERE
|
|
JSR GOTOPL ;INSTEAD OF REG GOTO
|
|
JMP NEWSTT
|
|
*
|
|
*
|
|
*ENHANCED PRINT STATEMENT
|
|
*
|
|
*OUTPUT A STRING AS STORED*
|
|
*SYNTAX: CALL ADRS*'(RPT CNT) <STREXP1> CONJ <STREXP2> ETC
|
|
* ' IS RPT COUNT DELIMITER AND *IS LITERAL DELIMITER
|
|
*
|
|
OUTPUT JSR FRMEVAL ;NEXT ITEMNG
|
|
OUT0 BIT VARTYP ;IS IT A STRING
|
|
BMI OUTF ;YES SO GO ON
|
|
JSR PRNTFAC ;NO SO NUMBER OUTPUT
|
|
BEQ FIXCNT ;AND RESTART PROCESS-ALWAYS
|
|
OUTF BIT FLAG ;REG ? ROUTINE?
|
|
BPL APDO ;YES USE APPLESOFT
|
|
JSR FREFAC ;NO USE OURS
|
|
TAX
|
|
BEQ FIXCNT ;DO NOTHING IF ZERO LENGTH STRING (UND)
|
|
LDY #$00
|
|
OUT1 LDA (INDEX),Y
|
|
JSR COUT
|
|
LDA SPDBYT
|
|
JSR WAIT ;IF SPEED IN EFFECT
|
|
INY
|
|
DEX
|
|
BNE OUT1 ;TILL FINISHED STRING
|
|
BEQ FIXCNT ;ALWAYS IF HERE
|
|
APDO JSR STRPRT ;THEIRS IS REG PRINT
|
|
FIXCNT LDA USLIN+1 ;IS DELIMITER ACTIVE?
|
|
BNE PRINT
|
|
LDX COUNT
|
|
BEQ PRINT ;COUNT NOT ACTIVE
|
|
DEC COUNT
|
|
BNE OUT0 ;IF MORE TO DO
|
|
*OTHERWISE FALL INTO PRINT
|
|
*
|
|
*MAIN ENTRY POINT FOR THESE ROUTINES FOLLOWS
|
|
*
|
|
* PARSE CONJUNCTIONS *
|
|
*
|
|
PRINT JSR CHRGOT
|
|
BNE CONJA ;EOL? -NO SO GO ON
|
|
LDA USLIN+1 ;YES SO IS ' ACTIVE?
|
|
BEQ CRBACK ;NO SO DONE
|
|
JSR CONR1 ;YES SO RESTORE POINTERS
|
|
SEC
|
|
BCS PRINT ;AND GO AGAIN
|
|
CONSEMI PLA ;DONT RETURN TO SRCH
|
|
PLA
|
|
SEC
|
|
ROR CMD ;SET FLAG
|
|
BMI PRINT ;ALWAYS
|
|
CRBACK ROL CMD ;CHECK SEMI FLG
|
|
BCS RTS5 ;NO CR IF SET
|
|
JMP CROUT ;DO CR AND EXIT
|
|
RTS5 RTS ;GO BACK
|
|
CONJA LSR CMD ;ZERO SEMI FLAG
|
|
LDY #$0D ;TABLE SIZE +1
|
|
SRCH DEY
|
|
BMI OUTPUT ;IF CANT FIND ASSUME READY TO PRINT
|
|
CMP CONTBL,Y ;CHECK TABLE FOR CHR IN A
|
|
BNE SRCH ;RPT IF NOT FOUND
|
|
JSR TOCONJ ;GO DO IT
|
|
SEC
|
|
BCS PRINT ;AND REPEAT
|
|
TOCONJ TYA
|
|
ASL A ;DOUBLE INDEX
|
|
TAX
|
|
LDA CCTBL+1,X
|
|
PHA ;AND GOTO
|
|
LDA CCTBL,X ;SUBROUTINE VIA RTS
|
|
PHA
|
|
JMP CHRGET ;GOBBLE TO NEXT FIRST
|
|
CONTBL DFB $CA ;*FOR LITERAL PRINT
|
|
DFB $28 ;( FOR GETTING COUNT
|
|
DFB $27 ;' DELIMITER FOR REPEATS
|
|
DFB $C0 ;TAB TOKEN
|
|
DFB $C3 ;SPC( TOKEN
|
|
DFB $2C ;COMMA FOR NEXT TAB POSITION
|
|
DFB $3B ;SEMICOLON FOR CR SUPPRESS
|
|
DFB $25 ;% FOR HEX OUTPUT
|
|
DFB $C5 ;AT TOKEN
|
|
DFB $97 ;HOME TOKEN
|
|
DFB $E2 ;PEEK
|
|
DFB $8B ;IN# TOKEN
|
|
DFB $D5 ;USR TOKEN
|
|
CCTBL DW CONLIT-1
|
|
DW CONOPN-1
|
|
DW CONRPT-1
|
|
DW CONTAB-1
|
|
DW CONSPC-1
|
|
DW CONCOM-1
|
|
DW CONSEMI-1 ;SEMICOLON DOES NOTHING
|
|
DW CONHEX-1 ;HAVE THIS ELSEWHERE
|
|
DW CONAT-1
|
|
DW HOME-1
|
|
DW CONPEEK-1
|
|
DW CONINST-1
|
|
DW USING-1
|
|
CONLIT LDA #$FF ;YES,SET FLAG
|
|
EOR FLAG
|
|
STA FLAG
|
|
RTS
|
|
CONOPN JSR GETBYT ;GET REPEAT COUNT
|
|
STX COUNT ;IN PLACE
|
|
CONOP1 JMP CHKCLS
|
|
CONRPT LDA COUNT ;IS COUNT ACTIVE
|
|
BEQ RPTFIN ;NO SO KILL RPT
|
|
LDA USLIN+1 ;IS RPT ACTIVE?
|
|
BEQ RPTSET ;SET IT UP
|
|
CONR1 DEC COUNT ;YES SO REDUCE COUNT
|
|
BNE RSTPTR ;IF STILL GOING RESTORE POINTERS
|
|
RPTFIN LDA #$00 ;OTHERWISE ZERO THEM
|
|
TAX
|
|
BEQ RPTSET1
|
|
RSTPTR STA TXTPTR+1 ;PREPARE TO RE-LOOP
|
|
LDA USLIN ;BY RESTORING POINTERS
|
|
STA TXTPTR
|
|
RTS
|
|
RPTSET LDX TXTPTR ;FIRST TIME
|
|
LDA TXTPTR+1 ;FOR LATER
|
|
RPTSET1 STX USLIN ;SO SAVE TXTPTR
|
|
STA USLIN+1
|
|
RTS
|
|
CONTAB JSR GETBYT ;HOW MANY?
|
|
JSR GETCH
|
|
CMP DPTR+1 ;IS CH>X?
|
|
BCS CONOP1 ;YES DO NOTHING
|
|
TXA ;NO SO USE
|
|
JSR COM0 ;TAB
|
|
BCC CONOP1 ;ALWAYS
|
|
CONSPC JSR GETBYT ;HOW MANY?
|
|
JSR PRBL2 ;GO DO THEM
|
|
BEQ CONOP1 ;ALWAYS
|
|
CONCOM JSR GETCH
|
|
AND #$F8 ;CH=>MULTIPLE OF 8
|
|
CLC
|
|
ADC #$08 ;AND NEXT
|
|
COM0 CMP WNDWDTH ;PAST WINDOW?
|
|
BCS COM1 ;YES
|
|
STA CH ;NO SO STORE
|
|
RTS
|
|
COM1 PHA
|
|
JSR CROUT ;NEXT LINE
|
|
PLA
|
|
SEC
|
|
SBC WNDWDTH ;HOW ARE WE ON THIS LINE?
|
|
BPL COM0 ;ALWAYS
|
|
CONHEX CMP #$E2 ;IS PEEK?
|
|
BNE TOHX ;NO SO NORMAL
|
|
JSR CHRGET ;YES SO GOBBLE
|
|
JSR PEEKFN ;AND DO IT
|
|
JMP HEXOUT0
|
|
TOHX JMP HEXOUT
|
|
CONAT JSR CHKOPN
|
|
CMP #$2C ;COMMA NEXT
|
|
BEQ GETVERT ;YES SO DEFAULT HORIZ
|
|
JSR GETBYT ;GET HORIZONTAL FIRST
|
|
DEX ;-1 IN MEM
|
|
STX YSAVE
|
|
CMP #$2C ;IS COMMA NEXT?
|
|
BEQ GETVERT ;YES, SO VERT IS ON KBD TOO
|
|
LDX CV ;NO SO USE OLD
|
|
BPL LASTCK ;ALWAYS
|
|
GETVERT JSR GETBYTC ;VERTICAL IN X
|
|
DEX
|
|
LASTCK JSR CHKCLS ;ALL SYNTAX CHECKED FIRST
|
|
LDA YSAVE ;GET BACK HORIZ
|
|
*TABAX CAN BE CALLED WITH HORIZ IN A AND VERT IN X
|
|
TABAX PHA
|
|
TXA
|
|
CMP WNDBTM
|
|
JSR VTABX1 ;VERT FIRST -CHECKS FOR BAD DATA
|
|
PLA ;GETHTAB BACK
|
|
JMP COM0
|
|
*
|
|
CONPEEK SEC ;PRINT ENTRY
|
|
DFB $24 ;BIT HIDES
|
|
PEEKFN CLC ;FUNCTION ENTRY
|
|
PHP ;SAVE IT
|
|
JSR CHKOPN
|
|
JSR INNUM
|
|
LDY #$00
|
|
LDA (A2L),Y ;GET IT
|
|
TAX ;SAVE FIRST ONE
|
|
JSR CHKCLS
|
|
CMP #$23 ;IS IT # ?
|
|
BEQ PEEK2 ;YES SO TWO BYTES
|
|
TXA ;NO,GET BYTE BACK
|
|
LDX #$00 ;ZERO OFF HI
|
|
BEQ PEEK3 ;ALWAYS
|
|
PEEK2 INY ;READY FOR NEXT BYTE
|
|
TXA ;AND STORE FIRST
|
|
PHA ;ON STACK
|
|
JSR CHRGET ;GOBBLE FLAG
|
|
LDA (A2L),Y ;OBTAIN OTHER BYTE
|
|
TAX ;SAVE IT
|
|
PLA ;GET LO BACK
|
|
PEEK3 TAY ;COMMON CODE SHIFTS
|
|
TXA ;TO YA
|
|
JSR GIVAYF ;FLOAT
|
|
PLP
|
|
BCC FNFIN
|
|
JMP PRNTFAC ;IF FROM ? GO BACK VIA PUT IT OUT
|
|
FNFIN RTS
|
|
*
|
|
*
|
|
*
|
|
*NEXT IS INSTR
|
|
CONINST SEC ;PRINT ENTRY
|
|
DFB $24 ;HIDES NEXT
|
|
INSFN CLC ;FUNCTION ENTRY
|
|
PHP ;SAVE FLAG
|
|
LDX #$00
|
|
STX XSAV ;MUST ZERO OFFSET
|
|
LDA #$24
|
|
JSR SYNCHR ;MUST BE $ SIGN THERE
|
|
JSR CHKOPN
|
|
JSR FRMEVAL ;FIRST EXPRESSION
|
|
BIT VARTYP
|
|
BMI INS2 ;IF STRING FIRST SKIP OFFSET
|
|
INS1 JSR CONINT ;X OFFSET
|
|
LDX DPTR+1 ;NEED AGAIN AS CONINT EXITS THROUGH CHRGET
|
|
BEQ INS1A
|
|
DEX
|
|
STX XSAV
|
|
INS1A JSR CHKCOM
|
|
JSR FRMEVAL ;GET STRING PTRS NOW
|
|
INS2 JSR FRESTR ;LOOSEN UP
|
|
STA STRLEN ;AND PUT WHERE WANTED
|
|
STX STRLO
|
|
STY STRHI
|
|
JSR CHKCOM
|
|
JSR FRMEVAL ;NEXT SET
|
|
JSR FRESTR
|
|
STA FORPNT ;SAVE LEN OF THIS
|
|
STX VARPNT
|
|
STY VARPNT+1
|
|
JSR CHKCLS ;FINISH SYNTAX
|
|
LDX XSAV ;IS OFFSET
|
|
CPX STRLEN ;MORE THAN STRLEN?
|
|
BGE INERR ;YES
|
|
INSCAN STX XSAV ;LONG INDEX
|
|
LDY #$FF ;SHORT INDEX
|
|
STY YSAV
|
|
INSCAN1 LDY YSAV
|
|
INY
|
|
CPY FORPNT ;END OF SHORT?
|
|
BEQ YESFND ;THEN GOT IT
|
|
LDA (VARPNT),Y ;NEXT IN SHORT
|
|
STY YSAV
|
|
LDY XSAV
|
|
CMP (STRLO),Y ;MATCH IN LONG?
|
|
BNE NXTLNG ;NO
|
|
CPY STRLEN ;END OF LONG?
|
|
BGE ZERFND ;EEND OF LONG SO QUIT
|
|
INY ;YES SO KEEP GOING
|
|
STY XSAV
|
|
BLT INSCAN1 ;ALWAYS IF HERE
|
|
NXTLNG CPX STRLEN ;TOO FAR
|
|
BGE ZERFND ;YES QUIT
|
|
INX
|
|
BLT INSCAN ;GO AGAIN
|
|
ZERFND LDY #$00
|
|
BEQ INSFIN ;EXIT HOLDING ZERO
|
|
YESFND TXA
|
|
TAY
|
|
INY
|
|
INSFIN JSR SGNFLT ;FLOAT Y
|
|
PLP
|
|
BCC INSFIN2
|
|
JSR PRNTFAC
|
|
INSFIN2 RTS
|
|
*
|
|
*
|
|
INERR JMP ERR2
|
|
*NEXT ONE IS PRINT USING BUT IS
|
|
*TREATED LIKE THE OTHER CONJUNCTIONS
|
|
*
|
|
*SYNTAX &?USRA$,A
|
|
*E.G. A$="***$00.00 ^^^^ "
|
|
* ::::::::::::...1..2 3
|
|
*1=ENDIG 2=EXPSTRT 3=STRLEN
|
|
*
|
|
USING JSR FRMEVAL ;OBTAIN EDIT STRING
|
|
BIT VARTYP ;WAS STRING MASK?
|
|
BMI USINGS ;YES, SO DO USUAL
|
|
JSR CONINT ;NO SO BYTE GIVEN IN X
|
|
TXA
|
|
JSR GETSPA
|
|
SEC
|
|
BCS USINGT ;ALWAYS
|
|
USINGS JSR FREFAC ;EDIT MASK STRING GIVEN
|
|
USINGT STA ENDIG ;STORE LEN FOR LATER
|
|
STA STRLEN ;AND IN DESCRIPTOR
|
|
STX STRPTSV ;SAVE POINTER TO ORIG
|
|
STY STRPTSV+1 ;STRING FOR LATER
|
|
BIT VARTYP ;CHECK TYPE AGAIN
|
|
BMI USINGB ;SKIP IF MASK GIVEN
|
|
TAY
|
|
BEQ USING1 ;SKIP IF NULL LEN
|
|
LDA #$20
|
|
USINGC DEY
|
|
STA (STRPTSV),Y ;BLANKS IN ORIG
|
|
BNE USINGC
|
|
LDA ENDIG ;GET LEN BACK
|
|
BNE USING1 ;ALWAYS
|
|
USINGB LDY #$22 ;WAS QUOTE IN ENDCHR
|
|
CPY ENDCHR ;MEANING LITERAL ON CMD LINE
|
|
BNE USING1 ;NO
|
|
JSR GETSPA ;YES SO PROTECT FIRST COPY
|
|
*IF NOT DONE, WONT GET PROTECTED TILL
|
|
*AFTER FIRST SUBSTITUTION WHICH
|
|
*WILL LEAVE JUNK BEHIND FOR THE NEXT ONE
|
|
USING1 JSR USRINIT ;RETURNS WITH X=0
|
|
LDA #$0F
|
|
STA FLAG2 ;SET A FLAG
|
|
LDA #$00
|
|
STA NUMFLG
|
|
LDY STRLEN
|
|
DEY
|
|
SCAN LDA (STRLO),Y ;SCAN EDIT STRING IN REVERSE FOR DECIMAL
|
|
CMP #$2E ;IS DEC
|
|
BEQ FNDEC ;YES
|
|
CMP #$30 ;NO IS A ZERO?
|
|
BEQ NUM1 ;NO DOES NOT COUNT AS DEC PLACE
|
|
CMP #$23 ;IS IT A #SIGN
|
|
BNE SCAN1 ;NO
|
|
NUM1 INX ;YES SO INC # OF PLACES
|
|
DEC NUMFLG ;SET FLAGTO GOT #
|
|
BMI NXY ;ALWAYS
|
|
SCAN1 CMP #$5E ;SKIP POSITION HOLDERS FOR SC. NOT.
|
|
BNE SCAN2
|
|
ASL FLAG2 ;NEEDS FOUR OF THESE TO GET EXP
|
|
BPL SCAN2 ;NOT YET 4 OF THEM
|
|
STY EXPSTRT ;START OF EXP SAVED
|
|
SCAN2 BIT NUMFLG ;GOT A NUMBER YET
|
|
BMI NXY ;YES SO KEEP # OF PLACES
|
|
DEC ENDIG ;NO REDUCE AVAIL LENGTH
|
|
NXY DEY
|
|
BPL SCAN ;LOOP IF NOT DONE
|
|
LDY ENDIG ;END OF DIGITS IS SAME AS
|
|
CPY #$02 ;AT LEAST 2?
|
|
BCS FNDEC0 ;YES
|
|
LDY STRLEN ;NO SO DEFAULT BACK
|
|
STY ENDIG ;TO WHOLE LENGTH
|
|
FNDEC0 LDX #$00 ;IF NO DEC NEED 0
|
|
FNDEC STX COUNT+1 ;#OF DEC PLACES
|
|
*
|
|
*CHECK FOR STRING, DO IF SO
|
|
*
|
|
CHKTYP BIT VARTYP ;IS STRING?
|
|
BPL MKEXP ;NO
|
|
JSR FREFAC ;YES TO INDEX A=LEN
|
|
TAY
|
|
BEQ TOOUT ;NO SUB IF NULL STRING
|
|
DEY
|
|
LDEND JSR CHRGOT ;WHATS AFTER A STRING
|
|
CMP #$4C ;IS IT AN L ?
|
|
BNE LDENDR ;NO
|
|
JSR CHRGET ;YES SO GOBBLE
|
|
TYA
|
|
TAX
|
|
SEC
|
|
BCS LDEND2
|
|
LDENDR CMP #$52 ;IS IT R
|
|
BNE LDENDC ;NO
|
|
JSR CHRGET ;YES GOBBLE
|
|
LDX STRLEN ;USE OURS AS STOP
|
|
DEX
|
|
SEC
|
|
BCS LDEND2 ;AND CARRY ON
|
|
LDENDC CMP #$43 ;IS IT A C ?
|
|
BNE LDEND1 ;NO SO NORMAL
|
|
STY YSAV
|
|
LDX STRLEN ;GET MASK LEN
|
|
DEX
|
|
TXA ;AND GET READY TO USE
|
|
SEC
|
|
SBC YSAV ;TAKE DIFFERENCE
|
|
BCC TOTB ;IF TOO BIG
|
|
LSR A ;TAKE HALF
|
|
STA YSAV ;AND STORE
|
|
TXA ;RETURN ORIG LEN
|
|
SEC
|
|
SBC YSAV
|
|
TAX ;SAVE THIS
|
|
JSR CHRGET ;GOBBLE FLAG
|
|
SEC
|
|
BCS LDEND2 ;AND CARRY ON
|
|
LDEND1 LDX ENDIG ;GET END TO A SAFE PLACE
|
|
DEX
|
|
LDEND2 STX XSAV
|
|
CPY XSAV
|
|
BEQ STRLUP
|
|
BCC STRLUP
|
|
TOTB JMP TOOBIG
|
|
STRLUP LDA (INDEX),Y
|
|
STY YSAV
|
|
LDY XSAV
|
|
STA (STRLO),Y
|
|
DEY
|
|
STY XSAV
|
|
LDY YSAV
|
|
DEY
|
|
BPL STRLUP ;TILL DONE
|
|
TOOUT JMP PUTOUT ;OTHERWISE
|
|
*
|
|
* OR, FOR A NUMBER
|
|
*
|
|
MKEXP JSR MKSTR ;STRING ORIG #
|
|
BNE DECMOV ;IF NO EXPONENT
|
|
BIT FLAG2 ;IS EXP BUT IS ROOM FOR ONE?
|
|
BMI MKEXP1 ;YES
|
|
JMP TOOBIG
|
|
MKEXP1 LDY #$FF ;LAST OF TEMP EXP POS
|
|
MKEXP2 LDA FBUFFR-1,X
|
|
STA $00,Y ;AND MOVE EXP IN
|
|
DEX ;TO TEMP BUFFER
|
|
DEY
|
|
CMP #$45 ;MOVED THE E YET
|
|
BNE MKEXP2 ;NO
|
|
BEQ CHKEXP
|
|
DOMULT JSR MUL10
|
|
CHKEXP LDA FEXP
|
|
CMP #$81 ;MUST BE >=$81 TO BE POS EXP
|
|
BCC DOMULT ;KEEP GOING TO ENSURE FAC HAS SIG FIG ONLY
|
|
LDA SIGN
|
|
PHA
|
|
JSR ABS
|
|
CHK10A LDY #$EA ;ADDRESS OF TEN
|
|
LDA #$50
|
|
JSR FCOMP ;COMPARE 10 TO FAC
|
|
BMI PUTSGN ;GO ON IF LESS
|
|
JSR DIV10 ;POS ONLY
|
|
SEC
|
|
BCS CHK10A ;ALWAYS
|
|
PUTSGN PLA
|
|
BPL DECMOV
|
|
JSR NEGOP
|
|
DECMOV LDA COUNT+1 ;GET BACKLEN
|
|
STA DECPTSV
|
|
DECMOV1 BEQ NODEC
|
|
JSR MUL10 ;FAC*10
|
|
DEC DECPTSV
|
|
BPL DECMOV1 ;AS MANY AS DEC PLACES
|
|
NODEC JSR RNDB ;ROUND LAST BIT OF FAC
|
|
LDA SIGN
|
|
PHA ;SAVE SIGN OF FAC
|
|
JSR ABS ;ABSOLUTE VALUE
|
|
JSR FADDH ;ADD .5
|
|
JSR INT ;CONVERT TO INTEGER
|
|
PLA
|
|
BPL GOMKSTR ;LEAVE IF SIGN POS
|
|
JSR NEGOP ;OTHERWISE CHANGE IT
|
|
GOMKSTR JSR MKSTR
|
|
BEQ TOOBIG ;IF HAVE EXP NOW IS BAD
|
|
CPX ENDIG ;AND CHECK IT
|
|
BEQ SEEEXP ;= IS O.K
|
|
BCS TOOBIG ;IF WRONG SIZE
|
|
SEEEXP BIT FLAG2 ;IS EXP ROOM?
|
|
BPL GOMK1 ;NO
|
|
LDY EXPSTRT ;YES SO WHERE
|
|
LDX #EXPSV ;TEMP EXP STORED AT
|
|
MVEXP LDA $00,X
|
|
STA (STRLO),Y
|
|
INY
|
|
INX
|
|
BMI MVEXP ;DO ALL 4
|
|
GOMK1 LDY ENDIG ;AND GET EDIT STRING IN Y
|
|
LDX XSAV ;GET BACK FOUT LENGTH
|
|
DEY ;LESS ONE
|
|
CLV ;SET FLAG
|
|
DEX ;REDUCE LENGTH
|
|
DOSTR TXA ;CHECK IT ON EACH PASS
|
|
BMI PUTOUT ;AND PRINT IF DONE
|
|
LDA (STRLO),Y ;START AT BACK
|
|
CMP #$2C ;SKIP COMMAS
|
|
BEQ LOOPY
|
|
CMP #$2E ;ALSO DEC
|
|
BEQ LOOPY
|
|
CMP #$2D ;AND DASH
|
|
BEQ LOOPY
|
|
CMP #$24 ;CHECK FOR $
|
|
BNE MOVFIG
|
|
BIT AMPJ ;IF THERE SETV
|
|
MOVFIG LDA FBUFFR,X
|
|
STA (STRLO),Y ;PUT THEIR STRING IN OURS
|
|
DEX ;DONE ONLY IF SUB DONE
|
|
LOOPY DEY
|
|
BVC LOOPY1 ;SKIP IF NO $
|
|
LDA #$24
|
|
STA (STRLO),Y ;BACK UP THAT $
|
|
CLV ;CLEAR FLAG
|
|
TYA ;TO CHECK
|
|
LOOPY1 BPL DOSTR ;AND GO AROUND
|
|
TXA ;IS X DONE TOO
|
|
BMI PUTOUT ;YES SO O.K.
|
|
TOOBIG LDY STRLEN
|
|
DEY
|
|
LDA #$3E ;AND FILL IT WITH >
|
|
TOOBIG1 STA (STRLO),Y
|
|
DEY
|
|
BPL TOOBIG1
|
|
PUTOUT JSR GETCH ;GET CURSOR MAY NEED IT
|
|
STA XSAV ;SAVE IT
|
|
LDA #$00 ;ZERO A
|
|
LDY #STRLEN
|
|
STY DPTR ;POINT DPTR TO STRLEN
|
|
STA DPTR+1
|
|
PUTOUT1 JSR STRPRT ;AND OUTPUT STRING
|
|
JSR CHRGOT ;LAST ON LINE
|
|
CMP #$21 ;WAS ! FOR FEED?
|
|
BNE PUTOUT2 ;NO
|
|
JSR CROUT ;CARRIAGE RETURN
|
|
LDA XSAV ;GET CH BACK
|
|
STA CH ;AND SAME CH AS BEFORE
|
|
PUTOUT2 LDX USLIN+1 ;IS DELIMITER ACTIVE?
|
|
BNE USRFIN1 ;YES SO RETURN FOR RESET
|
|
LDX COUNT ;NO SO IS COUNT ACTIVE?
|
|
BEQ USRFIN1 ;NO SO DONE
|
|
DEC COUNT ;YES SO REDUCE
|
|
BPL PUTOUT1 ;AND MAKE COPIES IF NOT DONE
|
|
USRFIN1 JSR CHRGOT
|
|
CMP #$21 ;IS A FEED THERE
|
|
BNE USRFINA ;NO
|
|
JSR CHRGET ;YES SO GOBBLE
|
|
USRFINA CMP #$2C ;IS A COMMA NEXT?
|
|
BNE USRFIN2 ;NO
|
|
LDA STRLEN ;YES SO GO AROUND AGAIN
|
|
JSR USRINIT
|
|
JMP CHKTYP
|
|
*
|
|
*SUBROUTINES FOLLOW
|
|
*
|
|
MKSTR LDX #$05 ;MOVE FAC TO TEMP
|
|
MOVFTP LDA FEXP,X
|
|
STA FACSV,X
|
|
DEX
|
|
BPL MOVFTP
|
|
JSR FOUT ;STRING IT OUT
|
|
LDX #$05
|
|
MOVTPF LDA FACSV,X ;RESTORE FAC
|
|
STA FEXP,X
|
|
DEX
|
|
BPL MOVTPF
|
|
INX ;ZERO IT
|
|
SCN LDA FBUFFR,X ;AND SCAN FOR LENGTH
|
|
BEQ MKSTR1 ;OF # TO PRINT
|
|
INX
|
|
BNE SCN ;UNTIL WE GET A ZERO
|
|
MKSTR1 STX XSAV ;SAVE LENGTH
|
|
LDA FBUFFR-4,X ;AND LOOK FOR EXP
|
|
CMP #$45
|
|
USRFIN2 RTS
|
|
*
|
|
*ENTER HOLDING LEN(EDIT$) IN A AND IN STRLEN
|
|
USRINIT JSR GETSPA ;WE NEED A COPY AT HIMEM
|
|
STX STRLO ;BUILD OR REBUILD
|
|
STY STRHI ;REST OF DESCRIPTOR
|
|
LDX STRPTSV
|
|
LDY STRPTSV+1 ;GET BACK STRING PTR
|
|
JSR MOVSTR ;SEND ORIG TO FRESPA
|
|
JSR CHKCOM
|
|
JSR FRMEVAL ;#IN AND TO FAC
|
|
LDA #$20 ;BLANK TEMP EXP
|
|
LDX #EXPSV
|
|
BLKTEX STA $00,X
|
|
INX
|
|
BNE BLKTEX
|
|
RTS
|
|
*
|
|
*INPUT ANYTHING ROUTINE*
|
|
*
|
|
*SYNTAX :CALLADDRSS <A$>
|
|
INPUT JSR ERRDIR ;CHECK IF ILLEGAL DIRECT
|
|
JSR CHRGOT
|
|
CMP #$22 ;IS QUOTE?
|
|
BNE ISSPRS
|
|
JSR STRTXT ;EVALUATES AND ADVANCE TXTPTR
|
|
JSR STRPRT ;PUTS IT OUT
|
|
JSR CHRGOT
|
|
ISSPRS CMP #$3B ;IS SEMICOLON?
|
|
BNE PRQUES ;NO SO PUT OUT ?
|
|
JSR CHRGET ;GOBBLE SEMIE
|
|
BNE FETCH ;ALWAYS
|
|
PRQUES JSR OUTQST
|
|
FETCH JSR PTRGET ;PTRS IN VARPNT
|
|
LDX #$00
|
|
JSR NXTCHAR ;DOES INPUT IN MONITOR
|
|
TXA ;LENGTH IN X ON RETURN
|
|
PHA ;STORE IT
|
|
JSR GDBUFS ;AND MASK OFF HIGH BITS ,NOW A=0 X=FF Y=1
|
|
TAY
|
|
PLA ;GET LENGTH BACK
|
|
STA (VARPNT),Y ;AND PUT IT IN DESCRIPTOR
|
|
JSR GETSPA ;NOW MAKE SPACE FOR STORING IT
|
|
PHA ;STILL HAS LENGTH AND Y,X POINT TO SPACE
|
|
TYA ;NOW FIX REST OF DESCRIPTOR
|
|
PHA
|
|
TXA
|
|
LDY #$01
|
|
STA (VARPNT),Y
|
|
INY
|
|
PLA
|
|
STA (VARPNT),Y
|
|
PLA ;NOW PUT STRING THERE A=LEN
|
|
LDX #$00
|
|
JMP MOVSTR
|
|
*
|
|
* CHN ASDM2.0.2
|
|
*
|
|
*DOS ROUTINES
|
|
*
|
|
* SUBROUTINES
|
|
*
|
|
*TO TURN DOS OFF
|
|
*PASTE I/O IN EFFECT OVER PAGE 0 LOCS
|
|
*
|
|
CSSWOFF LDX #$03
|
|
CSOF1 LDA VECTOUT,X
|
|
STA CSWL,X
|
|
DEX
|
|
BPL CSOF1
|
|
RTS
|
|
*
|
|
*TO TURN DOS BACK ON
|
|
*PUT PAGE 0 VECTORS INTO DOS HOOKS
|
|
*AND PUT STD DOS HOOKS BACK TO P0
|
|
*
|
|
CSSWON LDX #$03
|
|
CSON1 LDA CSWL,X
|
|
CMP VDOSIO,X ;ALREADY ON?
|
|
BEQ CSON2 ;YES, DONT DO IT
|
|
STA VECTOUT,X
|
|
LDA VDOSIO,X
|
|
STA CSWL,X
|
|
CSON2 DEX
|
|
BPL CSON1
|
|
RTS
|
|
*
|
|
CAT LDA #$03 ;JUST PART OF STRING
|
|
DFB $2C ;HIDES
|
|
CATALOG LDA #$07
|
|
PHA
|
|
TAX
|
|
JSR MOVCMDBUF ;REST IN AFTER SOME SPACE
|
|
JSR MOVCRBUF
|
|
PLA
|
|
STA YSAV ;AND PUT IT WHERE MOVER CAN GET IT
|
|
LDA #<CATSTR ;LOW BYTE
|
|
LDY #>CATSTR ;HIGH BYTE
|
|
JSR MOVAYBUF0
|
|
JSR DOSCMD ;AND MAKE ProDOS DO IT
|
|
CATDONE JMP ALLDONE
|
|
*
|
|
*MOVE COMMAND POINTED TO BY (A,Y) TO BUFFER AT $200
|
|
MOVAYBUF0 LDX #$00
|
|
BEQ MOVAYBUF
|
|
*
|
|
*MOVE REST OF COMMAND TO BUFFER AT 0
|
|
MOVCMDB0 LDX #0
|
|
*
|
|
*MOVE REST OF COMMAND TO BUFFER AT CURRENT X
|
|
*EXIT WITH Y AS STRING LENGTH
|
|
MOVCMDBUF LDY #$00
|
|
JSR CHRGOT
|
|
BEQ MOVDNE
|
|
STA (HIMEML),Y
|
|
MOVC1 INY
|
|
JSR CHRGET
|
|
BEQ MOVDNE
|
|
STA (HIMEML),Y
|
|
CMP #$3B
|
|
BNE MOVC1 ;ALWAYS
|
|
MOVDNE STA LASTSV ;END OFG COMMAND
|
|
STY YSAV ;PUT LEN IN
|
|
LDY HIMEMH
|
|
LDA #0
|
|
*
|
|
*MOVE STRING POINTED TO BY (A,Y -HI) TO BUFFER
|
|
*ENTER WITH (A LO,Y HI) SET LENGTH IN YSAV ,AND START POS IN X
|
|
*LEAVE WITH BUF POS IN X
|
|
MOVAYBUF STY FORPNT+1 ;SET UP ON ZERO PAGE
|
|
STA FORPNT
|
|
MOVFORBUF LDY #$00
|
|
STY XCNUM ;FOR EXTERNAL COMMAND
|
|
TXA ;CALCULATE END
|
|
CLC ;BY ADDING START+LENGTH
|
|
ADC YSAV
|
|
TAX
|
|
STX XSAV
|
|
DEX
|
|
LDY YSAV ;COUNTER FOR LEN
|
|
MOVFOR1 DEY
|
|
BMI MOVEFFIN ;WHEN FINISHED
|
|
LDA (FORPNT),Y
|
|
ORA #$80 ;HI BIT SET
|
|
STA IN,X
|
|
DEX
|
|
BPL MOVFOR1 ;ALWAYS
|
|
MOVEFFIN LDX XSAV ;GET POS BACK IF MORE
|
|
RTS
|
|
*
|
|
*MOVE A CR (8D) TO $200 BUFFER AT X POS
|
|
*
|
|
MOVCRBUF LDA #$8D
|
|
STA IN,X
|
|
FIXEDRTS RTS
|
|
*
|
|
LASTSV DFB $00
|
|
***************************************
|
|
*SOME STRINGS TO MOVE
|
|
*
|
|
CATSTR ASC 'CATALOG'
|
|
OPNSTR ASC 'OPEN'
|
|
CLSSTR ASC 'CLOSE'
|
|
|
|
********************************************
|
|
*EQUATES FOR DOS GLOBALS NEEDED
|
|
*
|
|
VADDR EQU $BE58
|
|
VBYTE EQU $BE5A
|
|
VENDA EQU $BE5D
|
|
VLNTH EQU $BE5F
|
|
VSLOT EQU $BE61
|
|
VDRIV EQU $BE62
|
|
VFELD EQU $BE63
|
|
VRECD EQU $BE65
|
|
VVOLM EQU $BE67
|
|
VLINE EQU $BE68
|
|
VPATH1 EQU $BE6C
|
|
*
|
|
*********************************************
|
|
*
|
|
*PARSE OFF FILENAME AND PUT INTO BUFFER AT LINNUM
|
|
*
|
|
DOSFNDO JSR FRMEVAL ;GET FORMULA
|
|
BIT VARTYP ;ENSURE STRING
|
|
BPL TODONERR ;IT IS NOT
|
|
JSR FREFAC ;AND FREE IT UP
|
|
STX STRPTSV
|
|
STY STRPTSV+1
|
|
TAX
|
|
LDY #$FF ;NOW CREATE FILENAME
|
|
FNDO1 INY
|
|
LDA (STRPTSV),Y
|
|
STA (LINNUM),Y ;MOVE STRING TO BUFFER
|
|
DEX
|
|
BNE FNDO1 ;AND CONTINUE
|
|
RESTOBUF JSR CHRGOT
|
|
BEQ RESTFIN ;END OF CMD
|
|
RESTBUF1 CMP #$3B
|
|
BEQ RESTFIN ;IF SEMI DONT STORE
|
|
INY
|
|
STA (LINNUM),Y
|
|
JSR CHRGET
|
|
BNE RESTBUF1 ;ALWAYS
|
|
RESTFIN STA LASTSV
|
|
INY
|
|
STY STRLEN
|
|
FNDOFIN RTS
|
|
*
|
|
TODONERR LDA #$40 ;NAME ERROR
|
|
SEC
|
|
TODNE1 JMP ALLDONE
|
|
*
|
|
********************************************
|
|
*
|
|
*
|
|
COMOPN LDY #$04 ;LENGTH OF OPENSTRING
|
|
STY YSAV
|
|
LDA #<OPNSTR
|
|
LDY #>OPNSTR
|
|
JSR MOVAYBUF0
|
|
LDA STRLEN
|
|
STA YSAV ;NOW OUR NAME THERE TOO
|
|
LDA LINNUM
|
|
LDY LINNUM+1 ;HI
|
|
JSR MOVAYBUF ;NAME THERE TOO
|
|
JSR MOVCRBUF
|
|
DEC STATE ;TELL IT ITS IN DEF MODE
|
|
LDY #4
|
|
JSR CLEARBUFY
|
|
LDY #0
|
|
STY FILEPOS ;START AT 0
|
|
JSR DOSCMD ;GO OPEN IT
|
|
INC STATE ;AND PUT BACK STATE
|
|
BCS TODNE1
|
|
*MOVE ZERO PAGE PARAMS TO OURS
|
|
LDX #4
|
|
COMOPNB LDA ZDEV,X
|
|
STA REFNUM,X
|
|
DEX
|
|
BPL COMOPNB
|
|
*
|
|
*
|
|
*CLOSE LAST ONE OPENED
|
|
CLOSE LDY #$05
|
|
STY YSAV
|
|
LDA #<CLSSTR
|
|
LDY #>CLSSTR
|
|
JSR MOVAYBUF0
|
|
JSR MOVCRBUF
|
|
JMP DOSCMD
|
|
*
|
|
*
|
|
* TO MAKE DOS PARSE OFF PARAMS
|
|
*
|
|
PARSEP LDA TXTPTR ;GO BACK TO LAST CHR
|
|
SEC
|
|
SBC #$01
|
|
STA TXTPTR
|
|
BCS DOVDS
|
|
DEC TXTPTR+1
|
|
DOVDS JSR VDSOPT
|
|
JMP ALLDONE
|
|
*
|
|
VDS JSR CHRGOT
|
|
STA LASTSV
|
|
CMP #$2C ;COMMA NEXT
|
|
BEQ VDSOPT ;COMMA OK
|
|
CMP #$CB ;OR APPLESOFT SLASH
|
|
BNE VDSFIN
|
|
VDSOPT LDA #%00010100 ;OPTIONAL FILENAME
|
|
DFB $2C ;HIDES
|
|
VDSREQ LDA #%00000101 ;REQUIRED FILENAME
|
|
LDY #$FF ;ALLOW ALL
|
|
VDS1 STA PBITS ;NOW PUT PARSE EXPECTED INTO GLOBAL PAGE
|
|
STY PBITS+1
|
|
VDS2 LDA #$D8 ;FAKE A COMMAND TO DOS
|
|
STA IN
|
|
LDX #$01 ;REST OF STRING TO NEXT POSITION
|
|
JSR MOVCMDBUF ;PUT IT IN
|
|
JSR MOVCRBUF ;WITH A CARRET
|
|
LDA EXTRNCMD+1 ;SAVE PRESENT VALUE
|
|
STA SAVEXTRN
|
|
LDA EXTRNCMD+2
|
|
STA SAVEXTRN+1
|
|
LDA #<VDS3
|
|
STA EXTRNCMD+1 ;NOW SEE THAT FAKE GETS US BACK HERE
|
|
LDA #>VDS3
|
|
STA EXTRNCMD+2
|
|
JMP DOSCMD ;GO AND PARSE IT
|
|
VDS3 LDA #$00 ;COMING BACK HERE
|
|
STA XLEN ;ONE LESS THAN LENGTH
|
|
STA XCNUM ;TELL THEM THE FAKE IS OURS
|
|
LDA #<VDS4 ;AND WHERE TO GO WHEN THEY ARE DONE
|
|
STA XTRNADDR
|
|
LDA #>VDS4
|
|
STA XTRNADDR+1
|
|
CLC ;NEEDED TO MAKE THE LIE BELIEVABLE
|
|
VDSFIN RTS ;AND BACK TO PARSE WHAT WE WANTED ALL ALONG
|
|
VDS4 LDA VSLOT
|
|
STA DEFSLT
|
|
LDA VDRIV
|
|
STA DEFDRV
|
|
LSR A ;0 OR 1 NOW
|
|
ASL A
|
|
ASL A
|
|
ASL A
|
|
ORA DEFSLT
|
|
ASL A
|
|
ASL A
|
|
ASL A
|
|
ASL A
|
|
STA REFNUM ;AND PUT IT IN
|
|
VDS5 BIT FBITS+1 ;HI BIT SET?
|
|
BPL CHKAT ;NO SO NO A PARSED
|
|
LDA VADDR ;YES
|
|
STA BUFADR
|
|
LDA VADDR+1
|
|
STA BUFADR+1
|
|
CHKAT LDA #$08 ;WAS @ PARSED?
|
|
BIT FBITS+1
|
|
BEQ VDS6 ;NO
|
|
LDA #0 ;YES
|
|
STA RWBLK+1 ;ZERO OURS
|
|
LDA VLINE+1
|
|
ASL A ;TIMES8
|
|
ROL RWBLK+1 ;CARRYING TO HI
|
|
ASL A
|
|
ROL RWBLK+1
|
|
ASL A
|
|
ROL RWBLK+1
|
|
STA ACC
|
|
LDA VLINE ;NOW SECTOR
|
|
BNE CHK1 ;IF NOT 0
|
|
CLC ;IS 0
|
|
BCC ADDIT ;SO GO OUT WITH LOWER INDICATOR
|
|
CHK1 CMP #$0F ;WAS 15
|
|
BNE CHK2 ;NO
|
|
LSR A ;ASLO SPECIAL NOW 7 AND CARRY SET - UPPER
|
|
BCS ADDIT ;ALWAYS
|
|
CHK2 EOR #$0F ;SB FROM 15
|
|
LSR ;TAKE HALF
|
|
ADDIT ROR HALFFLAG ;CARRY SET = UPPER, CLEAR IS LOWER
|
|
SEC
|
|
ROR HALFFLAG ;NOW MI IF T/S MODE AND V SET IF UPPER
|
|
CLC
|
|
ADC ACC ;REST
|
|
STA RWBLK
|
|
BCC VDS6
|
|
INC RWBLK+1
|
|
VDS6 LDA EXTRNCMD+2
|
|
CMP #$BE ;ALREADY OK?
|
|
BEQ VDSFIN2 ;YES,NO FIX
|
|
LDA SAVEXTRN+1 ;PUT THE THING BACK THE WAY IT WAS
|
|
BEQ VDSFIN2 ;NOT DONE
|
|
STA EXTRNCMD+2
|
|
LDA SAVEXTRN
|
|
STA EXTRNCMD+1
|
|
VDSFIN2 RTS
|
|
*
|
|
SAVEXTRN DW 0
|
|
*
|
|
***************************************************
|
|
* READ AND WRITE BLOCKS *
|
|
*
|
|
WRITE BNE WRITE0 ;IF NOT END OF COMMAND
|
|
JSR CSSWOFF ;IF IT IS ,DOS OFF
|
|
JMP ISWRIT1 ;AND GO DO IT
|
|
WRITE0 INC CMD2 ;WILL BE 3
|
|
READ INC CMD2 ;WILL BE 2
|
|
OPEN INC CMD2 ;WILL BE 1
|
|
LDX #$FF
|
|
STX FLAG2
|
|
LDX HIMEMH
|
|
STX BUFADR+1
|
|
INX
|
|
INX ;TOP PART OF BUFFER
|
|
STX LINNUM+1
|
|
LDY #0
|
|
TYA
|
|
STA LINNUM
|
|
STA (LINNUM),Y ;ZERO FIRST BYTE OF SAME
|
|
JSR CHRGOT ;NEXT
|
|
BEQ OPEN2 ;EOL OR EOC - NO MORE
|
|
BCC GETBLK ;NUMBER SO GET IT
|
|
CMP #$2C
|
|
BEQ TOVDS ;IF COMMA THEN VDS NOW
|
|
CMP #$24 ;OR $
|
|
BEQ GETBLK ;IF SO DO IT
|
|
CMP #$25 ;IS IT A %
|
|
BEQ GETBLK0 ;YES, GO STRIP IT
|
|
JSR DOSFNDO ;ELSE MUST BE FILENAME
|
|
SEC
|
|
BCS OPEN2
|
|
GETBLK0 JSR CHRGET ;STRIP OFF %
|
|
GETBLK JSR INNUM ;BLOCK #
|
|
STX RWBLK ;AND STORE IT
|
|
STA RWBLK+1
|
|
TOVDS JSR VDS
|
|
OPEN2 DEC CMD2 ;NOT OPEN SO RD OR WR
|
|
BNE RDWR
|
|
JSR COMOPN ;OPEN WITH FILE NAME
|
|
BCS MYCALLFIN ;IF ERROR
|
|
LSR FLAG2 ;SAY WE DID IT
|
|
BCS MYCALLX ;ALWAYS ;TO DUMP
|
|
RDWR DEC CMD2 ;IS IT WRITE
|
|
BNE WRITE1 ;YES, GO THERE
|
|
READ1 JSR CLEARBUF
|
|
READ2 LDA #$80 ;READ #
|
|
DFB $2C ;HIDES
|
|
WRITE1 LDA #$81 ;WRITE #
|
|
STA MYCALLNO
|
|
*
|
|
*ENTRY TO MLI HERE
|
|
*
|
|
ASYSCALL JSR ENTRY
|
|
MYCALLNO DFB $80 ;READ UNLESS CHANGED
|
|
MYPARAM DW RWBLOCK
|
|
BCS MYCALLFIN ;RETURN HERE CC IS OK, CS IS ERROR
|
|
LDX CMD2 ;WAS WRITE
|
|
DEX
|
|
BEQ MYCALLFIN ;YES SO DONE
|
|
MYCALLX LDA LASTSV
|
|
EOR #$3B ;WITH SEMI
|
|
BEQ MYCALLFIN ;YES SO NO DUMP
|
|
JMP DUMP1 ;NO SO DO IT
|
|
*
|
|
*ACTUAL READ WRITE BLOCK
|
|
*
|
|
RWBLOCK DFB $03 ;PARAM COUNT, SAME FOR BOTH
|
|
REFNUM DFB $60 ;SLOT 6 DRIVE 1 UNLESS CHANGED
|
|
BUFADR DW $9600 ;LOCATION OF DATA
|
|
RWBLK DW 0 ;TWO BYTES FOR BLOCK NO
|
|
*
|
|
*
|
|
*TYPE OUT A TEXT FILE TO OUTPUT DEVICE
|
|
*
|
|
TYPE JSR DOSFNDO ;GET FILENAME
|
|
JSR COMOPN ;OPEN FILE GET FIRST BLOCK
|
|
BCC TYPE0 ;IF ALL OK
|
|
MYCALLFIN JMP ALLDONE ;IF NOT
|
|
*
|
|
TYPE0 JSR HOME ;CLEAR SCREEN IN CASE THAT IS OUTPUT
|
|
TYPE1 LDY #0 ;INIT COUNTER
|
|
TYPE2 JSR ISWAIT ;CHECK KEYBOARD
|
|
BCS TYPEFIN ;AND QUIT IF IT SAYS SO
|
|
LDA (BUFPT),Y ;GET A BYTE
|
|
BEQ TYPEFIN ;QUIT IF EOF
|
|
JSR OUTDO ;OTHERWISE PRINT IT VIA APPLESOFT
|
|
INY ;NEXT
|
|
BNE TYPE2 ;LOOP TO END OF FIRST PART OF BLOCK
|
|
BIT LFLAG ;SEE IF ACTUALLY SECOND PART
|
|
BMI TYPE3 ;YES IT WAS
|
|
DEC LFLAG ;NO, BUT NOW IT WILL BE
|
|
INC BUFPT+1 ;SECOND HALF
|
|
BNE TYPE2 ;ALWAYS
|
|
TYPE3 STY LFLAG ;ZERO HALFER BACK OFF
|
|
DEC BUFPT+1 ;RESTORE BUFFER POINTER TO ORIG
|
|
LDA #1 ;AND GO GET NEXT SECTOR
|
|
JSR FILENXT
|
|
JSR ENTRY
|
|
DFB $80 ;READ PARAM
|
|
DW RWBLOCK ;SAME AS FOR READ/WRITE ROUTINES
|
|
BCC TYPE1
|
|
DFB $24 ;HIDES NEXT CLEAR, RETURNS WITH ERROR SET
|
|
TYPEFIN CLC ;NO ERROR
|
|
JMP ALLDONE ;AND AN ORDERLY EXIT
|
|
*
|
|
*
|
|
*FORMAT A DISK
|
|
*
|
|
*FORMAT LDA REFNUM
|
|
* JSR AFORMAT
|
|
*FORMAT RTS ;NOT HERE YET
|
|
*
|
|
*ROUTINE TO CLEAR DATA BUFFER
|
|
*
|
|
CLEARBUF LDY #$02 ;# OF PAGES TO DO
|
|
CLEARBUFY LDX BUFADR+1
|
|
CLEARBUF3 STX BLKBUF+1
|
|
STX BUFPT+1 ;SET UP DATA BUFFER POINTER
|
|
TYA
|
|
TAX
|
|
LDY #$00
|
|
STY BUFPT
|
|
TYA
|
|
CLRB1 STA (BLKBUF),Y
|
|
DEY
|
|
BNE CLRB1
|
|
DEX
|
|
BEQ CLRDNE
|
|
INC BLKBUF+1 ;SECOND PAGE
|
|
BNE CLRB1 ;ALWAYS
|
|
CLRDNE DEC BLKBUF+1 ;LEAVE IT POINTING TO LO PAGE OF LAST CLEARED
|
|
RTS
|
|
|
|
*HERE EQU >*
|
|
*PAD DS $100-HERE,0 ;TO NEXT PAGE
|
|
*
|
|
*NEXT INCLUDE FORMATTER ON A PAGE BOUNDARY
|
|
*
|
|
*AFORMAT INCLUDE FORMATTER
|
|
*
|
|
|
|
***************************************************
|
|
*INPUT A KBD NUMBER IN HEX OR DEC AND GET IN X,A AND A2
|
|
*
|
|
INNUMNC JSR CHRGOT ;LIKE C BUT NO GOBBLE
|
|
CMP #$2C ;IS COMMA
|
|
BEQ INNUMR ;YES ,HEAD BACK
|
|
BNE INNUM1 ;NO,GO ON
|
|
INNUMG JSR CHRGET ;ALTERNATE ENTRY, GOBBLES ANYTHING
|
|
SEC
|
|
BCS INNUM0
|
|
INNUMC JSR CHKCOM ;ALTERNATE ENTRY, CHECKS COMMA ONLY
|
|
INNUM JSR CHRGOT ;GET LAST CHR AGAIN
|
|
INNUM0 CMP #$2C ;IS COMMA ALREADY?
|
|
BNE INNUM1 ;NO SO GO ON
|
|
JSR CHRGET ;YES SO GOBBLE IT
|
|
INNUMR LDA #$00 ;AND RETURN WITH ZERO
|
|
TAX
|
|
BEQ DECAD3
|
|
INNUM1 CMP #$24 ;IS IT $ ?
|
|
BNE DECAD ;NO SO DECIMAL INPUT
|
|
JSR CHRGET ;YES SO GOBBLE AND SET NEXT
|
|
JMP CONVERT2
|
|
DECAD JSR FRMEVAL
|
|
BIT VARTYP ;IS A STRING?
|
|
BMI STRAD ;YES SO DO THAT WAY
|
|
DECAD2 JSR GETADR ;NO,SO NUMBER
|
|
LDX LINNUM ;A HAS LINNUM+1
|
|
DECAD3 STX A2L
|
|
STA A2H
|
|
RTS
|
|
STRAD JSR FREFAC
|
|
LDY #$00
|
|
TAX ;LENGTH OF STRING
|
|
LDA (INDEX),Y
|
|
CMP #$24 ;DOES STRING START WITH $?
|
|
BNE MSERR ;NO SYNTAX ERROR OR MISMATCH
|
|
DEX ;SHORTEN BY ONE
|
|
STRAD2 INY
|
|
DEX
|
|
BMI STRADFIN ;OUT OF LEN
|
|
LDA (INDEX),Y ;NO SO GO ON
|
|
BEQ STRADFIN ;NULL ENDS
|
|
CMP #$22 ;SO DOES QUOTE
|
|
BEQ STRADFIN
|
|
ORA #$80 ;SET HI
|
|
STA IN-1,Y
|
|
BNE STRAD2 ;ALWAYS
|
|
STRADFIN JMP CNT
|
|
MSERR JMP ERR
|
|
*
|
|
*
|
|
*DUMP A SECTOR STARTING AT LAST BUFFER READ OR AT SUPPLIED ADDRESS*
|
|
*
|
|
DUMP BEQ DUMP1 ;NO MORE SO USE LAST
|
|
DUMP0 JSR INNUM ;GET ADDRESS
|
|
LSR FLAG2 ;NO, CLEAR
|
|
LSR FLAG2 ;TO DUMP POS
|
|
BPL DUMP1Z ;ALWAYS
|
|
DUMP1 LDX BUFADR
|
|
LDA BUFADR+1
|
|
BIT HALFFLAG
|
|
BVC DUMP1Z
|
|
TAY
|
|
INY
|
|
TYA
|
|
DUMP1Z STA BUFPT+1
|
|
STA IFLAG ;SAVE FIRST BUFFER HI
|
|
STX BUFPT
|
|
STX PCL
|
|
STA PCH
|
|
DUMP1A JSR CSSWOFF ;ENTRY FROM ZAP
|
|
DUMP2 LDX #$C0 ;CHECK FOR BAD PAGE
|
|
CPX BUFPT+1 ;IS IT?
|
|
BNE DUMP2A ;NO, O.K.
|
|
JSR CROUT ;YES SO INFORM USER
|
|
LDX #>CANTDU
|
|
LDA #<CANTDU
|
|
JMP PRINTER ;WITH A MESSAGE
|
|
*
|
|
*ENTRY FORM ZAP
|
|
DUMPL LDA LFLAG ;WERE WE LISTING
|
|
DUMPR PHP ;SAVE FLAG
|
|
BNE DUMP4 ;YES
|
|
LDA BUFPT
|
|
LDX BUFPT+1 ;NO SET UP
|
|
DFB $2C ;HIDES
|
|
DUMP4 LDX XCOUNT ;OTHER HALF OF OLD LIST
|
|
STA PCL
|
|
STX PCH
|
|
PLP ;WHAT WAS THAT FLAG
|
|
BEQ DUMP1A ;0 SO DO DUMP
|
|
JMP DOLIST ;NONZERO SO BACK TO LIST
|
|
*
|
|
*
|
|
DUMP2A DEX ;NOW $BF
|
|
CPX BUFPT+1 ;WHAT OF THAT?
|
|
BNE DUMP3 ;O.K.
|
|
LDX #$00
|
|
STX BUFPT ;ENSURE NO RUN INTO P$C0
|
|
DUMP3 JSR HOME ;START OF MAIN PROGRAM
|
|
LDY #$00 ;INIT SECTOR COUNT
|
|
NXTLN JSR PRBL1 ;START LINE WITH SPACE
|
|
TYA
|
|
JSR PRBYTE ;AND OUTPUT INDEX
|
|
LDA #$AD ;THEN A DASH
|
|
JSR COUT
|
|
NXTX LDX #$04 ;PRINT GROUPS OF FOUR BYTES
|
|
NXTA LDA (BUFPT),Y
|
|
JSR PRBYTE ;OUTPUT HEX VALUE
|
|
INY
|
|
BEQ INFO ;IF LAST ONE
|
|
DEX
|
|
BNE NXTA
|
|
JSR PRBL1 ;AFTER 4 BYTES DO SPACE
|
|
STY YSAVE
|
|
LDA #$0E
|
|
BIT YSAVE ;SEE IF 16X +1
|
|
BEQ NXTLN ;SO DO ANOTHER BESIDE IT
|
|
BNE NXTX ;NO SO ANOTHER GROUP
|
|
*
|
|
ETYCLADJ JSR PRBL1
|
|
ETYCLADJ1 LDA WNDWDTH ;80COL
|
|
CMP #$50
|
|
BNE ADJFIN ;NO
|
|
JSR CROUT ;AND SKIP LINE
|
|
ADJFIN RTS
|
|
*
|
|
INFO JSR ETYCLADJ
|
|
INFO1 LDA (BUFPT),Y ;NOW OUTPUT THE CHARACTERS
|
|
TAX ;STORE
|
|
AND #$7F ;AND TEST
|
|
CMP #$21 ;FOR CONTROL CHRS
|
|
BCC DOTDO ;IF SO REPLACE WITH DOT
|
|
TXA ;OTHERWISE
|
|
BNE CHRDO ;PUT IT OUT
|
|
DOTDO LDA #$AE
|
|
CHRDO JSR COUT
|
|
INY ;DONE YET?
|
|
BNE INFO1 ;NO SO MORE
|
|
CHRDO1 JSR ETYCLADJ ;SPACE AT END
|
|
CHRDO1A BIT FLAG2 ;FROM READ OR OPEN?
|
|
BVC BUFOUT ;NO
|
|
BMI BLKOUT ;NOT FORM OPEN
|
|
LDA FILEPOS ;REL BLOCK #
|
|
JSR PRBYTE
|
|
BLKOUT LDA RWBLK+1 ;YES ;SAY BLOCK #
|
|
LDX RWBLK
|
|
JSR PRNTAX
|
|
BIT HALFFLAG ;T/S MODE
|
|
BPL CHRDO2 ;NO
|
|
JSR $FE80 ;SET INVERSE
|
|
LDA VLINE+1 ;TRACK
|
|
LDX VLINE ;SECTOR
|
|
JSR PRNTAX
|
|
JSR $FE84 ;BACK TO NORM
|
|
BMI BUFOUT ;ALWAYS
|
|
CHRDO2 JSR OUTSPC
|
|
BUFOUT LDA #$A4 ;GET $ SIGN
|
|
JSR COUT ;OUTPUT IT
|
|
LDA BUFPT+1
|
|
LDX BUFPT ;FOR REFERENCE
|
|
JSR PRNTAX
|
|
LDX STATE ;IN DIRECT?
|
|
BEQ IFZAP2 ;YES SO GO ON
|
|
JSR CHRGOT ;NO,SO WHATS AT TXTPTR
|
|
CMP #$AF ;IS IT &?
|
|
BEQ IFZAP2 ;YES SO GO ON
|
|
DUMPFIN CLC
|
|
JMP ALLDONE
|
|
IFZAP2 LDX #>CMDLIN ;YES,ASK IF ZAP
|
|
LDA #<CMDLIN
|
|
LDY #$02
|
|
BIT FLAG2 ;FROM READ/OPEN
|
|
BVC TOPRINT ;NO
|
|
DEY ;YES SO GIVE <> OPTIONS
|
|
DEY
|
|
TOPRINT JSR PRNTR1
|
|
TOPRNT1 LDA #$BF ;? PROMPT
|
|
STA PROMPT
|
|
JSR GETLN ;AND SEE WHAT USER GIVES
|
|
LDA IN ;CHECK FIRST LETTER
|
|
ISLST CMP #$CC ;IS L FOR LIST?
|
|
BEQ DOLIST
|
|
CMP #$EC
|
|
BNE ISBLNK ;NO
|
|
DOLIST TXA ;SAVE LING LENGTH
|
|
PHA
|
|
JSR HOME
|
|
LDA #$FF ;SET UP PROGRAM FLAG
|
|
STA COUNT
|
|
PLA ;NOW GET X BACK
|
|
TAX
|
|
JSR MON3 ;GO DO MONITOR LIST
|
|
JMP CHRDO1A
|
|
ISBLNK CMP #$82 ;IS CNTRL B TO BLANK IT
|
|
BNE CLRALL ;NO
|
|
LDX BUFPT+1
|
|
LDY #1
|
|
BNE CLRALL2
|
|
CLRALL CMP #$97 ;IS CNTRL-W FOR WIPE WHOLE BLOCK?
|
|
BNE ISRST ;NO
|
|
LDY #2
|
|
LDX IFLAG
|
|
CLRALL2 LDA BUFPT
|
|
JSR CLEARBUF3
|
|
JMP DUMP1A ;AND SHOW USER
|
|
ISRST CMP #$D2 ;IS R FOR RESTART?
|
|
BEQ DORST
|
|
CMP #$F2 ;OR LOWER CASE
|
|
BNE ISZAP ;NO
|
|
DORST JMP DUMPR ;YES
|
|
ISZAP CMP #$DA ;IS IT A Z?
|
|
BEQ DOZAP ;YES SO DO IT
|
|
CMP #$FA ;LC Z
|
|
BEQ DOZAP
|
|
BIT FLAG2 ;FROM READ?
|
|
BVC NXTDMP ;NO
|
|
ISWRITE CMP #$A1 ;IS ! ?
|
|
BNE NXTLST ;NO
|
|
ISWRIT1 LDY #$01
|
|
STY CMD2 ;RESET CMD #
|
|
JMP WRITE1 ;YES DO IT
|
|
NXTLST CMP #$BC ;IS>
|
|
BEQ NXTRD ;YES
|
|
CMP #$BE ;OR<
|
|
BEQ NXTRD ;YES
|
|
CMP #$AC
|
|
BEQ NXTRD ;OR,
|
|
CMP #$AE ;OR.
|
|
BEQ NXTRD
|
|
NXTDMP CMP #$AB
|
|
BEQ NXTPG ;WAS +
|
|
CMP #$BD ;OR =
|
|
BEQ NXTPG
|
|
CMP #$BB ;OR ;
|
|
BEQ NXTPG
|
|
CMP #$AD
|
|
BEQ LSTPG ;WAS -
|
|
CMP #$DF ;OR UNDERLINE
|
|
BEQ LSTPG
|
|
JMP DUMPFIN ;NO, SO EXIT OUR DOS WAY
|
|
DOZAP LDX #$01
|
|
SETLIN LDA IN,X
|
|
STA IN-1,X ;REARRANGE INPUT
|
|
INX
|
|
CMP #$8D ;RETURN?
|
|
BNE SETLIN ;NO
|
|
JSR CNT ;AND TO CONVERT #
|
|
JMP ZAP2 ;AND INTO ZAP
|
|
NXTPG INC BUFPT+1
|
|
DFB $2C ;HIDES
|
|
LSTPG DEC BUFPT+1
|
|
JMP DUMP2
|
|
*
|
|
*ROUTINE TO READ NEXT OR LAST BLOCK
|
|
*ENTER WITH $BC,$AC FOR LAST OR $BE OR $AE FOR NEXT
|
|
*
|
|
NXTRD ORA #$10 ;SET B
|
|
SEC
|
|
SBC #$BD ;NOW +-1
|
|
BIT FLAG2 ;FROM OPEN?
|
|
BMI NXTRD1 ;NO SO GO AHEAD
|
|
JSR FILENXT ;YES SO GO DO IT
|
|
BCC NXTRD2 ;IF ALL OK
|
|
JMP MYCALLX ;REDUMP IF AT EITHER END
|
|
NXTRD2 JMP READ2 ;OR GET NEXT ONE
|
|
NXTRD1 CLC
|
|
ADC RWBLK
|
|
STA RWBLK
|
|
TXA ;AGAIN FOR HI
|
|
BPL IFSET ;CHANGE HI IF PL AND CE OR MI AND CC
|
|
BCC DOHI
|
|
GTNXT JMP READ1 ;GO DO IT
|
|
IFSET BCC GTNXT
|
|
DOHI CLC
|
|
ADC RWBLK+1
|
|
CMP #$FF ;NO WRAP AROUND
|
|
BNE DOHI1
|
|
LDA #0
|
|
STA RWBLK
|
|
DOHI1 STA RWBLK+1 ;ALL OK TO CHANGE
|
|
SEC
|
|
BCS GTNXT ;ALWAYS IF HERE
|
|
*
|
|
FILENXT CLC
|
|
ADC FILEPOS ;LAST POS +-1 DEPENDING ON DIRECTION
|
|
FNXT1 TAY
|
|
INC BLKBUF+1 ;GET HI BYTE OF BLOCK NUM
|
|
LDA (BLKBUF),Y
|
|
STA YSAV ;STORE FOR A WHILE
|
|
DEC BLKBUF+1 ;NOW LO
|
|
LDA (BLKBUF),Y
|
|
TAX ;STORE THAT ONE TOO
|
|
ORA YSAV ;CHECK FOR BOTH ZERO
|
|
BNE FNXT2 ;OK
|
|
SEC
|
|
RTS ;NOT OK EXIT, LET SENDER KNOW
|
|
FNXT2 LDA YSAV
|
|
FNXT3 STA RWBLK+1 ;CAN ENTER HERE IF DESIRED
|
|
STX RWBLK
|
|
STY FILEPOS
|
|
CLC
|
|
RTS ;AND OK EXIT
|
|
*
|
|
*
|
|
*ROUTINE TO ZAP LAST BUFFER DUMPED
|
|
*
|
|
ZAP JSR CONVERT1 ;GET OFFSET
|
|
ZAP2 TXA ;RETURNS IN X
|
|
CLC
|
|
ADC BUFPT ;ADD TO LO BYTE OF BUFFER
|
|
STA A3L ;AND PUT IN NXTOPN
|
|
TAX
|
|
LDA #$00
|
|
ADC BUFPT+1 ;AND ADD CARRY TO HI BYTE OF
|
|
STA A3H ;NXTOPN
|
|
JSR PRNTAX ;INFORM USER
|
|
LDA #$BA ;COLON
|
|
STA IN ;TO INPUT BUFFER
|
|
JSR COUT ;AND OUTPUT : TOO
|
|
LDA #$A6 ;& PROMPT JUST IN CASE
|
|
STA PROMPT
|
|
LDX #$02 ;LINE INDEX
|
|
JSR BCKSPC ;PART WAY THROUGH GETLIN
|
|
LDA #$FF
|
|
STA COUNT
|
|
JSR MON3 ;AND JUMP INTO MONITOR CMD
|
|
LDX STATE
|
|
BEQ ZAP3 ;YES, RECYCLE
|
|
JSR CHRGOT ;NO SO
|
|
CMP #$AF ;IS &
|
|
BNE ZAPFIN ;NO SO DONE
|
|
JMP ALLDONE
|
|
ZAP3 JMP DUMPL ;AND DUMP AGAIN
|
|
ZAPFIN CLC
|
|
*
|
|
* FOR ENTERING MONITOR COMMANDS
|
|
*
|
|
MON1 JSR BELL ;COME HERE IF ERROR
|
|
JSR CROUT
|
|
MON2 LDA #$00 ;MAIN ENTRY
|
|
DFB $2C ;HIDES NEXT
|
|
LDA #$FF ;PROGRAM ENTRY
|
|
STA COUNT ;SAVE THAT FLAG
|
|
LDA #$A6 ;AMPERSAND PROMPT
|
|
STA PROMPT
|
|
JSR GETLN
|
|
MON3 TXA ;HOW LONG IS LINE
|
|
BEQ MONDONE ;IF BARE RETURN THEN EXIT
|
|
TOZ JSR ZMODE
|
|
NXTITMR JSR TOGETNUMM
|
|
STY YSAV ;JUST LIKE MONITOR
|
|
LDY $FF79 ;ROUTINE, BUT WE CAN GET OUT (SIZE OF CMDTBL)
|
|
CHRSRCHR DEY ;FIND CMD
|
|
BPL CKTBL
|
|
BIT COUNT ;NOT FOUND SO SEE WHAT WE DO
|
|
BPL MON1 ;NOT FROM ONE OF OUR ROUTINES SO BELL
|
|
JMP $FF2D ;IS FROM A SUBR SO RETURN VIA ERR BELL
|
|
CKTBL CMP CHRTBL,Y ;LOOK IN THE MON TABLE
|
|
BNE CHRSRCHR ;CHECK NEXT TILL DONE
|
|
CMP #$C6 ;IS CRMON FUNCTION?
|
|
BNE DOMCMD ;NO SO GO ON
|
|
JSR ZMODE-2
|
|
JSR TOBL1
|
|
SEC
|
|
BCS MONDONE
|
|
DOMCMD JSR TOSUB ;GOTO MONITOR ROUTINE
|
|
LDY YSAV
|
|
JMP NXTITMR
|
|
MONDONE BIT COUNT ;CHECK RETURN TYPE
|
|
BMI ALLMDNE ;AND RTS ONLY IF FROM PROGRAM
|
|
JMP ALLDONE1
|
|
ALLMDNE JMP CROUT ;YES SO DONE
|
|
*
|
|
CONVERT1 LDX #$01 ;FOR ONE BYTE
|
|
DFB $2C ;BIT TO HIDE NEXT
|
|
CONVERT2 LDX #$03 ;FOR TWO BYTES
|
|
LDY #$00
|
|
JSR CHRGOT ;FIRST ONE AT TXTPTR
|
|
CMP #$B8 ;MINUS SO DEF TOKEN?
|
|
BNE NXTGT1 ;NO,QUIT - PROBABLE SYNTAX ERROR
|
|
CPX #$02 ;GOT ROOM FOR 3?
|
|
BLT NXTGT1
|
|
LDA #$03 ;YES SO PUT IN D,E,F
|
|
STA XSAV ;IF THEY FIT
|
|
LDA #$C3 ;START AT C
|
|
CLC
|
|
DEFLUP ADC #$01 ;AND GO UP
|
|
DEC XSAV
|
|
BMI NEXTGET ;DONE ALL 3
|
|
STA IN,Y
|
|
INY
|
|
DEX
|
|
BPL DEFLUP ;ALWAYS
|
|
NEXTGET JSR CHRGET ;GET NEXT ONE
|
|
NXTGT1 BCC NXTGT2 ;NUMBER SO GO ON
|
|
CMP #$41 ;NO SO IS AT LEAST A
|
|
BCC ZERCHR ;NO
|
|
CMP #$47 ;YES SO IS <G?
|
|
BCC NXTGT2 ;YES SO OK
|
|
ZERCHR LDA #$00
|
|
BEQ PUTCHR
|
|
NXTGT2 ORA #$80 ;SET HI BIT
|
|
PUTCHR STA IN,Y
|
|
BEQ CNT ;EXIT IF ZERO
|
|
INY
|
|
BEQ CNT ;EXIT IF RUN OFF BUFFER
|
|
DEX ;OR IF TO MAXIMUM #
|
|
BPL NEXTGET
|
|
LDA #$00
|
|
STA IN,Y ;ENSURE ENDS WITH ZERO
|
|
JSR CHRGET ;AND ADVANCE TXTPTR
|
|
CNT JSR ZMODE
|
|
JSR TOGETNUMM
|
|
LDX A2L
|
|
LDA A2H
|
|
RTS
|
|
*
|
|
*PATCH AREA FOR BASIS COMPATIBILITY
|
|
*
|
|
TOOUTDOA JMP ($D760)
|
|
TOBL1 JMP ($FEF7)
|
|
TOGETNUMM JMP ($FF74)
|
|
*
|
|
*
|
|
*PATCH AREA FOR //E
|
|
*
|
|
ISETYCLM LDA SIGBYTE ;SEE IF //E
|
|
CMP #$06 ;IS 6
|
|
BNE ISETYRTS1 ;NO SO OUT WITH NE
|
|
LDA ISETYCOL
|
|
EOR #$8D ;NOW 0 IF ON
|
|
BEQ ISETYRTS ;YUP, GOT IT
|
|
ULTRASIG EQU $C30B
|
|
ISULTRA LDA ULTRASIG
|
|
CMP #$01 ;IS ULTRATERM
|
|
BNE ISETYRTS1 ;NO
|
|
LDA ULTRASIG+1
|
|
CMP #$87
|
|
BNE ISETYRTS1 ;NO
|
|
LDA #$C3 ;IS ACTIVE
|
|
CMP VECTOUT+1 ;AND IN SLOT 3
|
|
BEQ ISETYRTS ;OK
|
|
CMP CSWL+1 ;OR MAYBE DOS OFF
|
|
ISETYRTS CLC
|
|
DFB $B0 ;HIDES
|
|
ISETYRTS1 SEC
|
|
RTS
|
|
*CARRY SET IF NOT THERE, CLEAR IF IT IS, EQ SET IF ALSO ON
|
|
*
|
|
GETCH JSR ISETYCLM
|
|
BEQ GETCH2 ;IF TWOE AND 80COL
|
|
LDA CH ;OTHERWISE ORDINARY
|
|
RTS
|
|
GETCH2 LDA TWOECH
|
|
RTS
|
|
*
|
|
TWOEOFF0 JSR ISULTRA
|
|
BNE TWOEOFF1
|
|
LDA #$96 ;TURN OFF ULTRA
|
|
JSR COUT
|
|
LDA #$B0
|
|
JSR COUT
|
|
RTS
|
|
*
|
|
TWOEOFF1 JSR ISETYCLM
|
|
BNE ISETYRTS ;NOT //E 80
|
|
LDA #$15 ; CNTRL -U
|
|
JMP COUT ;IS
|
|
*
|
|
*MONITOR AND OTHER ROUTINES HERE
|
|
PRBL1 LDA #$A0 ;PRINT A BLANK
|
|
JMP COUT ;GO DO IT
|
|
*
|
|
*
|
|
ALLDONE0 JSR CROUT
|
|
ALLDONE PHP ;SAVE ERROR FLAG
|
|
PHA
|
|
JSR APDATA ;FIX UP APPLESOFT LINE
|
|
LDA #0
|
|
STA STATUS
|
|
JSR CLOSE
|
|
JSR VDS6 ;FIX EXTERNAL IN CASE BUNGED
|
|
PLA
|
|
PLP ;GET ERROR FLAG BACK
|
|
BCC ALLDONE1 ;ALL OK
|
|
JSR BADCALL ;TRANSLATE
|
|
JMP ERROUT ;DOS HANDLES
|
|
ALLDONE1 LDX STATE ;DIRECT MODE?
|
|
BNE ALDN2 ; NO,PROGRAM SO REHOOK ONLY
|
|
JMP BI_ENTRY
|
|
ALDN2 JMP CSSWON
|
|
*
|
|
*
|
|
* DO INITP-$803
|
|
* ELSE
|
|
DFB $00 ;NEEDED FOR LOW MEMORY VERSION
|
|
ENDPROG EQU *
|
|
* FIN
|