github.com/PDP-10.its
1
0
Fork 0
mirror of https://github.com/PDP-10/its.git synced 2026-01-16 00:14:18 +00:00
Code Issues Releases Wiki Activity
PDP-10.its/src/sysen3/execvt.83
Eric Swenson 4e1e666dff Added EXECVT. 
Resolves #312.

Source from AI: KCC; EXECVT 83.
2016-12-21 10:15:49 +01:00

793 lines
15 KiB
Plaintext
Executable File
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 -*-
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 View Git Blame Copy Permalink