.IIF NDF RSX RSX = 1 ;Assume RSX ;01 .TITLE CC102 .ident /X01.09/ .NLIST BEX, CND .ENABL LC, GBL .LIST MEB ;01- ; ; C COMPILER ; STATEMENTS ; ; VERSION X01 ; ; DAVID G. CONROY 14-NOV-77 ; LAST UPDATED: 30-APR-79 ; ; Edit history ; 01 04-Mar-80 MM Updated for RT11 ; 02 04-Mar-80 MM Unix-style argument passing (only) ; 03 13-Mar-80 MM Allow more cases (for lex tables) ; 04 06-Mar-81 MM Output function type for code generator ; u1 24-Aug-81 CCG Changed double to float ; u2 14-Sep-81 CCG Re-ordered loop testing in FOR stmt. ; u3 17-Sep-81 CCG Fixed allocation of excessive locals. ; 05 09-Feb-82 MM Merged in Unimation sources (slightly undid u1) ; 06 06-Mar-82 RBD Tree symbol table stuff ; 07 21-Mar-82 MM Bucket symbol table stuff ; 08 21-Jun-84 JRW Allow return expr ; 09 09-Jul-84 MM Handle all return cases ; .GLOBL STATE .IF NE RSX ;01 .MCALL CALLR .ENDC ;01 ; ; EQUIVALENCES ; UFARG = 4 ;FIRST FORMAL PMTR AT 4(R5) ;02 UFAUTO = -6 ;FIRST LOCAL VAR. AT -10(R5) ;02 MCASES = 100. ;MAX NUMBER OF CASES ;03 ;NOTE: MCASES <= MSWIT IN CC200 ;03 MARRAY = 20. ;MAX NUMBER OF ARRAYS NCASES = 0 ;NUMBER OF CASES DEFLAB = 2 ;DEFAULT LABELS CASES = 4 ;START OF THE CASES SBSIZE = CASES+<4*MCASES> ; ; LOCAL DATA ; .PSECT LD102,OVR,GBL ;01 BLAB: .WORD 0 ;BREAK LABEL CLAB: .WORD 0 ;CONTINUE LABEL SWP: .WORD 0 ;POINTER TO SWITCH DATA BLOCK ; ; FOR REGISTER ARGUMENTS. ; SRARG: .WORD OP.ASG ;ASSIGNMENT .BYTE 0, TY.INT ;INT .WORD 0, 0 ;SIZES .WORD SRARG1 ;LOP .WORD SRARG3 ;ROP SRARG1: .WORD OP.REG ;REGISTER .BYTE 0, TY.INT ;INT .WORD 0, 0 ;SIZES .WORD 0 ;OFFSET SRARG2: .BLKW 1 ;REGNO SRARG3: .WORD OP.INX ;INDEX .BYTE 0, TY.INT ;INT .WORD 0, 0 ;SIZES SRARG4: .BLKW 1 ;OFFSET .WORD 5 ;R5 ; ; ERRORS ; .PSECT ER102 ;01 ERR01: .ASCIZ "Unexpected EOF" ERR02: .ASCIZ "Missing right brace" ERR03: .ASCIZ "Illegal 'break'" ERR04: .ASCIZ "Illegal 'continue'" ;FIXED AT LAST ;01 ERR05: .ASCIZ "Illegal 'else'" ERR06: .ASCIZ "'Default' not in 'switch'" ERR07: .ASCIZ "'Case' not in 'switch'" ERR08: .ASCIZ "Too many cases" ERR09: .ASCIZ "Statement syntax" ERR10: .ASCIZ "Illegal label" ERR11: .ASCIZ "'Goto' non label" ERR12: .ASCIZ "Parenthesised expression required" ERR13: .ASCIZ "Declaration syntax" ERR14: .ASCIZ "Missing semicolon" ERR15: .ASCIZ "Integer expression required" .EVEN .PSECT CC102 ;01 CC102:: ;01 ;+ ; ** STATE - COMPILE 1 STATEMENT ; ; THIS RECURSIVE PROCEDURE IS CALLED TO COMPILE A SINGLE C STATEMENT. ; ALTHOUGH IT RAMBLES ON FOR MANY PAGES, IT ISN'T REALLY TOO COMPLEX. ; ; SOME GROUND RULES. THE VARIABLES BLAB AND CLAB CONTAIN THE INTERNAL ; LABEL NUMBERS OF THE BREAK AND CONTINUE LABELS. THEY ARE SAVED (ON ; THE STACK) AND RESET WHENEVER YOU ENTER A COMPOUND STATEMENT. ZERO ; MEANS NOT IN A COMPOUND STATEMENT. ; ; SWP POINTS TO A SWITCH BLOCK. THIS BLOCK IS ALLOCATED BY THE SWITCH ; STATEMENT. THE CASE AND DEFAULT STATEMENTS JUST STUFF THINGS INTO ; THE BLOCK. AT THE END OF THE TARGET STATEMENT OF THE SWITCH ALL THE ; STUFF IN THE BLOCK IS WRITTEN OUT (IN 'W' RECORDS), THE BLOCK FREED ; AND THE SWP RESTORED. ; ; INPUTS: ; R5=0 IF COMPOUND STATEMENT IS NOT TOP LEVEL IN A ; FUNCTION. ; R5=1 IF COMPOUND STATEMENT IS THE TOP LEVEL OF A ; FUNCTION AND REQUIRES THE PARSING OF DECLS. ; AND OUTPUT OF THE 'N' DIRECTIVE. ;- STATE: MOV R0,-(SP) ;SAVE THE REGISTERS MOV R1,-(SP) MOV R2,-(SP) MOV R3,-(SP) MOV R4,-(SP) MOV R5,-(SP) 10$: CALL SCAN ;LOOK FOR LEADING LABELS CMP R0,#OP.ID BNE 20$ CMP LEX1,#OP.CLN BNE 20$ CALL DOLAB ;DEFINE THE LABEL AND CALL SCAN ;SKIP OVER IT BR 10$ 20$: CMP R0,#OP.EOF ;END OF FILE IS AN ERROR BNE 30$ MOV #ERR01,R0 CALL ERROR1 ;01 BR 36$ 30$: CMP R0,#OP.SEM ;NULL STATEMENT BEQ 36$ CMP R0,#OP.LBR ;COMPOUND STATEMENT BNE 40$ TST (SP) ;DO DECLARATIONS IF NECESSARY BEQ 32$ CALL DECLS 32$: CMP LEX1,#OP.EOF ;LOOK FOR DELIMITERS OF THE BLOCK BEQ 34$ CMP LEX1,#OP.RBR BEQ 34$ CLR R5 ;IF NO DELIMITER IN SIGHT, COMPILE CALL STATE ;A STATEMENT BR 32$ 34$: CALL SCAN ;DELIMITER MUST BE A BRACE CMP R0,#OP.RBR BEQ 36$ MOV #ERR02,R0 CALL ERROR1 ;01 36$: JMP 210$ 40$: CMP R0,#OP.GOT ;GOTO STATEMENT BNE 50$ CALL SCAN ;MUST BE IDENTIFIER CMP R0,#OP.ID BNE 42$ CALL DOGOTO JMP 170$ 42$: JMP 190$ 50$: CMP R0,#OP.RET ;RETURN STATEMENT BNE 60$ CALL DORET JMP 180$ 60$: CMP R0,#OP.IF ;IF STATEMENT BNE 70$ CALL GENLB1 ;LABEL AT END OF 'THEN' PART ;01 MOV R0,-(SP) CALL PEXPR BCS 64$ CALL CHWORD ;MUST BE INTEGER EXPRESSION MOV (SP),R0 ;JUMP FALSE CALL FREC CALL OUTREE CLR R5 ;THE 'THEN' CLAUSE CALL STATE CMP LEX1,#OP.ELS ;IS THERE AN 'ELSE' NEXT BNE 62$ ;NO CALL GENLB1 ;YES, BRANCH AROUND ELSE PART. ;01 MOV R0,R1 CALL JREC MOV (SP)+,R0 ;PUT OUT THE ELSE LABEL CALL LREC MOV R1,-(SP) ;AND PUT NEW ENDING LABEL ON THE STACK CALL SCAN CALL STATE ;ELSE CLAUSE 62$: MOV (SP)+,R0 CALL LREC JMP 210$ 64$: TST (SP)+ JMP 195$ 70$: CMP R0,#OP.WHI ;WHILE STATEMENT BNE 80$ MOV BLAB,-(SP) ;SAVE BREAK AND CONTINUE LABELS MOV CLAB,-(SP) CALL GENLB1 ;BREAK LABEL ;01 MOV R0,BLAB CALL GENLB1 ;CONTINUE LABEL ;01 MOV R0,CLAB CALL LREC ;THE CONTINUE LABEL GOES HERE CALL PEXPR BCS 72$ CALL CHWORD MOV BLAB,R0 ;JUMP FALSE TO BREAK LABEL CALL FREC CALL OUTREE CLR R5 ;THE BODY OF THE WHILE CALL STATE MOV CLAB,R0 ;JUMP BACK TO CONTINUE LABEL CALL JREC MOV BLAB,R0 ;BREAK LABEL CALL LREC MOV (SP)+,CLAB ;PUT LABELS BACK MOV (SP)+,BLAB JMP 210$ 72$: MOV (SP)+,CLAB ;ERROR MOV (SP)+,BLAB JMP 195$ 80$: CMP R0,#OP.BRK ;BREAK STATEMENT BNE 90$ MOV BLAB,R0 ;PICK UP BREAK LABEL BEQ 82$ ;IF NO LABEL, ERROR CALL JREC BR 84$ 82$: MOV #ERR03,R0 CALL ERROR1 ;01 84$: JMP 170$ 90$: CMP R0,#OP.CTN ;CONTINUE STATEMENT BNE 100$ MOV CLAB,R0 BEQ 92$ ;ILLEGAL CONTINUE CALL JREC BR 94$ 92$: MOV #ERR04,R0 CALL ERROR1 ;01 94$: JMP 170$ 100$: CMP R0,#OP.DO ;DO ... WHILE STATEMENT BNE 110$ MOV BLAB,-(SP) MOV CLAB,-(SP) CALL GENLB1 ;01 MOV R0,BLAB CALL GENLB1 ;01 MOV R0,CLAB CALL GENLB1 ;TOP OF THE LOOP LABEL ;01 MOV R0,-(SP) CALL LREC CLR R5 ;BODY CALL STATE MOV CLAB,R0 ;CONTINUE LABEL IS BEFORE THE TEST CALL LREC CALL SCAN ;MUST BE 'WHILE' CMP R0,#OP.WHI BNE 102$ CALL PEXPR BCS 104$ CALL CHWORD MOV (SP)+,R0 ;JUMP TRUE TO THE TOP OF THE LOOP CALL TREC CALL OUTREE MOV BLAB,R0 ;THE BREAK LABEL IS AFTER THE TEST CALL LREC MOV (SP)+,CLAB MOV (SP)+,BLAB JMP 210$ 102$: TST (SP)+ MOV (SP)+,CLAB MOV (SP)+,BLAB JMP 170$ 104$: TST (SP)+ ;LOOP LABEL MOV (SP)+,CLAB MOV (SP)+,BLAB JMP 195$ 110$: CMP R0,#OP.ELS ;ELSE STATEMENT, SHOULD NOT HAPPEN BNE 120$ MOV #ERR05,R0 CALL ERROR1 ;01 CLR R5 ;COMPILE THE STATEMENT ANYWAY CALL STATE JMP 210$ 120$: CMP R0,#OP.FOR ;FOR STATEMENT BEQ 1205$ ;u2+ JMP 130$ 1205$: MOV BLAB,-(SP) ;GENERATE NEW BREAK AND ;u2- MOV CLAB,-(SP) ;CONTINUE LABELS CALL GENLB1 ;01 MOV R0,BLAB CALL GENLB1 ;01 MOV R0,CLAB CALL SCAN ;CHECK FOR THE '(' CMP R0,#OP.LPA BNE 127$ ;u2 CALL SCAN ;INIT PART CMP R0,#OP.SEM BEQ 121$ ;BR IF NO INIT PART CALL CLRTRE CALL EXPR MOVB #'E,R0 CALL CODC1 ;01 CALL CODNL1 ;01 CALL OUTREE CMP LEX0,#OP.SEM BNE 127$ ;u2 121$: CLR -(SP) ;DEFAULT TO NO TEST PART ;u2 CALL CLRTRE CALL SCAN CMP R0,#OP.SEM BEQ 122$ ;BR IF NO TEST PART CALL EXPR CALL CHWORD MOV R5,@SP ;SAVE PTR TO TEST TREE ;u2 CMP LEX0,#OP.SEM BNE 126$ 122$: CALL SCAN ;IS THERE AN INCR PART ;u2+ CLR R5 ;INIT INCR POINTER TO ZERO CMP R0,#OP.RPA BEQ 123$ ;BR IF NOT CALL EXPR ;COMPILE INCR CMP LEX0,#OP.RPA BNE 126$ 123$: CALL GENLB1 ;GET LABEL FOR START OF LOOP MOV R0,-(SP) ;SAVE IT TST 2(SP) ; ANY TEST PART ? BEQ 1235$ ; SKIP JUMP IF SO CALL JREC ; AND JUMP TO IT 1235$: CALL GENLB1 ;GET LABEL FOR TOP OF LOOP MOV R0,-(SP) ;SAVE IT CALL LREC ; AND PLACE IT HERE MOV R5,-(SP) ;SAVE POINTER TO INCR TREE CLR R5 CALL PSHTRE ;PUSH THESE TREES CALL STATE ;COMPILE AND OUTPUT BODY OF THE FOR CALL POPTRE ;RESTORE THE TREES MOV CLAB,R0 ;PUT THE CONTINUE LABEL HERE CALL LREC MOV (SP)+,R5 ;GET THE INCR CODE TREE BEQ 124$ ; SKIP IF NONE MOVB #'E,R0 ;PUT THE INCR CODE HERE CALL CODC1 ;01 CALL CODNL1 ;01 CALL OUTREE 124$: MOV (SP)+,R4 ;SAVE THE TOP OF LOOP LABEL MOV (SP)+,R0 ;GET THE START OF LOOP LABEL CALL LREC ; AND PUT IT HERE MOV R4,R0 ;GET TOP OF LOOP LABEL MOV (SP)+,R5 ;GET THE TEST TREE BEQ 1245$ ;SKIP IF NONE CALL TREC ;JUMP TRUE TO TOP OF LOOP CALL OUTREE BR 125$ 1245$: CALL JREC ;NO TEST -> UNCONDITIONAL JUMP 125$: MOV BLAB,R0 ;BREAK LABEL HERE CALL LREC MOV (SP)+,CLAB MOV (SP)+,BLAB JMP 210$ 126$: TST (SP)+ ; POP STACK 127$: MOV (SP)+,CLAB ;u2- MOV (SP)+,BLAB JMP 190$ 130$: CMP R0,#OP.DEF ;DEFAULT STATEMENT BNE 140$ CALL SCAN ;CHECK FOR THE ':' CMP R0,#OP.CLN BNE 134$ MOV SWP,R5 ;POINTER TO SWITCH BLOCK BEQ 132$ ;IF ZERO, NOT IN A SWITCH CALL GENLB1 ;01 MOV R0,DEFLAB(R5) ;SAVE DEFAULT LABEL AND CALL LREC ;PUT OUT THE LABEL BR 146$ 132$: MOV #ERR06,R0 ;DEFAULT NOT IN SWITCH CALL ERROR1 ;01 BR 146$ 134$: JMP 190$ ; ; CASE. ; 140$: CMP R0,#OP.CAS ;CASE STATEMENT BNE 150$ ;NO INC INITFG ;MAKE ":" AND "," SPECIAL. CALL SCAN ;GRAB TOKEN. CALL CLRTRE ;CLEAR TREE SPACE. CALL CONXPR ;GET CONSTANT EXPRESSION. MOV R5,R1 ;CASE VALUE CLR INITFG ;PUT IT BACK. CMP LEX0,#OP.CLN ;TEST DELEIMITER. BNE 148$ ;UGH. MOV SWP,R5 ;PTR TO THE SWITCH BLOCK BEQ 144$ ;NOT IN SWITCH MOV NCASES(R5),R4 CMP R4,#MCASES ;CHECK FOR TOO MANY CASES BHIS 142$ INC NCASES(R5) ;1 MORE ASL R4 ;4 BYTES PER ENTRY ASL R4 ADD R5,R4 ADD #CASES,R4 ;ADDRESS OF WHERE THIS CASE GOES MOV R1,(R4)+ ;VALUE CALL GENLB1 ;01 MOV R0,(R4)+ ;LABEL CALL LREC BR 146$ 142$: MOV #ERR08,R0 ;TOO MANY CASES CALL ERROR1 ;01 BR 146$ 144$: MOV #ERR09,R0 ;CASE NOT IN SWITCH CALL ERROR1 ;01 146$: JMP 10$ 148$: JMP 190$ 150$: CMP R0,#OP.SWI ;SWITCH STATEMENT BNE 160$ MOV BLAB,-(SP) ;GET NEW BREAK LABEL CALL GENLB1 ;01 MOV R0,BLAB MOV SWP,-(SP) ;SAVE SWITCH BLOCK POINTER CALL PEXPR BCS 154$ CALL CHWORD ;CAN ONLY SWITCH INTEGERS MOVB #'S,R0 ;SWITCH CALL CODC1 ;01 CALL CODNL1 ;01 CALL OUTREE CALL GENLB1 ;SKIP OVER BODY ;01 MOV R0,-(SP) CALL JREC MOV #SBSIZE,R0 ;GET SWITCH BLOCK CALL $ALLOC MOV R0,SWP CLR NCASES(R0) CLR DEFLAB(R0) CLR R5 ;THE BODY CALL STATE MOV BLAB,R0 ;FREE BREAK CALL JREC MOV (SP)+,R0 ;PUT OUT THE CASES CALL LREC MOV SWP,R5 ;IF NO DEFAULT, SET DEF. TO BREAK TST DEFLAB(R5) BNE 152$ MOV BLAB,DEFLAB(R5) 152$: CALL PUTAB ;PUT OUT CASES MOV BLAB,R0 ;BREAK LABEL CALL LREC MOV SWP,R0 ;RELEASE SWITCH BLOCK CALL $FREE MOV (SP)+,SWP MOV (SP)+,BLAB BR 210$ 154$: MOV (SP)+,SWP ;ERROR MOV (SP)+,BLAB BR 195$ 160$: CALL CLRTRE ;IF ALL ELSE FAILS CALL EXPR ;TRY AN EXPRESSION STATEMENT MOVB #'E,R0 ;OUTPUT EFFECT OP CALL CODC1 ;01 CALL CODNL1 ;01 CALL OUTREE ;AND THE TREE BR 180$ 170$: CALL SCAN ;SEMICOLON CHECKS 180$: CMP LEX0,#OP.SEM ;IS IT THE REQUIRED SEMICOLON BEQ 210$ ;YES MOV #ERR14,R0 ;MISSING SEMICOLON ERROR BR 192$ 190$: MOV #ERR09,R0 ;STATEMENT SYNTAX 192$: CALL ERROR1 ;PRINT ERROR ;01 195$: MOV LEX0,R0 ;RESYNCH IN THE SOURCE 200$: CMP R0,#OP.SEM ;SKIP OVER BAD INPUT BEQ 210$ CMP R0,#OP.RBR BEQ 210$ CMP R0,#OP.EOF BEQ 210$ CALL ESCAN BR 200$ 210$: MOV (SP)+,R5 ;RETURN MOV (SP)+,R4 MOV (SP)+,R3 MOV (SP)+,R2 MOV (SP)+,R1 MOV (SP)+,R0 RETURN ;+ ; ** CHWORD - CHECK FOR INTEGER OPERANDS ; ; CERTAIN CONTEXTS (SWITCHES, IF STATEMENTS, ETC.) REQUIRE AN INTEGER ; EXPRESSION. THIS ROUTINE VALIDATES THAT THE RESULT TYPE OF AN EXPR- ; ESSION IS ENOUGH LIKE AN INTEGER TO BE USED. ; ; ENOUGH LIKE AN INTEGER MEANS INT, CHAR, UNSIGNED OR POINTER. ; ; INPUTS: ; R5=TREE ; ; USES: ; R0, R2 ;- CHWORD: MOV R5,R2 ;GET THE CALL GTYPE ;LINEARISED TYPE CMP R0,#TY.LNG ;TEST FOR INTEGERS BLO 10$ ;OK MOV #ERR15,R0 ;ERROR IF NOT CALL ERROR1 ;01 10$: RETURN ;+ ; ** DOLAB - DEFINE A LABEL ; ; THIS ROUTINE PERFORMS THE DIRTY WORK OF DEFINING A LABEL. THE NAME ; MUST BE EITHER UNDEFINED (A NEW LABEL) OR FORWARD REFERENCED (THE ; GOTO HAS ALREADY APPEARED). ; ; IF THE NAME IS UNDEFINED AN INTERNAL LABEL NUMBER IS ASSIGNED. IN ; ANY CASE AN 'L' (DEFINE LABEL) RECORD GETS PUT OUT. ; ; INPUTS: ; LEX0=THE ID TOKEN ; LEX1=':' ; ; USES: ; R0, R5 ;- DOLAB: MOV VAL0,R5 ;SYMBOL POINTER MOVB S.CLAS(R5),R0 ;PICK UP ITS CLASS CMP R0,#CL.UND ;IF UNDEFINED OK BEQ 10$ ; CMP R0,#CL.FOR ;IF FORWARD REFERENCED LABEL BEQ 20$ ;OK MOV #ERR10,R0 ;ILLEGAL CALL ERROR1 ;LABEL ;01 BR 30$ ; 10$: CALL GENLB1 ;IF UNDEF, NEED LABEL ;01 MOV R0,S.ADDR(R5) ;SET NEW LAB INTO SYMBOL 20$: MOVB #CL.LAB,S.CLAS(R5) ;SET CLASS MOV S.ADDR(R5),R0 ;PUT OUT CALL LREC ;'L' RECORD 30$: RETURN ;DONE ;+ ; ** DOGOTO - GOTO STATEMENT ; ; THIS ROUTINE PROCESSES GOTO STATEMENTS. THE STATEMENT SYNTAX IS OK. ; THE LABEL MUST BE EITHER UNDEFINED, A LABEL OR AN ALREADY EXISTING ; FORWARD REFERENCE. ; ; A 'J' RECORD (UNCONDITIONAL JUMP) IS PUT OUT. ; ; INPUTS: ; LEX0=THE ID ; ; USES: ; R0, R4, R5 ;- DOGOTO: MOV VAL0,R5 ;SYMBOL NODE POINTER MOVB S.CLAS(R5),R0 ;PICK UP ITS CLASS CMP R0,#CL.UND ;GOTO UNDEF -> FORWARD REF. BEQ 10$ ; CMP R0,#CL.LAB ;LABELS AND FORWARD ARE OK BEQ 20$ ; CMP R0,#CL.FOR ; BEQ 20$ ; MOV #ERR11,R0 ;GOTO NON LABEL CALL ERROR1 ; ;01 BR 30$ ; 10$: CALL GENLB1 ;MAKE NEW FORWARD REFERENCE ;01 MOV R0,S.ADDR(R5) ;SET LABEL NUMBER MOVB #CL.FOR,S.CLAS(R5) ;SET CLASS 20$: MOV S.ADDR(R5),R0 ;PUT OUT THE JUMP CALL JREC ; 30$: RETURN ;DONE ;+ ; ** DORET - RETURN STATEMENT ; ; THIS ROUTINE COMPILES RETURN STATEMENTS. MOST OF THE WORK HAS TO DO ; WITH TYPE CONVERTING THE RETURN VALUE OF THE FUNCTION. THIS IS DONE ; BY ROUTINE RCVN (CC103). ; ; USES: ; ALL ;- DORET: CALL SCAN ;Get the next token ;09+ CMP R0,#OP.SEM ;Check for "return;" BEQ 20$ ;Exit if no expression ;09- CALL CLRTRE ;GET EXPRESSION ;08+ CALL EXPR ; ;08- CALL RCVN ;DO RETURN CONVERSIONS MOVB #'R,R0 ;TREE FOR RETURN CALL CODC1 ; ;01 CALL CODNL1 ; ;01 CALL OUTREE ; 20$: MOV FRETLB,R0 ;THEN JUMP OFF TO THE RET. LABEL CALL JREC ; RETURN ;SET WINDOW TO DELIMITER ;08 ;+ ; ** PUTAB - PUT OUT SWITCH TABLE ; ; THIS ROUTINE DIGS AROUND IN THE SWITCH BLOCK, AND OUTPUTS THE TABLE ; IN THE FORM OF 'W' AND 'V' RECORDS. ; ; INPUTS: ; R5=POINTER TO SWITCH BLOCK ; ; USES: ; R5, R4, R0 ;- PUTAB: CALL 30$ ;FIRST W RECORD IS THE DEFAULT MOV DEFLAB(R5),R0 ;LABEL CALL CODNM1 ; ;01 CALL CODNL1 ; ;01 MOV NCASES(R5),R4 ;GET # OF CASES ADD #CASES,R5 ;POINT R5 AT THE CASES 10$: DEC R4 ;BREAK IF NO MORE BMI 20$ ; CALL 30$ ;W MOV (R5)+,R0 ;VALUE CALL CODNM1 ; ;01 MOVB #' ,R0 ; CALL CODC1 ; ;01 MOV (R5)+,R0 ;LABEL CALL CODNM1 ; ;01 CALL CODNL1 ; ;01 BR 10$ ;GET THEM ALL 20$: MOVB #'V,R0 ;END OF THE TABLE CALL CODC1 ; ;01 CALLR CODNL1 ; ;01 30$: MOVB #'W,R0 ;PUT OUT "W " CALL CODC1 ; ;01 MOVB #' ,R0 ; CALLR CODC1 ; ;01 ;+ ; ** PEXPR - PARENTHESIZED EXPRESSION ; ; READ IN A PARENTHESIZED EXPRESSION. RETURN A POINTER TO THE TREE. ; ; OUTPUTS: ; R5=TREE POINTER ;- PEXPR: CALL SCAN ;MUST START WITH A '(' CMP R0,#OP.LPA ; BNE 10$ ;ERROR CALL CLRTRE ;GET EXPRESSION CALL SCAN ; CALL EXPR ; CMP LEX0,#OP.RPA ;MUST STOP ON A RIGHT PAREN. BNE 10$ ;ERROR CLC ;GOOD RETURN BR 20$ ; 10$: MOV #ERR12,R0 ;PAREN. EXPR. REQUIRED CALL ERROR1 ; ;01 SEC ;ERROR RETURN 20$: RETURN ; ;+ ; ** DECLS - READ DECLARATIONS AT THE START OF A FUNCTION ; ; THIS ROUTINE IS CALLED AT THE BEGINNING OF A FUNCTION TO READ IN THE ; DECLARATIONS OF THE LOCAL VARIABLES. ; ; IT ALSO PERFORMS CERTAIN TRANSFORMATIONS ON THE TYPE AND DIMP OF THE ; ARGUMENTS, AND TRANSFORMS PARAMETERS INTO AUTOS. ; ; AT THE END OF ALL THIS, THE 'N' RECORD IS PUT OUT. ; ; USES: ; ALL ;- DECLS: MOV #UFAUTO,OFFSET ;OFFSET IS 2 BEFORE FIRST LOCAL ;02 10$: CALL CANDT ;GET CLASS AND TYPE MOV CLASS,R0 ;IF BOTH COME BACK 0 BIS TYPE,R0 ;ASSUME NO DECLARATION BEQ 40$ ; TST CLASS ;IF NO CLASS DEFAULT TO AUTO BNE 20$ ; MOV #CL.AUT,CLASS ; 20$: TST TYPE ;IF NO TYPE DEFUALT TO INT BNE 30$ ; MOV #TY.INT,TYPE ; 30$: CALL DECLST ;PROCESS THE LIST OF DECLARATORS BR 10$ ;AND TRY FOR ANOTHER DECLARATION ; ; END OF THE DECLARATIONS. ; PUT OUT THE 'N' DIRECTIVE. ; 40$: MOVB #'N,R0 ;OPCODE CALL CODC1 ; ;01 MOVB #' ,R0 ; CALL CODC1 ; ;01 MOV OFFSET,R0 ;THE NUMBER OF BYTES OF AUTOS NEG R0 ; SUB #2-UFAUTO,R0 ; STACK ALREADY HAS ROOM FOR 2 BYTES ;u3+ BPL 42$ ; SKIP IF POSITIVE CLR R0 ; CAN'T ALLOCATE NEGATIVE 42$: CALL CODNM1 ; ;01 ;u3- MOVB #' ,R0 ; CALL CODC1 ; ;01 MOV NXTREG,R0 ;HIGHEST REGISTER CALL CODNM1 ; ;01 MOV #' ,R0 ; ;04+ CALL CODC1 ; MOV FSYMBL,R0 ;THE FUNCTION SYMBOL ENTRY MOVB S.TYPE(R0),R0 ;GET TYPE CODE CALL CODNM1 ; ;04- MOV #' ,R0 ; CALL CODC1 ; ;01 MOV FSYMBL,R0 ;THE FUNCTION NAME ADD #S.NAME,R0 ; CALL CODST1 ;MOSTLY FOR PROFILER ;01 CALL CODNL1 ; ;01 ; ; WALK DOWN THE FORMAL PARAMETER LIST. ; TRANSFORM THEM ALL INTO AUTOS. ; ARRAYS BECOME POINTERS. ; CHAR BECOMES INT; FLOAT BECOMES DOUBLE. ; MOV #PARMS,R4 ;POINT AT THE PARAMETER LIST MOV #UFARG,R3 ;ADDRESS OF THE FIRST ARG. ;02 50$: CMP R4,PARPTR ;BREAK IF DONE ALL ARGS BHIS 90$ ; MOV (R4)+,R5 ;GET POINTER TO ARGUMENT S.T. NODE MOV S.DIMP(R5),R2 ;POINTER TO ITS DIMENSIONS BEQ 60$ ;BR IF SCALAR CMP D.TYPE(R2),#DT.ARY ;IS IT AN ARRAY BNE 80$ ;NO MOV #DT.PTR,D.TYPE(R2) ;YES, CHANGE IT TO POINTER CLR D.BOUN(R2) ;BECAUSE THET IS HOW ARRAYS GET PASSED BR 80$ ; 60$: CMPB S.TYPE(R5),#TY.CHR ;CHAR BECOMES INT BNE 70$ ; MOVB #TY.INT,S.TYPE(R5) ; BR 80$ ; 70$: ;u1+/05+ TSTB FFLAG ;IS FLOAT DEFAULT? BNE 75$ ;BR IF THAT'S WHAT'S WANTED CMPB S.TYPE(R5),#TY.FLT ;FLOAT BECOMES DOUBLE BNE 80$ ; MOVB #TY.DBL,S.TYPE(R5) ; ;u1- 75$: ;MAIN SEQUENCE ;05- ; ; CONVERT ARGS TO AUTO. ; INITIALISE REGISTER ARGUMENTS. ; 80$: CMPB S.CLAS(R5),#CL.DRG ;IS THIS A REGISTER ARGUMENT BNE 82$ ;NO MOVB #CL.REG,S.CLAS(R5) ;MAKE PLAIN REGISTER MOV S.ADDR(R5),SRARG2 ;SAVE REGISTER NUMBER MOV R3,SRARG4 ;AND OFFSET FROM R5 MOV #'E,R0 ;TREE FOR EFFECT CALL CODC1 ; ;01 CALL CODNL1 ; ;01 MOV R5,-(SP) ;PUT OUT THE ASSIGNMENT MOV #SRARG,R5 ; CALL OUTREE ; MOV (SP)+,R5 ; BR 84$ ; 82$: MOVB #CL.AUT,S.CLAS(R5) ;ALL ARGUMENTS ARE AUTOMATIC MOV R3,S.ADDR(R5) ;SET CORRECT PLACE ON THE STACK 84$: CALL SLENG ;COMPUTE POSITION OF NEXT ARG ADD R0,R3 ; BR 50$ ; ; ; LOOK THROUGH SYMBOL TABLE. ; PUT OUT SYMBOL TABLE ENTRIES FOR AUTOS, REGISTERS AND STATICS. ; 90$: MOV #100$,R5 ;PROCESS ROUTINE ;07+ CALL SYWALK ;HERE WE GO RETURN ;THERE WE WENT 100$: MOVB S.CLAS(R5),R0 ;GRAB CLASS. CMP R0,#CL.AUT ;DO AUTOS. BEQ 110$ ; CMP R0,#CL.REG ;REGISTERS. BEQ 110$ ; CMP R0,#CL.SIN ;AND INTERNAL STATIC. BNE 120$ ; 110$: CALL PRSTE ;PUT OUT ENTRY. 120$: RETURN ; ;07- .END