* WILD ASSEMBLE
*
* CARL KASS AND JEFF DAMENS, CUCCA USER SERVICES, 12/80
* COPYRIGHT (C) 1980 COLUMBIA UNIVERSITY
* PERMISSION IS GRANTED TO ANY INDIVIDUAL OR INSTITUTION TO COPY
* OR USE THIS PROGRAM, EXCEPT FOR EXPLICITLY COMMERCIAL PURPOSES.
*
WILD     CSECT
         USING     WILD,15            ADDRESSABILITY
         STM       14,12,12(13)        SAVE REGS
         LR        14,13               SAVE REG 14
         L         13,=V(WILDA)     DATA AREA
         USING     WILDA,13         POINT TO DATA AREA
         ST        14,4(13)            BACKCHAIN
         ST        13,8(14)            FORECHAIN
         DROP      15
         BALR      10,0                ESTABLISH FINAL...
         USING     *,10                ...ADDRESSABILITY
************
* WILDCARD STRING MATCH.  CALL WITH R1 POINTING TO PAB OF FORM:
*  A(PAT.STRING)
*  A(SOURCE.STRING)
*  A(C'*%')  WHERE * IS SNOBOL'S ARB, % IS LEN(1).
* RETURNS CC=0 IF STRINGS MATCH, CC=8 IF NOT
*
* IF ONLY 2 PARMS ARE PASSED, THEN THE THIRD IS ASSUMED TO BE
* "*" FOR THE ARB AND "%" FOR THE LEN(1)
*
**********
* FIRST SOME INITIALIZATION
         SR        5,5
         SR        7,7
         USING     PAB,1
         L         2,APAT    GET PATTER ADDRESS
         USING     STRING,2
         LH        5,STRLEN            GET LENGTH
         LA        4,STRTXT            POINT AT START OF PATTERN
         DROP      2                   DON'T NEED PTR NOW
         L         2,ASRC              POINT AT PARAMETER SOURCE
         USING     STRING,2            NOW WE NEED IT
         LH        7,STRLEN            GET LENGTH OF SOURCE
         LA        6,STRTXT            POINT AT SOURCE
* NOW CHECK TO SEE IF THERE IS A THIRD PARAMETER
         CLI       ASRC,X'80'          IS FIRST BIT ON?
         BE        NOTHIRD             IF SO THEN THIS IS LAST PARM
         DROP      2                   THUD
         L         2,ASPEC             ADDRESS OF SPECIAL CHARS
         MVC       ARB(2),0(2)         COPY BOTH
         B         COMSTART           GO AND USE THIRD PARM
NOTHIRD  EQU       *                   NO THIRD PARMS, USE DEFAULTS
         MVC       ARB(2),=CL2'*%'     MOVE IN DEFAULTS
COMSTART EQU       *                   COMMON THIRD PARM START ADDR
         MVI       STARFLG,X'00'       HAVEN'T SEEN ANY OF THESE
         ICM       7,B'1000',ARB       USE THIS AS THE FILL CHAR
*
COMPRE   EQU       *
         CLCL      4,6                 COMPARE THEM
         BE        SUCCESS             THEY'RE EQUAL, TELL SOMEONE
*****
* STRINGS DON'T MATCH, SO EXAMINE OFFENDING PATTERN CHARACTER
* IF NOT A SPECIAL CHARACTER AND WE HAVEN'T SEEN ANY ARBS YET,
* ALL WE CAN DO IS FAIL.  IF IT'S THE LEN1 CHARACTER, WE JUST
* SKIP IT; IF IT'S THE ARB CHARACTER, WE SKIP IT AND REMEMBER
* WE'VE SEEN IT.  OTHERWISE, BACK UP TO ONE PAST THE LAST ARB
* CHARACTER AND TRY AGAIN.
*******
         CLC       0(1,4),LEN1         WAS IT THE LEN1 CHARACTER?
         BE        GOTLEN1             TAKE CARE OF IT.
         CLC       0(1,4),ARB          WAS IT THE ARB CHAR
         BE        GOTARB              HANDLE IT
         CLI       STARFLG,X'00'       HAVE WE SEEN A STAR?
         BE        BOMB                NO, FAIL
         CLM       7,B'0111',=XL3'000000'   IS THIS ONE EXHAUSTED
         BE        BOMB                SAME DEAL HERE
         LM        4,7,PATADDR         RESTORE ADDR OF OLD ARB CHAR
         LA        6,1(6)              PUSH ONE PAST
         BCTR      7,0                 DECREMENT LENGTH
         STM       6,7,SRCADDR         STORE CHANGED ADDR
         B         COMPRE              AND GO COMPARE AGAIN.
GOTLEN1  EQU       *
         LA        4,1(4)              INCREMENT PATTERN ADDR
         BCTR      5,0                 DECREMENT PATTERN LEN
         LA        6,1(6)              INCREMENT SOURCE ADDR
         BCTR      7,0                 DECREMENT SOURCE LEN
         LA        0,0(,7)             GET LENGTH W/O PAD CHAR
         LTR       0,0                 ANY MORE SOURCE LEFT?
         BNZ       COMPRE              AND KEEP TRYINGKING
         LTR       5,5                 NO DATA LEFT HERE EITHER?
         BZ        SUCCESS             SAME LENGTH - A MATCH
         CLC       0(1,4),ARB          IS IT THE WILD CHAR?
         BE        COMPRE              IT'S OK
         B         BOMB                ELSE, WE FAIL
GOTARB   EQU       *
* IF PATTERN ENDS IN ARB, THEN IT WILL MATCH ANYTHING, SO
* GOTARB SHOULD NOT RETURN TO COMPRE IF THE PATTERN IS EXHAUSTED.
         MVI       STARFLG,X'FF'       REMEMBER WE SAW ONE
         LA        4,1(4)              PASS THE STAR
         BCTR      5,0                 DECREMENT ITS LENGTH
         LTR       5,5
         BZ        SUCCESS             WE HAVE A MATCH
         STM       4,7,PATADDR         SAVE WHERE THEY WERE
         B         COMPRE
SUCCESS  EQU       *
         L         13,4(13)            RESTORE OLD SAVE AREA
         LM        14,12,12(13)        BLAH
         SR        15,15               IT WORKED
         BR        14                  HOME, JAMES
BOMB     EQU       *                   IS IT EQUAL TO A START?
         L         13,4(13)            PUT THE CONTENTS OF 13 IN 4
         LM        14,12,12(13)        PUT LOTS OF NUMBERS BACK
         LA        15,8(0)             TAKE SOME NUMBERS
         BR        14                  CALL IEFBR14
* DATA AREA
WILDA    CSECT
SAVEAREA DS        18F
* NEXT TWO THINGS MUST BE ADJACENT
ARB      DS        CL1'*'              THIS MATCHES ANY STRING.
LEN1     DS        CL1'%'              THIS MATCHES ANY CHARACTER.
STARFLG  DS        X'00'               IF ON, WE'VE SEEN A STAR
PATADDR  DS        A                   PLACE IN PATTERN OF LAST STAR
PATOLDLN DS        F                   LENGTH OF PATTERN PAST STAR
SRCADDR  DS        A         PLACE IN SOURCE WHEN STAR SEEN
SRCOLDLN DS        F         LENGTH OF SOURCE PAST SRCADDR
PAB      DSECT
APAT     DS        A         ADDRESS OF THE PATTERN STRING
ASRC     DS        A         ADDRESS OF THE SOURCE STRING
ASPEC    DS        A         ADDRESS OF SPECIAL CHARS STRING
STRING   DSECT
STRLEN   DS        H         LENGTH OF THE STRING
STRTXT   DS        C         THE ACTUAL STRING
         END       ,         THIS IS A COMMENT
