*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