Google
 

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