Retro1.org codex

          IDENT  0AU,UPFX
          TITLE  0AU - UPDATE PROJECT PROFILE FILE.
          PERIPH J
          BASE   MIXED
          SST
*COMMENT  0AU - UPDATE PROJECT PROFILE FILE.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992.
          SPACE  4,10
***       0AU - UPDATE PROJECT PROFILE FILE.
*         S. L. KSANDER.     76/04/20.
          SPACE  4,10
***       0AU IS A LOCATION-FREE ROUTINE WHICH DOES THE FOLLOWING
*
*         1. UPDATES THE APPROPRIATE LEVEL-3 BLOCK PROJECT ENTRY OF
*            THE PROJECT PROFILE FILE.
*         2. CLEARS CONTROL POINT AREA ACCUMULATOR OVERFLOW FLAGS
*            AND ISSUES THE APPROPRIATE ACCOUNT DAYFILE MESSAGE.
*
*         0AU IS CALLED WHENEVER OVERFLOW OF AN ACCUMULATOR IS
*         DETECTED OR AT END OF ACCOUNT BLOCK.
          SPACE  4,15
***       ENTRY CONDITIONS.
*
*         ((LA)-5) = AABB
*                    AA = OVERFLOW FLAG BITS FROM *SRUW*.
*                    BB = FUNCTION CODE.
*                         0 = END OF ACCOUNT BLOCK CALL.
*                         1 = ACCUMULATOR OVERFLOW CALL.
*         ((LA)-4) = PP ADDRESS OF TWO CM WORD JSN/SRU BLOCK.
*                    WORD 1 = 24/JSN,24/,6/SC,6/
*                    WORD 2 = 18/,42/SRU ACCUMULATOR.
*                    JSN = JOB SEQUENCE NUMBER.
*                    SC = SERVICE CLASS.
*         ((LA)-3) = FNT ORDINAL OF PROFILE FILE.
*         ((LA)-2) = TRACK OF LEVEL 3 BLOCK ON PROFILE FILE.
*                  = 0, IF NO PROFILE FILE PRESENT.
*         ((LA)-1) = SECTOR OF LEVEL 3 BLOCK ON PROFILE FILE.
          SPACE  4,20
***       EXIT CONDITIONS.
*
*         (A) = 0, IF SUCCESSFUL CALL. ONE OF THE FOLLOWING OCCURRED
*                1. END OF ACCOUNT BLOCK CALL - PROFILE FILE UPDATE
*                   PERFORMED IF PROFILE FILE PRESENT.
*                2. OVERFLOW CALL - NO OVERFLOW DETECTED, OR OVERFLOW
*                   FLAG CLEARED (IN ADDITION, IF SRU ACCUMULATOR,
*                   PROFILE FILE UPDATE PERFORMED AS IN 1.).
*                ((LA)-1) = CONTROL POINT AREA ACCUMULATOR OVERFLOW
*                FLAGS BEFORE CLEARING.
*         THE FOLLOWING INDICATE PROFILE FILE NOT UPDATED-
*         (A) = 1, IF SYSTEM ERROR. ONE OF THE FOLLOWING HAS OCCURED
*                  1. *ORET* ERROR FLAG SET IN CP.
*                  2. READ ERROR ON LEVEL-3 BLOCK.
*                  3. VALIDATION ERROR IN LEVEL-3 BLOCK.
*                  4. WRITE ERROR ON LEVEL-3 BLOCK.
*             = 2, IF PROFILE FILE INTERLOCKED BY *PROFILE*.
*                  (ANY OVERFLOW FLAGS REMAIN SET).
*
*         (A) .LT. 0 IF PROFILE FILE DEVICE INACCESSIBLE.
*         (T5) = EST ORDINAL OF PROFILE FILE DEVICE.
          SPACE  4,15
***       ACCOUNT DAYFILE MESSAGES.
*
*         THE FOLLOWING ERROR MESSAGES ARE ISSUED WHEN
*         THE CORRESPONDING ACCUMULATOR HAS OVERFLOWED.
*         (XXXXXX.XXX IS THE ACCUMULATOR,S OVERFLOW VALUE)
*
*         *UCAD, XXXXXX.XXXKUNS.* = ADDER ACCUMULATOR.
*
*         *UCPF, XXXXXX.XXXKUNS.* = PERMANENT FILE ACCUMULATOR.
*
*         *UCMT, XXXXXX.XXXKUNS.* = MAGNETIC TAPE ACCUMULATOR.
*
*         *UCMS, XXXXXX.XXXKUNS.* = MASS STORAGE ACCUMULATOR.
*
*         *UCOD, XXXXXX.XXXKUNS.* = OPTICAL DISK ACCUMULATOR.
*
*         *ACSO, XXXXXX.XXXUNTS.* = SRU ACCUMULATOR.
*
*         *UCMP, XXXXXX.XXXKUNS.* = MAP ACCUMULATOR.
*
*         *UCAC, XXXXXX.XXXUNTS.* = AUC ACCUMULATOR.
          SPACE  4,10
***       OPERATOR MESSAGES.
*
*         NONE.
          SPACE  4,5
***       ROUTINES USED.
*
*         CALLS  DFM, RDS, WDS.
          SPACE  4,10
*CALL     COMPMAC
*CALL     COMSCPS
*CALL     COMSMSP
*CALL     COMSPFM
*CALL     COMSPRO
*CALL     COMSZOL
*CALL     COMPREL
          SPACE  4,10
****      DIRECT CELL ASSIGNMENTS.
 
 FA       EQU    16          PROFILE FILE FNT ORDINAL
 BA       EQU    17          BUFFER ADDRESS
 
****
          SPACE  4,10
****      ASSEMBLE CONSTANTS.
 
 EAFC     EQU    0           END OF ACCOUNT BLOCK FUNCTION
 AOFC     EQU    1           ACCUMULATOR OVERFLOW FUNCTION
 
 MEPO     EQU    3           MASS STORAGE ERROR PROCESSING OPTION
 PFDL     EQU    4000D       DELAY CYCLES WAITING FOR PROFILE FILE
 
****
          TITLE  MAIN PROGRAM.
 UPF      SPACE  4,10
**        UPF - MAIN PROGRAM.
 
          ORG    5
 
 UPF      SUBR               ENTRY/EXIT
          RJM    PRS         PRESET
 
*         CHECK FOR ACCUMULATOR OVERFLOW.
 
          LDN    RLCO        CLEAR OVERFLOW FLAGS
          STD    CM+1
          MONITOR RLMM
          RJM    IOM         ISSUE OVERFLOW MESSAGES
 
*         READ LEVEL-3 BLOCK.
 
 UPF2     LDD    T6          CHECK PROFILE FILE PRESENT
          ZJN    UPFX        IF PROFILE FILE NOT PRESENT
          LDN    2           PRESET LEVEL-3 BLOCK PROJECT ENTRY INDEX
          STD    T3
          LDM    -5          CHECK SECTOR POSITION
          SHN    21-12
          PJN    UPF3        IF FIRST ENTRY
          LDC    5*PMWE      SET SECOND ENTRY OFFSET
          RAD    T3
 UPF3     LDD    BA          SET BUFFER ADDRESS
          RAD    T3
          RAM    UPFF
          STM    UPFG
          RAM    UPFH
          LDD    BA          READ SECTOR
          RJM.   RDS
          PJN    UPF7        IF NO READ ERROR
 
*         COMPLETION PROCESSING.
 
 UPF4     ENDMS
          LDN    RFAS        RETURN PROFILE FILE
          RJM    ARF
 UPF6     LDN    1           SET SYSTEM ERROR STATUS
 UPFC     EQU    *-1
*         LDN    0           (NORMAL COMPLETION)
          LJM    UPFX
 
*         UPDATE MASTER USER AND INSTALLATION SRU ACCUMULATORS.
 
 UPF7     LDN    ZERL        CLEAR SRU ACCUMULATOR VALUE
          CRD    CM
          LDN    40          INCREMENT ACCUMULATOR FOR OVERFLOW
          STD    CM+1
 UPFD     LDN    0           CHECK FUNCTION CODE
*         LDN    (FC)&AOFC
          ZJN    UPF8        IF OVERFLOW FUNCTION CODE
          LDD    MA          SET CURRENT SRU ACCUMULATOR
          CWM.   *,TR
 UPFE     EQU    *-1
          SBN    2
          CRD    CM
 UPF8     LDD    MA          SET MASTER/INSTALLATION ACCUMULATOR
          CWM.   5*PMSW,TR
 UPFF     EQU    *-1
          CWD    CM          SET INCREMENT VALUE
          SBN    2
          CWD    CM
          LDN    2           SET OPERATION COUNT
          STD    CM+4
          LDN    ABIF
          STD    CM+1
          MONITOR ACTM
          LDD    MA          SET INCREMENTED VALUES
          CRM.   5*PMSW,TR
 UPFG     EQU    *-1
          LDN    PDTL        SET LAST UPDATE DATE AND TIME
          CRM.   5*PUDW-5*PMSW,ON
 UPFH     EQU    *-1
 
*         RE-WRITE LEVEL-3 BLOCK.
 
          LDD    BA          WRITE SECTOR
          LMK    WLSF        SET WRITE LAST SECTOR
          RJM.   WDS
          MJN    UPF9        IF WRITE ERROR
          SOM    UPFC        SET NORMAL COMPLETION
 UPF9     LJM    UPF4        RETURN FILE AND SET STATUS
 
 
          ERRNZ  PISW-PMSW-2 SETUP ERROR FOR *ACTM* FUNCTION
          ERRNZ  PUDW-PMSW-1
          TITLE  SUBROUTINES.
 ARF      SPACE  4,10
**        ARF - ATTACH/RETURN FAST ATTACH FILE.
*
*         ENTRY  (A) = SUBFUNCTION CODE FOR ATTACH/RETURN.
*                (FA) = PROFILE FILE FNT ORDINAL.
*                (T5) = PROFILE FILE EST ORDINAL.
*
*         EXIT   (A) = FUNCTION RESPONSE CODE.
*                (CM+4) = BYTE 4 OF RESPONSE IF REJECT.
*
*         USES   CM - CM+4.
*
*         MACROS MONITOR.
 
 
 ARF      SUBR               ENTRY/EXIT
          STD    CM+3
          LDC    4000+PTUP   SET NON-ROLLABLE UPDATE MODE
          STD    CM+2
 ARFA     LDN    0
          ZJN    ARF1        IF NOT GLOBAL FAST ATTACH FILE
          LDD    T5          SET GLOBAL FAST ATTACH EST ORDINAL
 ARFB     ADD    TH          IMMEDIATE RETURN IF INACCESSIBLE DEVICE
*         PSN                (AFTER FILE IS ATTACHED)
 ARF1     STD    CM+1
          LDD    FA          SET FNT ORDINAL
          STD    CM+4
          MONITOR AFAM
          LDD    CM+1        SET EXIT CONDITION
          UJP    ARFX        RETURN
 BUF      SPACE  4,10
**        BUF - MASS STORAGE BUFFER
 
 
 BUF      EQU    *
          TITLE  OVERLAID SUBROUTINES.
 IDM      SPACE  4,10
**        IDM - ISSUE DAYFILE MESSAGE.
*
*         ENTRY  MESSAGE PRESET IN BUFFER.
*
*         CALLS  DFM.
 
 
 IDM      SUBR               ENTRY/EXIT
          LDC    AJNN+IDMA   ISSUE ACCOUNT FILE MESSAGE
          ADD    LA
          RJM.   DFM
          LDC    CDON+IDMA+5 ISSUE USER DAYFILE MESSAGE
          ADD    LA
          RJM.   DFM
          UJN    IDMX
 
 
 IDMA     VFD    24/4HJSNN,24/4H    ,12/**
          DATA   C*UCXX,   1048.576KUNS.*
 IOM      SPACE  4,15
**        IOM - ISSUE OVERFLOW MESSAGES.
*
*         ENTRY  (CM+4) = CONTROL POINT AREA OVERFLOW FLAGS (RIGHT
*                         JUSTIFIED) BEFORE CLEARED.
*
*         EXIT   ((LA)-1) = CONTROL POINT AREA OVERFLOW FLAGS
*                           (RIGHT JUSTIFIED) BEFORE CLEARED.
*                APPROPRIATE OVERFLOW MESSAGES ISSUED.
*
*         CALLS  IDM.
 
 
 IOM2     LDM    -1          CHECK OPTICAL DISK OVERFLOW
          SHN    21-10
          PJN    IOM2.1      IF NO OVERFLOW
          LDC    2ROD
          STM    IDMA+6
          RJM    IDM
 IOM2.1   LDM    -1          CHECK AUC OVERFLOW
          SHN    21-7
          PJN    IOM4        IF NO OVERFLOW
          LDN    11          MOVE DAYFILE MESSAGE
          STD    T1
          LDD    LA
          RAM    IOMF
 IOM3     LDM.   IOMH,T1
 IOMF     EQU    *-1
          STM.   IDMA+5-IDMA,T1
 IOMG     EQU    *-1
          SOD    T1
          PJN    IOM3        IF MESSAGE MOVE NOT COMPLETE
          RJM    IDM         ISSUE DAYFILE MESSAGE
 IOM4     LDD    T3          CHECK SRU ACCUMULATOR OVERFLOW
          SHN    21-5
          PJN    IOMX        IF NO OVERFLOW
          LDN    11          MOVE DAYFILE MESSAGE
          STD    T1
          LDD    LA
          RAM    IOMA
 IOM5     LDM.   IOMC,T1
 IOMA     EQU    *-1
          STM.   IDMA+5-IDMA,T1
 IOMB     EQU    *-1
          SOD    T1
          PJN    IOM5        IF MESSAGE MOVE NOT COMPLETE
          RJM    IDM         ISSUE DAYFILE MESSAGE
 
 IOM      SUBR               ENTRY/EXIT
          LDD    CM+4        SET OVERFLOW FLAGS
          STM    -1
          STD    T3
          LDN    7-2         SET INITIAL SHIFT COUNT
          STD    T4
 IOM1     SOD    T4          DECREMENT SHIFT COUNT
          MJP    IOM2        IF ALL SHIFTS COMPLETE
          LDD    T3          CHECK OVERFLOW FLAG
          RAD    T3
          SHN    21-7
          PJN    IOM1        IF OVERFLOW FLAG NOT SET
          LDM.   IOMD-IDMA-5,T4 SET MESSAGE PREFIX
 IOME     EQU    *-1
          STM    IDMA+6
          RJM    IDM
          UJN    IOM1        PROCESS REMAINING OVERFLOW FLAGS
 
 
 
 IOMC     DATA   L*ACSO, 219902.325UNTS*
 
 IOMH     DATA   L*UCAC, 536872.911UNTS.*
 
 IOMD     BSS    0           MESSAGE PREFIX TABLE
          CON    2RAD
          CON    2RPF
          CON    2RMT
          CON    2RMS
          CON    2RMP
          TITLE  PRESET.
 PRS      SPACE  4,25
**        PRS - PRESET.
*
*         ENTRY  ((LA)-5 - (LA)-1) = INITIAL CALLING SEQUENCE.
*
*         EXIT   (T5) = PROFILE FILE DEVICE EST ORDINAL.
*                (T6) = LEVEL-3 BLOCK TRACK.
*                (T7) = LEVEL-3 BLOCK SECTOR.
*                (FA) = FNT ORDINAL OF PROFILE FILE.
*                (BA) = SECTOR BUFFER ADDRESS.
*                (UPFA) = (UPFD) = *LDN (FC)&AOFC*
*                (UPFE) = PARAMETER BLOCK ADDRESS.
*                (UPFB) = SET IF PROFILE FILE PRESENT.
*                (IOMB) = (IOMG) = RELOCATED ADDRESS OF *IDMA+5*.
*                (IDMA - IDMA+1) = JOB SEQUENCE NUMBER.
*                (SFAA) = BASE FNT ADDRESS / 10.
*         (ARFB) = *PSN* IF *PROFILE* ATTACHED OR NOT NEEDED.
*                PROFILE FILE ATTACHED IF PRESENT.
*                DRIVER SET IF NEEDED.
*                TO *UPFX* IF *ORET* ERROR FLAG SET OR FILE BUSY.
*
*         USES   BA, FA, T1, T2, CM - CM+4, T5 - T5+4.
*
*         CALLS  ARF.
*
*         MACROS PAUSE, SETMS, SFA.
 
 
 PRS      SUBR               ENTRY/EXIT
          LDN    1           SET JSN FOR DAYFILE MESSAGE
          STD    T1
          LDD    LA
          RAM    PRSB
          RAM    IOMB
          STM    IOMG
          RAM    IOME
          LDM    -4          SET JSN/SRU PARAMETER ADDRESS
          STM    UPFE
          STM    PRSA
          ADN    4
          STD    T2
 PRS1     LDM.   *,T1        MOVE JSN TO DAYFILE MESSAGE
 PRSA     EQU    *-1
          STM.   IDMA,T1
 PRSB     EQU    *-1
          SOD    T1
          PJN    PRS1
          LDI    T2          SET SERVICE CLASS
          SHN    -6
          STM    IDMA+4
 
*         SET PROFILE FILE POINTERS FROM PARAMETER PASS.
 
          LDC    BUF         SET BUFFER ADDRESS
          ADD    LA
          STD    BA
          LDM    -3          SET PROFILE FILE FNT ORDINAL
          STD    FA
          SFA    FNT         READ FNT ENTRY
          CRD    CM
          ADN    FSTG        SET PROFILE FILE DEVICE EST ORDINAL
          CRD    T5
          LDD    CM+3        SET GLOBAL FILE STATUS
          LPN    77
          RAM    ARFA
          LDM    -1          SET LEVEL-3 BLOCK SECTOR
          STD    T7
          LDM    -5          EXTRACT FUNCTION CODE
          LPN    77
          LMN    AOFC
          STD    T1
          RAM    UPFD
          LDD    CP          FETCH CONTROL POINT AREA OVERFLOW FLAGS
          ADN    SRUW
          CRD    CM
          LDD    CM+1        CHECK SRU ACCUMULATOR OVERFLOW
          LPN    40
          ADD    T1
          ZJN    PRS2        IF NO NEED TO ACCESS PROFILE FILE
          LDM    -2
 PRS2     STD    T6
          NJN    PRS4        IF PROFILE FILE PRESENT
 PRS3     STM    ARFB
          LJM    PRSX        RETURN
 
 PRS4     SETMS  IO,RW
          LDM.   MSD
          SHN    21-6
          MJN    PRS6        IF PROFILE FILE DEVICE INACCESSIBLE
 
*         ATTACH PROFILE FILE FOR UPDATE.
 
 PRS5     LDN    AFAS        ATTACH PROFILE FILE
          RJM    ARF
          ZJN    PRS3        IF ATTACH COMPLETED
          SHN    21-11
          MJN    PRS6        IF DEVICE INACCESSIBLE
          LDD    CM+4
          LPN    2           CHECK REJECT
          LMN    2
          NJN    PRS6        IF ATTACHED IN MODIFY MODE BY *PROFILE*
 
*         WAIT FOR OTHER *0AU* TO RELEASE PROFILE FILE.
 
          LDC    PFDL/2
          SBN    1
          NJN    *-1
          PAUSE
          LDD    CM+1        CHECK ERROR FLAG
          LMN    ORET
          NJN    PRS5        IF NOT OPERATOR OVERRIDE
          LDN    1
 PRS6     LJM    UPFX        EXIT
          SPACE  4,10
**        COMMON DECKS.
 
 
 FNT$     EQU    1           ASSEMBLE SYSTEM FNT ACCESS
*CALL     COMPGFP
          SPACE  4,10
          OVERFLOW 5,ZAUL
 
          ERRNG  ZAUL-BUF-503 BUFFER OVERFLOWS CALLING PROGRAM
          END