mirror of
https://github.com/PDP-10/its.git
synced 2026-01-28 12:59:20 +00:00
Eric Swenson
committed by
Lars Brinkhoff
Lars Brinkhoff
parent
cc5789597e
commit
cbbdbe357f
565
src/sysen3/xhost.36
Executable file
565
src/sysen3/xhost.36
Executable file
@@ -0,0 +1,565 @@
|
||||
; -*- Midas -*-
|
||||
|
||||
title XHOST - Prepare to canonicalize all host names in a file.
|
||||
|
||||
a=:1
|
||||
b=:2
|
||||
c=:3
|
||||
d=:4
|
||||
e=:5
|
||||
t=:6
|
||||
tt=:7
|
||||
x=:10
|
||||
y=:11
|
||||
z=:12
|
||||
|
||||
p=:17
|
||||
|
||||
ch==:0,,-1
|
||||
chttyi==:1
|
||||
chttyo==:2
|
||||
chdski==:3
|
||||
chdsko==:4
|
||||
|
||||
%fr==:0,,525252
|
||||
%freof==:400000
|
||||
%frlcl==:200000
|
||||
%fl==:1,,525252
|
||||
|
||||
call=:pushj p,
|
||||
return=:popj p,
|
||||
save==:push p,
|
||||
rest==:pop p,
|
||||
flose=:.lose %lsfil
|
||||
slose=:.lose %lssys
|
||||
pause=:.break 16,100000
|
||||
quit=:.logout 1,
|
||||
tyi=:.iot chttyi,
|
||||
tyo=:.iot chttyo,
|
||||
|
||||
define bltdup org,len
|
||||
move tt,[<org>,,<org>+1]
|
||||
blt tt,<org>+<len>-1
|
||||
termin
|
||||
|
||||
define syscall name,args
|
||||
.call [setz ? .1stwd sixbit /name/ ? args(400000)]
|
||||
termin
|
||||
|
||||
popj1: aos (p)
|
||||
cpopj: return
|
||||
|
||||
format"$$pcode==:1
|
||||
format"$$errs==:0
|
||||
.insrt dsk:syseng;format >
|
||||
|
||||
outstr: syscall siot,[movei chttyo ? a ? b]
|
||||
slose
|
||||
return
|
||||
|
||||
define format &string&,args
|
||||
call [
|
||||
call $format
|
||||
.zzz.==-1
|
||||
irp arg,,[args]
|
||||
save arg
|
||||
.zzz.==.irpcnt
|
||||
termin
|
||||
hrroi a,[ascii string]
|
||||
movei b,.length string
|
||||
movni c,.zzz.+1
|
||||
jrst format"format]
|
||||
termin
|
||||
|
||||
$forma: save a
|
||||
save b
|
||||
save c
|
||||
save [.+2]
|
||||
jrst @-4(p)
|
||||
rest c
|
||||
rest b
|
||||
rest a
|
||||
rest (p)
|
||||
return
|
||||
|
||||
; Table of hostname translations:
|
||||
; Host named by left half should always appear with name in right half.
|
||||
; If right half is 0, then host is ignored.
|
||||
tran:
|
||||
[asciz "Symbolics"],,[asciz "Symbolics"]
|
||||
[asciz "Berkeley.EDU"],,[asciz "Berkeley.EDU"]
|
||||
; Nobody sends mail to RICE-KRISPIES.AI.MIT.EDU:
|
||||
[asciz "Rice"],,[asciz "Rice.EDU"]
|
||||
ltran==:.-tran
|
||||
|
||||
; UNAME table:
|
||||
; Certain common tokens that frequently occur in mailing lists that aren't
|
||||
; really host names go here.
|
||||
; Keep this list sorted!
|
||||
unames:
|
||||
irps name,,[
|
||||
cent CMB COLE dae DanG EB FILE Frank
|
||||
Gregor HAL HES HIC KWH Lauren lee LIN
|
||||
LSP MAH MAP Moon MRC NULL OLE RAY
|
||||
RK RMS RON Tim TK TY
|
||||
]
|
||||
sixbit /name/
|
||||
termin
|
||||
nunames==:.-unames
|
||||
lgunames==:36.-.lz nunames-1,
|
||||
repeat <1_lgunames>-nunames, setz-1
|
||||
|
||||
netwrk"$$hstmap==:1
|
||||
netwrk"$$hostnm==:1
|
||||
netwrk"$$symlook==:1
|
||||
netwrk"$$look==:1
|
||||
netwrk"$$hst3==:1
|
||||
.insrt dsk:syseng;netwrk >
|
||||
|
||||
.vector tran1(ltran)
|
||||
|
||||
; CALL LKINIT: Initialize hostname database
|
||||
; Clobbers A and B
|
||||
lkinit: movei a,ffpage
|
||||
movei b,chdski
|
||||
call netwrk"hstmap
|
||||
.lose
|
||||
setzm tran1+0
|
||||
bltdup tran1,ltran
|
||||
movsi b,-ltran
|
||||
lkini1: hlrz a,tran(b)
|
||||
hrli a,440700
|
||||
call look
|
||||
skipa
|
||||
movem a,tran1(b)
|
||||
aobjn b,lkini1
|
||||
return
|
||||
|
||||
; CALL LOOK: Canonicalize hostname
|
||||
; skips if hostname found
|
||||
; A (a/v): bp -> asciz /hostname/
|
||||
look: move y,a
|
||||
move z,[440600,,x]
|
||||
setzi x,
|
||||
jrst lookgo
|
||||
|
||||
looklp: tlnn z,770000
|
||||
jrst lookhs
|
||||
trzn t,100
|
||||
trca t,40
|
||||
tro t,40
|
||||
idpb t,z
|
||||
lookgo: ildb t,y
|
||||
jumpn t,looklp
|
||||
movei t,unames
|
||||
zzz==1_lgunames
|
||||
repeat lgunames,[
|
||||
zzz==zzz_-1
|
||||
caml x,zzz(t)
|
||||
movei t,zzz(t)
|
||||
] ;end repeat
|
||||
camn x,(t)
|
||||
return
|
||||
lookhs: save b
|
||||
save e
|
||||
call netwrk"hsttbp ; E: aobjn to NAMES table
|
||||
call netwrk"syml1 ; non-interactive search
|
||||
jrst looklz ; lost
|
||||
camn b,[-1]
|
||||
jrst looklz ; numbers lose too
|
||||
hlrz a,netwrk"nmlsit(b)
|
||||
add a,netwrk"hstadr ; A: SITE table entry
|
||||
hlrz a,netwrk"stlnam(a)
|
||||
add a,netwrk"hstadr
|
||||
hrli a,440700 ; A: bp -> asciz /official name/
|
||||
movsi t,-ltran
|
||||
came a,tran1(t)
|
||||
aobjn t,.-1
|
||||
jumpge t,lookwn
|
||||
hrr a,tran(t)
|
||||
trne a,-1
|
||||
lookwn: aos -2(p)
|
||||
looklz: rest e
|
||||
rest b
|
||||
return
|
||||
|
||||
; The only characters in hostnames are letters, digits, "." and "-".
|
||||
; Hostnames never begin or end with "." or "-".
|
||||
; (There is also a bug in NETWRK where hostnames beginning with a digit are not
|
||||
; found.)
|
||||
foo: call netwrk"hsttbp ; E: aobjn to NAMES table
|
||||
foolp: hrrz a,netwrk"nmrnam(e)
|
||||
add a,netwrk"hstadr
|
||||
hrli a,440700
|
||||
move b,a ; A, B: bp -> hostname
|
||||
setzi d, ; D: accumulate length
|
||||
foolpc: ildb t,a
|
||||
jumpe t,foonxt
|
||||
aoja d,foolpc
|
||||
|
||||
foonxt: syscall siot,[movei chdsko ? b ? d]
|
||||
slose
|
||||
.iot chdsko,[^M]
|
||||
.iot chdsko,[^J]
|
||||
aobjn e,foolp ; OK, so we know they are one word long...
|
||||
return
|
||||
|
||||
rfn"$$rfn==:1
|
||||
rfn"$$switch==:1
|
||||
.insrt dsk:syseng;rfn >
|
||||
|
||||
rsixtp: cain a,"/
|
||||
aos (p)
|
||||
return
|
||||
|
||||
switch: format "Illegal switch: ~C",a
|
||||
quit
|
||||
|
||||
.vector buffer(lbuffer==:10000)
|
||||
.scalar inbp ; bp for INCH
|
||||
.scalar incnt ; # chars available to INCH
|
||||
.scalar outbp ; bp to output still in buffer
|
||||
.scalar outcnt ; # chars of output still in buffer
|
||||
|
||||
; CALL INCH: Read a character
|
||||
; A (val): Next character
|
||||
; B (val): Class of character
|
||||
inch0: setzb a,b .see qeof
|
||||
trne %freof
|
||||
return
|
||||
call fill
|
||||
inch: sosge incnt
|
||||
jrst inch0
|
||||
ildb a,inbp
|
||||
move b,class(a)
|
||||
return
|
||||
|
||||
; CALL IOINIT: Initialize I/O
|
||||
ioinit: setzm outcnt
|
||||
move t,[-lbuffer,,buffer]
|
||||
jrst fill1
|
||||
|
||||
fill: syscall siot,[movei chdsko ? outbp ? outcnt] ; zeros OUTCNT
|
||||
slose
|
||||
move t,buffer+lbuffer-1
|
||||
movem t,buffer+0
|
||||
move t,[1-lbuffer,,buffer+1]
|
||||
fill1: .iot chdski,t
|
||||
jumpl t,eof
|
||||
movei t,5*<lbuffer-1> ; Don't give out last word yet
|
||||
fill2: movem t,incnt
|
||||
move t,[440700,,buffer]
|
||||
movem t,inbp
|
||||
movem t,outbp
|
||||
return
|
||||
|
||||
eof: tro %freof
|
||||
.close chdski,
|
||||
movei t,-buffer(t)
|
||||
jumpe t,fill2
|
||||
move tt,buffer-1(t)
|
||||
imuli t,5
|
||||
xor tt,[.byte 7 ? 0 ? ^C ? ^C ? ^C ? ^C]
|
||||
trne tt,177_1
|
||||
jrst fill2
|
||||
trne tt,177_8
|
||||
soja t,fill2
|
||||
subi t,3
|
||||
tdne tt,[177_15.]
|
||||
aoja t,fill2
|
||||
tlne tt,(177_22.)
|
||||
jrst fill2
|
||||
soja t,fill2
|
||||
|
||||
.vector pdl(lpdl==:100.)
|
||||
.scalar option
|
||||
.vector filnam(4)
|
||||
|
||||
usrvar: sixbit /OPTION/ ? tlo %opint\%opopc
|
||||
sixbit /MASK/ ? move [%pipdl]
|
||||
sixbit /OPTION/ ? movem option
|
||||
sixbit /SNAME/ ? movem filnam+3
|
||||
lusrvar==:.-usrvar
|
||||
|
||||
nojcl: format "Use JCL"
|
||||
quit
|
||||
|
||||
go: move p,[-lpdl,,pdl-1]
|
||||
setzi 0, ; clear flags
|
||||
.open chttyi,[.uai,,'tty ? setz ? setz]
|
||||
slose
|
||||
.open chttyo,[.uao\%tjdis,,'tty ? setz ? setz]
|
||||
slose
|
||||
move tt,[-lusrvar,,usrvar]
|
||||
syscall usrvar,[movei %jself ? tt]
|
||||
slose
|
||||
call lkinit
|
||||
move a,option
|
||||
tlnn a,%opcmd
|
||||
jrst nojcl
|
||||
.vector jcl(ljcl==:100.)
|
||||
setzm jcl
|
||||
bltdup jcl,ljcl-1
|
||||
movsi t,(.byte 7 ? ^C ? ^C)
|
||||
movem t,jcl+ljcl-1
|
||||
.break 12,[..rjcl,,jcl]
|
||||
movsi t,(sixbit /DSK/)
|
||||
movem t,filnam+0
|
||||
move t,[sixbit /NAMES/]
|
||||
movem t,filnam+1
|
||||
movsi t,(sixbit />/)
|
||||
movem t,filnam+2
|
||||
movei b,filnam
|
||||
move d,[440700,,jcl]
|
||||
call rfn"rfn
|
||||
syscall open,[movsi .bai ? movei chdski ? filnam+0
|
||||
filnam+1 ? filnam+2 ? filnam+3]
|
||||
flose
|
||||
syscall open,[movsi .uao ? movei chdsko ? filnam+0
|
||||
filnam+1 ? [sixbit /XHOST/] ? filnam+3]
|
||||
flose
|
||||
call ioinit
|
||||
setom breakc
|
||||
jrst begin
|
||||
|
||||
nsemic: aos outcnt
|
||||
call inch ; parse comment
|
||||
caie a,^M
|
||||
jumpn b,nsemic
|
||||
jumpe b,ndone
|
||||
normal: aos outcnt
|
||||
norml1: call inch
|
||||
jrst @ntable(b)
|
||||
|
||||
ntable: offset -.
|
||||
qeof:: ndone ; must be 0
|
||||
qbreak:: nbreak
|
||||
qquote:: nquote
|
||||
qsemic:: nsemic
|
||||
qslash:: nslash
|
||||
qbrack:: nbrack
|
||||
qother:: normal
|
||||
qhyphe:: normal
|
||||
qalnum:: ;; letters and digits from here on up
|
||||
qalpha:: normal
|
||||
qnumer:: normal
|
||||
offset 0
|
||||
|
||||
; slash
|
||||
nslash: movei t,normal
|
||||
eatone: aos outcnt
|
||||
call inch
|
||||
jumpn b,(t)
|
||||
jrst ndone
|
||||
|
||||
; doublequote
|
||||
nquot0: jsp t,eatone
|
||||
nquote: aos outcnt
|
||||
call inch
|
||||
cain b,qslash
|
||||
jrst nquot0
|
||||
caie a,42
|
||||
jumpn b,nquote
|
||||
jumpn b,nbreak
|
||||
jrst ndone
|
||||
|
||||
; filename
|
||||
nbrac0: jsp t,eatone
|
||||
nbrack: aos outcnt
|
||||
call inch
|
||||
cain b,qslash
|
||||
jrst nbrac0
|
||||
caie a,135
|
||||
jumpn b,nbrack
|
||||
jumpn b,nbreak
|
||||
jrst ndone
|
||||
|
||||
ndone: syscall siot,[movei chdsko ? outbp ? outcnt]
|
||||
slose
|
||||
quit
|
||||
|
||||
.vector token(ltoken==:20.)
|
||||
.scalar breakc
|
||||
|
||||
; break character
|
||||
nbreak: aos outcnt
|
||||
movem a,breakc
|
||||
begin: call inch
|
||||
caie b,qalpha
|
||||
jrst @ntable(b)
|
||||
move c,[440700,,token]
|
||||
movni d,5*ltoken
|
||||
acum: aojge d,aexito
|
||||
idpb a,c
|
||||
call inch
|
||||
jrst @atable(b)
|
||||
|
||||
atable: offset -.
|
||||
qeof:: abreak ; must be 0
|
||||
qbreak:: abreak
|
||||
qquote:: abreak
|
||||
qsemic:: abreak
|
||||
qslash:: aexit
|
||||
qbrack:: aexit
|
||||
qother:: aexit
|
||||
qhyphe:: ahyphe
|
||||
qalnum:: ;; letters and digits from here on up
|
||||
qalpha:: acum
|
||||
qnumer:: acum
|
||||
offset 0
|
||||
|
||||
ahyphe: aojge d,aexito
|
||||
idpb a,c
|
||||
call inch
|
||||
cail b,qalnum
|
||||
jrst acum
|
||||
jrst aexit
|
||||
|
||||
abrekf: rest a
|
||||
aexit: addi d,<5*ltoken>
|
||||
aexit0: skipn outcnt
|
||||
jrst aexit1
|
||||
addm d,outcnt
|
||||
jrst @ntable(b)
|
||||
|
||||
aexito: movei d,<5*ltoken>-1
|
||||
jrst aexit0
|
||||
|
||||
aexit1: move c,[440700,,token]
|
||||
syscall siot,[movei chdsko ? c ? d]
|
||||
slose
|
||||
aexit2: setoi c,
|
||||
adjbp c,inbp
|
||||
movem c,outbp
|
||||
jrst @ntable(b)
|
||||
|
||||
abreak: setzi t,
|
||||
idpb t,c
|
||||
save a
|
||||
move a,[440700,,token]
|
||||
call look
|
||||
jrst abrekf
|
||||
call lclchk
|
||||
move x,[440700,,token]
|
||||
move y,a
|
||||
call sequal
|
||||
cain t,(tt)
|
||||
jrst abrekf
|
||||
jumpn t,abrekt
|
||||
trne %frlcl
|
||||
caie tt,".
|
||||
jrst abrekt
|
||||
jrst abrekf
|
||||
|
||||
abrekt: syscall siot,[movei chdsko ? outbp ? outcnt]
|
||||
slose
|
||||
move t,[440700,,token]
|
||||
addi d,<5*ltoken>
|
||||
syscall siot,[movei chdsko ? t ? d]
|
||||
slose
|
||||
.iot chdsko,[177]
|
||||
movei t,"@
|
||||
came t,breakc
|
||||
.iot chdsko,["@]
|
||||
move c,a
|
||||
setzi d,
|
||||
abrekl: ildb t,c
|
||||
jumpe t,abrekx
|
||||
cain t,".
|
||||
trnn %frlcl
|
||||
aoja d,abrekl
|
||||
abrekx: syscall siot,[movei chdsko ? a ? d]
|
||||
slose
|
||||
rest a
|
||||
jrst aexit2
|
||||
|
||||
; CALL LCLCHK: Check if hostname is local
|
||||
; A (a/v): b.p. -> asciz /hostname/
|
||||
; Sets %FRLCL if hostname ends in ".AI.MIT.EDU" or ".LCS.MIT.EDU".
|
||||
; Clears it otherwise.
|
||||
lclchk: trz %frlcl
|
||||
move x,a
|
||||
lclck1: ildb t,x
|
||||
caie t,".
|
||||
jumpn t,lclck1
|
||||
jumpe t,cpopj
|
||||
ildb t,x
|
||||
caie t,"A
|
||||
cain t,"a
|
||||
jrst lclcka
|
||||
caie t,"L
|
||||
cain t,"l
|
||||
jrst lclckl
|
||||
return
|
||||
|
||||
lclckl: skipa y,[440700,,[asciz "CS.MIT.EDU"]]
|
||||
lclcka: move y,[440700,,[asciz "I.MIT.EDU"]]
|
||||
call sequal
|
||||
cain t,(tt)
|
||||
tro %frlcl
|
||||
return
|
||||
|
||||
; CALL SEQUAL: Compare strings for equality
|
||||
; X (a/v): b.p. -> asciz /string1/ (updated)
|
||||
; Y (a/v): b.p. -> asciz /string2/ (updated)
|
||||
; T (val): last character read from string1
|
||||
; TT (val): last character read from string2
|
||||
; If C(T) = C(TT), then the strings were equal. (In which case C(T) = 0.)
|
||||
; Slightly faster if string2 is upper case.
|
||||
sequal: ildb t,x
|
||||
ildb tt,y
|
||||
cain t,(tt)
|
||||
jumpn t,sequal
|
||||
caie t,"a-"A(tt)
|
||||
jrst sequl1
|
||||
cail t,"a
|
||||
caile t,"z
|
||||
return
|
||||
jrst sequal
|
||||
|
||||
sequl1: caie tt,"a-"A(t)
|
||||
return
|
||||
cail tt,"a
|
||||
caile tt,"z
|
||||
return
|
||||
jrst sequal
|
||||
|
||||
class: repeat 200, qother
|
||||
|
||||
loc class+"A
|
||||
repeat 26., qalpha
|
||||
|
||||
loc class+"a
|
||||
repeat 26., qalpha
|
||||
|
||||
loc class+"0
|
||||
repeat 10., qnumer
|
||||
|
||||
irp ch,,[11,12,14,15,40,50,51,100,133,42,73,55,56,57,21]type,,[qbreak,qbreak,qbreak,qbreak,qbreak,qbreak,qbreak,qbreak,qbrack,qquote,qsemic,qhyphe,qhyphe,qslash,qslash]
|
||||
loc class+ch
|
||||
type
|
||||
termin
|
||||
|
||||
loc class+200
|
||||
|
||||
tsint:
|
||||
loc 42
|
||||
-ltsint,,tsint
|
||||
loc tsint
|
||||
400000,,p
|
||||
ltsint==:.-tsint
|
||||
|
||||
dismis: setz ? sixbit /DISMIS/ ? movsi 400000 ? setz p
|
||||
|
||||
cnstnts:
|
||||
constants
|
||||
variables
|
||||
|
||||
patch::
|
||||
pat: block 100.
|
||||
epatch: -1 ; Make memory exist, end of patch area
|
||||
|
||||
ffaddr:
|
||||
ffpage==:<ffaddr+1777>_-12
|
||||
|
||||
end go
|
||||
Reference in New Issue
Block a user