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