software: Added more and more
[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape7 / FOTP.PA
diff --git a/sw/os8/v3d/sources/system/dectapes/dectape7/FOTP.PA b/sw/os8/v3d/sources/system/dectapes/dectape7/FOTP.PA
new file mode 100644 (file)
index 0000000..28abecb
--- /dev/null
@@ -0,0 +1,1638 @@
+/3.1 OS/8 V3 FOTP              5-AUGUST-1975   (NOT HALLOWEEN)
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/COPYRIGHT  (C)  1974,1975 BY DIGITAL EQUIPMENT CORPORATION
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
+/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
+/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
+/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
+/
+/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
+/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
+/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
+/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
+/
+/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
+/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
+/DIGITAL.
+/
+/
+/
+/
+/
+/
+/
+/
+/
+/
+\f/WITH FAILSAFE CHANGES        NOV 17, 1973    R.L.
+
+
+/  FOTP (FILE ORIENTED TRANSFER PROGRAM)   H.J.
+
+
+/CORE MAP
+
+/FROM TOP OF CORE
+
+/      FIELD 2 GETS CONDITIONALLY USED AS BUFFER
+
+/      FIELD 1
+/              7777-7600       MONITOR
+/              7577-4600       INCORE OUTPUT DIRECTORY
+/              4577-2000       FOTP CODE
+/              1777-0          RESIDENT USR
+/
+/      FIELD 0
+/              7777-7600       MONITOR
+/              7577-7200       ERROR MESSAGES
+/              7177-0          WORK AREA AS:
+/
+/              AT TOP- OUTPUT HANDLER IF NEEDED
+/                      1 OR 2 PAGES
+
+/                      INPUT HANDLER IF NEEDED
+/                      1 OR 2 PAGES
+
+/                      INPUT DEVICES DIRECTORY
+/                      (ONLY USED PORTION)
+
+/                      THE TRANSFER BUFFER IN 8K
+/                      IS WHAT EVER REMAINS.
+
+/FIXES FOR MAINTENANCE RELEASE: (S.R. 5-AUG-75)
+
+/1.    CHANGED COPYRIGHT DATE
+/2.    INCORPORATED SEQ #1 PATCH (DSN MARCH 1975)
+/      PERMITS FOTP TO RECOVER FROM A MONITOR ERROR 6
+/      BY UNFAKING THE SYSTEM HANDLER
+/3.    UPDATED FOTP VERSION NUMBER TO V8
+/4.    ADDED SPACE FOR A PATCH LEVEL
+/5.    ALLOWED /T SWITCH TO WORK IN CONJUNCTION WITH /R
+/6.    PERMITS RENAMING A FILE TO IT'S OWN NAME
+/7.    IF NO OUTPUT DEVICE IS SPECIFIED WITH /R,
+/      ASSUME OUT DEV=INPUT DEVICE.
+
+/8.    FIXED BUG RE ADDITIONAL INFO WORDS
+\f/PAGE 0 LOCATIONS OS/8 USR WON'T MANGLE
+
+       PTR=20
+       CNT=21
+       INFPTR=22
+       OUHAND=23
+       INHAND=24
+       FPAGE=25
+       EPTR=26
+       INSCNT=27
+       TEMP=30
+       OKFLAG=31
+       IFCNT=32
+       BUFSIZ=33
+       INFWDS=34
+       BDPTR=35
+       GPTR1=36
+       INEOF=37
+
+/AUTO INDEX REGISTERS USR WILL ALLOW ME TO USE TEMPORARILY
+
+       XR=10
+       XR1=11
+       XR2=12
+
+
+/VARIOUS CONSTANTS THAT CAN BE GENERATED
+
+       AC2=CLA CLL CML RTL
+       AC4000=CLA CLL CML RAR
+       ACM2=CLA CLL CMA RAL
+       ACM3=CLA CLL CMA RTL
+
+/      LOCATIONS REFERENCED IN OS/8
+
+       ALTOPT=7642
+       OPT1=7643
+       OPT2=7644
+       DATE=7666
+       DIRKEY=7        /"DIRECTORY SEGMENT IN CORE" KEY
+
+/SYMBOLIC FOTP LOCATIONS:
+
+OUBUFR=        4600            /OUTPUT BUFFER - IN FIELD 1
+INBUFR=        0               /INPUT BUFFER - IN FIELD 0
+LSTFPG=        7000            /FIRST LOC OF LAST FREE PAGE IN FIELD 0
+FAKHND=        200             /LOCATION OF OS/8 FAKEOUT HANDLER
+VERSION=       11      /VERSION NUMBER
+SUBVER=                01      /SUB VERSION (PATCH LEVEL)
+                       /LOCATED AT "VERLOC" AS 60+VERSION^100+SUBVER
+\f/STARTS AT 4600 IN FIELD 1 (ONCE ONLY CODE)
+
+/SAVE INFO:
+
+/      .LOAD FOTP(89P)
+/      .SAVE SYS FOTP;14600
+
+       FIELD 1
+       *2000
+
+CDCALL,        JMS I (200      /SEE WHAT THE PERSON WANTS
+FIVE,  5
+STAR,  5200            /IN SPECIAL MODE
+
+BYPSCD,        JMS I (INTERC   /CATCH CALLS TO 7600
+
+       TAD I (7600     /SAVE USER OUTPUT DEVICE
+       DCA I (USEROD   /-FOR LATER
+
+
+/ CHECK FOR ? IN OUTPUT SPECIFICATION
+       TAD (-10        /8CHARACTERS TO LOOK AT
+       DCA CNT         /CNT HAVING -10 PUTS US AT FIRST CHAR
+S1C,   TAD (7605
+       JMS I (GTSXBT   /GET A CHAR
+       TAD (-"?!7700   /CHECK FOR ?
+       SNA CLA
+       JMP QINO        /? IN OUTPUT NOT ALLOWED
+       ISZ CNT
+       JMP S1C
+
+/ CHECK FOR EMBEDDED * IN ANY SPECIFICATION
+
+       TAD (7605
+S4L,   DCA PTR
+       TAD (-10
+       DCA CNT
+ACK,   TAD PTR
+       JMS I (GTSXBT
+       TAD (-"*!7700   /CHECK TO SEE IF CHARACTER *
+       SZA CLA         /SKIP IF IT IS
+       JMP CNTUP       /GO LOOK AT NEXT
+       AC2
+       TAD CNT         /ARE WE AT EXTENSION
+       SZA             /SKIP IF YES
+       TAD (6          /ARE WE AT START OF FILENAME?
+       SNA CLA         /SKIP IF NOT
+       ISZ CNT         /BUMP COUNT ONLY IF OK
+       TAD PTR         /LOOK AT NEXT CHAR
+       JMS I (GTSXBT
+       SZA CLA         /SKIP IF ITS NULL - OK
+       JMP AINO        /ERROR
+CNTUP, ISZ CNT         /BUMP TO NEXT CHAR
+       JMP ACK         /CONTINUE CHECKING
+       TAD I PTR       /ANY MORE INPUT
+       SNA CLA         /SKIP IF THERE IS
+       JMP NULLCK
+       TAD FIVE        /BUMP TO NEXT ENTRY
+       TAD PTR
+       JMP S4L
+\f/ CHECK FOR NULL OUTPUT SPECIFICATION AND MAKE *.*
+
+NULLCK,        TAD I (7601     /WAS OUTPUT FILENAME GIVEN?
+       SZA CLA         /SKIP IF NONE
+       JMP DIDEML
+       TAD STAR        /PUT AN ASTERISK IN
+       DCA I (7601     /FILENAME
+       TAD STAR
+       DCA I (7604     /AND EXTENSION
+
+/THIS CODE SETS A DEFAULT OUTPUT DEVICE ON DELETE
+
+DIDEML,        TAD I (7600     /IS AN OUTPUT DEVICE SPECIFIED?
+       SZA             /SKIP IF NOT
+       JMP ODSPEC      /NOTE DEVICE NUMBER IN AC
+       TAD I (OPT1     /CHECK FOR /D
+       AND (400
+       SZA CLA         /SKIP IF NOT /D
+       JMP MOV         /OUTPUT=INPUT
+       TAD I (OPT2     /V3C
+       AND (100        /CHECK FOR /R
+       SZA CLA         /V3C
+MOV,   TAD I (7605     /WE'LL SUBSTITUTE FIRST INPUT DEVICE FOR USER
+ODSPEC,        AND (17         /CLEAR USER SPECIFIED LENGTH
+       DCA I (7600     /WE KNOW BETTER
+
+/THE FOLLOWING BRINGS IN THE OUTPUT DEVICE HANDLER,
+/READS THE DIRECTORY INTO CORE AND VERIFIES IT.
+
+       TAD (LSTFPG     /SET THE FREE SPACE POINTER
+       DCA FPAGE       /TO THE LAST FREE PAGE IN FIELD 0
+       TAD I (7600     /IS THERE AN OUTPUT DEVICE?
+       SZA             /IF NO OUTPUT, DON'T FETCH HANDLER
+       JMS I (ASSIGN   /GET THE HANDLER AND ALLOCATE ITS SPACE
+       DCA OUHAND      /AC RETURNS HANDLER ENTRY POINT
+       JMS I (ODIRIN   /READ IN THE OUTPUT DIRECTORY
+       TAD (7605       /INGIALIZE INPUT POINTER
+
+/THIS IS THE BEGINING OF THE INPUT FILE LOOP
+
+DOMOIN,        DCA INFPTR      /POINTER TO CURRENT INPUT
+       TAD I INFPTR    /WHEN 0 NO MORE INPUT
+       SNA             /SKIP IF MORE TO DO
+       JMP I (ENDCHK   /DO END PROCESSING
+       JMS I (ASSIGN   /ASSIGN AND ALLOCATE SPACE FOR INPUT HANDLER
+       DCA INHAND      /AND SAVE ITS ENTRY ADDRESS
+
+/THE FOLLOWING 2 INSTRUCTIONS HELP AVOID ALL KINDS OF
+/PROBLEMS WITH THE MONITOR.  IF A HANDLER GETS LOADED, THE
+/MONITOR MAKES IT RESIDENT FOR OTHER PEOPLE AND DOESN'T DELETE
+/ITS RESIDENT STATUS IF A REQUEST IS MADE FOR A NEW HANDLER
+/TO BE LOADED OVER IT IF THE NEW HANDLER IS ALREADY RESIDENT
+
+       TAD FPAGE       /SAVE FREE SPACE POINTER HERE
+       DCA SFUDG
+       JMP I (PG1      /LINK TO NEXT SECTION
+
+SFUDG, 0
+\fONDERR,       JMS I (ERROR
+       ODRERR+40       /ERROR READING OUT DIR
+AINO,  JMS I (ERROR
+       ILLA+40         /ILLEGAL *
+QINO,  JMS I (ERROR
+       ILLQ+40         /ILLEGAL ?
+
+       PAGE
+\f/CHECK FOR NON FILE STRUCTURED INPUT
+/WE CAN'T HANDLE IT
+
+PG1,   TAD I INFPTR
+       TAD (7757
+       DCA TEMP
+       TAD I TEMP      /IS FILE STRUCTURED BIT ON
+       SMA CLA         /SKIP IF IT IS
+       JMP NFIN        /ERROR
+       CIF 0
+       JMS I INHAND    /READ INPUT DEVICES DIRECTORY
+       1400
+IDBUF, INBUFR
+       1
+       JMP INDERR      /ERROR
+       CDF 0
+       TAD I IDBUF     /MAKE SURE THAT THE
+       CMA CLL         /DIRECTORY OF
+       TAD I (INBUFR+2 /THE DEVICE IS
+       CDF 10          /GOOD
+       SNL
+       TAD (7700       /(SEE COMMENT ON TEST IN ROUTINE "ODIRIN")
+       SZL CLA         /SKIP IF ITS GOOD
+       JMP BIDIR       /ERROR
+
+/FIND LAST BLOCK OF DIRECTORY
+
+       AC2             /LINK TO NEXT SGMENT NUMBER
+FNDLST,        DCA PTR         /SAVE IT
+       CDF 0
+       TAD I PTR       /IS THERE ANOTHER SEGMENT?
+       SNA CLA         /SKIP IF YES
+       JMP ATIT        /NO...WE ARE POINTING TO LAST
+       TAD PTR         /BUMP TO NEXT SEGMENT
+       TAD (400
+       JMP FNDLST      /LOOK AGAIN
+ATIT,  ACM3            /AC=7775
+       AND PTR         /AND OUT 2'S BIT
+       TAD (400        /TOTAL SIZE OF IN CORE DIRECTRY
+       CIA             /NEGATE FOR ISZ
+       DCA CNT
+       TAD FPAGE       /WE ARE GOING TO PACK DIRECTORY
+       TAD (200        /RIGHT UP TO INPUT HANDLER SO
+       TAD CNT         /WE GET MAX SIZE TRANSFER BUFFER
+       DCA FPAGE       /ADJUSTED FREE CORE POINTER
+       CMA
+       TAD FPAGE
+       DCA XR1         /SET UP PLACE TO MOVE TO
+       CMA
+       DCA XR2         /ALWAYS COMES FROM 0
+       TAD I XR2       /MOVE
+       DCA I XR1       /IT
+       ISZ CNT
+       JMP .-3
+\f/SET SAME DEVICE FLAG FLAG 4000 IF /D
+
+       CDF 10
+       TAD I (OPT1
+       AND (400
+       RTL CLL         /PUT /D BIT INTO AC 0
+       RAL
+       DCA SDFLG
+
+
+/ COUNT NUMBER OF INPUTS FROM SAME DEVICE
+/ALSO MAKE NULL INPUT FILENAMES *.*
+/BUT ONLY IF NOT /D
+
+       TAD INFPTR      /OK LETS GO THROUGH
+       DCA PTR         /THE INPUT SPECIFICATIONS
+GETCNT,        ISZ PTR         /POINT TO FILENAME WORD
+       TAD (3          /SET TEMP TO POINT TO EXTENSION
+       TAD PTR
+       DCA TEMP
+       TAD SDFLG       /ARE WE DOING /D
+K7450, SNA             /SKIP IF YES - AC NON 0
+       TAD I PTR       /NO /D - LOOK AT FILENAME
+       SZA CLA         /ITS NULL PUT IN *.*
+       JMP NOSUB       /DONT CHANGE IT
+       TAD (5200       /MAKE IT *
+       DCA I PTR
+       TAD (5200       /.*
+       DCA I TEMP
+NOSUB, CLA IAC         /TEMP+1 POINTS TO NEW INPUT
+       TAD TEMP
+       DCA PTR
+/NOTE CNT WAS SET BY ISZ'ING TO ZERO
+       ISZ CNT         /KEEP COUNT OF DEVICES IN GROUP
+       TAD I (OPT2     /CHECK FOR /U (UGLY SWITCH)
+       AND (10
+       SZA CLA         /SKIP IN NO /U
+       JMP NOPTIM      /WERE FORCED TO DO ONE AT A TIME
+       TAD I PTR       /COMPARE DEVICE NUMBERS
+       CIA             /IN A GROUPING
+       TAD I INFPTR
+       SNA CLA         /SKIP IF NEW GROUP
+       JMP GETCNT      /WE'LL DO ALL THE SAME AT ONCE
+NOPTIM,        TAD CNT
+       CIA             /NEGATE COUNT
+       DCA INSCNT      /AS NUMBER OF INPUTS TO DO AT ONCE
+       TAD PTR         /SAVE WHERE TO CONTINUE FOR REST
+       DCA I (MOIN
+\f/THE FOLLOWING CHECKS TO SEE IF A OPERATION
+/IS BEING DONE FROM A DEVICE TO ITSELF
+
+       TAD I (7600     /GET DEVICE NUMBER
+       TAD (7646       /HANDLER ENTRY POINT TABLE
+       DCA TEMP
+       TAD I INFPTR    /GET INPUT ENTRY POINT
+       TAD (7646
+       DCA PTR
+       TAD I PTR       /CHECK INPUT ENTRY POINT AGAINST
+       CIA
+       TAD I TEMP      /OUTPUT ENRTY POINT
+       SNA CLA         /SKIP IF THEY ARE DIFFERENT
+       ISZ SDFLG       /SET SAME DEVICE FLAG, AC11
+       TAD FPAGE       /SET POINTER TO
+       DCA BDPTR       /START OF DIRECTORY
+       DCA TYPFND      /CLEAR FOUND FILE FLAG
+       JMP I (NBLOCK   /LINK TO SOME MORE
+
+TYPFND,        0
+SDFLG, 0               /NEGATIVE MEANS /D, ODD MEANS OUTPUT DEV=INPUT DEV
+
+NFIN,  JMS I (ERROR
+       NFLEIN+40       /NON FILE STRUCTED INPUT
+INDERR,        JMS I (ERROR
+       BADIRD+40       /ERROR READING INPUT DIR
+BIDIR, JMS I (ERROR
+       BIDIRM+40       /NOT A GOOD DIRECTORY
+
+       PAGE
+\f/THIS IS THE SUPERQUASIFACETED DIRECTORY PATTERN MATCHING ROUTINE
+
+/THE INPUT DIRECTORY IS SEARCHED HERE, IF A MATCH
+/IS FOUND USING THE INPUT GROUPING
+/GOT1 GETS CONTROL WITH -BLOCKS IN THE AC
+
+NBLOCK,        STA
+       TAD BDPTR       /POINTER TO START OF DIR BLOCK
+       DCA XR
+       CDF 0
+       TAD I XR        /GET COUNT OF NUMBER OF ENTRIES
+       DCA ENTCNT      /SAVE LOCALLY TO AVOID HERB'S BUG
+       TAD I XR        /GET BLOCK NUMBER FIRST FILE
+       DCA BLOCK
+       TAD I XR        /NEXT SEGMENT NUMBER
+       DCA LFLAG       /IF IT 0 WE AT END
+       ISZ XR          /SKIP TENTATIVE FILE WORD
+       TAD I XR        /GET -NUMBER OF INFO WORDS
+       CIA             /MAKE POSITVE
+       DCA INFWDS
+       TAD XR          /POINT TO FIRST
+       IAC             /ENTRY
+       DCA EPTR
+
+BLOOP, TAD I EPTR      /GET FILENAME WORD
+       CDF 10
+       SNA CLA         /SKIP IF FILE HERE
+       JMP EMPTY       /NO... ITS REALLY AN EMPTY
+       TAD INSCNT      /SET NUMBER OF INPUT TO LOOK
+       DCA NCNT        /AT ALL AT ONCE
+       DCA MATFLG      /CLEAR MATCH FLAG
+       TAD INFPTR      /ADDRESS OF FIRST INPUT
+       SKP
+MN1,   TAD GPTR2       /ADDRESS OF CURRENT INPUT
+       TAD (5          /GTSXBT SUBR REQUIRES US TO
+       DCA GPTR2       /POINT TO END OF FIELD
+       TAD EPTR        /POINT DIRECTORY POINTER TO
+       TAD (4          /END OF ENTRY FOR SAME REASON
+       DCA GPTR1
+       TAD GPTR1       /SET EPNEXT TO POINT TO
+       TAD INFWDS      /MINUS NUMBER OF BLOCKS IN
+       DCA EPNEXT      /FILE WORD
+       TAD (-10        /NUMBER OF CHARS TO LOOK AT
+WILDNM,        DCA CNT
+\fMLP,  TAD GPTR2       /OK - GET A CHARACTER FROM
+       JMS I (GTSXBT   /STRING
+       TAD (-"*!7700   /IS IT AN *
+       SNA             /SKIP IF NOT *
+       JMP WILDA       /YEP... ITS A WILD CARD
+       TAD ("*-"?      /IS IT A ?
+       SNA             /SKIP IF NOT
+       JMP WILD        /YES... FORCE MATCH ON THIS CHAR
+       TAD ("?&77      /RESTORE VALUE
+       CIA             /NEGATE
+       DCA CHAR        /AND SAVE
+       TAD GPTR1       /NOW GET CHAR FROM DIRECTORY
+       CDF 0
+       JMS I (GTSXBT
+       CDF 10
+       TAD CHAR        /DO CHARS MATCH
+       SZA CLA         /SKIP IF THEY DO
+       JMP NM1         /NO MATCH ON THIS INPUT
+WILD,  ISZ CNT         /BUMP COUNT OF CHARS & POINTER
+       JMP MLP         /COMPARE ALL 8
+MEXT,  ISZ MATFLG      /A MATCH!!!!!!!
+NM1,   CLA             /WILD CARD COMES HERE WITH ICHY AC
+       ISZ NCNT        /HAVE WE CHECKED GROUP OF INPUTS
+       JMP MN1         /NO CHECK WHOLE GROUP
+       TAD MATFLG      /HAVE THERE BEEN ANY MATCHES
+       SZA CLA         /SKIP IF NOT
+       TAD (4          /WILL INVERT /V SWITCH
+       TAD I (OPT2     /ADD SWITCH
+       AND (4          /ISOLATE IT
+       CDF 0
+/SKIPS IF INPUT DIRECTORY ENTRY IS NOT CANDIDATE
+/THAT IS - IF A MATCH WAS NOT FOUND BETWEEN ANY
+/OF THE INPUTS AND /V WAS NOT SPECIFIED   OR
+/A MATCH WAS FOUND AND /V WAS SPECIFIED
+
+/THIS ALLOWS /V TO MEAN EVERYTHING BUT...
+
+       SZA CLA
+       TAD I EPNEXT    /GET -NUMBER OF BLOCKS
+       CDF 10
+       SZA             /SKIPS IF TENTATIVE OR NOT CANDIDATE
+       JMP I (GOT1     /PROCESS FILE
+NENT,  TAD EPNEXT      /POINT EPTR TO BLOCK
+       DCA EPTR        /COUNT OF FILE
+       SKP
+EMPTY, ISZ EPTR        /ON EMPTY MAKE EPTR POINT TO BLOCK COUNT
+       CDF 0
+       TAD I EPTR      /GET BLOCK COUNT
+       CIA             /MAKE POSITIVE
+       TAD BLOCK
+       DCA BLOCK       /KEEP SUM
+       ISZ EPTR        /POINT TO NEXT ENTRY
+       ISZ ENTCNT      /BUMP THE NUMBER OF ENTRIES
+       JMP BLOOP       /NOT DONE WITH SEGMENT
+       CDF 10
+       TAD (400        /BUMP TO NEXT SEGMENT
+       TAD BDPTR
+       DCA BDPTR
+       TAD LFLAG       /DID WE PROCESS LAST SEGMENT
+       SZA CLA         /SKIP IF WE DID
+       JMP NBLOCK      /PROCESS NEW SEGNENT
+       TAD I (SFUDG    /RESET FREE CORE POINTER
+       DCA FPAGE       /TO PRESERVE INPUT HANDLER IF PRESENT
+       JMP I (SAYNON
+
+/HANDLE WILD CARDS
+
+WILDA, TAD CNT         /GET CURRENT CHAR POSITION
+       TAD (6          /ADD SIZE OF FILENAME
+       SPA             /SKIP IF IN EXTENSION FIELD
+       JMP WILDNM      /THIS BUMPS TO EXTENSION
+       JMP MEXT        /THIS MEANS IT HAS TO BE A MATCH
+
+
+CHAR,  0
+EPNEXT,        0
+GPTR2, 0
+LFLAG, 0
+NCNT,  0
+BLOCK, 0
+MATFLG,        0
+ENTCNT,        0
+
+
+       PAGE
+\fGOT1, DCA IFCNT       /-# OF BLOCKS IN AC
+       JMS I (DATCHK   /VERIFY IF /C OR /O ALSO MATCH
+       ISZ I (TYPFND   /COMES BACK IF THEY DO - 
+                       /TURN OFF NO FILES MSG FOR THIS INPUT GROUP
+       TAD I (OPT2     /CHECK FOR /T
+       AND (20
+       SNA CLA         /SKIP IF /T
+       TAD INFWDS      /SEE IF DATE PRESENT
+       CDF 0
+       SZA CLA         /SKIP IF NO DATE OR /T
+       TAD I GPTR1
+       CDF 10
+       SZA             /SKIP IF NO DATE OR /T
+       DCA I (DATE     /GIVE MONITOR FILES DATE
+       TAD (-4         /MAKE 2 COPIES
+       DCA CNT         /OF THE INPUT
+       CMA             /FILE NAME IN
+       TAD EPTR        /FIELD 1 TO
+       DCA XR          /WORK WITH THEM
+       TAD (SPOT-1     /MAKE THEM AT SPOT
+       DCA XR1         /AND SPOT1
+       TAD (SPOT1      /SPOT1 WILL ALWAYS
+       DCA PTR         /CONTAIN THE ORIGINAL
+MOVENT,        CDF 0           /AND SPOT WILL
+       TAD I XR        /CONTAIN THE
+       CDF 10          /UPDATED VERSION AS
+       DCA I PTR       /REFLECTED FROM
+       TAD I PTR       /THE OUTPUT SPECIFICATION
+       ISZ PTR         /-
+       DCA I XR1       /-
+       ISZ CNT         /-
+       JMP MOVENT      /-
+       TAD I (7601     /GET OUTPUT FILENAME
+       TAD (-5200      /WAS IT *
+       SNA CLA         /SKIP IF NOT
+       JMP TSTEXT      /YES... LEAVE FILENAME ALONE
+       TAD I (7601     /REPLACE INPUT NAME
+       DCA I (SPOT     /WITH GIVEN
+       TAD I (7602     /OUTPUT
+       DCA I (SPOT+1   /SPECIFICATION
+       TAD I (7603
+       DCA I (SPOT+2   /-
+TSTEXT,        TAD I (7604     /SEE IF EXTENSION
+       TAD (-5200      /WAS *
+       SNA CLA         /SKIP IF IT WASNT
+       JMP .+3         /LEAVE INPUT DEFAULT ALONE
+       TAD I (7604     /REPLCE EXTENSION
+       DCA I (SPOT+3   /WITH GIVEN EXTENSION
+       DCA TRFLG       /CLEAR THE TRANSFER FLAG
+       TAD I (OPT2     /IS /R ON?
+       AND (100
+       TAD I (SDFLG    /OR /D OR INPUT DEV=OUTPUT DEV?
+       SNA             /SKIP IF ANY
+       JMP SETGD       /WE ARE DEFINITELY OK
+       SMA CLA         /IF /D THEN CHECK OUTPUT
+       TAD (SPOT1-SPOT /OTHERWISE INPUT
+       JMS I (LOOKUP
+       JMP NSETGD      /NO OUTPUT FILE GIVEN
+       SNA             /AC=BLOCK NO OF FILE OR 0 IF NONE
+       JMP I (NENT     /NO FILE - DO NOTHING
+       DCA TEMP        /SAVE - WE MIGHT NEED IT
+       TAD I (SDFLG    /IF OPERATION IS TRANSFER THEN
+                       /TRFLG IS SET IF FILE HAS NOT
+                       /MOVED; IF /D TRFLG MUST NOT BE
+                       /SET ; WE DONT CARE ABOUT
+                       /RENAME - ITS IRRELEVANT.
+       SMA CLA         /SKIP IF /D- WILL CAUSE TRFLG=0
+       TAD TEMP        /GET THE BLOCK FILE IS NOW AT
+       CIA             /CHECK AGAINST ORIGINAL
+       TAD I (BLOCK    /LOCATION
+       SNA CLA         /SKIP IF IT MOVED - NOTE THAT
+                       /IF THIS SKIPS THE USER IS DOING
+                       /A PLAY WITH DEATH OPERATION
+SETGD, ISZ TRFLG       /ENABLE TRANSFERING OF THE FILE
+NSETGD,        TAD I (SDFLG    /SET UP TO PROMPT OR LIST
+       SPA CLA         /SKIP IF NOT /D
+       TAD (SPOT-SPOT1 /USE OUTPUT NAME
+       TAD (SPOT1+4    /USE INPUT NAME
+       JMS I (PRINTE   /SEE IF HE WANTS TO BE PROMPTED
+FLSRSM,        TAD I (OPT2
+       RTL             /PUT /N INTO LINK
+       AND (400        /ISOLATE /R OPTION
+       SZA CLA         /SKIP IF NOT /R
+       JMP I (RENAME   /GO TO RENAME CODE
+       TAD I (SDFLG    /CHECK FOR NO /D AND SAME DEV
+       SPA SNA CLA     /SKIP IF NO /D AND SANE DEV
+       TAD I (7600     /IS THERE AN OUTPUT?
+       SNA SZL         /SKIP IF NO /N AND OUTPUT DEV
+                       /DIDNT SKIP IF NO /D AND SAME DEVICE
+       JMP NODEL       /DONT DELETE
+       JMS I (FAKUSR   /FAKE USR HANDLER CALLS
+       JMS I (200      /CALL USR
+       4               /CLOSE
+       SPOT            /OUTPUT FILE NAME
+       0
+       CLA SKP         /O.K. TO GET CLOSE ERROR NOW
+       ISZ I (WRTDIR   /SIGNAL CHANGE MADE TO DIRECTRY
+       JMS I (UNFAK    /FIXUP HANDLER ADDRESS AGAIN
+NODEL, CLA
+       TAD TRFLG       /SET AC NOT 0 IF TRANSFER GO AHEAD
+       JMP I (NPG      /LINK TO SOME MORE
+
+TRFLG, 0
+
+
+       PAGE
+\f/THIS PAGE OF CODE PERFORMS FILE MOVES FROM
+/INPUT TO OUTPUT
+
+NPG,   SNA CLA         /SKIP IF WE CAN DO TRANSFER
+       JMP NFUNCT      /GO PROCESS NEXT ENTRY
+
+/THE FOLLOWING SMALL STRANGE PIECE OF CODE
+/DYNAMICALLY ALLOCATES THE BUFFER ACCORDING
+/TO THE FREE SPACE IN FIELD 0 (INCLUDING
+/DIRECTORY SHRINKING) OR ALLOCATES 15 BLOCKS
+/IN FIELD 2 IF ITS AVAILABLE.
+
+F2C1,  TAD (7400       /BECOMES  TAD EPTR  IF ONLY 8K
+       AND (7400       /CALCULATE FREE SPACE
+       RAL CLL         /SIZE
+       RTL             /AND SAVE
+       RTL             /IT
+       DCA BUFSIZ
+       TAD IFCNT       /SET THE OUTPUT 
+       CIA             /FILE COUNT
+       DCA OFCNT       /AS POSITIVE NIMBER OF BLOCKS
+       TAD OFCNT       /SET THE NUMBER
+       AND (7400       /OF BLOCKS
+       SNA CLA         /UP FOR ENTER
+       TAD OFCNT       /IF IT IS LESS
+       RTL CLL         /THAN 256 OR
+       RTL             /SET IT TO 0
+       DCA TEMP        /FOR FILES GREATER THAN 256
+       TAD (SPOT       /SET THE ADDRESS OF THE
+       DCA SBLKN       /OUTPUT NAME
+       TAD I (7600     /IS THERE AN OUTPUT FILE?
+       SNA             /SKIP IF THERE IS
+       JMP NFUNCT      /DO NO TRANSFER
+       TAD (7757       /INDEX INTO TENTATIVE FILE
+       DCA MSIZE       /TABLE IN ORDER TO
+       TAD I MSIZE     /CLEAR OUT ANY
+       AND (7770       /TENTATIVE WE DONT WANT
+       DCA I MSIZE     /THIS COMES IF AN I/O ERROR HIT
+       TAD I (7600     /DO THE ENTER
+       JMS I (FAKUSR   /MAKE USR USE IN CORE HANDLER
+       TAD TEMP        /ADD IN BLOCK COUNT
+       JMS I (200
+       3               /ENTER
+SBLKN, SPOT
+MSIZE, 0
+       JMP I (NOROOM   /ENTER FAILED
+       TAD I (SVDATE   /RESTORE REAL DATE TO MONITOR
+       DCA I (DATE
+       JMS I (UNFAK    /REMOVE OUR FAKE HANDLER
+       JMS I (ADDINF   /COPY ADDITIONAL INFO WORDS
+       TAD IFCNT       /SEE IF ENTER SIZE
+       STL CIA         /GIVEN BACK IS
+       TAD MSIZE       /ENOUGH - HANDLES >255 AND
+       SNL SZA CLA     /NON FILE STRUCTURED
+       JMP I (NOROOM   /LENGTHS. NOT ENOUGH
+       DCA INEOF       /CLEAR INPUT END OF FILE
+       TAD SBLKN       /SET THE OUTPUT BLOCK NUMBER
+       DCA OBLCKN
+       TAD I (BLOCK    /SET THE INPUT BLOCK NUMBER
+       DCA BLOCKN
+
+\f/THE FOLLOWING PIECE OF CODE IS A TRICKY PIECE
+/THAT CALCULATES THE NUMBER OF BLOCKS TO READ
+
+MOVEIT,        TAD IFCNT       /GET THE NUMBER OF BLOCKS
+       CLL             /ITS NEGATIVE
+       TAD BUFSIZ      /ADD ON BUFFER SIZE
+       SNL             /SKIP IF MORE ROOM AVAILABLE THAN NEEDED
+       DCA IFCNT       /OTHERWISE RESAVE NEW COUNT
+       SZL             /SKIP IF NOT AT END OF FILE
+       ISZ INEOF       /SET END OF FILE INDICATOR
+       CIA             /MAKES -BUFSIZ+COUNT
+       TAD BUFSIZ      /MAKES COUNT OF NUMBER OF BLOCK
+       RTR CLL         /BUILD THE
+       RTR             /INPUT CONTROL
+       RTR             /WORD
+F2C2,  TAD (20         /BECOMES NOP IF ONLY 8K
+       DCA INCTLW      /SET INPUT CONTROL WORD
+       JMS I (CINTER   /CHECK FOR ^C
+       SKP             /SKIP IF NOT
+       JMP I (CTCDE    /ABORT OPERATION
+       CIF 0
+       JMS I INHAND    /READ INPUT HUNK
+INCTLW,        0
+       0
+BLOCKN,        0
+       JMP I (RDERR    /WELL- SCRATCH THAT FILE
+       TAD BLOCKN      /UPDATE BLOCK COUNT
+       TAD BUFSIZ
+       DCA BLOCKN
+       AC4000          /SET THE OUTPUT
+       TAD INCTLW      /CONTROL WORD
+       DCA OUCTLW
+       JMS I (CINTER   /CHECK FOR ^C
+       SKP             /SKIP IF NOT
+       JMP I (CTCDE    /ABORT OPERATION
+       ISZ I (MUSTWT   /SIGNAL REAL OUTPUT DONE
+       CIF 0
+       JMS I OUHAND    /WRITE A HUNK OF FILE
+OUCTLW,        0
+       0
+OBLCKN,        0
+       JMP I (WRTERR   /WHAT A CRUMBY OUTPUT DEVICE
+       TAD OBLCKN      /UPDATE THE
+       TAD BUFSIZ      /OUTPUT FILE
+       DCA OBLCKN      /BLOCK NUMBER
+       TAD INEOF       /SEE IF THATS ALL FOLKS
+       SNA CLA         /SKIP IF WE TRANSFERED FILE
+       JMP MOVEIT      /DO SOME MORE
+       TAD I (7600     /OK - LETS MAKE IT PERMANENT
+       JMS I (FAKUSR   /TELL USR TO USE INCORE HANDLER
+       JMS I (200
+       4               /CLOSE
+       SPOT
+OFCNT, 0
+       JMP I (CLOERR   /THIS IS IMPOSSIBLE (I HOPE)
+       JMS I (UNFAK    /ENABLE SYSTEM USE OF REAL HANDLER
+       ISZ I (WRTDIR   /SET WE CHANGED DIRECTORY FLAG
+NFUNCT,        JMP I (NENT     /I KNOW ITS INEFFICIENT TO JUMP HERE
+                       /BUT- IT'S CLEAN...
+       PAGE
+\f/HERE COMES GOBBS AND GOBBS OF GOODY LITTLE ROUTINES
+
+/FIRST WE HAVE A NICE LITTLE ROUTINE WHICH WILL DO
+/HANDY LITTLE THINGS LIKE FETCH A HANDLER
+/AND IN ADDITION ALLOCATE THE SPACE FOR IT.
+/JUST IMAGINE THIS CAN BE YOURS FOR THE LOW LOW PRICE
+/OF 23 INSTRUCTIONS
+
+ASSIGN,        0
+       DCA TEMP        /SAVE DEVICE NUMBER
+       TAD TEMP
+       JMS I (200
+       12              /INQUIRE ABOUT HANDLER
+HADDR1,        0
+       JMP I (CLOERR   /CANT HAPPEN (I HOPE)
+       TAD HADDR1      /DID WE GET BACK ADDRESS
+       SZA             /SKIP IF NOT- NON-RESIDENT
+       JMP I ASSIGN    /YES... RETURN ITS ENTRY POINT
+       SKP
+TWOPAG,        IAC             /TURN ON 2-PAGE BIT
+       TAD FPAGE       /GET FREE SPACE POINTER
+       DCA HADDR2      /SET FOR FETCH
+       TAD FPAGE       /TAKE AWAY
+       TAD (-200       /PAGE FROM
+       DCA FPAGE       /FREE SPACE
+       TAD TEMP        /GET DEVICE NUMBER
+       JMS I (200
+       1               /FETCH
+HADDR2,        0
+       JMP TWOPAG      /FAILED- MUST BE 2-PAGER
+       TAD HADDR2      /RETURN ENTRY POINT ADDRESS
+       JMP I ASSIGN
+\f/THIS UTILITY ROUTINE RETURNS A SIS BIT
+/CHARACTER FROM ANY FIELD (SET ON ENTRY)
+/FROM ADDRESS IN AC-COUNT(IN HALF WORDS)
+
+GTSXBT,        HLT
+       CLL RAL         /DOUBLE POINTER ADDRESS
+       TAD CNT         /ADD NEGATIVE DISPLACEMENT
+       CML RAR         /GET WORD ADDRESS AGAIN
+       DCA TEMP        /SAVE IT
+       TAD I TEMP      /GET WORD
+       SNL             /SKIP IF WE WANT RIGHT HALF
+       JMS ROTR6       /MAKE LEFT HALF RIGHT HALF
+       AND (77         /GET LOW SIX BITS
+       JMP I GTSXBT
+
+
+ROTR6, 0
+       RTR
+       RTR
+       RTR
+       JMP I ROTR6
+
+/THIS TAKES A SIX BIT CHAR IN AC AND CONVERTS
+/IT TO ASCII TO TYPE IT
+
+CONVTP,        HLT
+       SZA             /CONVERT 0 TO BLANKS
+       TAD (240
+       AND (77
+       TAD (240
+       JMS I (TYPE     /TYPE IT
+       JMP I CONVTP
+\f/TYPE TAKES A CHARACTER IN THE AC AND CALLS
+/TTY TO TYPE IT IF ^O IS NOT IN AFFECT
+/ALSO CHECKS FOR ^C AND ^P
+
+TYPE,  HLT
+       DCA READKB      /SAVE CHARACTER
+       JMS I (CINTER   /SEE IF ^C
+       SKP             /NO
+       JMP I (CTCDE    /ABORT OPERATION IF ^C OR ^P
+       TAD (217        /^O
+       JMS I (CTYPE    /SEE IF TYPED
+       SKP             /SKIP IF NOT
+       DCA ECHO        /CLEAR ECHO SWITCH
+       TAD ECHO        /IS ECHO IN EFFECT
+       SNA CLA         /SKIP IF YES
+       JMP I TYPE      /IGNORE CHARACTER IF ^O
+       TAD READKB      /TYPE CHAR
+       JMS TTY
+       JMP I TYPE
+
+TTY,   0
+       DCA TCHAR       /SAVE CHAR
+       TAD TCHAR       /GET CHAR BACK
+                       /** NEXT 4 LOCATIONS REPLACED IF BATCH ACTIVE BY:
+TTYOUT,        TLS             /** SKP
+       TSF             /** 7400        /ADDRESS OF BATCH OUTPUT ROUTINE
+       JMP .-1         /** CIF TOPFIELD
+       CLA             /** JMS I .-2
+       TAD TCHAR       /GET CHAR AGAIN
+       TAD (-215       /IF WE JUST TYPED A C.R. TYPE
+       SZA CLA         /A L.F.
+       JMP I TTY
+       TAD (12
+       JMP TTY+1
+TCHAR, 0
+
+/GET A CHARACTER FROM KEYBOARD AND
+/CHECK FOR ^C AND ^P
+
+READKB,        HLT
+       KSF
+       JMP .-1
+       JMS I (CINTER   /IS IT ^C
+       SKP             /SKIP IF NOT
+       JMP I (CTCDE    /YES
+       KRB             /READ IT
+       AND (177        /AND GET RID OF
+       TAD (200        /PARITY
+       JMP I READKB
+\f/ROUTINE TO MAKE SURE USER SPECIFIED
+//C AND /O SWITCHES CAUSE CORRECT MATCH WITH DATE
+
+DATCHK,        0
+       TAD I (OPT1     /CHECK /C
+       JMS MDATE
+       NOP             /RETURN HERE WITH AC=0 IF NO /C
+       SZA CLA         /RETURN HERE WITH AC=0 IF DATES MATCH
+       JMP I (NENT     /DATES DONT MATCH AND /C GIVEN
+       TAD I (OPT2     /CHECK /V
+       JMS MDATE
+       CMA CLA         /SET AC=-1 IF NO /V
+       SNA CLA         /RETURN HERE AC=0 IF DATES SAME
+       JMP I (NENT     /DATES SAME WITH /V-IGNORE FILE
+       JMP I DATCHK    /CONTINUE
+
+MDATE, 0               //O AND /V ARE AC2
+       RTL             /IS IT OPTION ON?
+       SMA CLA         /SKIP IF IT IS
+       JMP I MDATE     /NO- RETURN WITH 0 AC
+       ISZ MDATE       /SKIP RETURN
+       CDF 0
+       TAD I GPTR1     /GET DATE WORD
+       CIA
+       CDF 10
+       TAD I (SVDATE   /COMPARE WITH MONITORS, 0 IF =
+       JMP I MDATE
+
+ECHO,  1
+
+
+       PAGE
+\f/THIS IS THE CORE DEVICE HANDLER
+/THE USR IS MADE TO COME HERE BY A CALL TO FAKUSR.
+/THIS HANDLER SWAPS THE DESIRED BLOCK INTO
+/THE USR AREA AND WRITES THE BLOCK BACK INTO THE
+/INCORE DIRECTORY.
+
+/THE CODE SET UP IN FIELD 0 TO CALL THE HANDLER IS:
+/      *FAKHND
+/      0               /ENTRY POINT
+/      TAD FAKHND      /GET RETURN ADDRESS
+/      CIF CDF 10
+/      JMP I .+1       /PLOP UP TO BODY OF HANDLER IN FIELD 1
+/      FAKBDY
+
+
+FAKBDY,        DCA RETLOC      /SAVE ARGUMENT ADDRESS
+       TAD I RETLOC    /GET CONTROL WORD
+       RAL             /R/W BIT INTO LINK
+       CLA RAL         /R/W BIT INTO AC11
+       TAD DCAXR1      /IF WRITE MAKE DCA XR2 ELSE XR1
+       DCA DCASPT      /SAVE WHERE WE NEED IT
+       ISZ RETLOC      /BUMP TO LOCATION (ALWAYS 1400 FROM USR)
+       ISZ RETLOC      /BUMP TO BLOCK NUMBER
+       TAD I RETLOC    /GET IT
+       ISZ RETLOC      /BUMP TO ERROR RETURN
+       ISZ RETLOC      /NOW TO GOOD RETURN (WE WONT FAIL)
+       CLL RTR         /MULTIPLY BY 400(8)
+       RTR
+       RAR
+       TAD (4177       /ADD ON TO BEGINING OF DIRECTRY
+DCAXR1,        DCA XR1         /SAVE IN BOTH XR1
+       TAD XR1
+       DCA XR2         /AND XR2
+       TAD (1377       /NOW SAVE USR BLOCK AREA
+DCASPT,        HLT             /IN EITHER XR1 OR XR2 (R OR W)
+       TAD (-400       /SET WORD TRANSFER COUNT 
+       DCA CNT
+       TAD I XR2       /GET A WORD
+       DCA I XR1       /PUT A WORD
+       ISZ CNT
+       JMP .-3
+       JMP I RETLOC    /GO BACK TO USR
+\f/THIS ROUTINE DOES THE SETUP OF THE INCORE
+/DIRECTORY HANDLER AND CHANGES THE REAL
+/HANDLERS ENTRY POINT IN THE MONITOR SO THAT
+/THE USR WILL CALL IT.
+
+FAKUSR,        0
+       DCA UNFAK       /SAVE DEVICE NUMBER
+       TAD UNFAK       /INDEX INTO MONITORS RESIDENCY
+       TAD (7646       /TABLE
+       DCA TABAD
+       TAD WRTDIR      /SEE IF DEVICE HAS DIRECTORY
+       SPA CLA         /SKIP IF IT DOES
+       JMP NOSUBST     /!!!DONT CHANGE IF NON-FILE DEV
+       TAD (FAKHND     /PUT OUR HANDLERS ADDRESS IN
+       DCA I TABAD     /MONITORS TABLE
+NOSUBST,CDF 0
+       TAD (1200       /PUT IN HANDLER INTERFACE CODE
+       DCA I (FAKHND+1 /INTO FIELD 0 AS GIVEN ABOVE
+       TAD (CIF CDF 10
+       DCA I (FAKHND+2
+       TAD (5604
+       DCA I (FAKHND+3
+       TAD (FAKBDY
+       DCA I (FAKHND+4
+       CDF 10
+       TAD UNFAK       /RETURN WITH DEVICE NUMBER IN AC
+       JMP I FAKUSR
+
+UNFAK, 0
+       CLA             /V3C
+       TAD OUHAND      /RESET MONITORS TABLE TO
+       DCA I TABAD     /POINT TO REAL HANDLER
+       DCA TABAD       /V3C
+       JMP I UNFAK
+
+TABAD, 0
+RETLOC,        0
+\f/ENTER HERE IF A BRANCH TO 7600 OR 7605 OCCURS
+
+FIXDIR,        JMS UNFAK       /JUST IN CASE
+       JMS I (CINTER   /CHECK FOR ^C
+       NOP
+       AC4000          /EITHER WAY GO BACK TO
+       DCA I (ALTOPT   /MONITOR BUT AFTER WE HANDLE DIRECTORY
+CTCDE, TAD MUSTWT      /IS MUST WRITE SET?
+       SNA CLA         /SKIP IF /Q OR MUST WRITE
+       TAD WRTDIR      /CHECK TO SEE IF WE HAVE TO
+       SPA SNA CLA     /WRITE THE DIRECTORY
+       JMP ENDCHK      /CONTINUE
+       DCA WRTDIR      /KEEP OLD DIRECTORY
+       JMS I (ERROR    /TELL HIM
+       DSVED+40
+
+ENDCHK,        ISZ I (ECHO     /TURN ON ECHO
+       JMS DIROUT      /WRITE OUT THE OUTPUT DIRECTORY
+       JMS I (RESTORE  /RESTORE 7600 IN FIELD 0
+       TAD I (OPT2     /GET OPTION /W
+       RTR
+       SNL CLA         /SKIP FOR VESION NUMBER
+       JMP NOVER
+       DCA I (OPT2     /STOPS RECUSION WITH ^P
+       JMS I (ERROR    /PRINT VERSION NUMBER
+       VERNO+40
+       TAD (215
+       JMS I (TYPE
+NOVER, TAD I (ALTOPT   /GO BACK TO MONITOR?
+       SMA CLA         /SKIP IF YES
+       JMP I (CDCALL   /CALL THE CD AGAIN
+       CIF CDF 0       /RETURN TO MONITOR
+       JMP I (7605
+
+
+MUSTWT,        0
+SVDATE,        0
+WRTDIR,        0
+\fDIROUT,       0               /ROUTINE TO WRITE THE OUTPUT DIRECTORY
+       TAD WRTDIR      /AC>0 IF WE HAVE TO WRITE IT
+       SPA SNA CLA     /SKIP TO WRITE DIRECTORY
+       JMP I DIROUT
+       CIF 0
+       JMS I OUHAND    /WRITE DIRECTORY BACK ONTO DEVICE
+       5410
+       4600
+       1
+       JMP I (ODERR    /IS HE IN TROUBLE...
+       DCA WRTDIR      /CLEAR WRITE DIRECTORY FLAG
+       JMP I DIROUT    /RETURN
+       PAGE
+\f/ROUTINE WHICH ECHOES ^(CHAR) AND SKIP RETURNS IF
+/ONE WE WANTED
+
+CTYPE, 0
+       DCA T2          /SAVE CHARACTER
+       TAD (200        /GT RID OF PARITY
+       KRS             /SEE WHATS IN BUFFER
+       CIA
+       TAD T2          /COMPARE AGAINST DESIRED ONE
+       SNA CLA         /SKIP IF NOT ONE
+       KSF             /IS FLAG UP?
+       JMP I CTYPE     /NO... JUST RETURN
+       KCC             /CLEAR CHARACTER
+       TAD ("^         /OUTPUT ^
+       JMS I (TTY
+       TAD T2
+       TAD (100        /CHAR
+       JMS I (TTY
+       TAD (215
+       JMS I (TTY
+       ISZ CTYPE       /SKIP RETURN
+       JMP I CTYPE
+
+T2,    0
+
+/ROUTINE USED TO DETERMINE IF ^C OR ^P TYPED
+
+CINTER,        0
+       TAD (203        /CHECK FOR ^C
+       JMS CTYPE
+       JMP UPPCK       /NO  CHECK FOR ^P
+       JMP SPURGE      /YES SET ALTMODE BIT
+UPPCK, TAD (220
+       JMS CTYPE
+       JMP I CINTER    /NOT EITHER ^P OR ^C
+       SKP             /IF ^P CLEAR ALTMODE BIT
+SPURGE,        CMA             /SET BIT
+       DCA I (ALTOPT
+       ISZ CINTER      /SKIP RETURN
+       JMP I CINTER
+\f/THIS ROUTINE MODIFIES THE THE MONITOR RETURN
+/LOCATIONS TO COME BACK TO FOTP AND SAVES WHAT
+/WAS THERE SO RESTORE CAN RESTORE THEM
+
+INTERC,        0
+       TAD I (DATE
+       DCA I (SVDATE   /SAVE MONITOR DATE
+       CDF 0
+       TAD I (7600     /SAVE 7600,7601,7602,7605
+       DCA SCODE       /AND REPLACE WITH
+       TAD (CIF CDF 10 /CIF CDF 10
+       DCA I (7600     /JMP I .+1
+       TAD I (7601     /FIXDIR
+       DCA SCODE+1     /7605 GETS JMP 7600
+       TAD (5602       /THIS ENABLES FOTP TO WRITE
+       DCA I (7601     /OUT DIRECTORY AN MANUAL ABORT
+       TAD I (7602     /OR IF HANDLER PICKS UP ^C
+       DCA SCODE+2     /AND TRIES TO GO TO MONITOR
+       TAD (FIXDIR
+       DCA I (7602
+       TAD I (7605
+       DCA SCODE+3
+       TAD (5200
+       DCA I (7605
+       CDF 10
+       JMP I INTERC
+
+/THIS ROUTINE SIMPLY RESTORES THE MONITOR
+/LOCATIONS TO THEIR ORIGINAL VALUE
+
+RESTORE,0
+       TAD I (SVDATE   /RESTORE DATE
+       DCA I (DATE
+       CDF 0
+       TAD SCODE
+       DCA I (7600     /RESTORE LOCATIONS
+       TAD SCODE+1
+       DCA I (7601
+       TAD SCODE+2
+       DCA I (7602
+       TAD SCODE+3
+       DCA I (7605
+       CDF 10
+       JMP I RESTORE
+
+SCODE, 0;0;0;0
+\f/THIS IS THE MAGIC MESSAGE PRINTER
+/IT IS ACTUALLY USED MORE THAN JUST FOR ERROR MESSAGES
+/IF THE MESSAGE ENDS WITH A % THEN THE OPERATION
+/IS ABORTED OTHERWISE CONTROL IS RETURNED
+/TO THE CALLER AND NO CRLF IS GIVEN
+/ALL MESSAGES COMMING THROUGH HERE ARE ECHOED
+
+ERROR, 0
+       CLA CLL         /JUNK MIGHT BE IN AC
+       TAD I (ECHO     /SAVE ECHO STATUS SO WE CAN
+       DCA I (ECTMP    /RESTORE IT AFTER MESSAGE
+       ISZ I (ECHO     /TURN ON ECHO
+       TAD (-100       /USED SO WE CAN USE GTSXBT TO
+       DCA CNT         /UNPACK THE MESSAGES
+PLOOP, TAD I ERROR     /CONTAINS ADDRESS OF MESSAGE
+       CDF 0           /IN FIELD 0
+       JMS I (GTSXBT   /GET CHARACTER
+       CDF 10
+       TAD (-45        /IS IT %
+       SNA             /SKIP IF NOT
+       JMP CRLF        /WE HIT EOM AND CALLER NO WANT CONTROL
+       TAD ("%&77      /RESTORE CHARACTER
+       DCA DFLAG       /SAVE IT FOR LATER
+       TAD DFLAG       /PRINT IT, 0 PRINTS AS BLANK
+       JMS I (CONVTP
+       ISZ CNT         /BUMP TO NEXT CHAR IN MESSAGE
+       TAD DFLAG       /ARE WE AT END
+       SZA CLA         /SKIP IF WE ARE
+       JMP PLOOP       /DO ANOTHER CHARACTER
+       ISZ ERROR       /SKIP ADDRESS OF MESSAGE
+       JMP I ERROR     /RETURN
+CRLF,  TAD (215        /PRINT CR
+       JMS I (TYPE     /LF
+       JMP I (ENDCHK   /FINISH PROCESSING
+
+DFLAG, 0
+       PAGE
+\f/THIS ROUTINE PRINTS A FILENAME.EXTENSION
+
+PNMSUB,        0
+       DCA NMEPLC      /SAVE ADDRESS OF NAME
+       TAD (-10        /SET CHAR COUNT
+       DCA CNT
+PNLOOP,        TAD NMEPLC      /GET THE SIXBIT CHAR
+       JMS I (GTSXBT
+       SZA             /SKIP IF NULL CHAR
+       JMS I (CONVTP   /PRINT CHAR
+       TAD (3          /SEE IF AT START OF
+       TAD CNT         /EXTENSION
+       SZA CLA         /SKIP IF SO
+       JMP .+3
+       TAD (".         /PRINT THE DOT
+       JMS I (TYPE
+       ISZ CNT
+       JMP PNLOOP      /KEEP GOING
+       JMP I PNMSUB
+
+NMEPLC,        0
+ECTMP, 0
+
+RDERR, JMS I (ERROR
+       INERR+40        /ERROR READING FILE
+DYSTF1,        TAD (SPOT1+4    /PRINT INPUT FILE NAME
+DYSTUF,        JMS I (PNMSUB
+       TAD (215
+       JMS I (TYPE
+       TAD ECTMP       /RESTORE ECHO FLAG AS
+       DCA I (ECHO     /SAVED ON ENTRY TO ERROR
+       JMP I (NENT     /GO TO NEXT FILE
+WRTERR,        JMS I (ERROR
+       OUERR+40        /ERROR WRITING FILE
+POUTNM,        TAD (SPOT+4     /PRINT OUTPUT FILE NAME
+       JMP DYSTUF
+NORUMX,        JMS I (ERROR    /NOT ENOUGH ROOM FOR
+       SPRBLM+40       /FILE ON OUTPUT DEVICE
+       JMP DYSTF1
+\f/ROUTINE WHICH PRINTS NO FILES MSG IF NECESSARY
+/IT WONT PRINT MESSAGE IF ANY FILE IN A SO CALLED
+/INPUT GROUP MATCHES(A BUG?)
+
+SAYNON,        TAD I (TYPFND   /GET INPUT MATCH FLAG
+       SZA CLA         /SKIP IF NOTHING MATCHED
+       JMP GOBCK       /DONT DO MESSAGE
+TLP,   JMS I (ERROR    /PRINT MESSAGE
+       NOFILE+40
+       TAD INFPTR      /POINT TO END OF INPUT ENTRY
+       TAD (5          /TO MAKE GTSXBT WORK CORRECTLY
+       DCA INFPTR
+       TAD INFPTR      /PRINT THE FILE NAME
+       JMS I (PNMSUB
+       TAD (OTAB-2     /NOW PRINT /V,/C,/O IF
+       DCA XR2         /ANY OF THEM SPECIFIED
+NOPT1, ISZ XR2         /FIX POINTER WHEN SWITCH NOT ON
+NOPT,  TAD I XR2       /GET ADDRESS OF OPTION
+       SNA             /SKIP IF NOT AT END
+       JMP CRIT        /WE ARE AT END
+       DCA TEMP
+       TAD I TEMP      /GET OPTION WORD
+       AND I XR2       /AND WITH OPTION BIT
+       SNA CLA         /SKIP IF OPTION GIVEN
+       JMP NOPT1       /DO ANOTHER
+       TAD ("/         /PRINT /
+       JMS I (TYPE
+       TAD I XR2       /OPTION
+       JMS I (TYPE
+       JMP NOPT        /DO ANOTHER
+CRIT,  TAD (215        /END WITH A CRLF
+       JMS I (TYPE
+       TAD ECTMP       /RESTORE ECHO FLAG THAT ERROR
+       DCA I (ECHO     /SAVED
+       ISZ INSCNT      /PRINT MESSAGE FOR ALL FILES
+       JMP TLP         /IN GROUP
+GOBCK, TAD I (USEROD   /GET USER SPECIFIED DEVICE
+       SNA CLA         /SKIP IF HE GAVE ONE
+       TAD I (SDFLG    /IF HE DIDNT WE CANT HANDLE /D
+       SPA CLA         /SKIP IF NO /D
+       TAD I MOIN      /YEP. /D BETTER NOT BE ANY MORE INPUT
+       SZA CLA         /THERE WASN'T - O.K.
+       JMP DELERR      /WARN HIM OF THE SHORTCOMING
+       TAD MOIN        /GET SAVED INPUT POINTER
+       JMP I (DOMOIN   /AND DO SOME MORE INPUTS
+
+DELERR,        JMS I (ERROR
+       CNTDEL+40       /MULTIPLE DEVICE DELETE
+       TAD (215
+       JMS I (TYPE
+       JMS I (ERROR
+       CNTDE2+40
+
+USEROD,        0
+MOIN,  0
+\f/TABLE OF SWITCHES FOR "NO FILES" MESSAGE
+
+OTAB,  OPT2
+       4
+       "V
+       OPT1
+       1000
+       "C
+       OPT2
+       1000
+       "O
+       0
+
+       PAGE
+\f/THIS ROUTINE HANDLES THE /L AND /Q OPTIONS
+/IF EITHER IS ON IT PRINTS THE NAME
+/THEN IF ITS /Q IT PRINTS A ? AND WAITS FOR
+/A RESPONSE. IF Y IT RETURNS, ANYTHING ELSE
+/AND IT GOES TO PROCESS THE NEXT DIRECTORY ENTRY
+
+PRINTE,        0
+       DCA I (NMEPLC   /SAVE ADDRESS OF NAME
+       TAD I (OPT1     /CHECK /L
+       RAR
+       SZL CLA         /SKIP IF NO /L
+       JMP PIT         /PRINT NAME
+       TAD I (OPT2     /CHECK /Q
+       AND (200
+       SNA CLA         /SKIP IF /Q
+       JMP I PRINTE    /RETURN
+       ISZ I (ECHO     /IF /Q FORCE ECHO ON
+PIT,   TAD I (NMEPLC   /NOW PRINT FILENAME
+       JMS I (PNMSUB
+       DCA OKFLAG      /CLEAR OKFLAG
+       TAD I (OPT2     /WAS IT /Q?
+       AND (200
+       SNA CLA         /SKIP IF /Q
+       JMP FUNCT2      /JUST PRINT CRLF
+       TAD ("?         /PRINT ?
+       JMS I (TYPE
+       CMA             /SET OKFLAG NO GOOD
+       DCA OKFLAG
+       JMS I (READKB   /GET A CHAR
+       TAD (-"Y        /IS IT Y?
+       SNA CLA         /SKIP ON NO
+       ISZ OKFLAG      /IT WAS Y, SET OK AND SKIP
+       TAD ("N-"Y      /GET N
+       TAD ("Y         /GET Y
+       JMS I (TYPE     /ECHO IT
+FUNCT2,        TAD (215        /PRINT CRLF
+       JMS I (TYPE
+       TAD OKFLAG      /OKFLG=0 MEANS YES
+       SZA CLA         /SKIP IF TO PROCESS FILE
+       JMP I (NFUNCT   /SKIP THIS FILE
+       JMP I PRINTE    /RETURN
+
+ODERR, CLA
+       DCA I (WRTDIR   /FIX RECURSION
+       JMS I (ERROR
+       ODIERR+40       /ERROR WRITING DIRECTORY
+BODIR, JMS I (ERROR
+       BODORM+40       /BAD OUTPUT DIRECTORY
+CLOERR,        JMS I (ERROR
+       SERR+40         /SYSTEM ERROR
+       HLT             /DONT LET HIM CONTINUE
+       JMP .-1         /IT CAN ONLY GET WORSE
+
+SPOT,  ZBLOCK 4        /ROOM FOR OUTPUT FILE NAME
+SPOT1, ZBLOCK 4        /ROOM FOR INPUT FILE NAME
+\f/CODE TO HANDLE OUT OF ROOM CONDITION ON OUTPUT DEVICE
+
+NOROOM,        JMS I (UNFAK    /RESTORE THE REAL OUTPUT HANDLER
+       TAD I (OPT1
+       AND (100        /CHECK FOR THE /F OPTION SPECIFIED
+       SNA CLA
+       JMP I (NORUMX   /NO - GIVE AN ERROR MESSAGE
+       JMS I (DIROUT   /FAILSAFING - WRITE OUT THE OUTPUT DIRECTORY
+       JMS I (ERROR    /PRINT THE MESSAGE
+       FLSFMS+40       /"MOUNT NEXT OUTPUT VOLUME"
+       JMS I (READKB   /GET AN ANSWER
+       CLA             /ANY CHAR EXCEPT ^C OR ^P IS YES
+       TAD (215
+       JMS I (TYPE     /PRINT CRLF
+       JMS ODIRIN      /READ IN THE NEW OUTPUT DIRECTORY
+       JMP I (FLSRSM   /RECOMPUTE THE PENDING TRANSFER.
+
+ODIRIN,        0               /SUBROUTINE TO READ IN THE OUTPUT DIRECTORY
+       TAD I (7600     /GET OUTPUT DEVICE NUMBER
+       SNA             /IS IT PRESENT?
+       JMP NOUTFL      /NO - DON'T READ OUTPUT DIRECTORY
+       TAD (7757       /ADD ADDRESS OF MONITOR TABLE
+       DCA TEMP        /TO INDEX INTO IT
+       TAD I TEMP      /FILE STRUCTURED BIT IS 0
+       SMA CLA         /SKIP IF DIRECTORY DEVICE
+       JMP NOUTFL      /WE DONT WANT TO READ OR WRITE DIRECTORY
+       CIF 0
+       JMS I OUHAND    /READ DIRECTORY
+       1410
+ODBUF, OUBUFR
+       1
+       JMP I (ONDERR   /ERROR
+       TAD I ODBUF
+       CMA CLL         /CHECK FOR LEGAL OUTPUT DIRECTORY - FIRST
+       TAD I (OUBUFR+2 /WORD OF AN OS/8 DIRECTORY IS .LT. 50
+       SNL             /AND THE THIRD WORD MUST BE .LT. 7,
+       TAD (7700       /SO WE CAN CHECK FOR THE SUM OF THOSE
+       SZL CLA         /WORDS BEING .LT. 64
+       JMP I (BODIR    /ERROR - CANT BE DIRECTORY
+       SKP
+NOUTFL,        AC4000          /WRTDIR MINUS MEANS DONT WRITE
+       DCA I (WRTDIR   /DIRECTORY
+       DCA I (MUSTWT   /CLEAR THE MUST WRITE FLAG
+       DCA DIRKEY      /CLEAR THE OS/8 DIRECTORY KEY
+       JMP I ODIRIN    /RETURN
+       PAGE
+\f/SUBROUTINE TO DO LOOKUPS ON OUTPUT DEVICE
+/DOES IMMEDIATE RETURN IF NO OUTPUT DEVICE
+/OTHERWISE RETURNS WITH BLOCK OF FILE IN AC   OR
+/0 IN AC MEANING NOT FOUND OR NON-FILE STRUCTURED DEVICE
+LOOKUP,        0
+       TAD (SPOT       /ADDRESS OF FILE NAME
+       DCA PLACE
+       TAD I (7600     /GET OUTPUT DEVICE
+       SNA             /SKIP IF PRESENT
+       JMP I LOOKUP    /NO OUTPUT DEVICE
+       JMS I (FAKUSR   /FAKE OUT THE USR
+       JMS I (200
+       2               /LOOKUP
+PLACE, SPOT
+       0
+       DCA PLACE       /NOT FOUND, 0 PLACE
+       JMS I (UNFAK    /RESTORE RESIDENT HANDLER
+       ISZ LOOKUP      /SKIP RETURN
+       TAD PLACE       /WITH BLOCK IN AC
+       JMP I LOOKUP
+\f/HERE IS WHAT WE HAVE ALL BEEN WAITING FOR
+
+    //////////////////////////////////////
+   /                                   /
+  /            RENAME                 /
+ /                                   /
+//////////////////////////////////////
+
+RENAME,        JMS LOOKUP
+       JMP I (CLOERR   /SUPER SYSTEM DISASTER
+       DCA OBLOCK      /V3C SAVE BLOCK OF NEW NAME (IF ANY)
+       TAD (SPOT1-SPOT /LOOKUP INPUT FILE
+       JMS LOOKUP
+       JMP I (CLOERR   /SUPER SYSTEM DISASTER
+       CIA             /LOOKUP INPUT NAME ON OUTPUT DEVICE
+       TAD OBLOCK      /IS IT SAME SPOT AS NEW NAME ON OUTPUT DEVICE?
+       SZA CLA         /V3C
+       JMS EXERR       /NO, MAYBE ALREADY EXISTS
+       TAD I (1404     /GET ADDRESS OF FILE
+       TAD 17          /FROM MONITOR BY THE
+       TAD (-4         /DOCUMENTED METHOD
+       DCA TEMP
+       TAD (SPOT-1     /GET NEW OUTPUT NAME
+       DCA XR1
+       TAD (-4         /SET UP COUNT OF WORDS TO MOVE
+       DCA CNT
+RNAM,  TAD I XR1       /MOVE THEM
+       DCA I TEMP
+       ISZ TEMP
+       ISZ CNT
+       JMP RNAM        /CONTINUE TILL DONE
+       TAD I (1404     /V3C
+       SNA CLA         /BUT IS THERE ROOM FOR DATE?
+       JMP NONUDA      /NO, NO ADDITIONAL INFO WORDS
+       TAD I (DATE     /YES, MOVE DATE
+       DCA I TEMP      /INTO NEW FILENAME ENTRY
+NONUDA,        JMS WRKEY       /V3C
+       ISZ I (WRTDIR   /INDICATE DIRECTORY CHANGED
+       JMP I (NFUNCT   /DO NEXT FILE
+
+WRKEY, 0               /V9
+       TAD DIRKEY      /GET "SEGMENT IN CORE" KEY
+       AND (7          /ISOLATE SEGMENT NUMBER
+       DCA SEGNO       /NUMBER FOR WRITE
+       CIF 0
+       JMS I 51        /CALL HANDLER USR USED TO DO
+       4210            /LOOKUP, THIS POINTS TO FOTPS
+       1400            /INCORE DIRECTORY HANDLER
+SEGNO, 0               /REWRITE UPDATED DIRECTORY BLOCK
+       JMP I (CLOERR   /SYSTEM ERROR
+       JMP I WRKEY
+\fEXERR,        0               /BLOCK NUMBERS DIFFERENT
+       TAD OBLOCK      /LOOK AT BLOCK NUMBER OF EXISTING FILE
+       SNA CLA         /DID IT REALLY EXIST?
+       JMP I EXERR     /NO, OK TO RENAME TO THIS NAME
+       JMS I (ERROR    /YES, TRYING TO RENAME TO EXISTING NAME
+       RENERR+40       /FILE ALREADY EXISTS
+       JMP I (POUTNM
+
+OBLOCK,        0               /TEMPORARY, HOLDS BLOCK NUMBER OF ALREADY
+                       /EXISTING FILE WITH SAME NAME AS PROPOSED NEW NAME
+                       /ON OUT PUT DEVICE (OR 0 IF NONE)
+\f/THIS ROUTINE TRANSFERS THE ADDITIONAL
+/INFORMATION WORDS OF THE INPUT FILE WHEN COPYING
+/IT IF THERE ARE ANY
+
+ADDINF,        0
+       CLA IAC         /AC=1
+       TAD I (1404     /GET NUMBER OF WORDS FROM OUTPUT DIRECTORY
+       SMA             /SKIP IF 2 OR MORE
+       JMP NOTRAN      /WE DONT TOUCH IT
+       DCA LOOKUP      /SAVE NEGATIVE NUMBER TO MOVE
+       TAD LOOKUP      /ADD NUMBER TO LOC 17
+       TAD 17          /TO FIND ADDR(SECOND)
+       DCA PPTR1       /USE 17
+       TAD INFWDS      /GET NUMBER OF AIW IN INPUT
+       CIA             /NEGATE
+       IAC             /ADD 1
+       SMA             /SKIP IF MORE THAN 1 AIW
+       JMP ZEROUT      /ZERO OUTPUT AIW
+       DCA TEMP        /SAVE COUNT
+MOVEM, ISZ GPTR1       /BUMP PTR (1ST TIME PAST DATE)
+       CDF 0
+       TAD I GPTR1     /GET WORD
+ZLOOP, CDF 10
+       DCA I PPTR1     /PUT IT INTO OUTPUT DIRECTORY
+       ISZ PPTR1
+       ISZ LOOKUP      /HAS OUTPUT COUNT OVERFLOWED?
+       JMP MORE        /MORE OUTPUT TO DO
+       JMS WRKEY       /V9
+NOTRAN,        CLA             /EXIT
+       JMP I ADDINF    /WERE DONE
+MORE,  ISZ TEMP        /BUMP INPUT COUNT
+       JMP MOVEM       /IT HASNT OVERFLOWED
+ZEROUT,        CLA CMA         /NO MORE INPUT WORDS-
+       DCA TEMP        /SO FIX UP TO ZERO REST OF OUTPUT WORDS
+       JMP ZLOOP       /DO ALL THE OUTPUTS
+
+PPTR1, 0
+       PAGE
+\f/** THIS IS THE STARTING ADDRESS OF FOTP!!!
+
+FOTP,  JMS INIT        /REGULAR ENTRY POINT
+       JMS INIT        /CHAIN ENTRY POINT
+       JMP I (CDCALL   /CALL COMMAND DECODER
+       JMP I (BYPSCD   /DONT CALL COMMAND DECODER
+INIT,  0
+       ISZ INIT        /DO SKIP RETURN
+       CLA CLL
+       CDF 0
+       TAD I (7777     /GET BATCH CONTROL WORD
+       AND (70
+       TAD FCIF0       /FORM CIF TO BATCH FIELD
+       DCA BATCIF
+       TAD I (7777
+       CDF 10
+       RTL
+       SNL CLA         /BATCH RUNNING?
+       JMP NOBTCH      /NO
+BMOVLP,        TAD BATOUT
+       DCA I TTOUTP    /MOVE IN SUBSTITUTE TTY OUTPUT CODE
+       ISZ BMOVLP
+       ISZ TTOUTP
+       ISZ TTCNT4
+       JMP .-5
+       STA
+NOBTCH,        DCA CORFUJ      / =0 IF NO BATCH, -1 IF BATCH
+MOVMSG,        TAD I ONCE      /MOVE MSGS TO LOWER FIELD
+       CDF 0
+       DCA I ONLY
+       CDF 10
+       TAD I M1
+       CDF 0           /MOVE CORE DETERMINER
+       DCA I M1        /INTO FIELD 0 ALSO
+       CDF 10
+       ISZ M1
+       ISZ ONCE
+       ISZ ONLY
+       ISZ CODE
+       JMP MOVMSG
+       TAD (2000       /SET RESTART LOCATION
+       CDF 0
+       DCA I (7745
+       TAD (6403       /SET JSW
+       DCA I (7746
+       CDF 10
+FCIF0, CIF 0
+       JMS I (CORE
+       TAD CORFUJ      /COMPUTE AMOUNT OF CORE EXCLUDING BATCH FIELD
+       TAD (-1
+       SZA CLA         /SKIP IF WE HAVE ONLY 8K (OR 12K AND BATCH)
+       JMP I INIT
+       TAD (TAD EPTR   /PATCH LOCATIONS IN FOTP
+       DCA I (F2C1     /TO WORK WITH ONLY 8K
+       TAD (NOP
+       DCA I (F2C2
+       JMP I INIT      /START
+
+M1,    .&7600
+ONCE,  MSGS
+ONLY,  LSTFPG+200
+CODE,  7400
+
+CORFUJ,        0
+TTCNT4,        -4
+TTOUTP,        TTYOUT
+BATOUT,        SKP             /OUTPUT TO BATCH LOG
+       7400
+BATCIF,        HLT
+       TTYOUT+1&177+4600       /JMS I .-2
+\f/SUBR TO DETERMINE MACHINE SIZE - RETURNS NUMBER OF
+/BANKS IN AC.
+/MUST RUN IN FIELD 0.
+
+CORE,  0
+       TAD     C6203
+       RDF
+       DCA     CORRTN
+       CDF 0
+       TAD I (7777
+       AND (70
+       SNA             /DOES LOCATION 7777 SPECIFY CORE SIZE?
+       JMP CORELP      /NO
+       CLL RTR         /YES - BELIEVE IT.
+       RAR
+       JMP CORRTN
+CORELP,        CDF 0           /NEEDED FOR PDP-8L
+       TAD TRYFLD      /GET FLD TO TST
+       CLL RTL
+       RAL
+       AND     COR70   /MASK USEFUL BITS
+       TAD     CORELP
+       DCA     .+1     /SET UP CDF TO FLD
+COR706,        0
+       TAD I   CORLOC  /SAV CURRENT CONTENTS
+       NOP             /HACK FOR PDP-8
+       DCA     .-3
+       TAD     .-2     /7000 IS A GOOD PATTERN
+       DCA I   CORLOC
+COR70, 70              /HACK FOR PDP-8.,NO-OP
+       TAD I   CORLOC  /TRY TO READ BK 7000
+       7400            /HACK FOR PDP-8,.NO-OP
+       TAD     .-1     /GUARD AGAINST WRAP AROUND
+       TAD     CORLOC+1        /TAD 1400
+       SZA CLA
+       JMP     .+5     /NON EXISTENT FLD EXIT
+       TAD     COR706  /RESTORE CONTENS DESTROYED
+       DCA I   CORLOC
+       ISZ     TRYFLD /TRY NXT HIGHER FLD
+       JMP     CORELP
+       STA
+       TAD     TRYFLD
+CORRTN,        0
+       JMP I   CORE
+CORLOC,        COR70+2         /ADR TO TST IN EACH FLD
+       1400            /7000+7400+1400=0
+TRYFLD,        1               /CURRENT FLD TO TST
+C6203, 6203
+
+       PAGE
+\f/FOTP'S ERROR MESSAGES
+/THESE RESIDE IN FIELD 0 LOCATIONS 7200-7577
+
+MSGS,
+
+       NOPUNCH
+       *LSTFPG+200
+       ENPUNCH
+
+ILLQ,  TEXT /ILLEGAL ?%/
+ILLA,  TEXT /ILLEGAL *%/
+SERR,  TEXT /SYSTEM ERROR/
+RENERR,        TEXT /ALREADY EXISTS-/
+VERNO, 0617;2420;4026  /FOTP V
+VERLOC,        VERSION+60^100+SUBVER   /ONE-DIGIT VERSION NUMBER AND 1 CHAR PATCH LEVEL
+       0
+BADIRD,        TEXT /ERROR READING INPUT DIRECTORY%/
+ODRERR,        TEXT /ERROR READING OUTPUT DIRECTORY%/
+ODIERR,        TEXT /ERROR WRITING OUTPUT DIRECTORY%/
+SPRBLM,        TEXT /NO ROOM, SKIPPING-/
+INERR, TEXT /ERROR ON INPUT DEVICE-SKIPPING-/
+OUERR, TEXT /ERROR ON OUTPUT DEVICE-SKIPPING-/
+NFLEIN,        TEXT /USE PIP FOR NON-FILE STRUCTURED INPUT%/
+NOFILE,        TEXT /NO FILES OF THE FORM:/
+BIDIRM,        TEXT /BAD INPUT DIRECTORY%/
+BODORM,        TEXT /BAD OUTPUT DIRECTORY%/
+CNTDEL,        TEXT /DELETES PERFORMED ONLY ON INPUT DEVICE GROUP 1/
+CNTDE2,        TEXT /CAN'T HANDLE MULTIPLE DEVICE DELETES%/
+DSVED, TEXT /ORIGINAL DIRECTORY PRESERVED%/
+FLSFMS,        TEXT /MOUNT NEXT OUTPUT VOLUME:/
+
+       FIELD 1         /SELF-STARTING BINARY LOADER STUFF FOR ABSLDR
+       *FOTP
+       $