;-*- Mode:MIDAS -*- TITLE DUMPER .SYMTAB 11657.,5000. ;be-bip be-beh SUBTTL AC, DIRECTORY DEFINITIONS ZR=0 A=1 B=2 C=3 D=4 E=5 N=6 SYM=7 TER=10 RTAPE"T=SYM RTAPE"TT=TER NETWRK"T=SYM NETWRK"TT=TER U=11 V=12 W=13 X=14 USRUFD=15 P=17 IF1,[ PRINTX /WHICH MACHINE? / .TTYMAC A .TTYFLG==.TTYFLG+1 PRINTX/A / .TTYFLG==.TTYFLG-1 ;When using this macro, also check the WRONG flag if you really care DEFINE MCOND B ,TERMIN MCHN==SIXBIT/A/ TERMIN ] NEWCOD==1 ; Assume a KS unless otherwise informed IFE MCOND MX, NEWCOD==0 ;Use old code on MX KL only (running old ITS) IFE MCOND KA, NEWCOD==0 ;Use old code on KA and KL too IFE MCOND KL, NEWCOD==0 DEFINE SYSCAL OP,ARGS .CALL [SETZ ? SIXBIT/OP/ ? ARGS ((SETZ))] TERMIN ;GET DEFINITION OF SYMBOLS FOR DIRECTORY FORMAT .INSRT SYSTEM;FSDEFS > ;THESE PARAMETERS CONTROL THE 'SYSENG; MACRO TAPES' FILE. ;DON'T CHANGE THESE IF YOU'RE NOT RJL ;AND EVEN THEN YOU SHOULD BE CAREFUL MAXTAP==3000. ;MAXIMUM TAPE NUMBER +1 IFE MCOND AI, MAXTAP==4000. ;EVEN THOUGH I'M NOT RJL IFE MCOND MX, MAXTAP==5000. ; I'm not RJL either... -Alan TPINFL==10. ;NUMBER OF WORDS OF INFO PER TAPE SUBTTL I/O CHANNEL, UUO DEFINITIONS MFDCH==1 ;MASTER FILE DIRECTORY INPUT UFDCH==2 ;FILE DIRECTORY INPUT DSKIN==3 ;DISK INPUT MAGOUT==4 ;MAG TAPE OUTPUT TYIC==5 ;TTY INPUT TYOC==6 ;TTY OUTPUT DSKOUT==7 ;DISK OUTPUT MAGIN==10 ;MAG TAPE INPUT LPTCH==11 ;LPT OR TPL OUTPUT ERRC==12 ;ERR DEVICE INPUT STATC==13 ;TAPE STATUS STORED ON DISK SAVET==14 ;SAVED TAPE FILE NAMES SNPLCH==15 .SEE SNPLACE RTAPE"RSICH==16 RTAPE"RSOCH==17 LPDL==100 ;LENGTH OF PDL LPAT==1000 ;LENGTH OF PATCH AREA BUFSIZ==5 PAGSIZ==2000 RPCNT==0 UUOTAB: ;THIS TABLE GENERATED BY FOLLOWING IRP IRP X,,[PSIS,PDPT,POCT,PERR,PASC,SIXTYP,OPEN] RPCNT==RPCNT+1 IRPS Y,,X Y=RPCNT_33 .ISTOP TERMIN LOC UUOTAB+RPCNT-1 A!X TERMIN LUUOTB==RPCNT IFG LUUOTB-37,.ERR TOO MANY UUOS DEFINED ;PRINT A FIXED STRING ON LPT (IF LPTSW) OR ON TTY DEFINE PRINT ARG PASC [ASCIZ \ARG\] TERMIN ;PRINT A STRING THEN ERR OUT DEFINE DIE ARG PERR [ASCIZ /ARG/] TERMIN ;PRINT SOME FILE NAMES DEFINE PRTFNS PRINT _ PSIS SNAME PRINT [;] PSIS FN1 PSIS FN2 TERMIN SUBTTL MISCELLANEOUS VARIABLES ZZ==. LOC 41 JSR UUOH JSR INT LOC ZZ TYIPD: 0 ;DEPTH IN IO-PUSHES ON TYIC DISPLY: 0 ;0 => HARD COPY, 1 => SCREEN PRNAM1: .FNAM1 ;PROGRAM NAME PRNAM2: .FNAM2 ;PROGRAM VERSION NUMBER WRONG: 1 ;0 => ON RIGHT MACHINE, -1 => ON WRONG MACHINE GARBAG: 0 ;READ INTO HERE TO IGNORE ERRPDP: 0 ;PDL LEVEL AT ADMP4 CTRLG: 0 ;0 NORMAL, -1 DEFER CONTROL-G, +1 DEFERRED CONTROL-G PENDING MYNAME: 0 ;ORIGINAL SNAME USNM: SIXBIT /FIRST/ ;CURRENT SNAME LUSNM: 0 ;LAST USER NAME DUMP COMPLETED FOR FUSNM: 0 ;FIRST USER NAME ON TAPE RFDATE: 0 ;REFERENCE DATE UNRNDW: 0 ;UNRNDM WORD FROM RRDATE SYSTEM CALL NTAPES: -1 ;NUMBER OF REEL IN CURRENT DUMP, -1==> WE DON'T KNOW THIS PARAMETER FDATE: 0 ;CREATION DATE OF FILE AUTHOR: 0 ;AUTHOR OF FILE BLOCKS: 0 ;BLOCKS IN UDIR QUOTA: 0 ;QUOTA OF UDIR OFINDF: 0 ;-1 IF DOING AN OFIND, 0 OTHERWISE TEST1: TDNN B,(A) ;SORT TEST 1 TEST2: TDNE B,(C) ;SORT TEST 2 UFDDAT: -1 ;DATE OF UFD INPUT MFDDAT: -1 ;DATE OF MFD INPUT DMPMFD: 0 ;DUMP MFD IF -1 DMPUFD: 0 ;DUMP UFD IF -1 DMPDIR: 0 ;OR OF DMPUFD AND DMPMFD DMPLNK: 0 ;-1 => DUMP LINKS RELOSW: 0 ;-1 IF DOING A RELOAD ;CAUSES DUMPBIT, REAPBIT, AUTHOR, AND REFDATE OF LOADED ; FILE TO BE RESTORED FROM TAPE COPY OF UFD. ALSO, ; CAUSES TAPE UFDS TO BE READ, LINKS TO BE RESTORED, ; DUMPBIT, REAPBIT, AUTHOR, REFDATE TO BE RESTORED, ; AND CAUSES OLD FILES ON DISK BUT NOT ON TAPE-UFD ; TO BE DELETE, THUS RESTORING THE FILE SYSTEM COMPLETELY. PDIRSW: 0 ;-1 => PRINT DIRECTORY FROM TAP AT MAGOP1. MRGSW: 0 ;-1 => MERGE (I.E. NEVER LOAD OVER ANY EXISTING FILE) ;0 => BASE ON VARIOUS OTHER CRITERIA. CAREF: 0 ;-1 DONT OVERWRITE FILES WHICH HAVEN'T BEEN DUMPED LOSRSW: 0 ;-1 SORRY MODE, ALWAYS WRITE OVER EXISTING COPIES IN LOAD ;0 => DON'T WRITE OVER FILES WITH NEWER DATE. (ASK FIRST) NOASK: 0 ;-1 => DON'T ASK QUESTIONS APPENF: -1 ;-1 => NO FILES DUMPED FOR CURRENT USER YET LDPACK: -1 ;NON-NEGATIVE => PACK# OF SINGLE PACK BEING RELOADED, IGNORE ;FILES ON OTHER PACKS, DELETE NEW FILES ON THIS PACK SINCE .SEE DIRUPN ;NOT REALLY THERE (SEE DIRUPN) .SEE DIRU2 ;ALSO ;IF YOU USE THE LDPACK FEATURE, USE THE 'RELOAD L SORRY' ; COMMAND OR YOU WILL BE SORRY. BBPACK: -1 ;LIKE LDPACK, BUT DOESNT MUNGE DISK DIRECTORIES BECUZ WE ASSUME ;THEY ARE CORRECT. DOESNT DELETE ANYTHING. DEADPK: -1 ;Non-negative => Number of pack lost in head crash that ; left the rest of the filesystem OK. Files referenced on ; this pack from existing UFD's need to be restored. CRDIR: 0 ;-1 TO CREATE DIRECTORIES WHEN LOADING FILES FROM TAPE FILN: 0 ;FILE NUMBER IN FIND (I.E. SEQUENCE NUMBER ON TAPE) FLNI: -1 ;-1 FIRST TIME THRU FNG (NEED TO OPEN FILE DIRECTORY) ;SETOM THIS WHEN CHANGING THE SNAME. GFRFQ: -1 ;FIRST TIME FLAG FOR QUOTA PRINTOUT FCDMAP: 0 ;-1 => MEANS WE HAVE MAPPED IN CORE PAGES FOR BUFFER .SEE FCDMP MFDIN: -1 ;-1 FIRST TIME THRU M.F.D. (NEED TO OPEN M.F.D.) ITAPE: -1 ;-1 IF JUST REWOUND (NEED TO READ/WRITE TAPE-HEADER) TAPTYP: 0 ;1 LOCAL, -1 REMOTE, -2 REMOTE AND MOUNTED, 0 NOT DECIDED YET TAPHST: BLOCK 2 ;ASCIZ HOST FOR REMOTE TAPE TAPDRV: BLOCK 2 ;ASCIZ DRIVE NAME TAPDIR: BLOCK 2 ;ASCIZ READ, WRITE, OR BOTH RMTUSR: BLOCK 2 ;ASCIZ REMOTE USER NAME RMTPSW: BLOCK 2 ;ASCIZ REMOTE PASSWORD TAPEF: 0 ;HOLDS TAPE STATUS (IFN NEWCOD,[ .STATUS ] .ELSE CONI 344,) IFE NEWCOD,[ TF%BOT==100000 ;BEGINNING OF TAPE TF%EOT==4000 ;PHYSICAL END OF TAPE TF%EOF==10000 ;END OF FILE SEEN TF%RDY==40 ;DRIVE ONLINE AND NOT BUSY ];IFE NEWCOD IFN NEWCOD,[ TF%BOT==4000 ;BEGINNING OF TAPE TF%EOT==10000 ;PHYSICAL END OF TAPE TF%EOF==200000 ;END OF FILE SEEN ;--- This is wrong, JTW seems to have misunderstood this bit in the old code ;--- really need a drive on-line indication ;--- but OPEN returns an error if it's not on-line TF%RDY==100000 ;DRIVE ONLINE AND NOT BUSY ];IFN NEWCOD LFDIR: 0 ; STORAGE FOR LAST FILE POINTER (IN FIND) TFIL: BLOCK LUNBLK ; TEMPORARY STORAGE FOR FILE SORT IN FIND MTCMD: 0 ;STORAGE FOR .MTAPE MAGOPN: 0 ; 0=> MAGOUT NOT OPEN,-1=> OPEN GTSYNF: 0 ; GETSYL NEGITIVE FLAG GTSYCC: 0 ;GETSYL NUMBER OF CHARACTERS LNKFLG: 0 ;-1=>DUMPING OR LOADING A LINK DMPMOD: 0 ;-1 DUMPING, 0 RETRIEVING TCOPYF: 0 ;-1 => COPYING TAPES OTAPE: 0 ;OUTPUT VERSION OF ITAPE, IN TCOPY DPACK: 0 ;PACK TO DUMP OR -1 IF ALL INCREM: 0 ;-1 DUMP INCREMENTAL, 0 ALL FILES FULLDMP:0 ;-1 FULL DUMP, 0 SPECIFIC FILES MICFLG: 0 ;-1 MICROTAPE, 0 DISK [NOTHING SETS THIS] ******* LPTSW: 0 ;-1 LPT OR TPL OUTPUT ON, 0 OUTPUTTING TO TTY EOTFLG: 0 ;-1 WHEN HIT EOT ON READ, RESET BY REWIND [NOTHING LOOKS AT THIS] ******* EXPERM: 0 ;-1 WHEN ONLY EXPERIMENTING => .DMPCH NOT SET, BYPASS LCHECK CKIDMP: 0 ;0=> CHECK INCREMENTAL DUMPS (SET TO -1 BY 'NO' OPTION) REAPSW: 0 ;-1 IF A REAP TO BE DONE AFTER DUMP NFTDMP: 0 ;NUMBER OF FILES THIS DUMP OR THIS TAPE, WHICHEVER IS SMALLER. CDMFL: 0 ;-1 CONTINUE A FULL DUMP FROM GIVEN USER, 0 ORDINARY DUMP LSTWHL: 0 ;-1 LIST WHILE DOING DUMP OR LOAD CHKFLG: 0 ;-1 CHECK OPERATION, 0 DUMP/LOAD DECIDF: 0 ;-1 DECIDE WHICH TAPES TO USE [NOTHING LOOKS AT THIS] ******* DATEF: 0 ;-1 DUMP ONLY FILES WITH CREATION DATES GREATER THAN OR EQUAL TO DATE DATESF: 0 ;-1 DUMP ONLY FILES BETWEEN TWO DATES DATE: 0 ;STORAGE FOR ABOVE DATE1: 0 ;STORAGE FOR UPPER BOUND IF THERE IS ONE ARCHVF: 0 ;-1 CALL THIS AN ARCHIVE DEVICE: 0 ;DEVICE IF SPECIFIED [THIS IS NEVER USED] ******* SUPERC: 0 ;-1 TO SUPPRESS DATA ERROR MESSAGES (USED BY CHECK) BASE: 10. ;OUTPUT BASE IN DPT/DOT ROUTINE FLENTH: 0 ;FILE LENGTH RDERR: 0 ;-1 => READ DATA ERROR OCCURRED PHYEOT: 0 ;-1 => PHYSICAL END OF TAPE ;TABLE OF "SECONDARY" DISKS. ;THESE ARE THE SAME AS IN ITS NQS==10 QPKID: BLOCK NQS ;PACK NUMBER QRESRV: BLOCK NQS ;PACK NAME OR RESERVED FLAG ;BIT MASK FOR THE PACK NUMBERS OF SECONDARY DISKS SECMSK: 0 ;SET UP AT SETSCM PRIMSK: 0 ;THE PRIMARY DISKS ;WORDS USED BY CHECKER ERRCNT: 0 ;ERRORS ENCOUNTERED THIS FILE ON TAPE IN ERRDSK: 0 ;ERRORS ENCOUNTERED THIS FILE IN DISK IN PNTALL: 0 ;-1 TO PRINT ALL FILES AS THEY GO ERRALL: 0 ;SET IF ANY ERRORS HAPPENED NEWCHR: 0 ;DUMP CHARACTER FOR THIS FILE WRDONG: 0 ;COUNT OF BAD WORDS LNTCNT: 0 ;DIFFERENCE IN LENGTH OF TWO FILES ALLWRD: 0 ;TOTAL WORDS ON THIS REEL SO-FAR LENGTH: 0 ;NUMBER OF FILE SPECS TYPED IN BY USER AND NOT ; SATISFIED YET. ALSO LENGTH OF TAPE FILE IN FNDCON. EOFF: 0 ;EOF FLAG FOR TAPE FILES ON DISK. USED IN AFIND COMMAND DIRIDX: 0 ;POINTER TO FILE DIRECTORY BUFFER(FDIRBF) BARROW: 0 ;BACK-ARROW FLAG ACLODF: 0 ;-1 => GOT TO EXECU VIA ACLOAD, DON'T ASK FOR FILES TTYST1: 0 ;TTY VARS TTYST2: 0 TTYSTS: 0 DKMFDP: 0 .SEE DKAUTH ; -1 If DSKMFD is in DKUFDP: 0 .SEE DKLOOK ; SIXBIT of DSKUFD currently in DKBLK: 0 .SEE DKBLKF ; Saved name block pointer for DKBLKF LLIST==200. ;NUMBER OF FILE SPECS ALLOWED IRP Y,,[TO,FM] IRP X,,[DEV,SNM,FN1,FN2] Y!!X: BLOCK LLIST TERMIN TERMIN FMDUMP: BLOCK LLIST ;-1 => THIS SPEC SATISFIED AT LEAST ONCE. IRP X,,[DEV,SNM,FN1,FN2] TIN!X: 0 ;HOLDS SPECS FOR FILGET TERMIN IRP X,,[DEV,SNM,FN1,FN2] TYN!X: 0 ;HOLDS SPECS FOR FILGET TERMIN DAYTIM: 0 ;HOLDS CREATION DATE AND TIME OF FILE DURING FIND COMMAND PSNAM: 0 ;SNAME TO BE PRINTED BY FIND COMMAND PFF1: 0 ;FILE NAME TO BE PRINTED BY FIND COMMAND PFF2: 0 ;.. WRDCNT: 0 ;COUNT OF WORDS IN FILE SAVAOB: 0 ;AOB OF FIRST BAD WORD INTAC: BLOCK 20 ;SAVED ACS DURING INTERRUPT GREATF: -1 ;0 ==> > FILE HACKED DURING DUMP THBLK: -LTHBLK,,0 ;TAPE-HEADER-BLOCK THTPN: -1 ;TAPE NUMBER,,NUMBER OF REEL IN THIS DUMP, -1==> WE DON'T YET KNOW THIS PARAMETER THDATE: 0 ;TAPE CREATION DATE (SIXBIT) THTYPE: 0 ;0 RANDOM, >0 FULL DUMP, <0 INCREMENTAL DUMP LTHBLK==.-THBLK LTHTPN: -1 ;LAST THTPN HBLK: -LHBLK,,0 ;FILE-HEADER-BLOCK HSNM: 0 ;SYS NAME HFN1: 0 ;FN1 HFN2: 0 ;FN2 LHBLKZ==.-HBLK ; Must be at least this long HPKN: 0 ;LINK FLAG,,PACK NUMBER (SAME INFO AS 3RD VALUE FROM ; FILBLK, BUT IN A DIFFERENT FORMAT) HDATE: 0 ;CREATION DATE AND TIME OF FILE ON DISK (DISK-FORMAT) (4TH ; VALUE FROM FILBLK) ; Next two added 7/14/89 by Alan HRDATE: 0 ;REFERENCE DATE, AUTHOR INDEX, BYTE SIZE AND BYTE COUNT ; (5TH VALUE FROM FILBLK) HLEN: 0 ;LENGTH OF FILE IN WORDS (FROM FILLEN) LHBLK==.-HBLK ; Must not be longer than this HFNL: 0 STAPST: ;BLOCK OF DATA STORED ON DISK FOR TAPE STATUS (IN SYSENG;MACRO TAPES) STAPEN: 0 ;TAPE NUMBER,,REEL NUMBER STDATE: 0 ;DATE TAPE LAST WRITTEN STYPE: 0 ;TYPE OF DATA LAST WRITTEN AS THTYPE ABOVE SFUSNM: 0 ;FIRST USER ON THIS TAPE SLUSNM: 0 ;LAST USER ON THIS TAPE SUSER: 0 ;UNAME OF PERSON WHO DUMPED THIS TAPE SDONE: 0 ;ZERO IF DUMP NOT COMPLETED,-1 REGULAR, 1 ARCHIVE BLOCK TPINFL+.-STAPST INTERR: SIXBIT /DEVICE/ ;USED FOR DISK ERROR ANALYSIS SIXBIT /RANDOM/ SIXBIT /FILE/ SIXBIT /LOSER/ SUBTTL OPEN-BLOCKS, .CALL BLOCKS LPTO: SIXBIT / !LPT/ ;OUTPUT TO LPT (AND TPL ETC.) SIXBIT /WALL/ SIXBIT />/ 0 0 ;LEAVE THESE HERE !!!! MAGI: 26,,(SIXBIT /MT0/) ; BLOCK IMAGE, DON'T FLUSH TO EOF ON CLOSE SIXBIT /MACRO/ SIXBIT /IN/ 0 0 ;LEAVE ALONE MAGO: SIXBIT / 'MT0/ ;OUTPUT TO MAG-TAPE SIXBIT /MACRO/ SIXBIT /OUT/ 0 0 MFO: (SIXBIT /DSK/) ;MASTER FILE DIRECTORY IN SIXBIT /M.F.D./ SIXBIT /(FILE)/ 0 0 FNO: SIXBIT / &DSK/ ;FILE DIRECTORY IN SIXBIT /.FILE./ SIXBIT /(DIR)/ 0 0 CRUFD: SIXBIT / DSK/ SIXBIT /..NEW./ SIXBIT /(UDIR)/ TRNI: SIXBIT / &DSK/ ;INPUT FROM DISK FN1: 0 ;FILE NAME 1 FN2: 0 ;FILE NAME 2 SNAME: 0 0 ;HERE IN CASE OF .FDELE TRNI ;***** ***** KEEP THESE NEXT 6 LOCATIONS TOGETHER FOR LINK INFO ***** LNKBLK: 200000,,(SIXBIT /DSK/) 0 0 LNKNM1: 0 ; LINK FN1 LNKNM2: 0 ;LINK FN2 PACKN: 0 ;PACK NUMBER OR SNAME IN LINK IF LEFT HALF NON ZERO ;****** ***** ***** CPYO: SIXBIT / #DSK/ ;OUTPUT TO DISK LFN1: 0 LFN2: 0 0 0 ERROP: 0,,(SIXBIT/ERR/) 1 0 0 0 SPLACE: SIXBIT /SYSENG/ ;PLACE TO STORE MACRO TAPES STATOP: SIXBIT / DSK/ ;FILE TO SAVE TAPE DATA IN SIXBIT /MACRO/ SIXBIT /TAPES/ 0 0 USRDEL: 0 ;FOR .FDELE 0 0 NPLACE: SIXBIT /.TAPE0/ ;TAPE DIRECTORY DIRECTORY, OR 0 IF HAVEN'T DECIDED YET NSVOP: SIXBIT / 'DSK/ SIXBIT /TAPE/ NSVTPN: 0 0 ;FOR .FDELE 0 0 TDIRN: 0 ;CURRENT INDEX IN TDIRTB SNBUF: BLOCK UDNAMP+1 ;USED TO GET UDNAMP TO ESTIMATE DIR FULLNESS SNTRY: SETZ SIXBIT /OPEN/ 3000,,E MOVEI SNPLCH [SIXBIT/DSK/] [SIXBIT/TAPE/] SNTRYN SETZ TDIRTB(A) SNTRYN: 0 RUSN: 0 ;NAMES USED IN SINGLE FILE RESTORE RFN1: 0 RFN2: 0 0 0 CUSN: 0 ;CURRENT USER NAME USED WHEN LSTWHL IS ON RDATE: SETZ SIXBIT /RFDATE/ [DSKIN] SETZ FDATE(2000) RQDATE: SETZ SIXBIT /RQDATE/ SETZM HDATE SDATE: SETZ SIXBIT /SFDATE/ [DSKOUT] SETZ FDATE SRDT: SETZ SIXBIT /SRDATE/ [DSKOUT] SETZ RFDATE FILLEN: SETZ SIXBIT /FILLEN/ [DSKIN] SETZM LENGTH FILBLK: SETZ SIXBIT /FILBLK/ [DSKIN] 2000,,0 2000,,0 2000,,0 2000,,FDATE SETZM RFDATE SRFDAT: SETZ SIXBIT /SRDATE/ [DSKIN] SETZ RFDATE CLBIT: SETZ SIXBIT /SDMPBT/ [STATC] SETZ [0] RESRDT: SETZ ;RESTORE REF DATE SIXBIT /RESRDT/ SETZ [DSKIN] RRDATE: SETZ SIXBIT /FILBLK/ 1000,,DSKIN 2000,,0 2000,,0 2000,,UNRNDW 2000,,0 402000,,RFDATE CREFDT: SETZ ;COPY REF DATE INTO FDATE SIXBIT /SFDATE/ [DSKIN] SETZ RFDATE RHDATS: SETZ SIXBIT /FILBLK/ MOVEI DSKIN MOVEM 0 ; FN1 MOVEM 0 ; FN2 MOVEM 0 ; RND MOVEM HDATE SETZM HRDATE RHLEN: SETZ SIXBIT /FILLEN/ MOVEI DSKIN SETZM HLEN TTYGET: SETZ SIXBIT /TTYGET/ MOVEI TYOC MOVEM TTYST1 MOVEM TTYST2 SETZM TTYSTS TTYSET: SETZ SIXBIT /TTYSET/ MOVEI TYOC TTYST1 TTYST2 SETZ TTYSTS TRRDFO: SETZ ;OPEN BLOCK FOR INDIRECT COMMAND FILES FROM DISK SIXBIT /OPEN/ 1000,,TYIC TINDEV TINFN1 TINFN2 SETZ TINSNM SUBTTL UUO HANDLER UUOH: 0 PUSH P,40 PUSH P,UUOH ;FOR RECURSIVE UUOS PUSH P,A PUSH P,B PUSH P,C LDB C,[330600,,40] ;OP CODE CAILE C,0 CAILE C,LUUOTB .VALUE ;ILLEGAL UUO PUSHJ P,@UUOTAB-1(C) CAIA ;REGULAR RETURN JRST SKPRET ;SKIP RETURN POP P,C POP P,B POP P,A POP P,UUOH POP P,40 JRST 2,@UUOH SKPRET: POP P,C POP P,B POP P,A POP P,UUOH POP P,40 AOS UUOH JRST 2,@UUOH ;MTAPE UUO. AC IS OPERATION, E IS SUBCOMMAND. ;THIS IS NEVER USED, TAKES THE WRONG ARGUMENTS, AND DOESN'T ;WORK SINCE IT USES THE 'MTAPE' SYMBOLIC SYSTEM CALL, ;WHICH DOES NOT EXIST!! ******* ; ;AMTAPE: PUSH P,40 ;PUSH OF 40 IS SUPERFLUOUS ******* ; OPEN MAGIN,MAGI ; JRST RET ; POP P,40 ; LDB A,[270400,,40] ; SPACE, DO SOMETHING ELSE, OR SET MODE(S) ; HRRZ B,40 ;SUBCOMMAND ; .CALL TAPBLC ; .LOSE 1000 ; POPJ P, ; ;TAPBLC: SETZ ; XWD SIXBIT / MTA/,SIXBIT / PE/ ;SO NMTAPE WILL NOT FIND THIS ; [MAGIN] ; A ; SETZ B ;PSIS UUO. PRINT A SPACE THEN A SIX CHARACTER SIXBIT WORD. APSIS: PUSHJ P,TYOS ;SIXTYP UUO. PRINT A SIX CHARACTER SIXBIT WORD. ASIXTYP:MOVE B,@40 JRST SIXTYO ;DPT UUO. PRINT A DECIMAL NUMBER RIGHT-JUSTIFIED IN 6 COLUMNS. ;PAY NO ATTENTION TO THE MOVE C,-1(P) IT'S SUPERFLUOUS! APDPT: MOVE C,-1(P) ;PRINT DECIMAL NUMBER MOVE A,@40 PUSHJ P,ADJUS JRST DPT ADJUS: PUSH P,A ;'FIXED' FORMAT HACK MOVM B,A SKIPN B MOVEI B,1 MOVEI C,10000. SKIPGE A IDIVI C,10. ;FOR THE MINUS SIGN ADJUS1: PUSHJ P,TYOS CAML B,C JRST POPAJ IMULI B,10. JRST ADJUS1 ;POCT UUO. PRINT SIGNED OCTAL NUMBER, PRECEDED BY SPACE. ;PAY NO ATTENTION TO THE MOVE C,-1(P) IT'S SUPERFLUOUS! APOCT: MOVE C,-1(P) ;PRINT OCTAL NUMBER PUSHJ P,TYOS MOVE A,@40 JRST DOT ;PERR UUO. MAINLY FOR DIE MACRO. APERR: SETZM LPTSW ;SURELY THESE SHOULD NOT GO INTO WALLPAPER FILE PUSHJ P,APASC ;PRINT ASCII AND DIE JRST ERR ;OPEN UUO. LIKE .OPEN, BUT IF IT FAILS GIVES MESSAGE ON TTY. AOPEN: MOVEI A,<.OPEN_-27.> MOVE B,40 DPB A,[331100,,B] MOVSI C,10 ;DO NOT SET REFERENCE DATE ON DSKIN LDB A,[270400,,B] CAIN A,DSKIN IORM C,@40 SETZM A XCT B SETOM A LDB B,[270400,,B] CAIN B,DSKIN ANDCAM C,@40 SKIPN A JRST POPJ1 ;SUCCEEDED PUSH P,LPTSW SETZM LPTSW ;TYPE ERROR MESSAGE ON TTY PUSH P,40 HRRZ B,UUOH SOS B POCT B ;PC OF OFFENDING OPEN POP P,A .SUSET [.RSNAM,,B] PUSHJ P,TELL POP P,LPTSW POPJ P, ;ALSO CALLED FROM INT4 (DISK DATA ERROR) TELL: PSIS (A) PRINT : PSIS 1(A) PSIS 2(A) PSIS B PASC [ASCIZ /;/] PUSHJ P,OPINFL JRST CRR OPINFL: PUSH P,A ;ANALYZE IOC ERROR .OPEN ERRC,ERROP .VALUE ;LOSING COMPLETELY! MOVEI A,40 ;SPACE ERRLOP: PUSHJ P,TYO .IOT ERRC,A CAIL A,40 JRST ERRLOP .CLOSE ERRC, PUSHJ P,CRR POPAJ: POP P,A POPJ P, ;PASC UUO. MAINLY FOR PRINT MACRO. APASC: MOVE B,40 ;PRINT ASCIZ STRING HRLI B,440700 PRINL5: ILDB A,B JUMPE A,CPOPJ CAIN A,^Q ;CONTROL-Q TURNS OFF UNDERSCORE MISFEATURE JRST [ ILDB A,B ? PUSHJ P,TYO ? JRST PRINL5 ] CAIN A,"_ ;UNDERSCORE GETS MAPPED INTO CR-LF JRST [ PUSHJ P,CRR ? JRST PRINL5 ] PUSHJ P,TYO JRST PRINL5 SIXTYO: MOVE C,[440600,,B] ;TYPE 6 SIXBIT CHARACTERS SIXTY1: ILDB A,C ADDI A,40 PUSHJ P,TYO TLNE C,770000 JRST SIXTY1 POPJ P, DOT: SKIPA B,[8] DPT: MOVEI B,10. MOVEM B,BASE JUMPL A,NDPT DPT1: IDIV A,BASE ;DECIMAL OUTPUT ROUTINE HRLM B,(P) SKIPE A PUSHJ P,DPT1 HLRZ A,(P) ADDI A,"0 JRST TYO NDPT: PUSH P,A MOVEI A,"- PUSHJ P,TYO POP P,A MOVNS A JRST DPT1 SUBTTL FNG - GET NEXT FILE ;FNG GETS THE NEXT FILE, MAPPING OVER THE WHOLE WORLD BUT EXCLUDING ; SOME FILES ON BASIS OF DATE, ETC. ;RETURNS FILE NAME AND ATTRIBUTES IN A FEW MILLION VARIABLES, ; WHICH SHOULD BE LISTED HERE. ;CLOBBERS JUST ABOUT ALL THE ACS. ;THIS ISN'T THE ENTRY, JUMPS HERE IF CAN'T READ UFD. FUNCT: .STATUS UFDCH,A LDB A,[220600,,A] ;OPEN-LOSS CODE CAIN A,20 POPJ P, ;DIRECTORY DOESN'T EXIST, FAIL. PUSH P,LPTSW SETZM LPTSW PSIS CHNTAB+UFDCH ;MAY JUST BE 'DEVICE NOT AVAILABLE' PUSHJ P,OPINFL PUSHJ P,CRR POP P,LPTSW MOVEI A,150. .SLEEP A, JRST FNG8 ;ENTRY. FNG: AOSE FLNI ;PUT ONE FILE NAME AND PACK # IN FN1,FN2,PACKN JRST NEXFLN ;NOT THE FIRST TIME FNG8: .OPEN UFDCH,FNO JRST FUNCT ;MAYBE TOO MUCH DISK ACTIVITY MOVE A,[-2000,,FDIRBF] .IOT UFDCH,A .CLOSE UFDCH, SKIPN GFRFLG JRST FNG1 HRRZ A,FDIRBF+UDBLKS MOVEM A,BLOCKS HLRZ A,FDIRBF+UDBLKS MOVEM A,QUOTA SKIPE GFREVR JRST FNG1 HLRZ A,FDIRBF+UDALLO JUMPE A,FNG1 MOVEI B,1 LSH B,(A) ;BIT FOR PACK ALLOCATED TO TDNN B,SECMSK ;ALLOCATED TO SECONDARY DOESN'T COUNT SKIPE GFRALO ;DON'T REAP ALLOCATED DIRS? JRST FNG1 ; REAP THE SUCKERS! POPJ P, ;ALLOCATED, DON'T REAP FNG1: MOVE A,FDIRBF+UDNAMP MOVEM A,DIRIDX ADDI A,FDIRBF ;A POINTS TO BEGINNING OF NAME AREA MOVE C,A GETNM: CAILE A,FDIRBF+1777-4 JRST OUTENT ;END OF NAME AREA SKIPN W,(A) JRST NEXENT ;EMPTY SLOT [SHOULDN'T HAPPEN!] MOVE B,UNRNDM(A) SKIPN GFRFLG JRST GETNM2 SKIPE GFREVR JRST GETNM1 TLNN B,UNREAP ;DON'T REAP FILES WITH REAP BIT ON TLNN B,UNDUMP ;DON'T REAP FILES NOT YET DUMPED JRST NEXENT PUSH P,A LDB A,[UNPKN B] MOVEI D,1 LSH D,(A) ;BIT FOR PACK IT'S ON POP P,A TDNN D,GFRPNM JRST NEXENT ;DON'T REAP OFF THIS DISK GETNM2: TLNN B,UNLINK JRST GETNM1 SKIPN DMPLNK JRST NEXENT GETNM1: SKIPL INCREM SKIPGE DATEF CAIA JRST IGNORQ TLNE B,UNLINK ; LINK JRST NEXENT ; DON'T INCREMENTAL DUMP LINKS SKIPGE DATEF JRST IGNORQ TLNE B,UNDUMP ;FILE-DUMPED BIT JRST NEXENT MOVE D,3(A) CAMN D,[-1] PUSHJ P,SM1DT ;MINUS 1 DATE, CHANGE INTO TODAY. IGNORQ: TLNE B,UNIGFL JRST NEXENT ;FILE IS EITHER OPEN FOR WRITING OR SOME FLAVOR OF BEING DELETED MOVE D,DATE SKIPGE DATEF CAMG D,3(A) ;IF DATE SPECIFIED, DISREGARD IF CREATION CAIA ; DATE IS BEFORE SPECIFIED DATE JRST NEXENT MOVE D,DATE1 SKIPGE DATESF CAMLE D,3(A) ;IF DATES SPECIFIED, DISREGARD IF CREATION CAIA ; DATE IS AFTER SPECIFIED DATE JRST NEXENT TLNE B,UNLINK JRST GETLNK MOVEM W,(C) ;FIRST NAME MOVE W,1(A) MOVEM W,1(C) LDB W,[UNPKN B] MOVEM W,2(C) ;PACK # MOVE W,3(A) MOVEM W,3(C) HLRZ W,4(A) ;REFERENCE DATE SKIPN W MOVEI W,177777 ANDI W,177777 SKIPE GFRCRE ;GET CREATION DATE INSTEAD OFF REFERENCE DATE. HLRZ W,3(A) MOVSM W,4(C) SKIPN GFRFLG JRST FNGOK PUSHJ P,LNTH JUMPE B,NEXENT ;ZERO-LENGTH FILES DON'T GET REAPED MOVE B,(C) CAME B,[SIXBIT/-READ-/] JRST FNGOK MOVE B,1(C) CAME B,[SIXBIT/-THIS-/] ;THESE FILES WORTH KEEPING AROUND FNGOK: ADDI C,LUNBLK ;ACCEPT THIS FILE INTO THE LIST NEXENT: ADDI A,5 JRST GETNM SM1DT: MOVEI D,.BII ;FILE SEEN WITH -1 CREATION DATE, HRLM D,TRNI ; AND NOT DUMPED YET. FIX. MOVE D,(A) MOVEM D,FN1 MOVE D,1(A) MOVEM D,FN2 .OPEN DSKIN,TRNI POPJ P, .CALL RRDATE ;READ REF DATE (= NOW SINCE JUST OPENED!!) SKIPA .CALL CREFDT ;COPY INTO CREATION DATE JFCL .CLOSE DSKIN, POPJ P, ;HACKED ALL ENTRIES, NOW SORT OUTENT: MOVEM C,LFDIR SETZM (C) ;ZERO ENTRY MEANS END OF DIRECTORY SETZM 1(C) SETZM 4(C) MOVE A,DIRIDX ADDI A,FDIRBF MOVEI D,LUNBLK MOVEI N,0 ;USUALLY BY FN1 SKIPE GFRFLG SKIPN GFRQUO JRST OUTEN1 MOVEI N,4 ;SORT BY REFDATE IF GFR AND QUOTA PUSHJ P,SORT MOVE A,DIRIDX ADDI A,FDIRBF MOVEI N,3 MOVE C,A OUTEN2: SKIPN B,4(A) JRST OUTLUP OUTEN3: ADDI C,LUNBLK CAMN B,4(C) JRST OUTEN3 PUSHJ P,SORT JRST OUTEN2 OUTEN1: PUSHJ P,SORT MOVE A,DIRIDX ADDI A,FDIRBF MOVEI N,1 ;SORT BY FN2 WITHIN EQUAL FN1 MOVE C,A BLUP: SKIPN B,(A) JRST OUTLUP BLUP1: ADDI C,LUNBLK CAMN B,(C) JRST BLUP1 PUSHJ P,SORT JRST BLUP OUTLUP: ;ESCAPE FROM ABOVE SORTING. DROP INTO NEXFLN. ;HERE TO EXTRACT A FILE FROM THIS MUNGED DIRECTORY. NEXFLN: SETZM RFDATE MOVE A,DIRIDX SKIPN B,FDIRBF(A) POPJ P, ;NO MORE FILES MOVEM B,FN1 MOVE B,FDIRBF+1(A) MOVEM B,FN2 MOVE B,FDIRBF+2(A) MOVEM B,PACKN MOVE B,FDIRBF+3(A) MOVEM B,LNKNM1 SKIPE GFRFLG MOVEM B,FLENTH MOVE B,FDIRBF+4(A) MOVEM B,LNKNM2 ADDI A,LUNBLK MOVEM A,DIRIDX SETZM LNKFLG HLRZ A,PACKN SKIPE A SETOM LNKFLG SKIPN LNKFLG MOVEM B,RFDATE POPJ1: AOS (P) CPOPJ: POPJ P, GETLNK: MOVEM W,(C) ;FIRST NAME MOVE W,1(A) MOVEM W,1(C) LDB B,[UNDSCP+UNRNDM(A)] ;GET FIRST BYTE INDEX PUSH P,B+1 IDIVI B,UFDBYT ADDI B,FDIRBF+UDDESC MOVNI N,-6(C) IMULI N,6 HRLI N,60200 ;ASSUMING B=2 !!! ROT N,30. POP P,B+1 PUSHJ P,GETLSL CAMN W,[SIXBIT /BACKUP/] ; DON'T BACKUP LINKS TO THE BACKUP DIRECTORY JRST NEXENT SKIPN W SETOM W ;IN CASE OF ZERO SNAME MOVEM W,2(C) ; SNAME PUSHJ P,GETLSL MOVEM W,3(C) ; LINK FN1 PUSHJ P,GETLSL MOVEM W,4(C) ADDI C,LUNBLK JRST NEXENT ;GETLSL GET LINK SYLLABLE. 6 BIT CHARACTERS. AT MOST 6 TO A WORD RETURNED IN W ; NEXT CHARACTER QUOTED BY : DELIMITER IS ; OR ZERO CHARACTER GETLSL: PUSH P,A PUSH P,C PUSH P,D MOVEI D,6 ;AT MOST 6 CHARACTERS MOVE C,[440600,,W] SETZM W GETLS1: ILDB A,N CAIE A,0 CAIN A,'; ; END? JRST GETLS2 CAIN A,': ; QUOTE NEXT CHAR ILDB A,N IDPB A,C ; STORE CHARACTER SOJG D,GETLS1 GETLS2: POP P,D POP P,C POP P,A POPJ P, LNTH: LDB D,[UNDSCP+B] SETZM B IDIVI D,6 HLL D,QBTBLI(E) ADDI D,UDDESC+FDIRBF PUSHJ P,LN1 MOVEM B,3(C) POPJ P, LN1: ILDB E,D SKIPN E POPJ P, CAILE E,UDTKMX JRST LN2 ADD B,E JRST LN1 LN2: CAIGE E,UDWPH AOJA B,LN1 CAIN E,UDWPH JRST LN1 REPEAT 2, IBP D AOJA B,LN1 QBTBLI: 440600,, 360600,, 300600,, 220600,, 140600,, 060600,, 000600,, ;THE FOLLOWING ROUTINE READS IN AND ALPHABETIZES THE MASTER FILE ;DIRECTORY OF THE DISK USING THE ASSUMED NAME M.F.D. (FILE). ;THE DIRECTORY IS READ IN WITH BLOCK IMAGE MODE INPUT INTO MFDLST, ;AND IS ASSUMED TO BE COMPLETELY CONTAINED IN 2000 OCTAL LOCATIONS. ;THE FIRST ENTRY IS ASSUMED TO BE IN LOCATION MFDLST+N, WHERE N IS THE CONTENTS OF MFDLST+1. ;EVERY ENTRY IS ASSUMED TO TAKE TWO LOCATIONS WITH THE NAME TO BE ALPHABETIZED IN THE FIRST ;LOCATION OF THE TWO. ; THE FINAL ALPHABETIZED LIST IS ONE WORD ENTRIES STARTING AT MFDLST. ;NEXT MFD ENTRY (FOR FNG) MFDN: SETOM APPENF AOS A,MFDIN MOVE A,MFDLST(A) JUMPE A,CPOPJ MOVEM A,USNM JRST POPJ1 ;READ IN MFD INMFD: MOVEI A,.BII HRLM A,MFO OPEN STATC,MFO .VALUE ;HOW CAN WE POSSIBLY WIN WITHOUT MFD? MOVE A,[-2000,,MFDLST] .IOT STATC,A .CLOSE STATC, MOVEI B,0 ;FIRST, COPY IT DOWN INTO CONTIG WORDS MOVE A,MFDLST+MDNAMP ;LOCATION OF FIRST ENTRY NEXUFD: SKIPN C,MFDLST(A) JRST GOON MOVEM C,MFDLST(B) ADDI B,1 GOON: ADDI A,2 CAIGE A,2000 JRST NEXUFD SETZM MFDLST(B) ;MARK END MOVEI A,MFDLST ;NOW SORT IT MOVEI C,MFDLST(B) MOVEI N,0 MOVEI D,1 JRST SORT SUBTTL SORT ROUTINE ;THIS ROUTINE SORTS A BLOCK OF CORE LOGICALLY (NOT ARITHMETICALLY) ;ARGUMENTS: ;A POINTS TO FIRST ENTRY ;C POINTS TO LOCATION AFTER LAST ENTRY ;N HOLDS ADDRESS OF KEY WORD RELATIVE TO BEGINNING OF BLOCK ;D HOLDS NUMBER OF WORDS TO BE MOVED TOGETHER ;THE METHOD IS RADIX EXCHANGE ;BORROWED FROM SYSENG;PRUFD > SORTDN: MOVE [TDNE B,(A)] MOVEM TEST1 MOVE [TDNN B,(C)] MOVEM TEST2 JRST SORTI SORT: MOVE [TDNN B,(A)] MOVEM TEST1 MOVE [TDNE B,(C)] MOVEM TEST2 SORTI: MOVSI B,(SETZ) SORT1: HRLM C,(P) ;SAVE UPPER BOUND MOVN W,D ADD W,C CAML A,W JRST SORT7 ;ONE OR ZERO ENTRIES PUSH P,A ;SAVE LOWER BOUND SORT3: ADD A,N XCT TEST1 ;BIT SET IN LOWER ENTRY? JRST SORT5 ;NO, INCREMENT TO NEXT AND MAYBE TRY AGAIN SUB A,N SUB C,D ADD C,N XCT TEST2 ;BIT CLEAR IN UPPER ENTRY? JRST SORT8 ;NO, CHECK FOR END, DECREMENT C, AND TRY AGAIN SUB C,N IMUL D,[-1,,] ;MAKE AOBJN POINTER SHUFFL: ADDI A,(D) ADDI C,(D) MOVE W,(A) EXCH W,(C) MOVEM W,(A) SUBI A,(D) SUBI C,(D) AOBJN D,SHUFFL SORT4: ADD A,D ;INCREMENT LOWER BOUND POINTER TO NEXT ENTRY SORT2: CAME A,C ;ANY MORE ENTRIES LEFT? JRST SORT3 ;YES, GO PROCESS THEM ;A AND C NOW BOTH POINT TO FIRST ENTRY WITH BIT SET ROT B,-1 ;ROTATE BIT INDICATOR TO NEXT (LESS SIGNIFICANT) BIT POP P,A ;RESTORE LOWER BOUND OF ENTIRE SORT JUMPL B,SORT6 ;JUMP IF NO MORE KEY TO SORT ON PUSHJ P,SORT1 ;SORT BOTTOM PART OF TABLE HLRZ C,(P) ;RESTORE UPPER BOUND (SORT1 CLOBBERED A TO MIDDLE) PUSHJ P,SORT1 ;SORT TOP PART OF TABLE SORT6: ROT B,1 ;BACK UP KEY AGAIN SO AS TOO "NOT CLOBBER B" SORT7: HLRZ A,(P) ;MAKE A POINT ABOVE TABLE ENTRIES SORTED POPJ P, SORT5: SUB A,N JRST SORT4 SORT8: SUB C,N JRST SORT2 SUBTTL PROGRAM STARTS HERE START: SKIPN MYNAME ;DON'T CHANGE IF NOT JUST LOADED .SUSET [.RSNAME,,MYNAME] .SUSET [.SSNAM,,MYNAME] .SUSET [.ROPTION,,A] TLO A,%OPOPC ;STORE PROPER PC ON INTERRUPTS .SUSET [.SOPTION,,A] .OPEN TYOC,[%TJDIS+.UAO,,(SIXBIT /TTY/)] .LOSE 1400 MOVEI P,PDL .CORE CORSIZ JRST .-1 .SUSET [.SMASK,,[%PIIOC+%PITYI]] ;ALLOW IOC, TYPEIN ;COPY QPKID AND QRESRV ARRAYS OUT OF ITS MOVE C,[SQUOZE 0,NQS] .EVAL C, .LOSE MOVE A,[SQUOZE 0,QPKID] .EVAL A, .LOSE MOVSS A HRRI A,QPKID MOVE B,C .GETLOC A, ADD A,[1,,1] SOJG B,.-2 MOVE A,[SQUOZE 0,QRESRV] .EVAL A, JRST NORSRV MOVSS A HRRI A,QRESRV .GETLOC A, ADD A,[1,,1] SOJG C,.-2 NORSRV: ;SET UP SECMSK TO BE ALL THE PACKS THAT ARE ON-LINE AND RESERVED SETZM SECMSK SETZM PRIMSK ;AND PRIMSK THE ON-LINE NON-RESERVED PACKS MOVSI C,-10 SETSCM: MOVEI A,1 SKIPGE QPKID(C) JRST SETSC1 ;NOT ON-LINE LSH A,@QPKID(C) SKIPE QRESRV(C) IORM A,SECMSK SKIPN QRESRV(C) IORM A,PRIMSK SETSC1: AOBJN C,SETSCM PUSHJ P,INMFD .OPEN TYIC,[10,,(SIXBIT /TTY/)] ;DDT MODE .LOSE 1400 .CALL TTYGET ;TRY TO TURN ON **MORE** PROCESSING JFCL MOVSI C,%TSMOR ANDCAM C,TTYSTS .CALL TTYSET JFCL .STATUS TYOC,A LDB A,[300,,A] MOVEM A,DISPLY SOS DISPLY ;0==> PAPER 1==> SCREEN ;PRINT _ ;CRLF ;PUSHJ P,FORMF ;CLEAR SCREEN IF DISPLAY SIXTYP PRNAM1 PRINT . SIXTYP PRNAM2 PUSHJ P,CRR SETOM ITAPE ;Assume tape is / will be rewound SETOM MFDDAT SETOM UFDDAT SKIPGE TAPTYP SETOM TAPTYP ;Dismount remote tape SKIPG WRONG ;Else SETIT will make local/remote decision JRST MLP SETZM WRONG ;See if on right machine (first time only) .CALL [ SETZ ? 'SSTATU ? REPEAT 5,[MOVEM A ? ] SETZM A ] .VALUE CAMN A,[MCHN] JRST MLP PRINT *** WRONG VERSION OF DUMP--ASSEMBLED FOR PSIS [MCHN] PRINT BUT RUNNING ON PSIS A PRINT ***_*** CERTAIN TAPE OPERATIONS WON'T BE ALLOWED *** SETOM WRONG ;JRST MLP ;drops through SUBTTL MAIN COMMAND LOOP RET: ;FAILURE RETURN FROM VARIOUS COMMANDS MLP: .CORE CORSIZ JRST .-1 ;NO CORE SETZM CTRLG SETZM ACLODF SETZM GFRFLG SETZM GFRCRE SETZM EOTFLG SETZM USRDEL SETZM DATEF SETZM DATESF SETZM RELOSW SETZM PDIRSW SETZM DMPDIR SETZM DMPUFD SETZM DMPMFD SETZM DMPLNK SETZM DFINDF MOVEI P,PDL CLEARM LPTSW .CLOSE SAVET, MOVNI A,1 SKIPE LPTBFC PUSHJ P,LPTTYO ;EMPTY THE LPT BUFFER .CLOSE LPTCH, .RESET MAGIN, ;ASSUMING MTAPE USES MAGIN AS ITS CHANNEL .CLOSE MAGIN, ;BEGINNING AND ERROR RESTART .CLOSE MAGOUT, SETZM MAGOPN SETZM LNKFLG .IOPDL ;FLUSH ANY PUSHED DSKIN, ETC. .CALL TTYSET ;TURN ECHOING BACK ON, IF OFF JFCL PROMPT: PUSHJ P,CRR MOVEI A,"_ PUSHJ P,TYO ;PROMPT THE LOSER PUSHJ P,TYI CAIN A,"? JRST AHELP PUSHJ P,GETSL1 ;READ THE COMMAND JRST PROMPT JUMPE SYM,RET ;JUST A CR OR FF, REPROMPT CLEARM SUPERC CLEARM DMPMOD CLEARM CHKFLG CLEARM TCOPYF MOVSI B,-NCOMS CAME SYM,COMT(B) ;SEARCH THE COMMAND TABLE AOBJN B,.-1 MOVEI C,0 ;USED IN SOME COMMANDS AS DEFAULT JUMPL B,MLP1 ;NOT REASONABLE COMMAND ? ERR: PRINT ? JRST MLP FORMF: SKIPG DISPLY POPJ P, PASC [ASCIZ /C/] POPJ P, MLP1: SKIPGE COMDTB(B) ;NOT ALL COMMANDS USE THE TAPE DRIVE PUSHJ P,SETITN ;SETIT, and show who used it last. PUSHJ P,@COMDTB(B) ;DO COMMAND JRST RET AHELP: PASC COMHLP ;GIVE COMMAND NAMES AND DESCRIPTION JRST MLP ; MOVSI D,-NCOMS ;LIST COMMANDS ; PUSHJ P,CRR ;HELP1: PSIS COMT(D) ; PUSHJ P,CRR ; AOBJN D,HELP1 ; JRST MLP SUBTTL COMMAND LOOK-UP TABLES ;NOTE IF YOU CHANGE THIS, CHANGE COMDTB AND COMHLP (ALSO ON THIS PAGE) COMT: SIXBIT /LOCAL/ ;USE LOCAL TAPE DRIVE SIXBIT /REMOTE/ ;USE REMOTE TAPE DRIVE SIXBIT /TAPED/ ;GENERATE TAPE DIRECTORY FROM MOUNTED TAPE SIXBIT /FIND/ ;FIND WHAT TAPE PARTICULAR FILE IS ON SIXBIT /OFIND/ ;FIND COMMAND USING A TAPE FOR INFO SIXBIT /DFIND/ ;FIND COMMAND FOR A DECEASED ITS. SIXBIT /DUMP/ ;DUMP FILES SIXBIT /LOAD/ ;LOAD FILES SIXBIT /RELOAD/ ;LOAD FILES, MODIFY DIRECTORY FROM TAPE COPY SIXBIT /CLOAD/ ;CONTINUE PREVIOUS LOAD OPERATION SIXBIT /CDUMP/ ;CONTINUE FULL DUMP SIXBIT /REWIND/ ;REWIND MAG TAPE SIXBIT /UNLOAD/ ;REWIND/UNLOAD SIXBIT /FLAP/ ;REWIND/UNLOAD SIXBIT /EOT/ ;GO TO END OF TAPE SIXBIT /LIST/ ;LIST FILES ON TAPE SIXBIT /MFD/ ;LIST OUT MFD SIXBIT /LISTF/ ;LIST OUT FILE DIRECTORY SIXBIT /HELP/ ;TYPE OUT COMMANDS SIXBIT /SPACE/ ;SPACE FORWARD N FILES SIXBIT /LSPACE/ ;SPACE FORWARD AND LIST FILES SIXBIT /CHECK/ ;CHECK FILES SIXBIT /LCHECK/ ;CHECK FILES AND LIST THEM SIXBIT /TAPES/ ;LIST ALL SAVED TAPE INFO SIXBIT /TAPE/ ;LIST SAVED INFO ABOUT ONE TAPE SIXBIT /TAPSET/ ;SET TAPE INFO FOR ONE TAPE SIXBIT /TLIST/ ;LIST FILES ON A TAPE(AS STORED ON DISK) SIXBIT /GFR/ ;GRIM FILE REAPER SIXBIT /QUIT/ ; REWIND AND KILL SIXBIT /ICHECK/ SIXBIT /ERRSTS/ ;TAPE CONTROL STATUS AS OF LAST ERROR SIXBIT /ALLOC/ ;SET/GET DIRECTORY ALLOCATION SIXBIT /LSTALC/ ;LIST ALL ALLOCATED DIRECTORIES SIXBIT /PTDIR/ ;PRINT DIRECTORIES FROM TAPE NCOMS==.-COMT COMHLP: ASCIZ\ LOCAL Use local tape drive on this machine REMOTE Use remote tape drive over the Chaos network FIND Find what tape a particular file is on OFIND FIND command using a tape for info DFIND FIND command for a deceased ITS DUMP Dump files LOAD Load files RELOAD Load files, modify directory from tape copy CLOAD Continue previous LOAD/RELOAD operation CDUMP Continue full dump REWIND Rewind mag tape UNLOAD Rewind/unload EOT Go to end of tape SPACE Space forward n files LSPACE Space forward and list files, hit after each LIST List files on tape MFD List MFD from disk LISTF List a file directory from disk HELP Type out commands CHECK Check files on tape against disk LCHECK Check files and list them ICHECK Check files on incremental dump, update dump-check bits TAPED Generate tape directory from mounted tape TAPES List all saved tape info TAPE List saved info about one tape TAPSET Set tape info for one tape TLIST List files on a tape (from tape directory stored on disk) GFR Grim File Reaper (Don't use this, please) QUIT return to DDT ERRSTS Print tape control status as of last error ALLOC Examine or change directory allocation LSTALC List all directories with allocations PTDIR Print directories from tape \ COMDTB: ALOCAL ;SETZ MEANS THAT COMMAND USES THE TAPE DRIVE AREMOTE ATAPED AFIND SETZ OFIND DFIND SETZ DUMP SETZ LOAD SETZ RELOAD SETZ ACLOAD SETZ ACDUMP ARWND AUNLD AUNLD AEOT SETZ ALIST AMFD ALISTF AHELP SETZ ASPACE SETZ ALSPACE SETZ ACHECK SETZ ALCHEC ATAPES ATAPE TAPSET ATLIST AGFR AQUIT AICHEC ERRSTS DALLOC LSTALC SETZ APTDIR IFN .-COMDTB-NCOMS, .ERR COMDTB NOT SAME LENGTH AS COMT SUBTTL TTY I/O TYI: .IOT TYIC,A ;TTY IN JUMPL A,TYICC1 ;EOF ON INDIRECT FILE CAIN A,^C ;IGNORE GARBAGE CHARS JRST TYI CAIN A,^G JRST TYI CAIL A,"a ;UPPER CASE LOWER CASE LETTERS CAILE A,"z CAIA SUBI A,40 SKIPE TYIPD JRST TYIDSK CAIE A,15 POPJ P, PUSHJ P,CAR ;CR ECHOS AS CRLF MOVEI A,15 POPJ P, TYIDSK: CAIN A,12 JRST TYI ;IGNORE LINE FEEDS IN DISK INPUT JRST TYO ;ECHO STUFF ON TTY TYICC1: SKIPG TYIPD POPJ P, SOS TYIPD ;AT END OF INDIRECT FILE .IOPOP TYIC, JRST TYI ;RETURN CARRIAGE CRR: MOVEI A,15 CAR: PUSHJ P,TYO MOVEI A,12 JRST TYO ;TTY/LPT/TPL OUT TYO: SKIPGE LPTSW JRST LPTTYO TYO1: .IOT TYOC,A POPJ P, LPTBUF: BLOCK 40 LPTBEP: 010700,,.-1 LPTBBP: 440700,,LPTBUF LPTBFP: 440700,,LPTBUF LPTBFC: 0 LPTTYO: PUSH P,B JUMPL A,LPTTO1 IDPB A,LPTBFP AOS LPTBFC CAIN A,^J JRST LPTTO1 MOVE B,LPTBFP CAME B,LPTBEP JRST POPBJ LPTTO1: MOVE B,LPTBBP MOVEM B,LPTBFP .CALL [ SETZ SIXBIT /SIOT/ MOVEI LPTCH MOVE B SETZ LPTBFC ] .LOSE 1000 SETZM LPTBFC POPBJ: POP P,B POPJ P, TYOS: PUSH P,A MOVEI A,40 ;OUTPUT SPACE PUSHJ P,TYO JRST POPAJ SUBTTL SYLLABLE INPUT ;THE FOLLOWING ROUTINE INPUTS A SYLLABLE. ;THE SYLLABLE ENDS UP AS SIXBIT IN SYM. ;IF IT IS COMPOSED OF DIGITS, THEY ARE COMPILED INTO A DECIMAL NUMBER ;AND STORED IN N. ;CARRIAGE RETURN, LINEFEED, SEMI-COLON, COLON, BACKARROW, AND ALTMODE END THE ;SYLLABLE BUT ARE NOT PART OF IT. THE TERMINATOR IS PUT IN TER. ;NON-SIXBIT CHARACTERS CAUSE GETSYL TO PRINT ?? AND WAIT FOR THE ;ENTIRE SYLLABLE AGAIN. SINGLE CHARACTER RUBOUT WORKS, ;BUT IF YOU RUBOUT BEYOND THE FIRST CHARACTER, GETSYL RETURNS WITHOUT ;SKIPPING. SUCCESSFUL RETURN IS A SKIP RETURN. ^Q MAY BE USED TO ENTER ;A TERMINATOR AS SIXBIT SUCH AS SEMI-COLON, OR COLON. ;RUBBED OUT CHARACTERS ARE ECHOED. GETSYL: SETZB N,GTSYCC ;CLEAR SIXBIT VALUE, NUMERIC VALUE, SETZB SYM,GTSYNF ; CHARACTER COUNT, NEGATIVE FLAG MOVE B,[440600,,SYM] GETCH: PUSHJ P,TYI SKCHAR: CAIN A,177 JRST RUBOUT CAIE A,"_ ;BACK-ARROW CAIN A,33 ;ALTMODE JRST OUTSYL CAIE A,15 ;CARRIAGE RETURN CAIN A,12 ;LINEFEED JRST OUTSYL CAIE A,"; ;SEMI-COLON CAIN A,": ;COLON JRST OUTSYL CAIN A,40 ;SPACE JRST OUTSYL CAIN A,^L ;SO USER CAN CLEAR SCREEN JRST GETSFF CAIN A,^Q JRST QUOTE CAIGE A,40 JRST OUTSYL ;ANY RANDOM CONTROL TERMINATES CAIN A,"- SETCMM GTSYNF NUMQ: CAIGE A,40 JRST CHERR CAIL A,"0 CAILE A,"9 JRST NONUM IMULI N,10. ADDI N,-"0(A) NONUM: SUBI A,40 TLNE B,770000 IDPB A,B AOS GTSYCC JRST GETCH QUOTE: PUSHJ P,TYI CAIE A,177 JRST NUMQ ;RUB OUT QUOTE RATHER THAN QUOTING RUBOUT .CALL [ SETZ ? 'CNSGET ? MOVEI TYOC REPEAT 4,[ MOVEM A ? ] SETZM A ] ;GET TTYOPT MOVEI A,0 TLNE A,%TOOVR TLNE A,%TOERS JRST [ PRINT XX JRST GETCH ] PRINT ^Q JRST GETCH GETSFF: SKIPN GTSYCC JRST OUTSYL ;NOTHING TYPED, TERMINATE PUSH P,N ;OTHERWISE, RE-ECHO MOVE N,[440600,,SYM] SETZM GTSYCC ;NOTE TRUNCATES TO AT MOST 6 CHARS GETSF1: ILDB A,N ADDI A,40 AOS GTSYCC PUSHJ P,TYO CAME N,B JRST GETSF1 POP P,N JRST GETCH RUBOUT: SKIPN GTSYCC JRST RUB1 LDB A,B ADDI A,40 PUSH P,C .CALL [ SETZ ? 'CNSGET ? MOVEI TYOC REPEAT 4,[ MOVEM C ? ] SETZM C ] ;GET TTYOPT MOVEI C,0 TLNE C,%TOOVR TLNE C,%TOERS JRST [ PUSH P,A MOVEI A,^P PUSHJ P,TYO MOVEI A,"X PUSHJ P,TYO POP P,A JRST RUB0 ] PUSHJ P,TYO RUB0: POP P,C CAIL A,"0 CAILE A,"9 JRST NOUNM SUBI N,-"0(A) PUSH P,SYM IDIVI N,10. POP P,SYM ;DIVISION CLOBBERS SYM NOUNM: SOS A,GTSYCC CAIL A,6 JRST GETCH SETZ A, DPB A,B ADD B,[60000,,] JRST GETCH RUB1: PRINT ?? PUSHJ P,TYOS POPJ P, CHERR: PRINT ?? PUSHJ P,TYOS JRST GETSYL OUTSYL: MOVEM A,TER AOSN GTSYNF MOVNS N JRST POPJ1 GETSL1: SETZB N,GTSYCC ;CLEAR SIXBIT VALUE, NUMERIC VALUE, SETZB SYM,GTSYNF ; CHARACTER COUNT, NEGATIVE FLAG MOVE B,[440600,,SYM] JRST SKCHAR SUBTTL INTERRUPT ROUTINE INT: 0 0 PUSH P,A MOVE A,INT TRZE A,%PITYI JRST TYILK ;CHARACTER TYPED POP P,A INTGO: MOVEM 17,INTAC+17 MOVEI 17,INTAC BLT 17,INTAC+16 ;SAVE ACS MOVE 17,INTAC+17 PUSH P,LPTSW SETZM LPTSW ;TYPE IOCER MESSAGE ON TTY NOT LPT MOVE A,INT TRNN A,%PIIOC JRST RNDINT ;NOT TTY OR IOC .SUSET [.RBCHN,,A] ;IOCER, GET CHANNEL CAIN A,MAGIN JRST INT1 CAIN A,DSKIN JRST INT3 CAIN A,DSKOUT JRST INT5 CAIE A,RTAPE"RSICH CAIN A,RTAPE"RSOCH JRST [ SKIPGE TAPTYP SETOM TAPTYP ;REMOTE TAPE CONNECTION BROKEN JRST .+1 ] CAIE A,MAGOUT ;NOT MACRO-TAPE INPUT JRST NTMGTP ;NOT MACRO TAPE OUTPUT EITHER ! SKIPN DMPMOD JRST NTDMMP ;NOT DUMPING ON MACRO-TAPE .STATUS MAGOUT,A LDB A,[330600,,A] ;IOCER FIELD CAIE A,9 JRST NTNDOF ;NOT END OF TAPE NTNDO1: MOVEI A,FOOB ;AH ! I KNOW HOW TO HANDLE END OF TAPE ! SKIPGE FULLDMP JRST INTX1 ;CAUSE PROGRAM TO RESTART AT FOOB PRINT _PHYSICAL END OF TAPE .DISMISS [ERR] RNDINT: PRINT _INTERRUPT POCT A .DISMIS [ERR] NTMGTP: PRINT _INTERRUPT ON CHANNEL POCT A PSIS CHNTAB(A) ;TYPE DEVICE AND DIRECTION .DISMIS [NAUGHT] NTDMMP: PRINT _INTERRUPT MAG TAPE OUT WHEN NOT DUMPING .DISMIS [NAUGHT] NTNDOF: PUSH P,A PUSHJ P,ERRSTS ;PRINT MAGTAPE ERROR STATUS POP P,A PRINT _INTERRUPT POCT A PRINT MAG TAPE OUT .. SIMULATING E-O-T .. JRST NTNDO1 CHNTAB: SIXBIT /RANDOM/ SIXBIT /MFD IN/ SIXBIT /DRC IN/ SIXBIT /DSK IN/ SIXBIT /MAGOUT/ SIXBIT /TTY IN/ SIXBIT /TTYOUT/ SIXBIT /DSKOUT/ SIXBIT /MAG IN/ SIXBIT /LPTOUT/ SIXBIT /ERR IN/ SIXBIT /STATUS/ SIXBIT /SAVET/ SIXBIT /SNPLCH/ SIXBIT /RMT IN/ SIXBIT /RMTOUT/ ;IOCER ON DISK OUTPUT, MOST LIKELY DEVICE OR DIRECTORY FULL ;LET DDT HANDLE IT. INT5: MOVE A,INT+1 ;SAVE PC MOVEM A,IOCPC' JSP A,INTX1 ;DISMISS AND COME BACK ;PASS THE ERROR TO DDT .CALL [SETZ ? SIXBIT/LOSE/ ? MOVEI <1+.LZ %PIIOC> ? SETZ IOCPC] .VALUE ;DISK INPUT ERROR INT3: .STATUS DSKIN,A LDB A,[330600,,A] ;IOCER FIELD CAIN A,3 JRST INT4 ;JUMP IF IRRECOV DATA ERROR PRINT INTERRUPT POCT A PRINT DISK IN .DISMIS [NAUGHT] INT4: SKIPN SUPERC PRINT DATA ERROR DISK IN_ AOS ERRDSK SETOM ERRALL HRRZ C,INT+1 POCT C ;PC OF LOSING INSTRUCTION MOVE A,[DSKIN,,INTERR] .RCHST A, MOVEI A,INTERR MOVE B,INTERR+3 PUSHJ P,TELL AOS INT+1 ;ABANDON THE .IOT THAT LOST JRST INTX TYILK: MOVEM A,INT ; DON'T DROP OTHER INTERRUPTS! TYILK1: MOVEI A,TYIC ;CHARACTER TYPED .ITYIC A, JRST POPEN CAIE A,^G JRST TYILK1 .RESET TYOC, SKIPN A,CTRLG ;SKIP IF DEFERRED .DISMIS [ERR] ;DEATH TO CURRENT OPERATION MOVNM A,CTRLG ;SET IT POSITIVE TO FLAG DEFERRED JUMPL A,TYILK1 ;JUMP IF ^G TYPED FOR THE FIRST TIME SKIPGE TAPTYP ;^G WHILE DEFERRED, KILL REMOTE TAPE CONNECTION SETOM TAPTYP .DISMIS [ERR] CTRLGX: AOSG CTRLG POPJ P, ;NO ^G HAPPENED WHILE DEFERRED JRST ERR POPEN: POP P,A SKIPE INT ; Any more pending? JRST INTGO ; Yes, go do 'em .DISMIS INT+1 ; No, all done NAUGHT: PUSHJ P,OPINFL JRST ERR ;Can only get here for local tape drive INT1: PUSH P,TAPTYP ;Select local drive if in TCOPY MOVEI A,1 MOVEM A,TAPTYP PUSHJ P,ERRSTS ;PRINT MAG TAPE ERROR STATUS .STATUS MAGIN,A ;INTERUPT ON MAG TAPE INPUT LDB A,[330600,,A] ;IOCER FIELD CAIN A,3 JRST INT2 ;NON RECOV DATA ERR POP P,TAPTYP CAIN A,9 SKIPE TCOPYF JRST INT1B ;PHYSICAL EOT OR TCOPYING SKIPE DMPMOD ;IF DOING A DUMP, MUST BE A COMPARE JRST INT1A PRINT _INTERRUPT POCT A PRINT MAG TAPE IN .DISMIS [NAUGHT] ;--- This is preposterously bogus, but fortunately is never reached ;--- since ICHECK+5 doesn't check last directory on reel INT1A: POP P,LPTSW .DISMIS [ICKEOT] INT1B: SETOM RDERR SETOM PHYEOT PRINT PHYSICAL END OF INPUT TAPE_ AOS INT+1 ;CAUSE .IOT TO RETURN WITHOUT READING JRST INTX INT2: AOS ERRCNT SETOM ERRALL PUSHJ P,TAPN PSIS HSNM PSIS HFN1 PSIS HFN2 PRINT DATA ERROR TAPE IN ..FILE BEING SKIPPED.._ PUSHJ P,OPINFL SETOM RDERR IFN NEWCOD, .STATUS MAGIN,B .CLOSE MAGIN, IFE NEWCOD, CONI 344,B TRNE B,TF%EOF ;EOF? JRST INT2X ;YES .OPEN MAGIN,MAGI ;NO, SKIP TO EOF JFCL AOS INT+1 ;SKIP OVER THE .IOT THAT LOST, NOTE THAT PUSHJ P,FILSKP ; 'RDERR' HAS BEEN SET, HOPEFULLY WE WERE INT2X: POP P,TAPTYP ; IN 'MAGREAD' WHEN THE ERROR OCCURRED. JRST INTX SUBTTL MAG TAPE STATUS DECODER ERRSTS: SKIPGE TAPTYP JRST RTAPE"PRSTS ;Print remote tape status PRINT _MAG TAPE STATUS MOVE A,[SQUOZE 0,MGEMTC] .EVAL A, .LOSE MOVSS A HRRI A,A .GETLOC A, ;A GETS CONI MTC, AT TIME OF ERROR IFE NEWCOD,[ LDB B,[110400,,A] ;FUNCTION PASC @(B)[[ASCIZ/NO-OP/] ;0 [ASCIZ/REWIND/] [ASCIZ/READ/] [ASCIZ/READ-COMPARE/] [ASCIZ/WRITE/] [ASCIZ/WRITE-EOF/] [ASCIZ/SPACE-FWD/] [ASCIZ/SPACE-REV/] [ASCIZ/AWAIT-UNIT-READY/] ;10 [ASCIZ/UNLOAD/] [ASCIZ/READ-MULTI-RECORD/] [ASCIZ/READ-COMPARE-MULTI-RECORD/] [ASCIZ/ERASE-THEN-WRITE/] [ASCIZ/ERASE/] [ASCIZ/SPACE-FILE-FWD/] [ASCIZ/SPACE-FILE-REV/]] LDB B,[060200,,A] PSIS (B)[SIXBIT/200BPI556BPI800BPI???BPI/] LDB B,[160100,,A] SIXTYP (B)[SIXBIT/ ODD EVEN /] PRINT PAR LDB B,[150100,,A] SKIPN B PRINT IBM MODE PRINT _ SETCM D,A ANDI D,7 ;= 0 IF DATA CHANNEL MOVE A,[SQUOZE 0,MGEMTS] .EVAL A, .LOSE MOVSS A HRRI A,A .GETLOC A, ;A GETS CONI MTS, AT TIME OF ERROR SKIPE D TLZ A,170 ;CLEAR CHANNEL STATUS IF NO CHANNEL MOVSI B,-LMTSTB/2 ERRST1: TDNE A,MTSTAB(B) PASC @MTSTAB+1(B) AOS B AOBJN B,ERRST1 POPJ P, MTSTAB: 10 ? [ASCIZ/WRITE-LOCK /] 200 ? [ASCIZ/BAD-TAPE /] 400 ? [ASCIZ/DATA-LATE /] 2000 ? [ASCIZ/READ-COMPARE-ERROR /] 4000 ? [ASCIZ/END-OF-TAPE /] 10000 ? [ASCIZ/END-OF-FILE /] 20000 ? [ASCIZ/TAPE-PARITY-ERROR /] 40000 ? [ASCIZ/ILLEGAL-COMMAND /] 100000 ? [ASCIZ/BEGINNING-OF-TAPE /] 200000 ? [ASCIZ/REWINDING /] 400000 ? [ASCIZ/UNIT-HUNG /] 20,, ? [ASCIZ/CHANNEL-DATA-PARITY-ERROR /] 40,, ? [ASCIZ/CHANNEL-NXM-ERROR /] 100,, ? [ASCIZ/CHANNEL-CONTROL-WORD-PARITY-ERROR /] LMTSTB==.-MTSTAB ];IFE NEWCOD .ELSE [;--- JTW missed this routine DIE TM03 error status decode routine needs to be written ];IFN NEWCOD SUBTTL DIRECTORY ALLOCATION COMMAND DALLOC: PRINT [ DIR=] PUSHJ P,GETSYL POPJ P, .CALL [ SETZ ? SIXBIT/OPEN/ ? [.BII,,UFDCH] [SIXBIT/DSK/] ? [SIXBIT/.FILE./] ? [SIXBIT/(DIR)/] ? SETZ SYM] JRST OPINFL MOVE A,[-2000,,UFDBUF] .IOT UFDCH,A .CLOSE UFDCH, HLRZ A,UFDBUF+UDBLKS JUMPE A,[ PRINT [_NO QUOTA] JRST DALLC1 ] PRINT [_QUOTA=] PDPT A DALLC1: PRINT [, USED=] HRRZ A,UFDBUF+UDBLKS PDPT A SKIPN UFDBUF+UDALLO JRST [ PRINT [, NO ALLOCATION] JRST DALLC2 ] PRINT [, ALLOCATED TO PACK ] HLRZ A,UFDBUF+UDALLO PDPT A HRRZ A,UFDBUF+UDALLO JUMPE A,DALLC2 PRINT [, BLKS=] PDPT A DALLC2: PRINT [_CHANGE ALLOCATION?] DALLC3: PUSHJ P,TYI MOVE D,A PUSHJ P,CRR CAIE D,"N CAIN D,"Y JRST DALLC4 PRINT [(Y or N) ] JRST DALLC3 DALLC4: CAIE D,"Y POPJ P, .SUSET [.SSNAME,,UFDBUF+UDNAME] MOVE A,UFDBUF+UDNAMP CAIN A,2000 JRST [ MOVSI B,'FOO ;DIR EMPTY, MAKE DUMMY FILE MOVEM B,FN1 MOVEM B,FN2 MOVEI B,.UIO HRLM B,TRNI OPEN DSKIN,TRNI POPJ P, PUSHJ P,DALLC5 .FDELE TRNI JFCL POPJ P, ] MOVE B,UFDBUF+UNFN1(A) MOVEM B,FN1 MOVE B,UFDBUF+UNFN2(A) MOVEM B,FN2 DALLC5: MOVEI B,.BII+30 ;DON'T SET REF DATE, DON'T CHASE LINKS HRLM B,TRNI OPEN DSKIN,TRNI POPJ P, PRINT [NEW QUOTA=] PUSHJ P,GETSYL POPJ P, MOVE W,N PRINT [_NEW ALLOCATED PACK=] PUSHJ P,GETSYL POPJ P, HRLZ X,N PRINT [_NEW ALLOCATED #BLOCKS=] PUSHJ P,GETSYL POPJ P, HRR X,N .CALL [ SETZ ? 'DIRSIZ ? MOVEI DSKIN ? MOVE W ? SETZ X ] JRST OPINFL PRINT [_DONE] POPJ P, ;COMMAND TO LIST ALL DIRECTORY ALLOCATIONS LSTALC: PUSHJ P,DEVGET SETOM MFDIN MOVEI A,.BII HRLM A,FNO LSTAL1: PUSHJ P,MFDN POPJ P, .SUSET [.SSNAME,,USNM] OPEN UFDCH,FNO POPJ P, MOVE A,[-2000,,UFDBUF] .IOT UFDCH,A .CLOSE UFDCH, HLRZ A,UFDBUF+UDBLKS ;QUOTA SKIPN UFDBUF+UDALLO JUMPE A,LSTAL1 ;SKIP THIS IF NOTHING INTERESTING SIXTYP USNM JUMPE A,LSTAL2 PRINT [ QUOTA=] PDPT A LSTAL2: SKIPN UFDBUF+UDALLO JRST LSTAL3 PRINT [ ALLOCATED TO PACK #] HLRZ A,UFDBUF+UDALLO PDPT A HRRZ A,UFDBUF+UDALLO JUMPE A,LSTAL3 PRINT [, ALLOCATION=] PDPT A LSTAL3: PRINT [, BLOCKS USED=] HRRZ A,UFDBUF+UDBLKS PDPT A PUSHJ P,CRR JRST LSTAL1 SUBTTL END OF TAPE ROUTINE FOOB: MOVE P,ERRPDP ;POPJ P, will return from ADMP3 POP P,A ;Remove that return PC from pdl MOVEM P,INTAC+P SKIPL LSTWHL JRST FOOB1 MOVEI A,^L SKIPE LPTSW PUSHJ P,TYO ;PAGE THROW ON LPT BETWEEN REELS FOOB1: PUSH P,LPTSW SETZM LPTSW SKIPL TAPTYP .CLOSE MAGOUT, SKIPG TAPTYP PUSHJ P,RTAPE"BUFRST SETZM MAGOPN SKIPN EXPERM SKIPN INCREM JRST FOOE ;JUMP IF NOT TO CHECK SKIPE CKIDMP JRST FOOE ;.. PRINT _REWINDING IFE MCOND DM,[ MOVE B,NFTDMP SOS B MOVN N,NFTDMP CAMN B,ITAPE ;IF NOT EQUAL, THEN IT IS NOT THE WHOLE TAPE JRST FOOB1A PUSHJ P,ASPAC1 SKIPA ] FOOB1A: PUSHJ P,ARWND PRINT _CHECKING INCREMENTAL DUMP_ PUSH P,USNM PUSHJ P,ICHECK POP P,USNM .SUSET [.SSNAM,,USNM] SETZM NFTDMP FOOE: PUSHJ P,ARWND ;REWIND IT PUSHJ P,GESELL ;GIVE AWAY BEGINNING AND LAST USER ON THIS REEL .RESET TYIC, FOOD: PRINT _MOUNT NEW TAPE THEN TYPE OK. PUSHJ P,GETSYL JRST .-1 MOVE A,SYM CAMN A,[SIXBIT /OK/] JRST FOOC CAMN A,[SIXBIT /STOP/] JRST MAYBE JRST FOOD FOOC: PUSHJ P,ARWND AOS NTAPES MOVE A,USNM CAME A,FUSNM ;SEE IF ONE DIR FILLED UP THE WHOLE REEL JRST FOOF SIXTYP A PRINT [ DIRECTORY FILLS WHOLE REEL, CONTINUING ONTO ANOTHER REEL._] SOS FLNI ;DO MOST RECENT FILE AGAIN MOVEI A,ADMP2 JRST INTX1 FOOF: MOVEM A,FUSNM SKIPGE FULLDMP SETOM DMPMFD ;DUMP THE MFD AGAIN AT START OF NEXT REEL SKIPGE FULLDMP SETOM DMPDIR ;REDO SAME DIRECTORY AGAIN SETOM APPENF ;SO USER UFD WILL BE OPENED MOVEI A,DMPAGN ;RESTART LOCATION FOR NEXT REEL INTX1: HRRZM A,INT+1 INTX: POP P,LPTSW MOVSI 17,INTAC BLT 17,17 ;RESTORE ACS .DISMIS INT+1 MAYBE: PRINT GIVE UP ? PUSHJ P,TYI CAIE A,"Y JRST FOOD JRST MLP ;HE REALLY WANTS TO STOP DUMPING NOW GESELL: SETOM SDONE MOVEI A,1 SKIPE ARCHVF MOVEM A,SDONE PUSHJ P,SINFO PRINT REEL PDPT NTAPES ;OUTPUT REEL NUMBER AND USER SPAN ON THIS REEL PRINT FIRST USER = PSIS FUSNM PRINT LAST USER = PSIS LUSNM JRST CRR SUBTTL LOAD, RELOAD, DUMP, CDUMP COMMANDS RELOAD: PRINT THIS WILL SMASH YOUR DIRECTORY. PUSHJ P,CHECK SETOM RELOSW ;RELOAD DISKS FROM TAPE JRST LOAD ACDUMP: SETOM CDMFL ;CONTINUE FULL DUMP SKIPA DUMP: CLEARM CDMFL SETOM DMPMOD ;GENERALISED DUMP SKIPA LOAD: CLEARM DMPMOD ;GENERALISED LOAD MOVSI A,-NFIGS ;CLEAR OPTIONS CLEARM @FIGTB2(A) AOBJN A,.-1 CLEARM MICFLG CLEARM CUSN SETOM DPACK MOVEI A,1 MOVEM A,THTYPE CAIN TER,15 JRST EXECU ;NO SWITCHES FORTH COMING LOOP: PUSHJ P,TYI CAIN A,"? JRST FIGLST ;GIVE INFO ON OPTIONS AVAILABLE PUSHJ P,GETSL1 POPJ P, ;OVER-RUBOUT, FLUSH PUSHJ P,SPACET ;PROCESS OPTION CAIN TER,15 JRST EXECU JRST LOOP SPACET: JUMPE SYM,CPOPJ MOVSI A,-NFIGS CAMN SYM,FIGTB1(A) JRST SPASED AOBJN A,.-2 SUB P,[1,,1] ;UNKNOW OPTION, BARF PRINT ? PSIS SYM PUSHJ P,TYOS PRINT IGNORED PUSHJ P,TYOS JRST LOOP ;BUT DON'T GIVE UP ENTIRELY SPASED: SETOM @FIGTB2(A) ;SET FLAG FOR OPTION SPECIFIED POPJ P, FIGLST: PASC FIGHLP ;LIST OPTIONS AND DESCRIPTIONS JRST LOOP ;CONTINUE LOADING WITH SAME OPTIONS COMMAND ACLOAD: .SEE FLUSH ;AS IT STANDS, THIS CAN'T WORK!! DIE SORRY THIS COMMAND DOESN'T WORK MOVE A,CLOADF ;RESTORE OPTIONS MOVEM A,DMPMOD JUMPL A,[DIE [LAST OPERATION WAS DUMP]] MOVE A,CLOADF+1 MOVEM A,RELOSW MOVE A,CLOADF+2 MOVEM A,LENGTH MOVSI A,-NFIGS MOVEI B,3 ACLOD1: MOVE C,CLOADF(B) MOVEM C,@FIGTB2(A) ADDI B,1 AOBJN A,ACLOD1 SETOM ACLODF JRST EXECU ;GO EXECUTE IT ;NOTE IF UPDATE THIS, UPDATE FIGTB2 AND FIGHLP (ALSO ON THIS PAGE) FIGTB1: SIXBIT /INCREM/ SIXBIT /I/ SIXBIT /MERGE/ SIXBIT /M/ SIXBIT /FULL/ SIXBIT /F/ SIXBIT /CARE/ SIXBIT /C/ SIXBIT /EXPERI/ SIXBIT /E/ SIXBIT /LIST/ SIXBIT /L/ SIXBIT /SORRY/ SIXBIT /S/ SIXBIT /NOASK/ SIXBIT /DECIDE/ SIXBIT /D/ SIXBIT /DATE/ SIXBIT /DATES/ SIXBIT /ARCHIV/ SIXBIT /A/ SIXBIT /REAP/ SIXBIT /R/ SIXBIT /NO/ SIXBIT /LINKS/ SIXBIT /CRDIR/ NFIGS==.-FIGTB1 FIGHLP: ASCIZ\ INCREM, I Do an Incremental dump FULL, F Do a Complete dump LIST, L Generate a listing of files loaded or dumped MERGE, M Don't load over existing file with the same name CARE, C Don't load over files not yet backed up EXPERI, E Don't set has-been-backed-up bits SORRY, S Go ahead and load over files with newer creation dates NOASK Don't ask whether a file should be loaded over, assume "no" DATE Dump only files with creation date greater or equal specified DATES Dump only files with creation date between two dates specified ARCHIV, A Declare this dump tape to be Archival. REAP, R Do a reap after dumping (don't use this, please) DECIDE, D (Supposedly controls tape number assignment) NO Don't check incremental dump (one pass instead of two) LINKS Dump links as well as files CRDIR Create directories that files are being loaded into OPTIONS: \ FIGTB2: INCREM INCREM MRGSW MRGSW FULLDMP FULLDMP CAREF CAREF EXPERM EXPERM LSTWHL LSTWHL LOSRSW LOSRSW NOASK DECIDF DECIDF DATEF DATESF ARCHVF ARCHVF REAPSW REAPSW CKIDMP DMPLNK CRDIR IFN .-FIGTB2-NFIGS, .ERR FIGTB2 NOT SAME LENGTH AS FIGTB1 ;NOTE: ABOVE LOCATIONS ARE MUNGED OVER BY EXECU AND ;THEN SET TO DIFFERENT VALUES THAN JUST WHETHER THE ;USER GAVE THE SWITCH OR NOT, IN SOME CASES. ;BEGIN EXECUTION OF LOAD OR DUMP OPERATION. ;FIRST STEP IS TO CLEAN UP OPTIONS AND ASK FOR ADDITIONAL INFO. EXECU: MOVE A,DMPMOD ;SAVE CRUFT FOR 'CLOAD' COMMAND MOVEM A,CLOADF MOVE A,RELOSW MOVEM A,CLOADF+1 MOVSI A,-NFIGS MOVEI B,3 EXECU0: MOVE C,@FIGTB2(A) MOVEM C,CLOADF(B) ADDI B,1 AOBJN A,EXECU0 ;Make sure the tape is not positioned in the middle of a file ;Also decide whether the first thing read/written should be a tape header MOVE A,TAPEF ;Tape status left by SETIT TRNN A,TF%BOT JRST [ PUSHJ P,SPRF ;Space reverse file PUSHJ P,SETIT1 ;Get status again TRNE A,TF%BOT JRST .+1 ;That moved it to beginning of tape PUSHJ P,SPFF ;Get to beginning of next file JRST .+2 ] SETOM THTPN ;At front of tape, we don't know the number SKIPE REAPSW PUSHJ P,REAPCK SETZM NPLACE SKIPGE DATESF SETOM DATEF SETZM NFTDMP SKIPGE CDMFL SETOM FULLDMP ;CDUMP IS A FULL ONE CLEARM PACKN SKIPE MICFLG CLEARM INCREM ;NO INCREMENTAL DUMPS FROM DEC-TAPE SETZM THTYPE ;DEFAULT TO RANDOM TYPE OF TAPE ; Removed by Alan 11/17/86, who didn't think it was a feature. ; SKIPGE DATEF ; SETOM FULLDMP ;DATES SPECIFIED => DUMP ALL SKIPGE FULLDMP SETOM EXPERM ;IF DUMPING ALL, DON'T SET DMPCHK BIT! SKIPGE DATESF SKIPE ACLODF CAIA PUSHJ P,GETUDT ;GET UPPER DATE SKIPGE DATEF SKIPE ACLODF CAIA PUSHJ P,GETLDT ;GET LOWER DATE SKIPGE FULLDMP AOS THTYPE SKIPGE INCREM SOS THTYPE SKIPGE A,INCREM SETOM FULLDMP ;AN INCREMENTAL DUMP IS ALWAYS A FULL ONE SKIPN ACLODF JRST [ SKIPGE DMPMOD SKIPL FULLDMP PUSHJ P,FILGET ;GET FILE NAMES OF FILES TO DUMP OR LOAD JRST .+1 ] SKIPE LSTWHL SKIPE ACLODF CAIA PUSHJ P,DEVGET ;GET LISTING DEVICE SETZM ACLODF .SUSET [.SSNAME,,USNM] SKIPN DMPMOD JRST RETRV0 ;LOAD SKIPL CDMFL SKIPE ITAPE CAIA CLEARM NTAPES ;COMMAND WAS DUMP ONLY DO THIS IF NOT CDUMP AND TAPE IS REWOUND SETOM MFDIN SETOM FLNI SKIPE CDMFL JRST EXECU1 SKIPL FULLDMP JRST ADUMP2 ;SINGLE FILE DUMP SETOM DMPMFD ;STARTING FULL OR INCREMENTAL DUMP, SO SETOM DMPDIR ;DUMP THE MFD AT THE FRONT AND DUMP JRST ADMP1 ;EACH UFD THAT HAS CHANGED. REAPCK: PUSHJ P,CRR PRINT YOU SPECIFIED REAP PUSHJ P,CHECK POPJ P, GETUDT: PRINT LATEST DAY - PUSHJ P,GETDAT MOVE A,DATE HLLOM A,DATE1 POPJ P, GETLDT: PRINT EARLIEST DAY - JRST GETDAT SUBTTL CONTINUING A COMPLETE DUMP, GET TAPE AND MFD BACK INTO PHASE ;TAPE FILE MISSING, DO REEL OVER EXECU2: PRINT _MAY I REWIND AND RESTART THIS REEL ?? PUSHJ P,CHECK2 PUSHJ P,ARWND PRINT ON THE LAST REEL_ EXECU1: SKIPGE ITAPE ;REWOUND ??? JRST SETFNG ;YES PUSHJ P,TAPEMB PUSHJ P,SNPLAC MOVEI A,.BII HRLM A,NSVOP OPEN SAVET,NSVOP ;GET .TAPEn; TAPE nnn FILE JRST EXECU2 MOVE B,[-LTHBLK-1,,BUF] ;FIND OUT LAST USER DUMPED .IOT SAVET,B SETOM A EXECU3: MOVE B,[-2000,,BUF] EXECU4: SKIPL A JRST LOOKSM .IOT SAVET,B HLLZS B SKIPGE B SETZM A MOVE C,[-2000,,BUF] SUB C,B SETOM D EXECU5: CAME D,(C) AOBJN C,EXECU5 HLRE B,C SKIPN B JRST EXECU3 ;COUNT RAN OUT AOJE B,EXECU6 ;ON BLOCK BOUNDRY? AOBJN C,.+1 MOVE B,(C) MOVEM B,USNM JRST EXECU5 EXECU6: HRROI B,USNM .IOT SAVET,B MOVE B,[-1777,,BUF+1] SETZM BUF JRST EXECU4 LOOKSM: PUSHJ P,SPRF ;BACK OVER TWO FILES PUSHJ P,SPRF PUSHJ P,SETIT1 ;Get tape status TRNN A,TF%BOT ;Unless BOT, PUSHJ P,SPFF ; Forward one file PUSHJ P,SETIT SKIPGE ITAPE ;DID WE BACK UP TO BEGINING OF TAPE ??? JRST SETFNG ;YES PUSHJ P,MAGOP ;READ HEADER FOR DIRECTORY NAME .VALUE ;EOT AFTER BACKSPACING ????? MOVE A,USNM ;IS DIRECTORY NAME OF FILE ON TAPE THE SAME CAME A,HSNM ; AS THE ONE WE ARE LOOKING FOR ??? JRST LOOKSM ;NO PUSHJ P,FILSKP ;YES, FLUSH TO END OF THIS FILE MOVE B,USNM ;I.E. END OF LAST DIRECTORY DUMPED ON TAPE JRST KSUSER SETFNG: PUSH P,LPTSW SETZM LPTSW PRINT WHAT WAS THE LAST DIRECTORY DUMPED ? POP P,LPTSW PUSHJ P,GETSYL JRST SETFNG MOVE B,SYM ;HAVING FOUND WHAT DIRECTORY TO CONTINUE DUMPING WITH, ADVANCE ;MFD TO THERE, THEN JOIN REGULAR DUMP CODE KSUSER: PUSHJ P,MFDN DIE NO SUCH DIRECTORY CAME B,USNM JRST KSUSER JRST ADMP1 ;GOT IT, START THE DUMP SUBTTL DUMPING FROM USER-GIVEN FILE LIST ;RUNS THROUGH ALL FILES IN WORLD, IF THEY MATCH DUMP 'EM ADUMP2: SETZM STYPE SETOM MFDIN NXUFD: PUSHJ P,MFDN ;GET SNAM INTO USNM JRST DUNG ;NO MORE SNAMES LEFT MOVN W,LENGTH HRLZS W ;MAKE AOBJN POINTER TO FILE SPEC LIST SNMCHK: SKIPN A,FMSNM(W) JRST UGLY ;ANY SNAME MATCHES, INVESTIGATE CAMN A,USNM JRST UGLY ;SOME SNAME MATCHES, INVESTIGATE AOBJN W,SNMCHK ;CONTINUE CHECKING JRST NXUFD ;NO MATCH POSSIBLE ;SNAME MATCHES, RUN THROUGH ALL FILES ON THIS DIRECTORY UGLY: MOVEI V,0 SETOM GREATF ;FOR > AND < FILE HACKERY .SUSET [.SSNAM,,USNM] SETOM FLNI NXFIL: PUSHJ P,FNG JRST EODIRK ;NO MORE FILES IN THIS DIRECTORY MOVN W,LENGTH HRLZS W ;AOBJN POINTER TO FILE SPECS LIST MOVS A,FMDEV(W) HRLI A,.BII MOVEM A,TRNI CMCON: SKIPN D,FMSNM(W) JRST CMFN1 CAME D,USNM JRST NXCOM CMFN1: SKIPN D,FMFN1(W) JRST CMFN2 CAME D,[SIXBIT //] CAIA JRST RCMFN1 SKIPN LNKFLG MOVEM D,FN1 SETZM GREATF JRST CMFN2 ;SNAME AND FN1 SEEM TO MATCH, THINK ABOUT FN2 RCMFN1: CAME D,FN1 JRST NXCOM CMFN2: SKIPE D,FMFN2(W) CAMN D,FN2 JRST DUMPIT CAME D,[SIXBIT //] CAIA JRST NXCOM SKIPN LNKFLG ;'>' AND '<' FILES DON'T GET OPENED FOR LINKS MOVEM D,FN2 SETZM GREATF ;WE FOUND A < OR > JRST DUMPIT NXCOM: AOBJN W,CMCON JRST NXFIL ;END OF DIRECTORY EODIRK: PUSHJ P,FILAPP SKIPGE APPENF ;ANY FILES DUMPED FOR THIS USER ??? JRST NXUFD EODIR3: MOVN W,LENGTH ;YES, MAYBE REMOVE SOME SPECS HRLZS W EODIR2: CAMN A,USNM ;IS THIS ENTRY ONE FOR USER JUST DUMPED ? JRST REMOVE ;YES EODIR1: AOBJN W,EODIR2 ;NO JRST NXUFD REMOVE: SKIPN FMDUMP(W) JRST EODIR1 ;DON'T REMOVE SPEC IF NOTHING EVER MATCHED IT PUSHJ P,FLUSH ;DELETE SPEC POPJ P, ;NO MORE SPECS LEFT ADD W,[1,,] JRST EODIR2 ;OK, DUMP THE FILE DUMPIT: SKIPE LNKFLG JRST AWRITE .SUSET [.SSNAM,,USNM] ;IF NOT LINK, SEE IF ALREADY DUMPED OPEN DSKIN,TRNI JRST NXCOM ;JUST CONTINUE MOVE A,[DSKIN,,TRNI] PUSH P,TRNI .RCHST A, POP P,TRNI MOVEI A,0 MOVE B,FN1 MOVE C,FN2 LOOP69: CAML A,V JRST APPEND CAME B,BIF(A) JRST LUP691 CAMN C,BIF+1(A) JRST EODIR3 LUP691: ADDI A,2 JRST LOOP69 APPEND: MOVEM B,BIF(A) MOVEM C,BIF+1(A) ADDI V,2 JRST AWRITE ;ACTUALLY WRITE OUT THE FILE. AWRITE: PUSHJ P,ADMP3 SETOM FMDUMP(W) ;MARK THIS ARG AS HAVING BEEN SATISFIED AT LEAST ONCE SKIPN FMSNM(W) JRST NXCOM ;DON'T DELETE ENTRY IF ANY "*" IN IT SKIPE FMFN1(W) SKIPN FMFN2(W) JRST NXCOM PUSHJ P,FLUSH POPJ P, ADD W,[1,,] SOJA W,NXCOM ;DONE DUMPING, SEE IF ANY SPECS WEREN'T SATISFIED. DUNG: MOVN W,LENGTH HRLZS W REMOV2: SKIPN FMSNM(W) JRST REMOV1 ;"*;" SKIPE FMFN1(W) ;"* *" SKIPN FMFN2(W) JRST REMOV1 REMOV3: AOBJN W,REMOV2 PRINT _NOT DUMPED:_ MOVN W,LENGTH HRLZS W NOREM1: IRP X,,[SNM,FN1,FN2] SKIPN A,FM!X(W) MOVSI A,(SIXBIT /*/) PSIS A IFSE X,SNM,[PASC [ASCIZ /;/]] TERMIN PUSHJ P,CRR AOBJN W,NOREM1 POPJ P, REMOV1: SKIPL FMDUMP(W) ;WAS ANYTHING DUMPED FOR THIS SPEC ?? JRST REMOV3 ;NO PUSHJ P,FLUSH POPJ P, ADD W,[1,,] JRST REMOV2 SUBTTL DUMPING ALL FILES (FULL OR INCREMENTAL) ADMP1: PUSHJ P,TAPEMB ;GET TAPE NUMBER IF DON'T HAVE YET PUSHJ P,MFDN ;READ A LOSER NAME FROM M.F.D. JRST RAT ;DONE SKIPE LSTWHL ;LIST ? PUSHJ P,LDMUT1 ADMPL1: MOVE A,USNM SKIPGE ITAPE MOVEM A,FUSNM ;FIRST LOSER DUMPED .SUSET [.SSNAM,,A] ;SO FNG READS THE CORRECT DIRECTORY ;COME HERE OUT OF END-OF-REEL INTERRUPT DMPAGN: SETOM FLNI ;RESTART ON NEW REEL SKIPL FULLDMP POPJ P, ;THIS PROBABLY RETURNS FROM ADMP3 ;IN THE CASE OF A GFR OR FILE BY FILE ;DUMP THAT USES UP THE REEL. CLEARLY ;THE WRONG THING TO DO, BUT CLOSE. SETOM DMPUFD SETOM DMPDIR .SUSET [.SSNAM,,USNM] PUSHJ P,ADMP4 ;DUMP THE DIR AND RETURN ;THIS IS WHERE COMPLETE AND INCREMENTAL DUMPS LOOP ADMP2: PUSHJ P,TAPEMB ;GET TAPE NUMBER IF NEEDED .SUSET [.SSNAM,,USNM] PUSHJ P,FNG ;READ ANOTHER FILE NAME JRST FULNMF ;NO MORE MOVE A,PACKN SKIPL DPACK ;RIGHT PACK ? CAMN A,DPACK PUSHJ P,ADMP3 ;YES, OR ANY WILL DO, CALL DUMPER JRST ADMP2 ;NOT RIGHT PACK FULNMF: PUSHJ P,FILAPP ;END OF THIS DIRECTORY, FINISH JRST ADMP1 ;AND GO BACK FOR MORE ;PRINT LISTING LINE WHEN STARTING A NEW UFD LDMUT1: PUSHJ P,CRR PUSHJ P,TAPN ;PRINT SEQUENCE NUMBER PSIS USNM ;PRINT DIRECTORY NAME PUSH P,LPTSW SETZM LPTSW PUSHJ P,CRR PSIS USNM ;PRINT JUST DIRECTORY NAME ON CONSOLE POP P,LPTSW POPJ P, ;INCREMENT FILE SEQUENCE NUMBER AND PRINT IT TAPN: MOVE D,ITAPE AOS D PDPT D POPJ P, ;DUMP A FILE (FROM EITHER TYPE OF DUMP) ;THIS IS A SUBROUTINE. CALL WITH SNAME SET UP AND NAME IN FN1, FN2 ADMP3: SKIPE LNKFLG JRST ADMP4 OPEN DSKIN,TRNI ;OPEN DISK INPUT POPJ P, ;FILE DOESN'T SEEM TO EXIST AFTER ALL .CALL [ SETZ ? 'FILLEN ? MOVEI DSKIN ? SETZM A] ;A GETS NUMBER OF WORDS IN FILE .LOSE %LSFIL CAMGE A,[2500.*2000] ; :BUG MUDDLE BEFORE DECREASING THIS CONSTANT! JRST ADMP4 ;FILE NOT TOO BIG PUSH P,LPTSW SETZM LPTSW PRINT _ .SUSET [.RSNAME,,A] PSIS A PRINT [;] PSIS FN1 PSIS FN2 PRINT [ - FILE IS TOO DAMNED BIG, ] ;SKIPN GFRFLG ;IF DOING GFR, DUMP ANYWAY, USER CAN QUIT OUT AND DELETE SKIPGE FULLDMP ; THE FILE IF THAT BECOMES NECESSARY. JRST [ ;IF DOING INCREMENTAL OR FULL, DON'T DUMP IT PRINT [NOT DUMPED._] POP P,LPTSW POPJ P, ] PRINT [IT MAY NOT FIT ON TAPE, WILL TRY ANYWAY._] POP P,LPTSW ADMP4: MOVEM P,ERRPDP ;SAVE STUFF IN CASE OF REMOTE TAPE ERROR MOVEM 16,INTAC+16 MOVEM 17,INTAC+17 MOVEI 16,INTAC BLT 16,INTAC+15 MOVE 16,INTAC+16 PUSHJ P,TAPEMB AOSE APPENF ;SKIP IF FIRST FILE THIS DIRECTORY JRST ADMP5 PUSHJ P,SNPLAC SETZM USRUFD ADMP5: IFE MCOND DM,[ SKIPGE ITAPE PUSHJ P,EXTPCK ; TAPE ALREADY EXIST? ] .SUSET [.SSNAM,,USNM] ;SO .OPEN DSKIN, LOOKS ON THE CORRECT DIRECTORY SKIPE MAGOPN ; OPEN YET? JRST ADMP7 ; YES SETOM MAGOPN SKIPL TAPTYP JRST ADMP6 ;Local tape PUSHJ P,RMTSTS ;Make sure it's mounted (this also TRNE A,TF%RDY ; drains queued status) JRST ADMP7 DIE OUTPUT TAPE NOT MOUNTED ADMP6: OPEN MAGOUT,MAGO ;OPEN MAG TAPE OUTPUT JRST RET ADMP7: SETOM EOTFLG AOSE ITAPE ;BEGINNING OF TAPE ? JRST LP2A ;NO PUSH P,LPTSW SETZM LPTSW PUSHJ P,GINFO SKIPG SDONE JRST LP2B PRINT THAT'S AN ARCHIV TAPE. PUSHJ P,CHECK ;ALREADY DELETED THE TAPE FILE FOR IT??? LP2B: MOVSI A,-1 ;TEST TAPE # BUT NOT REEL # SKIPE SDONE TDNN A,STAPEN ;CHECK FOR REUSE OF RECENT TAPE JRST LP2BB ;THAT WASN'T ABORTED, AND NOT TAPE0 MOVE A,STDATE PUSHJ P,SBDTTN ;CONVERT TAPE DATE TO NUMBER OF DAYS MOVE B,A .RDATE A, ;CURRENT DATE PUSHJ P,SBDTTN ADDI B,30. CAMLE A,B JRST LP2BB PRINT THAT TAPE IS LESS THAN 30 DAYS OLD PUSHJ P,CHECK LP2BB: POP P,LPTSW SETZM NSVTPN+1 ;BOT, START A NEW .TAPEn; TAPE nnn FILE .SUSET [.SSNAM,,NPLACE] .FDELE NSVOP ;SO WE DON'T APPEND TO ANY OLD ONE JFCL .SUSET [.SSNAM,,USNM] SETZM SDONE AOSE A,NTAPES ;IS THIS THE FIRST RUN FOR THIS LOADING? SOS A,NTAPES ;NO. WE WEREN'T SUPPOSED TO TOUCH NTAPES HRRM A,THTPN ;REEL NUMBER IN CURRENT DUMP PUSHJ P,SINFO .RDATE A, MOVEM A,THDATE ;.SUSET [.RSNAM,,E] ;doesn't seem to get used. JRST LP2C EXTPCK: .SUSET [.SSNAM,,NPLACE] HLRZ A,NSVOP HRRZS NSVOP .SEE .UAI .OPEN DSKOUT,NSVOP JRST EXTPK1 HRLM A,NSVOP PUSH P,LPTSW SETZM LPTSW PRINT YOU ARE NOT AT THE END OF TAPE. PUSHJ P,CRR PRINT YOU WILL DESTROY USEFUL DATA! POP P,LPTSW JRST CHECK EXTPK1: HRLM A,NSVOP POPJ P, ;COMPLETE OR INCREMENTAL DUMP IS, UH, COMPLETE. ;NOTE SIMILARITY OF THIS CODE TO 'FOOB' RAT: PUSH P,LPTSW ;REPORT THE CRUD TO TTY SETZM LPTSW PUSHJ P,GESELL ;SAY WHAT USERS ON THIS REEL PUSHJ P,CLSOUT ;CLOSE MAGOUT, WRITE LOGICAL EOT ON TAPE SKIPE INCREM SKIPE CKIDMP JRST RAT2 SKIPE EXPERM JRST RAT2 ;MUST CHECK, AND SET DUMPCHECK BITS SETOM LUSNM ;SO WE WILL GET LAST USER PRINT _REWINDING IFE MCOND DM,[ MOVN N,NFTDMP ;[SOMEONE SHOULD DOCUMENT THIS] MOVE B,NFTDMP SOS B CAMN B,ITAPE ;IF EQUAL, THEN IT IS THE WHOLE TAPE JRST RAT1 PUSHJ P,ASPAC1 SKIPA ] RAT1: PUSHJ P,ARWND PRINT _CHECKING INCREMENTAL DUMP PUSHJ P,ICHECK PUSHJ P,ARWND RAT2: POP P,LPTSW SKIPN REAPSW ;DO REAP IF ASKED JRST RET JRST INCGFR ;CONVERT SIXBIT DATE IN A TO NUMBER OF DAYS IN A SBDTTN: CAMN A,[-1] POPJ P, PUSH P,B PUSH P,C PUSH P,D PUSH P,E MOVE B,[440600,,A] PUSHJ P,SBDTN1 ;YEARS IMULI C,12.*31. ;EL CHEAPO! MOVE D,C PUSHJ P,SBDTN1 ;MONTHS IMULI C,31. ADD D,C PUSHJ P,SBDTN1 ;DAYS ADD D,C MOVE A,D POP P,E POP P,D POP P,C POP P,B POPJ P, ;GET TWO SIXBIT CHARS AND CONVERT TO NUMBER IN C SBDTN1: ILDB E,B SUBI E,"0 ILDB C,B SUBI C,"0 IMULI E,10. ADD C,E POPJ P, ;HERE'S THE ROUTINE THAT ACTUALLY, FINALLY, WRITES ON THE TAPE. ;HERE IF NEED A TAPE HEADER FIRST (WE'RE AT FRONT OF TAPE) LP2C: MOVE A,[THBLK,,LISTBF] ;LISTBF IS BUFFER FOR OUTPUT TO ADD A,USRUFD ;THE .TAPEn; TAPE nnn FILE BLT A,LISTBF+LTHBLK-1(USRUFD) MOVE A,[-3,,0] ADDI USRUFD,LTHBLK MOVEM A,LISTBF(USRUFD) AOS USRUFD MOVE A,[-LTHBLK,,THBLK] ;OUTPUT TAPE-HEADER PUSHJ P,MAGWRI ;HERE IF NOT AT FRONT OF TAPE LP2A: AOSN DMPDIR JRST DIRDMP ;DON'T DUMP A FILE, DUMP A DIR INSTEAD. PUSHJ P,DFHBLK ; Set defaults in file header MOVE A,USNM ;SET UP FILE HEADER MOVEM A,HSNM MOVE A,FN1 MOVEM A,HFN1 MOVE A,FN2 MOVEM A,HFN2 MOVE A,PACKN MOVEM A,HPKN MOVE A,[SETZ] MOVEM A,HDATE ;CREATION DATE OF LINK IS 400000,,0 MOVEI A,3 MOVEM A,HLEN ; Length of link is always 3 SKIPE LNKFLG JRST LP3A .CALL RHDATS PUSHJ P,DFHDTS ; So the dates are unknown SKIPE A,RFDATE ; Except if we are about to set the date HLLM A,HRDATE ; below, then use that. .CALL RHLEN SETOM HLEN ; So the length is unknown LP3A: MOVE A,[-LHBLK,,HBLK] ;OUTPUT FILE HEADER PUSHJ P,MAGWRI MOVE A,HBLK+2 MOVEM A,LISTBF(USRUFD) MOVE A,HBLK+3 MOVEM A,LISTBF+1(USRUFD) MOVE A,HBLK+5 MOVEM A,LISTBF+2(USRUFD) ADDI USRUFD,3 SKIPE LSTWHL PUSHJ P,LOUSY ;GENERATE LISTING LINE JFCL SKIPE LNKFLG JRST LP4A SKIPN RFDATE JRST LP .CALL SRFDAT JFCL LP: MOVE A,[-2000,,BUF] ;OUTPUT THE FILE .IOT DSKIN,A HRLOI B,-BUF-1(A) EQVI B,BUF ;AOBJN POINTER TO STUFF ACTUALLY READ SKIPGE A .CLOSE DSKIN, JUMPGE B,LP1 EXCH A,B PUSHJ P,MAGWRI JUMPGE B,LP ;MORE TO DO ? LP1: SKIPN CKIDMP JRST LP1A SKIPN MICFLG ;DON'T BOTHER CHECKING, SET DUMPCHECK SKIPE EXPERM ;BITS NOW. JRST LP1A OPEN DSKIN,TRNI ;RE-OPEN SINCE CLOSED BY EOF JRST LP1A .CALL SRFDAT JFCL MOVE A,[400000,,DSKIN] .DMPCH A, ;SET DUMP CHARACTER SO WONT BE .CLOSE DSKIN, ; INCREMENTALLY DUMPED AGAIN. LP1A: PUSHJ P,AEOF ;WRITE EOF MARK ON TAPE MOVE A,USNM MOVEM A,LUSNM ;LAST LOSER DUMPED AOS NFTDMP POPJ P, ;RETURN FROM ADMP3 LP4A: MOVE A,[-3,,LNKNM1] ;DUMP A LINK AS A 3 WORD FILE PUSHJ P,MAGWRI ; LKNM1,LKNM2,SNAM JRST LP1A ;HERE IF DUMPING A DIRECTORY RATHER THAN A FILE DIRDMP: .IOPUSH DSKIN, ;PROTECT FILE ALREADY OPEN MAYBE AOSN DMPMFD PUSHJ P,MFDDMP AOSN DMPUFD PUSHJ P,UFDDMP .IOPOP DSKIN, SKIPL FULLDMP JRST LP2A ;NOT A FULL DUMP, GO BACK POPJ P, ;RETURN TO ADMP2 MFDDMP: HRRI A,.BII HRLM A,MFO .OPEN DSKIN,MFO POPJ P, MOVE A,[-2000,,MFDBUF] .IOT DSKIN,A PUSHJ P,DFHBLK ; Set defaults in HBLK MOVE A,USNM MOVEM A,HSNM MOVE A,MFO+1 MOVEM A,HFN1 MOVE A,MFO+2 MOVEM A,HFN2 .CALL RQDATE JFCL MOVEI A,2000 ; MFD is always 2000 words long MOVEM A,HLEN MOVE A,[-LHBLK,,HBLK] ;OUTPUT FILE HEADER PUSHJ P,MAGWRI MOVE A,HBLK+2 MOVEM A,LISTBF(USRUFD) MOVE A,HBLK+3 MOVEM A,LISTBF+1(USRUFD) MOVE A,HBLK+5 MOVEM A,LISTBF+2(USRUFD) ADDI USRUFD,3 SKIPE LSTWHL PUSHJ P,LOUSY JFCL AOS ITAPE MOVE A,[-2000,,MFDBUF] PUSHJ P,MAGWRI PUSHJ P,AEOF AOS NFTDMP POPJ P, UFDDMP: HRRI A,.BII HRLM A,FNO .OPEN DSKIN,FNO POPJ P, MOVE A,[-2000,,UFDBUF] .IOT DSKIN,A PUSHJ P,DFHBLK ; Set defaults in HBLK MOVE A,USNM MOVEM A,HSNM MOVE A,FNO+1 MOVEM A,HFN1 MOVE A,FNO+2 MOVEM A,HFN2 .CALL RQDATE JFCL MOVE A,UDESCP+UFDBUF ; Calculate how many words we're actually ADDI A,5 ; going to dump out below. IDIVI A,6 ADDI A,UDDESC+2000 SUB A,UDNAMP+UFDBUF MOVEM A,HLEN MOVE A,[-LHBLK,,HBLK] ;OUTPUT FILE HEADER PUSHJ P,MAGWRI MOVE A,HBLK+2 MOVEM A,LISTBF(USRUFD) MOVE A,HBLK+3 MOVEM A,LISTBF+1(USRUFD) MOVE A,HBLK+5 MOVEM A,LISTBF+2(USRUFD) ADDI USRUFD,3 SKIPE LSTWHL PUSHJ P,LOUSY JFCL MOVE A,UDESCP+UFDBUF ;PACK DIRECTORY BY NOT DUMPING FREE AREA ADDI A,5 IDIVI A,6 ;ROUND UP TO NEXT HIGHER WORD ADDI A,UDDESC ;DUMP HEADER AREA TOO MOVNS A HRLS A HRRI A,UFDBUF ;DUMP OUT DESC AREA PUSHJ P,MAGWRI MOVE A,UDNAMP+UFDBUF SUBI A,2000 HRLS A HRR A,UDNAMP+UFDBUF ADDI A,UFDBUF ;DUMP OUT NAME AREA PUSHJ P,MAGWRI PUSHJ P,AEOF AOS NFTDMP POPJ P, ;CALL HERE AFTER DUMPING ALL THE FILES IN A SINGLE DIRECTORY ;UPDATE .TAPEn; TAPE nnn FILE (TAPE DIRECTORY) FILAPP: SKIPGE APPENF POPJ P, ;NOTHING WAS DUMPED FOR THIS USER MOVEI A,.BII HRLM A,NSVOP .SUSET [.SSNAM,,NPLACE] .OPEN SAVET,NSVOP JRST KARILY ;FIRST TIME THROUGH PUSHJ P,ACCESS MOVEI A,100007 ;WRITE-OVER MODE HRLM A,NSVOP FILAP0: OPEN SAVET,NSVOP JRST [ PUSH P,LPTSW SETZM LPTSW PRINT [TYPE ANY CHARACTER TO TRY AGAIN] ;MAYBE SOMEONE HAS IT OPEN PUSHJ P,TYI PUSHJ P,CRR POP P,LPTSW JRST FILAP0 ] ;KEEP TRYING UNTIL IT WORKS, DON'T PUNT THE WHOLE DUMP .ACCESS SAVET,B ;WE'RE ABOUT TO APPEND "USER" UFD" ONTO "TAPE XXX" FILAP1: MOVE A,[-1,,[0]] .IOT SAVET,A ;CREATE SNAME ENTRY HRROI A,USNM .IOT SAVET,A FLY: MOVNS USRUFD HRLS USRUFD HRRI USRUFD,LISTBF .IOT SAVET,USRUFD .CLOSE SAVET, POPJ P, ;GOTTA CREATE THE TAPE DIRECTORY KARILY: MOVEI A,.BIO HRLM A,NSVOP OPEN SAVET,NSVOP JRST RET MOVE A,[-LTHBLK-1,,LISTBF] ;PUT HEADER .IOT SAVET,A MOVE A,[-1,,[0]] ;THEN PUT CHANGE-SNAME TO THIS DIR .IOT SAVET,A HRROI A,USNM .IOT SAVET,A SUBI USRUFD,LTHBLK+1 ;THEN DUMP OUT THIS DIR'S INFO MOVNS USRUFD HRLS USRUFD HRRI USRUFD,LISTBF+LTHBLK+1 .IOT SAVET,USRUFD .CLOSE SAVET, POPJ P, ACCESS: MOVEI B,0 ;ACCUMULATED ACCESS POINTER MORCRF: MOVE A,[-2000,,BUF] ;THIS ROUTINE ACCESSES TO THE END OF THE FILE .IOT SAVET,A ;THIS READING ONLY TO GET POINTER HLRE C,A ADDI B,2000(C) ;INCREMENT ACCESS POINTER JUMPGE A,MORCRF ;CONTINUE READING POPJ P, ;DETERMINE INTELLIGENTLY WHETHER OR NOT TO ASK FOR ;TAPE AND REEL NUMBER ;AND ASK WHAT IS NECESSARY TAPEMB: SKIPL THTPN JRST ADMPK1 ;WE ALREADY KNOW WHAT TAPE THIS IS ADMPK: PUSHJ P,TAPGET MOVEM SYM,NSVTPN SKIPGE CDMFL ;DON'T ASK REEL # FOR NOT CDUMP SKIPL NTAPES ;DON'T ASK REEL # IF YOU KNOW IT JRST ADMPK1 ;WE ALREADY KNOW WHAT REEL THIS IS PUSH P,LPTSW SETZM LPTSW PRINT REEL = POP P,LPTSW PUSHJ P,GETSYL JRST .-1 HRRM N,THTPN MOVEM N,NTAPES ADMPK1: POPJ P, SUBTTL DUMP A FILE TO THE FILECOMPUTER ;THIS IS A SUBROUTINE. PLEASE CALL WITH SNAME SET UP AND NAME IN FN1, FN2 FCDMP: SKIPE LNKFLG ;IF INPUT FILE IS A LINK POPJ P, ;DONT BOTHER WITH IT HERE. .CALL [ SETZ ? SIXBIT/OPEN/ ? [.UIO,,DSKIN] GFRDEV ? FN1 ? FN2 ? 400000,,SNAME] ;TRY TO OPEN INPUT FILE. POPJ P, ;OH,WELL. FCDMP0: .CALL [ SETZ ? SIXBIT/OPEN/ ;PROBE FOR DIRECTORY ON FC: [.UAI,,DSKOUT] [SIXBIT /FC/] [SIXBIT /.FILE./] ? [SIXBIT /(DIR)/] 400000,,SNAME] JRST [ .CLOSE DSKOUT PUSHJ P,CFCDIR ;IF MISSING, TRY TO CREATE IT. PUSHJ P,FCDDLS ; UMMM, GEE. IT DIDNT WORK? JRST FCDMP1] ; YOW! NOW WE CAN HAVE FUN! .CLOSE DSKOUT FCDMP1: .CALL [ SETZ ? SIXBIT/OPEN/ ;OPEN OUTPUT FILE. [.UIO,,DSKOUT] [SIXBIT /FC/] ? FN1 ? FN2 ? 400000,,SNAME] JRST FCDLOS PUSHJ P,FCDMP4 ;GET PAGES FOR THE BUFFER. FCDMPI: MOVE U,[444400,,BUFFER] ;SETUP FOR FULL WORD TRANSFERS. MOVEI W,BUFSIZ*PAGSIZ .CALL [ SETZ ? SIXBIT/SIOT/ ? %CLIMM,,DSKIN ? U ? 400000,,W] .LOSE %LSFIL MOVEI V,BUFSIZ*PAGSIZ SUB V,W ;HOW MUCH MORE TO GO? JUMPE V,FCDMPZ MOVE U,[444400,,BUFFER] MOVEI W,BUFSIZ*PAGSIZ .CALL [ SETZ ? SIXBIT/SIOT/ ? %CLIMM,,DSKIN ? U ? 400000,,V] .LOSE %LSFIL JRST FCDMPI FCDMPZ: .CLOSE DSKOUT, ;CLEAN UP WHEN DONE. FCDMP3: .CLOSE DSKIN, POPJ P, FCDMP4: SKIPE FCDMAP ;IF WE ALREADY GOT SOME BUFFER PAGES POPJ P, ;DONT GET 'EM TWICE! MOVE X,[-BUFSIZ,,/PAGSIZ] .CALL [ SETZ ? SIXBIT/CORBLK/ %CLIMM,,%CBNDR\%CBNDW %CLIMM,,%JSELF X 400000+%CLIMM,,%JSNEW] .LOSE %LSSYS SETOM FCDMAP POPJ P, FCDDLS: PUSH P,LPTSW ;WARN OF LOSSAGE VIA THE TTY. SETZM LPTSW PRINT [FILECOMPUTER DIRECTORY CREATION FAILED - MAYBE FC IS DOWN?] POP P,LPTSW POPJ P, ;AND PUNT OUT. FCDLOS: PUSH P,LPTSW ;WARN OF LOSSAGE VIA THE TTY. SETZM LPTSW PRTFNS PRINT [NOT COPIED TO FILECOMPUTER.] POP P,LPTSW POPJ P, ;AND PUNT OUT. SUBTTL CREATE A USER DIRECTORY ON THE FC: FILECOMPUTER DEVICE ;THIS IS A SUBROUTINE. PLEASE CALL WITH SNAME SET UP. ;SKIPS IF SUCCESSFUL. CFCDIR: .CALL [ SETZ ? SIXBIT/OPEN/ [.UIO,,DSKOUT] [SIXBIT/FC/] [SIXBIT /..NEW./] [SIXBIT /(UDIR)/] SNAME 400000+%CLERR,,X ] JFCL CAIN X,%ENSFL ;IF WE GOT AN FNF ERROR AOS (P) ;WE WON. POPJ P, ;OTHERWISE WE LOSE SOMEHOW SUBTTL GRIM FILE REAPER ;FIRST, PROCESS OPTIONS LIKE 'LOOP' AGFR: SETOM THTPN MOVSI A,-NGFRSW SKIPGE GFRTB2(A) CLEARM @GFRTB2(A) ;IF INSTRUCTION IS SETOM, CLEAR IT AOBJN A,.-2 SETZM GFRPNM ;START WITH NO PACKS TO REAP OFF OF SETZM GFRDEV ;DEFAULT IS TO WRITE TO TAPE CAIN TER,15 JRST RET ;NO OPTIONS? DO NOTHING. GFRLP1: PUSHJ P,TYI CAIN A,"? JRST GFRPHL ;GIVE INFO ON OPTIONS AVAILABLE PUSHJ P,GETSL1 POPJ P, ;OVER-RUBOUT? DO NOTHING. PUSHJ P,GFRSPT CAIN TER,15 JRST GFREXC JRST GFRLP1 GFRSPT: JUMPE SYM,CPOPJ MOVSI A,-NGFRSW CAMN SYM,GFRTB1(A) JRST GFRSPD AOBJN A,.-2 SUB P,[1,,1] ;BAD OPTION, IGNORE PRINT ? PSIS SYM PUSHJ P,TYOS PRINT IGNORED PUSHJ P,TYOS JRST GFRLP1 GFRSPD: CAMN SYM,[SIXBIT /FC/] JRST FCNONE GFRSPX: XCT GFRTB2(A) ;DO OPTION AS SPECIFIED POPJ P, GFRPHL: PASC GFRHLP ;GIVE OPTIONS AND DESCRIPTION JRST GFRLP1 ; COME HERE TO SEE IF THIS MACHINE HAS A FILECOMPUTER. ; THIS IS SORT OF BOGUS, BUT I DIDNT WANT TO CONDITIONALIZE THE SOURCE. FCNONE: .CALL [ SETZ ? 'SSTATU ? REPEAT 5,[MOVEM A ? ] SETZM A ] .LOSE %LSSYS CAMN A,[SIXBIT \AIKA\] ;IF WE ARE ON THE AI-KA MACHINE JRST GFRSPX ;WE CAN DO FILECOMPUTER THINGS. PUSH P,LPTSW ;ELSE COMPLAIN. SETZM LPTSW PRINT [THIS MACHINE DOESN'T HAVE A FILECOMPUTER - IGNORING FC OPTION.] POP P,LPTSW POPJ P, ;IF YOU UPDATE THIS TABLE, ALSO UPDATE GFRTB2 AND GFRHLP (ALSO ON THIS PAGE) GFRTB1: SIXBIT /H/ ;HISTOGRAM SIXBIT /L/ ;LIST SIXBIT /DUMP/ ;DUMP SIXBIT /DELETE/ ;DELETE SIXBIT /DATE/ ;ENTER DATE SIXBIT /BLOCKS/ ;GET X BLOCKS SIXBIT /EVERY/ ;ALLOW NO SPECIAL DIRECTORIES SIXBIT /CREATE/ ;USE CREATION DATE INSTEAD OF REF DATE SIXBIT /QUOTA/ ;ENFORCE QUOTA SIXBIT /ALLOC/ ;REAP ALLOCATED DIRS TOO SIXBIT /FROM/ ;FROM DEVICE SIXBIT /TO/ ;TO DEVICE SIXBIT /ONLY/ ;ONLY FROM SPECIFIED DEVICE SIXBIT /DISK/ ;DUMP TO SECONDARY DISK INSTEAD OF TAPE SIXBIT /SECOND/ ;REAP SECONDARY DISK ALSO SIXBIT /FC/ ;REAP TO BOTH FC DEVICE AND TO TAPE NGFRSW==.-GFRTB1 GFRHLP: ASCIZ\ H MAKE HISTOGRAM OF BLOCKS FREED VERSUS DATE L LIST HISTOGRAM AND/OR FILES REAPED DUMP DUMP REAPED FILES ONTO TAPE DELETE DELETE REAPED FILES (AFTER DUMPING) TO dev DUMP TO DISK DEVICE dev (E.G. SECOND) INSTEAD OF TAPE DATE ENTER DATE OF OLDEST FILE TO RETAIN BLOCKS ENTER NUMBER OF BLOCKS TO BE OBTAINED CREATE USE CREATION DATE INSTEAD OF REFERENCE DATE QUOTA ENFORCE DIRECTORY QUOTAS ALLOC REAP ALLOCATED DIRS TOO EVERY ALLOW NO SPECIAL DIRECTORIES (DON'T USE THIS, PLEASE!) FROM dev REAP OFF OF DEVICE dev (E.G. SECOND) AS WELL AS MAIN DISK. ONLY REAP ONLY FROM SPECIFIED DEVICE, NOT MAIN DISK. DISK DUMP TO SECONDARY DISK INSTEAD OF TAPE (THIS IS AN OBSOLETE FORM FOR "TO SECOND") SECOND REAP SECONDARY DISK ALSO (THIS IS AN OBSOLETE FORM FOR "FROM SECOND") FC REAP FILES ONTO BOTH TAPE AND THE FILECOMPUTER. _GFR \ GFRTB2: SETOM GFRHSW SETOM GFRLST SETOM GFRDMS SETOM GFRDES SETOM GFRDAS SETOM GFRBLS SETOM GFREVR SETOM GFRCRE SETOM GFRQUO SETOM GFRALO PUSHJ P,GFPFRM PUSHJ P,GFPTO SETOM GFRONL PUSHJ P,GFPDSK PUSHJ P,GFPSEC SETOM FCREAP IFN .-GFRTB2-NGFRSW, .ERR GFRTB2 DISAGREES WITH GFRTB1 GFRHSW: 0 ;HISTOGRAM SWITCH GFRDMS: 0 ;DUMP SWITCH GFRDES: 0 ;DELETE SWITCH GFRDAS: 0 ;DATE SWITCH GFRBLS: 0 ;BLOCKS SWITCH GFRLST: 0 ;LIST SWITCH GFRNBK: 0 ;NUMBER OF BLOCKS DESIRED GFRNBG: 0 ;NUMBER OF BLOCKS GOTTEN GFREVR: 0 ;NO SPECIAL DIR SWITCH (BE CAREFUL WITH THIS!!!!) GFRCRE: 0 ;CREATION DATE SWITCH GFRQUO: 0 ;HACK QUOTA GFRALO: 0 ;REAP ALLOCATED DIRS TOO GFRDEV: 0 ;DEVICE WRITING TO (0 MEANS TAPE) GFRPNM: 0 ;PACK NUMBER MASK (1 MEANS OK TO REAP FROM) GFRONL: 0 ;ONLY FROM SPECIFIED DEVICE, NOT PRIMARY PACKS GFRJST: 0 ;DISCRIMINATE AGAINST CERTAIN DIRECTORIES FCREAP: 0 ;FC DEVICE SWITCH GFPDSK: MOVE SYM,['SECOND] PUSHJ P,GFPDV1 GFPTO: PUSHJ P,GFPDEV MOVEM SYM,GFRDEV POPJ P, GFPSEC: MOVE SYM,['SECOND] PUSHJ P,GFPDV1 GFPFRM: PUSHJ P,GFPDEV IORM B,GFRPNM POPJ P, ;RETURN WITH SIXBIT DEVICE IN SYM AND BIT MASK OF PACK NUMBERS IN B GFPDEV: PRINT [DEVICE=] PUSHJ P,GETSYL JRST RET CAIA GFPDV1: AOS (P) MOVEI B,0 MOVSI A,-NQS GFPDV2: CAME SYM,QRESRV(A) AOBJN A,.-1 JUMPGE A,GFPDV3 MOVEI C,1 LSH C,@QPKID(A) IOR B,C AOBJN A,GFPDV2 GFPDV3: JUMPN B,CPOPJ PASC [ASCIZ/? NO SUCH PACK MOUNTED/] JRST RET ;ENTRY FROM MAIN DUMP TO ALSO DO A REAP INCGFR: SETOM GFRFLG MOVSI A,-NGFRSW SKIPGE GFRTB2(A) ;CLEAR ALL ARGUMENTS EXCEPT GFRQUO AND LIST IF WAS SET CLEARM @GFRTB2(A) ;IF INSTRUCTION IS SETOM, CLEAR IT AOBJN A,.-2 MOVSI A,-NFIGS CLEARM @FIGTB2(A) AOBJN A,.-1 SETOM GFRQUO SETOM GFRDMS ;SET DUMP SWITCH SETOM GFRDES ;SET DELETE SWITCH SETOM MFDIN SKIPE LSTWHL SETOM GFRLST JRST GFREX1 ;GFR'S VERSION OF 'EXECU' - MASSAGE OPTIONS AND INITIALIZE GFREXC: MOVE A,PRIMSK ;ALSO REAP FROM PRIMARY PACKS SKIPN GFRONL IORM A,GFRPNM SKIPN GFRPNM DIE WHAT PACKS DO YOU WANT ME TO REAP FROM SKIPE GFRDAS CLEARM GFRBLS ;CAN'T DO BOTH DATES AND BLOCKS SKIPN GFRDEV ;REAPING TO SECONDARY DISK JRST GFRXC1 SETZM GFRDES SETZM GFRDMS GFRXC1: SKIPE GFRDES PUSHJ P,GFRDCK ;DELETE CHECK SKIPE GFRBLS PUSHJ P,GFRGNB ;GET NUMBER OF BLOCKS SETZM GFRNBG SKIPE GFRDAS PUSHJ P,GETDAT ;GET DATES SKIPE GFRLST PUSHJ P,DEVGET ;GET LISTING DEVICE .SUSET [.SSNAME,,USNM] SKIPE GFRHSW PUSHJ P,GFRPHI ;COMPUTE HISTOGRAM, MAYBE PRINT IT SKIPE GFRBLS PUSHJ P,GFRGBD ;GET DATE ASSOCIATED WITH NEEDED NUMBER OF BLOCKS SKIPN GFRDAS SKIPE GFRBLS JRST GFREX6 SKIPN GFRQUO JRST RET ;NO ACTUAL REAPING TO BE DONE, PROBABLY ; JUST WANTED TO SEE HISTOGRAM ;*DROPS IN GFREX6: SKIPE GFRDMS ;IF DUMPING, PUSHJ P,MBOCF ;GET TO BEGINNING OF CURRENT FILE ON TAPE. SETOM GFRFLG SETOM MFDIN JRST GFREX1 MBOCF: PUSHJ P,SPRF ;BEGINNING OF CURRENT FILE PUSHJ P,SETIT1 ;Get tape status TRNN A,TF%BOT ;Unless BOT, PUSHJ P,SPFF ; Forward one file PUSHJ P,SETIT POPJ P, GETDAT: PRINT ENTER DATE (YY/MM/DD) PUSHJ P,GETDT CAIGE N,100. CAIGE N,1. JRST GETDAT ;BAD YEAR DPB N,[330700,,DATE] PUSHJ P,GETDT CAIGE N,13. CAIGE N,1. JRST GETDAT ;BAD MONTH DPB N,[270400,,DATE] PUSHJ P,GETSYL JRST GETDAT ;OVER RUBOUT ON DAY CAIGE N,32. CAIGE N,1. JRST GETDAT ;BAD DAY DPB N,[220500,,DATE] POPJ P, GETDT: SETZM N ;GET SYLLABLE OF DATE GETDT1: PUSHJ P,TYI CAIN A,40 ;SPACE POPJ P, CAIN A,177 ;CAN'T HACK RUBOUT, START OVER JRST [ SUB P,[1,,1] ? JRST GETDAT ] CAIN A,"/ POPJ P, ;SLASH TERMINATES DATE SYLLABLES SUBI A,"0 IMULI N,10. ADD N,A JRST GETDT1 GFRGBD: SKIPN GFRHSW ;COMPUTE WHAT DATE TO REAP BACK TO PUSHJ P,GFRHIS ; TO GET DESIRED NUMBER OF BLOCKS MOVE B,[-LGFRBLK,,GFRBLK] GFRBD1: HLRZ A,(B) CAML A,GFRNBK JRST GFRBD2 AOBJN B,GFRBD1 PRINT YOU ASKED FOR THE WHOLE DISK JRST RET GFRBD2: HRRZS B PUSHJ P,CRR PUSHJ P,GFROFI MOVEM A,DATE PRINT DATE FOR GFR IS PUSHJ P,GFRPDT PUSHJ P,CRR POPJ P, GFRGNB: PRINT NUMBER OF BLOCKS DESIRED ? PUSHJ P,GETSYL JRST GFRGNB JUMPL N,GFRGNB MOVEM N,GFRNBK POPJ P, ;LOOP OVER ALL FILES GFREX1: PUSHJ P,MFDN ;GET NEXT DIRECTORY JRST GFRFIN ;DONE PUSHJ P,GFRUCK ;SEE IF SPECIAL DIRECTORY THAT JRST GFREX1 ; SHOULDN'T GET REAPED .SUSET [.SSNAM,,USNM] SETOM GFRFQ SETOM FLNI GFREX2: SKIPN GFRBLS ;IF USER SAID BLOCKS, STOP WHEN GOT THAT MANY JRST GFRX2A MOVE A,GFRNBG CAML A,GFRNBK JRST GFRFIN GFRX2A: PUSHJ P,FNG ;GET NEXT FILE IN THIS DIRECTORY JRST GFREX3 ; SORTED BY DECREASING DESIRE TO REAP. SKIPN GFRQUO ;IF ENFORCING QUOTAS, JRST GFREX4 MOVE A,BLOCKS ;SEE IF OVER QUOTA CAMG A,QUOTA JRST GFREX3 AOSE GFRFQ JRST GFREX5 SKIPN GFRLST JRST GFREX5 PUSHJ P,CRR PUSHJ P,CRR PSIS USNM PUSHJ P,TYOS PRINT QUOTA = PUSHJ P,TYOS PDPT QUOTA PUSHJ P,TYOS PRINT BLOCKS = PUSHJ P,TYOS PDPT BLOCKS PUSHJ P,CRR JRST GFREX5 GFREX4: SKIPN A,RFDATE JRST GFREX2 CAMLE A,DATE JRST GFREX2 JRST GFREX5 ;END OF DIRECTORY GFREX3: SKIPE GFRDMS PUSHJ P,FILAPP ;APPEND USERUFD FILE JRST GFREX1 ;'DELETE' OPTION GIVEN, SEE IF SHE REALLY MEANS IT GFRDCK: PRINT YOU SPECIFIED DELETE, PUSHJ P,CHECK SKIPE GFRDMS POPJ P, PRINT YOU DID NOT SPECIFY DUMP, PUSHJ P,CHECK PRINT WHAT TAPE DID YOU DUMP THESE FILES ON? PUSHJ P,TAPGET POPJ P, ;GENERATE LISTING LINE FOR FILE BEING REAPED. GFRLIS: PUSHJ P,CRR PSIS USNM PUSHJ P,TYOS PSIS FN1 PUSHJ P,TYOS PSIS FN2 PUSHJ P,TYOS MOVE A,RFDATE PUSHJ P,GFRPDT PUSHJ P,TYOS PDPT FLENTH POPJ P, GFRFIN: SKIPE GFRDMS ;IF DELETING, PUSHJ P,GESELL ;UPDATE SYSENG;MACRO TAPES. GFRNUT: SETZM LPTSW PUSHJ P,CRR MOVE A,GFRNBG PUSHJ P,DPT PRINT [ BLOCKS REAPED.] JRST RET ;THIS ONE IS GETTING REAPED GFREX5: MOVE A,BLOCKS ;COMPUTE BLOCKS SAVED SUB A,FLENTH MOVEM A,BLOCKS SKIPE GFRLST PUSHJ P,GFRLIS ;LIST SKIPE GFRDMS PUSHJ P,ADMP3 ;DUMP ONTO TAPE SKIPE FCREAP ;MAYBE DUMP ONTO FC DEVICE ALSO PUSHJ P,FCDMP SKIPE GFRDES PUSHJ P,GFRDEL ; THEN DELETE THE FILE. SKIPN GFRDEV JRST GFREX2 HRLZI A,.BII ;DUMP ONTO SECONDARY DISK HLLM A,TRNI OPEN DSKIN,TRNI JRST GFREX2 ;FILE BEEN DELETED .CALL [ SETZ ? SIXBIT/OPEN/ ? [.BIO,,DSKOUT] GFRDEV ? [SIXBIT/_DUMP_/] ? SETZ ['OUTPUT]] JRST [ PUSH P,LPTSW SETZM LPTSW PRINT [CAN'T OUTPUT TO ] PSIS GFRDEV PRINT [: ] .SUSET [.RSNAME,,A] PSIS A PRINT [; _DUMP_ OUTPUT - ] PUSHJ P,OPINFL PUSHJ P,CRR POP P,LPTSW .CLOSE DSKIN, JRST GFREX2 ] .CALL RDATE JFCL .CALL SDATE JFCL .CALL RRDATE JFCL .CALL SRDT JFCL LDB A,[230100,,UNRNDW] .CALL [SETZ ? 'SREAPB ? 1000,,DSKOUT ? SETZ A] JFCL LDB A,[430100,,UNRNDW] .CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZ A] JFCL .CALL [SETZ ? SIXBIT/RAUTH/ ? MOVEI DSKIN ? SETZM A] JFCL .CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ A] JFCL GFRDS1: MOVE A,[-2000,,BUF] ;HAVING GOT NEW FILE READY, COPY OVER .IOT DSKIN,A HRLOI B,-BUF-1(A) EQVI B,BUF SKIPGE B .IOT DSKOUT,B JUMPGE A,GFRDS1 .CLOSE DSKIN, .CALL [ SETZ ? 'RENMWO ? MOVEI DSKOUT ? FN1 ? SETZ FN2 ] JRST [ PUSH P,LPTSW SETZM LPTSW PRINT [CAN'T RENMWO ] PSIS GFRDEV PRINT [: ] .SUSET [.RSNAME,,A] PSIS A PRINT [; ] PSIS FN1 PRINT [ ] PSIS FN2 PRINT [ - ] PUSHJ P,OPINFL PUSHJ P,CRR POP P,LPTSW JRST .+1 ] .CLOSE DSKOUT, MOVE A,FLENTH ADDM A,GFRNBG JRST GFREX2 ;DELETE REAPED FILE BY REPLACING IT WITH A LINK TO BACKUP; TAPE nnn GFRDEL: MOVE A,FN1 MOVEM A,GFRLNK+1 MOVE A,FN2 MOVEM A,GFRLNK+2 MOVSI A,.BII HLLM A,TRNI OPEN DSKIN,TRNI ;OPEN FILE BEING DELETED (TO GET CREATION DATE) POPJ P, .CALL RDATE ;FDATE GETS CREATION DATE .LOSE %LSFIL .CALL [SETZ ? SIXBIT/RAUTH/ ? MOVEI DSKIN ? SETZM AUTHOR] SETZM AUTHOR .CALL [ SETZ ? 'DELEWO ? SETZI DSKIN ] .LOSE %LSFIL .CLOSE DSKIN, ;OLD FILE VANISHES MOVE A,FLENTH ADDM A,GFRNBG OPEN DSKOUT,GFRLNK ;MAKE THE LINK POPJ P, ;FOO, SHOULDN'T GET DIR FULL MOVSI A,20+.BII ;OPEN UP THE LINK AGAIN HLLM A,TRNI OPEN DSKOUT,TRNI POPJ P, ;FOO? .CALL SDATE ;SET CREATION DATE TO FDATE .LOSE %LSFIL .CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ AUTHOR] JFCL ;ALSO TRY TO PRESERVE AUTHOR .CLOSE DSKOUT, POPJ P, GFRLNK: 200000,,(SIXBIT/DSK/) ;OPEN COMMAND 2 = MLINK 0 ;FN1 0 ;FN2 SIXBIT /TAPE/ 0 ;TAPE NUMBER FROM TAPGET SIXBIT /BACKUP/ ;SNAME FOR LINK ;COMPUTE HISTOGRAM OF DATE VERSUS NUMBER OF BLOCKS SAVED ;IF FILES OLDER THAN THAT ARE REAPED. GFRPHI: PUSHJ P,GFRHIS ;COMPUTE IT SKIPE GFRLST PUSHJ P,GFRHP ;IF 'LIST' SPECIFIED, PRINT IT OUT POPJ P, GFRHIS: .RDATE A, SETOM MFDIN SETOM GFRFLG SETZM CURDAT LDB B,[000600,,A] ;LOW DIGIT OF DAY SUBI B,20 LDB C,[060600,,A] ;HIGH DIGIT OF DAY SUBI C,20 IMULI C,10. ADD C,B DPB C,[220500,,CURDAT] ;STORE DAY IN DAY FIELD OF DISK-DATE WORD LDB B,[140600,,A] ;SAME WITH MONTH SUBI B,20 LDB C,[220600,,A] SUBI C,20 IMULI C,10. ADD C,B DPB C,[270400,,CURDAT] LDB B,[300600,,A] ;SAME WITH YEAR SUBI B,20 LDB C, [360600,,A] SUBI C,20 IMULI C,10. ADD C,B DPB C,[330700,,CURDAT] ;NOW HAVE CURRENT TIME IN DISK FORMAT MOVE A,CURDAT ;[I DON'T KNOW WHAT'S WRONG WITH ******* SUBI C,GFRYRS ; THE RQDATE SYSTEM CALL] ******* DPB C,[330700,,A] MOVEM A,OLDDAT ;OLDEST FILE DATE IS GFRYRS YEARS AGO ******* SETZM GFRBLK MOVE A,[GFRBLK,,GFRBLK+1] BLT A,GFRBLK+LGFRBLK-1 GFR1: PUSHJ P,MFDN ;READ A DIRECTORY JRST GFRF PUSHJ P,GFRUCK ;SEE IF THIS DIRECTORY SHOULD NOT BE REEPED JRST GFR1 .SUSET [.SSNAM,,USNM] SETOM FLNI GFR2: PUSHJ P,FNG ;READ A FILE JRST GFR1 SKIPE LNKFLG ;DO NOTHING FOR LINKS JRST GFR2 SKIPN A,RFDATE ;DON'T COUNT FILES WITHOUT REFERENCE DATES JRST GFR2 CAMG A,OLDDAT ;IF OLDER THAN GFRYRS, USE OLDDAT MOVE A,OLDDAT PUSHJ P,GFROFS ;COMPUTE OFFSET MOVE B,FLENTH ADDM B,GFRBLK(A) ;INCREMENT COUNT OF BLOCKS ON THAT DATE JRST GFR2 ;NEXT FILE ;HISTOGRAM ALL DONE GFRF: SETZM GFRFLG SETZM A MOVEI B,GFRBLK GFRTOT: ADD A,(B) HRLM A,(B) ;RH INCREMENT, LH RUNNING SUM AOS B CAIG B,GFRBLK+LGFRBLK-1 JRST GFRTOT POPJ P, ;GIVEN A DATE IN A, COMPUTE NUMBER OF DAYS SINCE DATE IN OLDDAT GFROFS: SETZM B LDB C,[330700,,OLDDAT] ;SUBTRACT YEARS LDB D,[330700,,A] SUB D,C IMULI D,12.*31. ;APPARENTLY THERE ARE 372 DAYS PER YEAR MOVE B,D ; AT LEAST IF EACH MONTH HAS 31 DAYS LDB C,[270400,,OLDDAT] ;SUBTRACT MONTHS LDB D,[270400,,A] SUB D,C IMULI D,31. ADD B,D LDB C,[220500,,OLDDAT] ;SUBTRACT DAYS LDB D,[220500,,A] SUB D,C ADD B,D MOVE A,B CAILE A,LGFRBLK-2 ;DON'T GET FAKED OUT BY FILES MOVEI A,LGFRBLK-2 ; BROUGHT BACK FROM THE FUTURE POPJ P, ;PRINT GFR HISTOGRAM GFRHP: MOVEI B,GFRBLK GFRHPT: HRRZ A,(B) SKIPN A JRST GFRHP1 PUSHJ P,CRR PUSHJ P,GFROFI ;OFFSET BACK TO DATE PUSHJ P,GFRPDT ;PRINT DATE PASC [ASCIZ / /] HRRZ A,(B) PDPT A ;PRINT INCREMENT IN BLOCKS HLRZ A,(B) PDPT A ;PRINT TOTAL BLOCKS GFRHP1: AOS B CAIG B,GFRBLK+LGFRBLK-1 JRST GFRHPT POPJ P, ;PRINT DATE IN A GFRPDT: PUSH P,B PUSH P,A LDB B,[270400,,A] ;MONTH PSIS MONTH(B) PUSHJ P,TYOS LDB A,[220500,,A] ;DAY CAIGE A,10. PUSHJ P,TYOS PUSHJ P,DPT PASC [ASCIZ /, /] POP P,A LDB A,[330700,,A] ;YEAR ADDI A,1900. PUSHJ P,DPT POP P,B POPJ P, ;CONVERT GFRBLK POINTER IN B BACK FROM OFFSET INTO DATE ;SOMEONE SHOULD DOCUMENT THIS PURE MAGIC ;OK, here is the explanation: ; The date of GFRBLK+0 is stored in OLDDAT. If we pretend that every ; month has 31. days, then GFRBLK+ would have the date C(OLDDAT)+. ; (Where is measured in days, and date arithmetic is done appropriately.) ; Thus, some locations in GFRBLK correspond to impossible dates such as ; February 30. For some reason, people never create files on those dates... GFROFI: LDB C,[330700,,OLDDAT] ; C: old-year LDB D,[270400,,OLDDAT] ; D: old-month LDB E,[220500,,OLDDAT] ; E: old-day PUSH P,B SUBI B,GFRBLK MOVE A,B IDIVI A,12.*31. ; A: years, B: remainder ADD C,A MOVE A,B IDIVI A,31. ; A: months (0 - 11.), B: days (0 - 31.) ADD D,A ADD E,B CAILE E,31. AOS D CAILE E,31. SUBI E,31. CAILE D,12. AOS C CAILE D,12. SUBI D,12. CAILE D,12. AOS C CAILE D,12. SUBI D,12. POP P,B SETZM A DPB C,[330700,,A] DPB D,[270400,,A] DPB E,[220500,,A] POPJ P, GFRFLG: 0 ;MAGIC ARGUMENT TO FNG CURDAT: 0 ;CURRENT DISK-FORMAT DATE OLDDAT: 0 ;BASE DISK-FORMAT DATE FOR GFRBLK GFRYRS==:2 ; 2 year histogram LGFRBLK==:+1 ;1 ENTRY FOR EACH DAY, 1 EXTRA AT END FOR TOTAL GFRBLK: BLOCK LGFRBLK MONTH: 0 SIXBIT /JAN/ SIXBIT /FEB/ SIXBIT /MAR/ SIXBIT /APR/ SIXBIT /MAY/ SIXBIT /JUN/ SIXBIT /JUL/ SIXBIT /AUG/ SIXBIT /SEP/ SIXBIT /OCT/ SIXBIT /NOV/ SIXBIT /DEC/ ;GFRUCK - Skip if it's OK to reap this directory GFRUCK: ; Very grim procedure. SKIPE GFREVR ;Are we reaping all directories? JRST POPJ1 ; Yes - reap 'em all. ; Discriminatory reap procedures. SKIPN GFRJST ;If we are not being discriminatory JRST GFRUC2 ; follow normal procedures. MOVSI A,-NBADDY ;Number of discriminated against dirs. GFRUC1: CAMN B,BADDY(A) ;Is this dir a baddy? JRST POPJ1 ; Yes - it should be reaped. AOBJN A,GFRUC1 POPJ P, ;No, a normal dir. Don't reap it. ; Nondiscriminatory reap procedure. GFRUC2: HLRZ A,USNM CAIE A,(SIXBIT /SYS/) ;Never reap system dirs CAIN A,(SIXBIT /LIB/) ;Never reap libraries. POPJ P, MOVE B,USNM ;Don't reap the DUMP database! MOVSI A,-NTDIR GFRUC3: CAMN B,TDIRTB(A) POPJ P, AOBJN A,GFRUC3 SKIPE WRONG DIE Cannot GFR because this version of DUMP is for the wrong machine MOVSI A,-NSDIR ;Check list of specially protected dirs. GFRUC4: CAMN B,SDIR(A) ;Is this dir in the list? POPJ P, ; Yes, do not reap it. AOBJN A,GFRUC4 JRST POPJ1 ;Not in the list - reap it. SUBTTL SPECIALLY PROTECTED DIRS TO BE HAND REAPED ONLY SDIR: SIXBIT /./ SIXBIT /.BULK./ SIXBIT /.INFO./ SIXBIT /.MAIL./ SIXBIT /.TECO./ SIXBIT /ACOUNT/ SIXBIT /BACKUP/ SIXBIT /C/ SIXBIT /DEVICE/ SIXBIT /EMACS/ SIXBIT /EMACS1/ SIXBIT /FONTS/ SIXBIT /FONTS1/ SIXBIT /INFO/ SIXBIT /INQUIR/ SIXBIT /LISP/ SIXBIT /MAINT/ IFE MCOND AI,[ SIXBIT /COMLAP/ SIXBIT /DECSYS/ SIXBIT /KLDCP/ SIXBIT /KSC/ SIXBIT /KSHACK/ SIXBIT /L/ SIXBIT /LSPMAI/ SIXBIT /MIDAS/ SIXBIT /SAIL/ SIXBIT /UCODE/ ;Macsyma-related directories: ;(should be moved to the ML list when it comes up) ;Well, its up now, but perhaps we have decided to leave Macsyma on AI? SIXBIT /ALJABR/ SIXBIT /DEMO/ SIXBIT /LMMAXQ/ SIXBIT /MACDOC/ SIXBIT /MACSYM/ SIXBIT /MAXDOC/ SIXBIT /MAXDMP/ SIXBIT /MAXERR/ SIXBIT /MAXER1/ SIXBIT /MAXTUL/ SIXBIT /MAXOUT/ SIXBIT /MUNFAS/ SIXBIT /SHARE/ SIXBIT /SHARE1/ SIXBIT /SHARE2/ SIXBIT /SHAREM/ ] IFE MCOND MC,[ ; (The KS) SIXBIT /ANBB/ SIXBIT /DUPSYS/ SIXBIT /KSC/ SIXBIT /LSPMAI/ ] IFE MCOND MX,[ ; (The KL) SIXBIT /.DOVR./ SIXBIT /.KLFE./ SIXBIT /KLDCP/ SIXBIT /KSC/ SIXBIT /L/ SIXBIT /MIDAS/ SIXBIT /UCODE/ ;Macsyma-related directories: SIXBIT /ALJABR/ SIXBIT /DEMO/ SIXBIT /LMMAXQ/ SIXBIT /MACDOC/ SIXBIT /MACSYM/ SIXBIT /MAXDOC/ SIXBIT /MAXDMP/ SIXBIT /MAXERR/ SIXBIT /MAXER1/ SIXBIT /MAXTUL/ SIXBIT /MAXOUT/ SIXBIT /MUNFAS/ SIXBIT /SHARE/ SIXBIT /SHARE1/ SIXBIT /SHARE2/ SIXBIT /SHAREM/ ] IFE MCOND DM,[ SIXBIT /%SYS/ SIXBIT /.BATCH/ SIXBIT /COMDAT/ SIXBIT /COMMUD/ SIXBIT /COMPIL/ SIXBIT /COMSAV/ SIXBIT /CPROG/ SIXBIT /FONTS2/ SIXBIT /MADMAN/ SIXBIT /MBPROG/ SIXBIT /MPROG/ SIXBIT /MPROG1/ SIXBIT /MPROG2/ SIXBIT /MUDBUG/ SIXBIT /MUDDLE/ SIXBIT /MUDMAN/ SIXBIT /MUDSAV/ SIXBIT /MUDSYS/ SIXBIT /NCOMPI/ SIXBIT /NETDOC/ SIXBIT /R/ SIXBIT /READER/ SIXBIT /XFONT/ ] IFE MCOND AIKA,[ SIXBIT /CNVR/ SIXBIT /COMLAP/ SIXBIT /L/ SIXBIT /LMCONS/ SIXBIT /LMDOC/ SIXBIT /MIDAS/ SIXBIT /PUB/ SIXBIT /SAIL/ SIXBIT /VIS/ SIXBIT /WP/ ] NSDIR==.-SDIR SUBTTL DIRS TO BE DISCRIMINATORILY REAPED BADDY: SIXBIT /FOOBAR/ NBADDY==.-BADDY SUBTTL FILE NAME READER ;THE FOLLOWING ROUTINE GOBBLES INPUT LINES ;FROM THE TTY AND INTERPRETS THEM AS STANDARD MIDAS OR COPY INPUT ;LINES. EX. TODEV:TOSNM;TOFN1 TOFN2_FMDEV:FMSNM;FMFN1 FMFN2(CR) ;THE ROUTINE KEEPS TYPING FILE= AND WAITS FOR ANOTHER LINE ;UNTIL AN ALTMODE A LONELY CR IS TYPED. ALL THE TODEV'S ARE STORED IN A LIST ;CALLED TODEV:. ALL THE FMFN1'S ARE STORED ON A LIST CALLED FMFN1: ;ETC. THERE ARE EIGHT LISTS IN ALL. AN UNSPECIFIED ARGUMENT IN THE ;LINE IS GIVEN THE VALUE OF THE DEFAULT FOR ;THAT SPEC. A SPECIFIED ARG BECOMES THE DEFAULT FOR THAT SPEC. ;IF THE _ IS OMMITTED, ALL ARGS ARE FM ARGS. ;INITIAL DEFAULT FOR FM NAMES IS DSK:;* * ;THE ROUTINE EXITS IF THE LAST INPUT LINE OF FM NAMES ;EVALUATES TO *;* * ;TO NAMES UNSPECIFIED IN A LINE ARE SET ;TO FM NAMES OF THE SAME CORRESPONDING TYPE(DEV,SNM,FN1,FN2) FILGET: MOVSI D,-LLIST ;NUMBER OF ENTRIES ALLOWED SETZM FMDUMP(D) AOBJN D,.-1 MOVSI D,-LLIST CAIA ONEFIL: MOVSI D,-1 ;ENTRY FOR ONLY ONE SPEC TO BE READ MOVSI X,(SIXBIT /DSK/) ;DEFAULT FOR DEV MOVE U,MYNAME ;DEFAULT FOR SNAME MOVE V,[SIXBIT /*/] ;FIRST FILE NAME DEFAULT MOVE W,V ;SECOND FILE NAME DEFAULT IRP X,,[TO,FM] IRP Y,,[DEV,SNM,FN1,FN2] SETZM !X!!Y MOVE A,[!X!!Y,,!X!!Y+1] BLT A,!X!!Y+LLIST-1 TERMIN TERMIN TRAGEN: PRINT FILE= SETZM TINDEV MOVE A,[TINDEV,,TINSNM] BLT A,TINFN2 ;SO UNSPECIFIEDS WILL BE 0 SETOM BARROW ;SAYS NO BACK-ARROW TYPED YET PUSHJ P,TYI CAIE A,33 CAIN A,15 JRST TIDONE ;LONELY CR PUSHJ P,GETSL1 ;READ A SYLLABLE BUT FIRST CHARACTER ALREADY READ JRST TRAGEN ;ENTIRE SYLLABLE RUBBED OUT JRST OVER TGET: PUSHJ P,GETSYL JRST TRAGEN OVER: CAIN TER,": JRST TDEV CAIN TER,"; JRST TSNM CAIN TER,40 JUMPE SYM,TGET CAIN TER,^F JUMPE SYM,TRRDF ;INDIRECT AND READ FILE TO GET FILE NAMES CAIE TER,33 CAIN TER,15 JUMPE SYM,ENDLIN CAIN TER,"_ JUMPE SYM,BASET SKIPN TINFN1 JRST TFN1 SKIPE TINFN2 MOVEI TER,40 ;MORE THAN TWO FILE NAMES SKIPE TINFN2 JRST TOMANY MOVEM SYM,TINFN2 JRST TFNC TFN1: MOVEM SYM,TINFN1 JRST TFNC TFNC: CAIN TER,40 JRST TGET CAIN TER,"_ JRST BASET CAIN TER,^F JRST TRRDF ;INDIRECT TO READ FILE ENDLIN: AOS BARROW ;NO BACKARROW IMPLIES ONLY FM NAMES AOS BARROW PUSHJ P,DACIT IRP X,,[DEV,SNM,FN1,FN2] SKIPN A,TO!X(D) JRST Z!X CAME A,[SIXBIT /*/] JRST NZ!X Z!X: MOVE A,FM!X(D) MOVEM A,TO!X(D) NZ!X: TERMIN AOBJN D,.+1 MOVEI A,0 CAMN A,TYNSNM CAME A,TYNFN1 JRST NOCOM CAMN A,TYNFN2 JRST TIDONE ;CAN'T ASK FOR MORE THAN THE UNIVERSE ! NOCOM: CAIN TER,33 JRST TIDONE ;ALTMODE MEANS NO MORE LINES TO BE TYPED JUMPL D,TRAGEN JRST NOMORE ;FILE SPEC BUFFER FULL TRRDF: MOVSI A,'DSK SKIPN TINDEV MOVEM A,TINDEV MOVE A,MYNAME SKIPN TINSNM MOVEM A,TINSNM AOS TYIPD ;DEPTH IN IOPUSHES ON TYIC .IOPUSH TYIC, .CALL TRRDFO JRST TRRDFL JRST TRAGEN ;CONTINUE PROCESSING FILE SPECS (FROM DISK NOW) TRRDFL: PRINT [INDIRECT FILE ERROR; ] PUSHJ P,OPINFL SOS TYIPD .IOPOP TYIC, JRST TRAGEN BASET: PUSHJ P,DACIT AOSE BARROW JRST TOMANY SETZM TINDEV MOVE A,[TINDEV,,TINSNM] SETZM TINDEV BLT A,TINFN2 JRST TGET NOMORE: CAIN D,1 JRST TIDONE ;DON'T SAY FILE IF ONLY ONE LINE WAS ASKED FOR PRINT FILE= PUSHJ P,TYI ;PRETEND TO WANT ONE MORE, BUT BARF IF ONE GIVEN CAIE A,15 JRST TOOMCH TIDONE: HRRZM D,LENGTH SKIPN LENGTH JRST MLP ;NO ENTRIES JRST CRR ;APPLY DEFAULTS TO THE TYPED-IN FILE NAME DEFINE INITFD AC,DES SKIPN E,TYN!DES MOVEM AC,TYN!DES ;SET UNSPECIFIED ARG TO DEFAULT CAIE E,0 MOVE AC,E ;SET DEFAULT TO SPECIFIED ARG CAMN AC,[SIXBIT /*/] SETZM TYN!DES ;ASTERISKS MATCH TO ANYTHING CAME AC,[SIXBIT / */] JRST NOAST!AC MOVE E,[SIXBIT /*/] MOVEM E,TYN!DES ;SPACE * GETS CHANGED TO A REAL ASTERISK NOAST!AC: TERMIN DACIT: MOVSI B,-4 MOVE A,[TINDEV,,TYNDEV] BLT A,TYNFN2 SKIPG BARROW JRST ENDLUP IRP K,,[X,U,V,W]B,,[DEV,SNM,FN1,FN2] INITFD K,B TERMIN MOVSI C,(SIXBIT /DSK/) SKIPE A,TYNDEV CAMN A,[SIXBIT /*/] MOVEM C,TYNDEV ENDLUP: MOVE A,TYNDEV(B) SKIPL BARROW PUSHJ P,FMLST SKIPGE BARROW PUSHJ P,TOLST AOBJN B,ENDLUP POPJ P, TOOMCH: PRINT _NO MORE ENTRIES ALLOWED. QUES: PRINT SHALL I CONTINUE? .RESET TYIC, PUSHJ P,TYI CAIN A,"Y JRST TIDONE CAIN A,"N JRST MLP PRINT _TYPE Y FOR YES OR N FOR QUIT._ JRST QUES ;I HAVE NO IDEA WHETHER THESE DO ANYTHING ******* IRP X,,[TO,FM] X!LST: MOVEI C,LLIST IMULI C,(B) ADDI C,X!DEV(D) MOVEM A,(C) POPJ P, TERMIN IRP X,,[DEV,SNM] T!X: SKIPE TIN!X JRST TOMANY MOVEM SYM,TIN!X JRST TGET TERMIN TOMANY: PRINT UNACCEPTABLE WITH CAIN TER,"_ JRST NOTWO CAIE TER,": CAIN TER,"; JRST NOTWO PUSHJ P,TYOS PRINT THREE FILE NAMES! MOVEI TER,0 CAIA NOTWO: PUSHJ P,TYOS CAIE TER,": CAIN TER,"; PRINT TWO CAIN TER,"_ PRINT TWO CAIE TER,0 PUSHJ P,TYOS CAIN TER,"; PRINT SNAMES! CAIN TER,": PRINT DEVICES! CAIN TER,"_ PRINT BACKARROWS! PUSHJ P,CRR JRST TRAGEN SUBTTL MAGIC ROUTINES TO CALL FROM DDT ;WHO KNOWS WHAT THIS DOES? TRAN: SETOM MFDIN TRAN1: PUSHJ P,MFDN .VALUE SETOM FLNI .SUSET [.SSNAM,,USNM] TRAN2: PUSHJ P,FNG JRST TRAN1 .OPEN DSKIN,TRNI JRST TRAN2 SKIPE LNKFLG JRST TRAN2 .CALL RDATE JFCL SKIPG FDATE JRST TRAN2 MOVE A,FDATE TLO A,110000 CAML A,TOMDAT SUB A,[2000,,0] MOVEM A,FDATE .CALL SFDAT1 JFCL JRST TRAN2 TOMDAT: 0 SFDAT1: SETZ SIXBIT /SFDATE/ [DSKIN] SETZ FDATE ;CONVERT FROM OLD .TAPEn; TAPE nnn FILE FORMAT TO NEW (1975?) CONV: MOVE A,TDIRTB MOVEM A,USNM SETOM FLNI .SUSET [.SSNAME,,USNM] CONV1: PUSHJ P,FNG .VALUE MOVEI A,.BII HRLM A,TRNI OPEN DSKIN,TRNI .VALUE MOVEI B,.BIO HRLM B,TRNI OPEN DSKOUT,TRNI .VALUE HRLM A,TRNI .CALL RDATE SETOM FDATE .CALL SDATE JFCL .CALL SRDT1 JFCL SETOM USNM MOVE A,[-5,,BUF] .IOT DSKIN,A MOVE A,[-3,,0] MOVEM A,BUF+4 MOVE A,[-5,,BUF] .IOT DSKOUT,A CONV2: MOVE A,[-5,,BUF] .IOT DSKIN,A JUMPL A,CONV3 MOVE A,BUF CAME A,USNM PUSHJ P,CONV4 MOVE A,[-2,,BUF+1] .IOT DSKOUT,A HRROI A,BUF+4 .IOT DSKOUT,A JRST CONV2 CONV3: .CLOSE DSKOUT, .CLOSE DSKIN, JRST CONV1 CONV4: MOVEM A,USNM HRROI A,[0] .IOT DSKOUT,A HRROI A,USNM .IOT DSKOUT,A POPJ P, SRDT1: SETZ SIXBIT /SRDATE/ [DSKOUT] SETZ RFDATE ;ORDMFD$G WILL RUN THRU ALL THE .TAPE. FILES, AND PRODUCE A LIST ; OF DIRECTORIES WHICH HAVE EVER BEEN DUMPED ; (THIS IS A FILE OF SIXBIT, UNORDERED) ORDM1: -40000,,SBUF ;POINT TO A BUFFER ORDM2: -40000,,SBUF ;POINT TO CURRENT END ORDIR: 0 ;NAME OF A TAPE DIR ORDIRS: 0 ;NAME OF SAVED DIR DIRFLG: 0 ;FLAG SAYS THAT NEXT IS A DIR ORDMFD: .CORE CORSZB JRST .-1 MOVE A,[-40000,,SBUF] MOVEM A,ORDM1 MOVEM A,ORDM2 .SUSET [.RSNAM,,ORDIRS] SETOM TDIRN OM0: AOS A,TDIRN CAIGE A,NTDIR JRST [ MOVE A,TDIRTB(A) MOVEM A,ORDIR PUSHJ P,OM1 JRST OM0 ] .SUSET [.SSNAM,,ORDIRS] ;RESET SNAM OPEN DSKOUT,[SIXBIT / &DSKDMPMFD>/] .VALUE MOVE A,ORDM1 SUB A,ORDM2 ;# WDS IN BUF MOVSS A HRRI A,ORDM1 .IOT DSKOUT,A .CLOSE DSKOUT, .VALUE [ASCIZ /TAPES.SCANNED.FOR.MFD/] OM1: SETOM FLNI ;ROUTINE TO SCAN A .TAPE DIR .SUSET [.SSNAM,,A] OM1A: PUSHJ P,FNG POPJ P, ;END OF DIR PUSHJ P,OM2 JRST OM1A OM2: SETOM EOFF ;ROUTINE TO SCAN A .TAPE FILE OPEN DSKIN,TRNI .VALUE MOVEI B,0 JSR GWD CAME A,[-4,,] ;GOOD HEADER .VALUE JSR GWD ;TAPE# JSR GWD ;DATE JSR GWD ;FLAGS JFCL ;JUMPGE A,CPOPJ IF ONLY INCR WANTED JSR GWD ;ANOTHER RANDOM CAME A,[-3,,] ;MORE GOOD HEADER .VALUE JSR GWD ;SHOULD BE FOR A DIR NAME HERE CAME A,DIRFLG .VALUE OM2B: JSR GWD ;GET DIR NAME PUSHJ P,OMFD ;INSERT NAME IN LIST OM2C: JSR GWD ;GET FN1 OR FLAG CAMN A,DIRFLG JRST OM2B ;A DIR JSR GWD ;WAS FN1, GET FN2 JSR GWD ;DATE JRST OM2C OMFD: MOVE C,ORDM2 ;PUT A WORD IN LIST (IF UNIQUE) MOVEM A,(C) MOVE C,ORDM1 ;SEARCH CAME A,(C) AOBJN C,.-1 CAME C,ORDM2 ;SKIP IF REACHED END OF LIST POPJ P, ;NOT A NEW NAME AOBJP C,[.VALUE] ;REACHED END??? MOVEM C,ORDM2 ;BUMP POINTER NOW POPJ P, ;WHO KNOWS WHAT THIS DOES? ORFIND: .CORE CORSZB JRST .-1 SETOM MFDIN OF1: PUSHJ P,MFDN .VALUE MOVEM A,SCRDIR+2 .SUSET [.SSNAM,, [SIXBIT /TAPSCR/]] OPEN DSKOUT,SCRDIR .VALUE SETOM TDIRN OF1A: AOS A,TDIRN CAIL A,NTDIR JRST OF1 ;LOOP FOR ANOTHER NAME MOVE A,TDIRTB(A) MOVEM A,ORDIR PUSHJ P,OF2 JRST OF1A SCRDIR: 7,,446353 SIXBIT /TAPE/ 0 OF2: SETOM FLNI .SUSET [.SSNAM,,A] OF3: PUSHJ P,FNG POPJ P, SETOM EOFF OPEN DSKIN,TRNI .VALUE MOVE A,[-5,,BUF] .IOT DSKIN,A SKIPL BUF+3 JRST OF3 ;NOT INCREMENTAL PUSHJ P,OF4 JRST OF3 OF4: MOVEI B,0 MOVE A,TRNI+2 MOVEM A,DATA+3 JSR GWD OF7: PUSHJ P,OF5 POPJ P, JSR GWD OF6: MOVEM A,DATA JSR GWD MOVEM A,DATA+1 JSR GWD MOVEM A,DATA+2 MOVE A,[-4,,DATA] .IOT DSKOUT,A JSR GWD SKIPN A JRST OF7 JRST OF6 DATA: BLOCK 4 OF5: JSR GWD CAMN A,USNM JRST POPJ1 JRST OF8 OF9: JSR GWD JSR GWD OF8: JSR GWD SKIPN A JRST OF5 JRST OF9 ;WHO KNOWS WHAT THIS DOES? OFSORT: .CORE CORSZB JRST .-1 SETOM FLNI .SUSET [.SSNAM,,[SIXBIT /TAPSCR/]] OFS1: PUSHJ P,FNG .VALUE MOVE A,[-40000,,SBUF] MOVEI B,.BII HRLM B,TRNI OPEN DSKIN,TRNI .VALUE .IOT DSKIN,A SKIPL A .VALUE MOVEM A,SORTAS HRRZ C,A HRRZI A,SBUF MOVEI D,4 MOVEI N,0 SETZM (C) PUSHJ P,SORT MOVEI A,SBUF MOVEI N,1 MOVE C,A OFS2: SKIPN B,(A) JRST OFS4 OFS3: ADDI C,4 CAMN B,(C) JRST OFS3 PUSHJ P,SORT JRST OFS2 OFS4: MOVEI A,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT MODE HRLM A,TRNI .CLOSE DSKIN, OPEN DSKOUT,TRNI .VALUE .ACCESS DSKOUT,[0] MOVE A,[-40000,,SBUF] HLLZ B,SORTAS SUB A,B .IOT DSKOUT,A .CLOSE DSKOUT, JRST OFS1 OUTNAM: .CORE CORSZB JRST .-1 MOVE B,[440600,,A] MOVSI C,-6 OUTNM1: ILDB D,B ADDI D,40 PUSHJ P,OUTASC AOBJN C,OUTNM1 POPJ P, OUTNUM: MOVE B,[440600,,A] MOVSI C,-3 OUTNU1: ILDB D,B ADDI D,40 PUSHJ P,OUTASC AOBJN C,OUTNM1 POPJ P, OUTDAT: MOVE B,[270400,,A] MOVEI D,"0 LDB C,B CAIL C,10. MOVEI D,"1 PUSHJ P,OUTASC CAIL C,10. SUBI C,10. ADDI C,"0 MOVE D,C PUSHJ P,OUTASC MOVEI D,"/ PUSHJ P,OUTASC MOVE B,[220500,,A] LDB B,B IDIVI B,10. ADDI B,"0 MOVE D,B PUSHJ P,OUTASC ADDI C,"0 MOVE D,C PUSHJ P,OUTASC MOVEI D,"/ PUSHJ P,OUTASC MOVE B,[330700,,A] LDB B,B CAIGE B,72. ADDI B,72. IDIVI B,10. ADDI B,"0 MOVE D,B PUSHJ P,OUTASC ADDI C,"0 MOVE D,C PUSHJ P,OUTASC POPJ P, OUTCR: MOVEI D,15 PUSHJ P,OUTASC MOVEI D,12 JRST OUTASC OUTSPC: MOVEI D," JRST OUTASC OUT4SP: MOVEI D," MOVSI B,-4 PUSHJ P,OUTASC AOBJN B,.-1 POPJ P, OUTASC: MOVE U,ASCBP CAMN U,[010700,,BUF+2000-1] PUSHJ P,OUTBLK IDPB D,ASCBP POPJ P, OUTBLK: MOVE U,[-2000,,BUF] .IOT DSKOUT,U MOVE U,[440700,,BUF] MOVEM U,ASCBP POPJ P, ASCBP: 440700,,BUF CONASC: .CORE CORSZB JRST .-1 SETOM FLNI CONAS1: .SUSET [.SSNAM,,[SIXBIT /TAPSCR/]] PUSHJ P,FNG .VALUE MOVEI A,.BII HRLM A,TRNI OPEN DSKIN,TRNI .VALUE .SUSET [.SSNAM,,[SIXBIT /TAPASC/]] MOVEI A,.BIO HRLM A,TRNI OPEN DSKOUT,TRNI .VALUE MOVE A,[440700,,BUF] MOVEM A,ASCBP MOVE A,[-40000,,SBUF] .IOT DSKIN,A MOVEM A,SORTAS HRRZS A SUBI A,SBUF IDIVI A,4 MOVEM A,NUMENT MOVEI X,SBUF CONAS2: MOVE A,NUMENT ADDI A,3 IDIVI A,4 SETZM FUDGE+2 SETZM FUDGE+3 CAILE A,57 JRST CONAS6 MOVEI C,4 CAIN B,0 MOVEM C,FUDGE+2 CAIN B,1 MOVEM C,FUDGE+3 MOVEI C,8 CAIN B,0 MOVEM C,FUDGE+3 CONAS6: CAIL A,57. MOVEI A,57. MOVEM A,LINPAG CONAS3: MOVNI V,(A) HRLZS V CONAS4: MOVSI W,-4 CONAS5: MOVE E,LINPAG IMULI E,4 IMULI E,(W) ADD E,X SUB E,FUDGE(W) MOVE A,(E) PUSHJ P,OUTNAM PUSHJ P,OUTSPC MOVE A,(E)1 PUSHJ P,OUTNAM PUSHJ P,OUTSPC MOVE A,(E)2 PUSHJ P,OUTDAT PUSHJ P,OUTSPC MOVE A,(E)3 PUSHJ P,OUTNUM CAME W,[-1,,3] PUSHJ P,OUT4SP CAMN W,[-1,,3] PUSHJ P,OUTCR SOSN NUMENT JRST ASCEOF AOBJN W,CONAS5 ADDI X,4 AOBJN V,CONAS4 MOVEI D,^L PUSHJ P,OUTASC MOVE D,LINPAG IMULI D,12. ADD X,D JRST CONAS2 FUDGE: 0 0 0 0 ASCEOF: MOVEI D,3 ASCEF1: PUSHJ P,OUTASC HLRZ A,ASCBP CAIE A,10700 JRST ASCEF1 HRRZ A,ASCBP ADDI A,1 SUBI A,BUF MOVNS A HRLZS A HRRI A,BUF .IOT DSKOUT,A .CLOSE DSKOUT, JRST CONAS1 NUMENT: 0 LINPAG: 0 LNKBL: 200000,,446353 BLOCK 4 SIXBIT /TAPASC/ LNKSNM: SIXBIT /.LPTR./ OFMLNK: SETOM FLNI .SUSET [.SSNAM,,[SIXBIT /TAPASC/]] ML1: PUSHJ P,FNG .VALUE .SUSET [.SSNAM,,LNKSNM] MOVE A,FN1 MOVEM A,LNKBL+1 MOVEM A,LNKBL+3 MOVE A,FN2 MOVEM A,LNKBL+2 MOVEM A,LNKBL+4 .OPEN DSKIN,LNKBL .VALUE JRST ML1 ;CHECK FOR CLOBBERED FILES (CONTAIN 'CLBWRD') CHECCL: .CORE CORSZB JRST .-1 SETOM MFDIN PUSHJ P,DEVGET CHECL1: PUSHJ P,MFDN JRST RET SETOM FLNI .SUSET [.SSNAM,,USNM] CHSNM: PUSHJ P,FNG JRST CHECL1 SKIPE LNKFLG JRST CHSNM HRRI A,.BII HRLM A,TRNI OPEN DSKIN,TRNI JRST CHSNM CHSNM1: MOVE A,[-40000,,SORTAS] .IOT DSKIN,A PUSH P,A HLLZS A MOVE B,[-40000,,0] SUB B,A HRRI B,SORTAS MOVE C,CLBWRD CHSNM4: MOVE D,(B) TLZ D,770000 CAME C,D JRST CHSNM2 CHSNM3: POP P,A JUMPL B,CLBFL JUMPGE A,CHSNM1 .CLOSE DSKIN, JRST CHSNM CHSNM2: ADD B,[1777,,1777] AOBJN B,CHSNM4 JRST CHSNM3 CLBFL: PSIS USNM PSIS FN1 PSIS FN2 PDPT PACKN .CALL RDATE JFCL MOVE A,FDATE MOVEM A,DAYTIM PASC [ASCIZ / /] PUSHJ P,PFDATE .CLOSE DSKIN, PUSHJ P,CRR JRST CHSNM CLBWRD: 600,,3 ;USUAL WORD FILES GET CLOBBERED WITH ;MORE CHECKING FOR CLOBBERED FILES DIRSO: SIXBIT / &DSKWALL BIN / FBLK: .CORE CORSZB JRST .-1 .SUSET [.SSNAM,, [SIXBIT /SEC/]] .OPEN 15,DIRSO .VALUE PUSHJ P,DEVGET FBLK1: PUSHJ P,SFNG .VALUE FBLK5: .OPEN UFDCH,FNO .VALUE MOVE A,[-2000,,FDIRBF] .IOT UFDCH,A MOVEI A,.BII HRLM A,TRNI OPEN DSKIN,TRNI JRST FBLK1 MOVNI A,3 MOVEM A,BLKOFS FBLK2: MOVE A,[-6000,,SORTAS] .IOT DSKIN,A AOS BLKOFS AOS BLKOFS AOS BLKOFS PUSH P,A HLLZS A MOVE B,[-6000,,0] SUB B,A HRRI B,SORTAS MOVE C,CLBWRD FBLK3: CAMN C,(B) JRST FBLK4 ADD B,[1777,,1777] AOBJN B,FBLK3 POP P,A JUMPGE A,FBLK2 .CLOSE DSKIN, JRST FBLK1 SFNG: MOVE A,[-1,,USNM] .IOT 15,A JUMPL A,CPOPJ SKIPN USNM POPJ P, .SUSET [.SSNAM,,USNM] MOVE A,[-2,,FN1] .IOT 15,A JRST POPJ1 FBLK4: POP P,A PUSHJ P,CRR PSIS USNM PSIS FN1 PSIS FN2 HRRZS B SUBI B,SORTAS IDIVI B,2000 ADD B,BLKOFS PUSHJ P,DELBLK PUSHJ P,FTRK PDPT A JRST FBLK5 DELBLK: PUSH P,B IMULI B,2000 MOVEI C,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT HRLM C,TRNI .OPEN DSKIN,TRNI .VALUE .ACCESS DSKIN,B SETZM BUF ;CLOBBER WITH ZERO MOVE C,[BUF,,BUF+1] BLT C,BUF+1777 MOVE C,[-2000,,BUF] .IOT DSKIN,C .CLOSE DSKIN, POP P,B MOVEI C,.BII HRLM C,TRNI POPJ P, FTRK: MOVE A,FDIRBF+1 MOVEI A,FDIRBF(A) FTRK1: MOVE C,(A) CAME C,FN1 JRST FTRK3 MOVE C,1(A) CAME C,FN2 JRST FTRK3 LDB C,[150500,,2(A)] PDPT C LDB C,[UNDSCP +2(A)] IDIVI C,6 MOVE D,BTB(D) ADDI D,FDIRBF+11.(C) SETOM A FTRK2: ILDB C,D TRZE C,40 JRST FTRKL CAILE C,12. JRST FTRKS FTRKN: AOS A SOSGE B POPJ P, SOSLE C JRST FTRKN JRST FTRK2 FTRKS: SUBI C,11. ADD A,C SOSGE B POPJ P, JRST FTRK2 FTRKL: TRZ C,20 SETZM A DPB C,[140600,,A] ILDB C,D DPB C,[60600,,A] ILDB C,D DPB C,[600,,A] SOSGE B POPJ P, JRST FTRK2 BLKOFS: 0 BTB: 440600,, 360600,, 300600,, 220600,, 140600,, 060600,, FTRK3: ADDI A,5 CAIGE A,FDIRBF+1777 JRST FTRK1 SETOM A POPJ P, ;FIND PROBLEMS WITH CONVERTING TO NEW (1975?) .TAPEn; TAPE nnn FILE FORMAT FNDCON: .CORE CORSZB JRST .-1 MOVSI V,-NTDIR FNDCO1: MOVE B,TDIRTB(V) SETOM FLNI .SUSET [.SSNAM,,B] FNDCO2: PUSHJ P,FNG JRST FNDCO3 MOVEI B,.BII HRLM B,TRNI OPEN DSKIN,TRNI JRST FNDCO2 .CALL FILLEN .VALUE SKIPN A,LENGTH JRST FNDCO2 .CALL FILBLK .VALUE MOVNS A HRLS A HRRI A,SBUF .IOT DSKIN,A MOVSI B,-10. FNDCOX: SETZM (A) AOS A AOBJN B,FNDCOX MOVE A,SBUF CAME A,[-4,,0] JRST FNDCO2 ;NOT A GOOD TAPE MOVEI C,5 ;C WILL BE A POINTER INTO TAPE FCLOOP: CAML C,LENGTH JRST FNDCO4 MOVE A,SBUF(C) CAME A,[-1] JRST FCL1 ;REGULAR FILE MOVE A,SBUF+4(C) ;DATE OF NEXT FILE IF SNAME CHANGE CAMN A,[-1] JRST FCL3 LSH A,-27. CAIG A,2 ;OLD DATE JRST FCL3 CAIL A,71. CAILE A,76. JRST FCL2 FCL3: SETZM SBUF(C) ADDI C,2 JRST FCLOOP FCL1: ADDI C,3 JRST FCLOOP FCL2: MOVE A,SBUF+1(C) PSIS A JRST FCL1 FNDCO3: AOBJN V,FNDCO1 JRST RET FNDCO4: .CLOSE DSKIN, MOVEI A,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT MODE HRLM A,TRNI OPEN DSKOUT,TRNI .VALUE .CALL SDATE .VALUE .CALL SRDT .VALUE MOVN A,LENGTH HRLS A HRRI A,SBUF .IOT DSKOUT,A .CLOSE DSKOUT, JRST FNDCO2 ;CONVERT OLD SYSENG;MACRO TAPES FORMAT TO NEW TFCONV: .SUSET [.SSNAME,,SPLACE] MOVEI A,.BII HRLM A,STATOP OPEN DSKIN,STATOP JRST RET MOVEI A,.BIO HRLM A,STATOP OPEN DSKOUT,STATOP JRST RET SKIPE WRONG DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine MOVEI B,MAXTAP TFCNV1: MOVE A,[-10.,,BUF] ; Currently TPINFL=10. (1/17/86) .IOT DSKIN,A JUMPL A,TFCNV2 MOVE A,[-TPINFL,,BUF] .IOT DSKOUT,A SOJG B,TFCNV1 TFCNV2: SETZM BUF TFCNV3: MOVE A,[-TPINFL,,BUF] .IOT DSKOUT,A SOJG B,TFCNV3 .CLOSE DSKIN, .CLOSE DSKOUT, .BREAK 16, SUBTTL 'FIND', 'OFIND', and 'DFIND' COMMANDS ;CODE TO FIND FILES BASED ON DSK:.TAPEX; DIRECTORIES REWRITTEN 12/8/77 BY PDL ; TO READ ALL DIRECTORIES AND SORT TAPE FILES BY CREATION DATE BEFORE ; SEARCHING. MOST RECENTLY DUMPED FILES ARE THEREFORE SEEN FIRST. ; DEDDEV, DDIRTB, NDDIR DFIND: PRINT [ _FILES FOR ] SIXTYP DEDITS PRINT [ WHICH ARE STORED ON ] SIXTYP DEDDEV PRINT _ SETZM OFINDF ;SAY WE ARE CHECKING FROM DISK. SETOM DFINDF ;SAY THIS IS FOR A DECEASED ITS. JRST AFIND1 OFIND: SETOM OFINDF ;DO A FIND FROM A TAPE INSTEAD OF .TAPEn SKIPA ;THE TAPE CONTAINS .TAPEn; TAPE nnn FILES, ; NOT USER FILES! AFIND: SETZM OFINDF ;DOING A REGULAR FIND SETZM DFINDF ;FROM A LIVE ITS AFIND1: MOVSI A,-NFIGS CLEARM @FIGTB2(A) AOBJN A,.-1 PUSHJ P,FILGET ;WHAT SHOULD I FIND? PUSHJ P,DEVGET ;WHERE SHOULD I LIST THEM? SKIPE OFINDF JRST FLOOP1 ;HERE FIND FROM DISK .CORE CORSZB JRST .-1 MOVEI C,SBUF ;HUGE BUFFER AT END OF CORE MOVSI V,-NTDIR ;ONCE FOR EACH TAPE DIRECTORY POSSIBLY ON DISK SKIPE DFINDF ;IF THIS IS FOR A DECEASED ITS MOVSI V,-NDDIR ; USE DIFFERENT DIRECTORIES. FLOOP: SKIPE DFINDF JRST [ SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,UFDCH DEDDEV ? [SIXBIT /.FILE./] ? [SIXBIT /(DIR)/] DDIRTB(V)] JRST NEXDIR JRST FLSNRF] SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,UFDCH [SIXBIT /DSK/] ? [SIXBIT /.FILE./] ? [SIXBIT /(DIR)/] TDIRTB(V)] JRST NEXDIR ;DIR PROBABLY DOESNT EXIST FLSNRF: MOVE A,[-2000,,FDIRBF] .IOT UFDCH,A ;SNARF DIR .CLOSE A, MOVE A,FDIRBF+UDNAMP ;PROCESS THE DIR, MAKING A LIST OF TAPE FILES IN SBUF ADDI A,FDIRBF ;A POINTS TO BEGINNING OF NAME AREA FINDNM: CAILE A,FDIRBF+1777-4 JRST NEXDIR ;END OF NAME AREA SKIPE W,(A) ;EMPTY SLOT CAME W,[SIXBIT /TAPE/] ;KEEP ONLY "TAPE XXX" FILES JRST FNDNEX MOVE B,UNRNDM(A) TLNN B,UNLINK ;IGNORE FILES IN USE AND OTHER CHIMERAS TLNE B,UNIGFL JRST FNDNEX ; FILE IS LINK, OPEN FOR WRITING OR BEING DELETED MOVEM W,(C) ;FIRST NAME MOVE W,1(A) MOVEM W,1(C) ;SECOND NAME MOVE W,TDIRTB(V) MOVEM W,2(C) ;TAPE DIR NAME (FOR USE IN OPEN LATER) MOVE W,3(A) MOVEM W,3(C) ;CREATION DATE HLRZ W,4(A) ;REFERENCE DATE (NOT REALLY USED IN FIND) SKIPN W MOVEI W,177777 ANDI W,177777 MOVSM W,4(C) ADDI C,LUNBLK ;MOVE TO NEXT NAME ENTRY IN OUTPUT BUFFER FNDNEX: ADDI A,5 ;MOVE TO NEXT ENTRY IN DIRECTORY JRST FINDNM NEXDIR: AOBJN V,FLOOP ;MOVE TO NEXT DIR IN .TAPE* LIST MOVEM C,LFDIR ;LAST ENTRY ADDED TO LIST ;NOW SORT ACCUMULATED FILE POINTERS BY CREATION DATE MOVEI A,SBUF ;SORT BETWEEN SBUF AND C(LFDIR) MOVEI N,3 ; THIRD ELEMENT IS SORT KEY (CDATE) MOVEI D,LUNBLK ; ENTRIES ARE NAME PTRS PUSHJ P,SORTDN ; SORT IN DESCENDING ORDER MOVEI A,SBUF MOVEM A,DIRIDX ;POINTER TO TAPE FILE WE ARE WORKING ON NEXFL1: PUSHJ P,NEXTAP ;SET UP FILE OPEN BLOCK JRST CRR ; NO MORE TAPES TO LOOK AT PUSHJ P,NEXFL3 ;PROCESS TAPE FILE JRST NEXFL1 NEXTAP: MOVE A,DIRIDX ;ROUTINE TO SET UP OPEN BLOCK FOR TAPE FILE SEARCH SKIPN B,(A) POPJ P, ;NO MORE FILES MOVEM B,FN1 MOVE B,1(A) MOVEM B,FN2 MOVE B,2(A) .SUSET [.SSNAM,,B] ADDI A,LUNBLK MOVEM A,DIRIDX AOS (P) POPJ P, ;FIND FROM TAPE FILES DUMPED TO MAG TAPE ; USES SAME SEARCHING CODE ONCE FILE IS "OPEN", BUT IS OTHERWISE ; COMPLETELY SEPARATE FROM REGULAR FIND COMMAND FLOOP1: PUSHJ P,MAGOP ;READ TAPE JRST FLOOP2 MOVE A,HFN1 MOVEM A,FN1 MOVE A,HFN2 MOVEM A,FN2 PUSHJ P,NEXFL5 ;PROCESS THIS FILE NAME PUSHJ P,FILSKP ;SKIP FILE JRST FLOOP1 FLOOP2: PUSHJ P,ARWND ;REWIND TAPE AND EXIT JRST CRR ;HERE FOR EACH TAPE DIRECTORY ON DISK OR TAPE NEXFL3: SKIPE DFINDF JRST [ SYSCAL OPEN,[%CLBIT,,.BII ? %CLIMM,,DSKIN DEDDEV ? FN1 ? FN2 ? SNAME] JRST RET JRST NEXFL5 ] OPEN DSKIN,TRNI ;OPEN TAPE DIRECTORY JRST RET NEXFL5: SETOM EOFF MOVEI B,0 ;SO THAT GWD WILL .IOT IMMEDIATELY THE FIRST TIME THROUGH JSR GWDF MOVE C,A JSR GWDF AOBJN C,.-1 ;SKIP TAPE HEADER MOVE C,A SETZM FILN COMPR: JSR GWDF SKIPN A JRST FNDSSN AOS FILN MOVEM A,PFF1 JSR GWDF MOVEM A,PFF2 ADD C,[2,,2] ;WE JUST READ TWO WORDS MOVE W,LENGTH IMUL W,[-1,,] COMCON: SKIPN D,FMSNM(W) JRST COMFN1 ;ZERO MATCHES TO ANYTHING CAME D,PSNAM JRST NEXCOM ;NO MATCH COMFN1: SKIPN D,FMFN1(W) JRST COMFN2 CAME D,PFF1 JRST NEXCOM COMFN2: SKIPE D,FMFN2(W) CAMN D,PFF2 JRST MATCH NEXCOM: AOBJN W,COMCON NEXNAM: JUMPGE C,INITC ;ALREADY CORRECT PLACE JSR GWDF AOBJN C,.-1 ;GET TO BEGINNING OF NEXT ENTRY INITC: IMUL C,[-1,,] JRST COMPR FNDSSN: JSR GWDF MOVEM A,PSNAM JRST COMPR ;HERE WHEN THE FILE NAME MATCHES, LIST THIS ONE. MATCH: JSR GWDF ;READ DATE AND TIME PUSH P,B MOVEM A,DAYTIM ADD C,[1,,1] PUSHJ P,CRR PSIS FN1 PSIS FN2 PSIS PSNAM PSIS PFF1 PSIS PFF2 PDPT FILN PASC [ASCIZ / /] PUSHJ P,PFDATE POP P,B JRST NEXNAM PFDATE: MOVE A,DAYTIM ;PRINTS CONTENTS OF DAYTIM AS FILE CREATION DATE AND TIME AOJE A,NODATE CAMN A,[SETZ] JRST LDATE LDB A,[270400,,DAYTIM] ;CREATION DATE AND TIME PUSHJ P,DPT ;PRINT MONTH PASC [ASCIZ \/\] LDB A,[220500,,DAYTIM] PUSHJ P,DPT ;PRINT DAY PASC [ASCIZ \/\] LDB A,[330700,,DAYTIM] ADDI A,1900. PUSHJ P,DPT HRRZ A,DAYTIM ; TIME PASC [ASCIZ / /] IDIVI A,60.*60.*2 ;HALF SECONDS IN AN HOUR PUSHJ P,DDPA ;PRINT HOURS PRINT : MOVE A,B IDIVI A,60.*2 ;HALF SECONDS IN A MINUTE PUSHJ P,DDPA ;PRINT MINUTES PRINT : MOVE A,B IDIVI A,2 ;HALF SECONDS IN A SECOND PUSHJ P,DDPA ;PRINT SECONDS CAIE B,0 ;RG MEMORIAL (?) HALF SECOND OF SILENCE PRINT .5 POPJ P, NODATE: PRINT - POPJ P, LDATE: PRINT L POPJ P, DDPA: CAIGE A,10. ;SHOULD WE PRINT A '0' AS IN 4:07? PRINT 0 PUSH P,B PUSHJ P,DPT POP P,B POPJ P, GWD: 0 GWD1: MOVE A,(B) ;THIS ROUTINE READS ONE WORD, BUT ASSUMES BLOCK INPUT AOBJN B,[JRST @GWD] ;NO NEED TO READ FROM DISK YET(MORE IN BUFFER) SKIPL EOFF JRST CPOPJ ;END OF FILE, RETURN FROM CALLER!!!! MOVE B,[-2000,,BUF] .IOT DSKIN,B SUBI B,BUF-1 ;SO ONE WORD BUFFER WILL WIN MOVNS B HRLS B HRRI B,BUF CAME B,[-2000-1,,BUF] ;FULL BUFFER? AOS EOFF ;NO, MUST BE LAST BUFFER IN FILE JRST GWD1 ;NOW GET THE WORD GWDF: 0 ;FOR FIND, GWD FROM DISK OR TAPE SKIPN OFINDF JRST GWDFD GWDFM: JSR MGWD JRST @GWDF GWDFD: JSR GWD JRST @GWDF MGWD: 0 MGWD1: MOVE A,(B) ;THIS ROUTINE READS ONE WORD, BUT ASSUMES BLOCK INPUT AOBJN B,[JRST @MGWD] ;NO NEED TO READ FROM DISK YET(MORE IN BUFFER) SKIPL EOFF JRST CPOPJ ;END OF FILE MOVE A,[-2000,,BUF] PUSHJ P,MAGREAD JRST FILSKP ;ERROR, SKIP TO END OF FILE AND CONTINUE MOVE B,A SUBI B,BUF-1 ;SO ONE WORD BUFFER WILL WIN MOVNS B HRLS B HRRI B,BUF CAME B,[-2000-1,,BUF] ;FULL BUFFER? AOS EOFF ;NO, MUST BE LAST BUFFER IN FILE JRST MGWD1 ;NOW GET THE WORD SUBTTL MISCELLANEOUS MAGTAPE OPERATIONS ;CLOSE MAGOUT, WRITE LOGICAL EOT ON TAPE CLSOUT: SKIPL TAPTYP JRST [ .CLOSE MAGOUT, ;CLOSE TAPE OUTPUT POPJ P, ] PUSHJ P,RMTEOF ;Write a second EOF mark SETOM CTRLG ;Defer ^G PUSHJ P,RTAPE"FINISH ;Make sure all output was completed JRST RMTWER ;Tape error JRST CTRLGX ;Don't close RTAPE server yet ;WRITE EOF,MAGOUT ASUMED OPEN AEOF: SKIPGE TAPTYP JRST RMTEOF MOVEI A,5 MOVEM A,MTCMD MOVE A,[MAGOUT,,MTCMD] .MTAPE A, JRST NAUGHT POPJ P, RMTEOF: SETOM CTRLG PUSHJ P,RTAPE"WRTFM ;Write file mark JRST CTRLGX ;SPACE TO LOGICAL END OF TAPE AEOT: MOVEI A,10 PUSHJ P,TAPOPR SETOM EOTFLG SETOM UFDDAT SETOM MFDDAT CLEARM ITAPE POPJ P, ;SPACE REVERSE FILE SPRF: MOVE A,[-1,,7] JRST TAPOPR ;SPACE FORWARD FILE SPFF: MOVEI A,7 JRST TAPOPR ;REWIND ARWND: SKIPA B,[1] ;SKIPS THROUGH ;REWIND THEN UNLOAD AUNLD: MOVEI B,2 SETOM ITAPE SETOM UFDDAT SETOM MFDDAT SKIPL A,THTPN MOVEM A,LTHTPN SETOM THTPN MOVE A,B PUSHJ P,TAPOPR CLEARM EOTFLG POPJ P, ;PERFORM A TAPE OPERATION, COMMAND CODE IN A TAPOPR: SKIPGE TAPTYP JRST RMTOPR LCLOPR: OPEN MAGIN,MAGI JRST RET MOVEM A,MTCMD MOVE A,[MAGIN,,MTCMD] .MTAPE A, JRST NAUGHT .CLOSE MAGIN, POPJ P, ;This just initiates the operation ;Call SETIT1 if you want to know if it worked RMTOPR: PUSH P,B PUSH P,C PUSH P,D PUSH P,A PUSHJ P,SETIT1 ;Terminate any pending read-ahead POP P,A SETOM CTRLG XCT RMTDIS(A) POP P,D POP P,C POP P,B JRST CTRLGX RMTDIS: .VALUE PUSHJ P,RTAPE"REWIND PUSHJ P,RTAPE"UNLOAD REPEAT 4,.VALUE PUSHJ P,[ HLRE B,A ;7 space file JRST RTAPE"SKPFL0 ] PUSHJ P,[ MOVSI B,20000 ;10 space to eot JRST RTAPE"SKPFL0 ] ;ROUTINE TO DETERMINE WHETHER USER IS SURE CHECK: PUSH P,LPTSW SETZM LPTSW PUSHJ P,CRR PRINT ARE YOU SURE ? CHECK2: PUSHJ P,TYI CAIE A,"Y JRST ERR PUSHJ P,CRR POP P,LPTSW POPJ P, ;Show who used tape drive last. Put this on .TAPE0. That's ok, ;since FIND ignores files that aren't "TAPE XXX." SETITN: .suset [.runame,,a] .rdate d, .call [setz sixbit /MLINK/ [sixbit /DSK/] [sixbit /LAST/] [sixbit /USE/] [sixbit /.TAPE0/] COMT(B) ;which command D ;when SETZ A] ;who jfcl ;Drops in. ;SET ITAPE ROUTINE ;Call here first time tape is used SETIT: SKIPE TAPTYP ;Do we know what type of drive to use? JRST SETIT0 ;Yes .OPEN MAGIN,MAGI ;No, see if there is a local drive JRST [ .SUSET [.RIOS+MAGIN,,A] LDB A,[220600,,A] CAIE A,%ENSDV JRST .+1 SETOM TAPTYP ;Use remote drive JRST SETIT0 ] AOS TAPTYP ;Default is local drive if it exists SETIT0: PUSHJ P,SETIT1 ;Get tape status in A and in TAPEF TRNN A,TF%BOT ;Check for BOT POPJ P, ;No SETOM ITAPE ;Yes, at BOT SETOM UFDDAT SETOM MFDDAT POPJ P, SETIT1: SKIPGE A,TAPTYP ;Remote tape? JRST SETIT2 ;Yes SETIT4: OPEN MAGIN,MAGI ;WAIT FOR ALL TAPE ACTIVITY TO STOP JRST RET ;BARF IFN NEWCOD, .STATUS MAGIN,TAPEF .CLOSE MAGIN, IFE NEWCOD, CONI 344,TAPEF ;READ MAG TAPE STATUS MOVE A,TAPEF POPJ P, ;Mount remote tape if not already mounted SETIT2: PUSHJ P,RTAPE"RDRST ;Reset read and write buffers, stop readahead AOJL A,RMTSTS ;Jump if already mounted PUSH P,B PUSH P,C PUSH P,D PUSH P,E PUSH P,N PUSH P,SYM PUSH P,TER SKIPE TAPHST ;Host known yet? JRST SETIT3 PRINT TAPE SERVER HOST= PUSHJ P,GETSYL JRST ERR PUSH P,SYM PRINT DRIVE= PUSHJ P,GETSYL JRST ERR MOVE B,[440700,,TAPDRV] PUSHJ P,SIXTO7 POP P,SYM MOVE B,[440700,,TAPHST] PUSHJ P,SIXTO7 PRINT [READ-ONLY? ] ;HT server insists PUSHJ P,TYI MOVE SYM,[ASCII/BOTH/] CAIN A,"Y MOVE SYM,[ASCII/READ/] MOVEM SYM,TAPDIR PUSHJ P,CRR SETIT3: MOVEI A,TAPHST MOVEI B,CORSZB_10. MOVEI C,TAPDRV MOVEI D,TAPDIR SETOM CTRLG PUSHJ P,RTAPE"OPEN JRST [ SETZM LPTSW PRINT [Remote mount failed: ] PASC RTAPE"STATUS ;Just the string is enough SETZM TAPHST ;Don't save host if failed to connect JRST MLP ] ;Develop tape status in A and TAPEF RMTST1: MOVE B,RTAPE"STSFLG MOVEI A,TF%RDY TRNE B,RTAPE"F%BOT TRO A,TF%BOT TRNE B,RTAPE"F%EOT TRO A,TF%EOT TRNE B,RTAPE"F%EOF TRO A,TF%EOF TRNN B,RTAPE"F%OFFL TRNN B,RTAPE"F%MNT TRZ A,TF%RDY MOVEM A,TAPEF SETOM TAPTYP ;If not mounted, forget about this server TRNE A,TF%RDY SOS TAPTYP ;Mounted TRNE B,RTAPE"F%STRG JRST [ PUSH P,LPTSW SETZM LPTSW PRINT Remote tape status= PASC RTAPE"STATUS PUSHJ P,CRR POP P,LPTSW JRST .+1 ] POP P,TER POP P,SYM POP P,N POP P,E POP P,D POP P,C POP P,B JRST CTRLGX ;Tape already mounted, check status ;Develop tape status in A and TAPEF RMTSTS: PUSH P,B PUSH P,C PUSH P,D PUSH P,E PUSH P,N PUSH P,SYM PUSH P,TER SETOM CTRLG PUSHJ P,RTAPE"PROBE JRST RMTST1 ;Remote login routine RMTLGN: SKIPN RMTUSR ;First try own name and no password JRST [ .SUSET [.RXUNAME,,SYM] MOVE B,[440700,,RMTUSR] PUSHJ P,SIXTO7 JRST .+1 ] RMTLG1: MOVEI A,RMTUSR MOVEI B,RMTPSW PUSHJ P,RTAPE"LOGIN CAIA POPJ P, PRINT [_REMOTE LOGIN AS ] PASC RMTUSR PRINT [ FAILED: ] PASC RTAPE"STATUS PUSHJ P,CRR PASC TAPHST PRINT [ USER ID=] PUSHJ P,GETSYL JRST MLP MOVE B,[440700,,RMTUSR] SKIPE SYM ;DON'T CHANGE USER ID IF BLANK INPUT PUSHJ P,SIXTO7 MOVE A,TTYST1 ;TURN ECHOING OFF ANDCM A,[<%TGPIE+%TGMPE>*010101010101] MOVE B,TTYST2 ANDCM B,[<%TGPIE+%TGMPE>*010101010101] .CALL [ SETZ ? 'TTYSET ? MOVEI TYIC ? A ? B ? SETZ TTYSTS ] JFCL PRINT PASSWORD= PUSHJ P,GETSYL JRST MLP .CALL TTYSET ;TURN ECHOING BACK ON JFCL MOVE B,[440700,,RMTPSW] PUSHJ P,SIXTO7 JRST RMTLG1 SIXTO7: MOVEI N,0 ;Sixbit in SYM to ASCIZ, BP in B LSHC N,6 ADDI N,40 IDPB N,B JUMPN SYM,SIXTO7 IDPB SYM,B POPJ P, ;Commands to specify tape drive to use AREMOTE:SKIPA A,[-1] ALOCAL: MOVEI A,1 MOVEM A,TAPTYP .CLOSE RTAPE"RSICH, ;Dispose of possible remote server .CLOSE RTAPE"RSOCH, SETZM TAPHST ;Force ask for host again PUSHJ P,SETIT1 ;Get tape status in A and in TAPEF SKIPGE TAPTYP PRINT [REMOTE ] SKIPLE TAPTYP PRINT [LOCAL ] PRINT TAPE TRNE A,TF%BOT ;Check for BOT JRST ALOCL1 PRINT [ NOT REWOUND] TRNN A,TF%RDY ;Check for offline JRST ALOCL2 ;If offline, leave ITAPE alone so quit works SETZM ITAPE POPJ P, ALOCL1: PRINT [ REWOUND] SETOM ITAPE SETOM UFDDAT SETOM MFDDAT POPJ P, ALOCL2: PRINT [ AND NOT ON-LINE] POPJ P, ;COMMAND TO SPACE TAPE, LISTING FILES, AND WAITING FOR A SPACE ; AFTER EACH ALSPACE:PUSHJ P,CRR PUSHJ P,TYOS ASPAC2: PUSHJ P,LAST POPJ P, PUSHJ P,TYI CAIN A,177 POPJ P, JRST ASPAC2 ;COMMAND TO SPACE TAPE FORWARD OR BACKWARD 'N' FILES ASPACE: SETZM N CAIN TER,15 JRST ASPAC1 PUSHJ P,GETSYL POPJ P, ASPAC1: MOVEI A,7 ADDM N,ITAPE SKIPGE ITAPE SETOM ITAPE SKIPGE N SOS N ;SPACE REVERSE HRL A,N PUSHJ P,TAPOPR PUSHJ P,SETIT1 ;Await completion and get tape status TRNN A,TF%BOT ;Unless BOT, SKIPL N ;SPACING BACKWARD? POPJ P, JRST SPFF ;NOW SPACE FILE FORWARD SUBTTL GET TAPE NUMBER, LISTING DEVICE TAPGET: PUSH P,LPTSW TAPGT1: SETZM LPTSW PRINT TAPE NO= PUSHJ P,GETSYL JRST TAPGT1 JUMPL N,TAPGT1 SKIPE WRONG DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine CAIL N,MAXTAP JRST TAPGT1 POP P,LPTSW HRLM N,THTPN SETZM NPLACE MOVEM SYM,NSVTPN MOVEM SYM,GFRLNK+4 SKIPN LPTSW JRST SNPLAC PRINT TAPE NO = PDPT N PASC [ASCIZ / /] .RDATE A, MOVEM A,THDATE PRINT CREATION DATE PSIS THDATE PASC [ASCIZ / /] PRINT DUMPED BY .SUSET [.RXUNAME,,A] PSIS A JRST SNPLAC ;DECIDE WHERE TO PUT .TAPEn FILE ATPLA: HRRZ A,LPTO CAIN A,(SIXBIT /TPL/) JRST NAUGHT PRINT CHANGED TO TPL_ MOVEI SYM,(SIXBIT /TPL/) JRST SETOU1 DEVGET: PRINT LIST DEV = SETOUT: PUSHJ P,GETSYL ;READ DEVICE TO BE USED FOR LISTING STUFF ON JRST DEVGET HLRZS SYM SKIPN SYM MOVEI SYM,'TTY ;RESPONSE OF CR MEANS TTY CAIN SYM,'TTY POPJ P, SETOU1: HRRM SYM,LPTO .SUSET [.SSNAM,,MYNAME] ;WRITE ON USER'S WORKING DIR OPEN LPTCH,LPTO ;LIST FILES ON TAPE JRST ATPLA SETOM LPTSW ;SET LPT SWITCH ON POPJ P, SUBTTL DECIDE WHERE TO PUT .TAPEn; TAPE nnn FILE ;THIS IS A TABLE OF THE NAMES OF ALL THE TAPE DIRECTORIES TDIRTB: REPEAT 10., +.RPCNT REPEAT 26., +.RPCNT NTDIR==.-TDIRTB ;HERE IS A SORT OF KLUDGE TO EXAMINE THE TAPE DIRECTORIES OF A ;DECEASED ITS (IN THIS CASE, AI.) RESTORE ALL THE TAPE ;DIRECTORIES TO SOME MACHINE, UNDER THE NAMES %TAPEn;. DFINDF: 0 ;-1 => LOOKING ON DECEASED MACHINE'S TAPE DIRS. DEDDEV: SIXBIT /DM/ ;MACHINE WHERE %TAPEn DIRS ARE STORED. DEDITS: SIXBIT /AI/ ;WHICH MACHINE'S TAPE DIRS THEY WERE. DDIRTB: REPEAT 10., +.RPCNT REPEAT 26., +.RPCNT NDDIR==.-TDIRTB SNPLAC: SKIPN NPLACE ;IF ALREADY KNOW, DON'T MAKE INFINITE SYSTEM CALLS JRST SNPL0 .SUSET [.SSNAME,,NPLACE] POPJ P, SNPL0: PUSH P,A PUSH P,B PUSH P,C PUSH P,D PUSH P,E HLRZ A,THTPN MOVE D,NSVTPN CAIE A,-1 JRST SNPL00 HLRZ A,LTHTPN MOVE C,[440600,,D] MOVEI D,0 PUSHJ P,SIXNUM SNPL00: MOVEM D,SNTRYN SETOB B,C ;B NAME OF LEAST FULL DIR, C SPACE LEFT IN IT MOVSI A,-NTDIR SNPL1: .CALL SNTRY ;IS TAPE IN THIS DIR? JRST [ CAIN E,4 JRST SNPL3 ;NO CAIN E,20 JRST SNPL2 ;NON-EXISTENT DIRECTORY PRINT ERROR ACCESSING TAPE DIR - PUSHJ P,OPINFL JRST SNPL3 ] MOVE B,TDIRTB(A) JRST SNPL4 ;YES, LEAVE IN SAME DIR SNPL3: MOVE E,TDIRTB(A) ;READ DIR TO SEE HOW FULL IT IS .SUSET [.SSNAME,,E] .OPEN SNPLCH,FNO .LOSE %LSFIL MOVE D,[-UDNAMP-1,,SNBUF] .IOT SNPLCH,D CAML C,SNBUF+UDNAMP JRST SNPL3A MOVE C,SNBUF+UDNAMP ;THIS DIR LESS FULL MOVE B,TDIRTB(A) SNPL3A: AOBJN A,SNPL1 ;TRY NEXT DIR SNPL2: CAIL C,460 JRST SNPL4 ;THIS ONE HAS ENOUGH SPACE JUMPL A,SNPL2A SETZM LPTSW DIE ALL TAPE DIRECTORIES FULL SNPL2A: MOVE E,TDIRTB(A) .SUSET [.SSNAME,,E] .OPEN SNPLCH,CRUFD ;BEST DIR IS GROSSLY FULL, CREATE A NEW ONE JFCL .SUSET [.RIOS+SNPLCH,,C] LDB C,[220600,,C] CAIE C,4 ;ERROR CODE BETTER BE FILE NOT FOUND! JRST [ SETZM LPTSW DIE [NO FREE UFD SLOTS, CANNOT CREATE ANOTHER TAPE DIRECTORY, GET HELP] ] MOVE B,TDIRTB(A) SNPL4: MOVEM B,NPLACE ;USE THIS DIR .SUSET [.SSNAME,,NPLACE] .CLOSE SNPLCH, POP P,E POP P,D POP P,C POP P,B POP P,A POPJ P, SUBTTL TAPE LISTING COMMANDS ;QUIT COMMAND AQUIT: .BREAK 16,160000 ;LIST CONTENTS OF A TAPE BY USING .TAPEn FILE ATLIST: PUSHJ P,DEVGET PUSHJ P,TAPGET PUSHJ P,SNPLAC ;FIND WHICH TAPE DIR TO USE MOVEI A,.BII HRLM A,NSVOP .OPEN SAVET,NSVOP CAIA JRST ATLST4 PRINT NOT FOUND JRST RET ATLST4: SETZM ITAPE MOVE A,[-1,,B] .IOT SAVET,A ADD B,[1,,THBLK+1] .IOT SAVET,B PUSHJ P,PTHEAD MOVE A,[-1,,GARBAG] .IOT SAVET,A ATLST1: HRROI A,B .IOT SAVET,A JUMPL A,ATLST2 SKIPN B JRST ATLST3 MOVEM B,HBLK+2 HRROI A,HBLK+3 .IOT SAVET,A JUMPL A,ATLST2 HRROI A,HBLK+5 .IOT SAVET,A JUMPL A,ATLST2 PUSHJ P,LOUSY JFCL AOS ITAPE JRST ATLST1 ATLST2: SETOM ITAPE SETOM MFDDAT SETOM UFDDAT .CLOSE SAVET, POPJ P, ATLST3: HRROI A,HBLK+1 .IOT SAVET,A JRST ATLST1 APTDIR: SETOM PDIRSW ;PRINT DIRECTORIES FROM TAPE. PUSHJ P,DEVGET PUSHJ P,APTD1 POPJ P, JRST .-2 APTD1: PUSHJ P,MAGOP POPJ P, PUSHJ P,FILSKP AOS (P) POPJ P, ALIST: PUSHJ P,DEVGET ;LIST FILES ON MACRO-TAPE PUSHJ P,LAST POPJ P, JRST .-2 LAST: PUSHJ P,LOUSE POPJ P, PUSHJ P,FILSKP ;FLUSH REST OF FILE (PITY WE HAVE TO READ ALL THIS CRUFT) AOS (P) POPJ P, ;SAVE STUFF ABOUT THIS TAPE IN SYSENG; MACRO TAPES FILE SINFO: IRPS X,,[THTPN THTYPE FUSNM LUSNM]Y,,[STAPEN STYPE SFUSNM SLUSNM] MOVE A,X MOVEM A,Y TERMIN MOVE A,THTPN CAME A,[-1] JRST SINFO5 MOVE A,LTHTPN MOVEM A,STAPEN SINFO5: .RDATE A, MOVEM A,STDATE SINFO1: .SUSET [.RUNAME,,SUSER] .SUSET [.SSNAM,,SPLACE] SINFO4: MOVEI A,100007 ;WRITE-OVER BLOCK IMAGE OUTPUT MODE HRLM A,STATOP .OPEN STATC,STATOP JRST SINFO2 .CALL CLBIT ;ZERO DUMPCHECK BIT JFCL HLRZ A,STAPEN SKIPE WRONG DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine CAIL A,MAXTAP DIE [TAPE NUMBER TOO LARGE, YOU LOSE] IMULI A,TPINFL ;ACCESS TAPE INFO BLOCK .ACCESS STATC,A MOVE A,[-TPINFL,,STAPST] .IOT STATC,A .CLOSE STATC, .SUSET [.SSNAM,,USNM] POPJ P, SINFO2: MOVEI A,.BIO ;MACRO TAPES DOESN'T EXIST, CREATE IT HRLM A,STATOP OPEN STATC,STATOP JRST RET SETZM BUF MOVE A,[BUF,,BUF+1] BLT A,BUF+TPINFL-1 SKIPE WRONG DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine MOVEI B,MAXTAP SINFO3: MOVE A,[-TPINFL,,BUF] .IOT STATC,A SOJG B,SINFO3 .CLOSE STATC, JRST SINFO4 ;GET INFO ON A TAPE OUT OF SYSENG; MACRO TAPES FILE GINFO: MOVEI B,.BII HRLM B,STATOP .SUSET [.SSNAM,,SPLACE] .OPEN STATC,STATOP JRST GINFO1 SKIPE WRONG DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine CAIL N,MAXTAP DIE [TAPE NUMBER TOO LARGE, YOU LOSE] IMULI N,TPINFL .ACCESS STATC,N MOVE A,[-TPINFL,,STAPST] .IOT STATC,A .CLOSE STATC, GINFO2: .SUSET [.SSNAM,,USNM] POPJ P, GINFO1: SETZM STAPST MOVE A,[STAPST,,STAPST+1] BLT A,STAPST+TPINFL-1 JRST GINFO2 ;COMMAND TO LIST ALL KNOWN TAPES ATAPES: PUSHJ P,DEVGET .SUSET [.SSNAM,,SPLACE] MOVEI A,.BII HRLM A,STATOP OPEN STATC,STATOP JRST RET MOVEI U,0 TAPES1: MOVE A,[-TPINFL,,STAPST] .IOT STATC,A SKIPE STAPEN PUSHJ P,LINFO ADDI U,1 SKIPE WRONG DIE Cannot access MACRO TAPES file because this version of DUMP is for the wrong machine CAIGE U,MAXTAP JRST TAPES1 .CLOSE STATC, JRST CRR ;COMMAND TO LIST A SINGLE TAPE ATAPE: PUSHJ P,TAPGET PUSHJ P,GINFO PUSHJ P,LINFO JRST CRR ;LIST OUT MACRO TAPES INFO LINFO: HLRZ A,STAPEN JUMPE A,NOINFO PDPT A PSIS STDATE SKIPN STYPE PRINT NORM SKIPGE STYPE PRINT INCR SKIPLE STYPE PRINT FULL PSIS SUSER SKIPN SDONE PRINT ABRT SKIPLE SDONE PRINT ARCH SKIPGE SDONE PRINT DUMP HRRZ A,STAPEN PDPT A PRINT PSIS SFUSNM PSIS SLUSNM JRST CRR NOINFO: PRINT NO INFORMATION JRST CRR ;CREATE TAPE DIRECTORY ON DISK FROM MOUNTED TAPE ATAPED: PUSHJ P,ARWND PUSHJ P,MAGOP POPJ P, MOVE A,THTPN MOVEM A,LTHTPN SETOM THTPN ;KNOWN NUMERICALLY, NOT SYMBOLICALLY SETZM NPLACE PUSHJ P,SNPLAC ;FIND TAPE DIRECTORY IF ON-LINE ALREADY MOVEI A,.BII ;OTHERWISE DECIDE WHERE TO PUT IT HRLM A,NSVOP .OPEN SAVET,NSVOP JRST ATAPD3 PRINT _DIRECTORY ALREADY EXISTS._ PUSHJ P,CHECK ATAPD3: MOVEI A,.BIO HRLM A,NSVOP OPEN SAVET,NSVOP JRST RET MOVE A,[-LTHBLK,,THBLK] ;STORE TAPE HEADER .IOT SAVET,A HRROI A,[-3,,0] .IOT SAVET,A SETOM USNM DLUP: PUSHJ P,FILSKP ;SKIP THIS TAPE FILE PUSHJ P,MAGOP ;GET NEXT POPJ P, ;EOT MOVE B,USNM CAME B,HBLK+1 ;NEW S NAME? PUSHJ P,DLUPSN ;YES. MOVE A,[-2,,HBLK+2] ;FILE NAMES .IOT SAVET,A MOVE A,[-1,,HBLK+5] ;DATE .IOT SAVET,A JRST DLUP DLUPSN: MOVE A,HBLK+1 ;SWITCH S NAMES MOVEM A,USNM HRROI A,[0] ;0 FN FLAGS SNAME CHANGE .IOT SAVET,A HRROI A,USNM .IOT SAVET,A POPJ P, ;COMMAND TO CHANGE STORED INFO ABOUT A TAPE TAPSET: PUSHJ P,TAPGET ;GET TAPE NUMBER MOVE U,N PUSHJ P,GINFO PUSHJ P,LINFO HRLM U,STAPEN LWREQ: PRINT LAST WRITTEN= PUSHJ P,GETSYL JRST LWREQ CAIN A,33 JRST TAPST1 SKIPE SYM MOVEM SYM,STDATE PRINT TYPE= PUSHJ P,TYI MOVEI C,1 CAIN A,33 JRST TAPST1 CAIN A,"F MOVEM C,STYPE CAIN A,"R SETZM STYPE CAIN A,"I SETOM STYPE PRINT _ARCHIV? PUSHJ P,TYI CAIN A,"Y MOVEM C,SDONE CAIN A,"N SETOM SDONE SKIPN STYPE JRST TAPST1 RNFULU: PRINT _REEL NO FIRST USER LAST USER BACK: PUSHJ P,GETSYL JRST RNFULU CAIN A,33 JRST TAPST1 MOVEM SYM,W SKIPE SYM HRRM N,STAPEN BACK1: PUSHJ P,GETSYL JRST UNDO1 CAIN A,33 JRST TAPST1 SKIPE SYM MOVEM SYM,SFUSNM PUSHJ P,GETSYL JRST UNDO2 SKIPE SYM MOVEM SYM,SLUSNM TAPST1: PUSHJ P,CHECK JRST SINFO1 UNDO1: PSIS W PUSHJ P,TYOS JRST BACK UNDO2: PSIS SYM PUSHJ P,TYOS JRST BACK1 ;MORE LISTING COMMANDS AND SUBROUTINES LOUSE: PUSHJ P,MAGOP ;OPEN TAPE AND READ HEADER JRST ENDMAG ;END OF TAPE LOUSY: PUSHJ P,CRR PUSHJ P,TAPN PSIS HSNM PSIS HFN1 ;OUTPUT FILE NAME PSIS HFN2 SKIPE LNKFLG PUSHJ P,LDMUT5 SKIPE LNKFLG JRST NOPP SKIPL HPKN PDPT HPKN ;OUTPUT PACK NUMBER NOPP: SIXTYP [SIXBIT/ /] MOVE A,HDATE MOVEM A,DAYTIM SKIPN LNKFLG PUSHJ P,PFDATE AOS (P) POPJ P, ENDMAG: PRINT _ REEL = HRRZ A,THTPN PDPT A ;OUTPUT REEL NUMBER JRST CRR ;COMMAND TO LIST THE MFD AMFD: PUSHJ P,DEVGET SETOM MFDIN AMFD1: PUSHJ P,MFDN POPJ P, PSIS USNM PUSHJ P,CRR JRST AMFD1 ;COMMAND TO LIST A DIRECTORY ALISTF: SETOM FLNI CLEARM MICFLG MOVEI A,(SIXBIT /DSK/) HRRM A,FNO GETDIR: PRINT DIRECTORY= PUSHJ P,GETSYL JRST GETDIR CAIN TER,15 PUSHJ P,CRR CAIN TER,": HLRM SYM,FNO MOVEM SYM,USNM CAIE TER,": .SUSET [.SSNAM,,USNM] PUSHJ P,DEVGET ;WHERE TO LIST IT TO ALISTK: PUSHJ P,FNG JRST CRR PUSHJ P,CRR PSIS FN1 PSIS FN2 SKIPN MICFLG PDPT PACKN JRST ALISTK ;LISTING ROUTINES ;LIST LINK INFO LDMUT5: PSIS [SIXBIT /L/] PSIS PACKN ; SYSNM PSIS LNKNM1 PSIS LNKNM2 POPJ P, ;WHEN LOADING, LIST SNAMES AS ENCOUNTERED LDMUT4: MOVE A,HSNM CAMN A,CUSN POPJ P, ;SAME NAME PUSHJ P,TAPN MOVEM A,CUSN ;NEW NAME PSIS CUSN JRST CRR ;LIST A FILE THAT'S ACTUALLY BEING LOADED LDMUT3: PUSHJ P,TAPN PSIS HFN1 PSIS HFN2 SKIPE LNKFLG PUSHJ P,LDMUT5 SKIPN LNKFLG PDPT HPKN JRST CRR SUBTTL RETRIEVAL ROUTINES (LOAD, RELOAD) RETRV0: SKIPL LDPACK SKIPE LOSRSW JRST RETRV PRINT LDPACK FEATURE ISN'T GOING TO WORK UNLESS YOU RELOAD IN SORRY MODE JRST ERR SFRETR: PUSHJ P,FILSKP ;FLUSH CURRENT FILE, THEN DROP INTO RETRV ;ENTER HERE FROM EXECU FOR LOAD AND RELOAD COMMANDS RETRV: PUSHJ P,MAGOP ;OPEN TAPE POPJ P, ;END OF TAPE SKIPL A,LDPACK JRST [ CAME A,HPKN ;ON SINGLE PACK BEING RELOADED? JRST SFRETR ;NO, SKIP IT JRST .+1 ] SKIPL A,BBPACK JRST [ CAME A,HPKN ;ON SINGLE PACK BEING BROUGHT BACK? JRST SFRETR ;NO, SKIP IT. JRST .+1 ] SKIPE LSTWHL ;LIST? PUSHJ P,LDMUT4 MOVN W,LENGTH ;SEE IF THIS IS ONE OF THE FILES HRLZS W ;THAT WE WERE ASKED TO LOAD. COMCN2: SKIPN D,FMSNM(W) JRST CM2FN1 CAME D,HSNM JRST NEXCM2 CM2FN1: SKIPN D,FMFN1(W) JRST CM2FN2 CAME D,HFN1 JRST NEXCM2 CM2FN2: SKIPE D,FMFN2(W) CAMN D,HFN2 JRST RETRVF NEXCM2: AOBJN W,COMCN2 JRST SFRETR ;IT'S NOT, FLUSH IT ;CURRENT TAPE FILE MATCHES SPECS OF FILES TO BE LOADED RETRVF: IRP X,,[FN1,FN2] ;STORE FILE NAMES INTO 'CPYO' OPEN BLOCK SKIPE A,TO!X(W) MOVEM A,L!X MOVE A,H!X SKIPN TO!X(W) MOVEM A,L!X TERMIN MOVEI A,(SIXBIT /DSK/) SKIPN TODEV(W) HRRM A,CPYO ;UNSPECIFIED DESTINATION FOR LOADS IS DISK SKIPE A,TODEV(W) HLRM A,CPYO ;SPECIFIED DESTINATION SKIPN A,TOSNM(W) MOVE A,HSNM ;UNSPECIFIED SNAME IS THE ONE READ FROM TAPE .SUSET [.SSNAM,,A] ;SET SNAME FOR MERGE TEST MOVEI B,36 ;BLOCK IMAGE INPUT, DON'T TOUCH REFDATE, HRLM B,CPYO ; AND DON'T CHASE LINKS SKIPGE DEADPK ;If DEADPK being restored JRST CHMRG MOVE B,LFN1 ; SNAME still in A... MOVE C,LFN2 PUSHJ P,DKLOOK ; Look up file on disk JRST SFRETR ; No longer around, skip it MOVEM A,DKBLK ; Save this for later... MOVE B,UNRNDM(A) LDB C,[UNPKN B] TLNN B,UNLINK CAME C,DEADPK JRST SFRETR ; Link, or wrong pack, skip it MOVEI D,[ASCIZ\file on tape is a link.\] SKIPE LNKFLG JRST NORETR ; What kind of a tape is he using? MOVE B,UNDATE(A) CAMN B,HDATE JRST OKRETR ; Dates match, go read it! MOVEI D,[ASCIZ\file on disk has a different creation date.\] JRST NORETR ;CHECK FOR MERGE MODE CHMRG: SKIPL MRGSW JRST CHCARE .OPEN DSKOUT,CPYO ;MERGE. DON'T LOAD IF FILE EXISTS. JRST OKRETR ;FILE DOESNT EXIST MOVEI D,[ASCIZ\file already exists on disk.\] JRST NORETR ;FILE EXISTS, DON'T FILE ON TOP OF. ;IF NOT IN MERGE MODE, SEE IF FILE EXISTS ON DISK AND ; ISN'T DUMPED YET AND WE'RE BEING CAREFUL. IF SO, DON'T CLOBBER IT. CHCARE: SKIPE CAREF SKIPE MICFLG JRST CHRECN ;IF NOT BEING CAREFUL, LOAD OVER .OPEN DSKOUT,CPYO JRST OKRETR ;IF DOESNT EXIST, LOAD OVER MOVEI A,DSKOUT .DMPCH A, ;OTHERWISE, SEE IF DUMPED JUMPN A,CHRECN ;YES WAS DUMPED, OK TO LOAD OVER MOVEI D,[ASCIZ\file exists on disk and has not been backed up.\] JRST NORETR ;CHECK FOR OVER-WRITING MORE RECENT FILE CHRECN: SKIPE LOSRSW JRST OKRETR ;DON'T CHECK IF SORRY MODE MOVEI A,36 ;BLOCK IMAGE INPUT, DON'T SET REF DATE, HRLM A,CPYO ; AND DON'T CHASE LINKS .OPEN DSKOUT,CPYO JRST OKRETR ;FILE DOES NOT EXIST, NO OVERWRITE PROBLEMS .CALL [ SETZ ? 'FILBLK ? MOVEI DSKOUT ;GET FILE INFO MOVEM D ? MOVEM D ? MOVEM D ;D GETS UNRNDM BITS SETZM A ] ;A GETS CREATION DATE .LOSE %LSFIL TLNN D,UNLINK ;DON'T WORRY ABOUT LINKS, OR FILES CAMG A,HDATE ;WITH OLDER CREATION DATE THAN THAT ON TAPE JRST OKRETR MOVEI D,[ASCIZ\a newer file with same name exists on disk.\] JRST NORETR ;FILE SPECS SAY TO RETRIEVE THIS FILE, BUT OTHER OPTIONS SUCH ;AS MERGE SAY NOT TO. D -> ASCIZ STRING FOR WHY THIS SHOULDN'T ;BE RETRIEVED. IF 'NOASK' WAS NOT SPECIFIED, CONSULT ;USER, OTHERWISE SKIP IT. ;W -> CURRENT RETRIEVAL FILE, CPYO (LFN1, LFN2) HAS ACTUAL FILE WRITING TO. NORETR: SKIPE NOASK JRST SFRETR ;YES, JUST FLUSH IT QUIETLY PUSH P,LPTSW SETZM LPTSW PRINT _File .SUSET [.RSNAME,,A] PSIS A PRINT [;] PSIS LFN1 PSIS LFN2 PRINT [ not getting retrieved because ] PASC (D) PRINT [_Do you want to retrieve it anyway? ] NORET1: PUSHJ P,TYI MOVE D,A PUSHJ P,CRR CAIE D,"N CAIN D,"Y JRST NORET2 PRINT [(Y or N) ] JRST NORET1 NORET2: POP P,LPTSW CAIE D,"Y JRST SFRETR ;NO, FLUSH IT JRST OKRETR ;YES, LOAD IT ;SKIP AN INPUT FILE FILSKP: SKIPGE TAPTYP JRST [ SETOM CTRLG PUSHJ P,RTAPE"SKPFIL JRST CTRLGX ] PUSH P,A PUSH P,B MOVEI A,7 MOVE B,[MAGIN,,A] .MTAPE B, ; SKIP TO EOF JFCL .CLOSE MAGIN, POP P,B POP P,A POPJ P, ;OK, WE'VE DECIDED TO RELOAD IT. OKRETR: SKIPE LNKFLG JRST RETRLK ;GO RELOAD LINK MOVE A,HSNM ;DIR LOADING ONTO CAMN A,[SIXBIT/.KLFE./] JRST [ PRINT [ATTEMPT TO CLOBBER KL10 FRONT END DIRECTORY, FILE BEING SKIPPED_] JRST SFRETR ] MOVE B,HFN1 CAMN A,[SIXBIT /./] CAME B,[SIXBIT /.FEFS./] SKIPA JRST [ PRINT [ATTEMPT TO CLOBBER KS10 FRONT END FILESYSTEM, FILE BEING SKIPPED_] JRST SFRETR ] SKIPE A,TODEV(W) ;GET DEVICE TO WRITE TO JRST OKRET0 ;EXPLICITLY SPECIFIED USE IT, OTHERWISE CHOOSE MOVE B,HPKN ;IF RELOADING, AND FILE WAS FROM SECONDARY MOVSI A,-NQS ; DISK, PUT IT BACK THERE CAME B,QPKID(A) AOBJN A,.-1 JUMPGE A,OKRET9 SKIPE A,QRESRV(A) CAMN A,[-1] JRST OKRET9 SKIPL RELOSW OKRET9: MOVSI A,'DSK OKRET0: SKIPE CRDIR .OPEN CRUFD ;CREATE DIRECTORY IF NON-EXISTENT JFCL .CALL [SETZ ? SIXBIT/OPEN/ ? [.BIO,,DSKOUT] A ? [SIXBIT/_DUMP_/] ? SETZ [SIXBIT/OUTPUT/]] .LOSE 1400 ;MIGHT AS WELL LET DDT HANDLE IT SKIPE LSTWHL PUSHJ P,LDMUT3 ;LIST THIS FILE SETZM HFNL HLRZ A,HSNM CAIN A,'LCF PUSHJ P,ISLCF MOVE A,HDATE SKIPGE RELOSW ;IF NOT RELOADING, JRST OKRET1 SKIPE A CAMN A,[-1] PUSHJ P,ALD5 ;MAKE CREATION DATE FROM TAPE DATE OKRET1: MOVEM A,FDATE .CALL SDATE JFCL ;IT DOESN'T MATTER WEATHER YOU WIN OR LOSE, ITS HOW YOU PLAY THE GAME. OKRET2: MOVE A,[-2000,,BUF] PUSHJ P,MAGRDL ;READ A BUFFER LOAD FULL JRST RETRFN ;ERROR HRLOI B,-BUF-1(A) EQVI B,BUF SKIPE HFNL PUSHJ P,HFNLX SKIPGE B .IOT DSKOUT,B ;OUTPUT IT TO DISK JUMPGE A,OKRET2 ;JUMP UNLESS EOF PUSHJ P,FILSKP ;EOF, BE SURE. SKIPN THTYPE JRST OKRET3 ;RANDOM TAPE, DON'T CLEAR NOT-DUMPED INDIC. .CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZI 1] .LOSE 1000 OKRET3: SKIPGE RELOSW PUSHJ P,RELOAF ;IF WE ARE RELOADING, SET DUMPBIT,REAPBIT ,AUTHOR, REF DATE SKIPL DEADPK PUSHJ P,DKBLKF ; Restore attributes from saved file block .CALL [SETZ ? 'RENMWO ? MOVEI DSKOUT ? LFN1 ? SETZ LFN2] .LOSE 1000 ;FILE HAS BEEN LOADED, REMOVED FROM LOAD SPECS RETRFN: .CLOSE DSKOUT, SKIPE FMSNM(W) SKIPN FMFN1(W) JRST RETRV ;WAS "*"=> DON'T FLUSH ENTRY SKIPN FMFN2(W) JRST RETRV PUSHJ P,FLUSH POPJ P, ;NOTHING MORE TO DO JRST RETRV ISLCF: HLRZ A,HFN1 CAIE A,'ACT CAIN A,'DUN SETOM HFNL POPJ P, HFNLX: PUSH P,B ;DONT COMPROMISE, RANDOMIZE! PUSH P,A HFNLXL: MOVE A,(B) TSC A,1(B) MOVEM A,(B) AOBJN B,HFNLXL POP P,A POP P,B POPJ P, ;FLUSH ENTRY OF FILE THAT WAS JUST DUMPED, OR LOADED ;SKIP RETURN IF ANY MORE FILES TO BE DONE FLUSH: SOSN B,LENGTH POPJ P, ;NOTHING MORE TO DO SUBI B,1 HRLI A,FMDUMP+1(W) ;BLT DOWN ENTRIES ABOVE IT HRRI A,FMDUMP(W) BLT A,FMDUMP(B) IRP X,,[FM,TO] IRP Y,,[DEV,SNM,FN1,FN2] HRLI A,!X!!Y+1(W) HRRI A,!X!!Y(W) BLT A,!X!!Y(B) TERMIN TERMIN JRST POPJ1 ; Restoring dead pack: set author, reference date, and reap bit from disk ; copy of UFD. DKBLKF: MOVE C,DKBLK LDB A,[UNAUTH UNREF(C)] PUSHJ P,DKAUTH .CALL [ SETZ ? SIXBIT /SAUTH/ ? MOVEI DSKOUT ? SETZ A ] JFCL HLLZ A,UNREF(C) .CALL [ SETZ ? SIXBIT /SRDATE/ ? MOVEI DSKOUT ? SETZ A ] JFCL MOVE A,UNRNDM(C) TLNE A,UNREAP .CALL [ SETZ ? SIXBIT /SREAPB/ ? MOVEI DSKOUT ? SETZI 1 ] JFCL POPJ P, ;RELOADING, SET MISCELLANEOUS FILE ATTRIBUTES FROM TAPE COPY OF UFD RELOAF: SKIPGE UFDDAT POPJ P, ;NO UFD IN CORE MOVE A,HSNM CAME A,UFDBUF+UDNAME POPJ P, ;WRONG NAME MOVE C,UDNAMP+UFDBUF ADDI C,UFDBUF MOVE A,HFN1 SKIPA B,HFN2 RELOF1: ADDI C,LUNBLK CAIL C,UFDBUF+2000 POPJ P, ;NOT FOUND CAMN A,UNFN1(C) CAME B,UNFN2(C) JRST RELOF1 MOVE A,HDATE CAME A,UNDATE(C) POPJ P, ;SAME NAMES, DIFFERENT CREATION DATE RELOF2: LDB A,[.BP (UNREAP),UNRNDM(C)] .CALL [SETZ ? 'SREAPB ? 1000,,DSKOUT ? SETZ A] JFCL LDB A,[.BP (UNDUMP),UNRNDM(C)] .CALL [SETZ ? 'SDMPBT ? 1000,,DSKOUT ? SETZ A] JFCL HLLZ A,UNREF(C) .CALL [SETZ ? 'SRDATE ? 1000,,DSKOUT ? SETZ A] JFCL LDB A,[UNAUTH+UNREF(C)] PUSHJ P,GEAUTH POPJ P, .CALL [SETZ ? SIXBIT /SAUTH/ ? 1000,,DSKOUT ? SETZ A] JFCL POPJ P, ;MAKE A A CREATION DATE FROM TAPE DATE ALD5: SETZM A PUSH P,B PUSH P,C LDB B,[300400,,THDATE] LDB C,[360400,,THDATE] IMULI C,10. ADD B,C DPB B,[330700,,A] LDB B,[140400,,THDATE] LDB C,[220400,,THDATE] IMULI C,10. ADD B,C DPB B,[270400,,A] LDB B,[000400,,THDATE] LDB C,[060400,,THDATE] IMULI C,10. ADD B,C DPB B,[220500,,A] POP P,C POP P,B POPJ P, ;RELOAD A LINK RETRLK: SKIPE LSTWHL PUSHJ P,LDMUT3 .SUSET [.SSNAM,,HSNM] SKIPE CRDIR .OPEN CRUFD JFCL MOVE A,LFN1 MOVEM A,LNKBLK+1 MOVE A,LFN2 MOVEM A,LNKBLK+2 .OPEN DSKOUT,LNKBLK .LOSE 1400 ;SHOULD SUCCEED, LET DDT HANDLE IT. PUSHJ P,FILSKP ;FLUSH TO EOF SKIPL RELOSW ;IF RELOADING, JRST RETRFN ; WILL HAVE TO RESTORE MISC CRUFT MOVEI A,36 ;DON'T CHASE LINKS, DON'T SET REFD, HRLM A,CPYO ; BLOCK IMAGE INPUT (REOPEN THE LINK) .OPEN DSKOUT,CPYO .LOSE 1400 ;WE JUST PUT IT THERE!! PUSHJ P,RELOAF JRST RETRFN SUBTTL 'OPEN' A MAGTAPE FILE FOR INPUT ; DFHBLK: Set all defaults in HBLK ; DFHDTS: Default dates in HBLK DFHBLK: SETZM HBLK+1 MOVE A,[HBLK+1,,HBLK+2] BLT A,HBLK+LHBLK-1 SETOM HLEN ; Unknown length DFHDTS: SETOM HDATE ; Unknown creation date HRROI A,777000 ; Unknown reference date MOVEM A,HRDATE ; Unknown author, 36. bit bytes POPJ P, MAGOT: PSIS CHNTAB+MAGIN ;LOST PUSHJ P,OPINFL PUSHJ P,CRR MOVEI A,150. ;WAIT FOR SOMEONE TO FIX TAPE DRIVE .SLEEP A, ;DROP THROUGH ;ENTER HERE, NON-SKIP IF EOT. MAGOP: PUSHJ P,DFHBLK ; Set defaults in HBLK SKIPGE TAPTYP ;SKIP IF USING LOCAL DRIVE JRST MAGOP0 ;REMOTE DRIVE STAYS OPEN I GUESS .OPEN MAGIN,MAGI ;OPEN MAG TAPE INPUT (READ HEADERS) JRST MAGOT ;WAIT FOR HIM TO MOUNT TAPE OR REWIND MAGOP0: CLEARM ERRCNT ;RESET ERR COUNT FOR THIS FILE AOSE ITAPE ;SKIP IF BEGINNING OF TAPE JRST ART2 ; ALSO INCREMENTS FILE SEQUENCE NUMBER PUSH P,A SKIPGE TAPTYP PUSHJ P,RMTSTS ;DRAIN QUEUED STATUS POP P,A SETZM THTYPE SETOM THDATE HRROI A,B PUSHJ P,MAGREAD ;READ AOBJN WORD INTO B JRST MAGOP ;ERROR, TRY NEXT FILE TRNE B,-1 JSP D,BDHD ;BAD TAPE-HEADER - AOBJN WORD HAS NON-ZERO RIGHT HALF CAMGE B,[-LTHBLK,,] JSP D,BDHD ;BAD TAPE-HEADER - FIRST RECORD TOO LONG ADD B,[1,,THBLK+1] MOVE A,B PUSHJ P,MAGREAD ;READ TAPE HEADER JRST MAGOP ;ERROR, TRY NEXT FILE HLRZ A,THTPN ;CHECK TAPE NUMBER JUMPN A,ART3 ;IF NON-ZERO THEN IT IS VALID PRINT [TAPE NUMBER ON TAPE IS 0, REAL TAPE NUMBER/NAME=] PUSHJ P,GETSYL JRST .-2 ;SOME SORT OF ERROR, REPROMPT MOVEM SYM,NSVTPN HRLM N,THTPN ART3: PUSHJ P,PTHEAD ;TELL USER WHAT TAPE THIS CLAIMS TO BE ;HERE IF THIS WASN'T THE BEGINNING OF THE TAPE ART2: HRROI A,B PUSHJ P,MAGREAD ;READ ANOTHER WORD, SHOULD BE FILE HEADER AOBJN WD JRST MAGOP JUMPL A,EOTISH ;EOT TRNE B,-1 JSP D,BDHD ;BAD FILE-HEADER - AOBJN WORD NON-ZERO RIGHT HALF CAMGE B,[-LHBLK,,] JSP D,BDHD ;BAD FILE-HEADER - RECORD TOO LONG CAMLE B,[-LHBLKZ,,] JSP D,BDHD ;BAD FILE-HEADER - RECORD TOO SHORT ADD B,[1,,HBLK+1] MOVE A,B PUSHJ P,MAGREAD ;READ USER NAME, FILE NAMES AND PACK NUMBER JRST MAGOP SKIPGE A JSP D,BDHD1 ;BAD FILE-HEADER - NOT ALL THERE SETZM LNKFLG HLRZ B,HPKN SKIPN B ;LINK? (BITS ON IN LH OF PACK NUMBER) JRST MAGOP1 MOVE A,[-3,,LNKNM1] ;YES, READ NAMES LINKED TO PUSHJ P,MAGRDL JRST MAGOP SKIPGE A JSP D,BDHD1 ;BAD FILE-HEADER - LINK NOT ALL THERE SETOM LNKFLG AOS (P) ;TAKE SUCCESS RETURN POPJ P, EOTISH: PRINT E-O-T SETOM EOTFLG SKIPL TAPTYP ;SKIP IF REMOTE TAPE .CLOSE MAGIN, POPJ P, .SCALAR MGRDLF ; Flag for MAGRDL ; Like MAGREAD, but respect length in HLEN. MAGRDL: SKIPGE HLEN JRST MAGREAD ; Length is implicit on old tapes PUSH P,A SETZM MGRDLF PUSHJ P,MAGREAD SETOM MGRDLF EXCH B,(P) MOVEI B,(B) SUBI B,(A) ; B: minus # words read ADDB B,HLEN ; Adjust HLEN JUMPLE B,MAGRDJ ; HLEN exhausted JUMPL A,MAGRDN ; EOF but HLEN promises more... MAGRDX: POP P,B SKIPN MGRDLF AOS (P) POPJ P, .VECTOR MGARB(LMGARB==:40) MAGRDJ: JUMPL A,MAGRDK ; Already at EOF? PUSH P,A MAGRDH: SKIPE MGRDLF ; Errors? JRST MAGRDE ; Yes: Nothing to do MOVE A,[-LMGARB,,MGARB] ; No: Read extra garbage PUSHJ P,MAGREAD SETOM MGRDLF JUMPGE A,MAGRDH ; No EOF yet? Keep reading. MAGRDE: POP P,A MAGRDK: SETZM HLEN ; Nothing left MOVN B,B ; Adjust caller's ptr HRLI B,(B) SUB A,B JRST MAGRDX MAGRDN: SETOM MGRDLF SETOM RDERR SETOM ERRALL AOS ERRCNT PUSH P,LPTSW SETZM LPTSW PRINT _DATA ON TAPE TOO SHORT_ PUSHJ P,TAPN PSIS HSNM PSIS HFN1 PSIS HFN2 PRINT LENGTH ERROR TAPE IN ..FILE BEING SKIPPED.._ POP P,LPTSW JRST MAGRDX ;DO .IOT MAGIN,A AND SKIP IF NO DATA ERROR ;FILE MARK SIGNALLED BY NOT COUNTING OUT THE AOBJN POINTER MAGREA: SETZM RDERR SETZM PHYEOT SKIPGE TAPTYP JRST RMTREA .IOT MAGIN,A SKIPN RDERR AOS (P) POPJ P, RMTREA: PUSH P,B CAMN A,[-1,,B] HRROI A,(P) TRNN A,-20 DIE Program error--RMTREAD can't read into AC's SETOM CTRLG PUSHJ P,RTAPE"READ JRST RMTRER ;Tape error POP P,B AOS (P) JRST CTRLGX ;Remote read error, code similar to INT1 and INT2 RMTRER: PUSHJ P,CTRLGX PUSH P,A PUSH P,D PUSH P,LPTSW ;Error messages on TTY SETZM LPTSW PRINT _TAPE READ ERROR_ PUSHJ P,RTAPE"PRSTS MOVE A,RTAPE"STSFLG ;Classify error TRNE A,RTAPE"F%NLI+RTAPE"F%OFFL+RTAPE"F%EOT JRST ERR ;Non-data error AOS ERRCNT ;Non-recoverable data error SETOM ERRALL PUSHJ P,TAPN PSIS HSNM PSIS HFN1 PSIS HFN2 PRINT DATA ERROR TAPE IN ..FILE BEING SKIPPED.._ TRNN A,RTAPE"F%EOF PUSHJ P,FILSKP ;If not already at EOF, skip file SETOM RDERR POP P,LPTSW POP P,D POP P,B POP P,A POPJ P, ;WRITE BLOCK (NOT RECORD) TO TAPE, AOBJN POINTER IN A MAGWRI: SKIPGE TAPTYP JRST [ SETOM CTRLG ;Remote drive PUSHJ P,RTAPE"WRITE JRST CTRLGX ] .IOT MAGOUT,A ;Local drive POPJ P, ;Come here if write error on remote drive ;during RTAPE"WRITE, RTAPE"FORCE, or RTAPE"WRTFM ;Stack level unpredictable, but not at interrupt level ;All writes pass through ADMP4, which saves state so we can restore it RMTWER: PUSHJ P,CTRLGX PUSH P,LPTSW ;Error messages on TTY SETZM LPTSW MOVE A,RTAPE"STSFLG TRNE A,RTAPE"F%EOT JRST RMTEOT PRINT _TAPE WRITE ERROR_ PUSHJ P,RTAPE"PRSTS PRINT _SIMULATING E-O-T .. RMTEOT: MOVEI A,FOOB ;AH ! I KNOW HOW TO HANDLE END OF TAPE ! SKIPGE FULLDMP JRST INTX1 ;CAUSE PROGRAM TO RESTART AT FOOB DIE _PHYSICAL END OF TAPE ;BAD HEADER, SKIP FILE BDHD: MOVE A,[-3,,HSNM] PUSHJ P,MAGREAD JRST MAGOP ;ERROR BDHD1: PRINT _BAD HEADER PSIS HSNM ;TRY TO TYPE STUFF PAST LOSING HEADER PSIS HFN1 PSIS HFN2 PUSHJ P,CRR PUSHJ P,FILSKP ;FLUSH CURRENT FILE JRST MAGOP ;MAGOP, NOT A LINK MAGOP1: MOVE A,HFN1 MOVE B,HFN2 CAMN A,[SIXBIT /M.F.D./] CAME B,[SIXBIT /(FILE)/] SKIPA JRST MAGOP2 ;READ IN COPY OF MFD CAMN A,[SIXBIT /.FILE./] CAME B,[SIXBIT /(DIR)/] JRST POPJ1 ;AN ORDINARY FILE, TAKE SUCCESS RETURN ;READ IN UFD FROM TAPE SETZM UFDBUF MOVE A,[UFDBUF,,UFDBUF+1] BLT A,UFDBUF+1777 MOVE A,[-UDDESC,,UFDBUF] ;GET HEADER AREA PUSHJ P,MAGRDL JRST MAGOP ;ERROR, FLUSH MOVE A,UFDBUF+UDESCP ;COMPUTE SIZE OF DESCRIPTOR AREA ADDI A,5 IDIVI A,6 MOVNS A HRLS A HRRI A,UFDBUF+UDDESC PUSHJ P,MAGRDL ;READ IN DESCRIPTOR AREA JRST MAGOP ;ERROR, FLUSH MOVE A,UDNAMP+UFDBUF ;COMPUTE SIZE OF NAME AREA SUBI A,2000 HRLS A HRR A,UDNAMP+UFDBUF ADDI A,UFDBUF PUSHJ P,MAGRDL ;READ IN NAME AREA JRST MAGOP ;ERROR, FLUSH MOVE A,HDATE MOVEM A,UFDDAT SKIPGE RELOSW ;IF RELOADING, PUSHJ P,MAGOP3 ; UPDATE DISK DIRECTORY FROM TAPE SKIPGE PDIRSW PUSHJ P,PTUFD ;PRINT UFD FROM TAPE HRRZ A,(P) CAIN A,RLDRD0+1 ;RELOAD RDATES FROM THIS DIR PUSHJ P,RLDRD1 PUSHJ P,FILSKP ;DONE WITH THIS FILE JRST MAGOP ;TRY TO OPEN A REAL FILE PTUFD: PUSH P,C PUSH P,B PUSH P,A PUSH P,W PUSH P,N MOVE C,UFDBUF+UDNAMP ADDI C,UFDBUF PTUFD1: CAIL C,UFDBUF+2000 JRST [ POP P,N POP P,W POP P,A POP P,B POP P,C POPJ P,] SKIPE (C) SKIPN 1(C) JRST PTUFD2 PUSHJ P,CRR MOVE B,UNRNDM(C) TLNE B,UNLINK PASC [ASCIZ /L /] PSIS (C) PSIS 1(C) TLNE B,UNLINK JRST [ PASC [ASCIZ /=>/] LDB B,[UNDSCP+UNRNDM(C)] ; GET FIRST BYTE INDEX PUSH P,B+1 IDIVI B,UFDBYT ADDI B,UFDBUF+UDDESC MOVNI N,-6(B+1) IMULI N,6 HRLI N,60200 ;ASSUMING B=2 !!! ROT N,30. POP P,B+1 PUSHJ P,GETLSL PSIS W ;SNAME PASC [ASCIZ /;/] PUSHJ P,GETLSL PSIS W ;LINK FN1 PUSHJ P,GETLSL PSIS W JRST .+1] PTUFD2: ADDI C,LUNBLK JRST PTUFD1 ;"RELOAD" A DIRECTORY IF IT MATCHES AGAINST THE FILE SPEC LIST MAGOP3: MOVN A,LENGTH HRLZS A MAGOP4: SKIPE B,FMSNM(A) CAMN B,HSNM JRST DIRUPD AOBJN A,MAGOP4 POPJ P, ;READ IN MFD FROM TAPE MAGOP2: MOVE A,[-2000,,MFDBUF] PUSHJ P,MAGRDL JRST MAGOP ;ERROR, FLUSH MOVE A,HDATE MOVEM A,MFDDAT PUSHJ P,FILSKP ;DONE WITH THIS FILE ;GO THROUGH ALL DIRECTORIES IN DISK MFD BUT NOT IN TAPE MFD. ;FOR EACH, SEE IF IT CONTAINS NO 'NEW' FILES. IF SO, OFFER ;TO DELETE IT. ONLY DO THIS WHEN RELOADING, OF COURSE. SKIPL RELOSW JRST MAGOP .CALL [SETZ ? SIXBIT/OPEN/ ? [.BII,,UFDCH] [SIXBIT/DSK/] ? [SIXBIT/M.F.D./] ? SETZ [SIXBIT/(FILE)/]] .LOSE 1400 MOVE A,[-2000,,BUF] .IOT UFDCH,A .CLOSE UFDCH, SKIPA E,BUF+MDNAMP ;POINTS AT DISK MFD MFDUP3: ADDI E,LMNBLK CAIL E,2000 JRST MAGOP ;DONE ALL OF DISK MFD SKIPN A,BUF(E) ;NAME OF A DISK DIR JRST MFDUP3 MOVE D,MFDBUF+MDNAMP ;POINTS AT TAPE MFD MFDUP2: CAIL D,2000 JRST MFDUP4 ;DIR EXISTS ON DISK BUT NOT ON TAPE CAMN A,MFDBUF(D) JRST MFDUP3 ;OK, DIR EXISTS ON BOTH ADDI D,LMNBLK JRST MFDUP2 MFDUP4: .SUSET [.SSNAME,,A] ;THIS DIR IS CANDIDATE FOR DELETION MOVEI A,.BII HRLM A,FNO .OPEN UFDCH,FNO .LOSE 1400 MOVE A,[-2000,,BIF] .IOT UFDCH,A .CLOSE UFDCH, MOVE B,BIF+UDNAMP CAIL B,2000 JRST MFDUP3 ;Directory already empty, ignore CAIA MFDUP5: ADDI B,LUNBLK CAIL B,2000 JRST MFDUP6 MOVE C,UNDATE+BIF(B) CAMLE C,MFDDAT JRST MFDUP3 ;NEW FILE, PRESERVE THE DIR HLLZ C,UNREF+BIF(B) CAMLE C,MFDDAT JRST MFDUP3 ;OLD FILE, BUT NEWLY REFERENCED JRST MFDUP5 MFDUP6: PUSH P,LPTSW SETZM LPTSW PRINT _Directory PSIS BIF+UDNAME PRINT [ exists on disk but not tape and contains only old files.] PRINT [_Shall I delete it? ] PUSHJ P,GETSYL PUSHJ P,CRR POP P,LPTSW CAMN SYM,[SIXBIT/NO/] JRST MFDUP3 CAME SYM,[SIXBIT/YES/] JRST MFDUP6 SKIPA B,BIF+UDNAMP MFDUP7: ADDI B,LUNBLK CAIL B,2000 JRST MFDUP3 .CALL [SETZ ? 'DELETE ? [SIXBIT/DSK/] BIF+UNFN1(B) ? SETZ BIF+UNFN2(B)] .LOSE 1400 JRST MFDUP7 SUBTTL UPDATE DISK DIRECTORY FROM TAPE (RELOAD) DIRUPD: .SUSET [.SSNAM,,UFDBUF+UDNAME] MOVEI A,.BII HRLM A,FNO .OPEN UFDCH,FNO CAIA JRST DIRU0 .SUSET [.RIOS+UFDCH,,A] ;DIR SEEMS NOT TO EXIST LDB A,[220600,,A] CAIE A,20 ;NO SUCH DIRECTORY ERROR CODE .LOSE ;HMM, NEED HUMAN ASSISTANCE SKIPE CRDIR JRST DIRUCR PUSH P,LPTSW SETZM LPTSW PRINT _DIRECTORY PSIS UFDBUF+UDNAME PRINT [ DOES NOT EXIST ON DISK, SHALL I CREATE IT? ] PUSHJ P,TYI MOVE D,A PUSHJ P,CRR POP P,LPTSW CAIE D,"Y POPJ P, ;NOT CREATING IT, GIVE UP DIRUCR: .OPEN UFDCH,CRUFD JFCL ;SHOULD GET FNF JRST DIRUPD ;NOW TRY AGAIN DIRU0: MOVE A,[-2000,,BIF] ;READ DISK COPY INTO COMPARE BUFFER .IOT UFDCH,A .CLOSE UFDCH, MOVE B,BIF+UDNAMP ADDI B,BIF ;B POINTS TO NAME AREA ON DISK COPY MOVEI A,.BII+30 ;DON'T CHASE LINKS BIT, DON'T SET RDATE BIT. HRLM A,TRNI ;DROPS THROUGH ;HERE WE LOOP OVER ALL FILES ON DISK ON THIS DIRECTORY. FOR EACH ONE, ;IF IT IS NOT ON THE TAPE THEN (UNLESS IT IS NEW) WE DELETE IT. ;IF IT IS ON THE TAPE, AND THE TAPE COPY IS NEWER, WE DELETE THE ;DISK FILE TO TRY AND AVOID GETTING DEVICE/DIRECTORY FULL WHEN WE ;TRY AND LOAD IT LATER ON. IF IT SEEMS TO BE THE SAME VERSION ;ON TAPE AND ON DISK, WE UPDATE THE MISCELLANEOUS ATTRIBUTES. ;NOTE THAT THIS LOOP APPLIES TO LINKS AS WELL AS FILES. DIRUPL: CAIL B,BIF+2000 JRST DIRU5 ;PROCESSED WHOLE DIRECTORY MOVE D,(B) MOVE E,1(B) MOVEM D,FN1 MOVEM E,FN2 MOVE A,UNDATE(B) CAMLE A,UFDDAT ;DISK FILE NEWER THAN TAPE, LEAVE IT ALONE JRST DIRUPN HLLZ A,UNREF(B) CAMLE A,UFDDAT ;OLD FILE, BUT RECENTLY REFERENCED, JRST DIRU8 ; SO LEAVE IT ALONE MOVE C,UFDBUF+UDNAMP ADDI C,UFDBUF ;C POINTS TO NAME AREA ON TAPE COPY DIRU1: CAIL C,UFDBUF+2000 ;FIND TAPE COPY IF IT EXISTS JRST DIRU4 CAMN D,(C) CAME E,1(C) JRST DIRU2 SKIPL LDPACK ;DON'T MESS OVER NOW, IF WILL BE RELOADING JRST DIRU8 ;TAPE COPY IN SORRY MODE ANYWAY. MOVE A,UNDATE(B) CAME A,UNDATE(C) JRST DIRU4A ;SAME NAMES, DIFFERENT CREATION DATE, DELETE IT JRST DIRU3 DIRU2: ADDI C,LUNBLK JRST DIRU1 ;FILE DOES NOT EXIST ON TAPE, OR WILL BE LOADED OVER. ;DELETE IT EITHER BECAUSE BEING FLUSHED OR TO MAKE ENOUGH ROOM ;ON DISK AND IN DIR TO ALLOW IT TO BE RELOADED. DIRU4: SKIPN LSTWHL JRST DIRU4A PRINT [DELETE] ;MAKE LISTING LINE FOR FILE REALLY BEING PSIS UFDBUF+UDNAME ;DELETED (I.E. NOT JUST BEING LOADED OVER) PSIS FN1 PSIS FN2 PUSHJ P,CRR DIRU4A: .FDELE TRNI ;DELETE IT FROM DISK JFCL JRST DIRU8 ;SAME NAMES, SAME CREATION DATE. RESTORE OTHER CRUFT. ;WORKS EVEN FOR LINKS SINCE DON'T CHASE LINKS BITS IS SET DIRU3: SETO E, ;FLAG NOT OPENED YET HLLZ A,UNREF(B) HLLZ D,UNREF(C) CAME A,D PUSHJ P,DIRURF ;UPDATE REF DATE LDB A,[UNAUTH+UNREF(B)] LDB D,[UNAUTH+UNREF(C)] CAME A,D PUSHJ P,DIRUAU ;UPDATE AUTHOR LDB A,[430100,,UNRNDM(B)] LDB D,[430100,,UNRNDM(C)] CAME A,D PUSHJ P,DIRUDB ;UPDATE REAPBIT LDB A,[230100,,UNRNDM(B)] LDB D,[230100,,UNRNDM(C)] CAME A,D PUSHJ P,DIRURB ;UPDATE REAP BIT .CLOSE DSKIN, DIRU8: ADDI B,LUNBLK JRST DIRUPL ;FOUND FILE ON DISK NEWER THAN TAPE. DIRUPN: LDB A,[UNPKN+UNRNDM(B)] CAME A,LDPACK JRST DIRU8 ;LEAVE IT LDB A,[UNLNKB+UNRNDM(B)] JUMPN A,DIRU8 ;LINK IS OK JRST DIRU4 ;REALLY GONE, DELETE IT ;GET AUTHOR SIXBIT GIVEN MAGIC NUMBER IN DIRECTORY GEAUTH: SKIPGE MFDDAT ;INDEX IN A, RETURN MFD ENTRY IN A POPJ P, ;MFD NOT IN CORE, CAN'T LOOK IT UP PUSH P,B MOVE B,MDNUDS+MFDBUF SUB A,B LSH A,1 MOVE A,MFDBUF+2000(A) POP P,B AOS (P) POPJ P, ;FILE NOT ALREADY OPEN, OPEN SO CAN UPDATE STUFF DIROPF: OPEN DSKIN,TRNI JRST POP1J POPJ P, POP1J: SUB P,[1,,1] POPJ P, ;UPDATE DUMPCHECK BIT DIRUDB: AOSN E PUSHJ P,DIROPF .CALL DIRSDB JFCL POPJ P, DIRURB: AOSN E PUSHJ P,DIROPF .CALL DIRSRB JFCL POPJ P, DIRURF: AOSN E PUSHJ P,DIROPF .CALL DIRSRF JFCL POPJ P, DIRUAU: MOVE A,D PUSHJ P,GEAUTH POPJ P, AOSN E PUSHJ P,DIROPF .CALL DIRSAU JFCL POPJ P, DIRSAU: SETZ SIXBIT /SAUTH/ 1000,,DSKIN SETZ A DIRSDB: SETZ SIXBIT /SDMPBT/ 1000,,DSKIN SETZ D DIRSRB: SETZ SIXBIT /SREAPB/ 1000,,DSKIN SETZ D DIRSRF: SETZ SIXBIT /SRDATE/ 1000,,DSKIN SETZ D ;SCAN ALL FILES IN TAPE UFD AND MAKE ANY REQUIRED LINKS. ;THE REASON THIS HAS TO BE DONE IS THAT LINKS ARE NOT ;PUT ON INCREMENTAL DUMPS. ;NOTE THAT IF ANY FILE WITH THE SAME NAME EXISTS, DON'T MAKE ; THE LINK SINCE THE FILE WAS LESS WORTHY IT WOULD ; HAVE BEEN DELETED AT DIRU4. DIRU5: MOVE C,UFDBUF+UDNAMP ;SCAN NAME AREA OF TAPE DIRECTORY CAIL C,2000 JRST DIRU7 ;EMPTY ADDI C,UFDBUF DIRU6: MOVE V,UNRNDM(C) TLNE V,UNLINK PUSHJ P,DIRMLK ;MAKE A LINK ADDI C,LUNBLK CAIGE C,UFDBUF+2000 JRST DIRU6 DIRU7: MOVEI A,.BII ;TURN OFF RANDOM BITS IN TRNI HRLM A,TRNI .CLOSE DSKOUT, POPJ P, ;DIRUPD ALL DONE DIRMLK: MOVE W,UNFN1(C) MOVEM W,LNKBLK+1 ;FIRST NAME MOVEM W,FN1 MOVE W,UNFN2(C) MOVEM W,LNKBLK+2 MOVEM W,FN2 MOVEI A,30+.BII ;DON'T CHASE LINKS, DON'T SET REF DATE HRLM A,TRNI .OPEN DSKIN,TRNI ;SEE IF IT EXISTS (EVEN A LINK) CAIA POPJ P, ;YES, DON'T CLOBBER IT LDB B,[UNDSCP+UNRNDM(C)] ; GET FIRST BYTE INDEX PUSH P,B+1 IDIVI B,UFDBYT ADDI B,UFDBUF+UDDESC MOVNI N,-6(B+1) IMULI N,6 HRLI N,60200 ;ASSUMING B=2 !!! ROT N,30. POP P,B+1 PUSHJ P,GETLSL SKIPN W SETOM W ;IN CASE OF ZERO SNAME (?) MOVEM W,LNKBLK+5 ; SNAME PUSHJ P,GETLSL MOVEM W,LNKBLK+3 ; LINK FN1 PUSHJ P,GETLSL MOVEM W,LNKBLK+4 ;; POP P,B Good joke flushed by Alan 12/22/87 .OPEN DSKOUT,LNKBLK ;MAKE THE LINK .LOSE 1400 ;HMM, NOT SUPPOSED TO HAVE TROUBLE .CALL [SETZ ? 'SFDATE ? MOVEI DSKOUT ? SETZ UNDATE(C)] JFCL JRST RELOF2 ;UPDATE MISC ATTRIBUTES SUBTTL PRINT TAPE HEADER PTHEAD: PRINT TAPE NO HLRZ A,THTPN PDPT A SKIPE A ;DON'T CONVERT IF TAPE NUMBER IS ZERO MOVE C,[440600,,NSVTPN] PUSHJ P,SIXNUM PRINT CREATION DATE PSIS THDATE PUSHJ P,CRR SKIPN THTYPE POPJ P, PRINT REEL NO HRRZ B,THTPN PDPT B SKIPGE THTYPE PRINT OF INCREMENTAL DUMP SETZM NPLACE PUSHJ P,SNPLAC SKIPLE THTYPE PRINT OF FULL DUMP JRST CRR SIXNUM: IDIVI A,12 ;CREATES SIXBIT FILE NAME FROM CONTENTS OF A PUSH P,B ;C INITIALLY SHOULD CONTAIN 440600,,LOC CAIE A,0 PUSHJ P,SIXNUM POP P,A ADDI A,20 IDPB A,C POPJ P, SUBTTL CHECKING OF DUMP TAPES, SETTING HAS-BEEN-DUMPED BITS ;ENTER HERE FROM END OF TAPE DURING AN INCREMENTAL DUMP ICHECK: PUSHJ P,MAGOP JRST ICKEOT .SUSET [.SSNAM,,HSNM] MOVE A,HSNM CAMN A,LUSNM JRST ICKEOT ;DON'T CHECK LAST USER (SO I DUMP CONTINUES ON NEXT TAPE WITH FULL USER) MOVE A,HFN1 MOVEM A,FN1 MOVE A,HFN2 MOVEM A,FN2 MOVEI A,10+.BII ;DON'T SET RDATE BIT HRLM A,TRNI .OPEN DSKIN,TRNI JRST ICK1 .CALL RDATE JFCL MOVE A,FDATE CAME A,HDATE JRST ICK1 ;BEEN CHANGED SINCE MOVE A,[ICKLP,,D] ;RUN LOOP IN ACS IF NOT KL10 BLT A,D+ICKLPL-1 SETZ A, BLT A,0 JUMPN A,ICK2 ;JUMP IF KL10 HRRI TER,D ;CLOSE LOOP ICK2: MOVE A,[-2000,,BUF] .IOT DSKIN,A PUSH P,A MOVE A,[-2000,,BIF] PUSHJ P,MAGRDL JRST ICKER2 ;ERROR MOVE B,A POP P,A SUBI B,BIF-BUF CAME A,B JRST ICKERR CAMN A,[-2000,,BUF] JRST ICK4 PUSH P,A HLLZ B,A MOVE A,[-2000,,BUF] SUB A,B JRST (TER) ;TO CHECKING LOOP IN ACS OR CACHE ICK3: POP P,A SKIPL A JRST ICK2 ;GET ANOTHER BLOCK ICK4: MOVE A,[400000,,DSKIN] .DMPCH A, MOVE A,HSNM CAME A,[SIXBIT /VANISH/] JRST ICK1 .FDELE TRNI JFCL ICK1: .CLOSE DSKIN, PUSHJ P,FILSKP JRST ICHECK ICKLP: MOVE B,(A) ;D MOVE C,BIF-BUF(A) ;E CAME B,C ;N JRST ICKER1 ;SYM AOBJN A,ICKLP ;TER (RH MODIFIED TO D IF PUT INTO ACS) JRST ICK3 ;U ICKLPL==.-ICKLP ICKER1: POP P,A ICKERR: JRST ICK1 ICKER2: POP P,A .CLOSE DSKIN, JRST ICHECK ICKEOT: POPJ P, ;LCHECK COMMAND ALCHEC: SETOM PNTALL JRST ACHEK1 ;ICHECK COMMAND AICHEC: PUSHJ P,ICHECK JRST RET ;CHECK COMMAND ACHECK: CLEARM PNTALL ACHEK1: SETOM SUPERC ;SUPPRESS DATA ERROR COMMENTS CLEARM MICFLG SETOM CHKFLG .CORE CORSIZ+1 JRST .-1 PUSHJ P,DEVGET ;CRUDE FILE CHECKER CLEARM ALLWRD ;RESET TOTAL NUMBER OF WORDS FOR THIS REEL SKIPN MICFLG MOVEI A,(SIXBIT /DSK/) HRRM A,TRNI ACHUCK: PUSHJ P,MAGOP ;OPEN NEXT TAPE FILE JRST ACHIND ;END-OF-TAPE .SUSET [.SSNAME,,HSNM] MOVE A,HFN1 MOVEM A,FN1 MOVE A,HFN2 MOVEM A,FN2 CLEARM WRDCNT CLEARM LNTCNT CLEARM WRDONG CLEARM ERRALL CLEARM ERRCNT ;RESET # OF TAPE IOCS CLEARM ERRDSK ;RESET # OF DISK IOCS SKIPE LNKFLG JRST ACHUF3 MOVEI A,10+.BII ;DON'T SET RDATE BIT HRLM A,TRNI .OPEN DSKIN,TRNI JRST DSKOPL SETOM NEWCHR SKIPE MICFLG JRST ACHUF1 MOVEI A,DSKIN .DMPCH A, MOVEM A,NEWCHR ACHUF1: MOVE A,[-2000,,BUF] .IOT DSKIN,A HRLOI B,-BUF-1(A) EQVI B,BUF ;AOBJN POINTER 1 SKIPGE A .CLOSE DSKIN, PUSH P,A MOVE A,[-2000,,BIF] PUSHJ P,MAGRDL JRST ACHUF4 MOVE C,A POP P,A HRLOI D,-BIF-1(C) EQVI D,BIF ;AOBJN POINTER 2 SKIPL A SKIPGE C PUSHJ P,FILSKP PUSHJ P,COMPAR ;COMPARE THE TWO BUFFERS HRRZI D,-BIF(C) ADDM D,WRDCNT SKIPL A JUMPGE C,ACHUF1 ;MORE TO COME JRST ACHUF2 ;LOSSAGE ACHUF2: SKIPN PNTALL SKIPE ERRALL SKIPA JRST CHKT5 PUSHJ P,LOUSZ CHKT6: PDPT WRDCNT PRINT WORD SOSE WRDCNT PRINT S SKIPN WRDCNT PRINT CHKT5: SKIPN WRDONG JRST CHKT4 PDPT WRDONG PRINT BAD WORD SOSE WRDONG PRINT S SKIPN WRDONG PRINT PRINT AT PDPT SAVAOB .CLOSE DSKIN, CHKT4: MOVE A,WRDCNT ADDM A,ALLWRD SKIPN V,LNTCNT JRST CHKT7 MOVM W,V PDPT W SKIPL V PRINT LONGER SKIPG V PRINT SHORTER PRINT ON DISK CHKT7: SKIPN ERRCNT JRST CHKTA PDPT ERRCNT PRINT *TAPE IOC SOSE ERRCNT PRINT S SKIPN ERRCNT PRINT PRINT * CHKTA: SKIPN ERRDSK JRST CHKTB PDPT ERRDSK PRINT *DISK IOC SOSE ERRDSK PRINT S SKIPN ERRDSK PRINT PRINT * CHKTB: SKIPN PNTALL SKIPE ERRALL PRINT ! JRST ACHUCK ACHUF3: PUSHJ P,FILSKP JRST ACHUF2 ACHUF4: POP P,A JRST ACHUF2 LOUSZ: PUSHJ P,LOUSY JFCL SKIPE MICFLG POPJ P, SKIPN NEWCHR PRINT NEW SKIPE NEWCHR PRINT POPJ P, DSKOPL: PUSHJ P,LOUSY JFCL PUSHJ P,OPINFL SETOM ERRALL PUSHJ P,CHKT3 ;FLUSH TAPE FILE JRST CHKT6 CHKT3: PUSH P,A MOVE A,[-2000,,BIF] PUSHJ P,MAGRDL JRST POPAJ MOVE C,A POP P,A HRRZI D,-BIF(C) ADDM D,WRDCNT JUMPGE C,CHKT3 PUSHJ P,FILSKP POPJ P, ACHIND: .CORE CORSIZ JRST .-1 .CLOSE DSKIN, .CLOSE MAGIN, PRINT _ REEL = HRRZ A,THTPN PDPT A PRINT HAS PDPT ALLWRD PRINT WORDS__ POPJ P, COMPAR: MOVE U,B MOVE V,D MOVE W,U XOR W,V TLNE W,-1 JRST DSKUNC COMPA0: JUMPGE U,CPOPJ JUMPGE V,CPOPJ COMPA1: MOVE W,(U) CAME W,(V) JRST WRNWRD COMPA2: AOBJN U,.+2 POPJ P, AOBJN V,COMPA1 POPJ P, WRNWRD: SKIPN WRDONG ;FIRST LOSSAGE ? PUSHJ P,WRNWR1 AOS WRDONG JRST COMPA2 WRNWR1: HRRZ W,U SUBI W,BUF ADD W,WRDCNT MOVEM W,SAVAOB POPJ P, DSKUNC: HLRES U HLRES V SUB V,U ADDM V,LNTCNT SETOM ERRALL MOVE U,B MOVE V,D JRST COMPA0 SUBTTL RESTORE REFERENCE DATES ;START NORMALLY, THEN ^Z AND START AGAIN HERE ;DON'T TRY TO USE THIS DUMP JOB FOR ANYTHING ELSE! RLDRDT: PRINT RESTORE REFERENCE DATES FROM TAPE WHEN CURRENT RDATE IS - PUSHJ P,GETDAT HLLZS DATE MOVEI A,%DONRF+%DONLK+.UAI HRLM A,TRNI RLDRD0: PUSHJ P,MAGOP ;OPEN TAPE JRST MLP ;END OF TAPE PUSHJ P,FILSKP ;ADVANCE TO NEXT FILE JRST RLDRD0 ;CALLED BY MAGOP IF DIRECTORY SEEN RLDRD1: .SUSET [.SSNAME,,UFDBUF+UDNAME] PUSHJ P,CRR PSIS UFDBUF+UDNAME SKIPA U,UFDBUF+UDNAMP RLDRD2: ADDI U,LUNBLK CAILE U,1777-4 POPJ P, ;END OF NAME AREA MOVE A,UFDBUF+UNFN1(U) MOVEM A,FN1 MOVE A,UFDBUF+UNFN2(U) MOVEM A,FN2 OPEN DSKIN,TRNI ;OPEN DISK INPUT JRST RLDRD2 ;FILE DOESN'T SEEM TO EXIST ANY MORE .CALL RRDATE .LOSE %LSFIL HLLZ A,RFDATE CAME A,DATE JRST RLDRD3 .CALL [ SETZ ? 'SRDATE ? MOVEI DSKIN ? SETZ UFDBUF+UNREF(U)] .LOSE %LSFIL RLDRD3: .CLOSE DSKIN, JRST RLDRD2 SUBTTL LOCAL TO REMOTE TAPE COPY ;START NORMALLY, GIVE REMOTE COMMAND, THEN ^Z AND START AGAIN HERE TCOPY: MOVE A,TAPTYP AOJL A,.+2 DIE You must use the REMOTE command to specify tape server host first PRINT _Mount input tape on local drive and blank output tape on remote drive. SETZM DMPMOD SETOM TCOPYF SETOM OTAPE ;Start of output tape TCOPY0: PRINT [_Type OK when ready. ] PUSHJ P,GETSYL JRST .-1 TCOPY1: SETOM ITAPE ;Start of input tape PUSHJ P,RMTSTS ;Make sure it's mounted (this also TRNN A,TF%RDY ; drains queued status) DIE OUTPUT TAPE NOT MOUNTED PUSHJ P,SETIT4 ;Get status of local drive TRNE A,TF%BOT JRST TCOPY3 PRINT [_Rewind input tape? ] PUSHJ P,YESNO JRST TCOPY3 MOVEI A,1 PUSHJ P,LCLOPR TCOPY3: PUSHJ P,DFHBLK ; Set defaults in HBLK ;; Start copying a file SETOM EOFF OPEN MAGIN,MAGI JRST NAUGHT TCOPY4: SETZM RDERR SETZM PHYEOT MOVE C,[-2000,,BUF] ;Copy next block of file .IOT MAGIN,C SKIPE RDERR JRST TCOPY9 ;File cannot be read PUSH P,C ;Save post-input aobjn pointer MOVEI B,BUF ;Pointer to next header input HRLOI A,-BUF-1(C) EQVI A,BUF ;Aobjn pointer for output AOSE EOFF ;See if first record in file JRST TCOPY6 ;No, this is the middle of a file CAMN C,[-2000,,BUF] JRST TCOPY7 ;Logical end of tape AOSE ITAPE ;See if first file on tape JRST TCOPY5 MOVE D,(B) ;First word on tape TRNN D,-1 ;Skip if bad header CAMGE D,[-LTHBLK,,] ;Skip if good header JRST TCOPY5 MOVSI C,1(B) ;Save tape header HRRI C,THBLK+1 BLT C,THBLK+LTHBLK-1 HLRO C,D MOVN C,C ;Number of words in tape header ADDI B,(C) ;Advance over tape header HRL C,C AOSE OTAPE ;See if first file on output tape ADD A,C ;No, skip over tape header on output TCOPY5: MOVE D,(B) ;File header TRNN D,-1 ;Skip if bad header CAMGE D,[-LHBLK,,] ;Skip if good header JRST TCOPY6 CAMLE D,[-LHBLKZ,,] ;Skip if good header JRST TCOPY6 MOVSI B,1(B) ;Save file header for error messages HRRI B,HBLK+1 BLT B,HBLK+LHBLK-1 TCOPY6: JUMPGE A,TCOP6A ;Jump if empty record PUSHJ P,MAGWRI AOS OTAPE ;Something has been written TCOP6A: POP P,C ;Recover post-input aobjn pointer JUMPGE C,TCOPY4 ;Jump unless EOF PUSHJ P,AEOF ;Write EOF mark on tape JRST TCOPY3 ;Copy next file ;Physical end of tape reached TCOP7A: AOSE EOFF ;See if first record in file PUSHJ P,AEOF ;No, close off that partial file TCOPY7: PRINT _End of tape._ MOVEI A,2 ;Rewind and unload the input tape PUSHJ P,LCLOPR PRINT [Copy another tape onto same output tape? ] PUSHJ P,YESNO JRST TCOPY8 PRINT _Mount next input tape on local drive. JRST TCOPY0 TCOPY8: PUSHJ P,CLSOUT ;Write logical EOT PUSHJ P,AUNLD ;Then unload the output tape JRST TCOPY ;File cannot be read -- system won't let us see the bad data either TCOPY9: SKIPE PHYEOT JRST TCOP7A AOSE EOFF ;See if first record in file JRST TCOP9A ;No AOS ITAPE ;For file header that could not be read AOSE OTAPE ;See if first file on output tape JRST TCOPY3 ;No, don't copy this file at all SETZM THTPN ;Write dummy header since real header SETZM THDATE ;could not be read SETZM THTYPE MOVE A,[-LTHBLK,,THBLK] PUSHJ P,MAGWRI JRST TCOPY3 ;Don't copy file, just tape header TCOP9A: SETZM BUF ;Substitute one block of nulls for rest of file MOVE A,[BUF,,BUF+1] BLT A,BUF+1777 MOVE A,[-2000,,BUF] PUSHJ P,MAGWRI PUSHJ P,AEOF ;Write EOF mark on tape JRST TCOPY3 ;Copy next file ;Skip if YES PRINT [ Please type YES or NO: ] YESNO: PUSHJ P,GETSYL JRST YESNO-1 CAMN SYM,[SIXBIT/YES/] AOSA (P) CAMN SYM,[SIXBIT/NO/] POPJ P, JRST YESNO-1 SUBTTL REMOTE TAPE SUPPORT $$CHAOS==1 $$HOSTNM==1 $$SYMLOOK==1 $$HSTMAP==1 $$CONNECT==1 .INSRT SYSNET;NETWRK > NETWRK"DEBUG: 0 ;NETWRK wants this for some reason .BEGIN RTAPE ;Remote Tape Package comment \ --- stuff remaining to do Problems convincing old server to disconnect from drive sometimes. Attempts to create new server say drive is still busy (using HT). Unix (Hermes) appears to have a wonderful bug where if you write a tape, rewind it, read a bunch, and then lose the network connection, it writes two eof marks wherever the tape happened to be positioned. Thanks a lot. Hermes drive tries really hard to screw you by setting the density to 6250, even though I tell it in the mount command to use 1600. When you mount the tape the drive's 1600 light is lit, but then when you walk away it switches to 6250. Try making sure the "sys sel" light is not on. VMS (Pygmalion) doesn't allow writing short records and also gives an error status at logical end of tape. CORE DUMP MODE IN ITS SERVER DUE TO BLOCK SIZE PROBLEMS ?? DUMP never seems to want to call CLOSE Should fix ILDB/IDPB loop in SIOKT to use KLH unaligned byte move which I think can be found in SYSENG;FSCOPY Perhaps this can be finessed by knowing what the alignment of the system's buffers probably is and aligning my own buffer correspondingly. Or just do my own packetizing, this will never run over TCP The old code certainly spent essentially all its time at SIOKS3 So I put in my own packetizing for output and the speed is slow but no longer pitifull. I fixed my byte copying routine, the next culprit is data reformatting in the Chaosnet interrupt routines. WRTFM should not need to force a packet out to the network, but that's how my modularity is right now. \ DEFINE PUSHAE AC,LIST IRP LOC,,[LIST] PUSH AC,LOC TERMIN TERMIN DEFINE POPAE AC,LIST IRP LOC,,[LIST] POP AC,LOC TERMIN TERMIN DEFINE PRTERR REASON DIE [Remote-Tape protocol error--REASON] TERMIN ;Remote Tape Protocol Definitions ;User to Server Opcodes RT%LGI==1 ;Login username password RT%MNT==2 ;Mount direction reelid drive blocksize density norewind RT%PRB==3 ;Probe uid (2 bytes) RT%RD==4 ;Read n-records (ascii decimal); no arg means read continuous RT%WRT==5 ;Record RT%RWD==6 ;Rewind RT%SYN==7 ;Rewind-sync RT%UNL==8 ;Rewind-unload RT%SPF==9 ;Space-file n-files (ascii decimal) RT%SPR==10. ;Space-record n-records (ascii decimal) RT%WFM==12. ;Write-file-mark RT%CLS==13. ;Close ;Server to User Opcodes RT%LGR==33. ;Login-response code message-string RT%DTA==34. ;Read-data RT%RFM==35. ;Read-file-mark RT%STS==36. ;Status ;Storage for decoded status, second word of each is byte length STSVER: 1 ? 1 ;Protocol version number STSUID: 0 ? 2 ;Probe unique ID, 0 if unsolicited STSNRD: 0 ? 3 ;Number of records read STSNSK: 0 ? 3 ;Number of objects skipped (?) STSNWD: 0 ? 3 ;Number of writes discarded STSLOP: 0 ? 1 ;Last non-probe opcode received STSDEN: 0 ? 2 ;Density in bits per inch STSRTR: 0 ? 2 ;Retries (?) STSDRV: BLOCK 4 ;Asciz drive name STSFLG: 0 ;Word of flag bits F%SOL==1 ;Solicited flag F%BOT==2 ;Beginning of tape F%EOT==4 ;Past end of tape F%EOF==10 ;EOF encountered in read F%NLI==20 ;Not logged in error F%MNT==40 ;Mounted F%STRG==100 ;Explanatory string follows status F%HER==200 ;Hard error encountered F%SER==400 ;Soft error encountered F%OFFL==1000 ;Offline F%NREC==2000 ;Non-record-oriented device STATUS: BLOCK 20 ;Most recent explanatory string, asciz UIDG: 0 ;Unique ID generator RDAHD: 0 ;0 idle, 1 reading, -1 stopped with exception, ; -2 stopped at file mark MXRECW==2000 ;Maximum record length in words MXRECB==MXRECW*5 ;Maximum record length in bytes BUFFER: BLOCK /4 ;Can hold biggest record (32-bit words) BUFCNT: 0 ;Number of 32-bit words sitting in buffer BUFPNT: 0 ;Number of words already taken out RESBUF: BLOCK 4 ;Residue of record (36-bit words) RESBFC: 0 ;Number of 36-bit words in RESBUF RESBFP: 0 ;Number of words already taken out MXSTSB==200 STSBUF: BLOCK MXSTSB/4 ;Buffer for status records ;Probe for status of remote drive ;Clobbers all registers, returns flags in D PROBE: PUSHJ P,SPROBE ;Send probe command PROBE7: PUSHJ P,LISTEN ;Read a response, waiting if necessary PUSHJ P,PROBE0 MOVE T,UIDG ;Verify that it isn't stale CAME T,STSUID JRST PROBE7 ;Try again POPJ P, ;OK SPROBE: AOS D,UIDG ;Get a unique ID DPB D,[341000,,STSBUF] ;Send it LSB first LSH D,-8 DPB D,[241000,,STSBUF] MOVEI A,RT%PRB MOVE B,[440800,,STSBUF] MOVEI C,2 JRST RSXMTF ;Listen for status, read it and skip return if there is any LISTEN: .CALL [ SETZ ? 'WHYINT ? MOVEI RSICH ? MOVEM T ? MOVEM T ? SETZM T ] .LOSE %LSFIL TLNN T,-1 ;Network input available? POPJ P, ;No, exit MOVE B,[440800,,STSBUF] MOVEI C,MXSTSB PUSHJ P,RSRCV ;Yes, read it into status buffer CAIE A,RT%STS JRST LISTEN ;Ignore any input other than Status AOS (P) ;Skip return JRST PROBE1 ;Read a status record PROBE0: MOVE B,[440800,,STSBUF] MOVEI C,MXSTSB PUSHJ P,RSRCV ;Should be status, response or unsolicited CAIE A,RT%STS JRST PROBE0 ;Something else, discard it ;Process a status record already received PROBE1: MOVEI A,STSVER ;Read status into here PROBE2: MOVE T,1(A) ;Number of bytes in this field SETZB D,(A) ;Accumulate field here, least significant first PROBE3: ILDB TT,B LSH TT,(D) ADDI D,8 IORM TT,(A) SOJG T,PROBE3 ADDI A,2 CAIE A,STSDRV JRST PROBE2 ILDB T,B ;Number of valid characters in drive name MOVEI D,16. ;Number of allocated characters in drive name HRLI A,440700 PROBE4: ILDB TT,B SOSGE T MOVEI A,0 IDPB TT,A SOJG D,PROBE4 IDPB D,A ;Ensure asciz termination ILDB D,B ;First byte of flags ILDB T,B ;Second byte of flags LSH T,8 IOR D,TT ;Leave flags in D for caller MOVEM D,STSFLG SUBI C,36. ;Number of bytes of status SKIPGE C PRTERR status record too short TRNN D,F%STRG ;Explanatory string follows? JRST PROBE6 MOVE A,[440700,,STATUS] ;Yes, swallow it PROBE5: ILDB T,B PROB5A: CAME A,[100700,,STATUS+20] IDPB T,A CAIN T,215 JRST [ MOVEI T,12 ? JRST PROB5A ] SOJG C,PROBE5 IDPB C,A IFN 0,[ ;temporary code not needed any more I think PUSH P,LPTSW SETZM LPTSW PRINT _REMOTE TAPE STATUS= PASC STATUS PRINT _ POP P,LPTSW ];IFN 0 PROBE6: MOVE A,STSVER CAIE A,1 PRTERR wrong protocol version number POPJ P, ;Done reading status, flags in D ;Print remote tape status most recently read PRSTS: PUSH P,A PRINT Remote tape status= PASC STATUS SKIPE STATUS PUSHJ P,CRR MOVE A,STSFLG TRNE A,F%BOT PRINT [BOT ] TRNE A,F%EOT PRINT [EOT ] TRNE A,F%EOF PRINT [EOF ] TRNE A,F%NLI PRINT [Not-logged-in ] TRNN A,F%MNT PRINT [Not-mounted ] TRNE A,F%HER PRINT [Hard-error ] TRNE A,F%SER PRINT [Soft-error ] TRNE A,F%OFFL PRINT [Offline ] POP P,A POPJ P, ;Random tape operations, none wait for completion UNLOAD: SKIPA A,[RT%UNL] REWIND: MOVEI A,RT%RWD RSXMT0: MOVEI C,0 MOVE B,[440800,,BUFFER] ;SIOT checks bp even though count is 0 JRST RSXMTF CLOSE: SKIPA A,[RT%CLS] WRTFM: MOVEI A,RT%WFM ;write file mark PUSHJ P,FORCE ;first force buffered output JRST RSXMT0 SKPREC: SKIPA A,[RT%SPR] ;B has signed number of records/files to skip SKPFL0: MOVEI A,RT%SPF MOVE T,B MOVE B,[440800,,BUFFER] MOVEI C,0 PUSHJ P,CMDN0 MOVE B,[440800,,BUFFER] PUSHJ P,RSXMTF POPJ P, CMDN0: JUMPGE T,CMDN1 MOVNS T MOVEI TT,"- IDPB TT,B ADDI C,1 CMDN1: IDIVI T,10. PUSH P,TT SKIPE T PUSHJ P,CMDN1 POP P,TT ADDI TT,"0 IDPB TT,B AOJA C,CPOPJ ;wait for completion of pending I/O ;skip return unless tape error FINISH: PUSHAE P,[A,B,C,D,E] PUSHJ P,PROBE ;By the time this answers, should be done TRNN D,F%EOT+F%NLI+F%HER+F%OFFL ;Serious error? AOS -5(P) ;No, take skip return POPAE P,[E,D,C,B,A] POPJ P, ;Read data in core-dump mode into buffer addressed by aobjn pointer in A ;A is advanced ;Skip return unless tape error ;File mark signalled by not fully counting-out A ;Record boundaries are invisible at this level READ: PUSHAE P,[B,C,D,E,T,TT] READ0: SKIPN RESBFC ;Collect residue if any is present JRST READ1 AOS B,RESBFP MOVE T,RESBUF-1(B) MOVEM T,(A) CAML B,RESBFC SETZM RESBFC ;Residue exhausted AOBJN A,READ0 JRST READ8 ;No more data required READ1: SKIPN C,BUFCNT ;Have a buffered record? JRST READ6 ;No, get one SUB C,BUFPNT ;Number of words not yet read IDIVI C,5 ;Number of 4-word blocks available MOVE B,BUFPNT HLRE T,A MOVN T,T LSH T,-2 ;Number of complete 4-word blocks wanted CAMLE C,T MOVE C,T ;Number of 4-word blocks to do JUMPE C,READ2 ;Jump if no bulk conversion possible PUSHJ P,RDCNV ;Copy data, advance A and B JUMPGE A,READ8 ;Destination buffer exhausted JRST READ1 ;Get more data READ2: PUSH P,A ;Fill residue buffer MOVEI A,RESBUF SETZM RESBFP MOVE C,BUFCNT SUB C,BUFPNT LSH C,2 ;Number of bytes available IDIVI C,5 ;Convert to words CAILE C,4 ;At most 4 words residue MOVEI C,4 MOVEM C,RESBFC MOVEI C,1 ;Translate one 4-word block PUSHJ P,RDCNV POP P,A JRST READ0 ;Collect residue READ6: SKIPGE T,RDAHD ;Read-ahead stopped due to exception? JRST [ AOJL T,READ8 ;EOF simply terminates the data JRST READ9 ] ;Anything else takes failure return PUSH P,A JUMPG T,READ7 ;Jump if read-ahead already in progress MOVEI A,RT%RD ;Initiate read-ahead PUSHJ P,RSXMT0 AOS RDAHD READ7: SETZM BUFPNT PUSHJ P,RSRCVB ;Receive next record from server MOVE T,A ;Opcode of record received POP P,A ;Recover aobjn pointer CAIN T,RT%DTA JRST [ ADDI C,3 LSH C,-2 ;Number of words, rounded up MOVEM C,BUFCNT ;Buffer now contains data JRST READ1 ] CAIN T,RT%STS JRST [ SETZM RDAHD ;Read-ahead has terminated PUSH P,A PUSHJ P,PROBE1 ;Swallow the status record B points to POP P,A TRNE D,F%NLI+F%HER+F%OFFL ;Serious error? SETOM RDAHD ;Yes, note exception has occurred JRST READ6 ] ;Consider current status again CAIE T,RT%RFM PRTERR [record type other than data, read-file-mark, or status] SETCMM RDAHD ;Filemark read, set RDAHD to -2 READ8: AOS -6(P) ;Success return READ9: POPAE P,[TT,T,E,D,C,B] POPJ P, ;Translate from 32-bit words to 36-bit words ;A - destination aobjn pointer ;B - source index in BUFFER ;C - number of 4-word blocks ;Arguments get advanced, T,TT are clobbered RDCNV: DMOVE T,BUFFER(B) ;First two 32-bit words LSH T,-4 ;Right-align first four bytes LSH TT,4 ;Flush 4 bits out of fifth byte LSHC T,4 ;First 36-bit word MOVEM T,(A) LSH TT,-12. ;Right-align bytes 6-8 MOVE T,BUFFER+2(B) ;Third 32-bit word ROTC T,8 ;TT has bytes 6-9 right-aligned LSH T,4 ;Flush 4 bits out of 10th byte ROTC T,4 ;Second 36-bit word in TT MOVEM TT,1(A) ROT T,16. ;Right align bytes 11-12 MOVE TT,BUFFER+3(B) ;Fourth 32-bit word LSHC T,16. ;T has bytes 11-14 right aligned LSH TT,4 ;Flush 4 bits out of 15th byte ROTC T,4 ;Third 36-bit word in T MOVEM T,2(A) LSHC T,8 ;Right align byte 16 MOVE TT,BUFFER+4(B) ;Bytes 17-20 ROTC T,-12. ;Right align bytes 17-19 in TT LSH T,4 ;Flush 4 bits out of 20th byte ROTC T,4 ;Fourth 36-bit word in TT MOVEM TT,3(A) ADD A,[4,,4] ADDI B,5 SOJG C,RDCNV MOVEM B,BUFPNT CAML B,BUFCNT SETZM BUFCNT ;Source buffer exhausted POPJ P, ;Terminate read-ahead ;--- Doesn't try to count records/files read ahead ;--- Unclear who is supposed to call this in that case STOP: SKIPLE RDAHD PUSHJ P,PROBE ;This should stop it SETZM RDAHD POPJ P, ;Skip rest of file, interacting properly with read-ahead SKPFIL: PUSHAE P,[A,B,C,D,T,TT] SKIPGE B,RDAHD AOJL B,SKPFL9 ;Pass by file mark already read JUMPLE B,SKPFL8 ;Send space-file command to drive ;Readahead in progress. Server may have already read up to file mark, ;but not past it. Send a probe so server shuts down, then swallow ;remaining readahead. PUSHJ P,RDSTOP JRST SKPFL9 ;File-mark seen SKPFL8: MOVEI B,1 ;Space one file PUSHJ P,SKPFL0 ;File mark not seen in readahead, so space-file SKPFL9: SETZM RDAHD ;No matter what path we take, read-ahead is off POPAE P,[TT,T,D,C,B,A] POPJ P, RDRST: PUSHAE P,[A,B,C,D,T,TT] SKIPLE RDAHD PUSHJ P,RDSTOP SETZM RDAHD PUSHJ P,BUFRST JRST SKPFL9 ;Reset buffers BUFRST: SETZM BUFCNT SETZM RESBFC POPJ P, ;Send a probe so server shuts down, then swallow remaining readahead. ;Skip return unless file mark seen during swallowed readahead. RDSTOP: PUSHJ P,SPROBE ;Tell server to stop PUSHJ P,BUFRST ;Flush partially read input record PUSH P,[0] ;Initialize file-mark-seen flag RDSTP1: PUSHJ P,RSRCVB ;Receive next record from server CAIN A,RT%DTA JRST RDSTP1 ;Ignore data records CAIN A,RT%RFM JRST [ SETOM (P) ;File mark seen JRST RDSTP1 ] CAIE A,RT%STS PRTERR [record type other than data, read-file-mark, or status] PUSHJ P,PROBE1 ;Swallow status record MOVE T,UIDG ;Verify that it isn't stale CAME T,STSUID JRST RDSTP1 ;Another status should be incoming SKIPN (P) AOS -1(P) ;No file-mark seen SETZM RDAHD ;Read-ahead has been terminated JRST POP1J ;WRITE -- write core-dump mode data, AOBJN pointer in A ;Record boundaries are invisible at this level ;Aobjn pointer in A is advanced ;Clobbers no registers ;Abnormal exit: tape error jumps to RMTWER WRITE: PUSHAE P,[B,C,D,E,T,TT] SKIPN C,RESBFC ;If there is residue, append to it JRST WRITE2 WRITE1: MOVE T,(A) ;Copy into RESBUF until it is full or MOVEM T,RESBUF(C) ; aobjn pointer counts out AOS C,RESBFC CAIGE C,4 AOBJN A,WRITE1 JUMPGE A,WRITE9 ;Did not fill up residue buffer AOBJN A,.+1 ;Filled residue buffer, adjust aobjn pointer PUSH P,A MOVEI A,RESBUF ;Send off the residue MOVEI C,1 PUSHJ P,WRICNV SETZM RESBFC CAIL B,MXRECB/4 ;If buffer is now full, PUSHJ P,FORCE1 ; send off that record POP P,A ;Recover aobjn pointer WRITE2: HLRE C,A ;Minus count of words remaining MOVN C,C ;Positive count TRZ C,3 ;Round down to multiple of 4 words JUMPE C,WRITE7 ;Jump if only a residue remains MOVE T,BUFCNT IDIVI T,5 ;Number of 4-word blocks already in buffer LSH T,2 ADD T,C CAILE T,MXRECW SUBI C,-MXRECW(T) ;Whole transfer cannot be accomodated HRL C,C ;Number of words to do in both halves PUSH P,A ;Save and advance aobjn pointer ADDM C,(P) HRRZ C,C ;Compute number of 4-word blocks to do LSH C,-2 PUSHJ P,WRICNV ;Convert that much CAIL B,MXRECB/4 ;If buffer is now full, PUSHJ P,FORCE1 ; send off that record POP P,A ;Recover aobjn pointer JUMPL A,WRITE2 ;Jump if there is more to do WRITE7: JUMPGE A,WRITE9 ;Not even a residue remains WRITE8: MOVE T,(A) ;Copy residue into buffer MOVEM T,RESBUF(C) AOS C,RESBFC AOBJN A,WRITE8 WRITE9: POPAE P,[TT,T,E,D,C,B] POPJ P, ;FORCE -- force buffered output, if any, as a short record ;Clobbers no registers ;Abnormal exit: tape error jumps to RMTWER FORCE: PUSHAE P,[A,B,C,D,E,T,TT] SKIPN BUFCNT SKIPE RESBFC PUSHJ P,FORCE1 POPAE P,[TT,T,E,D,C,B,A] POPJ P, FORCE1: PUSHJ P,LISTEN ;Any status incoming? JRST FORCE2 ;No TRNE D,F%EOT+F%NLI+F%HER+F%OFFL ;Serious error? JRST RMTWER ;Yes, exit FORCE2: MOVE C,BUFCNT LSH C,2 ;Convert word count to byte count SKIPN E,RESBFC JRST FORCE3 ;Jump if no residue PUSH P,C MOVE A,[.BYTE 7 ? 3 ? 3 ? 3 ? 3 ? 3] CAIGE E,2 ;Pad residue with ^Cs MOVEM A,RESBUF+1 CAIGE E,3 MOVEM A,RESBUF+2 CAIGE E,4 MOVEM A,RESBUF+3 MOVEI A,RESBUF ;Include the residue MOVEI C,1 PUSHJ P,WRICNV POP P,C ;Residue doesn't count as 4 full words IMULI E,5 ;5 bytes for each word of residue ADD C,E SETZM RESBFC FORCE3: MOVEI A,RT%WRT MOVE B,[440800,,BUFFER] ;If the tape server on PYG (VMS) worked, you would need ;this in order to be able to use it IFN 0,[ CAIGE C,16 ;God damn bag chomping VMS barfs if record MOVEI C,16 ; is shorter than this ];IFN 0 PUSHJ P,RSXMT ;Send off this record SETZM BUFCNT POPJ P, ;Convert from 36-bit form to 32-bit form ;A - address of 36-bit data ;C - number of 4-word blocks to do ;Returns new value of BUFCNT in C ;Bashes A,B,C,D,T,TT WRICNV: MOVE B,BUFCNT ;Append 32-bit words to buffer WRICN1: DMOVE T,(A) ;First two 36-bit words MOVEM T,BUFFER(B) ;First 4 bytes ROTC T,-8 ;5th byte to high end of TT TLZ TT,600000 ;Book says these bits are zero MOVEM TT,BUFFER+1(B) ;Second four bytes EXCH T,TT LSHC T,4 ;9th byte to low end of T LSH TT,-4 ;10th byte to high end of TT MOVE D,T ;Copy bits 30-31 of second 36-bit word ANDI D,3 ROT D,-4 IOR TT,D LSHC T,8 ;9th and 10 bytes in T MOVE TT,2(A) ;Third 36-bit word LSHC T,20. ;9th-12th bytes left-aligned in T MOVEM T,BUFFER+2(B) LSHC T,12. ;13th, 14th bytes to low end of T LSH TT,-4 ;15th byte to high end of TT MOVE D,T ;Copy bits 30-31 of third 36-bit word ANDI D,3 ROT D,-4 IOR TT,D LSHC T,8 ;13th-15th bytes in T MOVE TT,3(A) ;Fourth 36-bit word LSHC T,12. ;13th-16th bytes left-aligned in T MOVEM T,BUFFER+3(B) LSHC T,20. ;17th-19th bytes to low end of T LSH TT,-4 ;20th byte to high end of TT MOVE D,T ;Copy bits 30-31 of fourth 36-bit word ANDI D,3 ROT D,-4 IOR TT,D LSHC T,12. ;17th-20th bytes left-aligned in T MOVEM T,BUFFER+4(B) ADDI A,4 ;Advance to next block of words ADDI B,5 SOJG C,WRICN1 MOVEM B,BUFCNT POPJ P, ;Open remote tape connection and mount tape ;A - asciz host name (0 to listen) ;B - address at which to map host table ;C - remote drive name in asciz ;D - direction in asciz (READ, WRITE, or BOTH) ;reel name assumed not to matter, I'll always use "ITS" as the reel ID ;Skip return if successful, otherwise tape is not mounted and status ;buffer contains the details. OZ sets F%HER but HT just returns a string. OPEN: PUSH P,C PUSH P,D SETZM STSFLG SETZM STATUS MOVEI C,[ASCIZ/RTAPE/] PUSHJ P,RSOPEN JRST OPEN7 ;Failed OPEN1: MOVE B,[440800,,BUFFER] ;Build mount command MOVNI C,1 ;Remove final space by starting with -1 MOVE A,(P) ;Direction PUSHJ P,SOUT MOVEI A,[ASCIZ/ITS/] ;Reel PUSHJ P,SOUT MOVE A,-1(P) ;Drive PUSHJ P,SOUT MOVEI A,RECLEN ;Maximum record length (decimal) PUSHJ P,SOUT MOVEI A,[ASCIZ/1600/] ;Density PUSHJ P,SOUT MOVEI A,[ASCIZ/NOREWIND/] ;Don't be gratuitous PUSHJ P,SOUT MOVEI A,RT%MNT ;Send mount command MOVE B,[440800,,BUFFER] PUSHJ P,RSXMTF PUSHJ P,PROBE ;Did it work? TRNE D,F%MNT JRST POP2J1 ;Yes TRNE D,F%NLI JRST [ PUSHJ P,RMTLGN ;Login please JRST OPEN1 ] ;And try again JRST POP2J ;Failed OPEN7: MOVSI B,-17 ;Copy reason for failure into STATUS string OPEN8: MOVE T,(A) ADDI A,1 MOVEM T,STATUS(B) TRNE T,177_1 AOBJN B,OPEN8 JRST POP2J DEFINE FOO A ASCIZ/A/ TERMIN RADIX 10. RECLEN: FOO \MXRECB RADIX 8 EXPUNGE FOO ;A - ASCIZ user name ;B - ASCIZ password ;Skip return if success, otherwise STATUS has the string LOGIN: PUSHAE P,[A,B,C] MOVE B,[440800,,BUFFER] ;Build login command MOVNI C,1 ;Remove final space by starting with -1 MOVE A,-2(P) ;User name PUSHJ P,SOUT MOVE A,-1(P) ;Password SKIPE (A) PUSHJ P,SOUT MOVEI A,RT%LGI ;Send login command MOVE B,[440800,,BUFFER] PUSHJ P,RSXMTF MOVE B,[440800,,STATUS] ;Receive response MOVEI C,100 PUSHJ P,RSRCV CAIE A,RT%LGR PRTERR wrong record type in response to login JUMPE C,LOGIN9 ;Success return if count is zero MOVE A,[440700,,STATUS] ;Convert 8 bit to asciz LOGIN2: ILDB T,B IDPB T,A SOJG C,LOGIN2 IDPB C,A SOS -3(P) LOGIN9: AOS -3(P) POPAE P,[C,B,A] POPJ P, POP2J1: AOS -2(P) POP2J: SUB P,[2,,2] CPOPJ: POPJ P, SOUT: TLNN A,-1 HRLI A,440700 SOUT1: ILDB T,A JUMPE T,SOUT2 IDPB T,B AOJA C,SOUT1 SOUT2: MOVEI T,40 IDPB T,B AOJA C,CPOPJ ;Record-Stream support ;Open a record stream to a Chaosnet host, and initialize it ;RSICH, RSOCH - input and output channels ;A - asciz host name (0 to listen) ;B - address at which to map host table ;C - asciz contact name ;Clobbers all ACs ;If successful, skip return ;If failure, A has asciz failure reason RSOPEN: PUSH P,C JUMPE A,RSOPN1 PUSH P,A LDB A,[121000,,B] ;Page number MOVEI B,RSICH PUSHJ P,NETWRK"HSTMAP ;--- Someday use DQ device instead? JRST [ MOVEI A,[ASCIZ/Cannot map network host table/] JRST POP2J ] POP P,A ;Host name PUSHJ P,NETWRK"HSTLOOK JRST [ MOVEI A,[ASCIZ/Host not found in host table/] JRST POP1J ] PUSHJ P,NETWRK"HSTUNMAP JFCL RSOPN1: POP P,C ;Contact name MOVEI D,15. ;Window size MOVE B,A ;Host number or 0 MOVEI A,RSICH ;Channel pair JUMPE B,RSOPN2 ;Jump if listen PUSHJ P,NETWRK"CHACON JRST [ MOVEI A,[ASCIZ/Cannot connect to remote tape server/] POPJ P, ] JRST RSOPN3 RSOPN2: PUSHJ P,NETWRK"CHALSN .LOGOUT 1, ;Nobody home RSOPN3: MOVE T,[440700,,[ASCII/RECORD STREAM VERSION 1/]] MOVEI TT,.LENGTH/RECORD STREAM VERSION 1/ .CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSOCH ? T ? SETZ TT ] .LOSE %LSFIL .IOT RSOCH,[215] .NETS RSOCH, MOVE A,[440700,,[ASCII/RECORD STREAM VERSION 1/]] MOVEI B,.LENGTH/RECORD STREAM VERSION 1/ SETZM PKTRBC RSINI1: PUSHJ P,RSRBTI ILDB TT,A SKIPN TT MOVEI TT,215 CAME T,TT PRTERR wrong record-stream identification text SOJGE B,RSINI1 SETZM PKTXBC MOVE T,[440800,,PKTXBF+NETWRK"%CPKDT] MOVEM T,PKTXBP JRST POPJ1 ;Success return ;--- Experiment to avoid hideously slow SIOKS3 PKTXBF: BLOCK NETWRK"%CPMXW ;Packet transmit buffer PKTXBP: 0 ;Byte pointer to PKTXBF PKTXBC: 0 ;Byte count (valid bytes in packet) PKTRBF: BLOCK NETWRK"%CPMXW ;Packet receive buffer PKTRBP: 0 ;Byte pointer to PKTRBF PKTRBC: 0 ;Byte count ;Transmit record and force output RSXMTF: PUSHJ P,RSXMT RSXSND: PUSH P,A MOVE A,PKTXBC LSH A,4 TLO A,(SETZ) MOVEM A,PKTXBF .CALL [ SETZ ? 'PKTIOT ? MOVEI RSOCH ? SETZI PKTXBF ] .LOSE %LSSYS SETZM PKTXBC MOVE A,[440800,,PKTXBF+NETWRK"%CPKDT] MOVEM A,PKTXBP POP P,A POPJ P, ;Output byte from T, low volume RSXBTO: AOS TT,PKTXBC CAIG TT,NETWRK"%CPMXC JRST [ IDPB T,PKTXBP POPJ P, ] SOS PKTXBC PUSHJ P,RSXSND JRST RSXBTO ;Input byte to T, low volume PUSHJ P,RSRRCV RSRBTI: SOSGE PKTRBC JRST .-2 ILDB T,PKTRBP POPJ P, ;Receive next packet into PKTRBF RSRRCV: .CALL [ SETZ ? 'PKTIOT ? MOVEI RSICH ? SETZI PKTRBF ] .LOSE %LSSYS MOVE T,[440800,,PKTRBF+NETWRK"%CPKDT] MOVEM T,PKTRBP LDB T,[NETWRK"$CPKNB+PKTRBF] MOVEM T,PKTRBC SKIPGE PKTRBF ;Skip if non-data packet POPJ P, LDB T,[NETWRK"$CPKOP+PKTRBF] ; CAIN T,NETWRK"%COEOF ; Ignore EOFs fucking Unix sends... ; JRST RSRRCV ; Doesn't do any good if it also closes the channel... $%!$#^%!$%!! ;A little bit of useful non-modularity (knows we're inside DUMP) SETZM LPTSW PRINT _Non-data packet received: POCT T PRINT [ ] CAIN T,NETWRK"%COCLS PRINT [(CLS) ] CAIN T,NETWRK"%COLOS PRINT [(LOS) ] RSRRC1: SOSGE PKTRBC JRST ERR ILDB T,PKTRBP .IOT TYOC,T JRST RSRRC1 ;Transmit a record ;RSOCH - network output channel ;A - opcode ;B - 8-bit byte pointer to buffer containing record ;C - number of bytes in record ;Bashes A,B,C,T,TT RSXMT: MOVE T,A ;Send opcode byte PUSHJ P,RSXBTO CAIGE C,1_15. ;Long count? JRST RSXMT1 MOVEI T,200 PUSHJ P,RSXBTO LDB T,[301000,,C] PUSHJ P,RSXBTO LDB T,[201000,,C] PUSHJ P,RSXBTO RSXMT1: LDB T,[101000,,C] ;Send high byte of count PUSHJ P,RSXBTO MOVE T,C ;Send low byte of count PUSHJ P,RSXBTO RSXMT2: JUMPLE C,CPOPJ MOVEI T,NETWRK"%CPMXC SUB T,PKTXBC ;Space remaining in buffer CAMLE T,C MOVE T,C JUMPLE T,[ PUSHJ P,RSXSND ;Make space and try again JRST RSXMT2 ] ADDM T,PKTXBC ;Send this many SUB C,T PUSH P,C MOVE A,PKTXBP MOVE C,T PUSHJ P,SCOPY ;Copy into buffer MOVEM A,PKTXBP POP P,C JRST RSXMT2 ;Copy string of 8-bit bytes ;Byte instructions are hideously slow on KS10 ;A - destination byte pointer ;B - source byte pointer ;C - number of bytes ;Bashes T,TT; advances arguments SCOPY: JUMPLE C,CPOPJ ;Return if nothing left to do TLNN A,300000 ;Skip if destination not word-aligned CAIGE C,8 ;If fewer than two words, use slow loop JRST SCOPY1 ;Copy one byte and try again IBP A ;Point to first actual byte IBP B MOVE T,C LSH T,-2 ;Number of words to do ANDI C,3 ;Number of bytes left over CAMGE B,[341000,,0] ;Skip if source is word-aligned JRST SCOPY2 HRLZ TT,B ;Both aligned, use BLT HRR TT,A ADD A,T ADD B,T BLT TT,-1(A) JRST SCOPY4 ;Take care of residue, if any SCOPY1: ILDB T,B IDPB T,A SOJA C,SCOPY SCOPY2: PUSHAE P,[D,E] LDB D,[360600,,B] ;Byte position of source MOVEI TT,34 ;Compute left shift required to align it SUB TT,D SCOPY3: DMOVE D,(B) LSH D,-4 ;Squeeze out extra bits LSHC D,4(TT) ;Align source to destination MOVEM D,(A) ADDI A,1 ADDI B,1 SOJG T,SCOPY3 POPAE P,[E,D] SCOPY4: ADD A,[100000,,] ;Undo IBP ADD B,[100000,,] ;.. JRST SCOPY ;Take care of residue, if any IFN 0,[ ;Transmit record and force output RSXMTF: PUSHJ P,RSXMT .NETS RSOCH, POPJ P, ;Transmit a record ;RSOCH - network output channel ;A - opcode ;B - 8-bit byte pointer to buffer containing record ;C - number of bytes in record RSXMT: .IOT RSOCH,A ;Send opcode byte CAIGE C,1_15. ;Long count? JRST RSXMT1 .IOT RSOCH,[200] LDB T,[301000,,C] .IOT RSOCH,T LDB T,[201000,,C] .IOT RSOCH,T RSXMT1: LDB T,[101000,,C] ;Send high byte of count .IOT RSOCH,T .IOT RSOCH,C ;Send low byte of count .CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSOCH ? B ? SETZ C ] .LOSE %LSFIL POPJ P, ];IFN 0 ;Receive a record into buffer RSRCVB: MOVE B,[440800,,BUFFER] MOVEI C,MXRECB ;fall into RSRCV ;Receive a record ;RSICH - network input channel ;A - opcode is returned here ;B - 8-bit byte pointer to buffer in which record is returned ;C - input: number of bytes in buffer, output: number of bytes in record RSRCV: PUSHJ P,RSRBTI ;Await record and receive the opcode PUSH P,T ;Save opcode PUSH P,C ;Save buffer size PUSHJ P,RSRBTI ;High byte of count MOVE C,T MOVEI TT,1 ;Normally one additional byte TRNE C,200 JRST [ MOVEI TT,4 ;Long count MOVEI C,0 JRST .+1 ] RSRCV0: LSH C,8 PUSHJ P,RSRBTI IOR C,T SOJG TT,RSRCV0 CAMLE C,(P) PRTERR Record-stream input buffer overflow--record too long MOVEM B,(P) ;Save buffer pointer PUSH P,C ;Save record length SKIPA A,B ;Destination RSRCV1: PUSHJ P,RSRRCV ;Get another packet MOVE B,PKTRBP ;Source PUSH P,C ;Save remaining record length CAMLE C,PKTRBC MOVE C,PKTRBC ;Only part of record is in this packet MOVN T,C ADDM T,PKTRBC ;Use up source and destination buffers ADDM T,(P) PUSHJ P,SCOPY ;Copy into caller's buffer MOVEM B,PKTRBP POP P,C ;Number of bytes still needed JUMPG C,RSRCV1 POP P,C ;Overall record length POP P,B ;Original buffer pointer POP P,A ;Opcode POPJ P, IFN 0,[ RSRCV: .IOT RSICH,A ;Await record and receive the opcode PUSH P,C ;Save buffer size .IOT RSICH,C ;High byte of count MOVEI TT,1 ;Normally one additional byte TRNE C,200 JRST [ MOVEI TT,4 ;Long count MOVEI C,0 JRST .+1 ] RSRCV0: LSH C,8 .IOT RSICH,T IOR C,T SOJG TT,RSRCV0 CAMLE C,(P) PRTERR Record-stream input buffer overflow--record too long MOVEM B,(P) ;Save buffer pointer MOVE T,C .CALL [ SETZ ? SIXBIT/SIOT/ ? MOVEI RSICH ? B ? SETZ T] .LOSE %LSFIL POP P,B POPJ P, ];IFN 0 .END RTAPE SUBTTL DKAUTH, DKLOOK ; Call with magic number in A, returns with SIXBIT of author in A. Author ; is looked up in the -local- MFD, so that better be what you want. DKAUTH: PUSH P,B SKIPN DKMFDP JRST DKAUT1 DKAUT2: MOVE B,MDNUDS+DSKMFD SUB A,B LSH A,1 SKIPGE A SKIPA A,DSKMFD+2000(A) SETZI A, ; 0 if no author POP P,B POPJ P, DKAUT1: .IOPUSH DSKIN, .CALL [ SETZ ? SIXBIT /OPEN/ [.BII,,DSKIN] [SIXBIT /DSK/] [SIXBIT /M.F.D./] SETZ [SIXBIT /(FILE)/]] .LOSE %LSFIL MOVE B,[-2000,,DSKMFD] .IOT DSKIN,B SKIPGE B .LOSE SETOM DKMFDP .IOPOP DSKIN, JRST DKAUT2 ; Call with directory name in A, first name in B, second name in C, returns ; with pointer to name block in A. Fails to skip if file or directory not ; found. Uses the local filesystem, so that better be what you want. DKLOOK: PUSH P,D CAMN A,DKUFDP JRST DKLOK1 .IOPUSH DSKIN, .CALL [ SETZ ? SIXBIT /OPEN/ [.BII,,DSKIN] [SIXBIT /DSK/] [SIXBIT /.FILE./] [SIXBIT /(DIR)/] SETZ A ] JRST [ .IOPOP DSKIN, ? JRST POPDJ ] MOVE D,[-2000,,DSKUFD] .IOT DSKIN,D SKIPGE D .LOSE MOVEM A,DKUFDP .IOPOP DSKIN, DKLOK1: MOVE A,DSKUFD+UDNAMP ADDI A,DSKUFD-LUNBLK DKLOK2: ADDI A,LUNBLK CAIL A,DSKUFD+2000 JRST POPDJ CAMN B,UNFN1(A) CAME C,UNFN2(A) JRST DKLOK2 MOVE D,UNRNDM(A) TLNE D,UNIGFL JRST DKLOK2 POPDJ1: AOS -1(P) POPDJ: POP P,D POPJ P, SUBTTL BUFFERS CONSTANTS VARIABLES PATCH: PAT: BLOCK LPAT PDL: BLOCK LPDL CLOADF: ;SAVE SWITCHES FOR 'CLOAD' COMMAND -1 ;SAVE DMPMOD HERE 0 ;SAVE RELOSW HERE 0 ;SAVE LENGTH HERE BLOCK NFIGS ;SAVE @FIGTB2(n) HERE MFDLST: BLOCK 1000 ;MUST BE IN THIS ORDER BUF: BLOCK 2000 ;NORMAL BUFFER DSKUFD: BLOCK 2000 .SEE DKLOOK ;UFD ON DISK DSKMFD: BLOCK 2000 .SEE DKAUTH ;MFD ON DISK UFDBUF: BLOCK 2000 ;STORAGE FOR INCOMING AND OUTGOING UFDS MFDBUF: BLOCK 2000 ;STORAGE FOR TAPES COPY OF MFD FDIRBF: BLOCK 2000+10 ;FOR FNG+POSSIBLE OVERFLOW LISTBF: BLOCK 600. ;3 WORDS MAX 190. FILES, LISTING BUFFER BIF: BLOCK 2000 ;COMPARE BUFFER CORSIZ==<.+1777>_-10. SORTAS: 0 SBUF: ;FOR ORDMFD (SCOTT CUTLER MEMORIAL BUFFER) CORSZB==<.+40000+1777>_-10. BUFFER: 0 .SEE FCDMP END START