github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-16 08:24:38 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/syseng/arcdev.69
Lars Brinkhoff a35deeeb66 Build ARCDEV.
2016-11-11 21:10:29 +01:00

1963 lines
55 KiB
Plaintext
Executable File
Raw Blame History

This file contains invisible Unicode characters

This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

;-*-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 /</]
JRST QLOOKA ;4.9 BIT OF J SET IF >
CAMN B,[SIXBIT />/]
TLOA J,400000
CAMN B,[SIXBIT /</]
AOJA C,QLOOK1
PUSHJ P,QLGLK
JRST POPJJ ;FNF
TRNN J,1777
JRST POPJJ ;J IS OFF THE END OF THE BLOCK
PUSH P,C
QLK4: CAIL J,ARCADR+2000-LUNBLK
JRST QLK5
CAMN B,UNFN2+5(J) ;Now scan forward PAST all the files with this name.
CAME A,UNFN1+5(J)
JRST QLK5
ADDI J,LUNBLK
JRST QLK4
QLK5: EXCH Q,J ;Then scan back through them all for the one with no "*".
QLK1: CAMN A,UNFN1(Q)
CAME B,UNFN2(Q) ;They all have stars => 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 /</]
CAMN 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 /</]
JRST JFDEL1
CAME A,[SIXBIT />/]
CAMN A,[SIXBIT /</]
JRST JFDEL1
PUSHJ P,QLOOK ;Make sure no file exists with the specified new names.
JRST JFDEL1
CAMN Q,(P) ;(but allow rename to the same names as now).
JRST FILXST
JFDEL1: POP P,Q
PUSHJ P,JRNM1 ;just do a rename-while-open,
JRST JFDELW
JDELWO: SKIPE DIRFLG ;DELEWO. Mark file to be deleted when closed.
JRST WTDERR
PUSHJ P,LOCK
MOVSI C,UNCDEL
IORM C,UNRNDM(Q)
PUSHJ P,ARCWRT
JRST JCALR1
TSINT: 0
0
SKIPL TSINT
JRST TSFW
SETOM INT
.DISMISS TSINT+1
TSFW: PUSH P,A
MOVE A,TSINT
TRZE A,%PIMPV
PUSHJ P,TSMPV
TRZE A,%PIIOC
PUSHJ P,TSIOC
POP P,A
.DISMIS TSINT+1
;When an MPV interrupt happens from one of the right places, create the core.
TSMPV: PUSH P,A
HRRZ A,TSINT+1
CAIE A,MPVOK1
CAIN A,MPVOK2
JRST TSMPV1
CAIE A,MPVOK3
.VALUE
TSMPV1: .SUSET [.RMPVA,,A]
LSH A,-10.
SYSCAL CORBLK,[%CLIMM,,%CBNDW ? %CLIMM,,%JSELF ? A ? %CLIMM,,%JSNEW]
JSR CBKLOS
POP P,A
POPJ P,
;IOC error must be disk full. Just wait a while and try again.
;(could also be directory full, but what can we do?)
TSIOC: PUSH P,TT
PAUSE
POP P,TT
POPJ P,
;COME HERE TO REALLY GIVE UP THE GHOST.
DIE: .LOGOUT 1,
JRST DIE
JBGT: SETZ
'JOBCAL
[CHBOJ]
2000,,JBCOP
SETZ [-11.,,JBCWD1]
JBST: SETZ
'JOBSTS
MOVEI CHBOJ
MOVEI 43 ;SNDSK
RDEVN
RDEVN+1
RDEVN+2
SETZ RDIRN
JBRT1: SETZ ;JOBRET call block to report success.
SIXBIT /JOBRET/
[CHBOJ]
SETZ [1]
JBRTL: SETZ ;JOBRET to return non-skipping but with no error code.
SIXBIT /JOBRET/
[CHBOJ]
SETZ [0]
JBRT3: SETZ ;JOBRET to return an error code.
SIXBIT /JOBRET/
[CHBOJ]
SETZ ERRCOD
ERRCOD: 0 ;ERROR CODE PUT IN HL OF THIS WORD.
;DATA RETURNED BY JOBCAL.
JBCOP: 0 ;OPCODE: 0-8 MEANING OPEN, IOT, MLINK, RESET, RCHST, ACCESS, DELETE/RENAME, RENMWO, .CALL.
JBCWD1: 0 ;BLOCK IOT PTR / ACCESS PTR / NEW FN1 IN RENAME&MLINK / 0 IN DELETE. / SYSTEM CALL NAME.
JBCFN1:
JBCWD2:: 0 ;FN1
JBCFN2:
JBCWD3:: 0 ;FN2
JBCSNM:
JBCWD4:: 0 ;SNAME
JBCDEV:
JBCWD5:: 0 ;DEVICE
JBCWD6: 0 ;NEW FN2 IN RENAME&MLINK / OPEN MODE IN OPEN.
JBCWD7: 0 ;NEW SNAME IN MLINK.
JBCWD8: 0
JBCWD9: 0
JBCW10: 0
JBCW11: 0
LPDLL==20
PDL: BLOCK LPDLL+4
CONSTANTS
VARIABLES
ARCADR==<.+1777>&-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
Reference in New Issue View Git Blame Copy Permalink