         PROC  &P,0                                                     00000100
FUNEND   NAME  1                                                        00000200
         GBL   &SYSTM                                                   00000300
.*                                                                      00000400
.*  FORT GLOBALS                                                        00000500
.*                                                                      00000600
         GBL   &MAXAREA,&MAXWORK,&CRDFLAG,&PRNFLAG,&TABFLAG,&ENDFLAG    00000700
.*                                                                      00000800
.*  FOR GLOBALS                                                         00000900
.*                                                                      00001000
         GBL   &FMAXWRK                 MAX WORK AREA NEEDED            00001100
         GBL   &FDIAGFL                 FDIAGNOS=YES SPECIFIED          00001200
         GBL   &FIOERFL                 EXTRN TO FL$IOERR GENERATED     00001300
         GBL   &MXPOOL1                 MAX POOLED I/O AREA 1 NEEDED    00001400
         GBL   &MXPOOL2                 MAX POOLED I/O AREA 2 NEEDED    00001500
         GBL   &FRERDDF                 REREAD UNIT DEFINED             00001600
         GBL   &MAXRERD                 MAX REREAD BUFFER NEEDED        00001700
         GBL   &FFNTBFL                 VALID FUNTAB CALL               00001800
         GBL   &FFNENFL                 VALID FUNEND CALL               00001900
         GBL   &FBKNOFL                 FBKNO=YES SPECIFIED             00002000
         GBL   &FPRNTFL                 PRNTR FILE DEFINED              00002100
         GBL   &FEOFFL                  EXTRN TO FL$EOF GENERATED       00002200
         GBL   &FSKADRFL                EXTRN TO FL$SKADR GENERATED     00002300
         GBL   &FSECTRFL                BUF POOLING ON SECT DISC SPEC   00002400
         GBL   &FOUTFL                  SDISC OR DISC OUTPUT W/POOLING  00002500
         DO    '&SYSTM'='FORT'                                          00002600
         DO    &TABFLAG=1                                               00002700
         DO    &ENDFLAG=0                                               00002800
&ENDFLAG SET   1                                                        00002900
FP$UTBL  CSECT                                                          00003000
         DC    XL16'0'            END MARKER                            00003100
         DS    F                                                        00003200
         DO    &PRNFLAG=0                                               00003300
         PNOTE *,'INVALID I/O MODULE-NO PRINTER'                        00003400
         GOTO  .LAST                                                    00003500
         ENDO                                                           00003600
         DO    &MAXAREA>0                                               00003700
.*   EXTRA WORD FOR UNIT'S TAPE FBKNO=YES                       V4A     00003800
         DC    A(0)                                             V4A     00003900
.*                                                              V4A     00004000
         ENTRY FP$SIOA                                                  00004100
FP$SIOA  DS    CL(&MAXAREA)                                             00004200
         ENDO                                                           00004300
         DS    CL20                                                     00004400
         EXTRN FP$ERR,FP$EOF                                            00004500
         ENTRY FP$WORK                                                  00004600
FP$WORK  DS    0H                                                       00004700
         DO    &MAXWORK>&MAXAREA                                        00004800
         DS    CL(&MAXWORK)                                             00004900
         GOTO  .LAST                                                    00005000
         ENDO                                                           00005100
         DS    CL(&MAXAREA)                                             00005200
         GOTO  .LAST                                                    00005300
         ENDO                                                           00005400
         ENDO                                                           00005500
         PNOTE *,'INVALID MACRO SEQUENCE-IGNORED'                       00005600
         GOTO  .LAST                                                    00005700
         ENDO                                                           00005800
         DO    '&SYSTM'='FOR'                                           00005900
         DO    ('&FFNTBFL'='1')**('&FFNENFL'='')                        00006000
&FFNENFL SET   1                                                        00006100
FUNLABEL DC    A(0)                     USED TO VALIDATE ASSEMBLY       00006200
.*                                                                      00006300
         DO    &FDIAGFL=0                                               00006400
         DO    &FPRNTFL=1                                               00006500
         PNOTE 'W','DIAGNOSTIC DEVICE NOT SPECIFIED - FILE ''PRNTR'' WIX00006600
               LL BE USED AS DEFAULT'                                   00006700
         GOTO  .F4LAB1                                                  00006800
         ENDO                                                           00006900
         PNOTE 'W','DEFAULT DIAGNOSTIC UNIT GENERATED - FILE NAME IS PRX00007000
               NTR'                                                     00007100
.*                                                                      00007200
         DO    &FMAXWRK<101                                             00007300
&FMAXWRK SET   101                                                      00007400
         ENDO                                                           00007500
.*                                                                      00007600
.*  GEN DIAG UNIT FUNTAB SLOT                                           00007700
.*                                                                      00007800
FL$FUNTB CSECT                                                          00007900
FL$UNPRT DS    0F                       AUTO GEN DIAG UNIT FUNTAB SLOT  00008000
         DC    AL1(0)                   RUN TIME FLAGS                  00008100
         DC    AL1(0)                   LAST COMMAND                    00008200
         DC    AL2(-3)                  UNIT NUMBER                     00008300
         DC    AL1(UTPRINT)             DEVICE=PRINTER                  00008400
         DC    AL1(UOSEQ)               SEQUENTIAL FILE                 00008500
         DC    AL1(UOOUT+UOPRNTR+UODIAG) OUTPUT/PRINTER/DIAG FLAGS      00008600
         DC    AL1(0)                   RUN TIME FLAGS 2                00008700
         DC    AL4(101)                 MAX RECORD SIZE                 00008800
         DC    AL4(0)                   ADDRESS OF I/O RECORD           00008900
         DC    AL4(PRNTR)               DTF ADDRESS                     00009000
         DC    AL4(0)                   DELAYED PRINT LINE LENGTH       00009100
         DC    AL4(0)                   NOT USED                        00009200
         EJECT                                                          00009300
.*                                                                      00009400
.*  GENERATE DTF                                                        00009500
.*                                                                      00009600
FL$DIAG  CSECT                                                          00009700
         DO    &FIOERFL=0                                               00009800
&FIOERFL SET   1                                                        00009900
         EXTRN FL$IOERR                                                 00010000
         ENDO                                                           00010100
PRNTR    DTFPR BLKSIZE=101,                                            X00010200
               CTLCHR=DI,                                              X00010300
               ERROR=FL$IOERR,                                         X00010400
               IOAREA1=IO1ERR,                                         X00010500
               IOAREA2=IO2ERR,                                         X00010600
               IOREG=(3),                                              X00010700
               PRINTOV=SKIP,                                           X00010800
               RECFORM=UNDEF,                                          X00010900
               RECSIZE=(6)                                              00011000
         DS    0F                                                       00011100
         DS    CL3                      PAD FOR INTEGRATED PRINTER      00011200
IO1ERR   DS    CL(101)                  DEFAULT DIAG UNIT I/O AREA 1    00011300
         DS    0F                                                       00011400
         DS    CL3                      PAD FOR INTEGRATED PRINTER      00011500
IO2ERR   DS    CL(101)                  DEFAULT DIAG UNIT I/O AREA 2    00011600
         EJECT                                                          00011700
         ENDO                                                           00011800
.F4LAB1  LABEL                                                          00011900
.*                                                                      00012000
FL$FUNTB CSECT                                                          00012100
         DC    XL1'80'                  SIGNALS END OF UNIT DEFS        00012200
.*                                                                      00012300
         DO    &FMAXWRK=0=0                                             00012400
FL$WORKA CSECT                                                          00012500
         DS    0F                       COMMON WORK AREA                00012600
         DS    CL(&FMAXWRK)                                             00012700
         ENDO                                                           00012800
         DO    &FMAXWRK=0                                               00012900
         ENTRY FL$WORKA                                                 00013000
FL$WORKA DS    0H                       DUMMY FL$WORKA ENTRY            00013100
         ENDO                                                           00013200
.*                                                                      00013300
         DO    &MXPOOL1=0=0                                             00013400
FL$POOL  CSECT                                                          00013500
         DO    &FOUTFL=1                                                00013600
         DS    0F                       DATA MGMT CNT FIELD FOR OUTPUT  00013700
         DS    CL8                                                      00013800
         ENDO                                                           00013900
         DO    &FBKNOFL=1                                               00014000
         DS    0F                                                       00014100
         DS    CL4                      EXTRA FOR BKNO                  00014200
         ENDO                                                           00014300
IO1POOL  DS    0F                       COMMON BUFFER POOL 1            00014400
         DO    &FSECTRFL=0                                              00014500
         DS    CL(&MXPOOL1)                                             00014600
         ENDO                                                           00014700
         DO    &FSECTRFL=1                                              00014800
         DS    CL((&MXPOOL1)//256*256)                                  00014900
         ENDO                                                           00015000
         DO    &MXPOOL2=0=0                                             00015100
         DO    &FOUTFL=1                                                00015200
         DS    0F                       DATA MGMT CNT FIELD FOR OUTPUT  00015300
         DS    CL8                                                      00015400
         ENDO                                                           00015500
         DO    &FBKNOFL=1                                               00015600
         DS    0F                                                       00015700
         DS    CL4                      EXTRA FOR BKNO                  00015800
         ENDO                                                           00015900
IO2POOL  DS    0F                       COMMON BUFFER POOL 2            00016000
         DO    &FSECTRFL=0                                              00016100
         DS    CL(&MXPOOL2)                                             00016200
         ENDO                                                           00016300
         DO    &FSECTRFL=1                                              00016400
         DS    CL((&MXPOOL2)//256*256)                                  00016500
         ENDO                                                           00016600
         ENDO                                                           00016700
         ENDO                                                           00016800
.*                                                                      00016900
         DO    &MAXRERD=0=0                                             00017000
         DO    &FRERDDF=0                                               00017100
         PNOTE 'W','FREREAD=YES OR FRECERR=YES SPECIFIED BUT NO REREAD X00017200
               UNIT WAS DEFINED'                                        00017300
         ENDO                                                           00017400
FL$RERDB CSECT                                                          00017500
         DS    0F                       COMMON REREAD BUFFER            00017600
         DC    AL4(0)                   LENGTH OF REREAD DATA           00017700
         DS    CL(&MAXRERD)                                             00017800
         ENDO                                                           00017900
         DO    &MAXRERD=0                                               00018000
         ENTRY FL$RERDB                                                 00018100
FL$RERDB DS    0H                       DUMMY FL$RERDB ENTRY            00018200
         ENDO                                                           00018300
         DO    (&MAXRERD=0)**(&FRERDDF=1)                               00018400
         PNOTE 'W','REREAD UNIT DEFINED BUT FREREAD=YES OR FRECERR=YES X00018500
               NEVER SPECIFIED'                                         00018600
         ENDO                                                           00018700
         GOTO  .F4LAST                                                  00018800
         ENDO                                                           00018900
         PNOTE 'W','INVALID PROC SEQUENCE - CALL IGNORED'               00019000
         GOTO  .F4LAST                                                  00019100
         ENDO                                                           00019200
.*                                                                      00019300
         PNOTE 'W','INVALID FORTRAN SYSTEM - FIX AND REASSEMBLE'        00019400
.LAST    LABEL                                                          00019500
.F4LAST  LABEL                                                          00019600
&SYSECT  CSECT                                                          00019700
         END                                                            00019800
