*DECK EFDCRM
          IDENT     EF$CRM
 CB.ON    SET       1              CIRCULAR BUFFER ON 
*#
*1CD  THE EF$CRM SUBPROGRAM 
*0D   PURPOSE 
*0        TRANSFER A MESSAGE ALONG WITH ANY MESSAGE INSERT DATA TO THE
*         CRM ERROR FILE. 
*0D   CALLING SEQUENCE
*0        EQ        =YEF$CRM  (RETURNS TO ENTRY EFR$CRM IN ERR$RM)
*0D   PARAMETERS
*0        A0-    FIT ADDRESS
*         B1-    1
*         X0-    VFD 6/0,18/RTN,18/INA,1/FNF,1/NTE,1/DME,1/INF,1/EES, 
*                    4/SES,9/ES    (INA=FWA MESSAGE INSERT LIST)
*0D   ACTIONS 
*0        FIRST PERFORM THE GMSP PROCEDURE TO ESTABLISH A BUFFER POINTER
*         WHERE NO MORE BUFFER SPACE IS AVAILABLE 
*#
 .CB      IFNE      CB.ON,0 
*#
*         AND TO ACQUIRE THE SPACE IF NEEDED BY KEEPING OUTPUT GOING. 
*#
 .CB      ENDIF 
*#
*         TRANSFER 3 WORDS OF THE MESSAGE CONSTRUCTED BY DF$CRM TO THE
*         BUFFER.  IF AN ERROR MESSAGE IS BEING ISSUED ENCODE THE USER
*         RETURN ADDRESS AND STORE IN BUFFER.  IF THERE ARE NO INSERTS
*         FOR THIS MESSAGE PROCEDURE TO STEP 1.  LOOP THROUGH THE LIST
*         CALLING THE INSRT PROCEDURE FOR EACH LIST ELEMENT, EXITING THE
*         LOOP WHEN THE SIGN BIT IS SET AFTER RETURN FROM INSRT.
*0     1. IF THE FATAL BIT (FNF) IS SET CONSTRUCT THE MESSAGE INSERT FOR
*         THE FIT DUMP AND CALL INSRT TO TRANSFER IT TO THE BUFFER. 
*         STORE THE END OF RECORD WORD INTO THE BUFFER AND CALL THE 
*         GMSP PROCEDURE TO TERMINATE THE RECORD.  RETURN TO ERR$RM 
*         THROUGH ENTRY POINT EFR$CRM.
*0D   REGISTERS 
*0        A05,B017,X0 PRESERVED 
*0D   OTHER CODE REQUIRED 
*0        MACROS-   F.RM,SYSY,RCL.RM,MESSAGE
*         PROGRAMS- MSG=,MISC$RM
*#
          LIST      F,X 
          TITLE     EF$CRM - WRITE ERROR MSGS TO FILE.
          COMMENT   CRM COMMON ERROR PROCESSOR (ERROR FILE CAPSULE) 
          SST 
          B1=1
#LGTH#    MICRO     1,,/0,1,7,18,1,1/ LENGTH OF TABLE 
* CALL /EPCOM/
*CALL /EPCOM/ 
 .CB      IFEQ      CB.ON,0 
 RCL      MICRO     1,,/,RECALL/
 ER.BFSZ  SET       101B
 .CB      ELSE
 RCL      MICRO     ,,//
 ER.BFSZ  SET       240B
 .CB      ENDIF 
 NOSPACE  DATA      C*$NO SPACE * 
 BLNKMSG  DATA      C*        * 
          EJECT 
 LOFADR   DATA      0              >0 - ERROR FILE NAME IN LIST OF FILES
                                   =0 - NO ATTEMPT YET ON LIST ENTRY
                                   <0 - ATTEMPT FAILED - WRITER EACH REC
 EFB      BSS       0              ************** FWB ******************
 SETLOF   BSS       0              THE FOLLOWING CODE IS BUFFER RESIDENT
          BX4       X5             SAVE PARAMETERS
          SA5       NAMELOC 
*CALL /SETLOF/
          SX7       B1
          BX5       X4             RESTORE PARAMETERS 
          SA7       LOFADR         INDICATE NAME IS IN FILES LIST 
          SX4       A0             SAVE FIT 
          SA0       FET            USE FET OF ERROR FILE
          SYSY      104B,RECALL    OPEN WRITE,NR
 .NODROP  IFNE      #NODROP#,0
          SX1       =YLFM=
          NG        X1,SKP.NAD
          SET.FS     A0,NAD 
 SKP.NAD  BSS       0 
 .NODROP  ENDIF 
          SA0       X4             RESTORE FIT
          EQ        ZIFL           RETURN 
          SPACE     1 
 CALLERR  BSS       0 
          MX6       1              CANT FLUSH ON ABNORMAL TERMINATION SO
          SA6       LOFADR         INDICATE WRITER FOR EACH RECORD. 
          MESSAGE   M346B,,RECALL 
          EQ        ENDLOF
          SPACE     1 
 M346B    DIS       ,* RM EF PRODUCTION SLOWED BY ERROR 346*
 NAMELOC  VFD       42/0LZZZZZEG,18/FET 
          SPACE     1 
 ER.BFSZ  MAX       *-SETLOF,ER.BFSZ
          BSS       EFB+ER.BFSZ-*  ********** END OF BUFFER ************
 FET      VFD       42/0LZZZZZEG,18/1 
 FIRST    VFD       15/0,1/1,7/0,1/1,18/0,18/EFB  (FF=1, EP=1)
 IN       VFD       42/,18/EFB
 OUT      VFD       42/,18/EFB
 LIMIT    VFD       42/,18/EFB+ER.BFSZ
 15B      IS.IN     5 
  
          BSSZ      1              THIS WORD WILL STAY ZERO IF STATIC 
 EF$CRM   CAP.RM
          SA3       CAPSTAT        NAME OF CAPSULE
          BX7       X3-X6 
          AX7       18
          NZ        X7,STA
          SA6       A3-1           REMEMBER IF DYNAMIC
 STA      BSS 
          SA1       LOFADR
          ZR        X1,SETLOF      IF ZZZZZEG NOT IN FILES LIST 
 ZIFL     BSS       0 
          SA1       IN
          SB2       X1
          BX0       X5             KEEP PARAMETERS IN X0
          MX3       0 
          SA5       A0             SAVE FIT (ALWAYS IN RANGE) 
          SA0       B6             SAVE RETURN (POSSIBLY OUT OF RANGE)
          SX5       B0             CLEAR INTERNAL RETURN STACK
          SB6       GMSP           SET CALL TARGET _ GMSP 
          RJ        CALL           (GMSP) GET STOP POINTER
 XFER     BSS       0 
          SA1       =XMS$BUF+X3    DAYFILE MSG WORD 
          BX6       X1
          SA6       B2             STORE INTO BUFFER
          SX3       X3+B1          INCREMENT DAYFILE MSG POINTER
          SB2       B2+B1          INCREMENT *IN* 
          NE        B2,B3,BMSGL    IF WE HAVE BUFFER SPACE
          RJ        CALL           (GMSP) 
 BMSGL    BSS       0 
          SX1       X3-3
          NZ        X1,XFER        IF MORE DAYFILE MSG TO XFER
          BX1       X0
          LX1       NTE.P 
          MI        X1,I.N.F.T     IF A NOTE
          SA1       =10H EXIT ADDR
          BX6       X1
          SA6       B2
          SB2       B2+1
          NE        B2,B3,ENCD     IF WE HAVE BUFFER SPACE
          RJ        CALL           (GMSP) 
 ENCD     BSS       0 
          SA2       A5+7           LOAD CRM RETURN STACK
          SB4       6              CHARACTERS (DIGITS) TO ENCODE
          SX1       A0+0           CRM RETURN REGISTER
          ZR        X2,USEB6       IF EMPTY RETURN STACK
 STLP     BSS       0 
          SX1       X2             EXTRACT RETURN ADDRESS 
          AX2       18
          NZ        X2,STLP        IF NOT FIRST ADDRESS 
 USEB6    BSS       0 
*     CONVERT ADDRESS TO DISPLAY CODE.
          SA2       =10HESS 000000
          MX7       -3
          BX6       X2
  
 BD.ADR   BX2       -X7*X1
          LX7       6 
          SB4       B4-B1 
          IX6       X6+X2 
          LX1       3 
          GT        B4,BD.ADR 
  
          SA6       B2             STORE INTO BUFFER
          SB2       B2+1           INCREMENT *IN* 
          NE        B2,B3,I.N.F.T  IF WE HAVE BUFFER SPACE
          RJ        CALL           (GMSP) 
 I.N.F.T  BSS       0 
          BX1       X0
          SB6       INSRT          SET CALL TARGET _ INSRT
          LX1       INF.P 
          PL        X1,FNFT        IF NO INSERTS
          BX1       X0
          LX1       INA.P+INA.S 
          SA3       X1             LOAD FIRST INSERT LIST ELEMENT 
 INLP     BSS       0 
          RJ        CALL           (INSRT)
          MI        X3,FNFT        IF END OF INSERTS
          SA3       A3+1           LOAD NEXT INSERT LIST ELEMENT
          EQ        INLP
          SPACE     1 
 FNFT     BSS       0 
          BX1       X0
          LX1       FNF.P 
          PL        X1,EOR1        IF NON-FATAL  ERROR
          SX2       #FTL#+#FTS# 
          LX2       60-LEN.P-LEN.S
          SX1       45B            EOL=1,TYPE=1,MODE=1
          LX1       60-EOL.S-TYPE.S-MODE.S
          BX1       X2+X1          OR IN FIT LENGTH 
          SX3       B1             FIT BIT
          SX2       A5             FIT LOCATION 
          LX3       60-FIT.P-FIT.S POSITION FIT BIT 
          BX1       X3+X1          INDICATES FIT DUMP TO POST PROCESSOR.
          BX3       X2+X1          INSERT LIST FOR FIT DUMP 
          RJ        CALL           (INSRT)
 EOR1     BSS       0 
          SA1       =8LZZZZZEF. 
          BX6       X1
          SA6       B2             STORE EOR INDICATOR IN BUFFER
          SB2       B2+1
          SB6       GMSP           SET CALL TARGET _ GMSP 
          RJ        CALL           (GMSP) 
          SB6       A0             RESTORE CRM RETURN REGISTER
          SA0       A5             RESTORE FIT
          EQ        =XEFR$CRM      RETURN TO DF$CRM 
          TITLE     EF$CRM - INSERT LIST ELEMENT
*#
*1CD  THE INSRT SUBPROGRAM
*0D   PURPOSE 
*0        PROCESS ONE MESSAGE INSERT LIST ELEMENT 
*0D   CALLING SEQUENCE
*0        SB6       INSRT 
*         RJ        CALL
*0D   PARAMETERS
*0        B1-    1
*         B2-    *IN* POINTER 
*         B3-    BUFFER FILL STOP ADDRESS 
*         X3-    INSERT LIST ELEMENT
*0D   ACTIONS 
*0        STORE THE INSERT LIST ELEMENT INTO THE BUFFER (IT NOW BECOMES 
*         THE INSERT CONTROL WORD). EXTRACT THE INSERT MODE.  IF THE
*         MODE IS *CONTAINED* RETURN.  IF MODE IS *BSTRING* PROCEDE TO
*         STEP  1.   EXTRACT THE INSERT LENGTH.  IF THE MODE IS 
*         *DIRECTED* PROCEDE TO STEP 1.   MODE IS *CSTRING* SO COMPUTE
*         THE NUMBER OF CM WORDS CONTAINING THE STRING. 
*0    1. TRANSFER THE INSERT TO THE BUFER, CALLING GMSP IF MORE BUFFER
*         SPACE IS NEEDED.  RETURN. 
*0D   REGISTERS 
*0        USES A126,B2345,X12467
*0D   OTHER CODE REQUIRED 
*0        MACROS-   NONE
*         PROGRAMS- GMSP
*#
 INSRT    BSS       0              (X3=INSERT LIST ELEMENT) 
          SB6       GMSP           SET CALL TARGET _ GMSP 
          BX6       X3
          SA6       B2             STORE INSERT CONTROL WORD INTO BUFF. 
          SB2       B2+B1          INCREMENT *IN* 
          NE        B2,B3,STICW    IF WE HAVE BUFFER SPACE
          RJ        CALL           (GMSP) 
 STICW    BSS       0 
          BX7       X3
          MX2       60-MODE.S 
          LX7       MODE.P+MODE.S 
          BX4       -X2*X7         EXTRACT INSERT MODE FROM LIST ELEMENT
          MX7       0 
          ZR        X4,XFR         IF MODE IS CONTAINED, WORDS=0
          SX7       B1
          SB4       X4-3
          SB5       X3             PRE-SET INSERT ADDRESS REG.
          SX2       B1             WORD COUNT DECREMENT 
          ZR        B4,XF3         IF MODE IS BSTRING, WORDS=1
          BX7       X3
          MX6       -LEN.S
          LX7       LEN.P+LEN.S 
          SB4       X4-1
          BX7       -X6*X7         EXTRACT INSERT LENGTH
          ZR        B4,XF3         IF MODE IS DIRECTED, WORDS=LEN 
          BX4       X3
          MX6       -POS.S
          LX4       POS.P+POS.S 
          SX7       X7+9            CSTRING SO
          BX4       -X6*X4         EXTRACT CHARACTER POSITION OF INSERT 
          SX6       1S19/10+1 
          IX7       X7+X4          ADD POSITION TO LENGTH 
          IX7       X6*X7 
          AX7       19             DIVIDE BY 10 
 XF3      BSS       0 
          ZR        X7,XFR         IF NO MORE DATA THIS INSERT
          SA1       B5             LOAD INSERT WORD 
          BX6       X1
          SA6       B2             STORE INTO BUFFER
          SB2       B2+B1          INCRENENT *IN* 
          IX7       X7-X2          DECREMENT WORD COUNT 
          SB5       B5+B1          NEXT WORD OF DATA
          NE        B2,B3,XF3      IF WE HAVE BUFFER SPACE
          SX3       B5+            SAVE INSERT DATA WORD ADDRESS
          LX3       18
          BX3       X3+X7          SAVE INSERT LENGTH COUNTER 
          RJ        CALL           (GMSP) 
          SX7       X3             RESTORE INSERT LENGTH COUNTER
          AX3       18
          SB5       X3             RESTORE INSERT DATA WORD ADDRESS 
          SA3       A3             RESTORE INSERT ELEMENT WORD+ADDR.
          SX2       B1             RESTORE WORD COUNT DECREMENT 
          EQ        XF3            XFER NEXT WORD OF INSERT 
          SPACE     1 
 XFR      BSS       0 
          SB6       INSRT          SET CALL TARGET _ INSRT
          EQ        RETURN
          TITLE     EF$CRM - GET MORE SPACE 
*#
*1CD  THE GMSP SUBPROGRAM 
*0D   PURPOSE 
*0        RETURN A POINTER AT WHICH DATA TRANSFER TO THE BUFFER IS TO 
*         STOP AND ENSURE SPACE AVAILABLE BY KEEPING OUTPUT GOING.
*0D   CALLING SEQUENCE
*0        SB6      GMSP 
*         RJ       CALL 
*0D   PARAMETERS
*0        A0-      FIT
*         B1-    1
*         B2-    *IN* BUFFER POINTER
*         B3-    BUFFER XFER STOP POINTER (RETURNED ON EXIT)
*0D   ACTIONS 
*0     1. COMPUTE THE AMOUNT OF SPACE IN THE BUFFER AND SET B3 TO THE 
*         LAST ADDRESS OF CONTIGUOUS SPACE AVAILABLE. 
*         IF THERE IS ANY SPACE PROCEDE TO STEP 2.
*         STORE THE *IN* POINTER TO POINT TO STOPAT-1.
*         IF FILE IS NOT BUSY ISSUE A WRITE REQUEST TO CIO AFTER ERRCK. 
*         ISSUE PERIODIC RECALL THEN GO BACK TO STEP 1 TO TRY AGAIN.
*      2. IF PSEUDO IN = *LIMIT* SET PSEUDO IN = *FIRST* AND
*         STOPAT = *OUT*. 
*#
 .CB      IFEQ      CB.ON,0 
*#
*         IF LAST WORD STORED INTO BUFFER WAS NOT THE EOR WORD RETURN.
*         PUT FILE IN AUTO-RECALL AND CHECK FOR ERRORS IF FILE IS BUSY. 
*         ISSUE WRITER WITH RECALL AND CHECK FOR ERRORS THEN RETURN.
*#
 .CB      ENDIF 
*#
*0D   REGISTERS 
*0        USES A1247,B2345,X12467 
*0D   OTHER CODE REQUIRED 
*0        MACROS-   SYSY,RCL.RM 
*         PROGRAMS- MISC$RM,SYS=,ERRCK
*#
 GMSP     BSS       0 
          SA1       =8LZZZZZEF. 
          SA4       FIRST 
          SB6       ERRCK          SET CALL TARGET _ ERRCK
          IX6       X1-X6 
 DTCMP    BSS       0 
          SA1       OUT 
          SA2       LIMIT 
          SB4       X1
          SB3       B4-B2          SPACE = OUT - IN 
          LT        B0,B3,SPTST    IF OUT > IN
          SB3       B3+ER.BFSZ     (LIMIT-IN)+(OUT-FIRST) = SPACE 
 SPTST    BSS       0 
          SB3       B3-B1          AVOID LOSING BUFFER FULL OF DATA 
          NE        B3,B0,EORCK    IF WE NOW HAVE SPACE 
          SX7       B2
          SB4       X2             LIMIT
          NE        B2,B4,NOWRP    NO WRAP AROUND 
          SX7       X4             RESET IN = FIRST 
          SB2       X4
NOWRP     BSS       0 
          SA1       FET 
          SX4       A0
          LX1       59
          SA7       IN
          SA0       FET 
          PL        X1,PRCL        IF FILE BUSY 
          RJ        CALL           (ERRCK)
          SYSY      14B            WRITE NO RECALL
 PRCL     BSS       0 
          RCL.RM    A0,PERIODIC 
          SA0       X4
          SA4       A4             RELOAD *FIRST* 
          EQ        DTCMP          GO CHECK FOR SPACE AGAIN 
          SPACE     1 
 EORCK    BSS       0 
          SB4       X2+0           LIMIT
          NE        B4,B2,INOK     IF IN " LIMIT
          SB2       B2-ER.BFSZ     IN = FIRST 
 INOK     BSS       0 
          SB3       B3+B2          STOPAT = SPACE + IN
          LE        B3,B4,STOK     IF STOPAT @ LIMIT
          SB3       B4             STOPAT = LIMIT 
 STOK     BSS       0 
          NZ        X6,RTNG        IF LAST WORD INTO BUFFER NOT EOR WORD
          SX7       B2+0
          SA7       IN
          SA1       LOFADR
          PL        X1,RTNG        IF JOB ABORT WILL FLUSH BUFFER VIA OS
          SA1       FET 
          SX4       A0+0           SAVE RETURN ADDRESS OF USER FILE 
          SA0       A1             USE FET OF ERROR FILE
          LX1       59
          MI        X1,SKRCL       IF FILE NOT BUSY 
          RCL.RM    A0,AUTO        WAIT FOR COMPLETE BEFORE DOING EOR 
          RJ        CALL           (ERRCK)
 SKRCL    BSS       0 
          SYSY      24B,RECALL     WRITER THE RECORD, WAIT FOR COMPLETE 
          RJ        CALL           (ERRCK)
          SA0       X4+0           RESTORE RETURN ADDRESS OF USER FILE
 RTNG     BSS       0 
          SB6       GMSP           SET CALL TARGET _ GMSP 
          EQ        RETURN
          TITLE     EF$CRM - FLUSH ERROR FILE AND UNLOAD
*#
*1CD  THE FLEG$RM SUBPROGRAM
*0D   PURPOSE 
*0        FLUSH THE ERROR FILE BUFFER 
*         UNLOAD EF$CRM 
*0D   CALLING SEQUENCE
*0        SB3       RETURN
*         EQ        FLEG$RM 
*         (ONLY CALLED FROM DF$CRM) 
*0D   PARAMETERS
*0        B1-       1 
*         B3-       RETURN
*         A0-       FIT ADDRESS 
*0D   ACTIONS 
*0        IF THE FILE IS BUSY WAIT FOR COMPLETE AND CHECK FOR ERRORS. 
*         ISSUE WRITER TO TERMINATE SYSTEM-LOGICAL-RECORD, CHECK ERRORS.
*0D   REGISTERS 
*0        USES A1267,B4,X124567 
*0D   OTHER CODE REQUIRED 
*0        MACROS-   RCL.RM,SYSY 
*         PROGRAMS- SYS=,ERRCK
*#
          ENTRY     FLEG$RM 
 FLEG$RM  BSS 
 .CB      IFNE      CB.ON,0 
          SA1       LOFADR
          ZR        X1,NIL         IF NO RECORDS,    OR 
          MI        X1,NIL         IF ERROR 346 FORCED WRITER OF EACH 
          SA1       FET 
          SX3       B3             SAVE RETURN
          SX4       A0             SAVE FIT ADDRESS 
          SA0       A1             USE ZZZZZEG FET
          LX1       59
          MI        X1,SKRCLF      IF NOT BUSY
          RCL.RM    A0,AUTO        WAIT FOR COMPLETE
          SX5       SKRCLF
          EQ        ERRCK          CHECK FOR ERRORS 
 SKRCLF   BSS       0 
          SYSY      24B,RECALL     TERMINATE ERROR FILE (WRITER)
          SX5       ERCKRTN 
          EQ        ERRCK          CHECK FOR ERRORS 
 ERCKRTN  BSS       0 
* CALL /CLSFLOF/
*CALL /CLSFLOF/ 
          SB3       X3             RESTORE RETURN 
          SA0       X4             RESTORE FIT
 NIL      BSS       0 
 .CB      ENDIF 
          RJ        =XRM$UTC
          SA1       CAPSTAT-1 
          SB2       B1+B1          INDICATE NO LOAD ON ULJ CALL 
          BX7       X1
          SA7       =XRM$TMP
          EQ        =YRM$ULJ       UNLOAD SELF THEN EXIT VIA B3 
          TITLE     EF$CRM - ERRCK - CIO ERRORS ON ERROR FILE 
*#
*1CD  THE ERRCK SUBPROGRAM
*0D   PURPOSE 
*0        CHECK FOR AND HANDLE CIO ERRORS ON THE CRM ERROR FILE.
*0D   CALLING SEQUENCE
*0        SB6       ERRCK 
*         RJ        CALL
*0D   PARAMETERS
*0        B1-    1
*0D   ACTIONS 
*0        INITIALIZE NO=SPACE FLAG (B4) TO ZERO.
*0     1. IF NOT DEVICE CAPACITY EXCEEDED ERROR PROCEDE TO STEP 2.
*         IF NO-SPACE FLAG IS ZERO SET IT TO 1 AND ISSUE NO-SPACE 
*         MESSAGE TO CONSOLE.  WAIT 100 MILLESECONDS (RECALL) THEN
*         RE-ISSUE LAST PREVIOUS CIO REQUEST AND GO BACK TO STEP 1. 
*      2. IF NO-SPACE FLAG IS ON CLEAR CONSOLE DISPLAY.  RETURN.
*0D   REGISTERS 
*0        USES A1267,B45,X1267
*0D   OTHER CODE REQUIRED 
*0        MACROS-   MESSAGE,RCL.RM,SYSY 
*         PROGRAMS- MISC$RM,MSG=
*#
 ERRCK    BSS       0 
          SB4       0              INITIALIZE NOSP FLAG 
 CKLOOP   BSS       0 
          SA2       A0
          MX1       47
          BX1       -X1*X2
          AX1       9              ISOLATE BITS 13-9 OF CODE AND STATUS 
 .OS      IFC       EQ,/"OS.NAME"/KRONOS/ 
          SB5       X1-22B
          NZ        B5,ER4         IF NO EXTENDED ERROR CODE
          SA1       A0+6
          SB5       X1-4007B
 .OS      ELSE
          SB5       X1-10B
 .OS      ENDIF 
          NZ        B5,ER4         IF NOT DEVICE CAPACITY EXCEEDED
          NZ        B4,ER3         IF NOSP FLAG SET 
          SB4       B1             SET NOSP FLAG
          MESSAGE   NOSPACE        DISPLAY NO SPACE MESSAGE 
 ER3      BSS       0 
          RCL.RM    A0,PERIODIC,3777B WAIT 100 MILLESECONDS 
          SA1       A0
          SX2       774B
          BX1       X1*X2          ISOLATE PERVIOUS CIO CODE
          SYSY      X1,RECALL      RE-ISSUE LAST REQUEST
          EQ        CKLOOP         TRY AGAIN
          SPACE     1 
 ER4      BSS       0 
          ZR        B4,RETURN      IF NOSP FLAG NOT SET, EXIT 
          MESSAGE   BLNKMSG        CLEAR NO SPACE MESSAGE FROM CONSOLE
          EQ        RETURN
          TITLE     EF$CRM - CALL 
*#
*1CD  THE CALL SUBPROGRAM 
*0D   PURPOSE 
*0        PERFORM RE-ENTRANT RETURN JUMPS WITH NO CM TEMPORARIES. 
*         MAXIMUM OF 3 LEVELS.
*0D   CALLING SEQUENCE
*0        SB6       TARGET ROUTINE
*         RJ        CALL
*0D   PARAMETERS
*0        B6-    TARGET ADDRESS OF BRANCH 
*         X5-    RETURN STACK (MUST BE ZERO ON FIRST CALL)
*0D   ACTIONS 
*0        EXTRACT THE RETURN ADDRESS FROM THE ENTRY POINT AND ADD TO THE
*         X5 STACK, THEN ENTER CALLED ROUTINE.
*0        ON RETURN EXTRACT NEXT ADDRESS FROM THE STACK AND RETURN TO 
*         CALLER.  B6 IS PRESERVED FOR POSSIBLE SUBSEQUENT SAME CALL. 
*0D   REGISTERS 
*0        USES A1,X15 (DESTROYES B5 ON RETURN)
*0D   OTHER CODE REQUIRED 
*0        NONE
*#
 CALL     EQ        *+1S17         ADD RETURN ADDRESS TO 3 LEVEL STACK
          SA1       CALL
          AX1       30
          LX5       18
          SX1       X1
          BX5       X5+X1 
          JP        B6             ENTER TARGET ROUTINE 
          SPACE     1 
 RETURN   BSS       0 
          SB5       X5             POP THE RETURN STACK 
          AX5       18
          JP        B5             RETURN FROM TARGET ROUTINE 
          END 
