;;; -*-MIDAS-*- TITLE FAST-STRING SUPPORT FOR MACLISP .FASL .INSRT SYS:FASDFS ; --------- ;A "STRING" is a 4-hunk, with | 1 | 0 | ; indices as indicated in the --------- ; diagram. | 3 | 2 | ; --------- ; (cxr 0 s) ;ptr to class object for STRINGs ; (cxr 1 s) ;"**SELF-EVAL**" ; (cxr 2 s) ;word-index in STR:ARRAY of first word ; (cxr 3 s) ;length of string, in characters STWIWO==1 ;STRING-WORD-INDEX, WORD-OFFSET - A RH QUANTITIY STLNWO==1 ;STRING-LENGTH, WORD-OFFSET - A LH QUANTITIY STSEWO==0 ;STRING "SELF-EVAL" MARKER, WORD-OFFSET CHNVWO==1 DEFINE STRWDNO AC,IX HRRZ AC,STWIWO(IX) SKIPGE AC,(AC) TERMIN DEFINE STRLEN AC,IX HLRZ AC,STLNWO(IX) MOVE AC,(AC) TERMIN ;Check for new-data-type - STRING or CHARACTER DEFINE CHKSTR ERRH PUSHJ P,SCHKSTR JUMPE T,ERRH TERMIN DEFINE CHKCHR ERRH PUSHJ P,SCHKCHR JUMPE T,ERRH TERMIN SCHKSTR: PUSH P,A PUSH P,B PUSH P,C PUSH FXP,F CALL 1,.FUNCT STRINGP XSCHKSTR: POP FXP,F MOVE T,A POP P,C POP P,B POP P,A POPJ P, SCHKCHR: PUSH P,A PUSH P,B PUSH P,C PUSH FXP,F CALL 1,.FUNCT CHARACTERP JRST XSCHKSTR ;Check for STRING in A, valid index in B (fall thru if index is bad) DEFINE ST2ACK ERRH,OKADDR CHKSTR ERRH STRLEN R,A ;WILL LEAVE STRING-LENGTH IN R JSP T,FXNV2 ;CERTIFY SECOND ARG AS FIXNUM CAIGE D,(R) ;REQUESTED INDEX MUST BE LESS THAN MAX INDEX JUMPGE D,OKADDR TERMIN ;LaST-BYTe-ify - take the word/byte specifier for a string place, ; and a count, given as 5*(A)+(B), and convert it to a word/byte ; specifier for the "last" byte of the indicated substring. ;The register, dummy arg "W1", holds the word addr, and W1+1 must ; hold the byte address (as a byte number within word). DEFINE LSTBYTIFY W1\TG1,TG2 ADD W1,A ADD W1+1,B SOJGE W1+1,TG1 SOS W1 MOVEI W1+1,4 JRST TG2 TG1: CAIGE W1+1,5 JRST TG2 AOS W1 SUBI W1+1,5 JRST TG1 TG2: TERMIN ;;; Some PDL offsets defined for STRING-POSQ and STRING-REPLACE DEFINE MAKE1 NM,PDL,OFF DEFINE NM OFF(PDL) TERMIN TERMIN IRP NM,,[CNTP,CNT,I2,S2,XCH] MAKE1 NM,P,\-.IRPCNT TERMIN IRP NM,,[INHBFL,N,BY2,WD2,NI2,NCH,NUMCFL,BKWP,OPERATION] MAKE1 NM,FXP,\-.IRPCNT TERMIN ;-4 allows for CNTP,CNT,I2,S2 to be above these goodies on PDL IRP NM,,[I1,S1] MAKE1 NM,P,\-4-.IRPCNT TERMIN ;-4 allows for INHBFL,N,BY2,WD2, to be above these goodies on PDL IRP NM,,[BY1,WD1] MAKE1 NM,FXP,\-4-.IRPCNT TERMIN SUBTTL ERROR MSGS AND COMMENTS IRP A,,[FILL,POSQ,SKIPQ,SCHAR,SCHAR,SNCHAR,SSET,SNSET] 4T.!A==.IRPCNT TERMIN ;;; THE "OPERATION" IS AN INTEGER ENCODING THE OPERATION TYPE AS FOLLOWS: ;;; 0 - FILL (and FILL-N) 4T.FILL ;;; 1 - POSQ (and POSQ-N) 4T.POSQ ;;; 2 - SKIPQ (and SKIPQ-N) 4T.SKIPQ ;;; 3 - ;;; 4 - SEARCH-CHAR 4T.SCHAR ;;; 5 - SEARCH-NOT-CHAR 4T.SNCHAR ;;; 6 - SEARCH-SET 4T.SSET ;;; 7 - SEARCH-NOT-SET 4T.SNSET CZERO: .ATOM #0 WNAERE: LERR [SIXBIT \WRONG NUMBER OF ARGUMENTS FOR A STRING OPERATION!\] BISERE: LERR BISER NACER: SIXBIT \ARGUMENT SHOULD BE A "CHARACTER", FOR STRING OPERATION!\ NACCVER: SIXBIT \BAD NUMERICAL ASCII VALUE FOR CHARACTER ARGUMENT IN STRING OPERATION!\ BISER: SIXBIT \BAD INDEX FOR STRING OPERATION!\ SR2ERM: SIXBIT \INDEX OUT OF RANGE - STRING-REPLACE!\ BISPSK: SIXBIT \BUG IN STRING-POSQ/SKIPQ!\ NASTER: SIXBIT \STRING REQUIRED, FOR STRING OPERATION!\ ;ERROR CODE FOR CHAR CHIERR: EXCH A,B %WTA BISER EXCH A,B JRST CHAR1 CHHERR: %WTA NASTER JRST CHAR1 ;ERROR CODE FOR RPLACHAR RPCIERR: EXCH A,B %WTA BISER EXCH A,B JRST $RPLCN RPCCERR: EXCH A,C %WTA NACCVER EXCH A,C JRST $RPLCN RPCHERR: %WTA NASTER JRST $RPLCN SUBTTL CHAR-N, RPLACHAR-N ;;; CHAR-N and RPLACHAR-N -- each takes about 17 JJ's (JonlJiffies) of time. ;;; on minimun path (non-*rset mode) .ENTRY CHAR-N SUBR 000003 $CHARN: PUSH P,CFIX1 CHAR1: SKIPE .SPECIAL *RSET JRST CHAR1C MOVE D,(B) ;BASIC CHARACTER GET'ER CHAR1B: IDIVI D,5 STRWDNO TT,A ;WORD-INDEX-IN-ARRAY OF STRING BASE JRST CHAR1S ADDI TT,(D) ;WORD-INDEX-IN-STRING OF REQUESTED CHAR LDB TT,BPAR(R) ;IMPURE STRINGS HAVE WORD-INDEX INTO POPJ P, ; STR/:STRING-ARRAY CHAR1S: ADDI D,(TT) LDB TT,BPARS(R) ;PURE STRINGS HAVE ABSOLUTE ADDRESS POPJ P, ;REMEBER, INDEXING OFF "D" CHAR1C: ST2ACK CHHERR,CHAR1B ;Falls thru on index error JRST CHIERR .ENTRY RPLACHAR-N SUBR 000004 $RPLCN: SKIPE .SPECIAL *RSET JRST RPCH1K MOVE D,(B) ;BASIC RPLACHAR'ER! MOVE F,(C) RPCH1B: IDIVI D,5 STRWDNO TT,A ;WORD-INDEX-IN-ARRAY OF STRING BASE JRST RPCH1S ADDI TT,(D) DPB F,BPAR(R) POPJ P, RPCH1S: ADDI D,(TT) DPB F,BPARS(R) POPJ P, RPCH1K: ST2ACK RPCHERR,RPCH1C ;Falls thru on index error JRST RPCIERR RPCH1C: JSP T,FXNV3 ;THIRD ARG MUST BE A FIXNUM SKIPL F,R CAILE F,177 JRST RPCCERR JRST RPCH1B ;Table of byte-ptrs, into "array" by indirecting thru special array cell BPAR: REPEAT 5, @<<35-7*.RPCNT>_36>+07_30 .ARRAY STR/:ARRAY ;Table of byte-ptrs for absolute address, index'd by D BPARS: REPEAT 5, <<35-7*.RPCNT>_36>+07_30 (D) ;Table of just the LH of byte-ptrs, but origined just before the word PPSSTB: REPEAT 6,<<44-7*.RPCNT>_36>+07_30 SUBTTL STRING-PNGET, STRING-PNPUT SPGERR: %WTA NASTER .ENTRY STRING-PNGET SUBR 000003 SKIPN .SPECIAL *RSET JRST SPNG1 CHKSTR SPGERR SPNG1: JSP T,FXNV2 CAIE D,7 LERR [SIXBIT \FOO! NEED A "7" AS 2ND ARG - STRING-PNGET!\] LOCKI HRRZ R,.ARRAY STR/:ARRAY ;GETS TTSAR?? STRWDNO F,A SKIPA R,F ;PURE STRING ALREADY HAS ADDRESS ADD R,F ;ELSE, ADD IN OFFSET TO BUILD STRLEN T,A ; ADDR OF FIRST WORD TO GET MOVE C,A MOVEI A,NIL JUMPE T,UNLKX IDIVI T,5 JUMPE T,SPNG2 PUSH FXP,TT MOVN D,T HRL R,D MOVE TT,(R) ;LOOP AROUND HERE MOVE B,A JSP T,FIX1A JSP T,%CONS AOBJN R,.-4 ;TO HERE POP FXP,TT SPNG2: JUMPE TT,SPNG3 MOVE TT,SPNTB-1(TT) AND TT,(R) MOVE B,A JSP T,FIX1A JSP T,%CONS SPNG3: CALL 1,.FUNCTION NREVERSE UNLKPOPJ SPNTB: REPEAT 4, -1_<29.-<.RPCNT*7>> .ENTRY STRING-PNPUT SUBR 000003 PUSH P,A CALL 1,.FUNCTION LENGTH MOVE TT,(A) PUSH FXP,TT ;ORIGINAL LENGTH OF PNLIST IMULI TT,5 PUSH FXP,TT MOVEI A,(FXP) CALL 1,.FUNCTION MAKE-STRING POP P,B POP FXP,D ;STRING LENGTH SUB FXP,R70+1 LOCKI HRRZ R,.ARRAY STR/:ARRAY ;GETS TTSAR?? STRWDNO F,A SKIPA R,F ;PURE STRING ALREADY HAS ADDRESS ADD R,F ;ADDRESS OF FIRST WORD TO MUNG STPP0: JUMPE B,STPP1 HLRZ C,(B) HRRZ B,(B) MOVE TT,(C) MOVEM TT,(R) AOJA R,STPP0 ;TRIM ^@'S OFF THE END OF THE STRING STPP1: MOVNI T,5 JUMPE TT,STPP2 LSH TT,7 AOJA T,.-2 STPP2: ADD D,T UNLOCKI PUSH P,A MOVE TT,D JSP T,FIX1A MOVE TT,(P) HRLM A,STLNWO(TT) JRST POPAJ SUBTTL CHAR-EQUAL, CHAR-LESSP, CHAR-DOWNCASE, CHAR-UPCASE, .ENTRY CHAR-EQUAL SUBR 000003 TDZA R,R .ENTRY CHAR-LESSP SUBR 000003 MOVEI R,1 ;R HOLDS "EQUAL"P SKIPE .SPECIAL *RSET JRST CHEQ1 MOVE TT,(A) MOVE D,(B) CHEQ0: CAIL TT,"a CAILE TT,"z JRST .+2 SUBI TT,"a-"A CAIL D,"a CAILE D,"z JRST .+2 SUBI D,"a-"A XCT CHEQTB(R) TDZA A,A MOVEI A,.ATOM T POPJ P, CHEQ1: JSP T,FXNV1 JSP T,FXNV2 JRST CHEQ0 CHEQTB: CAME TT,D CAML TT,D .ENTRY CHAR-DOWNCASE SUBR 000002 PUSH P,CFIX1 SKIPE .SPECIAL *RSET JSP T,FXNV1 MOVE TT,(A) CAIL TT,"A CAILE TT,"Z JRST .+2 ADDI TT,"a-"A POPJ P, .ENTRY CHAR-UPCASE SUBR 000002 PUSH P,CFIX1 SKIPE .SPECIAL *RSET JSP T,FXNV1 MOVE TT,(A) CAIL TT,"a CAILE TT,"z JRST .+2 SUBI TT,"a-"A POPJ P, SUBTTL STR/:CLEAR-WORDS, STR/:GRAB-PURSEG .ENTRY STR/:CLEAR-WORDS SUBR 000003 SKIPN D,(B) JRST CPOPJ LOCKI HRRZ R,.ARRAY STR/:ARRAY ;GETS TTSAR?? STRWDNO F,A SKIPA R,F ;"PURE" STRING ALREADY HAS ADDRESS ADD R,F ;ADDR OF FIRST WORD TO CLEAR SETZM (R) SOJE D,UNLKX ADDI D,(R) HRLI R,1(R) MOVSS R BLT R,(D) UNLKX: UNLKPOPJ .ENTRY STR/:GRAB-PURSEG SUBR 000001 PUSH P,CFIX1 PUSHJ P,GRBPSG LSH T,SEGLOG MOVE TT,T POPJ P, SUBTTL STRING-SKIPQ, STRING-POSQ, and variants ;;; STRING-POSQ &optional ( 0) ( 0 ) ;;; STRING-POSQ, and variants for "Backwards" searching, and for "numeric" ;;; argument (instead of "CHARACTER"). ;;; The entry/exit overhead is (in minimun, non-*rset mode path) about 75 JJ's ;;; (JonlJiffies), with about another 75 JJ's for loop set-up time, and ;;; then about 2 JJ's for each character passed over. .ENTRY STRING-SKIPQ LSUBR 003005 TDZA F,F .ENTRY STRING-BSKIPQ LSUBR 003005 MOVEI F,.ATOM T SETZ R, JRST SSK0 .ENTRY STRING-SKIPQ-N LSUBR 003005 TDZA F,F .ENTRY STRING-BSKIPQ-N LSUBR 003005 MOVEI F,.ATOM T ;F - "BACKWARDSP" MOVEI R,.ATOM T ;R - "NUMERIC-CHARACTERP" SSK0: MOVEI D,4T.SKIPQ ;D - "OPERATION" JRST SPQSK0 .ENTRY STRING-POSQ LSUBR 003005 TDZA F,F .ENTRY STRING-BPOSQ LSUBR 003005 MOVEI F,.ATOM T SETZ R, JRST SPQ0 .ENTRY STRING-POSQ-N LSUBR 003005 TDZA F,F .ENTRY STRING-BPOSQ-N LSUBR 003005 MOVEI F,.ATOM T MOVEI R,.ATOM T SPQ0: MOVEI D,4T.POSQ SPQSK0: PUSH FXP,D ;"OPERATION" - SKIPQ, POSQ, FILL PUSH FXP,F ;"BACKWARDSP" FLAG PUSH FXP,R ;"NUMCFL" JSP F,SPQFL% ;SET UP STACK-FRAME, PUSH "INHIBIT", SKIPN N ; AND GET STRING PTR IN A JRST SPQDONE JSP T,SPQFL. ;CALCULATE WORD- AND BYTE- INDICES SKIPE BKWP JRST [ CAIN R,4 JRST SPQ6C JRST SPQ6L ] JUMPE R,SPQ4C ;;;FALLS THRU ;;;FALLS THRU ; AT THIS POINT, IN THE "CACHE" IS: D - WD2, R - BY2, A - N ;Word-align the string-index, in left-most byte of word SPQ4L: MOVE 5,D ;STARTING AT INDEX NOT "WORD ALIGNED" HLL 5,PPSSTB(R) SKIPG C,OPERATION ;SKIPQ or POSQ? LERR BISPSK MOVE F,SP4TB-4T.POSQ(C) ;WILL BE EITHER CAME B,C OR CAMN MOVE C,NCH ;C NOW HAS THE CHAR (IN NUMERIC FORM) SUBI R,5 MOVM TT,R SPQ4A: ILDB B,5 ;LOOP, 1 CHAR AT A TIME, XCT F ; UNTIL "WORD-ALIGNED" JRST SPQ4BDONE SOJLE A,SPQLUZ ;DECREMENTS "N" AOJL R,SPQ4A ADDM TT,NI2 ;UPDATE "START-INDEX" BY NO. OF CHARS AOS D,WD2 ; FROBBLED, AND GO TO NEXT WORD SETZB R,BY2 SPQ4C: IDIVI A,5 MOVEM B,N ;AT THIS POINT, THE INDEX IS NOW "LEFT-ALIGNED" IN A WORD ; AND WE NEED TO DO "N" MORE CHARACTERS, WHICH IS THE SAME AS ; N/5 WORDS AND N\5 CHARS IN THE WORD PRECEEDING THAT ; AT THIS POINT, IN THE "CACHE" IS: D - WD2, B - N SPQ4D: JUMPE A,SPQ4E1 MOVE T,[004020100402] MUL T,NCH ;5 COPIES OF THE BYTE IN QUESTION CAIE T,0 TLO TT,400000 MOVE F,[000017700000] ;MIDDLE-BYTE MASK MOVEI R,5 ;INCREMENT TO NI2 EACH TIME THRU LOOP SKIPG T,OPERATION LERR BISPSK CAIE T,4T.POSQ JRST SSK4E SPQ4E: MOVE T,(D) ;The "group" form of POSQ XOR T,TT TLNN T,774000 JRST SPQDONE TLNN T,003760 JRST [ MOVEI TT,1 JRST SPQ4DONE ] TDNN T,F JRST [ MOVEI TT,2 JRST SPQ4DONE ] TRNN T,077400 JRST [ MOVEI TT,3 JRST SPQ4DONE ] TRNN T,000376 JRST [ MOVEI TT,4 JRST SPQ4DONE ] AOJ D, ADDM R,NI2 SOJN A,SPQ4E MOVEM D,WD2 SPQ4E1: MOVE A,N ;Restore cache - see SPQ4L SETZB R,BY2 JRST SPQ4L SP4TB: CAMN B,C ;CONTINUE TEST FOR POSQ CAME B,C ;CONTINUE TEST FOR SKIPQ SSK4E: MOVE T,(D) ;The "group" form of SKIPQ XOR T,TT TLNE T,774000 JRST SPQDONE TLNE T,003760 JRST [ MOVEI TT,1 JRST SPQ4DONE ] TDNE T,F JRST [ MOVEI TT,2 JRST SPQ4DONE ] TRNE T,077400 JRST [ MOVEI TT,3 JRST SPQ4DONE ] TRNE T,000376 JRST [ MOVEI TT,4 JRST SPQ4DONE ] AOJ D, ADDM R,NI2 SOJN A,SSK4E MOVEM D,WD2 JRST SPQ4E1 SPQLUZ: MOVEI A,NIL JRST SPQFL$ SPQDONE: TDZA TT,TT SPQ4BDONE: ADD TT,R SPQ4DONE: ADD TT,NI2 JSP T,FIX1A SPQFL$: SETZB 2,3 SETZB 4,5 UNLOCKI SUB FXP,R70+NPQFXV-1 SUB P,R70+5 ;4 ARGS AND "CNTP" POPJ P, ;AT THIS POINT, IN THE "CACHE" IS: D - WD2, R - BY2, A - N ;Word-align the string-index, in right-most byte of word SPQ6L: MOVE 5,D HLL 5,PPSSTB+1(R) SKIPN C,OPERATION LERR BISPSK MOVE F,SP4TB-4T.POSQ(C) ;WILL BE EITHER CAME B,C OR CAMN MOVE C,NCH ;C NOW HAS THE CHAR (IN NUMERIC FORM) MOVE T,[0700_30] MOVN TT,R SPQ6A: LDB B,5 XCT F JRST SPQ4BDONE SOJLE A,SPQLUZ ;DECREMENTS "N" ADD 5,T ;DECREMENT BP SKIPGE 5 SUB 5,[430000,,1] SOJGE R,SPQ6A ADDM TT,NI2 SOS D,WD2 MOVEI R,4 MOVEM R,BY2 SPQ6C: IDIVI A,5 MOVEM B,N ;AT THIS POINT, THE INDEX IS NOW "RIGHT-ALIGNED" IN A WORD ; AND WE NEED TO DO "N" MORE CHARACTERS, WHICH IS THE SAME AS ; N/5 WORDS AND N\5 CHARS IN THE WORD PRECEEDING THAT ; AT THIS POINT, IN THE "CACHE" IS: D - WD2, R - BY2, B - N SPQ6D: JUMPE A,SPQ6E1 MOVE T,[004020100402] MUL T,NCH ;5 COPIES OF THE BYTE IN QUESTION CAIE T,0 TLO TT,400000 MOVE F,[000017700000] ;MIDDLE-BYTE MASK MOVNI R,5 ;DECREMENT TO NI2 EACH TIME THRU LOOP SKIPG T,OPERATION LERR BISPSK CAIE T,4T.POSQ JRST SSK6E SPQ6E: MOVE T,(D) SOJ D, ADDM R,NI2 XOR T,TT TRNN T,000376 JRST [ MOVEI TT,4 JRST SPQ4DONE ] TRNN T,077400 JRST [ MOVEI TT,3 JRST SPQ4DONE ] TDNN T,F JRST [ MOVEI TT,2 JRST SPQ4DONE ] TLNN T,003760 JRST [ MOVEI TT,1 JRST SPQ4DONE ] TLNN T,774000 JRST SPQDONE SOJN A,SPQ6E MOVEM D,WD2 SPQ6E1: MOVE A,N ;Restore cache - see SPQ6L MOVEI R,4 MOVEM R,BY2 JRST SPQ6L SSK6E: MOVE T,(D) SOJ D, ADDM R,NI2 XOR T,TT TRNE T,000376 JRST [ MOVEI TT,4 JRST SPQ4DONE ] TRNE T,077400 JRST [ MOVEI TT,3 JRST SPQ4DONE ] TDNE T,F JRST [ MOVEI TT,2 JRST SPQ4DONE ] TLNE T,003760 JRST [ MOVEI TT,1 JRST SPQ4DONE ] TLNE T,774000 JRST SPQDONE SOJN A,SSK6E MOVEM D,WD2 JRST SPQ6E1 SUBTTL Checking Routines for SKIPQ, POSQ, and FILL ;Pushes things, does a LOCKI, and leaves string ptr in A SPQFL%: ADDI T,4 JUMPE T, [ PUSH P,[.ATOM T ] ;"CNTP" set to T JRST SPQ1A0 ] JUMPL T,WNAERE SOJE T,SPQ1A1 ;only "CNT" not supplied SOJG T,WNAERE SKIPE -1(FXP) ;"BKWP", but others not yet pushed HRROS -1(FXP) ; set up "I2P" in lh of "BKWP" PUSH P,CZERO ;Make space for "I2" SPQ1A1: PUSH P,CZERO ;Make space for "CNT" PUSH P,R70 ;"CNTP" set to () SPQ1A0: SKIPE -1(FXP) ;"BKWP", but others not yet pushed JRST SPQ1A SKIPN -2(FXP) ;"OPERATION", but others not yet pushed JRST [ MOVE T,S2 ;Must reverse first two args EXCH T,XCH ; of a call to STRING-FILL MOVEM T,S2 JRST SPQ1A ] SPQ1A: SKIPN .SPECIAL *RSET JRST SPQ2 MOVE A,XCH ;"NUMCFL", but notice that other things SKIPE (FXP) ; are not yet pushed JRST [ JSP T,FXNV1 JUMPL TT,SPQCERR ;Certify 1st arg as FIXNUM for ASCII CAILE TT,177 ; characgter value JRST SPQCERR JRST SPQ1E ] MOVE TT,-2(FXP) ;"OPERATION", but others not yet pushed CAIL TT,4T.SSET JRST SPQ1E CHKCHR SPQNCERR ;FOR NON-"SET" OPERATIONS, CHK FOR CHAR SPQ1E: MOVE A,S2 MOVE B,I2 ST2ACK SPQHERR,SPQ1B ;LEAVE STRING-LENGTH IN R, FALL THRU ON ERROR SPQIERR: %WTA BISER MOVEM A,I2 JRST SPQ1A SPQCER: %WTA NACCVER SKIPA SPQNCER: %WTA NACER MOVEM A,XCH JRST SPQ1A SPQHER: %WTA BISER MOVEM A,S2 JRST SPQ1A SUBTTL Calculation Routines for SKIPQ, POSQ, and FILL SPQ1B: SKIPN CNTP ;ST2ACK macro has left numerical index in D JRST SPQ2 ; numerical string length in R MOVE A,CNT JSP T,FXNV1 ;"CNT" ARG MUST BE FIXNUM JUMPL TT,SPQNERR SKIPE -1(FXP) ;"BKWP", but others not yet pushed JRST [ SUB D,TT JUMPL D,SPQNERR JRST SPQ2 ] ADD D,TT CAILE D,(R) JRST SPQNERR SPQ2: SKIPN (FXP) ;"NUMCFL", BUT OTHER THINGS NOT YET PUSHED JRST [ MOVE TT,-2(FXP) ;"OPERATION", but others not yet pushed MOVE T,XCH CAIGE TT,6 HRRZ T,CHNVWO(T) JRST SPQ2B ] MOVE T,@XCH SPQ2B: SPQ2S==. PUSH FXP,T ;NCH PUSH FXP,@I2 ;NI2 PUSH FXP,(FXP) ;WD2 PUSH FXP,R70 ;BY2 PUSH FXP,@CNT ;N PUSH FXP,INHIBIT ;INHIBIT - part of a LOCKI NPQFXV==.-SPQ2S+3 ;ADD IN 3 FOR "OPERATION", "BKWP", AND "NUMCFL" MOVE A,S2 STRLEN TT,A ;STRING-LENGTH INTO TT SKIPE T,BKWP JRST [ TLNN T,-1 JRST [ CAMG TT,NI2 JRST BISERE ;If I2 was supplied, then prepare to MOVE TT,NI2 ; set N to length of string. AOJA TT,SPQ2A ] SOS TT ;If I2 not supplied, set NI2 to length MOVEM TT,NI2 ; of string -1, and prepare to set N, AOJA TT,SPQ2A ] ; as above, to length of string SUB TT,NI2 JUMPLE TT,BISERE SPQ2A: SKIPN CNTP JRST [ MOVEM TT,N ;CALCULATE CNT FROM OTHER ARGS JRST SPQ3 ] CAMGE TT,N JRST [ PUSHJ FLP,SPQCNR JRST SPQ2A ] SPQ3: SETOM INHIBIT ;A SHOULD HAVE THE STRING IN IT JRST (F) SPQNERR: PUSH FLP,[SPQ1B] SPQCNR: WTA [SIXBIT \BAD "CNT" ARGUMENT TO STRING OPERATION!\] MOVEM A,CNT SETOM CNTP POPJ FLP, ;Calculates word address and byte-number within word or first character SPQFL.: MOVE D,NI2 IDIVI D,5 MOVEM R,BY2 ;0-ORIGINED BYTE-NO WITHIN WORD STRWDNO F,A ;WORD-INDEX-IN-ARRAY JRST SPQFL1 ADD D,F HRRZ F,.ARRAY STR/:ARRAY ;GETS TTSAR?? ADD D,F SPQFL2: MOVEM D,WD2 ;ADDRESS OF FIRST WORD TO FROBULATE MOVE A,N JRST (T) SPQFL1: ADDI D,(F) ;PURE FIXNUM HAS ACTUAL ADDRESS JRST SPQFL2 SUBTTL STRING-FILL .ENTRY STRING-FILL LSUBR 003006 TDZA R,R .ENTRY STRING-FILL-N LSUBR 003006 MOVEI R,.ATOM T MOVEI D,4T.FILL PUSH FXP,D ;"OPERATION" is 0 for FILL PUSH FXP,R70 ;"BKWP" is null too PUSH FXP,R ;"NUMCFL" JSP F,SPQFL% SKIPN N JRST SPQFL$ JSP T,SPQFL. JUMPE R,SFL4C ; At this point, in the "CACHE" is: D - WD2, R - BY2, A - N SFL4L: MOVE 5,D HLL 5,PPSSTB(R) MOVE C,NCH SUBI R,5 MOVM TT,R SFL4A: IDPB C,5 SOJLE A,[MOVE A,S2 JRST SPQFL$] AOJL R,SFL4A ADDM TT,NI2 AOS D,WD2 SETZB R,BY2 SFL4C: IDIVI A,5 MOVEM B,N JUMPE A,SFLE1 MOVE T,[004020100402] MUL T,NCH ;5 COPIES OF THE BYTE IN QUESTION CAIE T,0 TLO TT,400000 MOVEM TT,(D) HRLI F,(D) HRRI F,1(D) ADD D,A MOVEM D,WD2 SOJE A,SFLE1 BLT F,-1(D) SFLE1: MOVE A,N JRST SFL4L SUBTTL STRING-SEARCH-... for LISPM compatibilities .ENTRY STRING-SEARCH-SET LSUBR 003004 TDZA F,F .ENTRY STRING-REVERSE-SEARCH-SET LSUBR 003004 MOVEI F,.ATOM T MOVEI D,4T.SSET JRST SSS0 .ENTRY STRING-SEARCH-NOT-SET LSUBR 003004 TDZA F,F .ENTRY STRING-REVERSE-SEARCH-NOT-SET LSUBR 003004 MOVEI F,.ATOM T MOVEI D,4T.SNSET SSS0: MOVEI R,NIL JRST SSSC0 .ENTRY STRING-SEARCH-CHAR LSUBR 003004 TDZA F,F .ENTRY STRING-REVERSE-SEARCH-CHAR LSUBR 003004 MOVEI F,.ATOM T MOVEI D,4T.SCHAR JRST SSC0 .ENTRY STRING-SEARCH-NOT-CHAR LSUBR 003004 TDZA F,F .ENTRY STRING-REVERSE-SEARCH-NOT-CHAR LSUBR 003004 MOVEI F,.ATOM T MOVEI D,4T.SNCHAR SSC0: MOVEI R,.ATOM T SSSC0: PUSH FXP,D ;"OPERATION" PUSH FXP,F ;"BACKWARDSP" FLAG PUSH FXP,R ;"NUMCFL" JSP F,SPQFL% ;SET UP STACK-FRAME, PUSH "INHIBIT", SKIPN N ; AND GET STRING PTR IN A JRST SPQDONE JSP T,SPQFL. ;CALCULATE WORD- AND BYTE- INDICES MOVE 5,D ; AND LEAVE "CNT" IN A MOVE B,OPERATION MOVE F,SSC4TB-4(B) MOVEM F,OPERATION SETZ TT, CAIL B,4T.SSET JRST SSC6L MOVE C,NCH ;C NOW HAS THE CHAR (IN NUMERIC FORM) CAIL C,"a ;UPPER-CASIFY C IF NOT A "SET" OPERAT CAILE C,"z JRST .+2 SUBI C,"a-"A SSC6L: HLL 5,PPSSTB+1(R) JRST SSC6A ;;;FALLS THRU ;;;FALLS THRU SSC6B: IBP 5 SSC6A: LDB B,5 CAIL B,"a ;UPPER-CASIFY B IF NOT A "SET" OPERAT CAILE B,"z JRST .+2 SUBI B,"a-"A XCT OPERATION JRST SPQ4DONE SOJLE A,SPQLUZ ;DECREMENTS "N" SKIPN BKWP AOJA TT,SSC6B ADD 5,[0700_30] ;DECREMENT BP SKIPGE 5 SUB 5,[430000,,1] SOJA TT,SSC6A SSC4TB: CAMN B,C ;Continue test for SEARCH-CHAR CAME B,C ;Continue test for SEARCH-NOT-CHAR JSP T,SSMQL ;Continue test for SEARCH-SET JSP T,SSNMQL ;Continue test for SEARCH-NOT-SET SSMQL: HRRZ D,XCH ;MUST PRESERVE A,4,5,TT 1SSMQL: JUMPE D,1(T) HLRZ C,(D) MOVE C,(C) ;GET NUMERIC VALUE? CAIL C,"a ;UPPER-CASIFY C IF NOT A "SET" OPERAT CAILE C,"z JRST .+2 SUBI C,"a-"A CAMN B,C JRST (T) HRRZ D,(D) JRST 1SSMQL SSNMQL: HRRZ D,XCH 1SSNMQL: JUMPE D,(T) HLRZ C,(D) MOVE C,(C) ;GET NUMERIC VALUE? CAIL C,"a ;UPPER-CASIFY C IF NOT A "SET" OPERAT CAILE C,"z JRST .+2 SUBI C,"a-"A CAMN B,C JRST 1(T) HRRZ D,(D) JRST 1SSNMQL SUBTTL STRING-REPLACE ;;; STRING-REPLACE &optional ( 0) ( 0) ( 0 ) .ENTRY STRING-REPLACE LSUBR 003006 MOVNS T CAIN T,5 JRST [ PUSH P,[.ATOM T ] JRST SR0 ] CAIG T,5 CAIGE T,2 JRST WNAERE JRST .-1(T) ;PAD OUT UNSUPPLIED ARGS WITH 0 REPEAT 3, PUSH P,CZERO PUSH P,R70 ;"CNTP" SR0: MOVE T,-3(P) EXCH T,-4(P) ;RE-ARRANGE "S2" AND "I1" MOVEM T,-3(P) SR1: SKIPN .SPECIAL *RSET JRST SR2 ;Check all argument types and ranges IRP STR,,[S1,S2]ITM,,[I1,I2] MOVE A,STR MOVE B,ITM ST2ACK SR!STR!ER,SR!STR!EX MOVE A,B WTA [BAD INDEX - STRING-REPLACE!] MOVEM A,ITM JRST SR1 SR!STR!ER: %WTA NASTER MOVEM A,STR JRST CHAR1 SR!STR!EX: TERMIN SR2: MOVE A,S1 MOVE B,S2 STRLEN T,A STRLEN TT,B SRFXVP==. PUSH FXP,@I1 ;wd1 PUSH FXP,R70 ;by1 PUSH FXP,@I2 ;wd2 PUSH FXP,R70 ;by2 PUSH FXP,@CNT ;n PUSH FXP,INHIBIT ;INHIBIT - beginning part of a LOCKI NSRFXV==.-SRFXVP CAMG T,WD1 JRST SR2A CAMG TT,WD2 JRST SR2B SUB T,WD1 ;CALCULATE "CNT", IF NOT SUPPLIED SUB TT,WD2 CAMGE T,TT ;PUT INTO TT MAXIMUM LEGAL "CNT", WHICH IS MOVE TT,T ; MIN OF THE 2 "LENGTH-STARTINDEX"'s SKIPN CNTP MOVEM TT,N CAMGE TT,N JRST SR2C ;;;FALLS THRU ;;;FALLS THRU SR3: SETOM INHIBIT SKIPN N JRST SRDONE HRRZ F,.ARRAY STR/:ARRAY ;GETS TTSAR?? MOVE T,WD1 IDIVI T,5 ;CALCULATE WORD AND BYTE ADDRESS STRWDNO D,A SKIPA ADD T,F ; FOR START POSITION OF MOVEMENT ADDI T,(D) MOVEM T,WD1 MOVEM TT,BY1 MOVE D,WD2 IDIVI D,5 ;CALCULATE WORD AND BYTE ADDRESS STRWDNO F,B ; FOR START POSITION OF SOURCE JRST SR3A1 ADD D,F HRRZ F,.ARRAY STR/:ARRAY ;GETS TTSAR AGAIN ADD D,F SR3A2: MOVEM D,WD2 MOVEM R,BY2 MOVE A,N ;CNT/5 - NUMBER OF FULL WORDS OF MOVEMENT IDIVI A,5 ;CNT\5 - NUMBER OF BYTES AFTER THAT ; The "CACHE" now has: T - WD1, TT - BY1, D - WD2, R - BY2 ; A - CNT/5, B - CNT\5 CAMGE T,D ;SINK START ADDR IS STRICTLY BELOW JRST SR4 ; SOURCE? CAME T,D JRST SR3B ;MOVING BY A DISTANCE OF < 5 CHARS? CAMN T,R JRST SRDONE CAMG R,TT JRST SRBTB JRST SR4 SR3A1: ADDI D,(F) ;PURE STRING HAS ABSOLUTE ADDRESS JRST SR3A2 SR3B: MOVE AR1,D ;CHECK FOR OVERLAP OF FIELDS, IF MOVE AR1+1,R ; SOURCE ADDR IS BELOW SINK ADDR. LSTBYTIFY AR1 CAMG T,AR1 JRST SRBTB ;IF SO, THEN MOVE BACKWARDSLY SR4: JUMPE TT,SR4B ;JUMPE IF SINK START CHAR IS ON WD BDRY ;;;FALL THRU ;;;FALLS THRU ;Word-align the sink string-index, in left-most byte of word SR4L: MOVE A,N MOVE 5,D HLL 5,PPSSTB(R) MOVE 4,T HLL 4,PPSSTB(TT) ; The "CACHE" now has: T - WD1, TT - BY1, D - WD2, R - BY2, A - N SR4A: ILDB C,5 IDPB C,4 SOJE A,SRDONE AOJ R, TLNE 4,760000 ;FILL OUT ODD START WORD IN SINK JRST SR4A AOS T,WD1 SETZB TT,BY1 CAIGE R,5 JRST .+3 AOS D,WD2 SUBI R,5 MOVEM R,BY2 IDIVI A,5 ;RE-ADJUST THE CNT/5 AND CNT\5 REGISTERS SR4B: JUMPE A,SR4C ;MOVE SOME "FULL" WORDS ADDI B,5 ;DO AT LEAST 5 CHARS BY SLOW METHOD SOJE A,SR4C ; (YES YOU LOSER, THEY CAN OVERLAP!) HRL F,D HRR F,T ADD T,A MOVEM T,WD1 ;ACCOUNT FOR MOVEMENT OF FULL WORDS ADD D,A MOVEM D,WD2 JUMPN R,SR5 ;JUMP IF SOURCE NOT ON WD BDRY SKIPE A BLT F,-1(T) SR4C: JUMPE B,SRDONE SR4C1: MOVEM B,N JRST SR4L ;GO TO SLOW ILDB-IDPB LOOP FOR LAST 4 CHARS SR5: MOVEM B,N MOVEI 7,-1(T) ;7 - HIGHEST WD INTO WHICH TO MOVE MOVN C,A ;C - NEGATIVE OF # WDS TO MOVE MOVEI 4,(D) ;4 - HIGHEST WD FROM WHICH TO MOVE MOVE 5,R IMULI 5,7 ;AMOUNT BY WHICH TO LSH MOVNI 10,-43(5) HRLI 4,(MOVE B,(C)) HRLI 5,(LSHC A,) MOVE 6,[LSH A,1] HRLI 7,(MOVEM A,(C)) HRLI 10,(LSHC A,) MOVE 12,[JRST SR5A] MOVE A,@4 ROT A,-1 MOVE 11,.+1 AOJLE C,4 SR5A: SKIPN N JRST SRDONE MOVE T,WD1 ;RELOAD THE "CACHE" MOVE TT,BY1 MOVE D,WD2 MOVE R,BY2 JRST SR4L SRDONE: MOVE A,S1 SETZB B,C SETZB 4,5 UNLOCKI SUB FXP,R70+NSRFXV-1 SUB P,R70+6 POPJ P, SRBTB: ;FIRST, CONVERT INDICES INTO "LAST BYTE" ADDRESSES ;Note that we must have T+1=TT, and D+1=R IRP RG,,[T,D]AD,,[WD1,WD2] LSTBYTIFY RG MOVEM RG,AD MOVEM 1+RG,1+AD TERMIN CAIN TT,4 ;JUMP IF SINK STOP CHAR IS RIGHT-ADJUSTED JRST SR6B ; IN WORD ALREADY. ;Word-align the sink string-index, in left-most byte of word SR6L: MOVE A,N MOVE 5,D HLL 5,PPSSTB+1(R) MOVE 4,T HLL 4,PPSSTB+1(TT) ; The "CACHE" now has: T - WD1, TT - BY1, D - WD2, R - BY2, A - N SR6A: LDB C,5 DPB C,4 SOJE A,SRDONE SOJ R, ADD 4,[0700_30] ;DECREMENT BP ADD 5,[0700_30] ;DECREMENT BP JUMPGE 4,[JUMPGE 5,SR6A SUB 5,[430000,,1] JRST SR6A ] SOS T,WD1 MOVEI TT,4 MOVEM TT,BY1 JUMPGE R,.+3 SOS D,WD2 ADDI R,5 MOVEM R,BY2 IDIVI A,5 ;RE-ADJUST THE CNT/5 AND CNT\5 REGISTERS SR6B: JUMPE A,SR6C ADDI B,5 ;DO AT LEAST 5 CHARS BY SLOW METHOD SOJE A,SR6C ; (YES YOU LOSER, THEY CAN OVERLAP!) HRRO F,D ;MAKE A "PDL" TO POINT TO LAST WD TO MOVE FROM SUB T,A SUB D,A MOVEM T,WD1 ;ACCOUNT FOR MOVEMENT OF "FULL" WORDS MOVEM D,WD2 CAIE R,4 JRST SR7 MOVEI 3,(T) ;# WDS BETWEEN SOURCE AND SINK START SUBI 3,(D) HRLI 3,(POP F,(F)) MOVE 5,[JRST SR6C] MOVE 4,.+1 SOJGE A,3 ;A SIMPLE "POP" LOOP FOR BLT-BACKWARDS SR6C: JUMPE B,SRDONE MOVEM B,N JRST SR6L ;;; SHIFTING CHARS, EN PASSANT, BY AN AMOUNT NOT A MULTIPLE OF 5 SR7: MOVEM B,N MOVEI 3,(A) ;3 - # WDS TO MOVE MOVEI 4,(D) ;SOURCE START ADDR MOVEI 10,1(T) ;SINK START ADDR MOVE 6,R SUBI 6,4 IMULI 6,7 ;AMOUNT BY WHICH TO RIGHT-SHIFT MOVNI 11,43(6) HRLI 4,(MOVE A,(C)) HRLOI 5,(LSH A,) HRLI 6,(LSHC A,) MOVE 7,[ANDCMI B,1] HRLI 10,(MOVEM B,(C)) HRLI 11,(LSHC A,) MOVEM 13,CNTP ;FOO,FOO MOVE 13,[JRST SR7A] MOVE B,@4 MOVE 12,.+1 SOJGE C,4 SR7A: MOVEI 13,NIL EXCH 13,CNTP ;FOO,FOO SKIPN N JRST SRDONE MOVE T,WD1 ;RELOAD THE "CACHE" MOVE TT,BY1 MOVE D,WD2 MOVE R,BY2 JRST SR6L SR2C: MOVE A,CNT WTA ["CNT" OUT OF RANGE - STRING-REPLACE!] MOVEM A,CNT SETOM CNTP SR2CX: SUB FXP,R70+NSRFXV JRST SR1 SR2A: MOVE A,I1 %WTA SR2ERM MOVEM A,I1 JRST SR2CX SR2B: MOVE A,I2 %WTA SR2ERM MOVEM A,I2 JRST SR2CX FASEND