mirror of
https://github.com/PDP-10/its.git
synced 2026-05-23 13:56:15 +00:00
b467dcc16a
CLUDMP is the compiler, and is a normal ITS executable. It has a variety of commands documented in CLU ORDER, but normally just the file name can be passed on the JCL. The compiler emits an intermediate CLUMAC file which is then assembled with MIDAS, leavning a BIN file. The BIN file is not a normal ITS binary, but has to be loaded into the CLU runtime. The CLUSYS directory has files needed to assemble CLUMAC files. ALPHA and OMEGA are inserted at the top and bottom, respectively. ALPHA in turn needs PASS1, TYPES, and COMMON. It is not known how LOAD is used, but it's also necessary in the compilation process. TS CLUSYS is the runtime system. The procedure "fload" accepts a string specifying a file to be loaded. It's an open question whether the two executables can be rebuilt from source code found on the scattered ITS backups.
656 lines
17 KiB
Groff
656 lines
17 KiB
Groff
;**** A BASIC CLUSYS FILE ****
|
|
|
|
cluster %load,0,0,[],[]
|
|
|
|
; %snap should be called with the address of a
|
|
; procedure call block (pcb) and the address of the
|
|
; entry block of the procedure executing when
|
|
; snapping. it will give a nasty error if the pc.lnk
|
|
; field of the pcb does not refer to a word which
|
|
; refers back to the pcb. it will give another nasty
|
|
; error if the pcb refers to a procedure that is not
|
|
; present in the procedure table. snap returns (if all
|
|
; is well) with the procedure object.
|
|
|
|
propt%==prc.ni
|
|
proc %snap,[plnk,ent]
|
|
$label retry ; we will try forever if necessary
|
|
refchk r0,plnk(er)
|
|
repchk r0,tcrep
|
|
; lookup the procedure quickly or slowly
|
|
$if skipn pc.typ(r0) ; if no type to find
|
|
skipe pc.par(r0) ; and no parms to fool with
|
|
$then mcall pfind,[pc.str(r0)] ; then look in ptab
|
|
aos $snap ; and bump snapped count
|
|
$else call %desc$snap_pcb,1,[r0] ; look and perhaps build one
|
|
$fi
|
|
; check the returned object for some validity
|
|
refchk rr,rr
|
|
$if came rr,$none
|
|
$then mcall %dfail,[plnk(er)]
|
|
$fi
|
|
; if block is an entry block, check the # of arguments
|
|
$if isrep rr,terep
|
|
$then hrrz r1,en.lpr(rr) ; get the pr for the found procedure
|
|
hrrz n1,pr.cut(r1) ; get number of args for that procedure
|
|
hrrz r0,plnk(er)
|
|
$if skipl n2,pc.num(r0) ; if #args < 0, then no test
|
|
cain n2,-2(n1) ; adjust test for frame size
|
|
$then slink lnk,Snap found a bad # of args for:
|
|
move g0,lnk(lr)
|
|
$go bitch
|
|
$fi
|
|
$fi
|
|
; attempt to find (and replace) the pcb in cluster data
|
|
push sp,rr
|
|
move r0,ent(er) ; try to fixup linkage
|
|
hlro r0,en.lpr(r0)
|
|
$ift mcall ld.sb,[r0,plnk(er),rr]
|
|
$then $rtn (sp)
|
|
$fi
|
|
; attempt to find (and replace) the pcb in cluster parm dependent stuff
|
|
move rr,(sp)
|
|
move r0,ent(er) ; try to fixup cluster parms
|
|
hrro r0,en.par(r0)
|
|
trnn r0,ones
|
|
$go ppfix
|
|
$ift mcall ld.sb,[r0,plnk(er),rr]
|
|
$then $rtn (sp)
|
|
$fi
|
|
move rr,(sp)
|
|
; attempt to find (and replace) the pcb in proc parm dependent stuff
|
|
$label ppfix
|
|
move r0,ent(er) ; try to fixup proc parms
|
|
hlro r0,en.par(r0)
|
|
trnn r0,ones
|
|
$rtn rr
|
|
$ift mcall ld.sb,[r0,plnk(er),rr]
|
|
$then $rtn (sp)
|
|
$fi
|
|
move rr,(sp)
|
|
$rtn rr ; and return the procedure object
|
|
|
|
$label bitch ; come here to bitch about something
|
|
mcall crlf,[$tyo] ; get new line
|
|
mcall ch.ws,[$tyo,g0] ; write the bitch
|
|
move r0,plnk(er)
|
|
mcall ch.ws,[$tyo,pc.str(r0)] ; write the name of the offender
|
|
mcall crlf,[$tyo]
|
|
croak $p gets you a listen loop (maybe).
|
|
call listen,2,[$tyi,$tyo] ; call to listen again
|
|
$go retry ; try again if we return
|
|
corp %snap,[plnk,ent]
|
|
|
|
; %Load$replace(vec,item,repl) tries to replace all occurences
|
|
; of item in vec by repl. If there was a replacement, it returns
|
|
; true, otherwise false.
|
|
propt%==prc.ni
|
|
proc ld.sb,[vec,item,repl],[flag],[tbool+false]
|
|
|
|
move r0,vec(er)
|
|
$if trne r0,-pgsize
|
|
$then $rtnc $false
|
|
$fi
|
|
$for all,rr,mcall loopv,[r0]
|
|
move r0,item(er)
|
|
$if came r0,(rr)
|
|
$then move r1,repl(er)
|
|
movem r1,(rr)
|
|
move rr,$true
|
|
movem rr,flag(er)
|
|
$fi
|
|
$rof all
|
|
$rtn flag(er)
|
|
|
|
corp %load$replace,[vec,item,replace],[flag]
|
|
|
|
; xload takes a string and tries to open the named channel.
|
|
; it then reads lines and treats them as file names to be fload'd
|
|
; into the current environment.
|
|
propt%==prc.ni
|
|
proc xload,[str],[chan],[0]
|
|
slink lnk,read
|
|
mcall ch.op,[lnk(lr),str(er)]
|
|
movem rr,chan(er)
|
|
$loop
|
|
link lnk,tchar+12
|
|
mcall ch.rs,[chan(er),lnk(lr)]
|
|
assn str(er),rr
|
|
mcall s.siz,[rr]
|
|
$if camg rr,$two
|
|
$then mcall ld.fl,[str(er)]
|
|
$else mcall ch.cl,[chan(er)]
|
|
$rtnc $none
|
|
$fi
|
|
$pool
|
|
|
|
corp xload,[str],[chan]
|
|
|
|
; %load$page(chan,addr) attempts to load in a page from
|
|
; a load file by mapping it in. If successful, it
|
|
; makes the page read-only to prevent funny things
|
|
; from happening.
|
|
propt%==prc.ni
|
|
proc ld.np,[chan,addr]
|
|
movei n0,0
|
|
hrrz n1,chan(er)
|
|
hrrz n2,addr(er)
|
|
idivi n2,pgsize
|
|
$if .call ld.np1(pr) ; did we map it in?
|
|
$then
|
|
$elf .call ld.np2(pr) ; try to get new page for reading
|
|
$then movei n1,pgsize ; could not map it in, so try to read it
|
|
stypix n1,(tint)
|
|
mcall ch.rv,[chan(er),addr(er),n1]
|
|
$else croak Can't get the page to load!
|
|
$fi
|
|
$rtnc $none
|
|
ld.np1==.-proc$
|
|
setz
|
|
sixbit /corblk/
|
|
5000,,%cbndr+%cbcpy ; copy, read
|
|
n0 ; arg1 = 0 (no mod to ctrl bits)
|
|
1000,,%jself ; job = self
|
|
n2 ; page number
|
|
setz n1 ; channel #
|
|
ld.np2==.-proc$
|
|
setz
|
|
sixbit /corblk/
|
|
5000,,%cbndr+%cbndw ; read & write the page
|
|
n0 ; arg1 = 0 (no mod to ctrl bits)
|
|
1000,,%jself ; job = self
|
|
n2 ; page number
|
|
setzi %jsnew ; try for new page
|
|
corp %load$page,[chan,addr]
|
|
|
|
; Fload takes a string for a file name, then attempts
|
|
; to open a load file by that name. If successful it
|
|
; calls Load on the resulting channel.
|
|
|
|
propt%==prc.ni
|
|
proc ld.fl,[name]
|
|
mcall f.pa1,[name(er)]
|
|
movei n1,'BIN
|
|
skipn fb.nm2(rr)
|
|
movsm n1,fb.nm2(rr)
|
|
movei n1,6 ; read in block mode
|
|
mcall f.opn,[n1,rr] ; try to open the file
|
|
vargen chan,0
|
|
movem rr,chan(er)
|
|
$if hlrz n1,rr ; did we get a channel?
|
|
cain n1,(tchan)
|
|
$then slink lnk,Fload could not open
|
|
mcall s.cat,[lnk(lr),name(er)]
|
|
fail rr
|
|
$fi
|
|
mcall ld.ld,[chan(er)] ; load the file
|
|
mcall ch.cl,[chan(er)] ; close the channel
|
|
$rtn name(er)
|
|
corp fload,[name]
|
|
|
|
; Load takes an open channel, then reads in what had
|
|
; better be a load file. To wit, there should be a
|
|
; JRST 1 in the first page of the file, followed by
|
|
; blocks with the format:
|
|
; 0: -N,,addr
|
|
; 1-N: data
|
|
; N: checksum
|
|
; This loading process runs out when a block is found
|
|
; with N = 0. The first block to be loaded must be in
|
|
; the "load block" format given here:
|
|
ld.cod== 0 ; tvec+5
|
|
ld.siz== 1 ; size of load file
|
|
ld.low== 2 ; virtual low bound
|
|
ld.ent== 3 ; ref to entry block vector
|
|
ld.ver== 4 ; CLU version number
|
|
ld.ref== 5 ; ptr to ref area
|
|
; Load then calls %load$fix to fix up the loaded stuff,
|
|
; then runs around making the entry blocks happy and
|
|
; entering them into the module table.
|
|
|
|
propt%==prc.ni
|
|
proc ld.ld,[chan],[lolim,size,reloc,source,srclen],[0,0,0,0,0]
|
|
mcall ld.np,[chan(er),$work]
|
|
movei n1,1
|
|
hrli n1,(jrst)
|
|
move r0,$work
|
|
hrli r0,-pgsize
|
|
.here ld.ld1 ; Scan for a JRST 1 to start the file.
|
|
camn n1,(r0)
|
|
jrst ld.ld2(pr)
|
|
aobjn r0,ld.ld1(pr)
|
|
jrst ld.lde(pr) ; there had better be one!
|
|
.here ld.ld2 ; Get the descriptor block & check it
|
|
movei n1,6
|
|
hrli n1,(tvec)
|
|
came n1,ld.cod+2(r0) ; the first word must be tvec+6
|
|
jrst ld.lde(pr)
|
|
hrrz n1,1(r0) ; get the low addr from load format
|
|
hrrz n2,2+ld.low(r0) ; and from the load block itself
|
|
came n1,n2
|
|
jrst ld.lde(pr) ; they had better match!
|
|
movem n2,lolim(er) ; save the low limit
|
|
hlrz n3,2+ld.ver(r0) ; get the version number
|
|
caie n3,ones&(myvers); compare against format part
|
|
jrst ld.lde(pr) ; otherwise we goof off
|
|
hrrz n1,2+ld.siz(r0)
|
|
movem n1,size(er) ; and the size of the memory
|
|
hrli n1,(twvec)
|
|
alloc (n1),n1 ; grab enough memory to load into
|
|
intoff ; no interrupts, please
|
|
hrroi r1,0(rr) ; point at the memory
|
|
movem r1,reloc(er) ; save that address
|
|
movei n3,0 ; clear to force new virtual ptr
|
|
.here ld.ld3
|
|
jumpl r0,ld.ld4(pr) ; if work ptr is valid, then use it
|
|
hrrm n3,source(er) ; save the virtual ptr
|
|
hlrm n3,srclen(er)
|
|
mcall ld.np,[chan(er),$work] ; grab the page
|
|
move r0,$work
|
|
hrli r0,-pgsize ; get ptr to the work area
|
|
move n3,source(er) ; get virtual ptr
|
|
hrl n3,srclen(er) ; and the length
|
|
.here ld.ld4
|
|
jumpl n3,ld.ld6(pr) ; if we can load another word, do so
|
|
aobjn r0,ld.ld5(pr) ; skip checksum & check for new page needed
|
|
mcall ld.np,[chan(er),$work] ; grab the page
|
|
move r0,$work
|
|
hrli r0,-pgsize ; get ptr to the work area
|
|
.here ld.ld5
|
|
$if skipge n3,(r0) ; get new virtual ptr & check for loading done
|
|
$then mcall ld.fx,[reloc(er),size(er),lolim(er),size(er),reloc(er)]
|
|
move r0,reloc(er) ; get the first word address
|
|
$if skipn r1,ld.ref(r0) ; if there are strings to fix up
|
|
$then add r0,ld.siz(r0)
|
|
stypix r0,(trel)
|
|
move g1,r0
|
|
$loop ; then start to fix them
|
|
stypix r1,(trel)
|
|
$if camge r1,g1 ; test for end of area
|
|
$then $go sfixed
|
|
$fi
|
|
$if skipl n2,(r1)
|
|
tlnn n2,repbit
|
|
$then hlrz n2,n2
|
|
$if caie n2,(tsrep) ; fix the string
|
|
$then stypix r1,(trel)
|
|
push sp,g1
|
|
mcall ld.sf,[r1]
|
|
pop sp,g1
|
|
move r1,rr
|
|
$elf caie n2,(tarep); skip the array block
|
|
$then addi r1,3
|
|
$elf caie n2,(torep); skip the oneof block
|
|
$then addi r1,2
|
|
$else hrrz n1,(r1) ; skip other blocks
|
|
addi r1,(n1)
|
|
$fi
|
|
$else aos r1 ; skip any other word
|
|
$fi
|
|
$pool
|
|
$label sfixed
|
|
$fi
|
|
|
|
move r0,reloc(er) ; get the first word address
|
|
$for all,rr,call loopv,1,[ld.ent(r0)] ; for all entry blocks, do
|
|
move g0,(rr) ; get the entry block
|
|
$if isrep g0,terep
|
|
$then ; this is an entry block
|
|
hrrz r0,en.lpr(g0) ; get the proc
|
|
skipn r0
|
|
$resume ; don't enter anything not a procedure
|
|
push sp,g0 ; save the entry block
|
|
add r0,pr.nam(r0)
|
|
move rr,(r0) ; get the procedure name
|
|
hrro r0,r0
|
|
push sp,r0 ; save the name address
|
|
mcall tb.ca,[$mtab,rr]
|
|
hrro r0,(sp)
|
|
movem rr,(r0) ; canonicalize the name
|
|
movem rr,(sp) ; save the name for later
|
|
mcall tb.va,[$mtab,rr] ; get old entry
|
|
pop sp,g0 ; restore the name
|
|
pop sp,g1 ; restore the entry
|
|
push sp,rr ; save the old guy
|
|
hrrz r0,rr
|
|
mcall tb.en,[$mtab,g0,g1]
|
|
pop sp,rr ; restore the old guy
|
|
$if camn rr,$none
|
|
$then movei n1,relink ; change setup call
|
|
hrli n1,(jsp xr,0)
|
|
movem n1,en.set(rr) ; to relink
|
|
$fi
|
|
$elf isrep g0,tdrep
|
|
$then ; this is a descriptor for a cluster
|
|
push sp,g0
|
|
mcall tb.ca,[$mtab,td.nam(g0)]
|
|
pop sp,g0
|
|
movem rr,td.nam(g0) ; canon the name
|
|
mcall tb.en,[$mtab,rr,g0] ; enter the type desc
|
|
$fi
|
|
$rof all
|
|
move rr,chan(er)
|
|
jrst ld.ldx(pr)
|
|
$fi
|
|
aobjp r0,ld.ld3(pr) ; skip over block ptr word & get new page if needed
|
|
.here ld.ld6 ; come here to move a bunch of words
|
|
; n3 is aobjn to virtual area
|
|
; r0 is aobjn to work area
|
|
hlre n2,n3
|
|
movn n2,n2 ; get length of virtual ptr
|
|
hlre n1,r0
|
|
movn n1,n1 ; and length of work ptr
|
|
camle n1,n2
|
|
exch n1,n2 ; n1 now has min length to blt
|
|
hrrz n0,n3
|
|
sub n0,lolim(er)
|
|
jumpl n0,ld.lde(pr) ; if low limit too low, error
|
|
hrrz br,reloc(er)
|
|
add br,n0 ; save for destination address
|
|
add n0,n1 ; add in blt length
|
|
camle n0,size(er)
|
|
jrst ld.lde(pr) ; if too long to blt, then error
|
|
hrrz r1,br ; get dest address
|
|
addi r1,-1(n1) ; find last word address
|
|
hrl br,r0 ; get work area address as source
|
|
blt br,(r1) ; move all possible words
|
|
hrl n1,n1 ; duplicate the size moved
|
|
add n3,n1 ; update the aobjn ptrs
|
|
add r0,n1
|
|
jrst ld.ld3(pr) ; and go test for source acceptability
|
|
.here ld.lde
|
|
croak Bad load file!!!!
|
|
slink lnk,Load failed.
|
|
move rr,lnk(lr)
|
|
.here ld.ldx
|
|
inton ; ok to interrupt now
|
|
$rtn rr
|
|
corp %load,[chan],[lolim,size,reloc,source,srclen]
|
|
|
|
|
|
; %load$fix(src,srclen,reflow,reflen,reloc) scans the
|
|
; area from src for srclen, looking for references to
|
|
; the area from reflow to reflen, and relocates such
|
|
; references to point at the area starting at reloc.
|
|
|
|
; macro to perform one case
|
|
define .case x
|
|
jrst lf.nxt(pr)
|
|
$elf caie n2,(t!x)
|
|
$then .case.==0
|
|
termin
|
|
|
|
; macro to skip a word of rsb's
|
|
define .skip pos
|
|
ifsn pos,,[
|
|
kvetch pos-.case.,n,Bad position in .skip pos !
|
|
.case.==.case.+1
|
|
]
|
|
aobjp r0,lf.ex(pr)
|
|
move n1,(r0)
|
|
termin
|
|
|
|
; macro to relocate the right half of current word
|
|
define .rel pos
|
|
ifsn pos,,[
|
|
kvetch pos-.case.,n,Bad position in .rel pos !
|
|
.case.==.case.+1
|
|
]
|
|
jsp r1,lf.rel(pr)
|
|
termin
|
|
|
|
; macro to relocate both halves of current word
|
|
define .pair pos
|
|
ifsn pos,,[
|
|
kvetch pos-.case.,n,Bad position in .pair pos !
|
|
.case.==.case.+1
|
|
]
|
|
jsp r1,lf.par(pr)
|
|
termin
|
|
|
|
; macro to snap setup words
|
|
define .set pos
|
|
ifsn pos,,[
|
|
kvetch pos-.case.,n,Bad position in .set pos !
|
|
.case.==.case.+1
|
|
]
|
|
jsp r1,lf.set(pr)
|
|
termin
|
|
|
|
propt%==prc.ni
|
|
proc ld.fx,[src,srclen,reflow,reflen,reloc]
|
|
move r0,src(er)
|
|
movn n1,srclen(er)
|
|
hrl r0,n1 ; r1 is aobjn to source for fix
|
|
hrrz g0,reflow(er) ; g0 points to ref bottom
|
|
hrrz n3,reflen(er) ; n3 is size of ref area
|
|
move g1,reloc(er) ; g1 points to start of reloc area
|
|
.here lf.get
|
|
$crtnc r0,ge,$none
|
|
move n1,(r0)
|
|
.here lf.nxt
|
|
.case.==0
|
|
hlrz n2,n1 ; grab the type code
|
|
$if skipl n1
|
|
$then .rel
|
|
$elf trne n2,repbit
|
|
$then .skip
|
|
$elf cail n2,typrep+repbit
|
|
$then croak Bad rep code in %load$fix (ptr in r0)
|
|
$elf caige n2,typrsb+repbit
|
|
$then croak Bad rep code in %load$fix (ptr in r0)
|
|
; otherwise each .case is an $elf-$then pair
|
|
; to handle the rep cases
|
|
.case arep ; arrays
|
|
.skip ar.cod
|
|
.rel ar.rel
|
|
.rel ar.vec
|
|
.case crep ; call blocks
|
|
.skip pc.cod
|
|
.set pc.set
|
|
.skip pc.num
|
|
.case drep ; descriptors
|
|
.skip td.cod
|
|
.rel td.fix
|
|
.skip td.opt
|
|
.case erep ; entry blocks
|
|
.skip en.cod
|
|
.set en.set
|
|
.pair en.lpr
|
|
$if trnn n1,ones ; if there is initialization
|
|
$then movs n1,n1 ; en.vi is (ref+1,,rsb)
|
|
sos n1
|
|
movem n1,(r0)
|
|
.rel en.vi
|
|
move n1,-1(r0)
|
|
aos n1
|
|
movsm n1,-1(r0)
|
|
move n1,(r0) ; remember, n1 has word in r0
|
|
$else setzm (r0)
|
|
.skip
|
|
$fi
|
|
.pair en.par
|
|
.rel en.tr
|
|
.case orep ; oneofs
|
|
.skip on.cod
|
|
.case prep ; pure parts
|
|
; Remove indirection in the code that goes through jumpers.
|
|
hrrz n2,pr.err(r0)
|
|
subi n2,pr.go ; n2 has # of words to scan
|
|
movei r1,pr.go(r0) ; r1 points to start of code
|
|
.here ld.fx1
|
|
$if skipl n1,(r1) ; get the instruction
|
|
$then tlz n1,400000 ; test for setz
|
|
skipe n1
|
|
movni n2,1 ; force end of loop
|
|
$elf
|
|
tlz n1,777400 ; clear off opcode & ac
|
|
cail n1,jumplo ; don't try if too low
|
|
caile n1,jumphi ; or if too high
|
|
$then ; could be indirect jrst or jumpxx
|
|
move n3,(n1) ; get jrst from where n1 points
|
|
hlrz n1,(r1) ; get instruction LH
|
|
trz n1,777 ; clear all but opcode
|
|
cain n1,(jrst) ; if a jrst, then
|
|
hrrm n3,(r1) ; snap indirection
|
|
trz n1,7777 ; clear low 3 bits of opcode
|
|
cain n1,(jump) ; if a jump*, then
|
|
hrrm n3,(r1) ; snap indirection
|
|
$fi
|
|
addi r1,1
|
|
sojg n2,ld.fx1(pr)
|
|
|
|
hrrz n1,pr.err(r0) ; get disp to errors
|
|
hrl n1,n1
|
|
add r0,n1 ; move over to errors
|
|
jrst lf.get(pr)
|
|
.case srep ; strings
|
|
movei n1,bpword+bpword-1(n1)
|
|
idivi n1,bpword ; get # of words to skip
|
|
hrl n1,n1 ; duplicate the number
|
|
add r0,n1 ; point at next stuff to fix
|
|
jrst lf.get(pr)
|
|
.case vec ; vectors
|
|
.skip
|
|
.case wvec ; word vectors
|
|
hrl n1,n1
|
|
add r0,n1
|
|
jrst lf.get(pr)
|
|
.case xrep ; ref vector
|
|
hrrz n1,n1
|
|
push sp,n1
|
|
.skip
|
|
$loop
|
|
$if sosg (sp)
|
|
$then .rel
|
|
$else jrst lf.nxt(pr)
|
|
$fi
|
|
$pool
|
|
$fi
|
|
jrst lf.nxt(pr)
|
|
|
|
.here lf.par ; reloc a pair of refs (ref,,ref)
|
|
hlrz n2,n1
|
|
sub n2,g0
|
|
jumpl n2,lf.rel(pr)
|
|
caml n2,n3
|
|
jrst lf.rel(pr)
|
|
add n2,g1 ; add in relocation
|
|
hrlm n2,(r0) ; insert the left half back into mem
|
|
.here lf.rel
|
|
hrrz n1,n1
|
|
sub n1,g0 ; check for validity of ref at bottom
|
|
jumpl n1,lf.skp(pr)
|
|
caml n1,n3 ; must be under (or at) the top, too
|
|
jrst lf.skp(pr)
|
|
add n1,g1 ; add in relocation
|
|
hrrm n1,(r0) ; relocate the right half
|
|
.here lf.skp
|
|
.skip
|
|
jrst (r1) ; and return to caller
|
|
.here lf.set
|
|
trne n1,-typlo ; check for n1 being in the common area
|
|
jrst lf.rel(pr)
|
|
trnn n1,-comadr
|
|
jrst lf.rel(pr) ; skip if it is not
|
|
hlrz n2,(n1)
|
|
caie n2,(jrst) ; is it a link to a jrst ?
|
|
jrst lf.skp(pr)
|
|
hrr n1,(n1) ; yes, so change it
|
|
movem n1,(r0)
|
|
jrst lf.skp(pr) ; and go skip the word
|
|
|
|
.here lf.ex ; to exit, come here
|
|
$rtnc $none
|
|
corp %load$fix,[src,srclen,reflow,reflen,reloc]
|
|
|
|
propt%==prc.ni
|
|
proc ld.sf,[rel]
|
|
refchk r0,rel(er)
|
|
move rr,r0 ; save the start in rr
|
|
hrli r0,(bsize)
|
|
move r1,r0
|
|
hrro g1,r1 ; save the start
|
|
hrre n3,(r0) ; grab the size in bytes
|
|
$loop
|
|
$if sosl n3
|
|
$then $go done
|
|
$fi
|
|
ildb n1,r1 ; grab byte from source
|
|
$label again
|
|
$if caie n1,"\
|
|
$then movei n2,3
|
|
movei n1,0
|
|
$loop
|
|
$if sosl n2
|
|
$then $go next
|
|
$fi
|
|
$if sosl n3
|
|
$then idpb n1,r0
|
|
$go done
|
|
$fi
|
|
ildb n0,r1
|
|
$if cail n0,"0
|
|
caile n0,"7
|
|
$then rot n1,3
|
|
andi n0,7
|
|
add n1,n0
|
|
sos (rr) ; keep track of chars missed
|
|
$elf caie n2,2
|
|
$then ; no # chars follow \
|
|
sos (rr) ; keep track of chars missed
|
|
cain n0,"n ; Newline
|
|
movei n0,12
|
|
cain n0,"N
|
|
movei n0,12
|
|
cain n0,"t ; Tab
|
|
movei n0,11
|
|
cain n0,"T
|
|
movei n0,11
|
|
cain n0,"p ; Page (form feed)
|
|
movei n0,14
|
|
cain n0,"P
|
|
movei n0,14
|
|
cain n0,"b ; Backspace
|
|
movei n0,10
|
|
cain n0,"B
|
|
movei n0,10
|
|
cain n0,"r ; carriage Return
|
|
movei n0,15
|
|
cain n0,"R
|
|
movei n0,15
|
|
cain n0,"v ; Vertical tab
|
|
movei n0,13
|
|
cain n0,"V
|
|
movei n0,13
|
|
move n1,n0 ; default to literal char
|
|
$go next
|
|
$else idpb n1,r0
|
|
move n1,n0
|
|
$go again
|
|
$fi
|
|
$pool
|
|
$fi
|
|
$label next
|
|
idpb n1,r0 ; deposit byte to dest
|
|
$pool
|
|
|
|
$label done
|
|
movei n1,0
|
|
$loop
|
|
$if came r0,r1
|
|
$then hrrz n1,(rr) ; and the number of bytes
|
|
addi n1,bpword+bpword-1 ; adjust to get # of words
|
|
idivi n1,bpword
|
|
add rr,n1 ; skip them
|
|
$rtn rr ; and return the ptr
|
|
$fi
|
|
idpb n1,r0 ; clear out remainder of string
|
|
$pool
|
|
|
|
corp %load$string_fix,[rel]
|
|
|
|
|
|
retsulc %load
|
|
|