*DECK FIXVARS                                                           010280
USETEXT TCLFN 
USETEXT TCRMDEF 
USETEXT TENVIRN 
USETEXT TFIT
USETEXT TOPTION 
USETEXT TREPCOM 
USETEXT TREPORT 
USETEXT TXSTD 
      PROC FIXVARS(RNAME);                                              010290
                                                                        010300
# FIND THE LINE ON THE VARIABLE FILE THAT STARTS WITH RNAME.            010310
  IF THERE IS NONE, JUST RETURN.  IF THE NAME IS FOUND, READ THE        010320
  ^REST OF THE CARD.  FOR EACH PARAMETER-VALUE PAIR, READ THE           010330
  PARAMETER AND THE VALUE, AND STORE THE VAL[UE IN THE LISTS. #         010340
                                                                        010350
      BEGIN                                                             010360
                                                                         FIXVARS
      ITEM RNAME C(7);       # PARAMETER--CURRENT REPORT NAME #         010370
      ITEM RETCODE I;        # RETURN CODE FROM READ ROUTINE #          010380
      ITEM FOUND B;          # TELLS WHETHER RNAME HAS BEEN FOUND #     010390
      ITEM NEOF I;           # NUMBER OF EOFS ENCOUNTERED SO FAR #      010400
      ITEM  ILOOP;
      XREF PROC  OPENM; 
      XREF PROC  GET; 
      XREF PROC  CLOSEM;
      XREF PROC WEOR; 
      XREF ITEM REP;
      XREF PROC CMOVE;
      XREF PROC WRITE;
      XREF PROC  OCTAL; 
      XREF PROC LEXINIT;     # INITIALIZE SCANNER ON NEW LINE #         010420
      XREF PROC LEXSCAN;     # SCAN NEXT ITEM #                         010430
      XREF PROC REWINDM;     #REWIND FILE #                             010440
      XREF PROC DIAG;        # PRINT DIAGNOSTIC MESSAGE #               010450
      XREF  PROC  CLOSETL;
      CONTROL EJECT;                                                    010550
      PROC STORE;                                                       010560
                                                                        010570
# STORE THE VALUE WHICH IS IN NXTWORD INTO THE ENTRY FOR                010580
  THE VARIABLE PARAMETER WHICH IS IN CURWORD. #                         010590
                                                                        010600
        BEGIN                                                           010610
        ITEM POINTER I;      # ADDRESS OF CURRENT LIST ENTRY #          010620
        ITEM I I;            # LOOP INDEX VARIABLE #                    010630
        ITEM KLOOP;          # LOOP INDEX VARIABLE #
        ITEM ADDR I;         # ADDRESS OF NAME OR VALUE #               010640
        SWITCH STOREVAL CHAR, ERR, INT, REAL, DBLE, CMPLX, LOG;         010650
                                                                        010660
# SEARCH THROUGH THE DEFINE AND THEN THE SPECIFY LIST FOR THE           010670
  ENTRY WITH THE NAME THAT MATCHES WHAT IS IN CURWORD.  POINTER         010680
  CONTAINS THE ABSOLUTE ADDRESS OF THE ENTRY BEING TESTED.  BITS        010690
  17-0 OF WORD 0 OF EACH ENTRY CONTAINS THE LINK TO THE NEXT            010700
  ENTRY.  A LINK EQUAL TO 0 SIGNALS THE END OF THE LIST.  IF THE        010710
  PARAMETER IS NOT FOUND, PRINT A DIAGNOSTIC AND RETURN.  THIS          010720
  IS A NON-FATAL ERROR. #                                               010730
                                                                        010740
        POINTER = DEFLIST;   # START OF DEFINE LIST #                   010750
        FOR KLOOP = KLOOP WHILE POINTER NQ 0 DO 
          BEGIN                                                         010770
          IF B<2,1>RA[POINTER + 2] EQ 0 THEN   # FIND START OF NAME #   010780
            ADDR = POINTER +3;
          ELSE                                                          010800
            ADDR = POINTER +4;
          IF CURLENG EQ B<0,6>RA[POINTER + 1] THEN #CHECK NUM OF CHARS# 010820
            BEGIN                                                       010830
            FOR I=0 STEP 1         #CHECK EACH WORD                    # FIXVARS
              UNTIL CURLENW - 1                                          FIXVARS
            DO                                                           FIXVARS
              BEGIN                                                      FIXVARS
              IF RA[ADDR + I] NQ ICW[I] THEN                            010850
                GOTO NEXTDEF;                                           010860
              END                                                        FIXVARS
            GOTO FOUNDENTRY;                                            010870
            END                                                         010880
NEXTDEF:  POINTER = B<42,18>RA[POINTER];                                010890
          END                                                           010900
                                                                        010910
        POINTER = SPELIST;   # START OF SPECIFY LIST #                  010920
        FOR KLOOP = KLOOP WHILE POINTER NQ 0 DO 
          BEGIN                                                         010940
          IF B<2,1>RA[POINTER + 2] EQ 0 THEN   # FIND START OF NAME #   010950
            ADDR = POINTER +3;
          ELSE                                                          010970
            ADDR = POINTER +4;
          IF CURLENG EQ B<0,6>RA[POINTER + 1] THEN #CHECK NUM OF CHARS# 010990
            BEGIN                                                       011000
            FOR I=0 STEP 1                                               FIXVARS
              UNTIL CURLENW - 1                                          FIXVARS
            DO                                                           FIXVARS
              BEGIN                                                      FIXVARS
              IF RA[ADDR + I] NQ ICW[I] THEN                            011020
                GOTO NEXTSPE;                                           011030
              END                                                        FIXVARS
            GOTO FOUNDENTRY;                                            011040
            END                                                         011050
NEXTSPE:  POINTER = B<42,18>RA[POINTER];                                011060
          END                                                           011070
                                                                        011080
        DIAG(241, CURWORD);  # NOT FOUND #                              011090
        LEXSCAN;                   # SHIFT THE EQUAL SIGN              #
        RETURN;                                                         011100
                                                                        011110
# BRANCH DEPENDING ON THE TYPE OF THE ITEM EXPECTED.  CHECK TO MAKE     011120
  SURE THAT THE TYPE OF THE VALUE IS APPROPRIATE.  IF SO, STORE IT AND  011130
  RETURN.  IF NOT, FATAL ERROR. #                                       011140
                                                                        011150
FOUNDENTRY:   # MOVE UP NEXTWORD TO CURWORD, SO THAT THE VALUE
                ASSOCIATED WITH THE NAME FOUND IN THE DEFINE/SPECIFY
                LIST SHOWS IN NEXWORD.  # 
  
              LEXSCAN;
              IF ICW[0] NQ "=" THEN 
                 BEGIN
                   DIAG(241,CURWORD);   #REPLACE WITH ANOTHER DIAG# 
                   CLOSETL; 
                   STOP;
                 END
  
              I = B<12,6>RA[POINTER+1];   # GET ITEM TYPE FROM LIST # 
              IF I LQ 6 THEN                                            011170
                             GOTO STOREVAL[I];                          011180
                                                                        011190
# ILLEGAL TYPE CODE #                                                   011200
                                                                        011210
ERR:    DIAG (242, RA[ADDR]); 
        CLOSETL;
        STOP;                                                           011230
                                                                        011240
# CHARACTER ITEM #                                                      011250
                                                                        011260
CHAR:   IF NEXTYPE EQ 103 OR NEXTYPE EQ 104 THEN                        011270
                             # VALUE MUST BE CHAR OR MASK #             011280
          BEGIN                                                         011290
          ADDR = B<18,18>RA[POINTER + 1];   # ADDR OF SPACE FOR VALUE # 011300
          FOR I=0 STEP 1           #STORE EACH WORD                    # FIXVARS
            UNTIL NEXLENW - 1                                            FIXVARS
          DO                                                             FIXVARS
            BEGIN                                                        FIXVARS
            RA[ADDR + I] = INWI[I];                                     011320
            END                                                          FIXVARS
          RETURN;                                                       011330
          END                                                           011340
        ELSE                                                            011350
          BEGIN                                                         011360
          DIAG(239, CURWORD);   # WRONG TYPE #                          011370
          CLOSETL;
          STOP;                                                         011380
          END                                                           011390
                                                                        011400
# INTEGER--DECIMAL OR OCTAL #                                           011410
                                                                        011420
INT:    IF NEXTYPE EQ 106 OR NEXTYPE EQ 107 THEN                        011430
          BEGIN                                                         011440
          ADDR = B<18,18>RA[POINTER + 1];                               011450
          RA[ADDR] = INWI[5];      # TAKE CONVERTED RESULT             #
          RETURN;                                                       011470
          END                                                           011480
        ELSE                                                            011490
          BEGIN                                                         011500
          DIAG(239, CURWORD);                                           011510
          CLOSETL;
          STOP;                                                         011520
          END                                                           011530
                                                                        011540
# FLOATING POINT ITEM #                                                 011550
                                                                        011560
REAL:   IF NEXTYPE EQ 108 OR NEXTYPE EQ 111 THEN                        011570
          BEGIN                                                         011580
          ADDR = B<18,18>RA[POINTER + 1];                               011590
          RA[ADDR] = INWI[5];      # TAKE CONVERTED RESULT             #
          RETURN;                                                       011610
          END                                                           011620
        ELSE                                                            011630
          BEGIN                                                         011640
          DIAG(239, CURWORD);                                           011650
          CLOSETL;
          STOP;                                                         011660
          END                                                           011670
                                                                        011680
# DOUBLE PRECISION FLOATING POINT #                                     011690
                                                                        011700
DBLE:   IF NEXTYPE EQ 112 THEN                                          011710
          BEGIN                                                         011720
          ADDR = B<18,18>RA[POINTER + 1];                               011730
          RA[ADDR] = INWI[5];      # TAKE CONVERTED RESULT             #
          RA[ADDR+1] = INWI[6]; 
          RETURN;                                                       011760
          END                                                           011770
        ELSE                                                            011780
          BEGIN                                                         011790
          DIAG(239, CURWORD);                                           011800
          STOP;                                                         011810
          CLOSETL;
          END                                                           011820
                                                                        011830
# COMPLEX NUMBER #                                                      011840
                                                                        011850
CMPLX:  IF NEXTYPE EQ 109 THEN                                          011860
          BEGIN                                                         011870
          ADDR = B<18,18>RA[POINTER + 1];                               011880
          RA[ADDR] = INWI[5];      # TAKE CONVERTED RESULT             #
          RA[ADDR+1] = INWI[6]; 
          RETURN;                                                       011910
          END                                                           011920
        ELSE                                                            011930
          BEGIN                                                         011940
          DIAG(239, CURWORD);                                           011950
          CLOSETL;
          STOP;                                                         011960
          END                                                           011970
                                                                        011980
# LOGICAL VALUE #                                                       011990
                                                                        012000
LOG:    IF NEXTYPE EQ 101 AND NEXLENW EQ 1 THEN   # IDENTIFIER #        012010
          BEGIN                                                         012020
          ADDR = B<18,18>RA[POINTER + 1];                               012030
          IF INW[0] EQ "T" OR INW[0] EQ "TRUE" THEN                     012040
            RA[ADDR] = 1;                                               012050
          ELSE                                                          012060
            IF INW[0] EQ "F" OR INW[0] EQ "FALSE" THEN                  012070
              RA[ADDR] = 0;                                             012080
            ELSE                                                        012090
              BEGIN                                                     012100
              DIAG(243, NEXWORD);   # UNRECOGNIZABLE WORD #             012110
              CLOSETL;
              STOP;                                                     012120
              END                                                       012130
          END                                                           012140
        ELSE                                                            012150
          BEGIN                                                         012160
          DIAG(239, CURWORD);                                           012170
          CLOSETL;
          STOP;                                                         012180
          END                                                           012190
        END                                                             012200
      CONTROL EJECT;                                                    012210
# SCAN THROUGH THE VARIABLE FILE, LOOKING FOR THE LINE THAT STARTS WITH 012220
  RNAME.  IF THE REPORT NAME HAS NOT BEEN FOUND, ISSUE A FATAL
  DIAGNOSTIC AND RETURN.                                               #
                                                                        012260
      SEPARATOR = SEP;                                                  012270
      P<FIT> = LOC(VARFIT);                                              FIXVARS
      FITBBH = TRUE;               # ALLOCATE BUFFERS BELOW HHA        #
      OPENM (VARFIT, $IO$, $R$, RA0);                                   000320
      FOR DUMMY = DUMMY STEP 1
      DO
        BEGIN 
      FOR ILOOP = 0 STEP 1 WHILE ICW[0] NQ RNAME DO 
      BEGIN 
        GET (VARFIT, QUIWSA, RA0);
      P<FIT> = LOC(VARFIT); 
      QUIRL = FITRL;               # SET RECORD LENGTH READ            #
      IF FITES NQ 0                # IF A CRM ERROR OCCURED            #
      THEN
        BEGIN 
        DIAG(903,FITES,FITLFNC);   # DIAGNOSE CRM ERROR                #
        IF REP NQ 0                # IF NOT FIRST REPORT               #
        THEN
          BEGIN 
          WEOR(RPTFIT,0,RA0);      # FLUSH BUFFER                      #
          END 
        CLOSETL;
        STOP;                # STOP REPORT NOW                         #
        END 
        IF FITFP EQ O"100"         #END OF FILE                        # FIXVARS
          OR FITFP EQ O"40"        # IF EOF                            #
        THEN                                                             FIXVARS
          BEGIN 
          CLOSEM(VARFIT, $DET$, RA0);  # CLOSE FILE AND RELEASE BUFFER #
          RETURN; 
          END 
        WP = 0;              #SIGNAL NEW LINE TO LEXSCAN.              #
        LEXINIT;             #INITIALIZE LEXICAL SCAN.                 #
        LEXSCAN;             #GET FIRST INPUT WORD IN ICW.             #
      END 
  
      QUIRL = FITRL;               # RESET RECORD LENGTH               #
      CMOVE (QUIWSA, 0, QUIRL, QUIWSA, 10);      #SHIFT RIGHT FOR PRINT#
      INWORD = "0VARIABLE=";
      WRITE (QUIWSA, QUIRL + 10, RETCODE);
  
                                                                        012540
# READ IN THE REST OF THE CARD WITH THE RIGHT NAME.  FIRST ELIMINATE    012550
  EQUAL SIGNS.  THE CARD NOW CONSISTS OF PAIRS OF THE FORM              012560
  [PARAMETER VALUE].  FOR EACH PAIR, CALL LEXSCAN TO PUT THE PARAMETER  012570
  INTO CURWORD AND THE VALUE INTO NEXWORD.  STORE THE VALUE IN THE      012580
  PARAMETER'S LOCATION IN THE DEFINE OR SPECIFY LIST. #                 012590
                                                                        012600
      FOR ILOOP = 0 STEP 1
      WHILE INW[0] NQ "  "
      DO
        BEGIN                                                           012620
        LEXSCAN;             # SHIFT PARAMETER NAME TO CURWORD AND #    012630
                             # GET VALUE IN NEXWORD #                   012640
        IF CURLENG GR 30 THEN   # LONGER THAN PERMISSIBLE ID #          012650
          BEGIN                                                         012660
          DIAG(241, CURWORD);                                           012670
            IF REP NQ 0 THEN       # IF NOT FIRST REPORT               #
              BEGIN 
              WEOR(RPTFIT, 0, RA0);  # FLUSH BUFFER                    #
              CLOSEM(RPTFIT, $DET$, RA0);  # CLOSE REPORT FILE         #
              END 
          CLOSETL;
          STOP;                                                         012680
          END                                                           012690
        STORE;                                                          012700
        LEXSCAN;             # SHIFT VALUE INTO CURWORD AND #           012710
                             # NEXT PARAMETER INTO NXTWORD #            012720
        END                                                             012730
        END 
      END                                                               012740
      TERM                                                              012750
