*DECK MOV40 
USETEXT TBASCTB 
USETEXT TCONVRT 
USETEXT TDESATT 
USETEXT TEXPRES 
USETEXT TINDTBL 
USETEXT TOPTION 
USETEXT TSBASIC 
      PROC MOV40; 
      BEGIN 
                                                                         MOV40
          XREF PROC CONVERT;
          XREF PROC FIGSUB; 
          XREF PROC MOVEC;
          XREF PROC EXPEVALUATE;
XDEF
      ARRAY P S(EESIZE);
            ITEM PPEDIT B(0,3,1), 
                  PFROMCHAR U(0,4,4), 
                  PNBCHAR U(0,12,12), 
                  PFROMWORD U(0,24,18), 
                  PFROMPTR U(1,24,18),
                  PCONVERTCODE U(1,0,6),
                  PWORD1 U(0,0,60), 
          PTOWORD U(0,42,18),                                           001830
          PTOCHAR U(0,8,4),                                             001840
          PTOPTR U(1,42,18),                                            001850
          PWORD2 U(1,0,60);                                             001860
          ITEM UB;
          BASED ARRAY EVALDATA; 
          BEGIN ITEM EVALWD I(0,0,60);
              ITEM DATADEFADDR I(0,42,18),
              LOGRST B(0,0,1),                                          022530
                   DATASTACK I(0,24,18),
                   DATACNVT I(0,6,18);
          END 
          ARRAY ATTR S(2);
         ITEM AWPOS I(0,18,18), 
               ABPOS U(0,36,6), 
               ALG I(0,42,18),
               ADS U(1,4,11), 
               ADSS I(1,27,15), 
              ACLS I(0,12,6); 
      ARRAY ATTR2 S(2);            # ATTRIBUTES OF INTEGER SUBSCRIPT   #
                                   # USED FOR CONVERT                  #
        BEGIN 
        ITEM AWPOS2 I(0,18,18);    # ADDRESS OF VALUE                  #
        END 
          BASED ARRAY II; ITEM INTE I(,,60);
      BASED ARRAY MOVETBL S(EESIZE);
              ITEM MENTRY    U(0,00,03),
                   MFCHAR    U(0,04,04),
                   MTCHAR    U(0,08,04),
                   MCHARLG   U(0,12,12),  # LENGTH OF FIELD IN CHARS   #
                   MFROMADDR I(0,24,18),
                   MTOADDR   I(0,42,18),
                   MCNVT     U(1,00,06),
                   MSTACKADD I(1,06,18),
                   MADDRFR   I(1,24,18),
                   MADDRTO   I(1,42,18),
                   MWORD1    I(0,00,60),
                   MWORD2    I(1,00,60);
          BASED ARRAY PARAM; ITEM PAR U(,,60);
          XREF PROC DIAG; 
          BASED ARRAY ANYTABLE;    #USED FOR PARAMETERS#
          BEGIN ITEM ANYWD I(,,60); 
                  ITEM ANYWORD C(0,0,10); 
          END 
          ITEM I,RC,J;
  
          ITEM KK I;               # LOOP COUNTER                      #
          ITEM JJ I;               # NO OF ENTRIES IN INDEX TABLE      #
          ITEM LL I;
      ITEM LENG;
          ARRAY DD[6];
              ITEM DDW I(0,0,60), 
          DDEWPOS I(0,18,18), 
          DDBITPOS I(0,36,6);                                           001220
          ITEM SUB,LG,BP,WP,CP,WP1,CP1,BP1; 
          XREF PROC UPBUN;
          ITEM SAVTOAD,UBT; 
          ITEM ALLNM B; 
          ITEM ALLFLG B;
          XREF PROC CMOVE;
          XREF PROC LOGREC; 
          XREF ITEM TYPEC C(1); 
          XREF ITEM BFCM; 
  
          XDEF PROC EXCEV;
          PROC EXCEV; 
           BEGIN P<BASICTABLE> = BASCPTR; 
                P<EVALDATA> = BASCADDR[BASTABIND];
              EVACONT: # #
                FOR I = 0 STEP 1 UNTIL 5 DO 
                BEGIN IF EVALWD[I] EQ 0 THEN RETURN;
                      IF DATASTACK[I] NQ 0 THEN 
                      BEGIN PROGSTACKLOC = DATASTACK[I];
         IF LOGRST[I] THEN LOGICALRESLT=TRUE;                           021440
           ELSE                                                         021450
                            LOGICALRESLT = FALSE; 
                            EXPEVALUATE(RC);  # EVALUATE EXPRESSION    #
                      END 
                      IF DATACNVT[I] NQ 0 THEN
          BEGIN 
          P<MOVETBL> = DATACNVT[I];  # POSITION TO MOVE TABLE          #
          SWITCH EVALTYPE          # SWITCHES ON EVALUATION TYPE       #
            EVACVT,      #0#
            EVAMOV,      #1#
            EVACVT,      #2#
            EVAEVCV,     #3#
            EVASUB;      #4#
  
          GOTO EVALTYPE[MENTRY];
  
EVAMOV: 
          MOVEC(MOVETBL); 
          RC = 0; 
          GOTO NXT; 
  
EVACVT: 
          CONVERT(MOVETBL, RC); 
          GOTO NXT; 
  
EVAEVCV:                           # CONVERT EXPRESSION JUST EVALUATED #
          J = MADDRFR[0];          # MAKE THE FROM ADDRESS RELATIVE    #
          MADDRFR[0] = LOC(J);
          CONVERT(MOVETBL, RC);    # CONVERT THE EVALUATED RESULT      #
          MADDRFR[0] = J;          # CHANGE BACK TO THE ABSOLUTE ADDR  #
          GOTO NXT; 
  
EVASUB: 
          P<INDTBL> = MSTACKADD[0];  # POSITION TO INDEX TABLE         #
          JJ = TBLGS[0] - 1;
          FOR KK = 0 STEP 1 
            UNTIL JJ
          DO
            BEGIN 
            IF DEPNDFG[KK]
            THEN
              BEGIN 
              LL = MADDRFR[0];
            UPBUN(INDTBL, UB, LL,RC);  # CHECK THAT SUBSCRIPT IN RANGE #
              IF RC NQ 0           # IF NOT IN RANGE                   #
              THEN
                BEGIN 
                GOTO NXT; 
                END 
              END 
            JJ = JJ - 1;
            END 
          FIGSUB(MOVETBL, RC);
          GOTO NXT; 
  
NXT:  
          IF RC NQ 0
          THEN
            BEGIN 
            DIAG(RC); 
            END 
          END 
                  END 
          P<EVALDATA> = EVALWD[6];
          IF P<EVALDATA> NQ 0 THEN GOTO EVACONT;
                RETURN; 
          END 
  
      XDEF ITEM NEXTON B; 
      XDEF ITEM TIMES;
          XDEF PROC FIGSUB2;
          PROC FIGSUB2(TBL,RC); 
          BEGIN 
          ARRAY TBL S(2); 
          ITEM TBLENTRY U(0,0,3), 
                 TBLFIG I(1,6,18),
                 TBLADDRF I(1,24,18), 
                 TBLADDRT I(1,42,18); 
          ITEM RC;
          RC = 0; 
          P<INDTBL> = TBLFIG[0];
          UB = UPBND[0];                                                001440
          LENG = 0;                                                     001230
          WP = 0;                                                       001240
          BP = TBLGS[0]-1;                                              001250
          CP = BP;                                                      001260
          IF BP NQ 0 THEN                                               001270
          BEGIN                                                         001280
         REP: # #                                                       000440
                  IF INTESUB[WP] THEN                                   001310
                  BEGIN P<II>=INDCE[WP]; SUB = INTE[WP]; END            001320
                  ELSE SUB = INDCE[WP];                                 001330
          IF DEPNDFG[WP] THEN                                           000460
          BEGIN IF TBLENTRY[0] EQ 4 THEN
                 J = TBLADDRF[0]; 
                 ELSE J = TBLADDRT[0];
                 UPBUN(INDTBL,UB,J,RC); 
                 IF RC NQ 0 THEN RETURN;
          BP = BP - 1; CP = CP - 1;                                     001270
          END                                                           000530
      ELSE LENG = LENG + (SUB-1) * ENTYLG[WP];
              WP = WP + 1;                                              001370
              IF WP LS BP THEN GOTO REP;                                001380
              P<INDTBL> = P<INDTBL> + CP;                               001390
          UB = UPBND[0];           # UPPER BOUND                       #
          END                                                           001400
          LENG = LENG * 6;                                              000930
          IF DEPNDFG[0] THEN
          BEGIN IF TBLENTRY[0] EQ 4 THEN
                 J = TBLADDRF[0]; 
                 ELSE J = TBLADDRT[0];
                 P<INDTBL> = TBLFIG[0]; 
                UPBUN(INDTBL,UB,J,RC);
          IF RC NQ 0 THEN RETURN; 
          P<INDTBL> = P<INDTBL> + CP;                                   000570
          IF LASTFG[0] THEN                                             001510
          BEGIN SUB = UB;                                               001520
          RETURN; 
          END                                                           001540
          ELSE IF NEXTFG[0] THEN                                        001550
          BEGIN UB = UB + 1;                                            001560
                IF UB GR UPBND[0] THEN                                  001570
          BEGIN RC = 942; 
                 RETURN;
          END 
          NEXTON = TRUE;
                SUB = UB;                                               001590
                AWPOS2[0] = LOC(UB);  # FROM ADDRESS IN ATTRIB TABLE   #
                PFROMWORD[0] = LOC(ATTR2) - 1;  # ADDRESS OF ATTRIB    #
                                                # TBL IN CONVERT PARAM #
                PFROMPTR[0] = 0;                                        001610
          PTOPTR[0]=TBLADDRT[0];
          PNBCHAR[0] = ENTYLG[1] ;
                PCONVERTCODE[0] = C<DPTYPE[1],1>CCODE[2];               001630
                PTOCHAR[0] = TBLGS[1];                                  001640
                PFROMCHAR[0] = 0;                                       001650
          IF DPTYPE[1] GQ 1        # IF NUMERIC, INTEGER, OR FIXED     #
            AND DPTYPE[1] LQ 3
          THEN
          BEGIN PTOWORD[0] = LOC(ATTR) - 1; 
                AWPOS[0] = INDCE[1];
                ABPOS[0] = PTOCHAR[0] * 6;
                ALG[0] = PNBCHAR[0];
                ADS[0] = ALG[0];
                ADSS[0] = ALG[0]; 
                ACLS[0] = DPTYPE[1];
          END 
          ELSE
                PTOWORD[0] = INDCE[1];                                  001660
          RETURN; 
          END                                                           001680
          END                                                           001690
          IF INTESUB[0] THEN
          BEGIN P<ANYTABLE> = INDCE[0]; SUB = ANYWD[0]; END 
          ELSE SUB = INDCE[0];
          IF ALLFG[0] THEN BEGIN SUB=1; TIMES=UB; END 
IF SUB GR UB OR SUB LS 1 THEN RC=941; 
          RETURN; 
          END 
          XDEF PROC FIGSUB3;
          PROC FIGSUB3(TBL,DD,LG,CP); 
          BEGIN 
          ARRAY DD[6];
              ITEM DDW I(0,0,60), 
          DDEWPOS I(0,18,18), 
          DDBITPOS I(0,36,6);                                           001220
                 ARRAY TBL S(2);
                 ITEM TBLTCHAR U(0,8,4),
                      TBLTADDR I(0,42,18);
          ITEM CP;
                 ITEM LG; 
                 P<DESATT1> = LG; 
                 LG = ENTYLG[0];
          SUB = SUB - 1;
          WP1 = DEWPOS[0];
                 CP1 = TBLTCHAR[0]; 
          BP1 = DBITPOS[0]; 
          CP = BP1 + WP1 * 60 + LG * SUB * 6; 
          CP = CP + LENG; 
          WP = CP / 60; 
          BP = CP - WP * 60;
                 TBLTCHAR[0] = BP / 6;
                 IF TBLTADDR[0] EQ P<DESATT1> THEN
          BEGIN FOR J = 0 STEP 1 UNTIL 6 DO DDW[J] = DDWORD0[J];
          DDEWPOS[1] = WP;
          DDBITPOS[1] = BP; 
                 TBLTADDR[0] = LOC(DD); 
                 END
                 ELSE TBLTADDR[0] = WP; 
                 RETURN;
          END 
          XDEF PROC MOVEXE; 
          PROC MOVEXE;
          BEGIN P<BASICTABLE> = BASCPTR;
      IF BASCODE[BASTABIND] GQ STORCODE  # IF NOT A STAND-ALONE *MOVE* #
      THEN
        BEGIN 
        P<MOVETBL> = BASCMOVADDR[BASTABIND]; # USE 2ARY PTR TO MOVETBL #
        END 
      ELSE                         # IF THE *MOVE* DIRECTIVE           #
        BEGIN 
        P<MOVETBL> = BASCADDR[BASTABIND];  # USE PRIMARY TABLE PTR     #
        END 
      XDEF ITEM TOAREA B; 
          TOAREA = FALSE; 
      SWITCH TYPE DIRM,DIRM,CNVT,EVA,FIGSU1,FIGSU1,FIGSU1,FIGSU1; 
           MOVCONT: # # 
      FOR I = 0 STEP 1 UNTIL 9 DO 
          BEGIN 
      IF MWORD1[I] EQ 0  THEN RETURN; 
      P<PARAM> = P<MOVETBL> + EESIZE * I; 
          IF MADDRTO[I] NQ 0 THEN TOAREA = TRUE;
                  GOTO TYPE[MENTRY[I]]; 
                DIRM: 
                  MOVEC(PARAM); 
                  TEST I; 
                CNVT: 
                  CONVERT(PARAM,RC);
  IF RC NQ 0 THEN DIAG(RC); 
                  TEST I; 
                EVA:  
                  PROGSTACKLOC = MSTACKADD[I];
                  LOGICALRESLT = FALSE; 
                  EXPEVALUATE(RC);  # EVALUATE EXPRESSION              #
                  J = MADDRFR[I]; 
                  MADDRFR[I] = LOC(J);
                  CONVERT(PARAM,RC);
  IF RC NQ 0 THEN DIAG(RC); 
                  MADDRFR[I] = J; 
                  TEST I; 
                FIGSU:  
          FIGSUB(PARAM,RC); 
          IF RC NQ 0 THEN DIAG(RC); 
          TEST I; 
        FIGSU1: # # 
          ITEM JJ;
          SAVTOAD = MTOADDR[I]; 
          JJ = MSTACKADD[I];
          P<INDTBL> = JJ; 
          IF MENTRY[I] EQ 4 AND NOT ALLFG[0] THEN GOTO FIGSU; 
          FIGSUB2(PARAM,RC);
          IF RC NQ 0 THEN 
          BEGIN DIAG(RC); TEST I; END 
        CONT: # #                                                       001730
          IF MENTRY[I] EQ 4 THEN
          BEGIN 
            ALLITM: # # 
                IF MCNVT[I] EQ 1 THEN 
                BEGIN 
          UB = 1; 
                  BLOCK: # #
                      SUB = UB * MCHARLG[I];
                      P<DESATT1> = MTOADDR[I];
           SUB = UB *DECLSLG[0];
           P<ANYTABLE> = DEWPOS[0];                                     000290
          P<DESATT1> = MFROMADDR[I];                                    000300
                      CP = DECLSLG[0];  #LG#
                      BP = MTCHAR[I]; 
                      WP = MFCHAR[I]; 
                      P<PARAM> = DEWPOS[0]; 
          P<DESATT1> = MADDRFR[I];                                      000340
          IF P<DESATT1> NQ 0 THEN P<PARAM>=P<PARAM>+DDWORD0[0];         000350
          CMOVE(PARAM,WP,SUB,ANYTABLE,BP);                              000360
                END 
                ELSE
                BEGIN 
                      P<DESATT1> = MFROMADDR[I];
                      BP = MCNVT[I];
                      IF BP LS O"11"
                        OR BP GR O"32" THEN 
                        MFROMADDR[I] = DEWPOS[0]; 
                      CONVERT(PARAM,RC);
                      MFROMADDR[I] = P<DESATT1>;
                END 
                IF ALLNM THEN GOTO EVANEXT; 
                TEST I; 
          END 
          LG = B<18,18>INDTBLWD[2]; 
          FIGSUB3(PARAM,DD,LG,CP);
          IF MENTRY[I] EQ 5 THEN
          BEGIN IF ALLFG[0] THEN
                BEGIN J = P<INDTBL>;
                P<INDTBL> = INDCE[2]; 
                IF ALLFG[0] THEN
                BEGIN P<INDTBL> = J;
   # SHOULD CHECK IF CAN DO BLOCK MOVE INSTEAD OF GOTO #
   # ALL ITEMS MUST BE ADJACENT FOR BLOCK MOVE #
       GOTO LPALLALL; 
                END 
                ELSE
                P<INDTBL> = J;
                FIGSUB(PARAM,RC); 
                IF RC NQ 0 THEN GOTO EVANEXT; 
                GOTO LOOPALL; 
          END 
          J = P<INDTBL>;
          P<INDTBL> = INDCE[2]; 
          IF ALLFG[0] THEN
          BEGIN ALLNM = TRUE; 
                P<INDTBL> = J;
                GOTO ALLITM;
          END 
          MSTACKADD[I] = P<INDTBL>; 
                FIGSUB(PARAM,RC); 
          MSTACKADD[I] = JJ;
          P<INDTBL> = JJ; 
          END 
          ELSE IF MENTRY[I] EQ 7 THEN                                   001770
          BEGIN PROGSTACKLOC=INDCE[2];
                  LOGICALRESLT = FALSE; 
                  EXPEVALUATE(RC);  # EVALUATE EXPRESSION              #
          UBT = MADDRFR[I]; 
          MADDRFR[I] = LOC(UBT);
                  CONVERT(PARAM,RC);
          MADDRFR[I] = UBT; 
          IF ALLFG[0] THEN ALLFLG = TRUE; 
          END 
          ELSE
          BEGIN CONVERT(PARAM,RC);
                IF RC EQ 0 AND ALLFG[0] THEN ALLFLG = TRUE; 
          END 
          EVANEXT: # #
          MTCHAR[I] = CP1;
          MTOADDR[I] = SAVTOAD; 
          IF RC NQ 0 THEN DIAG(RC);                                     000830
          IF NEXTFG[0] THEN CONVERT(P,RC);                              002930
          IF NOT ALLFLG THEN
          TEST I; 
        LOOPALL: # #
          IF MADDRTO[I] NQ 0       # RESULT FIELD ADDR RELATIVE        #
          THEN
            BEGIN 
            P<ANYTABLE> = MADDRTO[I]; 
            P<ANYTABLE> = ANYWD[0] + WP;
            END 
          ELSE                     # RESULT FIELD ADDR ABSOLUTE        #
            BEGIN 
            P<ANYTABLE> = WP; 
            END 
          CP = BP / 6;
          CP1 = CP + LG;
          LENG = DECLSLG[0];       # SET LENG TO DATA LENGTH IN CHAR   #
          IF UB GR 1 THEN 
          FOR J = 2 STEP 1 UNTIL UB DO
          BEGIN CMOVE(ANYTABLE,CP,LENG,ANYTABLE,CP1); 
                CP1 = CP1 + LG; 
          END 
          IF NEXTFG[0] THEN CONVERT(P,RC);
          TEST I; 
        LPALLALL: # # 
          CP1=P<INDTBL>;
          P<INDTBL> = INDCE[2]; 
          UBT = UB; 
          J = MADDRFR[I]; 
          UPBUN(INDTBL,UB,J,RC);
           LG = LG * 6; 
          WP1=MSTACKADD[I]; MSTACKADD[I]=P<INDTBL>; 
           IF RC NQ 0 THEN                                              000940
          BEGIN DIAG(RC); GOTO ENDALL;                                  000950
          END                                                           000960
          IF UBT LS UB THEN UB = UBT; 
          ALLFG[0] = FALSE; 
          CONSUB[0] = TRUE; 
          FOR UBT = 1 STEP 1 UNTIL UB DO
          BEGIN INDCE[0] = UBT; 
               FIGSUB(PARAM,RC);
               IF RC NQ 0 THEN GOTO ENDALL; 
               CP = CP + LG;
               WP = CP / 60;
               BP = CP - WP * 60; 
               MTCHAR[I] = BP / 6;
               IF MTOADDR[I] EQ LOC(DD) THEN
       BEGIN
         DDEWPOS[1] = WP; 
         DDBITPOS[1] = BP;
               END
               ELSE MTOADDR[I] = WP;
          END 
        ENDALL: # # 
          ALLFG[0] = TRUE;
          CONSUB[0]  = FALSE; 
          INDCE[0]  = 0;
          P<INDTBL>=CP1; MSTACKADD[I]=WP1;
          GOTO EVANEXT; 
              END 
      IF MWORD1[10] NQ 0 THEN 
      BEGIN I = MWORD1[10]; 
                      P<MOVETBL> = I; 
                      GOTO MOVCONT; 
                END 
          END 
      END 
      TERM; 
