;-*-MIDAS-*- TITLE BOJ JOB ARCDEV VERSIO==.FNAM2 A=1 B=2 C=3 D=4 E=5 TT=6 INT=7 ;FLAG FOR INTERRUPT, -1 INT HAPPENED Q=10 J=11 I=12 W=13 H=14 P=15 T=16 U=17 CH==,,-1 ;BIT TYPEOUT MODE MASK FOR I/O CHANNEL NAMES. CHBOJ==1 CHDSK==2 CHSALV==3 IOCEOF==8 ;IOCERROR CODE FOR EOF. ;Temporary until they're predefined in MIDAS. %CBLOK==2000 ; 4.2 LOCK PAGE IN CORE. %CBULK==1000 ; 4.1 UNLOCK PAGE (ALLOW SWAP-OUT) DEFINE PAUSE MOVEI TT,10.*30. .SLEEP TT, TERMIN DEFINE SYSCAL NAME,ARGS .CALL [ SETZ ? SIXBIT/NAME/ ? ARGS ((SETZ))] TERMIN LOC 42 JSR TSINT SWTLST: 0 ;This is the locked switch list, used to undo AOS's if we are killed. -CRITLN,CRITTB ;This points to the critical routine table. LOC 77 SIXBIT /ARCDEV/ RDEVN: BLOCK 3 ;Real filenames of file open in creator's channel on the archive device. RDIRN: 0 ACCP: 0 ;Access pointer in open file, as byte # of next byte to transfer. DIRECTN:0 ;-1 if direction is Output. CRUNAM: 0 ;creator's uname. CRJNAM: 0 ;creator's jname. FILLEN: 0 ;File length, in bytes of size now open in, ;or -1 => FILLEN, FILBLN and FILBSZ not known. BYTSIZ: 0 ;Byte size channel is open in. FILBLN: 0 ;File length, in bytes of size file was written in. FILBSZ: 0 ;Byte size file was written in. ;;; From 77 to here is looked at by PEEK. AFDEV: 0 ;Real Device (the machine name) and FN2 of the archive file. AFFN2: 0 ;(the real FN1 and SNAME are in RDEVN and RDIRN). FILADR: 0 ;Address in core of start of file's data area (actually, start of header). ;Zero only if no file is open. DIRFLG: 0 ;-1 => reading the directory rather than a file. ACCBP: 0 ;byte pointer for I/O to file. Always agrees with ACCP. P-field mustn't be 44 BYTSWD: 0 ;number of bytes per word in file. FILRND: 0 ;# of bytes that fit in space allocated to file. ;bytes past this one exist only on output, when we are extending the file, ;and they live starting at NEWDAT rather than in the archive. OPMODE: 0 ;Mode creator opened us in. CRDATE: 0 ;Creation date of open file. REFDAT: 0 ;Reference date of open file. DATUPD: 0 ;-1 if CRDATE or REFDAT has been set and UNDATE, UNREF need to be updated. OFILLE: 0 ;Value of FILLEN before we changed it by .IOTing to extend the file. ORFDAT: 0 ;Old reference date, so RESRDT system call can set it back. ERCD: 0 ;Error code saved here by some system calls. ARCCDT: 0 ;Creation date of archive device, saved for first call to LOCK ;(because at that time the archive device pages aren't mapped yet. ;-1 after archive is mapped in and we should look in ARCADR+UDCDAT ARCDMP: 0 ;Dumped bit of archive device, saved over first LOCK, or -1 thereafter. RNDM: BLOCK 5 ;Temp storage used for return values of FILBLK. PAT: PATCH: BLOCK 100 PATCHE: -1 ;START HERE. GO: MOVE P,[-LPDLL-1,,PDL-1] .SUSET [.SMASK,,[%PIMPV+%PIIOC]] SYSCAL USRVAR,[%CLIMM,,%JSELF ? ['OPTION] ? 0 ? [TLO %OPOPC\%OPLOK]] .LOSE %LSSYS .OPEN CHBOJ,[17,,'BOJ] .VALUE SYSCAL RFNAME,[ 1000,,CHBOJ 2000,,0 2000,,CRUNAM 2000,,CRJNAM] JFCL .CALL JBGT ;What is the name of the archive device and file? .VALUE MOVE A,JBCOP TLNE A,60000 ;IF HE ALREADY PCLSR'D, GIVE UP, SINCE HE WILL GIVE UP ON US JRST DIE ;SINCE WE DID A JOBGET AND SAW THAT FACT. ANDI A,-1 ;NOW .VALUE IF OPCODE IS .IOT - SHOULDN'T HAPPEN, CAIN A,1 ;BUT DID DUE TO A BUG. .VALUE SYSCAL OPEN,[ ;OPEN THE ARCHIVE DEVICE FILE WE ARE SUPPOSED TO USE. [.BII,,CHDSK] ['DSK,,] JBCDEV [SIXBIT />/] JBCSNM %CLERR,,B] PUSHJ P,ARCINI ;Archive file does not exist => maybe create it. HRROI A,B .IOT CHDSK,A CAME B,[SIXBIT/ARC1!!/] ;If the file isn't recognizable as a current-format archive, JRST OLDARC ;maybe it's an old-format one. Load the old handler. SYSCAL RFNAME,[%CLIMM,,CHDSK %CLOUT,,AFDEV ? %CLOUT,,RDEVN ? %CLOUT,,AFFN2 ? %CLOUT,,RDIRN] .LOSE %LSFIL SYSCAL RFDATE,[%CLIMM,,CHDSK ? %CLOUT,,ARCCDT] .LOSE %LSFIL ;Read the arc dev's creation date before we lock it. SKIPGE ARCCDT ;If file has none, use current date. SYSCAL RQDATE,[%CLOUT,,ARCCDT] JFCL SKIPGE ARCCDT ;Current date not known either => barf. .LOSE %LSSYS SYSCAL RDMPBT,[%CLIMM,,CHDSK ? %CLOUT,,ARCDMP] .LOSE %LSFIL ;Same for file-dumped-bit. SYSCAL SSTATU,[REPEAT 6,[ ? %CLOUT,,AFDEV ]] .LOSE %LSSYS .CLOSE CHDSK, ;Close our input channel PUSHJ P,LOCK ;Open an output channel instead, PUSHJ P,MAPARC ;get all the pages. MOVE A,ARCCDT ;Store what should be the creation date and dumped bit MOVEM A,ARCADR+UDCRDT ;of the archive itself inside the archive. MOVE A,ARCDMP MOVEM A,ARCADR+UDDMPB SETOM ARCCDT SETOM ARCDMP PUSHJ P,ARCDEL ;Delete any files marked "delete when closed" and not open. .SUSET [.SMSK2,,[1_CHBOJ]] JRST GOINIT ;Dispatch to JOPEN or JFDEL with dir still locked. WRGDIR: SKIPA A,[%ENSIO] NSDEV: MOVSI A,%ENSDV JRST NOGO2 PKNMTD: MOVSI A,%ENAPK ;If Pack Not Mounted, say so, and die. JRST NOGO2 FILXST: MOVSI A,%EEXFL ;File already exists error. JRST NOGO2 DIRFUL: SKIPA A,[%EFLDR] WTDDIE: MOVSI A,%EBDDV ;Wrong type device on initial operation - report and suicide. NOGO2: MOVEM A,ERRCOD MOVEI C,20. NOGO1: .CALL JBGT .LOSE %LSFIL ;JOBGET ON INITIAL IS NOT SUPPOSED TO FAIL. MOVE A,JBCOP TLNE A,%JGCLS ;HE CLOSED US => WE CAN STOP NOW. JRST DIE .CALL JBRT3 ;KEEP TRYING TO RETURN THIS ERROR, IN CASE HE PCLSR'S AND COMES BACK. SOJG C,[MOVEI B,1 ? .SLEEP B, ? JRST NOGO1] JRST DIE ;When an archive device file is in an old format, load in the old archive device handler. OLDARC: .CLOSE CHBOJ, ;Close both channels. .IOPUS CHBOJ, ;Push them both, so a single .IOPDL will close both. .IOPUS CHDSK, .OPEN CHBOJ,['BOJ] ;Then open them again. .LOSE %LSSYS SYSCAL OPEN,[[.UII,,CHDSK] ? ['DSK,,] ? ['OARCDV] ? ['BIN,,] ? ['DEVICE]] .LOSE %LSFIL MOVE 17,[LOADER,,0] ;Put the loader in the ACS so we can flush all core. BLT 17,17 JRST LOADIT LOADER: OFFSET -. %ENACR,,0 ;"No Core Available" error code. CRAPIT::.CALL CRAP ;Do JOBRET to give user the "No Core" error code. ;If the JOBRET succeeds, we go through the .CORE and ;then the .CALL LOAD must fail, so we'll get here again; ;but then we will fail and log out. .LOGOUT LOADIT::.CORE 0 ;Flush all core so LOAD will get fresh core. .LOGOUT .CALL LOAD ;Load up old-format archive device handler. JRST CRAPIT .IOT CHDSK,CRAP ;Read in starting address. .IOPDL ;Close all I/O channels (which we carefully pushed to this end). CRAP:: SETZ ;.IOT clobbers this word with a jump to the starting address. SIXBIT \JOBRET\ %CLIMM,,CHBOJ LOAD:: SETZ ;1st wor of LOAD call and last word of JOBRET call. SIXBIT \LOAD\ %CLIMM,,%JSELF 401000,,CHDSK IFG .-20,.ERR LOADING ROUTINE DOESN'T FIT IN ACS. OFFSET 0 ;Here to create an archive file if appropriate and necessary. ARCINI: CAIN B,%ENAFL ;If we couldn't open the file because it was locked, JRST [ PAUSE ;wait and try again. JRST ARCIN1] CAIN B,%ENAPK ;if pack not mounted, JRST PKNMTD ;say so and die. HRRZ A,JBCOP CAIE A,%JOOPN ;Create only if opening a file JRST NSDEV MOVE A,JBCWD6 TRNN A,1 ;for output JRST NSDEV TRNE A,100000 ;and not for write-over. JRST NSDEV SYSCAL OPEN,[[.BIO,,CHDSK] ? ['DSK,,] ? JBCDEV ? [SIXBIT />/] ? JBCSNM] JRST NSDEV ;Can't create file => no such device. PUSHJ P,GETPAG SETZM DIRCPY ; INITIALIZE THE OUTPUT BLOCK MOVE A,[DIRCPY,,DIRCPY+1] BLT A,DIRCPY+1777 MOVE A,[SIXBIT /ARC1!!/] MOVEM A,DIRCPY ; IDENTIFY THIS FILE AS LEGITIMATE ARCHIVE. MOVEI A,2000 ; POINTER TO NAME AREA OFF THE END MOVEM A,DIRCPY+UDNAMP MOVEM A,DIRCPY+UDDATP MOVE A,[-2000,,DIRCPY] .IOT CHDSK,A PUSHJ P,RELPAG ARCIN1: SOS (P) SOS (P) ;Return to retry the open which originally failed. CPOPJ: POPJ P, ;Upon first accessing an archive, clean up after any damage produced ;by a system crash. ARCCLN: SYSCAL RQDATE,[ %CLOUT,,A ;Ignore 1st value %CLOUT,,A] ;2nd value is time of system startup. .LOSE %LSSYS JUMPL A,[ PAUSE ;System doesn't know the time => wait JRST ARCCLN] ;and hope it finds out the time. CAMN A,UDINIT+ARCADR ;Has this archive been cleaned since the system came up? POPJ P, ;Yes. PUSHJ P,ARCCL1 ;No, it's our task. Set all UHREFC's to 0. MOVEM A,UDINIT+ARCADR ;Assert that this archive has been initialized POPJ P, ;since the last system crash. ARCCL1: MOVE Q,UDNAMP+ARCADR ;Scan through all filename blocks in the directory. ADDI Q,ARCADR ARCCL2: CAIN Q,2000+ARCADR POPJ P, HRRZ B,UNRNDM(Q) ;Set the UHREFC word of each file to 0. SETZM UHREFC+ARCADR(B) ADDI Q,LUNBLK JRST ARCCL2 ;Delete all files marked "delete when closed" which aren't open. Dir already locked. ARCDEL: PUSHJ P,DIRGE1 ;Get a copy of the directory. MOVE Q,UDNAMP+ARCADR ADDI Q,ARCADR SETZ I, ;I is flag saying whether any files had to be deleted. ARCDE1: CAIN Q,2000+ARCADR JRST ARCDE3 MOVE B,UNRNDM(Q) ;Look at each file. TLNE B,UNCDEL ;If UNCDEL is set SKIPE UHREFC+ARCADR(B) ;And the ref count is 0, JRST ARCDE2 PUSHJ P,QSQSH0 ;delete its filename block. SETO I, ARCDE2: ADDI Q,LUNBLK JRST ARCDE1 ARCDE3: JUMPN I,DIRPU1 ;If any files are being deleted, write back the directory. POPJ P, ;If no files are open in this archive, and there is at least 1K of garbage, ;rewrite the archive to compress it. ARCSAL: PUSHJ P,DIRWST JUMPN C,CPOPJ ;Do nothing if files are open, CAIGE B,2000 ;of if there isn't much garbage to clean up. POPJ P, SYSCAL OPEN,[[.BIO,,CHSALV] ? ['DSK,,] ? ['_ARCSA] ? ['OUTPUT] ? RDIRN] POPJ P, MOVE A,[-2000,,ARCADR] .IOT CHSALV,A ;Write out the old directory, SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? %CLIMM,,DIRCPY/2000 %CLIMM,,CHSALV ? %CLIMM,,0] ;then map that page in so we can update it. JSR CBKLOS ;Now write out the data areas of all files, one by one, ;and make the copy's directory point at them. MOVE Q,UDNAMP+ARCADR ADDI Q,ARCADR MOVEI D,2000 ;D is a running pointer into the copy's data area. ARCSA1: CAIN Q,2000+ARCADR JRST ARCSA2 HRRZ B,UNRNDM(Q) ADDI B,ARCADR ;Get address of next file's data area. MOVN C,(B) HRL B,C ;Get an AOBJN pointer to that data area. .IOT CHSALV,B ;Write it into the copy. HRRM D,UNRNDM+DIRCPY-ARCADR(Q) ;Make copy's directory point at it. SUB D,C ;Advance D to be right for the next file we copy. ADDI Q,LUNBLK JRST ARCSA1 ARCSA2: MOVEM D,UDDATP+DIRCPY ;Store size of copy's data area into the copy. ;Now the copy is fully written. Replace the old archive device file with it. SYSCAL RFNAME,[%CLIMM,,CHDSK ? %CLOUT,,A ? %CLOUT,,B ? %CLOUT,,C] .LOSE %LSFIL SYSCAL RENMWO,[%CLIMM,,CHSALV ? B ? C] .LOSE %LSFIL SYSCAL DELEWO,[%CLIMM,,CHDSK] .LOSE %LSSYS .CLOSE CHDSK, .CLOSE CHSALV, POPJ P, ;Compute in B the total number of words used by all files' data areas. ;Return C nonzero if any files in this archive are open. DIRWST: MOVE Q,UDNAMP+ARCADR SETZB B,C DIRWSF: CAIN Q,2000 JRST DIRWS2 MOVE A,UNRNDM+ARCADR(Q) ADD B,UHWCNT+ARCADR(A) IOR C,UHREFC+ARCADR(A) ADDI Q,LUNBLK JRST DIRWSF DIRWS2: MOVNS B ;B has number of used words in the data area. ADD B,UDDATP+ARCADR ;Subtract from total size to get number of wasted words, SUBI B,2000 ;but don't count the directory as wasted. POPJ P, ;Archive device format: ;The first page of an archive device file is its directory. ;The remaining pages are data. ;The directory may not even be looked at unless the archive is "locked". .SEE LOCK,UNLOCK ;Only one ARCDEV can lock a given archive at a time. ;Shuffling the directory should not be done in place, even when it is locked. ;Instead, use DIRGET to make a copy and DIRPUT to store the copy back in. ;When a file is open, the address of its data area is remembered in FILADR. ;The data area of a file never moves, and the file can be open only in one ;direction at a time, so reading or writing the data area requires no interlocking. ;The format of the archive device directory is approximately that of ;an I.T.S. UFD. The differences are: ;In the fixed header, word 0 (UDESCP) contains SIXBIT /ARC1!!/ ;Word 1 points to the beginning of the name area, as in UFDs. ;Word 2 points to the end of the data area. ;Word 3 is used to tell when the archive needs to be cleaned ; because it is being touched for the first time since the system came up. ;Word 4 contains what is supposed to be the creation date of the archive. ; Since locking the archive device clobbers the creation date, ; we store it here so we can restore it after clobbering it. ;Word 5 similarly stores the dumped bit. ;There is nothing analogous to the "descriptors" in a disk UFD. ;Random info in UFD UDESCP==0 ;SIXBIT /ARC1!!/ UDNAMP==1 ;Address in directory of first filename block. UDDATP==2 ;Address of first free word past data area of last file. UDINIT==3 ;Time of startup of last run of system during which this ;archive was cleaned (ARCCLN). If not same as startup time ;of this run of the system, we must do ARCCLN. UDCRDT==4 ;This word holds what ought to be the creation date ;of the archive device file itself. ;0 => this archive antedates the UDCRDT word, in which ;case it gets set from today's date. UDDMPB==5 ;This is like UDCRDT but stores the dumped bit. UDNMIN==10 ;If UDNAMP is less than this, there is no room for another filename block. ;In each filename block, the UNFN1, UNFN2, UNDATE and UNREF words are ;just as in UFDs. The UNRNDM word is slightly different: LUNBLK==5 ;Number of words in each filename block. UNFN1==0 ;First file name. UNFN2==1 ;Second file name. UNRNDM==2 ;All kinds of random info: ;The RH is the address in the file of the start of the file's data area header. ;The LH contains these bits: UNWRIT==4 ;Open for writing. Not actually maintained in the archive, ;Just reflected to the user when he reads ARC:.FILE. (DIR). UNCDEL==20 ;Delete this file when it is closed. UNIGFL==24 ;Bits to ignore file UNWRDC==301200,, ;Word count of last block mod 2000. ;This information really lives in UHWCNT, and is just reflected ;here when the user reads the image directory. UNDATE==3 ;Date and time file last modified. UNTIM==2200,, ;Compacted time of creation UNYMD==222000,, ;Y,M,D of creation UNMON==270400,, ;Month UNDAY==220500,, ;Day UNYRB==330700,, ;Year UNREF==4 ;Reference date same as left half of undate UNREFD==222000,, ;Reference date byte pointer UNAUTH==111100,, ;MFD index of author, all 1=> no directory. UNBYTE==001100,, ;File byte size and length info. ;LET S=BITS PER BYTE, C=COUNT OF UNUSED BYTES IN LAST WD ;400+100xS+C S=1 TO 3 C=0 TO 35. ;200+20xS+C S=4 TO 7 C=0 TO 8 ;44+4xS+C S=8 TO 18. C=0 TO 3 ;44-S S=19. TO 36. C=0 ;NOTE THAT OLD FILES HAVE UNBYTE=0 => S=36. ;The data of a file starts with two words of header information: UHWCNT==0 ;Total length of the file's data, including header, in words. UHREFC==1 ;RH: Number of archives using the file, in either direction. ;LH: -1 if file open for writing. UHNAMP==2 ;Unused UHBLEN==3 ;Length of this header; offset to 1st actual data word. GOL: SKIPL INT ;THERE ARE NO INTERRUPTS => WAIT QUIETLY. .HANG GOLOOP: SETZM INT ;HERE TO SERVICE ANY INTERRUPTS THERE ARE. .CALL JBGT JRST GOL GOINIT: MOVE B,JBCOP TLNE B,%JGCLS JRST JCLS LDB A,[000400,,JBCOP] TLNE B,%JGFPD ;IF THIS IS A RETRY OF A CALL THAT PCLSR'ED, JRST RETRY ;GIVE IT THE SAME JOBRET WE TRIED TO GIVE LAST TIME. RETRYR: SETZM PCLSRD ;WE CAN'T MANAGE TO HANDLE A RETRY AFTER ANYTHING ELSE HAPPENS. CAILE A,7 JRST JSYSCL ; HANDLE A .CALL JRST @DISP(A) DISP: JOPEN JIOT WTDDIE ;Mlink isn't allowed. JRESET JRCH JACC JFDELE JRNMWO ;HERE WHEN CREATOR GIVES US A SYSTEM CALL AND SAYS IT'S A RETRY. RETRY: AOSE PCLSRD ;IF WE HADN'T SEEN THE SYSTEM CALL THE FIRST TIME, JRST RETRYR ;TREAT IT AS NEW. MOVE B,LJBRTA ;IF WE FINISHED HANDLING IT AND OUR JOBRET FAILED, JRST -2(B) ;GIVE HIM THE SAME JOBRET AGAIN. PCLSR: POP P,LJBRTA ;FOLLOW EVERY JOBRET WITH A PUSHJ P,PCLSR. PCLSR1: SETOM PCLSRD ;A FAILING JOBRET INDICATES THAT CREATOR WAS PCLSRD AND WE SHOULD JRST GOLOOP ;EXPECT HIM TO RETRY HIS SYSTEM CALL. PCL==PUSHJ P,PCLSR LJBRTA: 0 ;2 PLUS ADDRESS OF LAST FAILING JOBRET. PCLSRD: 0 ;-1 => OUR LAST JOBRET FAILED, SO EXPECT A RESTARTED SYSTEM CALL. ;Get a page of core at address DIRCPY GETPAG: SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? %CLIMM,,DIRCPY/2000 ? %CLIMM,,%JSNEW] JSR CBKLOS POPJ P, ;JSR CBKLOS after a CORBLK which can possibly get NO CORE AVAILABLE. ;If that happens, we sleep and retry. Otherwise, we LOSE. CBKLOS: 0 SOS CBKLOS SOS CBKLOS ;Get address of the CORBLK which failed. PUSH P,A .STATUS 0,A LDB A,[220600,,A] CAIE A,%ENACR ;If not NO CORE AVAILABLE, pretend we did a .LOSE. JRST [ POP P,A SYSCAL LOSE,[ %CLIMM,,%LSSYS ? CBKLOS]] MOVEI A,300. ;If NO CORE AVAILABLE, wait 10 seconds and return .SLEEP A, ;to the failing CORBLK to retry it. JRST @CBKLOS ;Release the page. RELPAG: SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? %CLIMM,,DIRCPY/2000] .LOSE %LSSYS POPJ P, ;Lock the archibve directory and core allocation by opening the file for write-over. ;This also enables us to extend the archive file. ;Also, return in Q the address of the filename block for the file whose ;data header address is in FILADR, if there is one. ;Note: follow a LOCK with a MAPARC, unless you are damned sure ;that you won't reference anything outside the directory. ;Anything which might look at the header for a file other than the one which is open ;might look at a file which was created since your last MAPARC. LOCK: SYSCAL OPEN,[[100000+.BIO,,CHDSK] ? AFDEV ? RDEVN ? AFFN2 ? RDIRN %CLERR,,TT] JRST LOCKWT SKIPGE Q,ARCCDT MOVE Q,ARCADR+UDCRDT SYSCAL SFDATE,[%CLIMM,,CHDSK ? Q] ;Restore the arc dev's creation date .LOSE %LSFIL ;which was clobbered by the OPEN just done. SKIPGE Q,ARCDMP MOVE Q,ARCADR+UDDMPB SYSCAL SDMPBT,[%CLIMM,,CHDSK ? Q] ;Restore the arc dev's dumped bit .LOSE %LSFIL ;which was clobbered by the OPEN just done. SKIPN FILADR POPJ P, MOVE Q,ARCADR+UDNAMP ADDI Q,ARCADR LOCK1: CAIN Q,ARCADR+2000 .LOSE ;File no longer has a filename block pointing to it? HRRZ TT,UNRNDM(Q) ADDI TT,ARCADR CAMN TT,FILADR POPJ P, ADDI Q,LUNBLK JRST LOCK1 LOCKWT: CAIE TT,%ENAFL .LOSE PAUSE JRST LOCK UNLOCK: .CLOSE CHDSK, POPJ P, ;Map in the pages of the archive file starting at ARCADR. ;We assume that CHDSK is open. MAPARC: PUSH P,A PUSH P,B PUSH P,C SYSCAL FILLEN,[%CLIMM,,CHDSK ? %CLOUT,,A] .LOSE %LSFIL MOVE C,A CAILE A,ARCMAX ;Barf if archive file is bigger than address space allocated. .LOSE ADDI A,1777 LSH A,-10. MOVNS A HRLZS A HRRI A,ARCADR/2000 SETZ B, SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? A ? %CLIMM,,CHDSK ? B ? %CLERR,,ERCD] JSR CBKLOS POP P,C JRST POPBAJ ;Make a copy of the archive directory in DIRCPY so we can move filename blocks around. DIRGET: PUSHJ P,LOCK DIRGE1: PUSHJ P,GETPAG MOVE TT,[ARCADR,,DIRCPY] BLT TT,DIRCPY+1777 POPJ P, ;Store the updated archive directory from DIRCPY into the archive, carefully. DIRPUT: PUSHJ P,DIRPU1 JRST UNLOCK ;This should really use PGEXCH, whenever that exists. DIRPU1: MOVE TT,[DIRCPY,,ARCADR] BLT TT,ARCADR+1777 JRST RELPAG ;When the archive device is "written" as it appears to the user, call this ;routine to update the creation date and clear the dumped bit. ;Archive must be locked. ARCWRT: SYSCAL RQDATE,[%CLOUT,,ARCADR+UDCRDT] .LOSE %LSSYS SETZM ARCADR+UDDMPB SYSCAL SFDATE,[%CLIMM,,CHDSK ? ARCADR+UDCRDT] .LOSE %LSFIL SYSCAL SDMPBT,[%CLIMM,,CHDSK ? ARCADR+UDDMPB] .LOSE %LSFIL POPJ P, ;OPEN operation. This is an initial operation, done with no JOB channel open yet, ;so the dir is still locked from the initialization. JOPEN: LDB W,[410100,,JBCOP] ;0 => INPUT 1 => OUTPUT MOVEM W,DIRECTN MOVE A,JBCWD6 ;SAVE OPEN-MODE. MOVEM A,OPMODE TRNE A,6 ; SKIP IF CHARACTER MODE SKIPA A,[44] ; BLOCK OR IMAGE MOVEI A,7 MOVEM A,BYTSIZ MOVEI B,44 IDIVM B,A MOVEM A,BYTSWD HRLZ A,OPMODE ; GET OPEN MODE TLZ A,777770 ; ISOLATE BASIC OPEN MODES TLC A,1 ; COMPLEMENT READ/WRITE MODE TLO A,10 ; MAKE SURE OPPOSITE DIRECTION BIT IS ON HRRI A,(SIXBIT/BOJ/) .OPEN CHBOJ,A ; OPEN BOJ IN THE CORRECT MODE .VALUE MOVE A,JBCFN1 ; MY KIND OF ARCHIVE MOVE B,JBCFN2 ; SEE IF HE ASKED FOR DIRECTORY CAMN A,[SIXBIT/.FILE./] CAME B,[SIXBIT/(DIR)/] JRST FILOPN ; NO - GO OPEN THE FILE SETOM DIRFLG ; SET DIRECTORY OPEN FLAG MOVE C,OPMODE ; GET OPEN MODE TRNE C,777771 ; OPEN FOR WRITING? JRST WRGDIR ; WRONG DIRECTION - LOSE MOVEM A,RDEVN+1 MOVEM B,RDEVN+2 .CALL JBST ;Report file being operated on as .FILE. (DIR) JFCL PUSHJ P,DIRGE1 ;Get a copy of the directory. MOVE A,DIRCPY+UDNAMP MOVSI C,UNWRIT ;Set the UNWRIT bit in the copy for each file JOPNC2: CAIL A,2000 ;which is being written now. JRST JOPNC3 HRRZ B,UNRNDM+DIRCPY(A) SKIPGE UHREFC+ARCADR(B) IORM C,UNRNDM+DIRCPY(A) MOVE D,UHWCNT+ARCADR(B) SUBI D,UHBLEN ;Also store the number of words in the last K DPB D,[UNWRDC,,UNRNDM(B)] ;in the UNWRDC field in the filename block. ADDI A,LUNBLK JRST JOPNC2 JOPNC3: PUSHJ P,UNLOCK MOVE A,OPMODE TRNE A,4 ; ascii or image directory? JRST [ MOVE A,[004400,,DIRCPY-1] MOVEM A,ACCBP ;For image directory, just read straight out of our copy. MOVEI A,2000 MOVEM A,FILLEN MOVEM A,FILBLN MOVEI A,44 MOVEM A,FILBSZ JRST OPNWIN] PUSHJ P,DIRASC ;For ASCII directory, create the text starting at NEWDAT-1 MOVE A,FILBLN ;Length (in chars) left in FILBLN. IDIVI A,5 ;Set up for FILCP1. MOVNS B ADDI B,5 CAIN B,5 ;B gets number of free bytes in last word. SETZ B, MOVE D,FILBLN ADDI D,4 IDIVI D,5 ;D gets number of words. MOVEI A,7 ;A gets byte size. MOVEM A,FILBSZ PUSHJ P,FILCP1 ;Set up FILLEN. MOVE A,[010700,,NEWDAT-1] MOVEM A,ACCBP ;and start reading it. OPNWIN: MOVE A,FILLEN ;keep track of whether we extend the file at all MOVEM A,OFILLEN ;(whether FILLEN changes). SETZM ACCP .CALL JBRT1 PUSHJ P,IJBRTF JRST GOLOOP IJBRTF: MOVEI A,30. ;IF INITIAL JOBRET FAILS, WAIT A WHILE BEFORE JOBGETING, .SLEEP A, ;SINCE IF WE JOBGET BEFORE HE RETRIES WE WILL READ A CLOSE JRST PCLSR ;AND GIVE UP, AND HE WILL DO WHATEVER IT IS TWICE. ; FILOPN - Come here to open a sub-file in the archive. ; The archive's directory is still locked from start-up. FILOPN: MOVE C,OPMODE ; GET OPEN MODE TRNE C,1 ; OPEN FOR READING? JRST OPNWRT ; NO - GO OPEN FOR WRITING MOVE A,JBCFN1 MOVE B,JBCFN2 PUSHJ P,QLOOK ; ATTEMPT A LOOK UP JRST RDFNF ; FILE NOT FOUND PUSHJ P,FILCPT ; Compute file length in byte size open in. FILOP0: HRRZ B,UNRNDM(Q) ADDI B,ARCADR MOVEM B,FILADR MOVEI A,UHREFC(B) MOVEM A,HRZBLK MOVEM A,SOSBLK CRIT1A: AOS UHREFC(B) ; Update file reference count MOVEI A,SOSBLK CRIT1B: MOVEM A,SWTLST SKIPE DIRECTN HRROS UHREFC(B) ; and whether the file is open for writing. CRIT2A: MOVEI A,HRZBLK MOVEM A,SWTLST CRIT2B: JRST FILOP3 ;These two blocks form the locked switch list HRZBLK: 0 ;This word gets the UHREFC word's address. HRRZS @SOSBLK ;This block undoes the HRROS, if there was one. SOSBLK: 0 ;This word gets the UHREFC word's address. SOS @ ;This block undoes the AOS, if there was one. ;The critical code table undoes things if we are in the middle of ;setting up the locked switch list. CRITTB: CRIT1A,,CRIT1B SOS @SOSBLK ;These can be indirect but can't be indexed! CRIT2A,,CRIT2B HRRZS @SOSBLK CRIT3A,,CRIT3B SOS @SOSBLK CRITLN==.-CRITTB FILOP3: MOVE A,UNFN1(Q) ; STORE REAL INFO ABOUT THE FILE MOVEM A,RDEVN+1 MOVE A,UNFN2(Q) MOVEM A,RDEVN+2 .CALL JBST ; GIVE REAL NAMES TO SYS JFCL MOVE A,BYTSIZ ; Create B.P. to ILDB the first byte of the file. LSH A,30 HRR A,FILADR ADDI A,UHBLEN-1 MOVEM A,ACCBP MOVE A,UNREF(Q) ; REFERENCE DATE MOVEM A,ORFDAT HLLZ B,A ; SAVE ISOLATED REFERENCE DATE MOVE A,OPMODE ; DOES HE WANT REFERENCE DATE UPDATED TRNE A,10 ; IF 3.4=1 - DON'T CHANGE REFERENCE DATE JRST FILOP5 SYSCAL RQDATE,[%CLOUT,,A] ; NOW UPDATE REFERENCE DATE SETZM A HLLZS A CAMN A,B ; HAS REFERENCE DATE CHANGED? JRST FILOP5 ; NO - DON'T CHANGE THE PAGE HLLM A,UNREF(Q) ; UPDATE DIRECTORY FILOP5: MOVE A,UNDATE(Q) MOVEM A,CRDATE ; Remember the file's dates in our memory HLLZ A,UNREF(Q) ; so we can return and set them without locking the directory. MOVEM A,REFDATE SETZM DATUPD LDB A,[UNBYTE,,UNREF(Q)] PUSHJ P,BDEC ; Now remember the file's written byte size MOVEM B,FILBSZ ; and how many bytes of that size it has. MOVEI J,44 IDIV J,B ; J gets # bytes per word. MOVE D,@FILADR SUBI D,UHBLEN ; D gets number of words IMUL D,J ; Convert to bytes. SUB D,A ; less bytes which are free MOVEM B,FILBLN ; gives number of bytes, in file byte size. SKIPE DIRECTN PUSHJ P,ARCWRT ; Set archive creation date and dumped bit, if writing. PUSHJ P,UNLOCK JRST OPNWIN ; DONE - OPEN HAS WON ; FILE NOT FOUND - CHECK TO SEE IF BECAUSE OPEN FOR WRITING? RDFNF: HRLZI A,%ENSFL ; BE PREPARED TO REPORT FNF ADDI Q,5 ; ON FNF Q POINTS TO ENTRY BEFORE ; MATCH IF THERE WAS ONE CAIL Q,ARCADR ; SO SEE IF (Q)+5 IS IN BOUNDS CAIL Q,ARCADR+2000 JRST NOGO2 CAMN A,UNFN1(Q) ; SEE IF THE FILE NAMES MATCH CAME B,UNFN2(Q) JRST NOGO2 ; NO - REALLY A FNF HRLZI A,%ENAFL ; - REPORT FILE LOCKED INSTEAD OF FNF JRST NOGO2 ;Compute file's length in bytes of the size it is open for. ;Set up FILLEN and FILRND. Assume that BYTSIZ and BYTSWD are set up. ;Also, return in A and B what BDEC returns (for byte size remembered by file). FILCPT: LDB A,[UNBYTE,,UNREF(Q)] PUSHJ P,BDEC ; Extract byte size of file, and # free bytes in last word. MOVE C,UNRNDM(Q) MOVE D,UHWCNT+ARCADR(C) ; Get length in words. SUBI D,UHBLEN FILCP1: MOVE E,A IMUL E,B ; Number of free BITS in last word. MOVE W,D IMUL W,BYTSWD ; Number of bytes of size file is open in, including WHOLE last word. MOVEM W,FILRND IDIV E,BYTSIZ ; Number of free bytes of size open in in last word. SUB W,E ; File's length in size open in. MOVEM W,FILLEN POPJ P, ;Get in B the byte size of the current file, ;and in A the number of unused bytes in the last word. ;Assume that A contains the UNBYTE field for the file. .SEE UNBYTE ;Comments there explain this code. BDEC: TRNN A,400 JRST BDEC1 LDB B,[060200,,A] ANDI A,77 POPJ P, BDEC1: TRNN A,200 JRST BDEC2 LDB B,[040300,,A] ANDI A,17 POPJ P, BDEC2: CAIG A,44 JRST BDEC3 SUBI A,44 LDB B,[020600,,A] ANDI A,3 POPJ P, BDEC3: MOVEI B,44 SUB B,A MOVEI A,0 POPJ P, ;Update the UNBYTE fiels of the open file's directory entry ;according to what BYTSIZ and FILLEN and FILRND say. ;Assume that Q points at the file's 5-word directory entry BENC: MOVE B,BYTSIZ MOVE A,FILRND SUB A,FILLEN ;B has byte size, A has # free bytes in last word. CAIGE B,19. ;Now do a backwards BDEC, producing result in A. JRST BENC1 MOVEI A,44 SUB A,B JRST BENC9 BENC1: CAIGE B,8 JRST BENC2 LSH B,2 ADDI A,44(B) JRST BENC9 BENC2: CAIGE B,4 JRST BENC3 LSH B,4 ADDI A,200(B) JRST BENC9 BENC3: LSH B,6 ADDI A,400(B) BENC9: DPB A,[UNBYTE,,UNREF(Q)] POPJ P, ; HANDLE OPENS FOR OUTPUT ; OPNWRT - OPEN FOR WRITE OR WRITE OVER OPNWRT: LDB C,[170300,,OPMODE] ; GET EXTRA MODE BITS CAIE C,1 ; OPEN FOR WRITE-OVER? JRST OPNOUT ; NO - GO OPEN FOR OUTPUT PUSHJ P,QLOOK ; DO LOOK TO SEE IF ALREADY EXISTS JRST RDFNF ; NO - GO SEE WHY PUSHJ P,FILCPT ; Set up FILLEN and FILRND. MOVE A,FILLEN MOVEM A,FILBLN PUSHJ P,BENC ; So update the file's UNBYTE field in the directory. OPNWR1: MOVE A,BYTSIZ MOVEM A,FILBSZ ; Since we are writing, the file's byte size is set to ours. .CALL GDATE SETO A, MOVEM A,UNDATE(Q) JRST FILOP0 ; GO COMPLETE THE OPEN ; OPNOUT - OPEN NEW FILE FOR OUTPUT OPNOUT: PUSHJ P,QFNG ; FIXUP ">" AND "<" IF ANY JFCL ; DON'T CARE IF FAIL (DINSRT KNOWS WHAT TO DO) PUSHJ P,DINSRT ; MAKE NEW DIRECTORY ENTRY SETZM FILLEN ; A new file's length is 0, in all units. SETZM FILRND SETZM FILBLN SETZM UNREF(Q) MOVE D,UDDATP+ARCADR ;Create a header with zero data words so things will look OK, HRRM D,UNRNDM(Q) ;and make filename block point at it. MOVEI J,3 ;Construct the header in J thru J+2 SETZB J+1,J+2 MOVE C,[-3,,J] PUSHJ P,JFRCIOT ;And output it, using BLT if page already exists. JUMPG TT,OPNOU1 SYSCAL FINISH,[%CLIMM,,CHDSK] .LOSE %LSFIL PUSHJ P,MAPARC ;maybe that gobbled an additional page, so map all pages again. OPNOU1: MOVEI A,3 ;Remember that data area is 3 words bigger now. ADDM A,UDDATP+ARCADR JRST OPNWR1 GDATE: SETZ ; CALL TO GET FUNNY FORMAT DATE SIXBIT/RQDATE/ SETZM A ; DINSRT - ROUTINE TO INSERT A NEW ENTRY INTO A DIRECTORY ; TAKES FILE NAMES IN A AND B. DINSRT: PUSH P,A ; SAVE FILE NAMES PUSH P,B DINSR1: MOVE TT,UDNAMP+ARCADR CAIGE TT,UDNMIN JRST DIRFUL PUSHJ P,DIRGE1 ; Copy the directory out of the archive (which stays locked). PUSHJ P,DINSR2 ; In sert an entry in the copy, and store filenames from A, B. SETZM UNRNDM(Q) ; Initialze random info .CALL GDATE ; Get current date and time SETO A, MOVEM A,UNDATE(Q) ; Store as file creation date, HLLZM A,UNREF(Q) ; and as file reference date. PUSHJ P,DIRPU1 ; Write the directory back into the archive. SUBI Q,DIRCPY-ARCADR POPBAJ: POP P,B POPAJ: POP P,A POPJ P, DINSR2: PUSHJ P,QLGLKB ; DO THE LOOKUP MOVEI J,DIRCPY+2000 ; DIRECTORY EMPTY MOVE Q,J MOVEI C,-DIRCPY-5(Q) ; GET INDEX TO NEW NAME AREA SLOT CAML C,DIRCPY+UDNAMP ; FARTHER BACK THAN POINTER? JRST DINSR6 ; NO - GO AHEAD MOVEM C,DIRCPY+UDNAMP ; UPDATE INDEX JRST DINSR4 ; AND DON'T BLT DINSR6: SKIPN -LUNBLK(Q) ; SEE IF ENTRY ZERO OR IF BLT NEEDED JRST DINSR4 ; MUST HAVE BEEN DELETED - NO BLT MOVE C,DIRCPY+UDNAMP ; NEED TO BLT - BUILD BLT POINTER ADDI C,DIRCPY ; GET ADDRESS OF START OF NAME AREA HRLS C ; PUT IN BOTH HALVES OF C SUBI C,LUNBLK ; BLT UP ONE NAME BLOCK BLT C,-LUNBLK-1(Q) ; MAKE ROOM MOVE C,DIRCPY+UDNAMP ; UPDATE START POINTER SUBI C,LUNBLK MOVEM C,DIRCPY+UDNAMP DINSR4: SUBI Q,LUNBLK ; BACK UP TO EMPTY ENTRY DINSR5: MOVEM A,UNFN1(Q) ; STORE NEW INFORMATION MOVEM B,UNFN2(Q) POPJ P, QFNG: SKIPA C,[SETZ] ;GENERATE FILE NAME TO REPLACE < OR > ON WRITE QLOOK: MOVEI C,0 PUSH P,J ;Q_FILE # MOVEI J,ARCADR ;GET POINTER TO SHARED COPY OF DIRECTOYR MOVEI Q,2000-LUNBLK(J) ADD J,UDNAMP(J) CAMN A,[SIXBIT />/] TLOA J,400000 CAMN A,[SIXBIT / CAMN B,[SIXBIT />/] TLOA J,400000 CAMN B,[SIXBIT / return non-skip, JRST QLK3 ;causing File Not Found or File Locked. MOVE C,UNRNDM(Q) SKIPL UHREFC+ARCADR(C) TLNE C,UNCDEL CAIA JRST QLK2 ;Found one with no "*" => return skipping. SUBI Q,LUNBLK CAML Q,J JRST QLK1 QLK3: POP P,C POPJJ: POP P,J POPJ P, QLK2: AOS -2(P) JRST QLK3 ;Look up names containing a > or <. QLOOKA: CAME B,[SIXBIT //] JRST POPJJ ;MUST BE READ RETN FILE NOT FOUND QLOOK1: PUSH P,D PUSH P,TT PUSH P,I PUSH P,[-1] ;BEST INDEX PUSH P,[SETZ] ;BEST "NUMERIC" PART PUSH P,[SETZ] ;BEST ALPHA PART QLOOK4: CAIGE Q,(J) JRST QLOOK2 MOVE D,UNRNDM(Q) TLNE D,UNIGFL JUMPGE C,QLOOK3 ;IF CONJURING NAME FOR WRITE, CONSIDER ALL XCT QLKI1(C) JRST QLOOK3 SKIPE TT,@QLKI1+1(C) QLOOK6: TRNE TT,77 ;RIGHT ADJ JRST QLOOK5 LSH TT,-6 JRST QLOOK6 QLOOK5: MOVEI I,0 QLOOK8: LDB D,[600,,TT] CAIL D,'0 CAILE D,'9 JRST QLOOK7 ;NOT A DIGIT QLOK5B: TRNE I,77 ;RIGHT ADJ LOW NON NUM PART JRST QLOK5A LSH I,-6 JUMPN I,QLOK5B QLOK5A: TLC TT,400000 ;AVOID CAM LOSSAGE TLC I,400000 SKIPGE -2(P) JRST QLOK5D ;FIRST MATCH JUMPGE J,QLOK5E ;GET LEAST CAMGE TT,-1(P) ;GET GREATEST JRST QLOOK3 CAME TT,-1(P) JRST QLOK5D CAMGE I,(P) JRST QLOOK3 ;NOT AS GOOD QLOK5D: HRRZM Q,-2(P) MOVEM TT,-1(P) MOVEM I,(P) QLOOK3: SUBI Q,LUNBLK JRST QLOOK4 QLOK5E: CAMLE TT,-1(P) JRST QLOOK3 CAME TT,-1(P) JRST QLOK5D CAMLE I,(P) JRST QLOOK3 JRST QLOK5D QLOOK7: LSHC TT,-6 ;LOW DIGIT NOT NUMERIC JUMPN TT,QLOOK8 ;NO NUMERIC DIGITS AT ALL ("BIN", MAYBE?) JUMPL J,QLOK5B ;IF LOOKING FOR GREATEST, LET THIS BE LEAST MOVNI TT,1 ;GREATEST IF LOOKING FOR LEAST JRST QLOK5B QLOOK2: JUMPL C,QFNG1 ;REALLY WANT TO MAKE F.N.'S FOR WRITE SUB P,[1,,1] POP P,C ;BEST "NUMERIC" PART POP P,Q ;ADR POP P,I POP P,TT POP P,D JUMPL Q,POPJJ MOVE A,UNFN1(Q) ;ACTUAL MATCHED FILE NAMES MOVE B,UNFN2(Q) POP P,J AOS (P) POPJ P, QFNG1: SKIPGE -2(P) JRST QFNG2 ;NOT FOUND START W/ 1 MOVE TT,-1(P) TLC TT,400000 MOVE I,[600,,TT] QFNG3: LDB D,I CAIL D,'0 CAILE D,'9 JRST QFNG4 ;REACH END OF NUMERIC FIELD AOS D CAILE D,'9 JRST QFNG5 DPB D,I QFNG5A: TLNE TT,770000 JRST QFNG3A LSH TT,6 JRST QFNG5A QFNG2: MOVSI TT,(SIXBIT /1/) QFNG3A: MOVEM TT,A(C) ;STORE INTO A OR B AS APPRO SUB P,[3,,3] POP P,I POP P,TT POP P,D JRST POPJJ QFNG5: MOVEI D,'0 DPB D,I ADD I,[60000,,] JUMPL I,QFNG5A JRST QFNG3 QFNG4: TLNN TT,770000 ;SKIP ON ALREADY 6 CHAR NAME LSH TT,6 MOVEI D,'1 DPB D,I MOVEI D,'0 QFNG4B: TLNN I,770000 JRST QFNG5A IDPB D,I JRST QFNG4B QLKI1: CAME B,UNFN2(Q) CAME A,UNFN1(Q) UNFN2(Q) ;ROUTINE TO FIND PLACE IN DIRECTORY WHERE A B WOULD GO ;SKIPS ONL IF DIRECTORY CONTAINS AT LEAST ONE FILE ;FOR INSERTION, FILE GOES BEFORE PNTR RETURNED IN J ;RETURNS PNTR IN Q TO BEGINNING OF NAME AREA ;(ONLY WORKS FOR LUNBLK = 5) QLGLKB: SKIPA J,[DIRCPY] QLGLK: MOVEI J,ARCADR HRRZ Q,UDNAMP(J) ADDI Q,(J) CAIL Q,2000(J) POPJ P, ;DIRECTORY EMPTY TLC A,(SETZ) TLC B,(SETZ) PUSH P,D PUSH P,E ADDI J,600 REPEAT 7,[ CAMGE J,Q JRST .+6 MOVE D,UNFN1(J) TLC D,(SETZ) CAMN A,D JSP E,QLGLE CAML A,D ADDI J,<1_<7-.RPCNT>>*LUNBLK SUBI J,<1_<6-.RPCNT>>*LUNBLK ] CAMGE J,Q ADDI J,LUNBLK CAMGE J,Q JRST 4,. MOVE D,UNFN1(J) TLC D,(SETZ) CAME A,D JRST QLGL1 MOVE D,UNFN2(J) TLC D,(SETZ) CAMLE B,D QLGL2: ADDI J,LUNBLK QLGL3: TLC A,(SETZ) TLC B,(SETZ) POP P,E POP P,D POPJ1: AOS (P) POPJ P, QLGL1: CAML A,D JRST QLGL2 JRST QLGL3 ;CALL BY JSP E,QLGLE QLGLE: MOVE D,UNFN2(J) TLC D,(SETZ) CAMN B,D JRST QLGL3 CAML B,D JRST 1(E) JRST 2(E) ;REMOVE HOLE FROM NAME AREA AT Q QSQSH: PUSH P,A PUSH P,B PUSHJ P,DIRGE1 PUSHJ P,QSQSH0 PUSHJ P,DIRPUT JRST POPBAJ ;Note that Q should point into ARCADR, but we operate on DIRCPY. QSQSH0: MOVEI TT,DIRCPY MOVE A,UDNAMP(TT) ADDI A,(TT) HRRZ C,Q ADDI C,DIRCPY-ARCADR QSQSH1: SUBI C,LUNBLK CAMLE A,C JRST QSQSH2 HRLZ B,C HRRI B,LUNBLK(C) BLT B,2*LUNBLK-1(C) JRST QSQSH1 QSQSH2: REPEAT LUNBLK,SETZM .RPCNT(A) SUBI A,-LUNBLK(TT) HRRZM A,UDNAMP(TT) POPJ P, QBTBLI: 440600,, ;IF GOING TO ILDB 360600,, 300600,, 220600,, 140600,, 060600,, 000600,, ;Generate an ASCII directory. Write the whole thing as an ASCII string ;starting at NEWDAT. FILBLN gets the number of characters. DIRASC: MOVE D,[440700,,NEWDAT] SETZM FILBLN ;initialize vars used for creating the directory string. MOVE B,AFDEV PUSHJ P,DIRSI4 ;Output machine name and disk dir which archive resides on. MOVE B,RDIRN PUSHJ P,DIRSIX MOVEI A,40 PUSHJ P,DIRCHR MOVE B,RDEVN PUSHJ P,DIRSIX ;Output archive device name, and archive file's FN2. MOVEI A,40 PUSHJ P,DIRCHR MOVE B,AFFN2 PUSHJ P,DIRSIX PUSHJ P,DIRCRL MOVEI B,[ASCIZ /Free files = /] PUSHJ P,DIRSTR MOVE B,ARCADR+UDNAMP SUBI B,UDNMIN-LUNBLK+1 IDIVI B,LUNBLK ;Compute # of filename blocks we have room for. PUSHJ P,DIRDEC MOVEI B,[ASCIZ /, Wasted Words = /] PUSHJ P,DIRSTR PUSHJ P,DIRWST PUSHJ P,DIRDEC PUSHJ P,DIRCRL MOVE Q,ARCADR+UDNAMP ADDI Q,ARCADR ;Q gets addr of first existing file. DIRFIL: CAIN Q,ARCADR+2000 JRST DIRPAD MOVEI A,40 ;First, a space, or a star for an inaccessible file. MOVE B,UNRNDM(Q) SKIPL UHREFC+ARCADR(B) ;File is being written, or TLNE B,UNIGFL ;is marked for deletion, => MOVEI A,"* ;mark it with a star. PUSHJ P,DIRCHR MOVEI B,[ASCIZ / 0 /] PUSHJ P,DIRSTR MOVE B,UNFN1(Q) ;Then come the FN1 PUSHJ P,DIRSIX MOVEI A,40 PUSHJ P,DIRCHR MOVE B,UNFN2(Q) ;and the FN2. PUSHJ P,DIRSIX MOVEI A,40 PUSHJ P,DIRCHR MOVE B,UNRNDM(Q) MOVE B,UHWCNT+ARCADR(B) ADDI B,1777-UHBLEN LSH B,-10. PUSHJ P,DIRDEC ;and then the size in K. MOVEI B,[ASCIZ / /] ;No archive files are ever dumped, PUSHJ P,DIRSTR ;so don't mention any dumped-bit. MOVE A,UNDATE(Q) PUSH P,D MOVE D,[440700,,DIRDAT] PUSHJ P,DATIME"TWDASC ;Convert creation date/time to ASCII POP P,D MOVEI B,DIRDAT PUSHJ P,DIRSTR ;and copy into the directory. PUSHJ P,DIRCRL ;That's all for this file. ADDI Q,LUNBLK JRST DIRFIL ;Pad the end of an ASCII directory with ^C's. DIRPAD: MOVE B,D MOVEI A,^C REPEAT 5,IDPB A,B POPJ P, ;Subroutines for generating ASCII directories. ;Output the next character of one. ;The character is in A. Stuff it down bp in D and count in FILBLN. MPVOK3:: DIRCHR: IDPB A,D AOS FILBLN POPJ P, ;Output the SIXBIT word in B as six characters. DIRSI4: SKIPA C,[4] ;DIRSI2 outputs only the first four. DIRSIX: MOVEI C,6 DIRSI1: SETZ A, ROTC A,6 ADDI A,40 PUSHJ P,DIRCHR SOJG C,DIRSI1 POPJ P, ;Send a CRLF to the ascii directory. DIRCRL: MOVEI A,^M PUSHJ P,DIRCHR MOVEI A,^J JRST DIRCHR ;Output ASCIZ string B points at into the ASCII directory. DIRSTR: HRLI B,440700 DIRST1: ILDB A,B JUMPE A,CPOPJ PUSHJ P,DIRCHR JRST DIRST1 ;Print number in B in decimal into the ASCII directory. DIRDEC: IDIVI B,10. HRLM C,(P) SKIPE B PUSHJ P,DIRDEC HLRZ A,(P) ADDI A,"0 JRST DIRCHR DATIME"$$OUT==1 ;Insert the TWDASC routine for converting times to asciz. .INSRT SYSENG;DATIME DIRDAT: BLOCK 5 ;Buffer for TWDASC to use. ;Handle .IOT. JIOT: MOVE A,JBCOP TLNN A,100000 ;Skip if output IOT JRST JIOTI TLNN A,200000 ;Skip if block IOT JRST JIOTO1 HLRE D,JBCWD1 ;User's block IOT pointer - get word count. MOVNS D ;D has number of words we want to write. JIOTO2: MOVE C,FILRND ;C gets # of bytes that fit in existing space allocated. SUB C,ACCP ;How many remain past current access pointer? SKIPN C ;Are we pointing exactly at end of file? PUSHJ P,JIOTEX ;If so, prepare to extend the file. JUMPGE C,JIOTO5 ;If this is extending the file, make sure we don't overflow maximum. MOVEI A,NEWMAX IMUL A,BYTSWD ;How many bytes is the most we can fit in memory? MOVE B,NEWLEN ADD B,C ;How many will we have, of data to extend with, after this? CAML B,A ;Will it fit? JRST JIOTDF ;No. Give a "device fill" ioc error. JIOTO5: SKIPLE C ;Are we extending the file? CAMLE C,D ;No, we are overwriting it. If whole IOT will fit in existing length, MOVE C,D ;do it all. Else rewrite existing stuff, then loop around ;and come through JIOTO2 to xfer the rest and extend the file. SUB D,C ;# bytes of user's IOT that will be left. MOVE A,JBCOP TLNE A,200000 ;Now read the bytes from the user. JRST JIOTO4 ;using SIOT or block IOT, whichever we can. MOVE A,C ;SIOT directly into the file's data. MPVOK1: SYSCAL SIOT,[ 1000,,CHBOJ ? ACCBP ? C] .VALUE SUB A,C ;A gets # bytes we got, C # we wanted but didn't get. JIOTO3: PUSHJ P,UPDACP ;Update access pointer in bytes. Access b.p. already incremented. JUMPN C,GOLOOP ;Now, if this IOT was pclsr'ed, don't try to do ;any more for it. If it comes back in we will find out. JUMPE D,GOLOOP ;If there is more stuff to output, JRST JIOTO2 ;go read it in and extend the file. ;Here to xfer from creator in block mode. JIOTO4: MOVN B,C HRLZS B HRR B,ACCBP AOS B ;Point at first unfilled word, not last filled. MPVOK2: .IOT CHBOJ,B HRRZ A,B SUB A,ACCBP MOVEI A,-1(A) ;A gets number of words we got. SUB C,A ;C gets # that we expected but didn't get. ADDM A,ACCBP JRST JIOTO3 ;Here to begin extending the file. Start writing into NEWDAT instead of the file's data. ;Core in NEWDAT is created by MPVs. JIOTEX: MOVEI A,NEWDAT-1 ;Create 010700,,NEWDAT-1 or 004400,,NEWDAT-1 HRRM A,ACCBP POPJ P, ;Here to decode a unit mode IOT or SIOT. JIOTO1: TLNE A,%JGSIOT ;Skip if unit IOT. SKIPA D,JBCWD1 ;Else it's SIOT, get the byte count. MOVEI D,1 ;Unit IOT, byte count is 1. JRST JIOTO2 ;Update our access pointer when we write C(A) bytes. UPDACP: ADDB A,ACCP SKIPL FILLEN ;If file length known, CAMG A,FILLEN ;and writing past end of file, POPJ P, MOVEM A,FILLEN ;update the file length. MOVEM A,FILBLN ;Since we're writing, byte size written and current byte size must be the same. SUB A,FILRND ;Get how many of the bytes were added above old allocated space. CAML A,NEWLEN MOVEM A,NEWLEN ;Store as amount of bytes to extend file by when we close. POPJ P, JIOTDF: SYSCAL JOBIOC,[%CLIMM,,CHBOJ ? %CLIMM,,11] .LOSE %LSFIL JRST GOLOOP JIOTI: TLNN A,200000 ;SKIP IF BLOCK IOT JRST JIOTI3 HLRE C,JBCWD1 ;USER'S BLOCK IOT POINTER - GET WD COUNT. MOVNS C ;C HAS # BYTES THE USER WANTS IN THIS IOT OR SIOT. ;A HAS JBCOP, EVERYWHERE ON THIS PAGE. DON'T CLOBBER IT! JIOTI1: MOVE D,FILLEN SUB D,ACCP ;How many bytes of file remain past current access pointer? JUMPLE D,JIOTIE CAML D,C MOVE D,C ;D gets # of bytes we can give the user. SUB C,D ;C gets number user wants beyond that (beyond EOF). TLNN A,200000 JRST JIOTI4 ;NOW IN UNIT MODE GO XFER THEM WITH SIOT. MOVNS D HRLZS D HRR D,ACCBP ;IN BLOCK MODE, MAKE AOBJN TO WHAT WE WILL GIVE AOS D .IOT CHBOJ,D ;GIVE SKIPGE D ;IF CREATOR DIDN'T TAKE ALL WE OFFERED, HE WAS SETZ C, ;PCLSRED, SO DON'T TRY TO OFFER ANY MORE. MOVEI E,-1(D) SUB E,ACCBP ;NUMBER OF WORDS GIVEN TO CREATOR ANDI E,-1 ADDM E,ACCBP ;HERE E HAS # BYTES WE JUST GAVE THE USER. ACCBP HAS BEEN UPDATED, JIOTI5: ADDM E,ACCP JUMPN C,JIOTI1 ;NOW, IF CREATOR'S IOT NOT ALL FILLED, GIVE HIM MORE. JRST GOLOOP ;Here for unit mode IOT or SIOT to determine amount to transfer. JIOTI3: TLNE A,%JGSIOT ;SKIP IF UNIT IOT SKIPA C,JBCWD1 ;SIOT, GET BYTE COUNT MOVEI C,1 ;IOT, TRANSFER ONE BYTE JRST JIOTI1 ;HERE TO GIVE THE CREATOR SOME DATA IN UNIT MODE. JIOTI4: MOVE E,D SYSCAL SIOT,[1000,,CHBOJ ? ACCBP ? D] .VALUE SUB E,D ;E GETS # BYTES HE TOOK. SKIPE D ;IF HE DIDN'T TAKE ALL WE OFFERED, HE WAS PCLSRED, SETZ C, ;SO DON'T TRY TO GIVE HIM ANY MORE. JRST JIOTI5 ;Handle attempt to read when at EOF. JIOTIE: MOVE A,JBCOP TLNN A,201000 ;SKIP IF BLOCK OR SIOT BIT ON JRST JIOTI6 ;FOR UNIT-MODE IOTS, RETURN SOMETHING. .CALL JBRTL ;JUST UNHANG A BLOCK IOT OR SIOT. PCL JRST GOLOOP JIOTI6: TLNE A,400000 ;EOF, AND USER'S CHANNEL IS UNIT MODE. JRST JIOTI8 .IOT CHBOJ,[-1,,^C] ;IF ASCII, INDICATE EOF (CHBOJ IS UNIT MODE) JRST GOLOOP JIOTI8: SYSCAL JOBIOC,[MOVEI CHBOJ ? MOVEI 2] ;IOCERR FOR EOF JFCL JRST GOLOOP ;ON UNIT IMAGE CHANNEL ;The creator closed his channel. JCLS: SKIPN FILADR ;If a file is open, JRST JCLS1 PUSHJ P,JFORCE ;write out any extension data. JFCL PUSHJ P,LOCK PUSHJ P,MAPARC PUSHJ P,CLSDEL ;Closing a file can delete an existing one. MOVE B,FILADR HRRZS UHREFC(B) ;Remove our traces from the reference count SETZM SWTLST ;and unlock our locks. CRIT3A: SOS UHREFC(B) CRIT3B: JRST JCLS2 JCLS1: PUSHJ P,LOCK PUSHJ P,MAPARC JCLS2: PUSHJ P,ARCDEL ;Delete this file if desired, and it's now no longer open. PUSHJ P,ARCSAL ;Maybe eliminate wasted space. PUSHJ P,UNLOCK JRST DIE ;When we close a file we were writing, delete any existing file with the same name. CLSDEL: MOVE B,UNRNDM(Q) SKIPGE UHREFC+ARCADR(B) TLNE B,UNCDEL ;(but not if this file is going to be deleted itself). POPJ P, MOVE A,UNFN1(Q) ;Get this file's filenames. MOVE B,UNFN2(Q) MOVE C,UDNAMP+ARCADR ADDI C,ARCADR MOVSI D,UNCDEL CLSDE1: CAIN C,2000+ARCADR ;Scan through the directory POPJ P, CAMN A,UNFN1(C) ;for all files with those names. CAME B,UNFN2(C) JRST CLSDE2 HRRZ TT,UNRNDM(C) ;All files with those names, not being written, CAME C,Q ;(aside from the one we're closing!) SKIPGE UHREFC+ARCADR(TT) JRST CLSDE2 IORM D,UNRNDM(C) ;Get marked for deletion CLSDE2: ADDI C,LUNBLK ;(which will be done right away, by ARCDEL, JRST CLSDE1 ; except for files open for reading). JFINISH:PUSHJ P,JFORCE JRST DVFLERR JRST JSUCC ;Extend a file, adding to it the output we have been saving up in NEWDAT JFORCE: SKIPN DIRECTN ;If we are writing a file, stick it into the directory. JRST JFRCDT MOVE B,FILLEN CAMN B,OFILLEN ;If we have output something since the last time here, JRST JFRCDT MOVEM B,OFILLEN PUSHJ P,LOCK ;Lock the archive and stick the new stuff into it. PUSHJ P,MAPARC SKIPN B,NEWLEN ;Do we need to allocate any more words? JRST JFOR1 ;No => just update # free bytes in last word. MOVE D,FILADR ;Yes => we must extend the file. ADD D,UHWCNT(D) SUBI D,ARCADR HRRZ A,UNRNDM(Q) CAMN D,UDDATP+ARCADR ;Is this file the last thing in the archive? JRST JFRCX ;Yes => we can extend it in place. MOVN C,@FILADR ;Otherwise we must recopy the old contents at the end. HRLZS C HRR C,FILADR ;Write out a copy of the file's old contents. MOVE D,UDDATP+ARCADR ;Start writing where allocation is being done. MOVE A,D PUSHJ P,JFRCIOT ;Simulate .IOT, using BLT on existing pages. JRST UNLOCK ;A has new value for file's UNRNDM rh. JFRCX: MOVE J,NEWLEN ;D has updated access pointer. ADD J,BYTSWD SUBI J,1 IDIV J,BYTSWD ;How many WORDS are we growing by? MOVE C,J ADD C,D CAIL C,ARCMAX ;Return non-skip if we will exceed maximum archive device size. JRST UNLOCK PUSH P,J MOVN C,J HRLZS C ;Write out the data we are extending the file with. HRRI C,NEWDAT PUSHJ P,JFRCIOT .VALUE MOVEM D,UDDATP+ARCADR ;Advance the data area free pointer over what we just gobbled. JUMPG TT,JFOR2 ;If we .IOT'ed to make new pages, SYSCAL FINISH,[%CLIMM,,CHDSK] .LOSE %LSFIL ;Do a finish, so that pages are all on disk when we unlock. PUSHJ P,UNLOCK ;Unlock and relock to make all pages be in the disk ufd, PUSHJ P,LOCK PUSHJ P,MAPARC ;map those pages in. ;This temporary unlocking can't cause any problems, because the new data area ;is marked as allocated so can't be reused, but no file points at it so nobody can touch it. ;Also, since we have a file open, nobody can salvage the archive, ;and the old file data area can't change since only we have it open. JFOR2: MOVE B,(P) ADD B,@FILADR ;Compute new total length in words, including header. MOVEM B,UHWCNT+ARCADR(A) ;Store as length of file data area. IMUL B,BYTSWD MOVEM B,FILRND ;Store # of bytes now allocated to the file. HRRM A,UNRNDM(Q) ;Store new location of file in directory. ADDI A,ARCADR MOVEM A,FILADR ;Store new address of file. POP P,A ;Flush the core we were using ADDI A,1777 ;to hold the data we just wrote out. LSH A,-10. MOVNS A HRLZS A HRRI A,NEWDAT/2000 SYSCAL CORBLK,[%CLIMM,,0 ? %CLIMM,,%JSELF ? A] .LOSE %LSSYS SETZM NEWLEN JFOR1: PUSHJ P,BENC ;Update the UNBYTE fiels of the file's directory entry. JRST JFOR3 JFRCDT: SKIPN DATUPD JRST POPJ1 PUSHJ P,LOCK JFOR3: MOVE A,CRDATE ;Update the file's dates stored in the directory, MOVEM A,UNDATE(Q) MOVE A,REFDAT HLLM A,UNREF(Q) SETZM DATUPD ;and say that they are now up to correct there. PUSHJ P,UNLOCK ;Unlock the file (close CHDSK). MOVEI A,ARCADR/2000 SYSCAL PGWRIT,[A] ;Make sure all pages of archive are up-to-date on disk. CAIA AOJA A,.-2 JRST POPJ1 ;Extend the archive file by effectively doing .IOT CHDSK,C, with access pointer from D. ;But, to avoid screws, any of the transfer which goes to a page which already exists ;must also be BLT'ed into that page. ;When we return, TT is negative if any new pages were created. ;Clobbers E. Updates D by the number of words transferred. ;Skips unless the archive became full. JFRCIOT: PUSH P,B PUSH P,C HLRZS C SUBM D,C CAIL C,ARCMAX JRST POPDBJ .ACCESS CHDSK,D .IOT CHDSK,C ;First, IOT the whole thing so file length is set right. POP P,C HLRE E,C MOVNS E ;E gets number of words to be transferred. PUSH P,D ADDM E,(P) ;Store on the PDL, to be popped, the updated value of D. MOVE TT,UDDATP+ARCADR ADDI TT,1777 TRZ TT,1777 SUBI TT,(D) ;How many words fit on existing page? JUMPLE TT,JFRCI1 ;None, starting past the last mapped page, => ;no need to BLT anything. CAMGE E,TT JRST JFRCI2 MOVE E,TT ;get number of words to transfer, on existing page. SETO TT, ;If we will make new pages, leave TT negative. JFRCI2: HRLZ B,C HRR B,D ADDI B,ARCADR ;Transfer them with BLT. ADD D,E BLT B,ARCADR-1(D) JFRCI1: AOS -2(P) POPDBJ: POP P,D POPBJ: POP P,B POPJ P, NEWLEN: 0 ;# of bytes we are buffering up to add to the end of the file. ;Handle .ACCESS and .CALL ACCESS JACCCL: PUSHJ P,JACC0 ;.CALL ACCESS JRST WTDERR .CALL JBRT1 PCL JRST GOLOOP JACC: MOVE A,JBCWD1 ;.ACCESS. PUSHJ P,JACC0 JFCL JRST JSTS JACC0: SKIPE DIRFLG ;Can't change access pointer if reading a directory. POPJ P, MOVEM A,ACCP ;Set the access pointerk in bytes. CAMLE A,FILRND ;Set the access byte pointer. JRST JACC1 IDIV A,BYTSWD ADD A,FILADR MOVEI A,UHBLEN-1(A) ;get address of word before the one containing next byte. JACC3: MOVE C,BYTSIZ DPB C,[300600,,A] ;Store the byte size in the byte pointer. JUMPE B,JACC2 IBP A ;Advance the appropriate number of bytes past word boundary. SOJG B,.-1 JACC2: MOVEM A,ACCBP JRST POPJ1 JACC1: SUB A,FILRND IDIV A,BYTSWD MOVEI A,NEWDAT-1(A) JRST JACC3 JRESET: JSTS: .CALL JBRTL PCL JRST GOLOOP ;Handle .RCHST and .CALL RCHST JRCH: SYSCAL JOBRET,[ 1000,,CHBOJ 1000,,0 [-5,,RDEVN]] JFCL JRST GOLOOP JSYSCL: MOVE B,JBCWD1 ;Handle a .CALL. What is its name? MOVE A,JBCWD5 ;dispatch to it with its 2nd arg in A. CAMN B,['FILLEN] JRST JFILLEN CAMN B,['SFDATE] JRST JSFDAT CAMN B,['RFDATE] JRST JRFDAT CAME B,[SIXBIT /FORCE/] CAMN B,[SIXBIT /FINISH/] JRST JFINISH CAMN B,[SIXBIT /ACCESS/] JRST JACCCL CAMN B,[SIXBIT /RFPNTR/] JRST JRFPNT CAMN B,[SIXBIT /SRDATE/] JRST JSRDAT CAMN B,[SIXBIT /RRDATE/] JRST JRRDAT CAMN B,[SIXBIT /RESRDT/] JRST JRESRDT CAMN B,[SIXBIT /DELEWO/] JRST JDELWO CAMN B,[SIXBIT /FILBLK/] JRST JFILBLK ;If the call is onw we don't handle, return "wrong type device". WTDERR: MOVSI A,%EBDDV ;Return "Wrong Type Device" error. ERR: MOVEM A,ERRCOD .CALL JBRT3 PCL JRST GOLOOP DVFLERR:SKIPA A,[%EFLDV,,] ILFERR: MOVSI A,%EBDFN ;Return "Illegal Filename" error. JRST ERR ;Individual .CALL handlers. JRFPNT: HRROI A,ACCP ;RFPNTR. JRST JSUCC JFILLE: MOVE A,[-4,,FILLEN] ;FILLEN. JSUCC: SKIPE DIRFLG JRST WTDERR JCALRT: MOVEM A,JRFDAP JCALR1: SYSCAL JOBRET,[ 1000,,CHBOJ ? 1000,,1 ? JRFDAP] PCL ;THE SYSTEM CALL WAS PCLSR'ED AND COMES IN AGAIN. JRST GOLOOP JRFDAP: 0 JSFDAT: MOVEM A,CRDATE ;SFDATE. Set our cached date but don't write directory yet. SETOM DATUPD ;Set flag saying dir must be updated later. JRST JSUCC JRFDAT: HRROI A,CRDATE ;RFDATE. JRST JSUCC JRRDAT: HRROI A,REFDAT ;RRDATE. JRST JSUCC JRESRDT: MOVE A,ORFDAT ;RESRDT. Restore ref date which was in effect before the open. JSRDAT: HLLM A,REFDAT ;SRDATE. SETOM DATUPD JRST JSUCC ;Return five words: fn1, fn2, "random", cdate, rdate+byte count. JFILBLK: SKIPE DIRFLG JRST WTDERR PUSHJ P,LOCK ;Lock the directory. SKIPN DATUPD JRST JFILB1 MOVE A,CRDATE ;If nec., update the file's dates stored in the directory, MOVEM A,UNDATE(Q) MOVE A,REFDAT HLLM A,UNREF(Q) SETZM DATUPD ;and say that they are now up to correct there. JFILB1: HRL A,Q ;Copy the 5 words out of the dir, so we can unlock fast. HRRI A,RNDM BLT A,RNDM+LUNBLK-1 PUSHJ P,UNLOCK MOVE A,[-5,,RNDM] ;Return the values. JRST JCALRT ;Rename while open. JRNMWO: SKIPE JBCWD1 ;make sure that neither filename is zero. SKIPN JBCWD6 JRST ILFERR SKIPE DIRFLG JRST WTDERR PUSHJ P,LOCK ;Lock dir, get filename block address in Q. PUSHJ P,MAPARC PUSHJ P,JRNM1 JRST JCALR1 JRNM1: PUSHJ P,ARCWRT PUSH P,UNDATE(Q) ;Don't clobber creation date, etc. PUSH P,UNRNDM(Q) PUSH P,UNREF(Q) PUSHJ P,DIRGE1 ;Make a copy of the directory. PUSHJ P,QSQSH0 ;Delete the old filename block. MOVE A,JBCWD1 MOVE B,JBCWD6 PUSHJ P,QFNG ;process a > or < appearing in the new filenames. JFCL MOVEM A,RDEVN+1 MOVEM B,RDEVN+2 ;Report changed names to RFNAME system call. .CALL JBST .LOSE %LSFIL PUSHJ P,DINSR2 ;Make a new one at the appropriate place, with the new names. POP P,UNREF(Q) ;The other three words carry over from the old entry. POP P,UNRNDM(Q) POP P,UNDATE(Q) JRST DIRPUT ;Return to JCALL do do the JOBRET. ;Rename/delete. ;This is an initial operation, done when there is no JOB channel open yet, ;so the directory is still locked from the initialization. JFDELE: MOVE A,JBCFN1 MOVE B,JBCFN2 CAMN A,['.FILE.] CAME B,[SIXBIT /(DIR)/] CAIA JRST ILFERR PUSHJ P,QLOOK ; Look for the file we are going to rename or delete. JRST RDFNF ; Can't find it => report error. SKIPE JBCWD1 ;Is this delete or rename? JRST JFDELR ;Rename. PUSHJ P,ARCWRT HRRZ B,UNRNDM(Q) ;Delete. SKIPE UHREFC+ARCADR(B) ;Is file being referred to? If not, JRST JFDELD PUSHJ P,DIRGE1 ;we can delete it now. Copy the directory, PUSHJ P,QSQSH0 ;delete the filename block, PUSHJ P,DIRPUT ;rewrite the directory. JFDELW: SYSCAL JOBRET,[%CLIMM,,CHBOJ ? %CLIMM,,1] ;Return success. PUSHJ P,IJBRTF JRST JCLS1 ;Commit suicide, since no channel open. Maybe salvage. JFDELD: MOVSI C,UNCDEL ;Deleting a file that's being read. IORM C,UNRNDM(Q) ;Set bit to cause it to be deleted when closed. JRST JFDELW ;Rename. Now that the filename block address is in Q, JFDELR: PUSH P,Q MOVE A,JBCWD1 MOVE B,JBCWD6 CAME B,[SIXBIT />/] CAMN B,[SIXBIT //] CAMN A,[SIXBIT /&-2000 ;Address of place to map in the archive pages. DIRCPY==540000 ;Address of place to put temporary copy of archive directory. NEWDAT==542000 ;Address of place to put stuff to add to end of file. NEWMAX==776000-NEWDAT ;Max number of words of extension data we can hold. ARCMAX==DIRCPY-ARCADR ;Maximum size archive we can handle. END GO