ASMB,R,L,C
      NAM !$#&%,1,1 09611-16009 REV. A 75164 -TLD-
* 
* 
* SOURCE 09611-18009
* BINARY 09611-16009
* 
* 
* THIS PROGRAM IS USED TO CONFIGURE THE EQT ENTRY FOR 
* THE OFF-LINE 2313 OR 6940 VERIFICATION RUNNING IN 
* THE RTE-C ENVIRONMENT.  EQT 2 IS CONFIGURED FOR 2313- 
* EQT 3 IS CONFIGURED FOR 6940.  IN ADDITION, THE INTERRUPT 
* TABLE IS CONFIGURED FOR THE PROPER SELECT CODE. LU 2 IS 
* ASSUMED TO POINT TO EQT 2, LU 3 TO EQT 3.  THE DRT FOR
* THE APPROPRIATE LU WILL HAVE THE SUBCHANNEL SET TO 1 FOR
* REMOTE. 
* 
* EXT'S PROVIDE DATA TO DETERMINE WHICH EQT WILL BE CONFIGURED
* EITHER 2313 (EQT 2) OR 6940 (EQT 3).
* 
      EXT EXEC,$LIBR,$LIBX
      EXT !$#&1,!$#&2,!$#&3,!$#&4 
START EQU * 
      JSB EXEC      ASK FOR SC
      DEF *+5 
      DEF D2
      DEF D1
      DEF !$#&1 
      DEF DM20
      JSB EXEC      GET REPLY 
      DEF *+5 
      DEF D1
      DEF B401
      DEF BFR 
      DEF DM2 
      SZB,RSS 
      JMP START     IF TLOG=0 ERROR 
      CPB D1
      JMP START     IF TLOG=1 ERROR 
      LDA BFR       GET CHARS 
      AND B377      MASK
      STA TEMP      SAVE
      LDA BFR       GET CHARS 
      ALF,ALF       GET HI CHAR 
      AND B377      MASK
      JSB D.CHK     CHECK FOR DIGIT 
      JMP START     IF NOT DIGIT ERROR
      ALF,RAR       MULTIPLY BY 8 
      STA BFR       SAVE
      LDA TEMP      GET LOW CHAR
      JSB D.CHK     CHECK FOR DIGIT 
      JMP START     IF NOT DIGIT ERROR
      ADA BFR       ADD UPPER CHAR VALUE
      STA TEMP      SAVE SC 
      ADA DM8       CHECK FOR < 8 
      SSA 
      JMP START     < 8 ERROR 
R.L?  EQU * 
      JSB EXEC      ASK REMOTE OR LOCAL 
      DEF *+5 
      DEF D2
      DEF D1
      DEF QQ
      DEF DM18
      JSB EXEC      GET REPLY 
      DEF *+5 
      DEF D1
      DEF B401
      DEF BFR 
      DEF DM1 
      SZB,RSS 
      JMP R.L?      IF TLOG=0 ERROR 
      LDA BFR       GET CHAR
      ALF,ALF 
      AND B377      MASK
      CPA L         LOCAL?
      JMP NOSCH     YES - NO SUBCHANNEL TO BE SET 
      CPA R         REMOTE? 
      RSS 
      JMP R.L?      NO - ERROR
      JSB $LIBR     TURN OFF INTERRUPT SYSTEM 
      NOP 
      LDB DRT       GET DRT ADDR
      ADB !$#&2     GET OFFSET INTO DRT 
      LDA B,I       GET DRT ENTRY 
      IOR BIT11     TURN ON BIT 11
      STA B,I       REPLACE DRT ENTRY 
      JMP SKPIO     INTERRUPT ALREADY OFF 
NOSCH EQU * 
      JSB $LIBR     TURN OFF INTERRUPT SYSTEM 
      NOP 
SKPIO EQU * 
      LDA !$#&2     GET OFFSET INTO EQT 
      MPY D15       MULTIPLY BY 15
      ADA EQT       ADD EQT ADDR
      LDB INTBA     GET INT TABLE ADDR
      ADB DM6       ADJUST SC 
      ADB TEMP      INDEX INTO TABLE
      STA B,I       SET EQT ADDR INTO INT TABLE 
      LDB A         SAVE EQT ADDR 
      ADB D3        MOVE TO SC WORD 
      LDA B,I       GET WORD
      AND CMASK     MASK SC 
      IOR TEMP      PUT IN NEW SC 
      STA B,I       RESTORE WORD
      JSB $LIBX     TURN ON INTERRUPT SYSTEM
      DEF *+1 
      DEF *+1 
      JSB EXEC      TELL WHICH LU TO USE
      DEF *+5 
      DEF D2
      DEF D1
      DEF !$#&4 
      DEF DM19
      JSB EXEC      SCHEDULE PROGRAM
      DEF *+8 
      DEF D10 
      DEF !$#&3 
      DEF ZERO
      DEF ZERO
      DEF ZERO
      DEF ZERO
      DEF ZERO
      JSB EXEC      TERMINATE 
      DEF *+2 
      DEF D6
D.CHK NOP           CHECK FOR VALID OCTAL DIGIT 
      ADA BM60      ADD -"0"
      SSA 
      JMP D.CHK,I   < "0" SO ERROR
      LDB A 
      ADB DM8       ADD -8
      SSB 
      ISZ D.CHK     IF <= 7 BUMP RETURN 
      JMP D.CHK,I    OTHERWISE ERROR RETURN 
BM60  OCT -60 
B377  OCT 377 
B401  OCT 401 
BFR   NOP 
BIT11 OCT 4000
CMASK OCT 177700
ZERO  NOP 
D1    DEC 1 
D10   DEC 10
D15   DEC 15
D2    DEC 2 
D3    DEC 3 
D6    DEC 6 
DM1   DEC -1
DM2   DEC -2
DM6   DEC -6
DM8   DEC -8
DM18  DEC -18 
DM19  DEC -19 
DM20  DEC -20 
L     OCT 114 
R     OCT 122 
TEMP  NOP 
QQ    ASC  9,LOCAL OR REMOTE? _:
DRT   EQU 1652B 
EQT   EQU 1650B 
INTBA EQU 1654B 
A     EQU 0 
B     EQU 1 
      END START 
                                                                                                                                                                      