From 4e1e666dff21d459ab4fb7a6055f9df78cbb1feb Mon Sep 17 00:00:00 2001 From: Eric Swenson Date: Tue, 20 Dec 2016 15:57:09 -0800 Subject: [PATCH] Added EXECVT. Resolves #312. Source from AI: KCC; EXECVT 83. --- README.md | 1 + build/build.tcl | 4 + src/sysen3/execvt.83 | 792 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 797 insertions(+) create mode 100755 src/sysen3/execvt.83 diff --git a/README.md b/README.md index c0f7fe50..adc266e0 100644 --- a/README.md +++ b/README.md @@ -133,6 +133,7 @@ A list of [known ITS machines](doc/machines.md). - DSKUSE, disk usage information. - DUMP/LOAD, tape backup and restore. - EMACS, editor. + - EXECVT, convert 20x.exe (SSAVE) file to ITS BIN (PDUMP) file. - FDIR, fast directory listing. - FED, font editor. - FIND, search for files. diff --git a/build/build.tcl b/build/build.tcl index 24427b45..a16742a5 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -1035,6 +1035,10 @@ respond "*" ":link dragon;hourly tmpkil,sys2;ts tmpkil\r" respond "*" ":midas sys2;ts what_syseng;what\r" expect ":KILL" +# EXECVT +respond "*" ":midas sys2;ts execvt_sysen3;execvt\r" +expect ":KILL" + # UPTIME respond "*" ":midas sysbin;uptime bin_sysen1;uptime\r" expect ":KILL" diff --git a/src/sysen3/execvt.83 b/src/sysen3/execvt.83 new file mode 100755 index 00000000..303b2b6a --- /dev/null +++ b/src/sysen3/execvt.83 @@ -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,[,,+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