.TITLE	CC104
	.IDENT	/X01/
 
	.NLIST	BEX
	.ENABL	LC
 
;
; C COMPILER.
; MISC.
;
; VERSION X01
;
; DAVID G. CONROY	14-OCT-77
;
 
	.GLOBL	PRSTE
	.GLOBL	GENLAB
	.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	PREC
 
	.MCALL	CALL
	.MCALL	CALLR
	.MCALL	RETURN
 
;
; LOCAL DATA
;
 
ISN:	.WORD	1		;FOR GENERATING LABELS
 
;
; ERRORS
;
 
ERR01:	.ASCIZ	"Structure/union size not known"
 
	.EVEN
	.PAGE
;+
; ** PRSTE - OUTPUT SYMBOL TABLE ENTRY
;
; CALLED FROM DEFINE, THIS ROUTINE FORMATS AND OUTPUTS A SYMBOL TABLE
; ENTRY (Q RECORD).
;
; INPUTS:
;	R5=POINTER TO THE SYMBOL
;
; USES:
;	R0, R1
;-

PRSTE:	MOVB	#'Q,R0		;OPCODE
	CALL	CODC		;
	CALL	40$		;BLANK
 
	MOVB	S.CLAS(R5),R0	;CLASS
	CALL	CODNUM		;
	CALL	40$		;

	MOVB	S.TYPE(R5),R0	;TYPE
	CALL	CODNUM		;
	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	CODNUM		;
	CALL	40$		;
 
	MOV	S.ADDR(R5),R0	;ADDRESS
	CALL	CODNUM		;
	CALL	40$		;

	MOV	R5,R0		;NAME
	ADD	#S.NAME,R0	;
	CALL	CODSTR		;

	MOV	S.DIMP(R5),R1	;PICK UP DIMS
	BEQ	30$		;NULL
20$:	CALL	40$		;BLANK
	MOV	D.TYPE(R1),R0	;TYPE
	CALL	CODNUM		;
	CALL	40$		;
	MOV	D.BOUN(R1),R0	;BOUND
	CALL	CODNUM		;
	MOV	D.LINK(R1),R1	;FOLLOW THE LIST
	BNE	20$		;

30$:	CALLR	CODNL		;DONE

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

;+
; ** GENLAB - GENERATE A LABEL
;
; OUTPUTS:
;	R0=LOCAL LABEL NUMBER
;-
 
GENLAB:	MOV	ISN,R0		;GET ISN NUMBER
	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	GENLAB		;LABEL FOR THE STRING
	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		;
 
	CALL	PREC		;GET INTO PROGRAMME PSECTION
	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	ERROR		;
	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	CODC		;OUTPUT OPCODE
	MOVB	#' ,R0		;A BLANK
	CALL	CODC		;
	MOV	(SP)+,R0	;THE OPERAND
	CALL	CODNUM		;
	CALLR	CODNL		;DONE

	.DSABL	LSB
 
;+
; ** CREC - OUT OUT A 'C' DIRECTIVE
; ** PREC - PUT OUT A 'P' DIRECTIVE
;
; USES:
;	R0
;-

	.ENABL	LSB

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

PREC:	MOVB	#'P,R0		;GET OPCODE

10$:	CALL	CODC		;PUT OUT THE OPCODE
	CALLR	CODNL		;AND A NEWLINE

	.DSABL	LSB

	.END