*DECK SAME
USETEXT TBASCTB 
USETEXT TCMMDEF 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TSBASIC 
USETEXT TXSTD 
      PROC SAME;
  
#----------------------------------------------------------------------#
#                                                                      #
#     THE FOLLOWING PROCS ARE XDEF-D WITHIN THIS DECK:                 #
#                                                                      #
#     GETSAME                      RETRIEVE ITEMS FROM -SAME- LIST     #
#     MOVSAME                      SAVE ITEMS IN -SAME- LIST           #
#     SAVPTR                       SAVE PTR TO 1ST CHAR OF -SAME- LIST #
#                                                                      #
#----------------------------------------------------------------------#
  
      BEGIN 
  
  
                                   #------X R E F S--------------------#
                                   #                                   #
      XREF ITEM EOTTERM I;         # NEG IF EOT CAN END CURRENT STATE  #
      XREF ITEM ESTDBEG I;         # BEGINNING OF ITEMS IN -ESTD-      #
      XREF ITEM ESTDEND I;         # END OF ITEMS IN -ESTD-            #
      XREF ITEM ESTDLEN I;         # NUM OF ITEMS IN -ESTD-            #
      XREF ITEM SAMINPUT     B;    # TRUE IF -SAME- LIST IN -QUIWSA-   #
      XREF ITEM SAMPTR  I;         # PTR TO FIRST WORD OF NEW -SAME-   #
      XREF ITEM STATE   I;         # SUBSCRIPT INTO STATE TABLE        #
      XREF ITEM SUB100  B;         # TRUE IF -OLDLEX- PTS INTO PREVIOUS#
                                   # SET OF 100 CHARS (IE, -CT100-     #
                                   # INCREMENTED IN MID-WORD)          #
      XREF ITEM SVCT100 I;         # ADD TO -LEXPTR- TO GET NUMBER OF  #
                                   # CHARS SCANNED SO FAR              #
      XREF ITEM SVEOTTERM    I;    # EOT STATUS OF ORIGINAL -QUIWSA-   #
      XREF ITEM SVOLDLEX     I;    # SAVE -LEXPTR- VALUE BEFORE SCAN   #
      XREF ITEM SVQUIRL I;         # LENGTH OF ORIGINAL -QUIWSA-       #
      XREF ITEM SVQUIWSA     I;    # PTR TO ORIGINAL -QUIWSA-          #
      XREF ITEM SVSTATE I;         # STATE ORIG -QUIWSA- WAS LEFT IN   #
      XREF ITEM SVSTATRANS   I;    # PTR TO ORIGINAL STATE TABLE       #
  
      XREF BASED ARRAY STATETRANS [0];;  # PTR TO CURRENT STATE TABLE  #
      XREF BASED ARRAY SVESTD;;    # TEMP HOLD FOR ORIGINAL -ESTD-     #
  
      XREF PROC DIAG;              # ISSUE DIAGNOSTIC MESSAGE TO USER  #
      XREF PROC LEXINIT;           # INITIALIZE SCAN TO START OF QUIWSA#
      XREF PROC MOVE;              # WHOLE WORD MOVE                   #
      XREF PROC MOVEC;             # CHARACTER STRING MOVE             #
      XREF PROC RECNO;             # RETURN TO -STDNO- IF RECORDING    #
      XREF PROC RECYES;            # RETURN TO -STDYES- IF RECORDING   #
  
  
                                   #------D E F S----------------------#
                                   #                                   #
      DEF LPAREN  #"("#;           # LEFT PARENTHESIS                  #
      DEF RPAREN  #")"#;           # RIGHT PARENTHESIS                 #
  
  
                                   #------I T E M S--------------------#
                                   #                                   #
      ITEM I       I;              # SCRATCH TEMPORARY                 #
      ITEM SAMINDX I;              # INDEX INTO ARRAY -SAME-: 1 = IF,  #
                                   # 2 = DISPLAY, 3 = USING            #
      ITEM TEMPLEN I;              # LENGTH OF NEW -SAME- LIST         #
      ITEM WORDS   I;              # SCRATCH TEMPORARY                 #
  
  
                                   #------A R R A Y S------------------#
                                   #                                   #
      BASED ARRAY SETPAREN;        # USED TO ENCLOSE -SAME- CONDITION  #
        BEGIN                      # WITHIN PARENTHESES                #
        ITEM SETP  C(0,0,10); 
        END 
  
      ARRAY MOVPARM [0:0] S(2);    # PARAMETER TO -MOVEC-              #
        BEGIN 
        ITEM FRCP  U(0,04,04);     # RELATIVE CHAR POSN OF SOURCE      #
        ITEM TOCP  U(0,08,04);     # RELATIVE CHAR POSN OF DESTINATION #
        ITEM CLEN  U(0,12,12);     # LENGTH OF CHAR STRING TO MOVE     #
        ITEM FRWD  U(0,24,18);     # WORD ADDRESS OF SOURCE            #
        ITEM TOWD  U(0,42,18);     # WORD ADDRESS OF DESTINATION       #
        ITEM MOVWD0 U(0,0,60);
        ITEM MOVWD1 U(1,0,60);
        END 
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     G E T S A M E                                                    #
#                                                                      #
#     *GETSAME* IS CALLED FROM THE SYNTAX OF *DISPLAY* AND *INSERT/    #
#     UPDATE/DELETE* WHEN THE KEYWORD *SAME* IS ENCOUNTERED.  IF THE   #
#     PROPER *SAME* LIST EXISTS, IT SAVES ALL LEXICAL INFORMATION ABOUT#
#     THE CURRENT INPUT BUFFER AND SWITCHES THE LEXICAL SCAN OVER TO   #
#     THE SAVED *SAME* BUFFER.                                         #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC GETSAME;
      PROC GETSAME; 
      BEGIN 
      RECYES;                      # RETURN TO -YES- IF RECORDING      #
  
      P<BASICTABLE> = BASCPTR;     # POSN TO CURRENT BLOCK OF BASIC TBL#
      I = BASCODE[BASTABIND];      # PICK UP DIRECTIVE-S CODE          #
  
                                   # SET INDEX INTO -SAME- ARRAY       #
                                   # ACCORDING TO DIRECTIVE            #
  
      IF I EQ DISPCODE             # IF DIRECTIVE IS -DISPLAY-         #
      THEN
        BEGIN 
        SAMINDX = 2;
        END 
  
      IF BASCUSING[BASTABIND]      # IF INS/UPD/DEL HAS -USING- CLAUSE #
      THEN
        BEGIN 
        SAMINDX = 3;
        END 
  
      IF SAMWD[SAMINDX] EQ 0       # IF NO INFO IN THIS -SAME- ENTRY   #
      THEN
        BEGIN 
        DIAG (189);                # NO -SAME- LIST TO REFER TO        #
        STDNO;                     # ERROR EXIT                        #
        END 
                                   # SAVE ALL LEXSCAN-S INFO ABOUT THE #
                                   # CURRENT -QUIWSA-                  #
                                   # START WITH -ESTD- VALUES          #
      ESTDLEN = LOC(ESTDEND) - LOC(ESTDBEG);
      P<SVESTD> = CMM$ALF (ESTDLEN, 0, 0);
      MOVE (ESTDBEG, ESTDLEN, SVESTD);
                                   # NOW SAVE -LEXSCAN- LOCAL AND      #
                                   # -QUIWSA- RELATED ITEMS            #
      SVCT100 = CT100;
      SVEOTTERM = EOTTERM;
      SVOLDLEX = OLDLEX;
      SVQUIRL = QUIRL;
      SVQUIWSA = P<QUIWSA>; 
      SVSTATE = STATE;
      SVSTATRANS = P<STATETRANS>; 
                                   # SWITCH POINTERS OVER TO -SAME-    #
                                   # BUFFER AND START LEXSCAN ON IT    #
      P<QUIWSA> = SAMADDR[SAMINDX]; 
      QUIRL = SAMLEN[SAMINDX];
      CT100 = -100; 
      LEXINIT;
  
      SAMUSED[SAMINDX] = TRUE;     # FLAG THAT -SAME- LIST USED IN DIR #
      SAMINPUT = TRUE;             # FLAG THAT -SAME- LIST IN -QUIWSA- #
  
      STDYES; 
      END                          # PROC *GETSAME*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     M O V S A M E                                                    #
#                                                                      #
#     *MOVSAME* IS CALLED FROM THE END OF THE SYNTAX FOR *DISPLAY*,    #
#     *IF*, AND *INS/UPD/DEL* TO SAVE THE NEW *SAME* LIST.  IF THE     #
#     DIRECTIVE USED THE OLD *SAME*, NOTHING IS DONE.  OTHERWISE, THE  #
#     OLD LIST IS RELEASED AND THE NEW ONE SAVED IN A BUFFER POINTED   #
#     TO BY THE APPROPRIATE ENTRY IN THE ARRAY *SAME*.  *IF* IS A      #
#     SPECIAL CASE IN THAT THE NEW *SAME* LIST MAY BE ADDED ON TO THE  #
#     END OF THE OLD.                                                  #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC MOVSAME;
      PROC MOVSAME; 
      BEGIN 
      RECNO;                       # RETURN TO -NO- IF RECORDING       #
  
      P<BASICTABLE> = BASCPTR;     # POSN TO CURRENT BLOCK OF BASIC TBL#
      I = BASCODE[BASTABIND];      # PICK UP DIRECTIVE-S CODE          #
  
                                   # SET INDEX INTO -SAME- ARRAY       #
                                   # ACCORDING TO DIRECTIVE            #
  
      IF I EQ IFCODE               # IF DIRECTIVE IS -IF-              #
      THEN
        BEGIN 
        SAMINDX = 1;
        END 
  
      IF I EQ DISPCODE             # IF DIRECTIVE IS -DISPLAY-         #
      THEN
        BEGIN 
        SAMINDX = 2;
        END 
  
      IF BASCUSING[BASTABIND]      # IF INS/UPD/DEL HAS -USING- CLAUSE #
      THEN
        BEGIN 
        SAMINDX = 3;
        END 
  
      IF SAMUSED[SAMINDX]          # IF THIS DIRECTIVE USED -SAME- LIST#
        AND NOT SAMINIF            # AND IT WASN-T ADDED ON TO BY -IF- #
      THEN
        BEGIN 
        SAMUSED[SAMINDX] = FALSE;  # RESET THE -SAME- FLAG             #
        STDNO;                     # NORMAL EXIT                       #
        END 
                                   # LENGTH OF NEW -SAME- LIST = TOTAL #
                                   # NUMBER OF CHARS SCANNED MINUS     #
                                   # CHARS SCANNED UP TO NEW -SAME-    #
      TEMPLEN = CT100 + OLDLEX - SAMPTR;
      IF SUB100                    # IF OLDLEX IS REL TO PREVIOUS CT100#
      THEN
        BEGIN 
        TEMPLEN = TEMPLEN - 100;   # REDUCE -TEMPLEN- ACCORDINGLY      #
        END 
  
      MOVWD0 = 0;                  # CLEAR PARAMETER TO -MOVEC-        #
      MOVWD1 = 0; 
                                   # IF NEW -SAME- LIST TO BE ADDED    #
      IF SAMINIF                   # TO END OF OLD (-IF- DIR ONLY)     #
      THEN
        BEGIN 
                                   # FIRST MOVE OLD -SAME- LIST TO     #
                                   # NEWLY ALLOCATED BUFFER THE SIZE   #
        FRWD[0] = SAMADDR[1];      # OF OLD PLUS NEW LISTS             #
        CLEN[0] = SAMLEN[1];
        TOWD[0] = CMM$ALF (TEMPLEN + SAMLEN[1] + 3, 0, 0);
  
        P<SETPAREN> = TOWD[0];     # START -SAME- LIST WITH LEFT PAREN #
        C<0,1> SETP = LPAREN; 
        TOCP[0] = 1;               # MOVE -SAME- TO CHAR AFTER PAREN   #
  
        MOVEC (MOVPARM);
        CMM$FRF (SAMADDR[1]);      # FREE CM SPACE OF OLD -SAME- LIST  #
        SAMADDR[1] = TOWD[0];      # SAVE ADDR OF NEW -SAME- LIST      #
                                   # NEXT MOVE NEW LIST TO BUFFER      #
                                   # STARTING AT CHAR AFTER OLD LIST.  #
                                   # INCLUDE DELIMITER BEFORE NEW SAME #
                                   # TO BE SURE OLD AND NEW -SAME- ARE #
        SAMPTR = SAMPTR - 1;       # SEPARATED.                        #
        TEMPLEN = TEMPLEN + 1;
        WORDS = SAMPTR / 10;
        FRWD[0] = P<QUIWSA> + WORDS;
        FRCP[0] = SAMPTR - WORDS * 10;
        CLEN[0] = TEMPLEN;
        SAMLEN[1] = SAMLEN[1] + 1; # INCLUDE LPAREN IN OLD LENGTH      #
        WORDS = SAMLEN[1] / 10; 
        TOWD[0] = TOWD[0] + WORDS;
        TOCP[0] = SAMLEN[1] - WORDS * 10; 
        MOVEC (MOVPARM);
                                   # SAVE LENGTH OF COMBINED LISTS     #
        SAMLEN[1] = SAMLEN[1] + TEMPLEN;
                                   # END -SAME- LIST WITH RIGHT PAREN  #
        WORDS = SAMLEN[1] / 10; 
        TOCP = SAMLEN[1] - WORDS * 10;
        P<SETPAREN> = SAMADDR[1] + WORDS; 
        C<TOCP,1> SETP = RPAREN;
        SAMLEN[1] = SAMLEN[1] + 1; # ADD RIGHT PAREN INTO LIST LENGTH  #
  
        SAMINIF = FALSE;           # RESET FLAGS                       #
        SAMUSED[1] = FALSE; 
        END 
  
      ELSE                         # IF REPLACING ENTIRE -SAME- LIST   #
        BEGIN 
        IF SAMADDR[SAMINDX] NQ 0   # IF OLD -SAME- LIST EXISTED        #
        THEN
          BEGIN 
          CMM$FRF (SAMADDR[SAMINDX]);  # FREE ITS CM SPACE             #
          END 
                                   # MOVE NEW LIST TO NEWLY ALLOCATED  #
                                   # BUFFER.                           #
        WORDS = SAMPTR / 10;
        FRWD[0] = P<QUIWSA> + WORDS;
        FRCP[0] = SAMPTR - WORDS * 10;
        CLEN[0] = TEMPLEN;
        TOWD[0] = CMM$ALF (TEMPLEN + 2, 0, 0);
  
        IF SAMINDX EQ 1            # IF -IF- DIRECTIVE                 #
        THEN
          BEGIN 
          P<SETPAREN> = TOWD[0];   # START -SAME- LIST WITH LEFT PAREN #
          C<0,1> SETP = LPAREN; 
          TOCP[0] = 1;             # MOVE -SAME- TO CHAR AFTER PAREN   #
          END 
  
        MOVEC (MOVPARM);
  
        SAMADDR[SAMINDX] = TOWD[0];  # SAVE ADDR OF NEW -SAME- LIST    #
        SAMLEN[SAMINDX] = TEMPLEN; # SAVE ITS LENGTH                   #
  
        IF SAMINDX EQ 1            # IF -IF- DIRECTIVE                 #
        THEN
          BEGIN 
          SAMLEN[1] = SAMLEN[1] + 1; # ADD LEFT PAREN TO LIST LENGTH   #
          WORDS = SAMLEN[1] / 10;    # END -SAME- LIST WITH RIGHT PAREN#
          TOCP = SAMLEN[1] - WORDS * 10;
          P<SETPAREN> = SAMADDR[1] + WORDS; 
          C<TOCP,1> SETP = RPAREN;
          SAMLEN[1] = SAMLEN[1] + 1; # ADD RIGHT PAREN TO LIST LENGTH  #
          END 
        END 
  
      STDNO;
      END                          # PROC *MOVSAME*                    #
      CONTROL EJECT;
#----------------------------------------------------------------------#
#                                                                      #
#     S A V P T R                                                      #
#                                                                      #
#     *SAVPTR* IS CALLED FROM THE SYNTAX OF *DISPLAY*, *IF*, AND       #
#     *DELUPSYN* TO STORE A POINTER TO THE BEGINNING OF THE DIRECTIVE-S#
#     ITEM LIST/EXPRESSION WHICH WILL BE SAVED AS THE *SAME* LIST.     #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC SAVPTR; 
      PROC SAVPTR;
      BEGIN 
      RECYES;                      # RETURN VIA -YES- IF RECORDING     #
  
      SAMPTR = CT100 + OLDLEX;     # SAVE POINTER TO FIRST OF ITEMS    #
  
                                   # IF WORD STARTED IN PREVIOUS SET   #
      IF SUB100                    # OF 100 CHARS                      #
      THEN
        BEGIN 
        SAMPTR = SAMPTR - 100;     # DECREASE -SAMPTR- ACCORDINGLY     #
        END 
  
      STDYES; 
      END                          # PROC *SAVPTR*                     #
  
      END 
      TERM
