mirror of
https://github.com/PDP-10/its.git
synced 2026-01-29 13:21:11 +00:00
Eric Swenson
committed by
Lars Brinkhoff
Lars Brinkhoff
parent
eb6da57516
commit
4e1e666dff
792
src/sysen3/execvt.83
Executable file
792
src/sysen3/execvt.83
Executable file
@@ -0,0 +1,792 @@
|
||||
; -*- Midas -*-
|
||||
|
||||
title EXECVT - Convert 20X .EXE (SSAVE) file to ITS BIN (PDUMP) 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
|
||||
chttyo==:1
|
||||
chdski==:2
|
||||
chdsko==:3
|
||||
|
||||
%fr==:0,,525252
|
||||
%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,
|
||||
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
|
||||
|
||||
define conc foo,bar
|
||||
foo!bar!termin
|
||||
|
||||
; JSP T,LOSE is like .LOSE %LSSYS(TT) or SLOSE (TT)
|
||||
lose: syscall lose,[movei %lssys(tt) ? movei -2(t)]
|
||||
slose
|
||||
|
||||
popj1: aos (p)
|
||||
cpopj: return
|
||||
|
||||
.jbsa==:120 ; RH contains start address
|
||||
.jbsym==:116 ; aobjn to symbol table
|
||||
|
||||
rfn"$$rfn==:1
|
||||
rfn"$$pfn==:1
|
||||
.insrt dsk:syseng;rfn >
|
||||
|
||||
rsixtp: cain a,",
|
||||
aos (p)
|
||||
psixtp: return
|
||||
|
||||
format"$$pcode==:1
|
||||
format"$$pfn==:1
|
||||
format"pfn==:rfn"pfn
|
||||
.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
|
||||
call @-3(p)
|
||||
rest c
|
||||
rest b
|
||||
rest a
|
||||
rest (p)
|
||||
return
|
||||
|
||||
.vector pdl(lpdl==:100.)
|
||||
|
||||
usrvar: sixbit /OPTION/ ? tlo %opint\%opopc
|
||||
sixbit /MASK/ ? move [%pipdl]
|
||||
sixbit /SNAME/ ? movem sname
|
||||
sixbit /OPTION/ ? movem a
|
||||
lusrvar==:.-usrvar
|
||||
|
||||
.vector buffer(lbuffer==:1000) ; All-purpose buffer
|
||||
|
||||
.scalar sname ; default directory name
|
||||
|
||||
.vector infile(4) ; input filename
|
||||
.vector outfile(4) ; output filename
|
||||
|
||||
go: move p,[-lpdl,,pdl-1]
|
||||
movei t,<ffaddr+1777>&<-2000>
|
||||
movem t,memt
|
||||
movei t,ffaddr
|
||||
movem t,freept
|
||||
setzm bflist
|
||||
.open chttyo,[.uao\%tjdis,,'tty ? setz ? setz]
|
||||
slose
|
||||
move tt,[-lusrvar,,usrvar]
|
||||
syscall usrvar,[movei %jself ? tt]
|
||||
slose
|
||||
setzm buffer
|
||||
bltdup buffer,lbuffer-1
|
||||
setom buffer+lbuffer-1
|
||||
tlne a,%opcmd
|
||||
.break 12,[..rjcl,,buffer]
|
||||
move t,[[sixbit /DSK/ ? sixbit /FOO/ ? sixbit /EXE/],,infile]
|
||||
blt t,infile+2
|
||||
move t,sname
|
||||
movem t,infile+3
|
||||
move d,[440700,,buffer]
|
||||
movei b,infile
|
||||
call rfn"rfn
|
||||
move t,[[sixbit /DSK/ ? sixbit /FOO/ ? sixbit /BIN/],,outfile]
|
||||
blt t,outfile+2
|
||||
move t,infile+1
|
||||
movem t,outfile+1
|
||||
move t,sname
|
||||
movem t,outfile+3
|
||||
movei b,outfile
|
||||
cain a,",
|
||||
call rfn"rfn
|
||||
; Open in Image mode because RMTDEV throws away the low bits
|
||||
; otherwise. This is a bug in RMTDEV.
|
||||
syscall open,[movsi .bii ? movei chdski ? infile+0
|
||||
infile+1 ? infile+2 ? infile+3]
|
||||
flose
|
||||
syscall rfname,[movei chdski ? movem infile+0
|
||||
movem infile+1 ? movem infile+2 ? movem infile+3]
|
||||
slose
|
||||
format "~& ~F => ~F",[[[infile]],[[outfile]]]
|
||||
syscall open,[movsi .bao ? movei chdsko ? outfile+0
|
||||
[sixbit /_EXCVT/] ? [sixbit /OUTPUT/] ? outfile+3]
|
||||
flose
|
||||
|
||||
; Parse 20X page map
|
||||
|
||||
dirgo: setzm evlen
|
||||
setzm evloc
|
||||
setzm jhead
|
||||
setzm fhead
|
||||
setom incount
|
||||
setzi d, ; D: aobjn to remainder of buffer
|
||||
dirlp: jsp t,dirnxt
|
||||
dirlp0: hlrz t,(d)
|
||||
cain t,1777
|
||||
jrst dirend
|
||||
cain t,1776
|
||||
jrst dirmap
|
||||
cain t,1775
|
||||
jrst direv
|
||||
dirskp: format "~&Warning: Directory area section header ~H ignored.",(d)
|
||||
hrrz a,(d)
|
||||
jumple a,ebdfl
|
||||
jsp t,dirnxt
|
||||
sojg a,.-1
|
||||
jrst dirlp0
|
||||
|
||||
dirnxt: aobjn d,(t)
|
||||
aos incount
|
||||
ifl lbuffer-1000, .err BUFFER too small.
|
||||
move d,[-1000,,buffer]
|
||||
move tt,d
|
||||
.iot chdski,tt
|
||||
jumpge tt,(t)
|
||||
ebdfl: format "~&Bad file format. No conversion."
|
||||
jrst abort
|
||||
|
||||
.scalar evloc,evlen ; Entry vector location and length.
|
||||
; If length is (JRST) then use .JBSA,
|
||||
; .JBREN, and .JBVER instead.
|
||||
|
||||
direv: hrrz t,(d)
|
||||
caie t,3
|
||||
jrst dirskp
|
||||
jsp t,dirnxt
|
||||
move t,(d)
|
||||
movem t,evlen
|
||||
jsp t,dirnxt
|
||||
move t,(d)
|
||||
movem t,evloc
|
||||
jrst dirlp
|
||||
|
||||
dirmap: hrrz a,(d)
|
||||
trzn a,1
|
||||
jrst dirskp
|
||||
lsh a,-1 ; A: # pairs to go
|
||||
jumpg a,maplp
|
||||
jrst dirlp
|
||||
|
||||
maplp1: sojle a,dirlp
|
||||
maplp: jsp t,dirnxt
|
||||
move b,(d) ; B: <access>_33 <file page #>
|
||||
jsp t,dirnxt
|
||||
move c,(d) ; C: <repeat-1>_33 <job page #>
|
||||
maprpt: call ealloc ; X: new map entry
|
||||
movem b,eflags(x)
|
||||
movei x,efile(x)
|
||||
move y,b
|
||||
movei z,fhead
|
||||
call insert
|
||||
movei x,ejob-efile(x)
|
||||
move y,c
|
||||
movei z,jhead
|
||||
call insert
|
||||
tlnn c,777000
|
||||
jrst maplp1
|
||||
add c,[-1000,,1]
|
||||
aoja b,maprpt
|
||||
|
||||
dirend: hrrz t,(d)
|
||||
sojn t,ebdfl
|
||||
move t,jhead
|
||||
call nreverse
|
||||
movem t,jhead
|
||||
move t,fhead
|
||||
call nreverse
|
||||
movem t,fhead
|
||||
movem t,inhead
|
||||
|
||||
; Compute start instruction
|
||||
|
||||
.scalar start ; Start instruction
|
||||
|
||||
setzm start
|
||||
movei a,.jbsa
|
||||
call mapit
|
||||
jrst nojbsa
|
||||
hrrz t,(a)
|
||||
movem t,start
|
||||
nojbsa: move x,evlen
|
||||
skipe y,evloc
|
||||
cain x,(jrst)
|
||||
jrst evjrst
|
||||
cail x,1
|
||||
caile x,777
|
||||
jrst [ format "~&Warning: Entry vector of length ~:H ignored.",evlen
|
||||
jrst evchek ]
|
||||
exch y,start
|
||||
evjrst: ;; The start address that 20X would prefer is now in START, and a
|
||||
;; supposedly identical, redundant copy is in Y.
|
||||
skipn start ; Except 0 doesn't count
|
||||
movem y,start
|
||||
skipn y ; ... in either case
|
||||
move y,start
|
||||
came y,start
|
||||
format "Warning: Duplicate, inconsistent start address ~:H discarded.",y
|
||||
evchek: move t,start
|
||||
tlne t,-1
|
||||
jrst [ format "~&Warning: Start address ~:H discarded.",start
|
||||
setzm start
|
||||
jrst .+1 ]
|
||||
skipe t,start
|
||||
hrli t,(jrst)
|
||||
movem t,start
|
||||
|
||||
; Compute symbol table location
|
||||
|
||||
.scalar symloc,symlen ; Symbol table length and location
|
||||
|
||||
movei a,.jbsym
|
||||
call mapit
|
||||
skipa
|
||||
skipn t,(a)
|
||||
jrst [ format "~&Warning: No symbol table."
|
||||
jrst nosym ]
|
||||
tlne t,400000 ; better be negative
|
||||
tlne t,1 ; and even
|
||||
jrst [ format "~&Warning: Bogus symbol table pointer ~:H ignored.",t
|
||||
jrst nosym ]
|
||||
hrrzm t,symloc
|
||||
hlre t,t
|
||||
movnm t,symlen
|
||||
move b,symloc
|
||||
add b,symlen
|
||||
addi b,777
|
||||
lsh b,-9 ; B: first page beyond symbols
|
||||
move a,symloc
|
||||
lsh a,-9 ; A: first page of symbols
|
||||
sub b,a ; B: number of pages of symbols
|
||||
call pfind
|
||||
jrst nosypg
|
||||
symref: aos ecount-ejob(e)
|
||||
sojle b,symex
|
||||
skipn e,(e)
|
||||
jrst nosypg
|
||||
aos a
|
||||
camn a,1(e)
|
||||
jrst symref
|
||||
nosypg: format "~&Warning: Symbol table pages missing or duplicated."
|
||||
nosym: setzm symlen
|
||||
symex::
|
||||
|
||||
; Output page map
|
||||
|
||||
setzm buffer
|
||||
ifl lbuffer-1000, .err BUFFER too small.
|
||||
bltdup buffer,1000
|
||||
movei e,jhead
|
||||
outmlp: skipn e,(e) ; E: entry
|
||||
jrst outmwr
|
||||
move a,1(e) ; A: 20X page
|
||||
cail a,1000
|
||||
jrst outmlz
|
||||
lsh a,-1 ; A: ITS page
|
||||
move x,eflags-ejob(e)
|
||||
movei y,600000 ; Read and Write
|
||||
tlnn x,eflwrt
|
||||
movei y,200000 ; Read only
|
||||
iorm y,buffer+1(a) ; ORing them does the right thing!
|
||||
jrst outmlp
|
||||
|
||||
outmlz: movei d,1
|
||||
outunr: call unref
|
||||
skipe e,(e)
|
||||
aoja d,outunr
|
||||
lsh a,9
|
||||
format "~&Warning: ~:H page~P of data (starting at ~:H) discarded.",[d,a]
|
||||
outmwr: move t,[-1000,,buffer]
|
||||
.iot chdsko,t
|
||||
|
||||
;; Fill up to page boundary with zeros.
|
||||
;; (If we saved ACs, they would go here.)
|
||||
setzm buffer
|
||||
ifl lbuffer-1000, .err BUFFER too small.
|
||||
bltdup buffer,1000
|
||||
move t,[-1000,,buffer]
|
||||
.iot chdsko,t
|
||||
|
||||
; *** BUFFER contains zeros from here on in ***
|
||||
|
||||
; Output data pages
|
||||
|
||||
movei e,jhead
|
||||
setzi b, ; B: next expected page # out
|
||||
outlp: skipn e,(e)
|
||||
jrst outlpx
|
||||
move a,1(e) ; A: (20X) page #
|
||||
cail a,1000
|
||||
jrst outlpx
|
||||
camge a,b
|
||||
jrst outskp
|
||||
camn a,b ; If pages are consecutive,
|
||||
jrst outout ; just send it out.
|
||||
trne b,1 ; If expecting odd page #,
|
||||
call outpad ; then fill with zeros.
|
||||
trne a,1 ; If this is odd page #,
|
||||
call outpad ; then fill with zeros
|
||||
outout: call getbuf
|
||||
.iot chdsko,x
|
||||
call unref
|
||||
movei b,1(a)
|
||||
jrst outlp
|
||||
|
||||
outskp: lsh a,9
|
||||
format "~&Warning: Duplicate page at ~:H ignored.",a
|
||||
call unref
|
||||
jrst outlp
|
||||
|
||||
outpad: move t,[-1000,,buffer]
|
||||
.iot chdsko,t
|
||||
return
|
||||
|
||||
outlpx: trne b,1 ; If expecting odd page #,
|
||||
call outpad ; then fill with zeros.
|
||||
|
||||
; Output symbol table
|
||||
|
||||
.scalar symtbl
|
||||
|
||||
hrroi t,start ; First, the start instruction
|
||||
.iot chdsko,t
|
||||
skipn t,symlen
|
||||
jrst stbex
|
||||
call syminit
|
||||
movei x,2(t)
|
||||
call alloc
|
||||
movem x,symtbl
|
||||
setzb a,b ; A: name for structured program
|
||||
; B: -> current block (or 0 initially)
|
||||
move c,symtbl ; C: -> SYMTBL
|
||||
move d,symlen
|
||||
lsh d,-1 ; D: # pairs
|
||||
stblp: call symget
|
||||
caie z,500000 ; Local, Half-killed
|
||||
cain z,100000 ; Local
|
||||
jrst stbsym
|
||||
caie z,440000 ; Global, Half-killed
|
||||
cain z,40000 ; Global
|
||||
jrst stbsym
|
||||
cain z,140000 ; Block
|
||||
jrst stbblk
|
||||
cain z,000000 ; Program
|
||||
jrst stbprg
|
||||
format "~&Warning: Symbol ~U = ~:H has strange flags: ~:H",[x,y,z]
|
||||
jrst stbsym
|
||||
|
||||
stbblk: jumpe b,badstb ; better be in -some- program
|
||||
addi y,3
|
||||
jumpn a,stblk1
|
||||
caie c,2(b)
|
||||
jrst badstb ; program block better be empty
|
||||
move a,(b)
|
||||
movei c,(b) ; Start block over
|
||||
jrst stbout
|
||||
|
||||
stblk1: call stbeob
|
||||
movei b,(c) ; Start block
|
||||
jrst stbout
|
||||
|
||||
; ITS DDT effectively ignores level 1, so we go right to level 2...
|
||||
stbprg: movei y,2
|
||||
call stbeop
|
||||
setzi a, ; No structure yet
|
||||
movei b,(c) ; Start block
|
||||
jrst stbout
|
||||
|
||||
; Finish current program:
|
||||
stbeop: call stbeob ; First finish block
|
||||
jumpe a,cpopj ; Done if not structured
|
||||
movem a,0(c)
|
||||
move t,[-2,,2]
|
||||
movem t,1(c)
|
||||
movei c,2(c)
|
||||
return
|
||||
|
||||
; Finish current block: Insert length and sort it (bleagh).
|
||||
stbeob: jumpe b,cpopj
|
||||
movei t,(b)
|
||||
subi t,(c)
|
||||
hrlm t,1(b)
|
||||
movei e,(c)
|
||||
stbsr1: movei e,-2(e) ; E: -> sorted part
|
||||
caig e,2(b)
|
||||
return
|
||||
move tt,-1(e) ; TT: value
|
||||
camg tt,1(e)
|
||||
jrst stbsr1
|
||||
movei t,2(e) ; T: -> rest of sorted
|
||||
stbsr2: caige t,(c)
|
||||
camg tt,1(t)
|
||||
jrst stbsr3
|
||||
movei t,2(t)
|
||||
jrst stbsr2
|
||||
|
||||
stbsr3: save -1(e)
|
||||
save -2(e)
|
||||
hrli tt,(e)
|
||||
hrri tt,-2(e)
|
||||
blt tt,-3(t)
|
||||
rest -2(t)
|
||||
rest -1(t)
|
||||
jrst stbsr1
|
||||
|
||||
; Global symbols are made local because stripping them out and eliminating
|
||||
; duplicates would be painful, and the result isn't really particularly
|
||||
; useful.
|
||||
stbsym: jumpe b,badstb ; better be in -some- program
|
||||
trnn z,400000 ; (but preserve half-killed bit)
|
||||
tloa x,100000
|
||||
tlo x,500000
|
||||
stbout: movem x,0(c)
|
||||
movem y,1(c)
|
||||
movei c,2(c)
|
||||
sojg d,stblp
|
||||
call stbeop
|
||||
move t,[squoze 0,global]
|
||||
movem t,0(c)
|
||||
movsi t,-2
|
||||
movem t,1(c)
|
||||
move t,symtbl
|
||||
subi t,2(c)
|
||||
hrlm t,symtbl
|
||||
hllz c,symtbl ; C: accumulate checksum
|
||||
hrroi t,c
|
||||
.iot chdsko,t
|
||||
move t,symtbl
|
||||
stbcks: rot c,1
|
||||
add c,(t)
|
||||
aobjn t,stbcks
|
||||
move t,symtbl
|
||||
.iot chdsko,t
|
||||
hrroi t,c
|
||||
.iot chdsko,t
|
||||
jrst stbex
|
||||
|
||||
badstb: format "~&Warning: Symbol table format error."
|
||||
stbex::
|
||||
|
||||
; Finish up
|
||||
|
||||
hrroi t,start ; Finally, a duplicate start instruction
|
||||
.iot chdsko,t
|
||||
syscall renmwo,[movei chdsko ? outfile+1 ? outfile+2]
|
||||
slose
|
||||
syscall finish,[movei chdsko]
|
||||
jfcl
|
||||
exit: .close chdsko,
|
||||
quit
|
||||
|
||||
abort: syscall delewo,[movei chdsko]
|
||||
jfcl
|
||||
jrst exit
|
||||
|
||||
.scalar symcnt
|
||||
.scalar sympt
|
||||
.scalar symend
|
||||
|
||||
; CALL SYMINIT: Set up for calling SYMGET
|
||||
symini: move t,symloc
|
||||
add t,symlen
|
||||
movem t,symend
|
||||
setzm symcnt
|
||||
return
|
||||
|
||||
; CALL SYMGET: Read next symbol table pair
|
||||
; X (val): (ITS) squoze
|
||||
; Y (val): value, or whatever
|
||||
; Z (val): flags in 2.9 - 2.6
|
||||
symget: sosge symcnt
|
||||
call symnxt
|
||||
sos t,sympt
|
||||
save (t)
|
||||
sosge symcnt
|
||||
call symnxt
|
||||
sos t,sympt
|
||||
move x,(t)
|
||||
tlza x,740000
|
||||
sym50: imuli x,50
|
||||
camge x,[squoze 0,0] ; Smallest left-justified SQUOZE
|
||||
jrst sym50
|
||||
rest y
|
||||
hlrz z,(t)
|
||||
andi z,740000
|
||||
return
|
||||
|
||||
symnxt: save a
|
||||
save e
|
||||
sos a,symend ; A: address of last word
|
||||
movei t,777
|
||||
andcam t,symend
|
||||
and t,a
|
||||
movem t,symcnt
|
||||
call mapit
|
||||
.lose
|
||||
movei t,1(a)
|
||||
hrrzm t,sympt
|
||||
rest e
|
||||
rest a
|
||||
return
|
||||
|
||||
.scalar jhead ; first entry in job (+EJOB)
|
||||
.scalar fhead ; first entry in file (+EFILE)
|
||||
|
||||
; Format of each entry:
|
||||
ejob==:0 ; next entry in job (+EJOB)
|
||||
; 1 ; Page number in job
|
||||
efile==:2 ; next entry in file (+EFILE)
|
||||
; 3 ; Page number in file, or zero
|
||||
eflags==:4 ; 4.9 - 4.1 from 20X:
|
||||
eflshr==:200000 ; 4.8 => sharable (we ignore this)
|
||||
eflwrt==:100000 ; 4.7 => writable
|
||||
eflzer==:040000 ; 4.6 => page of zeros (undocumented!)
|
||||
ecount==:5 ; reference count
|
||||
ebuffer==:6 ; aobjn to data or 0
|
||||
lentry==:7
|
||||
|
||||
; CALL EALLOC: Allocate entry
|
||||
; X (val): entry
|
||||
ealloc: movei x,lentry
|
||||
call alloc
|
||||
movei t,1
|
||||
movem t,ecount(x)
|
||||
setzm ebuffer(x)
|
||||
return
|
||||
|
||||
; CALL INSERT: Insert new entry
|
||||
; X (a/v): address of pair for threading
|
||||
; 0(X): location to thread up
|
||||
; 1(X): location for number
|
||||
; Y (arg): number
|
||||
; Z (arg): address of head of list
|
||||
insert: tlz y,777000
|
||||
movem y,1(x)
|
||||
insrt1: skipe t,(z)
|
||||
caml y,1(t)
|
||||
jrst insrt2
|
||||
movei z,(t)
|
||||
jrst insrt1
|
||||
|
||||
insrt2: movem x,(z)
|
||||
movem t,(x)
|
||||
return
|
||||
|
||||
; CALL NREVERSE: Destructively reverse a list
|
||||
; T (arg): address of first pair
|
||||
; T (val): address of new first pair
|
||||
nrever: tdza tt,tt
|
||||
nrvrs1: exch t,tt
|
||||
exch tt,(t)
|
||||
jumpn tt,nrvrs1
|
||||
return
|
||||
|
||||
.scalar incount ; # of last page read from file
|
||||
.scalar inhead ; first unread entry in file (+EFILE)
|
||||
|
||||
; CALL PAGNXT: Read in page corresponding to next entry
|
||||
pagnxt: call balloc ; X: aobjn to buffer
|
||||
movei y,inhead
|
||||
pagnx1: skipn y,(y) ; Y: unread entry (+EFILE)
|
||||
.lose ; can't happen
|
||||
skipg ecount-efile(y) ; find one with positive reference count
|
||||
jrst pagnx1
|
||||
skipn z,1(y) ; Z: next desired file page #
|
||||
jrst pagzer ; (0 means zero page)
|
||||
pagskp: aos incount
|
||||
move t,x
|
||||
.iot chdski,t
|
||||
jumpl t,ebdfl
|
||||
camn z,incount
|
||||
jrst pagref
|
||||
camg z,incount
|
||||
jrst [ format "~&File has no page ~:H? No conversion.",z
|
||||
jrst abort ]
|
||||
format "~&Warning: Page ~:H in file isn't used?",incount
|
||||
jrst pagskp
|
||||
|
||||
pagzer: setzm (x)
|
||||
hrli t,(x)
|
||||
hrri t,1(x)
|
||||
blt t,777(x)
|
||||
pagref: skipg ecount-efile(y) ; if entry reference count positive:
|
||||
jrst pagrf1
|
||||
movem x,ebuffer-efile(y) ; install buffer and
|
||||
aos -1(x) ; aos buffer reference count
|
||||
pagrf1: skipn y,(y)
|
||||
jrst pagfin
|
||||
camn z,1(y) ; "These aren't the 'droids we're
|
||||
jrst pagref ; looking for."
|
||||
pagfin: movem y,inhead
|
||||
return
|
||||
|
||||
; CALL PFIND: Find an entry for a given (20X) page
|
||||
; skips if it finds it
|
||||
; A (a/v): (20X) page #
|
||||
; E (val): entry (+EJOB)
|
||||
pfind: movei e,jhead
|
||||
findl: skipn e,(e)
|
||||
return
|
||||
camle a,1(e)
|
||||
jrst findl
|
||||
camn a,1(e)
|
||||
aos (p)
|
||||
return
|
||||
|
||||
; CALL MAPIT: Get data starting at given address
|
||||
; skips if address exists
|
||||
; A (arg): address
|
||||
; A (val): aobjn to remainder of buffer for that address
|
||||
; E (val): entry (+EJOB)
|
||||
mapit: move x,a
|
||||
andi x,777
|
||||
hrli x,(x) ; X: <line #>,,<line #>
|
||||
lsh a,-9
|
||||
call pfind ; E: entry
|
||||
return
|
||||
move a,x
|
||||
call getbuf ; X: aobjn
|
||||
add a,x ; A: aobjn to remainder of buffer
|
||||
aos (p)
|
||||
return
|
||||
|
||||
; CALL GETBUF: Get the data buffer from an entry
|
||||
; E (a/v): entry (+EJOB)
|
||||
; X (val): aobjn to data
|
||||
getbuf: skipg ecount-ejob(e)
|
||||
.lose ; can't happen
|
||||
getbf1: skipe x,ebuffer-ejob(e)
|
||||
return
|
||||
call pagnxt
|
||||
jrst getbf1
|
||||
|
||||
; CALL UNREF: Decrement the reference count on an entry
|
||||
; E (a/v): entry (+EJOB)
|
||||
unref: sosg ecount-ejob(e)
|
||||
skipn x,ebuffer-ejob(e)
|
||||
return
|
||||
setzm ebuffer-ejob(e)
|
||||
sose -1(x)
|
||||
return
|
||||
jrst bfree
|
||||
|
||||
.scalar freept ; Pointer to free memory
|
||||
.scalar memt ; Top of memory
|
||||
|
||||
; CALL ALLOC: Allocate memory
|
||||
; X (arg): # words desired
|
||||
; X (val): pointer to first word allocated
|
||||
alloc: save x
|
||||
addb x,freept
|
||||
camle x,memt
|
||||
call newmem
|
||||
rest t
|
||||
subi x,(t)
|
||||
return
|
||||
|
||||
; CALL NEWMEM: Set MEMT
|
||||
; X (a/v): desired new top of memory
|
||||
newmem: move t,x
|
||||
addi t,1777
|
||||
trz t,1777
|
||||
movem t,memt
|
||||
lsh t,-12
|
||||
caile t,400
|
||||
jrst [ format "~&Perverse file. Not enough memory to do conversion."
|
||||
jrst abort ]
|
||||
.core (t)
|
||||
.lose
|
||||
return
|
||||
|
||||
.scalar bflist ; free list of buffers
|
||||
|
||||
; CALL BALLOC: Allocate 1000-word buffer
|
||||
; X (val): aobjn to buffer
|
||||
; Reference count in -1(X) contains zero
|
||||
balloc: skipn x,bflist
|
||||
jrst baloc1
|
||||
move t,(x)
|
||||
movem t,bflist
|
||||
return
|
||||
|
||||
baloc1: movei x,1001
|
||||
addb x,freept
|
||||
camle x,memt
|
||||
call newmem
|
||||
sub x,[1000,,1000]
|
||||
setzm -1(x)
|
||||
return
|
||||
|
||||
; CALL BFREE: Free 1000-word buffer
|
||||
; X (arg): aobjn to buffer
|
||||
; Reference count in -1(X) must be zero
|
||||
bfree: skipe -1(x)
|
||||
.lose
|
||||
move t,bflist
|
||||
movem t,(x)
|
||||
movem x,bflist
|
||||
return
|
||||
|
||||
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:
|
||||
|
||||
end go
|
||||
Reference in New Issue
Block a user