*DECK CRA1DAA                                                           013130
          IDENT  CRA1$AA                                                013140
          ENTRY  CRA1$AA                                                013150
          ENTRY  DMPM$AA
          TITLE  CRA1$AA,FOR ISSUEING RA+1 CALLS                        013160
*#                                                                      013170
* *       CRA1$AA - ISSUE RA + 1 REQUESTS        PAGE  1                 AM2A077
*1CD      CRA1$AA                                                       013180
*0CD      FUNCTION                                                      013190
*         THIS ROUTINE IS CALLED TO ISSUE RA + 1 REQUESTS.               AM2A077
*0CD      ENTRY CONDITIONS                                              013210
*         A1 POINTS TO A SYMPL PARAMETER LIST OF FOUR PARAMETERS        013220
*         THE PARAMETERS ARE P1,P2,P3,P4                                013230
*         P1 = 0 FOR CIO CALLS                                          013240
*            = 1 FOR AUTOMATIC RECALL RCL                               013250
*            = 2 FOR MSG                                                013260
*            = 3 FOR TIM                                                013270
*            = 4 FOR PFE                                                013280
*            = 5 FOR PRM
*            = 6 FOR ABT                                                013300
*            = SOME VALID PP CALL NAME IN DISPLAY CODE, RIGHT JUSTIFIED.013310
*         P2 = ADDRESS OF ARRAY OR SINGLE WORD ITEM WHICH IS            013320
*         A) FET ADDRESS IF P1 = CIO OR RCL                             013330
*         B) STATUS WORD OR PARCEL IF TIM,PFE OR PRM.  IF CALL IS PFE OR013340
*            PRM, THE LFN OF THE FILE MUST BE STORED LEFT JUSTIFIED,    013350
*            ZERO FILLED IN THE FIRST WORD OF THE PARCEL OR STATUS WORD.013360
*         C) MESSAGE BUFFER ADDRESS IF MSG                              013370
*         D) NOT NEEDED FOR ABT                                         013380
*         E) IF P1 = PP NAME, P2 WILL BE EXPLAINED UNDER NOTE.          013390
*         P3 0 OR NEGATIVE IF NO RECALL, .GT.0 IF RECALL
*         P4 = CIO CODE IF P1 = 0                                       013410
*            = NOT USED FOR MSG.  CALLER SHOULD FILL WITH 0             013420
*            = IF P1 = I (TIM)                                          013430
*                A) 0 FOR TIME (CPTIME)                                 013440
*                B) 1 FOR DATE                                          013450
*                C) 2 FOR CLOCK                                         013460
*                D) 3 FOR JDATE                                         013470
*                E) 4 FOR RTIME                                         013480
*                F) 10B FOR IOTIME                                      013490
*         = 30B FOR PFE                                                 013500
*         = 60B FOR PRM                                                 013510
*0CD      EXIT CONDITIONS                                               013520
*         B1 = 1, A0 PRESERVED, A1267, X1267, B5 DESTROYED              013530
*0CD      CALLED ROUTINES                                               013540
*         RM$CIO TO ISSUE CIO REQUESTS                                  013550
*         RM$SYS= TO ISSUE PP CALLS                                     013560
*         RM$CLA TO ISSUE AUTOMATIC RECALL                              013570
*         MSG= TO ISSUE MSG CALLS                                       013580
*0CD      DESCRIPTION                                                   013590
*         ON ENTRY, P1 IS USED TO INDEX THROUGH A JUMP TABLE TO TAKE US 013600
*         TO THE PROPER PLACE FOR FORMATTING THE CALL.  THE ONLY        013610
*         EXCEPTION IS WHEN P1 IS A PP CALL NAME.  THAT WILL BE         013620
*         EXPLAIN IN THE LAST PARAGRAPH.                                013630
*         THE RA + 1 IS FORMATTED, AND THE PROPER ROUTINE IS CALLED.    013640
*         FOR MSG CALLS, THE PARAMETERS ARE SET UP FOR CALLING MSG=.    013650
*0CD      NOTE                                                          013660
*         TO MAKE THIS ROUTINE MORE FLEXIBLE, ATEST IS FIRST MADE TO SEE013670
*         IF P1 IS GREATER THAN 6. IF SO, IT WILL BE ASSUMED AS A PP    013690
*         CALL NAME IN DISPLAY CODE AS MENTIONED ABOVE.  A CORRESPONDING013700
*         RA + 1 CALL IS FORMATTED WITH                                 013710
*         BITS 59 - 42 VALUE OF P1                                      013720
*         BIT 40  VALUE OF P3                                           013730
*         BIT 36 - 18 VALUE OF P4                                       013740
*         BIT 17 - 00 VALUE OF P2                                       013750
*         IT IS THE CALLER"S RESPONSIBILITY TO ENSURE ALL PARAMETERS    013760
*         ARE VALID.                                                    013770
*#                                                                      013780
          LIST   -L          CALL TO AAMCOMCMP
*CALL AAMCOMCMP 
          LIST   L
 SAVA0    BSS    1                                                      013790
 RESA0    SA1    SAVA0                                                  013800
          SA0    X1          RESTORE A/ BEFORE EXIT                     013810
 CRA1$AA  BSS    1                                                      013820
          SB1    1                                                      013830
          SA1    A1                                                     013840
          SA2    X1          LOAD UP FIRST PARAMETER                    013850
          SB5    X2          B5 = JUMP INDEX                            013860
          SX6    X2-7        TEST FOR PP CALL NAME                      013870
          PL     X6,USERCL   SKIP IF PP CALL NAME                       013880
          JP     JTAB+B5                                                013890
 JTAB     SA1    A1+B1       GET READY                                  013900
          SX7    A0          SAVE A0                                    013910
          EQ     CIO                                                    013920
          SA1    A1+B1                                                  013930
          SA2    X1                                                     013940
          EQ     RCL                                                    013950
          SA1    A1+B1       GET READY FOR MSG                          013960
          SA2    A1+B1                                                  013970
          EQ     MSG                                                    013980
          SX7    3LTIM       GET PP NAME READY FOR TIM                  013990
          EQ     TIM                                                    014000
          SX7    3LPFE                                                  014010
          EQ     ISSUE                                                  014020
          SX7    3LPRM                                                  014030
          EQ     ISSUE                                                  014040
          SX7    3LABT                                                  014050
          EQ     ISSUE                                                  014060
*#                                                                      014070
*         AT CIO, WE SAVE A0, SET A0 POINTING TO THE INPUT FET ADDRESS  014080
*         SET THE OP CODE INTO X7, COMPLEMENT X7 IF REQUEST IS TO BE    014090
*         ISSUED WITH RECALL, SET B5 FOR RETURN, AND CALL RM$CIO.       014100
*#                                                                      014110
 CIO      SA7    SAVA0                                                  014120
          SA2    X1                                                     014130
          SA1    A1+B1                                                  014140
          SA0    X2          SET A0 TO FET ADDRESS                      014150
          SA2    X1          LOAD UP RECALL PARAMETER                   014160
          SA1    A1+B1                                                  014170
          SA1    X1          LOAD UP P4 IN X1                           014180
          BX7    X1          GET CIO CODE INTO X7                       014190
          ZR     X2,CIO1     SKIP IF NO RECALL                          014200
          NG     X2,CIO1
          BX7    -X7         COMPLEMENT X7 FOR RECALL                   014210
 CIO1     BSS    0
          BX2    X7 
          RJ     =YRM$CIO 
          IFC    EQ,*"OS.NAME"*KRONOS*,2                                 CY211
          SX7    A0                                                      CY211
          RJ     EXCEED 
 STATS    IF     DEF,STATS
          SA4    BLOK$AA           X4 IS ADDRESS OF BLOK$AA 
          RF.AA  X4,BLFSTTA,3      X3 IS ADDRESS OF BLOCK,S FSTT
          IX5    X4-X3             IS THIS BLOCK A FSTT 
          ZR     X5,RESA0          DON,T COUNT CIO CALLS ON A FSTT
          RF.AA  X3,FSCIOCN        SET X1 TO FSTT CIO COUNT 
          SX2    1
          IX7    X1+X2
          SF.AA  X3,FSCIOCN,X7     RESET COUNT
 STATS    ENDIF 
          EQ     RESA0
*#                                                                      014240
*0        FOR RCL REQUESTS, ALL WE NEED IS FET ADDRESS IN X7, AND CALL  014250
*         RM$RCLA                                                       014260
*#                                                                      014270
 RCL      BX7    X2                                                     014280
          RJ     =YRM$RCLA
          IFC    EQ,*"OS.NAME"*KRONOS*,1
          RJ     EXCEED 
          EQ     CRA1$AA
KRON      IFC    EQ,*"OS.NAME"*KRONOS*
*#
*0    IF NOS, WE CONVERT THE DEVICE-CAPACITY-EXCEEDED 
*     ERROR STATUS TO THE NOS/BE FORM.
*#
EXCEED    DATA   0
          SA1    X7                                                      CY211
          SX2    37000B 
          BX6    X2*X1
          SX6    X6-22000B
          NZ     X6,EXCEED
          SA1    X7+6                                                    CY211
          MX6    48 
          BX6    -X6*X1 
          SX6    X6-4007B 
          NZ     X6,EXCEED
          SA1    X7                                                      CY211
          BX6    -X2*X1 
          SX2    10000B 
          BX6    X6+X2
          SA6    X7                                                      CY211
          EQ     EXCEED 
* 
KRON      ENDIF 
*#                                                                      014310
*         TO CALL MSG= TO ISSUE DAYFILE MESSAGES, X1 HAS TO BE SET TO   014320
*         REQUEST IS WITH RECALL.                                       014330
*#                                                                      014340
 MSG      SA2    X2                                                     014350
          SA1    X1          X1 = MESSAGE BUFFER ADDRESS                014360
          BX6    X2          GET RECALL BIT IF SET                      014370
          LX2    22D                                                    014380
          RJ     =YMSG=      FO ISSUE MESSAGE                           014390
          EQ     CRA1$AA     EXIT                                       014400
*#                                                                      014410
*         FOR TIM CALL, P4 DETERMINES THE TYPE OF TIM CALL.  THE CALL IS014420
*         FORMATTED INTO X7, AND WE SKIP OVER TO TAG ISSUE1 TO POST THE 014430
*         RA + 1 CALL.                                                  014440
*#                                                                      014450
 TIM      SA1    A1+B1                                                  014460
          SA2    X1                                                     014470
          BX6    X2                                                     014480
          SA1    A1+B1                                                  014490
          SA2    X1                                                     014500
          ZR     X2,TIM1     SKIP IF NO RECALL                          014510
          PX7    X7          ELSE SET RECALL BIT                        014520
 TIM1     LX7    42                                                     014530
          BX7    X7+X6                                                  014540
          SA1    A1+B1       LOAD P4                                    014550
          SA1    X1                                                     014560
          LX1    24D                                                    014570
          BX7    X7+X1                                                  014580
          EQ     ISSUE1                                                 014590
*#                                                                      014600
*0         FOR PFE, PRM OR ABT CALLS, CONTROL GOES TO TAG ISSUE WITH X7 014610
*         SET TO THE RESPECTIVE PP NAME.  THE RA + 1 CALL IS FORMATTED, 014620
*         AND RM$SYS= IS CALLED TO POST THE RA + 1 REQUEST AT TAG ISSUE1014630
*#                                                                      014640
 ISSUE    SA1    A1+B1                                                  014650
          SA2    X1          LOAD STATUS WORD ADDRESS                   014660
          SX6    X2                                                     014670
          SA1    A1+B1                                                  014680
          SA2    X1          LOAD RECALL BIT                             RPN1115
          LX2    40          GET RECALL BIT READY                       014700
          LX7    42                                                     014710
          BX7    X7+X2                                                  014720
          BX7    X7+X6                                                  014730
          SA1    A1+B1                                                  014740
          SA1    X1          LOAD P4                                    014750
          SA2    X6                                                     014760
          MX6    42                                                     014770
          BX6    X6*X2       CLEAR LOW 18 BITS                          014780
          BX6    X6+X1       OR IN CODE                                 014790
          SA6    A2                                                     014800
 ISSUE1   BSS    0
          RJ     =YRM$SYS=
          EQ     CRA1$AA
*#                                                                      014830
*0        AT TAG USERCL, WE ARE DEALING A PP CALL THAT THE USER WANTS.  014840
*         X7 IS SET UP AS MENTIONED IN NOTE, AND WE GO TO ISSUE1 TO POST014850
*         THE CALL.                                                     014860
*#                                                                      014870
 USERCL   BX7    X2          MOVE PP NAME INTO X7                       014880
          LX7    42                                                     014890
          SA1    A1+B1                                                  014900
          SA2    X1          LOAD P2                                    014910
          BX7    X7+X2       OR INTO X7                                 014920
          SA1    A1+B1                                                  014930
          SA2    X1          LOAD P3                                    014940
          LX2    40                                                     014950
          BX7    X7+X2                                                  014960
          SA1    A1+B1                                                  014970
          SA2    X1          LOAD +4                                    014980
          LX2    18                                                     014990
          BX7    X7+X2                                                  015000
          EQ     ISSUE1      GO ISSUE CALL                              015010
* 
*     DMPM$AA 
* 
*     THIS ROUTINE IS CALLED ONLY FROM MSCF$AA OR MSGF$AA IN AAM$AA.
*     AFTER A FATAL ERROR ON AN AAM FILE WE WOULD OFTEN LIKE TO HAVE A
*     MEMORY DUMP, BUT REPRIEVE DESTROYS THE EVIDENCE AND MAKES THE 
*     DUMP USELESS. WITH THIS NEW CODE, HOWEVER, ONE CAN USE A FILE 
*     CARD TO SET CM=YES IN THE FIT OF THE FILE THAT IS GOING TO HAVE 
*     THE FATAL ERROR, THEN RUN THE JOB. THE FATAL ERROR ROUTINE IN 
*     AAM$AA WILL CALL DMPM$AA, WHICH WILL CHECK AND RESET TO 0 THE 
*     CM BIT IN THE FIT. IF IT WAS 1, DMP IS CALLED FOR A DUMP OF THE 
*     WHOLE FIELD LENGTH. THEN WE RETURN TO AAM$AA. 
*     THIS IS LONG BEFORE REPRIEVE IS CALLED. 
* 
DMPM$AA   DATA   0
          SA2    X1 
          SA3    X2+11
          MX0    1
          LX0    36     BIT 35 WD 11 IS CM BIT
          BX6    X0*X3
          ZR     X6,DMPM$AA 
          BX6    -X0*X3 
          SA6    A3     TURN IT OFF AFTER FIRST TIME
          SA1    DAMP+1 
          MX6    48 
          BX6    X6*X1
          SA6    A1 
          SA1    DAMP 
          BX6    X1 
          SB1    1
          RJ     =YSYS= 
          EQ     DMPM$AA
* 
DAMP      BSS    0
DOOM      IFC    EQ,*"OS.NAME"*KRONOS*
          VFD    24/0LDMDP,18/0,18/377777B
          VFD    60/0    JUST HERE SO DAMP+1 CAN BE CLEARED 
DOOM      ELSE
          VFD    24/0LDMPP,18/0,18/*+1
          VFD    30/0,18/377777B,12/0 
DOOM      ENDIF 
* 
          END                                                           015020
