Retro1.org codex

*DECK DLARG 
USETEXT DLFPDEF 
USETEXT ARGERR
USETEXT ARGTBL
USETEXT VDPARM
PROC DLARG;                  # SCAN PARAMETERS FROM PROGRAM CALL       #
 
*IF DEF,IMS 
 #
*1DC  DLARG 
* 
*     1. PROC NAME           AUTHOR              DATE.
*        DLARG               P.C.TAM             78/06/18 
* 
*     2. FUNCTIONAL DESCRIPTION.
*        SCAN ARGUMENTS FROM PROGRAM CALL.
* 
*     3. METHOD USED. 
*        GET EACH ARGUMENT, CHECK WITH VALID PARAMETER LIST,
*        SET PARAMETER TABLE. 
* 
*     4. ENTRY PARAMETERS.
*        RA+2 THRU RA+22 WORDS. 
* 
*     5. EXIT PARAMETERS. 
*        VALUES SET IN ARGTBL COMMON BLOCK. 
* 
*     6. COMDECKS CALLED AND SYMPL TEXTS USED.
*        ARGERR    ARGTBL    DLFPDEF   VDPARM 
* 
*     7. ROUTNES CALLED.
*        DLABEND             ABORT MAIN LINE
*        DLDFM               DAYFILE MESSAGE PROCESSOR
* 
*     8. DAYFILE MESSAGES.
*        NONE.
* 
 #
*ENDIF
CONTROL PRESET; 
# 
      EXTERNAL VARIABLES
# 
      XREF
        BEGIN                # RA COMMUNICATION AREA                   #
        ARRAY ARGRW [1:22] S(1);
          BEGIN              # RA.ARGR                                 #
          ITEM PSYMBO        U(0,0,NL);# ACTUAL PARAMETER              #
          ITEM PSEPAR        U(0,ZL,AL);# ACTUAL PARAMETER SEPARATOR   #
          END 
        ARRAY ACTRW;
          BEGIN              # RA.ACTR                                 #
          ITEM ACTR          U(0,ZL,AL);# NUMBER OF ARGUMENTS          #
          END 
        END 
 
      XREF
        BEGIN 
        PROC DLABEND;        # ABORT MAIN LINE                         #
        PROC DLDFM;          # DAYFILE MESSAGE PROCESSOR               #
        END 
# 
      LOCAL VARIABLES 
# 
 
      BASED ARRAY DUMMY; ;
 
      SWITCH PARMTYPE 
             , INTYPE, OTYPE, BTYPE, NTYPE, DTYPE;
 
      ITEM
      ERRCODE    I = 0,      # ERROR RETURN CODE                       #
      ARGPTR     I = 0,      # POINTER TO AVAILABLE ARGUMENT ENTRY     #
      LEFTSYM    U,          # LEFT PART SAVE AREA                     #
      I          I,          # TEMPORARY VARIABLE                      #
      K          I,          # TEMPORARY VARIABLE                      #
      MATCH      B = TRUE;   # SYMBOL MATCHED FLAG                     #
 
#**********************************************************************#
      BEGIN 
 
# 
      LOOP TO READ ALL PARAMETERS 
# 
      FOR ARGPTR = ARGPTR WHILE ARGPTR LS ACTR[0] AND ERRCODE EQ 0
      DO
        BEGIN 
        ARGPTR = ARGPTR + 1; # MOVE POINTER TO NEXT ARG                #
        LEFTSYM = PSYMBO[ARGPTR];# GET CURRENT ACTUAL PARAMETER        #
        MATCH = FALSE;
# 
        LOOP TO MATCH ACTUAL PARAMETER WITH FORMAL PARAMETER
# 
        FOR I = 1 STEP 1 WHILE I LQ PARMNO AND NOT MATCH
        DO
          BEGIN 
          IF LEFTSYM EQ VDPARM[I] 
          THEN
            BEGIN 
            MATCH = TRUE; 
            K = I;
            END 
          END 
        IF MATCH
        THEN
          BEGIN              # FOUND A MATCH                           #
          I = ARGPTR + 1; 
          IF (VDPMLEN[K] EQ 1 AND       # PARAMETER OF LENGTH 1        #
              (PSEPAR[ARGPTR] EQ 1 OR   # SEPARATOR IS ,               #
               PSEPAR[ARGPTR] EQ 15)) OR# SEPARATOR IS .)              #
             (VDPMLEN[K] EQ 2 AND       # PARAMETER OF LENGTH 2        #
               PSEPAR[ARGPTR] EQ 2 AND  # SEPARATOR IS =               #
              I LQ ACTR[0] AND          # VALUE PRESENT                #
              (PSEPAR[I] EQ 1 OR        # NEXT SEP IS ,                #
               PSEPAR[I] EQ 15))        # NEXT SEP IS .)               #
          THEN               # PARAMETER CHECKED OK                    #
            BEGIN 
            IF VDPMLEN[K] NQ 1
            THEN
              ARGPTR = I;    # UPDATE ARGUMENT PTR                     #
# 
            SWITCH TO DIFFERENT PROCESSING CASES
# 
            GOTO PARMTYPE[K]; 
 
INTYPE:                      # INPUT FILE NAME                         #
            I = INFILE;      # SET INPUT FILE INDEX                    #
            GOTO ENDP;
 
OTYPE:                       # OUTPUT FILE NAME                        #
            I = OFILE;       # SET OUTPUT FILE NAME                    #
            GOTO ENDP;
 
BTYPE:                       # ZZZZZDN FILE NAME                       #
            I = ZFILE;       # SET ZZZZZDN FILE INDEX                  #
            GOTO ENDP;
 
NTYPE:                       # NEW DEBUG LOG FILE OPTION               #
            I = NFILE;
            GOTO ENDP;
 
DTYPE:                       # IGNORE ERROR                            #
            I = DOPTION;     # SET D OPTION INDEX                      #
 
ENDP: 
            IF NOT ARGFLAG[I] 
            THEN             # OPTION HAS NOT BEEN SELECTED            #
              BEGIN 
              IF VDPMLEN[K] EQ 1
              THEN
                ARGENTR[I] = 1; 
              ELSE
                ARGENTR[I] = PSYMBO[ARGPTR];
              ARGFLAG[I] = TRUE;
              END 
            ELSE             # DUPLICATE PARAMETER SELECT              #
              ERRCODE = A$DUPERR; 
            END 
          ELSE               # PARAMETER FORMAT ERROR                  #
            ERRCODE = A$FMERR;
          END 
        ELSE                 # ILLEGAL PARAMETER                       #
          ERRCODE = A$ILLERR; 
        END 
 
      FOR I = 1 STEP 1 WHILE I LQ DOPTION-1 AND ERRCODE EQ 0
      DO
        BEGIN 
        LEFTSYM = ARGENTR[I]; 
        FOR K = I+1 STEP 1 WHILE K LQ DOPTION AND ERRCODE EQ 0
        DO
          BEGIN 
          IF LEFTSYM EQ ARGENTR[K]
          THEN
            ERRCODE = A$DUFERR; 
          END 
        END 
 
      FOR I = 1 STEP 1 WHILE I LS DOPTION AND ERRCODE EQ 0
      DO                     # LOOP TO CHECK ALL FILE NAMES            #
        BEGIN 
        ARGPTR = 0; 
        B<0, NL>ARGPTR = ARGENTR[I];
    IF ARGFLAG[I] AND        # PARAMETER HAS BEEN SET                  #
       (I NQ INFILE OR       # FOR INPUT FILE, IT CAN BE 0             #
        I EQ INFILE AND ARGPTR NQ O"33000000000000000000")
        THEN
          BEGIN 
          FOR K = 0 STEP 1 WHILE K LS NC AND
                                 C<K, NC-K>ARGPTR NQ 0
          DO
             BEGIN           # LOOP TO CHECK EACH CHAR                 #
             LEFTSYM = C<K, 1>ARGPTR; 
             IF (K EQ 0 AND     # 1ST CHAR MUST BE LETTER              #
                (1 GR LEFTSYM OR LEFTSYM GR O"32")) OR
                (K NQ 0 AND     # ALL OTHERS MUST BE ALPHANUMERIC      #
                (1 GR LEFTSYM OR LEFTSYM GR O"44")) 
             THEN 
               ERRCODE = A$ILFERR;
             END
           END
         END
 
      IF ERRCODE NQ 0 
      THEN
        BEGIN 
        P<DUMMY> = LOC(ARGM0[ERRCODE]); 
        DLDFM(DUMMY); 
        DLABEND;
        END 
 
      END 
TERM