Google
 

Trailing-Edge - PDP-10 Archives - BB-H348C-RM_1982 - swskit-v21/demos/cbltst.cbl
There are 2 other files named cbltst.cbl in the archive. Click here to see a list.
IDENTIFICATION DIVISION.
PROGRAM-ID. CBLTST.
AUTHOR. PETER MIERSWA.
INSTALLATION. DIGITAL MARLBORO.
REMARKS.
	This program will perform any of the DECnet-20 interface
	macro calls by command.
DATA DIVISION.
WORKING-STORAGE SECTION.

01 NETLN PIC S9(10) COMP VALUE 0.
01 N-TYPE PIC S9(10) COMP VALUE 0.
01 DESC PIC X(80) DISPLAY-7 VALUE SPACE.
01 WAIT PIC S9(10) COMP VALUE 0.
01 RETCOD PIC S9(10) COMP VALUE 0.
01 EOM PIC S9(10) COMP VALUE 0.
01 N-COUNT PIC S9(10) COMP VALUE 0.
01 DATA-RECORD PIC X(132) DISPLAY-7.
01 N-CODE PIC S9(10) COMP VALUE 0.


01 COMMAND PICTURE X(5).
01 I PIC S9(10) COMP VALUE 0.
PROCEDURE DIVISION.
START.
	DISPLAY " ".
	DISPLAY "DN>" WITH NO ADVANCING.
	ACCEPT COMMAND.
	IF COMMAND EQUALS "NFGND" GO TO DO-NFGND.
	IF COMMAND EQUALS "NFOPN" GO TO DO-NFOPN.
	IF COMMAND EQUALS "NFINF" GO TO DO-NFINF.
	IF COMMAND EQUALS "NFACC" GO TO DO-NFACC.
	IF COMMAND EQUALS "NFREJ" GO TO DO-NFREJ.
	IF COMMAND EQUALS "NFSND" GO TO DO-NFSND.
	IF COMMAND EQUALS "NFRCV" GO TO DO-NFRCV.
	IF COMMAND EQUALS "NFINT" GO TO DO-NFINT.
	IF COMMAND EQUALS "NFRCI" GO TO DO-NFRCI.
	IF COMMAND EQUALS "NFCLS" GO TO DO-NFCLS.
	IF COMMAND EQUALS " " GO TO START.
	DISPLAY "%UNKNOWN COMMAND ",'"',COMMAND,'"'.
	GO TO START.

DO-NFOPN.
	DISPLAY "	Type(0=Passive,1=Active)>" WITH NO ADVANCING.
	ACCEPT N-TYPE.
	DISPLAY "	Network File Specification>" WITH NO ADVANCING.
	ACCEPT DESC.
	DISPLAY "	Byte Size>" WITH NO ADVANCING.
	ACCEPT N-CODE.
	DISPLAY "	Wait(0=no wait,1=wait)>" WITH NO ADVANCING.
	ACCEPT WAIT.
	CALL NFOPN USING NETLN,N-TYPE,DESC,N-CODE,WAIT,RETCOD.
	DISPLAY "	  Return code = ",RETCOD.
	DISPLAY "	  Netln = ",NETLN.
	GO TO START.

DO-NFGND.
	DISPLAY "	Netln>" WITH NO ADVANCING.
	ACCEPT NETLN.
	DISPLAY "	Wait(0=no wait,1=wait)>" WITH NO ADVANCING.
	ACCEPT WAIT.
	CALL NFGND USING NETLN,WAIT,RETCOD.
	DISPLAY "	  Netln = ",NETLN.
	DISPLAY "	  Retcod = ",RETCOD.
	IF RETCOD EQUALS 1 DISPLAY "	  Connect event occured.".
	IF RETCOD EQUALS 2 DISPLAY "	  Abort was received.".
	IF RETCOD EQUALS 3 DISPLAY "	  An interrupt message was received.".
	IF RETCOD EQUALS 4 DISPLAY "	  Data has been received.".
	IF RETCOD EQUALS 5 DISPLAY "	  A disconnect has been received.".
	GO TO START.

DO-NFINF.
	DISPLAY "	 Netln>" WITH NO ADVANCING.
	ACCEPT NETLN.
	DISPLAY "	  (Type/Return code/length/data)".
	PERFORM CALL-NFINF VARYING I FROM 1 BY 1 UNTIL I = 10.
	GO TO START.

CALL-NFINF.
	MOVE SPACES TO DATA-RECORD.
	CALL NFINF USING NETLN,I,N-COUNT,DATA-RECORD,RETCOD.
	IF N-COUNT EQUAL ZERO OR DATA-RECORD EQUAL SPACES
	  DISPLAY "	",I,"/",RETCOD,"/",N-COUNT,"/"
	    ELSE
	  DISPLAY "	  ",I,"/",RETCOD,"/",N-COUNT,"/",DATA-RECORD.

DO-NFACC.
	DISPLAY "	Netln>" WITH NO ADVANCING.
	ACCEPT NETLN.
	DISPLAY "	Count of bytes in optional data(<=16)>" WITH NO ADVANCING.
	ACCEPT N-COUNT.
	IF N-COUNT NOT EQUAL ZERO
	  DISPLAY "	Optional Data>" WITH NO ADVANCING
	  ACCEPT DATA-RECORD.
	CALL NFACC USING NETLN,N-COUNT,DATA-RECORD,RETCOD.
	DISPLAY "	  Retcod = ",RETCOD.
	GO TO START.

DO-NFREJ.
	DISPLAY "	Netln>" WITH NO ADVANCING.
	ACCEPT NETLN.
	DISPLAY "	Abort code>" WITH NO ADVANCING.
	ACCEPT N-CODE.
	DISPLAY "	Count of bytes in optional data>" WITH NO ADVANCING.
	ACCEPT N-COUNT.
	IF N-COUNT NOT EQUAL ZERO
	  DISPLAY "	Optional data>" WITH NO ADVANCING
	  ACCEPT DATA-RECORD.
	CALL NFREJ USING NETLN,N-CODE,N-COUNT,DATA-RECORD,RETCOD.
	DISPLAY "	  Return code = ",RETCOD.
	GO TO START.

DO-NFSND.
	DISPLAY "	Netln>" WITH NO ADVANCING.
	ACCEPT NETLN.
	DISPLAY "	Count of bytes to send>" WITH NO ADVANCING.
	ACCEPT N-COUNT.
	DISPLAY "	Data to send>" WITH NO ADVANCING.
	ACCEPT DATA-RECORD.
	DISPLAY "	Message mode(0=stream,1=message)>" WITH NO ADVANCING.
	ACCEPT EOM.
	CALL NFSND USING NETLN,N-COUNT,DATA-RECORD,EOM,RETCOD.
	DISPLAY "	  Return code = ",RETCOD.
	GO TO START.

DO-NFRCV.
	DISPLAY "	Netln>" WITH NO ADVANCING.
	ACCEPT NETLN.
	DISPLAY "	Count of bytes to receive>" WITH NO ADVANCING.
	ACCEPT N-COUNT.
	DISPLAY "	Message mode(0=stream,1=message)>" WITH NO ADVANCING.
	ACCEPT EOM.
	DISPLAY "	Wait(0=no wait,1=wait)>" WITH NO ADVANCING.
	ACCEPT WAIT.
	MOVE SPACES TO DATA-RECORD.
	CALL NFRCV USING NETLN,N-COUNT,DATA-RECORD,EOM,WAIT,RETCOD.
	DISPLAY "	  Return code = ",RETCOD.
	DISPLAY "	  Count = ",N-COUNT.
	DISPLAY "	  Data = ",DATA-RECORD.
	GO TO START.

DO-NFINT.
	DISPLAY "	Netln>" WITH NO ADVANCING.
	ACCEPT NETLN.
	DISPLAY "	Count of bytes in message(<=16)>" WITH NO ADVANCING.
	ACCEPT N-COUNT.
	DISPLAY "	Data>" WITH NO ADVANCING.
	ACCEPT DATA-RECORD.
	CALL NFINT USING NETLN,N-COUNT,DATA-RECORD,RETCOD.
	DISPLAY "	  Return code = ",RETCOD.
	GO TO START.

DO-NFRCI.
	DISPLAY "	Netln>" WITH NO ADVANCING.
	ACCEPT NETLN.
	MOVE SPACES TO DATA-RECORD.
	CALL NFRCI USING NETLN,N-COUNT,DATA-RECORD,RETCOD.
	DISPLAY "	  Return code = ",RETCOD.
	DISPLAY "	  Data = ",DATA-RECORD.
	GO TO START.

DO-NFCLS.
	DISPLAY "	Netln>" WITH NO ADVANCING.
	ACCEPT NETLN.
	DISPLAY "	Type(0=synchronous disconnect,1=abort)>"
		WITH NO ADVANCING.
	ACCEPT N-TYPE.
	DISPLAY "	Abort code(0,if type=0,>0 if type=1)>"
		WITH NO ADVANCING.
	ACCEPT N-CODE.
	DISPLAY "	Count of bytes in optional data>" WITH NO ADVANCING.
	ACCEPT N-COUNT.
	IF N-COUNT NOT EQUAL ZERO
	  DISPLAY "	Optional data>" WITH NO ADVANCING
	  ACCEPT DATA-RECORD.
	CALL NFCLS USING NETLN,N-TYPE,N-CODE,N-COUNT,DATA-RECORD,RETCOD.
	DISPLAY "	  Return code = ",RETCOD.
	GO TO START.