Retro1.org codex

*DECK LFGMAIN 
USETEXT LFGDIR,LFGIOD,LFGDB,LFGFN 
      PROC LFGMAIN; 
      BEGIN 
*IF DEF,IMS 
# 
**    LFGMAIN - LFG MAIN ROUTINE
* 
*     M. E. VATCHER  81/02/18 
* 
*     THIS PROC CONTAINS THE LFG MAIN LOOP.  EACH INPUT FILE ON THE 
*     LFG CONTROL CARD IS PROCESSED.
* 
*     PROC LFGMAIN
* 
*     ENTRY  NONE.
* 
*     EXIT  NONE. 
* 
*     METHOD
* 
*     FOR EACH INPUT FILE ON THE LFG CONTROL CARD 
*       FOR EACH FILE IN THIS LFN (WHILE NOT EOI) 
*         GET LOAD PARTITION NAME AND TYPE
*         WHILE NOT END OF PARTITION (EOP)
*           READ A HEADER RECORD
*           IF IT IS A PICB 
*           THEN
*             REFORMAT PICB 
*             BREAK OUT OF "WHILE NOT EOP" LOOP 
*           FILL READ BUFFER
*           WHILE NOT EOR 
*             READW TO WORKING BUFFER 
*             MOVE AND SHIFT WORDS TO WORKING BUFFER FOR WRITE
*             CALCULATE CHECKSUM
*             ADD SM HEADER AND WRITE MESSAGE TO NLF
*         SEND SUMMARY LISTING LINE 
*         SKIP TRAILER RECORDS
*     WRITE DIRECTORY 
* 
# 
*ENDIF
 
# 
****  PROC LFGMAIN - XREF LIST BEGIN. 
# 
 
      XREF
        BEGIN 
        ITEM IFET U;         # INPUT FILE FET                          #
        ITEM NLF U;          # NETWORK LOAD FILE FET                   #
        ITEM OUTPUT U;       # FWA OF OUTPUT FILE FET                  #
 
        PROC LFGCKSM;        # COMPUTE CHECKSUM                        #
        PROC LFGCRAK;        # CRACK CONTROL CARD                      #
        PROC LFGGFN;         # GET FILE NAMES FOR REFORMATTING         #
        PROC LFGGPN;         # GET PARTITION NAME                      #
        PROC LFGHDRW;        # ADD SM HEADER AND WRITE TO NLF          #
        PROC LFGLHDR;        # SEND SUMMARY LISTING HEADER             #
        PROC LFGMOVW;        # MOVE AND SHIFT 16 BIT WORDS             #
        PROC LFGNLFH;        # WRITE HEADER RECORD TO NLF              #
        PROC LFGRDER;        # READ ERROR PROCESSOR                    #
        PROC LFGRDHR;        # READ HEADER RECORD                      #
        PROC LFGRDSR;        # READ SEQUENTIAL RECORD                  #
        PROC LFGREFP;        # REFORMAT PICB                           #
        PROC LFGSKIP;        # SKIP TRAILER RECORDS                    #
        PROC LFGSSLL;        # SEND SUMMARY LISTING LINE               #
        PROC LFGWRD;         # WRITE DIRECTORY TO NLF                  #
        PROC MESSAGE;        # SEND MESSAGE TO DAYFILE                 #
        PROC READW;          # READ WORDS FROM CIO BUFFER              #
        PROC WRITEC;         # WRITE LINE TO CIO BUFFER                #
        PROC WRITER;         # WRITE RECORD                            #
        FUNC XCDD C(10);     # CONVERT INTEGER TO DECIMAL DISPLAY CODE #
        FUNC XSFW C(10);     # SPACE FILL WORD                         #
        END 
 
# 
****
# 
 
      DEF DEF$BC # 64 #;     # DEFAULT BATCH COUNT VALUE               #
      DEF SYSLOC # 0 #; # MESSAGE TO SYSTEM AND LOCAL DAYFILES         #
 
      CONTROL PRESET; 
      CONTROL NOLIST;        # LFGSTAN COMMON DECK                     #
*CALL LFGSTAN 
      CONTROL LIST; 
 
      ITEM BEGADDR U;        # BEGINNING ADDRESS                       #
      ITEM BPOS U;           # BIT POSITION COUNTED FROM LEFT          #
      ITEM CKSM U;           # CHECKSUM                                #
      ITEM EOI B;            # END OF INFORMATION INDICATOR            #
      ITEM EOP B;            # END OF PARTITION INDICATOR              #
      ITEM FRST$REC B;       # FLAG INDICATING 1ST RECORD IN PARTITION #
      ITEM FOUTR B;          # FIRST OUTPUT RECORD OF PARTITION        #
      ITEM I U;              # LOOP INDEX                              #
      ITEM IW60 U;           # NUMBER OF 60 BIT WORDS MOVED            #
      ITEM J U;              # LOOP INDEX                              #
      ITEM K U;              # LOOP INDEX                              #
      ITEM LPAK U;           # 16 BIT WORDS IN LAST PACKET             #
      ITEM MRES B;           # MEMORY RESIDENT INDICATOR               #
      ITEM NP B;             # NEW PARTITION INDICATOR                 #
      ITEM NPAK U;           # NUMBER OF PACKETS (MESSAGES)            #
      ITEM NWDS16 U;         # 16 BIT WORDS IN CURRENT PACKET          #
      ITEM ON U;             # OVERLAY NAME IN ASCII                   #
      ITEM PICBF B;          # PICB FLAG                               #
      ITEM PN C(6);          # PARTITION NAME                          #
      ITEM PRC U;            # PARTITION RECORD COUNT                  #
      ITEM RC U;             # INPUT RECORD COUNT                      #
      ITEM STATIS;
      ITEM SUCCESS B; 
      ITEM TEMP C(10);
      ITEM WC U;             # WORD COUNT OF 16 BIT WORDS              #
      ITEM WPOS;             # WORD POSITION FOR SHIFTING              #
 
      ARRAY LFGCOMP [0:0] S(2); 
        BEGIN 
        ITEM LFGCOMP1 C(0,0,14) = 
          [" LFG COMPLETE."]; 
        ITEM LFGCOMPZ U(1,24,36) = [ 0 ]; 
        END 
 
      ARRAY MEMIN [0:27] S(1);
        BEGIN 
        ITEM INBUF U; 
        END 
 
      CONTROL EJECT;
      PROC ERRCHECK(SUCCESS); 
      BEGIN 
 
      XREF
        BEGIN 
        PROC ABORT; 
        PROC MESSAGE; 
        END 
 
      ITEM SUCCESS B; 
 
      ARRAY LFGERR [0:0] S(2);
        BEGIN 
        ITEM LERR C(0,0,12) = [" LFG ERRORS."]; 
        ITEM LZ U(1,12,48) = [ 0 ]; 
        END 
 
      IF NOT SUCCESS
      THEN
        BEGIN 
        MESSAGE(LFGERR,SYSLOC); # *LFG ERRORS.*                        #
        ABORT;
 
        END 
      END 
      CONTROL EJECT;         # LFGMAIN CODE STARTS HERE                #
      BC$VAL = DEF$BC;       # SET DEFAULT BATCH COUNT VALUE           #
      FIRST$PAGE = TRUE;     # SET FIRST PAGE FLAG                     #
      LFGCRAK;
      LFGNLFH;               # WRITE HEADER RECORD TO NLF              #
      LFGGFN(FN,NUMIFILE);   # GET FILE NAMES                          #
 
#     INITIALIZE DIRECTORY                                             #
 
      P<DIR> = LOC(DIRB$WORD[0]) + 15;
      DIR$ID[0] = DIR$IDENT;  # SET DIRECTORY IDENTIFIER               #
      DIR$ZERO[0] = 0;
      DIR$FID[0] = "NLF"; 
      DIR$WC[0] = 0;         # INITIALIZE DIRECTORY LENGTH             #
 
#     SEND SUMMARY LISTING HEADER                                      #
 
      PAGEN = 1;             # INITIALIZE PAGE NUMBER                  #
      PARTNUM = 0;           # CLEAR PARTITION COUNT                   #
      LFGLHDR(SUM$LST); 
 
#     LFG MAIN LOOP                                                    #
 
      FOR LFN = 1 STEP 1 UNTIL NUMIFILE DO
        BEGIN 
        FOR I = 1 STEP 1 UNTIL LFN - 1 DO 
          BEGIN              # SKIP OVER DUPLICATE FILE NAMES          #
          IF FNAME[I] EQ FNAME[LFN] 
          THEN
            TEST LFN; 
 
          END 
        C<0,7>IFET = C<0,7>FNAME[LFN]; # PUT FILE NAME IN FET          #
        EOI = FALSE;
        FOR FILENUM = 1 STEP 1 WHILE NOT EOI DO 
          BEGIN 
          LFGGPN(PN,RC,MRES,ON,EOI,SUCCESS); # GET PARTITION NAME      #
          ERRCHECK(SUCCESS);
          IF EOI
          THEN
            TEST FILENUM; 
 
          EOP = FALSE;       # NOT END OF PARTITION                    #
          FRST$REC = TRUE;   # FIRST RECORD IN PARTITION               #
          FOUTR = TRUE;      # FIRST OUTPUT RECORD, CLEARED BY HDRWRT  #
          NP = TRUE;         # THIS IS A NEW PARTITION                 #
          FOR I = 1 STEP 1 WHILE NOT EOP DO 
            BEGIN            # WHILE NOT END OF PARTITION              #
            LFGRDHR(PICBF,WC,BEGADDR,SUCCESS); # READ HEADER RECORD    #
            ERRCHECK(SUCCESS);
            IF PICBF AND FRST$REC 
            THEN             # THIS IS A PICB                          #
              BEGIN 
              LFGREFP(PN,WC,SUCCESS,DIR); 
              ERRCHECK(SUCCESS);
              PRC = 1;       # ONLY ONE RECORD IN PICB                 #
              EOP = TRUE; 
              TEST I; 
 
              END 
            FRST$REC = FALSE;          # CLEAR FIRST RECORD FLAG       #
            LFGRDSR(LOC(IFET),STATIS);
            IF STATIS NQ RDEOR AND STATIS NQ RDBFULL
            THEN
              BEGIN 
              LFGRDER(STATIS);
              SUCCESS = FALSE;
              ERRCHECK(SUCCESS); # ***** ABORT *****                   #
 
              END 
            NPAK = WC/105;   # CALCULATE NUMBER OF MESSAGES            #
            LPAK = WC - 105*NPAK; # 16 BIT WORDS IN LAST MESSAGE       #
            IF LPAK NQ 0
            THEN
              NPAK = NPAK + 1;
            NWDS16 = 105; 
            FOR J = 1 STEP 1 UNTIL NPAK DO
              BEGIN 
              IF J EQ NPAK AND LPAK NQ 0
              THEN           # LAST MESSAGE FROM THIS INPUT RECORD     #
                NWDS16 = LPAK;
              READW(IFET,MEMIN,28,STATIS);
              LFGCKSM(LOC(MEMIN),59,NWDS16,CKSM); 
              IF MRES 
              THEN
                BEGIN 
                BPOS = 36;   # BIT POSITION COUNTED FROM THE LEFT      #
                WPOS = 2;    # WORD POSITION OF DATA IN MESSAGE        #
                END 
              ELSE           # OVERLAY                                 #
                BEGIN 
                BPOS = 4;    # BIT POSITION                            #
                WPOS = 2;    # WORD POSITION                           #
                END 
              LFGMOVW(0,WPOS,BPOS,NWDS16,IW60,CKSM,MEMIN);
              IF I EQ RC AND J EQ NPAK
              THEN           # LAST MESSAGE OF PARTITION               #
                EOP = TRUE; 
              LFGHDRW(PN,PN,IW60,NWDS16,NP,MRES,EOP,BEGADDR,PRC,SUCCESS,
                     ON,J,NPAK,BC$VAL,DIR); 
              ERRCHECK(SUCCESS);
              END            # GET NEXT 28 WORDS                       #
            END              # GET NEXT HEADER RECORD                  #
          LFGSSLL(PN,PRC);      # SEND SUMMARY LISTING LINE            #
          LFGSKIP;           # SKIP TRAILER RECORDS                    #
          END                # GET NEXT PARTITION NAME                 #
        END                  # GET NEXT LFN                            #
      LFGWRD;                # WRITE DIRECTORY TO NLF                  #
      IF LISTFLG             # IF LISTING IS REQUESTED                 #
      THEN
        BEGIN 
        WRITER(OUTPUT);      # FLUSH CIO BUFFER FOR OUTPUT FILE        #
        END 
      MESSAGE(LFGCOMP,SYSLOC); # *LFG COMPLETE.*                       #
      END TERM