PDP-10.its/src/sysen3/execvt.83

; -*- 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