*DECK IDP 
**IF DEF,TEST    (NEXT LINE)
*IF DEF,TEST
          IDENT  IDP
 IDP      SECT   (INTERACTIVE DEBUG PACKAGE)
 IDP      SPACE  4
*         IN FTN
          EXT    CO.SNAP,CP.NFLS,F.IN,F.OUT 
  
*         IN PUC
          EXT    ALTNAM,BASES,NAMES,N.TABLE,SIZES,WOF 
  
*         IN RPV10
          EXT    RPV=RNA
  
*         IN UTILITY
          EXT    FRA= 
 IDP      SPACE  4,10 
***       IDP - INTERACTIVE DEBUGGING PACKAGE.
* 
* 
*         THIS IS THE IDP PACKAGE THAT IS COMMON TO ALL FTN 5 OVERLAYS. 
*         IT **SHOULD** NOT CONTAIN ANY OVERLAY SPECIFIC STUFF.  IT 
*         IS INTENDED TO BE COMMON TO ALL OVERLAYS, AND BECAUSE IT
 IDP      SPACE  4,10 
***       DEFINE IDP LINKAGE SYMBOLS. 
* 
* 
  
 F.BDO    EQUEXT F.OUT
  
 #IDPOS   IFNE   .OS,2,1
          ENTRY  IDP= 
  
          ENTRY  REG=,SNP=
  
          ENTRY  ROL=,RSR=
          ENTRY  SNAPLNE,SOB,SVR= 
 IDPENT   SPACE  4,10 
**        IDPENT - DECLARE IDP ENTRY POINT. 
* 
* 
* LOC     IDPENT SYM
* 
*         ENTRY  LOC = OPTIONAL LOCATION FIELD FOR SYMBOL TO BE DECLARED
*                      AN ENTRY POINT.
* 
*                SYM = /IDP/SYM TO BE DECLARED AS AN ENTRY POINT. 
* 
* 
*         EXIT   NONE 
* 
*         USES   NONE 
* 
*         CALLS  EQUENT 
  
  
          PURGMAC IDPENT
  
          MACRO  IDPENT,LOC,SYM 
 SYM = /IDP/SYM 
 '?ID#001 IFC EQ, LOC 
 IDP=SYM EQUENT SYM 
 '?ID#001 ELSE
 LOC EQUENT SYM 
 '?ID#001 ENDIF 
 IDPENT   ENDM
 OI.      SPACE  4,10 
**        OI. - DEFINE/SET UP IDP OPTIONS.
* 
* 
 #IDPOS   IFNE   .OS,2
*CALL COMATOK 
 #IDPOS   ENDIF 
 IDP      SPACE  4,10 
          QUAL   IDP
  
  
 QUAL$    =      1           DESELECT COMDECK QUALS 
  
 TEST     =      0           DESELECT *TEST* MODE FOR IDP 
*CALL     COMSIDP - COMCIDP INTERFACE TEXT
 #IDPOS   IFNE   .OS,2
*CALL COMSTOK 
 #IDPOS   ENDIF 
 IDP      SPACE  4,10 
          QUAL   *
 #IDPOS   IFNE   .OS,2
 OWNCODE  TITLE  FTN 5 OWNCODE SUPPORT FOR IDP. 
***       FTN 5 OWNCODE SUPPORT FOR IDP.
* 
* 
*         THE FOLLOWING SECTION CONTAINS FTN 5 OWNCODE SUPPORT
*         AND INTERFACES TO IDP.  THIS SECTION IS INTENDED FOR
*         **GENERAL** FTN USE, AND THEREFORE, SHOULD NOT CONTAIN
*         ANY OVERLAY SPECIFIC STUFF. 
 UKT=     SPACE  4,10 
**        UKT= - USER KEYWORD TABLE.
* 
* 
*         *UKT=* IS THE 1ST FTN USER KEYWORD TABLE IN IDP.S LINKED
*         LIST OF USER KEYWORD TABLES.  IT CONTAINS PROCESSORS/KEYWORDS 
*         THAT CAN BE USED ANYWHERE DURING A FTN COMPILATION (I.E. NO 
*         OVERLAY SPECIFIC KEYWORDS). 
* 
*         ANY KEYWORD PROCESSORS FOR HIGHER OVERLAYS WILL BE DYNAMICALLY
*         LINKED WHEN THAT OVERLAY IS LOADED BY STORING THE NEXT
*         KEYWORD LINK ADDR INTO (UKT=LNK). 
  
  
 UKT=     BSS    0           ** FWA **
          QUAL   IDP
 ABT      KEYW   ABT
 ABT      KEYW   ABORT
          QUAL   *
          DATA   0           ** END OF TABLE ** 
 UKT=LNK  CONENT 0
 STMTPROC SPACE  10,20
***       FTN 5 IDP OWNCODE STMT PROCESSORS.
* 
* 
*         THE FOLLOWING ARE STMT PROCESSORS FOR PROCESSING
*         THE KEYWORDS IN *UKT=* (USER KEYWORD TABLE).
 ST=ABT   SPACE  4,10 
**        ST=ABT - ABORT FROM IDP.
* 
* 
  
  
 ST=ABT   BSS    0           ** ENTRY **
          RJ     RSR=        RESTORE REGISTERS
          ABORT 
 +        EQ     *           WAIT...
 #IDPOS   ENDIF 
 SUBR     SPACE  10,20
***       FTN 5 SUPPORT SUBROUTINES.
* 
*         THE FOLLOWING ARE SUBROUTINES THAT INTERFACE TO IDP.
 DXP=     SPACE  4,8
**        DXP= - DUMP EXCHANGE PACKAGE. 
* 
* 
*                BECAUSE SCOPE 2 REPRIEVE HAS NO RESET, THE SYSTEM DUMPS
*         ALL REGISTERS AS THEY WERE DURING REPRIEVE PROCESSING; AND
*         BECAUSE THIS IS NOT USEFUL, THIS ROUTINE DUMPS ALL REGISTERS
*         AS THEY WERE WHEN REPRIEVE WAS CALLED. IT ALSO DUMPS 100
*         WORDS EITHER SIDE OF WHAT THE -P- REGISTER WAS WHEN REPRIEVE
*         WAS CALLED. 
* 
*         ENTRY  (A1,X1) = A + C OF 1ST WORD OF EXCHANGE PACKAGE
* 
*         EXIT   NONE 
* 
*         USES   ALL BUT A0,A5,X5 
* 
*         CALLS  COD,DAR,DCM,PRIDP,TEX
  
 .OS      IFEQ   .OS,2       IF SCOPE 2 
  
 DXP=     SUBR   =           ** ENTRY/EXIT ** 
          RJ     TEX         TRANSFER EXCHANGE PACKAGE REGISTERS
  
*         DUMP P,RA,FL,EM,RE,FE, AND MA.
  
 DXP2     SA3    DXPB 
          SX6    X3-6 
          ZR     X6,DXP3     IF DONE
          SX6    X3+B1
          SA6    A3 
          SA2    DXPA+X3     (X2) = .......XX.   (.=BLANK(55B)) 
          SA1    HARDREG+X3  (X1) = SAVED CONTENTS OF HARDWARE REGISTER 
          BX6    X2 
          SA6    =XSNAPLNE
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC
          LX6    3*CHAR      (X6) = .NNNNNN...
          SA6    A6+B1
          MX7    0
          SA7    A6+B1       MARK EOL 
          PRIDP  SNAPLNE,3
          EQ     DXP2 
  
*         HERE TO DUMP ALL REGISTERS. 
  
 DXP3     RJ     DAR         DUMP ALL REGISTERS 
  
*         HERE TO DUMP 100B WORDS EITHER SIDE OF -P- REGISTER 
  
          SA1    HARDREG     (X1) = -P- REGISTER
          SX4    200B        (X4) = NR OF WORDS TO DUMP (LEN) 
          NZ     X1,DXP4     IF -P- REGISTER NONZERO
          SA1    B0          EXTRACT -P- FROM RA+0
          LX1    59-47+18 
  
 DXP4     MX0    -18
          BX1    -X0*X1 
          SX2    X1-100B     (X2) = FWA TO DUMP 
          RJ     DCM         DUMP CENTRAL MEMORY
          EQ     EXIT.
  
  
 DXPA     DATA   10H1       P  NNNNNN 
          DATA   10H       RA  NNNNNN 
          DATA   10H       FL  NNNNNN 
          DATA   10H       EM  NNNNNN 
          DATA   10H       RE  NNNNNN 
          DATA   10H       FE  NNNNNN 
          DATA   10H       MA  NNNNNN 
  
 DXPB     BSSZ   1
 .OS      ENDIF 
 PTO      SPACE  4,8
**        PTO - PRINT TABLE ORIGINS.
* 
* 
*                PRINTS TABLE STATISTICS IN THE FOLLOWING FORMAT--
*     COL 1         1         1         1         (.=BLANK(55B))
*         ..........TABLE.......ORIGIN......SIZE.....SLOP...
*         ......NN..NAME........NNNNNN....NNNNNN...NNNNNN...
* 
*         ENTRY  NONE 
* 
*         EXIT   (X0) = TOTAL LENGTH OF ALL TABLES
* 
*         USES   ALL
* 
*         CALLS  COD,PLINE
  
  
 PTO      SUBR   =
          SA0    B0          (A0) = TABLE ORDINAL 
          =X0    0
          PLINE  PTOA,5,1 
  
 PTO2     SX1    A0 
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC -- TABLE ORD 
          SA1    =XNAMES+A0  (X1) = 42/7LNAME,18/ORDINAL
          MX4    7*6
          SA5    =3R
          BX2    X4*X1       REMOVE TABLE ORDINAL 
          LX6    2*CHAR      (X6) = ......NN..   (.=BLANK(55B)) 
          BX7    X2+X5
          SA6    =XSNAPLNE
          SA1    =XBASES+A0  (X1) = TABLE ORIGIN
          SA7    A6+B1
          =X5    X1+FUDGE    (X5) = ORIGIN + FUDGE
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC -- ORIGIN
          LX6    2*CHAR 
          SA6    A7+B1       (X6) = ..NNNNNN..   (.=BLANK(55B)) 
  
          SA3    A1+B1       (X3) = ORIGIN OF NEXT TABLE
          SA1    A0+=XSIZES  (X1) = TABLE LENGTH
          IX0    X0+X1       TOTAL LENGTH 
          IX5    X5+X1
          IX5    X3-X5       (X5) = AMOUNT OF SLOP SPACE
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC -- LENGTH
          LX6    2*CHAR      (X6) = ..NNNNNN..   (.=BLANK(55B)) 
          SA6    A6+B1
  
          BX1    X5 
          RJ     =XCOD       CONVERT BINARY TO OCTAL DPC -- SLOP
          LX6    2*CHAR 
          SA6    A6+B1
          BX5    X0          SAVE X0
          SX6    =XALTNAM    START OF ALTERNATE NAME TABLE
          SA6    PTOB        SAVE IT
          SX2    5           LENGTH FOR WOF 
 PTO3     PLINE  SNAPLNE,X2 
          SA1    PTOB 
          SB6    X1          CURRENT POSITION IN ALTERNAME NAME TABLE 
          MX0    18 
          LX0    18 
          SX1    A0          ORDINAL TO SEARCH FOR
          CALL   SKT         FIND ALTERNATE NAME
          ZR     X2,PTO4     IF NO ALTERNATES 
  
          MX4    42 
          BX6    X4*X2       REMOVE ORDINAL 
          SA1    =10H 
          BX7    X1 
          SA7    =XSNAPLNE
          SA6    A7+B1
          =X6    A2+1        NEXT WORD IN ALTNAM TABLE
          SA6    PTOB        SAVE IT
          SX2    2           LENGTH FOR WOF 
          EQ     PTO3        FIND MORE ALTERNATES 
  
 PTO4     BX0    X5          RESTORE X0 
          SB6    =XN.TABLE-1
          SA0    A0+B1
          SB7    A0 
          LT     B7,B6,PTO2  IF MORE TABLES TO GO 
          EQ     EXIT.
  
  
 PTOA     DIS    5,          TABLE      ORIGIN      SIZE     SLOP 
 PTOB     CON    0           SAVE WORD FOR ALTNAM POINTER 
 TEX      SPACE  4,8
**        TEX - TRANSFER EXCHANGE PACKAGE REGISTERS.
* 
* 
*                THIS ROUTINE WILL TRANSFER THE CONTENTS OF THE 
*         REGISTERS IN THE SAVED EXCHANGE PACKAGE TO THE REGISTER SAVE
*         AREA (SVB,SVA,SVX -- AS SET UP BY *COMCSVR*). A SUBSEQUENT
*         CALL TO *RSR=* WOULD RESTORE ALL REGISTERS TO THEIR VALUES
*         AT THE TIME OF THE EXCHANGE.
* 
*         ENTRY  (A1,X1) = A + C OF 1ST WORD OF EXCHANGE PACKAGE
* 
*         EXIT   NONE 
* 
*         USES   X - 0,1,6,7
*                A - 1,6,7
*                B - 2,3,4,5,7
* 
*         CALLS  NONE 
  
  
          SA1    HARDREG     P-REGISTER 
          SX6    X1-2 
          PL     X1,EXIT.    IF P-REGISTER NOT CLEARED
          MX0    -17
          =A5    0
          LX5    59-47+18 
          BX6    -X0*X5 
          SA6    HARDREG     SET UP P-REGISTER
 TEX      SUBR               ** ENTRY/EXIT ** 
          SA1    A1+16-1     (X1) = LAST WORD OF 16 WORD EXCHANGE PKG 
          SB2    =XSVB
          SB3    =XSVA
          SB4    =XSVX
          SB5    HARDREG
          SB7    7           (B7) = LOOP COUNT -N-
          MX0    -18
  
*         RESTORE -X- REGISTERS.
  
 TEX2     BX6    X1 
          SA6    B4+B7
          SB7    B7-B1       N-1
          SA1    A1-B1
          GE     B7,B0,TEX2  IF MORE -X- REGS TO GO 
  
*         RESTORE -B- AND -A- REGS, AND SAVE P,RA,FL,EM,RE,FE,MA. 
  
          SB7    7           (B7) = LOOP COUNT -N-
  
 TEX3     BX6    -X0*X1      (X6) = (B-N-)
          LX1    -18
          BX7    -X0*X1      (X7) = (A-N-)
          SA6    B2+B7
          SA7    B3+B7
          LX1    -18
          BX6    -X0*X1      (X6) = P,RA,FL,EM,RE,FE,OR MA
          SA6    B5+B7
          SB7    B7-B1       N-1
          SA1    A1-B1
          GE     B7,B0,TEX3  IF NOT DONE
          EQ     EXIT.
  
  
 HARDREG  BSSZ   8           SAVED HARDWARE REGISTERS 
*         BSSZ   1           SAVED P
*         BSSZ   1           SAVED RA 
*         BSSZ   1           SAVED FL 
*         BSSZ   1           SAVED EM 
*         BSSZ   1           SAVED RE 
*         BSSZ   1           SAVED FE 
*         BSSZ   1           SAVED MA 
*         BSSZ   1           DUMMY FOR CONSISTENCY
 UIO=     SPACE  4,8
**        UIO= - USER IDP OWNCODE.
* 
* 
*         ENTRY  (RA.ORG) =  12/LAST OVERLAY LOADED (0P0S FMT),48/OTHER 
*                (UIOA)   =  48/0,12/LAST OVERLAY LOADED ON PREVIOUS
*                              IDP CALL (0P0S FMT)
* 
*         EXIT   (X1)     =  .MI., I.E. HONOR BREAK 
* 
*                WARNING -- IF THE USER HAS NOT ALLOTTED ENOUGH SPACE 
*                  FOR THE USER *SET* NAME TABLE *IDPSET* TO CONTAIN
*                  ALL THE DEFAULT *SET* NMAES, THEN *ADZ* (CALLED BY 
*                  *IST*) WILL SENSE TABLE OVERFLOW AND XIT TO *IDP=ER*.
*                  THIS CONDITION SHOULD BE AVOIDED.
* 
*         USES   X - 0,1,2,3,6,7   (INCLUDES ALL CALLS) 
*                A - 1,2,6
*                B - 6,7
* 
*         CALLS  CLZ,IST
  
 #OS      IFNE   .OS,2
  
 UIO=     SUBR   =           ** ENTRY/EXIT ** 
          SA2    RA.ORG 
          SA3    UIOA 
          MX1    1           SET TO *HONOR BREAK* 
          AX2    48-0 
          IX7    X2-X3
          BX6    X2 
          ZR     X7,EXIT.    IF WE ARE STILL IN THE SAME OVERLAY
          SA6    A3 
          SB6    /IDP/IDPBA 
          RJ     CLZ         CLEAR IDP TABLE -- BREAK ADDRESSES 
          MX1    1           SET TO *HONOR BREAK* 
          EQ     EXIT.
  
  
 UIOA     BSSZ   1           USED TO TELL WHETHER OR NOT A NEW OVERLAY
*                              HAS BEEN LOADED SINCE THE LAST *IDP* 
*                              CALL-- CONTAINS THE MOST RECENT OVERLAY
*                              LOADED NR FROM *RA.ORG* -- 48/0,12/0P0S
 #OS      ENDIF 
 URO=     SPACE  4,8
**        URO= - USER REG= OWNCODE. 
* 
*         ENTRY  (X5) = FWA OF *REG=* PARAMETER LIST
* 
*         EXIT   (X1) = .MI. IF SNAP TO BE HONORED, ELSE .PL. 
* 
*         USES   ALL
* 
*         CALLS  NONE 
  
  
 URO=     SUBR   =           ** ENTRY/EXIT ** 
          SA2    =XCO.SNAP
          SA3    X5+/IDP/SN=URF  (X3) = USER *REG* FLAGS
          BX1    -X2
          LX1    1RG
          PL     X1,EXIT.    IF *SNAP=G* SELECTED, NO SNAPS...
          ZR     X3,EXIT.    IF *USF* WORD IS .ZR., SELECT SNAPS... 
  
          BX6    X2*X3
          NZ     X6,EXIT.    IF A MATCH SOMEWHERE, SELECT SNAPS...
          BX1    X1-X1       SET TO *DESELECT SNAPS*
          EQ     EXIT.
 USO=     SPACE  4,10 
**        USO= - USER SNP= OWNCODE. 
* 
*         ENTRY  (X5) = FWA OF *SNP=* PARAMETER LIST
* 
*         EXIT   (X1) = .MI. IF SNAP TO BE HONORED, ELSE .PL. 
* 
*         USES   ALL
* 
*         CALLS  NONE 
  
  
 USO=     SUBR   =           ** ENTRY/EXIT ** 
          SA2    =XCO.SNAP
          SA3    X5+/IDP/SN=USF  (X3) = USER *SNP* FLAGS
          BX1    -X2
          LX1    1RG
          PL     X1,EXIT.    IF *SNAP=G* SELECTED, NO SNAPS...
          ZR     X3,EXIT.    IF *USF* WORD IS .ZR., SELECT SNAPS... 
  
          BX6    X2*X3
          NZ     X6,EXIT.    IF A MATCH SOMEWHERE, SELECT SNAPS...
          BX1    X1-X1       SET TO *DESELECT SNAPS*
          EQ     EXIT.
 #IDPOS   IFNE   .OS,2
**        USY= - USER IDP SYMBOL SEARCH.
* 
* 
*         *USY=* PROVIDES A LINKAGE TO AN IDP SYMBOL SEARCH 
*         ROUTINE IN ANOTHER (POSSIBLY HIGHER) OVERLAY.  THIS 
*         IS DONE BY CONSTRUCTING AN *RJ* TO THE ADDRESS
*         OF A SUBROUTINE THAT WAS PREVIOUSLY SET UP DURING 
*         OVERLAY INITIALIZATION.  SEE *USY=* IN COMCIDP, AND THE 
*         *INITXX*S.
* 
*         ENTRY  (X1) = SYMBOL TO SEARCH FOR, -L- FMT.
* 
*         EXIT   (X1) = .NZ. IF A FIND, ELSE .ZR. 
*                (X6) = BINARY VALUE FOR SYMBOL.
* 
*         USES   ALL BUT A0,X0,A5,X5
* 
*         CALLS  USY=XX(VIA CONSTRUCTED *RJ*) 
  
  
 USY=     SUBR               ** ENTRY/EXIT ** 
          SA2    IDP=USY     (X2) = ADDR OF *USY=XX* SUBROUTINE 
          SB2    X2 
          BX6    X1 
          SA6    USYA        SAVE (X1)
          RJ     /IDP/CHK    CHECK CM ADDRESS 
          BX1    X1-X1       PRESET TO *NO FIND*
          SX3    B2 
          LE     B2,B0,EXIT. IF USER DID NOT PROVIDE *USY=XX* 
  
          SA1    USYA 
          SA2    USYB        (X2) = *RJ* SKELETON 
          LX3    30 
          BX6    X2+X3       CONSTRUCT *RJ USY=XX*
          SA6    USY=RJ 
  
 USY=RJ   BSSZ   1
          EQ     EXIT.
  
  
 USYA     BSSZ   1           SAVED (X1) 
  
 USYB     RJ     0           RJ SKELETON
  
  
 IDP=USY  CONENT "BLOWUP"    ADDR OF *USY=XX* SUBROUTINE
 UFT=     SPACE  4,8
**        UFT= - USER FILE NAME TABLE.
  
  
 UFT=     BSS    0
          VFD    42/0LINPUT,18/=XF.IN 
          VFD    42/0LF.OUT,18/=XF.OUT
          VFD    42/0LOUTPUT,18/=XF.OUT 
          DATA   0           END OF TABLE MARK
*CALL     COMCLFM                  LOCAL FILE MANAGER 
 #IDPOS   ENDIF 
 QUAL     SPACE  4,10 
          QUAL   IDP
*CALL     COMCIDP - INTERACTIVE DEBUG PACKAGE 
 #IDPOS   IFNE   .OS,2
*CALL COMCBUB 
*CALL COMCBUN 
 #IDPOS   ENDIF 
*CALL COMCCDD 
 #IDPOS   IFNE   .OS,2
*CALL COMCCIO 
 #IDPOS   ENDIF 
*CALL COMCCOD 
*CALL COMCDXB 
 #IDPOS   IFNE   .OS,2
*CALL COMCMCS 
*CALL COMCRDC 
*CALL COMCRDW 
 #IDPOS   ENDIF 
*CALL     COMCRSR            RESTORE REGISTERS VIA CPU
*CALL COMCSBM 
*CALL COMCSFN 
*CALL     COMCSVR            SAVE REGISTERS VIA CPU 
 #IDPOS   IFNE   .OS,2
*CALL COMCSYS 
*CALL COMCTOK 
 #IDPOS   ENDIF 
*CALL COMCWOD 
 #IDPOS   IFNE   .OS,2
*CALL COMCWTC 
*CALL COMCWTW 
*CALL     COMCXJR            RESTORE REGISTERS VIA *XJR*
 #IDPOS   ENDIF 
*CALL COMCZTB 
 IDP      SPACE  4,10 
          QUAL   *
 ENTRY    SPACE  4,10 
***       DEFINE IDP LINKAGE/ENTRY SYMBOLS. 
* 
* 
  
  
 #IDPOS   IFNE   .OS,2
 IDP=     IDPENT IDP= 
 IDP=MN   IDPENT IDP=MN 
 IDP=ER   IDPENT IDP=ERR
  
          IDPENT CLZ
          IDPENT FLL
          IDPENT PAS
          IDPENT PAT
 PAT#FWA  IDPENT PAT#FWA
 PAT#LEN  IDPENT PAT#LEN
  
 IDP=DXB  IDPENT DXB
 IDP=MCS  IDPENT MCS
 IDP=SFN  IDPENT SFN
 IDP=SYS  IDPENT SYS= 
 #IDPOS   ENDIF 
  
  
 IDP=SVB  IDPENT IDP=SVB
 IDP=SVA  IDPENT IDP=SVA
 IDP=SVX  IDPENT IDP=SVX
  
 IDPFLG   IDPENT IDPFLG 
 REG=     IDPENT REG= 
 ROL=     IDPENT ROL= 
 SNP=     IDPENT SNP= 
 SNAPLNE  IDPENT SNAPLNE
 FW=IDPL  IDPENT FW=PARM
  
          IDPENT CAD
          IDPENT CHK
          IDPENT DAR
 DCM=     IDPENT DCM
          IDPENT FRK
          IDPENT HDR
          IDPENT SKT
          IDPENT SOB
  
 IDP=CDD  IDPENT CDD
 IDP=COD  IDPENT COD
 IDP=WOD  IDPENT WOD
 IDP=ZTB  IDPENT ZTB
  
  
**        THE FOLLOWING SYMBOL DEFINITIONS ARE **TEMPORARY**, I.E. THEY 
*         SHOULD BE REMOVED WHEN ALL OF THE REFERENCES TO THEM IN THE 
*         FTN5 COMPILER CAN BE DELETED WHEN WE ARE BEING ASSEMBLED ON SC
  
 #OS      IFEQ   .OS,2
 IDP=ER   BSSENT
 IDP=FLL  BSSENT
 IDP=MCS  BSSENT
 IDP=MN   BSSENT
 IDP=PAS  BSSENT
 IDP=PAT  BSSENT
 IDP=SFN  BSSENT
 IDP=     BSSENT
 IDPCHK   BSSENT
 IDP=USY  BSSENT
 UKT=LNK  BSSENT
          EQ     *+4S15      IN CASE SOMEBODY JUMPS HERE
 #OS      ENDIF 
 COMCSVR  SPACE  4,10 
**        COMCSVR - SAVE AND RESTORE REGISTERS. 
* 
* 
*         PROVIDE A GLOBAL FTN/NON-IDP VERSION OF RSR=/SVR=.
*CALL     COMQSVR 
 COMCSVR  SPACE  4,10 
          ENTRY  RSR=,SVR=
 RSR      EQUENT RSR= 
 SVR      EQUENT SVR= 
 RESET=   EQUENT RSR= 
  
 #SVR     IF     -DEF,#SVR   IF LOCAL REGISTER SAVE AREA
          ECHO   4,R=(B,A,X)
 SV_R     =      /COMQSVR/SVREG+/COMQSVR/SV_R 
 SAV.R    =      SV_R 
          ENTRY  SV_R,SAV.R 
          ENTRY  SV=R 
 #SVR     ENDIF 
 IDP      SPACE  4,10 
          LIST   D
**ENDIF   TESTFTN            (FOLLOWS END CARD) 
          END 
*ENDIF
