.IIF	NDF	RSX	RSX	=	1	;Assume RSX	;01
	.TITLE	CC104
	.ident	/X01.07/
 
	.NLIST	BEX, CND
	.ENABL	LC, GBL
	.LIST	MEB						;01-
 
;
; C COMPILER.
; MISC.
;
; VERSION X01
;
; DAVID G. CONROY	14-OCT-77
; LAST UPDATED:		30-APR-79
;
; Edit history
; 01 04-Mar-80 MM	Updated for RT11
; 02 13-May-80 MM	Undefined structures give warning message
; 03 22-Jul-80 MM	Added OREC for data .psect
; 04 ??
; 05 09-Mar-81 MM	Dump symbol table if listing trees
; 06 21-Mar-82 MM	Track symbol table changes
; 06 01-Jul-82 MM	Comment changes for .psect
;
 
	.GLOBL	PRSTE
	.GLOBL	GENLB1
	.GLOBL	GETSTR
	.GLOBL	SLENG
	.GLOBL	BASIZE
	.GLOBL	TREC
	.GLOBL	FREC
	.GLOBL	LREC
	.GLOBL	JREC
	.GLOBL	HREC
	.GLOBL	YREC
	.GLOBL	IREC
	.GLOBL	BREC
	.GLOBL	CREC
	.GLOBL	OREC						;03
	.GLOBL	PREC
 
.IF NE	RSX							;01
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
.ENDC								;01
 
;
; LOCAL DATA
;
	.PSECT	LD104,OVR,GBL					;01
ISN:	.WORD	1		;FOR GENERATING LABELS
 
;
; ERRORS
;

	.PSECT	ER104						;01
ERR01:	.ASCIZ	"Warning: structure/union size not known yet, 0 used"
 
	.EVEN

	.PSECT	CC104
CC104::
;+
; ** PRSTE - OUTPUT SYMBOL TABLE ENTRY
;
; THIS ROUTINE FORMATS AND OUTPUTS A "Q" RECORD, WHICH IS USED BY THE
; CODE GENERATOR TO OUTPUT A SYMBOL TABLE ENTRY.
;
; INPUTS:
;	R5=POINTER TO THE SYMBOL
;-

PRSTE:	TSTB	LFLAG		;DUMPING TREES?			;05
	BNE	1$		;YES, DUMP SYMBOL TABLE TOO	;05
	TSTB	TFLAG		;NEED TABLE?
	BEQ	35$		;NO
1$:				;				;05

	MOV	R0,-(SP)	;SAVE REGISTERS
	MOV	R1,-(SP)	;

	MOV	#'Q,R0		;RECORD TYPE
	CALL	CODC1		;				;01
	CALL	40$		;BLANK
 
	MOVB	S.CLAS(R5),R0	;CLASS
	CALL	CODNM1		;				;01
	CALL	40$		;

	MOVB	S.TYPE(R5),R0	;TYPE
	CALL	CODNM1		;				;01
	CALL	40$		;

	CLR	R0		;STRUCTURE SIZE
	CMPB	S.TYPE(R5),#TY.STR ;
	BLO	10$		;
	MOV	S.DOPE(R5),R0	;
	MOV	S.SSIZ(R0),R0	;
10$:	CALL	CODNM1		;				;01
	CALL	40$		;
 
	MOV	S.ADDR(R5),R0	;ADDRESS
	CALL	CODNM1		;				;01
	CALL	40$		;

	MOV	R5,R0		;NAME
	ADD	#S.NAME,R0	;
	CALL	CODST1		;				;01

	BITB	#SF.FLD,S.FLAG(R5) ;FIELD?			;06
	BEQ	15$		;NO
	CALL	40$		;FAKE DIM SLOT.
	MOV	#DT.FLD,R0	;FAKE TYPE.
	CALL	CODNM1		;				;01
	CALL	40$		;
	MOVB	S.WIDE(R5),R0	;WIDTH OF FIELD.
	CALL	CODNM1		;				;01
	CALL	40$		;
	MOVB	S.BOFS(R5),R0	;OFFSET
	CALL	CODNM1		;				;01

15$:	MOV	S.DIMP(R5),R1	;PICK UP DIMS
	BEQ	30$		;NULL

20$:	CALL	40$		;BLANK
	MOV	D.TYPE(R1),R0	;TYPE
	CALL	CODNM1		;				;01
	CMP	R0,#DT.ARY	;ARRAY?
	BNE	25$		;NO, NO BOUNDS.
	CALL	40$		;
	MOV	D.BOUN(R1),R0	;BOUND
	CALL	CODNM1		;				;01
25$:	MOV	D.LINK(R1),R1	;FOLLOW THE LIST
	BNE	20$		;

30$:	CALL	CODNL1		;DONE DIMS			;01
	MOV	(SP)+,R1	;RESTORE REGISTERS
	MOV	(SP)+,R0	;

35$:	RETURN			;TOUT FINIS

40$:	MOVB	#' ,R0		;PUT OUT A BLANK
	CALLR	CODC1		;				;01

;+
; ** GENLB1 - GENERATE A LABEL					;01
;
; OUTPUTS:
;	R0=LOCAL LABEL NUMBER
;-
 
GENLB1:	MOV	ISN,R0		;GET ISN NUMBER			;01
	INC	ISN		;ADVANCE GENERATOR
	RETURN			;
 
;+
; ** GETSTR - GET A STRING
;
; THIS ROUTINE READS IN A STRING AND OUTPUTS IT TO THE STRINGS PSECT.
; IT ALSO CALLS 'ADVANC' TO RESTART LEXICAL PROCESSING.
;
; OUTPUTS:
;	R0=LABEL WHERE THE STRING WENT
;
; USES:
;	R0, R1
;-
 
GETSTR:	CALL	CREC		;GET INTO STRINGS PSECTION
 
	CALL	GENLB1		;LABEL FOR THE STRING		;01
	MOV	R0,-(SP)	;
	CALL	LREC		;
 
	MOV	#'",R1		;MAPCH DELIMITER
10$:	CALL	MAPCH		;GET CHARACTER
	BCS	20$		;END OF STRING
	CALL	HREC		;CONSTANT BYTE
	BR	10$		;
 
20$:	CLR	R0		;NULL ON THE END
	CALL	HREC		;
 
	MOV	#PREC,R0	;ASSUME PROGRAM SECTION		;03+
	TST	FSYMBL		;ARE WE GENERATING CODE?
	BNE	30$		;BR IF SO
	MOV	#OREC,R0	;NO, IT'S THE DATA SECTION
30$:
	CALL	(R0)		;GET INTO PROPER SECTION	;03-
	CALL	ADVANC		;RESTART THE SCANNER
	MOV	(SP)+,R0	;GET LABEL
	RETURN			;DONE
 
;+
; ** SLENG - GET LENGTH OF A SYMBOL (IN BYTES)
;
; INPUTS:
;	R5=SYMBOL TABLE NODE
;
; OUTPUTS:
;	R0=SIZE OF THE ITEM (IN BYTES)
;-
 
SLENG:	MOV	R2,-(SP)	;SAVE
	MOV	R1,-(SP)	;REGISTERS
 
	MOV	#1,R1		;DEFAULT TO SCALAR
	MOV	S.DIMP(R5),R0	;GET POINTER TO DIMENSIONS
	BEQ	30$		;NO DIMENSIONS
10$:	CMP	D.TYPE(R0),#DT.ARY ;ARRAY
	BNE	20$		;NO
	MOV	D.BOUN(R0),-(SP);YES, MULTIPLY BOUND INTO SIZE
	CALL	$MULR1		;R1=R1*(SP)
	TST	(SP)+		;
	MOV	(R0),R0		;GET NEXT DIM.
	BNE	10$		;BR IF MORE DIMS
	BR	30$		;BR ON END OF LIST
 
20$:	CLR	R0		;FUNCTIONS HAVE
	CMP	D.TYPE(R0),#DT.FUN ;ZERO SIZE
	BEQ	40$		;AND
	MOV	#2,R0		;POINTERS ARE
	BR	40$		;2 BYTES LONG
 
30$:	TST	R1		;IF ZERO LENGTH ARRAY ([])
	BEQ	45$		;YOU KNOW THE LENGTH
	MOVB	S.TYPE(R5),R0	;GET BASIC TYPE
	CMP	R0,#TY.STR	;IS THE ITEM A STRUCTURE
	BLO	35$		;NO, DON'T NEED THE SIZE
	MOV	S.DOPE(R5),R2	;R2=STRUCTURE SIZE
	MOV	S.SSIZ(R2),R2	;FROM THE DOPE BLOCK
35$:	CALL	BASIZE		;GET ELEMENT BASIC SIZE
 
40$:	MOV	R0,-(SP)	;R1=ACTUAL SIZE
	CALL	$MULR1		;
	TST	(SP)+		;
 
45$:	MOV	R1,R0		;RETURN IN R0
 
	MOV	(SP)+,R1	;RETURN
	MOV	(SP)+,R2	;
	RETURN			;
 
;+
; ** BASIZE - COMPUTE BASIC SIZE
;
; INPUTS:
;	R0=TYPE
;	R2=STRUCTURE SIZE
;
; OUTPUTS:
;	R0=BASIC SIZE (BYTES)
;-
 
BASIZE:	CMP	R0,#TY.CHR	;CHAR
	BNE	10$		;
	MOV	#1,R0		;1 BYTE LONG
	BR	60$		;
 
10$:	CMP	R0,#TY.LNG	;INT UNSIGNED POINTERS
	BHIS	20$		;
	MOV	#2,R0		;2 BYTES LONG
	BR	60$		;
 
20$:	CMP	R0,#TY.DBL	;FLOAT LONG
	BHIS	30$		;
	MOV	#4,R0		;4 BYTES LONG
	BR	60$		;
 
30$:	BNE	40$		;DOUBLES
	MOV	#10,R0		;ARE 8 BYTES LONG
	BR	60$		;
 
40$:	CMP	R0,#TY.STR	;STRUCTURES (AND UNIONS)
	BLO	50$		;
	MOV	R2,R0		;HAVE A STRUCTURE SIZE
	BR	60$		;
 
50$:	MOV	#ERR01,R0	;NEED LENGTH OF AN UNDEFINED STRUCTURE
	CALL	WARN1		;(MAKE IT A WARNING MESSAGE)		;01/02
	CLR	R0		;GIVE IT SIZE 0
 
60$:	RETURN			;
 
;+
; ** TREC - PUT OUT A 'T' DIRECTIVE
; ** FREC - PUT OUT A 'F' DIRECTIVE
; ** JREC - PUT OUT A 'J' DIRECTIVE
; ** LREC - PUT OUT A 'L' DIRECTIVE
; ** HREC - PUT OUT A 'H' DIRECTIVE
; ** YREC - PUT OUT A 'Y' DIRECTIVE
; ** IREC - PUT OUT A 'I' DIRECTIVE
; ** BREC - PUT OUT A 'B' DIRECTIVE
;
; INPUTS:
;	R0=THE NUMBER IN THE DIRECTIVE
;-
 
	.ENABL	LSB

TREC:	MOV	R0,-(SP)	;SAVE OPERAND
	MOVB	#'T,R0		;GET OPCODE
	BR	10$		;GO PRINT IT
 
FREC:	MOV	R0,-(SP)	;SAVE OPERAND
	MOVB	#'F,R0		;GET OPCODE
	BR	10$		;GO PRINT IT
 
JREC:	MOV	R0,-(SP)	;SAVE OPERAND
	MOVB	#'J,R0		;GET OPCODE
	BR	10$		;GO PRINT IT
 
LREC:	MOV	R0,-(SP)	;SAVE OPERAND
	MOVB	#'L,R0		;GET OPCODE
	BR	10$		;GO PRINT IT
 
HREC:	MOV	R0,-(SP)	;SAVE OPERAND
	MOVB	#'H,R0		;GET OPCODE
	BR	10$		;GO PRINT IT
 
YREC:	MOV	R0,-(SP)	;SAVE OPERAND
	MOVB	#'Y,R0		;GET OPCODE
	BR	10$		;GO PRINT IT
 
IREC:	MOV	R0,-(SP)	;SAVE OPERAND
	MOVB	#'I,R0		;GET OPCODE
	BR	10$		;GO PRINT IT
 
BREC:	MOV	R0,-(SP)	;SAVE OPERAND
	MOVB	#'B,R0		;GET OPCODE

10$:	CALL	CODC1		;OUTPUT OPCODE			;01
	MOVB	#' ,R0		;A BLANK
	CALL	CODC1		;				;01
	MOV	(SP)+,R0	;THE OPERAND
	CALL	CODNM1		;				;01
	CALLR	CODNL1		;DONE				;01

	.DSABL	LSB
 
;+
; ** CREC - OUTPUT A 'C' DIRECTIVE (SWITCH TO $STRN PSECT)
; ** OREC - OUTPUT A 'O' DIRECTIVE (SWITCH TO $DATA PSECT)
; ** PREC - OUTPUT A 'P' DIRECTIVE (SWITCH TO $CODE PSECT)
;
; USES:
;	R0
;-

	.ENABL	LSB

CREC:	MOVB	#'C,R0		;GET OPCODE
	BR	10$		;GO PUT IT OUT

OREC::								;03+
	MOVB	#'O,R0		;GET OPCODE
	BR	10$		;				;03-

PREC:	MOVB	#'P,R0		;GET OPCODE

10$:	CALL	CODC1		;PUT OUT THE OPCODE		;01
	CALLR	CODNL1		;AND A NEWLINE			;01

	.DSABL	LSB

	.END