mirror of
https://github.com/PDP-10/its.git
synced 2026-02-15 04:16:21 +00:00
694 lines
14 KiB
Plaintext
694 lines
14 KiB
Plaintext
;;;-*-Midas-*-
|
||
|
||
TITLE Dissociated Press Device
|
||
|
||
a=1
|
||
b=2
|
||
c=3
|
||
d=4
|
||
e=5
|
||
f=6
|
||
|
||
t=10 ;T & TT saved by interrupts
|
||
tt=11
|
||
|
||
ct=16
|
||
p=17
|
||
|
||
call=pushj p,
|
||
return=popj p,
|
||
jcall==jrst
|
||
save=push p,
|
||
rest=pop p,
|
||
|
||
dsk==d
|
||
boj==b
|
||
tty==t
|
||
|
||
%fojb==1_17. ;We have a superior, so act as an OJB handler.
|
||
;;Next 4 are the open mode. Must be kept in order!
|
||
%fnrf==1_16. ;Don't set the reference date.
|
||
%fimg==1_15. ;Image, not ascii.
|
||
%fblk==1_14. ;Block, not unit.
|
||
%fout==1_13. ;Output, not input.
|
||
%fdir==1_12. ;Luser asked for a directory listing.
|
||
%fval==1_11. ;BOJ interrupts clear this "valid" bit.
|
||
%fiot==1_10. ;Luser last seen in an IOT.
|
||
%fsio==1_9 ;Luser last seen in a SIOT.
|
||
%fhak==1_8 ;For directory hack.
|
||
|
||
define syscall name,args
|
||
.call [setz ? sixbit "name" ? args(400000)]
|
||
termin
|
||
|
||
ifndef reprtp, reprtp==0
|
||
|
||
define report &msg&
|
||
ifn reprtp,[
|
||
call [ call $report
|
||
.length msg
|
||
ascii msg]]
|
||
termin
|
||
|
||
define error &msg&
|
||
call [ call $error
|
||
.length msg
|
||
ascii msg]
|
||
termin
|
||
|
||
pdllen==100.
|
||
.vector pdl(pdllen)
|
||
|
||
go: move p,[-pdllen,,pdl-1]
|
||
goinit: setzb ct,0 ;Clear position and flags.
|
||
move tt,[-4,,[ .roption,,a
|
||
.rsuppr,,b
|
||
.runame,,uname
|
||
.rxuname,,xuname
|
||
]]
|
||
.suset tt
|
||
tlo a,%opint\%opopc
|
||
jumpl b,goset
|
||
tlo a,%opojb
|
||
tro %fojb
|
||
syscall open,[[%tjdis\.uao,,tty] ? [sixbit "tty"]]
|
||
.lose %lssys
|
||
tlne a,%opddt
|
||
.value [asciz ""]
|
||
report "Greetings!"
|
||
goset: move tt,[-3,,[ .soption,,a
|
||
.s40addr,,[forty]
|
||
.smsk2,,[1_boj]
|
||
]]
|
||
.suset tt
|
||
jrst begin
|
||
|
||
.vector args(12.) ;Args returned by JOBCAL go here.
|
||
|
||
begin: syscall open,[[10\.bio,,boj] ? [sixbit "boj"]]
|
||
done ;he went away?
|
||
move tt,[-12.,,args]
|
||
syscall jobcal,[movei boj ? tt ? movem t]
|
||
done ;he went away?
|
||
tlne t,60000 ;close? (Huh?)
|
||
done
|
||
jrst @.+1(t)
|
||
open ;.open
|
||
opndie ;.iot
|
||
mlink ;mlink
|
||
opndie ;.reset
|
||
opndie ;.rchst
|
||
opndie ;.access
|
||
fdele ;.fdele (delete or rename)
|
||
opndie ;.fdele (renmwo)
|
||
opndie ;.call
|
||
|
||
mlink: report "Make link"
|
||
syscall mlink,[%clerr,,a ? [sixbit "dsk"]
|
||
args+1 ? args+2 ? args+3
|
||
args+0 ? args+5 ? args+6]
|
||
jrst opnerr
|
||
onesho: .call jbrt
|
||
done ;perhaps he gave up
|
||
done
|
||
|
||
fdele: skipe args+0
|
||
jrst rename
|
||
report "Delete"
|
||
syscall delete,[%clerr,,a ? [sixbit "dsk"]
|
||
args+1 ? args+2 ? args+3]
|
||
jrst opnerr
|
||
jrst oneshot
|
||
|
||
rename: report "Rename"
|
||
syscall rename,[%clerr,,a ? [sixbit "dsk"]
|
||
args+1 ? args+2 ? args+3
|
||
args+0 ? args+5]
|
||
jrst opnerr
|
||
jrst oneshot
|
||
|
||
opndie: error "Unexpected opcode from initial JOBCAL"
|
||
|
||
;;;Come here with error code in A.
|
||
opnerr: report "Open error"
|
||
hrlz a,a
|
||
syscall jobret,[movei boj ? a]
|
||
done ;perhaps he punted
|
||
done
|
||
|
||
.vector fname(4) ;filename
|
||
.scalar flen ;It's length in 7-bit bytes, corrected for
|
||
;^C lossage.
|
||
.scalar fccct ;Just how many ^C's were there?
|
||
.scalar fobyt ;Byte size file was written with.
|
||
.scalar folen ;Files length in those bytes.
|
||
|
||
open: move tt,args+5 ;get open mode
|
||
trne tt,777760 ;don't support other funny bits
|
||
jrst [movei a,%ensmd ? jrst opnerr]
|
||
dpb tt,[.bp %fnrf\%fblk\%fimg\%fout,0] ;set it in flags
|
||
move tt,args+4 ;save filename
|
||
movem tt,fname
|
||
move tt,[args+1,,fname+1]
|
||
blt tt,fname+3
|
||
move a,fname+1
|
||
move b,fname+2
|
||
camn a,[sixbit ".file."] ;Check for magic names.
|
||
came b,[sixbit "(dir)"]
|
||
skipa
|
||
tro %fdir
|
||
camn a,[sixbit "m.f.d."]
|
||
came b,[sixbit "(file)"]
|
||
skipa
|
||
tro %fdir
|
||
trne %fdir ;We don't support image mode directories
|
||
trnn %fimg\%fout ; or output to directories.
|
||
skipa
|
||
jrst [movei a,%ensmd ? jrst opnerr]
|
||
trnn %fout
|
||
jrst iopen ;open for input
|
||
oopen: movei a,%ensio ;open for output
|
||
jrst opnerr ;We don't do output yet.
|
||
|
||
iopen: move tt,[.uai,,dsk]
|
||
tlne %fnrf ;Respect reference date if so requested.
|
||
tlo tt,%donrf
|
||
syscall open,[%clerr,,a ? tt ? [sixbit "dsk"]
|
||
fname+1 ? fname+2 ? fname+3]
|
||
jrst opnerr
|
||
syscall rfname,[%clerr,,ercode ? movei dsk ? movem tt
|
||
movem fname+1 ? movem fname+2 ? movem fname+3]
|
||
call lssys ;I don't know about this...
|
||
trne %fdir ;Can't take length of a directory.
|
||
jrst noflln
|
||
syscall fillen,[%clerr,,ercode ? movei dsk ? movem flen
|
||
movem tt ? movem fobyt ? movem folen]
|
||
call lssys
|
||
setzm fccct
|
||
move t,fobyt
|
||
cain t,7 ;If it was written in 7-bit bytes, length
|
||
jrst noflln ; must be OK.
|
||
move t,flen
|
||
jumpe t,noflln ;Can't argue with a 0 length file.
|
||
move t,flen
|
||
subi t,4 ;check out last 4 characters.
|
||
.access dsk,t
|
||
repeat 4,[
|
||
.iot dsk,t
|
||
cain t,3
|
||
aosa fccct
|
||
setzm fccct]
|
||
movn t,fccct
|
||
addm t,flen
|
||
noflln: ldb tt,[.bp %fimg\%fblk\%fout,0]
|
||
lsh tt,6
|
||
addi tt,22
|
||
syscall jobsts,[%clerr,,ercode ? movei boj ? tt
|
||
fname ? fname+1 ? fname+2 ? fname+3]
|
||
call lssys
|
||
syscall rfname,[movei boj ? movem tt ? movem juname ? movem jjname]
|
||
jfcl ;it was only for debugging.
|
||
trnn %fimg\%fblk
|
||
jrst [ ;;If user is using .UAI mode, then we MUST revert to .UAO
|
||
;;because otherwise there is no place to remember which
|
||
;;character in a word he has read!
|
||
syscall open,[[10\.uao,,boj] ? [sixbit "boj"]]
|
||
done ;he gave up?
|
||
jrst .+1]
|
||
.call jbrt
|
||
done ;He gave up?
|
||
call outinit ;Gotcha! Can't punt as easily now...
|
||
trnn %fdir
|
||
jrst dp
|
||
dirlp: .iot dsk,a ;What a pain directories are!
|
||
jumpl a,outeof
|
||
cail a,"A
|
||
caile a,"Z
|
||
jrst [cail a,"a
|
||
caile a,"z
|
||
trz %fhak
|
||
jrst dirupc]
|
||
troe %fhak
|
||
addi a,"a-"A
|
||
dirupc: call out
|
||
jrst dirlp
|
||
|
||
.scalar corlen ;Length adjusted to fit in our address space.
|
||
|
||
dp: skipn t,flen ;Zero length files are a pain.
|
||
jrst outeof
|
||
movem t,corlen
|
||
subi t,1
|
||
idivi t,5*2000
|
||
addi t,1
|
||
caig t,400-fpage ;Grabbing infinite core?
|
||
jrst dpnurk ;Nope.
|
||
move t,[<1000000-fbase>*5] ;That's fucking big!
|
||
movem t,corlen
|
||
movei t,400-fpage
|
||
dpnurk: imul t,[-1,,0]
|
||
hrri t,fpage
|
||
.access dsk,[0]
|
||
syscall corblk,[%clerr,,ercode ? movei %cbndr
|
||
movei %jself ? t
|
||
movei dsk]
|
||
call lssys
|
||
move c,flen
|
||
call rndinit ;Initialize random number generator.
|
||
call rndpos
|
||
dplp: movei tt,20.
|
||
call rndnum ;Between 5 and 24. characters in a run.
|
||
addi tt,5
|
||
move t,c ;Where will that put us?
|
||
sub t,tt
|
||
jumple t,dpdone ;Beyond the end? then finish up.
|
||
sub c,tt ;New count.
|
||
hrrei d,-3(tt) ;Keep count in d. Zap all but three.
|
||
charlp: jsp t,inwrap
|
||
call out
|
||
sojg d,charlp
|
||
jsp t,inwrap
|
||
move d,a
|
||
call out
|
||
jsp t,inwrap
|
||
move e,a
|
||
call out
|
||
jsp t,inwrap
|
||
move f,a
|
||
call out
|
||
call rndpos
|
||
srchlp: ildb a,inbp
|
||
came a,d
|
||
sojg b,srchlp
|
||
came a,d
|
||
jrst [jsp t,wrap ? jrst srchlp]
|
||
sosg b
|
||
jsp t,wrap
|
||
save b
|
||
save inbp
|
||
jsp t,inwrap
|
||
came a,e
|
||
jrst nope
|
||
jsp t,inwrap
|
||
came a,f
|
||
jrst nope
|
||
rest (p)
|
||
rest (p)
|
||
jrst dplp
|
||
|
||
nope: rest inbp
|
||
rest b
|
||
jrst srchlp
|
||
|
||
dpdone: jumpe c,outeof
|
||
jsp t,inwrap
|
||
call out
|
||
soja c,dpdone
|
||
|
||
.scalar inbp
|
||
|
||
rndpos: move tt,corlen
|
||
call rndnum
|
||
move b,corlen
|
||
sub b,tt
|
||
move t,tt
|
||
idivi t,5
|
||
move tt,(tt)[440700,,fbase ? 350700,,fbase ? 260700,,fbase
|
||
170700,,fbase ? 100700,,fbase]
|
||
add tt,t
|
||
movem tt,inbp
|
||
return
|
||
|
||
inwrap: ildb a,inbp
|
||
sojg b,(t)
|
||
wrap: move tt,[440700,,fbase]
|
||
movem tt,inbp
|
||
move b,corlen
|
||
jrst (t)
|
||
|
||
rndnum: save tt
|
||
call random
|
||
tlz t,400000
|
||
rest tt
|
||
idiv t,tt
|
||
return
|
||
|
||
buflen=100.
|
||
.vector outbuf(buflen)
|
||
.scalar outbp,outct
|
||
|
||
;;;Call here to output character in A.
|
||
out: idpb a,outbp
|
||
sosle outct
|
||
return
|
||
call stuf
|
||
;;;Call here to initialize output.
|
||
outini: move tt,[440700,,outbuf]
|
||
movem tt,outbp
|
||
movei tt,buflen*5
|
||
movem tt,outct
|
||
return
|
||
|
||
;;;Jump hear at EOF.
|
||
outeof: movei a,buflen*5
|
||
sub a,outct
|
||
jrst eof
|
||
|
||
;;;Call this routine whenever the output buffer is full.
|
||
stuf: save a
|
||
trnn %fimg\%fblk
|
||
jrst stuf7
|
||
report "Stuffing..."
|
||
move a,[-buflen,,outbuf]
|
||
add ct,[400000,,buflen] ;Sign bit means that A contains a
|
||
;correction to the position.
|
||
.iot boj,a
|
||
tlz ct,400000
|
||
rest a
|
||
return
|
||
|
||
stuf7: report "Stuffing in 7 bit mode..."
|
||
movei a,buflen*5
|
||
add ct,[400000,,buflen*5] ;Sign bit means that A contains a
|
||
;correction to the position.
|
||
move tt,[440700,,outbuf]
|
||
syscall siot,[%clerr,,ercode ? movei boj ? tt ? a]
|
||
call lssys
|
||
tlz ct,400000
|
||
rest a
|
||
return
|
||
|
||
;;;Jump here at end of file. A should contain the number of characters
|
||
;;;left over in the output buffer.
|
||
eof: trnn %fimg\%fblk
|
||
jrst eof7
|
||
report "EOF"
|
||
idivi a,5
|
||
move tt,[ascii ""]
|
||
dpb tt,(b)[4400,,outbuf(a) ? 3500,,outbuf(a) ? 2600,,outbuf(a)
|
||
1700,,outbuf(a) ? 1000,,outbuf(a)]
|
||
skipe b
|
||
aos a
|
||
move b,a
|
||
hlri b,400000
|
||
imul a,[-1,,0]
|
||
hrri a,outbuf
|
||
add ct,b
|
||
.iot boj,a
|
||
tlz ct,400000
|
||
jrst eoflp
|
||
|
||
eof7: report "EOF7"
|
||
move b,a
|
||
hrli b,400000
|
||
add ct,b
|
||
move tt,[440700,,outbuf]
|
||
syscall siot,[%clerr,,ercode ? movei boj ? tt ? a]
|
||
call lssys
|
||
tlz ct,400000
|
||
eoflp: trne %fval ;Do we understand the situation?
|
||
.hang ;Yep, twiddle thumbs.
|
||
tro %fval ;Set valid flag.
|
||
trnn %fiot\%fsio ;Luser last seen in IOT or SIOT?
|
||
jrst eoflp ;Nope. That was fast!
|
||
move a,iot.ct
|
||
tlzn a,400000
|
||
jrst gotct
|
||
hlre b,iot.a
|
||
trnn %fimg\%fblk
|
||
movn b,iot.a
|
||
add a,b
|
||
gotct: subm ct,a ;We have given him C(A) words since then.
|
||
hlre b,args+0
|
||
trnn %fblk
|
||
movn b,args+0
|
||
add a,b
|
||
jumpe a,eoflp ;Which is just what he wanted!
|
||
trnn %fsio ;SIOT and block mode just return.
|
||
trne %fblk
|
||
jrst wakeup
|
||
trne %fimg ;.UII gets %piioc if you IOT beyond eof
|
||
jrst ioceof
|
||
trnn %fval ;Last chance to back out loser!
|
||
jrst eoflp
|
||
;;Suppose he pclsrs and does a SIOT? He gets a ^C.
|
||
.iot boj,[-1,,3]
|
||
jrst eoflp
|
||
|
||
ioceof: trnn %fval ;Last chance to back out loser!
|
||
jrst eoflp
|
||
;;Suppose he pclsrs and does a SIOT? He gets an error anyway.
|
||
syscall jobioc,[%clerr,,ercode ? movei boj ? movei 2]
|
||
call lssys ;suppose he goes away?
|
||
jrst eoflp
|
||
|
||
wakeup: .call jbrt
|
||
jrst eoflp
|
||
jrst eoflp
|
||
|
||
rndlen==71. ;Canonical random number generator.
|
||
rndoff==35.
|
||
.vector rnd(rndlen)
|
||
.scalar rnd1,rnd2
|
||
|
||
;;;Returns a random number in T. This algorithm is a known winner.
|
||
random: sosge t,rnd1
|
||
jrst [movei t,rndlen-1 ? movem t,rnd1 ? jrst .+1]
|
||
sosge tt,rnd2
|
||
jrst [movei tt,rndlen-1 ? movem tt,rnd2 ? jrst .+1]
|
||
move t,rnd(t)
|
||
addb t,rnd(tt)
|
||
return
|
||
|
||
;;;Call here to initialize random number generator.
|
||
rndini: save a
|
||
movei a,rndoff-1
|
||
movem a,rnd2
|
||
movei a,rndlen-1
|
||
movem a,rnd1
|
||
move tt,[171622221402]
|
||
rndilp: move t,tt ;This initialization algorithm is stolen
|
||
muli t,3125. ; from MacLisp. There is no reason to
|
||
div t,[377777777741] ; believe that IT is particularly good.
|
||
tlcn a,400000
|
||
jrst [hrlm tt,rnd(a) ? jrst rndilp]
|
||
hrrm tt,rnd(a)
|
||
sojge a,rndilp
|
||
rest a
|
||
return
|
||
|
||
intacs==t_6+2 ;T and TT saved
|
||
|
||
tsint: intacs,,p
|
||
0 ? 1_boj ? 0 ? 1_boj ? bojint
|
||
tsintl==.-tsint
|
||
|
||
bojint: move tt,[-12.,,args]
|
||
syscall jobcal,[movei boj ? tt ? movem t]
|
||
jrst disint
|
||
tlne t,60000 ;time to close up shop!
|
||
done
|
||
trz %fiot\%fsio\%fval
|
||
jrst @.+1(t)
|
||
caldie ;.open
|
||
iot ;.iot
|
||
caldie ;mlink
|
||
reset ;.reset
|
||
rchst ;.rchst
|
||
cantdo ;.access
|
||
caldie ;.fdele (delete or rename)
|
||
cantdo ;.fdele (renmwo)
|
||
docall ;.call
|
||
|
||
.scalar iot.a,iot.ct ;save position at last IOT
|
||
|
||
iot: report "IOT"
|
||
tlnn t,%jgsio ;Is this IOT or SIOT?
|
||
troa %fiot
|
||
tro %fsio
|
||
movem a,iot.a ;record position
|
||
movem ct,iot.ct
|
||
disint: syscall dismis,[%clerr,,ercode ? %clbit,,intacs ? p]
|
||
call lssys
|
||
|
||
reset: report "RESET"
|
||
.call jbrt
|
||
jrst disint
|
||
jrst disint
|
||
|
||
docall: move t,args+0
|
||
camn t,[sixbit "fillen"]
|
||
jrst fillen
|
||
camn t,[sixbit "rfdate"]
|
||
jrst rfdate
|
||
camn t,[sixbit "lnkedp"]
|
||
jrst lnkedp
|
||
report ".CALL" ;stump
|
||
move tt,args+0
|
||
trne %fojb
|
||
call 6type
|
||
cantdo: movei tt,%ebddv
|
||
report "Wrong type device"
|
||
calerr: hrlz tt,tt
|
||
syscal jobret,[movei boj ? tt]
|
||
jrst disint
|
||
jrst disint
|
||
|
||
caldie: error "Unexpected opcode from JOBCAL on open channel"
|
||
|
||
.vector vals(12.) ;JOBRET values typically found here
|
||
|
||
jbrt: setz ;Common JOBRET call.
|
||
sixbit "jobret" ;Skips, returns no values.
|
||
movei boj
|
||
setzi 1
|
||
|
||
jbrtv: setz ;Another common JOBRET call.
|
||
sixbit "jobret" ;Skips, aobjn pointer to values in TT.
|
||
movei boj
|
||
movei 1
|
||
setz tt
|
||
|
||
rchst: report "RCHST"
|
||
move tt,[fname,,vals]
|
||
blt tt,vals+3
|
||
hrrei tt,-1
|
||
movem tt,vals+4
|
||
move tt,[-5,,vals]
|
||
.call jbrtv
|
||
jrst disint
|
||
jrst disint
|
||
|
||
rfdate: report "RFDATE"
|
||
trne %fdir ;Guess what doesn't have a reference date...
|
||
jrst cantdo
|
||
syscall rfdate,[%clerr,,ercode ? movei dsk ? movem vals+0]
|
||
call lssys
|
||
calrt1: move tt,[-1,,vals]
|
||
.call jbrtv
|
||
jrst disint
|
||
jrst disint
|
||
|
||
lnkedp: report "LNKEDP"
|
||
setzm vals+0 ;We are never a link.
|
||
jrst calrt1
|
||
|
||
fillen: report "FILLEN"
|
||
trne %fdir ;Directories don't have a length...
|
||
jrst cantdo
|
||
move t,flen
|
||
trnn %fimg\%fblk
|
||
jrst filen7
|
||
idivi t,5
|
||
skipe tt
|
||
aos t
|
||
skipa tt,[36.]
|
||
filen7: movei tt,7
|
||
movem t,vals+0
|
||
movem tt,vals+1
|
||
move t,fobyt
|
||
movem t,vals+2
|
||
move t,folen
|
||
movem t,vals+3
|
||
move tt,[-4,,vals]
|
||
.call jbrtv
|
||
jrst disint
|
||
jrst disint
|
||
|
||
$repor: trne %fojb
|
||
jrst repor1
|
||
rest (p)
|
||
return
|
||
|
||
repor1: exch t,(p)
|
||
call msg
|
||
rest t
|
||
return
|
||
|
||
.scalar ercode,losepc
|
||
|
||
lssys: exch t,(p)
|
||
subi t,2
|
||
movem t,losepc
|
||
movei t,%lssys
|
||
addm t,ercode
|
||
rest t
|
||
trnn %fojb
|
||
call crash
|
||
syscall lose,[ercode ? losepc]
|
||
.lose %lssys
|
||
|
||
$error: trnn %fojb
|
||
call crash
|
||
exch t,(p)
|
||
call msg
|
||
rest t
|
||
rest losepc
|
||
sos losepc
|
||
syscall lose,[movei 0 ? losepc]
|
||
.lose %lssys
|
||
|
||
msg: save tt
|
||
move tt,(t)
|
||
movei t,1(t)
|
||
hrli t,440700
|
||
.iot tty,[^p]
|
||
.iot tty,["A]
|
||
syscall siot,[movei tty ? t ? tt]
|
||
.lose %lssys
|
||
.iot tty,[^p]
|
||
.iot tty,["A]
|
||
rest tt
|
||
return
|
||
|
||
6type: jumpe tt,[.iot tty,["*] ? return]
|
||
save t
|
||
6typel: setzi t,
|
||
lshc t,6
|
||
addi t,40
|
||
.iot tty,t
|
||
jumpn tt,6typel
|
||
rest t
|
||
return
|
||
|
||
$done: report "Done."
|
||
.logout ;Only die if toplevel
|
||
.close dsk,
|
||
jfcl
|
||
.hang
|
||
|
||
done==call $done
|
||
|
||
.scalar crashx,uname,xuname,jjname,juname
|
||
|
||
;;;AAAIIIIEEEEE!!!!!!
|
||
crash: save 0 ;PDUMP misses the flags...
|
||
syscall open,[[.uio,,dsk] ? [sixbit "dsk"]
|
||
[sixbit "dpdev"] ? uname ? [sixbit "crash"]]
|
||
.logout 1, ;Well foo!
|
||
setz crashx
|
||
syscall pdump,[movei %jself ? movei dsk ? crashx]
|
||
.logout 1, ;???
|
||
.iot dsk,[jrst crashr]
|
||
.iot dsk,[jrst crashr]
|
||
.logout 1,
|
||
|
||
crashr: rest 0
|
||
syscall open,[[%tjdis\.uao,,tty] ? [sixbit "tty"]]
|
||
.lose %lssys
|
||
return
|
||
|
||
cnstnts:
|
||
constants
|
||
|
||
variables
|
||
|
||
forty: 0
|
||
0
|
||
-tsintl,,tsint
|
||
|
||
fpage==:<<.-1>_-12>+1
|
||
fbase=:fpage_12
|
||
|
||
end go
|