Apple-2-SW/A2osX
1
0
Fork 0
mirror of https://github.com/A2osX/A2osX.git synced 2024-11-25 05:32:20 +00:00
Code Issues Projects Releases Wiki Activity
0.95
A2osX/SCMASM.31/SCMASM.S.FNDREP.txt

408 lines
12 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

NEW
AUTO 3,1
*--------------------------------------
* FIND AND LIST COMMANDS
*--------------------------------
LIST
FIND JSR GET.KEY.STRING
JSR PARSE.LINE.RANGE
JSR HANDLE.REPLACE.OPTIONS
.1 JSR GET.LINE.TO.WBUF
BCC .2
RTS
.2 JSR FIND.KEY.IN.WBUF
BCC .1 KEY NOT IN WBUF
LDA A1L SET UP POINTER FOR LIST
LDX A1H
JSR LIST.LINE.AX
JMP .1
*--------------------------------
* PARSE <D><STRING><D> INTO FREE MEMORY
*--------------------------------
GET.KEY.STRING
LDA #KBUF
STA KEY.ADDR
LDA /KBUF
STA KEY.ADDR+1
GET.KEY2
JSR GNNB GET NEXT NON-BLANK
STA DLIM FOR DELIMITER
BCS .4 EOL
CMP #',
BEQ .4 COMMA
CMP #'. PERIOD
BEQ .4
EOR #$30
CMP #10
BCC .4 DIGIT
LDY #0
.1 STY PNTR
JSR GNC MOVE STRING
BCS .2 END OF LINE
CMP DLIM
BEQ .2 END OF STRING
LDY PNTR
STA (KEY.ADDR),Y
INY
CPY #39 SEE IF STRING FITS
BCC .1 YES, KEEP GOING
LDY #QSTRLNG NO, STRING TOO LONG
JMP HARD.ERROR
.2 LDY PNTR
LDA #0
STA (KEY.ADDR),Y
SEC WE FOUND IT
RTS
.4 LDA #0
STA PNTR
CLC DIDN'T FIND IT
JMP BACKUP.CHAR.PNTR
*--------------------------------
* GET NEXT LINE INTO WBUF
* RETURN CARRY CLEAR IF SUCCESSFUL
* CARRY SET IF BEYOND <ENDP>
* X = LENGTH OF LINE
*--------------------------------
GET.LINE.TO.WBUF
LDA SRCP
STA A1L SAVE POINTER FOR LIST
LDA SRCP+1
STA A1H
JSR CMP.SRCP.ENDP END OF RANGE YET?
BCS .2 ...YES, FINISHED
JSR GET.LINE.NUMBER
LDY #0 START AT BEGINNING OF WBUF
JSR CONVERT.LINE.NUMBER.STORE PUT CONVERTED # AT WBUF,Y
LDA #$A0 APPEND A SPACE AFTER LINE NUMBER
STA WBUF,Y
INY
TYA
TAX
.1 JSR NTKN BYTE FROM PROGRAM
STA WBUF,X
INX
TAY TEST CHAR
BNE .1 END OF LINE
CLC FLAG SUCCESSFUL
.2 RTS
*--------------------------------
* LIST LINE POINTED TO BY <SRCP>
*--------------------------------
LIST.LINE.AX
STA SRCP
STX SRCP+1
*--------------------------------
LIST.CURRENT.LINE
JSR CRLF PRINT CARRIAGE RETURN
JSR SPC SPACE
LDA PROMPT.FLAG
BEQ .1 ...NO SPACE SINCE NOT "H"
JSR SPC
.1 JSR GET.LINE.NUMBER BODY
JSR CONVERT.LINE.NUMBER.PRINT
LDA #$20 SPACE
.2 JSR CHO PRINT CHAR
JSR GET.NEXT.SOURCE.CHAR
BNE .2 NOT END YET
RTS FINISHED
*--------------------------------
* FIND KEY IN WBUF
* RETURN WITH CARRY CLEAR IF NO MATCH.
* RETURN WITH CARRY SET IF MATCH, AND WITH
* (PNTR) = INDEX OF START OF MATCH
* (X) = INDEX OF LAST CHAR MATCHED + 1
*--------------------------------
FIND.KEY.IN.WBUF
JSR FIND.START.OF.LINE.IN.WBUF
LDA PNTR
BNE .1 NON-NULL KEY STRING
LDA DLIM If delimiter is slash, list
CMP #'/' only major labels
BEQ .3 ...it is
SEC ...no string, so SIGNAL MATCH
RTS
.3 LDA WBUF,X GET FIRST CHAR
JSR ELIMINATE.CASE
JMP CHECK.LETTER
.1 LDY #39 MAP SEARCH KEY INTO UPPER CASE
.2 LDA (KEY.ADDR),Y ...IF LC.FLAG IS ON
JSR ELIMINATE.CASE.MAYBE
STA (KEY.ADDR),Y
DEY
BPL .2
FIND.KEY.IN.WBUF2
LDY #0 START AT FIRST CHAR OF KEY
.1 STY KEY.PNTR CURRENT STARTING POINT IN KEY
.2 STX BUF.PNTR CURRENT STARTING POINT IN BUFFER
.3 LDA (KEY.ADDR),Y NEXT CHAR FROM KEY
BEQ .6 END OF KEY, IT MATCHES
CMP WILD.CARD NORMALLY CONTROL-W
BEQ .8 YES
LDA WBUF,X NEXT CHAR FROM BUFFER
BEQ .5 END OF BUFFER, DID NOT MATCH
JSR ELIMINATE.CASE.MAYBE MAP INTO UPPER CASE IS NEEDED
CMP (KEY.ADDR),Y COMPARE WITH KEY CHAR
BNE .4 NO MATCH
INY ADVANCE KEY POINTER
INX ADVANCE BUFFER POINTER
BNE .3 ...ALWAYS
*--------------------------------
.4 LDY KEY.PNTR TRY AGAIN FURTHER INTO BUFFER
LDX BUF.PNTR
INX
BNE .2 ...ALWAYS
*--------------------------------
.5 LDA $C000
CMP #$8D ALLOW 'ABORT' WITH <RETURN>
BEQ .11
CLC SIGNAL NO MATCH
RTS
*--------------------------------
.6 LDA KEY.PNTR SEE IF IN FIRST SEGMENT OF KEY
BNE .7 NO
LDA BUF.PNTR YES
STA PNTR
.7 SEC SIGNAL MATCH
RTS
*--------------------------------
.8 LDA KEY.PNTR SEE IF IN FIRST SEGMENT OF KEY
BNE .9 NO
LDA BUF.PNTR YES
STA PNTR
.9 INY ADVANCE KEY POINTER
LDA (KEY.ADDR),Y PEEK AT NEXT CHAR OF KEY
BNE .1 NOT AT END YET
.10 LDA WBUF,X AT END, SO SCAN TO END OF BUFFER
BEQ .6 FOUND END, AND ALL MATCHES
INX ADVANCE BUFFER POINTER
BNE .10 ...ALWAYS
*--------------------------------
.11 JMP SOFT HE ABORTED
*--------------------------------
* REPLACE COMMAND
*--------------------------------
REPLACE
JSR GET.KEY.STRING
BCC R.ERR1 (SYN ERROR)
LDA PNTR NULL SEARCH FAILS
BEQ R.ERR1
JSR BACKUP.CHAR.PNTR USE DELIMITER OVER AGAIN
LDA #KBUF+40
STA KEY.ADDR
LDA /KBUF+40
STA KEY.ADDR+1 SET UP CALL
JSR GET.KEY2
BCC R.ERR1 (SYN ERROR)
STY REPLACE.LENGTH
JSR PARSE.LINE.RANGE
JSR HANDLE.REPLACE.OPTIONS
LDA #KBUF FOR SEARCH
STA KEY.ADDR
LDA /KBUF
STA KEY.ADDR+1
LDA #1
STA PNTR PNTR MUST BE > 0 FOR SEARCH
.1 JSR GET.LINE.TO.WBUF
BCS .5 FINISHED
STX WBUF.LENGTH
JSR FIND.KEY.IN.WBUF
BCC .1
LDA #0
STA CHANGE.CNT (DEF IS EQ)
.2 TXA COMPUTE # CHARS IN TARGET FIELD
SEC
SBC PNTR
STA SOURCE.LENGTH
STX MATCH.END
JSR REPLACE.REPLACE
BCS .5 NEITHER "Y" NOR "N"
BNE .3 THEY HIT 'N'
INC CHANGE.CNT
LDX MATCH.END
BNE .4 ...ALWAYS
.3 LDX PNTR MATCH BEGINNING
INX +1
.4 JSR FIND.KEY.IN.WBUF2
BCS .2 LOOP IF ANOTHER
LDA CHANGE.CNT ANY CHANGES?
BEQ .1 NO - TRY NEXT LINE
JSR NML PUT LINE BACK
LDA WBUF If replacement line was null,
BEQ .6 then just lshow line number
LDA LINE.END AND LIST
LDX LINE.END+1
JSR LIST.LINE.AX
JMP .1 TRY NEXT LINE
.5 RTS FINISHED
.6 LDA WBUF+1
STA CURRENT.LINE.NUMBER
LDA WBUF+2
STA CURRENT.LINE.NUMBER+1
JSR CRLF
JSR CONVERT.LINE.NUMBER.PRINT
JMP .1
*--------------------------------
R.ERR1 JMP SYNX MISSING STRING
R.ERR2 LDY #QREPLNG REP STRNG TOO LONG
JMP HARD.ERROR
*--------------------------------
* A MATCH IS FOUND, MAYBE REPLACE
* RETURNS: CARRY ZERO
* Q CS NE QUIT
* N CC NE NO CHG
* Y CC EQ CHANGE MADE
*--------------------------------
REPLACE.REPLACE
LDA AUTO.FLAG
BMI .40 - = AUTO MODE, + = VERIFY MODE
JSR PRINT.AND.PROMPT
BNE .99 Q,N EXITS
.40 SEC
LDA REPLACE.LENGTH
SBC SOURCE.LENGTH
BCC .60 (IF SHORTER)
BEQ .50 (IF EQUAL )
*--------------------------------
* REPLACE IS LONGER - MAKE SPACE
* ACC IS REP.LEN-SRC.LEN
*--------------------------------
CLC
ADC WBUF.LENGTH
BCS .45 OVER 256 LEN
CMP #WBUF.MAX
BCC .51
.45 JMP R.ERR2 TOO LONG ERR
.51 TAX
LDY WBUF.LENGTH
STX WBUF.LENGTH (RESET IT)
.52 LDA WBUF,Y
STA WBUF,X
DEX
DEY
CPY MATCH.END
BCS .52
INX
STX MATCH.END
*--------------------------------
* MOVE STRING INTO GAP
*--------------------------------
.50 LDX PNTR MOVE REPLACEMENT STRING INTO GAP
LDY #0 POINT AT REPLACEMENT STRING
.55 LDA KBUF+40,Y NEXT CHAR FROM REP. STRING
BEQ .57 END OF REP. STRING
STA WBUF,X STORE IN GAP
INX
INY
BNE .55 ...ALWAYS
.57 CLC SIGNAL SUCCESS
LDA #0 (CC,EQ)
.99 RTS
*--------------------------------
* REPLACE IS SHORTER - REMOVE EXTRA
*--------------------------------
.60 LDA PNTR
ADC REPLACE.LENGTH
TAX
LDY MATCH.END
STX MATCH.END (RESET IT)
.1 LDA WBUF,Y
STA WBUF,X
INY
INX
CPX WBUF.LENGTH
BCC .1
STX WBUF.LENGTH (RESET THIS TOO)
BCS .50 ...ALWAYS
*--------------------------------
* PRINT LINE AND GET Y,N,Q
* RETURNS: CARRY ZERO
* Q CS NE
* N CC NE
* Y CS EQ
*--------------------------------
PRINT.AND.PROMPT
JSR P.RETURN PRINT <CR>
LDX #0
.1 LDA WBUF,X
BEQ .4 EOL?
ORA #$80
CMP #$A0 SKIP CONTROL
BCC .3
CPX PNTR
BCC .2
CPX MATCH.END
BCS .2
JSR ELIMINATE.CASE
AND #$3F ...DISPLAY IN INVERSE
.2 JSR IO.COUT
.3 INX
BNE .1 NEXT CHAR
.4 JSR MON.CLREOL
LDY #QREPPRMT PRINT "REPLACE? "
YES.OR.NO
JSR QT.OUT
JSR READ.KEY.WITH.CASE
CMP #$A0 CONTROL CHAR?
BCC .2 ...YES, DO NOT ECHO
JSR MY.COUT
AND #$DF NOW IGNORE CASE
.2 CMP #'N+$80 NO: RETURN CC, NE
BEQ .1 ..."N"
CMP #'Y+$80 YES: RETURN CS, EQ
SEC NEITHER: CS, NE
RTS
.1 LSR WAS = N = $CE, SO CLEAR CARRY, SET NE
RTS
*--------------------------------
* SET FLAGS FROM CHAR IN ACC
* CHAR FLAG MEANING
* "A" AUTO.FLAG +=VERIFY, -=AUTO
* "U" LC.FLAG +=AS TYPED, -=ACCEPT EITHER CASE
*
* RETURN CS -> VALID OPTION
* CC -> NOT AN OPTION
*--------------------------------
HANDLE.REPLACE.OPTIONS
LSR AUTO.FLAG +=VERIFY MODE
LSR LC.FLAG +=CASE AS TYPED
.1 JSR GNNB GET NEXT BYTE FROM INPUT LINE
BCS .3 END OF LINE
JSR ELIMINATE.CASE MAP LOWER TO UPPER
CMP #'A AUTO MODE?
BNE .2 NO
ROR AUTO.FLAG YES, SET SIGN BIT FROM CARRY
.2 CMP #'U ACCEPT BOTH CASES?
BNE .1 NO
ROR LC.FLAG YES, SET SIGN BIT FROM CARRY
BNE .1 ...ALWAYS
.3 RTS
*--------------------------------
* MAP LOWER CASE INTO UPPER CASE
*--------------------------------
ELIMINATE.CASE.MAYBE
BIT LC.FLAG
BPL LCUC3 DON'T DO IT
ELIMINATE.CASE
PHA SAVE ORIGINAL CHAR
ORA #$80 MAKE CANONICAL FORM
CMP #$E0 IN LOWER CASE REGION?
PLA RESTORE ORIGINAL CHAR
BCC LCUC3 ...NOT LOWER CASE REGION
AND #$DF ...LC, MAP TO UPPER CASE
LCUC3 RTS
*--------------------------------
* LOAD CURRENT LINE NUMBER FROM SRCP
*--------------------------------
GET.LINE.NUMBER
JSR GNB SKIP LENGTH
JSR GNB GET LINE NUMBER
STA CURRENT.LINE.NUMBER
JSR GNB
STA CURRENT.LINE.NUMBER+1
RTS
*--------------------------------------
MAN
SAVE usr/src/scmasm.31/scmasm.s.fndrep
LOAD usr/src/scmasm.31/scmasm.s
ASM
Reference in New Issue View Git Blame Copy Permalink