Trailing-Edge
-
PDP-10 Archives
-
BB-H506D-SM_1983
-
cobol/source/cobtst.mac
There are 7 other files named cobtst.mac in the archive. Click here to see a list.
; UPD ID= 3402 on 2/19/81 at 9:42 AM by NIXON
TITLE COBTST - TO TEST SWITCH SETTINGS FOR BATCH JOBS
SUBTTL D.M.NIXON
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY ONLY BE USED
; OR COPIED IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE.
;
;COPYRIGHT (C) 1977, 1981 BY DIGITAL EQUIPMENT CORPORATION
SEARCH INTERM
CH=4 ;I/O CHARACTER
W1=6 ;FIRST OUTPUT WORD FROM I/O
W2=7 ;SECOND OUTPUT WORD FROM I/O
TB=15 ;TEMP
TA=16 ;TEMP
DEFINE SWITCH<
XX ONESEG
XX DEBUG
XX DBMS
XX ANS68
XX ANS74
XX BIS
XX FT68274
>
START: RESET
OUTSTR [ASCIZ /*/]
SETZ W1, ;RESULT INDICATOR
MOVE TA,[POINT 6,W1]
MOVEI TB,6
INLUP: INCHWL CH ;GET CHAR
JUMPE CH,INLUP ;IGNORE NULS
CAIN CH,15
JRST INLUP ;AND CARRIAGE-RETURN
CAIG CH,14 ;LOOK FOR END OF LINE
CAIGE CH,12
TRNA
JRST TEST ;GOT IT
CAIL CH,"a" ;CHECK FOR LOWER CASE
CAILE CH,"z"
TRNA ;NO
TRZA CH,100 ;YES, SIXBITIZE
SUBI CH,40 ;SIXBITIZE
SKIPLE TB ;DON'T STORE MORE THAN 6 CHARS
IDPB CH,TA ;STORE
SOJA TB,INLUP ;GET NEXT CHAR
TEST: MOVSI TA,-SWTLEN
CAMN W1,SWTTAB(TA)
JRST FND ;GO MATCH
AOBJN TA,.-2 ;LOOP
OUTSTR [ASCIZ /?FEATURE TEST NOT IN TABLE/]
JRST RET
FND: XCT SWTXCT(TA)
JUMPN W2,FALSE
OUTSTR [ASCIZ /%TRUE/]
JRST RET
FALSE: OUTSTR [ASCIZ /?FALSE/]
RET: EXIT 1,
DEFINE XX (A)< SIXBIT /A/>
SWTTAB: SWITCH
SWTLEN==.-SWTTAB
DEFINE XX (A)<
IFE A,<SETOM W2> ;FALSE
IFN A,<SETZM W2> ;TRUE
>
SWTXCT: SWITCH
END START