:ST,S,$TC04,5 
ASMB,L,C
      NAM STRT!,7 
      HED ***TCS UTILITIES (STRT!) - 9/74***
      ENT STRT! 
      EXT CB$,CNFIG 
      EXT EXEC
      EXT GBUF
      EXT ERR0
      EXT CNFGX 
* 
* CONDITIONAL COMMON FOR IMAGE/2100 
* 
      IFZ 
      COM IMAG1(1024),IMAG2(1),IMAG3(1175),IMAG4(128) 
      XIF 
      COM ISTAT,IPAR,ILU,ILOG 
A     EQU 0 
B     EQU 1 
STRT! NOP 
      LDA B,I 
      STA CBLOK 
      INB 
      LDA B,I 
      STA SYST      /SAVE CONFIGURATION ADDRESS 
      INB 
      LDA B,I 
      STA RTRN      /SAVE RETURN ADDRESS (MAIN) 
      INA 
      STA RTRN1     /SAVE RETURN ADDRESS(THREAD)
      INB 
      LDA B,I 
      STA POPR      /SAVE ADDRESS OF JSB POP IN MAIN
      INB 
      LDA B,I 
      STA START     /SAVE ADDRESS OF CB PARAMETERS
      LDA SYST,I    /GET JSB TCS/MTO
      AND =B101777  /ISOLATE BASE PAGE LINK 
      STA MTO       /SAVE FOR LOCAL CALLS 
      JSB CNFGX     /ENABLE EQT EXTENSION LOGGING 
      DEF *+2 
EQTX  DEF EQT 
      JSB CNFIG     /CONFIGURE SYSTEM 
      DEF *+4 
SYST  DEF * 
LUPTR DEF LUT 
      DEF LUCNT 
* 
      JSB MTO,I 
      DEF *+3 
      DEF P79$
      DEF ISTAT 
      LDA ISTAT 
      SZA           OK? 
      JMP ABRT      NO. 
      JSB MTO,I 
      DEF *+6 
      DEF P78$
      DEF ISTAT 
      DEF IPAR
      DEF ILU 
      DEF ILOG
* 
      LDA CB$X
      AND =B77777 
      LDB A,I       /GET ADDRESS OF CB PARAMETERS 
      ADB =B3       /BYPASS SEGMENT NAME
      LDA B,I 
      STA ICBX1     /SAVE # OF ONLINE DEVICES 
      INB 
      LDA B,I 
      STA ICBX2     /SAVE # OF OFFLINE DEVICES
      INB 
      LDA B,I 
      CPA LUCNT     /ALL UNITS INITIALIZED? 
      RSS           /YES
      JMP ABRT      /NO-ABORT 
      INB 
      LDA B,I 
      STA START,I   /SAVE LENGTH OF CONTROL BLOCK 
      STA CBL 
      ISZ START 
      LDA MTO       /SAVE MTO/TCS LINKAGE 
      STA START,I 
      INB 
      LDA B,I 
      STA BASE
      ISZ START 
      STA START,I   /SAVE CB START
      LDA ICBX1 
      ISZ START 
      STA START,I   /SAVE IN UTIL ROUTINE 
      ISZ START 
      LDA ICBX2 
      STA START,I 
* 
      LDA P01$
      STA IPAR
* 
STRT2 LDB BASE
      LDA LUPTR,I   /GET LU 
      SSA           /PRIVILEGED DEVICE? 
      JMP STRT5     /NO 
      ADA =B141000  /TYPE+302 
      RSS 
STRT5 EQU * 
      JSB FIND     /FIND TYPE FOR NON-PRIVILEGED DEV
      LDB BASE
      STA TEMP
      AND =B77
      STA B,I       /SAVE LU ON CB
      LDA TEMP
      ALF,ALF       /POSITION TYPE
      AND =B377     /ISOLATE TYPE 
      INB 
      STA B,I       /SAVE ON CB 
      ADB =D2 
      STB TEMP      /SAVE WB PARAMETER ADDRESSES
      INB 
      STB G1
* 
      JSB GBUF      /GET WORK BLOCK 
      DEF *+3 
G1    DEF * 
G2    DEF P01$
      STA TEMP,I
      LDA G1,I
      SSA      /GOT ONE?
      JMP ABRT    /NO.
      ALF,ALF 
      IOR P01$
      STA G1,I
      LDB BASE
      ADB =D9 
      LDA EQTX,I    /GET EQT EXTENSION
      STA B,I       /SAVE IN CB10 
      INB 
      ISZ EQTX
      LDA =B400     /SET CONTROL WORDS IN CB11 & CB12 
      STA B,I 
      INB 
      STA B,I 
* 
      LDB BASE
      LDA CBLS
      ADB A         /CALCULATE STACK PTR ADDRESS
      INA 
      STA B,I       /INDICATE NO ENTRIES
      ADA =D2 
      STA TEMP
      LDA IPAR
      CMA,INA 
      ADA ICBX1 
      SSA           /ONLINE DEVICE? 
      JMP STRT1     /NO 
STRT4 LDA TEMP      /YES
      STA B,I       /PUT ONE ENTRY IN STACK 
      ADB =D2 
      LDA RTRN1 
      STA B,I 
      LDA CBLOK 
      INB 
      STA B,I 
* 
      JSB MTO,I 
      DEF *+7 
      DEF P01$
      DEF NWAIT 
      DEF P01$
      DEF P01$
      DEF IPAR
      DEF POPR
STRT3 LDA BASE      /UPDATE CB ADDR 
      ADA CBL 
      STA BASE
      ISZ LUPTR     /INCR LU TABLE PTR
      ISZ IPAR      /INCR THREAD
      LDA IPAR
      CMA,INA 
      ADA ICBX2 
      SSA,RSS       /DONE?
      JMP STRT2     /NO 
      JSB MTO,I 
      DEF *+2 
      DEF P53$
MTO   DEF * 
POPR  DEF * 
CB$X  DEF CB$ 
ICBX1 NOP 
ICBX2 NOP 
ICBP  NOP 
* 
* 
STRT1 EQU * 
      LDA IPAR
      CPA ICBX2     /LAST CB? 
      RSS           /YES
      JMP STRT3     /NO 
      LDA RTRN      /CHG RETURN FOR MAIN THREAD 
      STA RTRN1 
      JMP STRT4 
ABRT  EQU * 
      JSB EXEC
      DEF *+5 
      DEF P02$
      DEF P01$
      DEF INER
      DEF P09$
      JSB EXEC
      DEF *+2 
      DEF COMP
COMP  DEC 6 
****************************************************
FIND  EQU * 
      NOP 
      LDA LUPTR,I 
      CMA,INA 
      STA LU
      CPA =B1      /CONSOLE 
      JMP FIND1    /YES 
      CPA =B77     /NO-DUMMY? 
      JMP FIND2    /      YES 
      JSB EXEC     /GET DRIVER TYPE 
      DEF *+4 
      DEF P13$
      DEF LU
      DEF ISTAT 
      LDA ISTAT 
      ALF,ALF 
      AND =B77
      STA ISTAT 
      LDB TYPE
FIND4 LDA B,I 
      AND =B77     /MASK DRIVER TYPE
      CPA ISTAT    /MATCH?
      JMP FIND3    /YES 
      INB           /NO 
      CPB ENDT     /END OF LIST?
      RSS          /YES-DEFAULT TO TERMINAL 
      JMP FIND4    NO-KEEP LOOKING
FIND2 LDB TYPE
FIND3 LDA B,I 
      RAL,RAL      /POSITION DEVICE TYPE
      AND =B177700 /FORM NEW TYPE/LU WORD 
      IOR LU
      JMP FIND,I
FIND1 LDA =B30000  /SYSTEM CONSOLE
      JMP FIND3+1 
****************************************************
****************************************************
TYPE  DEF *+1 
      OCT 30100    /00 TERMINAL 
      OCT 21301    /01 READER 
      OCT 11402    /02 PUNCH
      OCT 30005    /05 SYSTEM CONSOLE 
      OCT 31507    /07 READER / PUNCH 
      OCT 21311    /11 READER 
      OCT 11212    /12 PRINTER
      OCT 11414    /14 PUNCH
      OCT 21315    /15 READER 
      OCT 31123    /23 MAGTAPE
      OCT 30126    /26 TERMINAL 
      OCT 11427    /27 PRINTER
      OCT 31031    /31 DISC 
      OCT 31667    /67 HSI
ENDT  DEF * 
****************************************************
LU    NOP 
NWAIT OCT 20077 
P01$  DEC 1 
P02$  DEC 2 
P09$  DEC 9 
P13$  DEC 13
P53$  DEC 53
P78$  DEC 78
P79$  DEC 79
CBLOK NOP 
START NOP 
RTRN  NOP 
RTRN1 NOP 
CBL   NOP 
CBLS  DEC 16        /CB LENGTH W/O STACK -2 
BASE  NOP 
TEMP  NOP 
LUCNT NOP 
LUT   BSS 256 
EQT   BSS 256 
INER  ASC 9,INIT ERROR (ABORT)
      END 
::
:ST,S,$TC05,5 
ASMB,L,C
      NAM JOIN,7
      HED ***TCS UTILITIES (JOIN) - 9/74*** 
      ENT JOIN
      EXT PUSH,POP,PAUZ,START 
      EXT .ENTR 
* 
* CONDITIONAL COMMON FOR IMAGE/2100 
* 
      IFZ 
      COM IMAG1(1024),IMAG2(1),IMAG3(1175),IMAG4(128) 
      XIF 
      COM ISTAT,IPAR
      NOP 
JOIN  NOP 
      JSB .ENTR 
      DEF JOIN
      JSB PUSH      /PUT RETURN ON STACK
      DEF *+3 
      DEF JOIN-1
      DEF CB
      LDA IPAR
      LDB CB-1
      ADB P02$      /CALCULATE CB2
      CMA,INA 
      ADA B,I       /CALCULATE DIFF. BETWEEN THREADS TO BE JOINED 
      MPY START     / 
      ADA CB-1      FORM ADDRESS OF OTHER CB
      ADA P02$
      LDB A,I 
      SWP 
      IOR =B100000  /SET FLAG 
      STA B,I       /ON OTHER CB
JOINX EQU * 
      JSB PAUZ      /WAIT FOR OTHER CB
      DEF *+1 
      LDB CB-1
      ADB P02$      /CALCULATE ADDR OF CB3
      LDA B,I 
      SSA,RSS       /FLAG SET 
      JMP JOINX     /NO 
      RAL,CLE,ERA   /YES-CLEAR FLAG 
      STA B,I 
      JSB POP       /RETURN TO CALLER 
      NOP 
CB    BSS 7 
A     EQU 0 
B     EQU 1 
P02$  DEC 2 
      END 
::
:ST,S,$TC06,5 
ASMB,L,C
      NAM PCODE,7 
      HED ***TCS UTILITIES (PCODE) - 9/74***
      ENT PCODE 
A     EQU 0 
B     EQU 1 
********************************************************************************
* 
* 
*     PCODE SUBROUTINE - ALLOWS CORE TO CORE USE OF FORMATTER 
*     ORIGINAL CALLING SEQ. 
* 
*     JSB PCODE 
*     DEF *+2 
*     LDA PTR 
*     CLB 
*     JSB .DIO. 
* 
*     MODIFIED CALLING SEQ. 
* 
*     JSB PCODE 
*     DEF PTR-1 
*     CLB 
*     JSB .DIO. 
*     DEF PTR 
* 
* 
********************************************************************************
PCODE NOP 
      LDA PCODE 
      INA 
      CPA PCODE,I  /FIRST TIME THRU?
      JMP PCOD1    /YES 
      LDB PCODE    /NO
      LDA B,I 
      LDA A,I 
      ADB P03$
      STA B,I 
      ISZ PCODE 
      CLA 
      JMP PCODE,I 
PCOD1 EQU * 
      LDB PCODE,I 
      LDA B,I       /GET LDA PTR[,I]
      STA INST
      AND =B101777
      STA BASE      /SAVE I + 10BIT ADDR
          STB A 
      AND =B76000 
      STA PAGE      /SAVE UPPER 5 BITS
      LDA INST
      AND =B2000
      SZA           /CURRENT/BASE PAGE? 
      LDA PAGE      /CURRENT
      IOR BASE
      RSS 
      LDA A,I 
      RAL,CLE,SLA,ERA 
      JMP *-2 
      ADA N01$
      LDB PCODE 
      STA B,I            /SET POINTER TO ARRAY IN CALLING SEQ.
      ADB N01$
      STB PCODX          /SET RETURN
      ADB P02$
      STB PCODE 
      INB 
      LDA B,I            /CHANGE
      STA PCODE,I        /FROM---LDA PTR[,I]
      ISZ PCODE                  CLB
      INB                        JSB .DIO.
      LDA B,I       /TO  ---CLB 
      STA PCODE,I           JSB .DIO. 
      JMP PCODX,I           DEF PTR 
PCODX NOP 
* 
BASE  NOP 
PAGE  NOP 
INST  NOP 
N01$  EQU 52B 
P02$  EQU 55B 
P03$  EQU 56B 
      END 
::
:ST,S,$TC07,5 
ASMB,L,C
      NAM ARRAY,7 
      HED ***TCS UTILITIES (ARRAY) - 9/74***
      ENT ARRAY 
      EXT .ENTR 
A     EQU 0 
B     EQU 1 
*     ARRAY DEFINITION
*     SUBROUTINE REDEFINES DUMMY ARRAY X TO BE ARRAY Y
*      (DYNAMIC EQUIVALENCE)
*     JSB ARRAY 
*     DEF *+3 
*     DEF X 
*     DEF Y 
* 
*     EXAMPLE 
*     CALL ARRAY(X,Y(1,5))
*     X(3)=A+B+C
* 
*     X(3) IS ACTUALLY Y(3,5) 
*     ALL REFERENCES TO X MUST BE SUBSCRIPTED, UNLESS USED
*     IN A READ/WRITE STATEMENT PRECEDED BY A PCODE CALL. 
      NOP 
      NOP 
ARRAY NOP 
      JSB .ENTR 
      DEF ARRAY-2 
      CCA 
      ADA ARRAY-2 
      LDB ARRAY-1 
      STB A,I 
      JMP ARRAY,I 
      END 
::
:ST,S,$TC08,5 
ASMB,L,C
      NAM .TAPE,7 
      HED ***TCS UTILITIES (.TAPE) - 9/74***
      ENT .TAPE 
      EXT .ENTR 
      EXT PUSH,POP,TCNTL
A     EQU 0 
B     EQU 1 
* 
*     THIS ROUTINE IS CALLED BY FORTRAN COMPILED PROGRAMS 
*     WHICH USE TAPE COMMANDS.
*         REWIND
*         BACKSPACE 
*         ENDFILE 
* 
      NOP 
.TAPE NOP 
      AND MASK
      STA FUNCT 
      JSB PUSH
      DEF *+2 
      DEF .TAPE-1 
      JSB TCNTL 
      DEF *+4 
      DEF FUNCT 
      DEF P00$
      DEF * 
      JSB POP 
MASK  OCT 7700
FUNCT NOP 
P00$  EQU 53B 
      END 
::
:ST,S,$TC09,5 
ASMB,L,C
      NAM ERR0,7
      HED ***TCS UTILITIES (ERR0) - 9/74*** 
      ENT ERR0
      EXT .MTO
ERR0  NOP 
      STA TEXT+5
      STB TEXT+7
      LDA .MTO
      STA MTO       /LINK WITH  TCS/MTO 
* 
EXPG  EQU 141B
* 
      LDA EXPG
      STA TEXT+1
      LDA EXPG+1
      STA TEXT+2
      LDA EXPG+2
      AND 75B 
      IOR =B40
      STA TEXT+3
      JSB MTO,I 
      DEF *+7 
      DEF P02$
      DEF NWAIT 
      DEF TEXT
      DEF N16$
      DEF P00$
      DEF ERR0
      JSB MTO,I 
      DEF *+2 
      DEF P53$
NWAIT OCT 20001 
TEXT  ASC 5,      : 
      ASC 3,
#     EQU 53B 
P01$  EQU #+1 
P02$  EQU #+2 
N16$  DEC -16 
P00$  EQU # 
P53$  DEC 53
MTO   NOP 
      END 
::
:ST,S,$TC10,5 
ASMB,L,C
      NAM GDISC,7 
      HED ***TCS UTILITIES (GDISC) - 4/75***
      ENT GDISC 
      ENT NDISC 
      EXT EXEC,PAUZ,PUSH,POP,.ENTR
      EXT .RST
* 
* CONDITIONAL COMMON FOR IMAGE/2100 
* 
      IFZ 
      COM IMAG1(1024),IMAG2(1),IMAG3(1175),IMAG4(128) 
      XIF 
      COM ISTAT,IPAR,ILU,ILOG 
A     EQU 0 
B     EQU 1 
* 
* 
GDISC NOP 
      LDA GDISC     /SAVE RETURN
      STA CDISC 
      JSB COMM
GDSC2 JSB FIND      /FIND AVAILABLE TRACK 
      JMP GDSC1     /ALL BUSY 
GDSC3 LDA CTRAK     /GOTONE 
      ALF,ALF 
      STA PARM2,I   /RET TRACK TO USER
      LDA N01$      /FLAG AS BUSY 
      STA B,I 
GDSC4 CLA 
      LDB .RST
      STA B,I 
      JSB POP 
GDSC1 JSB NFIND     /INDICATE NO FIND 
      JSB PAUZ      /WAIT FOR A FREE TRACK
      DEF *+1 
      JSB RSTR      /RESTOR PARAMETERS
      JMP GDSC2     /RESUME SEARCH
* 
* 
NDISC NOP 
      LDA NDISC     /SAVE RETURN
      STA CDISC 
      JSB COMM
      JSB STPTR     /SET POINTERS 
      JSB NEXT      /GET NEXT SECTOR
      RSS           /END OF TRACK 
      JMP GDSC4 
      SEZ           /ALLOCATE 
      JMP NDSC1     /NO 
NDSC3 EQU * 
      JSB FIND      /YES-FIND AVAILABLE TRACK 
      JMP NDSC2     /ALL BUSY 
      LDA CTRAK 
      ALF,ALF 
      IOR PTR,I     /MERGE NEW TRACK W/LLD TRACK
      STA PTR,I 
      JMP GDSC3 
NDSC1 LDA PTR,I 
      AND LBYT$ 
      STA PARM2,I 
      LDA PARM1,I 
      AND P04$
      CLB 
      SZA           /FREE?
      STB PTR,I     /YES-CLEAR BUSY 
      LDA PARM2,I 
      SZA,RSS       /LAST TRACK?
NDSC4 EQU * 
      LDB N01$      /YES
      LDA .RST
      STB A,I 
      JSB POP 
NDSC2 JSB NFIND     /INDICATE NO FIND 
      JSB PAUZ      /WAIT FOR FREE TRACK
      DEF *+1 
      JSB RSTR      /RESTOR PARAMETERS
      JMP NDSC3 
* 
* 
COMM  NOP 
      JMP INIT      /GET WORK AREA LIMITS 
      JMP CDISC+1 
PARM1 NOP 
PARM2 NOP 
CDISC NOP 
      JSB .ENTR 
      DEF PARM1 
      JSB PUSH      /PUT RETURN ON STACK
      DEF *+3 
      DEF PARM2 
      DEF CB+1
      LDB CB        /SAVE PARAMETERS ON CONTROL BLOCK 
      ADB =D12
      LDA PARM1 
      STA B,I 
      INB 
      LDA PARM2 
      STA B,I 
      JMP COMM,I
* 
INIT  CLA 
      STA COMM+1    /CALL AT INITIALIZE ONLY
      JSB EXEC      /GET LIMITS 
      DEF *+6 
      DEF P17$
      DEF FTRAK 
      DEF LTRAK 
      DEF MSCTR 
      DEF P00$      SYSSC ONLY!   KM
      JMP COMM+1
* 
FIND  NOP 
      LDB FTRAK     /SEARCH FROM 1ST TRACK
FIND1 STB CTRAK 
      ADB DMAP      /CALCULATE DISC MAP ADDRESS 
      LDA B,I 
      SZA,RSS       /TRACK AVAILABLE? 
      JMP FINDX     /YES
      LDB CTRAK     /NO 
      INB 
      CPB LTRAK     /END OF WORK AREA?
      JMP FIND,I    /YES
      JMP FIND1     /NO 
FINDX ISZ FIND
      JMP FIND,I
* 
NEXT  NOP 
      LDA PTRC,I    /GET TRACK/SECTOR WORD
      INA           /INCR. SECTOR 
      AND RBYT$ 
      CPA MAX       MAX VALUE?
      JMP NEXT,I    /YES
      ISZ PTRC,I    /NO-UPDATE SECTOR COUNT IN CORE 
      ALF,ALF 
      IOR CTRAK     /MERGE WITH CURRENT TRACK 
      ALF,ALF       /RESTORE TRACK/SECTOR POSITION
      STA PARM2,I   /RETURN TO USER NEW VALUE 
      ISZ NEXT      /INDICATE SAME TRACK
      JMP NEXT,I
STPTR NOP 
      LDA PARM2,I   /SETUP POINTERS 
      ALF,ALF 
      AND RBYT$     ISOLATE TRACK 
      STA CTRAK 
      ADA DMAP      /CALCULATE ADDR. OF DISC MAP ENTRY
      STA PTR 
      LDA PARM1,I 
      AND P02$
      SZA           /ALLOCATE?
      JMP SPTR1     /NO-CHAIN 
      CLE           /CLEAR FLAG 
      LDB PTR       /SET UP FOR TRACK ALLOCATION
      LDA MSCTR 
SPTR2 STA MAX 
      STB PTRC
      LDA PTR,I 
      CPA N01$      /FIRST ACCESS?
      RSS           /YES
      JMP STPTR,I   /NO 
      CLA 
      SEZ           /YES-ALLOCATE?
      JMP NDSC4     /NO-END OF TRACK
      STA PTR,I     /YES-ADJUST SECTOR
      JMP STPTR,I 
SPTR1 CCE           /SET FLAG 
      LDB PARM2     /SETUP FOR TRACK CHAIN
      LDA PTR,I 
      AND RBYT$ 
      INA 
      JMP SPTR2 
NFIND NOP 
      LDA N01$      /NO FIND IN STATUS
      LDB .RST
      STA B,I 
      LDA PARM1,I 
      SLA           /WITHOUT WAIT 
      JSB POP       /YES-RETURN 
      JMP NFIND,I   /NO 
* 
* 
RSTR  NOP 
      LDB CB
      ADB =D12      /RESTOR PARAMETERS
      LDA B,I 
      STA PARM1 
      INB 
      LDA B,I 
      STA PARM2 
      JSB STPTR 
      JMP RSTR,I
* 
PTR   NOP 
FTRAK NOP 
LTRAK NOP 
CTRAK NOP 
MSCTR NOP 
PTRC  NOP 
MAX   NOP 
P00$  NOP           KM
P02$  DEC 2 
P04$  DEC 4 
P16$  DEC 16
P17$  DEC 17
N01$  DEC -1
LBYT$ OCT 177400
RBYT$ OCT 377 
CB    DEF *+1 
      BSS 7 
DMAP  DEF *+1 
      BSS 256 
* 
      END 
::
:ST,S,$TC11,5 
ASMB,L,C
      NAM BLANK,7 
      HED ***TCS UTILITIES (BLANK) - 9/74***
      ENT BLANK 
      EXT .ENTR 
ADDR  NOP 
COUNT NOP 
BLANK NOP 
      JSB .ENTR 
      DEF ADDR
      LDB COUNT,I 
      CMB,INB 
      LDA =B20040 
      STA ADDR,I
      ISZ ADDR
      INB,SZB 
      JMP *-3 
      JMP BLANK,I 
      END 
::
:ST,S,$TC12,5 
ASMB,L,C
      NAM LNGTH,7 
      HED ***TCS UTILITIES (LNGTH) - 9/74***
      ENT LNGTH 
      EXT .ENTR 
ADDR  NOP 
SIZE  NOP 
LNGTH NOP 
      JSB .ENTR 
      DEF ADDR
      CCB 
      ADB ADDR
      ADB SIZE,I    /CALCULATE LAST WORD OF ARRAY 
      LDA SIZE,I
      CMA,INA       /FORM NEG. COUNT
      STA SIZE
LNGT1 LDA B,I 
      CPA =B20040   /BLANKS?
      JMP LNGT2     /YES
      LDB SIZE      /NO 
      CMB,INB       /CONVERT TO POSITIVE COUNT
      RBL           /X2 FOR CHARACTERS
      AND =B377 
      CPA =B40      /LAST ONE A BLANK 
      ADB =D-1      YES-DECREMENT COUNT 
      STB A 
      JMP LNGTH,I   /RETURN WITH ANSWER IN A
LNGT2 EQU * 
      ADB =D-1      BACK UP POINTER 
      ISZ SIZE      DONE? 
      JMP LNGT1     /NO 
      CLA           /YES
      JMP LNGTH,I 
A     EQU 0 
B     EQU 1 
      END 
::
:ST,S,$TC13,5 
ASMB,L,C
      NAM ENDO,7
      HED ***TCS UTILITIES (ENDO) - 9/74*** 
      ENT ENDO
      EXT .ENTR 
J     NOP 
K     NOP 
L     NOP 
ENDO  NOP 
      JSB .ENTR 
      DEF J 
      LDA J,I 
      ADA L,I       /INCR INDEX 
      STA J,I 
      CMA,INA 
      ADA K,I       /FORM DIFF. BETWEEN INDEX AND TARGET
      AND =B100000  /MASK FOR LOGICAL 
      JMP ENDO,I
      END 
::
:CO MOUNT TAPE #9, TYPE :GO 
:PA 
                                    