File: FOTP40.PA of Tape: Original/Originals/os840-3
(Source file text)
/FOTP V40 FOR OS/8 V40
/
/
/
/
/
/
/
/
/
/COPYRIGHT (C) 1974,1975 BY DIGITAL EQUIPMENT CORPORATION
/ AND 1979,1980 BY DATAPLAN GMBH
/
/
/
/
/
/
/
/
/
/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.
/
/
/
/
/
/
/
/
/
/
/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
/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
DECIMAL
VERSION=40 /VERSION NUMBER
SUBVER="B /SUB VERSION (PATCH LEVEL)
OCTAL
GERMAN=1
/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
/ 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
JMS SETSDR /SET SD AND R FLAG
TAD SDFLG
TAD RFLG
SZA CLA /IF /D OR /R
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
SETSDR, 0
TAD I (OPT1
AND (400
CLL RTL /PUT /D BIT INTO AC 0
RAL
DCA SDFLG
TAD I (OPT2
AND (100
DCA RFLG /SET RENAME FLAG
JMP I SETSDR
SFUDG, 0
SDFLG, 0
RFLG, 0
RDOERR, JMS I (ERROR
ERRRDO+40 /READ-ONLY DEVICE
ONDERR, JMS I (ERROR
ODRERR+40 /ERROR READING OUT DIR
AINO, JMS I (ERROR
ILLA+40 /ILLEGAL *
QINO, JMS I (ERROR
ILLQ+40 /ILLEGAL ?
PAGE
/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 (-120 /(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
/SET SAME DEVICE FLAG FLAG 4000 IF /D
/AND SET RENAME FLAG
CDF 10
JMS I (SETSDR
/ 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 I (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
/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 I (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
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
/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
MLP, 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
GOT1, 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 CL7601 /GET OUTPUT FILENAME
TAD (-5200 /WAS IT *
SNA CLA /SKIP IF NOT
JMP TSTEXT /YES... LEAVE FILENAME ALONE
TAD I CL7601 /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 /REPLACE EXTENSION
DCA I (SPOT+3 /WITH GIVEN EXTENSION
DCA TRFLG /CLEAR THE TRANSFER FLAG
TAD I (RFLG /IS /R ON?
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 NSETGD /NO FILE - DO NOTHING *WM (WELL, ALMOST)
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 (RFLG /GET RENAME FLAG
SNA CLA /PRINT INPUT NAME ON /D AND /R
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
CL7600, 7600 /GROUP 2 CLA
TAD I (SDFLG /CHECK FOR NO /D AND SAME DEV
SPA SNA CLA /SKIP IF NO /D AND SAME DEV
TAD I CL7600 /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,
CL7601, 7601 /GROUP 3 CLA
TAD I (RFLG
SZA CLA /SKIP IF NOT /R
JMP I (RENAME /GO TO RENAME CODE
TAD TRFLG /SET AC NOT 0 IF TRANSFER GO AHEAD
JMP I (NPG /LINK TO SOME MORE
TRFLG, 0
PAGE
/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
/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
/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
/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 (40
AND (77
TAD (40
JMS I (TYPE /TYPE IT
JMP I CONVTP
/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 (17 /^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 (-15 /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 PARITY
JMP I READKB
/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
/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
/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
/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 (15
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
DIROUT, 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
/ROUTINE WHICH ECHOES ^(CHAR) AND SKIP RETURNS IF
/ONE WE WANTED
CTYPE, 0
DCA RESTORE /SAVE CHARACTER
KRS /SEE WHATS IN BUFFER
AND (177 /GET RID OF PARITY
CIA
TAD RESTORE /COMPARE AGAINST DESIRED ONE
SNA CLA /SKIP IF NOT ONE
KSF /IS FLAG UP?
JMP I CTYPE /NO... JUST RETURN
KCC /CLEAR CHARACTER
TAD ("^&177 /OUTPUT ^
JMS I (TTY
TAD RESTORE
TAD (100 /CHAR
JMS I (TTY
TAD (15
JMS I (TTY
ISZ CTYPE /SKIP RETURN
JMP I CTYPE
/ROUTINE USED TO DETERMINE IF ^C OR ^P TYPED
CINTER, 0
CLA STL IAC RAL /CHECK FOR ^C
JMS CTYPE
JMP UPPCK /NO CHECK FOR ^P
JMP SPURGE /YES SET ALTMODE BIT
UPPCK, TAD (20
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
/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 S7600 /SAVE 7600,7601,7602,7605
DCA SCODE /AND REPLACE WITH
TAD SCIFC /CIF CDF 10
DCA I S7600 /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
SCIFC, CIF 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 S7600 /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
/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
S7600, 7600 /CLA: JUNK MIGHT BE IN AC
CDF 10 /AND DF MIGHT BE WRONG
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
SPA /NEGATIVE ERRORS ARE
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 (15 /PRINT CR
JMS I (TYPE /LF
JMP I (ENDCHK /FINISH PROCESSING
DFLAG, 0
PAGE
/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 (".&177 /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 (15
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
/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
TAD I POPT1
AND (20 /WAS HUSH OPTION SET?
SZA CLA
JMP GOBCK /BE QUIET
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 ("/&177 /PRINT /
JMS I (TYPE
TAD I XR2 /OPTION
JMS I (TYPE
JMP NOPT /DO ANOTHER
CRIT, TAD (15 /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
USEROD, 0
MOIN, 0
/TABLE OF SWITCHES FOR "NO FILES" MESSAGE
OTAB, OPT2
4
"V&177
POPT1, OPT1
1000
"C&177
OPT2
1000
"O&177
0
PAGE
/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 ("?&177 /PRINT ?
JMS I (TYPE
JMS I (READKB /GET A CHAR
DCA ODIRIN
TAD ODIRIN
AND (137 /ALLOW LC
TAD (-131 /IS IT Y?
SZA
TAD (131-112 /OR 'JA'?
DCA OKFLAG /IF RESULT = 0 IT IS OK
TAD ODIRIN
JMS I (TYPE /ECHO IT
FUNCT2, TAD (15 /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
/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 (15
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, READ-ONLY 1
CLL RAL
SPA /IF READ-ONLY ERROR
JMP I (RDOERR
SNL 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 (-120 /SO WE CAN CHECK FOR THE SUM OF THOSE
SZL CLA /WORDS BEING .LT. 80
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
/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
/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
EXERR, 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)
/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
/** 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
/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
/FOTP'S ERROR MESSAGES
/THESE RESIDE IN FIELD 0 LOCATIONS 7200-7577
VV1=VERSION%12
VV2=VV1^12
MSGS, RELOC LSTFPG+200
IFNDEF GERMAN <
ILLQ, TEXT /ILLEGAL ?%/
ILLA, TEXT /ILLEGAL *%/
SERR, TEXT /SYSTEM ERROR/
RENERR, TEXT /ALREADY EXISTS-/
VERNO, TEXT /FOTP V/
*.-1
VERLOC, VV1+60^100+VERSION-VV2+60 /TWO-DIGIT VERSION NUMBER
SUBVER&77^100 /AND 1 CHAR PATCH LEVEL
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%/
DSVED, TEXT /ORIGINAL DIRECTORY PRESERVED%/
FLSFMS, TEXT /MOUNT NEXT OUTPUT VOLUME:/
ERRRDO, TEXT /OUTPUT DEVICE IS READ-ONLY%/
>
IFDEF GERMAN <
ILLQ, TEXT /FALSCHES ?%/
ILLA, TEXT /FALSCHER *%/
SERR, TEXT /SYSTEM-FEHLER/
RENERR, TEXT /GIBT ES SCHON: /
VERNO, TEXT /FOTP V/
*.-1
VERLOC, VV1+60^100+VERSION-VV2+60 /TWO-DIGIT VERSION NUMBER
SUBVER&77^100 /AND 1 CHAR PATCH LEVEL
BADIRD, TEXT /EIN-VERZEICHNIS LESE-FEHLER%/
ODRERR, TEXT /AUS-VERZEICHNIS LESE-FEHLER%/
ODIERR, TEXT /AUS-VERZEICHNIS SCHREIB-FEHLER%/
SPRBLM, TEXT /KEIN PLATZ FUER: /
INERR, TEXT /LESE-FEHLER BEI: /
OUERR, TEXT /SCHREIB-FEHLER BEI: /
NFLEIN, TEXT /BENUETZE 'PIP' ZUM LESEN VON NICHT-DATEIEN%/
NOFILE, TEXT /KEINE DATEIEN DER FORM: /
BIDIRM, TEXT /EIN-VERZEICHNIS KAPUTT%/
BODORM, TEXT /AUS-VERZEICHNIS KAPUTT%/
CNTDEL, TEXT /NUR ERSTE EIN-ANGABE WURDE ZUM LOESCHEN BENUTZT%/
DSVED, TEXT /URSPRUENGLICHES VERZEICHNIS INTAKT%/
FLSFMS, TEXT /BITTE NAECHSTEN DATENTRAEGER! /
ERRRDO, TEXT /AUS-GERAET KANN NUR LESEN%/
>
RELOC
PAGE
FIELD 1 /SELF-STARTING BINARY LOADER STUFF FOR ABSLDR
*FOTP
$