Retro1.org codex

*DECK LFGCRAK 
USETEXT LFGFET,LFGFN
      PROC LFGCRAK; 
      BEGIN 
*IF DEF,IMS 
# 
**    LFGCRAK - CRACK CONTROL CARD. 
* 
*     M. E. VATCHER   81/02/19
*     D. K. ENDO      81/12/22  (ADD -Z- AND -BC- PARAMETERS) 
* 
*     LFGCRAK CRACKS THE LFG CONTROL CARD.  ALL FILE NAMES ARE
*     CHECKED TO MAKE SURE THEY ARE VALID.
* 
*     PROC LFGCRAK
* 
*     ENTRY  NONE.
* 
*     EXIT   NONE.
* 
*     METHOD
* 
*     FOR EACH WORD BEGINNING AT RA+2 
*       IF ITS AN "I" PARAMETER 
*       THEN
*         CHECK FILE NAME 
*         SET FILE NAME IN INPUT FET
*       ELSE IF ITS AN "L" PARAMETER
*       THEN
*         CHECK FILE NAME 
*         SET FILE NAME IN OUTPUT FET 
*       ELSE IF ITS AN "NLF" PARAMETER
*       THEN
*         CHECK FILE NAME 
*         SET FILE NAME IN NLF FET
*       ELSE IF ITS A "Z" PARAMETER 
*       THEN
*         CALL *Z* ARGUMENT PROCESSOR 
*       ELSE IF ITS A "BC" PARAMETER
*       THEN
*         CHECK DECIMAL NUMBER
*         CONVERT TO INTEGER AND SAVE IT
*     END 
* 
# 
*ENDIF
 
# 
****  PROC LFGCRAK - XREF LIST BEGIN. 
# 
 
      XREF
        BEGIN 
        PROC ABORT;          # ABORTS JOB ON REQUEST                   #
        ITEM INPUT;          # INPUT DIRECTIVE FET                     #
        PROC LFGZAP;         # *Z* ARGUMENT PROCCESSOR                 #
        PROC MESSAGE;        # PUTS MESSAGE INTO DAYFILE               #
        ITEM OUTPUT U;       # FWA OF LIST OUTPUT FET                  #
        PROC READ;           # FILLS CIO BUFFER                        #
        PROC RECALL;         # RETURNS CONTROL WHEN RECALL BIT IS SET  #
        ITEM WFET U;         # FWA OF NLF FET                          #
        END 
 
# 
****
# 
 
      DEF COMMA # 1 #;       # JOB COMM. AREA CODE FOR ,               #
      DEF EQUAL # 2 #;       # JOB COMM. AREA CODE FOR =               #
      DEF MAX$BC # 64 #;     # MAXIMUM BC VALUE ALLOWED                #
      DEF MIN$BC #  1 #;     # MINIMUM BC VALUE ALLOWED                #
      DEF NO$LIST #O"33000000000000"#;  # LEFT JUSTIFIED ZERO          #
      DEF PARTERM #O"17"#;   # JOB COMM. AREA CODE FOR ) OR .          #
      DEF PLWC # O"64" #;    # WORD WHERE PARAMTER LIST WORD COUNT IS  #
      DEF PRMLIST # 2 #;     # WORD WHERE PARAMETER LIST STARTS        #
 
      CONTROL NOLIST;        # LFGSTAN COMMON DECK                     #
*CALL LFGSTAN 
      CONTROL LIST; 
      ITEM DONEII B;         # LOOP TERMINATION CONDITION              #
      ITEM DONEK B;          # LOOP TERMINATION CONDITION              #
      ITEM II U;             # LOOP INDEX                              #
      ITEM J I;              # POINTER TO WORD IN JOB COMM. AREA       #
      ITEM K U;              # LOOP INDEX                              #
      ITEM SUCCESS B;        # SUCCESSFUL COMPLETION INDICATOR         #
      ITEM SWTCHVCTR I;      # SWITCH VECTOR                           #
      ITEM Z$USED B;         # Z PARAMETER SPECIFIED FLAG              #
 
      BASED ARRAY PARAMS [1:1] S(1);
        BEGIN 
        ITEM PARVAL C(0,0,7); 
        ITEM PARCODE U(0,56,4); 
        END 
 
      DEF MAXPT # 5 #;       # MAXIMUM NUMBER OF PARAMETERS            #
      ARRAY PARAM$TABLE [01:MAXPT] S(1);
        BEGIN 
        ITEM PT$NAME    C(00,00,07) = [O"11000000000000", 
                                       O"14000000000000", 
                                       O"16140600000000", 
                                       O"32000000000000", 
                                       O"02030000000000"
                                      ];
        ITEM PT$SWTCHV  I(00,42,18) = [1, 
                                       2, 
                                       3, 
                                       4, 
                                       5
                                      ];
        END 
 
      BASED ARRAY PARAM$WC [00:00] S(1);
        BEGIN                # PARAMETER LIST WORD COUNT               #
        ITEM PLIST$WC   I(00,42,18);
        END 
 
      ARRAY BC$RANGE [00:00] S(4);
        BEGIN 
        ITEM BR$MSG     C(00,00,30) = [" BC VALUE OUT OF RANGE(1-64)."];
        ITEM BR$ZBYT    I(03,00,60) = [0];
        END 
 
      ARRAY NOVAL [0:0] S(3); 
        BEGIN 
        ITEM NOVAL1 C(0,0,28) = 
          [" NO VALUE FOR PARAMETER XXX."]; 
        ITEM NOVAL2 C(2,24,3);
        ITEM NOVALZ U(2,48,12) = [ 0 ]; 
        END 
 
      ARRAY UNREC$DELIM [00:00] S(3); 
        BEGIN 
        ITEM UD$MSG     C(00,00,24) = [" UNRECOGNIZED DELIMETER."]; 
        ITEM UD$ZBYT    I(02,24,36) = [0];
        END 
 
      ARRAY NO$EQUAL [00:00] S(3);
        BEGIN 
        ITEM NE$MSG     C(00,00,25) = [" CANNOT ASSIGN VALUE TO Z."]; 
        ITEM NE$ZBYT    I(02,30,30) = [0];
        END 
 
      ARRAY NOT$DEC [00:00] S(3); 
        BEGIN 
        ITEM ND$MSG     C(00,00,28) = [" BC VALUE SHOULD BE DECIMAL."]; 
        ITEM ND$ZBYT    I(02,48,12) = [0];
        END 
 
      ARRAY UNREC$PRM [0:0] S(3); 
        BEGIN 
        ITEM UNREC1 C(0,0,24) = 
          [" UNRECOGNIZED PARAMETER."]; 
        ITEM UNRECZ U(2,24,36) = [ 0 ]; 
        END 
 
      SWITCH GFNSWTCH UNK,
                      I$PRM,
                      L$PRM,
                      NLF$PRM,
                      Z$PRM,
                      BC$PRM; 
      CONTROL EJECT;
      PROC LFGCDN(VALUE,NUMBER,STATIS); 
      BEGIN                  # CHECK DECIMAL NUMBER                    #
 
      ITEM VALUE C(7);       # VALUE TO BE CHECKED AND CONVERTED       #
      ITEM NUMBER I;         # CONVERTED NUMBER                        #
      ITEM STATIS B;         # ERROR STATUS                            #
 
      DEF NINE # O"44" #; 
      DEF ZERO # O"33" #;    # DISPLAY CODE ZERO                       #
      ITEM CTEMP C(1);       # CHARACTER TEMPORARY                     #
      ITEM EXPONENT I;       # CURRENT EXPONENT VALUE                  #
      ITEM I I;              # SCRATCH ITEM                            #
#                                                                      #
#                            LFGCDN CODE BEGINS HERE                   #
#                                                                      #
      STATIS = TRUE;         # SET RETURN STATUS TO O.K.               #
      NUMBER = 0;            # CLEAR NUMBER TEMPORARY                  #
      EXPONENT = 0;          # CLEAR EXPONENT                          #
      FOR I=6 STEP -1 UNTIL 0 
      DO                     # FOR EACH CHARACTER OF VALUE(FROM RIGHT) #
        BEGIN 
        CTEMP = C<I,1>VALUE; # MASK CHARACTER                          #
        IF CTEMP NQ 0        # IF CHARACTER IS NOT BLANK               #
        THEN
          BEGIN 
          IF CTEMP GQ ZERO AND
             CTEMP LQ NINE             # IF CHARACTER IS A DECIMAL NUM #
          THEN
            BEGIN 
            CTEMP = CTEMP - ZERO;      # CALCULATE VALUE               #
            NUMBER = NUMBER + (CTEMP * 10**EXPONENT); 
            EXPONENT = EXPONENT + 1;   # INCREMENT EXPONENT VALUE      #
            END 
          ELSE               # CHARACTER IS NOT DECIMAL                #
            BEGIN 
            SUCCESS = FALSE; # SET ERROR STATUS                        #
            END 
          END 
        END 
      RETURN;                # **** RETURN *****                       #
      END 
      CONTROL EJECT;
      PROC LFGCKFN(FNAME,SUCCESS);
      BEGIN                  # CHECK FILE NAME                         #
 
      ITEM CHAR C(1); 
      ITEM FNAME C(7);       # FILE NAME CANDIDATE                     #
      ITEM III U;            # LOOP VARIABLE                           #
      ITEM SUCCESS B; 
 
      ARRAY CNA [0:0] S(4); 
        BEGIN 
        ITEM CNA1 C(0,0,38) = 
          [" FILE NAME CHARACTER NOT ALPHANUMERIC."]; 
        ITEM CNAZ U(3,48,12) = [ 0 ]; 
        END 
 
      ARRAY ZFFN [0:0] S(3);
        BEGIN 
        ITEM ZFFN1 C(0,0,23) =
          [" ZERO FILLED FILE NAME."];
        ITEM ZFFNZ U(2,18,42) = [ 0 ];
        END 
 
      SUCCESS = TRUE; 
      FOR III = 0 STEP 1 UNTIL 6 DO 
        BEGIN                # FOR EACH CHARACTER IN THE FILE NAME     #
        CHAR = C<III,1>FNAME; 
        IF III EQ 0 AND CHAR EQ 0 
        THEN                 # ZERO FILLED NAME                        #
          BEGIN 
          MESSAGE(ZFFN,0);
          SUCCESS = FALSE;
          RETURN;            # ***** EXIT *****                        #
 
          END 
        IF CHAR EQ 0
        THEN                 # END OF FILE NAME                        #
          BEGIN 
          RETURN;            # ***** EXIT *****                        #
 
          END 
        IF CHAR GR O"44"
        THEN                 # IT IS NOT ALPHANUMERIC                  #
          BEGIN 
          MESSAGE(CNA,0); 
          SUCCESS = FALSE;
          RETURN;            # ***** EXIT *****                        #
 
          END 
        END                  # GET NEXT CHARACTER                      #
      END                    # END OF ROUTINE                          #
      CONTROL EJECT;
      P<PARAMS> = PRMLIST;   # PARAMETERS IN JOB COMMUNICATION AREA    #
      P<PARAM$WC> = PLWC;    # POINT ARRAY TO WORD COUNT               #
      LISTFLG = TRUE;        # SET LISTING REQUESTED FLAG              #
      SUCCESS = TRUE; 
      Z$USED = FALSE; 
      J = 0;
      IF PLIST$WC[0] EQ 0    # IF NO PARAMETERS SPECIFIED              #
      THEN
        BEGIN 
        DONEII = TRUE;       # SET DONE FLAG                           #
        END 
      ELSE                   # PARAMTERS SPECIFIED                     #
        BEGIN 
        DONEII = FALSE;      # CLEAR DONE FLAG                         #
        END 
      FOR II=0 WHILE NOT DONEII AND SUCCESS 
      DO
        BEGIN                # FOR EACH WORD BEGINNING AT RA+2         #
        J = J + 1;
        IF J GR PLIST$WC[0]  # IF REACHED END OF PARAMETER LIST        #
        THEN
          BEGIN 
          DONEII = TRUE;     # SET DONE FLAG                           #
          END 
        IF NOT DONEII 
        THEN
          BEGIN 
          SWTCHVCTR = 0;     # SET SWITCH VECTOR TO UNKNOWN            #
          FOR K=0 STEP 1 UNTIL MAXPT
          DO                 # FOR EACH ENTRY IN PARAMETER TABLE       #
            BEGIN 
            IF PT$NAME[K] EQ PARVAL[J]
            THEN             # IF PARAMTER IS IN TABLE                 #
              BEGIN 
              SWTCHVCTR = PT$SWTCHV[K];# SAVE SWITCH VALUE             #
              END 
            END 
          GOTO GFNSWTCH[SWTCHVCTR];    # JUMP TO APPROPRIATE PARAGRAPH #
I$PRM:                       # I PARAMETER IS SPECIFIED                #
          IF PARCODE[J] NQ EQUAL
          THEN               # NO EQUALS SIGN                          #
            BEGIN 
            NOVAL2[0] = "  I";
            MESSAGE(NOVAL,0); 
            SUCCESS = FALSE;
 
            END 
          ELSE               # AN EQUAL WAS SPECIFIED                  #
            BEGIN 
            J = J + 1;       # POINT TO FILE NAME                      #
            LFGCKFN(PARVAL[J],SUCCESS);# CHECK FILE NAME               #
            P<SIOFET> = LOC(INPUT); 
            FETLFN[0] = PARVAL[J];     # PUT FILE NAME IN INPUT FET    #
            END 
          GOTO NEXT;
L$PRM:                       # L PARAMETER IS SPECIFIED                #
          IF PARCODE[J] NQ EQUAL
          THEN               # NO = SIGN AFTER L PARAMETER             #
            BEGIN 
            NOVAL2[0] = "  L";
            MESSAGE(NOVAL,0); 
            SUCCESS = FALSE;
            END 
          ELSE               # AN EQUAL WAS SPECIFIED                  #
            BEGIN 
            J = J + 1;
            IF PARVAL[J] EQ NO$LIST 
            THEN             # IF NO OUTPUT LISTING REQUESTED          #
              BEGIN 
              LISTFLG = FALSE;         # CLEAR LISTING FLAG            #
              END 
            ELSE             # FILE NAME WAS SPECIFIED                 #
              BEGIN 
              LFGCKFN(PARVAL[J],SUCCESS);  # CHECK FILE NAME           #
              P<SIOFET> = LOC(OUTPUT);
              FETLFN[0] = PARVAL[J];
              END 
            END 
          GOTO NEXT;
NLF$PRM:                     # NLF PARAMETER IS SPECIFIED              #
          IF PARCODE[J] NQ EQUAL
          THEN               # NO = SIGN AFTER NLF                     #
            BEGIN 
            NOVAL2[0] = "NLF";
            MESSAGE(NOVAL,0); 
            SUCCESS = FALSE;
            END 
          ELSE               # AN EQUAL WAS SPECIFIED                  #
            BEGIN 
            J = J + 1;       # GO TO NEXT WORD IN JOB COMM. AREA       #
            LFGCKFN(PARVAL[J],SUCCESS);  # CHECK FILE NAME             #
            P<SIOFET> = WFET; 
            FETLFN[0] = PARVAL[J];
            END 
          GOTO NEXT;
Z$PRM:                       # Z PARAMETER IS SPECIFIED                #
          IF PARCODE[J] EQ COMMA OR    # IF DELIMITER IS COMMA OR -)-  #
             PARCODE[J] EQ PARTERM
          THEN
            BEGIN 
            LFGZAP(INPUT);             # CALL *Z* ARGUMENT PROCESSOR   #
            Z$USED = TRUE;             # SET Z SPECIFIED FLAG          #
            END 
          ELSE                         # DELIMITER IS NOT VALID        #
            BEGIN 
            IF PARCODE EQ EQUAL        # TRIED TO ASSIGN VALUE TO Z    #
            THEN
              BEGIN 
              J = J + 1;               # POINT TO NEXT WORD            #
              MESSAGE(NO$EQUAL,0);
              SUCCESS = FALSE;
              END 
            ELSE                       # CONNOT RECOGNIZE DELIMITER    #
              BEGIN 
              MESSAGE(UNREC$DELIM,0); 
              SUCCESS = FALSE;
              END 
            END 
          GOTO NEXT;
BC$PRM:                      # BC PARAMETER IS SPECIFIED               #
          IF PARCODE[J] NQ EQUAL
          THEN               # NO EQUAL AFTER BC                       #
            BEGIN 
            NOVAL2[0] = "BC"; 
            MESSAGE(NOVAL,0); 
            SUCCESS = FALSE;
            END 
          ELSE               # AN EQUAL WAS SPECIFIED                  #
            BEGIN 
            J = J + 1;       # POINT TO NEXT WORD                      #
            LFGCDN(PARVAL[J],BC$VAL,SUCCESS);   # CHECK DECIMAL NUMBER #
            IF NOT SUCCESS
            THEN             # IF NOT A DECIMAL NUMBER                 #
              BEGIN 
              MESSAGE(NOT$DEC,0); 
              END 
            ELSE             # NUMBER VALUE IS O.K.                    #
              BEGIN 
              IF BC$VAL LS MIN$BC OR
                 BC$VAL GR MAX$BC      # IF VALUE IS NOT IN RANGE      #
              THEN
                BEGIN 
                MESSAGE(BC$RANGE,0);
                SUCCESS = FALSE;
                END 
              END 
            END 
          GOTO NEXT;
UNK:                         # UNKNOWN PARAMETER                       #
          MESSAGE(UNREC$PRM,0);        # SENT DAYFILE MESSAGE          #
          SUCCESS = FALSE;             # CLEAR SUCCESS FLAG            #
          IF PARCODE[J] EQ EQUAL
          THEN               # IF VALUE ASSIGNED TO UNKNOWN PARAMETER  #
            BEGIN 
            J = J + 1;       # SKIP THE VALUE                          #
            END 
NEXT: 
          IF PARCODE[J] NQ COMMA AND   # IF DELIM IS NOT COMMA OR -)-  #
             PARCODE[J] NQ PARTERM
          THEN
            BEGIN 
            MESSAGE(UNREC$DELIM,0);    # SEND DAYFILE MESSAGE          #
            SUCCESS = FALSE;           # CLEAR SUCCESS FLAG            #
            END 
          END 
        END 
      IF NOT SUCCESS         # IF ERRORS WERE DETECTED                 #
      THEN
        BEGIN 
        ABORT;               # ABORT JOB                               #
        END 
      IF NOT Z$USED          # IF -Z- WAS NOT SPECIFED                 #
      THEN
        BEGIN 
        READ(INPUT);         # FILL CIO BUFFER WITH INPUT DIRECTIVES   #
        RECALL(INPUT);
        END 
      RETURN;                # **** RETURN ****                        #
      END TERM