  
100  PRINT "**********************************************" 
110  PRINT "    12556B 40 BIT OUTPUT REGISTER"
115  PRINT "       RTE B DEVICE SUBROUTINE" 
120  PRINT "         VERIFICATION TEST" 
125  REM
126  REM       SOURCE TAPE: 09601-18023 
127  REM       ERS        : 09601-18023-1 
130  PRINT "**********************************************" 
140  PRINT  
150  PRINT  
160  PRINT "FUNCTIONS:" 
170  PRINT "   1 - CHANGE STATUS OF A SINGLE BIT" 
180  PRINT "   2 - OUTPUT 10 BCD DIGITS"
190  PRINT "   3 - OUTPUT ALL ZEROS"
200  PRINT "   4 - OUTPUT ALL 1'S"
210  PRINT "   5 - NEW UNIT NUMBER" 
220  PRINT " ANYTHING ELSE TERMINATES THIS PROGRAM" 
230  PRINT  
232  REM * INITIALIZE ALL VALUES
234  LET A=B=C=X=0
240  PRINT "UNIT NUMBER:";
250  INPUT U
260  IF U=0 GOTO 240
270  PRINT "FUNCTION:"; 
280  INPUT F
290  IF F=1 GOTO 1000 
300  IF F=2 GOTO 2000 
310  IF F=3 GOTO 3000 
320  IF F=4 GOTO 4000 
330  IF F=5 GOTO 230
340  PRINT  
350  PRINT "END OF TEST"
360  PRINT  
370  STOP 
1000  PRINT "SINGLE BIT TEST" 
1010  PRINT "---------------" 
1020  PRINT 
1030  PRINT "INPUT BIT # (41 BITS: 0-40) :";
1040  INPUT B0
1045  IF B0<0 OR B0>40 GOTO 1030
1050  PRINT "1=ON,0=OFF"; 
1060  INPUT S 
1065  IF S#0 AND S#1 GOTO 1050
1070  IF B0#40 GOTO 1100
1080  LET X=S 
1090  GOTO 1190 
1100  LET W=(B0>7)+(B0>23)
1120  LET R=B0-8*(W>0)-16*(W>1) 
1130  IF S=0 AND W=2 IBCLR(A,R,A) 
1140  IF S=0 AND W=1 IBCLR(B,R,B) 
1150  IF S=0 AND W=0 IBCLR(C,R,C) 
1160  IF S=1 AND W=2 IBSET(A,R,A) 
1170  IF S=1 AND W=1 IBSET(B,R,B) 
1180  IF S=1 AND W=0 IBSET(C,R,C) 
1190  FBTWR(U,A,B,C,X,0)
1200  GOTO 270
2000  PRINT "BCD OUTPUT (10 DIGITS)"
2005  PRINT "----------------------"
2007  PRINT 
2010  PRINT "  NUMBER TO BE OUTPUT:"
2020  PRINT 
2030  PRINT "  4 MOST SIGNIFICANT DIGITS (0-9999):";
2040  INPUT A 
2045  IF A<0 OR A>9999 GOTO 2030
2050  PRINT "  4 NEXT MOST SIGNIFICANT DIGITS (0-9999):"; 
2060  INPUT B 
2065  IF B<0 OR B>9999 GOTO 2050
2070  PRINT "  2 LEAST SIGNIFICANT DIGITS (0-99):"; 
2080  INPUT C 
2085  IF C<0 OR C>99 GOTO 2070
2090  PRINT "BIT 41 (0 OR 1):"; 
2100  INPUT X 
2110  FBTWR(U,A,B,C,X,1)
2120  GOTO 270
3000  PRINT "ALL ZEROS OUT" 
3002  PRINT "-------------" 
3004  PRINT 
3005  LET A=B=C=X=0 
3010  FBTWR(U,A,B,C,X,0)
3020  GOTO 270
4000  PRINT "ALL 1'S OUT" 
4004  PRINT "-----------" 
4006  PRINT 
4010  ISETC("177777",A) 
4020  LET B=A 
4030  ISETC("377",C)
4034  LET X=1 
4040  FBTWR(U,A,B,C,X,0)
4050  GOTO 270
9999  END 
        