* * 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 #TITLIN LDA #AUTHOR LDA #VERNO LDA #CPRNOT LDA #SERNO * LDA # 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 BNE HKSETO ;ALWAYS NOSHOW LDA #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 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 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 = *OR LET =ADDRSS,LEN *OR LET A =PEEK (#EXP) *OR LET A= EXP *OR LET =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 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) CONJ 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 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 ;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 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 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+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 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 #CMDLIN ;YES,ASK IF ZAP LDA # 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