      HED UNLOCK* THE UNLOCK COMMAND IS USED TO RESTORE TO THE SYSTEM ANY DISC* TRACKS WHICH HAVE PREVIOUSLY BEEN LOCKED.  THE FORMAT FOR THE * COMMAND IS AS FOLLOWS:* *     UNLOCK-DISC,TRACKF[,TRACKL] * * DISC IS THE DISC NUMBER. TRACKF AND TRACKL SPECIFY THE FIRST &* LAST TRACKS TO BE UNLOCKED. IF TRACKL IS NOT SPECIFIED, IT IS * ASSUMED TO BE EQUAL TO TRACKF.      SPC 2       ORG LIBRA       JSB UNLNO     GET DISC NO. IN B.      OCT -4      CPA .+54B     CHECK FOR COMMA FOLLOWING.      RSS       JMP LFRER *       STB UNLD      SAVE DISC NO.       ADB ?ATBL     MAKE SURE       LDA 1,I        DISC EXISTS.       SZA,RSS       JMP UNL1      NO DISC.      ALF,ALF       GET # OF SECTORS      AND B377       PER TRACK AND SAVE       STA UNLTL       IN UNLTL. *       JSB UNLNO     GET FIRST TRACK       OCT -100      STB UNLF      CPA .+54B     ONLY TRACK?       RSS           NO      JMP *+3 *       JSB UNLNO     GET LAST TRACK.       OCT -100      CPA .+15B       RSS       JMP LFRER       STB UNLL      CMB           CHECK FOR LAST TRACK >= FIRST.      ADB UNLF      SSB,RSS       JMP UNL4      NOT OK. *       LDA UNLD      CONVERT DISC/TRACK NO. INTO       LSL 6          SINGLE TRACK NO.       ADA UNLF      STA UNLF      STA UNLT      LDA UNLD      LSL 6       ADA UNLL      STA UNLL* * NOW SCAN TRAX TO DETERMINE HOW MANY TRACKS WILL * ACTUALLY BE OPENED. *       CLA           INITIALLY COUNT IS 0.       STA UNLCN UNL5  LDA UNLT      JSB UNLFT     FIND TRACK.       SZA           IF LOCKED, BUMP       ISZ UNLCN      COUNTER.       LDA UNLT      GET TRACK VALUE.      CPA UNLL      TEST FOR DONE.      JMP UNL6      ISZ UNLT      BUMP TRACK NO.      JMP UNL5* UNL6  LDA IDLEN     COMPUTE # OF NEW ADT ENTRIES.       AND M64       ADA P5440     =# OF WORDS AVAIL FOR ADT.      ADA ADLEN     =# OF NEW WORDS ALLOWED.      ARS           =# OF NEW ENTRIES ALLOWED.      LDB UNLCN     COMPARE WITH # WE WANT TO ADD.      CMB,INB       ADB 0       SSB       STA UNLCN * UNL7  LDA ADLEN     READ IN ADT.      STA WORD      LDA ADLOC       LDB LIBDI       ADB UNLCN     LEAVE ROOM FOR      ADB UNLCN      NEW ADDITIONS      JSB DISCL * * SEARCH ADT FOR FIRST ENTRY BEYOND FIRST ONE TO BE ENTERED.*       LDB LIBD      STB MOVED       ADB UNLCN       ADB UNLCN       STB MOVES UNL9  LDA UNLF      DO WE WANT TO       JSB UNLFT      UNLOCK THIS TRACK?       SZA,RSS       JMP UNL10     NO--GO DO NEXT ONE.       XOR 1,I       YES--CLEAR TRAX       STA 1,I        BIT.       LDA MOVED     CAN WE INSERT ADT ENTRY?      CPA MOVES       JMP UNL10     NO--GO DO NEXT ONE. UNL11 LDA UNLF      SEARCH ADT FOR A PLACE TO PUT IT      ALF,ALF       CMA,CLE,INA       ADA MOVES,I       SEZ       JMP *+4       FOUND ONE.      LDB .-2       MOVE 2 WORDS UP       JSB MOVEW      AND TEST NEXT ENTRY.       JMP UNL11 *       LDA UNLF      INSERT      ALF,ALF        ENTRY.       LDB UNLTL     GET TRACK LENGTH.       DST MOVED,I       ISZ MOVED       ISZ MOVED * UNL10 LDA UNLF      WAST THAT THE LAST TRACK?       CPA UNLL      JMP *+3       YES.      ISZ UNLF      BUMP TO NEXT TRACK.       JMP UNL9*       LDA UNLCN     COMPUTE NEW ADLEN.      ALS       CMA,INA       ADA ADLEN       STA ADLEN *       STA WORD      LDA ADLOC     WRITE ADT TO DISC.      LDB LIBD      JSB DISC,I      JMP LEND* * UNLNO INPUTS A DECIMAL NUMBER AND CHECKS THAT IT IS SMALLER THAN* -<JSB+1>. IT RETURNS WITH THE NUMBER IN B AND THE FOLLOWING * CHARACTER IN A. * UNLNO NOP       JSB UNLDG     GET A DIGIT.      JMP LFRER     ILLEGAL IF NONE UNLN3 STB UNLN      SAVE PARTIAL RESULT.      ADB UNLNO,I       SSB,RSS       JMP UNL4      JSB UNLDG     GET ANOTHER.      JMP UNLN2     END OF NUMBER       LDA UNLN      MULTIPLY RESULT SO FAR BY 10.       RAL,RAL       ADA UNLN      RAL       ADB 0         ADD IN NEW VALUE.       JMP UNLN3 UNLN2 LDB UNLN      RETURN NO.      ISZ UNLNO       JMP UNLNO,I * * UNLDG NOP           GET DECIMAL DIGIT.      JSB T35CQ       JMP UNLDG,I   NOT A DIGIT.      LDB 0       ADB M72B      SSB,RSS       JMP UNLDG,I       ADB .+10      SSB,RSS       ISZ UNLDG       JMP UNLDG,I * * UNLFT FINDS THE BIT IN THE TRAX TABLE SPECIFIED BY A. IT RETURNS* WITH B POINTING AT THE APPROPRIATE TRAX WORD & A=THAT WORD MASKED * BY THE APPROPRIATE BIT. * UNLFT NOP       STA 1         GET TRACK NO IN B.      ALF           POSITION WORD NO IN       LSR 4          LOW 4 BITS OF B, BIT NO      AND  .+17B     IN LOW 4 OF A.       ADA UNLBT     COMPUTE ADDRESS OF BIT MASK &       LDA 0,I        GET THE MASK.      ADB DTRAX     B=>TRAX WORD.       AND 1,I       MASK &      JMP UNLFT,I    RETURN.* UNLBT DEF *+1       OCT 1,2,4,10,20,40,100,200,400,1000,2000,4000       OCT 10000,20000,40000,100000UNL1  LDB .-17      JSB UNLER       OCT 5116      ASC 8,ONEXISTENT DISC UNL4  LDB .-19      JSB UNLER       OCT 5111      ASC 9,LLEGAL PARAMETERS UNLER NOP       STB UNLT      BRS       LDA UNLER       STA MOVES       LDA T35B1       STA MOVED       JSB MOVEW       LDA UNLT      CMA,INA       LDB T35B1       JMP LEND+2* * $UNL  EQU *       ORG LTEMP UNLD  BSS 1 UNLF  BSS 1 UNLL  BSS 1 UNLT  BSS 1 UNLCN BSS 1 UNLN  BSS 1 UNLTL BSS 1       HED LOCK* THE LOCK COMMAND IS USED TO TELL THE SYSTEM TO STOP USING CERTAIN * DISC TRACKS. THIS CAN BE DONE EITHER BECAUSE THE TRACKS HAVE BEEN * FOUND FAULTY OR BECAUSE THEY HAVE INFORMATION ON THEM WHICH IS* UNRELATED TO TSB. * * THE ROUTINE WILL NOT LOCK TRACKS WHICH ARE BEING USED FOR SYSTEM* PURPOSES. THESE TRACKS CAN BE LOCKED BY THE LOADER AT SYSTEM INI- * TIATION.* * THE FORMAT FOR THE LOCK COMMAND IS: * *     LOCK-DISC,TRACKF[,TRACKL] * * ALL TRACKS ON THE SPECIFIED DISC FROM TRACKF TO TRACKL ARE LOCKED.* IF TRACKL IS NOT SPECIFIED, ONLY ONE TRACK IS LOCKED. * * THE OPERATION OF THE LOCK ROUTINE IS AS FOLLOWS:* *     1)  INTERPRET & VALIDATE PARAMETERS *     2)  CHECK THAT FUSS IS NOT REFERENCING ANY OF THE *         SPECIFIED TRACKS. *     3)  CHECK THAT ALL SPECIFIED TRACKS ARE LOCKABLE. *     4)  UPDATE ADT AND TRAX.*     5)  UPDATE DIRECTORY AND IDT.       ORG LIBRA       JSB LOCNO     GET DISC NO.      OCT -4      CPA .+54B     CHECK FOR COMMA FOLLOWING.      RSS       JMP LFRER       LDA 1       RBR,RBR       STB LOCD      ADA ?ATBL     DOES DISC       LDA 0,I        EXIST?       SZA,RSS       JMP LOCR1     NO SUCH DISC. *       JSB LOCNO     GET FIRST TRACK       OCT -100      BLF,BLF       ADB LOCD      STB LOCF      CPA .+54B     TEST FOR SECOND PARAMETER.      RSS       JMP *+5       JSB LOCNO     GET LAST TRACK      OCT -100      BLF,BLF       ADB LOCD      STB LOCL      CPA .+15B     CHECK FOR CR FOLLOWING.       RSS       JMP LFRER *       CMB           MAKE SURE L>=F.       ADB LOCF      SSB,RSS       JMP LOCR2     IT ISN'T. * * TEST FOR ANY FUSS PROGRAM BEING LOCKED. *       LDA M128      INPUT       STA WORD      LDA FUSS,I     FUSS.      LDB LIBDI       JSB DISCL       LDA LIBD      TEST FUSS ENTRIES       STA *+2       JSB LOCTS       DEF LIBUS       ISZ *-1       BUMP POINTER.       ISZ WORD      ANY MORE?       JMP *-4 * * PREVENT LOCKING DIRECTORY TRACKS AND ID TRACK.*       JSB LOCTS       DEF DIREC+6       JSB LOCTS       DEF DIREC+13      JSB LOCTS       DEF DIREC+20      JSB LOCTS       DEF DIREC+27      JSB LOCTS       DEF IDLOC * * NOW READ ADT*       LDA ADLEN       STA WORD      LDA ADLOC       LDB LIBDI       JSB DISCL * * CHECK THAT NO SYSTEM TRACK (INDICATED BY AN ADT ENTRY OF LENGTH 0)* IS BEING LOCKED.*       LDA ADLEN     LENGTH.       ARS           # OF ENTRIES.       INA           DON'T COUNT LAST ONE.       STA LOCNT       LDA LIBD      INITIALIZE POINTER.       STA LOC1LOC2  DLD LOC1,I    GET ENTRY.      SZB           TEST ONLY IF ENTRY LENGTH = 0.      JMP *+3       JSB LOCTS LOC1  DEF LIBUS       ISZ LOC1      BUMP POINTER.       ISZ LOC1      ISZ LOCNT     ANY MORE?       JMP LOC2      YES.* * IT IS NOW PERMISSIBLE TO DO THE LOCKING. FIRST PURGE ADT. *       LDB LIBD      FIND FIRST ENTRY >= LOCF. LOC3  LDA LOCF      CMA,CLE,INA       ADA 1,I       SEZ       JMP *+3       FOUND ONE.      ADB .+2       JMP LOC3      STB MOVED     SAVE POINTER TO IT. LOC4  LDA LOCL      FIND FIRST ENTRY >=LOCL+128       ADA B200      CMA,CLE,INA       ADA 1,I       SEZ       JMP *+3       ADB .+2       JMP LOC4      STB MOVES *       ADB MLIBD     PERFORM       ADB ADLEN      MOVE       JSB MOVEW       OPERATION *       LDA MOVED     COMPUTE ADLEN.      CMA,INA       ADA LIBD      STA ADLEN       STA WORD      LDA ADLOC     WRITE ADT TO DISC.      LDB LIBD      JSB DISCL     WRITE TO DISC * * NOW MODIFY TRAX TABLE.*       LDA LOCF      GET FIRST TRACK NO IN LOCT. LOC5  STA LOCT      CLB           POSITION WORD NO IN B,      RRL 4          BIT NO IN A.       ALF       ADB DTRAX     GET POINTER TO WORD       STB LOCNT     SAVE IT.      ADA LOCLL     COMPUTE SHIFT INSTRUCTION.      STA *+2       CLA,INA       LSL 16        POSITION BIT.       SZA,RSS       IF LOW BIT,       INA            SET IT.      IOR LOCNT,I   SET BIT IN      STA LOCNT,I    WORD TO SAY LOCKED.      LDA LOCT      IS IT LAST TRACK?       CPA LOCL      JMP *+3       YES.      ADA B400      NO      JMP LOC5* * SET UP TO READ IN OVERLAY.*       LDA LIB       GET DISC      INA            ADDRESS OF OVERLAY.      LDA 0,I       LDB M252      STB WORD      LDB #LIBI       JMP LIBRA+254 * LOCLL LSL 16* * LOCNO SCANS THE INPUT FOR A NUMBER. THE NUMBER MUST BE LESS THAN* THE VALUE OF -(JSB+1). IT RETURNS WITH THE NUMBER IN B AND THE* NEXT CHAR. IN A.* LOCNO NOP       JSB LOCDG     GET A DIGIT.      JMP LFRER     ILLEGAL IF NONE.LOCN1 STB LOCN      SAVE PARTIAL RESULT.      ADB LOCNO,I   CHECK FOR OVERFLOW.       SSB,RSS       JMP LOCR2     ERROR.      JSB LOCDG     GET NEXT DIGIT.       JMP LOCN2     END OF NUMBER       LDA LOCN      MULTIPLY PREVIOUS RESULT BY 10.       RAL,RAL       ADA LOCN      RAL       ADB 0         ADD IN NEW VALUE.       JMP LOCN1     LOOP. LOCN2 LDB LOCN      RETURN NO.      ISZ LOCNO       JMP LOCNO,I * * LOCDG NOP           GET DECIMAL DIGIT.      JSB T35CQ     GET CHAR.       JMP LOCDG,I   NONE THERE.       LDB 0         DO DIGIT TEST.      ADB M72B      SSB,RSS       JMP LOCDG,I       ADB .+10      SSB,RSS       ISZ LOCDG       JMP LOCDG,I * LOCTS DETERMINES WHETHER A GIVEN TRACK IS INCLUDED IN THE RANGE OF* TRACKS BEING LOCKED. IF IT IS, AN ERROR MESSAGE IS PRINTED AND THE* ROUTINE IS TERMINATED.* * CALLING SEQUENCE: * *     JSB LOCTS *     DEF <LOCATION OF DISC ADDRESS>*     <RETURN IF OK>* LOCTS NOP       LDB LOCTS,I   GET POINTER TO DISC ADDRESS.      ISZ LOCTS     BUMP RETURN ADDRESS.      LDB 1,I       GET DISC ADDRESS      LDA LOCF      TEST AGAINST FIRST TRACK.       CMA,CLE,INA       ADA 1       SEZ,RSS       JMP LOCTS,I       CMB,CLE,INB   TEST AGAINST LAST TRACK.      ADB LOCL      ADB B200      SEZ,RSS       JMP LOCTS,I * * ERROR--ATTEMPT TO LOCK SYSTEM TRACK.*       CCA           GET DISC      ADA LOCTS      ADDRESS      LDA 0,I         AGAIN.      LDA 0,I       ALF,ALF       KEEP TRACK NO. ONLY.      AND B77       CLB           CONVERT TO DECIMAL.       DIV .+10      ALF,ALF       ADA 1       ADA ASC00       STA LOCR1-1   STORE IN BUFFER.      LDB .-20      JSB LOCER     PRINT ERROR MESS      OCT 5103      ASC 9,AN'T LOCK TRACK LOCR1 LDB .-13      JSB LOCER       OCT 5116      ASC 6,O SUCH DISC LOCR2 LDB .-19      JSB LOCER       OCT 5111      ASC 9,LLEGAL PARAMETERS LOCER NOP           ERROR PRINTER.      STB LOCT      LDA T35B1       STA MOVED       LDA LOCER       STA MOVES       BRS       JSB MOVEW       LDA LOCT      CMA,INA       LDB T35B1       JMP LEND+2* *       ORG LIBRA+254       JSB DISCL       JMP LIBRA $LOC  EQU * *       ORG LTEMP LOCD  BSS 1 LOCF  BSS 1 LOCL  BSS 1 LOCNT BSS 1 LOCN  BSS 1 LOCT  BSS 2 LOCID BSS 1 LOCP  BSS 1 LOCI  BSS 1 LOCDD BSS 1       HED LOCK OVERLAY* THIS SECTION OF THE LOCK ROUTINE IS RESPONSIBLE FOR UPDATING THE* DIRECTORY AND ID TABLE. EACH DIRECTORY ENTRY WHICH POINTS TO AN * AREA BEING LOCKED IS REMOVED FROM THE DIRECTORY, AND THE IDT IS * UPDATED ACCORDINGLY. THE ALGORITHM OPERATES AS FOLLOWS: * * EACH DIRECTORY TRACK IS READ IN TURN. THE ENTRIES ARE SCANNED,* USING MOVES AS A POINTER TO THEM. A NEW DIRECTORY IS BUILT BY DE- * LETING ALL ENTRIES NECESSARY, AND MOVED POINTS TO THE NEW DIREC-* TORY. WHEN ENTRIES ARE DELETED, THE NECESSARY INFO FOR UPDATING * THE IDT IS INSERTED IN A TABLE AT THE UPPER END OF THE SWAP AREA. * THE ROUTINE LOCFX IS CALLED AT CRITICAL TIMES TO UPDATE THE IDT * FROM THIS TABLE. THE MEANINGS OF THE VARIOUS POINTERS IS AS * FOLLOWS:* * LOCI=>DIREC ENTRY FOR DIRECTORY TRACK BEING UPDATED.* LOCP=>LAST ENTRY MADE IN UPPER CORE TABLE.* LOCID=>FIRST WORD BEYOND IDT. * MOVES=>ENTRY IN OLD DIRECTORY * MOVED=>BEYOND LAST ENTRY IN NEW DIRECTORY * LOCD=>BEYOND LAST ENTRY IN OLD DIRECTORY      SPC 2       ORG LIBRA       LDA IDLEN     INITIALIZE      CMA,INA        LOCID,LOCI,LOCP.       ADA LIBD      STA LOCID       LDA L5440       STA LOCP      LDA DIRD0 LOC6  STA LOCI      SET POINTER TO DIREC.       LDA MLIBD     TEST FOR WHETHER WE CAN FIT THE       ADA LOCI,I     DIRECTORY TRACK IN WITHOUT       ADA LOCP        CLOBBERING THE HICORE TABLE.      SSA           IF NOT, CALL LOCFX TO       JSB LOCFX      CLEAR OUT THAT TABLE.      LDA LOCI,I    READ IN THE DIRECTORY.      STA WORD      LDA LOCI      ADA .+6       LDA 0,I       STA LOCDD       LDB LIBDI       JSB DISCL *       LDA LIBD      INITIALIZE LOCD,MOVED,MOVES       STA MOVES       STA MOVED       CMA       ADA LOCI,I      CMA       STA LOCD* LOC8  LDB MOVES     IF MOVES=LOCD. WE'VE EXAMINED       CPB LOCD       THE ENTIRE DIRECTORY TRACK.      JMP LOC7      GO TO WRITE OUT TRACK.      ADB .+6       TEST FOR DELETING ENTRY.      LDA 1,I       A=DISC ADDRESS.       CMA,CLE,INA   TEST AGAINST LAST TRACK.      ADA LOCL      ADA B200      SEZ,RSS       JMP LOC9      BEYOND LAST TRACK BEING LOCKED.       LDA LOCF      TEST AGAINST FIRST TRACK.       CMA,CLE,INA       ADA 1,I       SEZ       JMP LOC10     GO TO DELETE ENTRY. * * NOT DELETING ENTRY--SLIDE UP AGAINST NEW DIRECTORY BEING BUILT. * LOC9  LDB .-8       JSB MOVEW       JMP LOC8* LOC10 LDA MOVES,I   COPY ID AND LENGTH IN SECTORS INTO      STA LOCT       LOCT&T+1.      INB       LDA 1,I       GET LENGTH.       INB           BUMP MOVES TO       STB MOVES      NEXT ENTRY.      CCB           CONVERT LENGTH TO       ASR 6          NEG. SECTORS.      STA LOCT+1*       LDB LOCP      TEST FOR ENTRY WITH SAME ID IN      CPB L5440      HICORE TABLE.      JMP LOC11     TABLE EMPTY.      LDA LOCT      CPA LOCP,I      INB,RSS       IT'S THERE.       JMP LOC11       LDA 1,I       UPDATE ENTRY.       ADA LOCT+1      STA 1,I       JMP LOC8* * HAVE TO MAKE NEW ENTRY. TEST IF HICORE TABLE IS ALREADY TOUCHING* THE DIRECTORY.* LOC11 CPB LOCD      JMP LOC12     IT IS--GO SQUEEZE THE DIRECTORY.LOC14 CPB LOCID     MAKE SURE WE'LL BE ABLE TO READ       JMP LOC13      THE IDT. LOC15 ADB .-2       CREATE NEW ENTRY.       STB LOCP      DLD LOCT      DST LOCP,I      JMP LOC8* * DIRECTORY ENDS AT BEGINNING OF HICORE TABLE. WE NOW SLIDE THE * ENTIRE DIRECTORY UP TO MAKE ROOM. * LOC12 LDA MOVED     SAVE MOVED IN N.      STA LOCN      CMB,INB       COMPUTE LENGTH OF MOVE.       ADB MOVES       JSB MOVEW       LDA MOVED     RESET DIRECTORY POINTERS.       STA LOCD      LDA LOCN      STA MOVED       STA MOVES       LDB LOCP      JMP LOC14 * * WE BARELY HAVE ROOM FOR THE IDT, SO WE WILL GAIN ROOM BY TEMPORAR-* ILY WRITING THE DIRECTORY ON THE DISC AND THEN PERFORMING ALL THE * IDT UPDATES.* LOC13 LDA LOCD      FIRST WRITE OUT DIRECTORY.      CMA,INA       ADA LIBD      STA WORD      LDA LOCDD       LDB LIBD      JSB DISCL *       JSB LOCFX     NOW CLEAN HICORE TABLE. *       LDA LOCD      NOW READ BACK DIRECTORY.      CMA,INA       ADA LIBD      STA WORD      LDA LOCDD       LDB LIBDI       JSB DISCL       LDB LOCP      JMP LOC15 * *  THE END OF THE DIRECTORY TRACK HAS BEEN REACHED. *  WRITE OUT THE NEW IMPROVED VERSION AND THEN TEST TO*  SEE IF WE'RE DONE. * LOC7  LDA MOVED     COMPUTE NEW DIRECTORY       CMA,INA        LENGTH.      ADA LIBD      STA LOCI,I    STORE IN TABLE.       STA WORD      PERFORM DISC TRANSFER.      LDA LOCDD       LDB LIBD      STB MOVES       JSB DISCL       LDA LOCI      SET UP 4 WORDS IN DIREC.      INA       STA MOVED       LDB .-4       JSB MOVEW       LDA LOCI      WAS THAT THE LAST TRACK?      CPA DIRD3       JMP *+3       YES--GO FINISH UP.      ADA .+7       NO--GO DO NEXT TRACK.       JMP LOC6*       JSB LOCFX     DO LAST IDT UPDATE*       CLA           FORCE A RECALL TO BRING IN THE      CLF 0          ORIGNAL LOCK ROUTINE.      STA LIB       JMP LEND* * THE LOCFX ROUTINE TAKES CARE OF THE ACTUAL IDT UPDATE. IT READS * IN THE IDT, MODIFIES EACH ENTRY SPECIFIED BY THE TABLE, WRITES* BACK THE IDT, AND LEAVES LOCP=L5440.* LOCFX NOP       LDA LOCP      CHECK FOR ANYTHING TO DO.       CPA L5440       JMP LOCFX,I   NO.       LDA IDLEN     READ IDT.       STA WORD      LDA IDLOC       LDB LIBDI       JSB DISCL       LDB IDLEN     SET B TO POINT AT END OF IDT.       CMB,INB       ADB LIBDLOCF1 LDA LOCP,I    GET ID OF FIRST PATCH.      ADB .-8       SEARCH FOR IT IN IDT.       CPA 1,I       RSS           FOUND.      JMP *-3       ISZ LOCP      POINT TO SECTOR UPDATE.       ADB .+7       POINT TO SECTORS USED.      LDA 1,I       SUBTRACT      ADA LOCP,I     PATCH      STA 1,I         OFF.      ISZ LOCP      SET LOCP TO POINT AT NEXT ENTRY.      ADB .-7       SET B BACK TO BEGINNING OF ENTRY      LDA LOCP      TEST FOR DONE       CPA L5440       RSS       JMP LOCF1     LOOP. *       LDA IDLOC       LDB LIBD      WRITE BACK IDT.       JSB DISCL       JMP LOCFX,I   RETURN. $$LOC EQU * 