; -*- 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,[,,+1] blt tt,+-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,&<-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: _33 jsp t,dirnxt move c,(d) ; C: _33 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: ,, 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