; 0001 Module GET_PID = ; 0002 begin ; 0003 ; 0004 ! Cracks the command line for a PID, either as a parameter, or in ; 0005 ! the qualifier /ID=pid. If neither is present, then a read with ; 0006 ! prompt is done for the PID. ; 0007 ! ; 0008 ! R.J. FitzPatrick July 1979 ; 0009 ! Smithsonian Astrophysical Observatory, Cambridge MA ; 0010 ! ; 0011 LIBRARY 'SYS$LIBRARY:STARLET.L32'; ; 0012 LIBRARY 'SYS$LIBRARY:CLIMAC.L32'; ; 0013 LIBRARY 'SYS$LIBRARY:TPAMAC.L32'; ; 0014 ; 0015 STRUCTURE ; 0016 BBLOCK [O, P, S, E; N] = ; 0017 [N] ; 0018 (BBLOCK+O); ; 0019 ! ; 0020 ! Macro to declare parameter list for TPARSE action routines. ; 0021 ! ; 0022 MACRO ; M 0023 TPARSE_ARGS (NAME) = ; M 0024 BUILTIN AP; ; M 0025 BIND NAME = AP : REF BBLOCK; ; 0026 %; ; 0027 ; 0028 OWN ; 0029 PID_ADDR : LONG, ; P 0030 GET_CMD : $CLIREQDESC (RQTYPE = GETCMD ; 0031 ), ; 0032 TPARSE_BLOCK : BBLOCK [TPA$K_LENGTH0] ; 0033 INITIAL (TPA$K_COUNT0, 2^24); ; 0034 ; 0035 EXTERNAL ROUTINE ; 0036 LIB$TPARSE, ; 0037 FOR$CNV_IN_Z; ; 0038 ; 0039 FORWARD ROUTINE ; 0040 ASK_PID; ; 0041 ; 0042 GLOBAL ROUTINE GET_PID (CLI_CALLBACK, PID) = ; 0043 BEGIN ; 0044 ; 0045 EXTERNAL ; 0046 TPID_STB : VECTOR [0], ; 0047 TPID_KTB : VECTOR [0]; ; 0048 ; 0049 PID_ADDR = .PID; ; 0050 (.CLI_CALLBACK) (GET_CMD); ; 0051 IF .GET_CMD[CLI$W_RQSIZE] GTR 0 THEN ; 0052 BEGIN ; 0053 TPARSE_BLOCK[TPA$L_STRINGCNT] = .GET_CMD[CLI$W_RQSIZE]; ; 0054 TPARSE_BLOCK[TPA$L_STRINGPTR] = .GET_CMD[CLI$A_RQADDR]; ; 0055 LIB$TPARSE (TPARSE_BLOCK, TPID_STB, TPID_KTB) ; 0056 END ; 0057 ELSE ; 0058 ASK_PID () ; 0059 END; ! end of routine GET_PID .TITLE GET_PID .PSECT $OWN$,NOEXE,2 PID_ADDR: .BLKB 4 GET_CMD:.BYTE 1 ; ; .BYTE 0 ; ; .BYTE 0 ; ; .BYTE 0 ; ; .LONG 0 ; ; .LONG 0, 0 ; ; .LONG 0 ; ; .LONG 0 ; ; .LONG 0 ; ; TPARSE_BLOCK: .LONG 8, 33554432 ; ; .BLKB 28 ; AUTHOR'S NOTE: ; The following line has been edited to remove TPID_STB and TPID_KTB. ; The BLISS compiler requires the EXTERNAL attribute here, but the MACRO assembler forbids it. .EXTRN LIB$TPARSE, FOR$CNV_IN_Z .PSECT $CODE$,NOWRT,2 .ENTRY GET_PID, ^M ;GET_PID, Save R2 ; 0042 MOVAB W^PID_ADDR, R2 ;PID_ADDR, R2 ; MOVL 8(AP), (R2) ;PID, PID_ADDR ; 0049 PUSHAB 4(R2) ;GET_CMD ; 0050 CALLS #1, @4(AP) ;#1, @CLI_CALLBACK ; MOVZWL 12(R2), R0 ;GET_CMD+8, R0 ; 0051 TSTL R0 ;R0 ; BLEQ 1$ ;1$ ; MOVL R0, 40(R2) ;R0, TPARSE_BLOCK+8 ; 0053 MOVL 16(R2), 44(R2) ;GET_CMD+12, TPARSE_BLOCK+12 ; 0054 PUSHAB W^TPID_KTB ;TPID_KTB ; 0055 PUSHAB W^TPID_STB ;TPID_STB ; PUSHAB 32(R2) ;TPARSE_BLOCK ; CALLS #3, W^LIB$TPARSE ;#3, LIB$TPARSE ; RET ; ; 0051 1$: CALLS #0, W^ASK_PID ;#0, ASK_PID ; 0058 RET ; ; 0042 ; Routine Size: 58 bytes ; 0060 ; 0061 ! Store process id found by TPARSE. ; 0062 ; 0063 ROUTINE STO_PID = ; 0064 BEGIN ; 0065 ; 0066 TPARSE_ARGS (CONTEXT); ; 0067 ; 0068 .PID_ADDR = .CONTEXT[TPA$L_NUMBER]; ; 0069 RETURN 1; ; 0070 ; 0071 END; STO_PID:.WORD ^M<> ;Save nothing ; 0063 MOVL 28(AP), @W^PID_ADDR ;28(CONTEXT), @PID_ADDR ; 0068 MOVL #1, R0 ;#1, R0 ; 0069 RET ; ; 0063 ; Routine Size: 12 bytes ; 0072 ; 0073 ROUTINE ASK_PID = ; 0074 BEGIN ; 0075 ! ; 0076 ! Macro to generate a string and descriptor. ; 0077 ! ; 0078 ; 0079 MACRO ; M 0080 DESCRIPTOR (STRING) = ; 0081 UPLIT (%CHARCOUNT (STRING), UPLIT BYTE (STRING))%; ; 0082 ; 0083 OWN ; P 0084 INFAB: $FAB( ; P 0085 FAC = (GET,PUT), ; P 0086 RAT=CR, ; P 0087 FNA=UPLIT BYTE('SYS$INPUT'), ; P 0088 FNS=%CHARCOUNT('SYS$INPUT') ; 0089 ), ; P 0090 INRAB: $RAB( ; P 0091 RAC=SEQ, ; P 0092 ROP=(PMT,CVT), ; P 0093 FAB=INFAB ; 0094 ), ; 0095 LINEBUF : VECTOR[3], ; 0096 LINE_DESC : VECTOR[2] ; 0097 INITIAL ( 0, LINEBUF ); ; 0098 ; 0099 LITERAL ; 0100 LINELEN = 12; ; 0101 ; 0102 BIND ; 0103 PROMPT_STR = UPLIT BYTE (%ASCIC'$_Who ' ); ; 0104 ; 0105 $OPEN( FAB=INFAB ) ; ; 0106 $CONNECT( RAB=INRAB ) ; ; 0107 ; 0108 DO ; 0109 BEGIN ; 0110 INRAB[RAB$L_PBF] = PROMPT_STR + 1 ; ; 0111 INRAB[RAB$B_PSZ] = (.PROMPT_STR)<0,8> ; ; 0112 INRAB[RAB$L_UBF] = LINEBUF; ; 0113 INRAB[RAB$W_USZ] = LINELEN; ; 0114 IF $GET( RAB=INRAB ) EQL RMS$_EOF THEN $EXIT(); ; 0115 LINE_DESC[0] = .INRAB[RAB$W_RSZ]; ; 0116 END ; 0117 UNTIL ; 0118 .LINE_DESC[0] NEQ 0; ; 0119 ; 0120 FOR$CNV_IN_Z (LINE_DESC, .PID_ADDR) ; 0121 END; .PSECT $PLIT$,NOWRT,NOEXE,2 P.AAA: .ASCII \SYS$INPUT\ ; ; P.AAB: .ASCII <6>\$_Who\<9> ; ; .PSECT $OWN$,NOEXE,2 INFAB: .BYTE 3 ; ; .BYTE 80 ; ; .WORD 0 ; ; .LONG 0 ; ; .LONG 0 ; ; .LONG 0 ; ; .LONG 0 ; ; .WORD 0 ; ; .BYTE 3 ; ; .BYTE 0 ; ; .LONG 0 ; ; .BYTE 0 ; ; .BYTE 0 ; ; .BYTE 2 ; ; .BYTE 2 ; ; .LONG 0 ; ; .LONG 0 ; ; .LONG 0 ; ; .ADDRESS P.AAA ; ; .LONG 0 ; ; .BYTE 9 ; ; .BYTE 0 ; ; .WORD 0 ; ; .LONG 0 ; ; .WORD 0 ; ; .BYTE 0 ; ; .BYTE 0 ; ; .LONG 0 ; ; .LONG 0 ; ; .LONG 0[2] ; ; INRAB: .BYTE 1 ; ; .BYTE 68 ; ; .WORD 0 ; ; .LONG 1140850688 ; ; .LONG 0 ; ; .LONG 0 ; ; .WORD 0[3] ; ; .WORD 0 ; ; .LONG 0 ; ; .WORD 0 ; ; .BYTE 0 ; ; .BYTE 0 ; ; .WORD 0 ; ; .WORD 0 ; ; .LONG 0 ; ; .LONG 0 ; ; .LONG 0 ; ; .LONG 0 ; ; .BYTE 0 ; ; .BYTE 0 ; ; .BYTE 0 ; ; .BYTE 0 ; ; .LONG 0 ; ; .ADDRESS INFAB ; ; .LONG 0 ; ; LINEBUF:.BLKB 12 LINE_DESC: .LONG 0 ; ; .ADDRESS LINEBUF ; ; PROMPT_STR= P.AAB .EXTRN SYS$OPEN, SYS$CONNECT, SYS$GET, SYS$EXIT .PSECT $CODE$,NOWRT,2 ASK_PID:.WORD ^M ;Save R2 ; 0073 MOVAB W^INRAB, R2 ;INRAB, R2 ; PUSHAB -80(R2) ;INFAB ; 0105 CALLS #1, @#SYS$OPEN ;#1, @#SYS$OPEN ; PUSHL R2 ;R2 ; 0106 CALLS #1, @#SYS$CONNECT ;#1, @#SYS$CONNECT ; 1$: MOVAB W^PROMPT_STR+1, 48(R2) ;PROMPT_STR+1, INRAB+48 ; 0110 MOVB W^PROMPT_STR, 52(R2) ;PROMPT_STR, INRAB+52 ; 0111 MOVAB 68(R2), 36(R2) ;LINEBUF, INRAB+36 ; 0112 MOVW #12, 32(R2) ;#12, INRAB+32 ; 0113 PUSHL R2 ;R2 ; 0114 CALLS #1, @#SYS$GET ;#1, @#SYS$GET ; CMPL R0, #98938 ;R0, #98938 ; BNEQ 2$ ;2$ ; PUSHL #1 ;#1 ; CALLS #1, @#SYS$EXIT ;#1, @#SYS$EXIT ; 2$: MOVZWL 34(R2), 80(R2) ;INRAB+34, LINE_DESC ; 0115 BEQL 1$ ;1$ ; 0118 PUSHL -148(R2) ;PID_ADDR ; 0120 PUSHAB 80(R2) ;LINE_DESC ; CALLS #2, W^FOR$CNV_IN_Z ;#2, FOR$CNV_IN_Z ; RET ; ; 0073 ; Routine Size: 94 bytes ; 0122 ; 0123 $INIT_STATE (TPID_STB, TPID_KTB); ; 0124 ; P 0125 $STATE (, ; P 0126 ('/'), ; P 0127 (TPA$_LAMBDA,PARAM) ; 0128 ); ; P 0129 $STATE (, ; P 0130 ('IDENTIFICATION') ; 0131 ); ; P 0132 $STATE (, ; P 0133 ('=') ; 0134 ); ; P 0135 $STATE (PARAM, ; P 0136 (TPA$_HEX,,STO_PID) ; 0137 ); ; P 0138 $STATE (, ; P 0139 (TPA$_EOS, TPA$_EXIT) ; 0140 ); ; 0141 END ; 0142 ELUDOM .PSECT LIB$KEY1$,NOWRT,NOEXE, SHR,0 ;TPA$KEYST0 U.6: .BLKB 0 U.8: .ASCII \IDENTIFICATION\ ; ; .BYTE -1 ; ; U.10: .BYTE -1 ; ; .PSECT LIB$STATE$,NOWRT,NOEXE, SHR,0 TPID_STB:: .BLKB 0 U.2: .WORD 47 ; ; U.3: .WORD 5622 ; ; U.5: .WORD <-2> ; ; U.9: .WORD 1280 ; ; U.11: .WORD 1085 ; ; ;PARAM U.4: .BLKB 0 U.12: .WORD -31243 ; ; U.13: .LONG <-4> ; ; U.14: .WORD 5623 ; ; U.15: .WORD -1 ; ; .PSECT LIB$KEY0$,NOWRT,NOEXE, SHR,1 TPID_KTB:: .BLKB 0 ;TPA$KEY0 U.1: .BLKB 0 U.7: .WORD ; ; ; PSECT SUMMARY ; ; Name Bytes Attributes ; ; $OWN$ 236 WRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $CODE$ 164 NOWRT, RD , EXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; $PLIT$ 16 NOWRT, RD ,NOEXE,NOSHR, LCL, REL, CON,NOPIC,ALIGN(2) ; LIB$KEY0$ 2 NOWRT, RD ,NOEXE, SHR, LCL, REL, CON,NOPIC,ALIGN(1) ; LIB$STATE$ 20 NOWRT, RD ,NOEXE, SHR, LCL, REL, CON,NOPIC,ALIGN(0) ; LIB$KEY1$ 16 NOWRT, RD ,NOEXE, SHR, LCL, REL, CON,NOPIC,ALIGN(0) ; LIBRARY STATISTICS ; ; -------- Symbols -------- Blocks ; File Total Loaded Percent Read ; ; DBA0:[SYSLIB]STARLET.L32;2 2688 41 1 146 ; DBA0:[SYSLIB]CLIMAC.L32;1 14 2 14 5 ; DBA0:[SYSLIB]TPAMAC.L32;1 39 23 58 20 ; Compilation Complete .END