*DECK BASPOS2 
PROC BASPOS2; 
BEGIN 
XDEF PROC BASPOS; 
XREF ITEM ASCII U; # ASCII FLAG # 
# 
* 
          PROCEDURE  BASPOS 
* 
          COMPUTE THE BASIC 3 POS(A$,B$,C) FUNCTION.
* 
          PARAMETERS: 
                 ADR1 = FWA OF STRING 1 (THE REFERENCE
                        STRING) (LJ). 
                 LEN1 = LENGTH OF STRING 1  (IN BYTES). 
                 ADR2 = FWA OF STRING 2 (THE PATTERN STRING) (LJ) 
                 LEN2 = LENGTH OF STRING 2  (IN BYTES). 
                 POS = POSITION PARAMETER/ NO-MATCH-FOUND FLAG. 
* 
          INTERFACE:  
                 CALLED BY SYMPL EXTERNAL CALL, OR EQUIVALENT.
* 
          ENTRY CONDITIONS: 
                 ADR1, LEN1, ADR2, LEN2 ARE SET.
                 (POS) = POSITION IN STRING 1 FROM WHICH SEARCH 
                         IS TO START. 
                 (ASCII) = ZERO, IF 64-CHARACTER SET IS USED, 
                         = NONZERO, IF 6/12 CHARACTER SET IS USED 
* 
          EXIT CONDITIONS:  
                 (POS) = POSITION OF MATCH IN STRING 1, IF A
                         MATCH TO STRING 2 IS FOUND THERE.
                       = 0, IF NO MATCH IS FOUND. 
* 
          EXTERNAL REFERENCES:  
                 ASCII - CELL INDICATING CHARACTER SET IN FORCE 
                         FOR THIS EXECUTION.
* 
          ALGORITHM:  
                 IF (POS) LE 0, THEN POS <- 1 .,
                 COMPUTE THE CHARACTER LENGTH OF EACH STRING ., 
                 IF (POS) GT (CHAR-LENG OF STR1), THEN POS <- 0 .,
                              RETURN ., 
                 IF (LEN2) EQ 0, THEN RETURN (WITH STARTING POS) ., 
                 ESTABLISH A POSITION IN STRING 1 AT ITS START ., 
                 ADVANCE POSITION IN STRING 1 THROUGH 
                   (POS)-1 CHARACTERS .,
                 FOR K1 = (POS) TO (LEN1)-(LEN2)+1, DO: 
                   IF <STRING 1>[CURRENT POSITION] =
                     <STRING 2>[1] (6 BITS WORTH),
                   THEN:  
                     TEST THE NEXT (LEN2) CHARACTERS OF STRING 1
                       AGAINST STRING 2 .,
                     IF THEY MATCH, 
                     THEN:  
                       POS <- CURRENT POSITION ., 
                       RETURN .,
                   INCREMENT CURRENT POSITION IN STRING 1 .,
                 POS <- 0 .,
                 RETURN  ., 
* 
# 
##
# 
          LOCAL/GLOBAL VARIABLES. 
# 
ITEM SPOS; # OLD POS VALUE #
ITEM W1, P1;  # WORD AND OFFSET IN STRING 1 # 
ITEM K1; # LOGICAL POSITION IN STRING 1 # 
ITEM W3, P3;  # WORD AND OFFSET IN STRING 1 # 
ITEM W4, P4;  # WORD AND OFFSET IN STRING 2 # 
ITEM K2; # LOGICAL POSITION IN STRING 2 # 
ITEM K5 I; # POSITION TO RETURN#
ITEM K0 I; # POSITION FOR TEST# 
ITEM P2; # OFFSET FOR STRING 2# 
ITEM CC7 C(1); #STRING 2 - CODE FOLLOWING ESCAPE CODE#
ITEM CC8 C(1); #STRING 1 - CODE FOLLOWING ESCAPE CODE#
ITEM CC3 C(1); #STRING 1 - INNER LOOP CHECK#
ITEM PREV1 C(1); #STRING 1 - PREVIOUS ESCAPE CODE#
ITEM STARTC I; #POSITION IN STRING TO BEGIN COMPARE#
ITEM CC1 C(1);  # CURRENT CHARACTER IN STRING 1 # 
ITEM CC2 C(1);  # CURRENT CHARACTER IN STRING 2 # 
ITEM CC6 C(1);  # INITIAL CHARACTER IN STRING 2 # 
ITEM LEN3 I;  # CHARACTER LENGTH OF STRING 1 #
ITEM LEN4 I;  # CHARACTER LENGTH OF STRING 2 #
##
PROC BASPOS(ADR1,LEN1,ADR2,LEN2,POS); 
##
# 
          PARAMETERS. 
# 
ITEM ADR1 I; # FWA OF STRING 1 #
ITEM LEN1 I; # LENGTH OF STRING 1 # 
ITEM ADR2 I; # FWA OF STRING 2 #
ITEM LEN2 I; # LENGTH OF STRING 2 # 
ITEM POS I; # STARTING/EXIT POSITION #
##
# 
          STRING ACCESS VARIABLES.
# 
BASED ARRAY STR1 [0:13108]; # STRING 1 #
ITEM CHAR1 C(0,0,10); 
##
BASED ARRAY STR2 [0:13108]; # STRING 2 #
ITEM CHAR2 C(0,0,10); 
##
# 
          MACRO/DEF DEFINITIONS.
# 
DEF ESCAPEE(IX) # ASCII NQ 0 AND (IX EQ "^" OR IX EQ "@") #;
DEF MOD(X) # (X) - (X)/10*10 #; # MODULO 10 # 
DEF INCR(WX,PX) # BEGIN 
                  PX = MOD(PX+1); 
                  IF PX EQ 0 THEN WX = WX+1;
                  END #;  # ADVANCE POSITION IN STRING #
##
# 
          PROCEDURE AND FUNCTION DEFINITIONS. 
# 
FUNC TESTMATCH B; # TEST MATCH OF STRING 1 TO STRING 2 AT THIS POINT #
BEGIN # TESTMATCH # 
P3 = P1; W3 = W1; #CURRENT POSITION OF STRING 1#
P4 = P2; W4 = 0; #CURRENT POSITION OF STRING 2# 
  
IF LEN2 EQ 1 THEN #IF ONLY ONE CHARACTER, ALREADY HAVE MATCH# 
    BEGIN 
      TESTMATCH = TRUE; RETURN; 
    END 
FOR K2 =1 STEP 1 UNTIL K0 DO #CHECK FURTHER CHARACTERS# 
    BEGIN 
      CC3 = C<P3,1>CHAR1[W3]; 
      CC2 = C<P4,1>CHAR2[W4]; 
      INCR(W3,P3);
      INCR(W4,P4);
      IF CC3 EQ CC2 THEN TEST K2;    ELSE 
        BEGIN 
          TESTMATCH = FALSE;
          RETURN; 
        END 
    END  # INNER LOOP # 
  TESTMATCH = TRUE; 
  RETURN; 
END  # TESTMATCH #
##
##
FUNC CHARLEN(ADR0, LEN0) I;  # FIND CHARACTER LENGTH OF STRING #
BEGIN  # CHARLEN #
  # 
          PARAMETERS. 
  # 
  ITEM ADR0 I;  # FWA OF STRING # 
  ITEM LEN0 I;  # BYTE LENGTH OF STRING # 
  # 
          LOCAL VARIABLES.
  # 
  BASED ARRAY STR0 [0:13108];  # STRING # 
  ITEM CHAR0 C(0,0,10); 
  ITEM W0, P0 I;  # WORD AND OFFSET IN STRING # 
  ITEM CC0 C(1);  # CURRENT CHARACTER IN STRING # 
  ITEM K0 I;  # POSITION IN STRING #
  ITEM CHLN I;  # CHARACTER LENGTH OF STRING #
  # 
          FUNCTION. 
  # 
  P<STR0> = ADR0;  # FIND STRING #
  CHLN = 0;  # INITIALIZE LENGTH #
  W0 = -1;
  P0 = -1;
  CONTROL SLOWLOOP; 
INCR(W0,P0);
FOR K0= 1 STEP 1 UNTIL LEN0 DO
BEGIN 
   CC0 = C<P0,1>CHAR0[W0];
   IF NOT (ESCAPEE(CC0))
         THEN CHLN = CHLN+1;
   INCR(W0,P0); 
END 
  CHARLEN = CHLN;  # CHARACTER LENGTH # 
  RETURN; 
END  # CHARLEN #
##
##
BEGIN 
# 
          START OF MAIN PROGRAM.
# 
##
P<STR1> = ADR1; # FIND STRING 1 # 
P<STR2> = ADR2; # FIND STRING 2 # 
IF POS LQ 0 THEN POS = 1;  # MAKE POSITION POSITIVE. #
SPOS = POS;  # SAVE INCOMING VETTED POSITION PARAMETER. # 
IF ASCII EQ 0 
  THEN
    BEGIN 
      LEN3 = LEN1;
      LEN4 = LEN2;
    END 
  ELSE
    BEGIN 
      LEN3 = CHARLEN (ADR1, LEN1);
      LEN4 = CHARLEN (ADR2, LEN2);
    END 
IF SPOS GR LEN3 THEN
    BEGIN 
      POS = 0; RETURN;
    END 
IF LEN2 EQ 0 THEN RETURN;   # POS IS STARTING POSITION IF LEN2 IS ZERO #
POS = 0;  # POS IS ZERO IF LEN4 IS ZERO. #
P1 = 0;  W1 = 0;   # INITIALIZE PTR TO STRING 1 # 
CC1 = C<P1,1>CHAR1[W1]; 
STARTC = SPOS; #STARTING POSITION#
K5 = SPOS;   #POSITION TO RETURN# 
CONTROL SLOWLOOP; 
FOR K1 = 1 STEP 1 UNTIL SPOS-1 DO 
  BEGIN 
      IF ESCAPEE(CC1) THEN
          BEGIN 
            STARTC = STARTC + 1; INCR(W1,P1); 
          END 
    INCR(W1,P1);
   IF STARTC GR LEN1 THEN 
     BEGIN
     IF LEN2 EQ 0 THEN RETURN;
     ELSE 
       BEGIN
         POS = K1 - 1; RETURN;
       END
     END
    CC1 = C<P1,1>CHAR1[W1]; 
  END 
##
#  STRING 1 POSITIONED CORRECTLY.  LOOK FOR STRING 2 #
##
CC6 = C<0,1>CHAR2[0]; 
CC7 = " ";
P2 = 0;  K0 = LEN2; 
PREV1 = " ";
IF ESCAPEE(CC6) THEN
    BEGIN 
        P2 = 1;  K0 = LEN2 - 1; 
        CC7 = C<P2,1>CHAR2[0];
    END 
CONTROL SLOWLOOP; 
FOR K1 = STARTC STEP 1 UNTIL LEN1-LEN2+1 DO 
    BEGIN 
      CC8 = " ";
      IF ESCAPEE(CC1) THEN
         BEGIN
             INCR(W1,P1); 
             CC8 = C<P1,1>CHAR1[W1];
         END
    IF CC1 EQ CC6 AND CC7 EQ CC8 AND PREV1 EQ " " THEN
      BEGIN 
        IF TESTMATCH THEN 
          BEGIN 
             POS = K5;
            RETURN; 
          END 
      END 
    IF ESCAPEE(CC1) THEN
        BEGIN 
          PREV1 = CC1;  CC1 = CC8;
        END 
    ELSE
    BEGIN 
    K5 = K5 +1;   PREV1 = " ";
    INCR(W1,P1);
    CC1 = C<P1,1>CHAR1[W1]; 
    END 
  END  # OUTER LOOP # 
RETURN; 
END 
END 
TERM
