*DECK LFGREFP
USETEXT LFGFET,LFGIOD,LFGFN,LFGIB,LFGWB
PROC LFGREFP(PN,WC,SUCCESS,DIRBUF);
BEGIN # REFORMAT PICB #
*IF DEF,IMS
#
** LFGREFP - REFORMAT PICB.
*
* M. E. VATCHER 81/02/23
*
* LFGREFP REFORMATS A PICB AND WRITES IT TO THE NLF.
*
* PROC LFGREFP(PN,WC,SUCCESS)
*
* ENTRY PN PARTITION NAME
* WC 16 BIT WORD COUNT OF INPUT RECORD
*
* EXIT SUCCESS SUCCESSFUL COMPLETION INDICATOR
*
* METHOD
*
* READ A RECORD
* SAVE CURRENT RANDOM INDEX ON NLF
* PUT PARTITION NAME IN FIRST WORD OF PICB
* PUT NDCB ADDRESS IN SECOND WORD OF PICB
* WHILE THERE ARE STILL DIRECTIVES IN THE INPUT BUFFER
* GET NEXT 64 BIT DIRECTIVE FROM THE INPUT BUFFER
* REFORMAT THE DIRECTIVE
* WRITE PICB TO NLF
* MAKE A DIRECTORY ENTRY FOR THE PICB
* END
*
#
*ENDIF
#
**** PROC LFGREFP - XREF LIST BEGIN.
#
XREF
BEGIN
ITEM IFET U; # FWA OF INPUT FILE FET #
ITEM OUTPUT U; # FWA OF OUTPUT FILE FET #
ITEM WFET U; # FWA OF NLF FET #
PROC LFGMDE; # MAKE DIRECTORY ENTRY #
PROC LFGRDER; # SEND READ ERROR MESSAGE #
PROC LFGRDSR; # READ SEQUENTIAL RECORD #
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
#
****
#
ITEM CODE U; # DIRECTIVE CODE #
ITEM CRI U; # CURRENT RANDOM INDEX ON NLF #
ITEM DIRC U; # DIRECTIVE COUNT #
ITEM ENDS U; #NUMBER OF END DIRECTIVES #
ITEM I U; #LOOP INDEX #
ITEM IBIT U; # CURRENT INPUT BIT IN IBUF #
ITEM IWORD U; # CURRENT INPUT WORD IN IBUF #
ITEM J U; # LOOP INDEX #
ITEM OWORD U; # LAST 60 BITS OF 64 BIT DIRECTIVE #
ITEM PN C(10); # PARTITION NAME #
ITEM STATIS U;
ITEM SUCCESS B;
ITEM TEMPC C(10);
ITEM WC U; # 16 BIT WORD COUNT OF INPUT RECORD #
ARRAY DIRBUF [0:0] S(2); # DIRECTORY BUFFER #
BEGIN
ITEM DIR$ENT I(00,00,60);
END
ARRAY MANYEND [0:0] S(5);
BEGIN
ITEM MANYEND1 C(0,0,45) =
[" TOO MANY END DIRECTIVES ON XXXXXXX FILE NNN."];
ITEM MANYLFN C(2,48,7);
ITEM MANYFILE C(4,6,3);
ITEM MANYZ U(4,30,30) = [ 0 ];
END
ARRAY ILLDIR [0:0] S(5);
BEGIN
ITEM ILLDIR1 C(0,0,47) =
[" BAD DIRECTIVE IN PICB ON XXXXXXX FILE NNN."];
ITEM ILLLFN C(3,0,7);
ITEM ILLFILE C(4,18,3);
ITEM ILLZ U(4,42,18) = [ 0 ];
END
ARRAY FEWEND [0:0] S(6);
BEGIN
ITEM FEWEND1 C(0,0,55) =
[" NOT ENOUGH END DIRECTIVES IN PICB IN XXXXXXX FILE NNN."];
ITEM FEWLFN C(3,48,7);
ITEM FEWFILE C(5,6,3);
ITEM FEWZ U(5,30,30) = [ 0 ];
END
CONTROL EJECT;
PROC REFDUMP(OWORD);
BEGIN
ITEM OWORD U;
B<0,4>WBUF[J] = 0;
B<4,8>WBUF[J] = B<0,4>OWORD;
B<12,24>WBUF[J] = B<4,24>OWORD; # BEGINNING ADDRESS #
B<36,24>WBUF[J] = B<36,24>OWORD; # ENDING ADDRESS #
END
PROC REFLOAD(OWORD);
BEGIN
*CALL LFGASCI
ITEM OWORD U;
ITEM ACHAR U;
WBUF[J] = 0; # CLEAR ENTRY #
B<0,4>WBUF[J] = 1; # LOAD CODE #
ACHAR = B<5,7>OWORD;
B<12,6>WBUF[J] = C<ACHAR,1>ASCIITAB; # CONVERT TO DISPLAY CODE #
ACHAR = B<13,7>OWORD;
B<18,6>WBUF[J] = C<ACHAR,1>ASCIITAB;
ACHAR = B<21,7>OWORD;
B<24,6>WBUF[J] = C<ACHAR,1>ASCIITAB;
ACHAR = B<29,7>OWORD;
B<30,6>WBUF[J] = C<ACHAR,1>ASCIITAB;
ACHAR = B<37,7>OWORD;
B<36,6>WBUF[J] = C<ACHAR,1>ASCIITAB;
ACHAR = B<45,7>OWORD;
B<42,6>WBUF[J] = C<ACHAR,1>ASCIITAB;
END
PROC REFSTART(OWORD);
BEGIN
ITEM OWORD U;
B<0,4>WBUF[J] = 2; # START CODE #
B<4,8>WBUF[J] = B<0,4>OWORD;
B<12,48>WBUF[J] = 0;
END
PROC REFSNCB(OWORD);
BEGIN # REFORMAT SEND NCB DIRECTIVE #
ITEM OWORD U;
B<0,4>WBUF[J] = 5; # SEND NCB CODE #
B<4,8>WBUF[J] = 0;
B<12,24>WBUF[J] = B<4,24>OWORD; # BEGINNING ADDRESS #
B<36,8>WBUF[J] = 0;
B<44,16>WBUF[J] = B<44,16>OWORD; # SIZE OF NCB #
END
PROC REFOTHER(CODE);
BEGIN # REFORMAT OTHER KIND OF DIRECTIVE #
ITEM CODE U;
B<0,4>WBUF[J] = CODE;
B<4,56>WBUF[J] = 0;
END
CONTROL EJECT;
PROC GN64B(CODE,OWORD);
BEGIN # GET NEXT 64 BITS #
ITEM BITCOUNT U;
ITEM CODE U;
ITEM OBIT U;
ITEM OWORD U;
CODE = 0;
OWORD = 0;
B<56,4>CODE = B<IBIT,4>IBUF[IWORD]; # GET FIRST FOUR BITS #
IBIT = IBIT + 4;
BITCOUNT = 4; #NUMBER OF BITS TRANSFERRED #
IF IBIT EQ 60
THEN # GO ON TO NEXT INPUT WORD #
BEGIN
IBIT = 0;
IWORD = IWORD + 1;
END
# GET BITS UNTIL INPUT WORD BOUNDARY #
B<0,60 - IBIT>OWORD = B<IBIT,60 - IBIT>IBUF[IWORD];
OBIT = 60 - IBIT; # SAVE TO GET BITS FROM NEXT INPUT WORD #
BITCOUNT = BITCOUNT + 60 - IBIT;
IBIT = 0;
IWORD = IWORD + 1;
IF BITCOUNT EQ 64
THEN
RETURN; # ***** EXIT ***** #
# GET REST OF BITS FROM NEXT INPUT WORD #
B<OBIT,64-BITCOUNT>OWORD = B<0,64 - BITCOUNT>IBUF[IWORD];
IBIT = 64 - BITCOUNT;
END
CONTROL EJECT; # REFPICB CODE STARTS HERE #
SUCCESS = TRUE;
ENDS = 0;
IBIT = 0;
IWORD = 0;
LFGRDSR(LOC(IFET),STATIS); # READ PICB #
IF STATIS NQ RDEOR AND STATIS NQ RDBFULL
THEN
BEGIN
LFGRDER(STATIS);
SUCCESS = FALSE;
RETURN; # ***** EXIT ***** #
END
P<SIOFET> = WFET;
CRI = FETCRI[0]; # SAVE CURRENT RANDOM INDEX ON NLF #
FETOUT[0] = FETFST[0]; # FETIN IS SET LATER #
B<0,36>WBUF[0] = B<0,36>PN; # PUT IN VARIANT NAME #
B<36,24>WBUF[0] = 0;
B<0,36>WBUF[1] = 0;
GN64B(CODE,OWORD);
B<36,24>WBUF[1] = B<36,24>OWORD; # PUT IN NDCB ADDRESS #
B<0,24>WBUF[2] = "DPCB"; # DPCB HEADER #
B<24,36>WBUF[2] = 0;
DIRC = WC/4 - 1; # NUMBER OF DIRECTIVES #
J = 3;
FOR I = 1 STEP 1 UNTIL DIRC DO
BEGIN
GN64B(CODE,OWORD); # GET NEXT 64 BITS #
IF CODE EQ 0
THEN
REFDUMP(OWORD);
ELSE IF CODE EQ 1
THEN
REFLOAD(OWORD);
ELSE IF CODE EQ 2
THEN
REFSTART(OWORD);
ELSE IF CODE EQ 5
THEN
REFSNCB(OWORD);
ELSE IF CODE EQ 4 OR CODE EQ 6
THEN
REFOTHER(CODE);
ELSE IF CODE EQ 15
THEN
BEGIN
ENDS = ENDS + 1;
IF ENDS GQ 4
THEN # TOO MANY END DIRECTIVES #
BEGIN
TEMPC = XSFW(FNAME[LFN]);
MANYLFN[0] = C<0,7>TEMPC;
TEMPC = XCDD(FILENUM);
MANYFILE[0] = C<7,3>TEMPC; # SET FILE NUMBER IN MESSAGE #
WRITEC(OUTPUT,MANYEND);
WRITER(OUTPUT,"R"); # SEND MESSAGE TO OUTPUT #
SUCCESS = FALSE;
RETURN; # ***** EXIT ***** #
END
REFOTHER(CODE);
IF ENDS EQ 1
THEN # END OF DPCB #
BEGIN
J = J + 1;
B<0,24>WBUF[J] = "LPCB"; # PUT IN LPCB HEADER #
B<24,36>WBUF[J] = 0;
B<24,12>WBUF[1] = J - 2; # SAVE DPCB LENGTH #
END
ELSE IF ENDS EQ 2
THEN # END OF LPCB #
BEGIN
J = J + 1;
B<0,24>WBUF[J] = "SPCB";
B<24,36>WBUF[J] = 0;
B<12,12>WBUF[1] = J - 2 - B<24,12>WBUF[1]; # LPCB LENGTH #
END
ELSE IF ENDS EQ 3
THEN # FILL IN SPCB LENGTH #
BEGIN
B<0,12>WBUF[1] = J - 1 - B<12,12>WBUF[1]
- B<24,12>WBUF[1]; # LENGTH OF SPCB #
END
END
ELSE
BEGIN # ILLEGAL DIRECTIVE CODE #
TEMPC = XSFW(FNAME[LFN]);
ILLLFN[0] = C<0,7>TEMPC;
TEMPC = XCDD(FILENUM);
ILLFILE[0] = C<7,3>TEMPC;
WRITEC(OUTPUT,ILLDIR);
WRITER(OUTPUT,"R"); # SEND MESSAGE TO OUTPUT #
SUCCESS = FALSE;
RETURN; # ***** EXIT ***** #
END
J = J + 1;
END #GET NEXT 64 BITS #
IF ENDS LQ 2
THEN # NOT ENOUGH END DIRECTIVES #
BEGIN
TEMPC = XSFW(FNAME[LFN]);
FEWLFN[0] = C<0,7>TEMPC;
TEMPC = XCDD(FILENUM);
FEWFILE[0] = C<7,3>TEMPC;
WRITEC(OUTPUT,FEWEND);
WRITER(OUTPUT,"R");
SUCCESS = FALSE;
RETURN; # ***** EXIT ***** #
END
FETIN[0] = FETFST[0] + DIRC + 5;
WRITER(SIOFET,"R");
LFGMDE(PN,CRI,DIRC + 5,SUCCESS,DIRBUF);
END TERM