CONSTSTRING (13) VSN="23 OCT 79 1" EXTERNALROUTINESPEC DOUT(RECORDNAME P) EXTERNALSTRINGFNSPEC HTOS(INTEGER I,PL) SYSTEMROUTINESPEC DISCONNECT(STRING (31) FILE,INTEGERNAME FLAG) EXTERNALROUTINESPEC DESTROY(STRING (255) S) EXTERNALINTEGERFNSPEC EXIST(STRING (255) S) EXTERNALSTRINGFNSPEC UINFS(INTEGER I) EXTERNALINTEGERFNSPEC BIN(STRING (255) S) EXTERNALSTRINGFNSPEC DERRS(INTEGER N) ! EXTERNALROUTINESPEC DPON(RECORDNAME P) ! EXTERNALINTEGERFNSPEC DPRG(STRING (6) USER,STRING (15) FILE, C INTEGER FSYS,STRING (6) LABEL,INTEGER SITE) EXTERNALINTEGERFNSPEC DUNPRG(STRING (6) USER,STRING (15) FILE, C INTEGER FSYS,STRING (6) LABEL,INTEGER SITE) ! RECORDFORMAT PARMF(INTEGER DEST,SRCE,P1,P2,P3,P4,P5,P6) ! ROUTINE UDERRS(INTEGER N) PRINTSTRING("FLAG =") PRINTSTRING(DERRS(N)) NEWLINE END ; ! UDERRS ! EXTERNALROUTINE PRG(STRING (255) S) STRING (63) FILE,LABEL,SSITE,USER INTEGER SITE,J UNLESS S->FILE.(",").LABEL.(",").SSITE THEN -> BP USER=UINFS(1) DISCONNECT(FILE,J) IF FILE->USER.(".").FILE START ;FINISH UNLESS LENGTH(LABEL)=6=LENGTH(USER) THEN -> BP SITE=BIN(SSITE) UNLESS SITE=-1 OR (SITE>=0 AND SITE&X'3F'=0) THEN -> BP J=DPRG(USER,FILE,-1,LABEL,SITE) UDERRS(J) RETURN BP: PRINTSTRING("PARAM ?? FORM IS: PRG(FILE,LABEL,SITE) ") END ; ! PRG EXTERNALROUTINE UNPRG(STRING (255) S) STRING (63) FILE,LABEL,SSITE,USER INTEGER SITE,J UNLESS S->FILE.(",").LABEL.(",").SSITE THEN -> BP USER=UINFS(1) UNLESS FILE->USER.(".").FILE START ;FINISH UNLESS LENGTH(LABEL)=6 THEN -> BP SITE=BIN(SSITE) UNLESS SITE=-1 OR (SITE>=0 AND SITE&X'3F'=0) THEN -> BP J=DUNPRG(USER,FILE,-1,LABEL,SITE) UDERRS(J) RETURN BP: PRINTSTRING("PARAM ?? FORM IS: PRG(FILE,LABEL,SITE) ") END ; ! UNPRG EXTERNALROUTINE PRGDIR(STRING (255) S) STRING (63) FILE,LABEL,SSITE,USER INTEGER SITE,J,VSN UNLESS S->FILE.(",").LABEL.(",").SSITE THEN -> BP UNLESS LENGTH(FILE)=3 AND FILE->("00").FILE THEN -> BP UNLESS "0"<=FILE<="9" THEN -> BP UNLESS LENGTH(LABEL)=6 THEN -> BP UNLESS LENGTH(SSITE)=1 THEN -> BP VSN=BIN(SSITE) UNLESS 0<=VSN<=3 THEN -> BP J=DPRG("ERCC10","DIR".FILE."T",-1,LABEL,X'200' + X'40'*VSN) UDERRS(J) RETURN BP: PRINTSTRING("PARAM ?? FORM IS: PRGDIR(00N,LABEL,VSN) ") END ; ! PRGDIR ROUTINE TOINTS(STRING (6) USER,INTEGERNAME L1,L2) INTEGER I1,I2,AI1,AI2,AU,J I1=0; I2=0 AI1=ADDR(I1); AI2=ADDR(I2); AU=ADDR(USER) CYCLE J=0,1,3 BYTEINTEGER(AI1+J)=BYTEINTEGER(AU+J+1) REPEAT CYCLE J=0,1,1 BYTEINTEGER(AI2+J)=BYTEINTEGER(AU+J+5) REPEAT L1=I1; L2=I2 END ; ! TOINTS EXTERNALROUTINE PLOD(STRING (255) S) STRING (31) DISC1,DISC2,SITE1,SITE2,EPAGES,EMS RECORD P(PARMF) INTEGER I1,I2,NP,J UNLESS S->DISC1.(",").SITE1.(",").DISC2.(",").SITE2.(",").C EPAGES AND LENGTH(DISC1)=6=LENGTH(DISC2) START PRINTSTRING("EXAMPLE: PLOD(EMAS00,X200,EMAS00,X240,64) ") RETURN FINISH I1=BIN(SITE1) I2=BIN(SITE2) NP=BIN(EPAGES) EMS="SITE1" UNLESS 0<=I1<=X'FFFF' THEN -> BP EMS="SITE2" UNLESS 0<=I2<=X'FFFF' THEN -> BP EMS="EPAGES" UNLESS 0<=NP<=X'400' THEN -> BP P=0 P_DEST=X'00240000'; ! BULK MOVE P_P1=X'02020000' ! NP TO INTS(DISC1,P_P2,P_P3) P_P3=P_P3 ! I1 TO INTS(DISC2,P_P4,P_P5) P_P5=P_P5 ! I2 P_P6=M'KPRG' DOUT(P) UDERRS(P_P1) RETURN BP: PRINTSTRING(EMS) PRINTSTRING(" PARAM IN ERROR") NEWLINE END ; ! PLOD ENDOFFILE