;<PUP>PSVLEF.MAC.39, 24-Nov-82 09:49:11, Edit by SCHOEN
; Deposit correct AC into leader page at end of GETSIZ
;<PUP>PSVLEF.MAC.38, 3-Nov-82 17:34:06, Edit by SCHOEN
; Use CLZFF at CLNF2 to kill JFNs of server fork
;<PUP>PSVLEF.MAC.37, 18-Oct-82 08:54:54, Edit by SCHOEN
; remove LFINIT table
;<SCHOEN.LEAF>PSVLEF.MAC.4, 31-Jul-82 12:00:24, Edit by SCHOEN
; Present more debugging information when server fork crashes
; Don't log errorLeafs unless debugging
;<PUP>PSVLEF.MAC.33, 15-Jun-82 12:40:40, Edit by SCHOEN
; Make sure $closf clears out JFNTAB and WILDFT if it closes and releases
; the JFN, else just clear out RH of these table entries
;<PUP>PSVLEF.MAC.25, 7-Jun-82 14:47:02, Edit by SCHOEN
; $CLOSF senses unopened files, and does RLJFN instead.
; CHKHDL returns +2 for legal, unopened JFN, +3 for legal, opened JFN
; Add PROPL3 routines to GTJFN file (but not open it) for prop list functions
; CHKVER with b0 of p3 on doesn't open file
; Add Size (byte count) to list of known properties
;<PUP>PSVLEF.MAC.24, 4-Jun-82 18:51:20, Edit by SCHOEN
; Begin adding Property List functions
;<PUP>PSVLEF.MAC.23, 3-May-82 16:14:54, Edit by SCHOEN
; GETPTR was computing bytepointers incorrectly
;<PUP>PSVLEF.MAC.16, 27-Apr-82 22:59:38, Edit by SCHOEN
; Make the server wakeup mechanism more efficent (and complicated)
;<PUP>PSVLEF.MAC.15, 23-Apr-82 11:56:18, Edit by SCHOEN
; Make sure proper byte count gets set when EOF bit on in LeafWrite
;<PUP>PSVLEF.MAC.14, 22-Apr-82 11:05:13, Edit by SCHOEN
; Add log dump to background loop
;<PUP>PSVLEF.MAC.13, 11-Apr-82 22:25:05, Edit by SCHOEN
; Add LFINIT table to signal server fork ready to run
;<PUP>PSVLEF.MAC.12, 11-Apr-82 21:59:53, Edit by SCHOEN
; Check for Sequin received queue being empty before dismissing LEAFSV
; interrupt; repeat service code if queue non-empty.
;<PUP>PSVLEF.MAC.11, 10-Apr-82 20:52:20, Edit by SCHOEN
; PSQVAR, PSQPVR -> TOPVAR, TOPPVR so PUPUUO.MAC loads correctly
;<PUP>PSVLEF.MAC.10, 9-Apr-82 14:02:19, Edit by SCHOEN
; LOGBFS was supposed to be in units of words, not pages!
;<PUP>PSVLEF.MAC.8, 1-Apr-82 12:38:38, Edit by SCHOEN
; Don't search SYSDEF; PUPDEF was compiled with SYSDEF
;<PUP>PSVLEF.MAC.7, 31-Mar-82 17:14:09, Edit by SCHOEN
; Use BYTCNT(JFN) in READLF to determine whether read is past EOF
;<PUP>PSVLEF.MAC.5, 31-Mar-82 16:05:18, Edit by SCHOEN
; Replace SHRVAR mechanism with proper use of USEVAR
;<PUP>PSVLEF.MAC.4, 31-Mar-82 15:15:17, Edit by SCHOEN
; Keep track of file byte count during write operations, since paged
; I/O in Tenex/Tops-20 does not update EOF pointer.
;<PUP>PSVLEF.MAC.3, 18-Mar-82 13:37:26, Edit by SCHOEN
; HRRZ 1,FILVER -> HRR 1,FILVER at GETJFN+5. Don't wipe out GTJFN flags
;<SCHOEN>PSVLEF.MAC.79, 28-Feb-82 15:29:53, Edit by SCHOEN
; replace ! in list of version leadin. "OPENFILE(FOO.BAR;T)"
; on dolphin causes it to look for FOO.BAR!T.
;<SCHOEN>PSVLEF.MAC.78, 28-Feb-82 15:11:22, Edit by SCHOEN
; Make PRSFIL understand attributes in file names
; Remove ! from list of version leadins
;<SCHOEN>PSVLEF.MAC.77, 25-Feb-82 11:09:33, Edit by SCHOEN
; [Tops20] Make CHKACC return proper error codes in A
;<SCHOEN>PSVLEF.MAC.76, 20-Feb-82 17:38:26, Edit by SCHOEN
; Make MAPDAT extern, wait for system to have date/time before
; starting.
;<SCHOEN>PSVLEF.MAC.75, 17-Feb-82 15:26:22, Edit by SCHOEN
; Fix RIFSST to handle odd length strings correctly (dumb!)
;<SCHOEN>PSVLEF.MAC.73, 3-Feb-82 14:53:42, Edit by SCHOEN
; Mapdat at very start of program
;<SCHOEN>PSVLEF.MAC.72, 27-Jan-82 12:20:15, Edit by SCHOEN
; Use JFNTAB to scan through locked files
;<SCHOEN>PSVLEF.MAC.71, 27-Jan-82 00:33:35, Edit by SCHOEN
; Protect AOBJN pointer during jfn scanning in UNLOCK
;<SCHOEN>PSVLEF.MAC.69, 3-Jan-82 13:32:58, Edit by SCHOEN
; Close the correct connection on reset of a Resethosts op
; Clear interrupt system on server fork crash
;<SCHOEN>PSVLEF.MAC.64, 14-Dec-81 19:14:08, Edit by SCHOEN
; Log server fork crashes, check for BNTLCK unlocked if last locked by
; dismissing fork, unlock BNTLCK if server fork crashes with it locked
;<SCHOEN>PSVLEF.MAC.63, 14-Dec-81 15:18:19, Edit by SCHOEN
; Load the byte size of a file out of the proper ac
; Clean up stack in RestLf when login fails
;<SCHOEN>PSVLEF.MAC.61, 13-Dec-81 23:18:14, Edit by SCHOEN
; More work on the leader page bookkeeping
;<SCHOEN>PSVLEF.MAC.57, 11-Dec-81 14:44:54, Edit by SCHOEN
; Illegal instruction trap causes the server fork to restart itself
;<SCHOEN>PSVLEF.MAC.45, 10-Dec-81 10:20:33, Edit by SCHOEN
; Make a fake leader page out of Twenex FDB, redirect RSIN/RSOUT
; to work on the leader page if a negative byte address is given
;<SCHOEN>PSVLEF.MAC.41, 4-Dec-81 23:02:54, Edit by SCHOEN
; Strip out CR->CRLF conversion...messes up Lisp's byte count
; for random access I/O. Also return to default 8-bit binary files.
;<SCHOEN>PSVLEF.MAC.40, 23-Nov-81 11:53:39, Edit by SCHOEN
; Convert CR to CRLF in text mode files
; Default file type (i.e. byte size) to text (7-bit)
;<SCHOEN>PSVLEF.MAC.38, 19-Nov-81 23:31:32, Edit by SCHOEN
; Don't recheck passwords if login/connect name doesn't change
;<SCHOEN>PSVLEF.MAC.36, 18-Nov-81 15:12:55, Edit by SCHOEN
; trap IFS leader page munging of file type to set byte size
; make bytsiz a per JFN quantity, make JFN tables shared.
; Clean up some error messages and JSYS error <-> IFS error pairs
; Don't replace extension terminator by "!" anymore
;<SCHOEN>PSVLEF.MAC.31, 9-Nov-81 11:26:04, Edit by SCHOEN
; Made PUPFNH extern
;<SCHOEN>PSVLEF.MAC.30, 6-Nov-81 16:18:27, Edit by SCHOEN
; Don't log rec'd LeafReads unless debugging
;<SCHOEN>PSVLEF.MAC.28, 6-Nov-81 11:03:34, Edit by SCHOEN
; remember that $closf skip returns
;<SCHOEN>PSVLEF.MAC.26, 2-Nov-81 14:27:39, Edit by SCHOEN
; Finish implementing ResetHosts mechanism in LeafReset
;<SCHOEN>PSVLEF.MAC.22, 21-Oct-81 20:13:57, Edit by SCHOEN
; Make sure GNJFN mode of OpenLf closes previous file before
; opening the next one.
;<SCHOEN>PSVLEF.MAC.20, 9-Oct-81 12:44:01, Edit by SCHOEN
; Add wildcard feature to OpenLf:
; First call to OpenLf can have a file with
; wildcards in it. The file of the group
; is returned.
;
; Succeeding calls to OpenLf can have LSB
; of Open mode word set, meaning "do a GNJFN."
; In this case, user/connect name/password and
; filename strings are not checked.
title psvlef
subttl Tenex/Tops-20 Leaf Server
search pupdef,psqdef,plfdef
usevar topvar,toppvr,pshvar,pshpvr
tenex,< search stenex >
tops20,<search monsym>
; Eric Schoen
; SUMEX Computer Project
; Stanford University Medical Center
; Stanford, CA.
; November, 1981
; Work on Leaf and Sequin implementations in Tenex
; and Tops-20 was funded by NIH Biotechnology Resouces
; Program under grant RR-00785
stksiz==100
lflpdl==100 ; leaf pdl
njfn==150 ; size of jfn table
loglat==↑D<5*60> ; max logging latency, seconds
logbfs==2000 ; size of logging buffer (words)
ps%dev=1b35 ; seen a device
ps%dir=1b34 ; seen a directory
ps%nam=1b33 ; seen a name
ps%ext=1b32 ; seen an extension
ps%ver=1b31 ; seen a version
ps%drs=1b30 ; seen the start of a directory
ps%atr=1b29 ; seen at least one attribute
extern connum,usrnum,contab,.okint,.noint,pbhead,connfk
extern ppupsn,ppupsh,ppupss,ppupdn,ppupdh,ppupd0,ppupd1
extern pupfnh,bntlck,bntlkr
lsp pmadr,1 ; page for PMAP I/O
pmpag==pmadr/1000
subttl startup
srvstt::
start: reset
gtad
camn a,[-1,,-1]
jrst [movei a,↑D5000
disms
jrst .-2]
jsp fx,mapdat## ; map high core to a thawed file
seto fx, ; top fork
move p,[iowd stksiz,stack]
setz f,
tlo f,(debugf) ; assume debugging
tenex,<
gjinf ; detached?
skipge d
jrst [move a,[sixbit/LOGDES/]
sysgt
movei a,(b)
hrli a,1
getab
hrls a
move b,a
movei a,400000
spjfn
tlz f,(debugf) ; not debugging
jrst .+1]
>
tops20,<
seto a,
hrroi b,d
movei c,.jicpj
getji ; get controlling job number
ercal screwup
aose d ; are we controlled?
tlz f,(debugf) ; yes, don't debug
>
pushj p,inilog ; init logger
log <LEAFSV: Leaf server restarting...>
seto a, ; make a server
pushj p,seqini##; init sequin
log <LEAFSV: Leaf server running>
; Background loop here
leafsl: setob cx,fx ; so we can tell when this routine calls BNTSRV
movei a,↑d5000 ; go to sleep for a time
disms
pushj p,bntsrv##; run the Sequin background process
time
caml a,logtim ; time to dump log?
pushj p,dmplog ; yes, dump it
jrst leafsl
subttl IFS String Utilities
; routine to convert an ASCIZ string to an IFS String
; Call: pushj p,wifsst
; a/ 16 bit bytepointer to Leaf packet being written
; b/ Tenex string pointer to an ASCIZ string
; Returns: +1 always, a,b updated
wifsst::push p,c ; save c and d
push p,d
tlc b,-1
tlcn b,-1
hrli b,(point 7)
ibp a ; point to string length
push p,a ; save pointer to length
tlc a,(30b11) ; convert to 8 bit
setz d, ; zero count
wifss1: ildb c,b ; get a character
jumpe c,wifss2 ; leave if done
idpb c,a ; deposit into IFS string
aoja d,wifss1
wifss2: exch a,(p) ; interchange current pointer w/original
dpb d,a ; save string length
pop p,a ; retrieve string pointer
trne d,1 ; odd number of bytes?
idpb c,a ; yes, deposit a garbage byte
tlc a,(30b11) ; make back into 16 bit bytes again
pop p,d ; retrieve acs
pop p,c
popj p, ; return
; routine to convert an ASCIZ string to a BCPL String
; Call: pushj p,wbcpst
; a/ 16 bit bytepointer to Leaf packet being written
; b/ Tenex string pointer to an ASCIZ string
; Returns: +1 always, a,b updated
wbcpst::push p,c ; save c and d
push p,d
tlc b,-1
tlcn b,-1
hrli b,(point 7)
tlc a,(30b11) ; convert to 8 bit
ibp a ; point to string length
push p,a ; save pointer to length
setz d, ; zero count
wbcps1: ildb c,b ; get a character
jumpe c,wbcps2 ; leave if done
idpb c,a ; deposit into IFS string
aoja d,wbcps1
wbcps2: exch a,(p) ; interchange current pointer w/original
dpb d,a ; save string length
pop p,a ; retrieve string pointer
trnn d,1 ; even number of bytes?
idpb c,a ; yes, deposit a garbage byte
tlc a,(30b11) ; make back into 16 bit bytes again
pop p,d ; retrieve acs
pop p,c
popj p, ; return
; Routine to convert an IFS String to an ASCIZ string
; Call: pushj p,riffst
; a/ Tenex string pointer
; b/ 16-bit byte pointer to an IFS string (such that
; one IBP would point to the character bytes)
; Returns: +1, always
; a,b updated
rifsst::push p,c ; save c and d
push p,d
tlc a,-1 ; Convert tenex pointer to hardware pointer
tlcn a,-1
hrli a,(point 7,)
ildb d,b ; Get count
tlc b,(30b11) ; convert to 8 bit bytes
push p,d ; save original length
jumpe d,rifss2 ; if done, go to leave
rifss1: ildb c,b ; else get byte
idpb c,a ; save in string
sojn d,rifss1
rifss2: idpb d,a ; null off terminating byte
pop p,d ; get original length of string
trne d,1 ; was it odd?
ibp b ; yes, increment BP past garbage byte
pop p,d ; retrieve d
pop p,c ; retrieve c
tlc b,(30b11) ; make pointer 16 bits again
popj p, ; return
; Routine to compute the number of 16-bit bytes between two 16-bit
; bytepointers
; Call: pushj p,cmplen
; a/ 1st bytepointer
; b/ 2nd bytepointer
; Returns: +1 always, with the magnitude of the difference in a
; b/ lesser bytepointer
; WARNING! DOES NOT WORK WITH INDEXED OR INDIRECT BYTEPOINTERS!!!
cmplen: push p,c ; save c and d
push p,d
push p,5 ; save 5 also
hrrz 5,a
caige 5,(b)
exch a,b ; make sure a.ge.b
hrrz 5,a
subi 5,(b)
lsh 5,1 ; compute # of 16 bit bytes from PDP10 words
move c,[point 3,b,2] ; look at position
ldb d,c
lsh d,-1
xct [jfcl
aoj 5,
addi 5,2](d) ; adjust for position within word
move c,[point 3,a,2] ; look at greater byte now
ldb d,c
lsh d,-1
xct [jfcl
soj 5,
subi 5,2](d) ; adjust for position in word
movm a,5
pop p,5
pop p,d
pop p,c
popj p,
; routine to compare ASCIZ strings
; call: pushj p,strcmp
; a/ pointer to string 1
; b/ pointer to string 2
; returns: +1, strings are different
; +2, strings match
strcmp: push p,c
push p,d
tlc a,-1
tlcn a,-1
hrli a,(point 7)
tlc b,-1
tlcn b,-1
hrli b,(point 7)
strcm1: ildb c,a
caige c,"a"
caia
caile c,"z"
caia
trz c,40
ildb d,b
caige d,"a"
caia
caile d,"z"
caia
trz d,40
caie c,(d)
jrst [pop p,d
pop p,c
popj p,]
jumpn c,strcm1
pop p,d
pop p,c
aos (p)
popj p,
subttl Leaf server fork, one per connection
; call: SFORK at LEAF, with at least SQ, CX set up
leaf:: move p,[iowd lflpdl,lfpdl]
move fx,connfk(cx) ; get fork index
move a,[3,,lfint]
movem a,chntab## ; make channel 0 be the channel to wake on
move a,[1,,srvcrs] ; set up illegal instruction trap
movem a,chntab##+↑d15
movei a,400000
move b,[levtab##,,chntab##]
sir
eir
move b,[sigchn+1b15]
aic
; Server fork wakeup mechanism:
; Much efficiency is gained by reducing context swap overhead.
; This code attempts to reduce the amount of work the top fork
; must do to start the server fork running.
;
; If the server fork has been active within the last IDLE1 minutes,
; the fork dismisses for SHRTD milliseconds if its input queue is
; empty.
;
; If the fork has been idle for between IDLE1 and IDLE2 minutes,
; the fork dismisses for LONGD ms on an empty input queue.
;
; After IDLE2 minutes, the server fork goes to sleep (via WAIT).
;
; If the fork is asleep or waiting for LONGD ms, it sets a flag
; telling the superior fork that it is OK for the superior to
; interrupt it when it has data in the queue.
; here to wait for Leaf packets
leaflp: hrrzs leaffk(sq) ; make this fork uninterruptable
time ; compute time to go to delayed wakeup
add a,[idle1*↑d60*↑d1000]
move c,a
movei d,shrtd ; start with short disms
leafl1: move a,sqrxcu(sq) ; scan queue
skipe qucnt(a) ; anything in the queue?
jrst leafgo ; yes, go
movei a,(d)
lfwai1: disms
time
camge a,c ; go to delayed wakeup?
jrst leafl1
caie d,shrtd
jrst lfslep ; timed out on long dismiss; go to sleep
movei d,longd ; go to delayed wakeup
hrros leaffk(sq) ; say it's OK to interrupt
add a,[idle2*↑d60*↑d1000] ; compute time to go to sleep at
move c,a
jrst leafl1
; Here when no activity for SHRTD+LONGD ms
lfslep:
lfwait: wait
; Here when interrupted by superior fork
lfint: hrrz a,lev3pc## ; get PC of interrupt
soj a,
cain a,lfwai1 ; at the DISMS?
movei a,lfwait ; yes, make believe we were WAITing
caie a,lfwait ; were we waiting?
debrk ; no, just debrk, then
movei a,leafgo ; yes, start the server fork
movem a,lev3pc##
debrk
leafgo: pushj p,leafsv
jrst leaflp
; here when the fork crashes
srvcrs: push p,a
move a,lev1pc## ; get crash address
soj a, ; adjust
pop p,a
elog <Server fork %16O crashed: Illegal instruction at %1O>
skipl bntlck ; BNTLCK locked?
jrst [came fx,bntlkr ; By us?
jrst .+1 ; No
setom bntlck ; Yes, unlock it
jrst .+1]
cis ; Clear interrupts and restart process
log <ACS: F:%0O A:%1O B:%2O C:%3O D:%4O>
log < SQ:%5O CX:%6O PB:%7O P:%17O>
log <Stack follows:>
srvcr1: camn p,[iowd lflpdl,lfpdl]
jrst leaf
pop p,a
log < %1O>
jrst srvcr1
; here when Sequin connection receives a packet destined for me
; call: Signal interrupt on channel 0
; sq,cx/ set up
; returns: +1, always
leafsv::move a,sqrxcu(sq) ; see if anything waiting
skipn 2(a)
jrst [movei a,(cx)
log <Connection %1O awakened with empty input queue>
popj p,]
tlne f,(debugf)
movem cx,leafcx ; save connection if debugging
push p,p1 ; save p1
push p,p2 ; and p2
push p,p4
leafs0: movei a,LeafPk
pushj p,inpSeq##
jrst leafsx
move p1,a ; save number of bytes in this packet
move p2,[point 16,Leafpk]; point to received packet
Leafs1: move p5,p2 ; save pointer to start of packet
ildb a,p2 ; get leafOpCode
move p4,a ; save opcode for errors
ldb c,[point 10,a,35] ; get length
subi p1,(c) ; adjust byte count for this packet
ldb c,[point 5,a,24] ; get opcode from packet
caile c,maxOp ; less than the maximum defined opcode?
jrst LfOpEr ; no, send a BuddingLeaf
pushj p,@LfOpTb(c) ; dispatch
tlnn f,(debugf)
jrst Leafs2
came cx,leafcx ; if debugging, make sure cx still the same
jrst [push p,a
push p,b
movei b,(cx)
hrrz a,leafcx
elog <CX clobbered! Should be %1O, but is %2O>
pushj p,screwup##]
Leafs2: jumpg p1,Leafs1
Leafsx: move a,sqrxcu(sq) ; anything in the queue?
skipe 2(a) ; check queue count
jrst leafs0 ; yes, go again
pop p,p4
pop p,p2
pop p,p1
skipl bntlck ; Trace unreleased BNTLCKs
jrst [came fx,bntlkr ; Locked by us?
jrst .+1 ; No
setom bntlck ; Yes, release it then
movei a,(cx)
log <BNTLCK left locked by connection %1O, releasing...>
jrst .+1]
popj p,
define lfdisp(subr),<
ifdef subr,<subr>
ifndef subr,<LFOpEr>
>
LfOpTb: LfOpEr ; Servers don't like seeing LeafError
lfdisp <OpenLf> ; LeafOpen
lfdisp <ClosLf> ; LeafClose
lfdisp <DeleLf> ; LeafDelete
lfdisp <LfOpEr> ; LeafLength
lfdisp <TrunLf> ; LeafTruncate
lfdisp <ReadLf> ; LeafRead
lfdisp <WritLf> ; LeafWrite
lfdisp <RestLf> ; LeafReset
lfdisp <NopLf> ; LeafNop
lfdisp <LfOpEr> ; no opcode
lfdisp <ParmLf> ; LeafParams
lfdisp <PropLf> ; Get Leaf Prop list
maxOp=.-LfOpTb-1
; routine top clean up a leaf connection being closed
; call: pushj p,cleanf
; cx/ set up for this connection
; returns: +1, always
cleanf::movsi c,-njfn
clnf1: skipe jfntab(c) ; is there a jfn here?
pushj p,clnf2 ; yes, close if ours
aobjn c,clnf1 ; loop through jfn table
setzm connum(cx) ; done with jfns, undo login
setzm usrnum(cx)
tops20,<
hrrz a,connfk(cx) ; get fork index for this fork
clzff ; close all files belonging to process
>
popj p,
tops20,<
clnf2: hlrz b,jfntab(c) ; get owning connection
cain b,(cx) ; this one?
setzm jfntab(c) ; yes, forget about file
popj p,
>
tenex,<
clnf2: hlrz b,jfntab(c) ; get owning connection
caie b,(cx) ; this connection?
popj p,
movei a,(c)
push p,a
tlo a,(1b0)
pushj p,$closf ; yes, close it
jrst [caie a,CLSX1 ; file not open?
type <CLEANF: CLOSF error: %1J>
jrst .+1]
pop p,a
rljfn
type <CLEANF: RLJFN error: %1J>
popj p,
>
subttl Leaf Errors
; routine to return a BuddingLeaf error when an undefined LeafOp received
; call: pushj p,LfOpEr
; c/ OpCode
; returns: +1, always
; clobbers a,b,c,d
LfOpEr: movei a,erBdLf ; budding leaf error
move b,c
setz c,
pushj p,ErrLf ; send a leaf error
popj p,
; routine to send a leaf Error
; call: pushj p, ErrLf
; a/ error subcode
; b/ optional string pointer to human readable text
; c/ error filehandle
; p4/ error opcode
; returns: +1, always
; clobbers a,b,c,d
; note: if a is greater than 600000, then it is assumed to be a JSYS
; error number. In this case, it is mapped into a standard IFS error
; number.
ErrLf: move d,[point 16,LfAnPk,31]
cail a,600000 ; what type of error?
pushj p,jstifs ; convert JSYS error to IFS code
dpb a,d
idpb p4,d
idpb c,d
movei c,(a)
move a,d
cain b,0
pushj p,IFSdf ; try to find a string for this error
caie b,0
pushj p,wifsst ; write string into packet
movei b,(cx)
tlne f,(debugf)
log <ERRLF: Sending Leaf error %3D for connection %2O>
move b,[point 16,LfAnPk]
setz c,
pushj p,LeafOp
popj p,
; routine to convert Tenex/Tops-20 JSYS error number of IFS number
; call: a/ JSYS error
; returns: +1, always, a/ IFS error code if found, else 0
jstifs: push p,c
hrroi b,temp
write b,<%1J> ; do ERSTR on JSYS error code
movsi b,-njsifs ; loop through table
jstif1: hrrz c,jsifst(b) ; get a jsys error
cain c,(a) ; is it ours?
jrst [hlrz a,jsifst(b) ; yes, get IFS code
jrst jstif2]
aobjn b,jstif1 ; no, loop
setz a,
jstif2: pop p,c ; found it or didn't find it
hrroi b,temp
popj p,
; table of JSYS error <-> IFS error correspondance
jsifst: ↑d202,,GJFX4 ; illegal char
↑d205,,GJFX5 ; input field too large
↑d201,,GJFX6 ; too many device fields
↑d201,,GJFX7 ; too many directory fields
↑d201,,GJFX8 ; no closing direcory broket
↑d201,,GJFX9 ; too many name fields
↑d201,,GJFX10 ; non-numeric version
↑d201,,GJFX11 ; two version fields
↑d201,,GJFX12 ; two account fields
↑d207,,GJFX16 ; no such device
↑d210,,GJFX17 ; no such direcory
↑d207,,GJFX18 ; no such file name
↑d207,,GJFX19 ; no such extension
↑d207,,GJFX20 ; no such version
↑d207,,GJFX24 ; old file required
↑d214,,GJFX27 ; old file not allowed
↑d203,,GJFX31 ; illegal *
↑d203,,GJFX32 ; empty directory and * given
↑d202,,GJFX34 ; unquoted ? in name
↑d208,,GJFX35 ; read access not allowed
↑d209,,OPNX1 ; file already open
↑d207,,OPNX2 ; file doesn't exist
↑d208,,OPNX3 ; read access not allowed
↑d208,,OPNX4 ; write access not allowed
↑d209,,OPNX9 ; file busy
↑d211,,OPNX10 ; no room
njsifs==.-jsifst
; Routine to find supply a human-readable string to correspond
; with an IFS error number
; call: pushj p,IFSdf
; c/ IFS error number
; returns: +1, always, error number in c, string pointer to string in b
; or 0 if not found
IFSdf: push p,a
push p,b
movsi a,-nIFSdf ; prepare to loop through table
IFSdf0: hlrz b,IFSdft(a) ; get IFS error
cain c,(b) ; found it?
jrst IFSdf1 ; yes
aobjn a,IFSdf0 ; no loop
setzm (p) ; not found, return 0 in b
pop p,b
pop p,a
popj p,
; here when IFS error found
IFSdf1: hrro b,IFSdft(a) ; pick up string pointer
pop p,(p)
pop p,a ; clean stack
popj p,
; table of IFS error <-> Human readable string correspondance
IFSdft: ↑d116,,[asciz/Illegal combination of lookup bits./]
↑d201,,[asciz/Malformed filename./]
↑d202,,[asciz/Illegal character in filename./]
↑d203,,[asciz/Illegal use of "*"./]
↑d204,,[asciz/Illegal version number./]
↑d205,,[asciz/Filename too long./]
↑d206,,[asciz/Not allowed to access Directory Information File./]
↑d207,,[asciz/File not found./]
↑d208,,[asciz/File is protected - access denied./]
↑d209,,[asciz/File open in conflicting way - file busy./]
↑d210,,[asciz/No such directory./]
↑d211,,[asciz/Page allocation exceeded./]
↑d212,,[asciz/The disk is full!/]
↑d213,,[asciz/CreateDiskStream failed - disk error?/]
↑d214,,[asciz/Rename "to" file already exists./]
↑d215,,[asciz/File is not deletable./]
↑d216,,[asciz/Illegal user-name./]
↑d217,,[asciz/Incorrect user-password./]
↑d218,,[asciz/Can't login as files-only directory./]
↑d219,,[asciz/Illegal connect-name./]
↑d220,,[asciz/Incorrect connect-password./]
↑d1001,,[asciz/Timeout has occurred -- connection broken./]
↑d1010,,[asciz/Operation not implemented./]
↑d1011,,[asciz/Illegal leaf handle./]
↑d1012,,[asciz/File too long./]
↑d1013,,[asciz/Illegal leaf truncate./]
↑d1015,,[asciz/Illegal leaf read./]
↑d1016,,[asciz/Illegal leaf write./]
nIFSdf==.-IFSdft
; routine to advance pointer to start of next LeafOp
; call: p2/opcode of current packet
; p5/pointer to start of current packet
; returns: +1, always, p2 updated
flseop: push p,a
push p,b
ldb a,[point 10,p2,35] ; get length in bytes
lsh a,-1 ; convert to words
idivi a,2 ; see how many PDP10 words it spans
move p2,p5 ; get pointer to start of current packet
addi p2,(a) ; adjust EA
caie b,0 ; b is either 0 or 1
ibp p2 ; odd number of words, increment pointer
pop p,b
pop p,a
popj p,
subttl Send Leaf Answer
; Routine to finish up LeafOpAnswer and send it
; Call: pushj p,leafOp
; a/ current 16 bit bytepointer to packet
; b/ 16 bit pointer to start of packet, must be 442000,,x form
; c/ LeafOp to use
; Returns: +1, always
; Clobbers a,c
leafOp: push p,b ; save packet org
pushj p,cmplen
lsh a,1 ; convert to 8-bit bytes
lsh c,↑d11
tro c,1b25 ; make this an Answer
iori a,(c)
idpb a,b
andcmi a,(c)
lsh a,-1 ; convert to 16 bit bytes
movsi a,(a) ; put length into left half
hrr a,(p)
setz b, ; Send a Sequin data
pushj p,senSeq## ; send it off
pop p,b ; recover packet org
popj p,
subttl Login
; routine to do login
; call: pushj p,.login
; p2/ 16-bit pointer to packet, pointing at user name
; a/ B0: don't try connect
; returns: +1, failure, LeafError in a
; +2, success, usrnum(cx), connum(cx) filled in
.login: movem p,loginp ; save p incase of error
push p,a ; save a
hrroi a,temp
move b,p2
pushj p,rifsst ; convert string to asciz
move p2,b ; save updated pointer
ifn ft10x,<
movei a,1 ; try to parse name
hrroi b,temp
stdir
jfcl
jrst [movei a,erUsrN ; failure in user name
jrst .logf]
tlne a,(1b0) ; files only?
jrst [movei a,erFils ; yes, fail
jrst .logf]
movei a,(a) ; save dir number
push p,a ; save directory number
hrroi a,temp ; read password from packet
move b,p2
pushj p,rifsst
move p2,b ; save updated pointer
move a,(p) ; recover directory number
camn a,usrnum(cx) ; same as before?
jrst [pop p,a
jrst .logs] ; skip proxy login
hrroi b,temp ; try to do a proxy login
hrli a,(1b1)
cndir
jrst [movei a,erUsrP ; user password incorrect?
jrst .logf]
pop p,a ; recover directory number
movem a,usrnum(cx) ; save user number
> ; end ifn ft10x
ifn ft20,<
movsi a,(rc%emo) ; match name exactly
hrroi b,temp
rcusr ; convert to user number
erjmp jerr##
tlne a,(rc%nom!rc%amb) ; no match or ambiguous?
jrst [movei a,erUsrN ; fail
jrst .logf]
camn c,usrnum(cx) ; same as before?
jrst [hrroi a,temp ; yes, read password to advance pointer
move b,p2
pushj p,rifsst
move p2,b
jrst .logs]
push p,c ; else save user number
move a,c ; and prepare for GTDIR
tlo a,(1b3) ; convert to PS:
movei b,temp ; get directory password
hrroi c,temp+20
gtdir
hrroi a,temp ; read password from packet
move b,p2
pushj p,rifsst
move p2,b ; save updated pointer
hrroi a,temp
hrroi b,temp+20
pushj p,strcmp ; compare strings
jrst [movei a,erUsrP ; password failed
jrst .logf]
pop p,a
movem a,usrnum(cx) ; save directory as login and connected
tlo a,(1b3) ; make into a PS: directory number
> ; end ifn ft20
movem a,connum(cx)
pop p,a
jumpl a,.logx ; if no connect check, leave now
; now attempt to connect, if possible and necessary
; also end up here if no change in login directory
.logs: push p,p2 ; save pointer
ildb a,p2 ; read length of connect string
jumpe a,[ibp p2 ; no connect name, incr past password block
pop p,(p) ; clean stack
jrst .logx] ; leave
pop p,p2 ; recover connect name pointer
move b,p2
hrroi a,temp
pushj p,rifsst ; read connect name
move p2,b ; save updated pointer
ifn ft10x,< ; see if directory exists
pushj p,fixcon ; fix if necessary
move b,a ; prepare to STDIR
movei a,1
stdir
jfcl
jrst [movei a,erConN ; connect name failure
jrst .logf]
camn a,connum(cx) ; same as before?
jrst .logcx ; yes
push p,a ; save directory number
>; ifn ft10x
ifn ft20,<
pushj p,fixcon ; fix string if necessary
move b,a
movsi a,(rc%emo)
rcdir ; translate
ercal jerr##
tlne a,(rc%nom!rc%amb)
jrst [movei a,erConN
jrst .logf] ; fail on error
camn c,connum(cx) ; same as before?
jrst .logcx ; yes
push p,c ; save number
>; ifn ft20
hrroi a,temp
move b,p2
pushj p,rifsst ; read connect password
move p2,b
pop p,a ; recover connect directory number
pushj p,chkcon ; try to connect
jrst [movei a,erConP ; no, failed
jrst .logf]
movem a,connum(cx) ; save connected directory number
jrst .logx ; and leave
; here on error
.logf: move p,loginp ; recover p
setzb c,b ; no human string
pushj p,errLf ; send error answer
popj p,
; here when connect name hasn't changed
; advance pointer past password string
.logcx: hrroi a,temp
move b,p2
pushj p,rifsst ; swallow password string
move p2,b
; fall through...
; here to exit successfully
.logx: move p,loginp ; recover p
aos (p) ; succeed
ifn ft10x,<
hrrz a,usrnum(cx)
hrrz b,connum(cx)
movei c,(cx)
; log <.LOGIN: Login user %1U%74I%2U%76I on connection %3O>
>
ifn ft20,<
move a,usrnum(cx)
move b,connum(cx)
movei c,(cx)
; log <.LOGIN: Login user %1U, %2U on connection %3O>
>
popj p, ; leave
ls loginp,1 ; storage for P on entering .login
; routine to fix a connect directory for brokets
; call: pushj p,fixcon
; string in temp
; returns: +1, always, pointer to fixed string in A
; clobbers b
ifn ft20,<
fixcon: move a,[point 7,temp] ; look for a left broket
fixc0: ildb b,a
cain b,74 ; found one?
jrst [hrroi a,temp ; yes, leave
popj p,]
jumpn b,fixc0 ; loop until end of string
; here if ran out of string
hrroi a,temp+20 ; copy string with brokets
hrroi b,temp
write <%74I%2S%76I> ; will add brokets around string
hrroi a,temp+20
popj p,
> ;end ifn ft20
ifn ft10x,<
fixcon: move a,[point 7,temp]
ildb b,a
caie b,74 ; left broket?
jrst [hrroi a,temp
popj p,] ; no, leave
fixc1: ildb b,a ; loop until end or right broket
cain b,76
jrst [setz b,
dpb b,a ; null of right broket
move a,[point 7,temp,6]
popj p,]
jumpn b,fixc1
move a,[point 7,temp,6]
popj p,
> ;end ifn ft10x
; routine to try to connect
; call: pushj p,chkcon
; a/ target directory number in a
; returns: +1, failure
; +2, success
ifn ft10x,<
chkcon: movei a,(a) ; clear STDIR flags
push p,a
tlo a,(1b1) ; do proxy GFACC
hrrz 3,usrnum(cx) ; get user number
gfacc
trne a,1b32 ; need a password?
jrst [pop p,a ; no, recover dir
setz b,
cndir ; do the connect
caia ; failed
aos (p)
popj p,]
pop p,a
hrroi b,temp
cndir ; connect if possible
caia ; failed, assume password invalid
aos (p)
popj p,
>
ifn ft20,<
chkcon: push p,a ; save dir number
tlo c,(1b0)
hrroi b,temp ; point to password
pushj p,.cnchk## ; from PUPSUP
skipa
aos -1(p)
pop p,a
popj p,
>
subttl LeafOpen
; routine to open a file
; call: p2/ 16-bit pointer to received request (ILDB gets first word after
; opcode)
; returns: +1, always, p2 updated
OpenLf: movei a,(cx)
; log <OPENLF: LeafOpen received for connection %1O>
ildb b,p2 ; get file handle incase this is GNJFN
push p,p3
ildb p3,p2 ; get open mode
trne p3,1 ; is this a GNJFN-like operation?
jrst [movei c,(b) ; check valildity of JFN presented
pushj p,chkhdl
jrst [pop p,p3 ; not good, bail out
jrst flseop]
jfcl ; file not open, that's OK
movei b,(c) ; recover JFN
movei a,(b)
tlo a,(1b0) ; don't release JFN
pushj p,$closf ; close the file
jfcl
move a,wildft(b); get jfn and flags
gnjfn
jrst errLf ; error
movei a,(a) ; clear LH flags
pushj p,chkven ; open the file
pushj p,flseop ; flush extra words if necessary
jrst openL1] ; rejoin rest of LeafOpen code
jumpn b,[movei c,(b) ; try to open a file if non-0 handle supplied
pushj p,chkhdl
jrst [pop p,p3 ; not good, bail out
jrst flseop]
skipa ; not open, good
jrst [movei a,erFlBz ; file busy
hrroi b,[asciz/Attempt to open file already open!/]
pushj p,errLf
pop p,p3
jrst flseop]
movei a,(c)
pushj p,chkven ; open the file
pushj p,flseop ; flush extra words if necessary
jrst openL1] ; rejoin rest of LeafOpen code
; none of the above, a new file supplied. Do login and parse filename
pushj p,.login ; try to log in
jrst [pop p,p3
jrst flseop]
hrroi a,temp ; logged in; read file name
move b,p2
pushj p,rifsst
move p2,b
pushj p,prsfil ; parse the file name
jrst [movei a,erNmMl ; error, malformed name
hrroi b,[asciz/Malformed name/]
setz c,
pushj p,errLf ; send error
pop p,p3 ; recover p3
popj p,]
pushj p,chkver ; Check mode bits, open file
jrst [setzb b,c
pushj p,errLf ; send of error
pop p,p3
popj p,]
OpenL1: movem b,jfntab(a) ; save openf bits
hrlm cx,jfntab(a) ; tag whose connection it belongs to
movei b,(a)
move a,[point 16,LfAnPk]; build reply packet
ibp a ; increment past opcode field
idpb b,a ; put jfn in reply
push p,a ; get byte count
movei a,(b)
move b,bytcnt(a) ; get EOF
exch a,(p) ; recover packet pointer
rot b,-↑d16 ; deposit high bits
idpb b,a
rot b,↑d16
idpb b,a ; deposit low bytes
setz b,
idpb b,a ; this word is ignored
move b,[point 16,LfAnPk]
movei c,LfOpen ; respond
pushj p,Leafop ; do it
pop p,a ; get JFN
pushj p,makldr ; make a leader page
pop p,p3
popj p, ; return
subttl LeafOpen Utilities
; routine to parse filename (in TEMP)
; call: pushj p,prsfil
; returns: +1, bad file name detected
; +2, file name parsed, FILDEV, FILDIR, FILNAM, FILEXT, FILVER
; filled in
; Flags (see above) in RH of F set accordingly
prsfil: setzm fildev ; clear strings
setzm fildir
setzm filnam
setzm filext
setzm filver
setzm filflg ; flag word
setzm filprt ; protection
trz f,ps%dev!ps%dir!ps%nam!ps%ext!ps%ver!ps%drs!ps%atr
move a,[point 7,temp] ; start reading
prsfi0: move b,[point 7,temp+40]; temp storage
setz d, ; field length counter
prsfi1: ildb c,a ; get a character
cain c,":" ; device terminator?
jrst prsdev ; yes, save device
cain c,74 ; start of directory?
jrst prsdrs ; yes, check some flags
cain c,76 ; end of directory?
jrst prsdir
cain c,"." ; name or extension terminator?
jrst prsdot
cain c,";" ; Tenex extension terminator
jrst prssmi
cain c,"!" ; IFS version leadin?
jrst prssmi ; removed 2/28/82. Dolphin supposed to know
idpb c,b
jumpe c,prsfi2 ; at end of string, see what we've got
aoja d,prsfi1
; here when device terminator seen
prsdev: jumpe d,cpopj ; fail if a bare ":" seen
trne f,ps%dev!ps%dir!ps%nam ;already seen a device, dir, or name?
cpopj: popj p, ; fail
setz c, ; else terminate string
idpb c,b
hrroi c,fildev
move b,[point 7,temp+40]; copy into device
write c,<%2S>
tro f,ps%dev ; say we've seen a device
jrst prsfi0 ; continue
; here when start of directory seen
prsdrs: trne f,ps%drs!ps%dir!ps%nam ; already seen dir start, dir, or name?
popj p, ; fail
tro f,ps%drs ; say seen start
jrst prsfi0 ; continue
; here when end of directory seen
prsdir: jumpe d,cpopj ; fail if nothing in directory
trnn f,ps%drs ; seen the start of the directory?
popj p, ; no, die
setz c, ; null off dir string
idpb c,b
hrroi c,fildir
move b,[point 7,temp+40]
write c,<%2S>
trc f,ps%drs!ps%dir ; say seen directory
jrst prsfi0 ; continue
; here when a "." seen
prsdot: trne f,ps%drs ; in the middle of a directory?
jrst [idpb c,b ; dot is ok, then
aoja d,prsfi1] ; continue through loop
trnn f,ps%nam ; seen a name field, yet?
jrst [setz c, ; no, then this is name. terminate
idpb c,b
hrroi c,filnam ; and copy
move b,[point 7,temp+40]
write c,<%2S>
tro f,ps%nam ; say seen name
jrst prsfi0] ; go for extension
trnn f,ps%ext ; seen extension yet?
jrst [setz c, ; no, then this is ext. terminate
idpb c,b
hrroi c,filext ; and copy
move b,[point 7,temp+40]
write c,<%2S>
tro f,ps%ext ; say seen extension
jrst prsfi0] ; go for version
popj p, ; no dots after seeing name and extension
; here when a semicolon encountered
prssmi: trnn f,ps%nam ; seen a name yet?
jrst [setz c, ; no, then this is name. terminate
idpb c,b
hrroi c,filnam ; and copy
move b,[point 7,temp+40]
write c,<%2S>
tro f,ps%nam ; say seen name
tro f,ps%ext ; and also extension (foo;1 => foo.;1)
jrst prsfi0] ; go for version
trnn f,ps%ext ; seen an extension?
jrst [setz c, ; no, then this is ext. terminate
idpb c,b
hrroi c,filext ; and copy
move b,[point 7,temp+40]
write c,<%2S>
tro f,ps%ext ; say seen extension
jrst prsfi0] ; go for version
; must be a version or an attribute
move a,[point 7,temp+40]
ildb b,a ; get first character of version
caige b,"a" ; uppercase it, incase it's a character
caia
caile b,"z"
caia
trz b,40
cain b,"*" ; wildcard version?
jrst [hrrei b,-3 ; store numeric equivalent
movem b,filver
trne f,ps%atr ; seen any attributes, yet?
popj p, ; yes, version is illegal
tro f,ps%ver ; say seen version
jrst prsfi0]
cain b,"-" ; numeric special (-1, -2, -3)?
jrst [movei c,↑d10 ; try to read a number
nin
popj p, ; not a number, die
caig b,3 ; something other than 1, 2, or 3?
popj p, ; incorrect, die
movns b
trne f,ps%atr ; seen any attributes, yet?
popj p, ; yes, version is illegal
movem b,filver ; save version
tro f,ps%ver ; say we have a version
jrst prsfi0]
caige b,"0"
jrst prsatr
caile b,"9"
jrst prsatr
trne f,ps%atr ; seen any attributes
popj p, ; yes, die
move a,[point 7,temp+40]
movei c,↑d10 ; else explicit version?
nin
popj p, ; bad number
movem b,filver ; save version
tro f,ps%ver ; say we have a version
jrst prsfi0
prsatr: pushj p,doattr ; parse attributes
popj p, ; unknown attribute
jrst prsfi0 ; parse agai
; routine to parse file name attributes.
; currently understands ;S, ;T, ;P
; call: pushj p, doattr
; b/ attribute character
; returns: +1, unknown attribute
; +2, attribute known
doattr: cain b,"T" ; temp?
jrst [movsi b,(1b5)
iorm b,filflg
tro f,ps%atr
aos (p)
popj p,]
cain b,"S" ; scratch?
jrst [movsi b,(1b14)
iorm b,filflg
tro f,ps%atr
aos (p)
popj p,]
cain b,"P" ; protection
jrst [movei c,↑d8 ; try to read a number
nin
popj p, ; not a number, die
movem b,filprt ; save version
tro f,ps%atr
aos (p)
popj p,]
popj p, ; semicolon in version is illegal (for now)
; here when string ends
prsfi2: trne f,ps%drs ; was a started dir ever ended?
popj p, ; no, die
trnn f,ps%nam ; name seen?
jrst [setz c, ; no, then this is name. terminate
idpb c,b
hrroi c,filnam ; and copy
move b,[point 7,temp+40]
write c,<%2S>
tro f,ps%nam ; say seen name
tro f,ps%ext ; and also extension (foo;1 = foo.;1)
jrst prsfi4] ;
trnn f,ps%ext ; seen an extension?
jrst [setz c, ; no, then this is ext. terminate
idpb c,b
hrroi c,filext ; and copy
move b,[point 7,temp+40]
write c,<%2S>
tro f,ps%ext ; say seen extension
jrst prsfi4] ; go for version
; if here, string must have ended with version or attribute
move a,[point 7,temp+40]
ildb b,a ; get first character of version
caige b,"a" ; uppercase it, incase it's a character
caia
caile b,"z"
caia
trz b,40
caige b,"0"
caia
caile b,"9"
jrst [pushj p,doattr
popj p,
jrst prsfi4]
trne f,ps%ver!ps%atr ; seen a version or attribute?
popj p, ; can't have two versions or ;attr;version
cain b,"*" ; wildcard version?
jrst [hrrei b,-3 ; store numeric equivalent
movem b,filver
tro f,ps%ver ; say seen version
jrst prsfi4]
cain b,"-" ; numeric special (-1, -2, -3)?
jrst [movei c,↑d10 ; try to read a number
nin
popj p, ; not a number, die
caig b,3 ; something other than 1, 2, or 3?
popj p, ; incorrect, die
movns b
movem b,filver ; save version
tro f,ps%ver ; say we have a version
jrst prsfi4]
move a,[point 7,temp+40]
movei c,↑d10 ; else explicit version?
nin
popj p, ; bad number
movem b,filver ; save version
tro f,ps%ver ; say we have a version
prsfi4: trnn f,ps%dir ; seen a directory?
jrst [hrroi a,fildir ; no, fill in connected directory
move b,connum(cx); from tables
tlz b,77777 ; make into user number
write <%2U>
tro f,ps%dir ; say there's a directory
jrst .+1]
aos (p)
popj p,
; routine to check version supplied with file name against open mode bits
; call: pushj p,chkver
; FILDEV, FILNAM, ... , FILVER set up
; f/ ps%dev, ... , ps%ver flags set accordingly
; p3/open mode bits (b0 on means don't actually open file)
; returns: +1, illegal lookup control (error in A, possibly JSYS error)
; +2, success, file opened, JFN in A, OPENF mode bits in B
chkver: ldb a,[point 2,p3,26] ; get explicit version control bits
pushj p,@chkevd(a) ; dispatch
jrst chkvf1 ; failed, die
ldb a,[point 2,p3,28] ; get default handling
trne f,ps%ver ; version supplied
jrst chkve1 ; yes, skip this
pushj p,@chkdvd(a) ; will set GTJFN mode bits on success
jrst chkvf1 ; fail
chkve1: trne p3,lfo.cr ; should file be created?
tlo a,(1b1) ; say new file only
pushj p,getjfn
jrst chkvf1 ; GTFJN failed
; fall through ...
; Routine to OPENF a file whose JFN is in A
; this can be called from OPENLF when a GNJFN operation
; is being performed
chkven: movsi b,(↑d8b5) ; open 8 bit
trne p3,lfo.rd ; open read?
tro b,1b19 ; arg for OPENF
trne p3,lfo.wr!lfo.ex!lfo.cr ; open for write, extend, or create?
tro b,1b19!1b20 ; arg for OPENF (write implies read because of IFS code)
movei c,(a) ; hold onto JFN
tops20,<
pushj p,chkacc ; see if access for this user is allowed
pushj p,chkvrf
>
jumpl p3,[aos (p)
popj p,] ; don't open, just return
openf ; try to OPENF it
pushj p,chkvrf
push p,b ; save OPENF bits
sizef ; get current byte count
jrst [elog <CHKVER: Unexpected JSYS error %1J>
popj p,]
movem b,bytcnt(a) ; save current byte count
pop p,b
aos (p) ; success, return JFN in A
pushj p,getsiz ; get byte size for file
; tlnn f,(debugf) ; debugging?
; popj p, ; no, return here
hrroi d,temp
write d,<CHKVER: Open of file >
jrst chkvrx
; PUSHJ here when OPENF or CHKACC [Tops-20] above fails
; If a contains OPNX9 (file busy), CHKVRF will attempt to unlock
; If unlock is possible, CHKVRF returns +1 with JFN in A
; If not file busy, or unlock not possible, CHKVRF returns to CHKVER's
; caller with A/ error code from CHKACC or OPNX9
chkvrf: cain a,OPNX9 ; file busy?
jrst [movei a,(c) ; get jfn
pushj p,unlock ; try to unlock
jrst [movei a,OPNX9 ; restore error code
jrst .+1] ; give fail return
popj p,] ; unlocked, succeed
pop p,(p) ; undo return
push p,a ; don't clobber error
movei a,(c) ; release JFN on file
rljfn
log <CHKVRF: Failed to release JFN: %1J>
pop p,a
chkvf1: hrroi d,temp
write d,<CHKVRF: Failed to open file >
; fall through
chkvrx: push p,a
push p,b
hrroi a,fildir
hrroi b,filnam
hrroi c,filext
write d,<%74I%1S%76I%2S.%3S;>
move a,filver
write d,<%1D >
movei a,(cx)
write d,<for connection %1O%/>
hrroi a,temp
; log <%1S>
pop p,b
pop p,a
popj p,
; dispatch for handling explicit version number field
chkevd: chkev0
chkev1
chkev2
chkev3
; explicit version control says no versions allowed
chkev0: trne f,ps%ver ; don't allow versions; was there one?
jrst [movei a,erIlVr
popj p,]; yes, die
skpret: aos (p)
popj p,
; explicit version control says file must exist
chkev1: movsi a,(1b2) ; try a GTJFN on an existing file
pushj p,getjfn
popj p, ; fail
rljfn
jfcl
jrst skpret
; explicit version control says next or old
chkev2: pushj p,chkev1 ; try old
jrst [caie a,GJFX20 ; no old version lying around?
popj p, ; not the problem
jrst chkv2a]
rljfn
jfcl
jrst skpret
; here when old version doesn't exist
chkv2a: push p,filver ; try highest version
setzm filver
movsi a,(1b2)
pushj p,getjfn
popj p, ; shouldn't die here
move b,[1,,7]
movei c,c
gtfdb ; get version number
hlrz c,c
aoj c, ; increment version
pop p,filver ; recover filver
came c,filver ; equal?
jrst [movei a,erIlVr ; no
popj p,]
rljfn
jfcl
aos (p)
popj p,
; explicit version control says "any"
chkev3: jrst skpret
; dispatch table for default version handling
chkdvd: chkdv0
chkdv1
chkdv2
chkdv3
; here when there should be a version number
chkdv0: popj p, ; fail (here only if no version supplied)
; here to default to lowest version
chkdv1: movei a,-2
movem a,filver
movsi a,(1b2)
jrst skpret
; here to default to highest version or use next highest
chkdv3: movsi a,(1b0)
caia
chkdv2: movsi a,(1b2)
setzm filver
jrst skpret
ls gtjblk,16 ; storage for long gtjfn
ls fildev,10 ; store for device string
ls fildir,10 ; storage for directory name
ls filnam,10 ; store for file name
ls filext,10 ; storage for filename extension
ls filact,10 ; storage for default account
ls filprt,1 ; file protection
ls filflg,1 ; GTJFN flag word
ls filver,1 ; store for file version
subttl LeafOpen Utilities Utilities
; routine to do GTJFN from stored strings
; call: pushj p,getjfn
; a/ gtjfn bits in left half
; FILDEV, ... , FILVER filled in
; returns: +1, failure, GTJFN error code in A
; +2, success, JFN in A
getjfn: move b,[gtjblk,,gtjblk+1]
setzm gtjblk
blt b,gtjblk+15
ior a,[1b11] ; Allow wildcards
ior a,filflg
hrr a,filver ; 3/18/82 ejs This should be a HRR, not HRRZ!
movem a,gtjblk ; save gtjfn flags
move a,[377777,,377777] ; null I/O
movem a,gtjblk+1
move a,[gtjblk+2,,gtjblk+3] ; clear remaining entries
setzm gtjblk+2
blt a,gtjblk+10
hrroi a,fildev ; default device
skipe fildev
movem a,gtjblk+2
hrroi a,fildir ; default directory
skipe fildir
movem a,gtjblk+3
hrroi a,temp
hrroi b,filnam
hrroi c,filext
write <%2S.%3S>
move a,filprt
movem a,gtjblk+6 ; protection
movei a,filact ; get default account
move b,usrnum(cx)
gdacc
; pushj p,.gdacc## ; see PSVSUP, SMXACC
jrst getjf1
hrroi a,filact
movem a,gtjblk+7
getjf1: movei a,gtjblk ; try for JFN
hrroi b,temp
gtjfn
popj p, ; failed
setzm wildft(a) ; clear wildcard flag storage
tlne a,(77b5) ; Any wildcards supplied?
movem a,wildft(a) ; save wildcard flags
movei a,(a) ; clear flags from JFN
aos (p)
popj p, ; success, jfn in A
ifn ft20,<
; routine to check access for a file
; call: pushj p,chkacc
; a/jfn of file
; b/openf bits
; cx/connection table index
; returns: +1, access prohibited, error number in A
; +2, success
chkacc: push p,a
push p,b
movem a,chkblk+.ckaud ; store JFN in arg block
move a,usrnum(cx)
movem a,chkblk+.ckald ; store user number
move a,connum(cx)
movem a,chkblk+.ckacd ; store connected directory
movsi a,(sc%ctc!sc%gtb!sc%log) ; reasonable capabilities
movem a,chkblk+.ckaec ; store 'em
move a,b ; get openf bits
movei b,.ckard ; try read access if necessary
movem b,chkblk+.ckaac
trne a,of%rd ; want read?
jrst [pushj p,.chkac
skipa a,[OPNX3]
jrst .+1
movem a,-1(p)
jrst chkacf]
movei b,.ckawr ; want write?
movem b,chkblk+.ckaac
move a,0(p)
trne a,of%wr
jrst [pushj p,.chkac
skipa a,[OPNX4]
jrst .+1
movem a,-1(p)
jrst chkacf]
aos -2(p)
chkacf: pop p,b
pop p,a
popj p,
.chkac: move a,[ck%jfn!5]
movei b,chkblk
chkac ; look for capabilities
ercal jerr##
skipe a
aos (p)
popj p,
ls chkblk,6
> ; end ifn ft20
; routine to set up byte size for further I/O
; call: a/ JFN
; returns: +1, always, bytsiz(jfn) set up
getsiz: push p,a
push p,b
push p,c
pushj p,makldr ; get a leader page, if necessary
movei a,ldrtyp ; get the file type
pushj p,getptr
ildb c,a ; get size
cain c,0 ; if no bytesize,
movei c,2 ; assume to be written as binary
move a,-2(p) ; get JFN
movei b,↑d8 ; assume 8 bit bytes
caie c,2
movei b,7 ; nope, type text, 7-bit bytes
movem b,bytsiz(a) ; save it
movei a,ldrbyt
pushj p,getptr
idpb b,a ; store in leader page
pop p,c
pop p,b
pop p,a
popj p,
; routine to set byte size
; call: a/JFN
; b/byte size
; returns: +1, failure (byte size already set)
; +2, success, bytsiz(JFN) + file's FDB set up
setsiz: push p,a
push p,b
push p,c
pushj p,makldr ; make the leader
movei a,ldrtyp
pushj p,getptr
ildb c,a
caie c,0
jrst setsz1 ; byte size already exists
skipn c,-1(p) ; get type
movei c,2 ; default to vinary
dpb c,a ; place in leader page
movei b,↑d8 ; assume 8-bit bytes
caie c,2 ; binary?
movei b,7 ; nope, type text, 7-bit bytes
movei a,ldrbyt ; deposit in leader page
pushj p,getptr
idpb b,a
move a,-2(p)
movem b,bytsiz(a) ; store in byte size table
aos -3(p) ; set skip return
setsz1: pop p,c ; recovers acs and leave
pop p,b
pop p,a
popj p,
subttl Filelock mechanisms
; routine to "unlock" a file if it is held by a timed-out sequin
; call: pushj p,unlock
; a/ jfn of locked file
; b/ openf bits
; returns: +1, file cannot be unlocked
; +2, file unlocked, owning sequin broken
unlock: push p,a ; save jfn
push p,b ; save openf bits
push p,c
move b,[1,,3] ; get index block address
movei c,d
gtfdb
and d,[000017,,777777] ; just want address
movsi c,-njfn ; loop through jfn table
unlck0: push p,c ; save AOBJN pointer
skipn a,jfntab(c)
jrst unlck1 ; no jfn
movei a,(c) ; get JFN
move b,[1,,3] ; get this file's index block
movei c,c
gtfdb
and c,[000017,,777777]
came c,d ; compare them
jrst unlck1 ; not the same
hlrz a,(c) ; file same, get owning connection
move b,seqsta(a) ; get state of sequin for that connection
cain b,TIMD ; timed out?
jrst unlck2 ; yes, give the requestor the connection
unlck3: pop p,(p) ; clean stack of AOBJN pointer
unlck4: pop p,c ; recover JFN
pop p,b ; recover bits
pop p,a ; recover JFN
popj p, ; return bad
unlck1: pop p,c ; recover AOBJN pointer
aobjn c,unlck0 ; loop until filename found
jrst unlck4 ; not found, open by non-sequin user
; here when file owned by timed out connection
; c/ jfntab index
unlck2: movei a,400000 ; say file lock broken
pop p,c ; recover AOBJN pointer
iorm a,jfntab(c)
movei a,(c) ; close broken sequin's ownership
tlo a,(1b0) ; don't release JFN
pushj p,$closf
jrst [log <UNLCK2: CLOSF error %1J>
jrst unlck3]
pop p,c ; recover jfn
pop p,b ; recover openf bits
pop p,a ; recover jfn
openf
jrst [log <UNLCK2: OPENF error %1J>
popj p,]
aos (p) ; success
popj p,
subttl LeafClose
; routine to close a file
; call: p2/ 16-bit pointer to received request (ILDB gets first word after
; opcode)
; returns: +1, always, p2 updated
ClosLf: tlnn f,(debugf)
jrst Closl2
movei a,(cx)
log <LEAFSV: LeafClose received for connection %1O>
Closl2: ildb c,p2 ; get filehandle
pushj p,chkhdl ; check validity of filehandle
popj p, ; failed, invalid handle
jfcl ; file not open, just release JFN
movei a,(c) ; close file
pushj p,$closf
log <LEAFSV: Failed to close JFN %3O: %1J>
move a,[point 16,LfAnPk,31] ; send the answer
move b,[point 16,LfAnPk]
dpb c,a
movei c,LfClos
jrst LeafOp
; here to CLOSF file, unmapping any mapped pages first
; call: pushj p,$closf
; a/JFN (b0 on means don't release JFN)
; returns: +1, always.
$closf: push p,b
hrrz b,jfntab(a) ; file open?
jumpe b,[jumpl a,[pop p,b ; unopened, but want JFN saved; do nothing
aos (p)
popj p,]
setzm wildft(a)
setzm jfntab(a)
rljfn
log <LEAFSV: Failed to release JFN %3O: %1J>
pop p,b
aos (p)
popj p,]
hlrz b,curpag ; is a page of this file mapped?
cain b,(a)
jrst [push p,a
seto a, ; yes, unmap it
move b,[400000,,pmpag]
pmap
setzm curpag
pop p,a
jrst .+1]
aos -1(p) ; assume successful CLOSF
move b,ldrfil
cain b,(a) ; is this the file in the leader page?
pushj p,wrtldr ; update the FDB
jumpg a,[setzm jfntab(a); if not releasing JFN, hold onto table entries
setzm wildft(a)
jrst .+3]
hllzs jfntab(a)
hllzs wildft(a) ; say not open, otherwise
closf
sos -1(p) ; adjust stack for +1 return on CLOSF error
pop p,b
popj p,
subttl LeafRead
; routine to read a bytes
; call: pushj p,Readlf
; p2/ pointer to request packet
; returns +1, always, LeafError sent if necessary
ReadLf: tlnn f,(debugf)
jrst ReadL2
movei a,(cx)
log <LEAFSV: LeafRead received for connection %1O>
ReadL2: ildb c,p2 ; get filehandle
pushj p,chkhdl ; check the handle
jrst flseop ; failed, flush to end of packet
jrst [movei a,erIlRd ; fail, Illegal Leaf Read
hrroi b,[asciz/File not open/]
jrst errLf]
move b,jfntab(c) ; get openf bits
trnn b,1b19 ; open for read?
jrst [hrroi b,[asciz/File is not open for reading./]
jrst ReadEr]
ildb b,p2 ; construct leafaddress
andi b,17777 ; mask to 13 bits
lsh b,↑d16
ildb a,p2
iori b,(a) ; combine with low order address
move a,c ; filehandle to A
caml b,bytcnt(a) ; trying to read past eof?
jrst [tlne b,400 ; write to leader page?
jrst .+1
move b,bytcnt(a) ; make address EOF
setzb d,c ; length 0
ibp p2 ; increment bytepointer over length
jrst ReadL1] ; yes, return no data, starting at EOF
ildb c,p2 ; get length of read
move d,c ; save length
ReadL1: caile c,1000 ; need multiple read?
movei c,1000 ; yes
sub d,c ; adjust residual byte count
push p,a
push p,b
push p,c
push p,d ; fill in packet
pushj p,rsin ; do random sin
move d,[point 16,LfAnPk,31]
dpb a,d ; deposit jfn
exch b,-2(p) ; get leaf address
rot b,-↑d16
idpb b,d
rot b,↑d16
idpb b,d
idpb c,d
exch b,-2(p) ; get pointer to end of packet
trne c,1 ; odd number of bytes?
idpb c,b ; make a garbage byte
move a,b
move b,[point 16,LFAnPk]
movei c,LfRead
pushj p,LeafOp
pop p,d
pop p,c
pop p,b
pop p,a
add b,c ; update address to read from
move c,d
jumpn d,ReadL1
popj p,
; routine to convert tenex/tops20 time to alto time
; call: pushj p,timalt
; a/ time in tenex/tops20
; returns: +1, always
; b/ time in Alto format
timalt:
ifn ft20,<
PUSHJ P,TIMTNX ; If tops-20, make into tenex format
>
HLRZ B,A ; Get days
SUBI B,↑D15385 ; Adjust origin to Jan 1, 1901
IMULI B,↑D86400 ; Convert days to seconds
ADDI B,0(A) ; Add seconds increment
POPJ P,
IFN FT20,<
; Convert Tops20 time format to Tenex format
TIMTNX: PUSH P,A ; Save day,,fraction
MOVEI A,(A) ; Isolate fraction
IMULI A,↑D86400 ; lh ← number of seconds since midnight
ADDI A,400000 ; Round
HLRM A,0(P) ; Make TENEX format on stack
POP P,A ; Recover it
POPJ P,
>
; here when illegal read encountered
readEr: movei a,erIlRd
pushj p,errLf
jrst flseop
subttl LeafWrite
; routine to write bytes
; call: pushj p,Writlf
; p2/ pointer to request packet
; returns +1, always, LeafError sent if necessary
WritLf: movei a,(cx)
tlne f,(debugf)
log <LEAFSV: LeafWrite received for connection %1O>
ildb c,p2 ; get filehandle
pushj p,chkhdl ; check the handle
jrst flseop ; failed, flush to end of packet
jrst [movei a,erIlWr ; fail, Illegal Leaf Write
hrroi b,[asciz/File not open/]
jrst errLf]
move b,jfntab(c) ; get openf bits
trnn b,1b20!1b22 ; open write or append?
jrst [hrroi b,[asciz/File is open READ only/]
jrst WritEr]
ildb b,p2 ; construct leafaddress
ldb d,[point 3,b,22] ; get mode and EOF bit
andi b,17777 ; mask to 13 bits
lsh b,↑d16
ildb a,p2
iori b,(a) ; combine with low order address
move a,c ; filehandle to A
ildb c,p2 ; get length of read
trne d,1 ; EOF bit set in address?
tro f,tempf1 ; yes, remember to set byte count
lsh d,-1
pushj p,@[mdanyw ; anywhere
mdnoho ; no holes
mddntx ; don't extend
mdchkx](d) ; check extend
jrst WritEr
caie c,0 ; skip if no bytes to write
pushj p,rsout ; do the write operation
tlne b,400 ; leader page write?
jrst LeafW1 ; yes, don't update EOF count
push p,c ; save length
add c,b ; compute ending byte
trnn f,tempf1 ; set EOF with this write?
camle c,bytcnt(a) ; no, but is this a longer byte count?
movem c,bytcnt(a) ; yes, save
pop p,c ; recover length
LeafW1: trze f,tempf1 ; set EOF?
jrst [push p,b ; do the CHFDB
push p,c
move c,bytcnt(a)
hrli a,12
seto b,
chfdb ; byte count
hrli a,11
movsi b,(77b11)
move c,bytsiz(a)
lsh c,↑d24
chfdb ; byte size
movei a,(a)
pop p,c
pop p,b
jrst .+1]
WrtLf1: move d,[point 16,LfAnPk,31] ; create answer
dpb a,d
rot b,-↑d16
idpb b,d
rot b,↑d16
idpb b,d
idpb c,d
move a,d
move b,[point 16,LfAnPk]
movei c,LfWrit
jrst LeafOp ; send answer and leave
; here on illegal write (illegal extend, no holes error, etc)
; a/ file handle
; b/ pointer to human readable string
WritEr: movei c,(a)
movei a,erIlWr
pushj p,errLf
jrst flseop
; mode handling routines
; anywhere
mdanyw: jrst skpret
; no holes
; a/ filehandle, b/ starting address, c/ length of write
mdnoho: tlne b,400 ; leader page write?
jrst skpret ; succeed
push p,b
push p,c
sizef ; get size
aoj b, ; hole if start addr > EOF+1
camge b,-1(p)
jrst [hrroi b,[asciz/Write operation would create hole in file/]
movem b,-1(p)
jrst mdnohx]
aos -2(p)
mdnohx: pop p,c
pop p,b
popj p,
; check extend
mdchkx: tlne b,400 ; leader page?
jrst skpret ; yes, succeed
tro f,tempf2 ; say send error in case of extend
; don't extend
; a/ filehandle, b/ starting address, c/ length of write
mddntx: tlne b,400 ; leader page write?
jrst skpret ; succeed
push p,c
push p,b
addi b,(c) ; compute new EOF
move d,b
move b,bytcnt(a) ; get old EOF
camge b,d ; will this extend?
jrst mddnx1 ; yes, modify length of write
aos -2(p)
mddnxx: pop p,b
pop p,c
popj p,
; here to modify length of write to keep EOF extend from happening
mddnx1: trze f,tempf2
jrst [hrroi b,[asciz/Write operation would necessitate EOF extension/]
movem b,(p)
jrst mddnxx]
sub b,(p) ; get starting address
caige b,0 ; also catch the no holes case
setz b, ; if start addr > old EOF, no write
movem b,-1(p) ; save new write length
aos -2(p)
jrst mddnxx
subttl LeafDelete
; routine to delete a file
; call: pushj p,DeleLf
; returns: +1, always
Delelf: movei a,(cx)
tlne f,(debugf)
log <DELELF: LeafDelete received for connection %1O>
ildb c,p2 ; get filehandle
pushj p,chkhdl
jrst flseop ; bad handle
jrst [movei a,erNtDl ; can't delete unless open write?
hrroi b,[asciz/File not open/]
jrst errLf]
move a,jfntab(c) ; get openf bits
trnn a,1b20!1b22 ; open write or append?
jrst Delel1 ; no, fail
movei a,(c) ; ok, delete it
tlo a,(1b0) ; close the jfn
pushj p,$closf
jfcl
delf
jrst [movei a,(c)
setzm jfntab(a)
rljfn
jfcl
setz b, ; failure
jrst errLf]
setzm jfntab(a)
rljfn
jfcl
move a,[point 16,LfAnPk,31]
dpb c,a
move b,[point 16,LfAnPk]
movei c,LfDel
jrst leafOp
; here when delete not allowed (i.e. file not open write or append)
Delel1: movei a,erNtDl ; file not deletable
setz b,
jrst errLf
subttl LeafParams
; routine to set Leaf Params
ParmLf: movei a,(cx)
tlne f,(debugf)
log <LEAFSV: LeafParams received for connection %1O>
ildb a,p2 ; get max pup length
ildb a,p2 ; discard pup length, get file timeout
ildb b,p2 ; get connection timeout
imuli a,5 ; convert to seconds
imuli b,5
cain a,0 ; any file timeout supplied?
movei a,filet ; no, use default
cain b,0
movei b,connt ; use default connection timeout if necessary
hrl a,b
pushj p,stlctm## ; set timeout
move a,[point 16,LfAnPk,31]
setz b,
dpb b,a
move b,[point 16,LfAnPk]
movei c,LfParm
jrst LeafOp
subttl LeafReset
; routine to do reset
; currently, only checks login name and password
RestLf: push p,p3
ildb p3,p2 ; get ResetHosts field
movsi a,(1b0) ; don't check connect params
pushj p,.login ; try to log in
jrst [pop p,p3
jrst flseop] ; fail, point to next packet, if it exists
pushj p,rstcon ; Do resets as directed by ResetHosts field
pop p,p3 ; recover p3
move a,[point 16,LfAnPk,31] ; respond with ResetHost Answer
setz b,
dpb b,a
move b,[point 16,LfAnPk]
movei c,LfRest
jrst LeafOp
; routine to implement ResetHosts
; call: cx/ connection table index for this connection
; p3/ ResetHosts field
; returns: +1, always
rstcon: jumpe p3,rsthst ; reset connections from this host
cain p3,177777 ; or is it from this user?
jrst rstusr ; yes
movei a,OPEN
movem a,seqSta(sq) ; make state = OPEN
movei a,(cx)
tlne f,(debugf)
log <LEAFSV: LeafReset received for connection %1O>
popj p, ; else just return
; routine to break all connections logged in under this user
; call: pushj p,rstusr
; cx/ connection table index
; returns: +1, always, all connections logged in under this user broken
; (except this one, of course)
rstusr: movsi a,-nconn ; set up AOBJN loop
push p,cx
movei cx,(cx) ; clean off any left half stuff
rstus0: move b,usrnum(cx) ; get this user
came b,usrnum(a) ; get a user
jrst rstus1 ; not this one
cain cx,(a) ; make sure we don't kill ourselves
jrst rstus1 ; this is us
skipn b,contab(a) ; get sequin data block address
jrst rstus1 ; no connection here
movei c,DSTR ; make its state = DeSTRoYed
movem c,seqSta(b)
rstus1: aobjn a,rstus0 ; loop until all connections scanned
pop p,cx
move a,usrnum(cx)
movei b,(cx)
tlne f,(debugf)
log <LEAFSV: Reset all %1U connections from connection %2O>
popj p,
; routine to reset connections logged in from this host
; call: pushj p,rsthst
; cx/ connection table index
; returns: +1 always
rsthst: movsi a,-nconn ; set up AOBJN loop
push p,cx
movei cx,(cx) ; clean off any left half stuff
rsths0: move b,pupfnh(cx) ; get this user
came b,pupfnh(a) ; get a user
jrst rsths1 ; not this one
cain cx,(a) ; make sure we don't kill ourselves
jrst rsths1 ; this is us
skipn b,contab(a) ; get sequin data block address
jrst rsths1 ; no connection here
movei c,DSTR ; make its state = DeSTRoYed
movem c,seqSta(b)
rsths1: aobjn a,rsths0 ; loop until all connections scanned
pop p,cx
hlrz a,pupfnh(cx)
hrrz b,pupfnh(cx)
movei c,(cx)
tlne f,(debugf)
log <LEAFSV: All connections from %1O#%2O# reset by connection %3O>
popj p,
subttl PropLists
; These routines are extensions to the Leaf protocol, as defined by
; Jeff Mogul in his paper on Leaf and Sequin. They exist because the
; implementation status of Leaf at that time provided no machine
; independent mechanisms for determining information about a file.
; Leaf had not been used much within Xerox, and certainly not at all
; outside of Xerox; hence, there was no problem in using the machine
; dependent leader page of an IFS file to access file properties.
; Then, one day, along came the Dolphin Lisp machines, and all of a
; sudden, there were these PDP10's and PDP20's and VAX's which had to
; communicate with the Dolphins. And the Twenex Leaf implementor said,
; "Why is this Dolphin trying to read byte -4000???" Anyway, PUPFTP-
; like property lists are supposed to be the solution.
;
;
COMMENT
The following documents the Leaf Op formats:
GetLeafProp
+--------------+---+-----------+
| OP | 0 | |
+--------------+---+-----------+
| Handle |
+------------------------------+
| Recognition Mode |
+------------------------------+
| Desired Property |
+------------------------------+
| Username |
+------------------------------+
| User Password |
+------------------------------+
| Connect Name |
+------------------------------+
| Connect Password |
+------------------------------+
| File name |
+------------------------------+
If the supplied handle is 0, the file name specified in the OP is looked
up using the supplied user/connect name/password. If the handle is non-
zero, it is assumed to be a handle valid for the Leaf connection, and the
name and password information is ignored. In the Tenex/Tops-20
implementation, if the file name has to looked up, the file will be GTJFN'd
but not OPENF'd. The desired property is returned in a GetPropAnswer
OP. If the desired property=PropList, the entire file property list is
returned. The recognition mode is like the LeafOpenMode (same bits).
If the file has to be looked up, it is forgotten after responding to the
request.
Returns:
+----------+---+---------------+
| OP | 1 | |
+----------+---+---------------+
| Handle |
+------------------------------+
| Property in IFS string |
+------------------------------+
; routine to return file properties
; call: pushj p,PropLf
; p2/ pointer to request packet
; returns: +1,always
PropLf: movei a,(cx)
tlne f,(debugf)
log <LEAFSV: LeafGetFileProp received for connection %1O>
propl2: ildb c,p2 ; get handle
jumpe c,propl3 ; if no handle, read filename as in OpenLeaf
pushj p,chkhdl ; check the handle
jrst flseop ; bad handle, error already sent
jfcl ; not open; that's OK
; handle still in c at this point!
ibp p2 ; increment past RecognitionMode word
hrroi a,temp2 ; read the desired property
move b,p2
pushj p,rifsst
move p2,b
propl4: move a,[point 7,temp2]
move b,[point 7,temp2+10]
pushj p,genfp ; generate the desired property list
jrst flseop ; bad prop, return
move a,[point 16,LfAnPk,31]
dpb c,a ; deposit handle
hrroi b,temp2+10
pushj p,wifsst ; write the prop list in
move b,[point 16,LfAnPk]; point to start of packet
hrrz d,jfntab(c) ; Is the file open?
jumpe d,[push p,a
movei a,(c)
pushj p,$closf
jfcl
pop p,a
jrst .+1]
movei c,LfProp ; return a LeafProp answer
jrst LeafOp ; send it and return
; here when file handle supplied is 0; do login and GTJFN as per strings
; in packet
propl3: push p,p3
ildb p3,p2 ; get OpenMode word
move b,p2 ; read property string
hrroi a,temp2
pushj p,rifsst
move p2,b ; p2 ← updated pointer
pushj p,.login ; attempt login
jrst [pop p,p3
jrst flseop]
hrroi a,temp ; read filename
move b,p2 ; point to IFS string
pushj p,rifsst
move p2,b ; save updated pointer in right place
pushj p,prsfil
jrst [movei a,erNmMl ; fail on malformed name
hrroi b,[asciz/Malformed name/]
setz c,
pushj p,errLf ; send error
pop p,p3 ; recover p3
popj p,]
tlo p3,(1b0) ; Tell CHKVER not to open file
pushj p,chkver
jrst [setzb b,c
pushj p,errLf
pop p,p3
popj p,] ; return in error
hrlzm cx,jfntab(a) ; assign the JFN to this cnxtn, but say closed
pop p,p3 ; recover old p3
movei c,(a) ; get handle into c for prop list code
jrst propl4 ; rejoin proplist code
subttl FileHandle utilities
; routine to check validity of file handle
; call: c/ file handle
; cx/ connection table index
; returns: +1, invalid handle for this connection, ErrorLeaf sent
; +2, valid handle
; clobbers b, on success, others in case of error
chkhdl: skipn jfntab(c)
jrst chkhd1 ; Bad Handle
hlrz b,jfntab(c) ; make sure this connection owns the jfn
caie b,(cx) ; compare with cx
jrst chkhd1 ; wrong owner
hrrz b,jfntab(c) ; make sure file lock unbroken
trne b,400000
jrst chkhd2 ; file lock broken
caie b,0
aos (p) ; ret +3 if open
aos (p) ; ret +2 if note
popj p,
chkhd1: movei a,erBdHn ; bad file handle
hrroi b,[asciz/Bad file handle/]
jrst errLf
chkhd2: movei a,erBkLf ; file lock broken
hrroi b,[asciz/File lock broken/]
jrst errLf
subttl Property Lists
; routine to generate a property list
; call: pushj p,genfp
; a/ pointer to string property desired
; b/ pointer to place to build output property
; c/ file handle (JFN)
; returns: +1, unrecognized property
; +2, property OK, written in string pointed to by B
; property lists look like Lisp S-expressions:
; ((Author SCHOEN) (Read-Date 4-Jun-82 15:52) --- )
; Property lists with single entries should be of the same form:
; ((Author SCHOEN))
genfp: push p,b
push p,c
move b,[-nprops,,pldisp] ; lookup property
pushj p,fndkey## ; routine from PUPPRP.MAC
jrst genfpe ; property in bad format
jrst genfpe ; unrecognized property
move a,0(b) ; get pointer
pop p,c
pop p,b
pushj p,gnpsta ; start the prop list
movei a,(a)
pushj p,0(a) ; generate property
pushj p,gnpend ; end the prop list
setz a,
idpb a,b ; null off string
aos (p) ; return
popj p,
genfpe: movei a,↑d609
hrroi b,[asciz/Unknown Property/]
pushj p,errLf
pop p,c
pop p,b
popj p,
; known properties
pldisp: [asciz/Author/],,fpauth
[asciz/Byte-Size/],,fpbyte
[asciz/Complete-Filename/],,fpcfil
[asciz/Creation-Date/],,fpcdat
[asciz/Property-List/],,fpprop
[asciz/Read-Date/],,fprdat
[asciz/Size/],,fpsize
[asciz/Type/],,fptype
[asciz/Write-Date/],,fpwdat
nprops==.-pldisp
; routine to start a prop list
; call: pushj p,gnpsta
; b/ pointer to start of list
; returns: +1, always
gnpsta: tlc b,-1
tlcn b,-1
hrli b,(point 7)
push p,a
movei a,"("
idpb a,b
pop p,a
popj p,
; routine to end a prop list
; call: pushj p,gnpend
; b/ pointer to end of list
; returns: +1, always
gnpend: tlc b,-1
tlcn b,-1
hrli b,(point 7)
push p,a
movei a,")"
idpb a,b
pop p,a
popj p,
; routine to copy property name into prop list
; call: pushj p,cpyprp
; a/ pointer to prop name
; b/ pointer to output string
; returns: +1, always
cpyprp: push p,c ; save handle
tlc a,-1
tlcn a,-1
hrli a,(point 7)
tlc b,-1
tlcn b,-1
hrli b,(point 7)
cpypr0: ildb c,a ; get byte
jumpe c,cpypr1 ; leave if null
idpb c,b
jrst cpypr0
cpypr1: pop p,c ; restore handle
popj p, ; leave
; routines to generate individual file properties
; routine to generate Author
fpauth: pushj p,gnpsta ; start the item
hrroi a,[asciz/Author /] ; identify the prop
pushj p,cpyprp
ifn ft10x,<
push p,c ; save handle
push p,b ; save prop list pointer
movei a,(c) ; handle to A
move b,[1,,6] ; get author
movei c,b ; put dir number in B
gtfdb
pop p,a ; recover string ptr to A
dirst ; output string to ptr in A
jrst [movei c,↑d8 ; not in use, write the number instead
nout ; write the number
jfcl
jrst .+1]
move b,a ; string ptr back to B
pop p,c ; recover handle
>
ifn ft20,<
movei a,(c) ; get handle in A
hrli a,1 ; get string of last writer
gfust ; write into string
>
pushj p,gnpend ; end property
popj p, ; return
; routine to write byte-size property
fpbyte: pushj p,gnpsta
hrroi a,[asciz/Byte-size /] ; name the property
pushj p,cpyprp
push p,c
push p,b
movei a,(c)
move b,[1,,11]
movei c,b
gtfdb
ldb b,[point 6,b,11] ; read bytesize out of word
pop p,a ; recover prop list pointer
movei c,↑d10 ; output decimal number
nout
jfcl ; shouldn't fail
move b,a ; proplist pointer to B
pop p,c ; recover handle
pushj p,gnpend ; end entry
popj p,
; Routine to output file length (in decimal bytes)
fpsize: pushj p,gnpsta
hrroi a,[asciz/Size /] ; name the property
pushj p,cpyprp
push p,c
push p,b
movei a,(c)
sizef ; ask the operating system
jfcl ; better not fail
pop p,a ; recover prop list pointer
movei c,↑d10 ; output decimal number
nout
jfcl ; shouldn't fail
move b,a ; proplist pointer to B
pop p,c ; recover handle
pushj p,gnpend ; end entry
popj p,
; routine to output Complete-Filename prop
fpcfil: pushj p,gnpsta
hrroi a,[asciz/Complete-Filename /] ; copy prop name
pushj p,cpyprp
push p,c
move a,b ; string pointer to A
movei b,(c) ; jfn to B
ifn ft10x,<
move c,[1b5+1b8+1b11+1b14+1b35]
>
ifn ft20,<
move c,[1b2+1b5+1b8+1b11+1b14+1b35]
>
jfns ; add complete filename
move b,a ; string ptr to B
pop p,c ; recover handle
pushj p,gnpend
popj p,
; date routines
; read date
fprdat: pushj p,gnpsta
hrroi a,[asciz/Read-Date /] ; copy prop name
pushj p,cpyprp
push p,c
push p,b
movei a,(c)
move b,[1,,15] ; get read date
movei c,b
gtfdb
jrst fpdate ; join common code
; write date
fpwdat: pushj p,gnpsta
hrroi a,[asciz/Write-Date /] ; copy prop name
pushj p,cpyprp
push p,c
push p,b
movei a,(c)
move b,[1,,14] ; get read date
movei c,b
gtfdb
jrst fpdate ; join common code
; creation date
fpcdat: pushj p,gnpsta
hrroi a,[asciz/Creation-Date /] ; copy prop name
pushj p,cpyprp
push p,c
push p,b
movei a,(c)
move b,[1,,13] ; get read date
movei c,b
gtfdb
; fall through
; common code to put date in prop list and end item
; date in internal format in B, stack has string pointer in 0(p),
; file handle in -1(p)
fpdate: pop p,a ; string ptr to A
setz c,
odtim
move b,a ; string ptr to B
pop p,c ; recover handle
pushj p,gnpend ; end prop
popj p,
; routine to output file type
fptype: pushj p,gnpsta
hrroi a,[asciz/Type /]
pushj p,cpyprp
push p,c
push p,b
movei a,(c)
move b,[1,,11]
movei c,a
gtfdb
ldb a,[point 6,a,11] ; read bytesize out of word
cain a,↑d7 ; 7-bit bytes means text
jrst [hrroi a,[asciz/Text/]
jrst .+2]
hrroi a,[asciz/Binary/] ; else assume binary
pop p,b
pushj p,cpyprp
pushj p,gnpend
pop p,c
popj p,
; routine to output an entire property list
fpprop: move d,[-nprops,,pldisp] ; point to dispatch table
fpprp1: hrrz a,0(d) ; point to next prop
caie a,fpprop ; avoid recursion
pushj p,0(a) ; call the routine for this prop
aobjn d,fpprp1 ; loop while table still exists
popj p, ; done,leave
subttl Paged Disk I/O
; routine to simulate a SIN from a specific point in the file
; call: pushj p,rsin
; a/jfn
; b/address in file (bytes)
; c/length of read
; returns +1, always, data read into LfAnPk, for LeafReadAnswer
rsin: jumpe c,[move b,[point 8,LfAnPk+2,15]
popj p,]
push p,a
push p,b
push p,c
movsi c,(1b2) ; map read only
pushj p,getpag ; map a page
move b,-1(p) ; recover byte address
tlne b,-400 ; negative byte address?
jrst [addi b,4000
hrrz a,b
pushj p,getptr
tlc a,(30b11) ; make into an 8-bit byte pointer
move c,a
move b,[point 8,LfAnPk+2,15]
move a,(p)
jrst rsin1]
pushj p,getsiz ; get bytesize
move c,bytsiz(a) ; get byte size
cain c,7
jrst [idivi b,5000
move b,[point 8,LfAnPk+2,15]
idivi c,5
add c,[point 7,pmadr,-1
point 7,pmadr,6
point 7,pmadr,13
point 7,pmadr,20
point 7,pmadr,27](d)
move a,(p)
jrst rsin1]
idivi b,4000 ; get index into page
move b,[point 8,LfAnPk+2,15]
idivi c,4
add c,[point 8,pmadr,-1
point 8,pmadr,7
point 8,pmadr,15
point 8,pmadr,23](d); this creates the lh of the byte pointer
move a,(p) ; get count
; loop here
rsin1: ildb d,c ; get next byte
idpb d,b ; put in packet
soje a,rsin2 ; if done, leave
move d,-2(p) ; get JFN
move d,bytsiz(d) ; get byte size
cain d,7
jrst [camn c,[point 7,pmadr+777,34] ; run out of buffer page?
jrst rsin3 ; yes
jrst rsin1] ; no, loop
came c,[point 8,pmadr+777,31] ; run out of buffer page?
jrst rsin1 ; no, loop
rsin3: move c,(p) ; retrieve count
sub c,a ; get number of bytes read
exch b,-1(p) ; get file address
addi b,(c) ; update for bytes read
exch a,-2(p) ; retrieve jfn
movsi c,(1b2) ; map read only
pushj p,getpag ; get the next page
exch a,-2(p) ; recover count
exch b,-1(p) ; recover dest bytepointer
move c,-2(p) ; get jfn
move c,bytsiz(c) ; get byte size
cain c,7
jrst [move c,[point 7,pmadr,-1]
jrst rsin1]
move c,[point 8,pmadr,-1] ; new source byte pointer
jrst rsin1 ; loop
; here when done
rsin2: tlc b,(30b11) ; make packet end pointer 16 bits
movem b,-1(p) ; save pointer to packet end
pop p,c ; clean stack
pop p,b
pop p,a
popj p,
; routine to put file page in core buffer
; call: pushj p,getpag
; a/jfn
; b/address, in 8-bit bytes
; c/pmap bits
; returns: +1 always
getpag: push p,a
tlne b,400 ; negative byte address?
jrst getpg2 ; yes, get leader page
push p,c
move c,bytsiz(a) ; get bytsize
cain c,7 ; text file?
jrst [idivi b,5 ; yes, 5 bytes/word
jrst .+2]
idivi b,4 ; convert to word address
lsh b,-↑d9 ; convert word address to page
pop p,c
hrl a,a
hrri a,(b) ; set up for PMAP
camn a,curpag ; is that page in core now?
jrst getpg1 ; yes, don't pmap
movem a,curpag ; no, save it
seto a,
move b,[400000,,pmpag]
pmap ; unmap previous page in core
move a,curpag
pmap
pop p,a
popj p,
; here when page in core is that which is desired. Adjust access
; c/ pmap bits
getpg1: push p,b
move a,[400000,,pmpag]
move b,c
spacs ; change access bits
pop p,b
pop p,a
popj p,
; here when a leader page address is desired
getpg2: pushj p,makldr ; make the leader page
pop p,a
popj p,
ls curpag,1 ; contains jfn,,page # for page in buffer
; Routine to simulate a SOUT to a specific point in the file
; call: pushj p,rsout
; a/jfn
; b/address in file (bytes)
; c/length of read
; returns +1, always, data read from LeafPk into file
rsout: push p,a
push p,b
push p,c
movsi c,(1b2!1b3) ; map read, write
pushj p,getpag ; map a page
move b,-1(p) ; recover byte address
tlne b,400 ; negative byte address
jrst [addi b,4000
hrrz a,b
pushj p,getptr
tlc a,(30b11)
move c,a
move b,[point 8,LeafPk+2,15]
move a,(p)
jrst rsout1]
pushj p,getsiz ; get byte size
move c,bytsiz(a) ; get bytesize
cain c,7
jrst [idivi b,5000
move b,[point 8,LeafPk+2,15]
idivi c,5
add c,[point 7,pmadr,-1
point 7,pmadr,6
point 7,pmadr,13
point 7,pmadr,20
point 7,pmadr,27](d)
move a,(p)
jrst rsout1]
idivi b,4000 ; get index into page
move b,[point 8,LeafPk+2,15]
idivi c,4
add c,[point 8,pmadr,-1
point 8,pmadr,7
point 8,pmadr,15
point 8,pmadr,23](d); this creates the lh of the byte pointer
move a,(p) ; get count
; loop here
rsout1: ildb d,b ; get next byte
idpb d,c ; put in packet
soje a,rsout2 ; if done, leave
move d,-2(p) ; get JFN
move d,bytsiz(d) ; get bytesize
cain d,7
jrst [camn c,[point 7,pmadr+777,34] ; run out of buffer page?
jrst rsout3 ; yes
jrst rsout1] ; no, loop
came c,[point 8,pmadr+777,31] ; run out of buffer page?
jrst rsout1 ; no, loop
rsout3: move c,(p) ; retrieve count
sub c,a ; get number of bytes read
exch b,-1(p) ; get file address
addi b,(c) ; update for bytes read
exch a,-2(p) ; retrieve jfn
movsi c,(1b2!1b3) ; map read, write
pushj p,getpag ; get the next page
exch a,-2(p) ; recover count
exch b,-1(p) ; recover dest bytepointer
move c,-2(p) ; get JFN
move c,bytsiz(c) ; get bytesize
cain c,7
jrst [move c,[point 7,pmadr,-1]
jrst rsout1]
move c,[point 8,pmadr,-1] ; new source byte pointer
jrst rsout1 ; loop
; here when done
rsout2: tlc b,(30b11) ; make packet end pointer 16 bits
pop p,c ; clean stack
pop p,b
pop p,a
popj p,
; ---------------------------------------------------------------------
; UUO handler routines specific to PSVLEF (Stolen from PUPSRV)
; ---------------------------------------------------------------------
; Log given string with formatting actions
%ULOG:: TLZA F,(LGTTYF) ; Log only on file
; Log and type the given string with formatting actions
%UELOG::TLO F,(LGTTYF) ; Log on both file and TTY
PUSHJ P,FORMAT## ; Call formatter
PUSHJ P,BEGLOG ; Setup -- begin log entry
PUSHJ P,ENDLOG ; Completion -- end log entry
POPJ P, ; Return from UUO
; UUOs not used in the server
%LETC:: %URUNM:: %UNOIS:: %UPROM:: %UFTPM:: PUSHJ P,SCREWUP##
; Individual functions for escape sequences
; P - Selected address from Pup pointed to by PB
; 1P = Destination, 2P = Source
%LETP:: PUSH P,A ; Save string ptr
CAIL C,1 ; Make sure arg in range
CAILE C,3
PUSHJ P,SCREWUP
XCT [ PUSHJ P,GTDPRT ; 1 = Destination Port
PUSHJ P,GTSPRT]-1(C) ; 2 = Source Port
MOVE D,C ; Copy socket
MOVSI C,(A) ; Make net,,host
HRRI C,(B)
POP P,A ; Recover string ptr
MOVE B,[1B2+C] ; Full expansion, constants allowed
PUPNM ; Convert address to string
PUSHJ P,SCREWUP
POPJ P,
; Routines to return source and destination ports
; Get Destination Port from Pup
; PB/ Packet buffer ptr
; Returns +1:
; A/ Net, B/ Host, C/ Socket
GTDPRT::MOVE A,PBHEAD+2(PB) ; Get net/host and high socket
MOVE C,PBHEAD+3(PB) ; Get low socket
LSHC A,-↑D28 ; Right-justify net
LSH B,-↑D12 ; Right-justify high socket
LSHC B,-↑D16 ; Concatenate, right-justify host
LSH C,-4 ; Right-justify socket
POPJ P,
; Get Source Port from Pup
; PB/ Packet buffer ptr
; Returns +1:
; A/ Net, B/ Host, C/ Socket
GTSPRT::LDB A,PPUPSN ; Get net
LDB B,PPUPSH ; Get host
LDB C,PPUPSS ; Get socket
POPJ P,
; -----------------------------------------------------------------
; Logging routines
; -----------------------------------------------------------------
; Begin a log entry
; CX/ Connection index of connection being considered
; SQ/ Sequin data block pointer
; Returns +1, A/ string ptr to logging buffer
; Clobbers B, C
BEGLOG: PUSHJ P,LOKLOG ; shut off interrupts if on
MOVE A,LOGBPT ; Get current byte ptr
SETO B, ; Default time to now
MOVSI C,(1B10+1B12) ; Suppress seconds and colon
ODTIM ; Log the date and time
MOVEI B," " ; A space
IDPB B,A
SKIPL B,FX
SUBI B,400000 ; Convert to small number if not top fork
MOVE C,[1B2+2B17+10B35] ; 2 digits, octal radix
NOUT ; Record connection #
JRST [ MOVEI B,"?" ; If FX bad, just print ??
IDPB B,A
IDPB B,A
JRST BEGLO1 ]
BEGLO1: MOVEI B," " ; Another space
IDPB B,A
POPJ P,
; End a log entry
; A/ Used string ptr (into logging buffer)
; Returns +1
ENDLOG: HRROI B,[ASCIZ /
/]
SETZ C, ; Append crlf and null
SOUT
MOVE C,LOGBPT ; Get start of string
MOVEM A,LOGBPT ; Update pointer to end
TLNE F,(DEBUGF) ; Debugging?
JRST [ MOVEI A,101 ; Yes, always print on TTY
DOBE ; Avoid intermixed messages
JRST ENDLO2] ; Go type
TLNN F,(LGTTYF) ; No, serious error?
JRST ENDLO3 ; No, print nothing
TIME ; Yes, get now
SUBM A,LTTTIM ; Compute time since last we did this
EXCH A,LTTTIM ; Save now, get interval
CAIGE A,↑D30000 ; Too soon?
JRST ENDLO3 ; Yes, don't hog the logging TTY
MOVEI A,101 ; Wait for logging TTY to be free
DOBE
HRROI A,[ASCIZ /**LEAFSV /] ; Identify source of message
PSOUT
ENDLO2: MOVE A,C ; Recover message pointer
PSOUT ; Print message
ENDLO3: HRRZ A,LOGBPT ; Get rh of current pointer
CAIGE A,LOGBUF+LOGBFS/2 ; More than half full?
JRST ULKLOG ; No, unlock buffer and return
JRST DMPLO1
LS LTTTIM ; Time we last printed on logging TTY
; Logging routines (cont'd)
; Initialize logging package
; Returns +1
; Clobbers A
INILOG: MOVE A,[POINT 7,LOGBUF] ; Initialize byte ptr into buffer
MOVEM A,LOGBPT
TIME ; Get now
ADD A,[LOGLAT*↑D1000] ; Compute time to force dump
MOVEM A,LOGTIM ; Store it
SETOM LOGLOK ; Free the logging lock
POPJ P,
; Routine to lock logger
LOKLOG: AOSE LOGLOK
JRST [CAMN FX,LOGLKR ; Do we own the log lock?
POPJ P, ; Yes, just return
JRST .-1] ; No, loop on getting it
MOVEM FX,LOGLKR ; Save locker of log
POPJ P,
; Routine to call on exiting logging code
ULKLOG: SETOM LOGLOK
POPJ P,
; Dump log buffer on file
; Returns +1
; Clobbers A-C
DMPLOG::SKIPGE LOGBPT ; Any text buffered?
JRST DMPLO5 ; No, just reset clock
PUSHJ P,LOKLOG
DMPLO1: MOVSI C,(1B8+1B17) ; Ignore deleted, short form
DMPLO2: MOVE A,C ; Get bits
HRROI B,[ASCIZ /<SYSTEM>LEAFSV.LOG/]
TLNE F,(DEBUGF) ; Debugging?
HRROI B,[ASCIZ /LEAFSV.LOG/] ; Yes, make private log
GTJFN ; Look for an existing log file
JRST [ TLON C,(1B0) ; Failed, maybe make a new version
JRST DMPLO2 ; Try again
MOVE C,A ; Save reason for failure
JRST DMPLO3] ; Already did, give up
MOVE C,A ; Ok, save JFN
MOVE B,[7B5+1B22] ; Open for append
OPENF
JRST [ EXCH A,C ; Failed, recover JFN
RLJFN ; Release it
CAI
HRRZ A,LOGBPT ; Look at buffer pointer again
CAIGE A,LOGBUF+LOGBFS-↑D<200/5> ; Desperately full?
JRST DMPLO4 ; No, leave it and try again later
JRST DMPLO3] ; Yes, flush buffer
HRROI B,LOGBUF ; Ok, make string ptr to log buffer
SETZ C, ; Until null
SOUT ; Append bufferful to log file
CLOSF ; Close it
CAI ; Huh?
MOVE A,[POINT 7,LOGBUF] ; Reinitialize buffer pointer
MOVEM A,LOGBPT
DMPLO4: PUSHJ P,ULKLOG
DMPLO5: TIME ; Get now
ADD A,[LOGLAT*↑D1000] ; Compute time to force dump
MOVEM A,LOGTIM
POPJ P, ; Done
; Here if failed to open file. C has jsys error code
DMPLO3: MOVE A,[POINT 7,LOGBUF] ; Reset buffer pointer
MOVEM A,LOGBPT
PUSHJ P,ULKLOG
JRST DMPLO5
GS LOGTIM ; Time of last real append to log file
GS LOGBPT ; Byte ptr into LOGBUF
GS LOGBUF,LOGBFS ; Buffer region for logging entries
GS LOGLOK ; Lock word on Log
GS LOGLKR ; Owner of lock on log
subttl IFS Leader page simulations
; These routines manage a image of an IFS leader page created from
; information contained in a Twenex FDB. These routines exist
; because the Xerox 1100 Scientific Information Processor (Dolphin
; Lisp machine) uses various entries in the leader page to store/
; retrieve information about a file. This is a hopelessy machine
; dependent mechanism which will eventually be replaced by a file
; property list system. Until then, we suffer.
; The following is a layout of the IFS file leader page:
; WORD ENTRY LENGTH (WORDS)
; ---- ----- ←←←←←←←←←←←←←←
; 0 Creation time 2
; 2 Write time 2
; 4 Read time 2
; 6 Name 24
; 32 Leader properties 322
; 354 Spare 12
; 366 Property begin|length 1
; 367 Consec bit|changeSerial byte 1
; 370 dirFp 5
; 375 hintLastPageFA 3
; 400 Complete IFS pathname 62
; 462 Inherited properties 14
; 476 Author 24
; 522 Last backup time 2
; 524 File type 1
; 525 File bytesize 1
; 526 IFS flags 1
ldrcre==0←1 ; Creation time
ldrwri==2←1 ; Write time
ldrrea==4←1 ; Read time
ldrnam==6←1 ; Name
ldrprp==32←1 ; Leader properties
ldrspr==354←1 ; Spare
ldrpr1==366←1 ; Property begin
ldrbit==367←1 ; Consec bit|changeSerial byte
ldrdfp==370←1 ; dirFp
ldrhnt==375←1 ; hintLastPageFA
ldrcnm==400←1 ; Complete IFS pathname
ldrinh==462←1 ; Inherited properties
ldraut==476←1 ; Author
ldrbkp==522←1 ; Last backup time
ldrtyp==524←1 ; File type
ldrbyt==525←1 ; File bytesize
ldrflg==526←1 ; IFS flags
; routine to return a bytepointer to a property in leader page
; call: pushj p,getptr
; a/byte offset into leader page
; p1/address of leader page in core
; returns: +1, always, 16-bit bytepointer in a
getptr: push p,b
idivi a,4 ; compute word offset
subi b,4 ; compute bytepointer offset quantity
movns b ; b has 1, 2, 3, or 4
lsh b,3 ; b has 10, 20, 30, 40
addi b,4 ; b has 14, 24, 34, 44
lsh b,6 ; b has 1400, 2400, 3400, 4400
addi b,20 ; b has 1410, etc
lsh b,↑d24 ; b has 142000,,0, etc
ior a,b ; make the bytepointer
addi a,ldrpag ; point into the leader
pop p,b
popj p,
; routine to store a time into the leader page
; call: pushj p,stotim
; a/Internal time
; b/bytepointer to leader page offset
; p1/address of leader page
; returns: +1, always
; clobbers a (returns Alto time format right-justified)
stotim: push p,a ; save time
move a,b ; get byte offset into a
pushj p,getptr ; make a bytepointer
move b,a ; save bytepointer in b
pop p,a ; restore time to a
push p,b ; save b
pushj p,timalt ; Convert to Alto time (ret'd in b)
move a,b ; move to a
pop p,b ; restore bytepointer
rot a,-↑d16 ; get high byte
idpb a,b ; deposit
rot a,↑D16 ; get next lower byte
idpb a,b ; deposit
popj p,
; routine to translate Twenex FDB to leader page
; call: pushj p,makldr
; a/JFN of file
; returns: +1, always
makldr: camn a,ldrfil ; this JFN already in leader page?
popj p, ; yes, return now
push p,b
push p,c
skipe ldrfil ; anything in the leader page?
pushj p,wrtldr ; yes, write it out
move b,[25,,0] ; read the entire FDB
movei c,fdbblk
gtfdb
push p,a ; save JFN
movem a,ldrfil ; save JFN of file in LDRPAG
move a,fdbblk+13 ; get create time
movei b,ldrcre
pushj p,stotim
move a,fdbblk+14 ; get write time
movei b,ldrwri
pushj p,stotim
move a,fdbblk+15 ; get read time
movei b,ldrrea
pushj p,stotim
ifn ft10x,<
move a,fdbblk+21 ; get last dump time (Tenex only)
movei b,ldrbkp
pushj p,stotim
>
hrroi a,temp ; write name of file
move b,(p) ; get JFN
move c,[1b8+1b11+1b14+1b35] ; print name.ext;version
jfns
movei a,ldrnam ; get pointer
pushj p,getptr
hrroi b,temp
pushj p,wbcpst ; write into leader page
hrroi a,temp
ifn ft10x,<
move c,[1b5+1b8+1b11+1b14+1b35]
>
ifn ft20,<
move c,[1b2+1b5+1b8+1b11+1b14+1b35]
>
move b,(p) ; now format the "complete IFS pathname"
jfns
movei a,ldrcnm
pushj p,getptr
hrroi b,temp
pushj p,wbcpst ; and store in core
move a,fdbblk+11 ; get bytesize
ldb b,[point 6,a,11]
movei a,ldrbyt
pushj p,getptr
idpb b,a ; store bytesize
movei c,2 ; assume type is binary
cain b,7 ; 7-bit bytes?
movei c,1 ; Yes, type is text
movei a,ldrtyp
pushj p,getptr
idpb c,a ; store file type
ifn ft10x,<
hlrz b,fdbblk+6 ; get directory number of last writer
hrroi a,temp ; make it into a string
dirst
jrst [hrroi a,temp ; not in use, write a number, instead
movei c,↑d8
nout ; write the number
jfcl
jrst .+1]
movei a,ldraut
pushj p,getptr
hrroi b,temp
pushj p,wbcpst ; write the author string
>
ifn ft20,<
move a,(p) ; get JFN
hrli a,1 ; get string of last writer
hrroi b,temp
gfust ; get it
movei a,ldraut
pushj p,getptr
hrroi b,temp
pushj p,wbcpst ; write the author string
>
pop p,a ; retrieve the JFN
pop p,c
pop p,b
popj p, ; leave
lsp ldrpag ; page on which to build IFS leader page
ls ldrfil ; has JFN of file in leader page, 0 if empty
; routine to write leader page back into Twenex FDB
; to be supplied
; call: pushj p,wrtldr
; returns: +1, always
; clobbers b,c
wrtldr: push p,a
movei a,ldrtyp
pushj p,getptr
ildb b,a ; get file type from leader
move a,fdbblk+11 ; get bytesize from FDB
ldb a,[point 6,a,11]
cain a,0 ; don't change it FDB already has size
jrst [hrrz a,ldrfil ; change it
hrli a,11
movei c,↑d8 ; assume binary file
caie b,2 ; binary?
movei c,↑d7 ; nope, text, write 7-bit bytes
movei b,(c)
setz c,
dpb b,[point 6,c,11]
movsi b,007700
chfdb
jrst .+1]
setzm ldrfil
pop p,a
popj p,
ls fdbblk,25
ls temp,100 ; temp storage
ls temp2,140 ; another temp storage area
ls LeafPk,200 ; Leaf packet reception space
ls LfAnPk,200 ; answer space
; Tables indexed by JFN
gs jfntab,njfn ; connection owner,,open mode
gs wildft,njfn ; GTJFN flags for JFN
gs bytsiz,njfn ; byte size file written in
gs bytcnt,njfn ; number of bytes in the file
; Tables indexed by CX
gs connum,nconn
gs usrnum,nconn
ls stack,stksiz ; sequin stack
ls lfpdl,lflpdl ; leaf stack
ls leafcx ; debugging info
end start