PACKER
          IDENT  PACKER,DATA
          ABS 
          ENTRY  PACKER 
          ENTRY  RFL= 
          ENTRY  SSJ= 
          SST 
          SYSCOM B1 
          ORG    110B 
          SPACE  4,10 
*COMMENT  PACKER - IAPF HOLE PACKER.
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
          SPACE  4,10 
          TITLE  PACKER - INDIRECT ACCESS PERMANENT FILE HOLE PACKER. 
***       PACKER - INDIRECT ACCESS PERMANENT FILE HOLE PACKER.
* 
*         C. A. LACEY.       75/12/18.
*         D. F. LINTON.      75/12/18.
*         R. R. VEACH.       78/01/08.
*         W. J. STURGIS.     78/03/07.
*         D. G. BEAUSANG.    80/08/24.
*         A. J. NATHANSON.   83/10/25.
*         K. R. DELAY.       84/03/26.
*         B. G. ALBRECHT.    85/03/22.
*         D. G. BEAUSANG.    87/01/06.
*         P. C. SMITH.       87/12/01.
          SPACE  4,15 
***           *PACKER* PERFORMS PERIODIC MAINTENANCE ON THE INDIRECT
*         ACCESS PERMANENT FILE (IAPF) CHAIN.  THE PROCESS OF IAPF
*         HOLE FRAGMENTATION, OCCURRING DURING NORMAL IAPF ACTIVITY,
*         IS COUNTERED BY THE PERIODIC EXECUTION OF *PACKER*.  ADJACENT 
*         HOLES ARE COLLAPSED TOGETHER, FILES ARE MOVED TO MAXIMIZE 
*         THE SIZE OF HOLES, AND LOST SPACE IS RECLAIMED IF POSSIBLE. 
*         THE SPACE OCCUPIED BY THE ENLARGED HOLES IS RETURNED TO THE 
*         OPERATING SYSTEM IF POSSIBLE.  THE HOLES WHICH MAY REMAIN AT
*         THE END OF *PACKER* EXECUTION ARE LARGER AND MORE USEFUL TO 
*         IAPF OPERATIONS.
* 
*             THE OPERATION OF *PACKER* NEVER LEAVES A DISK VULNERABLE. 
*         *PACKER* DUPLICATES ANY FILE IT MOVES, AND CHANGES THE FILE 
*         ADDRESS IN THE PFC WITH A SINGLE SECTOR REWRITE.  IF A
*         MACHINE OR ENVIRONMENT FAILURE OCCURS, ALL IAPF FILES ARE 
*         INTACT. 
          SPACE  4,10 
***           *PACKER* MAY BE RUN IN AN ACTIVE SYSTEM ENVIRONMENT.
*         USER ACCESS TO THE DEVICE IS PREVENTED WHILE *PACKER* IS
*         RUNNING BY SETTING THE PF UTILITY ACTIVE INTERLOCK IN THE 
*         MASS STORAGE TABLE.  SINCE *PACKER* CAN BE RUN IN AN ACTIVE 
*         SYSTEM, IT CAN BE USEFUL FOR DEALING WITH EMERGENCY 
*         SITUATIONS WHERE A DEVICE IS GETTING FULL DURING
*         PRODUCTION.  CONTIGUOUS HOLES CAN BE COMBINED QUICKLY BY
*         ENTERING
* 
*             PACKER(FM=NNNNNNN,DN=XX,NM) 
* 
*         IF ANY HOLES MADE BY COALESCING CONTIGUOUS HOLES ARE LARGE
*         ENOUGH, TRACKS WILL BE MADE AVAILABLE THROUGH DELINKING.
*         THE REMAINING HOLES SHOULD BE MORE USEFUL DUE TO THEIR
*         INCREASED SIZE. 
* 
*             FOR NORMAL PERIODIC MAINTENANCE, *PACKER* CAN BE RUN AT 
*         A TIME WHEN THE PRODUCTION LOAD IS LIGHT AND/OR PRIMARILY 
*         NOT INTERACTIVE.  FOR EXAMPLE, A SITE MAY CHOOSE TO RUN 
*         *PACKER* VIA THE FOLLOWING COMMAND AT 0230 LOCAL TIME EVERY 
*         MORNING.
* 
*             PACKER(FM=NNNNNNN,DN=XX)
* 
*         IF A SITE DETERMINES THAT THIS IS TOO MUCH OF AN IMPACT ON
*         PRODUCTION, THEY MAY DECIDE TO RUN *PACKER* WITH THE ABOVE
*         COMMAND ONLY ON SUNDAY MORNINGS AND THE REST OF THE WEEK
*         THEY MAY NOT RUN *PACKER* AT ALL OR THEY MAY ONLY COMBINE 
*         HOLES VIA THE FOLLOWING COMMAND.
* 
*             PACKER(FM=NNNNNNN,DN=XX,NM) 
* 
*             HOW FREQUENTLY *PACKER* NEEDS TO BE RUN IS SITE 
*         DEPENDENT.  SITES WHICH ARE EXTREMELY LIMITED ON DISK SPACE 
*         MAY NEED TO RUN *PACKER* MUCH MORE OFTEN THAN SITES WHICH 
*         RUN *PACKER* ONLY TO PROVIDE DYNAMIC SPACE MANAGEMENT OF
*         THE IAPF CHAIN.  THE DYNAMIC SPACE MANAGEMENT OF THE IAPF 
*         CHAIN WHICH *PACKER* PROVIDES FREES A SITE FROM SPACE 
*         MANAGEMENT VIA *PFDUMP* AND *PFLOAD*. 
* 
*             A SINGLE CALL TO *PACKER* ONLY ACCESSES A SINGLE
*         DEVICE, BUT MULTIPLE COPIES OF *PACKER* MAY BE ACTIVE AT
*         THE SAME TIME IF EACH IS OPERATING ON A DIFFERENT DEVICE. 
* 
*             TURNING ON SENSE SWITCH 1 WILL STOP *PACKER* IN A 
*         CONTROLLED MANNER.  AN OPERATOR DROP OR IDLE DOWN REQUEST 
*         WILL ALSO TERMINATE *PACKER* IN A CONTROLLED MANNER.  A 
*         SECOND OPERATOR DROP OR IDLE DOWN REQUEST WILL TERMINATE
*         *PACKER* IMMEDIATELY. 
          SPACE  4,10 
***       COMMAND FORMAT. 
          SPACE  4,10 
***       PACKER (P1=F1,P2=F2,...,PN=FN)
* 
*         WHERE P1, P2, ... PN CAN BE THE FOLLOWING - 
* 
*         DN =   DEVICE NUMBER OF THE DEVICE TO BE PACKED.  REQUIRED
*                UNLESS THE DEVICE IS AN AUXILIARY PACK.
* 
*         FM =   FAMILY NAME OF THE DEVICE TO BE PACKED.  REQUIRED
*                UNLESS THE DEVICE IS AN AUXILIARY PACK.
*                DEFAULT - SYSTEM DEFAULT FAMILY NAME.
* 
*         NM =   NO MOVES.  IF SPECIFIED, *PACKER* WILL NOT MOVE ANY
*                FILES.  THE WORK PERFORMED IS LIMITED TO THE 
*                COALESCING OF CONTIGUOUS HOLES AND THE RECLAMATION 
*                OF LOST SPACE. 
*                THIS PARAMETER MAY NOT BE EQUIVALENCED.
* 
*         PN =   PACKNAME OF THE AUXILIARY PACK TO BE PACKED. 
*                REQUIRED IF THE DEVICE TO BE PACKED IS AN AUXILIARY
*                PACK.
* 
*         TL =   TIME LIMIT.  THE MAXIMUM REAL TIME TO RUN IN 
*                SECONDS.  THE VALUE IS ASSUMED TO BE OCTAL.  AN 8, 9 
*                OR POST RADIX OF D WILL FORCE DECIMAL.  A POST RADIX 
*                OF B WILL FORCE OCTAL. 
*                DEFAULT - NO LIMIT.
*                ALTERNATE DEFAULT - 300D.
* 
*         THE FOLLOWING COMMAND PARAMETERS ARE ESOTERIC AND NEED NOT BE 
*         CONSIDERED FOR NORMAL OPERATION.
* 
*         EF =   EXACT FIT.  IF SPECIFIED, AN EXACT FIT IS REQUIRED 
*                FOR FILL MOVES.  USE OF THIS PARAMETER MAY INCREASE
*                THE NUMBER OF FILES MOVED VIA THE SLIDE TECHNIQUE
*                WHICH CAN RESULT IN MORE SPACE BEING RELEASED TO THE 
*                OPERATING SYSTEM AT THE EXPENSE OF MOVING AN 
*                INCREASED NUMBER OF FILES. 
*                THIS PARAMETER MAY NOT BE EQUIVALENCED.
* 
*         IX =   INDEX.  THE STARTING INDEX INTO THE SORTED PFC 
*                TABLE.  THIS PARAMETER CAN BE USED TO SKIP THE 
*                SPECIFIED NUMBER OF PFC ENTRIES BEFORE BEGINNING 
*                OPERATION.  IN SOME SITUATIONS THIS PROVIDES A 
*                USEFUL METHOD OF SHORTENING THE EXECUTION TIME OF
*                *PACKER*.  THE USE OF THIS PARAMETER IMPACTS THE END 
*                OF RUN STATISTICS AS THEY DO NOT REFLECT THE PORTION 
*                SKIPPED.  THE VALUE IS ASSUMED TO BE OCTAL.  AN 8, 9 
*                OR POST RADIX OF D WILL FORCE DECIMAL.  A POST RADIX 
*                OF B WILL FORCE OCTAL. 
*                DEFAULT - 0. 
* 
*         MR =   MOVE RATIO.  THIS IS THE MAXIMUM RATIO ALLOWED OF
*                TOTAL DATA TO MOVE TO HOLE SIZE FOR A SLIDE MOVE.
*                BEFORE MOVING A FILE WITH THE SLIDE TECHNIQUE, THE 
*                TOTAL AMOUNT OF DATA TO BE MOVED (THE SUM OF ALL THE 
*                FILE LENGTHS UP TO THE NEXT HOLE IN THE IAPF CHAIN)
*                AND THE HOLE SIZE (THE HOLE THE FILE IS TO BE SLID 
*                ACROSS) ARE COMPARED (THE TOTAL DATA IS DIVIDED BY 
*                THE HOLE SIZE).  IF THIS RATIO IS GREATER THAN OR
*                EQUAL TO THE *MOVE RATIO*, THEN THE FILE IS NOT
*                MOVED.  A VALUE OF 0 WILL PREVENT ALL FILES FROM 
*                BEING MOVED VIA THE SLIDE TECHNIQUE; HOWEVER,
*                IT IS RECOMMENDED THAT THE *NS* PARAMETER BE 
*                USED RATHER THAN SPECIFYING *MR=0*.  THE VALUE IS
*                ASSUMED TO BE OCTAL.  AN 8, 9 OR POST RADIX OF D 
*                WILL FORCE DECIMAL.  A POST RADIX OF B WILL FORCE
*                OCTAL. 
*                DEFAULT - 100B.
*                ALTERNATE DEFAULT - 377777B. 
* 
*         NC =   NO CHANGES.  IF SPECIFIED, *PACKER* WILL NOT MAKE
*                ANY CHANGES TO THE DEVICE.  THIS ALLOWS MULTIPLE 
*                SCENARIOS TO BE RUN TO DETERMINE THE BEST
*                COMBINATION OF OPTIONS TO OBTAIN THE DESIRED 
*                RESULTS.  MOST DEVICE READS ARE PERFORMED EXCEPT 
*                THOSE CONCERNING FILE COPIES.  NO DEVICE WRITES ARE
*                PERFORMED. 
*                THIS PARAMETER MAY NOT BE EQUIVALENCED.
* 
*         NF =   NO FILL MOVES.  IF SPECIFIED, *PACKER* WILL NOT MOVE 
*                ANY FILES USING THE FILL MOVE TECHNIQUE.  USE OF 
*                THIS PARAMETER FORCES ALL FILES TO BE MOVED VIA THE
*                SLIDE TECHNIQUE.  THIS CAN RESULT IN MORE SPACE
*                BEING RELEASED TO THE OPERATING SYSTEM AT THE
*                EXPENSE OF MOVING AN INCREASED NUMBER OF FILES.
*                THIS PARAMETER MAY NOT BE EQUIVALENCED.
* 
*         NP =   NO PRE-MOVE DELINKS.  IF SPECIFIED, *PACKER* WILL NOT
*                DELINK TRACKS PRIOR TO ATTEMPTING TO MOVE FILES. 
*                DELINKING TRACKS PRIOR TO MOVING FILES LIMITS THE
*                SIZE TO WHICH THE COLLECTION HOLE IS ALLOWED TO
*                GROW.  THIS LIMITS THE AMOUNT OF DATA (FILES) MOVED
*                BY *PACKER* IN ITS ATTEMPTS TO FILL THE COLLECTION 
*                HOLE.  THESE DELINKS MAY SHORTEN THE TIME *PACKER* 
*                EXECUTES AT THE EXPENSE OF POSSIBLY LEAVING SMALL
*                HOLES AT THE POINT WHERE TRACK(S) WERE DELINKED. 
*                THIS PARAMETER DOES NOT AFFECT THE DELINKING OF
*                TRACKS FROM HOLES WHICH REMAIN AFTER *PACKER* HAS
*                COMPLETED ITS WORK.
*                THIS PARAMETER MAY NOT BE EQUIVALENCED.
* 
*         NS =   NO SLIDE MOVES.  IF SPECIFIED, *PACKER* WILL NOT 
*                MOVE ANY FILES USING SLIDE MOVE TECHNIQUE.  THIS MAY 
*                INCREASE THE SPEED OF *PACKER* EXECUTION BY LEAVING
*                MORE HOLES UNFILLED.  IT IS USUALLY BETTER TO USE
*                THE *MR* PARAMETER TO CONTROL THE SLIDE MOVE.  THE 
*                ONLY EXCEPTION IS THAT IT IS BETTER TO SPECIFY *NS*
*                THAN *MR=0* AS (FOR VERY ESOTERIC REASONS) *MR=0*
*                MAY ALSO DISABLE A TYPE OF LOST SPACE RECLAMATION. 
*                THIS PARAMETER MAY NOT BE EQUIVALENCED.
          SPACE  4,10 
**        DEBUGGING COMMAND OPTIONS.
* 
*         THE FOLLOWING OPTIONS ARE PROVIDED FOR DEBUGGING PURPOSES 
*         ONLY. 
* 
*         DEBUG = OCTAL VALUE, EACH BIT SPECIFYING A DEBUGGING OPTION 
*                 TO BE ACTIVATED.
*                 BIT - OPTION
*                   0 - CALL *CEO* IN THE MAIN LOOP.
*                   1 - ACTIVATE RJ TRACE.
*                 DEFAULT - 0 (ALL DEBUG OPTIONS OFF).
*                 ALTERNATE DEFAULT - 377777B (ALL DEBUG OPTIONS ON). 
          SPACE  4,10 
***           OPERATIONAL OVERVIEW. 
* 
*             *PACKER* SCANS THE DEVICE-S CATALOG TRACKS AND BUILDS A 
*         SET OF TABLES WHICH ALLOWS IT TO OPERATE ON THE IAPF CHAIN
*         IN SEQUENTIAL ORDER.  AS *PACKER* SCANS THE IAPF CHAIN IT 
*         PERFORMS FUNCTIONS DEPENDING ON THE ITEMS ENCOUNTERED.
* 
*             LOST SPACE IS A CONDITION WHERE SPACE EXISTS ON THE 
*         IAPF CHAIN WHICH IS NOT POINTED TO BY A PFC ENTRY.  WITHOUT 
*         A PFC ENTRY *PFM* IS UNAWARE OF THE SPACE; THUS THE NAME, 
*         LOST SPACE.  IF THE LOST SPACE IS PRECEDED OR FOLLOWED BY A 
*         HOLE, *PACKER* WILL MERGE THE LOST SPACE WITH ONE OF THE
*         HOLES.  IF THE LOST SPACE IS PRECEDED BY A FILE AND NOT 
*         FOLLOWED BY A HOLE, *PACKER* WILL CREATE A NEW PFC ENTRY
*         FOR THE LOST SPACE, TRANSFORMING IT INTO A NORMAL IAPF
*         HOLE.  IF THE LOST SPACE IS SMALLER THAN THE ABSOLUTE 
*         MINIMUM IAPF HOLE SIZE OF THREE PRU-S, THE LOST SPACE CAN 
*         NOT BE RECLAIMED AND IS LEFT AS LOST SPACE. 
* 
*             A FILE IS CHECKED TO SEE IF IT HAS THE CORRECT LENGTH.
* 
*             A HOLE STARTS A SEQUENCE OF EVENTS.  THE HOLE IS TURNED 
*         INTO THE COLLECTION HOLE.  THE COLLECTION HOLE IS THE FOCAL 
*         POINT OF THE MAJOR OPERATIONS OF COMBINING HOLES AND MOVING 
*         FILES.  THE PFC POINTING TO THE COLLECTION HOLE IS CHANGED
*         INTO A PURGED DIRECT ACCESS PERMANENT FILE (DAPF) PFC.
*         THIS PFC WILL BE CHANGED BACK INTO AN IAPF PFC POINTING TO
*         THE HOLE WHEN THE COLLECTION HOLE IS CHANGED BACK INTO A
*         NORMAL HOLE.  UNTIL THAT OCCURS, THE COLLECTION HOLE IS 
*         LOST SPACE.  *PACKER* USES THIS TO PROVIDE FOR A SYSTEM 
*         FAILURE DURING *PACKER* OPERATION.  THE SYSTEM WILL BE
*         UNAWARE OF THE CHANGES *PACKER* WAS MAKING, ALL FILES WILL
*         BE INTACT, AND THE LOST SPACE WILL BE RECOVERED THE NEXT
*         TIME *PACKER* IS RUN.  THE FOLLOWING SEQUENCE WILL BE 
*         REPEATED UNTIL THE COLLECTION HOLE IS CLOSED. 
* 
*             ANY HOLES FOLLOWING THE COLLECTION HOLE HAVE THEIR PFC-S
*         CHANGED INTO PURGED DAPF PFC-S AND THEIR SPACE IS ADDED TO
*         THE COLLECTION HOLE.  THIS COLLAPSING OF CONTIGUOUS HOLES IS
*         CONTINUED UNTIL A FILE IS ENCOUNTERED.
* 
*             WHEN A FILE IS ENCOUNTERED A CHECK IS MADE TO SEE IF THE
*         COLLECTION HOLE IS BIG ENOUGH FOR TRACKS TO BE DELINKED FROM
*         IT.  IF SO, TRACKS ARE DELINKED AND RETURNED TO THE SYSTEM. 
*         AN IMPORTANT EFFECT OF THIS PREMOVE DELINKING IS THAT IT
*         LIMITS THE AMOUNT OF DATA (FILES) THAT ARE MOVED BY LIMITING
*         THE SIZE OF THE COLLECTION HOLE.
* 
*             NEXT A SCAN IS MADE STARTING FROM THE END OF THE IAPF 
*         CHAIN TO THE CURRENT POSITION, LOOKING FOR THE LARGEST FILE 
*         WHICH WILL FIT INTO THE COLLECTION HOLE.  IF SUCH A FILE IS 
*         FOUND IT WILL BE COPIED TO THE BEGINNING OF THE COLLECTION
*         HOLE AND ITS PFC WILL BE UPDATED TO POINT TO THE NEW
*         POSITION.  THEN THE COLLECTION HOLE-S STARTING ADDRESS AND
*         LENGTH IS UPDATED.  THIS IS THE JUMP FILL MOVE TECHNIQUE.  IF 
*         THE COLLECTION HOLE WAS COMPETELY FILLED, IT IS CONSIDERED
*         CLOSED AND THE SCAN STARTS OVER.  IF THE MOVE WAS SUCCESSFUL, 
*         IT IS REPEATED UNTIL NO FURTHER FILES CAN BE MOVED VIA THE
*         FILL TECHNIQUE. 
* 
*             NEXT, THE FILE ADJACENT TO THE COLLECTION HOLE (WHICH WAS 
*         EXCLUDED FROM THE FILL SEARCH) IS EXAMINED TO SEE IF IT CAN 
*         BE SLID ACROSS THE COLLECTION HOLE.  THE FILE MUST COMPLETELY 
*         FIT WITHIN THE COLLECTION HOLE, FOR THE FILE WOULD BE 
*         DESTROYED IF THE FILE WAS COPIED ON TOP OF ITSELF AND THE 
*         SYSTEM FAILED DURING THE COPY.  THE SIZES OF ALL THE FILES
*         UNTIL THE NEXT HOLE ARE EXAMINED TO ENSURE THEY ALL WILL
*         FIT IN THE COLLECTION HOLE (IF ANY DO NOT FIT THE EFFECT OF 
*         THE MOVES WOULD ONLY BE TO MOVE THE POSITION OF THE HOLE, 
*         WHICH IN ITSELF IS OF NO BENEFIT).  IF ALL THE FILES FIT, 
*         THEY ARE COPIED, ONE BY ONE, ACROSS THE COLLECTION HOLE, AND
*         THE ADDRESS OF THE COLLECTION HOLE IS UPDATED.  THIS IS THE 
*         SLIDE MOVE TECHNIQUE.  THE SCAN THEN CONTINUES WITH THE 
*         COLLAPSING OF THE NEWLY ADJACENT HOLE.  IF THE FILES DO NOT 
*         FIT, THE COLLECTION HOLE IS CLOSED AND SCAN CONTINUES.
* 
*             WHEN THE END OF THE IAPF CHAIN IS ENCOUNTERED THE SCAN
*         TERMINATES.  IF THE COLLECTION HOLE IS OPEN, IT IS DROPPED
*         OFF THE THE END OF THE IAPF CHAIN BY ADJUSTING THE EOI. 
          SPACE  4,10 
**            THE PP HELPER PROGRAM *MPF* IS CALLED TO DO 
*         THE FOLLOWING - 
*         1. DROP TRACKS FROM IAPF CHAIN. 
*         2. REWRITE END OF INFORMATION FOR FILE COPY.
*         3. DELINK TRACKS FROM IAPF CHAIN. 
*         4. READ SYSTEM SECTOR.
*         5. WRITE SYSTEM SECTOR. 
*         6. RETURN FST FOR OVERFLOW CATALOG TRACK. 
*         7. REWRITE CATALOG TRACK SECTOR.
          SPACE  4,10 
**            THE PF UTILITY PP ROUTINE *PFU* IS CALLED TO DO 
*         THE FOLLOWING - 
*         1. SET PF UTILITY DEVICE INTERLOCK. 
*         2. CLEAR PF UTILITY INTERLOCK.
*         3. REWIND CATALOG FILE. 
*         4. OPEN CATALOG / DATA FILE.
*         5. ADVANCE CATALOG TRACK. 
          SPACE  4,10 
***       TERMINATION DAYFILE MESSAGES (SYSTEM AND LOCAL DAYFILE).
* 
*         * PACKER COMPLETE.* 
*                *PACKER* TERMINATED NORMALLY.
* 
*         * PACKER ABORTED.*
*                *PACKER* TERMINATED ABNORMALLY.
* 
*         * REAL TIME DURATION TERMINATION.*
*                THE MAXIMUN REAL TIME ALLOWED FOR *PACKER* TO EXECUTE
*                HAS BEEN EXCEEDED. 
* 
*         * SENSE SWITCH ONE TERMINATION.*
*                *PACKER* HAS DETECTED A TERMINATION REQUEST VIA
*                SENCE SWITCH ONE.
          SPACE  4,10 
***       STATISTICAL DAYFILE MESSAGES (SYSTEM AND LOCAL DAYFILE).
* 
*         *PACKER* STATISTICS (BELOW) REFLECT THE CONDITION OF THE
*         PORTION OF THE IAPF CHAIN WHICH *PACKER* HAS PROCESSED. 
* 
*         * ONSET FILES     NNNNNN,  SSSSSS PRUS.*
*                *PACKER* STATISTICS. 
*                NNNNNN - NUMBER OF FILES AT *PACKER* ONSET.
*                SSSSSS - TOTAL SECTORS OCCUPIED BY FILES AT *PACKER* 
*                         ONSET.
* 
*         * ONSET HOLES     NNNNNN,  SSSSSS PRUS.*
*                *PACKER* STATISTICS. 
*                NNNNNN - NUMBER OF HOLES AT *PACKER* ONSET.
*                SSSSSS - TOTAL SECTORS OCCUPIED BY HOLES AT *PACKER* 
*                         ONSET.
* 
*         * FILL MOVES      NNNNNN,  SSSSSS PRUS.*
*                *PACKER* STATISTICS. 
*                NNNNNN - NUMBER OF FILES JUMP FILLED INTO HOLES. 
*                SSSSSS - TOTAL SECTORS JUMP MOVED. 
* 
*         * SLIDE MOVES     NNNNNN,  SSSSSS PRUS.*
*                *PACKER* STATISTICS. 
*                NNNNNN - NUMBER OF FILES SLID INTO HOLES.
*                SSSSSS - TOTAL SECTORS SLID. 
* 
*         * FILES MOVED     NNNNNN,  SSSSSS PRUS.*
*                *PACKER* STATISTICS. 
*                NNNNNN - NUMBER OF FILES MOVED.
*                SSSSSS - TOTAL SECTORS MOVED.
* 
*         * LOST SPACE      NNNNNN,  SSSSSS PRUS.*
*                *PACKER* STATISTICS. 
*                NNNNNN - NUMBER OF HOLES WITHOUT CATALOG ENTRIES.
*                SSSSSS - TOTAL SECTORS W/O CATALOG HOLE ENTRIES. 
*                         THIS MESSAGE INDICATES THE AMOUNT OF LOST 
*                         SPACE WHICH *PACKER* WAS UNABLE TO RECLAIM. 
*                         IT REMAINS UNKNOWN TO *PFM*.  IT MAY BE 
*                         RECLAIMED ON A FUTURE *PACKER* RUN AFTER
*                         PRODUCTION HAS CHANGED THE MAKEUP OF THE
*                         IAPF CHAIN.  (SYSTEM AND EOI SECTORS ARE
*                         NOT REMOVED FROM THIS TOTAL, SINCE LOST SPACE 
*                         CAN BE LESS THAN THREE SECTORS).
* 
*         * HOLES LEFT      NNNNNN,  SSSSSS PRUS.*
*                *PACKER* STATISTICS. 
*                NNNNNN - NUMBER OF HOLES WITH CATALOG ENTRIES. 
*                SSSSSS - TOTAL SECTORS WITH CATALOG HOLE ENTRIES.
* 
*         * HOLES FREED     NNNNNN,  SSSSSS PRUS.*
*                *PACKER* STATISTICS. 
*                NNNNNN - NUMBER OF CATALOG ENTRIES FREED.
*                SSSSSS - SECTORS REMOVED FROM THE IAPF CHAIN.  THIS
*                         IS THE NUMBER OF SECTORS GAINED WHEN VIEWING
*                         THE IAPF CHAIN AS A SEQUENCE OF SECTORS,
*                         IGNORING THE EFFECTS OF TRACK BOUNDARIES. 
* 
*         * TRACKS FREED    NNNNNN,  SSSSSS PRUS.*
*                *PACKER* STATISTICS. 
*                NNNNNN - NUMBER OF TRACKS DELINKED OR DROPPED. 
*                SSSSSS - SECTORS RETURNED TO THE SYSTEM VIA TRACK
*                         DELINKS OR TRACK DROPS. 
* 
*         * FLAW SPACE      NNNNNN,  SSSSSS PRUS.*
*                *PACKER* STATISTICS. 
*                NNNNNN - NUMBER OF IAPF FLAW FILES ENCOUNTERED.
*                SSSSSS - SECTORS OCCUPIED BY IAPF FLAW FILES.
*                         IAPF FLAWS ARE FILES WITH UI=IFUI.  THEY MAY
*                         RESIDE ON ANY IAPF DEVICE REGARDLESS OF THE 
*                         DEVICE MASK.
* 
*         *PACKER* RESOURCE UTILIZATION SUMMARY (BELOW) REFLECTS THE
*         RESOURCES USED BY *PACKER*. 
* 
*         * SRUS                23456.890 UNTS.*
*         * CPU SECONDS         23456.890 SECS.*
*         * MAXIMUM CM FL       234567890  SCM.*
*         * MANAGED TABLE MOVES 234567890 UNTS.*
          SPACE  4,10 
***       EXTERNAL ABORT DAYFILE MESSAGES (SYSTEM AND LOCAL DAYFILE). 
* 
*         *REPRIEVE PROCESSING BEGUN.*
*                *PACKER* HAS BEGUN REPRIEVE PROCESSING.
* 
*         *REPRIEVE PROCESSING COMPLETE.* 
*                *PACKER* HAS COMPLETED REPRIEVE PROCESSING.
* 
*         *STATISTICS MAY NOT BE ACCURATE.* 
*                *PACKER* IS ISSUING STATISTICAL MESSAGES DURING
*                REPRIEVE OR ERROR RECOVERY PROCESSING.  SINCE NORMAL 
*                PROCESSING HAS BEEN INTERRUPTED, THE INFORMATION MAY 
*                NOT BE ACCURATE. 
* 
*         WHEN AN ERROR FLAG IS SET AT *PACKER*-S CONTROL POINT, THE
*         CORRESPONDING MESSAGE (BELOW) IS ISSUED AND REPRIEVE
*         PROCESSING IS BEGUN.
* 
*         *USER BREAK ONE.* 
*         *USER BREAK TWO.* 
*         *ARITHMETIC ERROR.* 
*         *SCP INVALID TRANSFER ADDRESS.* 
*         *PROGRAM STOP ERROR.* 
*         *PPU ABORT.*
*         *CPU ABORT.*
*         *PPU CALL ERROR.* 
*         *COMMAND LIMIT.*
*         *MESSAGE LIMIT.*
*         *TIME LIMIT ERROR.* 
*         *FILE LIMIT ERROR.* 
*         *TRACK LIMIT ERROR.*
*         *SRU LIMIT ERROR.*
*         *FORCED ERROR.* 
*         *JOB HUNG IN AUTORECALL.* 
*         *OPERATOR DROP.*
*         *IDLE DOWN.*
*         *SUSPENSION TIMEOUT.* 
*         *ECS PARITY ERROR.* 
*         *SUBSYSTEM RECOVERED DURING LEVEL 3 DEADSTART.* 
*         *SUBSYSTEM ABORTED.*
*         *OPERATOR RERUN.* 
*         *OPERATOR KILL.*
*         *DEADSTART RERUN.*
*         *RECOVERY ABORT.* 
*         *JOB STEP ABORT.* 
*         *SECURITY VIOLATION.* 
*         *SYSTEM ABORT.* 
*         *CPU OR CM PARITY ERROR.* 
*         *SOFTWARE ERROR ABORT.* 
*         *OVERRIDE OF ERROR CONDITION.*
          SPACE  4,10 
***       ERROR MESSAGES (SYSTEM AND LOCAL DAYFILE).
* 
*         * CATALOG FST CURRENT SECTOR .NE. ZERO.*
*                OVERFLOW PROCESSING REQUIRES CATALOG TRACKS TO 
*                CONTAIN THE FULL NUMBER OF SECTORS PER TRACK.
* 
*         * DISK ADDRESS NOT ON CHAIN.* 
*                THE TRACK AND SECTOR SPECIFIED IN THE CATALOG ENTRY
*                WAS NOT ON THE IAPF CHAIN.  ABORT WITH DUMP. 
* 
*         * ENTRY OVERLAP TTTT/SSSS/O, TTTT/SSSS/O.*
*                *PACKER* HAS DETECTED AN IAPF CHAIN OVERLAP BETWEEN
*                THE TWO ENTRIES WHOSE PFC LOCATIONS ARE GIVEN
*                (TRACK/SECTOR/ PFC ORDINAL). 
*                NOTE - A VALUE OF 0000/0000/0 IN THE MESSAGE 
*                INDICATES THE IAPF CHAIN EOI.
* 
*         * FAMILY NOT FOUND.*
*                THE FAMILY DEVICE REQUESTED WAS AN AUXILIARY DEVICE. 
*                ABORT WITH DUMP. 
* 
*         * FILE OVERLAP TTTT/SSSS/O, TTTT/SSSS/O.* 
*                THE FILE LENGTH FROM THE CATALOG ENTRY OVERLAPS THE
*                NEXT FILE/HOLE.  ABORT WITH DUMP.  THE TWO PFC 
*                LOCATIONS ARE GIVEN (TRACK/SECTOR/PFC ORDINAL).
* 
*         * FILE LENGTH ERROR TTTT/SSSS/O.* 
*                DURING A FILE COPY, THE AMOUNT OF DATA READ DOES NOT 
*                MATCH THE FILE LENGTH IN THE PFC.  ABORT WITH DUMP.
*                TTTT/SSSS/O IS THE TRACK/SECTOR/PFC ORDINAL OF THE 
*                FILE-S PFC ENTRY.
* 
*         * IAPF CHAIN OVERLAP.*
*                *PACKER* HAS DETECTED ENTRY OVERLAPS ON THE IAPF 
*                CHAIN BEFORE ANY CHANGES HAVE BEEN MADE.  *PACKER* 
*                WILL NOT ATTEMPT TO PACK A CORRUPT IAPF CHAIN. 
* 
*         * INCORRECT ARGUMENT.*
*                ERROR IN COMMAND PARAMETER.
* 
*         * INCORRECT DEVICE/FAMILY.* 
*                THE DEVICE SPECIFIED BY THE *DN* AND THE *FM*/*PN* 
*                PARAMETERS COULD NOT BE FOUND OR WAS OFF, UNLOADED 
*                OR PF UTILITY ACTIVE.  ABORT WITH DUMP.
* 
*         * INTERNAL ERROR, ...*
*                *PACKER* HAS ENCOUNTERED A CONDITION WHICH IT CANNOT 
*                HANDLE.  THIS MAY BE DUE TO AN INTERNAL ERROR OR TO
*                EXTERNAL PROBLEMS.  *PACKER* ABORTS, WITH ITS
*                REASONS, TO PREVENT CAUSING PROBLEMS OR MAKING A BAD 
*                SITUATION WORSE. 
* 
*         * NOT A MASTER DEVICE.* 
*                THE DEVICE REQUESTED DID NOT CONTAIN PF CATALOGS 
*                (DEVICE MASK = 0).  ABORT WITH DUMP. 
* 
*         * PACKNAME NOT FOUND.*
*                THE PACK REQUESTED WAS A FAMILY DEVICE.
*                ABORT WITH DUMP. 
* 
*         * PARAMETER XX ARGUMENT ERROR.* 
*                ERROR IN THE SPECIFICATION OF PARAMETER XX.
* 
*         * RSA NOT ON CHAIN.*
*                THE RANDOM ADDRESS IN A CATALOG ENTRY IS NOT IN THE
*                IAPF CHAIN.  ABORT WITH DUMP.
* 
*         * TABLE OVERFLOW, UNABLE TO OBTAIN REQUIRED MEMORY.*
*                THE TABLE OVERFLOW PROCESSOR WAS UNABLE TO OBTAIN
*                ENOUGH MEMORY TO BUILD THE REQUIRED TABLES.  MAKE SURE 
*                THAT THE JOB HAS UNLIMITED CM VALIDATION.
* 
*         * TFHL TABLE DEACTIVATED.*
*                THE *TFHL* TABLE WAS DEACTIVATED DUE TO MEMORY 
*                CONSTRAINTS.  THE FILL MOVE TECHNIQUE IS NOT USED
*                WHEN THE *TFHL* TABLE IS INACTIVE.  THE PROCESSING 
*                TIME OF *PACKER* MAY INCREASE WHEN THE *TFHL* TABLE IS 
*                INACTIVE.
* 
*         * TOO MANY OVERFLOW CATALOG TRACKS.*
*                THE FIELD WIDTH ALLOTTED FOR THE CATALOG TRACK INDEX 
*                IN THE *TFRI* TABLE ENTRIES HAS BEEN EXCEEDED. 
*                *PACKER* IS UNABLE TO PROCESS THE DEVICE.
          SPACE  4,10 
***       B DISPLAY MESSAGES. 
* 
*         *CHECKING ENTRY OVERLAP.* 
*                INFORMATIVE STATUS MESSAGE.
* 
*         *COGITATING.* 
*                INFORMATIVE STATUS MESSAGE.
* 
*         *CREATING CATALOG TRACK TABLES.*
*                INFORMATIVE STATUS MESSAGE.
* 
*         *CREATING RANDOM ADDRESSES.*
*                INFORMATIVE STATUS MESSAGE.
* 
*         *CREATING TRACK RESERVATION TABLE.* 
*                INFORMATIVE STATUS MESSAGE.
* 
*         *INTERCHANGING HOLE-FILE* 
*                INFORMATIVE STATUS MESSAGE.
* 
*         *PURGING CONTIGUOUS HOLES.* 
*                INFORMATIVE STATUS MESSAGE.
          SPACE  4,10 
***       *K* DISPLAY.
* 
*         AN INFORMATIVE *K* DISPLAY IS AVAILABLE.  IT IS PROVIDED
*         TO ALLOW AN ANALYST TO OBSERVE *PACKER*-S STATE DURING
*         EXCEPTIONAL CIRCUMSTANCES.  ACTIVATION OF THE *K* DISPLAY IS
*         BY SIMPLY ASSIGNING THE *K* DISPLAY DURING EXECUTION. 
          SPACE  4,10 
***       FILES USED. 
* 
*         C      CATALOG TRACK FILE.
* 
*         I      IAPF CHAIN INPUT FILE. 
* 
*         O      IAPF CHAIN OUTPUT FILE.
* 
*         OUTPUT ENSURE DUMPS ARE NOT LOST VIA *SSST* ID. 
* 
*         ZZZZDMB ENSURE DUMPS ARE NOT LOST VIA *SSST* ID.
          TITLE  COMMON DECKS.
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMCMAC 
*CALL     COMCCMD 
*CALL     COMCDCM 
*CALL     COMCMTM 
*CALL     COMSLFD 
*CALL     COMSPFM 
*CALL     COMSPFU 
*CALL     COMSRPV 
*CALL     COMSSSD 
*CALL     COMSSSJ 
          TITLE  MACRO DEFINITIONS. 
 ABSREAD  SPACE  4,10 
**        ABSREAD - READ ABSOLUTE CENTRAL MEMORY. 
* 
*         ABSREAD FWA,BUF,N 
* 
*                FWA = FIRST WORD ADDRESS TO READ.
*                BUF = ADDRESS OF BUFFER TO READ TO.
*                N   = NUMBER OF WORDS TO READ (DEFAULT IS 1).
* 
*                IF *BUF* IS NOT SPECIFIED, ONE WORD IS READ TO (X6). 
* 
*         USES   X - 1, 6.
*                A - 1, 6.
* 
*         MACROS SYSTEM.
* 
*         NOTE   THIS MACRO DEFINES AND USES THE LOCATIONS
*                *ABSBUF* AND *ABSPAR*. 
  
  
          PURGMAC ABSREAD 
  
 ABSREAD  MACRO  FWA,BUF,N
          MX6    12 
          IFC    EQ,$BUF$$,1
          R=     A6,=SABSBUF
          IFC    NE,$BUF$$,1
          R=     A6,BUF 
          R=     X1,FWA 
          LX1    18 
          SX6    A6 
          BX6    X6+X1
          IFC    EQ,$N$$,1
          R=     X1,1 
          IFC    NE,$N$$,1
          R=     X1,N 
          IFC    EQ,$BUF$$,1
          R=     X1,1 
          LX1    36 
          BX6    X6+X1
          SX1    =SABSPAR 
          SA6    X1 
          SYSTEM RSB,R,X1 
          IFC    EQ,$BUF$$,2
          SA1    =SABSBUF 
          BX6    X1 
 ABSREAD  ENDM
 RJ       SPACE  4,10 
**        REDEFINE THE RJ INSTRUCTION TO PROVIDE RJ TRACE CAPABILITY. 
* 
*         IF RJ TRACING IS REQUESTED FOR ROUTINE SUB, THEN THE RJ 
*         INSTRUCTION 
*              RJ   SUB      CALL SUBROUTINE SUB
*         WILL GENERATE CODE OF THE FORM
*         +    RJ   SUB 
*         -    RJ   RJT 
*         WHERE *SUB* IS THE SUBROUTINE SPECIFIED ON THE RJ INSTRUCTION 
*         AND *RJT* IS THE RJ TRACE SUBROUTINE.  IF RJ TRACE IS ENABLED 
*         INSTRUCTION MODIFICATION REVERSES THE ORDER OF THE RJ-S,
*         CALLING THE RJ TRACE SUBROUTINE WHICH IN TURN CALLS THE 
*         SUBROUTINE SPECIFIED ON THE RJ INSTRUCTION.  SJ (SUBROUTINE 
*         JUMP) IS DEFINED TO PROVIDE A NORMAL RJ INSTRUCTION.
* 
*         CODE WITH THE QUAL *RPV* IS EXCLUDED FROM THE RJ TRACE SINCE
*         IT COULD INVALIDATE REPRIEVE INTERRUPT RESUMPTION.  CODE WITH 
*         THE QUAL *RJT* IS EXCLUDED SINCE THAT WOULD BE RECURSIVE. 
*         CODE WITH THE QUAL *PRS* IS EXCLUDED SINCE NO PROVISION 
*         EXISTS TO REMOVE ENTRIES FROM THE TABLE WHICH DO NOT EXIST
*         AFTER PRESET.  CALLS TO *RJT* ARE EXCLUDED SINCE THEY WOULD 
*         BE RECURSIVE. 
  
 SJQ      CPSYN  RJQ
  
          PURGDEF RJQ 
  
          PURGMAC RJ
  
 RJQ      OPDEF  W
          LOCAL T,LA,LB,LC,LD,LF,LG 
LA MICRO 1,, W
LB MICRO 1,1, "LA"
LC MICCNT LA
* REMOVE /QUAL/ 
RJTA IFC EQ, "LB" / 
LG SET 1
RJTB DUP LC-1 
LG SET LG+1 
LF MICRO LG,1, "LA" 
  IFC EQ, "LF" / ,1 
  STOPDUP 
RJTB ENDD 
RJTC IFC EQ, "LF" / 
LG SET LG+1 
RJTC IFLT LG,LC 
LA MICRO LG,, "LA"
LB MICRO 1,1, "LA"
LC MICCNT LA
RJTC ENDIF
RJTA ENDIF
* REMOVE =S, =X, =Y 
LD MICRO 1,2, "LA"
RJTA IFC NE, "LD" =S
RJTA IFC NE, "LD" =X
RJTA IFC NE, "LD" =Y
RJTA ELSE 
LA MICRO 3,, "LA" 
LB MICRO 1,1, "LA"
LC MICCNT LA
RJTA ENDIF
* CHECK LENGTH, VALID SYMBOL, DEF AND EXCEPTIONS
RJT IFLE LC,7 
RJT IFC GE, "LB" A
RJT IFC LE, "LB" 9
RJT IF DEF,"LA"_. 
RJT IFC NE, "QUAL" PRS
RJT IFC NE, "QUAL" RJT
RJT IFC NE, "QUAL" RPV
RJT IFC NE, "LA" RJT
  MACREF "LA"_. 
+ SJ W
- SJ RJT
T EQU *-1 
RJAT RMT
+ VFD 42/0L"LA",18/T  W 
RJAT RMT
RJT ELSE
  SJ W
RJT ENDIF 
RJQ ENDM
 RJT      SPACE  4,10 
**        RJT - DEFINE ROUTINES TO BE TRACED VIA RJ TRACE.
* 
*         RJT    SUB         RJ TRACE ROUTINE SUB 
*         RJT    ETC         RJ TRACE ROUTINE ETC 
  
  
          PURGMAC RJT 
  
 RJT      MACRO  W
W_. EQU 0 
RJT ENDM
 SCIOF    SPACE  4,10 
**        SCIOF - SET *CIO* FUNCTION IN FET.
* 
*         SCIOF  FILE,C 
* 
*         *SCIOF* SETS UP A CALL TO *CIO=* WITH THE *CIO* FUNCTION
*         CODE *C* ON THE FET *FILE*, AND REQUESTS THAT *CIO=* NOT
*         CALL *CIO*.  THE CALLER MUST ENSURE THAT THE FET IS 
*         COMPLETE BEFORE CALLING *SCIOF*.
*         THE RESULT IS INSERTING A *CIO* FUNCTION CODE IN THE
*         FET WITHOUT CALLING *CIO*.  THIS IS THE SAME AS THE 
*         * OPTION ON SOME *CIO* MACROS EXCEPT THAT THE FET 
*         COMPLETE BIT IS NOT SET.
  
  
          PURGMAC SCIOF 
  
 SCIOF    MACRO  F,C
  MACREF SCIOF
  R= X2,F 
  MX7 1 
  BX2 X7+X2 
  SX7 C 
  RJ =XCIO= 
 SCIOF    ENDM
 VOID     SPACE  4,10 
***       VOID - VOID THE STACK MACRO.
* 
*         THIS MACRO WILL CAUSE AN UNCONDITIONAL VOIDING OF THE 
*         STACK TO OCCUR. IT IS PLACED AFTER ALL LOCATIONS WHICH
*         CONTAIN INSTRUCTIONS THAT PLUG CODE AND WHICH ARE NOT 
*         NATURALLY FOLLOWED BY A RETURN JUMP.
  
  
          PURGMAC VOID
  
 VOID     MACRO 
  MACREF VOID 
  RJ *+1
+ EQ *+1S17 
- VFD 30/0LVOID.
 VOID     ENDM
          TITLE  DATA AND CONSTANTS.
*         ASSEMBLY CONSTANTS. 
  
 DBUFL    EQU    6001B       FILE TRANSFER BUFFER LENGTH
 CBUFL    EQU    1001B       CATALOG TRACK BUFFER LENGTH
 SBUFL    EQU    1           SCRATCH FET BUFFER LENGTH
 MXCT     EQU    377B        MAXIMUM CATALOG TRACKS + 1 (*TFRI* LIMIT)
 CTSS     EQU    10B         ADDRESS OF PFC COPY IN SYSTEM SECTOR 
 TRJHL    EQU    1001B       LENGTH OF RJ HISTORY TABLE 
          ERRNG  TRJHL-10D   *TRJH* TABLE TOO SMALL 
  
 PAKVER   MICRO  1,, 4.0     *PACKER* VERSION 
 PAKLVL   EQU    "NOSLVL"    *PACKER* RELEASE LEVEL 
 PAKLVL   DECMIC PAKLVL      *PACKER* RELEASE LEVEL 
          SPACE  4,10 
*         RJ TRACE DEFINITIONS. 
  
          RJT    AFM         ATTEMPT FILL MOVE
          RJT    ASM         ATTEMPT SLIDE MOVE 
          RJT    ATD         ATTEMPT TRACK DELINK 
          RJT    CEO         CHECK ENTRY OVERLAP
          RJT    CDF         COPY DATA FOR FILE 
          RJT    CFL         CHECK FILE LENGTH
          RJT    CIP         CLEAR IRRELEVANT PFC INFORMATION 
          RJT    CIT         CLEAR INTERLOCKS 
          RJT    CRA         CONVERT RANDOM ADDRESS 
          RJT    CTC         CHECK TERMINATION CONDITIONS 
          RJT    CTE         CREATE AND INSERT TABLE ENTRY
          RJT    DLK         DELINK TRACKS
          RJT    DRP         DROP TRACKS
          RJT    DTE         DELETE TABLE ENTRY 
          RJT    FLT         FIND LAST TRACK
          RJT    FPI         FORMAT PFC INFORMATION 
          RJT    FRM         FORMAT HOLES REMOVED STATISTIC MESSAGE 
          RJT    FSM         FORMAT STATISTIC MESSAGE 
          RJT    MSG         MESSAGE TO B DISPLAY (LINE ONE)
          RJT    IOM         ISSUE OVERLAP MESSAGE
          RJT    IRS         ISSUE RESOURCE SUMMARY TO DAYFILE
          RJT    ISD         ISSUE STATISTICS TO DAYFILE
          RJT    ISM         ISSUE STATISTIC MESSAGE
          RJT    PCH         PURGE CONTIGUOUS HOLES 
          RJT    RCE         READ CATALOG ENTRY 
          RJT    RJA         RJ TRACE ACTIVATION/DEACTIVATION 
          RJT    RLS         RECLAIM LOST SPACE 
          RJT    RSS         READ SYSTEM SECTOR 
          RJT    UFE         UPDATE FILE ENTRY
          RJT    UFF         UPDATE FILL FILE ENTRY 
          RJT    UHE         UPDATE HOLE ENTRY
          RJT    UKD         UPDATE *K* DISPLAY 
          RJT    USS         UPDATE SYSTEM SECTOR 
          RJT    VHS         VERIFY HOLE SIZE ADEQUATE FOR DELINK 
          RJT    WCE         WRITE CATALOG ENTRY
          RJT    ZWT         ZERO WORD TERMINATE *TFRI* TABLE 
  
          RJT    ADW         ADD WORD TO MANAGED TABLE
          RJT    AMU         ACCUMULATE MEMORY USED 
          RJT    ATS         ALLOCATE TABLE SPACE 
          RJT    CDD         CONSTANT TO DECIMAL DISPLAY CONVERSION 
          RJT    CFD         CONSTANT TO F10.3 CONVERSION 
          RJT    CIO=        I/O FUNCTION PROCESSOR 
          RJT    COD         CONSTANT TO OCTAL DISPLAY CODE CONVERSION
          RJT    EQS         EQUALITY SEARCH TABLE
          RJT    LFM=        LOCAL FILE MANAGER PROCESSOR 
          RJT    MES         MASKED EQUALITY SEARCH TABLE 
          RJT    MSG=        SEND MESSAGE 
          RJT    MTD         MOVE TABLES DOWN 
          RJT    MTU         MOVE TABLES UP 
          RJT    MVE=        MOVE BLOCK OF DATA 
          RJT    MTD         MOVE TABLES DOWN 
          RJT    PFU         PERMANENT FILE UTILITY FUNCTION PROCESSOR
          RJT    RSR         RESTORE REGISTERS
          RJT    SNM         SET NAME IN MESSAGE
          RJT    SVR         SAVE ALL REGISTERS 
          RJT    SYS=        PROCESS SYSTEM REQUEST 
          RJT    WNB=        WAIT NOT BUSY
          RJT    ZTB         ZEROS TO BLANKS
 POINTER  SPACE  4,10 
**        POINTER TABLE.
* 
*         THE POINTER TABLE MUST BE LOCATED AT FWA.  THIS 
*         PLACES IT IMMEDIATELY AFTER THE 5100 LOADER TABLE 
*         WHICH ALLOWS IT TO BE LOCATED BY A DMB INTERPRETER. 
  
****
 DATA     BSS    0           POINTER TABLE
          VFD    42/0LPOINTER,18/DATA 
          VFD    42/0LRPVBLK,18/RPVA
          VFD    42/0LFTAB,18/FTAB
          VFD    42/0LFETS,18/C 
          VFD    42/0LGLOBALS,18/PV 
          CON    0           END OF TABLE 
****
          SPACE  4,10 
*         FETS AND STORAGE. 
  
 C        RFILEB CBUF,CBUFL,FET=16D,RTP 
 I        RFILEB DBUF,DBUFL,FET=16D,RTP 
 O        RFILEB DBUF,DBUFL,FET=16D,RTP 
 S        BSS    0           SCRATCH FET
          FILEB  SBUF,SBUFL,FET=10B,EPR 
  
 SSJ=     BSS    0
          VFD    12/0,24/77777777B,12/60B,12/IRSI 
          BSSZ   SSJL-*+SSJ=
  
 PV       VFD    42/0LPAKVER,18/0L"PAKVER"    *PACKER* VERSION
          VFD    42/0LPAKLVL,18/0L"PAKLVL"    *PACKER* RELEASE LEVEL
          VFD    42/0LNOSLVL,18/0L"NOSLVL"    NOS RELEASE LEVEL 
          VFD    60/10L"DATE"                 DATE *PACKER* ASSEMBLED 
          VFD    60/10L"TIME"                 TIME *PACKER* ASSEMBLED 
 PD       CON    0           PACKED DATE AND TIME 
 DN       CON    0           DEVICE NUMBER
 FM       CON    0           FAMILY NAME
 PN       CON    0           PACKNAME 
 EQ       CON    -1          EST ORDINAL
 CC       CON    0           CATALOG TRACK COUNT
 CN       CON    -1          CATALOG TRACK NUMBER 
 HE       CON    0           COLLECTION HOLE *TFRI* TABLE ENTRY (COPY)
 FE       CON    0           SLIDE FILE *TFRI* TABLE ENTRY (COPY) 
 IX       CON    0           INDEX TO *TFRI* TABLE
 IF       CON    0           PF UTILITY INTERLOCK FLAG
 FT       CON    0           FIRST TRACK OF IAPF CHAIN
 SL       CON    0           SECTORS/TRACK
 TL       CON    0           TIME LIMIT 
 CT       CON    0           CURRENT TRACK
          ERRNZ  CT-TL-1     LOCATIONS MUST BE CONTIGUOUS 
 EI       CON    0           RSA OF IAPF CHAIN EOI
 MR       CON    0L100B      MOVE RATIO 
 DS       CON    0           DROPPED TRACK STATISTICS 
 HS       CON    0           HOLES SKIPPED STATISTICS 
 LS       CON    0           LOST SPACE STATISTICS
 BF       CON    0           COUNT OF TIMES BUFFER FILLED IN *CPY*
 HL       CON    0           LENGTH OF HOLE 
 FB       CON    0           BEGINNING RSA OF FILE
 FS       CON    0           FILE SIZE FROM CATALOG ENTRY + 1 FOR SS
 DM       CON    0           DATA MOVED 
 HR       CON    0           HOLES REMOVED
 DF       CON    0           DUMP REQUIRED FLAG 
 RP       CON    0           REPRIEVE ACTIVATED 
 PC       CON    0           PRESET COMPLETED 
 LT       CON    0           LENGTH TABLE ACTIVE
 HD       CON    0           HOLES DELETED SINCE FL REDUCTION 
 BD       CON    0           HOLE SIZE BEFORE DELINK (FOR STATISTICS) 
 AD       CON    0           HOLE SIZE AFTER DELINK (FOR STATISTICS)
 CTIH     CON    0           CURRENT TRACK IN HOLE
 HSIT     CON    0           HOLE SIZE IN CURRENT TRACK 
 LTIH     CON    0           LAST TRACK IN HOLE 
 NTIH     CON    0           NUMBER OF TRACKS IN HOLE 
 PTIH     CON    0           PREVIOUS TRACK IN HOLE 
 FW       CON    0           IAPF FLAW SPACE STATISTICS 
 ID       CON    0           OPERATOR IDLE DOWN REQUEST 
 FF       CON    0           FILL FILL *TFRI* TABLE ENTRY (COPY)
 FX       CON    0           FILL FILE INDEX TO *TFRI* TABLE
 EF       CON    0           EXACT FIT REQUIRED ON FILL FILE MOVE 
 NC       CON    0           NO CHANGES ARE TO BE MADE TO THE DEVICE
 NM       CON    0           NO DATA MOVE (NEITHER FILL NOR SLIDE)
 NF       CON    0           NO FILL FILE DATA MOVE 
 NS       CON    0           NO SLIDE FILE DATA MOVE
 NP       CON    0           NO PRE-MOVE TRACK DELINKS
 JM       CON    0           JUMP FILL MOVES OF FILES (FOR STATISTICS)
 SM       CON    0           SLIDE MOVES OF FILES (FOR STATISTICS)
 ES       CON    0           END SRU-S
 SS       CON    0           START SRU-S
 ET       CON    0           END CPU TIME 
 ST       CON    0           START CPU TIME 
 DB       CON    0           DEBUG OPTIONS
 IS       CON    0           INCOMPLETE/INACCURATE STATISTICS 
 OF       CON    0           FILES AT THE ONSET 
 OH       CON    0           HOLES AT THE ONSET 
 HC       CON    0           HOLES CREATED BY JUMP MOVE 
          TITLE  MANAGED TABLES.
          SPACE  4,10 
**        TRJH - RETURN JUMP HISTORY (DEBUG USE). 
* 
*         *TRJH* CONTAINS A ONE WAY *CIO* BUFFER INTO WHICH RJ TRACE
*         VALUES ARE STORED.  THE POINTERS *FIRST*, *IN*, *OUT*,
*         AND *LIMIT* ARE OFFSETS RELATIVE TO *F.TRJH*. 
* 
*         *FIRST* IS 1. 
*         *IN* IS STORED AT F.TRJH+0. 
*         *OUT* DOES NOT EXIST (AS IT IS NOT USED). 
*         *LIMIT* IS L.TRJH.
* 
*         THE TRACE GROUPS ARE COMPOSED OF THE FOLLOWING ENTRIES. 
* 
*T        30/ RJ CALLEE,30/ EQ CALLER 
  
  
 TRJH     TABLE 
          SPACE  4,10 
**        TCAT - TABLE OF CATALOG TRACKS. 
* 
*         FST ENTRIES FOR *PFU* OPEN FILE.
* 
*T        12/ EQ ,12/ TRACK ,12/ TRACK ,12/,12/ 5 
* 
*         EQ     EST ORDINAL OF CATALOG TRACK.
*         TRACK  LOGICAL TRACK NUMBER.
  
  
 TCAT     TABLE 
          SPACE  4,10 
**        TTRT - IMAGE OF DEVICE TRT
* 
*T        60/ EXACT IMAGE OF DEVICE TRACK RESERVATION TABLE 
* 
*         NOTE - THIS TABLE IS USED ONLY TO BUILD *TTLT*, AND IS
*         NOT USED AFTER PRESET.
  
  
 TTRT     TABLE 
          SPACE  4,10 
**        TTLT - TRACK LINK TABLE.
* 
*T        48/ CALCULATED RSA,12/ TRACK LINK 
* 
*         THE TABLE IS INDEXED BY TRACK NUMBER.  THE RSA MAY NOT
*         EXIST FOR ALL ENTRIES AS IT IS CALCULATED ONLY IF NEEDED. 
* 
*         NOTE - THE RSA IS VALID ONLY DURING PRESET.  IT IS NOT
*         ADJUSTED WHEN TRACKS ARE DELINKED FROM THE IAPF CHAIN.
  
  
 TTLT     TABLE 
 TAPE     SPACE  4,10 
**        TAPE - TABLE OF AVAILABLE PFC ENTRIES.
* 
*T        1/H,1/1,8/,8/ CT,15/ PRU,3/ P,24/ 
* 
*         H      ALWAYS SET.
*         1      REQUIRED TO MAKE ALL VALID ENTRIES NON-ZERO. 
*         CT     CATALOG TRACK NUMBER.
*         PRU    SECTOR WITHIN CATALOG TRACK. 
*         P      8-WORD PARCEL IN SECTOR. 
* 
*         THESE ENTRIES INDICATE PFC-S WHICH MAY BE USED FOR HOLES
*         CREATED BY FILL MOVES.
  
  
 TAPE     TABLE 
          SPACE  4,10 
**        TFRI - TABLE OF FILE RANDOM INDEXES.
* 
*T        1/H,1/1,1/I,7/,8/ CT,15/ PRU,3/ P,12/ TK,12/ SC 
* 
*         H      SET IF ENTRY IS FOR A HOLE.
*         1      REQUIRED TO MAKE ALL VALID ENTRIES NON-ZERO. 
*         I      IMMOVABLE FILE UNDER ALL CIRCUMSTANCES.
*         CT     CATALOG TRACK NUMBER.
*         PRU    SECTOR WITHIN CATALOG TRACK. 
*         P      8-WORD PARCEL IN SECTOR. 
*         TK     FILE/HOLE TRACK       (OR RSA).
*         SC     FILE/HOLE SECTOR      (OR RSA).
  
  
 TFRI     TABLE 
          SPACE  4,13 
**        TFHL - TABLE OF FILE AND HOLE LENGTHS FROM THE PFC. 
* 
*         THIS TABLE HAS EXACTLY A ONE TO ONE CORRESPONDENCE WITH 
*         THE *TFRI* TABLE AT ALL TIMES, UNLESS IT DOES NOT EXIST.
* 
*T        24/ LENGTH,12/0,24/ RSA 
* 
*         LENGTH   FILE OR HOLE LENGTH FROM THE PFC.
*         RSA      RANDOM SECTOR ADDRESS OF FILE OR HOLE ON IAPF CHAIN. 
*E
  
  
 TFHL     TABLE 
          TITLE  *K* DISPLAY. 
 KDS      SPACE  4,10 
*         *K* DISPLAY.
  
  
 KDS      VFD    24/KDI,18/KDRS,18/KDLS    *K* DISPLAY CONTROL WORD 
 KDI      SPACE  4,10 
*         *K* DISPLAY INPUT BUFFER. 
  
  
 KDI      BSSZ   8           *K* DISPLAY INPUT BUFFER.
 KDLS     SPACE  4,10 
*         KDLS - *K* DISPLAY LEFT SCREEN BUFFER.
  
  
 KDLS     BSS    0           *K* DISPLAY LEFT SCREEN
  
          VFD    10/0,1/0,1/1,47/0,1/1   LEFT DISPLAY CONTROL WORD
  
 KDLSA    DATA   C*PACKER "PAKVER"-"PAKLVL"("NOSLVL").* 
 KDLSB    DATA   C* * 
 KDLSC    DATA   C*              PERCENT PROCESSED* 
 KDLSD    DATA   C*              TFRI LENGTH* 
 KDLSE    DATA   C*           IX PRIMARY TFRI INDEX*
 KDLSF    DATA   C*           FX FILL FILE TFRI INDEX*
 KDLSG    DATA   C* * 
 KDLSH    DATA   C*           LT LENGTH TABLE ACTIVE* 
 KDLSI    DATA   C*           ID IDLE DOWN REQUESTED* 
 KDLSJ    DATA   C*           RP REPRIEVE ACTIVE* 
 KDLSK    DATA   C* * 
 KDLSL    DATA   C*           EQ* 
 KDLSM    DATA   C*           FM* 
 KDLSN    DATA   C*           PN* 
 KDLSO    DATA   C*           DN* 
 KDLSP    DATA   C* * 
 KDLSQ    DATA   C*           DB* 
 KDLSR    DATA   C*           MR* 
 KDLSS    DATA   C*        NO EF* 
 KDLST    DATA   C*        NO NC* 
 KDLSU    DATA   C*        NO NM* 
 KDLSV    DATA   C*        NO NF* 
 KDLSW    DATA   C*        NO NS* 
 KDLSX    DATA   C*        NO NP* 
 KDLSY    DATA   C* * 
 KDLSZ    DATA   C* ONSET FILES       ,           PRUS.*
 KDLS0    DATA   C* ONSET HOLES       ,           PRUS.*
 KDLS1    DATA   C* FILL MOVES        ,           PRUS.*
 KDLS2    DATA   C* SLIDE MOVES       ,           PRUS.*
 KDLS3    DATA   C* FILES MOVED       ,           PRUS.*
 KDLS4    DATA   C* LOST SPACE        ,           PRUS.*
 KDLS5    DATA   C* HOLES LEFT        ,           PRUS.*
 KDLS6    DATA   C* HOLES FREED       ,           PRUS.*
 KDLS7    DATA   C* TRACKS FREED      ,           PRUS.*
 KDLS8    DATA   C* FLAW SPACE        ,           PRUS.*
 KDLS9    DATA   C* * 
 KDLS$    DATA   C* * 
 KDLS=    DATA   50C CURRENT *B* DISPLAY MESSAGE 012345678901234567890
  
          CON    0
          ERRNG  512-*+KDLS  *K* DISPLAY LEFT SCREEN TOO LONG 
 KDRS     SPACE  4,10 
*         KDRS - *K* DISPLAY RIGHT SCREEN BUFFER. 
  
  
 KDRS     EQU    KDLS        RIGHT SCREEN IS THE SAME AS THE LEFT 
          TITLE  MAIN PROGRAM.
**        MAIN PROGRAM. 
  
  
 PACKER   BSS    0           ENTRY
          SB1    1
          RJ     PRS         PRESET 
          RJ     CEO         CHECK ENTRY OVERLAP
          SX6    1
          SA6    CEOA        ENABLE *CEO* CHECK FOR INTERNAL ERRORS 
          EQ     PAC2        ENTER LOOP 
  
*         LOOK FOR HOLE AND CHECK FOR OVERLAP OF INTERVENING FILES. 
  
 PAC1     RJ     CTC         CHECK TERMINATION CONDITIONS 
          NZ     X1,PAC8     IF TIME TO QUIT
 PAC2     SA1    DB          FETCH DEBUG FLAGS
          LX1    59-0 
          PL     X1,PAC3     IF *CEO* DEBUG AID NOT REQUESTED 
          RJ     CEO         CHECK ENTRY OVERLAP
 PAC3     SA1    KDLS 
          LX1    59-0 
          PL     X1,PAC4     IF SCREEN NOT ASSIGNED 
          RJ     UKD         UPDATE *K* DISPLAY 
 PAC4     SX0    =C/ COGITATING./ 
          RJ     MSG
          SA4    F.TFRI 
          SA1    IX 
          SA3    L.TFRI 
          IX3    X1-X3
          PL     X3,PAC10    IF PAST END OF TABLE 
          SB2    X1 
          SX6    X1+B1
          SA6    A1          INCREMENT INDEX
          SA2    X4+B2
          NG     X2,PAC5     IF HOLE FOUND
          ZR     X2,PAC10    IF END OF TABLE
          RJ     CTC         CHECK TERMINATION CONDITIONS 
          NZ     X1,PAC10    IF TIME TO QUIT
          RJ     CFL         CHECK FILE LENGTH
          ZR     X7,PAC2     IF NO LOST SPACE 
          RJ     RLS         RECLAIM LOST SPACE 
          EQ     PAC2        KEEP LOOKING FOR HOLE
  
*         HOLE FOUND, PURGE ALL THE CONTIGUOUS HOLES. 
  
 PAC5     SA1    A2          HOLE ENTRY 
          SA2    A2+B1       NEXT ENTRY 
          BX6    X1 
          SA6    HE          REMEMBER ORIGINAL HOLE (COLLECTION HOLE) 
          RJ     PCH         PURGE CONTIGUOUS HOLES 
          ZR     X2,PAC9     IF END OF TABLE
  
*         FILE ENCOUNTERED, PREPARE FOR POTENTIAL MOVE. 
  
          BX6    X1          HOLE ENTRY 
          BX7    X2          FILE ENTRY 
          SA6    HE          COLLECTION HOLE ENTRY
          SA7    FE          SLIDE FILE ENTRY 
          MX4    -24
          BX6    -X4*X6 
          BX7    -X4*X7 
          IX6    X7-X6       HOLE LENGTH
          SA6    HL 
          RJ     ATD         ATTEMPT PRE-MOVE TRACK DELINK
          PL     X1,PAC6     IF NO TRACK DELINKED 
          EQ     PAC2        COLLECTION HOLE IS CLOSED
  
 PAC6     RJ     AFM         ATTEMPT FILL MOVE
          NG     X1,PAC2     IF EXACT FIT, COLLECTION HOLE IS CLOSED
          ZR     X1,PAC7     IF UNSUCCESSFUL FILL MOVE
          EQ     PAC1        TRY ANOTHER MOVE, COLLECTION HOLE IS OPEN
  
 PAC7     RJ     ASM         ATTEMPT SLIDE MOVE 
          NG     X1,PAC2     IF UNSUCCESSFUL, COLLECTION HOLE IS CLOSED 
          EQ     PAC1        SUCCESSFUL MOVE, COLLECTION HOLE IS OPEN 
  
*         TERMINATION.  UPDATE ACTIVE COLLECTION HOLE.
  
 PAC8     SA4    F.TFRI 
          SA1    IX 
          IX2    X1+X4
          SA5    X2          HOLE ENTRY 
          SX6    X1+B1       UPDATE (IX) FOR *UHE*
          SA6    A1 
          BX6    X5 
          SA6    HE          REMEMBER COLLECTION HOLE ENTRY 
          RJ     UHE         UPDATE HOLE CATALOG ENTRY
          EQ     PAC10       CLEAR INTERLOCK AND TERMINATE
  
*         TERMINATION.  UPDATE ACTIVE COLLECTION HOLE AT END OF CHAIN.
  
 PAC9     SA1    HE          COLLECTION HOLE ENTRY
          MX0    -24
          BX1    -X0*X1 
          SA2    EI          CALCULATE HOLE LENGTH
          IX6    X2-X1
          SA6    HL 
          RJ     UHE         UPDATE HOLE ENTRY
  
*         CLEAR THE UTILITY INTERLOCK AND ISSUE STATISTICS. 
  
 PAC10    RJ     CIT         CLEAR INTERLOCKS 
          SX6    =0 
          SA6    MSGA        CLEAR LAST *B* DISPLAY MESSAGE ADDRESS 
          RJ     UKD         UPDATE *K* DISPLAY 
          BX0    X0-X0       SET NORMAL TERMINATION FLAG
          RJ     ISD         ISSUE STATISTICS TO DAYFILE
          MESSAGE  (=C/ PACKER COMPLETE./),,R 
          ENDRUN
          TITLE  ERROR TERMINATION PROCESSORS.
          SPACE  4,10 
**        ERROR PROCESSORS. 
  
          QUAL   RPV
  
*         NOTE - QUALIFICATION PREVENTS RJ TRACE ACTION.
 RPV      SPACE  4,15 
**        RPV - PROCESS REPRIEVE. 
* 
*         ENTRY  FROM *RPV*.
* 
*         EXIT   ERROR CONDITION RESET. 
* 
*         USES   X - 0, 1, 6, 7.
*                A - 1, 6, 7. 
*                B - 1. 
* 
*         CALLS  CIT, ISD, RSS. 
* 
*         MACROS ABORT, MESSAGE, REPRIEVE, RPVBLK, SYSTEM.
  
  
 RPV      BSS    0           ENTRY FROM *RPV* 
          SB1    1
          SX6    B1 
          SA6    RP          SET REPRIEVE ACTIVATED 
          SA1    RPVA+7 
          MX0    -12
          BX0    -X0*X1      ERROR FLAG FROM REPRIEVE BLOCK 
          SA1    TEMS+X0     ADDRESS OF CORRESPONDING MESSAGE 
          ZR     X1,RPV1     IF NO MESSAGE
          MESSAGE  X1,,R     ISSUE MESSAGE TO DAYFILE 
 RPV1     SX1    X0-ODET     CHECK ERROR FLAG 
          ZR     X1,RPV2     IF OPERATOR DROP 
          SX1    X0-IDET
          ZR     X1,RPV2     IF IDLE DOWN 
          EQ     RPV3        PROCESS OTHER ERRORS 
  
 RPV2     SA1    ID 
          NZ     X1,RPV3     IF PREVIOUS IDLE DOWN REQUESTED
          SX6    B1 
          SA6    A1          SET IDLE DOWN REQUESTED FLAG 
          MESSAGE  (=C/ IDLE DOWN BEGUN./),,R 
          SX6    B0+
          SA6    RP          CLEAR REPRIEVE ACTIVATED FLAG
          REPRIEVE  RPVA,RESUME,RPVC    RESUME PROGRAM EXECUTION
  
 RPV3     MESSAGE  (=C/ REPRIEVE PROCESSING BEGUN./),,R 
          SYSTEM DMB,R       GENERATE BINARY DUMP FILE
          SYSTEM DMP,R,0,0   DUMP EXCHANGE PACKAGE
          SYSTEM DMD,R,377777B  DUMP FIELD LENGTH 
          RJ     RSS         REMOVE *SSST* STATUS FROM DUMP FILES 
          SX6    B1+
          SA1    C           COMPLETE FETS SO *CIT* WON-T HANG
          BX7    X1+X6
          SA7    A1 
          SA1    I
          BX7    X6+X1
          SA7    A1 
          SA1    O
          BX7    X1+X6
          SA7    A1 
          RJ     CIT         CLEAR INTERLOCKS 
          SX0    B1          SET ABNORMAL TERMINATION FLAG
          RJ     ISD         ISSUE STATISTICS TO DAYFILE
          MESSAGE  (=C/ REPRIEVE PROCESSING COMPLETE./),,R
          MESSAGE  (=C/ PACKER ABORTED./),,R
          REPRIEVE  RPVA,RESET,0  RESET ERROR 
  
  
 RPVA     RPVBLK RPV,RPVB    REPRIEVE BLOCK 
 RPVC     EQU    /COMSRPV/EEMS+/COMSRPV/PCMS+/COMSRPV/SRMS+/COMSRPV/OTMS
,+/COMSRPV/PPMS+/COMSRPV/CPMS+/COMSRPV/TIMS    ERROR MASK 
 ERR      SPACE  4,15 
**        ERR - PROCESS ERROR.
* 
*         *ERR* PROCESSES AN INTERNAL ERROR BY CLEARING THE INTERLOCKS, 
*         ISSUING AN ERROR MESSAGE, GENERATING A DUMP, ISSUING THE
*         STATISTICS, AND ABORTING. 
* 
*         ENTRY  (X0) = ADDRESS OF MESSAGE. 
* 
*         USES   X - 0, 1.
*                A - 1. 
*                B - 1. 
* 
*         CALLS  CIT, ISD, RSS. 
* 
*         MACROS ABORT, MESSAGE, REPRIEVE, SYSTEM.
  
  
 ERR      BSS    0           ENTRY
          SB1    1
          ZR     X0,ERR1     IF NO MESSAGE
          MESSAGE  X0,,R     ISSUE MESSAGE TO DAYFILE 
  
*         GENERATE DUMPS. 
  
 ERR1     SA1    DF 
          ZR     X1,ERR2     IF NO DUMP REQUIRED
          SYSTEM DMB,R       GENERATE BINARY DUMP FILE
          SYSTEM DMP,R,0,0   DUMP EXCHANGE PACKAGE
          SYSTEM DMD,R,377777B  DUMP FIELD LENGTH 
          RJ     RSS         REMOVE *SSST* STATUS FROM DUMP FILES 
  
*         CLEAR INTERLOCKS AND TERMINATE. 
  
 ERR2     RJ     CIT         CLEAR INTERLOCKS 
          SX0    B1          SET ABNORMAL TERMINATION FLAG
          RJ     ISD         ISSUE STATISTICS TO DAYFILE
          MESSAGE  (=C/ PACKER ABORTED./),,R
          REPRIEVE  RPVA,SETUP,0B    CLEAR REPRIEVE PROCESSING
          ABORT 
          SPACE  4,10 
**        TEMS - TABLE OF ERROR MESSAGES. 
* 
*         INDEXED BY VALUE OF SYSTEM ERROR FLAG.
* 
*         THESE ERROR FLAGS ARE LISTED IN THE PRIORITY ORDER SCHEME.
*         THE TABLE GENERATED IS INDEPENDENT OF THE ACTUAL VALUES.
  
  
          MACRO  .1,A,B,M 
 .3       IFC    NE,$A$$
 A        BSS    0
 .2       SET    A
          IFC    EQ,$B$$,1
          ERR                MAX+1 VALUE NOT SPECIFIED
          IF     -DEF,B,1 
          ERR                B (MAX+1 VALUE) NOT DEFINED
          BSSZ   B
 .3       ELSE
          IF     -DEF,B,1 
 .3       SKIP
          ORG    .2+B 
          IFC    NE,$M$$,2
          LOC    B
          CON    =C/_M_/
          BSS    0
 .3       ENDIF 
 .1       ENDM
  
 TEMS     .1     MXET        START TABLE AND ZERO MAX WORDS 
  
*         ERROR FLAGS AND MESSAGES. 
  
          .1     TIET,( USER BREAK ONE.)
          .1     TAET,( USER BREAK TWO.)
          .1     ARET,( ARITHMETIC ERROR.)
          .1     ITET,( SCP INVALID TRANSFER ADDRESS.)
          .1     PSET,( PROGRAM STOP ERROR.)
          .1     PPET,( PPU ABORT.) 
          .1     CPET,( CPU ABORT.) 
          .1     PCET,( PPU CALL ERROR.)
          .1     CLET,( COMMAND LIMIT.) 
          .1     MLET,( MESSAGE LIMIT.) 
          .1     TLET,( TIME LIMIT ERROR.)
          .1     FLET,( FILE LIMIT ERROR.)
          .1     TKET,( TRACK LIMIT ERROR.) 
          .1     SRET,( SRU LIMIT ERROR.) 
          .1     FSET,( FORCED ERROR.)
          .1     RCET,( JOB HUNG IN AUTORECALL.)
          .1     ODET,( OPERATOR DROP.) 
          .1     IDET,( IDLE DOWN.) 
  
*                SPET - BEGINING OF SPECIAL ERRORS. 
  
          .1     STET,( SUSPENSION TIMEOUT.)
          .1     ECET,( ECS PARITY ERROR.)
          .1     RSET,( SUBSYSTEM RECOVERED DURING LEVEL 3 DEADSTART.)
          .1     SSET,( SUBSYSTEM ABORTED.) 
          .1     RRET,( OPERATOR RERUN.)
          .1     OKET,( OPERATOR KILL.) 
  
*                NRET - BEGINNING OF NON-REPRIEVABLE ERRORS.
  
          .1     DRET,( DEADSTART RERUN.) 
          .1     RAET,( RECOVERY ABORT.)
          .1     JSET,( JOB STEP ABORT.)
          .1     SVET,( SECURITY VIOLATION.)
          .1     SYET,( SYSTEM ABORT.)
          .1     PEET,( CPU OR CM PARITY ERROR.)
          .1     SWET,( SOFTWARE ERROR ABORT.)
          .1     ORET,( OVERRIDE OF ERROR CONDITION.) 
  
*                MXET - MAXIMUM NUMBER OF ERROR FLAGS.
  
          .1     MXET        REALIGN ORG
  
  
          PURGMAC .1
          SPACE  4,10 
*         UNQUALIFIED COMMON DECKS FOR *RPV* AND *ERR* USE. 
  
 QUAL$    EQU    0           FORCE UNQUALIFIED COMMON DECKS 
  
*CALL     COMCSYS 
          SPACE  4,10 
          QUAL   *
 ERR      EQU    /RPV/ERR 
 RPV      EQU    /RPV/RPV 
 RPVA     EQU    /RPV/RPVA
 RPVB     EQU    /RPV/RPVB
 RPVC     EQU    /RPV/RPVC
          TITLE  RJ TRACE PROCESSORS. 
**        RJ TRACE PROCESSORS.
  
  
          QUAL   RJT
  
*         NOTE - QUALIFICATION PREVENTS RJ TRACE ACTION.
 RJT      SPACE  4,25 
**        RJT - RETURN JUMP TRACE.
* 
*         THIS ROUTINE PLACES DEBUG INFORMATION IN A ONE WAY *CIO*
*         BUFFER.  THIS INFORMATION IS IN BLOCKS BEGINNING WITH 
*         30/RJ CALLEE,30/EQ CALLER.
* 
*         ENTRY  CALLED VIA + RJ RJT
*                           - RJ SUB
*                WHERE SUB IS THE TARGET SUBROUTINE.
* 
*         EXIT   TO *SUB*+1 WITH (SUB) SET TO PROPER RETURN ADDRESS,
*                STACK VOIDED.
* 
*         USES   ALL. 
* 
*         RESTORES ALL. 
* 
*         CALLS  RSR, SVR.
* 
*         MACROS VOID.
  
  
 RJT      SUBR               ENTRY ONLY 
          RJ     SVR         SAVE ALL REGISTERS 
          SB1    1
          SA1    RJTX        FETCH RETURN INSTRUCTION 
          BX6    X1 
          LX1    30 
          SA1    X1-1        FETCH CALLING INSTRUCTION
          SA6    X1          STORE RETURN IN TARGET SUBROUTINE
          MX2    -30
          BX6    X2*X6       30/EQ INSTRUCTION, 30/0
          BX1    -X2*X1      30/0, 30/RJ INSTRUCTION
          BX7    X6+X1
          LX7    30          FIRST WORD FOR DEBUG BUFFER
          MX2    -18
          SX1    X1+B1       FWA OF EXECUTABLE CODE IN SUBROUTINE 
          LX2    30 
          LX1    30 
          BX6    X2*X6
          BX1    -X2*X1 
          BX6    X6+X1
          SA6    RJTA        SET INSTRUCTION TO CALL SUBROUTINE 
          VOID               VOID ALL TYPES OF INSTRUCTION STACKS 
          SA1    F.TRJH      INSERT INTO ONE WAY CIO BUFFER 
          SA2    L.TRJH 
          SX3    X2-10D 
          NG     X3,RJT2     IF TABLE IS TOO SMALL
          SA3    X1          GET *IN* 
          SB2    X3 
          SA7    X1+B2       STORE AT *IN*
          SX6    X3+B1       NEXT *IN*
          IX3    X3-X2       *IN* - *LIMIT* 
          NG     X3,RJT1     IF NOT AT *LIMIT*
          SX6    B1          RESET *IN* TO *FIRST*
 RJT1     SA6    A3          STORE *IN* 
 RJT2     RJ     RSR         RESTORE ALL REGISTERS
 RJTA     EQ     *           EXIT TO TARGET SUBROUTINE
  
  
 RJTB     BSSZ   3*8         REGISTER SAVE AREA 
          SPACE  4,10 
*         UNQUALIFIED PSEUDO COMMON DECKS FOR *RJT* USE.
  
 QUAL$    EQU    0           FORCE UNQUALIFIED COMMON DECKS 
  
 RSR$     EQU    RJTB        REGISTER SAVE AREA FOR RSR 
 RSR      CTEXT  COMCRSR - RESTORE REGISTERS.    *MODIFIED FOR PACKER*
 RSR      SPACE  4,10 
          IF     -DEF,QUAL$,1 
          QUAL   COMCRSR
          BASE   D
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 RSR      SPACE  4,10 
***       RSR - RESTORE ALL REGISTERS.
* 
*         AUTHOR UNKNOWN.    CIRCA 1971.
*         P. C. TAM          77/07/05.
* 
*         RSR RESTORES B, A, AND X REGISTERS FROM A SAVE AREA.
 RSR      SPACE  4,10 
***       RSR RESTORES B, A, AND X REGISTERS FROM A SPECIFIED REGISTER
*         SAVE AREA. THE FORMAT OF THE REGISTERS IN THE SAVE AREA IS -
*         B0, B1, ..., B7, A0, A1, ..., A7, X0, X1, ..., X7.
*         EACH REGISTER OCCUPIES A FULL WORD WITH B AND A REGISTER
*         VALUES IN BITS 17-0.
* 
*         ENTRY  (X1) = ADDRESS OF REGISTER SAVE AREA.
*                IF RSR$ IS DEFINED THEN ITS VALUE IS THE FWA OF A
*                PERMANENT REGISTER SAVE AREA AND IT IS USED INSTEAD. 
* 
*         EXIT   ALL REGISTERS SET TO THE CONTENT OF THE REGISTER 
*                SAVE AREA. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 1, 2, 3, 4, 5, 6, 7. 
*                A - 0, 1, 2, 3, 4, 5, 6, 7.
* 
*         CALLS  NONE.
  
  
 SAVEB    EQU    0
 SAVEA    EQU    8
 SAVEX    EQU    16 
 RSR      SPACE  4,10 
 RSR      SUBR               ENTRY/EXIT 
          IF     -DEF,B1=1,1
          SB1    1
  
*         SET UP FINAL -B- REGISTERS RESTORE AT (RSR4) ET SEQ.
  
 RSR.     IF     DEF,RSR$ 
          SB7    RSR$        (B7) = FWA OF REGISTER SAVE AREA 
 RSR.     ELSE
          SB7    X1+         (B7) = FWA OF REGISTER SAVE AREA 
 RSR.     ENDIF 
          MX4    -18
          SA1    B7+SAVEB+7  (X1) = SAVED (B7)
          BX5    X4 
          LX4    30 
          SB4    4
          BX0    X4*X5       (X0) = 77770000007777000000B 
  
*         SET UP RESTORE B REGISTER INSTRUCTIONS. 
  
 RSR2     SA2    A1-B1       (X2) = SAVED (B.N-1) 
          SA3    RSR4+B4-1
          BX1    -X5*X1 
          SB4    B4-B1
          BX2    -X5*X2 
          LX1    30 
          BX3    X0*X3
          IX6    X1+X2
          BX7    X6+X3       (X7) = 30/SB.N B6+K, 30/SB.N-1 B6+K
          SA7    A3 
          SA1    A2-B1       (X1) = SAVED (B.N) 
          NZ     B4,RSR2     IF STILL MORE B REGISTERS TO GO
  
*         THE MOST LIKELY CANDIDATE FOR THE DANGER DISCUSSED IN THE 
*         NEXT PARAGRAPH IS THE SYSTEM COMMUNICATION CELL (RA.MTR). 
*         ACCORDINGLY, WE WAIT FOR IT TO CLEAR BEFORE PROCEEDING. 
  
          SA2    B7+SAVEA+6  (X2) = SAVED (A6)
 RSR3     SA1    RA.MTR 
          NZ     X1,RSR3     IF (RA.MTR) NOT CLEAR
  
*         A BIT OF CARE IS SPENT ON RESTORATION OF (A6) AND (A7). 
*         WE WISH TO AVOID HAVING THE CONTENTS OF THE WORD THAT THE 
*         STORE REGISTER IS POINTING TO GET CHANGED (I.E. BY A PP)
*         WHILE WE ARE RESTORING (A6) OR (A7). ABOUT THE ONLY THING 
*         THAT CAN BE DONE TO MINIMIZE THIS POSSIBILITY IS TO GET THE 
*         LOAD AND THE STORE AS CLOSE TOGETHER AS POSSIBLE. BY KEEPING
*         THEM IN THE SAME WORD, WE HAVE AT LEAST ENSURED THAT WE WILL
*         NOT BE EXCHANGED AFTER THE LOAD BUT BEFORE THE STORE. 
*         BARRING DELAYS IN THE HOPPER, THIS SHOULD REDUCE THE DANGER 
*         PERIOD TO A FEW MINOR CYCLES. 
  
          SA3    A2+B1       (X3) = SAVED (A7)
 +        SA4    X2-0 
          BX6    X4 
          SA6    A4-B0       RESTORE (A6) 
 +        SA5    X3-0 
          BX7    X5 
          SA7    A5-B0       RESTORE (A7) 
  
*         RESTORE (X6), (X7). 
  
          SA1    B7+SAVEX+6 
          SA4    A1+B1
          BX6    X1          RESTORE (X6) 
          LX7    X4          RESTORE (X7) 
          BX0    -X0-X0 
          SB6    X0-0        (B6) = -0
  
*         RESTORE (A0),(X0).
  
          SA4    B7+SAVEA+0 
          SA5    B7+SAVEX+0 
          SA0    X4+B6
          BX0    X5 
  
*         RESTORE (A) - 1,2,3,4.
*                 (X) - 1,2,3,4.
  
          ECHO   4,N=(1,2,3,4)
          SA4    A4+B1       (X4) = SAVED (A.N) 
          SA5    A5+B1       (X5) = SAVED (X.N) 
          SA.N   X4+B6
          BX.N   X5 
  
*         RESTORE (A5),(X5)-- THE ORIGINAL (X5) ARE BROKEN APART INTO 
*         (B1) THRU (B5) AS DISPLAYED BELOW. THIS ALLOWS US TO RESTORE
*         (A5). 
*         DISASSEMBLY IS FROM LEFT TO RIGHT, TOP TO BOTTOM. 
*         REASSEMBLY IS FROM RIGHT TO LEFT, BOTTOM TO TOP.
*         5          4          3          2          1               55
*         9          8          7          6          5              098
*         ..............................................................
*         ++++++++++++
*             (B1)   ++++++++++++ 
*                        (B2)   ++++++++++++
*                                   (B3)   ++++++++++++ 
*                                              (B4)   ++++++++++++++++++
*         ++                                                 (B5) 
  
          SA5    A5+B1       (X5) = SAVED (X5)
          ECHO   2,N=(1,2,3)
          UX5,B.N X5
          LX5    11 
          UX5,B4 X5 
          LX5    11+18
          SB5    X5+B6
          SA5    B7+SAVEA+5  (X5) = SAVED (A5)
          SA5    X5+B6       RESTORE (A5) 
  
*         REASSEMBLE (X5).
  
          SX5    B5+B6
          LX5    60-11-18 
          PX5    X5,B4
          ECHO   2,N=(3,2,1)
          LX5    -11
          PX5    X5,B.N 
  
*         RESTORE (B) - 0,1,2,3,4,5,6,7.
  
 RSR4     BSS    0
          ECHO   2,U=(1,3,5,7),L=(0,2,4,6)
          SB.U   B6+* 
          SB.L   B6+* 
          EQ     RSRX        RETURN 
 RSR      SPACE  4,10 
          BASE   *
 QUAL$    IF     -DEF,QUAL$ 
          QUAL   *
 RSR      EQU    /COMCRSR/RSR 
 RSR=     EQU    /COMCRSR/RSR 
 QUAL$    ENDIF 
 RSR      ENDX
 SVR$     EQU    RJTB        REGISTER SAVE AREA FOR SVR 
 SVR      CTEXT  COMCSVR - SAVE ALL REGISTERS.   *MODIFIED FOR PACKER*
 SVR      SPACE  4,10 
          IF     -DEF,QUAL$,1 
          QUAL   COMCSVR
          BASE   D
          COMMENT  COPYRIGHT CONTROL DATA SYSTEMS INC.  1992. 
 SVR      SPACE  4,10 
***       SVR - SAVE ALL REGISTERS. 
* 
*         AUTHOR UNKNOWN.    CIRCA 1971.
*         P. C. TAM.         77/06/18.
* 
*         SVR SAVES ALL REGISTERS IN A SPECIFIED REGISTER SAVE AREA.
 SVR      SPACE  4,10 
***       SVR SAVES ALL REGISTERS IN A SPECIFIED REGISTER SAVE AREA.
*         THE REGISTERS ARE SAVED IN THE FOLLOWING ORDER -
*         B0, B1, ..., B7, A0, A1, ..., A7, X0, X1, ..., X7.
*         EACH REGISTER OCCUPIES A FULL WORD WITH B AND A REGISTER
*         VALUES IN BITS 17-0. B AND A REGISTERS ARE SIGN EXTENDED. 
*         MINUS ZERO (-0) IS PRESERVED IN ALL REGISTERS.
* 
*         ENTRY  BITS 17-0 OF THE WORD FROM WHICH SVR= WAS CALLED 
*                CONTAIN THE ADDRESS OF THE REGISTER SAVE AREA. 
*                IF SVR$ IS DEFINED THEN ITS VALUE IS THE FWA OF A
*                PERMANENT REGISTER SAVE AREA AND IT IS USED INSTEAD. 
* 
*         EXIT   (SAVE - SAVE+7) = B REGISTERS. 
*                (SAVE+8 - SAVE+15) = A REGISTERS.
*                (SAVE+16 - SAVE+23) = X REGISTERS. 
* 
*         USES   A - 0, 1, 2, 3, 4, 5, 6, 7.
*                B - 1, 2, 3, 4, 5, 6, 7. 
*                X - 0, 1, 2, 3, 4, 5, 6, 7.
* 
*         CALLS  NONE.
  
  
 SAVEB    EQU    0
 SAVEA    EQU    8
 SAVEX    EQU    16 
  
 SVR      SUBR               ENTRY/EXIT 
  
*         CHECK FOR (B1) = 1. IF NOT, SAVE (B1) THE HARD WAY BY 
*         EXECUTING THE RJ SEQUENCE AT *SVR2*. IF BIT 
*         2**N WAS ON IN (B1), THEN THE *RJ* AT (SVR2+2*N+1) WILL BE
*         EXECUTED, RESULTING IN AN /EQ SVR2+2*N+1/. IF BIT 2**N WAS
*         NOT ON IN (B1), THEN THE *RJ* WILL NOT BE EXECUTED. BY
*         QUERYING (SVR2+2*N+1), ONE CAN DETERMINE WHETHER OR NOT THE 
*         BIT 2**N WAS ON IN (B1) BY THE PRESENCE OF AN *EQ* OR AN *RJ* 
*         INSTRUCTION.
  
          NG     B1,SVR2     IF (B1) .LE. 0 (PRESERVE -0) 
          SB1    B1-1 
          ZR     B1,SVR4     IF (B1) = 1
          SB1    B1+1        RESTORE (B1) 
  
*         *RJ* SEQUENCE FOR SAVING (B1).
  
 SVR2     PL     B1,*+2 
 +        RJ     *
 B.NE.1   DUP    17 
 +        SB1    B1+B1
          NO
          PL     B1,*+2 
 +        RJ     *
 B.NE.1   ENDD
  
*         FILLER BECAUSE RJ-S MUST BE 2 WORDS APART FOR RESTORE.
  
 +        SB0    B0+
 SVR3     RJ     *           (B1) = 1/(B1) .NE. 1 FLAG
  
*         SAVE   (A) - 4,5,6,7. 
*                (X) - 4,5,6,7. 
  
 SVR4     SB1    A7-B0       SAVE (A7) TEMPORARILY. 
          SA7    SVRA        SAVE (X7) TEMPORARILY
          SX7    A5-B0
          SA7    SVRB        SAVE (A5) TEMPORARILY
          BX7    X5 
          SA7    SVRC        SAVE (X5) TEMPORARILY
 SVR.     IF     DEF,SVR$ 
          SX5    SVR$        (X5) = FWA OF RSA
 SVR.     ELSE
          SA5    SVRX        (X5) = 30/EQ CALLER+1, 30/0
          LX5    30 
          SA5    X5-1        (X5) = 30/RJ SVR=, 30/FWA OF RSA 
 SVR.     ENDIF 
          SX7    B1-B0
          SB1    1
          SA7    X5+SAVEA+7  (A7) TO SAVE AREA
          SX7    A6-B0
          SA6    X5+SAVEX+6  (X6) TO SAVE AREA
          SA7    A7-B1       (A6) TO SAVE AREA
          BX6    X4 
          SX7    A4-B0
          SA6    A6-2        (X4) TO SAVE AREA
          SA7    A7-2        (A4) TO SAVE AREA
  
*         SAVE   (A) - 0,1,2,3. 
*                (X) - 0,1,2,3. 
  
 SV=AX    ECHO   ,N=(3,2,1,0) 
          BX6    X.N
          SX7    A.N-B0 
          SA6    A6-B1       (X.N) TO SAVE AREA 
          SA7    A7-B1       (A.N) TO SAVE AREA 
 SV=AX    ENDD
  
*         SAVE (X7), (A5), (X5) FINALLY.
  
          SA2    SVRA        (X2) = SAVED (X7)
          SA3    SVRB        (X3) = SAVED (A5)
          SA4    SVRC        (X4) = SAVED (X5)
          BX6    X2 
          LX7    X3 
          SA6    X5+SAVEX+7  (X7) TO SAVE AREA
          SA7    X5+SAVEA+5  (A5) TO SAVE AREA
          BX6    X4 
          SA6    X5+SAVEX+5  (X5) TO SAVE AREA
  
*         SAVE   (B) - 0,1,2,3,4,5,6,7. 
  
          BX6    X6-X6
          SA6    X5+SAVEB+0  (B0) = 0 TO SAVE AREA
          SX7    B1 
          SA7    A6+B1
 SV=B     ECHO   ,U=(2,4,6),L=(3,5,7) 
          SX6    B.U-B0 
          SX7    B.L-B0 
          SA6    A7+B1
          SA7    A6+B1
 SV=B     ENDD
  
*         SAVE (B1).
  
          SA5    SVR3        (X5) = (B1) = 1/(B1) .NE. 1 FLAG 
          SX4    0100B       (X4) = *RJ* OP CODE
          SX3    B1 
          LX3    42-0-1      BIT FOR RECONSTRUCTION OF B1 
          SX6    A5 
          LX4    29-11
          BX6    X4+X6       (X6) = 30/0, 30/RJ * 
          LX6    59-29
          SA6    A5          RESTORE RJ    *
          LX5    59-56
          BX7    X7-X7
          PL     X5,SVRX     IF (B1) = 1
          SB2    B1+B1
  
*         ASSEMBLE ORIGINAL (B1) INTO (X7). 
  
 SVR5     SA5    A5-B2
          IX3    X3+X3
          SX6    A5 
          LX5    59-56
          BX6    X4+X6       (X6) = 30/0, 30/RJ * 
          PL     X5,SVR6     IF BIT WAS CLEAR 
          BX7    X7+X3
 SVR6     LX6    59-29       RESTORE RJ * 
          SA6    A5 
          PL     X3,SVR5     IF MORE BITS TO ASSEMBLE 
  
*         FINALLY SAVE (B1).
  
          AX7    42          SIGN EXTEND
          SA7    A7-7+1      (B1) TO SAVE AREA
          EQ     SVRX        RETURN 
  
*         TEMPORARY SAVE AREAS. 
  
 SVRA     BSS    1           SAVE FOR (X7)
 SVRB     BSS    1           SAVE FOR (A5)
 SVRC     BSS    1           SAVE FOR (X5)
 SVR      SPACE  4,10 
          BASE   *
 QUAL$    IF      -DEF,QUAL$
          QUAL   *
 SVR      EQU    /COMCSVR/SVR 
 SVR=     EQU    /COMCSVR/SVR 
 QUAL$    ENDIF 
 SVR      ENDX
  
  
          QUAL   *
 RJT      EQU    /RJT/RJT 
          TITLE  SUBROUTINES. 
 AFM      SPACE  4,25 
**        AFM - ATTEMPT FILL MOVE.
* 
*         ENTRY  (HL) = COLLECTION HOLE LENGTH. 
*                (HE) = COLLECTION HOLE ENTRY.
*                (FE) = SLIDE FILE ENTRY. 
*                (IX) = INDEX OF SLIDE FILE.
*                (IX)-1 = INDEX OF COLLECTION HOLE. 
* 
*         EXIT   (X1) = 0, IF NO FILL MOVE WAS POSSIBLE.
*                (X1) .LT. 0, IF AN EXACT FIT OCCURRED. 
*                             THE COLLECTION HOLE IS CLOSED.
*                (X1) .GE. 0, IF EITHER NO FILL MOVE WAS POSSIBLE, OR 
*                             THE FILL MOVE DID NOT EXACTLY FILL THE
*                             COLLECTION HOLE.
*                             THE COLLECTION HOLE IS OPEN.
*                (HE) = UPDATED.
*                (HL) = UPDATED.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3.
* 
*         CALLS  CDF, RCE, UFF. 
  
  
 AFM6     SX1    B0+         INDICATE NO MOVE POSSIBLE
  
 AFM      SUBR               ENTRY/EXIT 
          SA1    NF 
          SA2    LT 
          NZ     X1,AFM6     IF FILL MOVE TECHNIQUE IS NOT TO BE USED 
          NZ     X2,AFM6     IF *TFHL* TABLE IS NOT ACTIVE
          SX6    B1 
          LX6    24-0        LARGEST FILE SIZE + 1
          SA6    AFMA        CLEAR BEST CANDIDATE SIZE
          SX6    -1 
          SA6    FX          CLEAR BEST CANDIDATE INDEX 
  
*         SEARCH FOR FILE TO JUMP FILL INTO COLLECTION HOLE.
  
          SA1    F.TFRI 
          SA2    L.TFRI 
          SA3    F.TFHL 
          SA4    IX          SLIDE FILE INDEX 
          SB2    X2          SEARCH INDEX + 1 (LENGTH)
          SB3    X4 
          SA5    HL          HOLE LENGTH
 AFM1     SB2    B2-B1
          LE     B2,B3,AFM3  IF SEARCH COMPLETE (SEARCH .LE. SLIDE) 
          SA2    X1+B2       ENTRY
          NG     X2,AFM1     IF HOLE
          SA4    X3+B2       CHECK LENGTH 
          LX2    59-57
          NG     X2,AFM1     IF IMMOVABLE FILE
          MX2    -24
          LX4    24 
          BX4    -X2*X4 
          SX2    B1+B1
          IX6    X4+X2       ADD SYSTEM AND EOI SECTORS 
          IX2    X5-X6
          ZR     X2,AFM2     IF EXACT FIT 
          NG     X2,AFM1     IF FILE TOO LARGE
          SA4    AFMA        BEST CANDIDATE THUS FAR
          IX4    X6-X4
          PL     X4,AFM1     IF NOT SMALLER FILE
 AFM2     SX7    B2 
          SA6    AFMA        NEW BEST CANDIDATE LENGTH
          SA7    FX          NEW BEST CANDIDATE INDEX 
          NZ     X2,AFM1     IF NOT EXACT FIT, CONTINUE SEARCH
 AFM3     SA2    AFMA        BEST CANDIDATE LENGTH
          SX4    MNHS 
          ERRNG  MNHS-3      MUST CONTAIN SYSTEM AND EOI SECTORS
          IX6    X5-X2       HOLE-FILE-SS-EOI 
          SA6    AFMB        POTENTIAL NEW COLLECTION HOLE LENGTH 
          ZR     X6,AFM4     IF EXACT FIT 
          IX4    X6-X4       HOLE-FILE-SS-EOI-MNHS
          NG     X4,AFM6     IF BEST NOT GOOD ENOUGH
          SA2    EF 
          NZ     X2,AFM6     IF EXACT FIT REQUIRED
          SA2    L.TAPE 
          ZR     X2,AFM6     IF NO PFC AVAILABLE AND NOT EXACT FIT
  
*         COPY THE FILL FILE INTO THE COLLECTION HOLE.
  
 AFM4     SA2    FX          FILL FILE INDEX
          NG     X2,AFM6     IF NEVER FOUND A VALID CANDIDATE 
          SX0    =C/ INTERNAL ERROR, HOLE LENGTH NEGATIVE IN AFM./
          NG     X6,ERR      IF HOLE LENGTH NEGATIVE
          SB3    X2 
          SA2    X1+B3       BASE + OFFSET
          BX6    X2 
          SA6    FF          FILL FILE ENTRY
          SA1    HE          COLLECTION HOLE ENTRY
          MX4    -24
          BX6    -X4*X1 
          SA6    O+6         OUTPUT I/O SETUP 
          BX7    -X4*X2 
          SA7    I+6         INPUT I/O SETUP
          SA7    FB          RSA OF FILE DATA 
          SA1    AFMA        FILE LENGTH + SS + EOI 
          SX7    B1 
          IX6    X1-X7       REMOVE EOI FROM LENGTH 
          SA6    FS          FILE SIZE + SS 
          SA1    FF 
          RJ     RCE         SET (A0) FOR *CDF* 
          SA1    FF          FILE *TFRI* ENTRY
          RJ     CDF         COPY DATA FOR FILE 
          RJ     UFF         UPDATE AFTER FILL FILE MOVE
          SA3    FS          FILES SIZE + SYSTEM SECTOR 
          SA4    JM          JUMP FILL MOVE STATISTICS
          SX7    B1 
          IX3    X3-X7       REMOVE SYSTEM SECTOR FROM FILE SIZE
          IX4    X4+X7       INCREMENT COUNT
          LX3    30 
          IX7    X3+X4
          SA7    A4          UPDATE STATISTICS
          SA1    AFMB 
          NZ     X1,AFM5     IF NOT AN EXACT FIT
          SX1    -B1         INDICATE COLLECTION HOLE CLOSED
          EQ     AFMX        RETURN 
  
 AFM5     SX1    B1          INDICATE COLLECTION HOLE OPEN
          EQ     AFMX        RETURN 
  
  
 AFMA     CON    0           BEST CANDIDATE LENGTH
 AFMB     CON    0           ZERO IF EXACT FIT (HOLE - FILE - SS - EOI) 
 ASM      SPACE  4,10 
**        ASM - ATTEMPT SLIDE MOVE. 
* 
*         ENTRY  (HL) = COLLECTION HOLE LENGTH. 
*                (HE) = COLLECTION HOLE ENTRY.
*                (FE) = SLIDE FILE ENTRY. 
*                (IX) = INDEX OF SLIDE FILE.
*                (IX)-1 = INDEX OF COLLECTION HOLE. 
* 
*         EXIT   (X1) .GE. 0, IF THE FILE WAS MOVED.
*                             THE COLLECTION HOLE IS OPEN.
*                (X1) .LT. 0, IF THE FILE WAS NOT MOVED.
*                             THE COLLECTION HOLE IS CLOSED.
* 
*         USES   X - 1, 2, 3, 4, 5, 6, 7. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2. 
* 
*         CALLS  CDF, CFL, RCE, UFE, UHE. 
  
  
 ASM      SUBR               ENTRY/EXIT 
  
*         SET UP I/O FOR POTENTIAL MOVE.
  
          SA1    HE          COLLECTION HOLE ENTRY
          SA2    FE          SLIDE FILE ENTRY 
          MX4    -24
          BX6    -X4*X1 
          SA6    O+6         OUTPUT I/O SET UP
          BX7    -X4*X2 
          SA7    I+6         INPUT I/O SET UP 
          SA7    FB          REMEMBER WHERE FILE STARTED
  
*         CHECK IF THE FILE FITS IN THE COLLECTION HOLE.
  
          SA1    F.TFRI 
          SA2    IX 
          SB2    X2 
          SA2    X1+B2       (A2), (X2) ENTRY CONDITIONS FOR *CFL*
          RJ     CFL         GET FILE LENGTH
          SX5    B1          ADD SYSTEM SECTOR
          IX6    X6+X5
          SA6    FS 
          SA5    HL 
          IX3    X5-X6
          ZR     X3,ASM4     IF HOLE TOO SMALL
          NG     X3,ASM4     IF HOLE TOO SMALL
  
*         DETERMINE IF THE MOVE IS PRACTICAL. 
  
          SA1    NS 
          NZ     X1,ASM4     IF SLIDE MOVE TECHNIQUE IS NOT TO BE USED
          SA1    F.TFRI 
          SA2    IX 
          SA3    LT          *TFHL TABLE ACTIVE* FLAG 
          SB2    X2-1 
          SA2    X1+B2       ENTRY MINUS ONE
 ASM1     SA2    A2+B1       GET NEXT ENTRY 
          NG     X2,ASM3     IF HOLE
          NZ     X2,ASM2     IF NOT EOI 
          SA2    EI          RSA OF EOI 
          EQ     ASM3        CHECK SIZE OF MOVE 
  
 ASM2     BX1    X2 
          LX1    59-57       CHECK IF IMMOVABLE FILE
          NG     X1,ASM4     IF FILE MAY NOT BE MOVED 
          NZ     X3,ASM1     IF *TFHL* TABLE IS NOT ACTIVE
          RJ     CFL         GET FILE LENGTH
          SX5    B1          + SS + EOI - 1 
          IX6    X6+X5
          SA5    HL 
          IX3    X5-X6
          ZR     X3,ASM4     IF HOLE TOO SMALL
          NG     X3,ASM4     IF HOLE TOO SMALL
          SA3    LT          REFETCH *TFHL TABLE ACTIVE* FLAG 
          EQ     ASM1        GET NEXT ENTRY 
  
 ASM3     SA3    FB          RSA OF START TO MOVE 
          MX4    -24
          BX1    -X4*X2      RSA OF END OF MOVE 
          IX4    X1-X3       TOTAL SECTORS TO MOVE
          IX5    X4/X5       DATA/HOLE SIZE 
          SA4    MR 
          IX4    X4-X5
          ZR     X4,ASM4     IF NOT WARRANTED 
          PL     X4,ASM5     IF MOVE WARRANTED
  
*         SKIP HOLE.
  
 ASM4     RJ     UHE         UPDATE HOLE CATALOG ENTRY
          SX1    -B1         INDICATE COLLECTION HOLE CLOSED
          EQ     ASMX        RETURN 
  
*         MOVE ONE FILE.
  
 ASM5     SA1    FE 
          RJ     RCE         SET (A0) FOR *CDF* 
          SA1    FE          FILE *TFRI* ENTRY
          RJ     CDF         COPY FILE INTO HOLE
          RJ     UFE         UPDATE CATALOG ENTRY FOR FILE
          SA3    FS          FILE SIZE + SYSTEM SECTOR
          SA4    SM          JUMP FILL MOVE STATISTICS
          SX7    B1 
          IX3    X3-X7       REMOVE SYSTEM SECTOR FROM FILE SIZE
          IX4    X4+X7       INCREMENT COUNT
          LX3    30 
          IX7    X3+X4
          SA7    A4          UPDATE STATISTICS
          SX1    B1+         INDICATE COLLECTION HOLE OPEN
          EQ     ASMX        RETURN 
 ATD      SPACE  4,25 
**        ATD - ATTEMPT PRE-MOVE TRACK DELINK.
* 
*         ENTRY  (HL) = COLLECTION HOLE LENGTH. 
*                (HE) = COLLECTION HOLE ENTRY.
*                (IX)-1 = INDEX OF COLLECTION HOLE. 
* 
*         EXIT   (X1) .LT. 0, IF A TRACK OR TRACKS HAVE BEEN DELINKED.
*                             THE COLLECTION HOLE IS CLOSED.
*                (X1) .GE. 0, IF NO TRACKS WERE DELINKED. 
*                             THE COLLECTION HOLE IS OPEN.
*                (IX) = UPDATED IF NEEDED TO REPROCESS CLOSED 
*                       COLLECTION HOLE ENTRY.
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 3, 5, 6, 7.
* 
*         CALLS  CRA, FLT, UHE, VHS.
  
  
 ATD2     SX1    B0+         INDICATE NO TRACKS DELINKED
  
 ATD      SUBR               ENTRY/EXIT 
          SA1    NP 
          NZ     X1,ATD2     IF NO PRE-MOVE TRACK DELINK IS TO BE DONE
          SA5    HE          GET HOLE ENTRY 
          RJ     CRA         CONVERT RANDOM ADDRESS 
          RJ     FLT         FIND LAST TRACK
          ZR     X6,ATD2     IF TRACK AT END OF IAPF CHAIN
          RJ     VHS         VERIFY HOLE SIZE 
          NG     X7,ATD2     IF NO TRACKS CAN BE DELINKED 
          SA1    HS 
          SA2    DS 
          BX6    X1 
          BX7    X2 
          SA1    L.TFRI 
          SA6    ATDA        SAVE HOLE STATISTICS PRIOR TO *UHE*
          SA7    ATDB        SAVE TRACK STATISTICS PRIOR TO *UHE* 
          BX6    X1 
          SA6    ATDC        SAVE *TFRI* LENGTH PRIOR TO *UHE*
          RJ     UHE         UPDATE HOLE ENTRY
          SA1    ATDA        HOLE STATISTICS PRIOR TO *UHE* 
          SA2    DS          TRACKS DROPPED AFTER *UHE* 
          SA5    ATDB        TRACKS DROPPED STATISTICS
          BX6    X1 
          IX7    X2-X5       CHANGES MADE BY *UHE*
          SA6    HS          RESTORE HOLE STATISTICS
          SA1    HR          HOLES REMOVED
          MX2    30 
          BX7    X2*X7
          IX7    X1+X7       ADD SPACE DELINKED 
          SA7    A1 
          SA2    L.TFRI      *TFRI* LENGTH AFTER *UHE*
          SA3    ATDC        *TFRI* LENGTH BEFORE *UHE* 
          IX6    X2-X3
          NG     X6,ATD1     IF THE HOLE ENTRY WAS DELETED FROM *TFRI*
          SA2    IX 
          SX6    X2-1 
          SA6    A2          DECREMENT *IX* TO REPROCESS HOLE 
 ATD1     SX1    -B1         INDICATE COLLECTION HOLE CLOSED
          EQ     ATDX        RETURN 
  
  
 ATDA     CON    0           STORAGE FOR HOLES LEFT STATISTICS
 ATDB     CON    0           STORAGE FOR TRACKS DROPPED STATISTICS
 ATDC     CON    0           STORAGE FOR *TFRI* LENGTH
 CDF      SPACE  4,20 
**        CDF - COPY DATA FOR FILE. 
* 
*         ENTRY  (I+6) = RSA OF FILE DATA.
*                (O+6) = RSA OF TARGET. 
*                (FB) = RSA OF FILE DATA. 
*                (FS) = FILE SIZE FROM PFC ( + 1 FOR SS). 
*                (A0) = ADDRESS OF PFC OR ZERO FOR NO PFC UPDATE IN SS. 
*                (X1) = FILE *TFRI* ENTRY.
* 
*         EXIT   DATA COPIED TO TARGET. 
*                PFC IN SYSTEM SECTOR UPDATED IF REQUESTED. 
*                TO *ERR* IF ERROR. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 5, 7.
* 
*         CALLS  CRA, FPI, MSG, USS.
* 
*         MACROS BKSPRU, READ, REWRITE, REWRITEF, REWRITER, SYSTEM. 
  
  
 CDF9     SA1    DM          UPDATE STATISTICS FOR *NO CHANGE* OPTION 
          SA2    FS 
          SX6    B1 
          IX2    X2-X6       REMOVE SYSTEM SECTOR FROM FILE SIZE
          LX2    30 
          IX6    X2+X6       COUNT FILE 
          IX6    X1+X6
          SA6    A1+
  
 CDF      SUBR               ENTRY/EXIT 
          BX6    X1          FILE *TFRI* ENTRY
          SA6    CDFB 
          SX0    =C/ INTERCHANGING HOLE-FILE./
          RJ     MSG
          SA1    NC 
          NZ     X1,CDF9     IF NO CHANGES ARE TO BE MADE TO THE DEVICE 
          SYSTEM MPF,R,I,4S6 READ SYSTEM SECTOR 
          SA5    O+6
          RJ     CRA
          SA1    I+1
          RJ     USS         UPDATE SYSTEM SECTOR 
          SYSTEM MPF,R,O,5S6 WRITE SYSTEM SECTOR
          SX6    1
          SA6    CDFA        SET NO EOR FLAG INITIALLY
 CDF1     SA1    O+2         IN 
          SA3    A1+B1       OUT
          BX6    X1 
          BX7    X3 
          SA6    I+2
          SA7    A6+B1
          READ   I,R
          SA1    I+2         IN 
          SA3    A1+B1
          BX6    X1 
          BX7    X3 
          SA6    O+2
          SA7    A6+B1
          SA1    X2 
          LX1    59-9 
          NG     X1,CDF6     IF EOI 
          LX1    9-4
          LX2    X1,B1
          NG     X1,CDF2     IF EOR OR EOF
          REWRITE O,R 
          SA1    BF          INCREMENT BUFFER FULL COUNT
          SX6    X1+B1
          SA6    A1 
          SA6    CDFA        SET NO EOR FLAG
          EQ     CDF1        LOOP 
  
 CDF2     NG     X2,CDF3     IF EOF 
          REWRITER O,R
          SX6    B0+
          SA6    CDFA        CLEAR NO EOR FLAG
          EQ     CDF1        LOOP 
  
 CDF3     SA1    O+2         CHECK FOR DATA WITH EOF
          SA2    A1+B1
          IX2    X1-X2
          NZ     X2,CDF4     IF DATA IN BUFFER
          SA1    CDFA 
          ZR     X1,CDF5     IF EOR/EOF WRITTEN 
 CDF4     REWRITER O,R
          BKSPRU O,1,R       BACK OVER EMPTY PRU
 CDF5     REWRITEF O,R       WRITE EOF
          SX6    B0+
          SA6    CDFA        CLEAR NO EOR FLAG
          EQ     CDF1        LOOP 
  
 CDF6     SA1    I+6         CHECK DATA COPIED
          SA2    FB 
          SA3    FS 
          SA4    DM 
          SX7    B1 
          AX1    30 
          IX2    X2+X3
          BX6    X1-X2
          IX3    X3-X7       REMOVE SYSTEM SECTOR FROM FILE SIZE
          LX3    30 
          IX3    X3+X7       INCREMENT FILE COUNT 
          IX7    X4+X3
          SA7    A4 
          NZ     X6,CDF8     IF NOT CORRECT LENGTH
          SA3    O+2
          SA4    A3+B1
          BX6    X3-X4
          ZR     X6,CDF7     IF NO DATA IN BUFFER 
          REWRITE O,R 
 CDF7     REWRITER O,R       FORCE FST UPDATE FOR *MPF* 
          BKSPRU X2,1,R 
          SYSTEM MPF,R,O,1S6 REWRITE EOI
          EQ     CDFX        RETURN 
  
 CDF8     SA1    CDFB        FILE *TFRI* ENTRY
          SB7    1R(
          SB5    CDFC 
          RJ     FPI         FORMAT PFC INFORMATION 
          SX0    CDFC        * FILE LENGTH ERROR TTTT/SSSS/O.*
          EQ     ERR         ABORT
  
  
 CDFA     CON    0           NO EOR/EOF WRITTEN FLAG
 CDFB     CON    0           FILE *TFRI* ENTRY
 CDFC     DATA   C* FILE LENGTH ERROR ((((/))))/$.* 
 CEO      SPACE  4,15 
**        CEO - CHECK ENTRY OVERLAP.
* 
*         EXIT   TO *ERR* IF OVERLAP. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 1, 2, 3, 4, 6, 7.
*                B - 2, 3.
* 
*         CALLS  IOM, MSG.
  
  
 CEO      SUBR               ENTRY/EXIT 
          SA1    LT 
          NZ     X1,CEOX     IF *TFHL* TABLE IS NOT ACTIVE
          SX0    =C/ CHECKING ENTRY OVERLAP./ 
          RJ     MSG
          BX6    X6-X6
          SX7    -B1
          SA6    CEOC        CLEAR PREVIOUS EOI+1 
          SA7    CEOD        PRESET INDEX 
          SA3    L.TFRI 
          SA4    L.TFHL 
          BX6    X3-X4
          SX0    =C* INTERNAL ERROR, TFRI/TFHL LENGTH MISMATCH IN CEO.* 
          NZ     X6,ERR      IF *TFRI*/*TFHL* LENGTH MISMATCH 
          SB2    X3 
          SA3    F.TFRI 
          SA4    F.TFHL 
          SA1    X3+B2
          SA2    X4+B2
          BX6    X1+X2
          SX0    =C* INTERNAL ERROR, MISSING TABLE TERMINATOR IN CEO.*
          NZ     X6,ERR      IF NO ZERO WORD FOLLOWING TABLES 
  
*         TABLE SCAN LOOP.
  
 CEO1     SA1    CEOC        PREVIOUS EOI + 1 
          SA2    CEOD        INDEX
          SA3    L.TFRI 
          SB2    X2 
          SB3    X3 
          BX7    X1 
          MX0    -24
          SA3    F.TFRI 
          SA4    F.TFHL 
 CEO2     SB2    B2+B1
          GT     B2,B3,CEO5  IF NO MORE ENTRIES TO EXAMINE
          EQ     B2,B3,CEO3  IF AT EOI
          SA1    X3+B2       *TFRI* ENTRY 
          SA2    X4+B2       *TFHL* ENTRY 
          BX6    X1-X2
          BX6    -X0*X6 
          SX0    =C* INTERNAL ERROR, TRFI/TFHL MISMATCH IN CEO.*
          NZ     X6,ERR      IF *TFRI*/*TFHL* TABLE MISMATCH
          MX0    -24
          BX6    -X0*X2      RSA
          IX1    X6-X7       RSA - (RSA OF PREVIOUS EOI+1)
          SX7    B1+B1
          LX2    24 
          BX2    -X0*X2      LENGTH 
          IX7    X2+X7       LENGTH + SS + EOI
          IX7    X6+X7       NEW PREVIOUS EOI + 1 
          PL     X1,CEO2     IF NO OVERLAP
          EQ     CEO4        PROCESS ERROR
  
 CEO3     SA1    EI 
          IX1    X1-X7
          PL     X1,CEO2     IF NO OVERLAP WITH IAPF CHAIN EOI
  
*         ISSUE ENTRY OVERLAP MESSAGE.
  
 CEO4     SA7    CEOC        SAVE PREVIOUS EOI + 1
          SX6    B2 
          SX7    B1 
          SA6    CEOD        SAVE INDEX 
          SA7    CEOB        SET ERROR ENCOUNTERED
          SB2    B2-1 
          RJ     IOM         ISSUE OVERLAP MESSAGE
          EQ     CEO1        LOOP 
  
*         TERMINATE.
  
 CEO5     SA1    CEOB 
          ZR     X1,CEOX     IF NO ERRORS ENCOUNTERED 
          SX0    =C/ IAPF CHAIN OVERLAP./ 
          SA1    CEOA 
          ZR     X1,ERR      IF EXTERNAL ERROR
          SX0    =C/ INTERNAL ERROR, CEO DETECTED ERRORS./
          EQ     ERR         INTERNAL ERROR 
  
  
 CEOA     CON    0           INTERNAL/EXTERNAL ERROR MESSAGE FLAG 
 CEOB     CON    0           ERRORS ENCOUNTERED FLAG
 CEOC     CON    0           PREVIOUS EOI + 1 
 CEOD     CON    0           INDEX
 CFL      SPACE  4,15 
**        CFL - CHECK FILE LENGTH.
* 
*         ENTRY  (A2,X2) = *TFRI* TABLE ENTRY OF FILE.
* 
*         EXIT   (X6) = FILE LENGTH (FROM THE PFC). 
*                (X7) = LOST SPACE AFTER FILE.
*                TO *ERR* IF ERROR. 
* 
*         USES   X - 0, 1, 3, 4, 5, 6, 7. 
*                A - 3, 5.
*                A - 5, 7.
* 
*         CALLS  FPI, RCE.
  
  
 CFL      SUBR               ENTRY/EXIT 
          SA3    A2+B1       GET NEXT ENTRY 
          SA5    MR 
          MX4    -24
          NZ     X3,CFL1     IF NOT AT EOI
          SA3    EI 
 CFL1     BX6    -X4*X2      GET IMPLIED LENGTH 
          BX3    -X4*X3 
          IX6    X3-X6
          SX7    B1+B1       ADD SYSTEM AND EOI SECTORS 
          IX6    X6-X7
          BX7    X7-X7
          NG     X6,CFL4     IF NOT ENOUGH ROOM FOR FILE
          SA3    LT 
          NZ     X3,CFL2     IF *TFHL* IS NOT ACTIVE
          BX5    X6 
          SA3    F.TFRI      FWA OF TABLE 
          SX1    A2          ENTRY ADDRESS
          IX1    X1-X3       OFFSET IN TABLE
          SA3    F.TFHL 
          IX3    X3+X1
          SA3    X3          FETCH FILE LENGTH
          MX4    -24
          BX1    X2-X3       COMPARE RSA-S FROM *TFRI* AND *TFHL* 
          BX4    -X4*X1 
          NZ     X4,CFL5     IF TABLES DO NOT MATCH 
          EQ     CFL3        CHECK LENGTH 
  
 CFL2     ZR     X5,CFLX     IF *MR=0*, DO NOT READ CATALOG 
          SA3    IX 
          BX5    X6 
          BX1    X2 
          SX4    X3-2 
          SX3    B0+         ANCHOR ENTRY DATA LENGTH 
          NG     X4,CFL3     IF ANCHOR ENTRY, IT DOES NOT HAVE A PFC
          RJ     RCE         READ CATALOG ENTRY 
          SA3    A0+FCLF     GET LENGTH FROM CATALOG
 CFL3     MX4    -24
          LX3    24 
          BX6    -X4*X3 
          IX7    X5-X6
          PL     X7,CFLX     IF IMPLIED .GE. CATALOG LENGTH 
 CFL4     BX1    X2          *TFRI* ENTRY 
          SB7    1R(
          SB5    CFLA 
          RJ     FPI         FORMAT PFC INFORMATION 
          SA3    A2+B1       NEXT *TFRI* ENTRY
          BX1    X3 
          SB7    1R[
          SB5    CFLA 
          RJ     FPI         FORMAT PFC INFORMATION 
          SX0    CFLA        * FILE OVERLAP TTTT/SSSS/O, TTTT/SSSS/O.*
          EQ     ERR         ABORT
  
 CFL5     SX0    =C* INTERNAL ERROR, TFRI/TFHL MISMATCH IN CFL.*
          EQ     ERR         ABORT
  
  
 CFLA     DATA   C* FILE OVERLAP ((((/))))/$, [[[[/]]]]/%.* 
 CIP      SPACE  4,20 
**        CIP - CLEAR IRRELEVANT PFC INFORMATION. 
* 
*         THIS ROUTINE CLEARS ALL WORDS OF THE PFC EXCEPT FOR PFC+1.
*         THE CURRENT PACKED DATE AND TIME IS PLACED INTO THE CREATION
*         DATE AND TIME FIELD.  THIS IS DONE TO SIMPLIFY DISK RECOVERY
*         VIA *DDF* SINCE THE INFORMATION CLEARED NO LONGER RELATES TO
*         WHERE THE PFC NOW POINTS. 
* 
*         ENTRY  (A0) = ADDRESS OF THE PFC. 
* 
*         EXIT   (A0) = UNCHANGED.
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 6, 7.
  
  
 CIP      SUBR               ENTRY/EXIT 
          BX6    X6-X6
          SA6    A0          CLEAR WORD 0 
          SB7    17B         LAST WORD OFFSET TO CLEAR
          SB6    B1          SKIP WORD 1
          ERRNZ  1-FCBT      CODE DEPENDS ON THE VALUE OF *FCBT*
          ERRNZ  1-FCLF      CODE DEPENDS ON THE VALUE OF *FCLF*
 CIP1     SB6    B6+B1
          SA6    A0+B6       CLEAR WORDS 2 TO 17B 
          LT     B6,B7,CIP1  IF FINAL WORD NOT CLEARED
          SA1    PD          PACKED DATE AND TIME 
          BX6    X1 
          SA6    A0+FCCD     SET CREATION DATE AND TIME 
          EQ     CIPX        RETURN 
 CIT      SPACE  4,15 
**        CIT - CLEAR INTERLOCKS. 
* 
*         ENTRY  (IF) = INTERLOCK REQUEST.
* 
*         EXIT   FILES RETURNED, ETC. 
* 
*         USES   X - 1, 7.
*                A - 1, 7.
* 
*         MACROS CALLPFU, RETURN. 
  
  
 CIT      SUBR               ENTRY/EXIT 
          RETURN C,R
          RETURN I,R
          RETURN O,R
          SA1    EQ 
          NG     X1,CITX     IF NEVER INTERLOCKED 
          SX7    IF 
          LX1    48 
          BX7    X7+X1       SET EST ORDINAL AND INTERLOCK FLAG 
          SA7    C+FTPM 
          CALLPFU  C,CTCU,R  CLEAR UTILITY INTERLOCK
          EQ     CITX        RETURN 
 CRA      SPACE  4,20 
**        CRA - CONVERT RANDOM ADDRESS. 
* 
*         ENTRY  (X5) = 36/ ,24/RSA.
* 
*         EXIT   (X5) = 36/ 0,12/ TK,12/ SECTOR.
*                (X4) = 36/ 0,12/ TK,12/ 0. 
*                (X3) = (SL). 
*                (X0) = -7777B. 
*                (B6) = (F.TTLT)-1S11.
*                TO *ERR* IF ERROR. 
* 
*         USES   X - 0, 1, 3, 4, 5, 6.
*                A - 1, 3.
*                B - 6, 7.
  
  
 CRA4     BX6    -X0*X1      LINK OR EOI SECTOR 
          IX5    X5+X3       SECTOR ON TRACK
          LX4    12 
          IX6    X6-X5
          NG     X6,CRA3     IF BEYOND EOI
          BX5    X5+X4
  
 CRA      SUBR               ENTRY/EXIT 
          MX0    -24
          BX5    -X0*X5 
          SA1    F.TTLT 
          SB7    59-11       SHIFT COUNT FOR TRACK BIT
          SB6    X1-1S11
          SA1    FT          FIRST TRACK OF IAPF CHAIN
          SA3    SL          SECTORS/TRACK
          MX0    -12
          BX6    -X6+X6      (X6) = -0
          EQ     CRA2        ENTER LOOP 
  
 CRA1     IX5    X5-X3
          NG     X5,CRA4     IF RSA ON THIS TRACK 
          LX6    X1,B7
 CRA2     PL     X6,CRA3     IF EOI 
          BX4    -X0*X1      NEXT TRACK 
          SA1    X4+B6
          EQ     CRA1        LOOP 
  
 CRA3     SX0    =C/ RSA NOT ON CHAIN./ 
          EQ     ERR         ABORT
 CTC      SPACE  4,15 
**        CTC - CHECK TERMINATION CONDITIONS. 
* 
*         EXIT   (X1) .NE. 0, IF TERMINATION CONDITIONS MET.
* 
*         USES   X - 1, 5, 6. 
*                A - 1, 5, 6. 
* 
*         PRESERVES  A2, X2.
* 
*         MACROS MESSAGE, RTIME.
  
  
 CTC2     MESSAGE  (=C/ REAL TIME DURATION TERMINATION./) 
          EQ     CTC4        SET RETURN STATUS
  
 CTC3     MESSAGE  (=C/ SENSE SWITCH ONE TERMINATION./) 
 CTC4     SX1    B1          INDICATE TERMINATION CONDITIONS MET
          SX6    B1 
          SA6    IS          SET INCOMPLETE/INACCURATE STATISTICS 
  
 CTC      SUBR               ENTRY/EXIT 
          SA1    ID          CHECK IDLE DOWN FLAG 
          NZ     X1,CTC4     IF OPERATOR IDLE DOWN REQUESTED
          SA1    B0 
          LX1    59-6        CHECK SENSE SWITCH ONE 
          NG     X1,CTC3     IF SENSE SWITCH ONE IS SET 
          SA5    TL 
          ZR     X5,CTC1     IF NO TIME LIMIT 
          RTIME  CTCB 
          SA1    CTCB 
          IX1    X5-X1
          NG     X1,CTC2     IF TIME TO QUIT
 CTC1     BX1    X1-X1       INDICATE TERMINATION CONDITIONS NOT MET
          EQ     CTCX        RETURN 
  
  
 CTCB     CON    0           CURRENT TIME STORAGE 
 CTE      SPACE  4,25 
**        CTE - CREATE AND INSERT TABLE ENTRY.
* 
*         ENTRY  (X1) = INDEX OF ENTRY BEFORE WHICH TO INSERT THE 
*                       NEW ENTRY.
*                (X2) = RSA OF THE SPACE ON THE CHAIN.
*                (X6) = LENGTH OF THE SPACE (AS IN PFC, W/O SS EOI).
* 
*         EXIT   NEW ENTRY CREATED, INSERTED INTO *TFRI*/*TFHL* TABLES. 
*                (X6) = ENTRY INSERTED. 
*                (HD) = UPDATED.
*                (LT) = UPDATED (*TFHL* TABLE MAY BECOME INACTIVE). 
*                TO *ERR* IF ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 1, 2, 3, 4, 6, 7.
*                B - 7. 
* 
*         CALLS  ZWT. 
* 
*         MACROS ADDWRD, MOVE.
  
  
 CTE4     SX0    =C/ INTERNAL ERROR, TAPE TABLE EMPTY IN CTE./
          EQ     ERR         ABORT
  
 CTE      SUBR               ENTRY/EXIT 
          SA3    F.TAPE 
          SA4    L.TAPE 
          ZR     X4,CTE4     IF *TAPE* TABLE EMPTY
          NG     X4,CTE4     IF *TAPE* TABLE EMPTY
          SX7    B1 
          IX7    X4-X7
          SA7    A4          NEW LENGTH OF TABLE
          SB7    X7 
          SA3    X3+B7       FETCH ENTRY
          MX0    -24
          BX2    -X0*X2      RSA
          BX7    X0*X3       *TFRI* ENTRY W/O RSA 
          BX7    X7+X2
          SA7    CTEA        NEW *TFRI* ENTRY 
          BX6    -X0*X6      LENGTH 
          LX6    -24
          BX6    X2+X6
          SA6    CTEB        *TFHL* ENTRY 
          BX6    X1 
          SA6    CTEC        INDEX
          BX1    X1-X1
          ADDWRD TFRI,X1     MAKE ROOM
          SA1    L.TFRI 
          SA2    F.TFRI 
          SA3    CTEC        INDEX
          IX1    X1-X3       LENGTH - OFFSET = WORDS TO MOVE
          IX3    X2+X3       FROM 
          MOVE   X1,X3,X3+B1
          SA1    F.TFRI 
          SA2    CTEC        INDEX
          SA3    CTEA        *TFRI* ENTRY 
          SB7    X2 
          BX6    X3 
          SA6    X1+B7       INSERT ENTRY 
          SA1    HD 
          SX6    X1-1 
          NG     X6,CTE1     IF LESS THAN ZERO
          SA6    A1 
 CTE1     SA1    LT 
          NZ     X1,CTE3     IF *TFHL* TABLE IS NOT ACTIVE
          BX1    X1-X1
          ADDWRD TFHL,X1     MAKE ROOM
          SA1    LT 
          ZR     X1,CTE2     IF *TFHL* TABLE IS STILL ACTIVE
          BX6    X6-X6
          SA6    L.TFHL      CLEAR LENGTH 
          EQ     CTE3        ZERO WORD TERMINATE *TFRI* TABLE 
  
 CTE2     SA1    L.TFHL 
          SA2    F.TFHL 
          SA3    CTEC        INDEX
          IX1    X1-X3       LENGTH - OFFSET = WORDS TO MOVE
          IX3    X2+X3       FROM 
          MOVE   X1,X3,X3+B1
          SA1    F.TFHL 
          SA2    CTEC        INDEX
          SA3    CTEB        *TFHL* ENTRY 
          SB7    X2 
          BX6    X3 
          SA6    X1+B7       INSERT ENTRY 
          SA1    HD 
          SX6    X1-1 
          NG     X6,CTE3     IF LESS THAN ZERO
          SA6    A1 
 CTE3     RJ     ZWT         ZERO WORD TERMINATE *TFRI* TABLE 
          SA1    CTEA 
          BX6    X1          EXIT CONDITION 
          EQ     CTEX        RETURN 
  
  
 CTEA     CON    0           NEW *TFRI* ENTRY 
 CTEB     CON    0           NEW *TFHL* ENTRY 
 CTEC     CON    0           INDEX BEFORE WHICH TO INSERT THE NEW ENTRY 
 DLK      SPACE  4,25 
**        DLK - DELINK TRACKS IN MIDDLE OF TRACK CHAIN. 
* 
*         ENTRY  (X3) = SECTOR LIMIT. 
*                (X4) = 36/0, 12/TRACK, 12/0 (OF HOLE). 
*                (X4) = 36/0, 12/TRACK, 12/SECTOR (OF HOLE).
*                (B7) = 48. 
*                (HE) = COLLECTION HOLE *TFRI* TABLE ENTRY. 
* 
*         EXIT   TRACKS DELINKED. 
*                *HL*, *EI* ADJUSTED BY NUMBER OF SECTORS DELINKED. 
*                RANDOM INDEXES OF REMAINING FILES AND HOLES
*                ADJUSTED BY NUMBER OF SECTORS DELINKED.
*                TO *ERR* IF ERROR. 
* 
*         CALLS  CRA. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 5, 6. 
*                B - 2, 6, 7. 
* 
*         MACROS SYSTEM.
  
  
 DLK      SUBR               ENTRY/EXIT 
          BX6    X4-X5
          NZ     X6,DLK1     IF FIRST TRACK OF HOLE NOT TO BE DELINKED
          SA5    HE          FIND TRACK BEFORE HOLE 
          SX7    B1 
          IX5    X5-X7
          RJ     CRA         CONVERT RANDOM ADDRESS 
 DLK1     SA1    EQ 
          LX2    X4,B7       FIRST TRACK
          LX1    36 
          SX6    X2-4000B    CLEAR TRACK BIT
          LX6    24 
          BX6    X1+X6
          SA1    CTIH        CURRENT TRACK IN HOLE
          SA2    LTIH        LAST TRACK IN HOLE 
          LX1    12 
          BX6    X2+X6
          BX6    X1+X6
          SA6    DLKA        12/,12/EQ,12/FT,12/NT,12/LT
          SA1    NC 
          NZ     X1,DLK2     IF NO CHANGES ARE TO BE MADE TO THE DEVICE 
          SYSTEM MPF,R,DLKA,2S6  DELINK TRACKS
 DLK2     SA1    CTIH        DELINK TRACKS IN TRT TABLE 
          LX2    X4,B7       FIRST TRACK
          BX6    X1 
          SA6    X2+B6       LINK FIRST TRACK TO LAST TRACK 
          SA1    NTIH        NUMBER OF TRACKS IN HOLE 
          SA2    DS          GET TRACKS DROPPED STATISTICS
          SX1    X1-1        ACTUAL TRACKS DELINKED 
          IX7    X1*X3       SECTORS DELINKED 
          LX7    30 
          IX6    X1+X7       MERGE TRACK COUNT WITH SECTOR COUNT
          IX6    X2+X6
          SA6    A2+
          LX7    -30
  
*         CORRECT RANDOM INDEXES DUE TO HOLE DELINK.
  
          MX0    -24
          SA1    EI          ADJUST EOI RANDOM INDEX
          IX6    X1-X7
          SA6    A1 
          SA1    HL          ADJUST HOLE LENGTH 
          IX6    X1-X7
          SA6    A1 
          SA3    LT          *TFHL ACTIVE* FLAG 
          SA1    L.TFRI      ADJUST ENTRIES IN FILE RANDOM INDEX TABLE
          SA2    F.TFRI 
          SB6    X1-1 
          SB7    X2+
          SA1    HE          RANDOM INDEX OF HOLE ENTRY 
          BX1    -X0*X1 
          BX4    X3 
          NZ     X4,DLK3     IF *TFHL* TABLE NOT ACTIVE 
          SA2    L.TFHL      TABLE MISMATCH CHECK 
          SB2    X2-1 
          SB2    B2-B6
          NZ     B2,DLK6     IF *TFRI*/*TFHL* TABLE LENGTHS MISMATCH
          SA2    F.TFHL      SET UP FOR THE *TFHL* TABLE
          SB2    X2+         FWA *TFHL* 
 DLK3     SA2    B6+B7       GET NEXT RANDOM INDEX TO ADJUST
          BX6    -X0*X2 
          IX6    X1-X6
          PL     X6,DLK5     IF ALL INDEXES ADJUSTED
          IX6    X2-X7
          SA6    A2 
          NZ     X4,DLK4     IF *TFHL* NOT ACTIVE 
          SA3    B6+B2       GET NEXT RANDOM INDEX FROM *TFHL*
          IX6    X3-X7
          SA6    A3+
          BX6    X2-X3       COMPARE ORIGINAL RSA-S 
          BX6    -X0*X6 
          NZ     X6,DLK6     IF *TFRI*/*TFHL* TABLES MISMATCH 
 DLK4     SB6    B6-1        DECREMENT INDEX
          GT     B6,DLK3     IF MORE FILES TO ADJUST
 DLK5     SA5    HE          RESET HOLE ADDRESS 
          RJ     CRA         CONVERT RANDOM ADDRESS 
          EQ     DLKX        RETURN 
  
 DLK6     SX0    =C* INTERNAL ERROR, TFRI/TFHL MISMATCH IN DLK.*
          EQ     ERR         ABORT
  
  
 DLKA     CON    0           *MPF* PARAMETER WORD 
 DRP      SPACE  4,15 
**        DRP - DROP TRACKS AT END OF TRACK CHAIN.
* 
*         ENTRY  (HE) = HOLE ENTRY AT END OF CHAIN. 
*                (X3) = SECTOR LIMIT. 
*                (X5) = 36/ 0, 12/ FIRST TRACK, 12/ SECTOR. 
* 
*         EXIT   TRACKS DROPPED.
*                (HL) = 0.
* 
*         USES   X - 0, 1, 2, 4, 6, 7.
*                A - 1, 4, 6, 7.
* 
*         MACROS SYSTEM.
  
  
 DRP      SUBR               ENTRY/EXIT 
          SA1    HE          ENTRY OF HOLE AT END OF CHAIN
          MX0    -24
          BX1    -X0*X1      RSA OF HOLE
          SA4    EQ 
          SX2    B1 
          MX0    -12
          IX7    X1-X2       RSA HOLE - 1 = FILE EOI = EOI OF CHAIN 
          BX4    -X0*X4 
          LX4    -12
          BX6    X4+X7
          SA6    DRPA        12/EQ, 24/, 24/EOI 
          SA1    EI          OLD EOI
          IX1    X1-X2       (EI WAS REALLY EOI+1)
          IX6    X1-X7       OLD RSA - NEW RSA = SECTORS DROPPED
          IX7    X7+X2       (EI REMAINS EOI+1) 
          SA7    A1          NEW EOI
          SX7    B1 
          BX1    X1-X1       FULL TRACKS DROPPED
          BX2    X6          SECTORS DROPPED
          BX4    -X0*X5      ISOLATE FIRST SECTOR OF HOLE 
          ZR     X4,DRP1     IF FIRST TRACK DROPPED IS A FULL TRACK 
          IX4    X3-X4
          IX2    X2-X4       REMOVE INCOMPLETE TRACK FROM SECTOR COUNT
 DRP1     ZR     X2,DRP2     IF NO TRACKS REMAINING 
          NG     X2,DRP2     IF NOT A COMPLETE TRACK REMAINING
          IX1    X1+X7       INCREMENT FULL TRACKS DROPPED COUNT
          IX2    X2-X3       DEBIT A TRACK OF SECTORS 
          EQ     DRP1        LOOP 
  
 DRP2     IX7    X1*X3       SECTORS DROPPED (FULL TRACKS)
          LX7    30 
          IX7    X7+X1
          SA1    DS          ADD TO DROPPED TRACK STATISTICS
          IX7    X7+X1
          SA7    A1 
          LX6    30          SECTORS RELEASED FROM THE IAPF CHAIN 
          SA1    HR          HOLES RELEASED 
          IX6    X1+X6
          SA6    A1 
          SX4    0S6         DROP TRACKS
          SA1    NC 
          NZ     X1,DRP3     IF NO CHANGES ARE TO BE MADE TO THE DEVICE 
          SYSTEM MPF,R,DRPA,X4
 DRP3     SX6    B0+         RESET HOLE LENGTH
          SA6    HL 
          EQ     DRPX        RETURN 
  
  
 DRPA     CON    0           *MPF* PARAMETER WORD 
 DTE      SPACE  4,20 
**        DTE - DELETE TABLE ENTRY. 
* 
*         ENTRY  (X4) = INDEX OF ENTRY TO BE DELEATED FROM
*                       *TFRI* AND *TFHL* TABLES. 
* 
*         EXIT   ENTRY DELETED FROM TABLES. 
* 
*         USES   X - 1, 3, 4, 6.
*                A - 1, 3, 4, 6.
*                B - 7. 
* 
*         CALLS  MTD, ZWT.
* 
*         MACROS ADDWRD, MEMORY, MOVE.
  
  
 DTE      SUBR               ENTRY/EXIT 
          SA3    F.TFRI      DELETE TABLE ENTRY OF SECOND HOLE
          BX6    X4 
          SB7    X4 
          SA6    DTEA        SAVE INDEX 
          SA1    X3+B7
          BX6    X1 
          SA6    DTEB        SAVE ENTRY TO BE DELETED 
          SA1    L.TFRI 
          SX6    X1-1 
          IX3    X3+X4
          SA6    A1          DECREMENT TABLE LENGTH 
          IX1    X1-X4       NUMBER OF WORDS TO MOVE
          MOVE   X1,X3+B1,X3
          SA3    HD          HOLES DELETED SINCE FL REDUCTION 
          SX6    X3+B1
          SA6    A3 
          SA3    LT 
          NZ     X3,DTE1     IF *TFHL* IS NOT ACTIVE
          SA3    F.TFHL      DELETE TABLE ENTRY OF SECOND HOLE
          SA4    DTEA 
          SA1    L.TFHL 
          SX6    X1-1 
          IX3    X3+X4
          SA6    A1          DECREMENT TABLE LENGTH 
          IX1    X1-X4       NUMBER OF WORDS TO MOVE
          MOVE   X1,X3+B1,X3
          SA3    HD          HOLES DELETED SINCE FL REDUCTION 
          SX6    X3+B1
          SA6    A3 
          SA1    DTEB 
          MX3    -24
          BX6    X3*X1       REMOVE RSA 
          MX1    10D
          BX6    -X1*X6      REMOVE FLAGS 
          MX1    2
          BX1    X1+X6       SET HOLE AND NON-ZERO BIT
          ADDWRD TAPE,X1     TABLE OF AVAILABLE PFC ENTRIES 
          SA3    HD 
          SX6    X3-1 
          SA6    A3 
 DTE1     SX6    X6-1000B 
          NG     X6,DTE2     IF NOT ENOUGH TO WARRANT FL REDUCTION
          RJ     MTD         MOVE TABLES DOWN 
          SA1    F.TFHL 
          SA3    L.TFHL 
          IX6    X1+X3
          SX6    X6+B1
          SA6    F.TEND 
          SX6    X3+10B      MORE FL THAN TELLING 
          MEMORY CM,,R,X6    REDUCE FL
          BX6    X6-X6
          SA6    HD          CLEAR HOLES DELETED SINCE FL REDUCTION 
 DTE2     RJ     ZWT         ZERO WORD TERMINATE *TFRI* TABLE 
          EQ     DTEX        RETURN 
  
  
 DTEA     CON    0           INDEX OF ENTRY TO REMOVE FROM TABLES 
 DTEB     CON    0           ENTRY TO BE DELETED
 FLT      SPACE  4,15 
**        FLT - FIND LAST TRACK OF HOLE.
* 
*         ENTRY  (X0) = -7777B. 
*                (X3) = SECTOR LIMIT. 
*                (X4) = 36/0, 12/TRACK, 12/0 (OF HOLE). 
*                (X5) = 36/0, 12/TRACK, 12/SECTOR (OF HOLE).
*                (B7) = 48. 
* 
*         EXIT   (X6) = 0 IF HOLE IS AT END OF TRACK CHAIN. 
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
  
  
 FLT      SUBR               ENTRY/EXIT 
          SA1    HL          HOLE LENGTH
          IX6    X5-X4       FIRST SECTOR OF HOLE 
          BX7    X1 
          SA6    FLTA        FIRST SECTOR 
          SA7    HSIT        HOLE SIZE
          MX7    0           NUMBER OF TRACKS 
          NZ     X6,FLT1     IF HOLE DOES NOT START IN FIRST SECTOR 
          SX7    B1          SET 1 POSSIBLE TRACK TO DELINK/DROP
 FLT1     LX6    X4,B7       STARTING TRACK 
          SA7    NTIH 
          SA6    CTIH 
  
*         FIND LAST TRACK OF HOLE.
  
 FLT2     SA1    CTIH        CURRENT TRACK
          SA2    X1+B6       NEXT TRACK 
          LX6    X2,B7
          NG     X6,FLT3     IF NOT END OF TRACK CHAIN
          SA1    FLTA        FIRST SECTOR OF HOLE IN CURRENT TRACK
          BX2    -X0*X2      CLEAR TAG
          IX6    X2-X1
          SA1    HSIT        HOLE SIZE IN TRACK 
          IX6    X1-X6       CALCULATE HOLE 
          SX6    X6-1        (X6) = 0 IF EOI IS AT END OF HOLE
          EQ     FLTX        RETURN 
  
*         CHECK FOR LAST TRACK OF HOLE. 
  
 FLT3     SA1    FLTA        FIRST SECTOR OF THIS TRACK 
          SA2    HSIT        LENGTH OF HOLE REMAINING 
          IX7    X3-X1       NUMBER OF SECTORS OF HOLE IN THIS TRACK
          IX6    X2-X7
          NG     X6,FLTX     IF END OF HOLE 
          MX7    0
          SA6    A2          LENGTH MINUS SECTOR THIS TRACK 
          SA7    A1+         FIRST SECTOR OF HOLE IN NEXT TRACK 
          SA1    NTIH        TRACK COUNT
          SA2    LTIH        LAST TRACK 
          SX6    X1+B1
          BX7    X2 
          SA6    A1+         NEW TRACK COUNT
          SA7    PTIH        PREVIOUS LAST TRACK
          SA1    CTIH        CURRENT TRACK
          SA2    X1+B6       NEXT TRACK 
          LX6    X1 
          BX7    -X0*X2 
          SA7    A1          NEW CURRENT TRACK
          SA6    LTIH        NEW LAST TRACK 
          EQ     FLT2        FIND END OF HOLE 
  
  
 FLTA     CON    0           FIRST SECTOR OF HOLE IN CURRENT TRACK
 FPI      SPACE  4,20 
**        FPI - FORMAT PFC INFORMATION. 
* 
*         *FPI* WILL FORMAT FOR OUTPUT THE INFORMATION DESCRIBING 
*         THE LOCATION OF A PARTICULAR PFC ENTRY. 
* 
*         ENTRY  (X1) = *TFRI* TABLE ENTRY. 
*                (B7) = FIRST CHARACTER OF SEQUENCE FOR *SNM*.
*                (B5) = ADDRESS OF MESSAGE FOR *SNM*. 
* 
*         EXIT   MESSAGE FORMATTED. 
* 
*         USES   X - 1, 2, 5, 6.
*                A - 1. 
*                B - 2, 7.
* 
*         CALLS  COD, SNM.
  
  
 FPI      SUBR               ENTRY/EXIT 
          BX5    X1 
          LX1    -42
          MX2    -8 
          BX1    -X2*X1 
          SB2    X1          CATALOG TRACK INDEX
          SA1    F.TCAT 
          SA1    X1+B2       FSE FOR CATALOG TRACK
          LX1    -36
          MX2    -12
          BX1    -X2*X1      TRACK
          RJ     COD         CONVERT TRACK
          MX1    4*6
          LX6    6*6
          BX1    X1*X6
          SB2    B7 
          RJ     SNM         SET TRACK IN MESSAGE 
          SB7    B7+B1
          BX1    X5 
          LX1    -27
          MX2    -12
          BX1    -X2*X1      SECTOR 
          SX2    B1 
          LX2    13 
          BX1    X1+X2       PROVIDE LEADING ZEROS
          RJ     COD         CONVERT SECTOR 
          MX1    4*6
          LX6    6*6
          BX1    X1*X6
          SB2    B7 
          RJ     SNM         SET SECTOR IN MESSAGE
          SB7    B7+B1
          BX1    X5 
          LX1    -24
          MX2    -3 
          BX1    -X2*X1      PFC ORDINAL IN EIGHT WORD PARCELS
          AX1    1           PFC ORDINAL IN SIXTEEN WORD PARCELS
          RJ     COD         CONVERT ORDINAL
          MX1    1*6
          LX6    9*6
          BX1    X1*X6
          SB2    B7 
          RJ     SNM         SET ORDINAL IN MESSAGE 
          EQ     FPIX        RETURN 
 FRM      SPACE  4,15 
**        FRM - FORMAT HOLES RELEASED STATISTICAL MESSAGE.
* 
*         ENTRY  (A0) = ADDRESS OF MESSAGE. 
* 
*         EXIT   MESSAGE FORMATTED. 
* 
*         USES   X - 0, 1, 2, 3, 5, 6.
*                A - 1, 2, 6. 
* 
*         CALLS  CDD. 
  
  
 FRM      SUBR               ENTRY/EXIT 
          SA1    HR          HOLES FREED
          SX5    1R          POSITIVE VALUE SIGN
          SA2    HC          HOLES CREATED
          BX0    X1          SAVE SECTOR COUNT
          MX6    -30
          BX1    -X6*X1      NUMBER 
          IX1    X1-X2       FREED MINUS CREATED
          PL     X1,FRM1     IF POSITIVE VALUE
          SX5    1R-         NEGATIVE VALUE SIGN
          BX1    -X1         COMPLEMENT 
 FRM1     RJ     CDD
          SA1    A0+B1       MMBXXXXXXX 
          MX3    18 
          BX1    X3*X1       MMB....... 
          BX6    -X3*X6      ...NNNNNNN 
          BX6    X6+X1       MMBNNNNNNN 
          MX1    -6 
          LX1    B2          POSITION MASK
          LX5    B2          POSITION SIGN
          BX6    X1*X6       REMOVE CHARACTER 
          IX6    X6+X5       INSERT SIGN
          SA6    A1 
          MX6    -30
          LX0    30 
          BX1    -X6*X0      NUMBER OF SECTORS
          RJ     CDD
          SX1    1R,-1R 
          LX1    -6 
          IX6    X6+X1
          SA6    A6+B1
          EQ     FRMX        RETURN 
 FSM      SPACE  4,15 
**        FSM - FORMAT STATISTICAL MESSAGE. 
* 
*         ENTRY  (A0) = ADDRESS OF MESSAGE. 
*                (X1) = 30/ SECTORS,30/ N.
* 
*         EXIT   MESSAGE FORMATTED. 
* 
*         USES   X - 0, 1, 3, 6.
*                A - 1, 6.
* 
*         CALLS  CDD. 
  
  
 FSM      SUBR               ENTRY/EXIT 
          BX0    X1          SAVE SECTOR COUNT
          MX6    -30
          BX1    -X6*X1      NUMBER 
          RJ     CDD
          SA1    A0+B1       MMBXXXXXXX 
          MX3    18 
          BX1    X3*X1       MMB....... 
          BX6    -X3*X6      ...NNNNNNN 
          BX6    X6+X1       MMBNNNNNNN 
          SA6    A1 
          MX6    -30
          LX0    30 
          BX1    -X6*X0      NUMBER OF SECTORS
          RJ     CDD
          SX1    1R,-1R 
          LX1    -6 
          IX6    X6+X1
          SA6    A6+B1
          EQ     FSMX        RETURN 
 IOM      SPACE  4,20 
**        IOM - ISSUE OVERLAP MESSAGE.
* 
*         *IOM* WILL ISSUE A MESSAGE INFORMING THE USER THAT
*         AN OVERLAP HAS BEEN DETECTED. 
* 
*         ENTRY  (B2) = INDEX OF THE FIRST ENTRY WHICH OVERLAPS.
* 
*         EXIT   MESSAGE ISSUED.
* 
*         USES   X - 1, 2, 3, 6, 7. 
*                A - 1, 2, 3, 6, 7. 
*                B - 5, 7.
* 
*         CALLS  FPI. 
* 
*         MACROS MESSAGE, MOVE. 
  
  
 IOM      SUBR               ENTRY/EXIT 
          SA1    F.TFRI 
          SA2    X1+B2
          SA3    A2+B1
          BX6    X2 
          BX7    X3 
          SA6    IOMA 
          SA7    IOMB 
          MOVE   IOMCL,IOMC,IOMD
          SA1    IOMA 
          SB7    1R(
          SB5    IOMD 
          RJ     FPI
          SA1    IOMB 
          SB7    1R[
          SB5    IOMD 
          RJ     FPI
          MESSAGE IOMD
          EQ     IOMX        RETURN 
  
  
 IOMA     DATA   0
 IOMB     DATA   0
 IOMC     DATA   C* ENTRY OVERLAP ((((/))))/$, [[[[/]]]]/%.*
 IOMCL    EQU    *-IOMC 
 IOMD     BSS    IOMCL
 IRS      SPACE  4,15 
**        IRS - ISSUE RESOURCE SUMMARY MESSAGES TO DAYFILE. 
* 
*         USES   X - 0, 1, 2, 3, 6. 
*                A - 1, 2, 6. 
* 
*         CALLS  CDD, CFD, COD. 
* 
*         MACROS MESSAGE, STIME, TIME.
  
  
 IRS      SUBR               ENTRY/EXIT 
          STIME  ES 
          TIME   ET 
          SA1    ES          END SRU-S
          SA2    SS          START SRU-S
          IX6    X1-X2
          MX0    -36
          BX1    -X0*X6 
          RJ     CFD         CONVERT TO F10.3 FORMAT
          SA6    IRSA+2      SET SRU-S CONSUMED 
          SA1    ET          END CPU TIME 
          SA2    ST          START CPU TIME 
          IX6    X1-X2
          MX0    -12
          BX1    -X0*X6      MILLISECONDS 
          SX3    1000D
          LX6    -12
          MX0    -24
          BX2    -X0*X6      SECONDS
          IX6    X2*X3       SECONDS*1000 
          IX1    X6+X1       (SECONDS*1000)+MILLISECONDS
          RJ     CFD         CONVERT TO F10.3 FORMAT
          SA6    IRSB+2      SET CPU TIME USED
          SA1    TOVC 
          RJ     COD         CONVERT TO OCTAL DISPLAY 
          SA6    IRSC+2      SET MAXIMUM CM FL USED 
          SA1    /COMCMTP/ATSA
          RJ     CDD         CONVERT TO DECIMAL DISPLAY 
          SA6    IRSD+2      SET MANAGED TABLE MOVES
          MESSAGE  IRSA      * SRUS                23456.890 UNTS.* 
          MESSAGE  IRSB      * CPU SECONDS         23456.890 SECS.* 
          MESSAGE  IRSC      * MAXIMUM CM FL       234567890  SCM.* 
          MESSAGE  IRSD      * MANAGED TABLE MOVES 234567890 UNTS.* 
          EQ     IRSX        RETURN 
  
  
 IRSA     DATA   36C SRUS                23456.890 UNTS.
 IRSB     DATA   36C CPU SECONDS         23456.890 SECS.
 IRSC     DATA   36C MAXIMUM CM FL       23456.890  SCM.
 IRSD     DATA   36C MANAGED TABLE MOVES 23456.890 UNTS.
 ISD      SPACE  4,15 
**        ISD - ISSUE STATISTICS TO DAYFILE.
* 
*         ENTRY  (X0) = 0 IF NORMAL TERMINATION.
*                (X0) = 1 IF ABNORMAL TERMINATION.
* 
*         USES   X - 1. 
*                A - 0, 1.
* 
*         CALLS  FRM, IRS, ISM. 
* 
*         MACROS MESSAGE. 
  
  
 ISD      SUBR               ENTRY/EXIT 
          SA1    PC          CHECK IF PRESET COMPLETE 
          ZR     X1,ISDX     IF PRESET NEVER COMPLETED
          SA1    IS          INCOMPLETE/INACCURATE STATISTICS FLAG
          BX0    X0+X1
          ZR     X0,ISD1     IF NORMAL TERMINATION
          MESSAGE  (=C/ STATISTICS MAY NOT BE ACCURATE./),,R
 ISD1     SA1    OF          ONSET FILES
          SA0    ISDI 
          RJ     ISM
          SA1    OH          ONSET HOLES
          SA0    ISDJ 
          RJ     ISM
          SA1    JM          FILES MOVED VIA THE FILL TECHNIQUE 
          SA0    ISDA 
          RJ     ISM
          SA1    SM          FILES MOVED VIA THE SLIDE TECHNIQUE
          SA0    ISDB 
          RJ     ISM
          SA1    DM          FILES MOVED
          SA0    ISDC 
          RJ     ISM
          SA1    LS          LOST SPACE 
          SA0    ISDD 
          RJ     ISM
          SA1    HS          HOLES REMAINING
          SA0    ISDE 
          RJ     ISM
          SA0    ISDF 
          RJ     FRM         FORMAT HOLES REMOVED MESSAGE 
          MESSAGE A0
          SA1    DS          DROPPED TRACKS SPACE 
          SA0    ISDG 
          RJ     ISM
          SA1    FW          FLAW FILES ENCOUNTERED 
          SA0    ISDH 
          RJ     ISM
          RJ     IRS         ISSUE RESOURCE SUMMARY 
          EQ     ISDX        RETURN 
  
  
 ISDI     DATA   36C ONSET FILES       ,           PRUS.
 ISDJ     DATA   36C ONSET HOLES       ,           PRUS.
 ISDA     DATA   36C FILL MOVES        ,           PRUS.
 ISDB     DATA   36C SLIDE MOVES       ,           PRUS.
 ISDC     DATA   36C FILES MOVED       ,           PRUS.
 ISDD     DATA   36C LOST SPACE        ,           PRUS.
 ISDE     DATA   36C HOLES LEFT        ,           PRUS.
 ISDF     DATA   36C HOLES FREED       ,           PRUS.
 ISDG     DATA   36C TRACKS FREED      ,           PRUS.
 ISDH     DATA   36C FLAW SPACE        ,           PRUS.
 ISM      SPACE  4,15 
**        ISM - ISSUE STATISTICAL MESSAGE.
* 
*         ENTRY  (A0) = ADDRESS OF MESSAGE. 
*                (X1) = 30/ SECTORS,30/ N.
* 
*         EXIT   MESSAGE ISSUED.
* 
*         CALLS  FSM. 
* 
*         MACROS MESSAGE. 
  
  
 ISM      SUBR               ENTRY/EXIT 
          RJ     FSM         FORMAT STATISTIC MESSAGE 
          MESSAGE A0
          EQ     ISMX        RETURN 
 MSG      SPACE  4,20 
**        MSG - ISSUE MESSAGE.
* 
*         ENTRY  (X0) = ADDRESS OF MESSAGE. 
*                MUST BE TERMINATED WITH A ZERO BYTE IN BITS 11-0.
* 
*         EXIT   MESSAGE TO B DISPLAY (LINE ONE). 
*                *B* DISPLAY MESSAGE IN *K* DISPLAY UPDATED.
* 
*         USES   X - 0, 1, 3, 4, 6. 
*                A - 1, 4, 6. 
*                B - 2, 3, 4. 
* 
*         PRESERVES  A0, X2.
* 
*         CALLS  ZTB. 
* 
*         MACROS MESSAGE. 
  
  
 MSG      SUBR               ENTRY/EXIT 
          SA1    MSGA 
          BX3    X1-X0
          BX6    X0 
          ZR     X3,MSGX     IF SAME MESSAGE
          SA6    A1 
          MESSAGE X0,1
  
*         MOVE CURRENT *B* DISPLAY MESSAGE TO THE *K* DISPLAY.
  
          SB4    B0          ZERO BYTE FLAG 
          SB3    5           MAXIMUM WORDS TO TRANSFER TO *K* DISPLAY 
          SB2    B0          ADDRESS OFFSET 
          MX4    -12
          SA1    MSGA        ADDRESS OF CURRENT MESSAGE 
          SX0    X1          SOURCE BASE ADDRESS
 MSG1     SA1    X0+B2
          BX6    -X4*X1 
          NZ     X6,MSG2     IF NOT ZERO BYTE 
          SB4    B1+         SET ZERO BYTE ENCOUNTERED FLAG 
          SA4    =10H 
 MSG2     RJ     ZTB
 MSG3     SA6    KDLS=+B2    STORE WORD IN *K* DISPLAY BUFFER 
          SB2    B2+B1
          GE     B2,B3,MSGX  IF ALL WORDS PROCESSED 
          EQ     B4,B0,MSG1  IF NO ZERO BYTE ENCOUNTERED
          BX6    X4          BLANKS 
          EQ     MSG3        BLANK FILL 
  
  
 MSGA     CON    =0          INITIALLY THE ADDRESS OF A ZERO WORD 
 PCH      SPACE  4,20 
**        PCH - PURGE CONTIGUOUS HOLES. 
* 
*         ENTRY  (A1,X1) = HOLE ENTRY.
*                (A2,X2) = NEXT CONTIGUOUS ENTRY. 
*                (PCHA) = -1 IFF THE COLLECTION HOLE IS CLOSED. 
* 
*         EXIT   (A1,X1) = ORIGINAL HOLE ENTRY. 
*                (A2,X2) = ENTRY AFTER LAST CONTIGUOUS HOLES. 
*                CONTIGUOUS HOLES PURGED FROM CATALOG.
*                ALL BUT FIRST HOLE REMOVED FROM TABLE. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 3, 4, 6. 
*                B - 2. 
* 
*         CALLS  CIP, DTE, MSG, RCE, WCE. 
  
  
 PCH      SUBR               ENTRY/EXIT 
          SA3    PCHA        CHECK IF FIRST HOLE ALREADY SEEN 
          MX4    -24
          BX3    X1-X3
          BX3    X4*X3
          ZR     X3,PCH1     IF ALREADY PROCESSED 
          BX6    X1 
          SA6    PCHA        REMEMBER THIS ONE
          SX5    A1+         SAVE (A1)
          RJ     RCE         PURGE FIRST HOLE 
          SA1    A0+FCBS
          SX6    1S11 
          BX6    X6+X1       SET DAPF BIT 
          SA6    A1+
          RJ     WCE
          SA1    X5+         RESTORE (A1) AND (X1)
          SA2    X5+B1       RESTORE (A2) AND (X2)
 PCH1     PL     X2,PCHX     IF NOT CONTIGUOUS HOLE 
          SA1    HR 
          SX6    B1 
          IX6    X6+X1
          SA6    A1+
          SX0    =C/ PURGING CONTIGUOUS HOLES./ 
          RJ     MSG
          BX1    X2          PURGE NEXT HOLE
          RJ     RCE
          SA1    A0+FCBS
          SX6    1S11 
          BX6    X1+X6
          SA6    A1+
          RJ     CIP         CLEAR IRRELEVANT INFORMATION 
          RJ     WCE
          SA4    IX          ESTABLISH (IX) AS ENTRY TO DELETE
          RJ     DTE         DELETE TABLE ENTRY 
          SA4    IX          RE-ESTABLISH LOCATION IN TABLE 
          SB2    X4 
          SA3    F.TFRI 
          SA2    X3+B2       NEXT HOLE/FILE ENTRY 
          SA1    A2-B1       OLD HOLE ENTRY 
          EQ     PCH1        LOOP FOR NEXT ENTRY
  
  
 PCHA     CON    -1          FIRST HOLE FROM LAST CALL
 RCE      SPACE  4,15 
**        RCE - READ CATALOG ENTRY. 
* 
*         ENTRY  (X1) = *TFRI* ENTRY OF CATALOG ENTRY.
* 
*         EXIT   (A0) = ADDRESS OF CATALOG ENTRY. 
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                A - 0, 1, 2, 6, 7. 
*                B - 2. 
* 
*         MACROS CALLPFU, RECALL, RETURN, RPHR. 
  
  
 RCE      SUBR               ENTRY/EXIT 
          BX0    X1 
          SA2    RCEB 
          BX4    X2-X1
          RECALL C
          MX3    15+8 
          LX3    -1-1-8 
          BX4    X3*X4
          NZ     X4,RCE1     IF DIFFERENT PRU 
          SA1    C+1
          SA2    RCEC 
          IX6    X1+X2
          SX6    X6 
          SX7    X1 
          SA6    A1+B1       INCREMENT IN 
          SA7    A6+B1       RESET OUT
          LX0    36 
          EQ     RCE4        SET CATALOG ENTRY ADDRESS
  
 RCE1     BX6    X0 
          SA6    RCEB 
          LX0    5-47 
          MX3    8
          LX3    -1-1-8 
          BX4    X3*X4
          ZR     X4,RCE2     IF SAME CATALOG TRACK
          RETURN C,R
          SA1    F.TCAT 
          MX2    -8 
          BX3    -X2*X0      CATALOG TRACK NUMBER 
          SB2    X3 
          SX3    X3-MXCT
          PL     X3,RCE5     IF ANCHOR ENTRY REFERENCE
          SA1    X1+B2       FST FOR THIS CATALOG TRACK 
          BX7    X1 
          SA7    C+FTPM 
          CALLPFU  C,CTOP,R  OPEN CATALOG TRACK 
 RCE2     LX0    47-5-27
          MX4    -15
          BX6    -X4*X0      CATALOG ENTRY PRU
          SA6    C+6
          SA6    RCEA        SAVE CURRENT ADDRESS 
          NZ     X6,RCE3     IF NOT PRU 0 
          CALLPFU  C,CTRC,R  REWIND CATALOG FILE
 RCE3     SA1    C+1
          SX6    X1 
          SA6    A1+B1       SET IN = OUT = FIRST 
          SA6    A6+B1
          RPHR   A1-B1,R
          SA1    C+3
          SA2    A1-1 
          IX6    X2-X1       WORDS IN PRU READ
          SA6    RCEC 
          LX0    3
 RCE4     MX4    -3 
          BX3    -X4*X0 
          LX3    3
          IX3    X3+X1
          SA0    X3          SET CATALOG ENTRY ADDRESS
          EQ     RCEX        RETURN 
  
 RCE5     SX0    =C/ INTERNAL ERROR, ANCHOR ENTRY REFERENCE IN RCE./
          EQ     ERR         ABORT
  
  
 RCEA     CON    0           CURRENT PRU RSA
 RCEB     CON    -1          LAST CALL TO *RCE* 
 RCEC     CON    0           NUMBER OF WORDS IN PRU 
 RJA      SPACE  4,20 
**        RJA - RETURN JUMP TRACE ACTIVATION/DEACTIVATION.
* 
*         THIS ROUTINE ACTIVATES OR DEACTIVATES THE RETURN JUMP 
*         TRACE INSTRUCTIONS.  THIS IS ACCOMPLISHED BY SHIFTING 
*         EACH RJ INSTRUCTION WORD BY 30 BITS.
*         30/RJ SUB, 30/RJ RJT   TO/FROM   30/RJ RJT, 30/RJ SUB 
* 
*         ENTRY  (X1) = 0, DEACTIVATE RJ TRACE. 
*                (X1) = 1, ACTIVATE RJ TRACE. 
* 
*         EXIT   INSTRUCTIONS MODIFIED, STACK VOIDED. 
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2, 6. 
*                B - 2, 3.
* 
*         MACROS ALLOC, VOID. 
  
  
 RJA6     VOID               VOID ALL TYPES OF INSTRUCTION STACKS 
  
 RJA      SUBR               ENTRY/EXIT 
          SA2    RJAA 
          ZR     X1,RJA3     IF DEACTIVATE REQUEST
          NZ     X2,RJA6     IF RJ TRACE ALREADY ACTIVE 
          SA1    L.TRJH      LENGTH 
          NZ     X1,RJA1     IF TABLE ALREADY ALLOCATED 
          ALLOC  TRJH,TRJHL  ALLOCATE RJ TRACE BUFFER 
 RJA1     SA1    F.TRJH      CLEAR RJ HISTORY BUFFER
          SA2    L.TRJH 
          SX6    B1          INITIAL *IN* 
          SA6    X1 
          SB3    X2 
          BX6    X6-X6
          SB2    B1          SKIP *IN* POINTER STORAGE
 RJA2     SA6    X1+B2
          SB2    B2+B1
          LT     B2,B3,RJA2  IF MORE ADDRESSES IN BUFFER
          SX6    B1 
          EQ     RJA4        SET NEW RJ TRACE STATE 
  
 RJA3     ZR     X2,RJA6     IF RJ TRACE ALREADY INACTIVE 
          SX6    B0 
 RJA4     SA6    RJAA        SET NEW RJ TRACE STATE 
          SB2    30 
          SA1    RJAT-1      PRESET (A1)
 RJA5     SA1    A1+B1       NEXT ENTRY 
          ZR     X1,RJA6     IF END OF TABLE
          SA2    X1          FETCH INSTRUCTION WORD 
          LX6    X2,B2       REVERSE RJ INSTRUCTIONS
          SA6    A2 
          EQ     RJA5        LOOP 
  
  
 RJAA     CON    0           RJ TRACE STATE, 0=INACTIVE, 1=ACTIVE 
 RLS      SPACE  4,20 
**        RLS - RECLAIM LOST SPACE. 
* 
*         IF (IX) POINTS TO A HOLE ENTRY THEN THE LOST SPACE IS MERGED
*         WITH THAT HOLE, ELSE A NEW HOLE IS CREATED IF THE LOST SPACE
*         IS AT LEAST THREE PRUS (SS+DATA+EOI), OTHERWISE THE LOST
*         SPACE IS LEFT AS LOST SPACE.
* 
*         ENTRY  (IX) = INDEX OF NEXT ENTRY.
*                (IX)-1 = FILE INDEX. 
*                (X6) = FILE LENGTH.
*                (X7) = LOST SPACE FOLLOWING THE FILE.
* 
*         EXIT   (LS) = UPDATED.
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2. 
* 
*         CALLS  CIP, CRA, CTE, RCE, WCE. 
  
  
*         UPDATE STATISTICS.
  
 RLS3     SA1    LS          LOST SPACE 
          SA2    RLSA        SPACE
          SX6    B1 
          LX2    30 
          IX6    X6+X2
          IX6    X6+X1
          SA6    A1          UPDATE LOST SPACE
  
 RLS      SUBR               ENTRY/EXIT 
          SA7    RLSA        LOST SPACE FOLLOWING FILE
          SA4    F.TFRI 
          SA1    IX 
          SA3    L.TFRI 
          SB2    X1+
          IX3    X1-X3
          SA2    X4+B2
          PL     X3,RLS2     IF PAST END OF TABLE 
          PL     X2,RLS2     IF FILE OR EOI FOLLOWS LOST SPACE
  
*         MERGE THE LOST SPACE WITH THE HOLE FOLLOWING IT.
  
          MX0    -24
          BX7    -X0*X7 
          IX6    X2-X7       BACK UP THE RSA OF THE HOLE
          SA6    A2          REWRITE *TFRI* ENTRY 
          SA3    LT 
          NZ     X3,RLS1     IF *TFHL* TABLE IS NOT ACTIVE
          SA3    F.TFHL 
          SA3    X3+B2
          IX6    X3-X7       BACK UP THE RSA OF THE HOLE
          LX7    -24
          IX6    X6+X7       INCREASE THE LENGTH
          LX7    24 
          SA6    A3          REWRITE THE *TFHL* ENTRY 
 RLS1     SA5    A2          *TFRI* ENTRY 
          RJ     CRA         CONVERT RANDOM ADDRESS 
          SA1    A2 
          RJ     RCE         READ CATALOG ENTRY 
          SA1    A0+FCLF
          SA4    RLSA        LOST SPACE LENGTH
          LX4    -24
          IX6    X1+X4       INCREASE THE HOLE SIZE 
          SA6    A1 
          SA1    A0+FCBT
          MX0    36 
          BX6    X0*X1
          BX5    -X0*X5 
          BX6    X6+X5       SET NEW ADDRESS OF HOLE
          SA6    A1 
          RJ     WCE         WRITE CATALOG ENTRY
          EQ     RLSX        RETURN 
  
*         CREATE AN ENTRY FOR THE LOST SPACE. 
  
 RLS2     SX4    B1+B1
          IX3    X4-X7
          PL     X3,RLS3     IF SMALLER THAN ABSOLUTE MINIMUM 
          SA3    L.TAPE 
          ZR     X3,RLS3     IF *TAPE* TABLE EMPTY
          NG     X3,RLS3     IF *TAPE* TABLE EMPTY
          SA2    A2-B1       ENTRY OF FILE PRECEDING LOST SPACE 
          IX2    X2+X6       FILE RSA + FILE LENGTH 
          IX2    X2+X4       FILE RSA + FILE LENGTH + SS + EOI
          IX6    X7-X4       LENGTH OF THE HOLE (LOST SPACE - SS - EOI) 
          RJ     CTE         CREATE TABLE ENTRY 
          SA6    RLSB        SAVE *TFRI* ENTRY
          BX5    X6 
          RJ     CRA         CONVERT RANDOM ADDRESS 
          SA1    RLSB 
          RJ     RCE         READ CATALOG ENTRY 
          SA1    A0+FCBT
          MX0    36 
          BX6    X0*X1
          BX5    -X0*X5 
          BX7    X6+X5
          SA7    A1          SET THE ADDRESS OF THE HOLE
          SA1    A0+FCLF
          SA4    RLSA        LOST SPACE 
          SX0    B1+B1
          IX4    X4-X0       LOST SPACE - SS - EOI
          MX0    24 
          LX4    -24
          BX4    X0*X4
          BX6    -X0*X1 
          BX6    X6+X4
          SA6    A1          SET LENGTH OF HOLE 
          RJ     CIP         CLEAR IRRELEVANT INFORMATION 
          RJ     WCE         WRITE CATALOG ENTRY
          EQ     RLSX        RETURN 
  
  
 RLSA     CON    0           LOST SPACE FOLLOWING FILE
 RLSB     CON    0           *TFRI* ENTRY RETURNED FROM *CTE* 
 RSS      SPACE  4,15 
**        RSS - REMOVE *SSST* STATUS FROM DUMP FILES. 
* 
*         EXIT   *SSST* STATUS REMOVED FROM SPECIFIED FILES.
* 
*         USES   X - 1, 2, 6. 
*                A - 1, 2, 6. 
*                B - 7. 
* 
*         MACROS RECALL, SETFS, STATUS. 
  
  
 RSS      SUBR               ENTRY/EXIT 
          SB7    RSSA-1      FILE LIST MINUS ONE
 RSS1     RECALL S
          SB7    B7+B1
          SA1    B7          42/0LLFN,18/3
          ZR     X1,RSS2     IF END OF FILE NAME LIST 
          BX6    X1 
          SA6    S           SET SCRATCH FET+0
          STATUS S,P
          SA2    S+5         GET FNT
          MX1    -6 
          BX2    -X1*X2      GET FILE STATUS
          SX1    X2-SSST
          NZ     X1,RSS1     IF PRIOR OUTPUT ID 
          SETFS  S,0         CLEAR FILE STATUS
          EQ     RSS1        LOOP 
  
 RSS2     RECALL S
          SX6    3
          SA6    S           CLEAR SCRATCH FET
          EQ     RSSX        RETURN 
  
  
 RSSA     VFD    42/0LOUTPUT,18/3 
          VFD    42/0LZZZZDMB,18/3
          CON    0
 TOV      SPACE  4,15 
**        TOV - TABLE OVERFLOW PROCESSOR. 
* 
*         ENTRY  (B5) = -AMOUNT OF MEMORY NEEDED. 
*                (B6) = RETURN ADDRESS. 
* 
*         EXIT   TO *ERR* IF UNABLE TO OBTAIN MEMORY. 
* 
*         USES   X - 0, 1, 2, 6.
*                A - 1, 2, 6. 
* 
*         MACROS MEMORY, MESSAGE. 
  
  
 TOV      BSS    0           ENTRY
          SX6    -B5
          SA1    F.TEND 
          IX6    X6+X1       CM REQUIRED TO SATISFY TABLES
          SX1    10B         INSURANCE
          IX6    X6+X1       REQUIRED + INSURANCE 
          SA2    TOVD        MAXIMUM CM FOR CURRENT JOB STEP
          IX1    X6-X2
          PL     X1,TOV3     IF JOB MAXIMUM IS INSUFFICIENT 
          SX1    3000B       DESIRED CM INCREMENT ABOVE REQUIREMENT 
          IX6    X6+X1       REQUIRED + INSURANCE + INCREMENT 
          IX1    X6-X2
          NG     X1,TOV1     IF JOB MAXIMUM IS SUFFICIENT 
          BX6    X2          REQUEST THE MAXIMUM CM ALLOWED 
 TOV1     SA6    TOVA        CM FL REQUESTED
          LX6    30 
          SA6    TOVB        *STAT* FOR MEMORY MACRO
          MEMORY CM,TOVB,R,,NA
          SA1    TOVB        FL OBTAINED
          BX6    X1 
          SA1    TOVC        PREVIOUS MAXIMUM FL
          AX6    30 
          IX1    X1-X6       OLD - NEW
          PL     X1,TOV2     IF NOT NEW MAXIMUM 
          SA6    A1 
 TOV2     SA1    TOVA        REQUESTED FL 
          IX1    X6-X1
          NG     X1,TOV3     IF CM FL NOT OBTAINED
          SX6    X6-10B      CM FL MINUS INSURANCE
          SA6    F.TEND      NEW END OF MANAGED TABLES
          JP     B6          RE-ENTER PROCESSOR 
  
 TOV3     SA1    L.TAPE      CHECK THE *TAPE* TABLE SIZE
          ZR     X1,TOV4     IF NO SPACE TO RELEASE 
          BX6    X6-X6
          SA6    A1          SET *TAPE* TABLE SIZE TO ZERO
          JP     B6          RE-ENTER PROCESSOR 
  
 TOV4     SA1    LT          CHECK IF *TFHL* TABLE IS ACTIVE
          NZ     X1,TOV5     IF *TFHL* IS NOT ACTIVE
          SX6    1
          SA6    LT          SET *TFHL* NOT ACTIVE
          MESSAGE  (=C* TFHL TABLE DEACTIVATED.*) 
          SX6    B0+
          SA6    L.TFHL      SET LENGTH OF *TFHL* TABLE TO ZERO 
          JP     B6          RE-ENTER PROCESSOR 
  
 TOV5     SX0    =C* TABLE OVERFLOW, UNABLE TO OBTAIN REQUIRED MEMORY.* 
          EQ     ERR         ABORT
  
  
 TOVA     CON    0           MEMORY REQUESTED 
 TOVB     CON    0           MEMORY MACRO STAT WORD 
 TOVC     CON    0           MAXIMUM FIELD LENGTH OBTAINED
 TOVD     CON    0           MAXIMUM CM FOR CURRENT JOB STEP
 UFE      SPACE  4,10 
**        UFE - UPDATE FILE ENTRY.
* 
*         ENTRY  (HE) = HOLE *TFRI* TABLE ENTRY.
*                (FE) = FILE *TFRI* TABLE ENTRY.
*                (FS) = FILE SIZE FROM PFC ( + 1 FOR SS). 
* 
*         EXIT   FILE CATALOG ENTRY UPDATED.
*                TABLE ENTRIES UPDATED AND EXCHANGED. 
*                TO *ERR* IF ERROR. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
* 
*         CALLS  CRA, RCE, WCE. 
  
  
 UFE      SUBR               ENTRY/EXIT 
          SA5    HE          HOLE ENTRY 
          RJ     CRA         GET FILE ADDRESS 
          SA1    FE          FILE ENTRY 
          RJ     RCE         READ FILE CATALOG ENTRY
          SA1    A0+FCBT
          MX0    36 
          BX6    X0*X1
          BX5    -X0*X5 
          BX7    X6+X5       SET NEW ADDRESS OF FILE
          SA7    A1 
          RJ     WCE
          SA1    F.TFRI 
          SA2    IX 
          IX1    X2+X1
          SA2    X1 
          SA1    A2-1 
          SA3    FS 
          MX4    -24
          BX5    X4*X2
          BX7    -X4*X1 
          BX7    X5+X7
          SX6    B1 
          IX6    X3+X6
          IX6    X1+X6
          SA6    A2          NEW HOLE ENTRY 
          SA7    A1          NEW FILE ENTRY 
          SA3    LT 
          NZ     X3,UFEX     IF *TFHL* IS NOT ACTIVE
          SA3    F.TFHL      EXCHANGE RSA-S IN *TFHL* 
          SA4    IX 
          IX3    X4+X3
          SA4    X3          IX ENTRY 
          SA3    A4-B1       IX-1 ENTRY 
          BX1    X7-X3       CHECK IF *TFRI*/*TFHL* MATCH (NEW F OLD H) 
          MX2    -24
          BX1    -X2*X1 
          SX0    =C* INTERNAL ERROR, TFRI/TFHL MISMATCH IN UFE.*
          NZ     X1,ERR      IF *TFRI*/*TFHL* MISMATCH
          BX3    X2*X3       REMOVE OLD RSA 
          BX4    X2*X4
          BX6    -X2*X6      ISOLATE NEW RSA
          BX7    -X2*X7 
          BX6    X3+X6       INSERT NEW RSA 
          BX7    X4+X7
          SA6    A4          STORE ENTRY WITH EXCHANGED RSA 
          SA7    A3 
          EQ     UFEX        RETURN 
 UFF      SPACE  4,30 
**        UFF - UPDATE AFTER FILL FILE MOVE.
* 
*         ENTRY  (HE) = COLLECTION HOLE *TFRI* TABLE ENTRY. 
*                (FE) = SLIDE FILE *TFRI* TABLE ENTRY.
*                (FF) = FILL FILE *TFRI* TABLE ENTRY. 
*                (FS) = FILL FILE SIZE + SYSTEM SECTOR. 
*                (HL) = COLLECTION HOLE LENGTH. 
*                (FX) = FILL FILE INDEX.
*                (IX) = SLIDE FILE INDEX. 
*                (IX)-1 = COLLECTION HOLE INDEX.
* 
*         EXIT   FILL FILE PFC ENTRY UPDATED. 
*                PFC CREATED FOR NEW HOLE AT (FX).
*                *TFRI*, *TFHL* AND *TAPE* TABLES UPDATED.
*                (HE) = UPDATED.
*                (HL) = UPDATED.
*                (LT) = UPDATED (*TFHL* TABLE MAY BECOME INACTIVE). 
*                (PCHA) = -1 IFF THE COLLECTION HOLE IS CLOSED. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 5, 6, 7. 
*                B - 2, 3.
* 
*         CALLS  CIP, CTE, CRA, RCE, WCE. 
  
  
 UFF      SUBR               ENTRY/EXIT 
  
*         UPDATE THE FILL FILE PFC. 
  
          SA5    HE          COLLECTION HOLE ENTRY
          RJ     CRA         CONVERT RANDOM ADDRESS 
          SA1    FF          FILL FILE ENTRY
          RJ     RCE         READ CATALOG ENTRY 
          SA1    A0+FCBT
          MX0    36 
          BX6    X0*X1
          BX5    -X0*X5 
          BX7    X6+X5
          SA7    A1+         SET NEW ADDRESS OF FILE
          RJ     WCE         WRITE CATALOG ENTRY
  
*         CHANGE THE COLLECTION HOLE PFC TO POINT TO THE NEW HOLE.
  
          SA5    FF          FILL FILE ENTRY
          RJ     CRA         CONVERT RANDOM ADDRESS 
          SA1    HE          COLLECTION HOLE ENTRY
          RJ     RCE         READ CATALOG ENTRY 
          SA1    A0+FCBT
          MX0    36 
          BX6    X0*X1
          BX5    -X0*X5 
          BX7    X6+X5
          SA2    FS          FILE SIZE + SS 
          SX6    B1 
          IX6    X2-X6       NEW HOLE LENGTH
          MX0    24 
          LX6    36-0 
          BX7    -X0*X7 
          BX6    X0*X6
          BX7    X7+X6       INSERT NEW LENGTH
          SA7    A1          SET LENGTH AND NEW ADDRESS OF HOLE 
          RJ     CIP         CLEAR IRRELEVANT INFORMATION 
          RJ     WCE         WRITE CATALOG ENTRY
  
*         UPDATE THE *TFRI*/*TFHL* ENTRIES EXCEPT FOR COLLECTION HOLE.
  
          SA1    F.TFRI 
          SA2    IX          SLIDE FILE INDEX 
          SA3    FX          FILL FILE INDEX
          SB3    X3 
          SB2    X2-1        COLLECTION HOLE INDEX
          SA4    X1+B3       FILL FILE ENTRY
          SA1    X1+B2       COLLECTION HOLE ENTRY
          MX0    -24
          BX6    -X0*X1      NEW RSA OF FILL FILE 
          BX7    -X0*X4      RSA OF NEW HOLE
          BX1    X0*X1       PFC ADDRESS, ET CETERA, OF NEW HOLE
          BX4    X0*X4       PFC ADDRESS, ET CETERA, OF FILL FILE 
          BX6    X6+X4       FILE ENTRY 
          BX7    X7+X1       NEW HOLE ENTRY 
          SA6    A1          FILE ENTRY GOES WHERE COLLECTION HOLE WAS
          SA7    A4          HOLE ENTRY GOES WHERE FILL FILE WAS
          SA1    F.TFHL 
          SA4    X1+B3       FILL FILE LENGTH ENTRY 
          SA1    X1+B2       COLLECTION HOLE LENGTH ENTRY 
          BX6    -X0*X6      RSA OF FILL FILE ENTRY 
          BX7    -X0*X7      RSA OF HOLE ENTRY
          BX4    X0*X4       LENGTH OF FILL FILE
          BX6    X6+X4       FILL FILE ENTRY
          BX7    X7+X4       HOLE ENTRY 
          SA6    A1          FILE ENTRY GOES WHERE COLLECTION HOLE WAS
          SA7    A4          HOLE ENTRY GOES WHERE FILL FILE WAS
  
*         UPDATE THE COLLECTION HOLE STATUS.
  
          SA1    HL          COLLECTION HOLE LENGTH 
          LX7    24 
          SX4    B1+B1
          BX2    -X0*X7      NEW HOLE LENGTH
          IX7    X2+X4       FILE LENGTH + SS + EOI 
          IX6    X1-X7
          SA6    A1          NEW COLLECTION HOLE LENGTH 
          SX0    =C/ INTERNAL ERROR, HOLE LENGTH NEGATIVE IN UFF./
          NG     X6,ERR      IF HOLE LENGTH NEGATIVE ABORT
          NZ     X6,UFF1     IF NOT EXACT FIT 
          BX7    -X6
          SX6    -B1
          SA7    HE          NEW COLLECTION HOLE ENTRY (NONE) 
          SA6    PCHA        INDICATE COLLECTION HOLE CLOSED
          EQ     UFFX        RETURN 
  
 UFF1     SA1    HE          OLD RSA OF COLLECTION HOLE 
          IX2    X2+X4       SS AND EOI OF FILE 
          IX2    X1+X2       NEW RSA OF COLLECTION HOLE 
          IX6    X6-X4       HOLE LENGTH FOR PFC (W/O SS EOI) 
          SA1    IX          INDEX BEFORE WHICH TO INSERT THE ENTRY 
          RJ     CTE         CREATE AND INSERT TABLE ENTRY
          SA1    HC          HOLES CREATED
          SX6    B1 
          IX6    X1+X6
          SA6    A1 
          EQ     UFFX        RETURN 
 UHE      SPACE  4,20 
**        UHE - UPDATE HOLE ENTRY.
* 
*         ENTRY  (HE) = HOLE *TFRI* TABLE ENTRY.
*                (HL) = HOLE LENGTH.
*                (IX)-1 = HOLE ENTRY INDEX. 
* 
*         EXIT   CATALOG UPDATED. 
*                (HS) = UPDATED.
*                (HL) = 0.
*                (PCHA) = -1. 
*                TO *ERR* IF ERROR. 
* 
*         USES   X - 0, 1, 2, 3, 4, 5, 6. 
*                A - 1, 2, 3, 4, 5, 6.
* 
*         CALLS  CIP, CRA, DLK, DRP, DTE, FLT, RCE, VHS, WCE. 
  
  
 UHE6     SX6    -B1
          SA6    PCHA        SET COLLECTION HOLE CLOSED 
          BX6    X6-X6
          SA6    HL          REPLACE THEN FALL TO RETURN
  
 UHE      SUBR               ENTRY/EXIT 
          SA5    HE          GET HOLE ADDRESS 
          RJ     CRA
          RJ     FLT         FIND LAST TRACK OF HOLE
          NZ     X6,UHE1     IF NOT AT END OF TRACK CHAIN 
          RJ     DRP         DROP TRACKS AT END OF CHAIN
          EQ     UHE2        REWRITE HOLE ENTRY 
  
 UHE1     RJ     VHS         VERIFY HOLE SIZE 
          NG     X7,UHE2     IF NO TRACKS TO DELINK 
          RJ     DLK         DELINK TRACKS
 UHE2     SA1    HE 
          RJ     RCE         UPDATE CATALOG ENTRY FOR HOLE
          SA1    A0+FCLF
          SA2    HL 
          SX6    X2-3        MAKE SURE HOLE IS .GE. REAL MINIMUM SIZE 
          NG     X6,UHE4     IF HOLE TOO SMALL
          SX2    X2-2        ADJUST FOR SYSTEM AND EOI SECTORS
          MX4    12 
          LX4    -24
          BX1    X4*X1
          LX2    36 
          BX6    X1+X2       PUT IN NEW LENGTH
          MX4    -24
          BX5    -X4*X5 
          BX6    X6+X5       PUT IN ADDRESS 
          SA6    A1 
          SA1    IX 
          SA3    LT 
          NZ     X3,UHE3     IF *TFHL* TABLE IS NOT ACTIVE
          SA3    F.TFHL 
          SX1    X1-1        INDEX TO HOLE ENTRY
          IX3    X3+X1
          SA3    X3          ENTRY
          LX4    -24
          BX6    X4*X3       REMOVE OLD LENGTH
          BX2    -X4*X2 
          BX6    X6+X2       INSERT NEW LENGTH
          SA6    A3 
          LX4    24 
          SA1    HE 
          BX6    X6-X1
          BX6    -X4*X6 
          SX0    =C* INTERNAL ERROR, TFRI/TFHL MISMATCH IN UHE.*
          NZ     X6,ERR      IF TABLE MISMATCH
 UHE3     RJ     CIP         CLEAR IRRELEVANT PFC INFORMATION 
          RJ     WCE         WRITE CATALOG ENTRY
          SA3    HL          UPDATE HOLE STATISTICS 
          SX6    B1 
          IX3    X3-X6       ADJUST FOR SYSTEM AND EOI SECTORS
          IX3    X3-X6
          LX3    30 
          IX6    X3+X6
          SA3    HS 
          IX6    X6+X3
          SA6    A3 
          EQ     UHE6        CLEAR HOLE SIZE
  
 UHE4     SA1    A0+FCBS     PURGE HOLE SMALLER THAN MINIMUM HOLE SIZE
          SX6    1S11 
          BX6    X6+X1       SET DAPF BIT 
          SA6    A1 
          RJ     CIP         CLEAR IRRELEVANT INFORMATION 
          RJ     WCE         UPDATE CATALOG ENTRY 
          SA4    IX 
          SX4    X4-1        ESTABLISH (IX)-1 AS THE ENTRY TO DELETE
          RJ     DTE         DELETE TABLE ENTRY 
          SA1    IX          ADJUST (IX) SINCE PRIOR ENTRY WAS DELETED
          SX6    X1-1 
          SA6    A1 
          SA1    LS          UPDATE LOST SPACE
          SA2    HL          HOLE LENGTH
          LX2    30 
          BX6    X2 
          ZR     X6,UHE5     IF CATALOG ENTRY PURGED
          SX6    B1          ONE HOLE LOST
 UHE5     IX6    X6+X2       LENGTH 
          IX6    X6+X1       COUNT
          SA6    A1          REPLACE
          SA1    HR          CATALOG ENTRY RELEASED 
          SX6    B1 
          IX6    X6+X1
          SA6    A1          REPLACE
          EQ     UHE6        CLEAR HOLE LENGTH
 UKD      SPACE  4,15 
**        UKD - UPDATE *K* DISPLAY. 
* 
*         ENTRY  *K* DISPLAY SCREEN PRESET WITH STATIC VALUES.
* 
*         EXIT   LEFT SCREEN CONTROL WORD SCREEN DISPLAY BIT CLEARED. 
*                DYNAMIC VALUES UPDATED.
* 
*         USES   X - 0, 1, 2, 3, 6, 7.
*                A - 0, 1, 2, 3, 6. 
*                B - 2, 3, 4. 
* 
*         CALLS  CFD, COD, FRM, FSM, ZTB. 
  
  
 UKD      SUBR               ENTRY/EXIT 
          SA1    KDLS        LEFT SCREEN CONTROL WORD 
          MX0    -1 
          BX6    X0*X1       CLEAR SCREEN DISPLAYED BIT 
          SA6    A1 
          SA2    L.TFRI      CURRENT LENGTH OF *TFRI* 
          SA1    IX          CURRENT POSITION IN *TFRI* 
          PX0    X2 
          PX7    X1 
          NX6    X0 
          NX0    X7 
          FX7    X0/X6
          SA1    =100000.    100.*1000. 
          RX0    X1*X7
          UX7,B2 X0 
          LX6    B2,X7       PERCENT PROCESSED * 1000.
          BX1    X6 
          RJ     CFD         CONVERT TO FLOATING POINT FORMAT 
          SA6    KDLSC
          SA1    L.TFRI 
          RJ     COD         CONVERT TO OCTAL DISPLAY 
          SA6    KDLSD
          SA1    IX 
          RJ     COD         CONVERT TO OCTAL DISPLAY 
          SA6    KDLSE
          SA1    FX 
          RJ     COD         CONVERT TO OCTAL DISPLAY 
          SA6    KDLSF
          SA2    =H*       YES* 
          SA3    =H*        NO* 
          SA1    LT 
          BX6    X2          YES
          ZR     X1,UKD1     IF TABLE ACTIVE
          BX6    X3          NO 
 UKD1     SA6    KDLSH
          SA1    ID 
          BX6    X2          YES
          NZ     X1,UKD2     IF IDLE DOWN REQUESTED 
          BX6    X3          NO 
 UKD2     SA6    KDLSI
          SA1    RP 
          BX6    X2          YES
          NZ     X1,UKD3     IF REPRIEVE ACTIVE 
          BX6    X3          NO 
 UKD3     SA6    KDLSJ
          SA1    JM          FILES MOVED VIA THE FILL TECHNIQUE 
          SA0    KDLS1
          RJ     FSM
          SA1    SM          FILES MOVED VIA THE SLIDE TECHNIQUE
          SA0    KDLS2
          RJ     FSM
          SA1    DM          FILES MOVED
          SA0    KDLS3
          RJ     FSM
          SA1    LS          LOST SPACE 
          SA0    KDLS4
          RJ     FSM
          SA1    HS          HOLES REMAINING
          SA0    KDLS5
          RJ     FSM
          SA0    KDLS6
          RJ     FRM         FORMAT HOLES REMOVED MESSAGE 
          SA1    DS          DROPPED TRACKS SPACE 
          SA0    KDLS7
          RJ     FSM
  
*         MOVE CURRENT *B* DISPLAY MESSAGE TO THE *K* DISPLAY.
  
          SB4    B0          ZERO BYTE FLAG 
          SB3    5           MAXIMUM WORDS TO TRANSFER TO *K* DISPLAY 
          SB2    B0          ADDRESS OFFSET 
          MX2    -12
          SA1    MSGA        ADDRESS OF CURRENT MESSAGE 
          SX0    X1          SOURCE BASE ADDRESS
 UKD4     SA1    X0+B2
          BX6    -X2*X1 
          NZ     X6,UKD5     IF NOT ZERO BYTE 
          SB4    B1+         SET ZERO BYTE ENCOUNTERED FLAG 
          SA2    =10H 
 UKD5     RJ     ZTB
 UKD6     SA6    KDLS=+B2    STORE WORD IN *K* DISPLAY BUFFER 
          SB2    B2+B1
          GE     B2,B3,UKDX  IF ALL WORDS PROCESSED 
          EQ     B4,B0,UKD4  IF NO ZERO BYTE ENCOUNTERED
          BX6    X2          BLANKS 
          EQ     UKD6        BLANK FILL 
 USS      SPACE  4,20 
**        USS - UPDATE SYSTEM SECTOR. 
* 
*         ENTRY  (A0) = ADDRESS OF PFC OR ZERO FOR NO PFC UPDATE IN SS. 
*                (X1) = ADDRESS OF SYSTEM SECTOR (INCLUDING THE EXTRA 
*                       WORD WITH THE LINKAGE BYTES). 
*                (X5) = TK/SC ADDRESS OF TARGET LOCATION. 
* 
*         EXIT   SYSTEM SECTOR UPDATED. 
*                PFC IN SYSTEM SECTOR UPDATED IF REQUESTED. 
* 
*         USES   X - 1, 5, 6. 
*                A - 1, 6.
* 
*         MACROS MOVE.
  
  
 USS      SUBR               ENTRY/EXIT 
          SX6    X1 
          SA6    USSA        SAVE TARGET ADDRESS
          SX6    A0 
          ZR     X6,USSX     IF PFC UPDATE NOT REQUESTED
          SX6    X1 
          MOVE   NWCE,A0,X6+CTSS+1
          SA1    USSA        UPDATE TRACK AND SECTOR IN PFC 
          SA1    X1+CTSS+FCBT+1 
          MX6    -24
          BX1    X6*X1
          BX5    -X6*X5 
          BX6    X1+X5
          SA6    A1 
          EQ     USSX        RETURN 
  
  
 USSA     CON    0           STORAGE FOR TARGET ADDRESS 
 VHS      SPACE  4,15 
**        VHS - VERIFY THAT HOLE SIZE IS ADEQUATE FOR DELINK. 
* 
*         ENTRY  (X3) = SECTOR LIMIT. 
*                (X4) = 36/0, 12/TRACK, 12/0 (OF HOLE). 
*                (X5) = 36/0, 12/TRACK, 12/SECTOR (OF HOLE).
* 
*         EXIT   (X7) .LT. 0 IF HOLE IS TOO SMALL FOR DELINK. 
* 
*         USES   X - 1, 2, 6, 7.
*                A - 1, 2, 6, 7.
  
  
 VHS      SUBR               ENTRY/EXIT 
 VHS1     SA1    NTIH        CHECK TRACK COUNT
          SX7    X1-2 
          NG     X7,VHSX     IF HOLE TOO SMALL
  
*         ENSURE HOLE AFTER DELINK IS LARGE ENOUGH. 
  
          SA1    HSIT        HOLE SIZE IN TRACK 
          BX6    X5-X4       FIRST SECTOR OF FIRST TRACK
          ZR     X6,VHS2     IF FIRST TRACK TO BE DELINKED
          IX6    X3-X6       HOLE SIZE IN FIRST TRACK 
 VHS2     IX6    X1+X6       HOLE SIZE IN FIRST AND LAST TRACK
          SX6    X6-MNHS
          PL     X6,VHSX     IF HOLE SIZE ADEQUATE
  
*         INCREASE HOLE SIZE BY ADDING TRACK. 
  
          IX6    X1+X3       ADD SECTORS FOR ONE TRACK TO HOLE LENGTH 
          SX7    X7+B1       (TRACK COUNT - 1) = (TRACK COUNT - 2) + 1
          SA6    A1+         SECTORS REMAINING IN HOLE
          SA7    NTIH        NUMBER OF TRACKS 
          SA1    PTIH        PREVIOUS LAST TRACK
          SA2    LTIH        LAST TRACK IN HOLE 
          BX6    X1 
          LX7    X2 
          SA6    A2+         NEW LAST TRACK 
          SA7    CTIH        NEW CURRENT TRACK
          EQ     VHS1        MAKE SURE HOLE SPANS AT LEAST ONE TRACK
 WCE      SPACE  4,15 
**        WCE - WRITE CATALOG ENTRY.
* 
*         ENTRY  (RCEA) = CURRENT PRU RSA.
*                (RCEC) = CURRENT PRU LENGTH. 
*                (CBUF) = PRU TO WRITE. 
* 
*         USES   X - 1, 3, 6. 
*                A - 1, 6.
* 
*         MACROS CALLPFU, RECALL, SCIOF, SYSTEM.
  
  
 WCE      SUBR               ENTRY/EXIT 
          SA1    NC 
          NZ     X1,WCEX     IF NO CHANGES ARE TO BE MADE TO THE DEVICE 
          RECALL C
          SA1    RCEA 
          NZ     X1,WCE1     IF NOT PRU 0 
          CALLPFU  C,CTRC,R  REWIND CATALOG FILE
          SA1    RCEA 
 WCE1     BX6    X1 
          SA6    C+6         SET RANDOM ADDRESS 
          SA1    RCEC 
          SX3    X1-100B
          ZR     X3,WCE2     IF FULL PRU
          SCIOF  C,224B      SET *CIO* *REWRITER* FUNCTION IN FET 
          SYSTEM MPF,R,C,7S6 REWRITE SECTOR VIA *MPF* 
          EQ     WCEX        RETURN 
  
 WCE2     SCIOF  C,214B      SET *CIO* *REWRITE* FUNCTION IN FET
          SYSTEM MPF,R,C,7S6 REWRITE SECTOR VIA *MPF* 
          EQ     WCEX        RETURN 
 ZWT      SPACE  4,10 
**        ZWT - ZERO WORD TERMINATE *TFRI* TABLE. 
* 
*         EXIT   ZERO WORD SET AT END OF *TFRI* TABLE.
* 
*         USES   X - 1, 6.
*                A - 1, 6.
*                B - 7. 
  
  
 ZWT      SUBR               ENTRY/EXIT 
          SA1    L.TFRI 
          SB7    X1 
          BX6    X6-X6
          SA1    F.TFRI 
          SA6    X1+B7
          EQ     ZWTX        RETURN 
          SPACE  4,10 
*         RJAT - RJ ADDRESS TABLE (FOR RJ TRACE). 
  
  
 RJAT     BSS    0
 RJAT     HERE               DUMP RJ ADDRESS TABLE HERE 
          CON    0           TERMINATE TABLE
          SPACE  4,10 
*         COMMON DECKS. 
  
  
*CALL     COMCCDD 
*CALL     COMCCIO 
*CALL     COMCCFD 
*CALL     COMCCOD 
*CALL     COMCLFM 
*CALL     COMCMTP 
*CALL     COMCMVE 
*CALL     COMCPFU 
*CALL     COMCSNM 
*CALL     COMCSYS 
*CALL     COMCZTB 
          SPACE  4,10 
          SEG 
          USE    BUFFERS
  
  
 DBUF     BSS    DBUFL       FILE TRANSFER BUFFER 
 WBUF     BSS    NWCE        PFC BUFFER 
 CBUF     BSS    CBUFL       CATALOG TRACK BUFFER 
 SBUF     BSS    SBUFL       SCRATCH FET BUFFER 
 MSTBUF   BSS    MSTL        MST BUFFER 
 MEML     BSS    700B        MANAGED TABLE BUFFER 
 RFL=     BSS    0           INITIAL FIELD LENGTH 
          TITLE  PRESET.
 PRS      SPACE  4,10 
**        PRS - PRESET. 
* 
*         ENTRY  (B1) = 1.
* 
*         EXIT   COMMAND PARAMETERS PROCESSED.
*                DEVICE UTILITY INTERLOCK SET.
*                ERROR EXIT ADDRESS SET.
*                TABLE *TCAT* CREATED.
*                TABLE *TFRI* CREATED AND SORTED. 
*                TABLE *TTLT* CREATED.
* 
*         USES   X - 1, 6, 7. 
*                A - 1, 6, 7. 
* 
*         CALLS  CST, ICF, PAG, SCT.
* 
*         MACROS GETFLC, PDATE, STIME, SYSTEM, TIME.
  
  
          ORG    DBUF 
          QUAL   PRS
  
  
 PRS      SUBR               ENTRY/EXIT 
          SX6    A0+
          SX7    A0-10B 
          SA6    TOVC        INITIAL FL 
          SA7    F.TEND      SET TABLE END AS FL-10B
          TIME   ST          START CPU TIME 
          STIME  SS          START SRU-S
          PDATE  PD          GET PACKED DATE AND TIME 
          GETFLC TOVD 
          SA1    TOVD 
          MX6    12 
          BX6    X6*X1       ISOLATE MAXIMUM CM FOR CURRENT JOB STEP
          LX6    17-59       POSITION AS 18 BIT ADDRESS 
          SA6    A1 
          SYSTEM CPM,R,,10100B  ABORT IF NO SYSTEM ORIGIN/PRIVILEGES
          RJ     PAG         PROCESS COMMAND ARGUMENTS
          RJ     ICF         FIND DEVICE AND INTERLOCK FILE 
          RJ     SCT         SCAN CATALOG TRACKS
          RJ     CST         CONVERT AND SORT TABLES
          RJ     KDP         *K* DISPLAY PRESET 
          SX6    B1+
          SA6    PC          SET PRESET COMPLETE
          EQ     PRSX        RETURN 
          TITLE  PRESET SUBROUTINES.
 CST      SPACE  4,15 
**        CST - CONVERT AND SORT TABLES.
* 
*         EXIT   TABLES BUILT AND SORTED. 
* 
*         USES   X - 0, 1, 2, 5, 6, 7.
*                A - 1, 2, 5, 6, 7. 
*                B - 6, 7.
* 
*         CALLS  CTT, MSG, MTD, SRA, SST, ZWT.
* 
*         MACROS MEMORY.
  
  
 CST      SUBR               ENTRY/EXIT 
          SX0    CSTA        * CREATING TRACK RESERVATION TABLE.* 
          RJ     MSG
          SA5    EQ 
          RJ     CTT         CONVERT TRACK TABLE
          SA1    L.TFRI 
          SB6    X1 
          BX7    X7-X7
          SA5    LT 
          NZ     X5,CST1     IF *TFHL* IS NOT ACTIVE
          SA5    L.TFHL 
          BX5    X1-X5
          SX0    CSTB        * INTERNAL ERROR, TFRI/TFHL MISMATCH ...*
          NZ     X5,ERR      IF *TFRI*/*TFHL* LENGTH MISMATCH 
          SA1    F.TFHL 
          SA7    X1+B6       CLEAR EXPANSION WORD FOLLOWING TABLE 
 CST1     SA1    F.TFRI 
          SA7    X1+B6       CLEAR EXPANSION WORD FOLLOWING TABLE 
          SX0    CSTC        * CONVERTING RANDOM ADDRESSES.*
          RJ     MSG
          SA5    F.TFRI 
          SA5    X5-1 
          SA2    F.TFHL 
          SA2    X2-1 
 CST2     SA5    A5+1 
          SA1    LT 
          NZ     X1,CST3     IF *TFHL* IS NOT ACTIVE
          SA2    A2+1 
          MX0    -24
          BX2    -X0*X2 
          BX6    -X0*X5 
          BX2    X2-X6
          SX0    CSTD        * INTERNAL ERROR, TFRI/TFHL MISMATCH ...*
          NZ     X2,ERR      IF *TFRI*/*TFHL* MISMATCH
 CST3     ZR     X5,CST4     IF END OF TABLE
          RJ     SRA         SET RANDOM ADDRESS 
          MX0    36 
          SA5    A5 
          BX5    X0*X5
          BX6    X5+X6
          SA6    A5 
          SA1    LT 
          NZ     X1,CST2     IF *TFHL* IS NOT ACTIVE
          SA2    A2 
          BX2    X0*X2
          BX6    -X0*X6 
          BX6    X2+X6
          SA6    A2 
          EQ     CST2        LOOP 
  
 CST4     SX0    CSTE        * SORTING TABLE.*
          RJ     MSG
          SA2    F.TFRI 
          SA1    L.TFRI 
          SB7    X2 
          RJ     SST         SHELL-SORT TABLE 
          SA1    LT 
          NZ     X1,CST5     IF *TFHL* IS NOT ACTIVE
          SA2    F.TFHL 
          SA1    L.TFHL 
          SB7    X2 
          RJ     SST         SHELL-SORT TABLE 
 CST5     RJ     MTD         MOVE TABLES DOWN 
          RJ     ZWT         ZERO WORD TERMINATE *TFRI* TABLE 
          SA1    F.TFHL 
          SA2    L.TFHL 
          IX6    X1+X2
          SX6    X6+B1
          SA6    F.TEND 
          BX5    X6 
          SX2    X5+10B      MORE FL THAN TELLING 
          MEMORY CM,,R,X2    REDUCE MEMORY
          EQ     CSTX        RETURN 
  
  
 CSTA     DATA   C/ CREATING TRACK RESERVATION TABLE./
 CSTB     DATA   C* INTERNAL ERROR, TFRI/TFHL MISMATCH IN CST.* 
 CSTC     DATA   C/ CONVERTING RANDOM ADDRESSES./ 
 CSTD     DATA   C* INTERNAL ERROR, TFRI/TFHL MISMATCH IN CST2.*
 CSTE     DATA   C/ SORTING TABLE./ 
 CTT      SPACE  4,10 
**        CTT - CONVERT TRACK TABLE.
* 
*         ENTRY  (X5) = EST ORDINAL.
* 
*         EXIT   *TTLT* BUILT.
* 
*         USES   X - ALL. 
*                A - 1, 2, 4, 6, 7. 
*                B - 2, 3, 4, 5, 6. 
* 
*         CALLS  MTD. 
* 
*         MACROS ABSREAD, ALLOC.
  
  
 CTT      SUBR               ENTRY/EXIT 
          ABSREAD ESTP
          MX0    -18
          LX6    24 
          BX6    -X0*X6 
          SX2    ESTE 
          IX5    X5*X2
          IX5    X5+X6
          ABSREAD X5         READ EST ENTRY 
          MX0    -12
          BX5    -X0*X6      FWA/10 OF MST
          LX5    3
          SX5    X5+TDGL
          ABSREAD X5
          AX6    24 
          BX0    -X0*X6      LENGTH OF TRT
          ALLOC  TTRT,X0
          SX5    X5+TRLL-TDGL 
          ABSREAD X5
          MX1    -18
          BX5    -X1*X6      FWA TRT
          SA4    F.TTRT 
          SX2    X0 
          SX3    100B 
 CTT1     IX2    X2-X3
          PL     X2,CTT2     IF FULL BLOCK OF DATA
          IX3    X2+X3       LAST BLOCK SIZE
          SX2    B0 
 CTT2     ABSREAD X5,X4,X3
          IX5    X5+X3       ADVANCE TRT ADDRESS
          IX4    X4+X3       ADVANCE DATA ADDRESS 
          NZ     X2,CTT1     IF MORE DATA TO READ 
          LX0    2           LENGTH OF LINK TABLE 
          ALLOC  TTLT,X0
          AX0    2
          SB2    -B1
          SA1    F.TTRT 
          SA2    F.TTLT 
          SB3    X1          FWA *TTRT* 
          SB4    X2          FWA *TTLT* 
          SB5    0           WORD INDEX 
          SX7    7777B
 CTT3     SA1    B3+B5       ADVANCE WORD 
          SB6    4
 CTT4     SB2    B2+B1       INCREMENT TRACK
          LX1    12 
          BX6    X7*X1
          SA6    B4+B2
          SB6    B6-B1
          NZ     B6,CTT4     IF FULL WORD NOT PROCESSED 
          SB5    B5+B1
          SX0    X0-1 
          NZ     X0,CTT3     IF MORE TRT WORDS
          SX7    0
          SA7    L.TTRT      RELEASE *TTRT* 
          RJ     MTD         PACK TABLES
          EQ     CTTX        RETURN 
 FDN      SPACE  4,15 
**        FDN - FIND DEVICE NUMBER. 
* 
*         ENTRY  (X1) = 42/ FAMILY NAME,6/ DEVICE NUMBER,12/ 0. 
* 
*         EXIT   (X1) = 0, IF DEVICE FOUND. 
*                (X1) = 1, IF DEVICE NOT FOUND. 
*                (X6) = EST ORDINAL.
* 
*         USES   X - 1, 2, 3, 5, 6, 7.
*                A - 1, 2, 6, 7.
*                B - 2. 
* 
*         MACROS ABSREAD. 
  
  
 FDN5     SX6    B1+
          SA6    DF          SET DUMP REQUIRED FLAG 
  
 FDN6     SX1    B1          INDICATE DEVICE NOT FOUND
  
 FDN      SUBR               ENTRY/EXIT 
          BX6    X1 
          SA6    FDNA 
          ABSREAD ESTP
          LX1    24 
          MX6    -18
          BX2    -X6*X1      FWA EST
          MX6    -12
          LX1    24 
          SX3    ESTE 
          BX7    -X6*X1      LAST MS ORDINAL + 1
          IX7    X7*X3
          SA7    FDNC        SAVE LAST MS ORDINAL + 1 
          SX5    FDNB        SET BUFFER TO READ INTO
          SX3    100B        NUMBER OF WORDS TO READ
 FDN1     IX7    X7-X3
          PL     X7,FDN2     IF NEXT WILL NOT BE LAST READ
          IX3    X7+X3
          SX7    B0 
 FDN2     ABSREAD X2,X5,X3
          IX2    X2+X3
          IX5    X5+X3
          NZ     X7,FDN1     IF MORE TO READ
          SA1    FDNA 
          MX6    42 
          BX1    X6*X1
          NZ     X1,FDN3     IF FAMILY/PACK SPECIFIED 
          ABSREAD PFNL       GET SYSTEM DEFAULT NAME
          AX6    12 
          MX2    -12
          BX1    -X2*X6 
          SX2    ESTE 
          IX1    X1*X2       FOR EST MULTI WORD ENTRIES 
          SA2    FDNB+X1     PICK UP FIRST WORD OF EST ENTRY
          PL     X2,FDN6     IF NOT MASS STORAGE DEVICE 
          MX1    -12
          BX1    -X1*X2 
          LX1    3           MST FOR DEFAULT FAMILY 
          ABSREAD X1,MSTBUF,MSTL
          SA1    MSTBUF+PFGL
          SA2    FDNA 
          MX6    42 
          BX1    X6*X1
          BX2    -X6*X2 
          BX6    X1+X2
          SA6    FDNA        STORE FAMILY NAME AND DEVICE NUMBER
 FDN3     SA1    FDNC        PICK UP LARGEST MS EST ORDINAL 
          SB2    X1 
 FDN4     SB2    B2-ESTE
          NG     B2,FDN6     IF END OF EST
          SA1    B2+FDNB
          MX6    -12
          BX2    -X6*X1      MST ADDRESS/10B
          LX2    3
          PL     X1,FDN4     IF NOT MASS STORAGE DEVICE 
          LX1    59-54
          NG     X1,FDN4     IF DEVICE *UNAVAILABLE*
          LX1    54-23
          NG     X1,FDN4     IF DEVICE *OFF*
          ABSREAD X2,MSTBUF,MSTL
          SA1    MSTBUF+STLL
          SX2    7752B
          LX1    -48
          BX2    X1*X2
          NZ     X2,FDN4     IF *INITIALIZE* OR *UNLOAD* STATUS 
          MX6    48 
          SA1    MSTBUF+PFGL
          SA2    FDNA 
          BX1    X1-X2
          BX1    X6*X1
          NZ     X1,FDN4     IF NOT SPECIFIED DEVICE
          SA2    MSTBUF+ACGL
          SX6    20B
          BX6    X6*X2
          NZ     X6,FDN5     IF *ERROR IDLE*
          SA2    MSTBUF+DALL
          SX6    3
          LX6    56-0 
          BX6    X6*X2
          NZ     X6,FDN5     IF DEVICE STATE IS NOT *ON*
          SX6    B2          SET EST ORDINAL
          SX2    ESTE 
          IX6    X6/X2
          EQ     FDNX        RETURN 
  
  
 FDNA     CON    0           SPECIFIED FAMILY/DEVICE NUMBER 
 FDNB     BSS    ESMX*ESTE   BUFFER FOR EST 
 FDNC     CON    0           LAST MS ORDINAL + 1
ICF       SPACE  4,20 
**        ICF - INITIALIZE CATALOG FILE.
* 
*         ENTRY  (DN) = DEVICE NUMBER.
*                (FM) = FAMILY OR PACKNAME. 
* 
*         EXIT   (EI) = RSA OF IAPF CHAIN EOI.
*                (EQ) = EST ORDINAL.
*                (CC) = NUMBER OF CATALOG TRACKS. 
*                PF UTILITY INTERLOCK SET.
*                CATALOG AND DATA FILES OPENED. 
*                TO *ERR* IF ERROR. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 6, 7. 
* 
*         CALLS  FDN. 
* 
*         MACROS CALLPFU, REPRIEVE, RETURN, SKIPEI. 
  
  
 ICF      SUBR               ENTRY/EXIT 
          RETURN C,R
          RETURN I,R
          RETURN O,R
          SA1    DN 
          SA2    FM 
          LX1    12 
          BX1    X1+X2
          RJ     FDN         READ MST FOR DEVICE
          SX0    ICFA        * INCORRECT DEVICE/FAMILY.*
          NZ     X1,ERR      IF ERROR 
          SA2    MSTBUF+PUGL
          SA1    MSTBUF+MDGL
          LX1    59-58
          SA3    PN 
          ZR     X3,ICF1     IF NO PACKNAME SPECIFIED 
          NG     X1,ICF3     IF AN AUXILIARY DEVICE 
          SX0    ICFB        * PACKNAME NOT FOUND.* 
          EQ     ERR         ABORT
  
 ICF1     PL     X1,ICF2     IF FAMILY DEVICE 
          SX0    ICFC        * FAMILY NOT FOUND.* 
          EQ     ERR         ABORT
  
 ICF2     MX0    -8 
          BX2    -X0*X2 
          NZ     X2,ICF3     IF A MASTER DEVICE 
          SX0    ICFD        * NOT A MASTER DEVICE.*
          EQ     ERR         ABORT
  
 ICF3     SA6    EQ          SAVE EST ORDINAL 
          SX7    IF 
          LX6    48 
          BX7    X6+X7
          SA7    C+FTPM 
          SX6    1
          SA6    DF          FORCE FL DUMP
          REPRIEVE  RPVA,SETUP,RPVC  SET REPRIEVE PROCESSING
          CALLPFU  C,CTSU,R  SET UTILITY INTERLOCK
          SA1    MSTBUF+ALGL
          AX1    12 
          MX0    -12
          BX6    -X0*X1      CATALOG TRACK COUNT
          SA6    CC 
          AX1    24 
          BX1    -X0*X1 
          BX6    X1 
          LX6    12 
          BX6    X6+X1       BUILD FST FOR CATALOG CHAIN
          LX6    24 
          SX1    5
          BX6    X6+X1
          SA1    EQ 
          LX1    48 
          BX6    X6+X1
          SA6    C+FTPM 
          CALLPFU  C,CTOP,R  OPEN CATALOG FILE
          SA1    MSTBUF+ALGL
          MX0    12 
          BX6    X0*X1       BUILD FST FOR IAPF CHAIN 
          LX6    -12
          BX4    X6 
          LX4    -12
          BX6    X4+X6
          SA1    EQ 
          LX1    48 
          BX6    X1+X6
          SX3    5
          BX5    X3+X6
          SA6    I+FTPM 
          SA6    O+FTPM 
          CALLPFU  I,CTOP,R  OPEN INPUT FILE
          CALLPFU  O,CTOP,R  OPEN OUTPUT FILE 
          SKIPEI O,R
          SA1    O+6
          AX1    30 
          SX6    B1 
          IX6    X6+X1
          SA6    EI          SET IAPF CHAIN EOI RSA 
          EQ     ICFX        RETURN 
  
  
 ICFA     DATA   C* INCORRECT DEVICE/FAMILY.* 
 ICFB     DATA   C* PACKNAME NOT FOUND.*
 ICFC     DATA   C* FAMILY NOT FOUND.*
 ICFD     DATA   C* NOT A MASTER DEVICE.* 
 KDP      SPACE  4,15 
**        KDP - *K* DISPLAY PRESET. 
* 
*         EXIT   DISPLAY PRESET WITH STATIC VALUES. 
* 
*         USES   A - 0, 1, 2, 6.
*                X - 0, 1, 2, 6.
* 
*         CALLS  COD, FSM, ZTB. 
* 
*         MACROS CONSOLE, MESSAGE.
  
  
 KDP      SUBR               ENTRY/EXIT 
          SA1    EQ 
          RJ     COD
          SA6    KDLSL
          SA1    FM 
          ZR     X1,KDP3     IF NO FAMILY NAME
          RJ     ZTB
          MX0    -6 
 KDP1     BX2    -X0*X1 
          NZ     X2,KDP2     IF NAME RIGHT JUSTIFIED
          LX1    -6 
          LX6    -6 
          EQ     KDP1        LOOP 
  
 KDP2     SA6    KDLSM
 KDP3     SA1    PN 
          ZR     X1,KDP6     IF NO PACKNAME 
          RJ     ZTB
          MX0    -6 
 KDP4     BX2    -X0*X1 
          NZ     X2,KDP5     IF NAME RIGHT JUSTIFIED
          LX1    -6 
          LX6    -6 
          EQ     KDP4        LOOP 
  
 KDP5     SA6    KDLSN
          SA2    KDPB        BLANK WORD 
          BX6    X2 
          SA6    KDLSM       CLEAR FM IF AUXILIARY PACK 
 KDP6     SA1    DN 
          RJ     COD
          SA6    KDLSO
          SA1    DB 
          RJ     COD
          SA6    KDLSQ
          SA1    MR 
          RJ     COD
          SA6    KDLSR
          SA2    =H*       YES* 
          BX6    X2 
          SA1    EF 
          ZR     X1,KDP7     IF EXACT FIT NOT REQUIRED
          SA6    KDLSS
 KDP7     SA1    NC 
          ZR     X1,KDP8     IF NO CHANGE NOT REQUESTED 
          SA6    KDLST
 KDP8     SA1    NM 
          ZR     X1,KDP9     IF NO MOVE NOT REQUESTED 
          SA6    KDLSU
 KDP9     SA1    NF 
          ZR     X1,KDP10    IF NO FILL MOVE NOT REQUESTED
          SA6    KDLSV
 KDP10    SA1    NS 
          ZR     X1,KDP11    IF NO SLIDE MOVE NOT REQUESTED 
          SA6    KDLSW
 KDP11    SA1    NP 
          ZR     X1,KDP12    IF NO PREMOVE DELINK NOT REQUESTED 
          SA6    KDLSX
 KDP12    SA1    OF          ONSET FILES
          SA0    KDLSZ
          RJ     FSM
          SA1    OH          ONSET HOLES
          SA0    KDLS0
          RJ     FSM
          SA1    FW          FLAW FILES ENCOUNTERED 
          SA0    KDLS8
          RJ     FSM
          CONSOLE KDS        REQUEST *K* DISPLAY
          MESSAGE  KDPA,2,R  CLEAR MESSAGE
          EQ     KDPX        RETURN 
  
  
 KDPA     DATA   0           BLANK MESSAGE
 KDPB     DATA   H* *        BLANK WORD 
 PAG      SPACE  4,15 
**        PAG - PROCESS COMMAND ARGUMENTS.
* 
*         EXIT   TO *ERR* IF ERROR. 
* 
*         USES   X - 0, 1, 2, 4, 5, 6.
*                A - 1, 2, 4, 5, 6. 
*                B - 4, 5, 7. 
* 
*         CALLS  ARG, DXB, RJA. 
* 
*         MACROS RTIME. 
  
  
 PAG      SUBR               ENTRY/EXIT 
          SB5    TARG        TABLE OF COMMAND ARGUMENTS 
          SA1    ACTR 
          SB4    X1 
          SA4    ARGR 
          RJ     ARG         PROCESS ARGUMENTS
          SX0    PAGA        * INCORRECT ARGUMENT.* 
          NZ     X1,ERR      IF ARG ERRORS
          SA5    DN 
          SB7    B0          ASSUME OCTAL CONVERSION
          RJ     DXB
          SX0    PAGB        * PARAMETER DN ARGUMENT ERROR.*
          NZ     X4,ERR      IF CONVERSION ERRORS 
          SA6    DN 
          SA5    IX 
          SB7    B0          ASSUME OCTAL CONVERSION
          RJ     DXB
          SX0    PAGC        * PARAMETER IX ARGUMENT ERROR.*
          NZ     X4,ERR      IF CONVERSION ERRORS 
          SA6    IX 
          SA5    TL 
          ZR     X5,PAG1     IF NO TIME LIMIT SPECIFIED 
          SB7    1           ASSUME DECIMAL CONVERSION
          RJ     DXB
          SX0    PAGD        * PARAMETER TL ARGUMENT ERROR.*
          NZ     X4,ERR      IF CONVERSION ERRORS 
          BX5    X6 
          LX5    36 
          RTIME  TL 
          SA2    TL 
          IX6    X2+X5
          SA6    A2          SET TIME TO QUIT 
 PAG1     SA5    MR 
          SB7    B0          ASSUME OCTAL CONVERSION
          RJ     DXB
          SX0    PAGE        * PARAMETER MR ARGUMENT ERROR.*
          NZ     X4,ERR      IF CONVERSION ERRORS 
          SA6    A5 
          SA1    PN 
          ZR     X1,PAG2     IF NO PACKNAME 
          BX6    X1 
          SA6    FM          SET FAMILY = PACKNAME
 PAG2     SA1    NM 
          ZR     X1,PAG3     IF NO MOVE NOT REQUESTED 
          SX6    B1+
          SA6    NF          FORCE NO FILL
          SA6    NS          FORCE NO SLIDE 
 PAG3     SA5    DB 
          ZR     X5,PAG4     IF DEBUG NOT SPECIFIED 
          SB7    B0          ASSUME OCTAL CONVERSION
          RJ     DXB
          SX0    PAGF        * PARAMETER DEBUG ARGUMENT ERROR.* 
          NZ     X4,ERR      IF CONVERSION ERRORS 
          SA6    DB 
          LX6    59-1 
          PL     X6,PAG4     IF RJ TRACE NOT SPECIFIED
          SX1    B1 
          RJ     RJA         ACTIVATE RJ TRACE
 PAG4     EQ     PAGX        RETURN 
  
  
 PAGA     DATA   C* INCORRECT ARGUMENT.*
 PAGB     DATA   C* PARAMETER DN ARGUMENT ERROR.* 
 PAGC     DATA   C* PARAMETER IX ARGUMENT ERROR.* 
 PAGD     DATA   C* PARAMETER TL ARGUMENT ERROR.* 
 PAGE     DATA   C* PARAMETER MR ARGUMENT ERROR.* 
 PAGF     DATA   C* PARAMETER DEBUG ARGUMENT ERROR.*
  
  
*         TARG - TABLE OF COMMAND ARGUMENTS.
  
 TARG     BSS    0
 DEBUG    ARG    TARC,DB
 DN       ARG    DN,DN
 EF       ARG    -TARA,EF 
 FM       ARG    FM,FM
 IX       ARG    IX,IX
 MR       ARG    TARC,MR
 NC       ARG    -TARA,NC 
 NF       ARG    -TARA,NF 
 NM       ARG    -TARA,NM 
 NP       ARG    -TARA,NP 
 NS       ARG    -TARA,NS 
 PN       ARG    PN,PN
 TL       ARG    TARB,TL
          CON    0
  
*         ASSUMED VALUES FOR COMMAND ARGUMENTS. 
  
 TARA     DATA   1
 TARB     DATA   0L300D 
 TARC     DATA   0L377777B
 SCT      SPACE  4,15 
**        SCT - SCAN CATALOG TRACKS.
* 
*         EXIT   TO *ERR* IF ERROR. 
* 
*         USES   X - ALL. 
*                A - 1, 2, 3, 4, 6, 7.
* 
*         CALLS  MSG. 
* 
*         MACROS ADDWRD, CALLPFU, READ, READW, STATUS, SYSTEM.
  
  
 SCT      SUBR               ENTRY/EXIT 
          SA1    MSTBUF+MDGL
          SA2    MSTBUF+ALGL
          MX0    -12
          LX2    12 
          BX7    -X0*X1      SECTOR LIMIT 
          BX6    -X0*X2      FIRST TRACK OF IAPF CHAIN
          SA7    SL          SET SECTORS/TRACK
          SA6    FT          SET FIRST TRACK OF IAPF CHAIN
          SX0    64D/NWCE*NWCE/8  PFC-S PER SECTOR (8 WORD PARCELS) 
          ERRNZ  NWCE/8*8-NWCE  *NWCE* NOT EVENLY DIVISIBLE BY EIGHT
          IX7    X0*X7
          SA7    SCTA        CATALOG ENTRIES PER TRACK (8 WORD PARCELS) 
          SX0    SCTC        * CREATING CATALOG TRACK TABLES.*
          RJ     MSG
          SA1    FT          FIRST TRACK OF THE IAPF CHAIN
          MX2    2           FLAGS FOR THE IAPF CHAIN ANCHOR ENTRY
          LX2    59-60
          LX1    12 
          BX0    X1          (X0) IS UNCHANGED BY ADDWRD
          BX1    X2+X1
          SX6    MXCT        MAXIMUM CATALOG TRACK + 1
          LX6    24+18
          BX1    X1+X6       *TFRI* ANCHOR ENTRY
          ADDWRD TFRI,X1
          SA1    LT 
          NZ     X1,SCT1     IF *TFHL* TABLE IS NOT ACTIVE
          BX1    X0          ANCHOR LENGTH IS ZERO (JUST SS AND EOI)
          ADDWRD TFHL,X1
 SCT1     SA1    CN 
          SA2    CC 
          SX6    X1+B1
          IX2    X2-X6
          ZR     X2,SCTX     IF NO MORE TRACKS
          SA6    A1 
          CALLPFU  C,CTAC,R  ADVANCE CATALOG TRACK
          STATUS C,P         BUILD FST ENTRY FOR THIS TRACK 
  
*         NOTE - OVERFLOW PROCESSING ASSUMES THAT CATALOG TRACKS
*                HAVE FULL SECTORS. 
  
          SA1    C+6
          LX1    36 
          AX1    48 
          SX0    SCTD        * CATALOG FST CURRENT SECTOR .NE. ZERO.* 
          NZ     X1,ERR      IF NOT ZERO
          SA1    A1          REFETCH FST FROM FET 
          SX7    5
          MX6    48 
          BX1    X1*X6
          BX1    X1+X7
          BX7    X1 
          SA7    SCTB        BASE CATALOG TRACK ENTRY (FOR OVERFLOW)
          ADDWRD TCAT,X1
          SX7    B0+         CLEAR FET+6
          SA7    C+6
          SA7    SCTB+1      CLEAR OVERFLOW TRACK NUMBER
          SX5    -NWCE/8     (CATALOG ENTRY IN 8 WORD PARCELS)
          READ   C
 SCT2     READW  C,WBUF,NWCE
          SX5    X5+NWCE/8   (CATALOG ENTRY IN 8 WORD PARCELS)
          NZ     X1,SCT1     IF EOI ON TRACK
          SA1    SCTA        CATALOG ENTRIES PER TRACK (8 WORD PARCELS) 
          IX1    X5-X1
          NG     X1,SCT3     IF STILL ON SAME TRACK 
          SA1    SCTB+1      INCREMENT OVERFLOW TRACK NUMBER
          SX6    X1+B1
          SA6    A1 
          SYSTEM MPF,R,SCTB,6S6  GET OVERFLOW TRACK FST 
          SA1    SCTB+2 
          SX5    B0          RESET TO FIRST ENTRY ON TRACK
          ADDWRD TCAT,X1
          SA1    CN          INCREMENT CURRENT TRACK NUMBER 
          SA2    CC          INCREMENT NUMBER OF CATALOG TRACKS 
          SX6    X1+B1
          SX7    X2+B1
          SA6    A1 
          SX1    X6-MXCT
          SX0    SCTE        * TOO MANY OVERFLOW CATALOG TRACKS.* 
          PL     X1,ERR      IF TOO MANY TRACKS FOR THE FIELD SIZE
          SA7    A2 
 SCT3     SA1    WBUF+FCUI
          SA4    A1+B1
          ERRNZ  1-FCUI-FCBS CODE DEPENDS ON *FCUI*, *FCBS* VALUES
          ERRNZ  FCBT-FCBS   CODE DEPENDS ON *FCBT*, *FCBS* VALUES
          ERRNZ  FCBT-FCLF   CODE DEPENDS ON *FCBT*, *FCLF* VALUES
          LX4    59-11
          NG     X4,SCT7     IF DIRECT ACCESS FILE
          MX2    -12         CHECK FOR ZERO TRACK 
          BX2    -X2*X4 
          ZR     X2,SCT2     IF DISK SPACE RELEASED 
          SA2    CN 
          LX2    24+18
          SX7    X5+
          LX7    24 
          PX7    X7 
          BX7    X7+X2
          MX3    -18
          BX3    -X3*X1      USER INDEX 
          NZ     X3,SCT4     IF FILE (NOT HOLE) 
          MX3    1           SET HOLE FLAG
          BX7    X7+X3
          EQ     SCT5        ISOLATE HOLE FLAG
  
 SCT4     SX3    X3-IFUI     CHECK IF CATALOGED UNDER *IFUI*
          NZ     X3,SCT5     IF NOT A FLAWED SECTOR CHAIN 
          SX3    B1          SET IMMOVABLE FILE FLAG
          LX3    57-0 
          BX7    X7+X3
          SA3    WBUF+FCLF   GET LENGTH 
          MX6    -24
          LX3    24 
          BX6    -X6*X3      FLAW LENGTH
          SX3    B1 
          LX6    30 
          IX6    X6+X3       30/ LENGTH,30/ COUNT 
          SA3    FW 
          IX6    X6+X3
          SA6    A3 
 SCT5     LX4    11-59
          MX3    -24
          BX0    -X3*X4      (X0 IS UNCHANGED BY ADDWORD) 
          BX1    X0+X7
          MX3    1
          BX3    X3*X7       ISOLATE HOLE FLAG
          BX0    X0+X3       SAVE HOLE FLAG 
          ADDWRD TFRI,X1
          SA2    OF          ONSET FILES
          PL     X0,SCT6     IF FILE
          SA2    OH          ONSET HOLES
 SCT6     MX3    1
          BX0    -X3*X0      REMOVE HOLE FLAG 
          SA1    WBUF+FCLF
          MX3    24 
          BX1    X3*X1
          BX1    X0+X1       24/ LENGTH,12/ 0,12/ TK,12/ SC 
          BX6    X1*X3       LENGTH 
          LX6    30-36+60 
          SX3    B1 
          IX6    X6+X3       30/ LENGTH,30/ COUNT 
          IX6    X6+X2
          SA6    A2          UPDATE (OF) OR (OH)
          SA2    LT          CHECK IF *TFHL* TABLE IS ACTIVE
          NZ     X2,SCT2     IF *TFHL* IS NOT ACTIVE
          ADDWRD TFHL,X1
          EQ     SCT2        LOOP 
  
 SCT7     MX3    -18
          BX3    -X3*X1 
          NZ     X3,SCT2     IF DIRECT ACCESS FILE IN USE 
          SA2    CN 
          MX3    1
          LX2    24+18
          SX1    X5+
          LX1    24 
          PX1 
          BX1    X1+X2
          BX1    X1+X3       SET HOLE BIT 
          ADDWRD TAPE,X1     TABLE OF AVAILABLE PFC ENTRIES 
          EQ     SCT2        LOOP 
  
  
 SCTA     CON    0        CATALOG ENTRIES PER TRACK (8 WORD PARCELS)
 SCTB     BSS    0        *MPF* PARAMETER BLOCK (FN=6)
          CON    0        BASE CATALOG TRACK FST
          CON    0        NUMBER OF OVERFLOW TRACK WHOSE FST IS DESIRED 
          CON    0        OVERFLOW TRACK FST (RETURNED) 
*                         (12/EQ,12/FT,12/FT,12/0,12/5) 
 SCTC     DATA   C/ CREATING CATALOG TRACK TABLES./ 
 SCTD     DATA   C/ CATALOG FST CURRENT SECTOR .NE. ZERO./
 SCTE     DATA   C* TOO MANY OVERFLOW CATALOG TRACKS.*
 SRA      SPACE  4,15 
**        SRA - SET RANDOM ADDRESS. 
* 
*         ENTRY  (X5) = 36/ ,12/ TK, 12/ SC.
* 
*         EXIT   (X6) = RANDOM SECTOR ADDRESS.
*                TO *ERR* IF ERROR. 
* 
*         USES   X - ALL. 
*                A - 1, 3, 4, 7.
*                B - 6, 7.
  
  
 SRA3     BX4    -X0*X1 
          IX6    X4-X2
          NG     X6,SRA2     IF NOT ON CHAIN
          IX6    X7+X2
          LX7    12 
          BX7    X7+X4
          SA7    A1          PRESET LENGTH
  
 SRA      SUBR               ENTRY/EXIT 
          MX0    -12
          BX2    -X0*X5      SECTOR 
          AX5    12 
          BX5    -X0*X5      TRACK
          SB7    59-11       SHIFT FOR TRACK BIT
          SA1    F.TTLT 
          SB6    X1-1S11     FWA - 4000B
          SA4    FT          FIRST TRACK OF IAPF CHAIN
          SA3    SL          SECTORS/TRACK
          BX7    X7-X7
          SA1    B6+X5
          BX6    X0*X1
          ZR     X6,SRA1     IF LENGTH NOT PREDETERMINED
          BX7    X6          PRECALCULATED LENGTH 
          AX7    12 
          EQ     SRA3        SET RSA AND EXIT 
  
 SRA1     SA1    B6+X4
          BX6    X4-X5
          ZR     X6,SRA3     IF TRACK LOCATED 
          IX7    X7+X3
          LX6    X1,B7
          PL     X6,SRA2     IF END OF CHAIN
          BX4    -X0*X1 
          EQ     SRA1        LOOP 
  
 SRA2     SX0    SRAA        * DISK ADDRESS NOT ON CHAIN.*
          EQ     ERR         ABORT
  
  
 SRAA     DATA   C* DISK ADDRESS NOT ON CHAIN.* 
 SST      SPACE  4,30 
**        SST - SHELL SORT TABLE. 
* 
*         *SST* SORTS A TABLE USING A SHELL SORTING TECHNIQUE.
*         THE TABLE IS SORTED IN PLACE INTO ASCENDING ORDER.
*         ALL ELEMENTS SHOULD BE OF THE SAME SIGN.
* 
*         ORIGIN OF TECHNIQUE IS CACM VOL 6 NUMBER 5 MAY 1963, P209.
*         FIRST CODED BY R. HOTCHKISS IN *SORT1*. 
*         REVISED BU L. A. LIDDIARD.
*         MODIFIED TO PERFORM MASKED SORT BY D. F. LINTON 
*                                        AND C. A. LACEY, 1975. 
* 
*         ENTRY  (B7) = ADDRESS OF TABLE TO BE SORTED.
*                (X1) = NUMBER OF ELEMENTS IN ARRAY.
* 
*         EXIT   TABLE SORTED.
* 
*         USES   X - 0, 1, 2, 3, 4, 6, 7. 
*                B - 2, 3, 4, 5.
*                A - 1, 2, 6, 7.
  
  
 SST1     SA7    B5-B4       T(J+K) = S 
          SB2    B2+B1       I = I+1
          EQ     B2,B3,SST4  IF END OF TABLE
 SST2     SA2    B2+         S = T(I) 
          SB5    B2+B4       J = I-K
          BX7    X2 
 SST3     SA1    B5+
          BX2    -X0*X2 
          BX6    X1 
          BX1    -X0*X1 
          IX3    X2-X1       COMPARE S AND T(J) 
          PL     X3,SST1     IF ELEMENTS IN ORDER 
          SB5    B5+B4       J = J-K
          SA6    A1-B4
          GE     B5,B7,SST3  IF J .NE. FIRST
          EQ     SST1        CONTINUE 
  
 SST4     AX4    1           K = K/2
          SB4    X4+         (B4) = -K
          SB2    B7-B4       I = FIRST+K
          NZ     X4,SST2     IF K .NE. 0
  
 SST      SUBR               ENTRY/EXIT 
          MX0    -24
          MX4    12          K = 2**(ENTIER(LOG2(COUNT)+1)
          SB3    B7+X1       (B3) = LAST+1
          NX6,B2 X1 
          AX4    X4,B2
          EQ     SST4        BEGIN SORTING
          SPACE  4,10 
*         PRESET COMMON DECKS.
  
  
*CALL     COMCARG 
*CALL     COMCCPM 
*CALL     COMCDXB 
*CALL     COMCRDW 
          SPACE  4,10 
          QUAL   *
 PRS      EQU    /PRS/PRS 
          SPACE  4,10 
          ERRNG  RFL=-*      INITIAL FIELD LENGTH TOO SHORT 
          SPACE  4
          END 
