Retro1.org codex

          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