c Replace spawn command. Normally fire up a subprocess to do the work c and just ship it commands once it is going. However, if logicals c GCY$SPWN1, GCY$SPWN2, or GCY$SPWN3 are defined as Y respectively for c number 1, 2, or 3 inputs, use lib$spawn instead. This permits c tailoring and drop-in replacement (pretty much) for lib$spawn c Copyright (c) 1994 Glenn C. Everhart c All rights reserved Integer*4 function jtspawn(string,number) integer*4 number character*(*) string integer*4 init(3) integer*4 lib$sys_trnlog,lib$spawn external lib$sys_trnlog,lib$spawn character*256 tln integer*4 ltln save init INTEGER*4 LINLEN LOGICAL*4 OK CHARACTER*132 LIN data init/0,0,0/ c If logicals GCY$SPWNn translate to "Y" then spawn instead of c using a subprocess. jtspawn=2 linlen=len(string) if(init(number).eq.0)then if(number.eq.1)then kk=lib$sys_trnlog('GCY$SPWN1',ltln,tln) kkk=kk.and.1 if(kkk.ne.0.and.(tln(1:1).eq.'Y'.or.tln(1:1).eq.'y')) 1 then kkk=lib$spawn(string(1:linlen),,,,,,istat) jtspawn=istat return endif CALL JRT1_SUB_INIT 1 continue endif if(number.eq.2)then kk=lib$sys_trnlog('GCY$SPWN2',ltln,tln) kkk=kk.and.1 if(kkk.ne.0.and.(tln(1:1).eq.'Y'.or.tln(1:1).eq.'y')) 1 then kkk=lib$spawn(string(1:linlen),,,,,,istat) jtspawn=istat return endif CALL JRT2_SUB_INIT 2 continue endif if(number.eq.3)then kk=lib$sys_trnlog('GCY$SPWN3',ltln,tln) kkk=kk.and.1 if(kkk.ne.0.and.(tln(1:1).eq.'Y'.or.tln(1:1).eq.'y')) 1 then kkk=lib$spawn(string(1:linlen),,,,,,istat) jtspawn=istat return endif CALL JRT3_SUB_INIT 3 continue endif init(number)=1 endif if(number.eq.1)then call JRT1_sub_put(string(:linlen)) call JRT1_sub_put('write sys$output "OK"') ntry=500 10 call JRT1_sub_get(lin,linlen,ok) if(ok)then if(lin(1:linlen).ne.'OK')then if(lin(1:linlen).eq.'NG')then jtspawn=8 return endif goto 10 endif else if(ntry.gt.0)then ntry=ntry-1 xtim=1.0 call lib$wait(xtim) goto 10 endif call JRT1_sub_put('$stop/id=0') call jrt1_sub_init goto 10 endif jtspawn=1 return endif if(number.eq.2)then call JRT2_sub_put(string(:linlen)) call JRT2_sub_put('write sys$output "OK"') ntry=100 20 call JRT2_sub_get(lin,linlen,ok) if(ok)then if(lin(1:linlen).ne.'OK')then if(lin(1:linlen).eq.'NG')then jtspawn=8 return endif goto 20 endif else if(ntry.gt.0)then ntry=ntry-1 xtim=1.0 call lib$wait(xtim) goto 20 endif call JRT2_sub_put('$stop/id=0') call jrt2_sub_init goto 20 endif jtspawn=1 return endif if(number.eq.3)then call JRT3_sub_put(string(:linlen)) call JRT3_sub_put('write sys$output "OK"') ntry=32 30 call JRT3_sub_get(lin,linlen,ok) if(ok)then if(lin(1:linlen).ne.'OK')then if(lin(1:linlen).eq.'NG')then jtspawn=8 return endif goto 30 endif else if(ntry.gt.0)then ntry=ntry-1 xtim=1.0 call lib$wait(xtim) goto 30 endif call JRT3_sub_put('$stop/id=0') call jrt3_sub_init goto 30 endif jtspawn=1 return endif cc on number 4 entry kill the subprocess C300 CALL RT_SUB_PUT('LOGOUT/BRIEF') C400 CALL LIB$WAIT(5.0) C CALL RT_SUB_GET(LIN,LINLEN,OK) C IF(.NOT.(OK.AND.INDEX(LIN(1:LINLEN),'terminated').GT.0)) GOTO 400 END