diff --git a/README.md b/README.md index 895b4310..cecb56ce 100644 --- a/README.md +++ b/README.md @@ -111,6 +111,7 @@ There's a [DDT cheat sheet](doc/DDT.md) for Unix users. - ATSIGN TCP, TCP support. - BINPRT, display information about binary executable file. - BYE, say goodbye to user. Used in LOGOUT scripts. + - CALPRT, decode a .CALL instructions CALL block - CHTN, CFTP, Chaosnet TELNET and FTP support. - COMPLR, lisp compiler. - COMSAT, Mail server. diff --git a/build/build.tcl b/build/build.tcl index 6b77e01f..af9cf974 100644 --- a/build/build.tcl +++ b/build/build.tcl @@ -823,6 +823,10 @@ respond "*" ":link sys1;ts luser,sysbin;luser bin\r" respond "*" ":midas sys2;ts arccpy_sysen2;arccpy\r" expect ":KILL" +# CALPRT +respond "*" ":midas sys2;ts calprt_sysen2;calprt\r" +expect ":KILL" + # ndskdmp tape respond "*" ":link kshack;good ram,.;ram ram\r" respond "*" ":link kshack;ddt bin,.;@ ddt\r" diff --git a/src/sysen2/calprt.23 b/src/sysen2/calprt.23 new file mode 100644 index 00000000..e1e8efe3 --- /dev/null +++ b/src/sysen2/calprt.23 @@ -0,0 +1,226 @@ +; -*-MIDAS-*- + +title calprt -- decode a .call's arguments + +.insrt rms;macros + +ch==,,-1 +chjob==1 +chtyo==2 + +tmploc 42,tsint + +define kilprt string ;commit suicide, typing . + .value [asciz — :string +:kill Ý +termin + +define prt string + movei g,[asciz ïstringÝ + call ascprt +termin + +start: move p,[-lpdl,,pdl-1] + .break 12,[..rljb,,jobidx] + move a,jobidx + syscal open,[[.uao,,chtyo] ? ['tty,,]] + .lose %lsfil + syscal open,[%clbit,,.uii+10 ? %climm,,chjob ;Don't reown! + ['usr,,] ? %climm,,400000(a) ? %climm,,0] + kilprt [Can't access current job?] + .suset [.smask,,[%pimpv]] + syscal usrvar,[%climm,,%jself ? %climm,,.roptio ? 0 ? [tlo %opopc]] + .lose %lssys + movsi a,-20 +rdacs: call read ;set up to do effective address calculations. + .value ;job has no acs??? + movem d,ac(a) + aobjn a,rdacs + .value [asciz * 4/ 1q  +:vp *] ;get the .call insn in a. + movem d,insn + call ea + hrrzm d,blkadr ;calculate address of the argument block. + hrrz a,d + call read + jrst mpvdie + came d,[setz] + kilprt [Invalid .CALL block: 1st word not SETZ?? ] + setzm incnt + setzm outcnt + movei a,1(a) ;skip the call name. Assume DDT already mentioned that. +rdarg: call rednxt ;read the next argument. + kilprt [.CALL block fell through into NXM?? ] + ldb b,[330300,,d] ;get argument type (0 = input, 1 = immediate, etc.) + save a + save d + call @argtyp(b) ;handle this type of arg. + rest d + rest a + jumpge d,rdarg ;print more args if there are any. + kilprt [] + +argtyp: inarg + immarg + outarg + errarg + cwarg + cbarg + badarg + badarg + +;here to handle an input argument. +inarg: call inarg1 +inarg2: call argea + call sprint + prt [/ ] + move a,d + call read ;get contents of the location. + jrst [ prt [?? ] ;print ?? if MPV, + jrst argend] +argprt: .value [asciz * 4/ 1j s;   ha;r  '  +CALPRTj :vp *] +argend: prt [ +] + ret + +inarg1: prt [Arg #] + aos g,incnt + call decprt + prt [: ] + ret + +;here to handle an immediate argument. +immarg: call inarg1 + call argea +argimm: .value [asciz * 4/ 1j s;   ha;r  +CALPRTj :vp *] + jrst argend + +;here to handle an output arg +outarg: prt [Value #] + aos g,outcnt + call decprt + prt [: ] + jrst inarg2 + +;here to handle an error code return arg. +errarg: prt [Error return: ] + jrst inarg2 + +;here to handle a word of control bits: +cwarg: prt [Control Bits: ] + jrst inarg2 + +;here to handle immediate control bits: +cbarg: prt [Control Bits: ] + call argea + jrst argimm + +;here to handle an argument of type 6 or 7 (meaningless). +badarg: prt [Bad argument type: ] + jrst inarg2 + +;print the address in d. If it is indexed or indirect, print -> . +argea: and d,[37,,-1] + tlnn d,-1 + ret + tlo d,(move) ;make ddt print the stuff as @addr(idx) instead of lh,,rh + call sprint + prt [ -> ] + call ea + andi d,-1 + ret + +;print the number in g in decimal, clobbering h. +decprt: idivi g,10. + hrlm h,(p) + skipe g + call decprt + hlrz h,(p) + addi h,"0 + .iot chtyo,h + ret + +;print the asciz string that g contains the address of. +ascprt: hrli g,440700 +ascpr1: ildb h,g + jumpe h,cpopj + .iot chtyo,h + jrst ascpr1 + +;come here after getting an irrecoverable MPV (one which means that the +;whole call-block is garbage). +mpvdie: kilprt [?? ] + +;print symbolically, using the decoded job's symbol table, the value in D. +sprint: .value [asciz * 4/ 1j s ;  +CALPRTj :vp *] + ret + +;Perform effective address calculation on instruction in D. +;The index and indirect fields are zeroed, and the rh gets the effective address. +ea: save a + save b + save c + movei c,20. +ea1: ldb a,[220400,,d] + skipe b,a ;get contents of index register, or 0 if unindexed. + hrrz b,ac(a) + add b,d + hrr d,b ;add that into rh of word, not changing lh. + tlz d,17 + tlnn d,(@) + jrst eax ;not indirect => all done. + soje c,eax ;trap infinite loops; don't indirect more than 20 times. + hrrz a,d + move b,d + call read ;indirect => read word indirected through. + jrst [ move d,b + jrst eax] + dpb d,[002700,,b] ;take rh, index and @ from it, + move d,b ;but keep the opcode and ac from the original arg. + jrst ea1 + +eax: rest c + rest b + rest a + ret + + +;Get in D the contents of the decoded job's word with address in A. +;Skip if successful (memory exists at that address). +rednxt: movei a,1(a) ;REDNXT to increment a and then read. +read: save a + andi a,-1 + .access chjob,a + rest a +mpvex: .iot chjob,d + aos (p) ;mpv here makes the iot skip, so read doesn't skip. +cpopj: ret + +tsint: 0 + 0 + movem a,tsinta + hrrz a,tsint+1 + caie a,mpvex ;if we got an MPV from the .IOT in read, + .value + aos tsint+1 ;make the .IOT skip. + move a,tsinta + .dismis tsint+1 + +tsinta: 0 ;a saved during tsint. + +jobidx: 0 ;job number of decoded job. +insadr: 0 ;address of the .call insn being decoded. +insn: 0 ;the .call itself. +blkadr: 0 ;the effective address of the .call. +incnt: 0 ;number of input args seen +outcnt: 0 ;number of value return args seen + +ac: block 20 ;the acs of the job being decoded, for address calculations. + +lpdl==20 +pdl: block lpdl+10 + +end start