FTN4,L
      PROGRAM FGETR(3,90),24999-16053 REV.2024 800514 
C 
C 
C                   THIS PROGRAM ALLOWS THE USER TO ACCESS FILES ON 
C                   JSAVE MAG TAPES. IT ALSO WILL GIVE A "DL" ON THE
C                   FILE FOR HIM. THE DIRECTORY LIST IS SLIGHTLY
C                   FASTER THAN THE FILE MANAGER BECAUSE IT DOES
C                   TRACK BUFFERS AT A TIME.
C 
C                   THE ONLY ROUTINE OTHER THAN THIS REQUIRED IS
C                   ASCII WHICH DOES A BINAR TO ASCII CONVERSION
C                   WITH LEADING ZEROS LEFT. THE ROUTINE IS IN
C                   ASSEMBLER THE CALLING SEQUNCE IS
C                   CALL ASCII(I,J,K) 
C 
C                   I IS THE BINARY NUMBER
C                   J IS THE ADDRESS OF THE RESULT (3 WORDS)
C                   K IS THE BASE WE WANT THE RESULT IN 
C 
C 
C     REVISIONS FOR 2024
C 
C         1) ABLE TO HANDLE 7925 DISC 
C         2) HANDLE TYPE 2 FILES CORRECTLY
C         3) GIVE CORRECT HEADINGS WHEN DOING MORE THAN ONE DL. 
C         4) POSITION TO MT FILE CORRECTLY FROM ANYWHERE. 
C         5) IMPROVE PROGRAM FLOW (HOPEFULLY FRIENDLINESS)
C 
      DIMENSION ID(144),NA(3),LT(40),LS(40),NS(40),NA2(3) 
      DIMENSION LU(5),IREG(2),MBUF(52),IPBUF(33)
      DIMENSION IBUF(8193),JBUF(8192),IANS(2),MES11(10) 
C                   ******     ****** 
      DIMENSION LIN(24),LIN1(5),KFILE(5)
      DIMENSION LIN2(35),LIN3(24),NSS(2)
C                       ****************
      INTEGER FIRST,LAST,FILE 
      EQUIVALENCE (IA,IREG),(IB,IREG(2)),(X,IREG) 
      EQUIVALENCE (IBUF,ITRAK),(JBUF,IBUF(2)) 
      EQUIVALENCE (IBUF(4),IBUF4) 
C 
C*********************
      DATA JLNTH/8192/
C*********************
      DATA KFILE/6412B,2H F,2HIL,2HE ,2H  / 
C*************************************************************
C 
C     REMOVED MESS1 TO,MES10 AND MES12 TO MES15 FROM DATA AREA
C 
C*************************************************************
      DATA MES11/2H F,2HIL,2HE ,2HCR,2HEA,2HTI,2HON,2H E,2HRR,2HOR/ 
      DATA LIN/24*2H  / 
      DATA LIN1/2H  ,2HCR,2H,3*2H  /
      DATA LIN2/2H  ,2H I,2HLA,2HB=,3*2H  ,2H N,2HXT,2HR=,
     *2*2H  ,2H N,2HXS,2HEC,2*2H  ,2H #,2HSE,2HC/,2HTR,2*2H  ,
     *2H L,2HAS,2HT ,2HTR,2H= ,2*2H  ,2H #,2HDR,2H T,2HR=,2H  / 
      DATA LIN3/2H  ,2HNA,2HME,2H  ,2H T,2HYP,2HE ,2H#B,2HLK, 
     *2HS/,2HLU,2H S,2HCO,2HDE,2H T,2HRA,2HCK,2H S,2HEC,2H  , 
     *2HOP,2HEN,2H T,2HO /
      CALL RMPAR(LU)
      IF(LU.EQ.0)LU=1 
      ILU=LU+400B 
C***********************************************************
      CALL EXEC(2,LU,2H  ,-2) 
      CALL EXEC(2,LU,30H 24999-16053 2024 SSK SYS 1000,-30) 
C***********************************************************
C 
C   GET MAG TAPE LU 
C 
C********************************************** 
10    CALL EXEC(2,ILU,2H  ,-2)
      CALL EXEC(2,ILU,16H  MAG TAPE LU: _,-16)
C********************************************** 
      X=REIO(1,ILU,MBUF,10) 
      IF (MBUF.EQ.2H/E)GO TO 380
      CALL PARSE(MBUF,IB*2,IPBUF) 
      MTLU=IPBUF(2) 
C 
      CALL EXEC(13,MTLU,ISTAT)
      IF(IAND(ISTAT,37400B)*2.EQ.23000B)GO TO 20
      IF(IAND(ISTAT,37400B)*2.EQ.24000B)GO TO 20
C*****************************************************
      CALL EXEC(2,ILU,24H  THAT'S NOT A MAG TAPE!,-24)
C*****************************************************
      GO TO 10
C*********************************************
20    IREG=LURQ(100001B,MTLU,1) 
      IF(IREG.EQ.0)GO TO 30 
      CALL EXEC(2,ILU,16HLU LOCK REJECTED,-16)
C*********************************************
      GO TO 380 
C 
30    REWIND MTLU 
40    FILE=1
C 
C 
C   GET MAG TAPE FILE NUMBER AND IDENT
C 
C***********************************************
50    IFLG = 0
      CALL EXEC(2,ILU,2H  ,-2)
      CALL EXEC(2,ILU,18H  MAG TAPE FILE: _,-18)
C***********************************************
      X=REIO(1,ILU,MBUF,10) 
      IF(MBUF .EQ. 2H/E)GO TO 380 
      CALL PARSE(MBUF,IB*2,IPBUF) 
      NFILE=IPBUF(2)
      IF(NFILE.LT.0)GO TO 380 
      IF(NFILE.EQ.0)NFILE = FILE
C 
C 
C 
C   POSITION THE TAPE 
C 
C********************************** 
      IF(NFILE .GT. 1)GO TO 60
      REWIND MTLU 
      FILE = 1
      GO TO 120 
60    IF(FILE.EQ.NFILE)GO TO 110
      CALL EXEC(3,MTLU+1400B) 
      IF(FILE.EQ.1)GO TO 70 
      CALL EXEC(3,MTLU+1300B) 
70    CALL EXEC(1,MTLU,MBUF,50) 
      CALL HEADL(MBUF,LEN)
      KFILE(5)=KCVT(FILE) 
      CALL EXEC(2,ILU,KFILE,5)
      CALL EXEC(2,ILU,MBUF,LEN) 
C 
C                   FORWORD-BACK WORD  UP PROCESSOR 
C 
C 
      IF(NFILE.GT.FILE)GO TO 80 
      GO TO 90
C 
C 
C                   FORWORD 
C 
C 
80    CALL EXEC(3,MTLU+1300B) 
      FILE=FILE+1 
      IF(FILE.EQ.NFILE)GO TO 120
      KFILE(5)=KCVT(FILE) 
      CALL EXEC(2,ILU,KFILE,5)
      CALL EXEC(1,MTLU,MBUF,50) 
      CALL HEADL(MBUF,LEN)
      CALL EXEC(2,ILU,MBUF,LEN) 
      GO TO 80
C 
C 
C                   BACK WORD 
C 
C 
90    FILE=FILE-1 
      CALL EXEC(3,MTLU+1400B) 
      CALL EXEC(3,MTLU+1400B) 
      IF(FILE.EQ.1)GO TO 120
      CALL EXEC(3,MTLU+1300B) 
100   IF(FILE .EQ. NFILE)GO TO 120
      CALL EXEC(1,MTLU,MBUF,50) 
      KFILE(5)=KCVT(FILE) 
      CALL EXEC(2,ILU,KFILE,5)
      CALL HEADL(MBUF,LEN)
      CALL EXEC(2,ILU,MBUF,LEN) 
      GO TO 90
C 
C 
C   GET HEADER AND CHECK IF THAT'S WHAT HE WANTS
C 
110   CALL EXEC(3,MTLU+1400B) 
      IF(FILE.EQ.1)GOTO 120 
      CALL EXEC(3,MTLU+1300B) 
120   CALL EXEC(1,MTLU,MBUF,50) 
      KFILE(5)=KCVT(FILE) 
      CALL EXEC(2,ILU,KFILE,5)
      CALL HEADL(MBUF,LEN)
C 
C     SET UP A ' ? _' IN THE BUFFER.
C 
      LEN=LEN+1 
      MBUF(LEN)=20077B
      LEN = LEN + 1 
      MBUF(LEN)=20137B
C***********************************************
130   CALL EXEC(2,ILU,MBUF,LEN) 
      CALL REIO(1,ILU,IANS,2) 
      IF(IANS.EQ.2HYE)GO TO 150 
      IF(IANS.EQ.2HNO)GO TO 50
C**************************** 
      CALL EXEC(3,MTLU+1400B) 
      IF(FILE.EQ.1)GO TO 140
      CALL EXEC(3,MTLU+1300B) 
140   GO TO 120 
C 
C         ASK IF THEY WANT A DIRECTORY LISTING OF THAT FILE 
C 
C*********************************************************
150   CALL EXEC(2,ILU,2H  ,-2)
      CALL EXEC(2,ILU,28H  DO YOU WISH A DIRECTORY ?_,-28)
C*********************************************************
      CALL REIO(1,ILU,IANS,2) 
      IF (IANS.EQ.2H/E)GO TO 380
      IF(IANS.NE.2HYE)GO TO 160 
      IFLG=1
C 
C                   ASK WHERE HE WOULD LIKE IT
C 
C**************************************** 
      CALL EXEC(2,ILU,2H  ,-2)
      CALL EXEC(2,ILU,11H  WHAT LU _,-11) 
C**************************************** 
      X=REIO(1,ILU,IANS,2)
      IF (IANS.EQ.2H/E)GO TO 380
      CALL PARSE(IANS,IB*2,IPBUF) 
      LIST=IPBUF(2) 
      GO TO 200 
C 
C              DOESNT WANT A DIRECTORY ASK FOR A FILE NAME
C 
C*****************************************************
160   CALL EXEC(2,ILU,2H  ,-2)
      CALL EXEC(2,ILU,24H  FILE NAMR,<NEW NAMR>:_,-24)
C*****************************************************
      MBUF=2H 
      MBUF(2)=2H
      MBUF(3)=2H
      X=REIO(1,ILU,MBUF,30) 
      IF (MBUF.EQ.2H/E)GO TO 380
      IF (IB .EQ. 0)GO TO 350 
      ICHRS = IB * 2
      IP = 1
      IF (NAMR(IBUF,MBUF,ICHRS,IP)) 160 ,170
170   IT = IAND (IBUF4,3) 
      IF(IT .LE. 1)GO TO 160
      NA (1) = IBUF (1) 
      NA (2) = IBUF (2) 
      NA (3) = IBUF (3) 
      ISC2 = IBUF(5)
      ICR2 = IBUF(6)
      IF (NAMR(IBUF,MBUF,ICHRS,IP)) 190 ,180
180   IT = IAND (IBUF4,3) 
      ISCHK = ISOL8(IBUF4,2,3)
      ICCHK = ISOL8(IBUF4,4,5)
      IF(IT .LE. 1)GO TO 190
      NA2 (1) = IBUF (1)
      NA2 (2) = IBUF (2)
      NA2 (3) = IBUF (3)
      IF(ISCHK .NE. 0) ISC2 = IBUF (5)
      IF(ICCHK .NE. 0) ICR2 = IBUF (6)
      GO TO 200 
190   NA2 (1) = NA (1)
      NA2 (2) = NA (2)
      NA2 (3) = NA (3)
C**************************** 
C 
C                   WERE THERE AT THE FILE READ IN THE DIRECTORY
C                   TRACKS AND EITHER FIND OUR FILE OR FORMAT THE 
C                   INFO AND OUTPUT IT TO THE LIST DEVICE 
C 
200   ISUM=0
      NSS=0 
      NSS(2) = 0
      MR=0
210   M=1 
      ISEC=0
      JSEC=0
C 
C     ********************************************************
C     *             READ A RECORD FROM MAG TAPE              *
C     ********************************************************
C 
C                   READ A TRACK
C 
      X = EXEC(1,MTLU,IBUF,JLNTH+1) 
      IF(IAND(IREG,200B).NE.0)GO TO 350 
C 
C                   IF FIRST DIRECTORY TRACK FIRST 16 WORDS 
C                   ARE PACK LBL INFO 
C 
      IF(MR.NE.0)GO TO 220
      M=17
      ISPT=JBUF(7)
      IBPT=ISPT/2 
      JLNTH=64*ISPT 
      IF(IFLG.EQ.0)GO TO 220
C 
C                   FORMAT AND OUTPUT THE DL HEADER INFO
C 
      CALL ASCII(JBUF(4),LIN1(3),10)
      LIN1(3)=IAND(LIN1(3),177B)+36400B 
      CALL EXEC(3,1100B+LIST,-1)
      CALL EXEC(2,LIST,LIN1,5)
      LIN2(5)=IAND(JBUF(1),77777B)
      LIN2(6)=JBUF(2) 
      LIN2(7)=JBUF(3) 
      CALL ASCII(JBUF(10),MBUF,10)
      LIN2(11)=MBUF(2)
      LIN2(12)=MBUF(3)
      CALL ASCII(JBUF(6),MBUF,10) 
      LIN2(16)=IAND(MBUF(2),177B)+36400B
      LIN2(17)=MBUF(3)
      CALL ASCII(JBUF(7),MBUF,10) 
      LIN2(22)=IAND(MBUF(2),177B)+36400B
      LIN2(23)=MBUF(3)
      IA=JBUF(8)-JBUF(9)-1
      CALL ASCII(IA,MBUF,10)
      LIN2(29)=MBUF(2)
      LIN2(30)=MBUF(3)
      IA=-JBUF(9) 
      CALL ASCII(IA,MBUF,10)
      LIN2(35)=MBUF(3)
      CALL EXEC(2,LIST,LIN2,35) 
      CALL EXEC(3,1100B+LIST,1) 
      CALL EXEC(2,LIST,LIN3,24) 
      CALL EXEC(3,1100B+LIST,1) 
C 
C                   SCAN THE ENTIRE TRACK LOOP
C 
220   DO 270 N=M,128,16 
C 
C                   COMPUTE THE FILE INFO OFFSET
C 
      MR=N+ISEC*64
C 
C                   IF ELEMENT = -1 FILE WAS PURGED IGNORE
C 
      IF(JBUF(MR).EQ.-1)GO TO 270 
C 
C                   IF = 0 END OF DIRECTORY GET OUT 
C 
      IF(JBUF(MR).EQ.0)GO TO 280
      IF(IFLG.EQ.0)GO TO 260
C 
C                   DO DL FORMATTING STUFF
C 
      DO 230 IA=1,24
230   LIN(IA)=2H
      LIN(2)=JBUF(MR) 
      LIN(3)=JBUF(MR+1) 
      LIN(4)=JBUF(MR+2) 
      CALL ASCII(JBUF(MR+3),LIN(5),10)
      IF(IAND(LIN(5),77400B).EQ.30000B)LIN(5)=IAND(LIN(5),177B) 
     1+20000B 
      IF(JBUF(MR+3).EQ.0)GO TO 240
      IA=JBUF(MR+6)/2 
      CALL ASCII(IA,LIN(8),10)
      IF(IAND(LIN(8),77400B).EQ.30000B)LIN(8)=IAND(LIN(8),177B) 
     1+20000B 
      CALL ASCII(JBUF(MR+4),LIN(15),10) 
      LIN(15)=20040B
      IA=IAND(JBUF(MR+5),377B)
      CALL ASCII(IA,MBUF,10)
      LIN(18)=MBUF(2) 
      IF(IAND(LIN(18),77400B).EQ.30000B)LIN(18)=IAND(LIN(18)
     1,177B)+20000B 
      LIN(19)=MBUF(3) 
      IA=0
      IF(JBUF(MR+5).LT.0)IA=200B
      IA=IA+IAND(77400B,JBUF(MR+5))/256 
      IF(IA.EQ.0)GO TO 250
      CALL ASCII(IA,MBUF,10)
      LIN(21)=IAND(MBUF(2),177B)+25400B 
      LIN(22)=MBUF(3) 
      GO TO 250 
240   CALL ASCII(JBUF(MR+4),MBUF,10)
      LIN(10)=MBUF(3) 
250   CALL ASCII(JBUF(MR+8),LIN(12),10) 
      IF(IAND(LIN(12),77400B).EQ.30000B)LIN(12)=IAND(LIN(12)
     1,177B)+20000B 
      CALL EXEC(2,LIST,LIN,24)
      GO TO 270 
C 
C                   NOT DOING DL SO SEE IF ENTRY IS FOR OUR FILE
C 
260   IF(JBUF(MR).NE.NA)GO TO 270 
      IF(JBUF(MR+1).NE.NA(2))GO TO 270
      IF(JBUF(MR+2).NE.NA(3))GO TO 270
C 
C                   YES SAVE AND INCRIMENT PERTINANT INFORMATION
C 
      ISUM=ISUM+1 
      IF(JBUF(MR+5).LT.256)NTP=JBUF(MR+3) 
      LT(ISUM)=JBUF(MR+4) 
      LS(ISUM)=IAND(377B,JBUF(MR+5))
      NS(ISUM)=JBUF(MR+6)/2 
      NSS=NSS+NS(ISUM)
C***************************************
      IF(NTP .EQ. 2) NSS(2) = JBUF(MR+7)
C***************************************
270   CONTINUE
C 
C                   DONE TRACK MUST BE MORE SO SET UP FOR THEM
C 
      M=1 
      ISEC=MOD(ISEC+14,ISPT)
C                      **** 
      JSEC=JSEC+1 
      IF(JSEC.LT.IBPT)GO TO 220 
C                **** 
      GO TO 210 
C 
C                   DONE SCAN SET UP TO GET FILE OFF TAPE 
C 
280   IF(ISUM.EQ.0)GO TO 330
      IS=1
C 
C                   CREATE THE FILE BECAUSE WE FOUND SOMETHING
C 
      CALL CREAT(ID,IRE,NA2,NSS,NTP,ISC2,ICR2)
      IF(IRE.LT.0)GO TO 340 
C 
C                   CLOSE THE FILE SO WE CAN OPEN IT BETTER 
C 
      CALL CLOSE(ID)
C 
C                   OPEN THE FILE TYPE ONE SO WE MAY JUST 
C                   TRANSFER WHOLE RECORDS
C 
      CALL OPEN(ID,IRE,NA2,4,ISC2,ICR2) 
C 
C                   READ IN A MAG TAPE RECORD 
290   X = EXEC(1,MTLU,IBUF,JLNTH+1) 
      IF(IAND(IREG,200B).NE.0)GO TO 320 
C 
C                   SEE IF WE WANT THIS TRACK 
C 
300   IF(IBUF.NE.LT(IS))GO TO 290 
C 
C                   YES FIGURE OUT OUR OFFSET INTO THE FILE 
C 
      IA=64*LS(IS)+1
C 
C                   TRANSFER THE CORRECT NUMBER OF SECTORS
      DO 310 N=1,NS(IS) 
      CALL WRITF(ID,IRE,JBUF(IA),128) 
      IA=IA+128 
C 
C                   MAKE SURE WE DONT CROSS TRACK BOUNDS
C 
      IF(IA.LT.JLNTH)GO TO 310
      X = EXEC(1,MTLU,IBUF,JLNTH+1) 
      IF(IAND(IREG,200B).NE.0)GO TO 320 
      IA=1
310   CONTINUE
      IS=IS+1 
      IF(IS.GT.ISUM)GO TO 320 
      GO TO 300 
320   CALL CLOSE(ID)
      GO TO 350 
C 
C                   IF NOT DOING DIRECTORY AND NO FILE SAY SO 
C 
330   IF(IFLG.EQ.0)CALL EXEC(2,ILU,8H NO FILE,-8) 
      GO TO 350 
C 
C                   FILE ERROR SAY SO 
C 
340   CALL ASCII(-IRE,MES11(11),10) 
      MES11(12)=26440B
      CALL EXEC(2,ILU,MES11,13) 
C 
C                   ASK IF ANY MORE TO DO 
C 
C**************************** 
350   CALL EXEC(2,ILU,2H  ,-2)
      CALL EXEC(2,ILU,24H  ANY MORE THIS FILE ? _,-24)
C*******************************************
      CALL REIO(1,ILU,MBUF,10)
      IF(MBUF.NE.2HYE)GO TO 370 
      IF(FILE .NE. 1)GO TO 355  
      REWIND MTLU 
      GO TO 360 
355   CALL EXEC(3,MTLU+1400B) 
      CALL EXEC(3,MTLU+1300B) 
360   CALL EXEC(3,MTLU+300B)
      IFLG = 0
      GO TO 160 
370   CALL EXEC(2,ILU,2H  ,-2)
      CALL EXEC(2,ILU,24H  ANY MORE THIS TAPE ? _,-24)
      CALL REIO(1,ILU,MBUF,10)
      IF(MBUF.EQ.2HYE)GO TO 50
C 
C                   REWIND MAG TAPE 
C 
C****************************** 
380   REWIND MTLU 
C 
C                   UNLOCK LU'S 
C 
      CALL LURQ(100000B,MTLU,1) 
C****************************** 
C                   NO BYE BYE
C 
      END 
      SUBROUTINE HEADL(IBUF,LEN),24999-16053 REV.2024 800509
      DIMENSION IBUF(50)
C 
C     DO BACK SCAN ON IBUF TO FIND TRUE LENGTH OF RECORD
C 
10    DO 20  I=50,1,-1
      IF(IBUF(I) .EQ. 2H  )GO TO 20 
      IF(IBUF(I) .NE.6412B)GO TO 30 
      I = I - 2 
      GO TO 30
20    CONTINUE
      LEN = 1 
30    LEN = I + 1 
C 
      RETURN
      END 
      END$
ASMB,L,C
      NAM ASCII 
      ENT ASCII 
      EXT .ENTR 
A     EQU 0 
B     EQU 1 
NUM   NOP 
PUT   NOP 
E     NOP 
ASCII NOP 
      JSB .ENTR        GET CALLING PARMS
      DEF NUM 
      CLA 
      STA FLAG
      LDA DM3 
      STA CNT 
      LDA PUT          SAVE DESTINATION ADDRESS 
      ADA .2
      STA PUTT
      LDA NUM,I 
      STA NUMM
      LDA E,I 
      STA BASE
      CPA .8
      JMP LOP 
      LDA NUMM
      SSA,RSS 
      JMP LOP 
      CCB 
      CMA,INA 
      STA NUMM
      STB FLAG
LOP   LDA NUMM
      CLB 
      DIV BASE
      ADB B60 
      STB PUTT,I
      CLB 
      DIV BASE
      STA NUMM
      LDA B 
      ADA B60 
      ALF,ALF 
      IOR PUTT,I
      STA PUTT,I
      LDA PUTT
      ADA DM1 
      STA PUTT
      ISZ CNT 
      JMP LOP 
      LDA FLAG
      SZA,RSS 
      JMP ASCII,I 
      ISZ PUTT
      LDA B377
      AND PUTT,I
      IOR MIN 
      STA PUTT,I
      JMP ASCII,I 
CNT   NOP 
DM3   DEC -3
DM1   DEC -1
.2    DEC 2 
.8    DEC 8 
B60   OCT 60
B377  OCT 377 
MIN   OCT 26400 
BASE  NOP 
NUMM  NOP 
PUTT  NOP 
FLAG NOP
      END 
ASMB,R,B,L
      NAM ISOL8,7 ISOLATE,RIGHT JUSTIFY BITS. 18 JAN 77.
      ENT ISOL8 
      EXT .ENTR 
* 
* I=ISOL8(J,11,8) ISOLATES BITS 11,10,9,8 FROM J AND RETURNS THEM 
*                 IN THE LEAST SIGNIFICANT BITS OF I. HIGH BITS OF
*                 I ARE ZEROED OUT. 
* I=ISOL8(J,8,11) DOES THE SAME THING.
* 
* I=ISOL8(J,15,0) RETURNS I=J 
* I=ISOL8(J,16,1) RETURNS I = J ROTATED 1 BIT RIGHT 
* 
J     NOP 
I1    NOP 
I2    NOP 
ISOL8 NOP 
      JSB .ENTR 
      DEF J 
      LDA I1,I
      CMA,INA      (A)= -I1 
      ADA I2,I     (A)= I2-I1 
      SSA          (A)>0 ?  I2>I1 ? 
      JMP RVERS    NO. I1>I2. 
      LDB I1,I     YES. I2>I1. GET I1.
      JMP CONT
RVERS LDB I2,I     I2 IS THE LEAST OF I1,I2.
      CMA,INA      (A)>=0.
CONT  CMB,INB      LEAST OF I1,I2 COUNTS ROTATIONS. 
      STA MASK#    MASK NUMBER >= 0.
      LDA J,I      GET THE WORD TO BE OPERATED ON.
* 
RLOOP SZB,RSS      DONE?  ROTATION COUNTER ROSE TO ZERO ? 
      JMP ISOL     YES. 
      RAR          NO. MOVE BITS-OF-INTEREST ONE PLACE RIGHT. 
      INB          BUMP ROTATION COUNTER. 
      JMP RLOOP 
* 
ISOL  LDB .MASK 
      ADB MASK#    (B) POINTS TO DESIRED MASK.
      AND B,I      ZERO OUT UNWANTED BITS.
      JMP ISOL8,I  RETURN WITH (A)=RIGHT JUSTIFIED ISOLATED BITS. 
* 
MASK# NOP 
.MASK DEF *+1 
      OCT 000001
      OCT 000003
      OCT 000007
      OCT 000017
      OCT 000037
      OCT 000077
      OCT 000177
      OCT 000377
      OCT 000777
      OCT 001777
      OCT 003777
      OCT 007777
      OCT 017777
      OCT 037777
      OCT 077777
      OCT 177777
* 
A     EQU 0 
B     EQU 1 
S     EQU 1 
      END