         TITLE    'PREPLOAD VERSION F00'
*M*  PREPLOAD COLLECTS APPROIATE EDMS PGS FOR D.B RESTORATION
*P*      NAME: PREPLOAD
*P*      PURPOSE: USING THE IN-PROGRESS LIST (FILE TPTPLIST) CREATED
*P*               BY LISTQIP AS INPUT PREPLOAD SCANS THE MOST RECENT
*P*               COMMON JOURNAL  BACKWARDS LOOKING FOR DMS BEFORE
*P*               IMAGES WHOSE TRANSACTION ID MATCHES THE ENTRIES ON THE
*P*               TPTPLIST FILE.  ANY THAT ARE FOUND ARE COPIED ONTO
*P*               THE F:AFTER FILE.  THIS FILE IS THEN USED BY
*P*               DMSLOAD TO RESTORE THE DATABASE.  THIS FILE IS ALSO
*P*               APPENDED TO THE LAST USED JOURNAL.  NOTE THAT DMS
*P*               BEFORES ARE CONVERTED TO DMS AFTERS BY PREPLOAD.
*P*               CHECKSUMS ARE RECALCULATED.
*P*      REFERENCE: TRANSACTION PROCESSING REFERENCE MANUAL 90-31-12.
*D*      NAME: PREPLOAD.
*D*      CALL: PREPLOAD IS A FREE STANDING SLAVE PROGRAM.
*D*      INTERFACE: STANDARD I-O (M:READ,WRITE) ARE USED FOR ALL
*D*               READING AND WRITING OF THE ANS JOURNAL FILE AND
*D*               THE IPLIST INPUT FILE.  M:LO IS USED FOR MISC
*D*               INFORMATION AND ERROR MESSAGES.
*D*      INPUT: TPIPLIST- CREATED BY LISTQIP AND CONTAINS ALL THE
*D*               IN-PROGRESS QUEUED ENTRIES.
*D*             COMMON-JOURNAL OWNED BY THE TPG AND USED BY THE
*D*               TIC AND TPLM. RECORDS USED BY PREPLOAD ARE
*D*               1) BEGIN TRANSACTION
*D*               2) DMS BEFORE RECORD
*D*               3) SYSTEM CRASH RECORD
*D*               4) TRANSACTION PROCESSING END RECORD.
*D*      OUTPUT: F:AFTERS JOURNAL RECORD FORMAT OF THE DMS BEFORE
*D*               RECORDS THAT MUST BE RESTORED (BY DMSLOAD)
*D*               RECORDS ARE IN JOURNAL RECORD FORMAT.  NOTE THAT
*D*               THESE RECORDS WERE THE APPROIATE BEFORES CHANGED TO
*D*               AFTERS.
*D*      ENVIRONMENT: PREPLOAD IS A SLAVE PROGRAM TO BE RUN IN
*D*               ACCOUNT :SYS TO EASILY ACCESS THE APPROIATE FILES
*D*               CREATED FOR IT BY OTHER PROCESSORS.
*D*               UNMAPED, SLAVE,PRIVILEGE 40.
         SYSTEM   TP:TPO
         SYSTEM   BPM
         SYSTEM   LP:TPOQ
         SYSTEM   SIG7FDP
*
*
         REF      M:SI              COMMON INPUT DCB
         REF      M:LO              COMMON OUT DCB
         REF      F:IPLIST          IN-PROGRESS LIST CREATED BY LISTQIP
         REF      F:TPFILES         USED TO GET JRNL SERIAL NUMBER(S)
         REF      F:AFTER           BUILD BY PREPLOAD FOR DMSLOAD
         DEF      PREPLOAD  MAIN PROGRAM ENTRY POINT
         DEF      FPTSECT           DEBUG USAGE ONLY
         DEF      PATCH             DEBUG USAGE ONLY
         DEF      @D                DEBUG USAGE
         DEF      @DCB              DEBUG USAGE
***************************************************************
DBGKEY   EQU      0                 SET TOO NOT DO ANY DEBUGGING
*                 SET THIS TO 1 FOR A DEBUG TRACE
********************************************************************
         DO       DBGKEY=1
ALLRECKEY  EQU    1
         ELSE
ALLRECKEY   EQU   0
         FIN
         PCC      0
         TITLE    'PREPLOAD  VERSION 0  **  PROCEDURES'
         GENTABS
PUSH     CNAME    X'0B'
PULL     CNAME    X'0A'
*
*                 FORMAT OF CALL:
*                    PULL     2,R7       PULLS R7,R8 FROM R:TSTACK
*                    PUSH   3,R0       PUSHES R0,R1,R2 INTO R:TSTACK
*                 NOTE THAT R:TSTACK MUST BE DECLARED AND
*                 INITIALIZED AS A STACK DOUBLEWORD POINTER
*
         PROC
LF       EQU      %
TMP      SET      -2
         DO       NUM(AF)>1
         DO       AF(1)<16
         LCI      AF(1)
         ELSE
         LCI      0
         FIN
TMP      SET      0
         FIN
         GEN,8,4,20  NAME+TMP,AF(NUM(AF)),R:TSTACK
         PEND
***********************************************************************
DEBUG    CNAME
         PROC
         LOCAL    %1,%2
         DO       DBGKEY=1
         B        %1
%2       TEXTC    AF
%1       EQU      %
         M:PRINT  (MESS,%2)
         FIN
         PEND
******************************************************************
*
EXPLAIN  CNAME,0                    PRINTS OUT EXPLANATIONS
         PROC
         OPEN     X,I
X        SET      S:UFV(AF)         LIST OF MESSAGES
I        DO       NUM(X)
         ERROR,*  ;
         '                                                       ****';
                  ,X(I)
         FIN
         CLOSE    X,I
         PEND
******************************************************************
*
*        CALL, ENTRY, AND RETURN ARE FOR INTERNAL LINKING.
*                 THE LINK LABEL IS A 2-ITEM LIST:
*                 1.  ADDRESS  OF A ROUTINE
*                 2.  ADDRESS OF A TEMP FOR REMEMBERING CALLER'S
*                      ADDRESS
*                 ENTRY IS THE ENTRY POINT INTO THE CALLED ROUTINE.
*                 RETURN RETURNS CONTROL TO THE
*                 CALLING PROGRAM.
*
*                 THESE ROUTINES WERE DONATED BY TED MARTNER
*                 THEIR OPERATION IS IDENTICAL TO THEIR USE IN THE
*                 TRANSACTION PROCESSING CONTROLLER
*
******************************************************************
         OPEN     X
*
CALL     CNAME                      CALL CALLS A SUBROUTINE
         PROC
X        SET      S:UFV(AF)
         ERROR,7,NUM(X)<2     'BAD CALL'  COMPLAIN IF IT ISN'T A SUBR
LF       BAL,11   X(1)              CALL IT
         EXPLAIN  X(3)
         PEND
*
ENTRY    CNAME                      ENTRY STARTS A SUBROUTINE
         PROC
         LOCAL    X,Y
         USECT    @T                PRESERVE A WORD IN TEMP SPACE
X        EQU      %
         DATA     0                 FOR HOLDING RETURN ADDRESS
         USECT    @P
Y        EQU      %
LF       EQU      Y,X,(AF)
         STW,11   X                 REMEMBER CALLER'S ADDRESS
         PEND
*
*                 ENTRYR NOT IMPLEMENTED FOR THIS PROGRAM
*
RETURN   CNAME
         PROC
X        SET      S:UFV(AF)
         ERROR,7,NUM(X)<2   'BAD RETURN'
LF       B        *X(2)             RETURN TO CALLER
         PEND
         CLOSE    X
*
@DCB     CSECT    0
@T       CSECT    0
@D       CSECT    0
@P       CSECT    1
         TITLE    'PREPLOAD VERSION 0'
*****************************************************************
*
*                 P R E P L O A D
*
*********************************************************************
PREPLOAD   EQU    %
,FPTSECT M:TYPE   (MESS,BEGIN%PREPLOAD)
         CALL     PROGRAM%CONTROL
         CALL     OPNIPLIST
         CALL     OPNAFTER
         CALL     READTRAN
         CALL     OPNJOURNAL
LOOP     EQU      %
         CALL     READJOURNAL
         GET,R2,R4  JTYPE,*R5
         CI,R2    BEGIN%TYPE
         BE       BEGIN%PROC
         CI,R2    BEFORE%TYPE
         BE       BEFORE%PROC
         CI,R2    CRASH%TYPE
         BE       CRASH%PROC
         CI,R2    TPGEND%TYPE
         BE       CRASH%PROC
         B        LOOP
BEGIN%PROC  EQU   %
         CALL     BEGIN%RECORD
         B        LOOP
BEFORE%PROC   EQU   %
         CALL     BEFORE%RECORD
         B        LOOP
CRASH%PROC   EQU   %
         CALL     CRASH%RECORD
         B        LOOP
CLEANUP   EQU   %
         CALL     WRITE%JOURNAL
         CALL     SUMMARY
ENDPREPLOAD   EQU   %
         CALL     CLSFILES
         M:EXIT
**************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  DATA'
*******************************************************************
*
*                 PREPLOAD DATA
*
*************************************************************************
         USECT    @D
BEGIN%TYPE   EQU   X'10'
BEFORE%TYPE   EQU   X'05'
CRASH%TYPE   EQU   X'12'
TPGEND%TYPE  EQU   X'13'
MAX%REC%SIZE   EQU   519
AFTER%RECORD%TYPE   EQU  X'06'
*
NON%EXIST%CODE   EQU   X'03'
ZERO%KEY%LEN EQU X'42'
TRAN%ID EQU X'4'
INOUT%MODE EQU X'4'
NO%SUCH%KEY%CODE   EQU   X'43'
FILE%ALREADY%OPEN%CODE   EQU  X'4C'
IRREC%READ%ERR%CODE   EQU   X'41'
BOF%CODE   EQU   X'04'
EOF%CODE EQU      X'06'
BUFF%TOO%SMALL   EQU   X'07'
*
ACTIVEFLAG   EQU   X'01'
OK%TO%OVERWRITE   EQU   X'01'
*
BUFFER%NUMBER   DATA   0
CRASH%FLAG   DATA   -1
*
SNINDEXMASK   DATA   X'0000FFFF'
*
         BOUND    8
TRANLIST  EQU   %
TRANCNT   DATA   0
TRAN:CD   DATA   0
TRANFLAG  EQU   %
*                 RESERVE 512 BYTES - DATA 0
         LIST     0
         DO1      512
         DATA,1   0
         LIST     1
TRANIDSTRT   EQU   %
*                 RESERVE 512 WORDS - DATA 0
         LIST     0
         DO1      512
         DATA     0
         LIST     1
TRANPAGE    EQU   %
*                 RESERVE 512 HW'S - DATA 0
         LIST     0
         DO1      512
         DATA,2   0
         LIST     1
SIZE%OF%TRANLIST   EQU   %-WA(TRANLIST)
*
         BOUND    8
TRANBUF0 RES      MAX%REC%SIZE
TRANID   EQU      TRANBUF0+6
         BOUND    8
TRANBUF1 RES      MAX%REC%SIZE
*
TRANSZ   DATA     0
*
KEY%ZERO%RECORD   DATA   X'030000C1'
ZERO%RECORD   EQU   %
         DO1      2
         DATA     0
QJOURNAL%KEY  EQU   %
         RES      8
ZERO%RECORD%SIZE  EQU   40
*
QJOURNAL%RECORD   EQU   %
         DO1      3
         DATA     0
         RES      8
SNINDEX  DATA     0
SN       RES      20
JOURNAL%RECORD%SIZE   EQU   108
         DATA     0
*
ECB%KEY   DATA   0
*
IPBUF    EQU      %
         DO1      3
         DATA     0
IPKEY    EQU      %
         TEXTC    'TPIPLIST'
IPFLAG   DATA     0
IPHTID   DATA     0
IPSZ     EQU      32
*
*
CTLKEY   TEXTC    'CTL0000'
CTLBUF   EQU      %
CTLTRANKEY   EQU   %
         DATA     0
CTLTRANCNT   EQU   %
         DATA     0
         RES      6
CTLHTID   DATA   0
CTLSZ    EQU      36
BINTRANCNT   DATA   0
DATATRANKEY   GEN,8,24   7,C'TRN'
KEYTRANCNT   RES   1
*
WORD4   DATA   4
WORD10   DATA     10
PAGE%MOD%CNT  DATA   0
RECORD%COUNT   DATA   0
*
ZERO%TRAN%COUNT   DATA   C'    '
*
AFTERBUF   EQU   %
         DATA     X'88000000'
         DATA     0
         DATA     0
AFTERKEY  TEXTC   'TPAFTER'
         DATA     0
AFTERFLAG    DATA   0
AFTERHTID   DATA   0
AFTERSZ  EQU      32
*
AFTERECB   DATA   0
*
REPBUF   DATA   0
SN%BUFF   RES   2
*
         BOUND    8
R:TSTACK   EQU   %
         DATA     WA(STKSTRT)
         GEN,16,16   64,0
STKSTRT  RES   64
*            MESSAGES
*
BUF0START RES 1  START OF DATA FOR BUF0   RMC 2-20-74
         BOUND    8
BUF1START RES 1 START OF DATA FOR BUF 1 RMC 2-20-74
HTIDMES  TEXTC    'HIGHEST TID VALUE FROM TPFILES IS  NNNNNNNN'
TPG%SAVE TEXTC    'TPG MUST COPY TPAFTER TO JOURNAL'
GO1      EQU      DA(HTIDMES+1)+4
*
KEYSN    TEXTC    'TYPE IN 6 CHARACTER SN OF LAST JOURNAL'
*
END%OF%JOURNAL   TEXTC   'PREPLOAD ENCOUNTERED BOF WITHOUT FINDING ';
                  ,' ALL BEGIN RECORDS'
*
OVRWRT%AFTER   TEXTC   'PREPLOAD: OK TO OVERWRITE CURRENT AFTER FILE';
                  ,' (Y OR N)'
*
         BOUND    8
READERROR   TEXTC   ' BLOCK COUNT = NNNNNNNN'
REC%MES  EQU      DA(READERROR)+2
*
         BOUND    8
GOBUF    EQU      WA(%)+1
GOAHEAD  TEXTC    '** NNNN TRANSACTIONS FOUND * ';
                  ,'STARTING JRNL SEARCH'
*
GOTO8    TEXTC    'OK TO RUN QPREP '
*
*
WRLENGTH   TEXTC   'SN MUST BE 6 CHARACTERS LONG'
         BOUND    8
*
*
SUM%MES  TEXTC    'TRANID NNNNNNNN ** NNNN PAGES TO BE RESTORED'
ID#BUF   EQU      DA(SUM%MES)+1
PAGE%CNT%BUF EQU WA(SUM%MES)+5   RMC
*
GOTO7    TEXTC    'OK TO ROLLBACK DATABASE * GO TO';
                  ,' EDMSLOAD '
*
INVAL%CHAR%MES   TEXTC   'INVALID CHARACTER'
PRIMER   TEXT     'NO DATA TO RESTORE'
         BOUND    8
BEGIN%PREPLOAD TEXTC 'PREPLOAD VERSION F00 '
CTLTID%MES   TEXTC   'HIGHEST TID VALUE FROM TPIPLIST IS NNNNNNNN'
CTLTIDBUF EQU     DA(%)-1
BAD%AFTER%MES   TEXTC   ' *** HIGHEST TID OF F:AFTER IS NNNNNNNN'
BAD%AFTER%BUF   EQU   DA(%)-1
         BOUND    8
TID%MES  TEXTC    '  HIGHEST TID VALUE IS NNNNNNNN'
TIDBUF   EQU      DA(%)-1
         USECT    @P
         TITLE    'PREPLOAD  VERSION 0  **  PROGRAM%CONTROL'
********************************************************************
*
*                 P R O G R A M % C O N T R O L
*
*                 NO INPUT OR OUTPUT
*                 EXIT%CONTROL IS THE EXIT ROUTINE
****************************************************************
PROGRAM%CONTROL                     ;
         ENTRY   ;
                  'ESTABLISH TRAP AND EXIT CONTROL'
         DEBUG    'ENTERING PROGRAM%CONTROL'
         M:TRAP   (IGNORE,FX)
         M:XCON   EXIT%CONTROL
         DEBUG    'EXITING PROGRAM%CONTROL'
         RETURN   PROGRAM%CONTROL
*
EXIT%CONTROL   EQU   %
         M:PRINT  (MESS,EXIT%MES%1)
         MTW,0    BEEN%HERE%BEFORE
         BGZ      EXIT%CONT%2       CONT'T LOOP IN EXIT
         MTW,1    BEEN%HERE%BEFORE
         CI,R8    0
         BE       EXIT%CONT%3       R8=ABORT CODE OR 0
         M:SNAP   'CHK 10'
         M:TYPE   (MESS,EXIT%MES%2)
         M:XXX
EXIT%CONT%2   EQU   %
         M:TYPE   (MESS,EXIT%MES%4)
EXIT%CONT%3   EQU   %
         M:EXIT
*
         USECT    @D
BEEN%HERE%BEFORE   DATA   0
EXIT%MES%1  TEXTC 'ENTRY TO EXIT CONTROL'
EXIT%MES%2   TEXTC   'UNEXPECTED ENTRY TO EXIT%CONTROL'
EXIT%MES%4   TEXTC    'LOOPING IN EXIT CONTROL - PROGRAM ABORTED'
***********************************************************************
         USECT    @P
         TITLE    'PREPLOAD  VERSION 0  **  BEFORE%RECORD'
****************************************************************
*
*                 B E F O R E % R E C O R D
*
*        BEFORE%RECORD CONVERTS AN EDMS BEFORE PAGE IMAGE
*        OF THE TRAN ID IN TRANLIST INTO AN EDMS
*        AFTER IMAGE, WHICH IS WRITTEN TO A DISK FILE VIA
*        F:AFTER DCB.
*
*        INPUT: THE PAGE IMAGE IN JOURNAL FORMAT IS IN TRANBUF
*        OUTPUT: THE PAGE IMAGE IS GIVEN A RECORD TYPE CORRESPONDING
*                 TO AN AFTER PAGE IMAGE, A NEW CHECKSUM IS
*                 CALCULATED AND THE RECORD IS WRITTEN TO DISK.
*        REGISTERS USED:  R1-R4 ARE DESTROYED
*        SUBROUTINES USED: CALCKSUM, LOOKUP
*        CALLED BY: PREPLOAD
*
**********************************************************************
BEFORE%RECORD    ENTRY     'PROCESS EDMS BEFORE PAGE IMAGE RECORD'
         DEBUG    'ENTERING BEFORE%RECORD'
         LW,R4    TRAN%ID,R5        GET TRAN ID  RMC
         CALL     LOOKUP
         MTW,0    R5                WAS TRANID FOUND?
         BLZ      NO%SUCH%ID
         MTH,1    TRANPAGE,R5       INCREMENT PAGE COUNT
         LW,R4    BUF0START         RMC 2-22-74
         MTW,0    BUFFER%NUMBER
         BEZ      BEFORE%1
         LW,R4    BUF1START         RMC 2-22-74
BEFORE%1 EQU %
         LI,R2    AFTER%RECORD%TYPE
         LW,R3    0,R4              GET FIRST WORD OF BUFFER RMC
         SLS,R3   16                GET RID OF BEFORE TYPE CODE
         SLD,R2   -16               INSERT THE AFTER TYPE CODE RMC
         STW,R3   0,R4              SAVE IT
         GET,R1,R3  JLEN,*R4
         STW,R1   TRANSZ
         CALL     CALCKSUM
         M:WRITE  F:AFTER,(BUF,*R4),(SIZE,*TRANSZ);
                  ,(ERR,ERR%AFTER);
                  ,(ABN,ABN%AFTER)
NO%SUCH%ID   EQU   %
         DEBUG    'EXITING BEFORE%RECORD'
         RETURN   BEFORE%RECORD
ABN%AFTER   EQU   %
         M:SNAP   'CHK R10'
         LI,R1    ERROR15
         CALL     ADVISE
ERR%AFTER   EQU   %
         M:SNAP   'CHK R10'
         LI,R1    ERROR16
         CALL     ADVISE
*********************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  BEGIN%RECORD'
*******************************************************************
*
*                 B E G I N % R E C O R D
*
*        BEGIN%RECORD TURNS OFF THE SEARCH FLAG FOR A PARTICULAR
*        TRAN ID IN TRANLIST.  IF ALL TRANSACTIONS HAVE
*        BEEN FOUND; I.E. THE BEGIN RECORDS OF ALL TRANSACTIONS
*        HAVE BEEN FOUND, THEN BEGIN%RECORD TRANSFERS CONTROL DIRECTLY
*        TO CLEANUP IN THE CALLING PROGRAM.
*
*        INPUT:  THE BEGIN RECORD IN JOURNAL FORMAT IN TRANBUF
*        OUTPUT: IF THE TRAN ID OF THE BEGIN RECORD MATCHES ONE
*                 OF THE TRAN ID'S IN TRAN LIST, THAT TRAN ID FLAG
*                 IS RESET.
*        REGISTERS USED:  R5 IS DESTROYED
*        SUBROUTINES USED: LOOKUP
*        CALLED BY: PREPLOAD
*
*********************************************************************
BEGIN%RECORD    ENTRY    'PROCESS BEGIN TRANSACTION RECORD'
         DEBUG    'ENTERING BEGIN%RECORD'
         LW,R4    TRAN%ID,R5        GET TRAN ID RMC 2-22-74
         CALL     LOOKUP
         MTW,0    R5                WAS THE TRAN ID FOUND
         BLZ      NO%SUCH%TRAN
         MTB,-1   TRANFLAG,R5       RESET FLAG
         MTW,-1   TRAN:CD           DECREMENT COUNT
         BEZ      END%OF%SEARCH     NO MORE ENTRIES IN TRAN LIST
NO%SUCH%TRAN   EQU   %
         LCI      0
         DEBUG    'EXITING BEGIN%RECORD'
         RETURN   BEGIN%RECORD
END%OF%SEARCH   EQU   %
         DEBUG    'EXITING BEGIN%RECORD FOR CLEANUP'
         B        CLEANUP           UNCONDITIONAL FINAL EXIT
****************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  CRASH%RECORD'
**************************************************************
*
*                 C R A S H % R E C O R D
*
*        CRASH%RECORD IS CALLED WHEN A SESSION DELIMITER,
*        SUCH AS A CRASH RECORD OR A TPG END RECORD IS ENCOUNTERED.
*        THE APPEARANCE OF EITHER OF THESE RECORDS IMPLIES THE END
*        OF PROCESSING FOR PREPLOAD, SINCE RECOVERY TAKES PLACE
*        AFTER THESE EVENTS.
*
*        INPUT: CRASH%FLAG=-1 AT FIRST ENTRY OF THIS ROUTINE
*                 SINCE THE LAST RECORD OF THE LAST VOLUME OF
*                 THE JOURNAL
*                 IS AN END-MARKER AND SHOULD NOT BE COUNTED
*        OUTPUT: NOTE FIRST ENTRY THROUGH ROUTINE SETS FLAG SO
*                 THAT SECOND ENTRY INTO ROUTINE CAN BE RECOGNIZED
*        REGISTERS USED: NONE
*        SUBROUTINES CALLED: NONE
*        CALLED BY: PREPLOAD
*
***********************************************************************
CRASH%RECORD    ENTRY    'PROCESS CRASH RECORD OR TPG END RECORD'
         DEBUG    'ENTERING CRASH%RECORD'
         MTW,1    CRASH%FLAG
         BGZ      CRASH%EXIT        THIS EXIT IS TAKEN IF THIS IS THE
*                                   SECOND APPEARANCE OF A CRASH OR END
*                                   RECORD IN THE SCAN OF THE JOURNAL
         DEBUG    'EXITING CRASH%RECORD FOR PREPLOAD'
         RETURN   CRASH%RECORD
CRASH%EXIT   EQU   %
         DEBUG    'EXITING CRASH%RECORD FOR CLEANUP'
         B        CLEANUP
***********************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  LOOKUP'
******************************************************************
*
*                 L O O K U P
*
*        LOOKUP FINDS THE ENTRY OF THE TRAN ID INDICATED IN R4 IN
*        TRAN LIST, IF ONE EXISTS THERE.
*
*        INPUT: TRAN ID IN R4
*        OUTPUT:  INDEX INTO TRAN LIST IN R5
*        REGISTERS USED: R3 AND R5 ARE DESTROYED
*        SUBROUTINES CALLED: NONE
*        CALLED BY: BEGIN%RECORD, BEFORE%RECORD, CRASH%RECORD
*
*****************************************************************
LOOKUP    ENTRY    'FIND THE INDEX OF THE TRAN ID IN TRANLIST'
         DEBUG    'ENTERING LOOKUP'
         LW,R3    TRANCNT           INIT BDR REGISTER
         LI,R5    0
LOOKLOOP EQU %    RMC 8-20-74
         CW,R4    TRANIDSTRT,R5
         BE       END%LOOKUP
         AI,R5    1
         BDR,R3   LOOKLOOP
         CW,R4    TRANIDSTRT,R5     LOOK AT LAST ENTRY,TOO
         BE       END%LOOKUP
         LI,R5    -1
END%LOOKUP   EQU   %
         DEBUG    'EXITING LOOKUP'
         RETURN   LOOKUP
*********************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  OPNJOURNAL'
****************************************************************
*
*                 O P N J O U R N A L
*
*        OPNJOURNAL FINDS, MOUNTS AND OPENS THE COMMON JOURNAL,
*        POSITIONS IT AT END-OF-FILE, AND READS THE FIRST RECORD
*        TO START THE DOUBLE BUFFERING
*
*        INPUT: CONTENTS OF TPFILES AND THE MOST RECENT JOURNAL
*        OUTPUT:  THE FIRST BUFFER CONTAINS THE FIRST RECORD (I.E. THE
*                 ONE AT THE END OF FILE.)
*        SUBROUTINES CALLED: CURRENT:SN, PREVIOUS%JOURNAL%VOL
*        REGISTERS USED:  R2 THRU R6 ARE DESTROYED
*        CALLED BY: PREPLOAD
*
*******************************************************************
OPNJOURNAL    ENTRY    'FIND, OPEN AND POSITION THE JOURNAL';
                  ,'AND START THE DOUBLE BUFFERING'
         DEBUG    'ENTERING OPNJOURNAL'
         CALL     CURRENT%SN        LOOKING FOR MOST RECENT VOLUME
         LI,R2    1                 INITIATE BUFFER NUMBER
         STW,R2   BUFFER%NUMBER     TO READ INTO BUFFER 0
         M:OPEN,E OPEN%JOURNAL%FPT
         LI,R1    1                 PFIL TO EOF
         CALL     JOURNAL%PFIL
         M:READ   F:JOURNAL,(BUF,TRANBUF0),(REV),;
                  (SIZE,MAX%REC%SIZE**2)
         DEBUG    'EXITING OPNJOURNAL'
         RETURN   OPNJOURNAL
*************
OPENJRNLRET   EQU   %               DCB RELATED ERR OR ABN RET
         LI,R1    ERROR35
         CALL     ADVISE
********************
**********
         USECT    @DCB
OPEN%JOURNAL%FPT M:OPEN,L F:JOURNAL,(ANSLBL,5);
                  ,(ERR,OPENJRNLRET),(ABN,OPENJRNLRET);
                  ,(INOUT),(VOL,1);
                  ,(SN,;    LEAVE ROOM FOR 20 POSIBLE SN'S
                  '    ','    ','    ','    ','    ',;
                  '    ','    ','    ','    ','    ',;
                  '    ','    ','    ','    ','    ',;
                  '    ','    ','    ','    ','    ')
         LIST     1
JOURNAL%NAME EQU  OPEN%JOURNAL%FPT+7 FILE NAME
JOURNAL%SN   EQU  OPEN%JOURNAL%FPT+16 SN LIST
JOURNAL%VOL EQU OPEN%JOURNAL%FPT+5     RMC 2-19-74
IN%INOUT%FLAG EQU OPEN%JOURNAL%FPT+4   RMC 2-23-74
********************************************************************
         USECT    @P
         TITLE    'PREPLOAD  VERSION 0  **  OPNIPLIST'
*******************************************************************
*
*                 O P N I P L I S T
*
*        OPNIPLIST OPENS AND CHECKS THE CONTENTS OF TPFILES AND
*        TPIPLIST
*
*        INPUT: CONTENTS OF TPFILES AND TPIPLIST
*        OUTPUT: THE BUFFER CONTAINING THE CONTROL KEY FOR TPIPLIST
*                 IS INITIALIZED AND APPROPRIATE MESSAGES ARE SENT
*                 TO THE OPERATOR
*        REGISTERS USED: R13-R15 ARE DESTROYED
*        SUBROUTINES: CONVERTID, ADVISE, OPNTPFILES
*        CALLED BY: PREPLOAD
*
*********************************************************************
OPNIPLIST    ENTRY    'OPEN AND CHECK TPFILES AND TPIPLIST'
         DEBUG    'ENTERING OPNIPLIST'
         CALL     OPNTPFILES
*                 OPEN TPIPLIST AND CHECK FOR IN PROGRESS
*                 TRANSACTIONS
         M:OPEN   F:IPLIST,(FILE,'TPIPLIST'),(KEYED),(DIRECT),;
                  (ERR,ERRINIPLIST),(ABN,ABNINIPLIST),;
                  (SAVE),(INOUT)
         M:READ   F:IPLIST,(BUF,CTLBUF),(SIZE,CTLSZ),(KEY,CTLKEY);
                  ,(ERR,RDIPLERR),(ABN,RDIPLABN)
         LW,R13   CTLTRANCNT        GET COUNT OF IP TRANSACTIONS
         CW,R13   ZERO%TRAN%COUNT   ANY IN PROGRESS ENTRIES?
         BE       OPNIP20           BRANCH IF NONE
*                 PRINT FULL-SPEED-AHEAD MESSAGE
         STW,R13  GOBUF
         LW,R13   CTLHTID
         CW,R13   IPHTID
         BNE      OPNIP10           CHECK TID'S FOR SYNCH.
         M:PRINT  (MESS,GOAHEAD)
         M:TYPE   (MESS,GOAHEAD)
         CALL     CONVERTID
         LI,R1    TIDBUF
         STD,R14  0,R1
         M:TYPE   (MESS,TID%MES)
         DEBUG    'EXITING OPNIPLIST'
         RETURN   OPNIPLIST
OPNIP10  EQU      %
         M:TYPE   (MESS,HTIDMES)
         LI,R1    CTLTIDBUF
         STD,R14  0,R1              INIT NEXT MESSAGE
         M:TYPE   (MESS,CTLTID%MES)
         LI,R1    ERROR34
         CALL     ADVISE
OPNIP20  EQU      %
         M:TYPE   (MESS,GOTO8)
         LI,R13   3                 SET  SENTINEL FOR TPIPLIST ACTIVE AND
         STB,R13  IPFLAG            PREPLOAD SUCCESSFUL
         DEBUG    'EXITING OPNIPLIST FOR ENDPREPLOAD'
         B        ENDPREPLOAD
*******************
*                 ERROR AND ABNORMAL ROUTINES
*******************
ABNINIPLIST   EQU %
         LB,R3    R10               CHECK FOR NON-EXISTANT FILE
         CI,R3    NON%EXIST%CODE
         BE       ABN1
         M:SNAP   'CHK 10'
         LI,R1    ERROR9
         CALL     ADVISE
ABN1     EQU      %
*                 NON EXISTENT FILE ON TPIPLIST
         LI,R1    ERROR10
         CALL     ADVISE            UNEXPECTED ABN ON OPEN OF F:IPLIST
ERRINIPLIST   EQU   %
         LB,R3    R10
         CI,R3    NO%SUCH%KEY%CODE
         BE       ERR3
         M:SNAP   'CHK 10'
         LI,R1    ERROR11           UNEXPECTED ERR ON OPEN F:IPLIST
         CALL     ADVISE
ERR3     EQU      %
         LI,R1    ERROR12           TPIPLIST INVALID- NO CTL KEY
         CALL     ADVISE
RDIPLABN   EQU   %
*                                   UNEXPECTED ABN ON TPIPLIST
         LI,R1    ERROR13
         CALL     ADVISE
RDIPLERR   EQU   %
         LI,R1    ERROR14           UNEXPECTED ERR ON READ F:IPLIST
         CALL     ADVISE
*****************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  OPNTPFILES'
******************************************************************
*
*                 O P N T P F I L E S
*
*        OPEN TPFILES, READ TPIPLIST RECORD AND CHECK VALIDITY OF
*        HIGHEST TRANSACTION ID.
*
*        INPUT: NONE
*        OUTPUT: TPIPLIST AND ITS ASSOCIATED TRAN ID ARE VERIFIED
*        REGISTERS: R13-R15 ARE DESTROYED
*        SUBROUTINES USED: CPNVERTID, ADVISE
*        CALLED BY: OPNIPLIST
*
*******************************************************************
OPNTPFILES    ENTRY    'OPEN TPFILES AND CHECK KEY FOR TPIPLIST'
         DEBUG    'ENTERING OPNTPFILES'
         M:OPEN   F:TPFILES,(FILE,'TPFILES'),(INOUT),;
                  (KEYED),(DIRECT),(SAVE),;
                  (ERR,ERRINTPF),(ABN,ABNINTPF)
         M:READ   F:TPFILES,(BUF,IPBUF),(SIZE,IPSZ),(KEY,IPKEY);
                  ,(ABN,ABNRDTPF),(ERR,ERRRDTPF)
         LB,R13   IPFLAG
         CI,R13   ACTIVEFLAG        IS IPFILES ACTIVE
         BE       OPNTPF10          YES ACTIVE
         LI,R1    ERROR1            TPIPLIST DORMANT
         CALL     ADVISE
OPNTPF10 EQU      %
         LW,R13   IPHTID
         CALL     CONVERTID
         LI,R1    GO1
         STD,R14  0,R1
         DEBUG    'EXITING OPNTPFILES'
         RETURN   OPNTPFILES
ABNINTPF   EQU   %
         LB,R3    R10               PICK UP ERROR CODE
         CI,R3    NON%EXIST%CODE
         BE       ABN2
         M:SNAP   'CHK 10'
         LI,R1    ERROR2
         CALL     ADVISE
ABN2     EQU      %
*                                   TPFILES NON-EXISTENT
         LI,R1    ERROR3
         CALL     ADVISE
ERRINTPF   EQU   %
         LB,R3    R10
         CI,R3    NO%SUCH%KEY%CODE
         BE       ERR1
         CI,R3    FILE%ALREADY%OPEN%CODE
         BE       ERR2
         M:SNAP   'CHK 10'
         LI,R1    ERROR4            UNEXPECTED ERR OPEN TPFILES
         CALL     ADVISE
ERR1     EQU      %
         LI,R1    ERROR5            NO KEY 'TPIPLIST'
         CALL     ADVISE
ERR2     EQU      %
         LI,R1    ERROR6            FILE ALREADY OPEN BY ANOTHER USER
         CALL     ADVISE
ABNRDTPF   EQU   %
         M:SNAP   'CHK 10'
         LI,R1    ERROR7            UNEXPECTED ABN ON READ F:TPFILES
         CALL     ADVISE
ERRRDTPF   EQU   %
         M:SNAP   'CHK 10'
         LI,R1    ERROR8            UNEXPECTED READ ERR ON TPFILES
         CALL     ADVISE
****************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  READTRAN'
****************************************************************
*
*                 R E A D T R A N
*
*        READTRAN INPUTS THE LIST OF IN PROGRESS TRANSACTIONS
*        AND BUILDS TRANLIST SO THAT A RECORD ABOUT A TRANSACTION
*        MAY BE IDENTIFIED AS BEING IN WHICH WE ARE INTERESTED.
*
*        INPUT: THE LIST OF IN PROGRESS TRANSACTIONS INFILE TPIPLIST
*        OUTPUT: TRANLIST IS BUILT
*        REGISTERS USED: R1-R2 ARE DESTROYED
*        SUBROUTINES: CALL EBCDICCNT
*        CALLED BY: PREPLOAD
*
**********************************************************************
READTRAN    ENTRY     'SET UP LIST OF TRANSACTION IDS FOR';
                  ,'JOURNAL SEARCH'
         DEBUG    'ENTERING READTRAN'
         LI,R2    0
READLOOP  EQU     %
         MTW,0    LAST%TRAN%FLAG    END OF TRANS IN TPIPLIST?
         BGZ      ENDREAD           YES
         CALL     EBCDICCNT
         LW,R1    KEYTRANCNT
         CW,R1    CTLTRANCNT
         BNE      NEXT%READ         NOT THE LAST TRAN YET
         MTW,1    LAST%TRAN%FLAG    FLAG THE LAST TRAN IN TPIPLIST
NEXT%READ   EQU   %
         M:READ   F:IPLIST,(BUF,TRANBUF0),(SIZE,1080),(KEY,DATATRANKEY);
                  ,(ERR,RDTRNERR),(ABN,RDTRNABN)
         MTB,1    TRANFLAG,R2
         CALL     CALCULATE%TRANID
         STW,R1   TRANIDSTRT,R2
         AI,R2    1
         CI,R2    SIZE%OF%TRANLIST
         BE       ENDREAD
         B        READLOOP
ENDREAD   EQU   %
         STW,R2   TRAN:CD           RMC NUMBER OR TRANSACTIONS
         AI,R2    -1
         STW,R2   TRANCNT
         DEBUG    'FINISHED TRAN LIST LOOKS LIKE'
         DO       DBGKEY=1
         M:SNAP   'TRANLIST',(TRANLIST,TRANLIST+SIZE%OF%TRANLIST)
         FIN
         DEBUG    'EXITING READTRAN'
         RETURN   READTRAN
*
RDTRNERR   EQU   %
         M:SNAP   'CHK 10'
         LI,R1    ERROR27           UNEXPECTED ERR ON READ TPFILES
         CALL     ADVISE
RDTRNABN   EQU   %
         M:SNAP   'CHK 10'
         LI,R1    ERROR28
         CALL     ADVISE
******************************************************************
         USECT    @D
LAST%TRAN%FLAG   DATA   0
         USECT  @P
         TITLE             'PREPLOAD   VERSION 0  **  CALCULATE%TRANID'
******************************************************************
*
*                          C A L C U L A T E % T R A N I D
*        CONVERTS THE TRAN ID IN EBCDIC TO BINARY
*        INPUT: JOURNAL RECORD IN TRANBUF0
*        OUTPUT: TRAN ID IN BINARY IN R1
*        REGISTERS USED: R4-R7 DESTROYED; R2 IS PRESERVED
*        SUBROUTINES CALLED: NONE
*        CALLED BY: READTRAN
*
*        THIS ROUTINE COURTESY OF TED MARTNER
*****************************************************************
CALCULATE%TRANID    ENTRY    'CALCULATE TRANID IN BINARY'
         DEBUG   'ENTERING CALCULATE%TRANID'
         LI,R7    TRANBUF0          INIT R7 W/ START OF TRANBUF0
         GET,R5,R6   JNAMELEN,*R7   GET LENGTH IF NAME IN BYTES
         AI,R7    JTRANAME(I)       SKIP TO START OF NAME
         SLS,R7   2                 CONVERT TO BA
         AW,R7    R5                SKIP TO END OF NAME
         AI,R7    -8                SKIP TO START OF TRAN ID
         LI,R5    0
         LI,R6    8
TRANID%10  EQU   %
         LB,R5    0,R7              GET A TID CHARACTER RMC 01-20-74
         CI,R5    X'30'
         BANZ     TRANID%20         BRANCH IF CHAR IS 0-9
         AI,R5    '9'+1-'A'         CONVERT
TRANID%20   EQU   %
         SCS,R5   -4                MOVE TO HIGH ORDER BITS
         SLD,R4   +4                MOVE INTO R4
         AI,R7    1                 BUMP POINTER
         BDR,R6   TRANID%10         CONTINUE FOR 8 CHARACTERS
         LW,R1    R4                TRANSFER TO R1
         DEBUG    'EXITING CALCULATE%TRANID'
         RETURN   CALCULATE%TRANID
         TITLE    'PREPLOAD  VERSION 0  **  CALCKSUM'
********************************************************************
*
*                 C A L C K S U M
*
*        CALCKSUM CALCULATES THE CHECKSUM OF THE RECORD IN
*        THE TRAN BUFFER CURRENTLY IN USE
*
*        INPUT: TRANBUF0 OR TRANBUF1 WITH BUFFER%NUMBER SET TO INDICATE
*                 WHICH BUFFER IS ACTIVE
*        OUTPUT: THE CHECKSUM IS STORED IN THE WORD AFTER THE LAST WORD IN
*                 THE RECORD
*        REGISTERS USED: R2-R5 AND R12 ARE DESTROYED
*        SUBROUTINES USED: NONE
*        CALLED BY: BEFORE%RECORD
*
********************************************************************
CALCKSUM    ENTRY    'CALCULATE CHECKSUM FOR JOURNAL RECORD'
         DEBUG    'ENTERING CALCKSUM'
         LW,R4    BUF0START         STARTING LOCATION OF BUF0
         MTW,0    BUFFER%NUMBER
         BEZ      CKSUM%1
         LW,R4    BUF1START         STARTING LOCATION OF BUF1
CKSUM%1  EQU      %
         GET,R3,R5  JLEN,*R4
         LW,R5    R4                STARTING LOCATION OF CURRENT BUF
         LI,R2    0
         DW,R2    WORD4             CONVERT TO WORDS
         CI,R2    0     RMC 2-22-74
         BEZ      CKSUM%2
         AI,R3    1
CKSUM%2  EQU      %
         AI,R3    -2                -1 FOR CHECKSUM,-1 FOR INIT OF ACCUMULATOR
         LI,R2    1
         LW,R12   *R4
CKSUM%3  EQU      %
         AW,R12   *R4,R2
         BNC      CKSUM%4
         AI,R12   1                 ADD ONE IF CARRY
CKSUM%4  EQU      %
         AI,R2    1
         BDR,R3   CKSUM%3
         LW,R3    *R4,R2            GET OLD CHECKSUM
         STW,R3   ORIG%CHECKSUM     SAVE IT
         STW,R12  NEW%CHECKSUM      FOR COMPARE IN READ%JOURNAL
         STW,R12  *R4,R2
         DEBUG    'EXITING CALCKSUM'
         RETURN   CALCKSUM
         USECT    @D
ORIG%CHECKSUM    DATA    0
NEW%CHECKSUM    DATA    0
         USECT    @P
*****************************************************************
***************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  CONVERTID'
************************************************************************
*
*                           C O N V E R T I D
*
*        CONVERT A HEXADECIMAL ID TO EBCDIC FOR PRINT OUT
*                 THIS ROUTINE SUPPLIED BY TED MARTNER
*
*        INPUT:  R13=ID IN HEXADECIMAL
*        OUTPUT: R14 AND R15 CONTAIN THE TRAN ID IN EBCDIC
*        ENTRY POINT:  CONVERTID
*        SUBROUTINES USED:  NONE
*        REGISTERS DESTROYED:  NONE
*
*********************************************************************
CONVERTID   ENTRY   'CONVERT CONTENTS OF R13 INTO AN';
                  ,' EBCDIC VALUE IN R14 AND R15'
         DEBUG    'ENTERING CONVERTID'
         PUSH     1,R12
         LI,R14   0                 INITIALIZE REGISTERS
         LI,R15   0
CONVERTID%1  EQU  %
         LI,R12   '0'**-4           CONVERT 1 DIGIT TO EBCDIC
         SLD,R12  +4
         CI,R12   '9'               WAS IT CONVERTED OK?
         BLE      CONVERTID%2       YES
         AI,R12   'A'-'9'-1         NO ADJUST IT
CONVERTID%2  EQU  %
         SLD,R14  8
         OR,R15   R12
         BNOV     CONVERTID%1       OV SET BY SLD WHEN DONE
         PULL     1,R12
         DEBUG    'EXITING CONVERTID'
         RETURN   CONVERTID
*
************************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  EBCDICCNT'
**********************************************************************
*
*                 E B C D I C C N T
*
*        GENERATION OF KEY FOR TPIPLIST
*
*        INPUT: NONE
*        OUTPUT: NEW KEY IS STORED IN KEY DOUBLEWORD
*        REGISTERS USED: R13-R15
*        CALLED BY: READTRAN
*        SUBROUTINES USED: CONVERTID
*
********************************************************************************
EBCDICCNT   ENTRY    'GENERATE TPIPLIST KEY IN EBCDIC'
         DEBUG    'ENTERING EBCDICCNT'
         MTW,1    BINTRANCNT        INCREMENT COUNTER
         LW,R13   BINTRANCNT        INIT REGISTER FOR CONVERTID
         CALL     CONVERTID
         STW,R15  KEYTRANCNT        SAVE RESULT IN KEY DW
EBCNT1   EQU      %
         DEBUG    'EXITING EBCDICCNT'
         RETURN   EBCDICCNT
*
*******************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  ADVISE'
*******************************************************************
*
*                 ADVISE
*
*
*        INTERNAL ROUTINE TO PRINT OUT ERROR MESSAGE FROM
*        MESSAGE LIST AND ABORT JOB
*
*        INPUT: R1=START OF ERROR MESSAGE
*        OUTPUT: ERROR MESSAGE IS WRITTEN TO OPERATOR'S CONSOLE
*                 AND TO M:LO
*        REGISTERS USED: R3 AND R4 ARE DESTROYED
*        CALLED BY:
***********************************************************************************
ADVISE    ENTRY    'PRINT ERROR MESSAGE AND ABORT JOB'
         DEBUG    'ENTERING ADVISE'
         M:TYPE   (MESS,*R1)        REPORT TO OPERATOR
         M:XXX
         RETURN   ADVISE            (NOT NEEDED - INCLUDED FOR AESTHETICS)
*
*****************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  CURRENT%SN'
************************************************************************
*
*                 C U R R E N T % S N
*
*        CURRENT%SN: GET VOLUME SERIAL NUMBER OF CURRENT VOLUME        *
*        OF JOURNAL ASSOCIATED WITH QUEUE. THE CURRENT SN IS FOUND     *
*        IN THE TPFILES RECORD FOR THE JOURNAL.                        *
*   IF IT IS NOT POSSIBLE TO ACCESS TPFILES, ASK THE OPERATOR TO       *
*   KEY IN THE CURRENT VOLUME SERIAL NUMBER.                           *
*   RETURN: R5 = SN INDEX TO CURRENT VOLUME                            *
*           SNINDEX = -1 IF TPFILES NOT ACCESSABLE                     *
************************************************************************
CURRENT%SN              ;
         ENTRY    'BUILD JOURNAL LABEL, SERIAL NUMBER,',;
                  'AND VOLUME NUMBER INTO THE OPEN FPT'
         DEBUG    'ENTERING CURRENT%SN'
         CALL     READTPFILES
         BCS,1    TPFILES%INACCESSABLE
        LW,R5    SNINDEX           SNINDEX(HW1)=INDEX
        AND,R5   SNINDEXMASK       R5=INDEX TOO CURRENT SN
         STW,R5   JOURNAL%VOL       START AT THIS VOLUMN NUMBER
         LW,R5    SNINDEX           TPFILES JOURNAL INDICATOR
         SLS,R5   -16               NUMBER OF JOURNALS ASSIGNED
         LW,R6    SN-1,R5           MOVE THEM TO FPT
         STW,R6   JOURNAL%SN-1,R5
         BDR,R5   %-2
         B        RETURN%SN
*   IF TPFILES IS INACCESSABLE,  ASK THE OPERATOR TO KEY IN THE
*   CURRENT VOLUME SERIAL NUMBERS AND JOURNAL LABEL.
TPFILES%INACCESSABLE EQU %
GET%LBL  EQU      %
         LI,R1    0
         STW,R1   ECB%KEY
         M:KEYIN  (MESS,JOURNALLBL),(REPLY,QJOURNAL%KEY),;
                  (SIZE,17),(ECB,ECB%KEY)
         M:WAIT   1
         LW,R5    ECB%KEY
         BLZ      %-2
         LB,R1    QJOURNAL%KEY
         CI,R1    1                 IF  CR, ASK AGAIN
         BE       GET%LBL
         LB,R2    QJOURNAL%KEY,R1
         CI,R2    X'0D'             IF CARRIAGE RETURN, OR
         BE       GET%LBL2
         CI,R2    X'15'             LINE FEED,
         BNE      GET%LBL3
GET%LBL2 EQU      %
         AI,R1    -1                THROW IT AWAY
GET%LBL3 EQU      %
         LI,R2    1
GET%LBL4 EQU      %
         LB,R3    QJOURNAL%KEY,R2
         CI,R3    X'40'             STOP ON FIRST BLANK
         BE       GOT%LBL
         STB,R3   JOURNAL%NAME,R2
         AI,R2    1
         CW,R2    R1
         BLE      GET%LBL4
GOT%LBL  EQU      %
         AI,R2    -1
         BLEZ     GET%LBL
         STB,R2   JOURNAL%NAME
         AI,R2    4
         SLS,R2   -2
         LI,R1    2
         STB,R2   JOURNAL%NAME-1,R1
         LI,R1    0
         STW,R1   ECB%KEY           INIT ECB
         LI,R6    0
         M:KEYIN  (MESS,FIRST%SN),(REPLY,SN%BUFF),(SIZE,7),(ECB,ECB%KEY)
NEXT%LOOP EQU %
******************************
WAIT%SN  M:WAIT   1                 WAIT 1.2 SECONDS
         LW,R5    ECB%KEY           BIT 0 = 1 IF NOT COMPLETE
         BLZ      WAIT%SN           CONTINUE TO WAIT
         LB,R2    SN%BUFF           SEE WHAT WAS ENTERED
         CI,R2    1                 was it only a cr
         BE       RETURN%SN         YES SO RETURN
         CALL     EDIT%SN
         CALL CONVERT%ANS%SN
         STW,R5   JOURNAL%SN,R6     ONLY DO SIX
         AI,R6    1
         STW,R6   JOURNAL%VOL
         CI,R6    6                 ALLOW ONLY SIX
         BGE      RETURN%SN
         M:KEYIN  (MESS,NEXT%SN),(REPLY,SN%BUFF),(SIZE,7),(ECB,ECB%KEY)
         B        NEXT%LOOP
JOURNALLBL TEXTC  'ENTER JOURNAL LABEL: '
NEXT%SN TEXTC     'ENTER NEXT SERIAL NUMBER'
FIRST%SN TEXTC 'ENTER ALL JRNL SERIAL # USED,START WITH 1ST'
RETURN%SN   RETURN   CURRENT%SN
*****************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  EDIT%SN'
************************************************************************
*   EDIT%SN: EDIT ANS SERIAL NUMBER KEYED IN BY OPERATOR. IF SN IS     *
*   ERRONEOUS, PRINT ERROR MESSAGE AND ASK HIM TO KEY IT IN AGAIN.     *
*   ENTRY : SN%BUFF CONTAINS SN KEYED BY OPERATOR IN TEXTC FORMAT.     *
*   RETURN: SN%BUFF CONTAINS SN IN CORRECT FORMAT.                     *
************************************************************************
EDIT%SN           ENTRY  'EDITED ANS SERIAL NUMBER IS IN SN%BUFF'
TEST%SN  LB,R2    SN%BUFF           R2 = LENGTH OF SN + 1 FOR CR
         AI,R2    -1                ONE LESS FOR CR
         CI,R2    6
         BNE      INVALID%LENGTH    BRANCH IF NOT 6 CHARACTERS LONG
         SPACE
*   TEST NEXT CHARACTER FOR ALPHANUMERIC
TEST%CHAR ;
         LB,R3    SN%BUFF,R2        R3 = NEXT CHARACTER TO TEST
         CI,R3    C'A'
         BL       INVALID%CHAR
         CI,R3    C'I'
         BLE      CHAR%OK           CHARACTER BETWEEN A-I
         CI,R3    C'J'
         BL       INVALID%CHAR
         CI,R3    C'R'
         BLE      CHAR%OK           CHARACTER BETWEEN J-R
         CI,R3    C'S'
         BL       INVALID%CHAR
         CI,R3    C'Z'
         BLE      CHAR%OK           CHARACTER BETWEEN S-Z
         CI,R3    C'0'
         BL       INVALID%CHAR
         CI,R3    C'9'
         BLE      CHAR%OK           CHARACTER BETWEEN 0-9
INVALID%CHAR ;
         M:TYPE   (MESS,INVAL%CHAR%MES)
KEY%AGAIN ;
         LI,R2    0
         STW,R2   ECB%KEY           REINIT ECB
         M:KEYIN  (MESS,KEYSN),(REPLY,SN%BUFF),(SIZE,7),(ECB,ECB%KEY)
WAIT     M:WAIT   1                 WAIT 1.2 SECONDS
         LW,R5    ECB%KEY           BIT 0 = 1 IF STILL NOT POSTED
         BLZ      WAIT              CONTINUE TO WAIT FOR KEYIN
         B        TEST%SN           EDIT NEW SN.
         SPACE
INVALID%LENGTH ;
         M:TYPE   (MESS,WRLENGTH)
         B        KEY%AGAIN
         SPACE
CHAR%OK  BDR,R2   TEST%CHAR         DECREMENT INDEX AND TEST NEXT CHAR
         RETURN   EDIT%SN
****************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  CONVERT%ANS%SN'
************************************************************************
*        CONVERT%ANS%SN
*   CONVERT 6-CHARACTER ANS SERIAL NUMBER TO ONE WORD.                 *
*   ENTRY : SN%BUFF = ANS SERIAL NUMBER IN TEXTC FORMAT.               *
*   RETURN: R5 = CONVERTED SERIAL NUMBER                               *
************************************************************************
         LOCAL    NEXT%ANS%CHAR
CONVERT%ANS%SN                  ;
         ENTRY    'R5 = CONVERTED ANS SN'
         LI,R9    0                 R9 WILL CONTAIN A 6-DIGIT NUMBER
*                                   USING BITS 4-7 OF EACH ANS CHARACTER
         LI,R10   0                 R10 WILL CONTAIN A 12-BIT STRING
*                                   CONCATENATING BITS 2-3 OF EACH
*                                   ANS CHARACTER. BITS 0-1 OF EACH
*                                   ANS CHARACTER ARE THROWN AWAY.
         LI,R12   6                 LOOP 6 TIMES
         LI,R3    1                 R3 = INDEX TO ANS CHARACTER
NEXT%ANS%CHAR ;
         LB,R13   SN%BUFF,R3        R13 = NEXT CHARACTER
         AND,R13  MASKS+4           MASK OFF BITS 0-4
         MI,R9    10
         AW,R9    R13               ADD NEXT DIGIT TO TOTAL
         LB,R13   SN%BUFF,R3
         SLS,13   -4
         AND,13   MASKS+2           MASK OFF BITS 2-3
         SLS,R10  2
         OR,R10   R13               ADD NEXT ZONE BITS TO TOTAL
         AI,R3    1                 INDEX NEXT CHARACTER
         BDR,R12  NEXT%ANS%CHAR
         SLS,R10  20                ZONE STRING IN HIGH ORDER 12 BITS
         OR,R10   R9                DIGITS IN LOW ORDER 24 BITS
         LW,R5    R10
         RETURN   CONVERT%ANS%SN
*******************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  OPNAFTER'
*****************************************************************
*
*                 O P N A F T E R
*
*        OPNAFTER CHECKS THE TPFILES ENTRY FOR TPAFTER TO ENSURE
*        THAT THE FILE MAY BE OVERWRITTEN AND ,IF SO, OPENS
*        F:AFTER.
*
*        INPUT:  TPFILES
*        OUTPUT: F:AFTER IS OPEN IF FILE MAY BE OVERWRITTEN
*        REGISTERS USED: R1-R3 ARE DESTROYED
*        SUBROUTINES CALLED: ADVISE
*        CALLED BY: PREPLOAD
*
*********************************************************************
OPNAFTER    ENTRY    'CHECK TPFILES ENTRY AND OPEN F:AFTER'
         DEBUG    'ENTERING OPNAFTER'
         M:SETDCB F:TPFILES,(ABN,ABNRDTPFILES),(ERR,ABNRDTPFILES)
         M:READ   F:TPFILES,(BUF,AFTERBUF),(SIZE,AFTERSZ);
                  ,(KEY,AFTERKEY);
                  ,(ERR,ERRDTPFILES),(ABN,ABNRDTPFILES)
         LB,R2    AFTERFLAG
         CI,R2    OK%TO%OVERWRITE   RMC
         BNE      AFTER%50
         LW,R13   AFTERHTID
         CALL     CONVERTID
         LI,R1    BAD%AFTER%BUF
         STD,R14  0,R1
         M:TYPE   (MESS,BAD%AFTER%MES)
         M:KEYIN  (MESS,OVRWRT%AFTER),(REPLY,REPBUF);
                  ,(ECB,AFTERECB),(SIZE,3)
AFTER%10 EQU      %
         M:WAIT   1
         LW,R2    AFTERECB
         BLZ      AFTER%10
AFTER%20 EQU      %
         LI,R3    1
         LB,R2    REPBUF,R3
         CI,R2    C'Y'
         BE       AFTER%50
         LI,R2    ERROR17           UNALLOWED TO OVERWRITE
         CALL     ADVISE
AFTER%50 EQU      %
         M:OPEN   F:AFTER,(INOUT),(FILE,'TPAFTER');
                  ,(SAVE);
                  ,(ERR,OPNAFTERERR),(ABN,OPNAFTERABN)
         M:REW    F:AFTER
         DEBUG    'EXITING OPNAFTER'
         RETURN   OPNAFTER
OPNAFTERERR   EQU   %
         M:SNAP   'CHK R10'
         LI,R1    ERROR18           UNEXPECTED ERROR
         CALL     ADVISE
OPNAFTERABN   EQU   %
         LB,R3    R10               GET ABN CODE
         CI,R3    NON%EXIST%CODE
         BE       AFTER%70          OK IF FILE HAS NEVER EXISTED
         LI,R1    ERROR19           UNEXPECTED ABN
         CALL     ADVISE
AFTER%70   EQU   %
         M:OPEN   F:AFTER,(OUT),(SAVE)
         M:WRITE  F:AFTER,(BUF,PRIMER),(SIZE,18)
         M:CLOSE  F:AFTER,(SAVE)
         B        AFTER%50          WRITE DUMMY RECORD AND REOPEN FILE IN UPDATE MODE
ERRDTPFILES   EQU   %
         LI,R1    ERROR24
         CALL     ADVISE
ABNRDTPFILES   EQU   %
         LB,R3    R10               GET ERROR CODE
         CI,R3    NO%SUCH%KEY%CODE
         BE       AFTER%50          CREATION OF FILE
         LI,R1    ERROR25
         CALL     ADVISE
******************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  READJOURNAL'
*******************************************************************
*
*                 R E A D J O U R N A L
*
*        READJOURNAL CHECKS TO ENSURE THAT THE PREVIOUS
*        IO WAS SUCCESSFULLY COMPLETED; THEN SWITCHES THE
*        THE BUFFER NUMBER TO INDICATE THE NEWLY READ-INTO
*        BUFFER AND STARTS THE IO TO FETCH THE NEXT
*        RECORD INTO THE PREVIOUS BUFFER.
*
*        INPUT: BUFFER%NUMBER GIVES THE NUMBER OF THE BUFFER
*                 JUST ANALYZED
*        OUTPUT: BUFFER%NUMBER INDICATES THE BUFFER TO BE ANALYZED
*        REGISTERS USED: R3 IS DESTROYED
*        SUBROUTINES CALLED: ADVISE
*        CALLED BY: PREPLOAD
*
******************************************************************************
READJOURNAL    ENTRY    'CHECK ON IO TO CURRENT BUFFER AND START';
                  ,' IO TO NEXT BUFFER'
         DEBUG    'ENTERING READJOURNAL'
READJ%1  EQU      %
         M:CHECK  F:JOURNAL,(ERR,ERRRDJRNL),(ABN,ABNRDJRNL)
         LW,R3    F:JOURNAL+4       GET JUST READ SIZE IN BYTES
         SLS,R3   -19               JUST READ WORDS
         LI,R4    MAX%REC%SIZE      BUFFER SIZE   RMC
         SW,R4    R3                STARTING LOCATION OF DATA RMC
         MTW,0    BUFFER%NUMBER
         BEZ      HAND%OFF%BUF1
         LI,R5    TRANBUF0          STARTING LOCATION OF BUFFER0
         AW,R5    R4                ADD THE EXTRA SPACE RMC
         STW,R5   BUF0START         SAVE STARTING LOCATION
         MTW,-1   BUFFER%NUMBER
         M:READ   F:JOURNAL,(BUF,TRANBUF1),(REV),;
                  (SIZE,MAX%REC%SIZE**2)
         B        END%READJOURNAL
HAND%OFF%BUF1   EQU   %
         LI,R5    TRANBUF1          STARTING LOC OF BUF1 RMC
         AW,R5    R4                OFFSET
         STW,R5   BUF1START         STARTING LOC OF BUF1 DATA RMC
         MTW,1    BUFFER%NUMBER
         M:READ   F:JOURNAL,(BUF,TRANBUF0),(REV),;
                  (SIZE,MAX%REC%SIZE**2)
END%READJOURNAL   EQU   %
         MTW,1    RECORD%COUNT
         CALL     CALCKSUM          DO CHECKSUM PROCESSING
         LW,R3    ORIG%CHECKSUM     OLD CHECKSUM
         CW,R3    NEW%CHECKSUM      COMPUTED VALUE
         BE       READ%J%EXIT
         LI,R1    ERROR36           CHECKSUM ERROR
         CALL     ADVISE
READ%J%EXIT   EQU   %
         DEBUG    'EXITING READJOURNAL'
         RETURN   READJOURNAL
ERRRDJRNL   EQU   %
         LB,R3    R10               GET ERROR CODE
         CI,R3    IRREC%READ%ERR%CODE
         BE       LOST%TAPE
         M:SNAP   'CHK R10'
         LI,R1    ERROR20
         CALL     ADVISE
LOST%TAPE   EQU   %
         LW,R13   RECORD%COUNT
         CALL     CONVERTID
         STD,R14  REC%MES
         M:TYPE   (MESS,READERROR)
         LI,R1    ERROR26
         CALL     ADVISE
ABNRDJRNL   EQU   %
         LB,R3    R10               GET ABN COE
         CI,R3    BOF%CODE
         BE       END%OF%READ
         M:SNAP   'CHK R10'
         LI,R1    ERROR21
         CALL     ADVISE
END%OF%READ   EQU %
         M:TYPE   (MESS,END%OF%JOURNAL)
         B        CLEANUP           NOTE DIRECT EXIT TO CLEANUP
*************************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  WRITE%JOURNAL'
*****************************************************************
*
*                 W R I T E % J O U R N A L
*
*        WRITE%JOURNAL COPIES THE FILE OF AFTER IMAGES TO THE MOST
*        RECENT VOLUME OF THE COMMON JOURNAL.  IT INITIALIZES THE AFTER
*        RECORD FOR THE ENTRY TO BE WRITTEN TO TPFILES.
*
*        INPUT:  FILE OF AFTER IMAGES CREATED THROUGH F:AFTER
*        OUTPUT: THE AFTER IMAGES ARE WRITEEN TO THE COMMON JOURNAL,
*                 AND THE TPFILES ENTRY REFLECTS THIS, OR
*                 ROUTINE WAS UNABLE TO WRITE THE IMAGES AND FLAGGED
*                 THE AFTER ENTRY OF TPFILES TO GET THE TPG TO DO
*                 THE RESTORE
*        REGISTERS USED:  R1-R5
*        SUBROUTINES CALLED: JOURNAL%PFIL, ADVISE
*        CALLED BY: PREPLOAD
*
********************************************************************
WRITE%JOURNAL    ENTRY    'RESTORE AFTER FILE TO COMMON JOURNAL'
         DEBUG    'ENTERING WRITE%JOURNAL'
         M:SETDCB F:JOURNAL,(ERR,JRNLER1),(ABN,JRNLAB1)
         M:CHECK  F:JOURNAL,(ERR,JRNLER1),(ABN,JRNLAB1)
         LI,R5    0                 SEE IF THERE ARE ANY AFTERS
         LH,R1    TRANPAGE,R5       RMC IF NONE DONT WRITE ON JRNL
         BEZ      NO%AFTERS         RMC
         M:REW    F:AFTER           BACK TO BOF FOR INPUT FIL
         LI,R1    1                 SKIP TO END OF FILE HEADER
         CALL     JOURNAL%PFIL
*                 JOURNAL NOW IN POSITION FOR RESTORE
         M:READ   F:AFTER,(BUF,TRANBUF0),(SIZE,MAX%REC%SIZE**2)
READWRTLOOP   EQU   %
         M:CHECK  F:AFTER,(ERR,RWAFTERER),(ABN,RWAFTERAB)
         LI,R5    8                 PREPARE TO LOOK AT HW 8 OF DCB
         LH,R5    F:AFTER,R5        GET ACTUAL RECORD SIZE
         SLS,R5   -1                RMC  3-14-74
         STW,R5   JRNLSZ0           INIT RECORD SIZE IN WRITE
         M:READ   F:AFTER,(BUF,TRANBUF1),(SIZE,MAX%REC%SIZE**2)
         MTW,0    FIRST%TIME%WRITE  FIRST TIME THROUGH LOOP?
         BNEZ     MORE%THAN%ONCE    NO
         MTW,1    FIRST%TIME%WRITE  NOW IS THE FIRST TIME
         B        EVERY%TIME
MORE%THAN%ONCE   EQU   %
         M:CHECK  F:JOURNAL,(ERR,JRNLER1),(ABN,JRNLAB1)
EVERY%TIME   EQU   %
         M:WRITE  F:JOURNAL,(BUF,TRANBUF0),;
                  (SIZE,*JRNLSZ0)
         M:CHECK  F:AFTER,(ERR,RWAFTERER),(ABN,RWAFTERAB)
         LI,R5    8                 LOOK INTO DCB AGAIN
         LH,R5    F:AFTER,R5
         SLS,R5   -1                RMC 2-29-74
         STW,R5   JRNLSZ1           INIT NEXT WRITE TO JRNL
         M:READ   F:AFTER,(BUF,TRANBUF0),(SIZE,MAX%REC%SIZE**2)
         M:CHECK  F:JOURNAL,(ERR,JRNLER1),(ABN,JRNLAB1)
         M:WRITE  F:JOURNAL,(BUF,TRANBUF1),;
                  (SIZE,*JRNLSZ1)
         B        READWRTLOOP
*                 CLOSE F:AFTER AND F:JOURNAL
END%COPY  EQU   %
         M:CLOSE  F:JOURNAL,(SAVE),(REM)
NO%AFTERS EQU %                     RMC 2-22-74
         M:CLOSE  F:AFTER,(SAVE)
         DEBUG    'EXITING WRITE%JOURNAL'
         RETURN   WRITE%JOURNAL
JRNLER1   EQU   %
         LB,R3    R10               GET ERROR CODE
         CI,R3    IRREC%WRITE%ERR
         BNE      JRNLER2           NOT A WRITE ERROR
         LI,R2    ACTIVEFLAG        SET UP FLAG IN TPAFTER OF TPFILES
*                                   FOR TPG TO RESTORE THE AFTER
*                                   IMAGES TO A NEW JOURNAL WHEN OPENED
         STB,R2   AFTERFLAG
         M:TYPE   (MESS,TPG%SAVE)
         B        END%COPY
JRNLER2  EQU      %
         LI,R1    ERROR22
         CALL     ADVISE
JRNLAB1   EQU   %
         LI,R1    ERROR23
         CALL     ADVISE
RWAFTERER EQU   %
         M:SNAP   'CHK R10'
         LI,R1    ERROR29
         CALL     ADVISE
RWAFTERAB   EQU   %
         LB,R3    R10               PICK UP ERROR CODE
         CI,R3    EOF%CODE
         BE       END%COPY
         M:SNAP   'CHK R10'
         LI,R1    ERROR30
         CALL     ADVISE
****************************************************************
         USECT    @D
IRREC%WRITE%ERR   EQU   X'45'
JRNLSZ0    DATA    0
JRNLSZ1  DATA     0
FIRST%TIME%WRITE   DATA   0
         USECT    @P
         TITLE    'PREPLOAD  VERSION 0  **  CLSFILES'
****************************************************************
*
*                 C L S F I L E S
*
*        CLSFILES WRITES KEY ENTRIES TO TPFILES FOR F:AFTER AND
*        TPIPLIST AND CLOSES TPFILES AND TPIPLIST.
*
*        INPUT: THE RECORDS IN AFTERBUF AND IPBUF ARE READY TO BE
*                 WRITTEN
*        OUTPUT: UPDATED RECORDS ARE WRITTEN TO TPFILES
*        REGISTERS USED: NONE
*        SUBROUTINES CALLED: NONE
*        CALLED BY: PREPLOAD
*
************************************************************************
CLSFILES    ENTRY   'UPDATE ENTRIES TO TPFILES AND CLOSE';
                  ,'TPFILES AND TPIPLIST'
         M:WRITE  F:TPFILES,(BUF,AFTERBUF),(SIZE,AFTERSZ),;
                  (KEY,AFTERKEY),;
                  (ONEWKEY),(WAIT)
         M:WRITE  F:TPFILES,(BUF,IPBUF),(SIZE,IPSZ),;
                  (KEY,IPKEY),;
                  (ONEWKEY),(WAIT)
         M:CLOSE  F:TPFILES,(SAVE)
         M:CLOSE  F:IPLIST,(SAVE)
         DEBUG    'EXITING CLSFILES'
         RETURN   CLSFILES
         TITLE    'PREPLOAD  VERSION 0  **  READTPFILES'
*********************************************************************
*
*                 R  E A D T P F I L E S
*
*        READTPFILES READS THE ENTRIES RELATED TO THE JOURNALS TO
*        GET THE LIST OF THE SERIAL NUMBERS OF THE JOURNAL
*        TAPES AND THE INDEX OF THE VOLUME CURRENTLY (OR MOST RECENTLY)
*        USED.
*
*        INPUT: THE 0000A AND JOURNAL ENTRIES FROM TPFILES
*        OUTPUT:  R5=INDEX INTO THE LIST OF SERIAL NUMBERS IN SN
*        REGISTERS USED:
*        SUBROUTINES USED:
*        CALLED BY: CURRENT%SN
*
***************************************************************************
READTPFILES ;
         ENTRY    'GET THE LIST OF SERIAL NUMBERS AND CURRENT';
                  ,' VOLUME INDEX IN R5'
         DEBUG    'ENTERING READTPFILES'
         M:SETDCB F:TPFILES,(ERR,ERROR%RETURN)  RMC
*   READ IN ZERO RECORD
         M:READ   F:TPFILES,(BUF,ZERO%RECORD),;
                  (SIZE,ZERO%RECORD%SIZE),;
                  (KEY,KEY%ZERO%RECORD),(ABN,ZERO%ABN),(ERR,READ%ERR)
GET%JOURNAL%LBL EQU %
         LB,R4    QJOURNAL%KEY
         AI,R4    1
         LI,R2    BA(QJOURNAL%KEY)
         LI,R3    BA(JOURNAL%NAME)
         STB,R4   R3
         MBS,R2   0
         AI,R4    3
         SLS,R4   -2
         LI,R2    2
         STB,R4   JOURNAL%NAME-1,2
READ%JOURNAL%REC  EQU  %
*
*   READ IN TPFILES JOURNAL RECORD ASSOCIATED WITH QUEUE.
         M:READ   F:TPFILES,(BUF,QJOURNAL%RECORD),;
                  (KEY,QJOURNAL%KEY),(SIZE,JOURNAL%RECORD%SIZE),;
                  (ABN,JOURNAL%ABN),(ERR,READ%ERR)
READ%OK ;
         LCI      0                 CC = 0000 FOR NORMAL RETURN
         B        RETURN%TPF
         SPACE
ZERO%ABN ;                          ABNORMAL RETURN WHILE READING
         LB,R5    SR3               ZERO RECORD.
         CI,R5    BUFF%TOO%SMALL    IF RECORD TOO SMALL FOR BUFFER,
         BE       GET%JOURNAL%LBL
         M:SNAP   'CHK R10'
         LI,R1    ERROR32
         CALL     ADVISE
READ%ERR   EQU   %
         M:SNAP   'CHK R10'
         LI,R1    ERROR31
         CALL     ADVISE
         SPACE
         SPACE
JOURNAL%ABN ;                       ABNORMAL RETURN WHILE READING
         LB,R5    SR3               JOURNAL RECORD
         CI,R5    BUFF%TOO%SMALL    IF RECORD TOO SMALL FOR BUFFER,
         BE       READ%OK           NO PROBLEM.
         B        READ%ERR          BRANCH IF OTHER ERROR.
         SPACE
         SPACE
*   IF UNABLE TO READ THE TPFILES RECORD THAT CONTAINS THE VOLUME
*   SERIAL NUMBERS OF THE JOURNAL, SET CC FOR ERROR RETURN.
ERROR%RETURN ;
         LI,R5    -1                SET SNINDEX=-1 TO INDICATE
         STW,R5   SNINDEX           RECORD NOT READ.
         LCI      1                 CC = 0001
RETURN%TPF   EQU   %
         M:SETDCB F:TPFILES,(ERR,ABNRDTPFILES)
         RETURN   READTPFILES
********************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  JOURNAL%PFIL'
****************************************************************
*
*                 J O U R N A L % P F I L
*
*        INPUT: OPENED JOURNAL VOLUME
*                 R1=1 IF IF FILE IS TO BE POSITIONED FORWARD
*                 R1=-1 IF FILE IS TO BE POSITIONED BACKWARD
*        OUTPUT: FILE IS POSITIONED BEYOND NEXT TAPE MARK IN THE
*                 INDICATED DIRECTION
*        REGISTERS USED: R1
*        SUBROUTINES CALLED: NONE
*        CALLED BY: OPNJOURNAL, VERIFY%HEADER
*
************************************************************************
JOURNAL%PFIL    ENTRY    'POSITION JOURNAL BEYOND NEXT TAPE MARK'
         DEBUG    'ENTERING JOURNAL%PFIL'
         CI,R1    0                 FORWARD OR BACKWARD
         BLZ      PFIL%2
*                 SKIP IN FORWARD DIRECTION
         M:PFIL   F:JOURNAL,(EOF)
END%PFIL   EQU   %
         DEBUG    'EXITING JOURNAL%PFIL'
         RETURN   JOURNAL%PFIL
*                 SKIP IN BACKWARD DIRECTION
PFIL%2   EQU      %
         M:PFIL   F:JOURNAL,(BOF)
         B        END%PFIL
***************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  SUMMARY'
*********************************************************************
*
*                 S U M M A R Y
*
*        SUMMARY LISTS THE TRANSACTION IDS AND
*        NUMBERS OF PAGES FOR EACH AND PRINTS THE MESSAGE
*        TO GO TO THE NEXT PHASE ON THE OPERATOR'S CONSOLE
*
*        INPUT: NONE
*        OUTPUT: MESSAGE TO LISTING AND TO OPERATOR
*        REGISTERS USED: NONE
*        CALLED BY: PREPLOAD'
*
******************************************************************
SUMMARY  ENTRY    'WRITE MESSAGE TO RESTART TP'
         DEBUG    'ENTERING SUMMARY'
         LI,R4    0
SUM%10   EQU      %
         LW,R13   TRANIDSTRT,R4
         CALL     CONVERTID
         STD,R14  ID#BUF
         LH,R13   TRANPAGE,R4
         BEZ      SUM%20
         MTW,1    PAGE%MOD%CNT
SUM%20   EQU      %
*                 DIVIDE THE PAGE COUNT BY 10
         LI,R12   0
         DW,R12   WORD10
         LW,13    R12
         CALL     CONVERTID
         STW,R15  PAGE%CNT%BUF
         M:PRINT  (MESS,SUM%MES)
         AI,R4    1                 RMC
         CW,R4    TRANCNT
         BL       SUM%10
         MTW,0    PAGE%MOD%CNT
         BEZ      SUM%30
         M:TYPE   (MESS,GOTO7)
         B        SUM%40
SUM%30   EQU      %
         M:TYPE   (MESS,GOTO8)
SUM%40   EQU      %
         DEBUG    'EXITING SUMMARY'
         RETURN   SUMMARY
****************************************************************
********************************************************************
         TITLE    'PREPLOAD  VERSION 0  **  ERROR MESSAGES'
***************************************************************
*
*                 ERROR MESSAGES
*
*************************************************************************
ERROR1   TEXTC    'TPIPLIST IS INACTIVE'
ERROR2   TEXTC    'UNEXPECTED ABN ON OPEN OF TPFILES'
ERROR3   TEXTC    'TPFILES DOES NOT EXIST - PLEASE RESTORE'
ERROR4   TEXTC    'UNEXPECTED ERROR ON OPEN OF TPFILES'
ERROR5   TEXTC    'NO TPIPLIST KEY FOUND IN TPFILES'
ERROR6   TEXTC    'TPFILES ALREADY OPEN BY ANOTHER USER'
ERROR7   TEXTC    'UNEXPECTED ABN ON READ OF TPFILES'
ERROR8   TEXTC    'UNEXPECTED ERROR ON READ OF TPFILES'
ERROR9   TEXTC    'UNEXPECTED ABN ON OPEN OF TPIPLIST'
ERROR10  TEXTC    'TPIPLIST IS A NON-EXISTENT FILE'
ERROR11  TEXTC    'UNEXPECTED ERROR ON OPEN OF TPIPLIST'
ERROR12  TEXTC    'NO CTL KEY FOUND IN TPIPLIST'
ERROR13  TEXTC    'UNEXPECTED ABN ON READ OF CTL REC IN TPIPLIST'
ERROR14  TEXTC    'UNEXPECTED ERR ON READ OF CTL REC IN TPIPLIST'
ERROR15  TEXTC    'UNEXPECTED ABN ON WRITE TO TPAFTER'
ERROR16  TEXTC    'UNEXPECTED ERR ON WRITE TO TPAFTER'
ERROR17  TEXTC    'PREPLOAD NOT PERMITTED TO OVERWRITE TPAFTER'
ERROR18  TEXTC    'UNEXPECTED ERROR ON OPEN OF TPAFTER'
ERROR19  TEXTC    'UNEXPECTED ABN ON OPEN OF TPAFTER'
ERROR20  TEXTC    'UNEXPECTED ERROR ON READ OF JOURNAL'
ERROR21  TEXTC    'UNEXPECTED ABN ON READ OF JOURNAL'
ERROR22  TEXTC    'UNEXPECTED WRITE ERROR ON TP JOURNAL'
ERROR23  TEXTC    'UNEXPECTED ABN ON WRITE TO TP JOURNAL'
ERROR24  TEXTC    'UNEXPECTED ERROR ON READ OF TPFILES'
ERROR25  TEXTC    'UNEXPECTED ABN ON READ OF TPFILES'
ERROR26  TEXTC    'UNABLE TO READ FURTHER ON TAPE -',;
                  'IRREC READ ERROR'
ERROR27  TEXTC    'UNEXPECTED ERR ON READ OF TRN REC IN TPIPLIST'
ERROR28  TEXTC    'UNEXPECTED ABN ON READ OF TRN REC IN TPIPLIST'
ERROR29  TEXTC    'UNEXPECTED ERROR ON READ OF TPAFTER'
ERROR30  TEXTC    'UNEXPECTED ABN ON READ OF TPAFTER'
ERROR31  TEXTC    'UNEXPECTED ERR ON READ OF JOURNAL KEY ENTRY';
                  ,' OF TPFILES'
ERROR32  TEXTC    'UNEXPECTED ABN ON READ OF ZERO REC OF TPFILES'
ERROR33  TEXTC    'UNEXPECTED ABN ON READ OF JOURNAL KEY ENTRY ';
                  ,' OF TPFILES'
ERROR34  TEXTC    'HIGHEST TID VALUES DO NOT AGREE'
ERROR35  TEXTC    'DCB RELATED ERR OR ABN RET ON JOURNAL'
ERROR36  TEXTC    'CHECKSUM ERROR ON JOURNAL RECORD'
PATCH    RES      100
F:JOURNAL DSECT 1
F:JOURNAL M:DCB   (ANSLBL,5),(SN,20)
         END      PREPLOAD

