Add README.md

[pdp8.git] / sw / os8 / v3d / sources / system / dectapes / dectape7 / FOTP.PA

/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
        $