mirror of
https://github.com/PDP-10/its.git
synced 2026-02-04 23:54:37 +00:00
2097 lines
46 KiB
Plaintext
2097 lines
46 KiB
Plaintext
;-*- Midas -*-
|
||
title RMTDEV - MLDEV for non-ITS hosts
|
||
|
||
ifndef dbgsw,dbgsw==0
|
||
|
||
;;July 1985, GZ
|
||
|
||
a=:1
|
||
b=:2
|
||
c=:3
|
||
d=:4
|
||
e=:5
|
||
t=:6
|
||
tt=:7
|
||
j=:10
|
||
k=:11
|
||
v=:12
|
||
w=:13
|
||
|
||
F=:14 ;Flags
|
||
|
||
U=:15 ;AC munged at interrupt level
|
||
INT=:16 ;Interrupt-p flag, in AC for more efficient .hanging
|
||
|
||
p=:17
|
||
call=:pushj p,
|
||
ret=:popj p,
|
||
nop=:jfcl
|
||
callret==:jrst
|
||
|
||
;Twenex-style label-generating macros.
|
||
.insrt midas;macsym
|
||
|
||
define syscal name,args
|
||
.call [ setz ? sixbit/name/ ? args ((setz))]
|
||
termin
|
||
|
||
define fallto label
|
||
if2,ifn .-label,.fatal fallto label not falling to label
|
||
termin
|
||
|
||
define note &text
|
||
ifn dbgsw,[
|
||
call [call $note
|
||
.length text
|
||
ascii text]
|
||
]
|
||
.else jfcl
|
||
termin
|
||
|
||
define nout loc
|
||
ifn dbgsw,[
|
||
call [call $nout
|
||
loc]
|
||
]
|
||
.else jfcl
|
||
termin
|
||
|
||
define nsix loc
|
||
ifn dbgsw,[
|
||
call [call $nsix
|
||
loc]
|
||
]
|
||
.else jfcl
|
||
termin
|
||
|
||
define nstr loc
|
||
ifn dbgsw,[
|
||
call [call $nstr
|
||
loc]
|
||
]
|
||
.else jfcl
|
||
termin
|
||
|
||
chboj==:1
|
||
chusr==:2
|
||
chneti==:3
|
||
chneto==:chneti+1
|
||
chtyo==:chneto+1 ;For debugging output
|
||
|
||
;;Flags in RHS of F. (LHS of F has the open mode)
|
||
f%pclsr==:000001 ;Our last JOBRET failed so expect a restarted call.
|
||
f%open==:000002 ;Creator has file open.
|
||
f%eofi==:000004 ;Have reached end of input from net
|
||
f%clss==:000010 ;Sent close request, don't leave til get a reply
|
||
f%dnrf==:000020 ;Device was xxDNRF:
|
||
f%blka==:000040 ;Open in block ascii mode
|
||
f%dbug==:000100 ;Debug mode
|
||
f%conn==:000200 ;Have a connection
|
||
f%dir==:000400 ;doing a directory listing
|
||
;Flags that say that interrupts happened and are awaiting mp level processing.
|
||
fi%boj==:100000
|
||
fi%nti==:200000
|
||
fi%nto==:400000
|
||
|
||
.insrt dsk:system;chsdef
|
||
;;Special Chaosnet Packet Opcodes
|
||
;;Opcodes 200-217 are data. The 10 bit means this is eof. The last 3 bits
|
||
;;give the number of padding bits in the last byte of the packet, so we can
|
||
;;transmit exact numbers of bits. All data is transmitted in FTP-like image
|
||
;;mode (i.e. as a bit stream of relevant bits).
|
||
%COLST==:210 ;Last (EOF) packet of file
|
||
%COMND==:220 ;A command
|
||
%CORPL==:221 ;A reply to a command
|
||
%COASY==:222 ;Asynchronous error from server.
|
||
|
||
;Dunno, MLDEV uses 10, FCDEV uses 20...
|
||
WINDOW==:10 ;Net window size
|
||
|
||
chnl==:200\^M ;Chaosnet newline character
|
||
|
||
;;%COMND/%CORPL opcodes
|
||
r.opno==:0 ;Output open
|
||
r.opni==:1 ;Input open
|
||
r.dirl==:2 ;List directory
|
||
r.renm==:3 ;Rename
|
||
r.dele==:4 ;Delete
|
||
r.expu==:5 ;Expunge
|
||
r.crdi==:6 ;Create directory
|
||
r.mlnk==:7 ;Make link
|
||
r.reu==:10 ;Reuse
|
||
|
||
r.cls==:20 ;Close
|
||
r.alc==:21 ;Input allocation
|
||
r.acc==:22 ;Access
|
||
r.rnmw==:23 ;Rename while open
|
||
r.delw==:24 ;Delete while open
|
||
r.srd==:25 ;Set Reference Date
|
||
r.sfd==:26 ;Set File write Date
|
||
r.saut==:27 ;Set file Author
|
||
r.rsts==:30 ;Read file status
|
||
r.srpb==:31 ;Set File Reap Bit
|
||
|
||
;;JOBCAL argument definitions
|
||
|
||
;JOBCAL words for OPEN
|
||
J.FN1==:1 ;First filename
|
||
J.FN2==:2 ;Second filename
|
||
J.SNM==:3 ;Sname
|
||
J.DEV==:4 ;Device
|
||
J.MOD==:5 ;Open mode
|
||
J.FNM==:7 ;String-filename pointer, or 0 if only sixbit
|
||
|
||
;JOBCAL words for IOT
|
||
J.PTR==:0 ;IOT pointer
|
||
|
||
;JOBCAL words for SIOT
|
||
J.CNT==:0 ;Byte count
|
||
|
||
;JOBCAL words for ACCESS
|
||
J.PTR==:0 ;ACCESS pointer
|
||
|
||
;JOBCAL words for MLINK
|
||
J.TFN1==:0 ;Target (linked-to) first filename
|
||
J.FN1==:1 ;Source (link's) first filename
|
||
J.FN2==:2 ;Source second filename
|
||
J.SNM==:3 ;Source sname
|
||
J.DEV==:4 ;Source device
|
||
J.TFN2==:5 ;Target second filename
|
||
J.TSNM==:6 ;Target sname
|
||
J.FNM==:7 ;Source string-filename pointer or 0
|
||
J.TFNM==:10 ;Target string-filename pointer or 0
|
||
|
||
;JOBCAL words for FDELE (rename/delete)
|
||
J.TFN1==:0 ;Target (new) first filename, or 0 if delete
|
||
J.FN1==:1 ;Source (old) first filename
|
||
J.FN2==:2 ;Source second filename
|
||
J.SNM==:3 ;Source sname
|
||
J.DEV==:4 ;Source device
|
||
J.TFN2==:5 ;Target second filename, or 0 if delete
|
||
J.FNM==:7 ;Source string-filename pointer
|
||
J.TFNM==:10 ;Target string-filename pointer
|
||
|
||
;JOBCAL words for FDELEWO (rename/delete while open)
|
||
J.TFN1==:0 ;Target (new) first filename, or 0 if delete
|
||
J.TFN2==:5 ;Target second filename, or 0 if delete
|
||
J.TFNM==:10 ;Target string-filename pointer
|
||
|
||
;JOBCAL words for CALL
|
||
J.CAL==:0 ;Sixbit call name
|
||
J.CTB==:1 ;Control bits
|
||
J.ARGC==:2 ;Count of arguments
|
||
J.ARG1==:3 ;First arg
|
||
J.ARG2==:4 ;Second arg
|
||
J.ARG3==:5 ;Third arg
|
||
;....
|
||
|
||
subttl variable definitions
|
||
|
||
loc 42
|
||
jsr tsint
|
||
loc 77
|
||
sixbit /MLDEV/ ;The pretender...
|
||
|
||
rdevn: block 4 ;Filename for JOBSTS (and nominally RCHST)
|
||
raccp: 0 ;Access pointer, must follow RDEVN block for RCHST.
|
||
opmode: 0 ;Mode from OPEN call (for JOBSTS)
|
||
crunam: 0 ;Creator's UNAME
|
||
crjnam: 0 ;Creator's JNAME
|
||
|
||
;;Next four must be in this order (for FILLEN .call)
|
||
fillen: 0 ;File length in BYTSIZ bytes or -1 if unknown (unknowable).
|
||
bytsiz: 0 ;Byte size open in, 7 for unit ascii, otherwise 36.
|
||
filbln: 0 ;File length in bytes of size written in
|
||
filbsz: 0 ;Byte size file written in
|
||
|
||
;Hope nobody snoops beyond this point...
|
||
|
||
debug: 0
|
||
|
||
pat:
|
||
patch: block 100
|
||
patche: -1
|
||
|
||
;;Random file properties.
|
||
.scalar fildat ;File creation date in universal time or 0 if unknown.
|
||
.scalar filref ;File reference date in universal time or 0.
|
||
.scalar filaut ;Author's name in sixbit or 0.
|
||
|
||
;;Data returned by JOBCAL.
|
||
.scalar jbcop ;JOBCAL Opcode
|
||
.scalar jbc(jbclen==:13) ;JOBCAL Arguments
|
||
|
||
;;Variables for buffer management
|
||
.scalar bufsiz ;Total buffer size in BYTSIZ bytes
|
||
.scalar bufcnt ;Number of BYTSIZ bytes available to user for reading/writing
|
||
.scalar bufptr ;Pointer into buffer for user<->buffer communication.
|
||
;In block mode, it's the address of next word to read/write
|
||
;In unit mode, it's a byte pointer.
|
||
.scalar bufptn ;Count of BYTSIZ bytes from BUFPTR to BUFEND
|
||
.scalar netptr ;Pointer into buffer for net<->buffer communication.
|
||
;RH has address of next word, LH has number of bits in
|
||
; that word still available to user (and hence not to net)
|
||
.scalar alcptr ;On input, address of first unallocated word in BUF
|
||
.scalar alccnt ;Number of allocated bits not received yet.
|
||
|
||
;;Variables for image mode packet<->buffer conversion
|
||
.scalar wdlen ;Number of bits in each buffer word (35 if ascii, 36 if image)
|
||
.scalar fudge ;wdlen-32 (32=number of bits in each packet word)
|
||
|
||
;;Handling of net commands
|
||
.scalar seqnum ;Transaction counter
|
||
.scalar rplseq ;Number of reply that we're waiting for, or -1 if not waiting
|
||
.scalar accseq ;Number of access command outstanding, or -1 if none.
|
||
|
||
.scalar iotcnt ;If non-zero, number of bytes remaining in a hung IOT
|
||
;On input, IOT hung because data still not available.
|
||
;On output, because we stopped to read some net reply packets.
|
||
|
||
fnmstl==:100 ;Max length of filename
|
||
.scalar trunam(fnmstl) ;Truename of file, from the server
|
||
.scalar sysnam(fnmstl) ;Permanently the truename of file, for JOBSTS
|
||
|
||
.scalar fdevn ;Foreign device name from initial open device name.
|
||
.scalar fhost ;Foreign host name from initial open device name.
|
||
.scalar fhostn ;Foreign host number
|
||
|
||
.scalar pktbuf(%cpmxw) ;Chaos packet buffer.
|
||
|
||
pdllen==:100
|
||
.scalar pdl(pdllen+4) ;Guess
|
||
|
||
subttl Initialization and top-level loop
|
||
|
||
begin: move p,[-pdllen,,pdl-1]
|
||
setz f, ;Clear flags
|
||
ifn dbgsw,[
|
||
.suset [.roption,,a]
|
||
tlnn a,%opddt
|
||
ifskp.
|
||
txo f,f%dbug
|
||
tlo a,%opojb
|
||
.open chtyo,[.uao\%tjdis,,'tty ? setz ? setz]
|
||
.lose %lssys
|
||
.value [asciz ""]
|
||
.suset [.soption,,a]
|
||
note "AHere we go..."
|
||
endif.
|
||
]
|
||
.suset [.smask,,[%piioc+%piilo+%pimpv+%pipdl]]
|
||
.open chboj,[30\.bio,,'boj] ;20=don't hang, 10=one way.
|
||
die
|
||
syscal rfname,[%climm,,chboj ? %clout,,a
|
||
%clout,,crunam ? %clout,,crjnam] ;Names for PEEK
|
||
nop
|
||
.call jobcal ;Get first call
|
||
die
|
||
note "[initial jobcal]"
|
||
move a,jbcop ;If he already pclsr'd, give up, since he will
|
||
tlne a,%jgcls ;give up on us since we did a JOBGET and saw
|
||
die ;that fact.
|
||
andi a,-1 ;Separate out opcode
|
||
caie a,%jornm ;Should be either FDELE
|
||
cain a,%jolnk ; or MLINK
|
||
ifskp.
|
||
caie a,%joopn ; or OPEN
|
||
bug ;I wanna know if any new ops get defined.
|
||
endif.
|
||
setom jbcaln' ;Flag initial jobget done
|
||
|
||
movei a,hstpag ;Try to figure out host
|
||
movei b,chusr
|
||
call netwrk"hstmap
|
||
bug
|
||
move a,jbc+j.dev ;Get device
|
||
movem a,jobdev' ;Save for reuse
|
||
camn a,[sixbit/KANSAS/] ;Special dispensation
|
||
move a,[sixbit/OZKS/]
|
||
camn a,[sixbit/SP/] ;Both acceptable, but standardize on one
|
||
move a,[sixbit/SPEECH/]
|
||
movem a,jbc+j.dev
|
||
tlz a,777700 ;Mask out the first 2 chars
|
||
came a,['DNRF]
|
||
ifskp.
|
||
xorm a,jbc+j.dev ;Clear the DNRF part from official device name
|
||
tro f,f%dnrf ;and remember we had it
|
||
endif.
|
||
setzm fhostn
|
||
move a,jbc+j.dev
|
||
movem a,rdevn ;Remember device for .RCHST's
|
||
movem a,fhost ;Assume it's the host name
|
||
call sixhst
|
||
jrst [ hllz a,rdevn ;No luck, try first two chars
|
||
tlz a,77
|
||
movem a,fhost
|
||
call sixhst
|
||
jrst [ movsi a,%ensdv ;No other good ideas, return with
|
||
jrst nogoe] ;no such device
|
||
move b,rdevn ;Won, get the foreign device
|
||
lsh b,2*6 ;from last 4 chars
|
||
jrst .+2]
|
||
move b,[sixbit/PS/] ;Else default foreign device
|
||
movem b,fdevn ;Remember this
|
||
movem b,jbc+j.dev ;Here too, like MLDEV, not sure why
|
||
movem a,fhostn ;Save host number
|
||
call netwrk"hstunmap ;Flush host pages
|
||
bug
|
||
move w,[440700,,buf] ;Cons RFC string
|
||
move a,[sixbit/RMTDEV/] ;RMTDEV<sp>UNAME
|
||
call wsix
|
||
movei a,40
|
||
idpb a,w
|
||
.suset [.rxunam,,a]
|
||
call wsix
|
||
setz a,
|
||
idpb a,w
|
||
conn: note " Connect..."
|
||
movei a,chneti ;Make the connection
|
||
move b,fhostn ;Host number
|
||
movei c,buf
|
||
movei d,window
|
||
call netwrk"chacon
|
||
jrst nogo
|
||
txo f,f%conn ;Have a connection now
|
||
setzm int ;All set up, can turn on interrupts now
|
||
.suset [.smsk2,,[1_chboj+1_chneti+1_chneto]]
|
||
setzm seqnum ;Start off transaction sequence numbers
|
||
note "OK
|
||
"
|
||
;Joins here when reused.
|
||
REUSE1: setom rplseq ;Not waiting for system call reply.
|
||
setom accseq ;No access command outstanding.
|
||
setzm iotcnt ;No iot in progress
|
||
trz f,f%open\f%clss\f%pclsr ;No file open, no close or pcl outstanding
|
||
tro f,fi%boj ;Fake a job interrupt for the initial jobcal.
|
||
fallto goloop
|
||
|
||
;;Main program loop.
|
||
;"<<"
|
||
goloop: note "==>>Goloop"
|
||
setzm int
|
||
trze f,fi%nti ;Net input interrupt
|
||
jrst ntint ; Read and handle a packet from server
|
||
skipe iotcnt ;If we interrupted an output IOT to read
|
||
tlnn f,%doout ;net replies
|
||
caia
|
||
jrst jioto ;Go back to finish it
|
||
trze f,fi%boj ;BOJ interrupt
|
||
jrst bojint ; process user call
|
||
trze f,fi%nto ;Net output interrupt
|
||
jrst ntoint ; Transfer some data if have any
|
||
skipl int ;Nothing, wait for an interrupt
|
||
.hang
|
||
jrst goloop
|
||
|
||
;;Here on chaosnet failure on initial command
|
||
nogo: movsi a,%enadv ;Device not available.
|
||
nogoe: movem a,errcod
|
||
note "Connection failed"
|
||
movei c,20. ;Number of times to JOBRET before we think other side
|
||
do. ;is gone.
|
||
.call jobcal
|
||
die ;JOBGET on initial is not supposed to fail.
|
||
move a,jbcop
|
||
tlne a,%jgcls ;He closed us so we can stop now.
|
||
exit.
|
||
.call jbrerr ;Keep trying to return this error, in case he pclsr's
|
||
sojg c,[movei b,1 ? .sleep b, ? jrst top.] ;and comes back.
|
||
enddo.
|
||
skipn fhostn ;Did we ever get a host?
|
||
die ;No, that's it
|
||
fallto reuse ;Let him keep trying if he really wants to
|
||
|
||
;COME HERE WHEN WE HAVE BEEN FINISHED WITH BY ONE CREATOR, TO OFFER OURSELVES
|
||
;TO OTHERS.
|
||
REUSE: MOVEI A,30.*5 ;WAIT FIVE SECONDS FOR SOMEONE TO REUSE US.
|
||
.SUSET [.SAMSK2,,[1_CHBOJ]]
|
||
SYSCAL JOBREU,[
|
||
JOBDEV ;DEVICE NAME WE ARE HANDLING.
|
||
['JOBDEV] ;FILENAMES WE WERE LOADED FROM.
|
||
JOBDEV
|
||
['DEVICE]
|
||
A] ;AMOUNT OF TIME TO WAIT
|
||
JRST REUSL
|
||
.SUSET [.SIMSK2,,[1_CHBOJ]]
|
||
note "AHere we go again..."
|
||
SYSCAL RFNAME,[ ;SOMEBODY GOBBLED US. FIND OUT WHO, FOR PEEK.
|
||
%CLIMM,,CHBOJ
|
||
%CLOUT,,A
|
||
%CLOUT,,CRUNAM
|
||
%CLOUT,,CRJNAM]
|
||
JFCL
|
||
jxe f,f%conn,conn
|
||
movei a,r.reu
|
||
call setcmd
|
||
movem a,rplseq
|
||
.suset [.rxunam,,a]
|
||
call wsix
|
||
call sndcmd
|
||
do.
|
||
call reply
|
||
came b,rplseq
|
||
loop.
|
||
enddo.
|
||
note "Synched"
|
||
jrst reuse1
|
||
|
||
;HERE IF WE SEE WE ARE NOT GOING TO BE REUSED.
|
||
REUSL: TRNE F,F%CLSS ;IF WE SENT A CLOSE COMMAD, WE MUST WAIT FOR THE REPLY,
|
||
JRST GOLOOP ;WHICH WILL MAKE US COME BACK TO DIE.
|
||
;COME HERE TO REALLY GIVE UP THE GHOST.
|
||
$die: txne f%dbug
|
||
; .break 16,100000
|
||
.value
|
||
.logout 1,
|
||
.value
|
||
0
|
||
|
||
die==:<pushj p,$die>
|
||
|
||
subttl BOJ interrupt dispatch
|
||
|
||
.scalar lastop ;Last opcode (unless f%pclsr)
|
||
.scalar ljbrta ;2 + .CALL JOBRET address if f%pclsr
|
||
|
||
pclsr: note " Pclsr'd"
|
||
pop p,ljbrta ;A failing jobret indicates that creator was
|
||
setom lastop ;pclsrd and we should expect him to retry his
|
||
tro f,f%pclsr\fi%boj ;system call. We must set FI%BOJ now because
|
||
jrst goloop ;coming back in might not set the interrupt bit
|
||
|
||
pcl==:pushj p,pclsr ;Follow every JOBRET with this
|
||
|
||
bojint: note "ABOJ interrupt..."
|
||
setzm iotcnt ;I guess he gave up on that IOT...
|
||
aosg jbcaln ;-1 if initial, don't do again
|
||
ifskp.
|
||
.call jobcal
|
||
jrst goloop
|
||
endif.
|
||
move b,jbcop ;Dispatch on opcode
|
||
tlne b,%jgcls
|
||
jrst jcls
|
||
movei a,(b)
|
||
caile a,%jocal
|
||
bug ;I want to know if any new ops get defined
|
||
cain a,%jocal
|
||
move a,jbc+j.cal
|
||
tlne b,%jgfpd ;If this is a retry of a call that pclsr'ed,
|
||
jrst [note "retry..."
|
||
skipl rplseq ;If waiting for a net reply to last command
|
||
came a,lastop ;And really have the same opcode (paranoia...)
|
||
caia
|
||
jrst goloop ;Just keep waiting...
|
||
trzn f,f%pclsr ;Something PCLSR'd and we noticed?
|
||
jrst .+1 ;No, treat this as a new invocation.
|
||
note "retrying"
|
||
move b,ljbrta ;Else yes, we finished with it so just give
|
||
jrst -2(b)] ;him the same jobret again.
|
||
setom rplseq ;I guess he no longer wants that reply
|
||
setzm iotcnt ;or that (input) iot
|
||
trz f,f%pclsr ;We can't handle a retry after anything else happens.
|
||
movem a,lastop
|
||
jrst @disp(b)
|
||
|
||
disp: offset -.
|
||
%joopn:: jopen
|
||
%joiot:: jiot
|
||
%jolnk:: jmlink
|
||
%jorst:: jret ;Just return
|
||
%jorch:: jrch
|
||
%joacc:: jacc
|
||
%jornm:: jfdele
|
||
%jorwo:: jrnmwo
|
||
%jocal:: jsyscl
|
||
offset 0
|
||
|
||
;More dispatching
|
||
jsyscl: move a,jbc+j.cal ;Get .call name
|
||
camn a,[sixbit/FORCE/]
|
||
jrst jforce
|
||
camn a,[sixbit/FINISH/]
|
||
jrst jfinish
|
||
camn a,[sixbit/FILLEN/]
|
||
jrst jfille
|
||
camn a,[sixbit/SFDATE/]
|
||
jrst jsfdat
|
||
camn a,[sixbit/SRDATE/]
|
||
jrst jsrdat
|
||
camn a,[sixbit/SAUTH/]
|
||
jrst jsauth
|
||
camn a,[sixbit/RFDATE/]
|
||
jrst jrfdat
|
||
camn a,[sixbit/RRDATE/]
|
||
jrst jrrdat
|
||
camn a,[sixbit/RAUTH/]
|
||
jrst jrauth
|
||
camn a,[sixbit/ACCESS/]
|
||
jrst jsacc
|
||
camn a,[sixbit/SREAPB/]
|
||
jrst jsreap
|
||
note ".Call ?"
|
||
nsix a
|
||
note "?..."
|
||
jrst wtderr ;That's all we handle.
|
||
|
||
subttl Initial OPEN
|
||
;Should we check that file is not open already, or is that guaranteed?
|
||
jopen: move a,jbc+j.mod ;Get open-mode
|
||
trnn a,%doout
|
||
note "OpenI..."
|
||
trne a,%doout
|
||
note "OpenO..."
|
||
trne f,f%dnrf ;If DNRF: from device name
|
||
tro a,%donrf ;set here too
|
||
movem a,opmode ;Save for JOBSTS
|
||
hrl f,a ;And in F, for easy access
|
||
movei a,%ensmd ;Check for unknown modes
|
||
tlne f,#<%doout\%doimg\%doblk\%donrf\%donlk\%dorwt\%dowov>
|
||
jrst opnerr
|
||
movei a,%esco ;Check for self-contradictory modes
|
||
tlnn f,%doout
|
||
tlnn f,%dowov ;(RWT is also supposedly for output only, but
|
||
caia ;it sorta has a reasonable interpretation for
|
||
jrst opnerr ;input as well, so we'll just pass it on.)
|
||
tlne f,%doblk ;Remember whether block ascii mode, it's
|
||
tlne f,%doimg ;special because server is in 7 bit (so we
|
||
trza f,f%blka ;can get exact eof) but user is really 36 bit.
|
||
tro f,f%blka
|
||
trz f,f%dir
|
||
move a,jbc+j.fnm ;Get the user-specified filename
|
||
move b,jbc+j.snm
|
||
move c,jbc+j.fn1
|
||
move d,jbc+j.fn2
|
||
move w,[440700,,trunam] ;Put it here temporarily
|
||
call usrfnm
|
||
call opnchk ;Check if have exactly two sixbit filenames
|
||
ifskp. ;Look out for special names
|
||
came b,[sixbit/(DIR)/]
|
||
camn b,[sixbit/(UDIR)/]
|
||
came a,[sixbit/..NEW./]
|
||
caia
|
||
jrst jcrdir
|
||
camn b,[sixbit/(DIR)/]
|
||
came a,[sixbit/.EXPUN/]
|
||
caia
|
||
jrst jexpun
|
||
camn b,[sixbit/(DIR)/]
|
||
came a,[sixbit/.FILE./]
|
||
caia
|
||
jrst jdir
|
||
endif.
|
||
|
||
jopnx: move a,opmode ;Get just the basic mode
|
||
andi a,%doblk\%doimg\%doout
|
||
trc a,%doout ;flip direction (he reads<=>we write, and v.v.)
|
||
tro a,30 ;unhang our iots if he pclsrs.
|
||
syscal open,[%climm,,chboj ? %clbtw,,a ? [sixbit/BOJ/]]
|
||
die
|
||
|
||
;Initialize some variables
|
||
movei a,35. ;Number of bits in each buffer word
|
||
tlne f,%doimg
|
||
movei a,36.
|
||
movem a,wdlen
|
||
subi a,32. ;Difference from packet word length
|
||
movem a,fudge
|
||
movei a,7 ;Byte size of connection to user.
|
||
tlnn f,%doblk
|
||
tlne f,%doimg
|
||
movei a,36.
|
||
movem a,bytsiz
|
||
movei b,bufl ;Size of buffer in those bytes
|
||
cain a,7
|
||
imuli b,5
|
||
movem b,bufsiz
|
||
call bufini ;Buffer and allocation pointers/counts
|
||
setzm raccp ;File position
|
||
trz f,f%eofi ;Haven't seen an eof yet
|
||
|
||
movei a,r.opno ;Send command to server
|
||
tlnn f,%doout
|
||
movei a,r.opni
|
||
txne f,f%dir
|
||
movei a,r.dirl
|
||
note "setcmd..."
|
||
call setcmd
|
||
movem a,rplseq ;Save sequence # for error checking
|
||
ifxe. f,f%dir
|
||
movei a,7. ;Open byte size (tell him 7 even if block ascii
|
||
tlne f,%doimg ;so we can do our local style of eof padding)
|
||
movei a,36.
|
||
nout a
|
||
call wdec
|
||
movei a,chnl
|
||
idpb a,w
|
||
note " "
|
||
movei a,[asciz "/NRF"] ;Next come the options
|
||
tlne f,%donrf
|
||
note "/NRF"
|
||
tlne f,%donrf
|
||
call wstr
|
||
movei a,[asciz "/NLK"]
|
||
tlne f,%donlk
|
||
note "/NLK"
|
||
tlne f,%donlk
|
||
call wstr
|
||
movei a,[asciz "/RWT"]
|
||
tlne f,%dorwt
|
||
note "/RWT"
|
||
tlne f,%dorwt
|
||
call wstr
|
||
movei a,[asciz "/WOV"]
|
||
tlne f,%dowov
|
||
note "/WOV"
|
||
tlne f,%dowov
|
||
call wstr
|
||
movei a,chnl
|
||
idpb a,w
|
||
endif.
|
||
note " "
|
||
move a,alccnt ;Next the initial allocation
|
||
call wdec
|
||
nout alccnt
|
||
movei a,chnl
|
||
idpb a,w
|
||
note " "
|
||
movei a,trunam ;And finally the filename
|
||
call wstr
|
||
nstr trunam
|
||
call sndcmd
|
||
|
||
note "A reply..."
|
||
call reply ;Get the reply
|
||
came b,rplseq
|
||
bug
|
||
setom rplseq
|
||
jumpn a,opnerr
|
||
note "OK"
|
||
call rsts ;Open reply is like status
|
||
.call jbrwin ;Tell the creator that the open succeeded.
|
||
call ipclsr
|
||
tro f,f%open ;He now has the file open
|
||
jrst goloop
|
||
|
||
opnerr: note "Bad#"
|
||
nout a
|
||
hrlzm a,errcod ;Here for failure reply to initial command
|
||
.call jbrerr ;Return the error
|
||
call ipclsr ;Different pclsr handling for initial commands
|
||
jrst reuse ;And we're all finished.
|
||
|
||
ipclsr: 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
|
||
jrst pclsr ;close and give up, and he will do whatever it is twice
|
||
|
||
bufini: movei a,buf
|
||
movem a,netptr
|
||
movei b,440700
|
||
tlne f,%doimg
|
||
hrli b,444400
|
||
tlnn f,%doblk
|
||
hrl a,b
|
||
movem a,bufptr
|
||
move a,bufsiz
|
||
movem a,bufptn
|
||
tlnn f,%doout
|
||
setz a,
|
||
movem a,bufcnt
|
||
movei a,buf+bufl-1
|
||
movem a,alcptr
|
||
movei a,bufl-1
|
||
imul a,wdlen
|
||
tlne f,%doout
|
||
setz a,
|
||
movem a,alccnt
|
||
ret
|
||
|
||
subttl Other first-call cases
|
||
|
||
;Handle OPEN of .FILE. (DIR) -- List a directory
|
||
jdir: note "DirLst..."
|
||
tlne f,%doout\%doimg\%donrf\%donlk\%dorwt
|
||
jrst wtderr
|
||
tro f,f%dir
|
||
move b,trufnb ;Get the filename frob from opnchk
|
||
add b,[4,,0] ;Flush filenames
|
||
move d,[440700,,temfn1]
|
||
call rfnl"pfn
|
||
move a,[temfn1,,trunam]
|
||
blt a,trunam+fnmstl-1
|
||
jrst jopnx ;Join open code
|
||
|
||
;Handle OPEN of .EXPUN (DIR) -- Expunge a directory.
|
||
jexpun: note "Expunge..."
|
||
jrst wtderr ;Not implemented yet
|
||
|
||
;Handle OPEN of .NEW.. (UDIR) -- Create a directory.
|
||
jcrdir: note "CrDir..."
|
||
jrst wtderr ;Not implemented yet
|
||
|
||
;Handle MLINK -- Create a link.
|
||
jmlink: note "MLink..."
|
||
jrst wtderr ;Not implemented yet
|
||
|
||
;Handle .FDELE -- Delete or rename a file
|
||
jfdele: move a,jbc+j.fnm ;Get the user-specified filename
|
||
move b,jbc+j.snm
|
||
move c,jbc+j.fn1
|
||
move d,jbc+j.fn2
|
||
move w,[440700,,trunam] ;Put it here temporarily
|
||
call usrfnm
|
||
skipn jbc+j.tfn1 ;Have a target?
|
||
ifskp.
|
||
note "Rename " ;Then it's a rename
|
||
movei a,r.renm
|
||
call setcmd
|
||
movem a,rplseq
|
||
movei a,trunam
|
||
nstr trunam
|
||
call wstr
|
||
movei a,chnl
|
||
idpb a,w
|
||
note " to "
|
||
move a,jbc+j.tfnm ;Get target filename
|
||
move b,jbc+j.snm
|
||
move c,jbc+j.tfn1
|
||
move d,jbc+j.tfn2
|
||
push p,w ;Read it into a buffer for logging
|
||
move w,[440700,,buf]
|
||
call usrtfn
|
||
pop p,w
|
||
movei a,buf
|
||
nstr buf
|
||
call wstr
|
||
else.
|
||
note "Delete "
|
||
movei a,r.dele
|
||
call setcmd
|
||
movem a,rplseq
|
||
movei a,trunam
|
||
nstr trunam
|
||
call wstr
|
||
endif.
|
||
call sndcmd
|
||
call reply ;Get the reply
|
||
came b,rplseq
|
||
bug
|
||
setom rplseq
|
||
jumpn a,opnerr
|
||
.call jbrwin
|
||
call ipclsr
|
||
jrst reuse
|
||
|
||
subttl Assorted non-initial non-i/o commands
|
||
|
||
;Note that the documentation claims only raccp word is used here... The system
|
||
;uses filenames from last jobsts.
|
||
jrch: note "RCHST..."
|
||
syscal jobret,[%climm,,chboj ? %climm,,0 ? [-5,,raccp-4]]
|
||
jrst bojint ;No need for "PCL" since we haven't altered anything.
|
||
jrst goloop
|
||
|
||
jfinish:note "Finish..." ;.CALL FINISH
|
||
;;Maybe should also wait for output access to be ack'd.
|
||
jforce: note "Force..."
|
||
call force ;.CALL FORCE
|
||
jrst jrwin
|
||
|
||
jfille: note "Fillen..."
|
||
skipge fillen ;.CALL FILLEN
|
||
jrst wtderr ;Not defined
|
||
move a,[-4,,fillen]
|
||
jrst jrval
|
||
|
||
;Foo, it looks like we're not expected to return anything to the creator.
|
||
;If file fails to get created properly, he'll never know. I wonder, does
|
||
;the .close return immediately or only when we issue the jobreu? If latter,
|
||
;maybe we should hold off on that so we can at least signal ioc errors...
|
||
jcls: note "Close..."
|
||
tlne f,%doout
|
||
call force ;Force out buffered output. Maybe should also wait
|
||
;for all access's to get ack'd?
|
||
movei a,r.cls ;Set up a close packet
|
||
call setcmd
|
||
movem a,rplseq
|
||
call sndcmd ;No args, just send it
|
||
tlne f,%doout
|
||
tro f,f%clss ;Stick around until we receive a reply or else server
|
||
jrst reuse ;might notice we're gone and abort
|
||
|
||
;Close continuation. We only get here if it turned out we weren't reused,
|
||
;since we don't do net interrupts while waiting for a reuse.
|
||
xcls: note "Close..."
|
||
die
|
||
|
||
jsacc: move a,jbc+j.arg2 ;Access pointer for symbolic call ACCESS
|
||
movem a,jbc+j.ptr
|
||
call jacc1 ;Common .call/uuo routine
|
||
jrwin: note "<retskp>"
|
||
.call jbrwin ;Just skip-return...
|
||
pcl
|
||
jrst goloop
|
||
|
||
jacc: call jacc1
|
||
jret: note "<ret>"
|
||
.call jbret ;Just return...
|
||
pcl
|
||
jrst goloop
|
||
|
||
jacc1: note "Access "
|
||
nout raccp ;"<"
|
||
note "=>"
|
||
nout jbc+j.ptr
|
||
note "..."
|
||
move b,jbc+j.ptr
|
||
camn b,raccp
|
||
ret
|
||
tlne f,%doout ;If doing input
|
||
ifskp. ;see if can do it locally
|
||
sub b,raccp
|
||
cail b,0
|
||
camle b,bufcnt
|
||
anskp. ;No such luck
|
||
note "(local)"
|
||
addm b,raccp ;Else update the file pointer
|
||
movn a,b ;And buffer count
|
||
addm a,bufcnt
|
||
tlnn f,%doblk ;Update buffer pointers
|
||
tlne f,%doimg
|
||
tdza c,c
|
||
idivi b,5
|
||
add b,bufptr
|
||
sojge c,[ibp b ? jrst .]
|
||
add a,bufptn
|
||
ifle. a ;Gone past end of buffer?
|
||
add a,bufsiz ;Yea, wrap
|
||
subi b,bufl
|
||
endif.
|
||
movem a,bufptn
|
||
movem b,bufptr ;B/updated bufptr for sndalc
|
||
callret sndalc ;Send allocation if need to and that's it!
|
||
endif.
|
||
|
||
tlne f,%doout ;Do it for real
|
||
call force ;If output, force it out now.
|
||
call bufini ;Flush old input
|
||
trz f,f%eofi ;No longer have an eof
|
||
movei a,r.acc
|
||
call setcmd
|
||
movem a,accseq
|
||
move a,jbc+j.ptr
|
||
movem a,raccp
|
||
trne f,f%blka ;In block ascii mode, server is in 7-bit
|
||
imuli a,5 ;bytes even though the user is in 36 bit.
|
||
call wdec
|
||
movei a,chnl
|
||
idpb a,w
|
||
move a,alccnt ;Include new allocation
|
||
call wdec
|
||
callret sndcmd ;send the command.
|
||
|
||
xacc: note "Access..."
|
||
skipge accseq
|
||
bug
|
||
camn b,accseq ;Is this the one we're waiting for?
|
||
setom accseq ;Yup, so no longer any outstanding
|
||
tlnn f,%doout
|
||
skipge accseq
|
||
skipn a
|
||
jrst goloop ;No error, or just an old input reply, ignore
|
||
note "Bad#"
|
||
nout a
|
||
;Here if error and either the latest input or ANY output reply
|
||
syscal jobioc,[%climm,,chboj ? %climm,,2] ;Make a reasonable error
|
||
.lose
|
||
;If this is input, could recover because no I/O can take place
|
||
;until all .ACCESS's ack'd, figure it out later. (Basically:
|
||
;give ioc errors on all iot's until he gives a working .access,
|
||
;remember to give ioc error now if iotcnt non-zero. Need to remember
|
||
;that that alloc didn't take either thou)
|
||
;For output, maybe should wait for reply before returning to user
|
||
;so we don't have to deal with outstanding access's. All sorts
|
||
;of synch problems with closing the file and such... Better yet,
|
||
;output iots should hang if there are outstanding access's too.
|
||
die
|
||
|
||
jsreap: note "SReapb "
|
||
movei a,r.srpb ;Set the do-not-reap bit
|
||
call setcmd
|
||
movem a,rplseq
|
||
move a,jbc+j.arg2
|
||
call wdec
|
||
nout a
|
||
call sndcmd
|
||
jrst goloop
|
||
|
||
xsreap: note "XSReapb "
|
||
jrst xret
|
||
|
||
jrnmwo: skipn jbc+j.tfn1
|
||
jrst jdelwo
|
||
note "Rnmwo..."
|
||
movei a,r.rnmwo
|
||
call setcmd
|
||
movem a,rplseq
|
||
move a,jbc+j.tfnm
|
||
setz b, ;No target sname!
|
||
move c,jbc+j.tfn1
|
||
move d,jbc+j.tfn2
|
||
call usrtfn
|
||
call sndcmd
|
||
jrst goloop
|
||
|
||
xrnmwo: note "Rnmwo..."
|
||
ife. a ;If no error, server DID change the names so...
|
||
push p,b ;read the new names even if user gave up.
|
||
call rfname
|
||
pop p,b
|
||
setz a,
|
||
endif.
|
||
jrst xret
|
||
|
||
jdelwo: note "Delwo..."
|
||
movei a,r.delwo
|
||
call setcmd
|
||
movem a,rplseq
|
||
call sndcmd
|
||
jrst goloop
|
||
|
||
xdelwo: note "Delwo..."
|
||
xret: came b,rplseq ;Were we still waiting for this?
|
||
jrst goloop ;No, tough
|
||
setom rplseq ;Else no longer wait for it
|
||
jumpn a,jrerr ;If error, tell him so
|
||
jrst jrwin ;Else report success.
|
||
|
||
jsrdat: note "SRDate..."
|
||
movei t,filref
|
||
movei a,r.srd
|
||
jrst jsdate
|
||
jsfdat: note "SFDate..."
|
||
movei t,fildat
|
||
movei a,r.sfd
|
||
jsdate: call setcmd
|
||
movem a,rplseq
|
||
move a,jbc+j.arg2
|
||
call datime"timnet
|
||
movem a,rplval' ;Remember the new date
|
||
setzm (t) ;No longer know the real date
|
||
call wdec
|
||
call sndcmd
|
||
jrst goloop
|
||
|
||
jsauth: note "SAuthor..."
|
||
movei a,r.saut
|
||
call setcmd
|
||
movem a,rplseq
|
||
move a,jbc+j.arg2
|
||
movem a,rplval ;Remember the new author
|
||
setzm filaut ;No longer know the real author
|
||
call wsix
|
||
call sndcmd
|
||
jrst goloop
|
||
|
||
xsrdat: note "SRDate..."
|
||
movei t,filref
|
||
jrst xsval
|
||
xsfdat: note "SFDate..."
|
||
movei t,fildat
|
||
jrst xsval
|
||
xsauth: note "SAuthor..."
|
||
movei t,filaut
|
||
xsval: came b,rplseq
|
||
jrst goloop
|
||
setom rplseq
|
||
jumpn a,jrerr
|
||
move a,rplval ;Server won, install the new value
|
||
movem a,(t)
|
||
jrst jrwin ;And tell the user
|
||
|
||
jrrdat: note "RRDate..."
|
||
hrroi a,filref ;.CALL RRDATE
|
||
jrst jrdata
|
||
jrfdat: note "RFDate..."
|
||
hrroi a,fildat ;.CALL RFDATE
|
||
jrst jrdata
|
||
jrauth: note "RAuthor..."
|
||
hrroi a,filaut ;.CALL RAUTH
|
||
jrdata: skipe (a) ;Have it locally?
|
||
jrst rdata ;Yes, just return it
|
||
movem a,rplval ;Else read status from server
|
||
movei a,r.rsts
|
||
call setcmd
|
||
movem a,rplseq
|
||
call sndcmd
|
||
jrst goloop
|
||
|
||
xrsts: note "RStatus..."
|
||
ife. a ;If successful reply
|
||
push p,b ;Might as well read it in
|
||
call rsts
|
||
pop p,b
|
||
setz a,
|
||
endif.
|
||
came b,rplseq ;Were we waiting for this?
|
||
jrst goloop ;No, he gave up
|
||
setom rplseq
|
||
jumpn a,jrerr
|
||
move a,rplval ;Do we have the value we want now?
|
||
skipn (a)
|
||
jrst wtderr ;No, must be unknowable
|
||
|
||
rdata: camn a,[-1,,filaut] ;Else return it.
|
||
jrst jrval ;Author is simple
|
||
move a,(a) ;Dates have to be converted first tho
|
||
subi a,datime"estdif*60.*60.
|
||
call datime"sectim
|
||
movei b,3600.
|
||
call datime"odayl
|
||
call datime"timadd
|
||
movem a,dskdat'
|
||
hrroi a,dskdat
|
||
jrval: movem a,retval' ;All args must stay around in case pclr'd
|
||
note "<retval>"
|
||
.call jbrval
|
||
pcl
|
||
jrst goloop
|
||
|
||
rsts: note "len "
|
||
call rwdec ;Length in open bytes
|
||
seto a, ;Not specified
|
||
nout fillen
|
||
ifxn. f,f%blka ;If block ascii, he is open in 7 but we're 36
|
||
andge. a
|
||
addi a,4
|
||
idiv a,5
|
||
endif.
|
||
movem a,fillen
|
||
note " bsz "
|
||
call rwdec ;Byte size of last open
|
||
setz a,
|
||
movem a,filbsz
|
||
nout filbsz
|
||
note " bln "
|
||
call rwdec ;Size in bytes of last open
|
||
setz a,
|
||
movem a,filbln
|
||
nout filbln
|
||
tlnn f,%doout
|
||
ifskp.
|
||
move a,bytsiz
|
||
movem a,filbsz
|
||
move a,fillen
|
||
movem a,filbln
|
||
endif.
|
||
note " cre "
|
||
call rwdec ;Creation date
|
||
setz a,
|
||
movem a,fildat
|
||
nout fildat
|
||
note " ref "
|
||
call rwdec ;Reference date
|
||
setz a,
|
||
movem a,filref
|
||
nout filref
|
||
note " aut "
|
||
call rwsix ;Author
|
||
movem a,filaut
|
||
nsix filaut
|
||
rfname: note " fnm "
|
||
movei a,trunam ;True name
|
||
call rwstr
|
||
nstr trunam
|
||
note "."
|
||
call unparse ;Unparse truename into RDEVN block
|
||
move a,[trunam,,sysnam]
|
||
blt a,sysnam+fnmstl-1
|
||
.call jobsts ;Give it to system for RCHST/RFNAME.
|
||
bug
|
||
ret
|
||
|
||
wtderr: note "WTDErr"
|
||
movei a,%ebddv ;Return "Wrong type device"
|
||
jrst jrerrX
|
||
jrerr: note "<Err#"
|
||
nout a
|
||
note ">"
|
||
jrerrX: hrlzm a,errcod'
|
||
.call jbrerr
|
||
pcl
|
||
jrst goloop
|
||
|
||
subttl IOT/SIOT
|
||
|
||
jiot: note "JIOT("
|
||
trnn f,f%open
|
||
bug
|
||
tlnn f,%doblk ;Figure out length of transfer
|
||
ifskp. ;Block mode
|
||
hlre a,jbc+j.ptr
|
||
movns a
|
||
else. ;Else unit mode
|
||
move a,jbcop
|
||
tlne a,%jgsio
|
||
skipa a,jbc+j.cnt
|
||
movei a,1
|
||
endif.
|
||
movem a,iotcnt ;Save new number of bytes not sent yet
|
||
nout iotcnt
|
||
note ")..."
|
||
tlnn f,%doout ;Dispatch on direction
|
||
jrst jioti
|
||
fallto jioto
|
||
|
||
;Maybe should hang if there are access's outstanding...
|
||
jioto: skipe d,iotcnt ;If nothing more to do
|
||
trne f,fi%nti ;or there are replies waiting
|
||
jrst goloop ;Bail out
|
||
skipe c,bufcnt ;Get # bytes available in our buffer.
|
||
ifskp. ;None, send a data packet to make room,
|
||
call snddat ;even if it means hanging
|
||
bug
|
||
jrst jioto ;Should work ok now, but check for FI%NTI again
|
||
endif.
|
||
call bojiot ;Do it. A gets new raccp
|
||
skipl fillen ;If file length known&settable
|
||
camg a,fillen ;and writing past end of file
|
||
ifskp.
|
||
movem a,fillen ;then update the file length
|
||
movem a,filbln
|
||
endif.
|
||
call jout ;Send off some data if we can
|
||
jrst jioto ;Try it again
|
||
|
||
;Come here for network output interrupt to move data from buffer to net.
|
||
ntoint: note "ANET Output interrupt..."
|
||
trne f,f%open
|
||
tlnn f,%doout
|
||
jrst goloop
|
||
move a,bufcnt ;Anything in buffer?
|
||
camge a,bufsiz
|
||
call jout ;Yea, output whatever we can to the network.
|
||
note "done"
|
||
jrst goloop
|
||
|
||
;Output data from BUF to the server, as much as we can without hanging.
|
||
;Clobbers A-E,T,TT,J
|
||
jout: syscal whyint,[%climm,,chneto ? %clout,,j ? %clout,,j ? %clout,,j]
|
||
.lose %lsfil
|
||
tlz j,-1 ;Number of packets we can send
|
||
jumpe j,cpopj ;No room for any data
|
||
call snddat ;Send some
|
||
ret ;No more, done
|
||
sojg j,.-2 ;Not finished yet, go again.
|
||
txo f,fi%nto ;Out of room, come back later to check again
|
||
ret
|
||
|
||
force: call snddat ;Send some
|
||
ret ;No more
|
||
jrst force
|
||
|
||
;Send a data packet to server. Clobbers A-E,T,TT.
|
||
;Skips if there was data to send.
|
||
snddat: move e,bufsiz ;Figure number of bytes used
|
||
sub e,bufcnt
|
||
jumpe e,cpopj ;None, finished
|
||
move c,bytsiz
|
||
trne f,f%blka ;Convert to (server) bit count
|
||
move c,wdlen
|
||
imul e,c
|
||
hlrz d,netptr ;D=bits already sent from first word
|
||
move a,d
|
||
idiv a,bytsiz
|
||
sub e,b ;E=# bits we can send
|
||
caile e,8*%cpmxc ;At most a packet's worth
|
||
movei e,8*%cpmxc ;E=# bits we're going to send
|
||
add b,e ;Update byte count
|
||
idivi b,(c)
|
||
addm b,bufcnt
|
||
hrrz c,netptr ;C=input address
|
||
move a,d ;Compute new bufptr
|
||
add a,e
|
||
idiv a,wdlen
|
||
hrlm b,netptr
|
||
hrrz b,netptr
|
||
add a,b
|
||
cail a,buf+bufl
|
||
subi a,bufl
|
||
hrrm a,netptr
|
||
movei a,7(e) ;Compute packet counts
|
||
idivi a,8
|
||
dpb a,[$cpknb+pktbuf] ;Number of bytes
|
||
trc b,%codat\7 ;Account for the padding bits
|
||
dpb b,[$cpkop+pktbuf]
|
||
addi a,3 ;Compute output words
|
||
idivi a,4
|
||
movns a
|
||
hrl b,a
|
||
hrri b,%cpkdt+pktbuf ;B=output aobjn pointer
|
||
move t,(c) ;Reprocess 1st word
|
||
aoj c,
|
||
tlne f,%doimg ;Right justify it for loop
|
||
ifskp. ;If ascii
|
||
lsh t,-1
|
||
aoj d, ;One more available bit
|
||
endif.
|
||
do.
|
||
cain c,bufend
|
||
movei c,buf
|
||
move tt,(c)
|
||
lshc t,(d)
|
||
movem t,(b)
|
||
aobjp b,endlp.
|
||
sub d,fudge ;WdLen-32
|
||
ifl. d
|
||
lshc t,40
|
||
movem t,(b)
|
||
aobjp b,endlp.
|
||
addi d,40
|
||
endif.
|
||
movn e,d
|
||
lshc t,40(e)
|
||
aoja c,top.
|
||
enddo.
|
||
.call pktout ;Send the packet
|
||
.lose
|
||
jrst cpopj1
|
||
|
||
jioti: skipg d,iotcnt
|
||
jrst goloop
|
||
note "AJiotI "
|
||
nout iotcnt
|
||
note "/"
|
||
nout bufcnt
|
||
note "..."
|
||
skipe c,bufcnt ;How many bytes do we have available
|
||
ifskp. ;None
|
||
trnn f,f%eofi ;Server sez end of file?
|
||
jrst goloop ;No, go wait for more
|
||
note "<Send Eof>"
|
||
move a,jbcop ;Else tell user about eof
|
||
tlnn a,%jgsio ;If SIOT
|
||
tlne f,%doblk ;Or block mode
|
||
jrst jret ;Just wake him up
|
||
tlnn f,%doimg ;Else unit mode IOT
|
||
jrst [.iot chboj,[-1,,^C] ;If ascii, indicate EOF
|
||
jrst goloop]
|
||
syscal jobioc,[%climm,,chboj ? %climm,,2] ;Else IOCERR for EOF
|
||
jrst bojint
|
||
jrst goloop
|
||
endif.
|
||
call bojiot ;Do it, B gets new bufptr
|
||
skipn iotcnt
|
||
ifskp.
|
||
nout iotcnt
|
||
note " left to send."
|
||
else.
|
||
note "All."
|
||
endif.
|
||
call sndalc ;Send allocation if appropriate
|
||
jrst jioti ;Go try again
|
||
|
||
;Send allocation if necessary. Call with B/bufptr
|
||
sndalc: tlnn f,%doblk ;Get address of first used word
|
||
ibp b
|
||
tlz b,-1
|
||
move a,b ;See how many words we could allocate
|
||
sub a,alcptr
|
||
sosge a ;Always leave one for image mode overflow
|
||
addi a,bufl
|
||
note "{alccnt:"
|
||
nout alccnt
|
||
note " Room:"
|
||
nout a
|
||
note "}"
|
||
caige a,bufl/2 ;At least half the buffer?
|
||
ret ;No, don't bother
|
||
note "ASending Allocation "
|
||
sos b ;Save new pointer
|
||
caige b,buf
|
||
addi b,bufl
|
||
movem b,alcptr
|
||
imul a,wdlen
|
||
nout a
|
||
addm a,alccnt ;and count
|
||
push p,a ;Now send the command
|
||
movei a,r.alc
|
||
call setcmd
|
||
pop p,a
|
||
call wdec
|
||
callret sndcmd
|
||
|
||
;XDAT - read data from net
|
||
;Enters with opcode in B.
|
||
xdat: note "Data..."
|
||
skipl accseq ;Waiting for access ack's?
|
||
jrst goloop ;Yea, keep waiting
|
||
trne f,f%eofi
|
||
bug
|
||
ldb a,[$cpknb+pktbuf]
|
||
jumpe a,goloop
|
||
imuli a,8 ;Number of bits in packet
|
||
trz b,%colst ;Subtract padding
|
||
sub a,b ;A=# data bits in packet
|
||
nout a
|
||
note "bits"
|
||
movn b,a ;Update alccnt
|
||
addm b,alccnt
|
||
note "(alccnt="
|
||
nout alccnt
|
||
note ")..."
|
||
skipge alccnt
|
||
bug
|
||
hlrz b,netptr ;Update byte count
|
||
idiv b,bytsiz
|
||
add c,a
|
||
move b,bytsiz
|
||
txne f,f%blka
|
||
move b,wdlen
|
||
idiv c,b
|
||
addm c,bufcnt
|
||
hlrz d,netptr ;D=bit count in last word
|
||
add a,d ;Update the bit count
|
||
idiv a,wdlen
|
||
hrlm b,netptr
|
||
hrrz b,netptr
|
||
movni a,1(a)
|
||
hrl b,a ;B= output aobjn pointer
|
||
movei c,%cpkdt+pktbuf ;C= input address
|
||
movei a,buf+bufl ;A= bufend, for easy wraparound checking
|
||
move t,(b) ;Re-do the last word
|
||
do.
|
||
lsh t,-36.(d)
|
||
sub d,fudge
|
||
ifl. d
|
||
move tt,(c)
|
||
aoj c,
|
||
lshc t,32.
|
||
addi d,32.
|
||
endif.
|
||
move tt,(c)
|
||
aoj c,
|
||
movni e,4(d)
|
||
rotc t,(e)
|
||
tlnn f,%doimg
|
||
lsh tt,1
|
||
cain a,(b)
|
||
hrri b,buf
|
||
movem tt,(b)
|
||
aobjn b,top.
|
||
enddo.
|
||
soj b,
|
||
hrrm b,netptr
|
||
ldb b,[$cpkop+pktbuf] ;Is this an eof packet?
|
||
caige b,%colst
|
||
jrst jioti ;No, just go see if user wants this data
|
||
tro f,f%eofi ;Hit end of file
|
||
note "<EOF>"
|
||
trnn f,f%blka ;If block ascii mode then might need to pad
|
||
jrst jioti ;beyond the ascii eof for the user
|
||
hlrz a,netptr
|
||
idivi a,7
|
||
jumpe a,jioti ;If didn't end on word boundary
|
||
move b,netptr ;Skip over complete bytes we've received
|
||
hrli b,440700
|
||
ibp b
|
||
sojg a,.-1
|
||
movei c,^C ;And fill the rest with ^C's
|
||
idpb c,b
|
||
tlne b,700000
|
||
jrst .-2
|
||
aos bufcnt ;Count this last word
|
||
jrst jioti
|
||
|
||
;;BOJIOT: perform an IOT/SIOT on the BOJ channel.
|
||
;;Called with C/# bytes available
|
||
;; D/# bytes requested
|
||
;;Updates bufptr/bufptn,bufcnt,iotcnt and raccp.
|
||
;; Returns with A/new raccp
|
||
;; B/new bufptr
|
||
bojiot: camle c,bufptn ;Only go to end of buffer, since IOT/SIOT will
|
||
move c,bufptn ;not wrap for us
|
||
camle c,d ;Don't take more than he has
|
||
move c,d ;C= # bytes we will read
|
||
sub d,c ;# bytes of user's IOT that will be left.
|
||
movem d,iotcnt
|
||
move b,bufptr
|
||
tlne f,%doblk
|
||
ifskp. ;Unit mode
|
||
move a,c
|
||
syscal siot,[%climm,,chboj ? b ? c]
|
||
.Lose
|
||
sub a,c ;A=# bytes we got, C=# bytes we didn't get
|
||
else. ;Else block mode
|
||
movn a,c ;Make AOBJN ptr to the words we can read.
|
||
hrl b,a
|
||
.iot chboj,b
|
||
hrrzs a,b
|
||
sub a,bufptr ;A=# words we got
|
||
sub c,a ;C=# words we didn't get
|
||
endif.
|
||
skipe c ;If didn't get everything, pclsr'd, so don't
|
||
setz d, ;try to get any more.
|
||
movn c,a ;Decrement counts
|
||
addm c,bufcnt ;This many fewer bytes available
|
||
addm c,bufptn ;And fewer til end of BUF
|
||
skipe bufptn ;Reached end of BUF?
|
||
ifskp.
|
||
subi b,bufl ;Yes, wrap
|
||
move c,bufsiz
|
||
movem c,bufptn
|
||
endif.
|
||
movem b,bufptr
|
||
addb a,raccp
|
||
ret
|
||
|
||
;Here from GOLOOP to process input from net.
|
||
ntint: note "ANet Input interrupt..."
|
||
syscal whyint,[%climm,,chneti ? %clout,,a ? %clout,,b ? %clout,,c]
|
||
.Lose %lssys
|
||
cain a,%wycha
|
||
caie b,%csopn
|
||
jrst [note "AConn state="
|
||
nout b
|
||
note " A="
|
||
nout a
|
||
jrst ntioc]
|
||
tlnn c,-1
|
||
jrst goloop ;No more input, done
|
||
txo f,fi%nti ;Else come back here when done
|
||
note "read..."
|
||
.call pktin
|
||
.lose %lsfil
|
||
ldb b,[$cpkop+pktbuf]
|
||
cail b,%codat
|
||
caile b,%codat+17
|
||
caia
|
||
jrst xdat
|
||
cain b,%coasy
|
||
jrst xioc
|
||
note "reply..."
|
||
call rreply
|
||
move c,b
|
||
andi c,377
|
||
cain c,r.cls
|
||
jrst xcls
|
||
cain c,r.acc
|
||
jrst xacc
|
||
cain c,r.rnmwo
|
||
jrst xrnmwo
|
||
cain c,r.delwo
|
||
jrst xdelwo
|
||
cain c,r.rsts
|
||
jrst xrsts
|
||
cain c,r.sfd
|
||
jrst xsfdat
|
||
cain c,r.srd
|
||
jrst xsrdat
|
||
cain c,r.saut
|
||
jrst xsauth
|
||
note "Unknown!"
|
||
bug
|
||
|
||
;Read a reply packet. B gets sequence#+opcode, A gets error
|
||
;code, V/W set up for reading data
|
||
reply: .call pktin
|
||
.lose
|
||
ldb b,[$cpkop+pktbuf]
|
||
rreply: caie b,%colos
|
||
cain b,%cocls
|
||
jrst [note "ALoss or Close pkt received"
|
||
jrst ntioc]
|
||
cain b,%coeof
|
||
jrst [note "AEOF pkt received"
|
||
jrst ntioc]
|
||
caie b,%corpl
|
||
bug
|
||
ldb v,[$cpknb+pktbuf]
|
||
subi v,4
|
||
skipge v
|
||
bug
|
||
ldb b,[143000,,%cpkdt+pktbuf]
|
||
move w,[041000,,%cpkdt+pktbuf]
|
||
ldb a,w
|
||
ret
|
||
|
||
;Server reports asynchronous lossage.
|
||
xioc: ldb a,[341000,,%cpkdt+pktbuf]
|
||
note "server IOC error #"
|
||
nout a
|
||
syscal jobioc,[%climm,,chboj ? a] ;report it to the creator.
|
||
jfcl
|
||
die
|
||
|
||
;Give the user an IOC error because the connection is closed.
|
||
;The server is most likely to use 3=non-recoverable data error for his
|
||
;errors, so we pick something else..
|
||
ntioc: note "ALocal net error!"
|
||
syscal jobioc,[%climm,,chboj ? %climm,,1] ;Illegal hardware operation
|
||
jfcl
|
||
die
|
||
|
||
subttl subroutines to read/write command packets
|
||
;Start creating a command packet in PKTBUF. A has opcode.
|
||
;On return, W is a BP to store the rest, A is the transaction code
|
||
setcmd: move w,[141000,,%cpkdt+pktbuf]
|
||
dpb a,w
|
||
aos a,seqnum
|
||
dpb a,[242000,,%cpkdt+pktbuf] ;Sequence
|
||
ldb a,[143000,,%cpkdt+pktbuf] ;Return whole seq+opcode id
|
||
ret
|
||
|
||
wsix: setz b,
|
||
rotc a,6
|
||
addi b,40
|
||
idpb b,w
|
||
jumpn a,wsix
|
||
ret
|
||
|
||
wdec: idivi a,10.
|
||
ifn. a
|
||
push p,b
|
||
call wdec
|
||
pop p,b
|
||
endif.
|
||
addi b,"0
|
||
idpb b,w
|
||
ret
|
||
|
||
wstr: hrli a,440700
|
||
do.
|
||
ildb b,a
|
||
jumpe b,cpopj
|
||
idpb b,w
|
||
loop.
|
||
enddo.
|
||
|
||
;Send the packet in PKTBUF, assuming that W contains a bp
|
||
;down which the text of the packet has been stuffed.
|
||
sndcmd: movei b,1-pktbuf-%cpkdt(w) ;Compute length of packet
|
||
imuli b,4
|
||
lsh w,-41
|
||
sub b,w
|
||
movei a,%comnd
|
||
dpb a,[$cpkop+pktbuf]
|
||
dpb b,[$cpknb+pktbuf]
|
||
.call pktout
|
||
.lose %lsfil
|
||
ret
|
||
|
||
rwdec: sojl v,cpopj
|
||
ildb b,w
|
||
cain b,chnl
|
||
ret
|
||
aos (p) ;Have a number, so skip return
|
||
setz a,
|
||
do.
|
||
cail b,"0
|
||
caile b,"9
|
||
bug
|
||
imuli a,10.
|
||
addi a,-"0(b)
|
||
sojl v,cpopj
|
||
ildb b,w
|
||
cain b,chnl
|
||
ret
|
||
loop.
|
||
enddo.
|
||
|
||
rwstr: hrli a,440700
|
||
do.
|
||
sojl v,endlp.
|
||
ildb b,w
|
||
cain b,chnl
|
||
exit.
|
||
idpb b,a
|
||
loop.
|
||
enddo.
|
||
setz b,
|
||
idpb b,a
|
||
ret
|
||
|
||
rwsix: setz a,
|
||
move b,[440600,,a]
|
||
do.
|
||
sojl v,cpopj
|
||
ildb c,w
|
||
cain c,chnl
|
||
ret
|
||
cail c,140
|
||
subi c,40
|
||
subi c,40
|
||
tlne b,770000
|
||
idpb c,b
|
||
loop.
|
||
enddo.
|
||
|
||
|
||
subttl filename parsing
|
||
|
||
fnblen==30. ;At most 30. components
|
||
|
||
.scalar temfn1(fnmstl),fnb1(2*fnblen) ;Initial user string
|
||
.scalar temfn2(3),fnb2(2*fnblen) ;Default dir
|
||
.scalar fnb(2*fnblen) ;Merged block
|
||
.scalar trufnb ;trunam pointer after opnchk
|
||
|
||
;;Check if trunam filename (not counting device/dir) can be expressed exactly
|
||
;;as 2 sixbit words, which are returned in a,b.
|
||
opnchk: move b,[-2*fnblen,,fnb]
|
||
move d,[440700,,trunam]
|
||
call rfnl"rfn
|
||
ret
|
||
movem b,trufnb
|
||
do. ;Skip to filenames proper
|
||
jumpge b,cpopj
|
||
ldb a,1(b)
|
||
caie a,":
|
||
cain a,";
|
||
caia
|
||
exit.
|
||
add b,[2,,2]
|
||
loop.
|
||
enddo.
|
||
hlrz a,b
|
||
caie a,-4 ;Must be exactly two filenames
|
||
ret
|
||
call namsix
|
||
ret
|
||
push p,a
|
||
add b,[2,,2]
|
||
call namsix
|
||
ret
|
||
move b,a
|
||
pop p,a
|
||
jrst cpopj1
|
||
|
||
;;Convert trunam to ITS format in RDEVN
|
||
unpars: move b,[-2*fnblen,,fnb]
|
||
move d,[440700,,trunam]
|
||
call rfnl"rfn
|
||
nop
|
||
setzm rdevn+1
|
||
setzm rdevn+2
|
||
setzm rdevn+3
|
||
do. ;Skip device
|
||
jumpge b,cpopj
|
||
ldb a,1(b)
|
||
caie a,":
|
||
exit.
|
||
add b,[2,,2]
|
||
loop.
|
||
enddo.
|
||
caie a,"; ;Process directory
|
||
ifskp.
|
||
call namsix
|
||
move a,[sixbit/.CANT./]
|
||
movem a,rdevn+3
|
||
do.
|
||
add b,[2,,2]
|
||
jumpge b,cpopj
|
||
ldb a,1(b) ;Is the next one also a directory?
|
||
caie a,";
|
||
exit.
|
||
move a,[sixbit/.CANT./] ;Yea, we lose
|
||
movem a,rdevn+3
|
||
loop.
|
||
enddo.
|
||
endif.
|
||
call namsix
|
||
nop
|
||
movem a,rdevn+1
|
||
add b,[2,,2]
|
||
jumpge b,cpopj
|
||
call namsix
|
||
nop
|
||
movem a,rdevn+2
|
||
note "("
|
||
nsix rdevn
|
||
note ":"
|
||
nsix rdevn+3
|
||
note ";"
|
||
nsix rdevn+1
|
||
note " "
|
||
nsix rdevn+2
|
||
note ")"
|
||
ret
|
||
|
||
;;Given name in (b)-1(b), return its sixbit rep in a.
|
||
;;Skips if rep is exact.
|
||
namsix: setz a,
|
||
hrrzs (p)
|
||
move e,[440600,,a]
|
||
move d,(b)
|
||
do.
|
||
ildb c,d
|
||
camn d,1(b)
|
||
exit.
|
||
tlnn e,770000
|
||
ret ;longer than 6 chars
|
||
caie c,^Q
|
||
ifskp.
|
||
camn d,1(b)
|
||
ret ;Could happen if had ^Q^@
|
||
ildb c,d
|
||
cail a,140 ;Quoted lower case can't be represented..
|
||
hrros (p)
|
||
endif.
|
||
caige c,40
|
||
hrros (p)
|
||
caige c,140
|
||
ifskp.
|
||
cail c,"a
|
||
caile c,"z
|
||
hrros (p) ;Non-letter "uppercase" chars can't go...
|
||
subi c,40
|
||
endif.
|
||
subi c,40
|
||
idpb c,e
|
||
loop.
|
||
enddo.
|
||
skipl (p)
|
||
cpopj1: aos (p)
|
||
cpopj: ret
|
||
|
||
;Get user filename into pointer in W. Called with A=pointer,B/C/D=snm/fn1/fn2
|
||
usrfnm: call getusr ;get it into temfn1/fnb1
|
||
push p,b ;Save block
|
||
move d,[440700,,temfn2] ;Make default name, just "SNAME;"
|
||
movem d,fnb2
|
||
.uset chboj,[.rsname,,a]
|
||
movei b,";
|
||
call sixnam
|
||
movem d,fnb2+1
|
||
pop p,a ;Get user's spec
|
||
move b,[-2,,fnb2] ;and the default
|
||
jrst usrmrg
|
||
|
||
;Get user name, defaulting sname from TRUNAM, for RENMWO... Really should
|
||
;default it from the specified name, in case there are links... Don't
|
||
;worry about it for now, there are no servers on hosts with links.
|
||
;When do fix it, remember to updated the 'specified' name when renmwo is done!
|
||
usrtfn: call getusr
|
||
push p,b
|
||
move b,[-2*fnblen,,fnb2]
|
||
move d,[440700,,trunam]
|
||
call rfnl"rfn
|
||
nop
|
||
do.
|
||
jumpge b,endlp.
|
||
ldb a,1(b)
|
||
caie a,":
|
||
cain a,";
|
||
caia
|
||
exit.
|
||
add b,[2,,2]
|
||
loop.
|
||
enddo.
|
||
movni c,-fnb2(b)
|
||
hrl b,c
|
||
hrri b,fnb2
|
||
pop p,a
|
||
usrmrg: move c,[-2*fnblen,,fnb] ;Merged block here
|
||
setz d, ;Normal defaulting
|
||
call rfnl"merge ;Merge
|
||
nop
|
||
move b,c ;B=fnm block
|
||
move d,w ;D=output bp
|
||
add b,[2,,2] ;Punt the first device (XX: or whatever)
|
||
skipl b ;Check next
|
||
tdza a,a
|
||
ldb a,1(b)
|
||
cain a,": ;Another device?
|
||
ifskp.
|
||
push p,b
|
||
move a,fdevn ;No, use the default one
|
||
movei b,":
|
||
call sixnam
|
||
pop p,b
|
||
movei a,.chspc ;Add a space if there is something else there
|
||
skipge b ;(just for compatibility with rnfl"pfn)
|
||
idpb a,d
|
||
endif.
|
||
call rfnl"pfn ;Append name
|
||
move w,d ;Update pointer
|
||
setz a,
|
||
idpb a,d
|
||
ret
|
||
|
||
getusr: ife. a ;If no user pointer
|
||
push p,d ;Just make a string from the sixbit names
|
||
push p,c
|
||
push p,b
|
||
move d,[440700,,temfn1]
|
||
move a,rdevn
|
||
movei b,":
|
||
call sixnam
|
||
pop p,a
|
||
movei b,";
|
||
call sixnam
|
||
pop p,a
|
||
movei b,.chspc
|
||
call sixnam
|
||
pop p,a
|
||
movei b,0
|
||
call sixnam
|
||
move d,[440700,,temfn1]
|
||
else.
|
||
.uset chboj,[.ruindex,,b] ;Fetch user string
|
||
syscal open,[%clbit,,.bai ? %climm,,chusr
|
||
[sixbit/usr/] ? %climm,,%jsnum(b) ? %climm,,0]
|
||
die
|
||
hrrz b,a
|
||
.access chusr,b
|
||
move b,[-fnmstl,,temfn1]
|
||
.iot chusr,b
|
||
.close chusr,
|
||
move d,a
|
||
hrri d,temfn1
|
||
;This is wrong in the aobjn pointer case, I had misunderstood.
|
||
;Fix it!
|
||
tlne d,77 ;Make sure it's a bp (not an aobjn pointer)
|
||
hrli d,440700 ;Aobjn pointer or something weird, force it
|
||
endif.
|
||
move b,[-2*fnblen,,fnb1]
|
||
call rfnl"rfn
|
||
nop
|
||
ret
|
||
|
||
sixnam: jumpe a,cpopj ;Output sixbit filename with quoting
|
||
push p,b
|
||
movei c,^Q
|
||
do.
|
||
setz b,
|
||
rotc a,6
|
||
addi b,40
|
||
caie b,":
|
||
cain b,";
|
||
idpb c,d
|
||
cain b,.chspc
|
||
idpb c,d
|
||
idpb b,d
|
||
jumpn a,top.
|
||
enddo.
|
||
pop p,b
|
||
idpb b,d
|
||
ret
|
||
|
||
$$rfn==1
|
||
$$pfn==1
|
||
$$merge==1
|
||
|
||
ifn dbgsw,junk1:constants
|
||
|
||
.insrt dsk:syseng;rfnl
|
||
|
||
rfnl"pfnspc:
|
||
rfnl"rfnspc:
|
||
popj p,
|
||
|
||
TSINT: 0
|
||
0
|
||
SKIPL U,TSINT
|
||
JRST TSFW
|
||
TRNN U,1_CHBOJ+1_CHNETI+1_CHNETO
|
||
.VALUE
|
||
TRZE U,1_CHBOJ
|
||
TRO F,FI%BOJ
|
||
TRZE U,1_CHNETI
|
||
TRO F,FI%NTI
|
||
TRZE U,1_CHNETO
|
||
TRO F,FI%NTO
|
||
CAME U,[SETZ]
|
||
.VALUE
|
||
SETOM INT
|
||
.DISMISS TSINT+1
|
||
|
||
TSFW: note "A*TSFW*A"
|
||
TRNN U,%PIIOC
|
||
.VALUE
|
||
.SUSET [.RBCHN,,U]
|
||
CAIE U,CHNETI
|
||
CAIN U,CHNETO
|
||
CAIA
|
||
.VALUE
|
||
TXNN F,F%OPEN
|
||
.DISMISS [NOGO] ;ERROR CONNECTING => DEV NOT AVAILABLE
|
||
.DISMISS [NTIOC] ;ERROR TRANSFERRING => IOC ERROR
|
||
|
||
JOBCAL: SETZ
|
||
SIXBIT /JOBCAL/
|
||
%CLIMM,,CHBOJ
|
||
%CLOUT,,JBCOP
|
||
SETZ [-JBCLEN,,JBC]
|
||
|
||
JOBSTS: SETZ
|
||
SIXBIT /JOBSTS/
|
||
%CLIMM,,CHBOJ
|
||
%CLIMM,,43 ;SNDSK
|
||
RDEVN
|
||
RDEVN+1
|
||
RDEVN+2
|
||
RDEVN+3
|
||
OPMODE
|
||
SETZ [440700,,SYSNAM]
|
||
|
||
JBRWIN: SETZ
|
||
SIXBIT /JOBRET/
|
||
%CLIMM,,CHBOJ
|
||
SETZI 1
|
||
|
||
JBRET: SETZ
|
||
SIXBIT /JOBRET/
|
||
%CLIMM,,CHBOJ
|
||
SETZI 0
|
||
|
||
JBRVAL: SETZ ;JOBRET a value
|
||
SIXBIT /JOBRET/
|
||
%CLIMM,,CHBOJ
|
||
%CLIMM,,1
|
||
SETZ RETVAL
|
||
|
||
JBRFNF: SETZ ;JOBRET error code 4 ("File not found").
|
||
SIXBIT /JOBRET/
|
||
%CLIMM,,CHBOJ
|
||
SETZ [%ENSFL,,0]
|
||
|
||
JBRERR: SETZ ;JOBRET AN ERROR CODE.
|
||
SIXBIT /JOBRET/
|
||
%CLIMM,,CHBOJ
|
||
SETZ ERRCOD
|
||
|
||
PKTOUT: SETZ
|
||
SIXBIT/PKTIOT/
|
||
%CLIMM,,CHNETO
|
||
SETZI PKTBUF
|
||
|
||
PKTIN: SETZ
|
||
SIXBIT/PKTIOT/
|
||
%CLIMM,,CHNETI
|
||
SETZI PKTBUF
|
||
|
||
|
||
;; Assorted subroutines
|
||
|
||
$$CHAOS==1
|
||
$$HSTMAP==1
|
||
$$HOSTNM==1
|
||
$$SYMLOOK==1
|
||
$$HST3==1 ;Hosts2 tables are no longer up to date.
|
||
$$CONNECT==1
|
||
.INSRT DSK:SYSENG;NETWRK >
|
||
|
||
;Lookup sixbit host in A
|
||
sixhst: camn a,[sixbit/SP/] ;Special dispensation
|
||
move a,[sixbit/SPEECH/]
|
||
move w,[440700,,buf]
|
||
call wsix
|
||
setz a,
|
||
idpb a,w
|
||
movei a,buf
|
||
callret netwrk"hstlook
|
||
|
||
DATIME"$$SVNG==1
|
||
DATIME"$$ABS==1
|
||
.INSRT DSK:SYSENG;DATIME >
|
||
|
||
ifn dbgsw,[
|
||
$note: exch t,(p)
|
||
ifxe. f,f%dbug
|
||
pop p,t
|
||
ret
|
||
endif.
|
||
push p,tt
|
||
;t/address of length+string, have push p,t ? push p,tt
|
||
move tt,(t)
|
||
movei t,1(t)
|
||
hrli t,440700
|
||
syscal siot,[%climm,,chtyo ? t ? tt]
|
||
.Lose %LsSys
|
||
$nret: pop p,tt
|
||
pop p,t
|
||
ret
|
||
|
||
$nsix: exch t,(p)
|
||
ifxe. f,f%dbug
|
||
pop p,t
|
||
ret
|
||
endif.
|
||
push p,tt
|
||
move t,@(t)
|
||
do.
|
||
setz tt,
|
||
rotc t,6
|
||
addi tt,40
|
||
.iot chtyo,tt
|
||
jumpn t,top.
|
||
enddo.
|
||
jrst $nret
|
||
|
||
$nstr: exch t,(p)
|
||
ifxe. f,f%dbug
|
||
pop p,t
|
||
ret
|
||
endif.
|
||
push p,tt
|
||
move t,(t)
|
||
hrli t,440700
|
||
do.
|
||
ildb tt,t
|
||
jumpe tt,$nret
|
||
.iot chtyo,tt
|
||
loop.
|
||
enddo.
|
||
|
||
$nout: exch t,(p)
|
||
ifxe. f,f%dbug
|
||
pop p,t
|
||
ret
|
||
endif.
|
||
push p,tt
|
||
move t,@(t)
|
||
ifl. t
|
||
.iot chtyo,["-]
|
||
movns t
|
||
endif.
|
||
call .nout
|
||
pop p,tt
|
||
pop p,t
|
||
ret
|
||
|
||
.nout: idivi t,10.
|
||
ifn. t
|
||
push p,tt
|
||
call .nout
|
||
pop p,tt
|
||
endif.
|
||
addi tt,"0
|
||
.iot chtyo,tt
|
||
ret
|
||
]
|
||
|
||
|
||
bugchk: ;Dump and send mail and stuff
|
||
die
|
||
bug==:call bugchk
|
||
|
||
CONSTANTS
|
||
VARIABLES
|
||
|
||
BUFL==10000-. ;TRY TO FIT IN 4K
|
||
IFL BUFL-2000,BUFL==2000+<BUFL&1777> ;OH, WELL
|
||
BUF: BLOCK BUFL-1
|
||
-1 ;Make sure enough core gets dumped.
|
||
BUFEND::
|
||
|
||
HSTPAG==:<.+1777>/2000 ;Host tables go here
|
||
|
||
DEFINE INFORM A,B
|
||
PRINTX/A=B
|
||
/TERMIN
|
||
IF2 INFORM Buffer size,\bufl
|
||
IF2 INFORM Pages used,\<<.+1777>/2000>
|
||
|
||
end begin
|