*DECK STX00 
USETEXT TBASCTB 
USETEXT TCMMDEF 
USETEXT TENVIRN 
USETEXT TEXPRES 
USETEXT TSBASIC 
USETEXT TXSTD 
 PROC STX00;
 BEGIN   # THIS PROC CONTAINS SEMANTIC ROUTINES FOR THE 0,0, OVERLAY #
  
          XREF ITEM RO B;    # THIS ITEM IS SET TO TRUE IF THE CONTROL #
                             #  CARD PARAMETER -RO- IS GIVEN,          #
                             #  TO FALSE OTHERWISE.                    #
      XREF PROC LOADOVL;           # LOAD AN OVERLAY                   #
      XREF LABEL INITRTN;          # RETURN FROM EOT PROCESSING        #
      XREF PROC  DIAG;
      XREF ITEM FRMLFN C(7);       # LFN OF -FROM- OR -KEY IN- FILE    #
      XREF ITEM FROMKEYINFIT I;    # ADDRESS OF *FROM* OR *KEY IN* FIT #
      XREF ITEM SM$GROUPID;        # GROUP ID OF CMM BLOCKS ALLOCATED  #
      ITEM IM, JM, KM, LM;
      XREF ITEM RECNAM I;          # RECORD DIRECTORY WORD ADDRESS     #
      XREF ITEM UPDTEMP B;
      XREF ITEM UPDATING B; 
      ITEM TEMPCTR I;              # COUNTER FOR TEMP STACK ADDRESSES. #
      ITEM LOOPER B;               # LOOP CONTROL.                     #
      ITEM DUMMY1;                 # LOOP INDUCTION.                   #
      ITEM LOOPCON B;              # LOOP CONTROL.                     #
      ITEM RC;                     # RETURN CODE.                      #
      BASED ARRAY DTABLE;          # DISPLAY TABLE                     #
        BEGIN 
        ITEM CPFROMADDR I(0, 24, 18);  # ADDRESS OF LIT IF DIS KEY LIT #
        END 
      XREF ITEM CURRELATION;       # WORD OF ACCUMULATED BIT PATHS.    #
      XREF ITEM RESTRICTPROC B;    # TRUE--RESTRICTS ARE BEING DONE.   #
  
  
      XDEF PROC CHKTEMP;
  PROC CHKTEMP;  # --------------------------- #
      BEGIN 
      IF TYPEALOW EQ 2             # IF DATA-NAME MUST BE DEFINED      #
        OR TYPEALOW EQ 5           # OR MUST BE DEFINED OR SPECIFIED   #
      THEN
        BEGIN 
        STDNO;                     # DIAG 365, -OF- IS ILLEGAL         #
        END 
      ELSE
        BEGIN 
        STDYES;                    # -OF- IS LEGAL                     #
        END 
      END 
  
  
  
  
  
XDEF PROC CHK40;             #-----------------------------------------#
                             # CALLED AT END OF TRANSMISSION TO SEE    #
                             # WHICH EXECUTION OVERLAY (IF ANY)        #
                             # SHOULD BE LOADED.                       #
PROC CHK40; 
BEGIN 
  
      IF NEXTXMISSN                # IF XMISSN IS CONTINUED            #
        OR NOT SEARCHFLAG          # IF XMISSN HAD NO 40,0 COMMAND     #
      THEN
        BEGIN 
        STDNO;
        END 
  
      IF RECORDFLAG                # IF RECORDING                      #
      THEN
        BEGIN 
        CLRBSCFLGS;                # CLEAR BASIC DIRECTIVE FLAGS       #
        STDNO;
        END 
  
               #----# 
      IF IFFAIL THEN           # CHECK IF PREVIOUS IF FAILED #
        BEGIN 
        IFFAIL = FALSE; 
        STDNO;                                                           STX00
        END 
      IF FILEPASS AND USINGFLAG THEN  # USING AND FILEPASS DIRS # 
        BEGIN                         # CAN-T BE IN SAME TRANSMISSION # 
        DIAG(807);                                                       STX00
        RLSBMEM;
        STDNO;
        #----#
        END 
      IF BASTABLOC EQ 0 THEN   # NO -BASIC- TABLE BUILT  #
        BEGIN 
        DIAG(806);                                                       STX00
        RLSBMEM;
        STDNO;
        #----#
        END 
      LOADOVL(BASE1X,1,O"77");     # EOT PROCESSING MUST BE DONE       #
      GOTO INITRTN;                # RETURN FROM EOT WITHOUT CALLING   #
                                   # CALLING ANOTHER PRIMARY.  CANNOT  #
                                   # EXIT THRU *STD$START*.            #
END 
  
  
  
    # --------------------------------- # 
 # THIS PROC GOES TO STDNO IF A BASIC FILE PASS DIRECTIVE HAS BEEN# 
 # RECEIVED, SO THAT THE ENTIRE XMISSN WILL BE IGNORED.  OTHERWISE# 
 # ALL FLAGS FOR FILE SEARCH ARE TURNED OFF AND SPACE RELEASED.   # 
      XDEF PROC ENDBASC;
      PROC ENDBASC; 
      BEGIN 
      IF PERDUMMY                  # IF DUMMY PERFORM                  #
      THEN
        BEGIN 
        IF NEXTXMISSN              # IF XMISSN IS TO BE CONTINUED      #
        THEN
          BEGIN 
          STDYES; 
          END 
        END 
  
      IF RECORDFLAG                # IF RECORDING                      #
      THEN
        BEGIN 
        STDYES; 
        END 
  
      IF SEARCHFLAG                # IF FILE PASS                      #
      THEN
        BEGIN 
        DIAG (193);                # ILLEGAL SEQ. OF DIRECTIVES        #
        STDNO;
        END 
  
      RLSBMEM;                                                          006600
      STDYES; 
      END 
  
    # --------------------------------- # 
      XDEF PROC RLSBASC;                                                006620
 PROC RLSBASC;   BEGIN                                                  006630
 # THIS PROC IS CALLED IN LOST TO RELEASE MEMORY FOR BASIC TABLES #     006640
     IF RECORDFLAG                 # IF RECORDING                      #
     THEN 
       BEGIN
       STDNO; 
       END
  
      RLSBMEM;                                                          006650
      STDNO;                                                            006660
 END                                                                    006670
  
    # --------------------------------- # 
      XDEF PROC RLSBMEM;
 PROC RLSBMEM;   BEGIN                                                  006680
 # THIS PROC RELEASES MEMORY FOR BASICTABLE AND ASSOCIATED TABLES #     006690
      IF NOT RESTRICTPROC          # IF RESTRICTS NOT BEING DONE       #
      THEN
        BEGIN 
        CLRBSCFLGS;                # CLEAR BASIC DIRECTIVE FLAGS       #
        END 
  
      IF BASTABLOC EQ 0  THEN RETURN;                                   006700
      P<BASICTABLE> = BASTABLOC;                                        006710
 RLS10:  BASTABIND = 0;                                                 006730
 RLS20:  IM = BASCODE [BASTABIND];                                      006740
      IF IM EQ ENDCODE  THEN GOTO RLS105;                               006750
      IF IM EQ CONTCODE  THEN BEGIN                                     006760
         JM = P<BASICTABLE>;                                            006770
         P<BASICTABLE> = BASCLAST [BASTABIND];                          006780
                 CMM$FRF(JM);      #RELEASE CM BLOCK# 
         GOTO RLS10;          END                                       006800
      KM = BASC$GROUPID[BASTABIND]; 
      LM = 0;                                                           006830
      IF KM NQ 0                   # IF GROUP ID ASSIGNED              #
      THEN
        BEGIN 
        IF IM EQ IFCODE            # IF DIRECTIVE WAS -IF-             #
        THEN
          BEGIN 
          LM = 1;                  # SET INDEX INTO -SAME- ARRAY       #
          SAMINIF = FALSE;         # RESET FLAG IN CASE CONDITION      #
                                   # CONTAINED -SAME-                  #
          END 
  
         IF IM EQ DISPCODE         # IF DISPLAY                        #
         THEN 
           BEGIN
           LM = 2;
           IF BASCKEY1[BASTABIND]  # IF DISPLAY KEY LITERAL            #
           THEN 
             BEGIN
             IF CPFROMADDR[0] NQ 0  # IF LIT STORAGE ASSIGNED          #
             THEN 
               BEGIN
               CMM$FRF(CPFROMADDR[0]);  # RELEASE LITERAL STORAGE      #
               END
             END
           END
  
        IF BASCUSING[BASTABIND]    # IF INS/UPD/DEL -USING-            #
        THEN
          BEGIN 
          LM = 3;                  # SET INDEX INTO -SAME- ARRAY       #
          END 
  
        IF LM NQ 0                 # IF DIR COULD HAVE -SAME- LIST     #
        THEN
          BEGIN 
          SAMUSED[LM] = FALSE;     # TURN OFF FLAG IN CASE -SAME- USED #
          END 
  
         CMM$FGR(KM);              # FREE ANY CMM BLOCKS IN THIS GROUP #
      END                                                               006950
 RLS50:  BASTABIND = BASTABIND + 1;                                     006960
        GOTO RLS20;                                                     006970
 RLS105:  JM = P<BASICTABLE>;                                           006980
                 CMM$FRF(JM);      #RELEASE CM BLOCK# 
         BASTABLOC = 0;   BASCPTR = 0;                                  007000
         BASTABIND = 0; 
      RETURN; 
      END 
  
#----------------------------------------------------------------------#
#                                                                      #
#     PROC      CLRBSCFLGS                                             #
#                                                                      #
#     CLEAR BASIC DIRECTIVE FLAGS                                      #
#                                                                      #
#----------------------------------------------------------------------#
  
      XDEF PROC CLRBSCFLGS; 
      PROC CLRBSCFLGS;
      BEGIN 
      UPDTEMP = FALSE;             #CLEAR *UPDATE USING TEMPORARY* FLAG#
      SEARCHFLAG = FALSE; 
      USINGFLAG = FALSE;
      IFFLAG = FALSE; 
      NEXTXMISSN = FALSE; 
      WRTRECD = FALSE;
      CURRELATION = O"37777777777777777777";
      FROMKEYINFIT = 0;            # NO *FROM* OR *KEY IN* FILE        #
      FRMLFN = " "; 
      FILEPASS = FALSE; 
      UPDATING = FALSE; 
      REFERFILE = 0;
      KEYLIT = 0; 
      SM$GROUPID = 0;              # INDICATE NO CMM GROUP ID ALLOCATED#
      RECNAM = 0; 
      RETURN;                                                           007010
      END 
  
  
  
  
      XDEF PROC UPDMODE;     #-----------------------------------------#
          #  THIS PROC IS CALLED WHEN PROCESSING A DIRECTIVE THAT      #
          #  TRANSLATES INTO MODIFICATIONS TO AN AREA.                 #
          #                         IT GOES TO STDNO IF THE FLAG -RO-  #
          #  IS SET, MEANING THAT THE MODIFICATION  DIRECTIVES ARE     #
          #  DISABLED IN READ-ONLY MODE.                               #
      PROC UPDMODE; 
          BEGIN 
                IF RO AND NOT RECORDFLAG THEN  #IN READ-ONLY MODE,     #
                                               #INSERT IS ALLOWED ONLY #
                                               # WHILE RECORDING.      #
                  BEGIN 
                  STDNO;           #DISALLOW REQUEST                   #
                  END 
                 STDYES;
          END 
  
  
 END
TERM
