perm filename SAICAT.FAI[S,AIL] blob
sn#191939 filedate 1975-12-15 generic text, type T, neo UTF8
SEARCH HDRFIL
COMPIL(CAT,<CAT,CATCHR,CHRCAT,CHRCHR,CAT.RV>
,<SAVE,RESTR,X22,X33,STRNGC,INSET,GOGTAB,CONFIG,PUTCH>
,<CAT -- CONCATENATION ROUTINE>)
DEFINE CANON (ADR,AC)<
LDB TEMP,[POINT 3,ADR,5] ;4,5,6,7,0,1 FROM POSITION
IMULI AC,5 ;ADDR IN CHARS
ADD AC,BPTBL(TEMP) ;0,1,2,3,4,5 EXTRA CHARS
>
BPTBL: 4
5
0
0
0
1
2
3 ;MAP
HERE (CAT.RV)
POP SP,TEMP ;ARGUMENTS ARE IN REVERSE ORDER,
POP SP,LPSA ; PUT THEM RIGHT
PUSH SP,-1(SP)
PUSH SP,-1(SP)
MOVEM LPSA,-3(SP)
MOVEM TEMP,-2(SP)
HERE (CAT)
MOVE USER,GOGTAB
POP P,UUO1(USER) ;SAVE FOR STRNGC ERR MESSAGE
MOVEI TEMP,-1 ;FOR TESTING LENGTHS
TDNN TEMP,-3(SP) ;FIRST STRING NULL?
JRST RETSEC ;YES, RETURN SECOND STRING
TDNN TEMP,-1(SP) ;SECOND STRING NULL?
JRST RETFRS ;YES, RETURN FIRST STRING
CATGO: MOVEI TEMP,RACS(USER)
BLT TEMP,RACS+3(USER)
MOVEM RF,RACS+RF(USER) ;SAVE F-REGISTER
CATGO1: HRRZ B,-2(SP) ;ADDR WORD OF FIRST STRING
MOVE LPSA,B
CANON (<-2(SP)>,LPSA) ;COMPUTE CANONICAL FORM
HRRZ A,-3(SP) ;#CHARS IN FIRST
ADD LPSA,A ;+#CHARS IN FIRST
HRRZ C,(SP) ;2D ADDRESS
CAMGE C,B ;IS IT POSSIBLE THEY ARE ALREADY CAT?
JRST CAT3 ;NO
CANON (<(SP)>,C) ;GET CANONICAL FORM OF 2D
CAMN C,LPSA ;SAME?
JRST ADJRET ;YES, RETURN ADJUSTED POINTER
CAT3: HRRZ C,TOPBYTE(USER) ;TRY SAME TRICK WITH THIS GUY
CANON (<TOPBYTE(USER)>,C)
CAMN C,LPSA ;FIRST AT THE TOP?
JRST ONLY1 ;YES
MOVTWO: ADD A,-1(SP) ;#CHARS(2)
HRRZ A,A ;ALLOW ROOM FOR POSSIBLE INSET
ADDM A,REMCHR(USER) ;#CHARS(NEW) - REMAINING #CHARS
SKIPLE REMCHR(USER) ;ENOUGH ROOM?
PUSHJ P,STRNGC ;NO, GO MAKE SOME
SKIPE SGLIGN(USER) ;IF ALIGNING,
PUSHJ P,INSET ; ALIGN
HRRZ B,-3(SP) ;GET 1ST # CHARS
HRROM A,-3(SP) ;COUNT RESULT
MOVE LPSA,TOPBYTE(USER);WILL BE NEW BYTE POINTER
MOVE A,LPSA ;WILL BE RESULT
EXCH A,-2(SP) ;TRADE WITH FIRST BYTE POINTER
ILDB C,A ;KNOWN NOT TO BE NULL STRING
IDPB C,LPSA ;MOVE THE STRING
SOJG B,.-2 ;RAPIDLY
HRRZ A,-1(SP) ;#CHARS(2)
JRST CATB
ONLY1: SKIPE SGLIGN(USER) ;CHECK ALIGNMENT?
JSP C,CHKLGN ;YES, DON'T RETURN IF MISALIGNED
HRRZ A,-1(SP) ;#CHARS(2)
ADDM A,REMCHR(USER) ; - REMAINING CHARS
SKIPLE REMCHR(USER) ;ROOM?
JRST [PUSHJ P,STRNGC ;no, collect, then start from scratch
MOVNS A ;since new string space may void
ADDM A,REMCHR(USER) ;the ONLY1 condition.
JRST CATGO1] ;CATGO1 is new for this fix.
ADDM A,-3(SP) ;NEW #CHARS
MOVE LPSA,TOPBYTE(USER);EXTEND FROM HERE
CATB: MOVE B,(SP) ;2D BYTE POINTER
ILDB C,B ;MOVE THIS STRING
IDPB C,LPSA ;AND MOVE IT
SOJG A,.-2 ; FAST
MOVEM LPSA,TOPBYTE(USER);PUT THIS AWAY, BY ALL MEANS
REST.4: MOVSI TEMP,RACS(USER)
BLT TEMP,C
RETFRS: SUB SP,X22 ;REMOVE NON-RESULT
JRST @UUO1(USER) ;RETURN
RETSEC: POP SP,-2(SP)
POP SP,-2(SP)
JRST @UUO1(USER) ;DIDN'T SAVE THEM
ADJRET: SKIPE SGLIGN(USER) ;IF NEED ALIGNMENT, MUST CHECK IT
JSP C,CHKLGN ;DON'T RETURN IF NOT ALIGNED
OKLG: HRRZ TEMP,-1(SP) ;COUNT OF 2D
ADDM TEMP,-3(SP) ;INCREASE COUNT OF FIRST
JRST REST.4
CHKLGN: MOVE TEMP,-2(SP) ;Check the position field of first arg --
TLNN TEMP,300000 ;44, 01 are aligned, 35,27,17,10 not. Bits
JRST (C) ; 1 and 2 are both off only for 44 and 01.
JRST MOVTWO ;Not aligned, move both
HERE (CHRCAT)
HRRZ TEMP,-1(SP) ;CHECK OTHER STRING NULL
JUMPE TEMP,ITSNUL
PUSH SP,-1(SP) ;MAKE ROOM FOR ONE UNDERNEATH
PUSH SP,-1(SP)
MOVEI TEMP,-4(SP) ;NOW PUT SINGLE-CHAR STRING
PUSH TEMP,[ONECH: 1
POINT 7,RACS+5(USER),27] ;CONSTANT IN
PUSH TEMP,ONECH+1
JRST CATCGO ;GO DO SPECIAL CAT
HERE (CATCHR)
HRRZ TEMP,-1(SP)
JUMPE TEMP,ITSNUL
PUSH SP,ONECH ;PUT ONE-CHAR DESCRIPTOR ON
PUSH SP,ONECH+1 ;TOP
CATCGO: MOVE USER,GOGTAB
POP P,UUO1(USER) ;RETURN ADDRESS
POP P,TEMP ;PUT IT SOMEWHERE SAFE
ADD TEMP,TEMP
MOVEM TEMP,RACS+5(USER)
JRST CATGO ;EVERYBODY'S NON-NULL
ITSNUL: SUB SP,X22
JRST PUTCH ;ZAP
HERE (CHRCHR)
MOVE USER,GOGTAB
MOVEM RF,RACS+RF(USER)
PUSH P,A
MOVEI A,2 ;NEED 2 CHARS
ADDM A,REMCHR(USER)
SKIPLE A,REMCHR(USER)
PUSHJ P,STRNGC ;THE USUAL
MOVE A,-3(P) ;CHAR 1
EXCH A,(P) ;GET BACK SAVED
PUSHJ P,PUTCH ;A STRING
AOS -1(SP) ;2 CHARACTER STRING
MOVE TEMP,-1(P) ;CHAR 2
IDPB TEMP,TOPBYTE(USER);A 2-CHAR STRING
SUB P,X33
JRST @3(P) ;QUICK AS A BUNNY
ENDCOM (CAT)
END