github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-02-23 07:42:10 +00:00
Code Issues Releases Wiki Activity
Files
1a68cec32841aa31915a6b6a9ec9cb0f9bb16589
PDP-10.its/src/rwk/empty.361
Lars Brinkhoff 1998766f04 SCRAM - encrypt/decrypt file.
2018-02-28 21:13:04 +01:00

1237 lines
27 KiB
Plaintext
Raw Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
;-*- midas -*-
subttl basic RWK UUO's
.qmtch==1
a=1 ;temporary
b=2 ;temporary
c=3 ;temporary
d=4
e=5
f=6
chr=10 ;character being read
ea=11 ;effective address of UUO's
opc=12 ;op code of UUO's
ac=13
u1=14 ;uuo temporary 1
u2=15 ;uuo temporary 2
u3=16 ;uuo temporary 3
sp=17 ;stack pointer
ifndef ttyp,ttyp==-1 ;assume we want the TTY opened
ifndef tyic,tyic==1 ;tty input channel
ifndef tyoc,tyoc==2 ;tty output channel
ifndef dski,dski==3 ;dsk output channel
ifndef dsko,dsko==4 ;dsk output channel
ifndef clic,clic==5 ;CLI output channel
ifndef usrc,usrc==7 ;user input and utility channel
ifndef uout,uout==10 ;usr output and fucked channel
ifndef ufdie,ufdie=0 ;needed early, so put it here
ifndef ufsiot,ufsiot=0 ;needed early, so put it here
opcode=.bp <777_33 0,0> ;opcode field
accum=.bp <0 17,0> ;accumulator field
index=.bp <0 0,(17)> ;index register
cnt==4000 ;control
cnti==5000 ;control immediate
errret==3000 ;error return
argi==1000 ;immediate argument
val==2000 ;value return
ifndef pdleng,[pdleng==50] ;length of PDL
ifndef patchl,[patchl==100] ;length of patch area
ifndef uuoloc,[uuoloc=100]
ifndef infuuo,[infuuo==0]
ifndef infuuo,infuuo==0
ifndef tyintp,tyintp==0
ifndef piclip,piclip==0
ifndef pirltp,pirltp==0
intp==infuuo\tyintp\piclip\pirltp
ifndef fgetp,fgetp==0 ;routine to read file names
;; here are the vars. for use with the load-check feature (ldchkp)
ifndef ldchkp,ldchkp==0 ;non-zero if we want load-check feature
ifn ldchkp,[
ifndef mvsldu,mvsldu==150. ;minimum fair share is 40%
ifndef mvsusr,mvsusr==18. ;maximum no. of users is 15.
ifndef usr$$$,usr$$$==20 ;charge per user
ifndef lod$$$,lod$$$==1
ifndef mvlmax,mvlmax==350. ;max points overall
]
;; interdependencies go here -- this must be LAST in the conditionals set-up
ifn infuuo,[ufdie==-1
ufsiot==-1
intp==-1
]
ifndef loss,loss=<.lose 1400>
;;The following two macros were swiped from the DRAGON. I retain comments...
;I HAVE IBM DISEASE
;FOLLOWING MACRO SAVES LOAC THROUGH HIGHAC INCLUSIVE ON PDL
;P MAY BE AMONG THOSE SAVED, BUT MUST BE NEITHER LOWAC NOR HIGHAC
;CLOBBERS LOWAC
DEFINE SAVE LOWAC,HIGHAC
PUSH sp,<LOWAC>
MOVSI <LOWAC>,<LOWAC>+1
HRRI <LOWAC>,1(sp)
ADD sp,[<HIGHAC>-<LOWAC>,,<HIGHAC>-<LOWAC>]
SKIPL sp
loss
BLT <LOWAC>,(sp)
TERMIN
;UNDO A SAVE (THIS IS WHY HIGHAC SHOULD NOT BE P)
DEFINE RESTOR LOWAC,HIGHAC
MOVSI <HIGHAC>,-<<HIGHAC>-<LOWAC>>(sp)
HRRI <HIGHAC>,<LOWAC>
BLT <HIGHAC>,<HIGHAC>
SUB sp,[<HIGHAC>-<LOWAC>+1,,<HIGHAC>-<LOWAC>+1]
TERMIN
define terpri chan=tyoc ;terpri on channel
tyo chan,[^M]
tyo chan,[^J]
termin
define text *string*
!.length |string|,,[asciz |string|]!termin
define ascnt *string*
![text /string/]!termin
define type *string*
sioto tyoc,<ascnt /string/>
termin
define death *string*
die <ascnt /string/>
termin
define print chan=tyoc,*string*
sioto chan,<ascnt /string/>
termin
define tabdef name
define name cruft
cruft
termin
define a!name more
name [define name cruft
cruft
more]
termin
termin
termin
define do stuff,else,\label
define ddoo exit
jrst [stuff
jrst label]
!else!
label::
termin
ddoo <jrst label>
termin
define do.lab cruft
cruft!!termin
define do.bod cruft
cruft!!termin
define adotab label,stuf
do.lab [define do.lab cruft
cruft]label!!termin
do.bod [define do.bod cruft
cruft]stuf!!termin
termin
define dotab
define foo fo1,fo2
irp x,,#[fo1],y,,#[fo2]
x: y
termin
termin
foo do.lab,do.bod
termin
define seval a,b ;get value of symbol B in A
move a,[squoze 0,/b/]
.eval a,
loss
termin
define eval a,b
seval a,b
hrl a,a ;move to left
hrri a,a ;destination is a
.getloc a, ;get it into a
termin ;done!
DEFINE SYSCAL A,B,C=<rwkuuo"calerr>
.CALL [SETZ ? SIXBIT/A/ ? B ? setz+<errret,,0>+c] TERMIN
call=pushj sp,
define ret
popj sp,
termin
define loop ix=0,beg,end,stuf,\label1,label2
define lloop exit
move ix,[beg-end,,beg]
label1::
stuf
aobjn ix,label1
label2::
termin
lloop [jrst label2]
termin
define prtval *prtstr,valstr
vlpr [<ascnt /prtstr/>,,[asciz /valstr/]]
termin
.begin rwkuuo ;My very own system calls!
tabdef utab
uuonum==1
define uuodef name,op,oper
ifndef uf!name,[uf!name==0]
ifn uf!name,{define uuodex [op1=[pushj sp,]]
autab [.m"name=<.-uuotab>_33
op1 u!name]
termin}
.also [ oper
uuodex op]
termin
loc 40
UUO: 0 ;traping UUO goes here.
JSR UUOH ;go handle UUO's
ifn intp, -intlng,,tsint ;abjon ptr to interrupt table
loc uuoloc
.m"intspc=100*100+5
ifn intp,[
tsint: .m"intspc,,sp
ifn tyintp,[0 ? 1_tyic ? 0 ? 0 ? ttyint]
ifn infuuo,[%piioc ? 0 ? 0 ? 0 ? ignore
0 ? -1,,0 ? 0 ? 0 ? rwkuuo"infuuo"dhandl]
ifn piclip,[%picli ? 0 ? 0 ? 0 ? cliget]
ifn pirltp,[%pirlt ? 0 ? %pirlt ? -1 ? realt] ;don't allow recursive
;real-time interrupts...if we get them we must
;be screwed
intlng==.-tsint
ignore:
ifn ufsioto,[ type /AGot an unknown IOC interrupt. Continuing
/]
disbye: syscal dismis,[cnti,,.m"intspc ;just go back to what you were doing
sp]
loss
.m"dismis=jrst disbye
]
uuoh: 0 ;saved PC
push sp,uuo ;and our UUO
push sp,uuoh ;save the PC
save ea,u3 ;save our AC's
ldb opc,[opcode uuo] ;get the opcode
cail opc,utabl ;is it legal?
ifn ufdie, die [text /BAD USER UUO/] ;nope
ife ufdie, .lose
ldb ac,[accum uuo] ;yep
hrrz ea,uuo ;get the effective address
xct uuotab(opc) ;and dispatch on it
restor ea,u3 ;restore our AC's
pop sp,uuoh ;restore UUOH
pop sp,uuo ;and restore our UUO -- We're done with this
;one. (hence if we die in a UUO the UUO is the
;last UUO done. Otherwise it is 0 (maybe might
;make it always last UUO, never reset to 0?
jrst @uuoh ;return
uuodef huh,jrst,[
uhuh: type /AType ? for list of commands.
/
move sp,[-pdleng,,pdl]
jrst @qitadr
QITADR: rwkend
]
uuodef usioti,,[
usioti: hrli u1,440700 ;ascii string pointer
hrr u1,(ea) ;get address of string
hlrz u2,(ea) ;get length of string
syscal siot,[ac ;ac has output channel
u1
u2]
loss ;lost.
popj sp, ;return
]
uuodef tyo,[
utyo: movei u2,1 ;preset length to 1
hrli u3,070700 ;ascii string pointer to last 7 bits
hrr u3,ea ;get the effective address
syscal siot,[ac ? u3 ? u2] ;do it
loss ;nope, lost somehow
ret
]
uuodef sioto,,[
usioto: hrli u1,440700 ;ascii string pointer
hrr u1,(ea) ;get address of string
hlrz u2,(ea) ;get length of string
movem u2,siotl ;move it to memory so it can be cleared
syscal siot,[ac ;ac has channel
u1
siotl]
loss ;lost.
popj sp, ;return
siotl: 0
]
uuodef tyi,,[
utyi: syscal iot,[ac ;ac has channel
(ea)] ;to loc pointed to by EA
loss ;lost
popj sp, ;return
]
uuodef vlpr,,[
prloc: 0
vlloc: 0
uvlpr: hlrz u1,(ea) ;get ptr to string to print
hrrz u2,(ea) ;and ptr to string to value
movem u1,prloc ;and save them
movem u2,vlloc
sioto tyoc,@prloc ;print it
.value @vlloc ; and value it
popj sp, ;and return if we ever get back
]
uuodef die,jrst,[
udie: caie ea,0 ;if typing
sioto tyoc,(ea) ; type it
skipe debug ;are we debuggin?
.value ;yes, just return
.logout 1,
loss ;how the hell did this happen?
]
uuodef jload,,[
ujload: hrlz u1,ea ;from <ea>
hrri u1,bload ;to BLOAD
blt u1,eload ;until ELOAD
syscal open,[cnti,,.uii ;open load file
argi,,dski ;on DSKI channel
dev
fn1
fn2
dir]
loss ;lost
syscal load,[argi,,%jself ;load self
argi,,dski ;from dsk
[0,,-1] ;all
]
loss
loss ;if we get here something lost!
BLOAD:
dev: 0
fn1: 0
fn2: 0
eload:
dir: 0
]
;; convert 6-bit to ascii. Input in AC, output by excecuting EA.
;; typical EA's are IDPB AC,[440700,,<loc>] and TYO TYOC,AC
uuodef 6toa,,[
U6toa: movei u3,6 ;for six bits
move u2,[440600,,(ac)] ;byte pointer into AC
u6toa1: ildb u1,u2 ;get the first byte
addi u1,40 ;make it ascii
push sp,(ac) ;save ac he gave us so we can use it as scource
movem u1,(ac) ;use it
xct ,(ea) ;and excecute his output instruction
pop sp,(ac) ;and get his AC back
sojn u3,u6toa1 ;and loop till done
ret ;and we're all done
]
uuodef rd6,,[
urd6:
uread6: movei u3,6 ;at most 6 of them
move u2,[440600,,(ac)] ;moved 6 bits at a time into our accumulator
setzm (ac) ;clear our given AC
;** NOTE ** U3, EA, AND AC ARE ILLEGAL AS AC FIELDS for this UUO
read6a: push sp,(ac) ;what we have so far
xct (ea) ;do it
move u1,(ac) ;get it into a know ac
pop sp,(ac) ;and get back our current val
cain u1,^Q ;if it's ^Q
jrst [xct (ea) ;get a new char
jrst read6b] ;and sneak it passed other tests
cain u1,^M ;if carraige return
jrst read6t ;we're all done
cain u1,^C ;same for ^C
jrst read6t
cain u1,"," ;same for ,
jrst read6t
cain u1,40 ;same for space
jrst read6t
skipn file6p ;are we reading for a file?
jrst read6b ; nope, go to it
cain u1,";" ; if it's a semi
jrst read6t
cain u1,":" ;or a :
jrst read6t ;we're all done
read6b: caige u1,140 ;if it's small
subi u1,40 ;convert it so numbers work out right
caile u3, ;if we're beyond, don't write it out
idpb u1,u2 ;and write it to our dest
skipe file6p ;if we're looking at file-names, find end char
do [sos u3 ;count em anyway
jrst read6a] ; don't give up
sojn u3,read6a ;and loop until done
setom t.char ;note that we ended from too many chars
ret ;and we're all done!
read6t: movem u1,t.char ;save our final char for posterity
ret ;and we're all done
file6p: 0 ;non-zero if we want : and ; to terminate 6bit
t.char:0 ;this gets the terminating character or -1 if
;it terminates because of going over 6 chars
]
;;; <ea> has an instruction to get the next character.
;;; the specified AC gets the result. the ea must put the char in the same
;;; ac as is being used for the result
;;; AC, EA, U2 may not be clobbered by the instruction
uuodef rda,,[
uread1: setzm (ac) ;clear our given ac
movei u2,12 ;get a 10
red10a: push sp,(ac) ;push what we have so far
xct (ea) ;and get next char
move u1,(ac) ;get it into a know ac
pop sp,(ac) ;restore our AC
caige u1,60 ;is it too small?
ret ; yes, we're at end, return
caile u1,71 ;is it too big?
ret ; yes, we're at end, return
imulm u2,(ac) ;and multiply the AC by it
subi u1,60 ;make it a number
addm u1,(ac) ;and add in our number
jrst red10a ;go get more
]
;; convert decimal to ascii. Input in AC, output by excecuting EA.
;; typical EA's are IDPB AC,[440700,,<loc>] and TYO TYOC,AC
uuodef deca,,[
udeca: move u1,(ac) ;get number in U1
decpnt: idivi u1,10. ;figure first digit
push sp,u2 ;push remainder
skipe u1 ;done?
pushj sp,decpnt ;no compute next one
decpn1: pop sp,u1 ;yes, take out in opposite order
addi u1,60 ;make ascii
push sp,(ac) ;save his AC so we can use it as output source
movem u1,(ac) ;use it
xct (ea) ;and execute his output instruction
pop sp,(ac) ;and give it back
popj sp, ;and return for the next one.
]
;;; Convert number to ascii rep of octal
;;; Take number in ac, ea has output instruction
uuodef 8toa,,[
u8toa: move u1,(ac) ;get number in U1
octpnt: idivi u1,10 ;figure first digit
push sp,u2 ;push remainder
skipe u1 ;done?
pushj sp,octpnt ;no compute next one
octpn1: pop sp,u1 ;yes, take out in opposite order
addi u1,60 ;make ascii
push sp,(ac) ;save his AC so we can use it as output source
movem u1,(ac) ;use it
xct ,(ea) ;and execute his output instruction
pop sp,(ac) ;and give it back
popj sp, ;and return for the next one.
]
uuodef rnd,,[
urnd: push sp,a ;generate a random number
push sp,b
push sp,c
eval a,jtmu ;get system resource word
add a,ooff ;add in an offset
add a,mtoop ;and our
and a,[377777,,-1] ;make positive
idiv a,mlen ;mod size of pointer fields?
hrlz b,b ;and put in left half
hrri b,b ;and get result in b
.getloc b, ;get that
add b,onum
and b,[377777,,-1] ;make positive
movem a,ooff ;save old one
eval a,nnsked ;number of times null job schedualed
;this should vary more when load light, to make
;up for others varying less
add b,a ;and include this in our randomness
idivi b,(ea) ;mod number of entries
movem b,onum ;save old one
movem c,rndloc ;return our value. Save it in RNDLOC for debug
pop sp,c
pop sp,b
pop sp,a
move u1,rndloc
movem u1,(ac) ;and return in right accumulator
ret
rndloc: 0
]
uuodef fget,,[
.m"dev: 'DSK '
.m"DIR: 'USERS '
.m"FN1: -1
.m"FN2: -1
ufget:
push sp,a
push sp,b
push sp,rwkuuo"file6p ;save for posterity
setom rwkuuo"file6p ;read it in file format
floop: XCT (EA) ;Get a name
;; typically EA is a [rd6 a,[tyi tyic,a]]
move b,rwkuuo"t.char6 ;get termination character
cain b,72 ; colon?
do [movem a,.m"dev ;note the device
jrst floop] ;and get more
cain b,40 ;is it a space?
do [movem a,.m"fn1 ;save it out
jrst floop] ;and go for more
cain b,73 ;is it a semicolon?
do [movem a,.m"dir ; save it
jrst floop] ;and go for more
jumpe a,fgot ;have we got it?
movem a,.m"fn2 ;save it out
fgot: pop sp,rwkuuo"file6p ;and restore our state
pop sp,b
pop sp,a
ret
]
.m"debug: 0 ;is in main block so user can reference
tyo1c: 1 ;will be reset to one on every tyo
calerr: 0 ;error return code
patch: block patchl ;patching area
pdl: [.status tyoc,a
ifn ufsiot,[skipn a,
type /PDL underflow/]
loss]
block pdleng ;PDL area
onum: 0
ooff: 0
mtoop: 0
mlen: 0
ifn infuuo,[
;;inferior hacking stuff
.begin infuuo
c1.cnt: %pival+%pic.z+%pibrk+%pidcl
c1.ded: %pi1pr+%pib42+%pipar
class2: %pitrp+%pifet+%pitty+%pidis+%piilo+%piioc+%pioob+%pimpv+%pimar
c1.2: %pi1pr+%pibrk+%pib42+%pipar+%pival+%pic.z+%pitrp+%pifet+%pitty+%pidis+%piilo+%piioc+%Pioob+%pimpv+%pimar+%pidcl
TTYFLG: 0 ;nonzero if we have given away our TTY
dhandl:.dtty ;get back the TTY
skip
syscal usrvar,[argi,,usrc ;get his interrupts
['PIRQC ']
val,,a]
loss
syscal usrvar,[argi,,usrc ;get mask for type 2 interrupts
['MASK ']
val,,b]
loss
and b,class2 ;b<-class two which are enabled
tdz a,b ;remove them from our interrupt word
and a,c1.2 ;remove class 3 interrupts
move b,a ;get a copy
tdz a,c1.cnt ;remove ones we'll handle
jumpn a,infuuo"fatal ;go handle fatal variety
trne b,%pibrk ;is the a .BREAK
jrst infuuo"break ;go handle
trne b,%pival ;is this a .VALUE?
jrst infuuo"value ;go handle
tdne b,[%pic.z+%pidcl] ;control-Z ?
skipa
jrst [type /ABug in Inferior Interrupt HandlerA/
loss]
syscal usrvar,[argi,,usrc ;reset his PIRQC
['APIRQC']
b]
loss
goback: syscal dismis,[cnti,,.m"intspc
sp
argi,,retloc]
loss
retloc: type /AReturned from InferiorA/
setzm ttyflg ;remember we have it back for good
ret
define usrmem usrc,dest,a,b
syscal corblk,[cnti,,%cbwrt ;may as well get write if we can
argi,,0 ;no XORing in my program!
argi,,%jself
argi,,377 ;mega moby page
argi,,usrc ;from usrc channel job
a] ;at location a
loss
move dest,(b)<377*2000> ;and get it
termin
define uread usrc,loc
.access usrc,loc
syscal iot,[argi,,usrc
loc]
loss
termin
define uwrite usrc,loc,dat
.access usrc,loc
syscal iot,[argi,,usrc
dat]
loss
termin
define addrup ind,rh,index,\foo,foo1
jumpe index,foo1 ;if non-zero index
uread usrc,index ;get value of index
add rh,index ;and add it in
foo1:: jumpn ind,[uread usrc,rh ;if we're indirecting
jrst foo] ;do the indirection
foo::
termin
define pagmak a
andi a,-1 ;clear left half
lshc a,-12 ;split off page number from rest
lsh <a+1>,12-44 ;and make remainder
termin
break: syscal usrvar,[argi,,usrc ;turn off the interrupt
['APIRQC']
[%pibrk]]
loss
syscal usrvar,[argi,,usrc ;get location of break
['UPC ']
val,,a]
loss
subi a,1 ;back up to the .BREAK
move e,a ;move to where we have two adjacent ac's
pagmak e ;a <- page#, f <- loc in page
usrmem usrc,a,e,f ;a <- contents of memory
ldb b,[accum a] ;b <- accumulator
ldb c,[index a] ;c <- index
hlr d,a ;clear d, getting left half of a
andi d,(@) ;and with indirect bit
andi a,-1 ;a <- address field
cain b,12 ;is it a .BREAK 12, ?
jrst brk12 ;yes
caie b,16 ;is it garbage?
jrst unbrk ;go handle unknown break
type /AInferior finishedA/
.uclose usrc, ;it must have been asking to die since we
;told it we wern't a DDT
jrst infdon
define .M"JCL *lcj*
move a,[text /lcj/]
movem a,rwkuuo"infuuo"jclptr
termin
jclptr: 0
brk12: addrup d,a,c ;ind,addr,ix
move e,a ;move to where we have room
move c,a ;and hold in C for error messages
pagmak e ;e <- page #, f <- loc in page
usrmem usrc,a,e,f ;get from his memory the location pointed to
jumpl a,[hlrz a,a ;if writing
caie a,400005 ; if clearing JCL
jrst [setzm jclptr ;clear it and
jrst infdon] ;be done
type /ABarf: Inferior trying to write!
/ ;complain
jrst infdon] ;and be done
hlrz b,a ;get operation
hrrz d,a ;and address
trne d,200000 ;is it block mode?
jrst [type /Barf: Inferior trying to use block mode .BREAK 12,
.BREAK 12,/
jrst addprt] ;go print out err message
cail b,brktbl ;is it out-of-range?
jrst unbrk1
xct brktb(b)
addprt: 8toa c,[tyo tyoc,c] ;type address
sioto tyoc,[text "/ "] ;"open" location with form
8toa b,[tyo tyoc,b] ;and type contents
type /,,/ ;in halfword mode
8toa d,[tyo tyoc,d] ;so we can read it easier
terpri tyoc ;CRLF
jrst infdon ;and give up
unbrk1: type /Barf: Inferior trying to use a .BREAK 12, I can't handle.
.BREAK 12,/
jrst addprt
brktb: jrst unbrk1
jrst unbrk1
jrst unbrk1
jrst symptr
jrst unbrk1
jrst getjcl
brktbl==.-brktb
symptr: caig d,17 ;is it an AC?
jrst [uwrite uout,d,[0] ;yep, do it the dangerous way
jrst infcnt]
move e,d ;get more space to work in and save d for error
pagmak e ;compute page in a and word in f
syscal corblk,[cnti,,%cbndw ;need write access
argi,,0
argi,,%jself
argi,,377
e]
jrst jclovf ;go gripe
add f,<377_22> ;make absolute in our space
setzm (f) ;and set the appropriate word to 0
jrst infcnt ;and continue
getjcl: move e,d ;get more space and save d for error
pagmak e
syscal corblk,[cnti,,%cbndw ;need write access
argi,,0 ;no XORing, please
argi,,%jself ;map into ourself
argi,,376 ;at the highest possible location
argi,,usrc ;our inferior's
e] ;page which is contained in A
jrst jclovf
aos e ;get next page too
hlrz a,jclptr ;get length pointer of JCL
addi a,4
idivi a,5 ;(ptr+4)/5==length in words
add a,f ;the final loc
cail a,2000 ;overflow?
jrst [syscal corblk,[cnti,,%cbndw ;need writing
argi,,0 ;barf, no XOR, please
argi,,%jself
argi,,377 ;very moby
argi,,usrc ;our very inferior inferior
e] ;and the next page
jrst jclovf ;complain of indigestion
jrst jcljcl] ;go write JCL
;a -- absolute ending address
;b -- operation
;c -- effective address of .BREAK
;d -- right half of contents of ea of .break
;e -- page number in inferior of JCL buffer
;f -- loc in that page
jcljcl: addi a,<376_12> ;make end addr. point into our page map
addi f,<376_12> ;make the dest. address point into our map
hrr e,f ;and put in right half for blt
hrl e,jclptr ;get our source for the BLT from the JCLPTR
blt e,-1(a) ;and perform the transfer
skipe ttyflg ;if it had the tty
jrst infcnt
jrst infdon ;else just dismiss
infcnt: setom ttyflg ;remember where the TTY went
.atty usrc, ;give it to him
jrst [.dtty ;get it back
.atty usrc, ;and try again
loss ;nope, we're screwed somehow
jrst infcn1] ;good, one with the show
call start
infcn1: syscal dismis,[cnti,,.m"intspc
sp]
loss
jclovf: type /AInferior tried to read into pure or non-existant memory
.BREAK 12,/
jrst addprt ;tell him about loss
unbrk: type /Inferior gave an unknown .BREAK
.BREAK /
addrtp: 8toa b,[tyo tyoc,b] ;type out the address stuff
tyo tyoc,[","] ;type out the comma
caie d,0 ;indirect?
tyo tyoc,["@"] ;type it
caie a,0 ;rh nonzero?
8toa a,[tyo tyoc,a]
jumpn c,[tyo tyoc,["("] ;type the (
8toa c,[tyo tyoc,c] ;type the index
tyo tyoc,[")"]
jrst ubrk1]
ubrk1: type / >>> /
addrup d,a,c ;compute effective address
8toa a,[tyo tyoc,a] ;and print it
terpri tyoc
jrst infdon
value: syscal usrvar,[argi,,usrc ;turn off the interrupt
['APIRQC']
[%PIVAL]]
loss
type /AInferior .VALUE'd....I don't understand that so I'm continuingA/
jrst infdon
fatal: type /Ainferior got a fatal interruptA/
.uclose usrc,
jrst infdon
infdon: setzm ttyflg ;remember we have it back for good
syscal dismis,[cnti,,.m"intspc
sp]
loss
start: syscal usrvar,[argi,,usrc ;copy his old state
['OPTION']
val,,a]
loss
tlz a,optcmd+optbrk ;clear the OPTCMD bit (+ the OPTBRK since LISP
;demands it!)
skipe jclptr ;if there is JCL
tlo a,optcmd+optbrk ;set it again
syscal usrvar,[argi,,usrc ;and set it up
['OPTION']
a] ;write it back again
loss
syscal usrvar,[argi,,usrc ;GO!
['USTP ']
argi,,0]
loss
ret
.m"TTYGO:
call start
setom ttyflg ;remember we gave it away
.atty usrc, ;give up the TTY and wait for return
skipe ttyflg ;what?
.hang ;until return of TTY
.dtty ;make SURE that we have the TTY
ret
ret
.M"nttygo:
syscal usrvar,[argi,,usrc
['USTP ']
argi,,0]
loss
ret
myunam: 0
ifndef .m"usrc,.m"usrc==7
istrt: 0
define .m"infcr chan,name,fn1,fn2,sname,f.loss=loss,page=-1,handle=.m"rwkuuo"infuuo"dhandl
push sp,a ;save a for local use
.status usrc,a ;look at the channel
caie a,0 ;if there is nothing open
.uclose usrc, ;kill it
syscal open,[cnti,,0 ;create a job
argi,,usrc
['USR ']
rwkuuo"infuuo"myunam
[sixbit /name/]]
loss
syscal open,[cnti,,.uio ;and an output channel to it (ugh!)
argi,,uout
['USR ']
rwkuuo"infuuo"myuname
[sixbit /name/]]
loss
syscal open,[cnti,,.uii ;open a file to load into it
argi,,dski
[sixbit /DSK /]
[sixbit /FN1/]
[sixbit /FN2/]
[sixbit /SNAME/]]
f.loss
syscal load,[argi,,usrc ;load it
argi,,dski]
loss
syscal iot,[argi,,dski ;get starting address
argi,,a] ;in a
loss
andi a,-1 ;ignore the JRST part
syscal close,[argi,,dski] ;close it
loss
movem a,rwkuuo"infuuo"istrt ;and save the ADDR in ISTRT
syscal usrvar,[argi,,usrc ;make it start there
['UPC ']
a] ;a has address
loss
syscal usrvar,[argi,,usrc ;get what bit to enable
['INTB ']
val,,a]
loss
syscal usrvar,[argi,,%jself ;and enable it
['IMSK2 ']
a]
loss
pop sp,a
termin
.m"infkil:
push sp,a ;get A free
.status usrc,a ;is there an inferior?
jumpe a,[type /AThere is no inferior open.A/
pop sp,a ;restore A
ret] ;and give up.
pop sp,a ;restoer a
setzm ttyflg ;remember we have it back for good
.uclose usrc, ;kill it
type /AInferior KilledA/ ;say it
ret ;return
.end infuuo
]
uuotab: loss
utab
utabl==.-uuotab
consta ;dump out constants table
popj.1: aos (sp) ;increment return address
popj sp, ;and return
.m"popj1=jrst popj.1 ;and define our symbol
ifn fgetp,[
.m"dev: 'DSK '
.m"DIR: 'USERS '
.m"FN1: -1
.m"FN2: -1
.m"fget:
push sp,a
push sp,b
push sp,rwkuuo"file6p ;save for posterity
setom rwkuuo"file6p ;read it in file format
floop: rd6 a,[tyi tyic,a] ;read in the name
move b,rwkuuo"t.char6 ;get termination character
cain b,72 ; colon?
do [movem a,.m"dev ;note the device
jrst floop] ;and get more
cain b,40 ;is it a space?
do [movem a,.m"fn1 ;save it out
jrst floop] ;and go for more
cain b,73 ;is it a semicolon?
do [movem a,.m"dir ; save it
jrst floop] ;and go for more
jumpe a,fgot ;have we got it?
movem a,.m"fn2 ;save it out
fgot: pop sp,rwkuuo"file6p ;and restore our state
pop sp,b
pop sp,a
ret
]
ifn ldchkp,[
.m"%sllog==1 ;bit to indicate not-logged-in
.m"%sldil==2 ;bit to indicate coming in from a dialup line
.m"%sload==4 ;bit to indicate over-stepping a load boundary
.m"%slcls==10 ;bit to indicate closed
.m"%sldet==20 ;we've been detached
.m"loadch: ;a routine to check the system load
;right half of A gets load units
;left half gets flags for dialup lines,
;detached tree, or not logged in
push sp,b ;save our temporaries
push sp,c
push sp,e
setz a, ;clear a to receive our results
.suset [.runame,,uname] ;check our UNAME....
hllz e,uname ;look at left half of uname for '___'
camn e,[-1,,0] ;are we logged in?
tlo a,%SLLOG ;no, note the fact
.suset [.rcnsl,,ttynum] ;we have to check for detached or dialups
move e,ttynum ;get our tty num
caig e, ;do we have one?
tlo a,%SLDET ;no, note the fact
movei b,1 ;let's figure out which we are
lsh b,(e) ;as a bit in the word
tdne b,dilmsk ;are we a dialup?
tlo a,%SLDIL ;yes, note the fact
;; charge for FAIR SHARE
eval e,SLOADU ;Get inverse fair share
subi e,100 ;shrink it down (it never gets below 100, I
;believe...)
move b,.M"mxsldu ;if not low enough
movei c,(e) ;get copy to work with
subi c,(b) ;subtract out the maximum
caile c, ;still OK?
call lcalc ;nope, gotta charge extra and set a bit
imul e,.m"lodchg ;compute the charge
add a,e ;add it in
;; charge for LUSERS
eval e,SUSRS ;Load also depends on how many users
move b,.M"MXSUSR ;if we're over our limit,
movei c,(e) ;get a copy of our limit to work on
subi c,(b) ;subtract out the actual
caile c, ;still OK?
call lcalc ;do the calculations and set the bit
imul e,.m"usrchg ;compute the charge
add a,e ;add it in
.rtime e, ;get time
camge e,t.open ;if before 8:00 am
jrst oopen ;it's OK
camle e,t.clos ;if it's after 8:00 pm
jrst oopen ;it's OK
.ryear b, ;get date stuff
ldb e,[.bp (003400),b] ;this byte
cain e,0 ;if zero
jrst oopen ;it's SUNDAY, let him go.
cain e,6 ;if not SATURDAY
jrst oopen ;OK!
call holdyp ;is it a holiday?
jrst nopen ; tell him we're closed!
oopen::
gobak: hrrz b,a ;get our points (separate from bits)
caml b,mxlmax ;OK! (or IS it....check out the total points)
tlo a,%SLOAD ;too high......note the fact
pop sp,e ;restore our AC's
pop sp,c
pop sp,b
ret ;and return it
nopen: tlo a,%SLCLS
jrst gobak
lcalc: tlo a,%SLOAD ;no, note the fact we're over
imuli c,10000 ;scale up the quantity
idivi c,(b) ;fraction more than max
addi c,10000 ;+ 1
imuli e,(c) ;times the total quantity
idivi e,10000 ;and scale back down
ret
holdyp: movsi e,-hldys ;aobjn ptr
.rdate b, ;get the year
holdy1: camn b,(e)hldy ;is it a holiday?
popj1 ;yes, skip
aobjn e,holdy1 ;no, loop?
ret ;no, not a holiday
hldy: '780417' ;Patriot's Day
'780530' ;Memorial Day
'780704' ;Independence Day
'781225' ;Christmas
'790101' ;New Year's Day
hldys==.-hldy
t.open: sixbit /080000/ ;opening time
t.clos: sixbit /200000/ ;closing time
.m"MXSLDU: MVSLDU ;Fair share less than 100/MVSLDU*100% means
;system is heavily loaded
.m"MXSUSR: MVSUSR ;More than MVSUSR users means system is heavily
;loaded
.m"MXLMAX: MVLMAX ;trip point for point total
.m"usrchg: usr$$$ ;how much to charge for users in load figure
.m"lodchg: lod$$$ ;how much to charge for system load in load
;figure
uname: 0 ;save the UNAME here to check for login etc.
dilmsk: 1_4+1_5+1_6+1_7
ttynum: 0 ;save our TTY number here to check for dialup
]
.m"go: move sp,[-pdleng,,pdl]
ifn ttyp,[syscal open,[cnti,,.uii
argi,,tyic
[sixbit /TTY/]]
loss
syscal open,[cnti,,<.uao+%tjdis>
argi,,tyoc
[sixbit /TTY/]]
loss
]
ifn infuuo,[
.suset [.runame,,rwkuuo"infuuo"myunam] ;get our name
]
ifn intp,[.suset [.roption,,a] ;get current .OPTION var
ior a,[(optint+optopc)]
.suset [.soption,,a] ;and set it for new interrupts and back up pc
syscal usrvar,[argi,,%jself ;enable IOC errors to ignored them
['IMASK ']
[%piioc]]
loss
]
ifn ufrnd,[
move a,[squoze 0,/toop/] ;output buffer pointers
.eval a,
loss
movem a,mtoop ;and save
move a,[squoze 0,/tintp/];end of output pointers, slower moving inpointr
.eval a,
loss
sub a,mtoop ;and save length of that region
movem a,mlen ;in mleng
]
.m"RWKEND==.
.end rwkuuo
;;and the rest of the system goes here.
Reference in New Issue View Git Blame Copy Permalink