&PL      PROC  &P,8                                                     PUB00010
PUB      NAME  0                                                        PUB00020
PUBCNT   NAME  1                                                        PUB00030
         DO    0                                                        PUB00040
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *  PUB00050
*                                                                    *  PUB00060
*   THE FOLLOWING PROGRAMS ARE THE SOLE PROPERTY OF SPERRY           *  PUB00070
*                                                                    *  PUB00080
* UNIVAC CONTAINING ITS PROPRIETARY, CONFIDENTIAL INFORMATION        *  PUB00090
*                                                                    *  PUB00100
* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *  *  PUB00110
         ENDO                                                           PUB00120
         GBL   &NUM,&CRNTTRL,&CRNTPUB                                   PUB00130
         GBL   &TYPE,&FEATS                                             PUB00140
         GBL   &DEVA,&DEV2,&CHN1,&CHN2,&MODE                            PUB00150
         GBL   &DEFPRT,&DEFRDR,&DEFCNL                                  PUB00160
         GBL   &IQ$IDA,&IQ$SEL1,&IQ$SEL2                                PUB00170
         GBL   &IQ$IPC0,&IQ$IPC1,&IQ$IPC2,&IQ$IPC3                      PUB00180
         GBL   &IQ$IPC4,&IQ$IPC5,&IQ$IPC6,&IQ$IPC7                      PUB00190
         GBL   &IQ$MUX0,&IQ$MUX1,&IQ$MUX2,&IQ$MUX3                      PUB00200
         GBL   &IQ$MUX4,&IQ$MUX5,&IQ$MUX6,&IQ$MUX7                      PUB00210
         GBL   &IQ$ADP0,&IQ$ADP1,&IQ$ADP2,&IQ$ADP3                      PUB00213
         GBL   &IQ$ADP4,&IQ$ADP5,&IQ$ADP6,&IQ$ADP7
         GBL   &GS$73LC,&GS$70LC,&GS$68LC,&GS$76LC                      PUB00215
         GBL   &GS$73VF,&GS$70VF,&GS$68VF,&GS$76VF,&GS$93VF
         GBL   &PUBLNG,&PUBTLNG                                         PUB00220
         GBL   &GS$TLCK,&GS$ERLG                                        PUB00230
         GBL   &GS$BLNM                                                 PUB00235
         GBL   &GS$MIN                                                  PUB00240
         LCL   &X,&ERR,&RPEATCT                                         PUB00250
         LCL   &Y                                                       PUB00255
         DO    0                                                        PUB00260
*        PUB   TYPE,FEATURES,DEVA,CHN1,DEV2,CHN2,MODE,ALT               PUB00270
*        PUBCNT  NUM                                                    PUB00280
         ENDO                                                           PUB00290
&PUBLNG  SET   32                       PUB LENGTH                      PUB00300
&PUBTLNG SET   24                       PUB TRAILER LENGTH              PUB00310
         DO    0                                                        PUB00320
*                                                                       PUB00330
***      INITIALIZE PUB GENERATION (PUBCNT)                             PUB00340
*                                                                       PUB00350
         ENDO                                                           PUB00360
         DO    &P(0)=1                                                  PUB00370
&NUM     SET   &P(1)                                                    PUB00380
         DO    &GS$MIN=0                                                PUB00390
&NUM     SET   &NUM+1                   ALLOW FOR CHECKSUM PUB          PUB00400
         ENDO                                                           PUB00410
&CRNTTRL SET   0                                                        PUB00420
&CRNTPUB SET   0                                                        PUB00430
&DEFPRT  SET   0                                                        PUB00440
&DEFRDR  SET   0                                                        PUB00450
&DEFCNL  SET   0                                                        PUB00460
&IQ$IDA  SET   0                                                        PUB00470
&IQ$SEL1 SET   0                                                        PUB00480
&IQ$SEL2 SET   0                                                        PUB00490
&IQ$IPC0 SET   0                                                        PUB00500
&IQ$IPC1 SET   0                                                        PUB00510
&IQ$IPC2 SET   0                                                        PUB00520
&IQ$IPC3 SET   0                                                        PUB00530
&IQ$IPC4 SET   0                                                        PUB00540
&IQ$IPC5 SET   0                                                        PUB00550
&IQ$IPC6 SET   0                                                        PUB00560
&IQ$IPC7 SET   0                                                        PUB00570
&IQ$MUX0 SET   0                                                        PUB00580
&IQ$MUX1 SET   0                                                        PUB00590
&IQ$MUX2 SET   0                                                        PUB00600
&IQ$MUX3 SET   0                                                        PUB00610
&IQ$MUX4 SET   0                                                        PUB00620
&IQ$MUX5 SET   0                                                        PUB00630
&IQ$MUX6 SET   0                                                        PUB00640
&IQ$MUX7 SET   0                                                        PUB00650
&IQ$ADP0 SET   0                                                        PUB00655
&IQ$ADP1 SET   0
&IQ$ADP2 SET   0
&IQ$ADP3 SET   0
&IQ$ADP4 SET   0
&IQ$ADP5 SET   0
&IQ$ADP6 SET   0
&IQ$ADP7 SET   0
         EJECT                                                          PUB00660
*********************************************************************** PUB00670
*                                                                     * PUB00680
*        PHYSICAL UNIT BLOCKS (PUBS)                                  * PUB00690
*                                                                     * PUB00700
*********************************************************************** PUB00710
*                                                                       PUB00720
SM$PUBS  CSECT                                                          PUB00730
*                                                                       PUB00740
         EXTRN IO$IDA,IO$IPC,IO$SEL,IO$MUX                              PUB00750
         EXTRN IN$IDA,IN$IPC,IN$SEL,IN$MUX                              PUB00760
*                                                                       PUB00770
IP$PUBS  DS    0F                                                       PUB00780
IP$NUM   EQU   &NUM                     NO. OF PUBS                     PUB00790
IP$PUBTS EQU   IP$PUBS+&NUM*IP$LNGTH    AD. OF PUB TRAILERS             PUB00800
         GOTO  .PUBEND                                                  PUB00810
         ENDO                                                           PUB00820
.*                                                                      PUB00830
.*       SET UP REPEAT COUNT FOR VIRTUAL PUB'S (SPECIFIED IN P(4))      PUB00840
.*                                                                      PUB00850
&RPEATCT SET   1                                                        PUB00860
         DO    ('&P(3)'='VIRTUAL')**('&P(4)'=''=0)                      PUB00870
&RPEATCT SET   &P(4)                                                    PUB00880
         ENDO                                                           PUB00890
.*                                                                      PUB00900
.PUBNEW  LABEL                                                          PUB00910
&TYPE    SET   0                                                        PUB00920
&FEATS   SET   0                                                        PUB00930
&DEVA    SET   0                                                        PUB00940
&CHN1    SET   0                                                        PUB00950
&DEV2    SET   0                                                        PUB00960
&CHN2    SET   0                                                        PUB00970
&MODE    SET   0                                                        PUB00980
         DO    '&P(2)'=''=0                                             PUB00990
&FEATS   SET   &P(2)                                                    PUB01000
         ENDO                                                           PUB01010
         DO    ('&P(4)'=''=0)**('&P(3)'='VIRTUAL'=0)                    PUB01020
&CHN1    SET   &P(4)                                                    PUB01030
         ENDO                                                           PUB01040
         DO    '&P(5)'=''=0                                             PUB01050
&DEV2    SET   &P(5)                                                    PUB01060
         ENDO                                                           PUB01070
         DO    '&P(6)'=''=0                                             PUB01080
&CHN2    SET   &P(6)                                                    PUB01090
         ENDO                                                           PUB01100
         DO    '&P(7)'=''=0                                             PUB01110
&MODE    SET   &P(7)                                                    PUB01120
         ENDO                                                           PUB01130
         DO    0                                                        PUB01140
*                                                                       PUB01150
*                                       (ALT NOT CURRENTLY PROCESSED)   PUB01160
*                                                                       PUB01170
***      VALIDITY CHECKS                                                PUB01180
*              IF BAD CALL - LEAVE GAP SO PUB COUNT WILL BE             PUB01190
*                   CORRECTLY MAINTAINED. USER CAN PATCH, IF DESIRED.   PUB01200
*                                                                       PUB01210
         ENDO                                                           PUB01220
&ERR     SET   0                                                        PUB01230
         DO    0                                                        PUB01240
*                                       DON'T ALLOW TOO MANY PUBS       PUB01250
         ENDO                                                           PUB01260
         DO    (&CRNTPUB<(&NUM*&PUBLNG))=0                              PUB01270
         PNOTE *,'INVALID PUB CALL - CHECK PUBCNT CARD'                 PUB01280
         GOTO  .PUBEND                                                  PUB01290
         ENDO                                                           PUB01300
         DO    0                                                        PUB01310
*                                       MAKE SURE 'TYPE' SPECIFIED      PUB01320
         ENDO                                                           PUB01330
         DO    '&P(1)'=''=0                                             PUB01340
&TYPE    SET   &P(1)                                                    PUB01350
         ENDO                                                           PUB01360
         DO    '&P(1)'=''                                               PUB01370
         PNOTE *,'DEVICE TYPE NOT SPECIFIED'                            PUB01380
&ERR     SET   1                                                        PUB01390
         ENDO                                                           PUB01400
         DO    0                                                        PUB01410
*                                       MAKE SURE 'DEVA' SPECIFIED      PUB01420
         ENDO                                                           PUB01430
         DO    ('&P(3)'=''=0)*('&P(3)'='VIRTUAL'=0)                     PUB01440
&DEVA    SET   &P(3)                                                    PUB01450
         ENDO                                                           PUB01460
         DO    '&P(3)'=''                                               PUB01470
         PNOTE *,'DEVICE ADDRESS NOT SPECIFIED'                         PUB01480
&ERR     SET   1                                                        PUB01490
         ENDO                                                           PUB01500
         DO    0                                                        PUB01510
*                                       CHAN. NO. MUST BE 0,1,3,4, OR 6 PUB01520
         ENDO                                                           PUB01530
         DO    (&CHN1=0)+(&CHN1=1)+(&CHN1=3)+(&CHN1=4)+(&CHN1=6)=0      PUB01540
         PNOTE *,'INVALID CHANNEL ADDRESS'                              PUB01550
&ERR     SET   1                                                        PUB01560
         ENDO                                                           PUB01570
         DO    0                                                        PUB01580
*                                       IF ANY ERRORS, LEAVE GAP        PUB01590
         ENDO                                                           PUB01600
         DO    &ERR>0                                                   PUB01610
         GOTO  .PUBNXT                                                  PUB01620
         ENDO                                                           PUB01630
         DO    0                                                        PUB01640
*                                                                       PUB01650
***      SUMMARY OF PUB POINTERS                                        PUB01660
*                                                                       PUB01670
*  CHN1 DEVA *   GLOBAL       IP$QUE       IP$EPS       IP$EPI          PUB01680
*  ____________________________________________________________         PUB01690
*    0   XY  *  IQ$IPC.&Y    IT$IPC.&Y     IO$IPC       IN$IPC          PUB01700
*    1   XY  *  IQ$MUX.&X    IT$MUX.&X     IO$MUX       IN$MUX          PUB01710
*    3   XY  *  IQ$IDA       IT$IDA        IO$IDA       IN$IDA          PUB01720
*    4   XY  *  IQ$SEL1      IT$SEL1       IO$SEL       IN$SEL          PUB01730
*    6   XY  *  IQ$SEL2      IT$SEL2       IO$SEL       IN$SEL          PUB01740
*                                                                       PUB01750
***      GENERATE PHYSICAL UNIT BLOCK                                   PUB01760
*                                                                       PUB01770
         ENDO                                                           PUB01780
*                                                                       PUB01790
SM$PUBS  CSECT                                                          PUB01800
         ORG   IP$PUBS+&CRNTPUB                                         PUB01810
         DO    (&TYPE/256=X'04')*(&DEFPRT=0)                            PUB01820
IP$PBPRT EQU   *                                                        PUB01830
&DEFPRT  SET   1                                                        PUB01840
         ENDO                                                           PUB01850
         DO    &DEFRDR=0                                                PUB01860
         DO    (&TYPE/256=8)++((&TYPE/256=2)**(&FEATS**X'04'>0))        PUB01870
IP$PBRDR EQU   *                                                        PUB01880
&DEFRDR  SET   1                                                        PUB01890
         ENDO                                                           PUB01900
         ENDO                                                           PUB01910
         DO    (&DEVA=0)*(&CHN1=0)*(&DEFCNL=0)                          PUB01920
IP$PBCNL EQU   *                                                        PUB01930
&DEFCNL  SET   1                                                        PUB01940
         ENDO                                                           PUB01950
&X       SET   '&PL.        '(1,8)                                      PUB01960
.*                                                                      PUB01970
.***     VIRTUAL PUB GENERATION                                         PUB01980
.*             (IF PUB LENGTH CHANGES, MUST FIX UP HERE ALSO)           PUB01990
.*                                                                      PUB02000
         DO    '&P(3)'='VIRTUAL'                                        PUB02010
&X DC    XL4'FFFFFFFF'                  VIRTUAL PUB INDICATOR           PUB02020
         DC    2F'0'                                                    PUB02030
         DC    Y(&TYPE)                 DEVICE / SUB-TYPE               PUB02040
         DC    Y(&FEATS)                FEATURES                        PUB02050
         DC    3F'0'                                                    PUB02060
         DC    AL3(0)                                                   PUB02070
&X       SET   &CRNTPUB/&PUBLNG+1                                       PUB02080
         DC    AL1(&X)                  PUB NO. FOR JOB ACCT.           PUB02090
         GOTO  .PUBDON                                                  PUB02100
         ENDO                                                           PUB02110
&X DC    YL1(&CHN2)                     CO-CHANNEL AD.                  PUB02120
         DC    YL1(&DEV2)               CO-DEVICE AD.                   PUB02130
         DO    (&TYPE=X'0808')++(&TYPE=X'0408')++(&TYPE=X'0208')        PUB02140
         ORG   *-2                                                      PUB02150
&X       SET   &DEVA/16                                                 PUB02160
         DC    Y(ADPT&X)                                                PUB02170
         ENDO                                                           PUB02180
         DC    YL1(&CHN1)               CHANNEL AD.                     PUB02190
         DC    YL1(&DEVA)               DEVICE AD.                      PUB02200
         DC    XL2'0'                   ALLOCATION/RESERVE BYTES        PUB02210
&X       SET   ((&TYPE/256**X'30')>0)*255    0 UNLESS DISC OR TAPE      PUB02220
         DC    YL1(BP$ATTN**&X)         CONTROL 1                       PUB02230
         DC    YL1(0)                   CONTROL 5                       PUB02240
         DC    A(0)                     CCB AD.                         PUB02250
         DC    Y(&TYPE)                 DEVICE/SUB-DEVICE TYPE          PUB02260
         DC    Y(&FEATS)                FEATURES                        PUB02270
         DO    0                                                        PUB02280
*                                                                       PUB02290
*        GENERATE QUEUE AD. (IP$QUE) BASED ON CHANNEL AD.               PUB02300
*                                                                       PUB02310
         ENDO                                                           PUB02320
         DO    &CHN1=0                                                  PUB02330
&X       SET   &DEVA**X'0F'                                             PUB02340
         DC    Y(IT$IPC&X)              QUEUE AD.                       PUB02350
&IQ$IPC0 SET   &IQ$IPC0++(&X=0)                                         PUB02360
&IQ$IPC1 SET   &IQ$IPC1++(&X=1)                                         PUB02370
&IQ$IPC2 SET   &IQ$IPC2++(&X=2)                                         PUB02380
&IQ$IPC3 SET   &IQ$IPC3++(&X=3)                                         PUB02390
&IQ$IPC4 SET   &IQ$IPC4++(&X=4)                                         PUB02400
&IQ$IPC5 SET   &IQ$IPC5++(&X=5)                                         PUB02410
&IQ$IPC6 SET   &IQ$IPC6++(&X=6)                                         PUB02420
&IQ$IPC7 SET   &IQ$IPC7++(&X=7)                                         PUB02430
         ENDO                                                           PUB02440
         DO    &CHN1=1                                                  PUB02450
&X       SET   &DEVA/16                                                 PUB02460
&Y       SET   ''                                                       PUB02470
         DO    (&TYPE=X'0808')++(&TYPE=X'0408')++(&TYPE=X'0208')
&Y       SET   &DEVA**X'0F'
&IQ$ADP0 SET   &IQ$ADP0++(&X=0)
&IQ$ADP1 SET   &IQ$ADP1++(&X=1)
&IQ$ADP2 SET   &IQ$ADP2++(&X=2)
&IQ$ADP3 SET   &IQ$ADP3++(&X=3)
&IQ$ADP4 SET   &IQ$ADP4++(&X=4)
&IQ$ADP5 SET   &IQ$ADP5++(&X=5)
&IQ$ADP6 SET   &IQ$ADP6++(&X=6)
&IQ$ADP7 SET   &IQ$ADP7++(&X=7)
         ENDO
         DC    Y(IT$MUX&X.&Y)
&IQ$MUX0 SET   &IQ$MUX0++(&X=0)                                         PUB02480
&IQ$MUX1 SET   &IQ$MUX1++(&X=1)                                         PUB02490
&IQ$MUX2 SET   &IQ$MUX2++(&X=2)                                         PUB02500
&IQ$MUX3 SET   &IQ$MUX3++(&X=3)                                         PUB02510
&IQ$MUX4 SET   &IQ$MUX4++(&X=4)                                         PUB02520
&IQ$MUX5 SET   &IQ$MUX5++(&X=5)                                         PUB02530
&IQ$MUX6 SET   &IQ$MUX6++(&X=6)                                         PUB02540
&IQ$MUX7 SET   &IQ$MUX7++(&X=7)                                         PUB02550
         ENDO                                                           PUB02560
         DO    &CHN1=3                                                  PUB02570
         DC    Y(IT$IDA)                QUEUE AD.                       PUB02580
&IQ$IDA  SET   1                                                        PUB02590
         ENDO                                                           PUB02600
         DO    &CHN1=4                                                  PUB02610
         DC    Y(IT$SEL1)               QUEUE AD.                       PUB02620
         ENDO                                                           PUB02630
         DO    &CHN1=6                                                  PUB02640
         DC    Y(IT$SEL2)               QUEUE AD.                       PUB02650
         ENDO                                                           PUB02660
         DO    (&CHN1=4)++(&CHN2=4)                                     PUB02670
&IQ$SEL1 SET   1                                                        PUB02680
         ENDO                                                           PUB02690
         DO    (&CHN1=6)++(&CHN2=6)                                     PUB02700
&IQ$SEL2 SET   1                                                        PUB02710
         ENDO                                                           PUB02720
 DO (&TYPE=X'0808')++(&TYPE=X'0208')++(&TYPE=X'0000')++(&GS$ERLG>0)     PUB02730
         DC    Y(IP$PUBTS+&CRNTTRL)     TRAILER AD.                     PUB02740
         GOTO  .SCHED                                                   PUB02750
         ENDO                                                           PUB02760
         DO    (&TYPE/256**X'34')=0                                     PUB02770
         DC    Y(0)                     TRAILER AD. (NONE)              PUB02780
         ENDO                                                           PUB02790
         DO    (&TYPE/256**X'34')>0                                     PUB02800
         DC    Y(IP$PUBTS+&CRNTTRL)     TRAILER AD.                     PUB02810
         ENDO                                                           PUB02820
.SCHED   LABEL                                                          PUB02830
         DO    0                                                        PUB02840
*                                                                       PUB02850
*        GENERATE CHAN. SCHEDULER/INTERRUPT ENTRIES (IP$EPS/IP$EPI)     PUB02860
*                                                                       PUB02870
         ENDO                                                           PUB02880
         DO    &CHN1=0                                                  PUB02890
         DC    Y(IO$IPC)                CHAN. SCHEDULER AD.             PUB02900
         DC    Y(IN$IPC)                CHAN. INTERRUPT AD.             PUB02910
         ENDO                                                           PUB02920
         DO    &CHN1=1                                                  PUB02930
         DC    Y(IO$MUX)                CHAN. SCHEDULER AD.             PUB02940
         DC    Y(IN$MUX)                CHAN. INTERRUPT AD.             PUB02950
         ENDO                                                           PUB02960
         DO    &CHN1=3                                                  PUB02970
         DC    Y(IO$IDA)                CHAN. SCHEDULER AD.             PUB02980
         DC    Y(IN$IDA)                CHAN. INTERRUPT AD.             PUB02990
         ENDO                                                           PUB03000
         DO    (&CHN1=4)++(&CHN1=6)                                     PUB03010
         DC    Y(IO$SEL)                CHAN. SCHEDULER AD.             PUB03020
         DC    Y(IN$SEL)                CHAN. INTERRUPT AD.             PUB03030
         ENDO                                                           PUB03040
         DC    A(0)                     CONT 3 / DNP / DEVICE CLOCK     PUB03050
&X       SET   (&TYPE/256=X'20')*255    0 UNLESS DISC                   PUB03060
         DC    YL1(BP$SHARE**&X)        CONTROL 2                       PUB03070
         DC    YL2(0)                   CONTROL 4 / UNUSED              PUB03080
&X       SET   &CRNTPUB/&PUBLNG+1                                       PUB03090
         DC    YL1(&X)                  PUB NO. FOR JOB ACCT.           PUB03100
.PUBNXT  LABEL                                                          PUB03110
         DO    0                                                        PUB03120
*                                                                       PUB03130
***      GENERATE PUB TRAILER IF PRINTER, DISC, OR TAPE                 PUB03140
*                                                                       PUB03150
         ENDO                                                           PUB03160
         DO    (&TYPE=X'0808')++(&TYPE=X'0208')                         PUB03170
         ORG   IP$PUBTS+&CRNTTRL                                        PUB03180
         DC    XL&PUBTLNG'0'                                            PUB03190
         GOTO  .SETLEN                                                  PUB03200
         ENDO                                                           PUB03210
         DO    (&TYPE/256**X'34')>0                                     PUB03220
*                                       PUB TRAILER                     PUB03230
         ORG   IP$PUBTS+&CRNTTRL                                        PUB03240
         DO    &TYPE=X'0480'                                            PUB03250
         DC    CL8'&GS$70LC'            DEFAULT 770 LCB NAME
         DC    CL8'&GS$70VF'            DEFAULT 770 VFB NAME
         GOTO  .LCVFSET
         ENDO
         DO    &TYPE=X'0440'
         DC    CL8'&GS$73LC'            DEFAULT 773 LCB NAME
         DC    CL8'&GS$73VF'            DEFAULT 773 VFB NAME
         GOTO  .LCVFSET
         ENDO
         DO    &TYPE=X'0420'
         DC    CL8'&GS$68LC'            DEFAULT 768 LCB NAME
         DC    CL8'&GS$68VF'            DEFAULT 768 VFB NAME
         GOTO  .LCVFSET
         ENDO
         DO    &TYPE=X'0410'
         DC    CL8'&GS$76LC'            DEFAULT 776 LCB NAME
         DC    CL8'&GS$76VF'            DEFAULT 776 VFB NAME
         GOTO  .LCVFSET
         ENDO
         DO    &TYPE=X'0408'
         DC    XL8'0'                   NO LCB FOR 9300
         DC    CL8'&GS$93VF'            DEFAULT 9300 VFB NAME
         GOTO  .LCVFSET                                                 PUB03280
         ENDO                                                           PUB03290
         DC    XL16'0'                                                  PUB03300
.LCVFSET LABEL                                                          PUB03310
         DO    &MODE>0                                                  PUB03320
         DC    XL2'0'                                                   PUB03330
         DC    YL1(&MODE)                                               PUB03340
         DC    YL1(&MODE)                                               PUB03350
         DC    XL4'0'                                                   PUB03360
         ENDO                                                           PUB03370
         DO    (&MODE>0)=0                                              PUB03380
         DC    XL8'0'                                                   PUB03390
         ENDO                                                           PUB03400
         DO    &PUBTLNG>24                                              PUB03410
         DC    XL(&PUBTLNG-24)'0'                                       PUB03420
         ENDO                                                           PUB03430
         DO    (&TYPE=X'0480')**(&FEATS**X'0040'=X'0040')               PUB03440
         DC    2XL200'00'               LOAD CODE BUFFER                PUB03450
&PUBTLNG SET   &PUBTLNG+400                                             PUB03460
         GOTO  .SETLEN                                                  PUB03470
         ENDO                                                           PUB03480
         DO    &TYPE=X'0420'                                            PUB03490
         DC    A(0)                     LINE COUNTER                    PUB03500
         DC    XL192'00'                VERTICAL FORMAT BUFFER          PUB03510
&PUBTLNG SET   &PUBTLNG+196                                             PUB03520
         GOTO  .SETLEN                                                  PUB03530
         ENDO                                                           PUB03540
         DO    (&TYPE/256=X'10')                                        PUB03605
         DC    A(0)                     FOR TAPE BLOCK COUNT
&PUBTLNG SET   &PUBTLNG+4
         GOTO  .SETLEN
         ENDO
         GOTO  .SETLEN                                                  PUB03610
         ENDO                                                           PUB03620
         DO    &TYPE=X'0000'                                            PUB03625
&PUBTLNG SET   &PUBTLNG+200
         ORG   IP$PUBTS+&CRNTTRL
         DC    XL&PUBTLNG'0'
         GOTO  .SETLEN
         ENDO
         DO    &GS$ERLG>0                    ERROR LOG SPEC'D           PUB03630
         ORG   IP$PUBTS+&CRNTTRL                                        PUB03640
         DC    XL&PUBTLNG'0'                                            PUB03650
.SETLEN  LABEL                                                          PUB03660
&CRNTTRL SET   &CRNTTRL+&PUBTLNG       PUBTLNG=16,20,216,420, OR 432    PUB03670
         ENDO                                                           PUB03680
.PUBDON  LABEL                                                          PUB03690
         DO    0                                                        PUB03700
*                                       UPDATE 'CURRENT PUB' POINTER    PUB03710
         ENDO                                                           PUB03720
&CRNTPUB SET   &CRNTPUB+&PUBLNG                                         PUB03730
*                                                                       PUB03740
         DO    (&GS$MIN=0)*(&CRNTPUB=((&NUM-1)*&PUBLNG))                PUB03750
*                                                                       PUB03760
*        PUB FOR CHECKSUM ERRORS                                        PUB03770
*                                                                       PUB03780
         ORG   IP$PUBS+&CRNTPUB                                         PUB03785
         ENTRY PUBCKSUM                                                 PUB03790
PUBCKSUM EQU   *                                                        PUB03800
         DC    XL(&PUBLNG)'0'                                           PUB03810
*                                                                       PUB03820
&CRNTPUB SET   &CRNTPUB+&PUBLNG                                         PUB03830
         ENDO                                                           PUB03840
         DO    &CRNTPUB=(&NUM*&PUBLNG)                                  PUB03850
*        LAST PUB - GENERATE PIOCS TABLES                               PUB03860
*                                                                       PUB03870
         ORG   IP$PUBTS+&CRNTTRL                                        PUB03880
         IO$QLST                                                        PUB03890
         IN$ST                                                          PUB03900
         DO    &GS$TLCK>0                                               PUB03910
         SPACE 6                                                        PUB03920
***      TRACK LOCK TABLE                                               PUB03930
*                                                                       PUB03940
         ENTRY IO$LOCKS                                                 PUB03950
IO$LOCKS DS    0F                                                       PUB03960
         DC    Y(&GS$TLCK)                                              PUB03970
         DC    Y(0)                                                     PUB03980
         DO    &GS$TLCK                                                 PUB03990
         DC    XL12'0'                                                  PUB04000
         ENDO                                                           PUB04010
         ENDO                                                           PUB04020
*********************************************************************** PUB04030
*********************************************************************** PUB04040
         ENDO                                                           PUB04050
.*                                                                      PUB04060
.*       REPEAT VIRTUAL PUB GENERATION, IF SPECIFIED IN P(4)            PUB04070
.*                                                                      PUB04080
&RPEATCT SET   &RPEATCT-1                                               PUB04090
         DO    &RPEATCT>0                                               PUB04100
         GOTO  .PUBNEW                                                  PUB04110
         ENDO                                                           PUB04120
.PUBEND  LABEL                                                          PUB04130
         END                                                            PUB04140
