;<* ZCL XX-V01.03  30-July-1985  *>   analyZe Character Length utility library
	.TITLE	ZCL
	.IDENT /V01.03/
	.ENABLE	LC		; allow low case characters in messages
		; 
VERZNO::	.ASCIZ/ V01.03/	; change version number here too
		; 
;+
; 		Allen Jay Bennett
;
; 		written :	July 26, 1985
;		revised :	July 29, 1985   AJB V01.01 uses SWSTK$
;		revised :	July 30, 1985   AJB V01.02 load /64. in KDSAR6
;		revised :	July 30, 1985   AJB V01.03 (has /AD & /OF)
;-
		; 
; 
	.MCALL	FSRSZ$
	.MCALL	FINIT$
	.MCALL	GCMLB$,GCML$
	.MCALL	CSI$,CSI$1,CSI$2,CSI$SW,CSI$SV,CSI$ND
	.MCALL	ALUN$S
	.MCALL	EXIT$S
;
	FSRSZ$	3		; room for 3 I/O buffers (1 for GCML$)
; 
	CSI$	DEF$G		; globally define command-string-intrpr equates
;;;	GCMLD$	DEF$G		; globally define get-command-line equates
; 
	.EVEN
CSIBLK::
	.BLKB	C.SIZE		; command string interpreter control block
; 
	; 			; generate get-command-line block
CMDBLK:	GCMLB$	,ZCL,,1		; use LUN #1 with prompt "ZCL>"
	; 
; 
;;;	ALUN$S	#1,#"TI,#0	; assign LUN #1 as TI0:
;
;
SWITCH::	.WORD	0		; bit-storage for switch settings
;
	SW.BD == 1			; decimal block num. given
	SW.HE == 2			; mask for help-request switch
	SW.ID == 4			; mask for show-Id.(version #)
	SW.IS == 10			; mask for IS request switch
	SW.AD == 20			; mask for address change switch
	SW.OF == 40			; mask for offset change switch
;;;	SW.zz == 100			; *future*
;
ISWTAB:
	CSI$SW	BD, SW.BD, SWITCH, SET, NEG, BDVDAT
	CSI$SW	HE, SW.HE, SWITCH, SET,,
	CSI$SW	ID, SW.ID, SWITCH, SET,,
	CSI$SW	IS, SW.IS, SWITCH, SET,,
	CSI$SW	AD, SW.AD, SWITCH, SET, NEG, ADVDAT
	CSI$SW	OF, SW.OF, SWITCH, SET, NEG, OFVDAT
	CSI$ND
;
BDVDAT:
	CSI$SV	ASCII, BDVAL, 10.
	CSI$ND
ADVDAT:
	CSI$SV	OCTAL, ADVAL, 2
	CSI$ND
OFVDAT:
	CSI$SV	OCTAL, OFVAL, 2
	CSI$ND
BLKVAL::
	.BLKB	2+2			; block value from command line
OFVAL:	.BLKB	2+2			; offset value from command line
ADVAL:	.BLKB	2+2			; address value from command line
BDVAL:	.BLKB	10.+2			; decimal value from command line
;
ZTTPAR::
	.WORD	001434		; The address /64. of the TTDRV partition 
ZCHROF::
	.WORD	012314		; The offset into TTYHV  (use .LST & .MAP)
				;  ... where the char.len. literal is stored
				;  ... in the routine SETLIN at 70$: BIS #,R2
;
; 
ARGBLK::	.BLKB	2+2+2+10.+4	; argument block
MESBUF::	.BLKB	144.		; message buffer
SAVCOD::	.BLKW	23		; storage for copy of the TTDRV code
;
	.NLIST	BEX
MES1:		.ASCIZ	<2>/ ?ZCL -- Command Syntax Error/
MES2SW:		.ASCIZ	<2>/ ?ZCL -- Switch Syntax Error/
MESDCT:		.ASCIZ	<2>/ ?ZCL -- decimal convert failed/
MES2OK:
M$FOOT::	.ASCIZ	/ /
MES2HE:	.ASCIZ	<2>/   BD HE ID IS AD OF/
M$CHRL:		.ASCIZ	<2>\ !ZCL -- analyZe Character Length is %D\
M$HOST:		.ASCIZ	<2>\ !ZCL -- running on PDP-11/%D\
M$ADDR:		.ASCIZ	<2>\ !ZCL -- base address changed to %P00\
M$OFFS:		.ASCIZ	<2>\ !ZCL -- offset value changed to %P\
M$DUMP::	.ASCIZ	/ %P/
	.LIST	BEX
	.EVEN
; 
DONE:
	EXIT$S				; quit
; 
ZCL::		NOP			; ZCL routine
;
 	FINIT$		; FORTRAN does it
	ALUN$S	#1,#"TI,#0	; assign LUN #1 as TI0:
RETRY:
	CLR	SWITCH			; initialize switches
;;;	MOV	#"SY,DEV+0		; initialize default device
;;;	MOV	#"0:,DEV+2		;   as SY0:
; 
	GCML$	#CMDBLK			; get command line
	BCS	DONE			; if <EOF> then quit
	TST	CMDBLK+G.CMLD		; check char.count
	BEQ	RETRY			; if zero then retry
; 
	CSI$1	#CSIBLK,CMDBLK+G.CMLD+2,CMDBLK+G.CMLD   ; parse command line
	BCC	10$			; if syntax OK -- next step
	MOV	#MES1,R1		; illegal syntax message
	CALL	EDMQIO			; display
	BR	RETRY			; try again
10$:
	CSI$2	#CSIBLK,OUTPUT,#ISWTAB	; parse for first output filespec.
	BCC	11$			; if syntax OK -- next step
	;
	MOV	#MES2SW,R1		; illegal switch message
	CALL	EDMQIO			; display
	JMP	RETRY			; try again
11$:
12$:
	CSI$2	#CSIBLK,INPUT,#ISWTAB	; check for switch on input-spec.
	BCC	13$			; if legal switch, skip
	MOV	#MES2SW,R1		; illegal switch message
	CALL	EDMQIO			; display
	JMP	RETRY			; try again
13$:
	BIT	#SW.ID,SWITCH		; test if ID. request
	BEQ	14$			; no, skip ID. output
	;
	MOV	#VERZNO,R1		; ID. message
;;;	MOV	#MES2ID,R1		; ID. message
	CALL	EDMQIO			; display
	;
	CALL	IDHOST			; go do ID. of HOST triage
	MOV	R0,ARGBLK		; show HOST PDP number
	MOV	#M$HOST,R1		; ID. of HOST message
	CALL	EDMQIO			; display
	JMP	RETRY			; try again
14$:
	BIT	#SW.HE,SWITCH		; test if HELP request
	BEQ	15$			; no, skip HELP output
	;
	MOV	#MES2HE,R1		; HELP message
	CALL	EDMQIO			; display
	JMP	RETRY			; try again
15$:
	BIT	#SW.BD,SWITCH		; test if bits request (decimal)
	BEQ	26$			; no, test if next switch
	;
	MOV	#-1,R4			; set counter for loop
17$:
	INC	R4			; next byte
	TSTB	BDVAL(R4)		; test if null
	BNE	17$			; loop til end-of-string
	;
	MOV	#BLKVAL,R3		; two-word field for converted num.
	MOV	#BDVAL,R5		; where string to convert lives
	CMPB	#'#,BDVAL		; test if octal request
	BNE	18$			; no, skip
	MOVB	#'0,BDVAL		; overwrite the # sign
	CALL	.OD2CT			; convert to double-word octal
	BCC	24$			; if successful, do block request
18$:
	CALL	.DD2CT			; convert to double-word decimal
	BCC	24$			; if successful, do block request
	MOV	#MESDCT,R1		; not succesful
	CALL	EDMQIO			; display
	JMP	90$			; go to finish-up
24$:
	BIC	#177760,BLKVAL+2	; null over forces only 4-bit-num.
	MOV	BLKVAL+2,R1		; fetch the char.len. request value
	SUB	#5,R1			; convert number of bits to a mask
	BIC	#177774,R1		; null over forces only 2-bit-num.
	MUL	#8.,R1			; shift left three bits
	MOV	R1,BLKVAL+2		; store the new char.len. value
	;
	CALL POKEIT		; here is where we do the POKE into memory
	;
	JMP	90$			; go to finish-up
26$:
	BIT	#SW.IS,SWITCH		; test if IS request
	BEQ	30$			; no, skip IS output
	;
	CALL PEEKIT		; here is where we do the PEEK into memory
	;
	BIC	#177740,BLKVAL+2	; null over forces only 5-bit-num.
	MOV	BLKVAL+2,R1		; fetch the char.len. current value
	DIV	#8.,R1			; shift right three bits
	ADD	#5,R1			; convert mask to the number of bits
	;
	MOV	R1,ARGBLK		; put input value into arg. block
	MOV	#M$CHRL,R1		; analyZe Character Length message
	CALL	EDMQIO			; display
	JMP	90$			; go to finish-up
30$:
	BIT	#SW.AD,SWITCH		; test if address request
	BEQ	36$			; no, skip base address change
	;
	TST	ADVAL			; check if there was an input value
	BEQ	34$			; if none, then just show it
	;
;;;;;;	MOV	#6,R1			; init. counter for sixbits shift
;;32$:	ASR	ADVAL			; force the shift sixbits right
;;;;;;	SOB	R1,32$			; loop back till sixbits shifted
;;;;;;
;;;;;;				*** WARNING ***
;;;;;;			the above code pulls the carry bit down
;;;;;;				so avoid it
;;;;;;
	MOV	ADVAL,R1		; fetch base address request value
	DIV	#64.,R1			; force the shift sixbits right
	MOV	R1,ADVAL		; store the shifted value
	;
	MOV	ADVAL,ZTTPAR		; put new base address value in
34$:
	MOV	ZTTPAR,ARGBLK		; load value of the partition /64.
	MOV	#M$ADDR,R1		; base address change message
	CALL	EDMQIO			; display
	JMP	90$			; go to finish-up
36$:
	BIT	#SW.OF,SWITCH		; test if offset request
	BEQ	40$			; no, skip offset change
	;
	TST	OFVAL			; check if there was an input value
	BEQ	37$			; if none, then just show it
	;
	MOV	OFVAL,ZCHROF		; put the offset request value in
37$:
	MOV	ZCHROF,ARGBLK		; load value of the offset value
	MOV	#M$OFFS,R1		; offset value change message
	CALL	EDMQIO			; display
	JMP	90$			; go to finish-up
40$:
	MOV	#MES2SW,R1		; switch syntax error message
	CALL	EDMQIO			; display
	JMP	RETRY			; try again
90$:
99$:
	MOV	#M$FOOT,R1		; footing message
	CALL	EDMQIO			; display
	;
	JMP	RETRY			; try again
;;;	JMP	DONE			;;;TEST;;; 
			; 
	.END	ZCL