.IIF NDF RSX RSX = 1 ;Assume RSX ;01 .TITLE CC100 .ident /X01.25/ .NLIST BEX, CND .ENABL LC, GBL .LIST MEB ;01- ; ; C COMPILER ; EXTERNAL DEFINITIONS ; ; VERSION X01 ; ; DAVID G. CONROY 14-NOV-77 ; LAST UPDATED: 23-MAY-79 ; ; Edit history ; 01 04-Mar-80 MM Updated for RT11 ; 02 02-Jun-80 MM Better symbol table diagnostics ; 03 22-Jul-80 MM Fixed psects, allowing pure code, strings ; 04 17-Nov-80 MM Always treat char's as 1-byte things ; 05 24-Dec-80 MM Char's may be assigned to registers. ; 06 25-Feb-80 MM Added one-line message ; 07 19-Oct-81 MM RT11 file create changes ; 08 04-Dec-81 MM Typedef bug fix (from Unimation) == Unimation u1 ; 09 04-Dec-81 MM Added "psect" ; 10 09-Dec-81 MM Added warning in "int foo 123;" ; u1 16-Sep-81 CCG Fixed bug when using * in typedef (see 08) ; u2 28-Sep-81 CCG Added code to distinguish members of different structs ; 11 09-Feb-82 MM Merged Unimation Sources. Added nerrs >= maxerr exit ; 12 07-Mar-82 RBD Changes for tree structured symbol table ; 13 21-Mar-82 MM/DGC Totally redid symbol tables ; 14 23-Mar-82 MM "Undefined" message improvement ; 15 19-Jun-82 MM Allow int/extern int redefinition. ; 16 01-Jul-82 MM Psect names -- comments only ; u3 06-Aug-82 CCG Allow register arrays in function args ; 17 02-Jul-82 JSL In dsect names, $ ==> ~; fill with ~, not ., for short ; psect names. ; 18 23-Jul-82 MM/CCG Allow arguments to psect and dsect. ; 19 02-Aug-82 JSL Once more, with feeling - edit 18 clobbered edit 17. ; Also, don't fill short dsect names. ; 20 16-Oct-82 RBD Add "ident" directive, fixed patch level to match ; that in CC0HD. Add conditional code to retain old ; PSECT names for those of us who have zillions of ; MACRO routines. ; 21 30-Jan-83 MM Merged Unimation u3 into Dec sources. ; 22 ??-Oct-84 CMF(cwru) Fixed "int foo();" ; 23 12-Dec-84 CMF(cwru) foo(a, a) now reports redeclaration error ; 24 06-Mar-85 MM Added ;22 and ;23 to master sources ; 25 18-Mar-85 MM Moved EDTLVL to CC0HD.MAC, added FATAL1 ; 26 21-Jul-85 KR Don't rewind input file if preprocessing disabled. ; (Caused ?MON-F-No device nnnnnn under RT-11) ; ; End edit MAXERR = 40. ; Abort compilation if more than MAXERR errors. ; ;20+ ; ***************** ; ** N O T I C E ** ; ***************** ; ; Update the following symbolic definition to match the ; "revision" level in the .IDENT directive at the top of ; CC0HD.MAC. This is vital to support of DECUS C. ; ;EDTLVL = 14. ; Patch level -- update at each compiler patch ;25 ; to match rev level in CC0HD. ;20- .GLOBL CC100 .GLOBL FRETLB .GLOBL FSYMBL .GLOBL CANDT .GLOBL CANDT1 .GLOBL DUPDIM .GLOBL ERROR1 .GLOBL FATAL1 ;25 .GLOBL WARN1 .GLOBL ERRSYM ;13 .GLOBL WARNSY ;13 .GLOBL NERRS .GLOBL MBUF .GLOBL CLASS .GLOBL TYPE .GLOBL DIMP .GLOBL DOPE .GLOBL OFFSET .GLOBL MOFSET .GLOBL PARMS .GLOBL PARPTR .GLOBL NXTREG .GLOBL DECLST .GLOBL SHORTF .GLOBL USIGNF .GLOBL LONGF .GLOBL MFLAG ;26 .IF NE RSX ;01 .MCALL CALLR .ENDC ;01 ; ; GLOBAL DATA (HAS BEEN MOVED TO CC1GBL.MAC) ;01+ ; ;FSYMBL: .BLKW 1 ;SYMBOL NODE OF CURRENT FUNCTION ;FRETLB: .BLKW 1 ;FUNCTION RETURN LABEL ;CLASS: .BLKW 1 ;DECLARATION CLASS ;TYPE: .BLKW 1 ;DECLARATION TYPE ;DIMP: .BLKW 1 ;DECLARATION DIMP ;DOPE: .BLKW 1 ;DECLARATION DOPE ;OFFSET: .BLKW 1 ;DECLARATION OFFSET ;MOFSET: .BLKW 1 ;DECLARATION MAX OFFSET ;NXTREG: .BLKW 1 ;DECLARATION NEXT REGISTER ;PARPTR: .BLKW 1 ;FORMAL PARAMETER POINTER ;PARMS: .BLKW 20. ;FORMAL PARAMETER BUFFER ;PARMSE: .BLKW 0 ;END MARK ; 01- ; ; LOCAL DATA ; .PSECT LD100,OVR,GBL ;01 ANINT: .WORD 0 ;DUMMY SYMBOL NODE FOR CSINIT .BYTE 0 ;CLASS .BYTE TY.INT ;TYPE .WORD 0 ;DIMP .WORD 0 ;DOPE ATYPE: .BLKW 1 ;SAVE FOR TYPE IN DEFINE ACLASS: .BLKW 1 ;SAVE FOR CLASS IN DEFINE BITOFS: .BLKW 1 ;BIT OFFSET (FOR FIELDS) FIELD: .BLKB 1 ;FIELD FLAG (DEFINE) FWIDTH: .BLKB 1 ;FIELD SIZE (DEFINE) DOPEPT: .BLKW 1 ;FOR BUILDING STRUCT DOPE LIST LONGF: .BLKW 1 ;'LONG' FLAG SHORTF: .BLKW 1 ;'SHORT' FLAG USIGNF: .BLKW 1 ;'UNSIGNED' FLAG UNION: .BLKW 1 ;DECLARING A UNION FLAG AF: .BLKB 1 ;ARRAY FLAG FF: .BLKB 1 ;FUNCTION FLAG RF: .BLKB 1 ;REDEFINITION FLAG MBUF: .BLKB 80. ;MESSAGE FORMAT BUFFER (ERROR/WARN) .EVEN ;01 ; ; ASCII ; .PSECT ER100 ;01 .MACRO MODASC X,Y $$$$$$ = X/Y $$$$$$ = $$$$$$-<$$$$$$/10.*10.> ; MOD 10 .IF NE Y-1 .IF NE $$$$$$ .BYTE $$$$$$+'0 .ENDC .IFF .BYTE $$$$$$+'0 .ENDC .ENDM MODASC WHOAMI: .ASCII /@ Decus C patch level / ;06+ .IIF NDF EDTLVL EDTLVL = 0 MODASC EDTLVL,10000. MODASC EDTLVL,1000. MODASC EDTLVL,100. MODASC EDTLVL,10. MODASC EDTLVL,1. .ASCIZ /, Compilation date: / .IF DF OLDPSC ;20+ OPSVER: .ASCIZ /@ ***** Special version with old P-Section names *****/ .ENDC ;20- INTRO: .ASCIZ <15>"Begin phase 1." INFUNC: .ASCIZ / in function "/ ATLINE: .ASCIZ / (defined at line / ;13/14 PSS01: .ASCIZ "U P" ;PSECT LEADIN ;02 DSS01: .ASCIZ "U D" ;DSECT LEADIN ;02 IDS01: .ASCIZ "V " ;IDENT LEADIN ;20 ERR01: .ASCIZ "Class must be external or static" ERR02: .ASCIZ "External syntax" ERR03: .ASCIZ "Compound statement required" ERR04: .ASCIZ "Too many class specifiers" ERR05: .ASCIZ "Too many type specifiers" ERR06: .ASCIZ "Misplaced 'long', 'short' or 'unsigned'" ERR07: .ASCIZ "Declaration syntax" ERR08: .ASCIZ "Declaration semantically forbidden:" ERR09: .ASCIZ "Structure offset redeclaration:" ERR10: .ASCIZ "Redeclaration of symbol" ERR11: .ASCIZ "Formal parameter required:" ERR12: .ASCIZ "Argument semantically forbidden:" ERR13: .ASCIZ "Zero length row for" ERR14: .ASCIZ "Too many initialisers for" ;ERR15: .ASCIZ "Constant initialiser required for" ERR16: .ASCIZ "Too many structure initialisers for" ERR17: .ASCIZ "Cannot initialise union or automatic aggregate for" ERR18: .ASCIZ "Field wider than 16 bits" ERR19: .ASCIZ "Field base type not int or unsigned" ERR20: .ASCIZ "Field must be a scalar:" ERR21: .ASCIZ "Field offset changed:" ERR22: .ASCIZ "Field cannot be initialised (sorry):" ERR23: .ASCIZ "Bad psect, dsect or ident directive" ;20 ERR24: .ASCIZ "Warning: initializers should have an '='" ;10 ERR25: .ASCII "Compilation terminated, more than " ;11+ MODASC MAXERR,10000. MODASC MAXERR,1000. MODASC MAXERR,100. MODASC MAXERR,10. MODASC MAXERR,1. .ASCIZ " errors." ;11- .EVEN ;+ ; ** CC100 - PHASE 1 MAINLINE ; ; THIS IS MAINLINE OF THE PARSER. WHEN CALLED FROM THE ROOT, SFDB IS ; OPEN AND CONTAINS THE EXPANDED SOURCE, PUT THERE BY CC000. IT MUST ; BE REWOUND BEFORE USE. IFDB IS OPEN AND IS USED FOR INTERMEDIATE ; LANGUAGE. ; ; CC100 FIRST CALLS KWINIT TO PUT THE RESERVED WORDS IN THE SYMBOL ; TABLE, THEN LOOPS AROUND (UNTIL EOF) COMPILING EXTERNALS. WHEN THE ; END OF THE SOURCE IS REACHED, THE GLOBAL RECORDS ARE OUTPUT TO THE ; INTERMEDIATE FILE, AND CONTROL RETURNS TO THE ROOT. ; ; SOURCE ERRORS ARE ACCUMULATED IN THE GLOBAL CELL NERRS. THIS CELL ; IS CHECKED BY THE ROOT; PHASE 2 IS NOT CALLED IF THERE WERE ERRORS ; IN PHASE 1. TOO BAD TO ALL YOU SLOBS WITH UNIX 5 PROGRAMMES. IF ; THERE ARE TOO MANY ERRORS, THE COMPILATION ABORTS THEN AND THERE. ;- .PSECT CC100 ;01+ CC100: TSTB DEBUGF ;DEBUG? ;11 BEQ 5$ ;NO MOV #INTRO,R0 ;SAY HELLO CALL CCTTY ; BPT ;TRAP TO ODT ;01 5$: ;01+ TSTB MFLAG ;Was preprocessing disabled? ;26 BNE 6$ ;If so then don't rewind source ;26 MOV #P1IN,R0 ;REWIND THE SOURCE CALL REWIND ; ;01- 6$: ;26 .IF EQ RSX ;07+ MOV #IPMTR,R1 ;CREATE THE INTERMEDIATE FILE CALL DOOPEN ;GO FOR IT .ENDC MOV #WHOAMI,R0 ;SET A NOTE IN THE ;06+ CALL CODST1 ;INTERMEDIATE FILE MOV #DATBUF,R0 ;SAVE TODAY'S DATE, TOO CALL CODST1 ; CALL CODNL1 ; ;06- .IF DF OLDPSC ;20+ MOV #OPSVER,R0 ;NOTE OLD PSECTS CALL CODST1 CALL CODNL1 .ENDC ;20- CALL KWINIT ;INITIALISE SYMBOL TABLE CALL OREC ;SET DATA PSECTION ;03 CALL ADVANC ;GET FIRST TOKEN 10$: CMP LEX1,#OP.EOF ;AT END OF FILE BEQ 20$ ;YES CALL EXDEFN ;COMPILE AN EXTERNAL BR 10$ ; 20$: CALL GLOBS ;PUT OUT "G" DIRECTIVES. CALL MOSYMT ;PUT OUT MEMBER SYMBOLS. ;01+ MOV #P1OUT,R0 ;AND FLUSH THE BUFFER CALLR FLUSH ;RETURNING TO MAINLINE ;01- ;+ ; ** EXDEFN - COMPILE AN EXTERNAL DECLARATION ; ; THIS ROUTINE COMPILES A SINGLE EXTERNAL DECLARATION, BE IT A DATA ; DECLARATION OR A FUNCTION DECLARATION. IT JUST RETURNS ON SEMICOLON ; (NULL DECLARATION) AND EOF. ; ; THERE IS SOME PDP-11 SPECIFIC CODE HERE. ALL OF IT HAS TO DO WITH ; WORD ALLIGNMENT, IN THE DISGUISE OF CALLS TO ALLIGN. ; ; USES: ; ALL ;- EXDEFN: CMP LEX1,#OP.EOF ;END OF FILE BEQ 10$ ;YES CMP LEX1,#OP.IDN ;"IDENT"? ;20+ BNE 1$ ;NO CALL DOIDIR ;YES, DO IT BR 4$ ;EXIT, WITH TRAILING ";" CHECK ;20- 1$: CMP LEX1,#OP.SEC ;"PSECT"? ;09+ BNE 2$ ;NO CALL DOPSEC ;YES, DO IT BR 4$ 2$: CMP LEX1,#OP.SED ;"DSECT"? BNE 6$ ;NO, CONTINUE CALL DODSEC ;YES, DO IT 4$: JMP 42$ ;AND EXIT, CHECKING FOR SEMICOLON 6$: ;09- CMP LEX1,#OP.SEM ;NULL DECLARATION BNE 15$ ;NO CALL SCAN ;SKIP IT 10$: JMP 70$ ;AND RETURN 15$: CLR FSYMBL ;SET NOT IN FUNCTION CALL CANDT ;GET CLASS AND TYPE TST CLASS ;IF NO CLASS BNE 20$ ;MAKE IT MOV #CL.GBD,CLASS ;SYMDEF 20$: TST TYPE ;IF NO TYPE BNE 22$ ;MAKE MOV #TY.INT,TYPE ;INT 22$: MOV CLASS,R0 ;GET CLASS CMP R0,#CL.TYP ;TYPEDEF BEQ 24$ ;YES CMP R0,#CL.SIN ;STATIC (INTERNAL) BNE 23$ ;NO MOV #CL.SEX,CLASS ;YES, SET STATIC (EXTERNAL) BR 24$ ; 23$: CMP R0,#CL.GBD ;CLASS BEQ 24$ ;MUST CMP R0,#CL.GBR ;BE BEQ 24$ ;EXTERNAL MOV #ERR01,R0 ;OR ITS CALL ERROR1 ;AN ERROR ;01 MOV #CL.GBD,CLASS ;FORCE SYMDEF 24$: CMP LEX1,#OP.SEM ;IF ONLY A TYPE BNE 25$ ;THEN CALL SCAN ;SKIP THE SEMICOLON JMP 70$ ;AND RETURN ;24 25$: CALL GDECLR ;GET A DECLARATOR BCS 50$ ;ERROR CLRB FIELD ;NOT A FIELD! CALL DEFINE ;DECLARE IT CMP CLASS,#CL.GBR ;IS THIS A GLOBL REFERENCE BEQ 26$ ;YES CMP CLASS,#CL.TYP ;HOW ABOUT A TYPEDEF BNE 27$ ;NO 26$: CALL SCAN ;IF SO, NO BODY IS ALLOWED BR 41$ ;GO CHECK FOR DELIMITER 27$: ; ;03+ ; DECIDE WHETHER IT'S A GLOBAL DATA ($DATA) OR A FUNCTION ($PROG) ;16 ; AND PUT OUT THE CORRECT .PSECT ; CLR -(SP) ;PUSH FLAG FOR LATER TEST REPEAT MOV S.DIMP(R5),R0 ;NON-ZERO IF A FUNCTION BEQ 28$ ;NO CMP D.TYPE(R0),#DT.FUN ;PERHAPS BNE 28$ ;NO INC (SP) ;YES, REMEMBER THE TEST CMPB S.CLAS(R5),#CL.GBD ;CHECK FOR EXTERN ;22+ BNE 2900$ ;BR IF NOT EXTERN CMP LEX1,#OP.SEM ;SEMICOLON? BEQ 29$ ;YES CMP LEX1,#OP.CMA ;HOW ABOUT COMMA? BNE 2900$ ;NO 29$: MOVB #CL.GBR,S.CLAS(R5) ;FIX THE CLASS CALL SCAN ;GET NEXT TOKEN CALL PURGE ;CLEAN UP SYMBOL TABLE TST (SP)+ ;FIX STACK MOV LEX0,R0 ;RELOAD TOKEN BR 41$ ;GO CONTINUE 2900$: ;HERE IF NOT SPECIAL CASE ;22- CALL PREC ;SWITCH TO $PROG PSECT 28$: ;REJOIN MAINSTREAM ;03- MOVB #'D,R0 ;PUT OUT 'D' RECORD CALL CODC1 ; ;01 MOVB #' ,R0 ; CALL CODC1 ; ;01 MOV R5,R0 ; ADD #S.NAME,R0 ; CALL CODST1 ; ;01 CALL CODNL1 ; ;01 CALL PRSTE ;PUT OUT SYMBOL TABLE TST (SP)+ ;WELL, WAS IT A FUNCTION? ;03+ BEQ 30$ ;NO MOV R5,FSYMBL ;SAVE POINTER TO FUNCTION NAME CALL CFUNC ;COMPILE IT CALL OREC ;SWITCH BACK TO .DATA. PSECT CALL ALLIGN ;JUST IN CASE ;03- BR 70$ ;RETURN 30$: CALL SCAN ;IF THE NEXT TOKEN IS ',' OR ';' CMP R0,#OP.CMA ; BEQ 32$ ; CMP R0,#OP.SEM ; BNE 34$ ; 32$: CALL SLENG ;ALLOCATE BSS CALL BREC ; BR 40$ ; 34$: CMP R0,#OP.ASG ;IS IT AN '=' (7TH EDITION) BEQ 35$ ;YES ;10+ MOV #ERR24,R0 ;NO, OLD FASHIONED SYNTAX CALL WARN1 ;SO WARN THE USER BR 36$ ;AND CONTINUE 35$: ;'=' GIVEN, SO ;10- CALL SCAN ;EAT IT 36$: MOV #1,R4 ;OTHERWISE DO CALL CINIT ;INITIALISERS (FLEX) 40$: CALL ALLIGN ;ALLIGN EVEN MOV LEX0,R0 ;PICK UP DELIMITER TOKEN 41$: CMP R0,#OP.CMA ;IF COMMA BEQ 24$ ;GO GET THE NEXT DECLARATOR 42$: ; (HERE AFTER "PSECT" SCAN) ;09 CMP R0,#OP.SEM ;IF SEMICOLON BEQ 70$ ;RETURN 50$: MOV #ERR02,R0 ;SYNTAX ERROR CALL ERROR1 ; ;01 MOV LEX0,R0 ;SKIP OVER BAD INPUT 60$: CMP R0,#OP.LBR ;IF OPEN BRACE BNE 65$ ;THEN MOV R5,FSYMBL ;SAVE POINTER TO FUNCTION NAME MOV #1,R5 ;COMPILE A FUNCTION CALL STATE ;STATEMENT BR 70$ ;RETURN 65$: CALL ESCAN ;GET NEXT TOKEN CMP R0,#OP.SEM ;IF SEMICOLON BEQ 70$ ;OR CMP R0,#OP.EOF ;END OF FILE BNE 60$ ;JUST 70$: RETURN ;RETURN ;+ ;09+ ; ** DOPSEC - COMPILE PSECT DIRECTIVE ; ** DODSEC - COMPILE DSECT DIRECTIVE ;18+ ; ** DOIDIR - COMPILE IDENT DIRECTIVE ;20 ; ; DOPSEC is called by EXDEFN to compile a psect directive. ; DODSEC is called by EXDEFN to compile a dsect directive. ; DOIDIR is called by EXDEFN to compile an ident directive. ;20 ; ; The approved syntax is ; ; psect "XXX qualif"; /* "XXX" is any three letters */ ; psect ""; /* null string -> normal sect's */ ; psect " qualif"; /* Set qualifiers for c$code */ ; /* only 3 letters used, if less */ ; /* than 3 letters, '$' fills */ ; ; dsect "QWERTY qualif"; /* Set the data section */ ; dsect ""; /* Set the default section */ ; dsect " qualif" /* Set qualifiers for c$data */ ; ; ident "FOOBAR"; /* Set module ident */ ;20 ; ; Note that the optional qualifiers (up to 8 bytes) are passed directly to AS. ; The compiler does not warn you of any errors when specifying qualifiers. ; Since "ident" uses common code, it will accept qualifiers. They are ;20 ; ignored. ;20 ; ; psect "XXX" changes the code generator program sections ; FROM TO ; C$CODE XXXCOD ; C$DATA XXXDAT ; C$STRN XXXSTR ; C$MWCN XXXMWC ; C$PROF XXXPRF ;- DOIDIR: ;20+ mov #val0+6,r3 ; Allow 6 bytes mov #ids01,r4 ; Ident signal to pass 2 br psect1 ; Use common code ;20- DOPSEC: mov #val0+3,r3 ; Allow three bytes mov #pss01,r4 ; Psect signal to pass 2; also flags a ; "psect" for the filler code. br psect1 ; Continue common section DODSEC: mov #val0+6,r3 ; Allow six bytes mov #dss01,r4 ; Dsect signal to pass 2; also flags a ; "dsect" for the filler code. .br psect1 ; Continue common section psect1: clr -(sp) ; psect "" flag mov #val0,r2 ; r2 -> output buffer clrb (r2) ; In case "" string call scan ; Get the section name cmp lex1,#OP.CST ; '"' follows? bne pserr1 ; Error if not ;20 mov #'",r1 ; Delimiter for mapch call mapch ; Get first character bcs 30$ ; psect "" given cmp r0,#40 ; not null, or ? blos 20$ ; assume space or tab. ; ; Get 3 or 6 characters, map '$' to tilde ; 10$: cmp r2,r3 ; Gone too far? bhis pserr1 ; Exit if so ;20 cmp r0,#'$ ; Is it the fearsome "$"? ;19+ bne 15$ ; Not this time! mov #0176,r0 ; Change it to tilde to pacify AS 15$: ;19- movb r0,(r2)+ ; OK, output the char. call mapch ; Get another bcs 30$ ; br if psect/ident "foo"; cmp r0,#040 ; nope, is there a qualifier bhi 10$ ; not yet there isn't ; ; A qualifier was given. Skip blank/tabs ; 20$: cmp r4,#ids01 ; Ident directive? ;20 beq pserr1 ; (Yes, illegal syntax) ;20 call mapch ; Get the next char. bcs 30$ ; No qualifier was given cmp r0,#040 ; Yep, is it printable blos 20$ ; Loop some more mov r0,(sp) ; And save first byte of qualifier ; ; Now, (sp) is non-null if there's a qualifier. r2 > #val0 if there's ; a psect/dsect. ; ; Output as follows: ; U P[xxx][ qual] ; If the byte after 'P' (or 'D') is space, there's a qualifier. ; Note that there might not be a (p|d)sect value. ; ; If the ident directive was 'ident ""', skip it altogether ;20+ ; 30$: cmp r4,#ids01 ; ident directive? bne 35$ ; (no) cmp r2,#val0 ; Blank ident? blos 60$ ; Yes, skip it completely 35$: mov r4,r0 ; Leadin ;20- call codst1 ; Go for it mov #val0,r0 ; Value buffer cmp r0,r2 ; Is there anything stored there? bhis 60$ ; continue if not ; ; Pad a psect name, but not a dsect name, with '$' (after AS mangles it) ; Don't touch ident names. ;20+ ; cmp r4,#pss01 ; Doing a psect? bne 50$ ; (no, skip padding) ;20-/20-- 40$: cmp r2,r3 ; At the end yet? bhis 50$ ; Exit loop if so movb #0176,(r2)+ ; Output a tilde br 40$ ; Continue 50$: clrb (r2) ; Terminate the string call codst1 ; And output it ; ; If there's a qualifier, the stack will be non-null. ; ident's never have qual's, so exit if ident ; 60$: mov (sp)+,r2 ; Get first qualifier byte beq 100$ ; Exit if none. mov #011,r0 ; A tab after psect name call codc1 ; Output it mov r2,r0 ; Get the first byte mov #8.,r3 ; Maximum number of qualifier bytes br 80$ ; Don't get the first byte again ; 70$: call mapch ; Get the next one bcs 100$ ; Exit at the end 80$: cmp r0,#040 ; Garbage? blos 70$ ; Ignore it cmp r0,#'A ; Valid? blo pserr ; Junk, ignore it cmp r0,#'Z ; Upper alpha? bhi 90$ ; Continue if not add #040,r0 ; Make it lowercase 90$: cmp r0,#'A+040 ; Valid lowercase blo pserr ; Urk cmp r0,#'Z+040 ; Other end bhi pserr ; Urk dec r3 ; Too many bmi pserr ; Br if so call codc1 ; Output it br 70$ ; Go for another ; ; Done ; 100$: call codnl1 ; Ok, terminate the record call advance ; Restart the scanner callr scan ; and scan the next token pserr1: tst (sp)+ ; Clean off stack ;20 pserr: mov #err23,r0 ; Trouble callr error1 ; Complain ;09-/18- ;+ ; ** CFUNC - COMPILE A FUNCTION ; ; THIS ROUTINE IS CALLED BY EXDEFN TO COMPILE A FUNCTION. ON ENTRY THE ; FUNCTION DECLARATOR HAS BEEN COMPLETELY READ IN. THE ARGUMENTS HAVE ; ALL BEEN DECLARED AS CL.ARG AND TY.INT (DEFINE CHECKS FOR THIS TYPE ; AND PERMITS REDECLARATION). ; ; FSYMBL CONTAINS THE POINTER TO THE SYMBOL TABLE NODE OF THE FUNCTION ; NAME. THIS IS USED TO OUTPUT THE NAME IN THE 'N' DIRECTIVE AND (NOTE ; BENE) TO OBTAIN THE RETURN TYPE OF THE FUNCTION SO THE RETURN STATE- ; MENT CAN PERFORM THE REQUIRED TYPE CONVERSIONS. ; ; USES: ; ALL ;- CFUNC: MOV #4,NXTREG ;START REGISTER ALLOCATION 10$: CALL CANDT ;GET CLASS AND TYPE MOV CLASS,R0 ;IF NO CLASS OR BIS TYPE,R0 ;TYPE BEQ 60$ ;ASSUME NO DECLARATION TST TYPE ;IS THERE A TYPE BNE 20$ ;YES MOV #TY.INT,TYPE ;NO, MAKE IT INT 20$: MOV CLASS,R0 ;GET CLASS BEQ 40$ ;NONE SPECIFIED (CL.DEF) CMP R0,#CL.REG ;REGISTER BNE 30$ ;NO, ERROR MOV #CL.DRG,CLASS ;SET DEFINED REGISTER ARGUMENT BR 50$ ; 30$: MOV #ERR04,R0 ;COMPLAIN CALL ERROR1 ; ;01 40$: MOV #CL.DEF,CLASS ;SET DEFAULT CLASS 50$: CALL DECLST ;COMPILE A LIST OF DECLS BR 10$ ; 60$: CMP LEX1,#OP.LBR ;MUST BE A LEFT BRACE BEQ 70$ ; MOV #ERR03,R0 ;OR CALL ERROR1 ;ITS AN ERROR ;01 70$: CALL GENLB1 ;SET UP FUNCTION MOV R0,FRETLB ;RETURN LABEL MOV #1,R5 ;COMPILE A STATEMENT CALL STATE ; MOV FRETLB,R0 ;PUT OUT THE CALL LREC ;RETURN LABEL MOVB #'X,R0 ;AND THE RETURN OPERATOR CALL CODC1 ; ;01 CALL CODNL1 ; ;01 CALLR PURGE ;CLEAR OUT SYMBOL TABLE ;+ ; ** CINIT - COMPILE INITIALISERS ; ; C INITIALISERS ARE SCREWY. I THINK THIS DOES WHAT THE MEMO FROM DMR ; SAYS. HOWEVER, THE MEMO IS FAR FROM CLEAR. ; ; INPUTS: ; R4=FLEX FLAG (1 MEANS FLEX OK) ; R5=SYMBOL TABLE NODE ; LEX0=FIRST TOKEN OF THE INITIALISER ; ; OUTPUTS: ; LEX0=TOKEN THAT DELIMITED THE INITIALISER ; ; USES: ; R0, R1 ;- FLEX = 14 ;FLEX FLAG (R4) BRACE = 6 ;BRACE FLAG ODIMP = 4 ;OLD DIMP FOR ARRAYS NEL = 2 ;NUMBER OF ELEMENTS WIDTH = 0 ;WIDTH OF AN ELEMENT CINIT: MOV R5,-(SP) ;SAVE ARGUMENTS AND REGISTERS MOV R4,-(SP) ; MOV R3,-(SP) ; MOV R2,-(SP) ; SUB #10,SP ;GET SPACE FOR LOCALS ; ; CANNOT INITIALISE AUTOMATIC AGGREGATES. ; CMPB S.CLAS(R5),#CL.AUT ;AUTO BNE 2$ ;NO MOV S.DIMP(R5),R0 ;GET POINTER TO DIMENSIONS BEQ 1$ ;BR IF SCALAR CMP D.TYPE(R0),#DT.ARY ;IS IT AN ARRAY BEQ 3$ ;YES, ERROR BR 4$ ; 1$: CMPB S.TYPE(R5),#TY.UST ;STRUCT OR UNION BHIS 3$ ;YES, ERROR BR 4$ ; ; ; CANNOT INITIALISE UNIONS. ; 2$: CMPB S.TYPE(R5),#TY.UUN ;IS IT AN UNDEFINED UNION BEQ 2500$ ;YES CMPB S.TYPE(R5),#TY.UNI ;NO, IS IT A (DEFINED) UNION BNE 4$ ;NO 2500$: MOV S.DIMP(R5),R0 ;MIGHT BE POINTER TO UNION BEQ 3$ ;NO CMP D.TYPE(R0),#DT.ARY ;WELL BNE 4$ ;OK 3$: MOV #ERR17,R0 ;COMPLAIN CALL ERRSYM ; ;01/02 ; ; SORRY. ; YOU CANNOT INITIALISE FIELDS. ; 4$: BITB #SF.FLD,S.FLAG(R5) ;FIELD ;13 BEQ 5$ ;NO MOV #ERR22,R0 ;ERROR CALL ERRSYM ; ;01/02 ; ; IF THE ITEM BEING INITIALISED IS AN ARRAY, ADJUST THE DIMENSIONS TO ; REMOVE THE TOP LEVEL "ARRAY OF". ; 5$: CALL SLENG ;GET SIZE OF THE THING MOV R0,WIDTH(SP) ;SAVE IT MOV S.DIMP(R5),R0 ;GET THE DIMP OF THE SYMBOL MOV R0,ODIMP(SP) ;SAVE IN CASE OF ARRAY BEQ 10$ ;SCALAR CMP D.TYPE(R0),#DT.ARY ;IS IT AN ARRAY BNE 10$ ;NO MOV (R0),S.DIMP(R5) ;UNDO ONE LEVEL OF 'ARRAY OF' TST WIDTH(SP) ;LOOK FOR 0 LENGTH ROWS BNE 20$ TST FLEX(SP) BNE 20$ ;OK IF UNDER A FLEX BOUND MOV #ERR13,R0 ;ERROR CALL ERRSYM ;01/02 BR 20$ 10$: CLR FLEX(SP) ;IF NOT ARRAY, NO FLEX ALLOWED ; ; COMPUTE THE NUMBER OF ELEMENTS AND THE PER ELEMENT SIZE. ; 20$: CALL SLENG ;GET THE LENGTH NOW (ARRAYS HAVE CHANGED) MOV R0,R2 ; MOV WIDTH(SP),R1 ;WIDTH/NEW WIDTH = NUMBER OF ELEMENTS CLR R0 ; MOV R2,-(SP) ; CALL $DIVR0 ; TST (SP)+ ; MOV R0,NEL(SP) ; MOV WIDTH(SP),R1 ;WIDTH/NEL = ELEMENT SIZE (WIDTH) CLR R0 ; MOV NEL(SP),-(SP) ; CALL $DIVR0 ; TST (SP)+ ; MOV R0,WIDTH(SP) ; ; ; SET BRACE FLAG IF THE NEXT TOKEN IS A BRACE AND WE HAVE SOMETHING ; OTHER THAN A SCALAR STRUCTURE (OR UNION). ; CLR BRACE(SP) ;NOT IN A BRACE CMP LEX0,#OP.LBR ;IS THE NEXT TOKEN A BRACE BNE 25$ ;NO TST ODIMP(SP) ;TEST IF SCALAR BNE 24$ ;NOT SCALAR CMPB S.TYPE(R5),#TY.UST ;SCALAR, CHECK FOR STRUCT (OR UNION) BHIS 25$ ;BR IF STRUCT (OR UNION) 24$: INC BRACE(SP) ;SET THE BRACE FLAG AND CALL SCAN ;SKIP THE BRACE ; ; THIS IS THE MAIN LOOP FOR READING IN THE INITIALISERS. THROUGHOUT ; THIS SECTION, R3 CONTAINS THE NUMBER OF INITIALISERS READ. ; 25$: CLR R3 ;START AT ZERO 30$: MOV LEX0,R0 ;WHAT IS COMING UP CMP R0,#OP.RBR ;DUCK OUT IF BEQ 130$ ;OPEN BRACE TST S.DIMP(R5) ;IF THE ITEM IS A BNE 35$ ;SCALAR STRUCTURE (OR UNION) CMPB S.TYPE(R5),#TY.UST ; BLO 35$ ;THEN CALL CSINIT ;USE SPECIAL ROUTINE BR 120$ ; 35$: MOV S.DIMP(R5),R1 ;IF THE ITEM IS AN ARRAY BEQ 37$ ; CMP D.TYPE(R1),#DT.ARY ; BNE 37$ ; CLR R4 ;CALL CINIT TO DO IT (RECURSIVELY) CALL CINIT ; BR 120$ ; 37$: CMP R0,#OP.CST ;CHARACTER STRING BNE 90$ ;NO TST S.DIMP(R5) ;TEST IF DOING BYTES BNE 60$ ;NO CMPB S.TYPE(R5),#TY.CHR ;PERHAPS BNE 60$ ;NO MOV #'",R1 ;TAKE THE STRING APART 40$: CALL MAPCH ; BCS 45$ ;END CALL HREC ;AND PUT IT OUT BYTE AT A TIME INC R3 ;COUNT 1 THING BR 40$ ; 45$: TST FLEX(SP) ;FLEX ARRAY? BEQ 50$ ;NO. CLR R0 ;YES, PUT OUT NULL BYTE CALL HREC ; INC R3 ;AND COUNT UP ONE MORE ITEM. 50$: CALL ADVANC ;START UP THE SCANNER AGAIN CALL SCAN ; BR 130$ ;DONE THIS ITEM 60$: CALL GETSTR ;NOT INITIALISING BYTES CALL IREC ;WE GET A POINTER CALL SCAN ; BR 120$ ; 90$: MOV R5,-(SP) ;SAVE THE SYMBOL POINTER CALL CLRTRE ;CLEAR OLD TREE INC INITFG ;MAKE ',' AND ':' SPECIAL CALL EXPR ; CLR INITFG ;NOT SPECIAL ANY MORE MOV #ES.OP,R2 ;GET A TREE NODE CALL TREES1 ; ;01 MOV #OP.CVR,(R2) ;TO PASS THE SYMBOL TYPE IN MOV R5,E.LOP(R2) ;LEFT TREE IS FROM EXPR MOV (SP),R5 ;THEN RECOVER THE SYMBOL AND MOVB S.TYPE(R5),E.TYPE(R2) ;FILL IN THE NODE MOV S.DIMP(R5),E.DIMP(R2) ; MOV S.DOPE(R5),E.DOPE(R2) ; ;u2 92$: MOVB #'K,R0 ;OUTPUT THE TREE CALL CODC1 ; ;01 CALL CODNL1 ; ;01 MOV R2,R5 ; CALL OUTREE ; MOV (SP)+,R5 ;RECOVER SYMBOL POINTER 120$: INC R3 ;COUNT UP AN ITEM MOV LEX0,R0 ;GET DELIMITER CMP R0,#OP.CMA ;COMMA BNE 130$ ;NO, STOP TST FLEX(SP) ;IF FLEX ALWAYS CONTINUE BNE 125$ ; CMP R3,NEL(SP) ;OTHERWISE CONTINUE IF MORE BHIS 130$ ;ARE NEEDED 125$: CALL SCAN ;GET NEXT TOKEN AND BR 30$ ;GO FOR MORE 130$: CMP R0,#OP.RBR ;IF THE NEXT TOKEN IS A RIGHT BRACE BNE 140$ ; TST BRACE(SP) ;AND THE BRACE FLAG IS SET BEQ 140$ ;THEN CALL SCAN ;EAT UP THE BRACE ; ; IF TOO FEW INITIALISERS, ALLOCATE MORE STORAGE. ; IF TOO MANY INITIALISERS, AND THE BOUNDS ARE FLEXABLE, INCREMENT THE ; SIZE FOR THE BENEFIT OF SIZEOF. ; 140$: CMP R3,NEL(SP) ;COMPARE WHAT WE GOT TO WHAT WE NEEDED BEQ 160$ ;EXACT BHI 150$ ;TOO MANY MOV NEL(SP),R1 ;PUT OUT A 'B' FOR THE REST SUB R3,R1 ; MOV WIDTH(SP),-(SP) ; CALL $MULR1 ; TST (SP)+ ; MOV R1,R0 ; CALL BREC ; BR 160$ ; 150$: TST FLEX(SP) ;IS TOO MANY OK BEQ 155$ ;NO MOV ODIMP(SP),R0 ;YES, FIDDLE THE DIMP MOV R3,D.BOUN(R0) ; BR 160$ ; 155$: MOV #ERR14,R0 ;TOO MANY INITIALISERS CALL ERRSYM ; ;01/02 160$: MOV ODIMP(SP),S.DIMP(R5) ;REPLACE THE DIMENSIONS ADD #10,SP ;RETURN MOV (SP)+,R2 ; MOV (SP)+,R3 ; MOV (SP)+,R4 ; MOV (SP)+,R5 ; RETURN ; ;+ ; ** CSINIT - COMPILE STRUCTURE INITIALISERS ; ; THIS ROUTINE IS CALLED BY CINIT TO INITIALISE A STRUCTURE. IT USES ; THE DOPE LIST (POINTED TO BY THE S.DOPE FIELD OF THE SYMBOL TABLE ; ENTRY) TO GET THE TYPES RIGHT. ; ; THIS ROUTINE ALSO GETS CALLED ON UNIONS. INITIALISATION OF UNIONS ; IS FORBIDDEN. WE JUST PRETEND THAT THE UNION IS A STRUCT TO AVOID ; HAVING TO RESYNC AFTER THE (BAD) INITIALISOR. DON'T WORRY, 'CINIT' ; PUTS OUT A DIAGNOSTIC. ; ; INPUTS: ; R5=SYMBOL TABLE POINTER ; LEX0=FIRST TOKEN OF THE INITIALISER ; ; OUTPUTS: ; LEX0=THE TOKEN THAT STOPPED THE SCAN ; ; USES: ; R0, R1 ;- CSINIT: MOV R5,-(SP) ;SAVE THINGS MOV R4,-(SP) ; MOV R3,-(SP) ; MOV R2,-(SP) ; MOV S.DOPE(R5),R3 ;POINT AT THE DOPE ENTRIES ADD #S.MEMB,R3 ;FOR THE STRUCT CLR R2 ;BRACE FLAG CMP LEX0,#OP.LBR ;IS THE NEXT TOKEN A BRACE BNE 10$ ;NO CALL SCAN ;YES, EAT IT UP AND INC R2 ;SET BRACE FLAG 10$: CMP LEX0,#OP.RBR ;RIGHT BRACE NEXT BEQ 40$ ;YES, DONE TST (R3) ;IS THERE ANOTHER ELEMENT BNE 20$ ;YES MOV #ERR16,R0 ;NO, GIVE ERROR CALL ERRSYM ; ;01/02 MOV #ANINT,R5 ;AND POINT AT BR 30$ ;DUMMY SYMBOL NODE 20$: MOV (R3)+,R5 ;GET THE ELEMENT BITB #SF.RUP,S.FLAG(R5) ;IF ALLIGNMENT IS INDICATED ;13 BEQ 30$ ;THEN CALL ALLIGN ;PUT OUT 'A' ITEM 30$: CLR R4 ;NOT FLEX CALL CINIT ;DO THE ITEM CMP LEX0,#OP.CMA ;IS THE NEXT TOKEN A COMMA BNE 40$ ;NO, THE DECLARATION ENDS TST (R3) ;ANY MORE ENTRIES IN THE DOPE BNE 35$ ;YES, GET ANOTHER TST R2 ;WAITING FOR A BRACE BEQ 40$ ;NO, QUIT 35$: CALL SCAN ;SKIP OVER THE ',' BR 10$ ;AND GO FOR MORE 40$: TST R2 ;EAT TRAILING RIGHT BRACE BEQ 50$ ;IF THE CMP LEX0,#OP.RBR ;INITIALISER WAS BNE 50$ ;ENCLOSED CALL SCAN ;IN BRACES 50$: CLR R1 ;PUT OUT PADDING TO THE END OF THE 60$: MOV (R3)+,R5 ;STRUCT BEQ 70$ ;FOUND THE END CALL SLENG ;ACCUMULATE ADD R0,R1 ;THE BR 60$ ;MEMBERS 70$: MOV R1,R0 ;PUT OUT A BSS FOR THE SPACE BEQ 80$ ;UNLESS CALL BREC ;THE SIZE IS ZERO 80$: CALL ALLIGN ;FORCE ALLIGN MOV (SP)+,R2 ;AND RETURN MOV (SP)+,R3 ; MOV (SP)+,R4 ; MOV (SP)+,R5 ; RETURN ; ;+ ; ** ALLIGN - PUT OUT AN 'A' RECORD ; ; THIS ROUTINE IS CALLED FROM ALL OVER CINIT AND CSINIT TO PUT OUT AN ; 'A' DIRECTIVE WHENEVER WORD ALLIGNMENT IS REQUIRED. ; ; ; USES: ; R0 ;- ALLIGN: MOVB #'A,R0 ;GET OPCODE CALL CODC1 ;PUT IT OUT ;01 CALLR CODNL1 ; ;01 ;+ ; ** CANDT - GET CLASS AND TYPE ; ** CANDT1 - GET CLASS AND TYPE (ALTERNATE ENTRY) ; ; THESE ROUTINES ARE USED TO PARSE THE CLASS AND TYPE KEYWORDS AT THE ; START OF A DECLARATION. THE TYPE AN CLASS INFORMATION IS STORED IN ; THE EXTERNAL VARIABLES CLASS, TYPE AND DOPE (DOPE IS ONLY SET WHEN ; THE TYPE IS STRUCT OR UNION). ; ; THE EXTERNAL VARIABLE DIMP IS SET FROM THE BASE DIMENSION LIST. IN ; ALL NORMAL CASES THIS WILL BE NULL. HOWEVER A TYPEDEF MAY HAVE NON ; NULL DIMENSIONS. ; ; THE CLASS AND TYPE ARE PRESET TO ZERO. THE CALLER MAY USE THIS AS A ; FLAG TO PERFORM A DEFAULT CLASS AND TYPE ASSIGNMENT. ; ; THE ALTERNATE ENTRY CANDT1 IS JUST LIKE CANDT EXCEPT THAT THE CLASS ; IS NOT PRESET; IT IS USED FOR COMPILING FUNCTION ARGUMENT LISTS AND ; STRUCTURES. ; ; USES: ; R0, R1 ;- CANDT: CLR CLASS ;SET THINGS UNDEFINED CANDT1: CLR TYPE ; CLR DIMP ; CLR DOPE ; CLR LONGF ;'LONG' FLAG CLR SHORTF ;'SHORT' FLAG CLR USIGNF ;'UNSIGNED' FLAG ; ; THIS IS THE MAIN LOOP. PEEK AHEAD IN THE INPUT, LOOKING FOR CLASS ; AND TYPE KEYWORDS. SET THE CLASS OR TYPE IF ONE IS FOUND. UNSIGNED ; LONG AND SHORT JUST SET FLAGS (AND GET RESOLVED TO TYPES LATER). ; ; STRUCTS AND UNIONS HAVE THEIR OWN ROUTINE. THE SAVE AND RESTORE OF ; THE 'UNION' FLAG IS KLUDGY. ; 10$: MOV LEX1,R0 ;GET PEEK TOKEN MOV #30$,R1 ;LOOK IT UP IN THE TABLE 20$: CMP R0,(R1)+ ; BEQ 25$ ;HIT ADD #4,R1 ; CMP R1,#40$ ; BLO 20$ ;BR IF MORE BR 100$ ;END OF CLASSES AND TYPES 25$: JMP @(R1)+ ;POINTS R1 AT THE VALUE ; ; TRANSFER TABLE. ; 30$: .WORD OP.AUT, 60$, CL.AUT .WORD OP.STA, 60$, CL.SIN .WORD OP.EXT, 60$, CL.GBR .WORD OP.REG, 60$, CL.REG .WORD OP.TYP, 60$, CL.TYP .WORD OP.INT, 80$, TY.INT .WORD OP.CHR, 80$, TY.CHR .WORD OP.FLT, 80$, TY.FLT .WORD OP.DBL, 80$, TY.DBL .WORD OP.LNG, 50$, LONGF .WORD OP.SHO, 50$, SHORTF .WORD OP.UNS, 50$, USIGNF .WORD OP.STR, 70$, 0 .WORD OP.UNI, 70$, 1 .WORD OP.ID, 75$, 0 40$: ;END OF THE TABLE 50$: INC @(R1)+ ;SET FLAG ON ADJECTIVE BR 90$ ; 60$: TST CLASS ;CLASS SPEC, DO WE HAVE ONE BEQ 65$ ;NO MOV #ERR04,R0 ;YES, COMPLAIN CALL ERROR1 ; ;01 65$: MOV (R1),CLASS ;SET CLASS BR 90$ ; 70$: MOV UNION,-(SP) ;SAVE UNION FLAG MOV (R1),UNION ;SET UNION FLAG IF 'UNION' CALL SUDCL ;DECLARE STRUCT OR UNION MOV (SP)+,UNION ;RESTORE UNION FLAG BR 10$ ; 75$: MOV VAL1,R1 ;SYMBOL POINTER. MOVB S.CLAS(R1),R0 ;GRAB STORAGE CLASS. CMP R0,#CL.TYP ;TYPEDEF? BNE 100$ ;NO MOV TYPE,R0 ;DO WE BIS SHORTF,R0 ;HAVE BIS LONGF,R0 ;A BIS USIGNF,R0 ;TYPE? BEQ 76$ ;NO MOV #ERR05,R0 ;COMPLAIN CALL ERROR1 ; ;01 76$: MOVB S.TYPE(R1),TYPE ;COPY TYPE MOV S.DIMP(R1),DIMP ;DIMS MOV S.DOPE(R1),DOPE ;STRUCTURE DOPE BR 90$ ; 80$: TST TYPE ;TYPE SPEC, DO WE HAVE ONE BEQ 85$ ;NO MOV #ERR05,R0 ;YES, COMPLAIN CALL ERROR1 ; ;01 85$: MOV (R1),TYPE ;SET TYPE ; ; GET THE NEXT TOKEN. IF THERE IS NO TYPE YET SAVE THE CURRENT STATE ; OF 'INMOSF' AND FORCE CLEAR 'INMOSF' DURING THE SCAN. THIS IS DONE ; DO THAT TYPEDEF NAMES GET LOOKED UP IN THE RIGHT SYMBOL TABLE. ; 90$: MOV INMOSF,-(SP) ;SAVE OLD STATE MOV TYPE,R0 ;DO WE BIS SHORTF,R0 ;HAVE BIS LONGF,R0 ;A BIS USIGNF,R0 ;TYPE? BNE 92$ ;YES CLR INMOSF ;NO, FORCE NOT IN MOS 92$: CALL SCAN ;GET NEXT TOKEN MOV (SP)+,INMOSF ;RESTORE MOS STATE JMP 10$ ;GO FOR ANOTHER ; ; RESOLVE ADJECTIVES. ; 100$: MOV LONGF,R0 ;MUST BE 0 OR 1 ADJECTIVES ADD SHORTF,R0 ; ADD USIGNF,R0 ; DEC R0 ;WELL BMI 180$ ;IF NONE, JUST LEAVE BEQ 110$ ;EXACTLY 1 MOV #ERR06,R0 ;COMPLAIN CALL ERROR1 ; ;01 110$: MOV TYPE,R0 ;GET THE DECLARED TYPE BNE 120$ ;IS ONE MOV #TY.INT,R0 ;DEFAULT TO INT 120$: TST LONGF ;LONG BEQ 140$ ;NO CMP R0,#TY.INT ;LONG INT BNE 130$ ;IS MOV #TY.LNG,R0 ;LONG BR 160$ ; 130$: CMP R0,#TY.FLT ;LONG FLOAT BNE 170$ ;IS MOV #TY.DBL,R0 ;DOUBLE BR 160$ ; 140$: TST SHORTF ;SHORT BEQ 150$ ;NO CMP R0,#TY.INT ;ONLY SHORT INT IS LEGAL BNE 170$ ; BR 160$ ;AND ITS JUST INT 150$: TST USIGNF ;UNSIGNED BEQ 160$ ;NO CMP R0,#TY.INT ;ONLY UNSIGNED INT BNE 170$ ; MOV #TY.UNS,R0 ;SET TYPE 160$: MOV R0,TYPE ;SAVE THE (NEW) TYPE BR 180$ ; 170$: MOV #ERR06,R0 ;COMPLAIN CALL ERROR1 ; ;01 180$: RETURN ; ;+ ; ** SUDCL - DECLARE STRUCT OR UNION ; ; READ IN A STRUCTURE DECLARATION AND SET UP THE TYPE AND THE DOPE ; POINTER. MOST OF THE WORK IS ASSOCIATED WITH NESTED STRUCTURES ; AND THE DOPE LIST. ; ; USES: ; R0, R1 ;- SUDCL: MOV R5,-(SP) ;SAVE REGISTERS MOV R4,-(SP) ; MOV CSTRUC,-(SP) ; SAVE CURRENT CSTRUC ;u2 CLR CSTRUC ; TOP LEVEL WHILE SCANNING TAG ;u2 CALL SCAN ;GET TOKEN AFTER 'STRUCT' INTO LEX1 MOV (SP)+,CSTRUC ; RESTORE CSTRUC ;u2 CLR R4 ;POINTER TO TAG CMP LEX1,#OP.ID ;IS IT A TAG BNE 10$ ;NO MOV VAL1,R4 ;YES, SAVE POINTER TO SYMBOL CALL SCAN ;AND ADVANCE THE WINDOW ; ; IF THE NEXT TOKEN IS AN OPEN BRACE READ IN A STRUCTURE DEFINITION ; THE CLASS IS CL.MOS. THE INMOSF IS SET NON ZERO TO MAKE SCAN USE ; THE RIGHT SYMBOL TABLE. THE SYMBOLS ARE THREADED (BY DEFINE) INTO ; A LIST THAT BEGINS AT DOPEPT AND WINDS ITS WAY THROUGH THE NAMES ; IN THE STRUCTURE VIA THE S.AUXP FIELD OF THE SYMBOL NODES. THIS ; LIST IS USED HERE TO BUILD THE DOPE BLOCK. ; 10$: CMP LEX1,#OP.LBR ;OPEN BRACE (DECLARATION) BEQ 11$ ;YES ;u2+ JMP 40$ ;NO 11$: ;(MAIN SEQUENCE) ;u2- MOV CLASS,-(SP) ;YES, SAVE THINGS MOV OFFSET,-(SP) ;OFFSET MOV MOFSET,-(SP) ;MAX OFFSET MOV DOPEPT,-(SP) ;POINTER TO HEAD OF OLD DOPE LIST MOV DIMP,-(SP) ;DIMS MOV LONGF,-(SP) ;'LONG' FLAG MOV SHORTF,-(SP) ;'SHORT' FLAG MOV USIGNF,-(SP) ;'UNSIGNED' FLAG MOV BITOFS,-(SP) ;BIT OFFSET MOV CSTRUC,-(SP) ;CURRENT STRUCTURE ID ;u2+ INC MSTRUC ;GET NEW STRUCTURE ID MOV MSTRUC,CSTRUC ;SET NEW CURRENT ;u2- CLR BITOFS ;CLEAR OUT BIT OFFSET CLR DOPEPT ;START ANEW CLR MOFSET ; CLR OFFSET ;AT LOC 0 OF THE STRUCTURE INC INMOSF ;CORRECT SYMBOLS MOV INMOSF,-(SP) ;BUT CLR INMOSF ;SKIP THE BRACE CALL SCAN ;IN THE ORDINARY TABLE FOR MOV (SP)+,INMOSF ;BENEFIT OF TYPEDEF 20$: CMP LEX1,#OP.RBR ;LOOK FOR DELIMITERS BEQ 30$ ;BUT CMP LEX1,#OP.EOF ;DON'T GET STUCK BEQ 70$ ;ON END OF FILE MOV #CL.MOS,CLASS ;GET A TYPE-DECL-LIST CALL CANDT1 ; TST TYPE ;IF NO TYPE BEQ 70$ ;ITS AN ERROR CALL DECLST ;DECLARE THE LIST OF NAMES AND BR 20$ ;CONTINUE 30$: ; ;u2+ MOV CSTRUC,R5 ;SAVE OLD CSTRUC MOV (SP)+,CSTRUC ;SWITCH BACK BEFORE RIGHT BRACE ;u2- DEC INMOSF ;SWITCH BACK BEFORE WE CALL SCAN ;SKIP THE RIGHT BRACE CALL ROFSET ;ROUND UP OFFSET MOV #S.MEMB+2,R0 ;BUILD DOPE BLOCK MOV DOPEPT,R1 ;SYMBOLS ARE CHAINED THRU 'S.AUXP' BEQ 32$ ;NULL 31$: ADD #2,R0 ;2 WORDS PER ENTRY MOV S.AUXP(R1),R1 ;CHAIN ALONG UNTIL BNE 31$ ;NONE LEFT 32$: CALL $ALLOC ;ALLOCATE DOPE BLOCK MOV R0,DOPE ;SAVE AND THEN CLR (R0)+ ;SET S.REFC TO 0 MOV OFFSET,R1 ;FOR STRUCT TST UNION ;DOING A UNION BEQ 3200$ ;NO MOV MOFSET,R1 ;YES, USE MAX OFFSET 3200$: MOV R1,(R0)+ ;SET S.SIZE MOV R5,(R0)+ ;SET S.STID TO OLD CSTRUC ;u2 MOV DOPEPT,R1 ;NOW MOVE IN DOPE ENTRIES 33$: MOV R1,(R0)+ ;THE END IS MARKED BY A 0 BEQ 34$ ; MOV S.AUXP(R1),R1 ;CHAIN ALONG BR 33$ ; 34$: MOV R4,R5 ;DECLARE THE TAG IF REQUIRED BEQ 35$ ;NO TAG MOV #CL.TAG,CLASS ;SET CLASS (OFFSET IS ALREADY SET) CLR TYPE ; CLRB FIELD ;NOT A FIELD! CALL DEFINE ;DEFINE WILL CALL BACKPG 35$: MOV (SP)+,BITOFS ;NOW MOV (SP)+,USIGNF ;RESTORE THINGS MOV (SP)+,SHORTF ; MOV (SP)+,LONGF ; MOV (SP)+,DIMP ; MOV (SP)+,DOPEPT ; MOV (SP)+,MOFSET ; MOV (SP)+,OFFSET ; MOV (SP)+,CLASS ; BR 60$ ;DONE ; ; IF THERE IS NO STRUCTURE BODY THERE MUST BE A TAG. FORWARD POINTER ; REFERENCES WILL CAUSE THE TAG TO BE UNDEFINED. IN THIS CASE SETUP ; A TYPE OF UNDEFINED STRUCTURE (TY.UST) AND POINT DOPE AND THE NAME ; NODE OF THE TAG. WHEN THE STRUCTURE TAG IS FINALLY DEFINED DEFINE ; WILL CALL BACKPG, WHO WILL SET THE DOPE BLOCK POINTER INTO THE SYM ; BOL NODE AND FIX THE REFERENCE COUNT. ; 40$: TST R4 ;IF NO BRACE, MUST BE A TAG BEQ 80$ ;OR SYNTAX ERROR MOVB S.CLAS(R4),R0 ;IS THE TAG UNDEFINED BNE 50$ ;NO MOV R4,DOPE ;PTR TO REQUIRED TAG MOV #TY.UST,TYPE ;UNDEFINED STRUCTURE TST UNION ;IS THIS A UNION BEQ 100$ ;NO MOV #TY.UUN,TYPE ;SET UNDEFINED UNION BR 100$ ; 50$: CMP R0,#CL.TAG ;IF DEFINED, MUST BE A TAG BNE 80$ ;URK MOV S.DOPE(R4),DOPE ;SET DOPE FROM THE TAG 60$: MOV #TY.STR,TYPE ;RETURN TYPE IS STRUCT TST UNION ;IS THAT RIGHT BEQ 100$ ;YES MOV #TY.UNI,TYPE ;RETURN TYPE IS UNION BR 100$ ; ; ; ERROR RECOVERY. ; MUST BE CAREFUL NOT TO LEAVE STUFF ON THE STACK, OR THE INMOSF FLAG ; SET. ; 70$: DEC INMOSF ;FIX 'IN MOS' FLAG MOV (SP)+,CSTRUC ; ;u2 MOV (SP)+,BITOFS ;THEN MOV (SP)+,USIGNF ;RESTORE VARIABLES MOV (SP)+,SHORTF ; MOV (SP)+,LONGF ; MOV (SP)+,DIMP ; MOV (SP)+,DOPEPT ; MOV (SP)+,MOFSET ; MOV (SP)+,OFFSET ; MOV (SP)+,CLASS ; 80$: CALL DECSYN ;ERROR COMMENT MOV LEX0,R0 ;SKIP OVER BAD INPUT 90$: CMP R0,#OP.RBR ; BEQ 100$ ; CMP R0,#OP.EOF ; BEQ 100$ ; CALL ESCAN ; BR 90$ ; 100$: MOV (SP)+,R4 ;DONE MOV (SP)+,R5 ; RETURN ; ;+ ; ** GDECLR - GET A DECLARATOR ; ; READ IN A SINGLE DECLARATOR. THE DIMENSIONS ARE KEPT IN THE DIM LIST ; WHICH BEGINS IN THE S.DIMP FIELD OF THE SYMBOL TABLE NODE. ; ; OUTPUTS: ; R5=POINTER TO THE SYMBOL TABLE NODE ;- GDECLR: MOV R4,-(SP) ;SAVE REGISTERS MOV R3,-(SP) ; MOV R2,-(SP) ; MOV R1,-(SP) ; MOV R0,-(SP) ; ; ; SIMPLE STUFF. ; IDENTIFIERS. ; POINTER DECLARATORS. ; PARENTHESISED DECLARATORS. ; CALL SCAN ;GET TOKEN CMP R0,#OP.MUL ;'*' BNE 10$ ;NO CALL GDECLR ;YES, GET A DECLARATOR BCS 15$ ;ERROR MOV #DT.PTR,R3 ;APPEND A 'POINTER TO' CLR R4 ; CALL TACK ; JMP 100$ ;DONE 10$: CMP R0,#OP.LPA ;'(' BNE 20$ ;NO CALL GDECLR ;GET DECLARATOR BCS 15$ ;ERROR CALL SCAN ;CHECK FOR THE CLOSING PARENTHESIS CMP R0,#OP.RPA ; BEQ 30$ ;OK. JMP 95$ ;ERROR IF NOT THERE. 15$: JMP 110$ ;ERROR RETURN 20$: CMP R0,#OP.ID ;MUST BE AN IDENTIFIER BNE 95$ ;NO, ERROR MOV VAL0,R5 ;CLEAR OUT DIMP AND DOPE ;13 CALL FDIMP ; CALL FDOPE ; ; ; A '(' MEANS FUNCTION DECLARATOR. ; 30$: MOV LEX1,R0 ;PEEK AHEAD CMP R0,#OP.LPA ;'(' (FUNCTION) BNE 80$ ;NO CALL SCAN ;YES, SKIP OVER IT TST FSYMBL ;IN A FUNCTION BNE 60$ ;YES, ARGS ARE ILLEGAL CMP CLASS,#CL.TYP ;WORKING ON A TYPEDEF BEQ 60$ ;YES, NO ARGS MOV #PARMS,PARPTR ;CLEAR OUT PARAMETER POINTER CALL SCAN ;CHECK FOR NULL ARGLIST CMP R0,#OP.RPA ; BEQ 70$ ;NULL 40$: CMP R0,#OP.ID ;MUST BE AN ID THEN BNE 95$ ;ERROR MOV R5,R3 ;DECLARE THE ARGUMENT MOV CLASS,-(SP) ;SAVE THE VARIABLES (FOR DEFINE) MOV TYPE,-(SP) ; MOV #CL.ARG,CLASS ;CLASS IS ARG MOV #TY.INT,TYPE ;TYPE IS INT CLRB FIELD ;NOT A FIELD! MOV VAL0,R5 ;CLEAR OUT DIMP AND DOPE ;13 CALL FDIMP ; CALL FDOPE ; CALL DEFINE ; MOV (SP)+,TYPE ;PUT VARIABLES BACK MOV (SP)+,CLASS ; CMP PARPTR,#PARMSE ;ADD TO LIST OF FORMAL PARMS BHIS 95$ ;OVERFLOW MOV R5,@PARPTR ; ADD #2,PARPTR ; MOV R3,R5 ;GET DECLARATOR BACK IN R5 CALL SCAN ;GET NEXT TOKEN CMP R0,#OP.RPA ;CLOSE PAREN MEANS END OF LIST BEQ 70$ ; CMP R0,#OP.CMA ;COMMA MEANS ANOTHER ID FOLLOWS BNE 95$ ;ERROR CALL SCAN ;SKIP THE COMMA BR 40$ ; 60$: CALL SCAN ;ONLY LIST LEGAL IS '(' ')' CMP R0,#OP.RPA ; BNE 95$ ;SYNTAX ERROR 70$: MOV #DT.FUN,R3 ;TACK ON A 'FUNCTION RETURNING' CLR R4 ; CALL TACK ; BR 30$ ; ; ; A '[' MEANS ARRAY DECLARATOR. ; 80$: CMP R0,#OP.LSQ ;'[' BNE 100$ ;END OF DECLARATOR CALL SCAN ;SKIP THE '[' CLR R4 ;[] = 0 CALL SCAN ;GRAB NEXT TOKEN. CMP R0,#OP.RSQ ;IF ] THEN BEQ 90$ ;ALL DONE MOV R5,-(SP) ;SAVE SYMBOL POINTER. INC INITFG ;MAKE ":" AND "," SPECIAL. CALL CLRTRE ;READ IN CALL CONXPR ;CONSTANT EXPRESSION. CLR INITFG ;BACK TO NORMAL. MOV R5,R4 ;COPY ARRAY BOUND AND MOV (SP)+,R5 ;RESTORE SYMBOL POINTER CMP LEX0,#OP.RSQ ;MUST STOP ON A "]" OR BNE 95$ ;IT IS AN ERROR. 90$: MOV #DT.ARY,R3 ;TACK ON 'ARRAY OF' CALL TACK ; BR 30$ ; 95$: CALL DECSYN ;SYNTAX ERROR SEC ;ERROR RETURN BR 110$ ; 100$: MOV DIMP,R0 ;GET COPY OF THE DIMS ;08+ CALL DUPDIM ; CALL TACK2 ;AND TACK ON "ARRAY OF" ;08- CLC ;GOOD RETURN 110$: MOV (SP)+,R0 ;RETURN MOV (SP)+,R1 ; MOV (SP)+,R2 ; MOV (SP)+,R3 ; MOV (SP)+,R4 ; RETURN ; ;+ ; ** TACK - ADD AN ENTRY TO THE END OF THE DIM ; ; INPUTS: ; R3=TYPE ; R4=BOUND ; R5=SYMBOL TABLE NODE ; ; USES: ; R0, R1 ;- TACK: MOV #D.LENG,R0 ;GET SPACE FOR CALL $ALLOC ;THE NEW DIM ENTRY CLR (R0) ;D.LINK MOV R3,D.TYPE(R0) ;D.TYPE MOV R4,D.BOUN(R0) ;D.BOUND TACK2: ; (HERE FROM 100$ ABOVE) ;08 MOV S.DIMP(R5),R1 ;IF THE DIM LIST IS NULL BNE 10$ ;THEN MOV R0,S.DIMP(R5) ;JUST STORE BR 30$ ; 10$: TST (R1) ;OTHERWISE FIND THE END OF THE BEQ 20$ ;EXISTING DIMS MOV (R1),R1 ;D.LINK IS ZERO BR 10$ ; 20$: MOV R0,(R1) ;AND ADD IT THERE 30$: RETURN ;FINIS ;+ ; ** DECLST - RUN DOWN A ',' SEPARATED LIST OF DECLARATORS ; ; USES: ; R0, R5 ;- ; ; FILLER FIELD. ; DECLST: CMP CLASS,#CL.MOS ;DECLARING MEMBER OF STRUCTURE? BNE 2$ ;NO, CANNOT BE FIELD. CMP LEX1,#OP.CLN ;":" BNE 2$ ;NO, CANNOT BE FIELD. CALL SCAN ;SKIP ":". CALL SCAN ;WIDTH. CMP R0,#OP.CON ;INTEGER CONSTANT? BNE 7$ ;NO, ERROR. CALL BITFLD ;CHECK THE WIDTH OUT, AND ADD VAL0,BITOFS ;ADJUST OFFSET. BR 4$ ;DONE. ; ; NORMAL DECLARATOR. ; PERHAPS FIELD. ; 2$: CALL GDECLR ;READ DECLARATOR. BCS 10$ ;URK. CLRB FIELD ;NOT A FIELD. CMP CLASS,#CL.MOS ;MEMBER OF STRUCTURE? BNE 3$ ;NO, CANNOT BE A FIELD. CMP LEX1,#OP.CLN ;":" BNE 3$ ;NO, CANNOT BE A FIELD. CALL SCAN ;":" CALL SCAN ;WIDTH. CMP R0,#OP.CON ;MUST BE INTEGER CONSTANT. BNE 7$ ;URK. CALL BITFLD ;CHECK IT OUT. MOVB VAL0,FWIDTH ;SAVE FOR "DEFINE" INCB FIELD ;SET "FIELD" FLAG FOR "DEFINE". 3$: CALL DEFINE ;DEFINE THE NAME. ; ; IF NEXT TOKEN IS "," DON'T RETURN TO THE ORDINARY SYMBOL TABLE OR ; "INT A, B, C;" IN A STRUCTURE WILL BE MISCOMPILED. ; THANKS TO PHIL AND KEN. ; 4$: CMP LEX1,#OP.CMA ;COMMA? BNE 5$ ;NO CALL SCAN ;SKIP IN CURRENT S.T. BR DECLST ; 5$: MOV INMOSF,-(SP) ;SAVE CLR INMOSF ;SCAN IN THE CALL SCAN ;ORDINARY TABLE MOV (SP)+,INMOSF ;BACK CMP R0,#OP.SEM ;IF SEMICOLON BEQ 30$ ;DONE 7$: CALL DECSYN ;OOPS 10$: MOV LEX0,R0 ;SKIP BAD INPUT 20$: CMP R0,#OP.SEM ; BEQ 30$ ; CMP R0,#OP.EOF ; BEQ 30$ ; CALL SCAN ; BR 20$ ; 30$: RETURN ; ;+ ; ** BITFLD -- CHECK OUT BITFIELD. ; ; THIS ROUTINE CHECKS THAT THE BASE TYPE OF A BITFIELD IS "UNSIGNED" ; OR "INT", AND THAT THE SIZE OF THE FIELD IS <= 16. IT ADJUSTS THE ; BIT OFFSET "BITOFS" AND THE BYTE OFFSET "OFFSET" TO ENFORCE WORD ; PACKING OF FIELDS. ; ; INPUTS: ; VAL0=SIZE (BITS). ; ; USES: ; R0 ;- BITFLD: CMP VAL0,#16. ;IS FIELD TOO WIDE? BLOS 10$ ;NO. MOV #ERR18,R0 ;YES, COMPLAIN CALL ERROR1 ;ABOUT IT. ;01 10$: MOV TYPE,R0 ;GET BASETYPE. CMP R0,#TY.INT ;MUST BE BEQ 20$ ;INT CMP R0,#TY.UNS ;OR BEQ 20$ ;UNSIGNED. MOV #ERR19,R0 ;OR CALL ERROR1 ;ITS AN ERROR. ;01 20$: MOV VAL0,R0 ;SKIP TO NEXT WORD IF BEQ 25$ ;":0: OR ;u2 Bug? ADD BITOFS,R0 ;IF THE FIELD CMP R0,#16. ;DOES NOT BLOS 30$ ;FIT. 25$: ADD #2,OFFSET ;NEXT WORD. ;u2 CLR BITOFS ;FIRST BIT. 30$: RETURN ;DONE ;+ ; ** DECSYN - DECLARATION SYNTAX ERROR ; ; USES: ; R0 ;- DECSYN: MOV #ERR07,R0 ;WRITE OUT THE DIAGNOSTIC CALLR ERROR1 ; ;01 ;+ ; ** DEFINE - DEFINE A SYMBOL ; ; DEFINE A SYMBOL, USING INFORMATION STASHED IN THE GLOBAL VARIABLES ; CLASS, TYPE, DOPE AND OFFSET. MANY CHECKS ARE MADE FOR CLASHES AND ; RECLARATIONS. ; ; INPUTS: ; R5=SYMBOL TABLE POINTER ;- DEFINE: MOV R1,-(SP) ;SAVE REGISTERS MOV R0,-(SP) ; CLRB RF ;REDECLARATION FLAG MOV CLASS,ACLASS ;GET WORKING COPIES OF CLASS MOV TYPE,ATYPE ;AND TYPE ; ; FIELDS MUST BE SCALAR. ; TSTB FIELD ;PROCESSING A FIELD? BEQ 5$ ;NO. TST S.DIMP(R5) ;ANY DIMS? BEQ 5$ ;NO. MOV #ERR20,R0 ;FIELD MUST BE A CALL ERRSYM ;SCALAR. ;01/02 ; ; AUTOMATIC FUNCTIONS DON'T MAKE ANY SENSE AND ARE, IN FACT, FORBID- ; DEN. HOWEVER, DMR'S COMPILER ALLOWED THEM INSIDE OF A FUNCTION; HE ; JUST CHANGED THE CLASS TO GLOBAL REFERENCE. HERE WE DO THE SAME. ; 5$: MOV S.DIMP(R5),R0 ;GET DIMS BEQ 70$ ;NO DIMS CMP D.TYPE(R0),#DT.FUN ;IS IT A FUNCTION BNE 10$ ;NO CMP ACLASS,#CL.AUT ;IS IT AN AUTOMATIC FUNCTION BNE 10$ ;NO MOV #CL.GBR,ACLASS ;MAKE IT GLOBAL REFERENCE ; ; CHECK FOR SEMANTICLY FORBIDDEN DECLARATORS. ; ARRAYS OF FUNCTIONS. ; FUNCTIONS RETURNING ARRAYS. ; FUNCTIONS RETURNING FUNCTIONS. ; FUNCTIONS RETURNING STRUCTURES. ; ; THE AF AND FF ARE USED TO REMEMBER WHAT THE LAST THING YOU FOUND ON ; THE DIM LIST WAS (POINTERS CLEAR BOTH). AS YOU WALK DOWN THE LIST ; FORBIDDEN DECLARATORS ARE RECOGNISED BASED ON D.TYPE AND THE LAST ; ITEM ON THE LIST. ; 10$: CLRB FF ;FUNCTION FLAG CLRB AF ;ARRAY FLAG 20$: MOV D.TYPE(R0),R1 ;DIM TYPE CMP R1,#DT.ARY ;ARRAYS BNE 30$ ;NO TSTB FF ;ERROR IF ARRAY OF FUNCTIONS BNE 60$ ; CLRB FF ;SET ARRAY INCB AF ; BR 50$ ; 30$: CMP R1,#DT.PTR ;POINTERS BNE 40$ ;NO CLRB FF ;SET POINTER CLRB AF ; BR 50$ ; 40$: BISB FF,AF ;MUST BE FUNCTION BNE 60$ ;ERROR IF REURNING FUNCTION OR ARRAY INCB FF ;SET FUNCTION CLRB AF ; 50$: MOV (R0),R0 ;FOLLOW ALONG THE DIM LIST BNE 20$ ; TSTB FF ;WAS THE LAST ENTRY A FUNCTION BEQ 70$ ;NO CMP ATYPE,#TY.UST ;RETURNING A STRUCTURE (OR UNION) BLO 70$ ;NO 60$: MOV #ERR08,R0 ;ILLEGAL DECLARATOR CALL ERRSYM ; ;01/02 ; ; BECAUSE THE PDP-11 DOES NOT HAVE A COMPLETELY UNIFORM INSTRUCTION ; SET WITH RESPECT TO BYTES AND FLOATS, WIDEN NAKED CHAR AND FLOAT ; ITEMS (NOT IN STRUCTURES) INTO INT AND DOUBLE ITEMS. THIS CAN BE ; DONE ON THE PDP-11 BECAUSE IT STORES THE BYTES IN A WORD RIGHT TO ; LEFT (POINTERS HAVE THE SAME ADDRESS). ; ; This code segment was removed because of two problems: ; extern char foo; If foo is accessed as int, but is stored ; on an odd-byte boundary, the program crashes. ; foo = 257; As foo is a char, this should assign 0 to foo. ; ; However, the widening of char to int is allowed for "register char foo;" ; declarations as code somewhere else thinks that "register char" may ; not be stored in a register! Sorry for the mess. ; 70$: .IF NE 0 ;04 CMP ACLASS,#CL.MOS ;ARE WE IN A STRUCTURE BEQ 90$ ;YES TST S.DIMP(R5) ;NO, IS THIS A SOLITARY ITEM BNE 90$ ;NO CMP ATYPE,#TY.CHR ;CHAR BNE 80$ ; MOV #TY.INT,ATYPE ;BECOMES INT BR 90$ ; 80$: CMP ATYPE,#TY.FLT ;FLOAT BNE 90$ ; MOV #TY.DBL,ATYPE ;BECOMES DOUBLE .ENDC ;04 ; ; TYPE ; 90$: CMPB S.CLAS(R5),#CL.ARG ;IF THE OLD CLASS IS FLOATING ARG BNE 100$ CMP ACLASS,#CL.ARG ;DOES THE ARGUMENT ALREADY EXIST? ;23 BEQ 110$ ;YES, CAN'T ALLOW THAT ;23 CALL BADARG ;NO TYPE CHECK, BUT INSURE VALID ARG BR 120$ 100$: MOVB S.TYPE(R5),R0 ;OLD TYPE BEQ 120$ ;WAS UNDEFINED MOV R0,-(SP) ;FREE CALL FDOPE ;DOPE MOV (SP)+,R0 ;BLOCK MOVB S.CLAS(R5),R1 ;OLD CLASS CMP R1,#CL.GBR ;REDEFINABLE IF GLOBAL REF BEQ 105$ CMP R1,#CL.GBD ;OR GLOBAL DEF ;15 BEQ 105$ ;15 CMP R1,#CL.TAG ;OR STRUCTURE TAG BEQ 105$ CMP R1,#CL.MOS ;OR MEMBER OF STRUCTURE BNE 110$ 105$: CMP R0,ATYPE ;BUT THE TYPE MUST NOT CHANGE BEQ 120$ 110$: INCB RF ;REDECLARATION 120$: MOVB ATYPE,S.TYPE(R5);SET THE TYPE ; ; DOPE ; THIS IS ONLY DONE FOR STRUCTURE TAGS AND STRUCTURES SO THAT THE REF ; COUNT IN THE DOPE BLOCK WILL BE CORRECT. IF THE TYPE IS AN UNDEFINED ; STRUCTURE THE DOPE POINTER CONTAINS A POINTER TO THE SYMBOL NODE OF ; THE TAG, AND THE REFERENCE COUNT MUST NOT BE TOUCHED! ; CMP ATYPE,#TY.UST ;STRUCTS OR UNIONS BHIS 130$ ;YES CMP ACLASS,#CL.TAG ;NO, STRUCTURE TAG BNE 140$ ;NO 130$: MOV DOPE,R0 ;SET DOPE POINTER MOV R0,S.DOPE(R5) ;INTO THE SYMBOL NODE CMP ATYPE,#TY.UST ;AND IF THE TYPE BEQ 140$ ;IS NOT UNDEFINED STRUCTURE CMP ATYPE,#TY.UUN ;OR UNDEFINED UNION BEQ 140$ ; INC S.REFC(R0) ;FIX REFERENCE COUNT ; ; CLASS ; FIELDS GET WORD ALLIGNED BECAUSE THEY ARE "INT". ; 140$: CMP ACLASS,#CL.MOS ;MEMBER OF STRUCTURE BNE 150$ ;NO TSTB FIELD ;IS THE MEMBER A FIELD? BNE 142$ ;YES. TST BITOFS ;NO, ANY BITS? BEQ 142$ ;NO. ADD #2,OFFSET ;FIX OFFSET AND CLR BITOFS ;BITS. 142$: CALL ISBYTE ;ALLIGN? BCC 150$ ;NO. BIT #1,OFFSET ;NEED TO? BEQ 150$ ;NO INC OFFSET ;FIX OFFSET AND BISB #SF.RUP,S.FLAG(R5) ;SET ROUND UP FLAG (FOR CSINIT) ;13 150$: MOV ACLASS,R1 ;NEW CLASS MOVB S.CLAS(R5),R0 ;OLD CLASS BEQ 164$ ;BR IF UNDEFINED CMP R0,R1 ;IF THEY ARE THE SAME CLASS BEQ 160$ ;OK CMP R0,#CL.ARG ;IF OLD IS FLOATING ARGUMENT BNE 151$ ; CMP R1,#CL.DEF ;AND NEW IS DEFINED ARG BEQ 160$ ; CMP R1,#CL.DRG ;OR DEFINED REGISTER ARGUMENT BEQ 160$ ;ACCEPT IT 151$: CMP R0,#CL.GBR ;IF OLD IS GLOBAL REFERENCE BNE 152$ ;AND CMP R1,#CL.SEX ;NEW IS STATIC EXTERNAL BEQ 160$ ;ITS OK. 152$: CMP R0,#CL.GBR ;GLOBAL REF VS. GLOBAL DEF BEQ 153$ CMP R0,#CL.GBD BNE 156$ 153$: CMP R1,#CL.GBR BEQ 154$ CMP R1,#CL.GBD BNE 156$ 154$: MOV #CL.GBD,ACLASS ;RESOLVES AS GLOBAL DEF BR 170$ 156$: INCB RF ;REDECLARATION 160$: MOVB S.FLAG(R5),R0 ;GRAB FLAGS. ;13 BIC #^C,R0 ;MASK OFF THE "FIELD" FLAG. BISB FIELD,R0 ;ADD CURRENT DEF. BEQ 161$ ;NEITHER IS A FIELD. CMP R0,#SF.FLD+1 ;WELL? BEQ 161$ ;BOTH ARE FIELDS. INCB RF ;REDECLARATION. BR 170$ ;DON'T COMPLAIN ABOUT OFFSET TOO. 161$: CMP R1,#CL.TAG ;IF TAG BEQ 162$ ;OR CMP R1,#CL.MOS ;MEMBER OF BNE 166$ ;STRUCTURE 162$: MOV S.ADDR(R5),R0 ;MAKE SURE THE OFFSET CMP R0,OFFSET ;HASN'T CHANGED. BEQ 163$ ;IT IS OK. MOV #ERR09,R0 ;GIVE CALL ERRSYM ;ERROR ;01/02 163$: TSTB FIELD ;AND IF FIELD BEQ 170$ ;THEN MOV BITOFS,R0 ;MAKE SWAB R0 ;SURE BISB FWIDTH,R0 ;THE CMP R0,S.FLD(R5) ;BIT INFO BEQ 170$ ;HAS MOV #ERR21,R0 ;NOT CALL ERRSYM ;CHANGED. ;01/02 164$: CMP R1,#CL.DEF ;IF OLD UNDEFINED, BUT CLASS IS DEF BEQ 165$ ; CMP R1,#CL.DRG ;OR DRG BNE 166$ ; 165$: MOV #ERR11,R0 ;YOU ARE DECLARING A FORMAL PARAMETER CALL ERRSYM ;THAT WASN'T IN THE ARGLIST ;01/02 166$: CMP R1,#CL.REG ;REGISTER BEQ 1660$ ;YES CMP R1,#CL.DRG ;DEFINED REGISTER ARGUMENT BNE 170$ ;NO 1660$: CALL OKREG ;WILL THE ITEM GO IN A REGISTER BCS 167$ ;NO CMP NXTREG,#1 ;YES, IS THERE ONE FREE BHI 170$ ;YES 167$: MOV #CL.AUT,R1 ;MAKE AUTO 170$: MOVB R1,S.CLAS(R5) ;SET CLASS INTO THE SYMBOL BICB #SF.FLD,S.FLAG(R5) ;CLEAR FIELD FLAG. ;13 TSTB FIELD ;REALLY A FIELD? BEQ 172$ ;NO. BISB #SF.FLD,S.FLAG(R5) ;SET FIELD FLAG ;13 MOVB BITOFS,S.BOFS(R5) ;SET OFFSET. MOVB FWIDTH,R0 ;GRAB WIDTH. MOVB R0,S.WIDE(R5) ;SET THE WIDTH AND ADD R0,BITOFS ;FIX BIT OFFSET. 172$: TSTB RF ;PRINT ERROR IF REDECLARATION BEQ 180$ MOV #ERR10,R0 CALL ERRSYM ;01/02 ; ; FILL IN THE S.ADDR FIELD. ; 180$: CALL SLENG ;GET SIZE (BYTES) INTO R0 CMP R1,#CL.MOS ;IS IT MOS BNE 185$ ;NO MOV OFFSET,S.ADDR(R5) ;SET STRUCTURE OFFSET TSTB FIELD ;FIELD? BNE 182$ ;YES. ADD R0,OFFSET ;ADJUST BY SIZE 182$: CALL ADOPE ;APPEND TO THE DOPE LIST TST UNION ;DOING A UNION BEQ 200$ ;NO CALL ROFSET ;ROUND UP OFFSET. MOV OFFSET,R0 ;GO BACK TO THE START CLR OFFSET ; CLR BITOFS ; CMP R0,MOFSET ;HAS THE UNION GROWN BLOS 200$ ;NO MOV R0,MOFSET ;RESET MAX SIZE BR 200$ ; 185$: CMP R1,#CL.TAG ;IS IT A STRUCTURE TAG BNE 190$ ;NO CALL BACKPG BR 200$ 190$: CMP R1,#CL.AUT ;AUTO BNE 193$ ;NO CALL RUP0 ;MAKE THE SIZE EVEN SUB R0,OFFSET ;GET THE ADDRESS AND MOV OFFSET,S.ADDR(R5) BR 200$ 193$: CMP R1,#CL.REG ;REGISTER BEQ 194$ ;OR CMP R1,#CL.DRG ;DEFINED REGISTER BNE 195$ ; 194$: MOV NXTREG,S.ADDR(R5) ;USE NEXT AVAILABLE REGISTER DEC NXTREG BR 200$ 195$: CMP R1,#CL.SIN ;STATIC INTERNAL BNE 200$ ;NO MOV R0,-(SP) ;SAVE THE SIZE CALL OREC ;GET INTO CORRECT PSECTION ;03 CALL ALLIGN ;FORCE EVEN CALL GENLB1 ;A LABEL FOR THE SPACE ;01 MOV R0,S.ADDR(R5) ;PUT IN THE SYMBOL NAME AND CALL LREC ;PUT OUT A LABEL MOV (SP)+,R0 ;PUT OUT A BSS FOR THE SPACE CALL BREC ; CALL PREC ;GET BACK TO PROGRAMME PSECTION ; ; SET SF.PRM ON ALL EXTERNALS, AND ANY SYMBOL THAT IS ENCOUNTERED OUT ; OF A FUNCTION (EXCEPT FOR FUNCTION ARGUMENTS). ; 200$: CMP R1,#CL.GBR ;IF GLOBAL REF BEQ 210$ ; CMP R1,#CL.GBD ;OR GLOBAL DEF BEQ 210$ ; TST FSYMBL ;OR NOT IN A FUNCTION BNE 220$ ; CMP R1,#CL.ARG ;AND NOT AN ARG BEQ 220$ ; 210$: BISB #SF.PRM,S.FLAG(R5) ;SET PERM SYMBOL FLAG ;13 220$: MOV (SP)+,R0 ;RETURN MOV (SP)+,R1 ; RETURN ; ;+ ; ** ROFSET -- ROUND UP OFFSET. ; ; THIS ROUTINE ROUNDS UP THE BYTE OFFSET "OFFSET" TO AN EVEN NUMBER ; OF WORDS, AND ADDS 1 MORE WORD IF THERE IS A PENDING BIT FIELD. ;- ROFSET: INC OFFSET ;ROUND UP BIC #1,OFFSET ;OFFSET TST BITOFS ;DREGS OF A FIELD? BEQ 10$ ;NO. ADD #2,OFFSET ;ONE MORE WORD. 10$: RETURN ;DONE ;+ ; ** BADARG - LOOK FOR BAD ARGUMENTS ; ; THIS ROUTINE CHECKS FOR THINGS WHICH CANNOT BE PASSED AS A FUNCTION ; ARGUMENT (STRUCTURES AND FUNCTIONS). THIS ROUTINE IS CALLED BY DEF- ; INE WHEN THE SYMBOL IS NOT UNDEFINED AND THE NEW CLASS IS CL.DEF. ; ; INPUTS: ; R5=POINTER TO SYMBOL TABLE ; ; USES: ; R0 ;- BADARG: MOV S.DIMP(R5),R0 ;GET DIMENSIONS BEQ 10$ ;BR IF SCALAR CMP D.TYPE(R0),#DT.FUN ;IS IT A FUNCTION BEQ 20$ ;YES, BAD BR 30$ ;OK 10$: CMPB S.TYPE(R5),#TY.UST ;SCALAR, CHECK FOR STRUCTURES BLO 30$ ;OK 20$: MOV #ERR12,R0 ;IMPOSSIBLE ARGUMENT CALL ERRSYM ;01/02 30$: RETURN ;+ ; ** OKREG - CHECK IF A SYMBOL CAN BE A REGISTER VARIABLE ; ; DEFINE USES THIS ROUTINE TO DETERMINE IF AN ITEM MAY BE BOUND TO A ; GENERAL REGISTER. ALL WORD ITEMS (INT, UNSIGNED) AND ALL POINTERS ; ARE OK. ; ; THE SPECIFIED SYMBOL MUST HAVE VALID S.TYPE AND S.DIMP FIELDS. ; ; INPUTS: ; R1=S.CLAS FIELD ; R5=SYMBOL TABLE NODE ; ; USES: ; R0 ;- OKREG: MOV S.DIMP(R5),R0 ;GET DIMS BEQ 10$ ;BR IF SCALAR CMP D.TYPE(R0),#DT.PTR ;IS IT A POINTER BEQ 20$ ;YES, OK CMP R1,#CL.DRG ; IS IT A FUNCTION ARGUMENT? ;u3+ BNE 30$ ; NO, NOT OK BR 16$ ;SCAN FOR LAST DIM 15$: MOV (R0),R0 ;GET NEXT 16$: TST (R0) ;IS THIS THE LAST DIM? BNE 15$ ;SKIP IF NOT CMP D.TYPE(R0),#DT.ARY ;IS IT AN ARRAY OR SOMETHING? BEQ 20$ ;YES, OK ;u3- BR 30$ ;NO, NOT OK 10$: MOVB S.TYPE(R5),R0 ;GET TYPE CMP R0,#TY.INT ;INTS ARE BEQ 20$ ;OK CMP R0,#TY.CHR ;CHAR'S ;05 BEQ 20$ ;ARE OK ;05 CMP R0,#TY.UNS ;UNSIGNS ARE BNE 30$ ;OK TOO 20$: CLC ;GOOD RETURN BR 40$ 30$: SEC ;BAD RETURN 40$: RETURN ;RETURN ;+ ; ** ISBYTE - CHECK IF A SYMBOL IS BYTE ALLIGNED ; ; INPUTS: ; R5=SYMBOL TABLE NODE ; ; OUTPUTS: ; C=0 IF BYTE ALLIGNED ; ; USES: ; R0 ;- ISBYTE: CMPB S.TYPE(R5),#TY.CHR ;IS THE TYPE 'CHAR' BNE 20$ ;NO, CANNOT POSSIBLE BY BYTE ALLIGNED MOV S.DIMP(R5),R0 ;GET DIMS BEQ 10$ ;SCALAR IS BYTE ALLIGNED CMP D.TYPE(R0),#DT.ARY ;ARRAYS OF CHAR ARE BYTE ALLIGNED BNE 20$ ;NOT BYTE ALLIGNED 10$: CLC ;GOOD RETURN BR 30$ 20$: SEC ;BAD (NOT BYTE) RETURN 30$: RETURN ;+ ; ** BACKPG - BACKPLUG STRUCTURES AND UNIONS ; ; THIS ROUTINE IS CALLED BY DEFINE WHEN A STRUCTURE TAG IS DEFINED. IT ; SEARCHES THROUGH THE SYMBOL TABLE, LOOKING FOR UNDEFINED STRUCTURES ; AND/OR UNDEFINED UNIONS WAITING FOR THE DEFINITION OF THE TAG. TYPE ; IS SET TO STRUCT OR UNION AND THE DOPE IS SET CORRECTLY. ; ; INPUTS: ; R5=SYMBOL TABLE POINTER (TAG) ; ; USES: ; R0, R1 ;- BACKPG: ;13+ MOV R2,-(SP) ;SAVE WORKING REGISTER MOV R5,R2 ;R2 -> SYMBOL TABLE POINTER (TAG) MOV DOPE,R1 ;CURRENT DOPE MOV #10$,R5 ;SETUP TO WALK SYMBOL TABLE CALL SYWALK ;GO FOR IT MOV R2,R5 ;RESTORE SYMBOL TABLE POINTER MOV (SP)+,R2 ;RESTORE WORKING REGISTER RETURN ;THAT'S ALL. ; ; Called on each node. ; 10$: CMPB S.TYPE(R5),#TY.UST ;UNDEFINED STRUCTURE? BEQ 20$ ;YES CMPB S.TYPE(R5),#TY.UUN ;UNDEFINED UNION BNE 30$ ;NO 20$: CMP S.DOPE(R5),R2 ;WAITING FOR THIS SYMBOL? BNE 30$ ;NO INCB S.TYPE(R5) ;UST=>STR UUN=>UNI INCB S.TYPE(R5) ; INCB S.TYPE(R5) ; INCB S.TYPE(R5) ; MOV R1,S.DOPE(R5) ;SET DOPE INC S.REFC(R1) ;FIX DOPE REFERENCE COUNT 30$: RETURN ;GO FOR NEXT SYMBOL ;13- ;+ ; ** ADOPE - APPEND TO THE DOPE LIST ; ; INPUTS: ; R5=SYMBOL TABLE NODE ; ; USES: ; R0 ;- ADOPE: CLR S.AUXP(R5) ;INSURE THE DOPE LIST PTR IS CLEAR MOV DOPEPT,R0 ;GET DOPE POINTER BNE 10$ ;NOT NULL MOV R5,DOPEPT ;START THINGS OFF BR 30$ ; 10$: TST S.AUXP(R0) ;FIND THE END BEQ 20$ ;PERHAPS A POINTER TO THE END WOULD MOV S.AUXP(R0),R0 ;BE USEFUL BR 10$ ; 20$: MOV R5,S.AUXP(R0) ;ADD IT THERE 30$: RETURN ;DONE ;+ ; ** DUPDIM - DUPLICATE DIMS ; ; THIS ROUTINE, GIVEN A POINTER TO A DIMENSION LIST, MAKES A COPY OF IT. ; IT IS USED (BY GDECLR) TO INSURE THAT EVERY SYMBOL HAS ITS OWN DIMLIST ; EVEN IF THE DIMS CAME FROM A TYPEDEF. ; ; INPUTS: ; R0=POINTER TO DIMS ; ; OUTPUTS: ; R0=POINTER TO DUPLICATED DIMS ;- DUPDIM: MOV R1,-(SP) ;SAVE R1 MOV R0,R1 ;ANY DIMS HERE BEQ 10$ ;NO MOV D.LINK(R1),R0 ;DUPLICATE THE REST CALL DUPDIM ; MOV R0,-(SP) ;SAVE REST MOV #D.LENG,R0 ;ALLOCATE A BLOCK CALL $ALLOC ; MOV (SP)+,D.LINK(R0);LINK IN DUPLICATED REST MOV D.TYPE(R1),D.TYPE(R0) ;COPY TYPE MOV D.BOUN(R1),D.BOUN(R0) ;AND BOUNDS 10$: MOV (SP)+,R1 ;RESTORE R1 RETURN ; ;+ ; ** RUP0 - ROUND UP R0 ; ; INPUTS: ; R0=NUMBER TO ROUND ; ; OUTPUTS: ; R0=NUMBER, ROUNDED UP EVEN ;- RUP0: INC R0 ;ROUND BIC #1,R0 ;IS EASY RETURN ;SOMETIMES ;+ ; ** MOSYMT -- MOS SYMBOL TABLES. ; ; LOOP THROUGH THE SYMBOL TABLE, LOOKING FOR ITEMS WITH CLASS OF MOS ; AND PUT OUT A SYMBOL TABLE ENTRY FOR THEM. DOING THIS AT THE LAST ; MAKES SURE ONLY ONE ENTRY GOES OUT PER NAME. ; ; USES: ; R5 ;- MOSYMT: MOV #10$,R5 ;SETUP TO WALK THE TABLE ;13+ CALL SYWALK ;WALK THE TABLE RETURN ;WALKED THE TABLE 10$: CMPB S.CLAS(R5),#CL.MOS ;MEMBER? BNE 20$ ;NO. CALL PRSTE ;PUT OUT SYMBOL TABLE ENTRY. 20$: RETURN ;13- ;+ ; ** WARN1 - ISSUE NON FATAL DIAGNOSTIC ;01 ; ** ERROR1 - ISSUE FATAL DIAGNOSTIC ;01 ; ** ERRSYM - ISSUE FATAL "SYMBOL DECLARATION" ERROR ;02 ; ** WARNSY - ISSUE NON-FATAL "SYMBOL" ERROR ;13 ; ** FATAL1 - ISSUE DIAGNOSTIC AND ABORT COMPILATION ;25 ; (MESSAGE IN R0, JMP FATAL1) ; ; ALL PHASE 1 DIAGNOSTICS ARE ISSUED BY THESE ROUTINES. THEY FORMAT ; THE MESSAGE (ADDING THE LINE NUMBER AND THE FILE NAME) AND PUT IT ; OUT THE ERROR STREAM BY CALLING CCERR (IN CC0RT). THE ERROR COUNT ; IS INCREMENTED BY ERROR. ; ; IF THE -V OPTION IS SET DOECHO IS CALLED TO ECHO THE CURRENT LINE ; OF INPUT ONTO THE ERROR STREAM. ; ; INPUTS: ; R0=POINTER TO ASCIZ MESSAGE ; R5=POINTER TO SYMBOL TABLE ENTRY (ERRSYM/WARNSY ONLY) ;02 ; R5=0 (ERROR1/WARN1) ;- ERRSYM: INC NERRS ;IT'S A REAL ERROR ;13 WARNSY: ;HERE ON NON-FATAL SYMBOL ERR'S ;13 MOV R5,-(SP) ;SAVE ;02+ MOV R1,-(SP) ;WORKING MOV R0,-(SP) ;REGISTERS BR WARN2 ;JOIN MAIN CODE ;02- FATAL1: MOV #CCSTOP,-(SP) ;FORCE ABORT EXIT FROM COMPILER ;25 ;BR ERROR1 ;CONTINUE TO PRINT ERROR MSG. ;25 ERROR1: INC NERRS ;ERROR COUNTS ERRORS ;01 WARN1: MOV R5,-(SP) ;SAVE R5 ;02 MOV R1,-(SP) ;SAVE REGISTERS ;01 MOV R0,-(SP) ; CLR R5 ;NO SYMBOL TABLE ENTRY WARN2: ;02- MOV #MBUF,R1 ;STORE LINE NUMBER MOV LINENO,R0 ;IN THE CALL $ITOC ;MESSAGE BUFFER MOVB #':,(R1)+ ;FOR MOVB #' ,(R1)+ ;LOOKS MOV #FILE,R0 ;GET POINTER TO FILE NAME TSTB (R0) ;IS THERE ONE BEQ 20$ ;NO 10$: MOVB (R0)+,(R1)+ ;COPY BNE 10$ ;INTO DEC R1 ;MESSAGE MOVB #':,(R1)+ ;FOR MOVB #' ,(R1)+ ;LOOKS 20$: MOV (SP),R0 ;COPY 30$: MOVB (R0)+,(R1)+ ;THE BNE 30$ ;MESSAGE DEC R1 ;BACK TO THE NULL ;02+ TST R5 ;IS THERE A SYMBOL NAME? BEQ 33$ ;NO, CONTINUE MOVB #040,(R1)+ ;' ' MOVB #'",(R1)+ ;'"' MOV R5,R0 ;GET SYMBOL TABLE ENTRY ADD #S.NAME,R0 ;R0 -> SYMBOL NAME 32$: MOVB (R0)+,(R1)+ ; BNE 32$ ;ALL OF IT MOVB #'",-1(R1) ;TERMINATING QUOTE REPLACES NULL CALL MSGEOL ;EOL IF LONG MESSAGE ;13+ TSTB S.CLAS(R5) ;IS IT DEFINED? ;14 BEQ 33$ ;BR IF NOT ;14 MOV #ATLINE,R0 ;"(defined at line" 3250$: MOVB (R0)+,(R1)+ ;MOVE IT OUT BNE 3250$ ;ALL OF IT DEC R1 ;FIX TRAILER MOV S.LINE(R5),R0 ;LINE NUMBER WHERE DEFINED CALL $ITOC ;PUT IT OUT MOVB #'),(R1)+ ;TRAILER, TOO ;13- 33$: ;02- TST FSYMBL ;IN A FUNCTION BEQ 37$ ;NO CALL MSGEOL ;FORCE EOL IF TOO FAR ;13 MOV #INFUNC,R0 ;COPY " IN FUNCTION " 35$: MOVB (R0)+,(R1)+ ; BNE 35$ ;AND DEC R1 ;THEN MOV FSYMBL,R0 ;COPY IN THE ADD #S.NAME,R0 ;NAME OF THE 36$: MOVB (R0)+,(R1)+ ;CURRENT BNE 36$ ;FUNCTION. DEC R1 ;ADD A MOVB #'",(R1)+ ;QUOTE ;02 37$: CLRB (R1) ;FORCE TERMINATING NULL ;02 MOV #MBUF,R0 ;PTR TO ASCIZ MESSAGE CALL CCERR ;PUT OUT ERROR MESSAGE TSTB VFLAG ;-V BEQ 40$ ;BR IF NOT CALL DOECHO ;ECHO THE LINE 40$: MOV (SP)+,R0 ;DONE, ;02 MOV (SP)+,R1 ;RESTORE MOV (SP)+,R5 ;REGISTERS CMP NERRS,#MAXERR ;TOO MANY ERRORS? ;11+ BGT 50$ ;SORRY. RETURN ; 50$: MOV #ERR25,R0 ;TERMINATION ERROR MESSAGE CALL CCERR ; JMP CCWRAP ;GOOD BYE FOR NOW ;11- MSGEOL: ;CALLED IN CASE OF LONG MESSAGE ;13+ CMP R1,#MBUF+50. ;GONE TOO FAR? BLO 10$ ;NOT YET CLRB (R1) ;YES, TERMINATE MESSAGE MOV #MBUF,R0 ;GET THE BUFFER CALL CCERR ;AND PRINT IT MOV #MBUF,R1 ;RESET POINTER 10$: RETURN ;13- .END