Retro1.org codex

*DECK WRITERI 
      PROC WRITERI ( (FET),(RECID),(WSA),(LENGTH), STATIS );
      BEGIN # WRITERI # 
*IF DEF,IMS 
 #
**
* 
*     1. PROC NAME           AUTHOR              DATE 
*        WRITERI             M. D. PICKARD       77/01/13 
* 
*     2. FUNCTIONAL DESCRIPTION 
*        WRITERI WILL WRITE A RECORD TO A SUPIO RANDOM FILE 
*        AND ADD THE RECORD IDENT TO THE SUPIO RANDOM INDEX.
* 
*     3. METHOD USED
*        IF THE FILE IS A SUPIO RANDOM FILE AND THERE IS ROOM IN
*        THE INDEX, FINDRI IS CALLED TO FIND THE PLACE IN THE INDEX 
*        FOR THE RECORD IDENT.  WRITER IS CALLED TO WRITE THE RECORD. 
*        IF THE WRITE IS SUCCESSFULL, THE RI IS ADDED TO THE INDEX. 
* 
*     4. ENTRY PARAMETERS 
*        FET                 ADDRESS OF THE FET 
*        RECID               RECORD IDENT 
*        WSA                 ADDRESS OF WRITE BUFFER
*        LENGTH              LENGTH OF RECORD TO REWRITE
* 
*     5. EXIT PARAMETERS
*        STATIS              RETURN STATUS
*                              0 - OPERATION COMPLETE 
*                              DECPEOC - PARITY ERROR, OPERATION COMP.
*                              DECPE -  PARITY ERROR
*                              DECAEOC - ADDRESS ERROR, OPER. COMPLETE
*                              DECAE - ADDRESS ERROR
*                              DECDSOC - DETAILED STATUS ERROR, OP. CMP.
*                              DECDS - DETAILED STATUS ERROR
*                              DECTL - TRACK LIMIT
*                              RANRSEQ - RANDOM REQUEST ON SEQ. FILE
*                              BADRI - BAD RECORD IDENT, DUPLICATE
*                              INDXSML - INDEX TOO SMALL TO ADD RECID 
*                              NOTSIOF - NOT A SUPIO FILE 
* 
*     6. COMDECKS CALLED
*        SIODEFS             SUPIO SYMPL DEFS 
*        SIOBASE             SUPIO BASED ARRAY DEFINITIONS
* 
*     7. ROUTINES CALLED
*        FINDRI              FINDS PLACE FOR RECORD IDENT 
*        RECALL              MACREL CPU RECALL SYMPL INTERFACE
*        WRITER              MACREL WRITER SYMPL INTERFACE
* 
*     8. DAYFILE MESSAGES 
*        NONE.
* 
 #
*ENDIF
      CONTROL NOLIST;        # STOPS LIST OF SIODEFS AND SIOBASE       #
*CALL SIODEFS 
*CALL SIOBASE 
      CONTROL LIST; 
      XREF
        BEGIN 
        PROC WRITER;
        PROC RECALL;
        PROC FINDRI;
        END 
      ITEM
           FET U,            # FET ADDRESS                             #
           RECID U,          # RECORD IDENT                            #
           WSA U,            # WORKING STORAGE AREA, WRITE FROM BUFFER #
           LENGTH U,         # RECORD LENGTH                           #
           STATIS U;         # RETURN STATUS                           #
      ITEM
           I U,              # INDUCTION VARIABLE                      #
           REQWORD U,        # REQUEST WORD FOR WRITER                 #
           TEMP U,           # TEMPORARY UNSIGNED INTEGER              #
           TEMPB B;          # TEMPORARY BOOLEAN                       #
      P<SIOFET> = FET;       # FORMAT FET                              #
      IF FETRAN[0]
      THEN                   # FET IS RANDOM FILE FET                  #
        BEGIN                # SEE IF THE INDEX IS OK                  #
        P<SIOINDX> = FETINDX[0]; # FORMAT THE INDEX                    #
        IF SIONAME[0] EQ "SUPIOINDEX" 
        THEN                 # FILE IS SUPIO RANDOM FILE               #
          BEGIN 
          IF ( LINDX[0] + 1 ) * SIOINDL LS FETINDL[0] 
          THEN               # THERE"S ROOM IN THE INDEX FOR WRITE     #
            BEGIN 
            FINDRI(LOC(SIOINDX),RECID,TEMP,TEMPB); # FIND RI IN INDX   #
            IF NOT TEMPB
            THEN             # NOT A DUPLICATE RECORD IDENT,           #
              BEGIN          # TEMP CONTAINS PLACE IT SHOULD GO        #
              FETFST[0] = WSA; # SET FIRST                             #
              FETIN[0] = WSA + LENGTH; # SET IN FOR BUFFER FULL        #
              FETOUT[0] = WSA; # SET OUT                               #
              FETLMT[0] = FETIN[0] + 1; # SET LIMIT                    #
              FETRR[0] = LOC(REQWORD); # RETURN RANDOM ADDR. TO REQWORD#
              WRITER(SIOFET,0); # WRITE THE RECORD                     #
              RECALL(SIOFET); # WAIT TIL COMPLETE BIT SET              #
              IF FETABNT[0] EQ 0
              THEN           # WRITE TOOK PLACE OK                     #
                BEGIN        # MOVE HIGHER ORDINAL DOWN TO MAKE ROOM   #
                FOR I = LINDX[0] STEP -1 UNTIL TEMP DO
                  BEGIN      # MOVE ALL HIGHER ENTRIES DOWN ONE        #
                  RI[I+1] = RI[I]; # MOVE RECORD IDENT DOWN ONE        #
                  RL[I+1] = RL[I]; # MOVE RECORD LENGTH DOWN ONE       #
                  RANINDX[I+1] = RANINDX[I]; # MOVE RANDOM INDEX DOWN  #
                  END 
                RI[TEMP] = RECID; # SET THIS ENTRY RI FIELD            #
                RL[TEMP] = LENGTH; # SET THIS ENTRY RECORD LENGTH      #
                RANINDX[TEMP] = REQWORD;
                LINDX[0] = LINDX[0] + 1; # ADJUST LAST INDEX ORDINAL   #
                CINDX[0] = TEMP; # SET CURRENT INDEX POSITION          #
                STATIS = 0; 
                END 
              ELSE
                STATIS = FETDEC[0]; # USE DETAIL ERROR CODE FOR STATUS #
              END 
            ELSE             # DUPLICATE                               #
              STATIS = BADRI; # BAD RECORD IDENT                       #
            END 
          ELSE               # INDEX AREA TO SMALL                     #
            STATIS = INDXSML; # SET RETURN STATUS                      #
          END 
        ELSE                 # NOT A SUPIO INDEX                       #
          STATIS = NOTSIOF;  # SET RETURN STATUS                       #
        END 
      ELSE                   # NOT A RANDOM FILE                       #
        STATIS = RANRSEQ;    # SET RETURN STATUS                       #
      RETURN; 
      END 
      TERM # WRITERI #