X-Git-Url: https://jxself.org/git/?a=blobdiff_plain;ds=sidebyside;f=mim%2Fdevelopment%2Fmim%2Fvax%2Fmimlib%2Fforks.mud;fp=mim%2Fdevelopment%2Fmim%2Fvax%2Fmimlib%2Fforks.mud;h=9690e6d40601c4c095a9f493c8881a507d23c45e;hb=d73ace3f3292e320b461b8fcd2e9f5dc5d9684d7;hp=0000000000000000000000000000000000000000;hpb=d530283ea60fb0ddcc28e9c5bd072456afe06e07;p=pdp10-muddle.git diff --git a/mim/development/mim/vax/mimlib/forks.mud b/mim/development/mim/vax/mimlib/forks.mud new file mode 100644 index 0000000..9690e6d --- /dev/null +++ b/mim/development/mim/vax/mimlib/forks.mud @@ -0,0 +1,631 @@ + + + + + + + + + + GET-INPUT GET-INPUT + GET-OUTPUT GET-INPUT + FORK-STATUS? TEST-FORK-STATUS + READ-BYTE FORK-READ + READ-BUFFER FORK-READ + READ-SAFE-BUFFER FORK-READ + WRITE-BYTE FORK-WRITE + WRITE-BUFFER FORK-WRITE + ;"READ-MEMORY ;FORK-READ-MEMORY + ;WRITE-MEMORY ;FORK-WRITE-MEMORY + ;READ-ACS ;FORK-READ-ACS + ;WRITE-ACS ;FORK-WRITE-ACS" + CONTINUE-FORK CONTINUE-FORK + KILL-FORK KILL-FORK + CLOSE KILL-FORK + PASS-TTY-DOWN PASS-TTY-DOWN + TAKE-TTY-BACK TAKE-TTY-BACK + WAIT-FORK WAIT-FORK + STOP-FORK STOP-FORK + OPEN OPEN-FORK + PRINT-DATA FORK-PRINT-DATA>)> + + + FORK-OUTPUT > + + + + + + + + + + + + + + FIX>> + + FIX>> + FIX>> + FIX>> + + .BIT>>>> + + )> + > LIST> + >) + (>)> + >> + > + > + FIX>>> + FIX>>)> +
> + + FIX>>>)> + > + + .ON>>)>>> + +;" + + + + + + + +" + + + + + + + + + + + + + + + + + + + + + + + + +> +> + +) FROB) + #DECL ((CH) CHANNEL (OPER) ATOM (FORK) FORK) + + >) + (T + >)> + .FROB>> + +) (OUTPUT <>) "TUPLE" ARGS + "AUX" VAL (OINT ) F) + #DECL ((FILE) STRING (INPUT OUTPUT) + (ARGS) (OINT) FIX (VAL) + (F) FORK) + > + > + > + .VAL !,ALL-FORKS)>)> + + >> + )> + + .VAL> + >> + +) (OCH <>) VAL) + #DECL ((FILE) STRING (ARGS) + (ICH OCH) ) + >> + >> + >> + + + .VAL) + (.VAL)>) + (T + + .OCH)>)> + )> + )>>>> + +> + +) (OUTPUT <>) + "TUPLE" ARGS "AUX" RFILE PID (ENV ) + PSTR TEMP ARGP ENVP (IJFN <>) (OJFN <>) (KILLJ1 <>) + (KILLJ2 <>) (WAIT? <>) CF (UV3 ,UV3) + (BROKEN? )) + #DECL ((RFILE FILE) STRING (ARGS) (PID) + (ENV) VECTOR (INPUT OUTPUT) + (KILLJ1 KILLJ2 IJFN OJFN) + (ARGP ENVP UV3) (PSTR) + (WAIT?) (CF) FORK) + > + > + + <1 .UV3 ,SIG-IGNORE> + <2 .UV3 0> + <3 .UV3 0> + + > + > + + ) NS) + + + >>> + > + > + 0 0 0 0>> + > + ,MODE-OFFS ,MODE-SIZE> + ,FMT-IFDIR>>> + >>) + (T + + )>)>)>> + .PSTR> + )>>) + (T + + .RF>)>) + (>> + ) + (>>)> + > + >> + ; "Don't have execute access" + > .RF>)> + ; "Now have file name in standard form, expanded, and it exists" + > + 2> 0>> + 1> 0>> + <1 .ARGP > + + >> + <1 .ARGPTR >>> + .ARGS > + + >>> + .ENV .ENVP> + + > + )> + + PIPE> + :UVECTOR>> + :UVECTOR>>) + (>)>)> + + PIPE> + >> + >>) + (>)>)> + ; "IJFN and OJFN can be closed by the superior; KILLJ1 and KILLJ2, + by the inferior" + > + + >>)> + )> + ; "Don't leave tty broken" + > + > ,MOI> + ; "We're inferior" + ; "Copy i/o translations, kill excess descriptors" + ,STDIN> + )> + ,STDOUT> + )> + )> + )> + ; "Set process group as appropriate" + > + + > + ) + (T + )> + ; "Now go for it" + + ; "This never returns") + ()>) + (T + + PIPE> + ) + ()>)> + + PIPE> + ) + ()>)> + + + 0 + + + .INPUT) + (T <>)>) + (,STDIN)> + + + .OUTPUT) + (T <>)>) + (,STDOUT)>] FORK>> + + .BROKEN?> + )> + .CF)>) + (T + )> + .PID)>> + )>>> + +) + (CH )) + #DECL ((CHANNEL) CHANNEL (FORK) FORK) + + ) + (T + #FALSE ("FORK IS NOT PIPELINED"))>> + +) + (CH )) + #DECL ((CHANNEL) CHANNEL (FORK) FORK) + + ) + (T + #FALSE ("FORK IS NOT PIPELINED"))>> + +; "Returns stopping signal if process is stopped (non-fatally), otherwise <>" +>> + >)>> + +; "Returns exit argument if returned normally" +>> + >)>> + +; "Returns fatal signal" +>>>> + > + '.DAT)>>> + + + +> +> + +) + 0>> + >> + ; "Got status" + >> + ; "Not ready to go yet, will try again later" + )>) + ( + ; "Nobody to handle")>>> + + (CC) CHANNEL (CFORK) FORK) + > + > + > + > ; "Fatal interrupt" + + + + ) + (> + + + + ) + (> ; "Non-fatal interrupt" + + ) + ( + <==? .MISC ,SIG-TTIN>> + ; "Trying to use tty when doesn't have it" + + ; "We think it has it" + > + >> + ) + (T + + + )>) + ( + ; "Not already stopped" + + + )>)>)>> + +) + (OINT )) + #DECL ((CHAN) CHANNEL (FORK) FORK (OINT) FIX) + > + >> + > + ,SIG-STOP>)> + > + + + .CHAN> + +) (OINT )) + #DECL ((CHAN) CHANNEL (FORK) FORK (OINT) FIX) + > + + + ) + (T + )> + + > + )> + + .CHAN> + +) + "AUX" (FORK )) + #DECL ((CHAN) CHANNEL (FORK) FORK (OINT) FIX) + > + + > + +) + "AUX" (FORK ) OINT + (FIXED? <>) + (BROKEN? )) + #DECL ((CHAN) CHANNEL (OINT?) (FORK) FORK (OINT) FIX + (FIXED?) >) + + )> + + > + >) + ()> + + + + )> + + > + > + >>)>)> + + ,SIG-CONT> + + + + > + > + )> + >)> + + .CHAN> + + )> + >>> + +> +> + +) + "AUX" (FORK ) + (CURRENT-FORK )) + #DECL ((CHAN) CHANNEL (OINT?) (FORK) FORK + (CURRENT-FORK) (WAIT-ACT) ) + )> + > + .CHAN) + (<==? > + .CURRENT-FORK> + > + .CHAN) + (.CID + + ) + (<==? <1 .CID> ,EINTR> + + ) + (T + >)>>> + +)) + #DECL ((CHAN) CHANNEL (FORK) FORK) + > + >> + ) + (T + )>> + +) + (OINT ) (AF ,ALL-FORKS) L) + #DECL ((CHAN) CHANNEL (FORK) FORK (OINT) FIX) + > + > + + ,SIG-KILL>)> + .AF>> + CHANNEL> + >)> + CHANNEL> + >)> + + >) + (T + 1>> + >)>)> + + + .CHAN> + +) OTH) + #DECL ((CHANNEL) CHANNEL (OUTCHAN) CHANNEL (FORK) FORK) + + + .OUTCHAN> + + .OUTCHAN> + + + ,ST-BIT-OTHER>> + ,ST-OTH-KILLED> + ) + (<==? .OTH ,ST-OTH-QUIT> + + >> + + .OUTCHAN>)>) + (<==? .OTH ,ST-OTH-DIED> + + .OUTCHAN>)>) + (T + + ) + ( + ) + (T + )> + + )> + + ) + (T + + >> + + .OUTCHAN>)>)>)> + + > CHANNEL> + .OUTCHAN>) + ( + ) + (T + )> + + > CHANNEL> + .OUTCHAN>) + ( + ) + (T + )> + > + + + + + + + + +) + (OTH ,ST-BIT-OTHER>)) + #DECL ((CHAN) CHANNEL (WHICH) FIX (FORK) FORK) + + + <==? .OTH ,ST-OTH-QUIT>> + )>) + (<==? .WHICH ,FORK-STATUS-KILLED> + + <==? .OTH ,ST-OTH-KILLED>> + T)>) + (<==? .WHICH ,FORK-STATUS-DIED> + + <==? .OTH ,ST-OTH-DIED>> + )>) + (<==? .WHICH ,FORK-STATUS-DEAD> + ) + (<==? .WHICH ,FORK-STATUS-RUNNING> + ) + (<==? .WHICH ,FORK-STATUS-STOPPED> + > + )>) + (<==? .WHICH ,FORK-STATUS-WAIT> + )>> + +