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.