* WILD ASSEMBLE 00001000 * 00002000 * CARL KASS AND JEFF DAMENS, CUCCA USER SERVICES, 12/80 00003000 * COPYRIGHT (C) 1980 COLUMBIA UNIVERSITY 00004000 * PERMISSION IS GRANTED TO ANY INDIVIDUAL OR INSTITUTION TO COPY 00005000 * OR USE THIS PROGRAM, EXCEPT FOR EXPLICITLY COMMERCIAL PURPOSES. 00006000 * 00007000 WILD CSECT 00008000 USING WILD,15 ADDRESSABILITY 00009000 STM 14,12,12(13) SAVE REGS 00010000 LR 14,13 SAVE REG 14 00011000 L 13,=V(WILDA) DATA AREA 00012000 USING WILDA,13 POINT TO DATA AREA 00013000 ST 14,4(13) BACKCHAIN 00014000 ST 13,8(14) FORECHAIN 00015000 DROP 15 00016000 BALR 10,0 ESTABLISH FINAL... 00017000 USING *,10 ...ADDRESSABILITY 00018000 ************ 00019000 * WILDCARD STRING MATCH. CALL WITH R1 POINTING TO PAB OF FORM: 00020000 * A(PAT.STRING) 00021000 * A(SOURCE.STRING) 00022000 * A(C'*%') WHERE * IS SNOBOL'S ARB, % IS LEN(1). 00023000 * RETURNS CC=0 IF STRINGS MATCH, CC=8 IF NOT 00024000 * 00025000 * IF ONLY 2 PARMS ARE PASSED, THEN THE THIRD IS ASSUMED TO BE 00026000 * "*" FOR THE ARB AND "%" FOR THE LEN(1) 00027000 * 00028000 ********** 00029000 * FIRST SOME INITIALIZATION 00030000 SR 5,5 00031000 SR 7,7 00032000 USING PAB,1 00033000 L 2,APAT GET PATTER ADDRESS 00034000 USING STRING,2 00035000 LH 5,STRLEN GET LENGTH 00036000 LA 4,STRTXT POINT AT START OF PATTERN 00037000 DROP 2 DON'T NEED PTR NOW 00038000 L 2,ASRC POINT AT PARAMETER SOURCE 00039000 USING STRING,2 NOW WE NEED IT 00040000 LH 7,STRLEN GET LENGTH OF SOURCE 00041000 LA 6,STRTXT POINT AT SOURCE 00042000 * NOW CHECK TO SEE IF THERE IS A THIRD PARAMETER 00043000 CLI ASRC,X'80' IS FIRST BIT ON? 00044000 BE NOTHIRD IF SO THEN THIS IS LAST PARM 00045000 DROP 2 THUD 00046000 L 2,ASPEC ADDRESS OF SPECIAL CHARS 00047000 MVC ARB(2),0(2) COPY BOTH 00048000 B COMSTART GO AND USE THIRD PARM 00049000 NOTHIRD EQU * NO THIRD PARMS, USE DEFAULTS 00050000 MVC ARB(2),=CL2'*%' MOVE IN DEFAULTS 00051000 COMSTART EQU * COMMON THIRD PARM START ADDR 00052000 MVI STARFLG,X'00' HAVEN'T SEEN ANY OF THESE 00053000 ICM 7,B'1000',ARB USE THIS AS THE FILL CHAR 00054000 * 00055000 COMPRE EQU * 00056000 CLCL 4,6 COMPARE THEM 00057000 BE SUCCESS THEY'RE EQUAL, TELL SOMEONE 00058000 ***** 00059000 * STRINGS DON'T MATCH, SO EXAMINE OFFENDING PATTERN CHARACTER 00060000 * IF NOT A SPECIAL CHARACTER AND WE HAVEN'T SEEN ANY ARBS YET, 00061000 * ALL WE CAN DO IS FAIL. IF IT'S THE LEN1 CHARACTER, WE JUST 00062000 * SKIP IT; IF IT'S THE ARB CHARACTER, WE SKIP IT AND REMEMBER 00063000 * WE'VE SEEN IT. OTHERWISE, BACK UP TO ONE PAST THE LAST ARB 00064000 * CHARACTER AND TRY AGAIN. 00065000 ******* 00066000 CLC 0(1,4),LEN1 WAS IT THE LEN1 CHARACTER? 00067000 BE GOTLEN1 TAKE CARE OF IT. 00068000 CLC 0(1,4),ARB WAS IT THE ARB CHAR 00069000 BE GOTARB HANDLE IT 00070000 CLI STARFLG,X'00' HAVE WE SEEN A STAR? 00071000 BE BOMB NO, FAIL 00072000 CLM 7,B'0111',=XL3'000000' IS THIS ONE EXHAUSTED 00073000 BE BOMB SAME DEAL HERE 00074000 LM 4,7,PATADDR RESTORE ADDR OF OLD ARB CHAR 00075000 LA 6,1(6) PUSH ONE PAST 00076000 BCTR 7,0 DECREMENT LENGTH 00077000 STM 6,7,SRCADDR STORE CHANGED ADDR 00078000 B COMPRE AND GO COMPARE AGAIN. 00079000 GOTLEN1 EQU * 00080000 LA 4,1(4) INCREMENT PATTERN ADDR 00081000 BCTR 5,0 DECREMENT PATTERN LEN 00082000 LA 6,1(6) INCREMENT SOURCE ADDR 00083000 BCTR 7,0 DECREMENT SOURCE LEN 00084000 LA 0,0(,7) GET LENGTH W/O PAD CHAR 00085000 LTR 0,0 ANY MORE SOURCE LEFT? 00086000 BNZ COMPRE AND KEEP TRYINGKING 00087000 LTR 5,5 NO DATA LEFT HERE EITHER? 00088000 BZ SUCCESS SAME LENGTH - A MATCH 00089000 CLC 0(1,4),ARB IS IT THE WILD CHAR? 00090000 BE COMPRE IT'S OK 00091000 B BOMB ELSE, WE FAIL 00092000 GOTARB EQU * 00093000 * IF PATTERN ENDS IN ARB, THEN IT WILL MATCH ANYTHING, SO 00094000 * GOTARB SHOULD NOT RETURN TO COMPRE IF THE PATTERN IS EXHAUSTED. 00095000 MVI STARFLG,X'FF' REMEMBER WE SAW ONE 00096000 LA 4,1(4) PASS THE STAR 00097000 BCTR 5,0 DECREMENT ITS LENGTH 00098000 LTR 5,5 00099000 BZ SUCCESS WE HAVE A MATCH 00100000 STM 4,7,PATADDR SAVE WHERE THEY WERE 00101000 B COMPRE 00102000 SUCCESS EQU * 00103000 L 13,4(13) RESTORE OLD SAVE AREA 00104000 LM 14,12,12(13) BLAH 00105000 SR 15,15 IT WORKED 00106000 BR 14 HOME, JAMES 00107000 BOMB EQU * IS IT EQUAL TO A START? 00108000 L 13,4(13) PUT THE CONTENTS OF 13 IN 4 00109000 LM 14,12,12(13) PUT LOTS OF NUMBERS BACK 00110000 LA 15,8(0) TAKE SOME NUMBERS 00111000 BR 14 CALL IEFBR14 00112000 * DATA AREA 00113000 WILDA CSECT 00114000 SAVEAREA DS 18F 00115000 * NEXT TWO THINGS MUST BE ADJACENT 00116000 ARB DS CL1'*' THIS MATCHES ANY STRING. 00117000 LEN1 DS CL1'%' THIS MATCHES ANY CHARACTER. 00118000 STARFLG DS X'00' IF ON, WE'VE SEEN A STAR 00119000 PATADDR DS A PLACE IN PATTERN OF LAST STAR 00120000 PATOLDLN DS F LENGTH OF PATTERN PAST STAR 00121000 SRCADDR DS A PLACE IN SOURCE WHEN STAR SEEN 00122000 SRCOLDLN DS F LENGTH OF SOURCE PAST SRCADDR 00123000 PAB DSECT 00124000 APAT DS A ADDRESS OF THE PATTERN STRING 00125000 ASRC DS A ADDRESS OF THE SOURCE STRING 00126000 ASPEC DS A ADDRESS OF SPECIAL CHARS STRING 00127000 STRING DSECT 00128000 STRLEN DS H LENGTH OF THE STRING 00129000 STRTXT DS C THE ACTUAL STRING 00130000 END , THIS IS A COMMENT 00131000