File FOTP.PA (PAL assembler source file)

Directory of image this file is from
This file as a plain text file

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

/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 /9. /Q NOW ACCEPTS LOWER CASE Y AS A YES RESPONSE
/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
/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 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
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 (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
/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
/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
/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 (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
/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 (240 AND (77 TAD (240 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 (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
/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 (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
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 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
/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
/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
/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
/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
/TABLE OF SWITCHES FOR "NO FILES" MESSAGE OTAB, OPT2 4 "V OPT1 1000 "C OPT2 1000 "O 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 ("? /PRINT ? JMS I (TYPE CMA /SET OKFLAG NO GOOD DCA OKFLAG JMS I (READKB /GET A CHAR TAD (-"Y /IS IT Y? SZA TAD (-40 /CHECK FOR LOWER CASE 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
/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
/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 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 $



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search