TITLE	DEBUG for RPGLIB V1
	SUBTTL	Routine to support the DEBUG verb


;	DEBUG for RPGLIB V1
;
;
;	This routine provides runtime support for the DEBUG verb.
;
;	Copyright (C) 1976, Bob Currier and Cerritos College
;	All rights reserved
;
;
;	Call:
;		MOVEI	16,parameter.address
;		PUSHJ	17,DEBUG.
;
;	Parameters:
;		Word 1:	Byte pointer to result item
;		Word 2:	Byte pointer to factor 1 item
;		Word 3:	0,,pointer to OTFTAB item for file
;		Word 4:
;			Bits 0-1:	00 = Field
;					01 = Table item
;					10 = Array entry
;					11 = Whole array
;			Bit 2:		Factor 1 item is numeric
;			Bits 3-6:	Size of factor 1 item
;			Bits 7-16:	Size of result item
;			Bits 17-26:	Size of array if result is whole array
;			Bit 27:		Result item is numeric
;			Bits 28-35:	Unused
;
;	Returns:
;		Call+1 always
;
;

	SEARCH	RPGPRM, RPGSWI, UUOSYM, MACTEN

	%%LBLP==:%%LBLP
	DEBUG==:DEBUG
	BIS==:BIS

	TA==4				; must match RPGIO
	TB==5				; must match RPGIO
	T1==TAC2
	T2==TAC3
	CNTI==TAC4

	SALL

	TWOSEG
	RELOC	400000
;DEBUG.		Main support routine
;
;
;

	ENTRY	DEBUG.

DEBUG.:	HRRZ	TA,2(PARM)		; get OTFTAB pointer
	LDB	OPTR,OT.BFP		; get pointer to buffer
	HRLI	T1,DETB1.		; get pointer to general info
	HRR	T1,OPTR			; get pointer to buffer into RH
	MOVEI	T2,5(OPTR)		; get pointer to fifth word
	BLT	T1,(T2)			; move basic data to buffer
	MOVE	IPTR,1(PARM)		; get pointer to factor 1 item
	JUMPE	IPTR,DEBG.2		; [163] if none, print indicators then try result item
	LDB	T1,PTIBS.		; get input byte size
	MOVE	T2,[POINT 6,1,11]	; get byte pointer
	ADD	T2,OPTR			; add to buffer pointer
	LDB	CNT,LITSZ.		; get size of item

DEBG.1:	ILDB	CH,IPTR			; get a character
	XCT	CNVTB.-6(T1)		; convert to sixbit
	IDPB	CH,T2			; stash in buffer
	SOJG	CNT,DEBG.1		; loop until done

DEBG.2:	LDB	CNT,OT.BSC		; get buffer size
	SUBI	CNT,31			; adjust for characters we've already output
	ADD	OPTR,[POINT 6,5,5]	; make byte pointer point into buffer
	MOVE	IPTR,[POINT 1,INDBAS]	; get start of indicators
	MOVEI	CNTI,222		; get number of indicators
	MOVE	T1,[POINT 6,INDNM.]	; get start of indicator names

DEBG.3:	CAIG	CNT,3			; room left in buffer?
	  PUSHJ	PP,DEBG11		; no - dump a buffer
	ILDB	T2,IPTR			; get an indicator
	JUMPE	T2,DEBG.4		; if not on then try next one
	ILDB	CH,T1			; get an indicator name
	IDPB	CH,OPTR			; output to buffer
	ILDB	CH,T1			; get another char
	IDPB	CH,OPTR			; output that too
	SETZ	CH,			; get sixbit space
	IDPB	CH,OPTR			; output it
	SUBI	CNT,3			; decrement buffer space count
	SOJG	CNTI,DEBG.3		; loop if any indicators left
	PUSHJ	PP,DEBG.9		; else output a buffer
	JRST	DEBG.8			; and exit

DEBG.4:	IBP	T1			; get past 1 char of name
	IBP	T1			; and the next
	SOJG	CNTI,DEBG.3		; loop if any more
DEBG.7:	PUSHJ	PP,DEBG.9		; else output a buffer and fall thru to DEBG.8
;DEBG.8		Handle output of result item
;
;
;

DEBG.8:	MOVE	IPTR,(PARM)		; get pointer to result item
	JUMPE	IPTR,RET.1		; exit if none
	LDB	OPTR,OT.BFP		; get pointer to buffer
	LDB	T1,OPTYP.		; get type of field
	MOVE	T1,TYPTB.(T1)		; get the name
	MOVEM	T1,(OPTR)		; output to buffer
	MOVE	T1,VALUE.		; get 'VALUE'
	MOVEM	T1,1(OPTR)		; stick that in your buffer too
	SWOFF	FDNUM;			; default to not numeric
	LDB	T1,OPNUM.		; get numeric flag
	SKIPE	T1			; is it?
	  SWON	FDNUM;			; yes - say so
	LDB	CNTI,OPSIZ.		; get size of field
	LDB	CNT,OT.BSC		; get buffer size
	SUBI	CNT,14			; allow for junk we've already output
	ADD	OPTR,[POINT 6,2,11]	; make pointer point to right spot
	LDB	T1,OPTYP.		; get type of field
	CAIN	T1,3			; whole array?
	  JRST	DEBG10			; yes -
	PUSHJ	PP,DEBOUT		; no - output the field

DEBG.9:	PUSH	PP,PARM			; save parameter pointer
	MOVEI	TB,3			; [171] get write flag
	PUSHJ	PP,XFIL			; do some output
	POP	PP,PARM			; restore pointer
	HRRZ	TA,2(PARM)		; get OTFTAB pointer
	MOVEM	TA,CUROTF##		; save in case of SPOUT call
	LDB	T1,OT.DEV		; get device
	CAIL	T1,3			; printer?
	CAILE	T1,5			; console?
	  POPJ	PP,			; no - exit
	PUSH	PP,PARM			; yes - save parm again
	MOVEI	TB,1			; just one space
	PUSHJ	PP,SPOUT		; output a space
	POP	PP,PARM			; restore pointer
	POPJ	PP,			; and exit
;DEBG10		Handle whole array output
;
;
;

DEBG10:	LDB	T2,OPASZ.		; get array size
	PUSHJ	PP,DEBOUT		; output a field
	SOJLE	T2,DEBG.9		; when done, exit
	CAIG	CNT,1			; room for space?
	  PUSHJ	PP,DEBG11		; No output a buffer full
	IBP	OPTR			; output a space
	SOJA	CNT,DEBG10+1		; loop

DEBG11:	PUSH	PP,IPTR			; save a bunch of AC's
	PUSH	PP,CNTI
	PUSH	PP,T1
	PUSH	PP,T2
	PUSHJ	PP,DEBG.9		; output a buffer
	POP	PP,T2
	POP	PP,T1
	POP	PP,CNTI
	POP	PP,IPTR
	HRRZ	TA,2(PARM)		; restore OTFTAB pointer
	LDB	OPTR,OT.BFP		; reget buffer pointer
	HRLI	OPTR,440600		; make into byte pointer
	LDB	CNT,OT.BSC		; get buffer size
	POPJ	PP,			; and exit
;DEBOUT		Routine to output a field
;
;
;

DEBOUT:	SWOFF	FDNEG;			; start as positive
	LDB	T1,PTIBS.		; get byte size

DEBOT1:	ILDB	CH,IPTR			; get a character
	XCT	CNVTB.-6(T1)		; convert to sixbit
	TSWT	FDNUM;			; is this numeric?
	  JRST	DEBOT2			; no -
	CVTSNM	6,CH,CH			; yes - convert to a number
	TLZE	CH,(1B0)		; overpunched "-" ?
	  TSWC	FDNEG;			; yes - flag it

DEBOT2:	IDPB	CH,OPTR			; output character
	SOSG	CNT			; anymore room in buffer?
	  PUSHJ	PP,DEBG11		; no - output a buffer full
	SOJG	CNTI,DEBOT1		; loop until all of field output
	TSWF	FDNUM;			; numeric?
	TSWT	FDNEG;			; and negative?
	  POPJ	PP,			; no - exit
	MOVEI	CH,'-'			; yes - get minus sign
	IDPB	CH,OPTR			; output to buffer
	SUBI	CNT,1			; count it
	POPJ	PP,			; and exit
;Define constants
;
;
;

LITSZ.:	POINT	4,3(PARM),6		; size of factor 1 item
LITNM.:	POINT 	1,3(PARM),2		; numeric flag for factor 1 item
OPSIZ.:	POINT	10,3(PARM),16		; size of result item
OPASZ.:	POINT	10,3(PARM),26		; size of array
OPNUM.:	POINT	1,3(PARM),27		; numeric flag for result item
OPTYP.:	POINT	2,3(PARM),1		; field type of result item

CNVTB.:	JFCL				; SIXBIT/SIXBIT
	LDB	CH,PTR.76##		; ASCII/SIXBIT
	Z
	LDB	CH,PTR.96##		; EBCDIC/SIXBIT

DETB1.:	SIXBIT	/ DEBUG-          INDICATORS ON-/

TYPTB.:	SIXBIT	/ FIELD/
	SIXBIT	/ TABLE/
	SIXBIT	/ FIELD/
	SIXBIT	/ ARRAY/

VALUE.:	SIXBIT	/ VALUE/

INDNM.:	SIXBIT	/010203/
	SIXBIT	/040506/
	SIXBIT	/070809/
	SIXBIT	/101112/
	SIXBIT	/131415/
	SIXBIT	/161718/
	SIXBIT	/192021/
	SIXBIT	/222324/
	SIXBIT	/252627/
	SIXBIT	/282930/
	SIXBIT	/313233/
	SIXBIT	/343536/
	SIXBIT	/373839/
	SIXBIT	/402142/
	SIXBIT	/434445/
	SIXBIT	/464748/
	SIXBIT	/495051/
	SIXBIT	/525354/
	SIXBIT	/555657/
	SIXBIT	/585960/
	SIXBIT	/616263/
	SIXBIT	/646566/
	SIXBIT	/676869/
	SIXBIT	/707172/
	SIXBIT	/737475/
	SIXBIT	/767778/
	SIXBIT	/798081/
	SIXBIT	/828384/
	SIXBIT	/858687/
	SIXBIT	/888990/
	SIXBIT	/919293/
	SIXBIT	/949596/
	SIXBIT	/979899/
	SIXBIT	/H1H2H3/
	SIXBIT	/H4H5H6/
	SIXBIT	/H7H8H9/
	SIXBIT	/L1L2L3/
	SIXBIT	/L4L5L6/
	SIXBIT	/L7L8L9/
	SIXBIT	/LROAOB/
	SIXBIT	/OCODOE/
	SIXBIT	/OFOGOV/
	SIXBIT	/M1M2M3/
	SIXBIT	/M4M5M6/
	SIXBIT	/M7M8M9/
	SIXBIT	/MRL01P/
	SIXBIT	/U1U2U3/
	SIXBIT	/U4U5U6/
	SIXBIT	/U7U8  /


EXTERN	PTIBS., OT.BFP, OT.BSC, OT.DEV, INDBAS, RET.1, XFIL, SPOUT

	END