From 673d3aee45071ea609789957e79c40ca88619795 Mon Sep 17 00:00:00 2001 From: Antoine Vignau <34219772+antoinevignau@users.noreply.github.com> Date: Fri, 31 Jul 2020 08:20:16 +0200 Subject: [PATCH] v2.1 from Merlin source code --- source/ampermanager.s | 3523 +++++++++++++++++++++++++++++++++++++++++ source/amperstart.s | 65 + source/formatter.s | 536 +++++++ source/t.ultra.s | 101 ++ 4 files changed, 4225 insertions(+) create mode 100644 source/ampermanager.s create mode 100644 source/amperstart.s create mode 100644 source/formatter.s create mode 100644 source/t.ultra.s diff --git a/source/ampermanager.s b/source/ampermanager.s new file mode 100644 index 0000000..31e8ebe --- /dev/null +++ b/source/ampermanager.s @@ -0,0 +1,3523 @@ +* +* 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 AMPSTR ;HIGH BYTE + JSR MOVAYBUF0 + JSR DOSCMD ;AND MAKE ProDOS DO IT + JSR $80C + LDA #13 + STA YSAV + LDA #PROGSTR + JSR MOVAYBUF0 + JMP DOSCMD + +* +* MOVE COMMAND POINTED TO BY (A,Y) TO BUFFER AT $200 +* LEN IN YSAV + +MOVAYBUF0 LDX #$00 +MOVAYBUF STY FORPNT+1 ;SET UP ON ZERO PAGE + STA FORPNT + TXA + CLC + ADC YSAV + TAX + STX XSAV + DEX + LDY YSAV ;COUNTER FOR LEN +MOVFOR1 DEY + BMI MOVCRBUF ;WHEN FINISHED + LDA (FORPNT),Y + ORA #$80 ;HI BIT SET + STA IN,X + DEX + BPL MOVFOR1 ;ALWAYS +MOVCRBUF LDA #$8D + LDX XSAV + STA IN,X +FIXEDRTS RTS + +AMPSTR ASC 'BLOADAMPERMANAGER' +PROGSTR ASC '-RECEPTIONIST' diff --git a/source/formatter.s b/source/formatter.s new file mode 100644 index 0000000..22f28a7 --- /dev/null +++ b/source/formatter.s @@ -0,0 +1,536 @@ +s* * * * * * * * * * * * * * * * * * * * * * * * * * * * +* * * * * * * * * * * * * * * * * * * * * * * * * * * * +* * * * +* * M U S T B E O N P A G E B O U N D A R Y * * +* * * * +* * * * * * * * * * * * * * * * * * * * * * * * * * * * +* * * * * * * * * * * * * * * * * * * * * * * * * * * * +* ORG $7800 +* * * * * * * * * * * * * * * * * * * * * * * * * * * * +* * +* ProDOS DISK ][ Formatter Device Driver * +* * +* Copyright Apple Computer, Inc., 1982, 1983 * +* * +* Enter with ProDOS device number in A-register: * +* Zero = bits 1, 2, 3, 4 * +* Slot No.= bits 4, 5, 6 * +* Drive 1 = bit 7 off * +* Drive 2 = bit 7 on * +* * +* Error codes returned in A-register: * +* $00 : Good completion * +* $27 : Unable to format * +* $2B : Write-Protected * +* $33 : Drive too SLOW * +* $34 : Drive too FAST * +* NOTE: Carry flag is set if error occured. * +* * +* Uses zero page locations $D0 thru $DD * +* * +* * * * * * * * * * * * * * * * * * * * * * * * * * * * + JSR *+$3A + CMP #$00 + BNE *+$04 + CLC + RTS + CMP #$02 + BNE *+$07 + LDA #$2B + JMP *+$12 + CMP #$01 + BNE *+$07 + LDA #$27 + JMP *+$09 + CLC + ADC #$30 + JMP *+$03 + SEC + RTS + ASL A + ASL *+$400 + STA *+$40F + TXA + LSR A + LSR A + LSR A + LSR A + TAY + LDA *+$406 + JSR *+$193 + LSR *+$3EE + RTS + TAX + AND #$70 + STA *+$3E6 + TXA + LDX *+$3E2 + ROL A + LDA #$00 + ROL A + BNE *+$08 + LDA $C08A,X + JMP *+$06 + LDA $C08B,X + LDA $C089,X + LDA #$D7 + STA $DA + LDA #$50 + STA *+$3C8 + LDA #$00 + JSR *-$3E + LDA $DA + BEQ *+$08 + JSR *+$2D2 + JMP *-$07 + LDA #$01 + STA $D3 + LDA #$AA + STA $D0 + LDA *+$3AA + CLC + ADC #$02 + STA $D4 + LDA #$00 + STA $D1 + LDA $D1 + LDX *+$39F + JSR *-$64 + LDX *+$399 + LDA $C08D,X + LDA $C08E,X + TAY + LDA $C08E,X + LDA $C08C,X + TYA + BPL *+$07 + LDA #$02 + JMP *+$5A + JSR *+$2C1 + BCC *+$10 + LDA #$01 + LDY $D4 + CPY *+$374 + BCS *+$04 + LDA #$04 + JMP *+$47 + LDY $D4 + CPY *+$368 + BCS *+$07 + LDA #$04 + JMP *+$3B + CPY *+$35F + BCC *+$07 + LDA #$03 + JMP *+$31 + LDA *+$357 + STA *+$357 + DEC *+$354 + BNE *+$07 + LDA #$01 + JMP *+$21 + LDX *+$348 + JSR *+$8C + BCS *-$10 + LDA $D8 + BNE *-$14 + LDX *+$33C + JSR *+$1D + BCS *-$1C + INC $D1 + LDA $D1 + CMP #$23 + BCC *-$73 + LDA #$00 + PHA + LDX *+$329 + LDA $C088,X + LDA #$00 + JSR *-$DF + PLA + RTS + LDY #$20 + DEY + BEQ *+$5E + LDA $C08C,X + BPL *-$03 + EOR #$D5 + BNE *-$0A + NOP + LDA $C08C,X + BPL *-$03 + CMP #$AA + BNE *-$0C + LDY #$56 + LDA $C08C,X + BPL *-$03 + CMP #$AD + BNE *-$17 + LDA #$00 + DEY + STY $D5 + LDA $C08C,X + BPL *-$03 + CMP #$96 + BNE *+$32 + LDY $D5 + BNE *-$0E + STY $D5 + LDA $C08C,X + BPL *-$03 + CMP #$96 + BNE *+$23 + LDY $D5 + INY + BNE *-$0E + LDA $C08C,X + BPL *-$03 + CMP #$96 + BNE *+$15 + LDA $C08C,X + BPL *-$03 + CMP #$DE + BNE *+$0C + NOP + LDA $C08C,X + BPL *-$03 + CMP #$AA + BEQ *+$5E + SEC + RTS + LDY #$FC + STY $DC + INY + BNE *+$06 + INC $DC + BEQ *-$0B + LDA $C08C,X + BPL *-$03 + CMP #$D5 + BNE *-$0E + NOP + LDA $C08C,X + BPL *-$03 + CMP #$AA + BNE *-$0C + LDY #$03 + LDA $C08C,X + BPL *-$03 + CMP #$96 + BNE *-$17 + LDA #$00 + STA $DB + LDA $C08C,X + BPL *-$03 + ROL A + STA $DD + LDA $C08C,X + BPL *-$03 + AND $DD + STA $D7,Y + EOR $DB + DEY + BPL *-$17 + TAY + BNE *-$47 + LDA $C08C,X + BPL *-$03 + CMP #$DE + BNE *-$50 + NOP + LDA $C08C,X + BPL *-$03 + CMP #$AA + BNE *-$5A + CLC + RTS + STX *+$271 + STA *+$26D + CMP *+$258 + BEQ *+$5E + LDA #$00 + STA *+$265 + LDA *+$24E + STA *+$260 + SEC + SBC *+$259 + BEQ *+$39 + BCS *+$09 + EOR #$FF + INC *+$23E + BCC *+$07 + ADC #$FE + DEC *+$237 + CMP *+$248 + BCC *+$05 + LDA *+$243 + CMP #$0C + BCS *+$03 + TAY + SEC + JSR *+$1F + LDA *+$14A,Y + JSR *+$136 + LDA *+$232 + CLC + JSR *+$15 + LDA *+$149,Y + JSR *+$129 + INC *+$224 + BNE *-$41 + JSR *+$121 + CLC + LDA *+$207 + AND #$03 + ROL A + ORA *+$214 + TAX + LDA $C080,X + LDX *+$20D + RTS + JSR *+$1E0 + LDA $C08D,X + LDA $C08E,X + LDA #$FF + STA $C08F,X + CMP $C08C,X + PHA + PLA + NOP + LDY #$04 + PHA + PLA + JSR *+$5F + DEY + BNE *-$06 + LDA #$D5 + JSR *+$56 + LDA #$AA + JSR *+$51 + LDA #$AD + JSR *+$4C + LDY #$56 + NOP + NOP + NOP + BNE *+$05 + JSR *+$1AC + NOP + NOP + LDA #$96 + STA $C08D,X + CMP $C08C,X + DEY + BNE *-$0E + BIT $00 + NOP + JSR *+$199 + LDA #$96 + STA $C08D,X + CMP $C08C,X + LDA #$96 + NOP + INY + BNE *-$0F + JSR *+$1E + LDA #$DE + JSR *+$19 + LDA #$AA + JSR *+$14 + LDA #$EB + JSR *+$0F + LDA #$FF + JSR *+$0A + LDA $C08E,X + LDA $C08C,X + RTS + NOP + PHA + PLA + STA $C08D,X + CMP $C08C,X + RTS + SEC + LDA $C08D,X + LDA $C08E,X + BMI *+$60 + LDA #$FF + STA $C08F,X + CMP $C08C,X + PHA + PLA + JSR *+$5A + JSR *+$57 + STA $C08D,X + CMP $C08C,X + NOP + DEY + BNE *-$0E + LDA #$D5 + JSR *+$5A + LDA #$AA + JSR *+$55 + LDA #$96 + JSR *+$50 + LDA $D3 + JSR *+$3A + LDA $D1 + JSR *+$35 + LDA $D2 + JSR *+$30 + LDA $D3 + EOR $D1 + EOR $D2 + PHA + LSR A + ORA $D0 + STA $C08D,X + LDA $C08C,X + PLA + ORA #$AA + JSR *+$2A + LDA #$DE + JSR *+$26 + LDA #$AA + JSR *+$21 + LDA #$EB + JSR *+$1C + CLC + LDA $C08E,X + LDA $C08C,X + RTS + PHA + LSR A + ORA $D0 + STA $C08D,X + CMP $C08C,X + PLA + NOP + NOP + NOP + ORA #$AA + NOP + NOP + PHA + PLA + STA $C08D,X + CMP $C08C,X + RTS + BRK + BRK + BRK + LDX #$11 + DEX + BNE *-$01 + INC $D9 + BNE *+$04 + INC $DA + SEC + SBC #$01 + BNE *-$0E + RTS + DFB $01,$30,$28 + DFB $24,$20,$1E + DFB $1D,$1C,$1C + DFB $1C,$1C,$1C + DFB $70,$2C,$26 + DFB $22,$1F,$1E + DFB $1D,$1C,$1C + DFB $1C,$1C,$1C + LDA *+$BE + STA $D6 + LDY #$80 + LDA #$00 + STA $D2 + JMP *+$05 + LDY $D4 + LDX *+$B0 + JSR *-$C8 + BCC *+$05 + JMP *+$93 + LDX *+$A5 + JSR *-$153 + INC $D2 + LDA $D2 + CMP #$10 + BCC *-$19 + LDY #$0F + STY $D2 + LDA *+$92 + STA *+$92 + STA *+$90,Y + DEY + BPL *-$04 + LDA $D4 + SEC + SBC #$05 + TAY + JSR *+$6C + JSR *+$69 + PHA + PLA + NOP + NOP + DEY + BNE *-$0B + LDX *+$74 + JSR *-$248 + BCS *+$3E + LDA $D8 + BEQ *+$15 + DEC $D4 + LDA $D4 + CMP *+$60 + BCS *+$31 + SEC + RTS + LDX *+$5D + JSR *-$25F + BCS *+$1C + LDX *+$55 + JSR *-$2CA + BCS *+$14 + LDY $D8 + LDA *+$4E,Y + BMI *+$0D + LDA #$FF + STA *+$47,Y + DEC $D2 + BPL *-$1E + CLC + RTS + DEC *+$3D + BNE *-$25 + DEC $D6 + BNE *+$04 + SEC + RTS + LDA *+$2F + ASL A + STA *+$2E + LDX *+$29 + JSR *-$293 + BCS *+$08 + LDA $D8 + CMP #$0F + BEQ *+$09 + DEC *+$1D + BNE *-$11 + SEC + RTS + LDX #$D6 + JSR *-$03 + JSR *-$06 + BIT $00 + DEX + BNE *-$09 + JMP *-$B4 + DFB $13,$19,$03 + DFB $10,$00,$00 + DFB $00,$00,$00 + DFB $00,$00,$00 + DFB $00,$00,$00 + DFB $00,$00,$00 + DFB $00,$00,$00 + DFB $00,$00,$00 + DFB $00,$00,$00 diff --git a/source/t.ultra.s b/source/t.ultra.s new file mode 100644 index 0000000..1b38f7f --- /dev/null +++ b/source/t.ultra.s @@ -0,0 +1,101 @@ +* +* Amper Manager - Ultraterm 2 driver +* +* (c) 1987, Paul Smith & Rick Sutcliffe +* (s) 2020, Antoine Vignau +* + + xc + xc + mx %11 + lst off + +*------------------------------- + +* * +* SPREADSHEET 2 * +* ULTRATERM DRIVER * +* * +* BY PAUL SMITH * +* * +* AND * +* RICK SUTCLIFFE * +* * +HOMEC EQU $8C +CNTRLV EQU $96 +ULFORMAT DFB $B1 +* +* +*ULTRATERM FORMATS +USTR ASC 'HERE ARE YOUR ULTRATERM FORMATS:' + DFB $0D,$0D + ASC '0) 40 X 24' + DFB $0D + ASC '1) 80 X 24' + DFB $0D + ASC '2) 96 X 24' + DFB $0D + ASC '3) 160 X 24' + DFB $0D + ASC '4) 80 X 24 I' + DFB $0D + ASC '5) 80 X 32 I' + DFB $0D + ASC '6) 80 X 48 I' + DFB $0D + ASC '7) 132 X 24 I' + DFB $0D + ASC '8) 128 X 32 I' + DFB $0D,$0D + DCI 'PICK FORMAT (1-8) DEFAULT = ' +* +*ACTUAL DRIVER +* +ULTRAO BIT $C061 ;CHECK BUTTONS + BMI ULTRA + BIT $C062 + BPL ULTRAFIN ;NO BUTTON SO FORGET IT +ULTRA JSR ISULTRA + BCC ULTRA2 ;GOT ONE +ULTRAFIN RTS ;NO ULTRATERM +ULTRA2 LDA $BF98 ;80 COL + ORA #$02 + STA $BF98 +ULTRA3 LDA #HOMEC + JSR $C300 ;START UP ULTRATERM + JSR PUTWWDTH + LDA #USTR + JSR PRINTERC + JSR FMTOUT +GETFMT LDA KBD + BPL GETFMT + BIT KBDSTRB + CMP #$8D ;IS RETURN + BEQ TODEFAULT + CMP #$B0 ;LESS THAN 1 + BCC GETFMT ;TRY AGAIN + CMP #$B9 ;OR>8 + BGE GETFMT + STA ULFORMAT ;SAVE IT + EOR #$B0 ;CHANGE TO INDEX + BNE GETFMT1 ;IF NOT 0 GO ON + LDA #$18 + STA WNDBTM + LDA #$28 + STA WNDWDTH + BNE TODEFAULT +GETFMT1 TAX + LDA PWDTBL-1,X ;GET WIDTH + SEC + SBC #$01 + STA WNDWDTH + LDA HGTBL-1,X + STA WNDBTM +TODEFAULT JSR DEFAULT + JSR HOME + JMP CSSWON +DEFAULT LDA #CNTRLV + JSR COUT +FMTOUT LDA ULFORMAT + JMP COUT