*DECK TESTC 
          IDENT  T8.TSTC
          TITLE  ROUTINES TESTC, FCPTR
 TESTC    TITLE  TEST PUNCH-CARD SOURCE FIELDS                          036240
*                                                                       036250
**    TESTC - TEST PUNCH-CARD SOURCE FIELDS 
*                                                                       036270
*         THIS CODE IS USED TO PERFORM SELECTION TESTING WHEN THE       036280
*        SOURCE RECORD IS IN PUNCH (HOLLERITH) CODE                     036290
*                                                                       036300
*         INPUT  -  B1 = 1                                              036310
*                   B6 = RETURN ADDRESS                                 036320
*                                                                       036330
*                T.INREC     POINTER TO CURRENT POSITION IN SOURCE      036340
*                T.RECORD    POINTER TO START OF SOURCE                 036350
*                T.COND      CONDITION CODE FOR RELATIONAL              036360
*                                                                       036370
*                   OTHER  T.- CELLS AS DEFINED IN THE PARSE ROUTINE    036380
*                                                                       036390
*         OUTPUT -  X0 = RETURN CODE, 0=TRUE, NOT 0 = FALSE             036400
*                                                                       036410
*         PRESERVED  --, --, --, --, --, --, --, --                     036420
*                    A0, --, --, --, --, --, --, --                     036430
*                        B1, --, --, --, --, B6, --                     036440
*                                                                       036450
          SPACE  1
*CALL COM2
          SPACE  4                                                      036470
*                                                                       036480
* JUMP VECTOR FOR TESTING CARD CODE                                     036490
*                                                                       036500
 TESTC    LETMASK R,(BX)     LEGAL T1 TYPES                             036510
          J      *                                                      036520
          ECHO   1,P=(X,B)                                              036530
          J      TESTC._P                                               036540
*                                                                       036550
          ECHO   4,P=(X,B)
 TESTC._P  LETMASK R,(BX01)  LEGAL T2 TYPES                             036570
          J      *
          ECHO   1,Q=(1,0,X,B)                                          036580
          J      TESTC._P_Q                                             036590
*                                                                       036600
* THE CODE TO DO THE TESTS FOLLOWS                                      036610
*                                                                       036620
          SPACE  4                                                      036630
*                                                                       036640
* THE FOLLOWING ENTRIES ARE FOR SAME-TYPE STRING COMPARES               036650
*                                                                       036660
*                                                                       036670
 TESTC.XX SB7    TST.BB      X-X, OK SINCE HOLLERITH SPACE IS 0         036680
          EQ     FCXVXV 
*                                                                       036700
          SPACE  2                                                      036710
*                                                                       036720
 TESTC.BB SB7    TST.BB      B-B                                        036730
          EQ     FCBVBV 
*                                                                       036750
          SPACE  2                                                      036760
*                                                                       036770
* THE FOLLOWING ENTRIES ARE FOR MIXED TYPE STRING COMPARES              036780
*                                                                       036790
*                                                                       036800
 TESTC.BX SB7    TSTC.1      B-X                                        036810
          EQ     FCBVXV 
 TSTC.1   SX6    B1          BITS PER BIT                               036830
          SA6    T.M1                                                   036840
          SX7    ZERO.P      -SPACE- IN A BIT STRING                    036850
          SB5    TR.BTOP                                                036860
          SX6    SIZE.P                                                 036870
          EQ     TST.SS                                                 036880
*                                                                       036890
          SPACE  2                                                      036900
*                                                                       036910
 TESTC.XB SB7    TSTC.1      X-B                                        036920
          EQ     FCXVBVR
*                                                                       036940
          SPACE  2                                                      036950
*                                                                       036960
 TESTC.B1 SB7    TST.B1      B-LITERAL STRING                           036970
          EQ     FCBVS
*                                                                       036990
          SPACE  2                                                      037000
*                                                                       037010
 TESTC.X1 SB7    TSTC.3A      X-LITERAL STRING
          EQ     FCXVS
 TSTC.3A  SB7    B6           FINAL RETURN
*                                                                       037040
 TSTC.3   SA1    T.T1        LOCAL LOOP DUE TO DOUBLE LOOKUP FOR P-TO-X 037050
          SB6    TSTC.4                                                 037060
          SX2    SIZE.P                                                 037070
          EQ     NXBITS                                                 037080
 TSTC.4   ZR     X0,TSTC.8   NO MORE IN STRING-1                        037090
          SB6    TSTC.5                                                 037100
          EQ     TRANSPC     CONVERT PUNCH TO EBCDIC                    037110
 TSTC.5   SA4    TR.CTOX                                                037120
          SB2    X6                                                     037130
          SA3    X4+B2       GET TABLE ENTRY                            037140
          AX4    18                                                     037150
          SB2    X4          SHIFT COUNT                                037160
          AX4    18          MASK                                       037170
          AX3    X3,B2                                                  037180
          BX5    X3*X4       TRANSLATED CHARACTER IN X5                 037190
          SA7    A1                                                     037200
          SA1    T.T2                                                   037210
          SB6    TSTC.6                                                 037220
          EQ     NCHAR       FAST FORM OF NXBITS                        037230
*                                                                       037240
 TSTC.6   PL     X6,TSTC.7   SECOND STRING NOT EMPTY                    037250
          SX6    SPACE.X     EMPTY, USE BLANK                           037260
 TSTC.7   IX0    X5-X6                                                  037270
          SA7    A1                                                     037280
          ZR     X0,TSTC.3   EQUAL, TRY NEXT PAIR                       037290
          EQ     TST.NES     NOT EQUAL                                  037300
*                                                                       037310
 TSTC.8   SA1    T.T2        FIRST STRING EMPTY, SCAN OUT SECOND        037320
          SB6    TSTC.9                                                 037330
          EQ     NCHAR                                                  037340
 TSTC.9   NG     X6,TST.EQS  DONE, EQUAL                                037350
          SX0    X6-SPACE.X                                             037360
          ZR     X0,NCHAR    SPACE, GO ON                               037370
          BX0    -X0         CORRECT SENSE OF INEQUALITY
          EQ     TST.NES     NOT SPACE, NOT EQUAL                       037380
*                                                                       037390
          SPACE  4                                                      037400
*                                                                       037410
*  THE FOLLOWING SECTIONS HANDLE NUMERIC COMPARISONS.  ARRAYS T.NUM(3)  037420
*   AND T.NUM1(3) ARE USED TO HOLD THE TRIPLE-PRECISION QUANTITIES TO   037430
*   BE COMPARED.  NOTE THAT T.NUM MAY ALREADY BE HOLDING A VALUE IF     037440
*   A NUMERIC LITERAL STRING WAS USED.                                  037450
*                                                                       037460
*   THE COMPARISON IS FOR (T.NUM -REL- T.NUM1).                         037470
*                                                                       037480
*         TEMPORARY CELLS USED..                                        037490
*                                                                       037500
*                T.SAVEB5    TEMPORARY SPOT TO HOLD RETURN ADDRESS      037510
*                T.TEMP                                                 037520
*                                                                       037530
          SPACE  2                                                      037540
*                                                                       037550
* THE FIRST SECTIONS BELOW ARE GENERAL ROUTINES, CORRESPONDING TO       037560
*  ROW AND COLUMN ENTRIES OF THE TEST MATRIX.                           037570
*                                                                       037580
          SPACE  2                                                      037590
*                                                                       037600
 TSTC..0  EQU    TST..0      NUMERIC LITERAL                            037610
*                                                                       037620
          SPACE  2                                                      037630
*                                                                       037640
 TSTC..1  EQU    TST..1      STRING LITERAL                             037650
*                                                                       037660
          SPACE  2                                                      037670
*                                                                       037680
 .A       ECHO   ,Q=(X,B)                                               037690
 TSTC..Q  SB4    CONC.Q.                                                037700
          EQ     TST..$                                                 037710
          SPACE  2                                                      037720
 .A       ENDD                                                          037730
*                                                                       037740
 .B       ECHO   ,Q=(X,B)                                               037750
 TSTC.Q.  SB5    TST.COM                                                037760
          EQ     CONC.Q.                                                037770
 .B       ENDD                                                          037780
*                                                                       037790
          SPACE  4                                                      037800
*                                                                       037810
* GENERATE CODE FOR THE TEST POINTS                                     037820
*                                                                       037830
*                                                                       037840
 .A       ECHO   ,P=(X,B),S=(XV,B)
 .B       ECHO   ,Q=(0),T=(( ))                                         037860
 XXX      SYMBOL                                                        037870
 TESTC.P_Q  SB7  "XXX"       P-Q                                        037880
          EQ     FC_S_T 
 "XXX"    SB5    TSTC.P.                                                037900
          EQ     TSTC..Q                                                037910
          SPACE  2                                                      037920
 .B       ENDD                                                          037930
 .A       ENDD                                                          037940
 FCPTR    TITLE  FIXPTR -- SUBROUTINES TO FIX UP TEST POINTERS (CARD)   010750
*                                                                       010760
****  FCPTR - A SERIES OF ROUTINES TO FIX UP POINTERS FOR TESTING FIELDS
*         IN CARD (HOLLERITH) CODE                                      010780
*                                                                       010790
          SPACE  1,17                                                   010810
*                                                                       010820
*     THE FOLLOWING ROUTINES ARE USED TO SET AND CHECK THE POINTERS     010830
*      FOR TESTING.  THEY USE THE SINGLE POINTER PICKUP ROUTINES        010840
*      DESCRIBED LATER.                                                 010850
*                                                                       010860
*      ALL OF THESE ROUTINES PUT POINTER 1 IN T.T1 AND POINTER 2 IN T.T2010870
*      UNLESS THE NAME IS SUFFIXED BY -R-, IN WHICH CASE THE POINTERS   010880
*      ARE REVERSED.                                                    010890
*                                                                       010900
*      ENTER WITH   B7 = RETURN ADDRESS                                 010910
*                                                                       010920
*      THE ROUTINES ARE NAMED.. FC-A-B                                  010930
*         WHERE A AND B ARE ONE OF    B   - BIT STRING                  010940
*                                     BV  - BIT STRING (VARIABLE LENGTH)
*                                     XV  - 12-BIT CHARACTER STRING 
*                                           (VARIABLE LENGTH) 
*                                     S  - THE LITERAL STRING           010960
*                                  BLANK - THE NUMERIC LITERAL          010970
*                                                                       010980
****
          SPACE  4                                                      011000
 FC.      SA7    T.T2 
          JP     B7 
* 
 FC.R     SA3    T.COND      REVERSE ORDER TEST 
          LX4    X3,B1
          BX4    X4-X3       XOR BITS 1 AND 2 OF CONDITION FLAG 
          LX4    59-2 
          PL     X4,FC.RX    EQUAL OR NOT EQUAL, NO CHANGE
          SX6    6B 
          BX6    X3-X6       FLIP SENSE OF INEQUALITY 
          SA6    A3 
 FC.RX    SA7    T.T1 
          JP     B7 
          SPACE  3
*                                                                       011060
 .B       ECHO   ,Q=(BV,XV,S) 
          SPACE  2                                                      011080
 FC._Q    SA7    T.T1                                                   011090
          SB3    FC.                                                    011100
          EQ     FCP2M_Q                                                011110
 .A       ECHO   ,P=(BV,XV) 
          SPACE  1                                                      011130
 FC_P_Q     SB3    FC._Q                                                011140
          EQ     FCP1M_P                                                011150
 .A       ENDD                                                          011160
 .B       ENDD                                                          011170
*                                                                       011180
 FC.BVR   SA7    T.T2        REVERSE POINTER SPECIAL
          SB3    FC.R                                                   011200
          EQ     FCP2MBV
 FCXVBVR  SB3    FC.BVR 
          EQ     FCP1MXV
*                                                                       011240
*                                                                       011250
* THE FOLLOWING ARE USED FOR -0 TYPES (NUMERIC LITERAL)                 011260
*                                                                       011270
 .B       ECHO   ,Q=(B,XV)
          SPACE  2                                                      011290
 FC_Q      SB3    FC.RX 
          EQ     FCP1M_Q                                                011310
 .B       ENDD                                                          011320
*                                                                       011330
          SPACE  4,19                                                   011340
**    THE FOLLOWING ROUTINES PICK UP A POINTER, PUT IT IN X7, AND 
*         CHECK THE M-VALUE FOR LEGALITY..                              011370
*                                                                       011380
*                   FCP1MB         -PTR 1, BIT STRING                   011390
*                   FCP2MB         -PTR 2, BIT STRING                   011400
*                                                                       011410
*                   FCP1MBV        -PTR 1, BIT STRING (VAR. LENGTH) 
*                   FCP2MBV        -PTR 2, BIT STRING (VAR. LENGTH) 
* 
*                   FCP1MXV        -PTR 1, 12-BIT CHARACTER STRING (VAR)
*                   FCP2MXV        -PTR 2, 12-BIT CHARACTER STRING (VAR)
*                                                                       011440
*                   FCP2MS         SPECIAL, LITERAL CHARACTER STRING    011450
*                                                                       011460
*      ENTER WITH..                                                     011470
*                                                                       011480
*         B3 = RETURN ADDRESS                                           011490
*                                                                       011500
*      THESE ROUTINES CALL FCP1 AND FCP2                                011510
*                                                                       011520
          SPACE  4                                                      011540
 FCP1MB   SB5    FCPM.1      PTR 1, BIT FIELD                           011550
          SB4    B1                                                     011560
          EQ     FCP1                                                   011570
 FCPM.1   SA3    T.M1                                                   011580
 FCPM.2   PL     X3,FCPM.3                                              011590
          SX3    1           USE 1 BIT IF UNSPECIFIED                   011600
 FCPM.3   BX6    X7                                                     011610
          AX6    36                                                     011620
          IX6    X6-X3                                                  011630
          NG     X6,FCPM.E2  ERROR, FIELD EXTENDS PAST END OF RECORD    011640
 FCPM.3A  MX0    24 
          LX3    36          ALIGN NEW LENGTH 
          BX6    -X0*X7      MAKE HOLE FOR LENGTH 
          IX7    X6+X3       UPDATED PTR WORD 
 FCPM.3B  BX1    X7          PTR
          JP     B3                                                     011650
*                                                                       011660
 FCP2MB   SB5    FCPM.4      PTR 2, BIT FIELD                           011670
          SB4    B1                                                     011680
          EQ     FCP2                                                   011690
 FCPM.4   SA3    T.M2                                                   011700
          EQ     FCPM.2                                                 011710
*                                                                       011720
 FCP1MBV  SB5    FCPM.5      PTR 1, BIT FIELD (VARIABLE LENGTH) 
          SB4    1
          EQ     FCP1 
 FCPM.5   SA3    T.M1 
 FCPM.5A  PL     X3,FCPM.5B 
          SX3    1           USE 1 BIT IF UNSPECIFIED 
 FCPM.5B  BX6    X7 
          AX6    36 
          IX6    X6-X3
          PL     X6,FCPM.3A  USE SPECIFIED LENGTH 
          EQ     FCPM.3B     USE REST OF RECORD 
* 
 FCP2MBV  SB5    FCPM.5C     PTR 2, BIT FIELD (VARIABLE LENGTH) 
          SB4    1
          EQ     FCP2 
 FCPM.5C  SA3    T.M2 
          EQ     FCPM.5A
* 
 FCP1MXV  SB5    FCPM.6      PTR 1, 12-BIT CHARACTER FIELD (VAR.) 
          SB4    B0                                                     011740
          EQ     FCP1                                                   011750
 FCPM.6   SA3    T.M1                                                   011760
 FCPM.7   PL     X3,FCPM.8                                              011770
          SX3    B1          USE 1 CHAR IF UNSPECIFIED                  011780
 FCPM.8   LX3    2           *4                                         011790
          IX6    X3+X3       *8                                         011800
          IX3    X3+X6       *12                                        011810
          EQ     FCPM.5B
*                                                                       011830
 FCP2MXV  SB5    FCPM.10     PTR 2, 12-BIT CHARACTER FIELD (VAR.) 
          SB4    B0                                                     011850
          EQ     FCP2                                                   011860
 FCPM.10  SA3    T.M2                                                   011870
          EQ     FCPM.7                                                 011880
*                                                                       011890
 FCP2MS   SA2    T.I2        SET UP POINTER TO LITERAL STRING 
          SX7    T.STRING                                               011910
          LX2    36                                                     011920
          BX7    X2+X7                                                  011930
          BX1    X7 
          JP     B3                                                     011940
*                                                                       011950
          SPACE  2                                                      011960
**    ERROR ACTIONS 
*                                                                       011990
 FCPM.E2  SA2    FCPM.M2     ERROR, FIELD EXTENDS PAST END OF RECORD    012000
          EQ     ERR.CON                                                012010
****
*                                                                       012020
 FCPM.M2  VFD    12/0,18/E.TST,12/0,18/*+1
          DATA   C/TEST FIELD EXTENDS PAST END OF RECORD/               012040
****
          SPACE  4,17                                                   012050
**    FCPTR IS THE WORKER-BEE IN THIS SET OF ROUTINES.  IT EXPECTS
*                                                                       012080
*         X2   = REL WORD                                               012090
*         X3   = I WORD                                                 012100
*         A4   = ADDRESS OF W WORD                                      012110
*         B5   = RETURN ADDRESS                                         012120
*                                                                       012130
*         THE RESULTANT POINTER IS LEFT IN X7 UPON EXIT.                012140
*                                                                       012150
* FCP1, FCP2 ARE USED TO CALL FCPTR WITH THE PROPER POINTERS (1 OR 2)   012160
*             ENTER WITH                                                012170
*                                                                       012180
*         B4   = CHAR/BIT FLAG. (0=CHAR, 1=BIT)                         012190
*         B5   = RETURN ADDRESS, RETURN IS DIRECTLY FROM FCPTR          012200
*                                                                       012210
          SPACE  2                                                      012230
 FCPTR    LX3    2           I*4                                        012240
          IX0    X3+X3        *8                                        012250
          SA5    T.RECORD                                               012260
          IX0    X0+X3       *12                                        012270
          PL     X2,FCPT.1   JP IF FEL                                  012280
          SX3    12          ABS, OFFSET BY 12 BITS                     012290
          IX0    X0-X3                                                  012300
          EQ     FCPT.A                                                 012310
 FCPT.1   LX2    59          REL, FIX UP SIGN OF OFFSET                 012320
          SA3    T.INREC     CURRENT POINTER                            012330
          AX2    59                                                     012340
          SX7    X5          ADDRESS OF RECORD START                    012350
          BX0    X0-X2       SIGNED OFFSET IN X0                        012360
          SX6    X3          ADDRESS OF CURRENT BYTE                    012370
          AX5    18                                                     012380
          IX7    X6-X7       NUMBER OF WORDS TO CURRENT POSITION        012390
          AX3    18                                                     012400
          SX5    X5          USED BITS FROM START                       012410
          BX6    X7                                                     012420
          SX4    X3          USED BITS AT CURRENT POSITION              012430
          LX6    6           WORDS * 64                                 012440
          IX4    X4-X5       EXTRA BIT OFFSET IN POINTER DIFFERENCE     012450
          LX7    2           WORDS * 4                                  012460
          IX0    X0+X4                                                  012470
          SA5    A5                                                     012480
          SX2    11                                                     012490
          IX0    X0+X6                                                  012500
          IX0    X0-X7       BIT OFFSET TO DESIRED POSITION IN X0       012510
          IX0    X0+X2                                                  012520
          IX0    X0/X2,12    MAKE IT A MULTIPLE OF 12                   012530
          LX0    2           *4                                         012540
          IX2    X0+X0       *8                                         012550
          IX0    X0+X2       *12                                        012560
*                                                                       012570
 FCPT.A   SA4    A4          PICK UP W OFFSET                           012580
          SX7    X5          BASE WORD                                  012590
          AX5    18                                                     012600
          ZR     X4,FCPT.A1 
          SX4    X4-1 
 FCPT.A1  BSS    0
          IX0    X0+X4       FINAL OFFSET INTO RECORD                   012610
          SX6    X5          USED BITS IN FIRST WORD                    012620
          AX5    18                                                     012630
          NG     X0,FCPT.E1  ERROR, OFFSET IS NEGATIVE                  012640
          IX5    X0-X5                                                  012650
          IX0    X0+X6       MAKE OFFSET RELATIVE TO A WORD BOUNDARY    012660
          PL     X5,FCPT.B   FIELD PAST RIGHT END OF RECORD 
          BX2    X0                                                     012680
          BX5    -X5         REMAINING BITS AFTER ADJUSTMENT            012690
          IX2    X2/X3,60    GET NUMBER OF WORDS OFFSET                 012700
          IX7    X7+X2       ADD TO BASE WORD                           012710
          LX5    36                                                     012720
          BX3    X2                                                     012730
          LX2    6           *64                                        012740
          IX0    X0-X2                                                  012750
          LX3    2           *4                                         012760
          IX0    X0+X3       GIVES USED BITS                            012770
          BX7    X7+X5                                                  012780
          LX0    18                                                     012790
          BX7    X7+X0       POINTER WORD NOW IN X7                     012800
          JP     B5          EXIT                                       012810
* 
 FCPT.B   MX7    0           NULL FIELD, PAST RECORD END
          JP     B3 
          SPACE  2
**    ERROR ACTIONS 
*                                                                       012840
 FCPT.E1  SA2    FCPT.M1     ERROR, POSITION OFF LEFT END               012850
          EQ     ERR.CON                                                012860
****
*                                                                       012890
 FCPT.M1  VFD    12/0,18/E.TST,12/0,18/*+1
          DATA   C/TEST FIELD NOT IN RECORD, ON LEFT/                   012910
****
          SPACE  4                                                      012950
*                                                                       012960
 FCP1     SA4    T.W1        PROCESS POINTER 1                          012970
          SA2    T.REL1                                                 012980
          SA3    T.I1                                                   012990
          NZ     X3,FXPTNZ
          SX6    B0 
          BX3    X6 
          SA6    T.REL1            FORCE TO +0
          BX2    X3 
          SA6    T.I1 
 FXPTNZ   BSS    0
          ZR     X4,FCPTR                                               013000
          NZ     B4,FCPTR                                               013010
          EQ     FCP.E1      ERROR, W NOT ZERO                          013020
*                                                                       013030
 FCP2     SA4    T.W2        PROCESS POINTER 2                          013040
          SA2    T.REL2 
          SA3    T.I2 
          NZ     X3,FXPTNZ2 
          SX6    B0 
          BX3    X6 
          SA6    T.REL2 
          BX2    X3 
          SA6    T.I2 
 FXPTNZ2  BSS    0
          ZR     X4,FCPTR                                               013070
          NZ     B4,FCPTR                                               013080
          EQ     FCP.E2      ERROR, W NOT ZERO                          013090
*                                                                       013100
* ERROR ACTIONS                                                         013110
*                                                                       013120
 FCP.E1   SA2    FCP.M1                                                 013130
          EQ     ERR.CON                                                013140
 FCP.E2   EQU    FCP.E1                                                 013150
****
*                                                                       013160
 FCP.M1   VFD    12/0,18/E.TST,12/0,18/*+1
          DATA   C/BIT SPECIFICATION ILLEGAL FOR NON BIT FIELD/         013180
****
          END 
