Trailing-Edge
-
PDP-10 Archives
-
tops10and20_integ_tools_v9_3-aug-86
-
70,6067/cobol1/cbl102.txt
There is 1 other file named cbl102.txt in the archive. Click here to see a list.
Conversion TOPS10/20 COBOL-74 to VAX-11 COBOL Page 1
----------------------------------
TOPS10/20 COBOL-74 to VAX-11 COBOL
----------------------------------
These notes can be usefull and helpfull tools with other
conversions to VAX-11 COBOL.
The remarks were sampled from the following projects:
= Conversion from TOPS20 COBOL-74 to VAX-11 COBOL, done by
Jude Braden, Dublin-office. (EASINET MAIL-address:
DUB01::BRADEN)
= Conversion from TOPS10 COBOL-74 to VAX-11 COBOL, done by
Jan Postmus, Utrecht-office. (EASINET MAIL-address:
UTR01::POSTMUS)
Please contact one of the above mentioned persons, concerning
remarks on projects like these.
1.0 GENERAL REMARKS
1.1 File Specifications
= The periode between file-name and file-ext in file-spec, has
to be specified in VAX COBOL (was omitted in TOPS10 COBOL).
The specification 'VALUE "COB DAT"' has to be changed into
'VALUE "COB.DAT"'.
= The file-specification passed to VAX/VMS on runtime, is a
combination of 'ASSIGN file-spec' ('SELECT' statement) and
'VALUE OF ID file-spec' ('FD' specification). A file-spec
field given with 'VALUE OF ID' clause overrides the
corresponding field in the 'ASSIGN' clause.
For more information, see Chapter "I/O Processing" in "VAX-11
COBOL User's Guide".
1.2 Clearing Of Records
Record clearing, prior to reading, or after writing, is not
handled by VAX COBOL the way it is done by TOPS COBOL. One of
the best is, use the 'INITIALIZE' statement, if necessary
together with 'MOVE' instruction(s).
See also remarks on 'INITIALIZE', 'READ' and 'WRITE'.
Conversion TOPS10/20 COBOL-74 to VAX-11 COBOL Page 2
1.3 Quotes
All single quotes ( ' ) should be changed to double quotes ( " ).
1.4 Spaces With '=' And ','
VAX-11 COBOL likes to see spaces around '=' and after ','.
2.0 IDENTIFICATION DIVISION
2.1 IDENTIFICATION DIVISION
VAX-11 COBOL wants the name 'IDENTIFICATION DIVISION' full, not
short 'ID DIVISION'.
3.0 ENVIRONMENT DIVISION
3.1 SOURCE-COMPUTER
Of course this has to be changed to 'VAX-11'.
3.2 OBJECT-COMPUTER
= Of course this has also to be changed to 'VAX-11'.
= 'MEMORY' clause is for documentation only on VAX, in TOPS
COBOL it is presently ignored.
3.3 SPECIAL-NAMES
= Special attention should be taken with the SPECIAL-NAMES
SECTION.
= Change 'CHANNEL (1)' into 'C01' for use of skip output to
top-of-form.
Conversion TOPS10/20 COBOL-74 to VAX-11 COBOL Page 3
3.4 SELECT
= The SELECT statement may have to be changed for VAX.
= To be able to use logical names with 'ASSIGN' and 'VALUE OF
ID' the same as implemented on TOPS, put the logical name in
quotes and use a colon, p.g. change:
'ASSIGN TO DISK01' into 'ASSIGN TO "DISK01:"'
See also the remarks about File Specifications.
= The 'RECORDING MODE' in the file description has been
discontinued, it cannot be used on VAX.
4.0 DATA DIVISION
4.1 FD
= 'BLOCK CONTAINS 0 RECORDS', used on TOPS10 to indicate
unblocked mode, cannot be used on VAX, this statement can be
deleted.
= VAX COBOL likes to see a 'RECORD CONTAINS' clause, when
'BLOCK CONTAINS' is used.
= 'VALUE OF IDENTIFICATION' should be changed to 'VALUE OF ID'.
= With respect to 'VALUE OF ID', see also the remarks about
File Specifications.
= The 'RECORDING MODE' in the file description has been
discontinued, it cannot be used on VAX.
= 'USER-NUMBER' to specify [PPN] is unknown on VAX, it has to
be deleted. Take care about directory-specification through
file-spec or logical name with 'ASSIGN' or 'VALUE OF ID' (see
remarks about File Specifications).
4.2 LINE-COUNTER/PAGE-COUNTER
'LINE-COUNTER' and 'PAGE-COUNTER' are reserved names in VAX-11
COBOL, change these names if present in code.
Conversion TOPS10/20 COBOL-74 to VAX-11 COBOL Page 4
4.3 OCCURS
= You may need to check the use of 'REDEFINES' with 'OCCURS'.
= VAX does not allow the use of 'OCCURS' with a level-number 01
or 77, TOPS10/20 COBOL-74 does allow this.
= When specifying key and index in the 'OCCURS' clause, the VAX
wants it in the order: key first, then index, like:
ASCENDING KEY IS ......
INDEXED BY ......
4.4 REDEFINES
= Make sure that the REDEFINES item is not bigger than the item
E SPEC BLOCK
MOVE P1,T1 ;WANT ADDRESS IN P1 ON G.P.S
MOVSI T1,'TTY' ;DEFAULT OUTPUT DEVICE
SETO T2, ;NON-WILD MASK
DMOVEM T1,.FXDEV(P1) ;SET DEFAULT DEVICE
XMOVEI T1,[ASCIZ\TTY\] ;DEFAULT OUTPUT DEVICE
MOVEM T1,.FSDEV(P1) ;SET DEFAULT DEVICE
;FLESH OUT THE OUTPUT FILE SPEC
DIRD52: MOVE T1,P1 ;POSITION ADDRESS OF FILE SPEC BLOCK
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNAM(P1) ;OUTPUT FILE NAME GIVEN?
JRST DIRD57 ;YES
MOVE T1,['FILES '] ;DEFAULT LISTING FILE NAME
SETO T2, ;NON-WILD MASK
DMOVEM T1,.FXNAM(P1) ;SET OUTPUT LIST FILE
DIRD57: SKIPE .FXEXT(P1) ;OUTPUT EXTENSION GIVEN?
JRST DIRD58 ;YES
MOVSI T1,'DIR' ;DEFAULT LISTING EXTENSION
HLLOM T1,.FXEXT(P1) ;SET LISTING FILE
XMOVEI T1,[ASCIZ\DIR\] ;DEFAULT LISTING EXTENSION
MOVEM T1,.FSEXT(P1) ;SET LISTING FILE
DIRD58: MOVX T1,FX.PRT ;THE /OKPROT BIT
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, FORCE /ERPROT FOR OUTPUT FILE
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
IORM T1,.FXMOM(P1) ;AND MAKE IT STICKY
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRN ;/QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T1,.FXCTM(P1) ;ENSURE NOONE UNDEFAULTS US
MOVEI T1,1 ;/SCERROR:NEVER
DPB T1,[POINTR .FXCTL(P1),FX.SCE] ;KROCK
;ALL DONE HERE
JRST .POPJ1## ;DEFAULTS DEFAULTED
SUBTTL DIRECTORY command - main file listing loop
;LOOP FINDING AND REPORTING THE FILE(S)
DIRL: MOVEI T1,CDBLI## ;ADDRESS OF INPUT I/O CDB
MOVEI T2,DIRIV ;ADDRESS OF CDB INIT VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDI## ;CAN'T
MOVE T3,SIFIR## ;FIRST INPUT FILE SPEC BLOCK ADDRESS
MOVEM T3,.IOFSB(T1) ;SET FIRST ADDRESS IN CDB
MOVE T3,SILAS## ;LAST INPUT FILE SPEC BLOCK ADDRESS
MOVEM T3,.IOFSL(T1) ;SET LAST ADDRESS IN CDB
SKIPN SOFIR## ;GOT A LISTING FILE?
JRST DIRL09 ;NO
MOVEI T1,CDBLO## ;ADDRESS OF LISTING I/O CDB
MOVEI T2,DIROV ;ADDRESS OF CDB INIT VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDO## ;CAN'T?
MOVE T3,SOFIR## ;ADDRESS OF FIRST OUTPUT FILE SPEC BLOCK
MOVEM T3,.IOFSB(T1) ;SET IN CDB
MOVEM T3,.IOFSL(T1) ;ALSO LAST ADDRESS
MOVEI T2,CDBLI## ;KROCK ADDRESS OF SOMETHING
PUSHJ P,.IOPOU## ;OPEN OUTPUT LISTING FILE
ERROR EOD,<Error OPENing directory listing file>
DIRL09: XMOVEI T1,DIRLTC ;ASSUME NO OUTPUT FILE
SKIPE SOFIR## ;DID WE GUESS RIGHT?
XMOVEI T1,DIRLTO ;NO, ADDRESS OF OUR "TYPER"
PUSHJ P,.XTYPO## ;REDIRECT TYPEOUT TO LISTING FILE
SKIPE DDCMDF## ;DAP MODE?
JRST DIRLD ;YEAH
;LOOP FINDING EACH FILE
DIRL10: PUSHJ P,.NXTFI## ;ASK FOR AN INPUT FILE
JRST DIRLIE ;SEE IF DONE
;LIST THE FILE
PUSHJ P,DIRLP ;PROCESS THIS FILE
JFCL ;HUH?
;NOW CLOSE OFF THIS FILE
MOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
PUSHJ P,.IOCLO## ;CLOSE OFF THE FILE
JFCL ;HUH?
JRST DIRL10 ;BACK FOR MORE FILES
;INPUT FILE ACCESS ERROR (.NXTFI/.IOPIN)
DIRLIE: CAIN M0,$EFIXN ;INPUT EXHAUSTED?
JRST .POPJ1## ;YES, SUCCESSFUL COMPLETION OF COMMAND
PUSHJ P,NERFAE ;HANDLE FILE OPEN ERROR
POPJ P, ;ABORT ON ERROR
JRST DIRL10 ;CONTINUE ON ERROR
;HERE FOR DAP MODE DIRECTORY
DIRLD: MOVEI T1,CDBLI## ;INPUT CDB ADDRESS
XMOVEI T2,DIRLP ;LIST-THE-FILE PROCESSOR
XMOVEI T3,DIRLDE ;ERROR PROCESSOR
PUSHJ P,.IODDI## ;DO A DAP-MODE DIRECTORY LIST
JRST DDCERM ;DAP-MODE COMMAND FAILURE
JRST .POPJ1## ;SUCCESSFUL
DIRLDE: AOS ERRORS## ;NOTE AN ERROR OCCURRED
PJRST ONERCK## ;MAYBE CONTINUE, MAYBE ABORT
;THE LIST-THE-FILE PROCESSOR
DIRLP: MOVEI T1,CDBLI## ;ADDRESS OF INPUT CDB
PUSHJ P,.TOCFN## ;TYPE OUT FILE SPECIFICATION STRING
JFCL ;CAN'T FAIL
PUSHJ P,.TCRLF## ;CAP OFF LISTING
;AND ACCUMULATE TOTALS FOR ANYONE WHO CARES
MOVE T1,CDBLI+.IOLNW ;LENGTH OF FILE
ADDM T1,WORDS## ;ACCUMULATE WORDS
ADDI T1,177 ;ROUND UP AND
LSH T1,-7 ;TRUNCATE TO BLOCKS
ADDM T1,BLOCKS## ;ACCUMULATE BLOCKS
AOS FILES## ;ACCUMULATE FILES
JRST .POPJ1## ;SUCCESSFUL RETURN
;HELPER TO "TYPE" CHARACTERS
DIRLTC: OUTCHR T1 ;THE SIMPLE CASE
POPJ P, ;ALL DONE
DIRLTO: PUSH P,T2 ;SAVE T2
MOVE T2,T1 ;PUT CHARACTER IN T2
MOVEI T1,CDBLO## ;AND THE CDB ADDRESS IN T1
PUSHJ P,@.IOOSR(T1) ;OUTPUT CHARACTER
JFCL ;*** GOTTA DO SOMETHING ABOUT THIS
MOVE T1,T2 ;RESTORE CHARACTER
POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
SUBTTL DIRECTORY command - switch definitions
;"DIRECT" SWITCHS
DEFINE SWTCHS,<
;SP INITFILE,NIPFSB,.SWFIL##,,FS.NFS!FS.VRQ
SN MOAN,S.MOAN,FS.NFS
SN OKERROR,S.OKER,FS.NFS
SP PASSWORD,<POINT <^D65-$ASCMX>,S.PASS>,.SWASQ##,,
SL TOTALS,S.TOTA,TOT,7777,FS.OBV
SP USERID,<POINT <^D65-<3*$ASCMX>>,S.USER>,.SWUID##,,
>
DOSCAN(DIRSW)
SUBTTL DIRECTORY command - SCAN argument blocks
;"DIRECT" TSCAN PARAMETER BLOCK
DIRTS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD DIRSWL,DIRSWN ;IOWD POINTER FOR SWITCH NAMES
XWD DIRSWD,DIRSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,DIRSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD CLRALL,CLRFIL ;CLEAR ALL,,CLEAR FILE
XWD INX,OUX ;ALLOC INPUT AREA,,ALLOC OUTPUT AREA
XWD MEMSTK,APLSTK ;MEMORIZE STICKY,,APPLY STICKY
XWD CLRSTK,0 ;CLEAR STICKY,,FLAGS
Z ;<FUTURE>,,SWITCH VALUE STORAGE RTN
DIRTL==.-DIRTS
;"DIRECT" OSCAN BLOCK
DIROS: EXP FXVRSN ;PROTOCOL VERSION WORD
IOWD DIRSWL,DIRSWN ;IOWD POINTER FOR SWITCH NAMES
XWD DIRSWD,DIRSWM ;DEFAULT TABLE,,PROCESSOR TABLE
XWD 0,DIRSWP ;<FUTURE>,,STORAGE POINTERS
SIXBIT /NIP/ ;HELP
XWD DIROSL,DIROSN ;OPTIONS NAME(S)
DIROL==.-DIROS
DIROSN: SIXBIT \NDIREC\
SIXBIT \NIP\
SIXBIT \NFT\
DIROSL==.-DIROSN
SUBTTL DIRECTORY command - I/O CDB initialization vectors
;"DIRECT" CDB INITIALIZATION VECTORS.
;
;NOTE THAT THE INPUT SIDE DEFERS BUFFER ALLOCATION UNTIL AFTER THE
;OUTPUT SIDE HAS BEEN OPENED AND OUTPUT BUFFERS ALLOCATED. THIS IS
;SO THAT VARIOUS INPUT DEVICES CAN ALLOCATE AND DEALLOCATE BUFFERS
;AND NOT "GROW" MEMORY NEEDLESSLY.
;"DIRECT" INPUT CDB INITIALIZATION VECTOR
DIRIV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
0 ;I/O CONTROL
0 ;I/O ERROR CONTROL
IM.SMD!IM.SBO ;I/O MODE
0 ;(RESERVED)
;"DIRECT" OUTPUT CDB INITIALIZATION VECTOR
DIROV: EXP 10 ;COUNT OF WORDS FOLLOWING
'NS',,102030 ;VERSION WORD
0 ;"EXTRA" SIZE TO ALLOCATE
0 ;DEFAULT BUFFERING
0 ;MAXIMUM BUFFERING
.ICASC ;I/O CONTROL (ASCII MODE)
0 ;I/O ERROR CONTROL
0 ;I/O MODE
0 ;(RESERVED)
SUBTTL MOVE command
MOV: ERROR MVY,<MOVE command not yet implemented>
SUBTTL NETWORK command
;NETWORK COMMAND
;
; NETWORK <INPUT-EXPRESSION>
;
;The NETWORK command is used to list network/DAP-related information
;about the specified network nodes.
NET: PUSHJ P,NETC ;READ IN THE NODE LIST
JRST NET70 ;DIED? CLEAN UP
PUSHJ P,NETD ;HANDLE ANY DEFAULTING
JRST NET70 ;NOT SUPPOSED TO HAPPEN!
PUSHJ P,NETL ;LIST THE NETWORK NODES
JFCL ;HO HUM
NET50: SKIPN SOFIR## ;GOT A REAL LISTING FILE?
JRST NET60 ;NO
MOVEI T1,CDBLO## ;ADDRESS OF OUTPUT/LISTING CDB
PUSHJ P,.IOCLO## ;CLOSE OFF LISTING FILE
ERROR ECN,<Error CLOSEing network listing file>,,,NET57
NET57: MOVEI T1,CDBLO## ;ADDRESS OF OUTPUT CDB
PUSHJ P,.IORLS## ;CLEAN UP THE CDB
JFCL
;DEALLOCATE SCAN BLOCKS
NET60: PUSHJ P,FRESB## ;FREE UP AN FILE SPEC BLOCKS
JRST NET77 ;FAILED???
JRST .POPJ1## ;SUCCESSFUL COMPLETION OF NETWORK COMMAND
;HERE ON ERROR
NET70: PUSHJ P,FRESB## ;PITCH ANY ACCUMULATED FILE SPEC BLOCKS
JFCL ;HO HUM
NET77: POPJ P, ;TAKE ERROR RETURN
SUBTTL NETWORK command - parsing
;HERE TO READ THE NODE LIST
NETC: SETZM SIFIR## ;CLEAR OUT THE OLD DATA BASE
PUSHJ P,.REEAT## ;WANT .TSCAN TO SEE CURRENT CHARACTER!
MOVE T1,[NETTL,,NETTS] ;.TSCAN BLOCK
PUSHJ P,.TSCAN## ;READ A COMMAND LINE
PUSHJ P,CLRFIL ;CLEAR FILE ANSWERS BEFORE SWITCH.INI
MOVE T1,[NETOL,,NETOS] ;.OSCAN BLOCK
PUSHJ P,.OSCAN## ;CHECK SWITCH.INI
JRST .POPJ1## ;RETURN HAPPILY
SUBTTL NETWORK command - defaulting
;HERE TO SUPPLY INPUT AND OUTPUT DEFAULTS
NETD: SKIPN P1,SIFIR## ;ADDRESS OF FIRST INPUT SPEC
ERROR NNN,<No nodes specified for NETWORK command>
;HANDLE INPUT DEFAULTING
NETD10: MOVE T1,P1 ;ADDRESS OF CURRENT INPUT SPEC
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNOD(P1) ;GOT AN EXPLICIT NODE?
JRST NETD20 ;YES, NO FAKERY
SKIPE .FXNAM(P1) ;NO, CAN WE FAKE ONE FROM A FILE NAME?
JRST NETD12 ;YES
SKIPE .FXDEV(P1) ;NO NODE, NO NAME, GIVE A DEVICE?
JRST NETD20 ;YES, TRY IT AND SEE WHAT HAPPENS
ERROR NNS,<No node name specified>
NETD12: DMOVE T1,.FXNAM(P1) ;GET NAME SPEC
DMOVEM T1,.FXNOD(P1) ;AND SET AS NODE SPEC
SETZM .FXNAM(P1) ;CLEAR OUT NAME SPEC
SETZM .FXNAM+1(P1) ;AND THE MASK TOO
MOVE T1,.FSNAM(P1) ;GET NAME STRING
MOVEM T1,.FSNOD(P1) ;AND SET AS NODE STRING
SETZM .FSNAM(P1) ;CLEAR OUT NAME STRING
MOVE T1,.FXFLD(P1) ;GET FIELDS FLAGS
TXZ T1,FX.UNM!FX.SNM;CLEAR NAME-TYPED FLAGS
TXNE T1,FX.WNM ;WAS NAME WILD?
TXO T1,FX.WND ;YES, THEN NODE IS WILD
TXO T1,FX.UND ;THE "USER" TYPED A NODE (NO, REALLY, HE DID!)
MOVEM T1,.FXFLD(P1) ;SET FIELDS FLAGS
NETD20: MOVX T1,FX.PRT ;THE /OKPROT SWITCH BIT
TDNN T1,.FXMOM(P1) ;EXPLICIT /OKPROT/ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, DEFAULT TO /ERPROT
IORM T1,.FXMOM(P1) ;MAKE SURE NOBODY ELSE UNDEFAULTS US!
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRN ;/QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T1,.FXCTM(P1) ;NO, MAKE SURE NOONE ELSE UNDEFAULTS US
ADDI P1,.FXMAX ;STEP TO NEXT SPEC
CAMG P1,SILAS## ;REACHED LAST ONE YET?
JRST NETD10 ;NOPE, LOOP BACK FOR MORE DEFAULTS
;HANDLE OUTPUT DEFAULTING
NETD50: SKIPE P1,SOFIR## ;OUTPUT FILE SPEC BLOCK
JRST NETD52 ;USER TYPED ONE IN, GO FILL IT OUT
JRST .POPJ1## ;*** JUST DO OUTCHRS!
;FLESH OUT THE OUTPUT FILE SPEC
NETD52: MOVE T1,P1 ;POSITION ADDRESS OF FILE SPEC BLOCK
PUSHJ P,DOSDF ;DO ANY GENERAL FILE-SPEC DEFAULTING
SKIPE .FXNAM(P1) ;OUTPUT FILE NAME GIVEN?
JRST NETD57 ;YES
MOVE T1,['NODES '] ;DEFAULT LISTING FILE NAME
SETO T2, ;NON-WILD MASK
DMOVEM T1,.FXNAM(P1) ;SET OUTPUT LIST FILE
NETD57: SKIPE .FXEXT(P1) ;OUTPUT EXTENSION GIVEN?
JRST NETD58 ;YES
MOVSI T1,'NET' ;DEFAULT LISTING EXTENSION
HLLOM T1,.FXEXT(P1) ;SET LISTING FILE
XMOVEI T1,[ASCIZ\NET\] ;DEFAULT LISTING EXTENSION
MOVEM T1,.FSEXT(P1) ;SET LISTING FILE
NETD58: MOVX T1,FX.PRT ;THE /OKPROT BIT
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
ANDCAM T1,.FXMOD(P1) ;NO, FORCE /ERPROT FOR OUTPUT FILE
TDNN T1,.FXMOM(P1) ;DID USER SPECIFY /[NO]ERPROT?
IORM T1,.FXMOM(P1) ;AND MAKE IT STICKY
MOVX T1,FX.QRY ;/QUERY MASK
MOVX T2,FX.QRN ;/QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T2,.FXCTL(P1) ;NO, DEFAULT TO /QUERY:NEVER
TDNN T1,.FXCTM(P1) ;/QUERY OF SOME SORT GIVEN BY USER?
IORM T1,.FXCTM(P1) ;ENSURE NOONE UNDEFAULTS US
MOVEI T1,1 ;/SCERROR:NEVER
DPB T1,[POINTR .FXCTL(P1),FX.SCE] ;KROCK
;ALL DONE HERE
JRST .POPJ1## ;DEFAULTS DEFAULTED
SUBTTL NETWORK command - main file listing loop
;LOOP FINDING AND REPORTING THE NODE(S)
NETL: MOVEI T1,CDBLI## ;ADDRESS OF INPUT I/O CDB
MOVEI T2,NETIV ;ADDRESS OF CDB INIT VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDI## ;CAN'T
MOVE T3,SIFIR## ;FIRST INPUT FILE SPEC BLOCK ADDRESS
MOVEM T3,.IOFSB(T1) ;SET FIRST ADDRESS IN CDB
MOVE T3,SILAS## ;LAST INPUT FILE SPEC BLOCK ADDRESS
MOVEM T3,.IOFSL(T1) ;SET LAST ADDRESS IN CDB
SKIPN SOFIR## ;GOT A LISTING FILE?
JRST NETL09 ;NO
MOVEI T1,CDBLO## ;ADDRESS OF LISTING I/O CDB
MOVEI T2,NETOV ;ADDRESS OF CDB INIT VECTOR
PUSHJ P,.IOINI## ;INITIALIZE THE CDB
JRST ERRCDO## ;CAN'T?
MOVE T3,SOFIR## ;ADDRESS OF FIRST OUTPUT FILE SPEC BLOCK
MOVEM T3,.IOFSB(T1) ;SET IN CDB
MOVEM T3,.IOFSL(T1) ;ALSO LAST ADDRESS
MOVEI T2,CDBLI## ;KROCK ADDRESS OF SOMETHING
PUSHJ P,.IOPOU## ;OPEN OUTPUT LISTING FILE
ERROR EON,<Error OPENing network listing file>
NETL09: XMOVEI T1,DIRLTC ;ASSUME NO OUTPUT FILE
SKIPE SOFIR## ;DID WE GUESS RIGHT?
XMOVEI T1,DIRLTO ;NO, ADDRESS OF OUR "TYPER"
PUSHJ P,.XTYPO## ;REDIRECT TYPEOUT TO LISTING FILE
SETZM NETNOD ;NO NODES SEEN YET
;LOOP FINDING EACH NODE
NETL10: MOVEI IO,CDBLI## ;RUN IN I/O CONTEXT
PUSHJ P,IOPND0## ;OPEN ONLY A NETWORK/DAP LINK (NO FILE LOOKUP)
JRST NETLIE ;SEE IF DONE
;GO TYPE OUT INFO FOR THIS NODE
MOVE T2,.ION6M(IO) ;GET NODE OPENED
CAMN T2,NETNOD ;SAME AS LAST TIME HERE?
JRST NETL10 ;YEAH, PUNT IT
MOVEM T2,NETNOD ;NEW NODE, REMEMBER IT
PUSHJ P,NETLP ;DO LOTS OF TYPING
JFCL ;HUH? NAH, DIDN'T HAPPEN . . .
AOS .CTFLF## ;TELL .LKWLD TO MIND ITS OWN BUSINESS
JRST NETL10 ;GO GET ANOTHER NODE
;HERE ON END, CLEAN UP THE CDB
NETL30: PUSHJ P,NTZAP0## ;BLAST AWAY THE NETWORK LINK
JFCL ;IGNORE NON-EXISTENT ERRORS
PUSHJ P,.TCRLF## ;BLANK LINE FOR NEATNESS
JRST .POPJ1## ;SUCCESSFUL COMPLETION OF COMMAND
;INPUT FILE ACCESS ERROR (.NXTFI/.IOPIN)
NETLIE: CAIN M0,$EFIXN ;INPUT EXHAUSTED?
JRST NETL30 ;YES, SUCCESSFUL COMPLETION OF COMMAND
PUSHJ P,NERFAE ;HANDLE FILE OPEN ERROR
POPJ P, ;ABORT ON ERROR
JRST NETL10 ;CONTINUE ON ERROR
;THE LIST-THE-NODE PROCESSOR
NETLP: PUSHJ P,.TCRLF## ;START WITH AN INTERVENING BLANK LINE
MOVEI T1,[ASCIZ\Node \] ;TEXT
PUSHJ P,.TSTRG## ;TYPE IT
MOVE T1,.ION6M(IO) ;NODE NAME
PUSHJ P,.TSIXN## ;TYPE IT
MOVE T2,.IOCCF(IO) ;CHANNEL CONTROL FLAGS
MOVEI T1,[ASCIZ\ (Unknown)\] ;NETWORK TYPE
TXNE T2,IO.ANF ;ANF-10 NODE?
MOVEI T1,[ASCIZ\ (ANF-10)\] ;YES
TXNE T2,IO.DCN ;DECNET NODE?
MOVEI T1,[ASCIZ\ (DECnet)\] ;YES
PUSHJ P,.TSTRG## ;TYPE IT OUT
MOVEI T1,[ASCIZ\ running \] ;TEXT TO IDENTIFY
PUSHJ P,.TSTRG## ;THE OPERATING SYSTEM
MOVD1 T1,OST ;GET REMOTE OPERATING SYSTEM TYPE
CAILE T1,$DVOMX ;WITHIN LIMITS?
SETZ T1, ;UNKNOWN (NEW) OPERATING SYSTEM TYPE
MOVE T1,NETOST(T1) ;GET ADDRESS OF TEXT STRING
PUSHJ P,.TSTRG## ;IDENTIFY REMOTE OPERATING SYSTEM
MOVD1 T1,FST ;GET REMOTE FILE SYSTEM
CAIE T1,$DVFT1 ;IF TOPS-10
CAIN T1,$DVFT2 ;OR TOPS-20
JRST NETLP2 ;THEN SKIP FILE SYSTEM JUNK
CAIN T1,$DVOS8 ;IF OS-8
JRST NETLP2 ;THEN SKIP FILE SYSTEM JUNK
MOVEI T1,[ASCIZ\ with \] ;PREFIX TEXT
PUSHJ P,.TSTRG## ;FOR THE FILE SYSTEM
MOVD1 T1,FST ;RETRIEVE FST AGAIN
CAILE T1,$DVFMX ;WITHIN KNOWN BOUNDS?
SETZ T1, ;NO, UNKNOWN FILE SYSTEM TYPE
MOVE T1,NETFST(T1) ;GET TEXT STRING TO
PUSHJ P,.TSTRG## ;IDENTIFY THE REMOTE FILE SYSTEM
NETLP2: PUSHJ P,.TCRLF## ;START UP A NEW LINE
;CONTINUED ON NEXT PAGE
;CONTINUED FROM PREVIOUS PAGE
MOVEI T1,[ASCIZ\ DAP version \] ;MORE PREFIX TEXT
PUSHJ P,.TSTRG## ;TO USE UP SCREEN SPACE
MOVD1 T1,DVR ;MAJOR VERSION
PUSHJ P,.TDECW## ;TYPE OUT AS DECIMAL
PUSHJ P,.TDOT## ;SEPARATE FROM MINOR VERSION
MOVD1 T1,DVE ;WHICH IS SAVED HERE
PUSHJ P,.TDECW## ;TYPE OUT MINOR ("ECO") LEVEL
PUSHJ P,.TDOT## ;SEPARATE FROM MINOR MINOR VERSION
MOVD1 T1,DVU ;WHICH IS YET A DIFFERENT FIELD
PUSHJ P,.TDECW## ;TYPE OUT "USER" (CUSTOMER) VERSION
PUSHJ P,.TDOT## ;SEPARATE WITH ANOTHER DOT
MOVD1 T1,DVS ;DAP "SOFTWARE" VERSION
PUSHJ P,.TDECW## ;TYPE THAT OUT TOO
PUSHJ P,.TDOT## ;THIS IS GETTING KINDA TEDIOUS . . .
MOVD1 T1,DVT ;DAP "USER SOFTWARE" VERSION
PUSHJ P,.TDECW## ;TYPE THAT OUT
MOVEI T1,[ASCIZ\; Maximum message size is \]
PUSHJ P,.TSTRG## ;MORE NOISE
MOVD1 T1,MSZ ;DAP MESSAGE MAXIMA
JUMPE T1,[MOVEI T1,[ASCIZ\unlimited\]
PUSHJ P,.TSTRG## ;TELL HIM
JRST NETLP3] ;CAP IF OFF
PUSHJ P,.TDECW## ;LIST DECIMAL BYTES
MOVEI T1,[ASCIZ\ bytes\]
PUSHJ P,.TSTRG## ;CAP O this subroutine also
performed the call to 'SYS$EXIT'.
In case the message file has to be updated, very likely on the
long run, it is not necessary to update and recompile all
programs, possibly updating and recompiling of the error handling
subroutine is the only necessity.
8.0 RUNTIME ERROR CONDITIONS
Conversion TOPS10/20 COBOL-74 to VAX-11 COBOL Page 12
8.1 'DIVISION BY 0' Error
A 'DIVISION BY 0' error occurred very frequently during the
Dublin project. Incorporated therefore an appropriate 'IF'
statement, which rectified the error.
8.2 'INVALID DECIMAL DATA' Error Condition
'INVALID DECIMAL DATA' error condition occurred very frequently
also. This error was generated because spaces were moved to
numerics and zeroes to alphabetic fields.
Also moving 'LOW-VALUES' to group-items caused this error
condition, during the Utrecht project.
================