home *** CD-ROM | disk | FTP | other *** search
/ Columbia Kermit / kermit.zip / cmsoriginal / cmswild.asm < prev    next >
Assembly Source File  |  2020-01-01  |  11KB  |  132 lines
  1. * WILD ASSEMBLE                                                         00001000
  2. *                                                                       00002000
  3. * CARL KASS AND JEFF DAMENS, CUCCA USER SERVICES, 12/80                 00003000
  4. * COPYRIGHT (C) 1980 COLUMBIA UNIVERSITY                                00004000
  5. * PERMISSION IS GRANTED TO ANY INDIVIDUAL OR INSTITUTION TO COPY        00005000
  6. * OR USE THIS PROGRAM, EXCEPT FOR EXPLICITLY COMMERCIAL PURPOSES.       00006000
  7. *                                                                       00007000
  8. WILD     CSECT                                                          00008000
  9.          USING     WILD,15            ADDRESSABILITY                    00009000
  10.          STM       14,12,12(13)        SAVE REGS                        00010000
  11.          LR        14,13               SAVE REG 14                      00011000
  12.          L         13,=V(WILDA)     DATA AREA                           00012000
  13.          USING     WILDA,13         POINT TO DATA AREA                  00013000
  14.          ST        14,4(13)            BACKCHAIN                        00014000
  15.          ST        13,8(14)            FORECHAIN                        00015000
  16.          DROP      15                                                   00016000
  17.          BALR      10,0                ESTABLISH FINAL...               00017000
  18.          USING     *,10                ...ADDRESSABILITY                00018000
  19. ************                                                            00019000
  20. * WILDCARD STRING MATCH.  CALL WITH R1 POINTING TO PAB OF FORM:         00020000
  21. *  A(PAT.STRING)                                                        00021000
  22. *  A(SOURCE.STRING)                                                     00022000
  23. *  A(C'*%')  WHERE * IS SNOBOL'S ARB, % IS LEN(1).                      00023000
  24. * RETURNS CC=0 IF STRINGS MATCH, CC=8 IF NOT                            00024000
  25. *                                                                       00025000
  26. * IF ONLY 2 PARMS ARE PASSED, THEN THE THIRD IS ASSUMED TO BE           00026000
  27. * "*" FOR THE ARB AND "%" FOR THE LEN(1)                                00027000
  28. *                                                                       00028000
  29. **********                                                              00029000
  30. * FIRST SOME INITIALIZATION                                             00030000
  31.          SR        5,5                                                  00031000
  32.          SR        7,7                                                  00032000
  33.          USING     PAB,1                                                00033000
  34.          L         2,APAT    GET PATTER ADDRESS                         00034000
  35.          USING     STRING,2                                             00035000
  36.          LH        5,STRLEN            GET LENGTH                       00036000
  37.          LA        4,STRTXT            POINT AT START OF PATTERN        00037000
  38.          DROP      2                   DON'T NEED PTR NOW               00038000
  39.          L         2,ASRC              POINT AT PARAMETER SOURCE        00039000
  40.          USING     STRING,2            NOW WE NEED IT                   00040000
  41.          LH        7,STRLEN            GET LENGTH OF SOURCE             00041000
  42.          LA        6,STRTXT            POINT AT SOURCE                  00042000
  43. * NOW CHECK TO SEE IF THERE IS A THIRD PARAMETER                        00043000
  44.          CLI       ASRC,X'80'          IS FIRST BIT ON?                 00044000
  45.          BE        NOTHIRD             IF SO THEN THIS IS LAST PARM     00045000
  46.          DROP      2                   THUD                             00046000
  47.          L         2,ASPEC             ADDRESS OF SPECIAL CHARS         00047000
  48.          MVC       ARB(2),0(2)         COPY BOTH                        00048000
  49.          B         COMSTART           GO AND USE THIRD PARM             00049000
  50. NOTHIRD  EQU       *                   NO THIRD PARMS, USE DEFAULTS     00050000
  51.          MVC       ARB(2),=CL2'*%'     MOVE IN DEFAULTS                 00051000
  52. COMSTART EQU       *                   COMMON THIRD PARM START ADDR     00052000
  53.          MVI       STARFLG,X'00'       HAVEN'T SEEN ANY OF THESE        00053000
  54.          ICM       7,B'1000',ARB       USE THIS AS THE FILL CHAR        00054000
  55. *                                                                       00055000
  56. COMPRE   EQU       *                                                    00056000
  57.          CLCL      4,6                 COMPARE THEM                     00057000
  58.          BE        SUCCESS             THEY'RE EQUAL, TELL SOMEONE      00058000
  59. *****                                                                   00059000
  60. * STRINGS DON'T MATCH, SO EXAMINE OFFENDING PATTERN CHARACTER           00060000
  61. * IF NOT A SPECIAL CHARACTER AND WE HAVEN'T SEEN ANY ARBS YET,          00061000
  62. * ALL WE CAN DO IS FAIL.  IF IT'S THE LEN1 CHARACTER, WE JUST           00062000
  63. * SKIP IT; IF IT'S THE ARB CHARACTER, WE SKIP IT AND REMEMBER           00063000
  64. * WE'VE SEEN IT.  OTHERWISE, BACK UP TO ONE PAST THE LAST ARB           00064000
  65. * CHARACTER AND TRY AGAIN.                                              00065000
  66. *******                                                                 00066000
  67.          CLC       0(1,4),LEN1         WAS IT THE LEN1 CHARACTER?       00067000
  68.          BE        GOTLEN1             TAKE CARE OF IT.                 00068000
  69.          CLC       0(1,4),ARB          WAS IT THE ARB CHAR              00069000
  70.          BE        GOTARB              HANDLE IT                        00070000
  71.          CLI       STARFLG,X'00'       HAVE WE SEEN A STAR?             00071000
  72.          BE        BOMB                NO, FAIL                         00072000
  73.          CLM       7,B'0111',=XL3'000000'   IS THIS ONE EXHAUSTED       00073000
  74.          BE        BOMB                SAME DEAL HERE                   00074000
  75.          LM        4,7,PATADDR         RESTORE ADDR OF OLD ARB CHAR     00075000
  76.          LA        6,1(6)              PUSH ONE PAST                    00076000
  77.          BCTR      7,0                 DECREMENT LENGTH                 00077000
  78.          STM       6,7,SRCADDR         STORE CHANGED ADDR               00078000
  79.          B         COMPRE              AND GO COMPARE AGAIN.            00079000
  80. GOTLEN1  EQU       *                                                    00080000
  81.          LA        4,1(4)              INCREMENT PATTERN ADDR           00081000
  82.          BCTR      5,0                 DECREMENT PATTERN LEN            00082000
  83.          LA        6,1(6)              INCREMENT SOURCE ADDR            00083000
  84.          BCTR      7,0                 DECREMENT SOURCE LEN             00084000
  85.          LA        0,0(,7)             GET LENGTH W/O PAD CHAR          00085000
  86.          LTR       0,0                 ANY MORE SOURCE LEFT?            00086000
  87.          BNZ       COMPRE              AND KEEP TRYINGKING              00087000
  88.          LTR       5,5                 NO DATA LEFT HERE EITHER?        00088000
  89.          BZ        SUCCESS             SAME LENGTH - A MATCH            00089000
  90.          CLC       0(1,4),ARB          IS IT THE WILD CHAR?             00090000
  91.          BE        COMPRE              IT'S OK                          00091000
  92.          B         BOMB                ELSE, WE FAIL                    00092000
  93. GOTARB   EQU       *                                                    00093000
  94. * IF PATTERN ENDS IN ARB, THEN IT WILL MATCH ANYTHING, SO               00094000
  95. * GOTARB SHOULD NOT RETURN TO COMPRE IF THE PATTERN IS EXHAUSTED.       00095000
  96.          MVI       STARFLG,X'FF'       REMEMBER WE SAW ONE              00096000
  97.          LA        4,1(4)              PASS THE STAR                    00097000
  98.          BCTR      5,0                 DECREMENT ITS LENGTH             00098000
  99.          LTR       5,5                                                  00099000
  100.          BZ        SUCCESS             WE HAVE A MATCH                  00100000
  101.          STM       4,7,PATADDR         SAVE WHERE THEY WERE             00101000
  102.          B         COMPRE                                               00102000
  103. SUCCESS  EQU       *                                                    00103000
  104.          L         13,4(13)            RESTORE OLD SAVE AREA            00104000
  105.          LM        14,12,12(13)        BLAH                             00105000
  106.          SR        15,15               IT WORKED                        00106000
  107.          BR        14                  HOME, JAMES                      00107000
  108. BOMB     EQU       *                   IS IT EQUAL TO A START?          00108000
  109.          L         13,4(13)            PUT THE CONTENTS OF 13 IN 4      00109000
  110.          LM        14,12,12(13)        PUT LOTS OF NUMBERS BACK         00110000
  111.          LA        15,8(0)             TAKE SOME NUMBERS                00111000
  112.          BR        14                  CALL IEFBR14                     00112000
  113. * DATA AREA                                                             00113000
  114. WILDA    CSECT                                                          00114000
  115. SAVEAREA DS        18F                                                  00115000
  116. * NEXT TWO THINGS MUST BE ADJACENT                                      00116000
  117. ARB      DS        CL1'*'              THIS MATCHES ANY STRING.         00117000
  118. LEN1     DS        CL1'%'              THIS MATCHES ANY CHARACTER.      00118000
  119. STARFLG  DS        X'00'               IF ON, WE'VE SEEN A STAR         00119000
  120. PATADDR  DS        A                   PLACE IN PATTERN OF LAST STAR    00120000
  121. PATOLDLN DS        F                   LENGTH OF PATTERN PAST STAR      00121000
  122. SRCADDR  DS        A         PLACE IN SOURCE WHEN STAR SEEN             00122000
  123. SRCOLDLN DS        F         LENGTH OF SOURCE PAST SRCADDR              00123000
  124. PAB      DSECT                                                          00124000
  125. APAT     DS        A         ADDRESS OF THE PATTERN STRING              00125000
  126. ASRC     DS        A         ADDRESS OF THE SOURCE STRING               00126000
  127. ASPEC    DS        A         ADDRESS OF SPECIAL CHARS STRING            00127000
  128. STRING   DSECT                                                          00128000
  129. STRLEN   DS        H         LENGTH OF THE STRING                       00129000
  130. STRTXT   DS        C         THE ACTUAL STRING                          00130000
  131.          END       ,         THIS IS A COMMENT                          00131000
  132.