! File: DECLAR.BLI ! ! This work was supported by the Advanced Research ! Projects Agency of the Office of the Secretary of ! Defense (F44620-73-C-0074) and is monitored by the ! Air Force Office of Scientific Research. MODULE DECLAR(TIMER=EXTERNAL(SIX12))= BEGIN ! DECLAR MODULE ! ------------- ! ! D. WILE ! MODIFIED BY: ! R. JOHNSSON ! P. KNUEVEN ! ! ! THIS MODULE PROCESSES DECLARATIONS. ! ! REQUIRE COMMON.BEG; REQUIRE GTST.BEG; REQUIRE ST.BEG; REQUIRE GTX.BEG; REQUIRE LDSFT.BEG; REQUIRE LDSF.BEG; REQUIRE ERROR.BEG; REQUIRE STRUCT.BEG; REQUIRE TN.BEG; REQUIRE IO.BEG; BEGIN !NEXT FIELD DEFINITIONS FOR THE FIELDS OF THE 2 WORD !LIST WE MAKE UP FOR SIZE PROCESSING IN THE DECLARATIONS. MACRO STELNEXTF=0,0,18$, STELSTEF=0,18,18$, STELCPF=1,0,36$; !------------------------------------------------------- ! THE FOLLOWING ARE MISC. EXTERNALS FOR DECLAR ONLY EXTERNAL CSCNAME, CSDNAME, CSGNAME, CSONAME, CSPNAME, DECLSIZE, ! 1 DURING "BYTE" DECLARATION, OTHERWISE 2 IDENTFLG, IDENTLEX, INAPLIT, ! SIGNAL FROM PLIT PARSER TO DETBRACKET (VIA HRUND) % THE FOLLOWING FOUR VARIABLES ARE SET BY GROMLIST % OEQL, ! POINTS TO ROUTINE TO PROCESS "=" OFUN, ! POINTS TO ROUTINE TO DO RANDOM BITS OF ! PROCESSING ON EACH VARIABLE (E.G. PLABEL, PLOCAL) OPAR, ! NOT USED AS FAR AS I KNOW. OTYPE, ! VARIABLE TYPE BEING DECLARED PLHEAD, ! CHARACTER STRING - NAME OF CURRENT PLIT PLLBRAC, ! LOCATION OF LAST PLIT LEFT PAREN STELAST, ! LAST ENTRY IN LIST OF SYMBOLS BEING DECLARED STELIST, ! LIST OF SYMBOLS BEING DECLARED UNAMNO; EXTERNAL GETTN, ! FROM LOW SEGMENT STRMAPPEND, ! FROM LEXAN STRMQUIT, STRUSC, BINDBIND, ! FROM SYNTAX PDETACH, DYNBIND, EXPRESSION, GETNCSE, RNAMEFOLLOWS, SENABLE, STRUPICKOFF; ! MACROS AND BINDS FOR SWITCHES: ! BIND SWSWL=19; !HIGHEST SWITCH INDEX VALID IN SWITCHES DECL. MACRO ALLSW=.SWTBL[-1]$; ! " " " " " MODULE HEAD ! THESE MACROS HELP IN SPECIFYING THE VALID SWITCHES. MACRO BS(NUM,STR)=('STR' OR ((-1)^(-7*NUM))) AND (-2)$, BL(STR)='STR' AND (-2)$; ! THE FOLLOWING IS A LIST OF SWITCHES FOR THE BLISS COMPILER. ! IT IS A PLIT WHICH IS SEARCHED AS A VECTOR. ! ! THIS DECLARATION IS SET UP AS FOLLOWS: ! ! FOR EACH ALLOWABLE SWITCH NAME, ONE OF THE ABOVE ! MACROS IS INVOKED WITH THE FIRST FIVE (5) CHARACTERS ! OF THAT SWITCH NAME AS ITS ARGUMENT. THE REMAINING ! CHARACTERS OF THE SWITCH NAME, IF ANY, FOLLOW AS A COMMENT. BIND SWTBL=PLIT ( BL(EXPAN) %D%, BL(NOEXP) %AND%, BS(4,LIST), BL(NOLIS) %T%, BS(4,ERRS), BL(NOERR) %S%, BL(MLIST), BL(NOMLI) %ST%, BL(OPTIM) %IZE%, BL(NOOPT) %IMIZE%, BL(UNAME) %S%, BL(NOUNA) %MES%, BL(FINAL), BL(NOFIN) %AL%, BS(4,SAFE), BL(UNSAF) %E%, BS(3,ZIP), BL(UNZIP), BL(DEBUG), BL(NODEB) %UG%, BS(3,PIC), BL(NOPIC), % END OF SWITCHES VALID IN BOTH MODULE HEAD AND SWITCHES DECLARATION. MODIFY SWSWL IF THE NUMBER OF SWITCHES ABOVE THIS CHANGES. THE FOLLOWING SWITCHES ARE VALID ONLY IN THE MODULE HEAD. % BL(SEGME) %NT%, BL(NOSEG) %MENT%, BL(START), BL(STACK), BS(4,MAIN), BL(RESER) %VE%, BL(IDENT), BL(SYNTA) %X%); ! KEYWORD TABLE FOR CSECT/PSECT PROCESSING BIND KWTBL=PLIT( BS(4,CODE), BL(DEBUG), BL(GLOBA) %L%, BS(3,OWN), BS(4,PLIT)); FORWARD ERRDECL, DCLARE, DECLARESYM, DEFOG, DEFGLO, DEFASYM, DEFMAP, INITEQ, OWNEQ, GLOBALEQ, MAPPURGE, SYMPURGE, GETLNKG, SFORWARD, SUNDECLARE, STARTLNKG, STARTNAME, MAYBEDECLARE, STARTCOL, CONTIDLIST, MAPONE, ENDIDBATCH, WHICHBIND, BINDEQ, GLBINDEQ, REGEQ, DOEQL, DOSIZE, GROMLIST, PGLOBAL, POWN, PSTACKLOCAL, PLOCAL, PEXTERNAL, PLABEL, PREGISTER, PBIND, PGLOBBIND, PROCPARMS, GLOBROUT, SLOCAL, SSTACKLOCAL, SOWN, SGLOBAL, SEXTERNAL, SDCLLABEL, SREGISTER, SBIND, SGLOBBIND, SROUTINE, SMAP, SSETSIZE, SBYTE, SWORD, INCRDECRREG, SSWITCHES, DOMODULE, GETCONS, GETSTRING, SWITCHER, SIDENT, SSTACK, SMAIN, SSTART, SRESERVE, SRESERVE, PPARAM, SSTRUCTURE, SMACRO, GETSTRING2, SCSECT, SLNKGDECL, SPLIT, SPLITB, PLITARG, TUPLEITEM, LSORLE, LEXTOP, SREQUIRE, REQUINIT; BIND DECLARATORS=PLIT( 0, !0 SBYTE, !1 SOWN, !2 SGLOBAL, !3 SEXTERNAL, !4 SROUTINE, !5 SSTRUCTURE, !6 SMAP, !7 SFORWARD, !8 SBIND, !9 SMACRO, !10 SUNDECLARE, !11 SDCLLABEL, !12 SWORD, !13 SSWITCHES, !14 SLOCAL, !15 SREGISTER, !16 SENABLE, !17 SREQUIRE, !18 SCSECT, !19 SSTACKLOCAL, !20 SLNKGDECL, !21 SCSECT !22 - PSECTS HANDLED BY CSECT ROUTINE ); MACRO ALLIGN(TABLE,NBYTE)=IF @TABLE AND NOT NBYTE THEN TABLE_@TABLE+1$, NEXTINTAB(TABLE,STE)=(STE[OFFSETF]_@TABLE; TABLE_@TABLE+.STE[NCONTIGLOC])$, BYTES(STE)=(.STE[SIZEF]/8)$; MACRO ERROR(A,B,C,D)=ERRORR(D,C,B,A)$, DELERR(COND,ERM)=IF .DEL COND THEN RETURN ERROR(.LOBRAC,.NDEL,.LASTEND,ERM)$, SXCTDECL=(LOBRAC_.NDEL;(@DECLARATORS[.DEL[HSYNTYP]])())$, XCTDECL=(IF .SYM NEQ HEMPTY THEN (SYM_HEMPTY; ERROR(.LOBRAC,.NSYM,.LASTEND,DECLSYMERR)) ELSE (SXCTDECL; IF .DEL NEQ HSEMICOLON THEN ERROR(.LOBRAC,.NDEL,.LASTEND,DCLDELERR) ELSE RUND(QLLEXEME)))$, DECF(TP)=(IF NOT DECLARESYM(SENTRY,TP,1) THEN RETURN ELSE (SENTRY[POSF]_0; SENTRY[SIZEF]_16))$, CKFORWD(RTYPE)=(IF (SENTRY_.NT[.SYM[ADDRF],SYMLINK]) NEQ 0 THEN IF .SENTRY[BLF] EQL .BLOCKLEVEL AND .SENTRY[TYPEF] EQL FORWT THEN (SENTRY[TYPEF]_RTYPE; SENTRY[DEBUGF]_.DEBFLG) ELSE DECF(RTYPE) ELSE DECF(RTYPE))$, FBIT(BITNUM)=BITNUM,1$, MUSTDECLARE =FBIT(0)$, !DECLARATION OTHER THAN MAP. MUSTMAP =FBIT(1)$, !MUST BE MAPPED. ISSBSLEX =FBIT(2)$, !HAS A SIZE LEXEME STREAM. TEMPF =FBIT(3)$, !TEMPORARY BOOLEAN. WASANEQUAL =FBIT(4)$, !EQUAL FOUND FOLLOWING THE !INCARNATION ACTUALS. LITRESULT=(.SYM[LTYPF] EQL LITTYP)$, RULITEXP(LOCALSAV,LOCINFO)=(RUND(QLLEXEME); LITEXP(LOCALSAV,LOCINFO))$, LITEXP(LOCALSAV,LOCINFO)=(LOCALSAV_LOCINFO; EXPRESSION(); SYM_BINDBIND(.SYM); IF NOT LITRESULT THEN (WARNEM(.LOCALSAV,ERMBADEXP); SYM_ONE))$; EXTERNAL STVEC LNKGLX:INCACTS:STRSTE; EXTERNAL INITSYMLSTS; EXTERNAL LOBRAC; GLOBAL ROUTINE ERRDECL=SXCTDECL; ! FOR ERROR HANDLING--SEE RUNC IN SYNTAX GLOBAL ROUTINE DCLARE= BEGIN LOCAL SAVEL; INDCL; DECLSIZE_2; NEWLASTEND(PSSEM); BLOCKLEVEL_.BLOCKLEVEL+1; WHILE .DEL[HCLASS] EQL DCLRTR DO XCTDECL; IF .NEXTLOCAL THEN NEXTLOCAL_.NEXTLOCAL+1; RESINDECL; RESLASTEND; LCBRAC_.NDEL END; ROUTINE DECLARESYM(WHERE,TYPE,ERRHURTS)= !I. GENERAL: ! ! 1. THIS ROUTINE DECLARES A SYMBOL IN "SYM". ! ! 2. PARAMETERS: ! ! A. WHERE - A POINTER TO A LOCATION WHERE THE ! SYMBOL TABLE INDEX OF THE SYMBOL ! DECLARED IN "SYM" SHOULD BE PUT. ! ! B. TYPE - THE TYPE OF THE SYMBOL TO BE DECLARED ! ! C. ERRHURTS - A BOOLEAN THAT DETERMINES THE TYPE ! OF ERROR RECOVERY TO BE ATTEMPTED. ! !II. SPECIFIC: ! ! 1. * ! ! A. FIRST EXAMINE THE LEXEME IN SYM. ! 1. IF IT IS NOT A NAME TABLE ENTRY, GIVE ! EITHER AN ERROR OR A WARNING MESSAGE, ! DEPENDING ON THE SETTING OF "ERRHURTS". ! ! 2. PICK UP THE SYMBOL TABLE ENTRY MOST ! RECENTLY ATTACHED TO THIS NAME TABLE ! ENTRY. ! ! B. IF THE ENTRY IS UNDECLARED, OR FROM AN OUTER ! BLOCK, THEN: ! 1. DECLARE THE SYMBOL, AND ENTER ITS NEW ! TYPE IN A NEW SYMBOL TABLE ENTRY FOR ! THIS BLOCK. ! ! ! 2. PUT IT WHERE THE CALLER WANTS IT, ! AND CORRECT THE FUTURE SYMBOL LEXEME. ! ! C. OTHERWISE, WE HAVE ALREADY DECLARED IT IN ! THIS BLOCK, AND THAT IS AN ERROR. BEGIN BIND STVEC STSYM=SYM; LOCAL STVEC STENTRY,MSGTYPE,ERRLOC; MSGTYPE_ERNOSYM; ERRLOC_.NSYM; IF .SYM EQL HEMPTY THEN (ERRLOC_.NDEL; IF .RESWD THEN (RUNDE(); MSGTYPE_ERDCLRESWD)); IF .SYM[LTYPF] EQL BNDVAR THEN (WARNEM(.LOBRAC,.NSYM,ERNOSYM); SYM_.STSYM[NAMEPTR]) ELSE IF .SYM[LTYPF] NEQ UNBNDVAR THEN (IF .ERRHURTS THEN ERROR(.LOBRAC,.ERRLOC,.LASTEND,.MSGTYPE) ELSE WARNEM(.LOBRAC,.ERRLOC,.MSGTYPE); RETURN 0); IF .STRUEXPAND THEN STINSERT(.SYM[ADDRF],UNDECTYPE,0); STENTRY_.STSYM[SYMLINK]; IF .STENTRY[TYPEF] NEQ UNDECTYPE AND .STENTRY[BLF] GEQ .BLOCKLEVEL THEN (ERRINFO[0]_.STENTRY; WARNEM(.NSYM,WASMPREV)); .WHERE_STINSERT(.SYM[ADDRF],.TYPE,0); RETURN 1; END; MACRO BDEF=BEGIN MAP STVEC STE;$, EDEF=END$; ROUTINE DEFOG(TABLE,STE,REQIN,RELIN,INIT)= BDEF ALLIGN(.TABLE,BYTES(STE)); IF .REQIN THEN (STE[REQINIT]_TRUE; STE[RELEASEINIT]_.RELIN; STE[INITP]_.INIT); STE[REGF]_PC; IF .STE[ITSAPLIT] THEN IF .STE[COUNTED] THEN (.TABLE)<0,36>_@.TABLE+2; NEXTINTAB(.TABLE,STE); INITSYMLSTS(.STE); 0 EDEF; ROUTINE DEFGLO(STE,REQIN,RELIN,INIT)= BDEF DEFOG(NEXTGLOBAL,.STE,.REQIN,.RELIN,.INIT); STE[MODE]_ABSOLUTE; EDEF; GLOBAL ROUTINE DEFASYM(STE,NOBYTES,POS,SIZ)= BDEF STE[NCONTIGLOC]_.NOBYTES; STE[POSF]_.POS; STE[SIZEF]_.SIZ; STE[LNKGNMF]_.LNKGLX; EDEF; GLOBAL ROUTINE DEFMAP(STE)= BDEF STE[HAVNOACTS]_TRUE; STE[STRUORIACT]_.STRUDEFV; EDEF; ROUTINE INITEQ= BEGIN LOCAL PLITP,ERR, SIZ; ERR_.NDEL; OLDDELI_#126; ! "PLIT" SIGNAL TO DETBRACKET IF (SIZ_2*SPLITB(PLITP %, T%)) GTR .SIZE THEN (IF NOT .NOTREE THEN WARNEM(.ERR,ERISEDS); SIZE_.SIZ); SYM_.PLITP; 0 END; ROUTINE OWNEQ=INITEQ(); ROUTINE GLOBALEQ=INITEQ(); ROUTINE MAPPURGE(STE)= % PRESUMES MAPPABLE SYMBOL % BDEF LOCAL STVEC STREAM; IF (.STE[STRUORIACT] EQL 0) OR .STE[HAVNOACTS] OR NOT .STE[RELEASEACTS] THEN RETURN; STREAM_.STE[STRUORIACT]; STREAM[STRUCF]_0; STRMRELEASE(.STREAM); TRUE EDEF; GLOBAL ROUTINE SYMPURGE(STE)= ! SYMPURGE RETURNS TRUE IF THE SYMBOL MAY BE PURGED. IN ! ADDITION IT RELEASES ALL FIELDS (STREAMS AND ! TREES ASSOCIATED WITH THE FIELDS WITHIN THE SYMBOL. BDEF EXTERNAL FERASEDET; MACRO INIPURGE(STE)= (IF .STE[REQINIT] AND .STE[RELEASEINIT] THEN FERASEDET(.STE[INITP]); 2)$, MACPURGE(STE)= (STRMRELEASE(.STE[STREAMF]); 1)$, STRPURGE(STE)= (STRMRELEASE(.STE[BODYSTRM]); IF .STE[SIZESTRM] NEQ 0 THEN STRMRELEASE(.STE[SIZESTRM]); 1)$; SELECT .STE[TYPEF] OF NSET UNDECTYPE: RETURN 1; MACROT: RETURN MACPURGE(STE); STRUCTURET: RETURN STRPURGE(STE); FORWT: (ERRINFO[0]_.STE; WARNEM(0,ERMRD); RETURN 1); % MAPPABLE TYPES ONLY PAST HERE % ALWAYS: IF NOT ISSTVAR(STE) THEN RETURN 1 ELSE MAPPURGE(.STE); GLOBALT: RETURN INIPURGE(STE); OWNT: RETURN INIPURGE(STE); ALWAYS: RETURN 2; TESN; 0 EDEF; ROUTINE GETLNKG(LOC)= ! ! CALLED BY SFORWARD, GLOBROUT, AND SROUTINE ! PARSES THE LINKAGE NAME OF THE ROUTINE ! BEGIN BIND NTVEC NTSYM=SYM; LOCAL STVEC LNKGNM; LNKGNM _ .DFLTLNKGLX; IF .DEL EQL ERRLEX THEN BEGIN LNKGNM _ .NTSYM[SYMLINK]; IF .LNKGNM[TYPEF] NEQ LNKGNMT THEN (WARNEM(.NSYM,WAMSPLNKG); LNKGNM _ .DFLTLNKGLX); RUND(QLQNAME); END; .LOC _ .LNKGNM; NOVALUE END; ROUTINE SFORWARD= ! !SYNTAX: FORWARD ,,..., ! ! ::=/(<#PARAMETERS>) ! !I. GENERAL: ! ! 1. THIS ROUTINE DECLARES AS FORWARD WITHIN THE BLOCK ! OPEN AT THE TIME OF DECLARATION. ! ! 2. THIS MEANS THAT THE ROUTINE WILL BE FOUND, AND ! DECLARED LATER WITHIN THIS SAME BLOCK; ! !II. SPECIFIC: ! ! 1. * ! ! A. IT DOES EACH OF THE FOLLOWING THINGS TO ! DECLARE A FORWARD NAME UNTIL IT COMES TO ! A ";". ! ! 1. DECLARE THE NAME IN "SYM" AS OF ! TYPE FORWARD. ! ! 2. NEXT, IF WE SEE AN OPEN PARENTHESIS, ! ("("),THEN: ! ! A. PROCESS THE EXPRESSION WITHIN ! THE PARENTHESIS PAIR, AND ! MAKE SURE IT IS A LITERAL. ! ! B. IF WE DON'T NOW SEE A ! CLOSE PARENTHESIS ! AND AND EMPTY FUTURE SYMBOL, ! IE, THE WINDOW SHOULD BE: ! ! (XXX,")",,",") ! ! THEN THERE IS AN ERROR. ! ! C. SAVE THE RESULTING LITERAL, ! AND MOVE THE WINDOW. ! ! 3. FINALLY, ADD THE NUMBER OF PARAMETERS ! FOR THE ROUTINE TO ITS SYMBOL TABLE ! ENTRY. ! ! 4. GENERATE INFORMATION FOR THE ROUTINE. ! ! 5. WE SHOULD HAVE A COMMA NEXT, OR A ";" BEGIN LOCAL SFSYMCHK,SAVSYM,STVEC SFSTE:LNKGNM; DO BEGIN RUND(QLQNAME); GETLNKG(LNKGNM); IF DECLARESYM(SFSTE,FORWT,0) THEN IF .DEL EQL HPARAOPEN THEN BEGIN RULITEXP(SFSYMCHK,.NSYM); IF .DEL NEQ HPARACLOSE THEN RETURN ERROR(.LOBRAC,.NDEL,.LASTEND,ERSYMNPRD); SAVSYM_.SYM; RUND(QLLEXEME); IF .SYM NEQ HEMPTY THEN RETURN ERROR(.LOBRAC,.NDEL,.LASTEND,ERSYMNPRD); END ELSE SAVSYM_0 ELSE EXITCOMPOUND; DEFMAP(.SFSTE); SFSTE[LNKGNMF]_.LNKGNM; SFSTE[POSF]_0; SFSTE[SIZEF]_16; SFSTE[REGF]_PC; SFSTE[MODE]_IF .PICSW THEN RELATIVE ELSE ABSOLUTE; END WHILE .DEL EQL HCOMMA; END; ROUTINE SUNDECLARE= DO BEGIN MAP STVEC SYM; RUND(QLQNAME); STINSERT(.SYM,UNDECTYPE,0) END WHILE .DEL EQL HCOMMA; ROUTINE STARTLNKG= BEGIN LOCAL STVEC STE; LNKGLX_.DFLTLNKGLX; IF .DEL EQL ERRLEX THEN BEGIN MACRO FORGET(WARNTYPE) = (WARNEM(.NSYM,WARNTYPE); EXITBLOCK RUND(QLQNAME)) $; IF .SYM[LTYPF] EQL UNBNDVAR THEN SYM_FASTLEXOUT(BNDVAR,.NT[.SYM,SYMLINK]) ELSE IF .SYM[LTYPF] NEQ BNDVAR THEN FORGET(WAINVSTRUC); IF (STE_.SYM[ADDRF]) EQL .TRAPLNKGLX[ADDRF] THEN FORGET(WATRAPLNKG); IF .STE[TYPEF] NEQ LNKGNMT THEN RETURN 0; LNKGLX_.STE; RUND(QLQNAME) END; RETURN 0; END; ROUTINE STARTNAME= !I. GENERAL: ! ! 1.THIS ROUTINE SETS UP A STRUCTURE SYMBOL TABLE ENTRY ! FOR THE SYMBOLS FOLLOWING IT, IF THE STRUCTURE IS ! SPECIFIED. ! ! 2. WE THEN SET FIELDS RELEVANT TO THE STRUCTURE, ONLY ! IF THE SYMBOLS FOLLOWING IN THIS DECLARATION ARE ! TO BE MAPPED. ! !II. SPECIFIC: ! ! 1. * ! ! A. IF ".DEL" IS AN ERROR LEXEME THEN WE ! HAVE: ! WITH NO INTERVENING DELIMITER, AND THUS ! SPECIFIES A STRUCTURE MAPPING. ! ! B. WE HAVE ERRORS NOW, IF: ! ! 1. THE SYMBOL TABLE ENTRY FOR THE ! STRUCTURE IS OF AN UNDECLARED TYPE. ! ! 2. THE SYMBOL IS NOT OF TYPE STRUCTURE. ! ! C. IF EVERYTHING ELSE IS OK, THEN WE HAVE A ! STRUCTURE, SO WE SET THE "MUSTMAP" FIELD ! OF THE FLAGS "OFLAGS", SINCE WE MUST THEN ! MAP THIS STRUCTURE ONTO ALL FOLLOWING ! IDENTIFIERS IN THIS FIELD. ! ! D. OTHERWISE,, IF WE DON'T EXPLICITLY HAVE A STRUCTURE, ! THEN THE STRUCTURE SYMBOL TABLE INDEX IS SET ! TO THE VECTOR DEFAULT INDEX, AND WE NEED NOT ! MAP AT THIS POINT. THE REASON THAT WE DO ! SET THE INDEX THOUGH IS THAT WE MAY FIND ! LATER THAT WE INDEED DO NEED TO MAP, AND WE ! WILL THEN HAVE EVERYTHING SET UP. ! E. NEXT WE SEE IF THE FOLLOWING ID'S NEED TO BE ! MAPPED WHETHER OR NOT WE SAW A STRUCTURE. ! THEY NEED TO BE MAPPED IN THE FOLLOWING ! CASES: ! ! 1. A STRUCTURE WAS SPECIFIED. ! ! 2. WE SEE "[". ! ! 3. WE SEE ":". ! ! 4. THE IDENTIFIERS FOLLOWING ARE ! NOT TO BE DECLARED. ! ! 2. * ! ! A. THEN, IF WE DO NEED TO MAP, THEN WE DO THE ! FOLLOWING: ! ! 1. SET THE FLAG FOR THE LEXEME STREAM ! TYPE. ! ! 2. SET THE LEXEME STREAM STRUCTURE INDEX. ! 3. SET THE INCARNATION ACTUALS CELL BLOCK ! SIZE, AND THE NUMBER OF EXPECTED ! INCARNATION ACTUALS. NOTE THAT THE ! NUMBER OF EXPECTED INCARNATION ! ACTUALS IS OBTAINED FROM THE ! STRUCTURE SYMBOL TABLE ENTRY. BEGIN INCACTS_0; STRSTE_.STRUDEFV; IF .DEL EQL ERRLEX THEN BEGIN LOCAL STVEC STE; MACRO FORGET(WARNTYPE) = (WARNEM(.NSYM,WARNTYPE); EXITBLOCK RUND(QLQNAME)) $; IF .SYM[LTYPF] EQL UNBNDVAR THEN SYM_.NT[.SYM,SYMLINK] ELSE IF .SYM[LTYPF] NEQ BNDVAR THEN FORGET(WAINVSTRUC); STE_.SYM[ADDRF]; IF .STE[TYPEF] NEQ STRUCTURET THEN FORGET(WASMNOTSTR) ELSE RUND(QLQNAME); STRSTE_.STE END; RETURN 0; END; ROUTINE MAYBEDECLARE(ERRHURTS)= !I. GENERAL: ! ! 1. THIS ROUTINE DECLARES THE SYMBOL IN "SYM" IF IT ! SHOULD BE, (IE IF OFLAGS[MUSTDECLARE] IS ON). ! ! 2. RETURNS: ! ! A. THIS ROUTINE RETURNS A 1 IF THERE WERE ! ANY ERRORS FOUND DURING DECLARATION. (IF .OFLAGS[MUSTDECLARE] THEN NOT DECLARESYM(STE,.OTYPE,.ERRHURTS) ELSE (STE_.NT[.SYM[ADDRF],SYMLINK];0)); ROUTINE STARTCOL= !I. GENERAL: ! ! 1. THIS ROUTINE TAKES THE SYMBOL IN "SYM", DECLARES ! IT IF NECESSARY, AND PUTS IT AS THE FIRST ELEMENT ! ON THE SYMBOL TABLE LIST. ! ! 2. THIS SYMBOL TABLE LIST IS MADE SINCE WE CAN HAVE ! THINGS OF THE FORM: ! ! :...:[,...,]:... BEGIN IF MAYBEDECLARE(1) THEN RETURN 1; ST[STELAST_STELIST_GETSPACE(ST,2),STELSTEF]_.STE; ST[.STELIST,STELCPF]_.NSYM; RETURN 0; END; ROUTINE CONTIDLIST= !I. GENERAL: ! ! 1. THIS ROUTINE SIMPLY CONTINUES DECLARING SYMBOLS ! IN "SYM". ! ! 2. WINDOW IN: ! ! A. ( , ":" ) ! ! 3. WINDOW OUT: ! ! A. ( , ":"/"["/","/";" ) BEGIN REGISTER SAVSTE; RUND(QLQNAME); IF MAYBEDECLARE(0) THEN RETURN 1; SAVSTE_.STELAST; ST[.SAVSTE,STELNEXTF]_STELAST_GETSPACE(ST,2); ST[.STELAST,STELSTEF]_.STE; ST[.STELAST,STELCPF]_.NSYM; RETURN 0; END; ROUTINE MAPONE(POS,FIRST)= BEGIN MAP STVEC STE; LOCAL STEE; IF .OTYPE EQL 0 THEN BEGIN IF NOT ISEXP(STE) THEN (WARNEM(.POS,WACANTMAP); RETURN 0); IF .STE[BLF] EQL .BLOCKLEVEL THEN MAPPURGE(.STE) ELSE (SYM_LEXOUT(UNBNDVAR,.ST[STEE_.STE,NAMEPTR]); DECLARESYM(STE,MBINDT,0); DEFASYM(.STE,0,0,8*.DECLSIZE); STE[BINDLEXF]_BINDBIND(LEXOUT(BNDVAR,.STEE))); END; STE[STRUORIACT]_ IF .INCACTS NEQ 0 THEN (IF STE[RELEASEACTS]_.FIRST THEN INCACTS[STRUCF]_.STRSTE; .INCACTS) ELSE (STE[HAVNOACTS]_TRUE; .STRSTE); 0 END; ROUTINE ENDIDBATCH= BEGIN REGISTER TEMP; MAP STVEC STELIST:TEMP:STE; LOCAL FIRSTACT; FIRSTACT_TRUE; DO BEGIN STE_.STELIST[STELSTEF]; IF MAPONE(.ST[.STELIST,STELCPF],.FIRSTACT) THEN RETURN 1; IF .OFLAGS[MUSTDECLARE] THEN BEGIN DEFASYM(.STE,.SIZE,0,8*.DECLSIZE); IF (.OFUN)(.FIRSTACT,.SIZE,.STE) THEN RETURN 1; END; FIRSTACT_FALSE; END WHILE BEGIN TEMP_.STELIST; STELIST_.TEMP[STELNEXTF]; RELEASESPACE(ST,.TEMP,2); .TEMP NEQ .STELAST END; RETURN 0; END; ROUTINE WHICHBIND= !I. GENERAL: ! ! 1. THIS ROUTINE DETERMINES WHAT TYPE OF BIND WE MUST ! DO, AND PASSES ITS FINDINGS TO ITS CALLER AS A ! RETURN VALUE. ! ! 2. RETURNS: ! ! A. 0 - CODE MUST BE GENERATED FOR THIS ! BIND. ! ! B. 1 - THE BIND IS TO A LITERAL. ! ! C. 2 - GENERAL ADDRESS BIND, BUT NO CODE. BEGIN MAP LEXEME SYM; EXPRESSION(); SYM_BINDBIND(.SYM); IF .SYM[LTYPF] EQL GTTYP THEN IF NOT BEGIN ! GET RID OF <0,0> AND <0,8> BEFORE CHECKONELOCAL DOES SO BIND STVEC STSYM=SYM; IF .STSYM[NODEX] EQL SYNPOI THEN IF .STSYM[OPR2] EQL ZERO THEN IF LITVALUE(.STSYM[OPR3]) MOD 8 EQL 0 THEN BEGIN BIND TEMP=.SYM[ADDRF]; STSYM_.STSYM[OPR1]; PDETACH(TEMP); RELEASESPACE(GT,TEMP,BASEGTNODESIZE+3); .SYM[LTYPF] NEQ GTTYP END END THEN (DYNBIND(); RETURN 0); IF LITRESULT THEN 1 ELSE 2 END; ROUTINE BINDEQ=(RUND(QLLEXEME); WHICHBIND(); 0); ROUTINE GLBINDEQ= BEGIN RUND(QLLEXEME); CASE WHICHBIND() OF SET %0% (WARNEM(.NSYM,ERSMPLNLO); SYM_ZERO); %1% ; %2% (IF .SYM[LTYPF] EQL BNDVAR THEN IF LOADCONST(SYM) THEN EXITCASE; WARNEM(.NSYM,ERSMPLNLO); SYM_ZERO) TES; 0 END; ROUTINE REGEQ= !I. GENERAL: ! ! 1. THIS ROUTINE PROCESSES AN "=" IN A REGISTER ! DECLARATION. ! !II. SPECIFIC: ! ! 1. * ! ! A. EVALUATE AN EXPRESSION WHOSE RESULT SHOULD ! BE A LITERAL. ! ! B. IF THE RESULT IS A LITERAL, THEN CHECK THAT ! IT IS WITHIN LIMITS FOR A REGISTER ! DECLARATION. ! ! C. IF EVERYTHING ELSE SO FAR IS OK, THEN SEE IF ! THE REGISTER IS IN USE FOR ANYTHING ELSE AT ! THIS TIME, AND IF IT IS, THEN GIVE A WARNING. BEGIN LOCAL SAVSYMPOS; REGISTER LTRES; BIND LOWREG=0, HIGHREG=5; RUND(QLLEXEME); LITEXP(SAVSYMPOS,.NSYM); LTRES_LITVALUE(.SYM[ADDRF]); IF (.LTRES GTR HIGHREG) OR (.LTRES LSS LOWREG) THEN (WARNEM(.SAVSYMPOS,ERSMNDEC); SYM_ONE); RETURN 0; END; ROUTINE DOEQL= !I. GENERAL: ! ! 1. THIS ROUTINE HANDLES THE GENERAL CASE OF AN EQUAL ! SIGN ("=") AFTER AN IDENTIFIER IN A DECLARATION. ! ! 2. RETURNS: ! ! A. 1 - IF ANY ERRORS WERE FOUND. AN ERROR OCCURS ! IF: ! ! 1. NO EQUAL SIGN IS FOUND, AND WE ! REQUIRE ONE. ! ! 2. THE SPECIFIC ROUTINE WHICH PROCESSES ! EQUAL SIGNS FOR THE TYPE OF ! DECLARATION WE ARE NOW PROCESSING ! FINDS ANY ERRORS. ! !II. SPECIFIC: ! ! 1. * ! ! A. IF A PROCESSING ROUTINE WAS SPECIFIED, AND ! AN EQUAL SIGN WAS FOUND (IN "SYM"), THEN ! MOVE THE WINDOW SO IT IS AT THE ! BEGILNING OF THE EXPRESSION FOLLOWING THE ! EQUAL SIGN. ! ! B. THERE ARE FOUR (4) RETURN CASES. ! ! 1. NO EQUAL SEEN, NONE REQUIRED, ALL OK. ! 2. NO EQUAL, BUT ONE IS REQUIRED, ! ERROR. ! ! 3. EQUAL SEEN, AND NOT REQUIRED. PROCESS ! IT, AND RETURN IN THE SAME STATE AS ! THE PROCESSING ROUTINE EXITED. ! ! 4. EQUAL SEEN, AND IT WAS REQUIRED. ! AGAIN PROCESS IT AND RETURN IN THE ! SAME STATE AS THE PROCESSING ROUTINE ! EXITED. BEGIN IF .DEL EQL HEQUAL THEN BEGIN OFLAGS[WASANEQUAL]_TRUE; IF .OEQL EQL 0 THEN (WARNEM(.NDEL,WANOEQL); RETURN INITEQ()) END ELSE OFLAGS[WASANEQUAL]_FALSE; RETURN CASE .OFLAGS[WASANEQUAL]*2+(.OEQL LSS 0) OF SET 0; BEGIN ERROR(.LOBRAC,.NDEL,.LASTEND,ERSYMEQ); 1 END; (.OEQL)(.SIZE); (-.OEQL)(.SIZE) TES; END; ROUTINE DOSIZE= BEGIN LOCAL NOBRAC, NSTART; SIZE_.DECLSIZE; IF .DEL EQL HCOLON THEN RETURN 0; NSTART_.NDEL; INCACTS_GETSPACE(ST,.STRSTE[NUMPARM]+3); INCACTS[STKLEN]_.STRSTE[NUMPARM]+2; IF .DEL EQL HSQBOPEN THEN (LOCAL SAVMNACTS; IF .OTYPE EQL LABELT THEN WARNEM(.NDEL,LSIZERR); SAVMNACTS_.MANYACTS; MANYACTS_0; STRUPICKOFF(HSQBCLOSE,.INCACTS+2,.INCACTS[STKLEN]-1,ONE,TRUE); MANYACTS_.SAVMNACTS; NOBRAC_FALSE) ELSE (SETCORE(INCACTS[2],.INCACTS[STKLEN]-1,ONE); NOBRAC_TRUE); INCACTS[1,0,36]_LITLEXEME(.DECLSIZE); IF .STRSTE[SIZESTRM] NEQ 0 THEN BEGIN LOCAL SAVDEL; IF .NOBRAC THEN SAVDEL_.DEL; ESTRU(.STRSTE[SIZESTRM],.INCACTS-1,.STRSTE,.NOBRAC); IF .NOBRAC THEN DEL_.SAVDEL; SYM_BINDBIND(.SYM); IF NOT LITRESULT THEN (WARNEM(.NSTART,ERMBADEXP); SYM_ONE); SIZE_LITVALUE(.SYM) END ELSE IF NOT .NOBRAC THEN RUNDE(); RETURN 0; END; ROUTINE GROMLIST(GRLTYPE,GRLPARAM,GRLFUN,GRLEQL,GRLASS)= ! !SYNTAX: ,..., ! ! ::= ...: ! ::=/ ! ::=:...: ! ::=/[,...,] ! ::=/ = ! !I. GENERAL: ! ! 1. THIS ROUTINE HANDLES THE GENERAL PROCESSING OF ! DECLARATIONS. ! ! 2. MACROS: ! ! A. CHECK(ROUTNAME) - "ROUTNAME" MUST BE THE ! NAME OF A ROUTINE WHICH RETURNS A 1 ! IF ANY ERRORS WERE FOUND. THIS MACRO ! SIMPLY SERVES TO CALL THIS ROUTINE, AND ! RETURN IF ANY ERRORS WERE FOUND. ! ! B. OTHERCHECKS - THIS MACRO STARTS THE PROCESSING ! OF A FIELD FOLLOWING THE ! OPTIONAL STRUCTURE, UP TO THE ! FIRST COMMA. IT WORKS AS ! FOLLOWS. IT FIRST PROCESSES ! THE FIRST NAME IN A POSSIBLE ! STRING OF AN ARBITRARY ! NUMBER, LIKE - X:Y:Z:... ! THEN IT PROCESSES ALL OTHERS ! WHILE THE DELIMITER FOLLOWING ! EACH IS A COLON (":"), IE ! UNTIL IT COMES TO "[" OR "=" ! AS IN X:Y:Z[10] OR X:Y:Z=20 ! IT THEN TRIES TO PROCESS AN ! OPTIONAL SIZE FIELD, AND THEN ! AN "=" (BIND). FINALLY, IT ! CALLS "ENDIDBATCH" TO ANY ! LAST NECESSARY THINGS IN THE ! DECLARATION OF IDENTIFIERS SO ! FAR FOUND. ! !II. SPECIFIC: ! ! 1. * ! ! A. FIRST PUT ALL PARAMETERS INTO GLOBALS FOR ! OTHER PROCESSING ROUTINES TO USE. ! ! B. TO PROCESS A FIELD OF DECLARATIONS,(IE ! BETWEEN COMMAS), WE MUST DO THE FOLLOWING ! THINGS: ! ! 1. FIRST CHECK IF THERE IS A STRUCTURE ! NAME, AND IF THERE IS, THEN DO THE ! APPROPRIATE THINGS TO SET IT UP. ! ! 2. THEN WE MUST SEE IF THERE ARE BINDS, ! ETC FOR A LIST OF IDENTIFIERS WHICH ! WE PROCESS NOW.SINCE THE FOLLOWING ! IS LEGAL, WE MUST DO THESE ! INSIDE STEPS AN ARBITRARY NUMBER OF ! TIMES: ! ! X:Z:T[100]:P:R[29,4]:D:C ! ! HERE WE SEE THAT THERE ARE 3 ! DECOMPOSABLE UNITS WHICH SHOULD ! BE TREATED THE SAME, THEY ARE: ! ! X:Z:T[100] ! P:R[29,4] ! D:C ! ! C. KEEP DOING PART [1.B] UNTIL ! THERE ARE NO MORE COMMAS. ! ! D. THE LAST DELIMITER SHOULD BE ";", AND THERE ! IS AN ERROR IF IT IS NOT. BEGIN MACRO CHECK(ROUTNAME)=(IF ROUTNAME() THEN RETURN)$, OTHERCHECKS=(CHECK(STARTCOL); WHILE .DEL EQL HCOLON DO CHECK(CONTIDLIST); CHECK(DOSIZE); CHECK(DOEQL); CHECK(ENDIDBATCH))$, NAMEPROC=(CHECK(STARTLNKG);CHECK(STARTNAME); DO OTHERCHECKS WHILE IF .DEL EQL HCOLON THEN (RUND(QLQNAME);1))$; LOCAL SAVTYPE,SAVPARM,SAVFUN,SAVEQL,SAVFLAGS; LOBRAC_.NDEL; SAVTYPE_.OTYPE; SAVPARM_.OPAR; SAVFUN_.OFUN; SAVEQL_.OEQL; SAVFLAGS_.OFLAGS; OTYPE_.GRLTYPE; OPAR_.GRLPARAM; OFUN_.GRLFUN; OEQL_.GRLEQL; OFLAGS[MUSTDECLARE]_.GRLTYPE NEQ 0; DO (RUND(QLQNAME); NAMEPROC) WHILE .DEL EQL HCOMMA; OTYPE_.SAVTYPE; OPAR_.SAVPARM; OFUN_.SAVFUN; OEQL_.SAVEQL; OFLAGS_.SAVFLAGS; END; ROUTINE PGLOBAL(FIRST,SIZE,STE)=DEFGLO(.STE,.OFLAGS[WASANEQUAL],.FIRST,.SYM); ROUTINE POWN(FIRST,SIZE,STE)= BEGIN MAP STVEC STE; DEFOG(NEXTOWN,.STE,.OFLAGS[WASANEQUAL],.FIRST,.SYM); STE[MODE]_ABSOLUTE; END; ROUTINE PSTACKLOCAL(IGP,PGSIZE,PGSTE)= BEGIN MAP STVEC PGSTE; ALLIGN(NEXTLOCAL,BYTES(PGSTE)); NEXTLOCAL_.NEXTLOCAL+.STE[NCONTIGLOC]; STE[OFFSETF]_-.NEXTLOCAL; PGSTE[REGF]_SP; PGSTE[MODE]_INDEXED; PGSTE[NOUPLEVEL]_TRUE; INITSYMLSTS(.PGSTE); 0 END; ROUTINE PLOCAL(IGP,PGSIZE,PGSTE)= BEGIN MAP STVEC PGSTE; IF .PGSIZE EQL 2 THEN BEGIN LOCAL GTVEC TN; TN_PGSTE[REGF]_GETTN(); TNDECREQD(.TN); TN[LDF]_.LOOPDEPTH; PGSTE[MODE]_GENREG; PGSTE[NOUPLEVEL]_TRUE; INITSYMLSTS(.PGSTE); END ELSE PSTACKLOCAL(.IGP,.PGSIZE,.PGSTE); 0 END; GLOBAL ROUTINE PEXTERNAL(IGPARAM,IGSIZE,PESTE)= !I. GENERAL: ! ! 1. THIS ROUTINE HANDLES THE SPECIFIC PROCESSING FOR ! THE EXTERNAL DECLARATION. ! !II. SPECIFIC: ! ! 1. * ! ! A. SIMPLY SET THE ADDITIONAL INFORMATION WORD ! TO A UNIQUE NUMBER REPRESENTING THE EXTERNAL ! TYPE FOR LATER PROCESSING BY THE LOADER ! INTERFACE. BEGIN MAP STVEC PESTE; % BIND EXTERNALADDR=#777777; % PESTE[REGF]_PC; PESTE[OFFSETF]_0; PESTE[MODE]_ABSOLUTE; % PESTE[ADDRESSF]_EXTERNALADDR; % INITSYMLSTS(.PESTE); RETURN 0; END; ROUTINE PLABEL(PARAM,PLSIZE,PLSTE)= NOVALUE; ROUTINE PREGISTER(IGPARAM,PRSIZE,PRSTE)= !I. GENERAL: ! ! 1. THIS ROUTINE PERFORMS THE FUNCTIONS UNIQUE TO ! REGISTER DECLARATIONS. ! !II. SPECIFIC: ! ! 1. * ! ! A. IF THERE WAS AN EQUAL SIGN, THEN THE ! REGISTER IS DECLARED AS AN ABSOLUTE ! TYPE. ! ! B. OTHERWISE, WE ACQUIRE THE REGISTER, INSERT ! IT INTO THE LITERAL TABLE, AND SET THE ! ADDITIONAL INFORMATION FIELD TO THIS ! LITERAL TABLE INDEX. BEGIN MAP STVEC PRSTE; LOCAL GTVEC TN; TN_PRSTE[REGF]_GETTN(); PRSTE[MODE]_GENREG; PRSTE[NOUPLEVEL]_TRUE; IF .OFLAGS[WASANEQUAL] THEN (BIND NUM=LITVALUE(.SYM); TNSRREQD(.TN,NUM); IF .RESERVED[NUM,1] THEN PRSTE[NOUPLEVEL]_FALSE) ELSE TNARREQD(.TN); TN[LDF]_.LOOPDEPTH; INITSYMLSTS(.PRSTE); RETURN 0; END; ROUTINE PBIND(PARM,SIZE,STENTRY)= BEGIN MAP STVEC STENTRY; STENTRY[BINDLEXF]_.SYM; STENTRY[NOUPLEVEL]_ CASE .SYM[LTYPF] OF SET % 0 % ; % LITTYP % FALSE; % BNDVAR % .ST[.SYM,NOUPLEVEL]; % GTTYP % TRUE TES; END; ROUTINE PGLOBBIND(PARM,SIZE,STENTRY)= BEGIN MAP STVEC STENTRY; STENTRY[BINDLEXF]_.SYM; STENTRY[GLBIND]_TRUE; END; GLOBAL ROUTINE PROCPARMS(RNAME)= BEGIN MAP STVEC RNAME; MACRO ISTRAPTYPE= ONEOF(.LNKT,BIT4(EMTLNKGT,INTRRPTLNKGT,TRAPLNKGT,IOTLNKGT))$; MACRO OLDPCPS= IF ISTRAPTYPE THEN BEGIN BIND PCPS=PLIT ('OLDPC','OLDPS'); LOCAL SACC[2],SSYM; SACC_.ACCUM; SACC[1]_.ACCUM[1]; SSYM_.SYM; DECR I FROM 1 TO 0 DO BEGIN ACCUM_.PCPS[.I]; ACCUM[1]_-2; SYM_FASTLEXOUT(UNBNDVAR,SEARCH(UNDECTYPE)); DECLARESYM(FORMAL,FORMALT,0); NP_.NP+1; DEFASYM(.FORMAL,2,0,16); FORMAL[STRUORIACT]_.STRUDEFV; FORMAL[HAVNOACTS]_1; FORMAL[OFFSETF]_.LSF; LSF_.FORMAL; FORMAL[REGF]_SP; FORMAL[MODE]_INDEXED; END; SYM_.SSYM; ACCUM[1]_.SACC[1]; ACCUM_.SACC; -2 END ELSE 0$; MACRO NEXTFORMDESC= IF (FNO_.FNO+1) GTR .LNKG[LNKGSIZEF] THEN FT_STACKPARM ELSE (FT_.LNKG[PARMTYPE(.FNO)]; FL_.LNKG[PARMLOC(.FNO)])$; REGISTER STVEC T:LNKG:FORMAL,LNKT; LOCAL FT,FL,FNO,LSF,NP; EXTERNAL LIFOENTER; ! FROM LSTPKG NP_LSF_FNO_0; LNKG_.RNAME[LNKGNMF]; LNKT_.LNKG[LNKGTF]; LNKG_.LNKG[LNKGDESCF]; RNAME[REGFORMLST]_MAKHDR(0,LIFOENTER); IF .DEL EQL HPARAOPEN THEN BEGIN WHILE .DEL NEQ HPARACLOSE DO BEGIN RUND(QLQNAME); IF NOT DECLARESYM(FORMAL,FORMALT,0) THEN EXITCOMPOUND; NP_.NP+1; DEFASYM(.FORMAL,2,0,16); FORMAL[STRUORIACT]_.STRUDEFV; FORMAL[HAVNOACTS]_1; NEXTFORMDESC; CASE .FT OF SET ! 0: STACK BEGIN FORMAL[OFFSETF]_.LSF; LSF_.FORMAL; FORMAL[REGF]_SP; FORMAL[MODE]_INDEXED END; ! 1: REGISTER BEGIN FORMAL[MODE]_GENREG; FORMAL[SREGF]_.FL; T_FORMAL[REGF]_GETTN(); T[LDF]_.LOOPDEPTH; T[LONFU]_T[LONLU]_T[FONFU]_T[FONLU]_1; ! SPAN MUST START AT 1 ENLST(.RNAME[REGFORMLST],MAKITEM(.FL^18+.FORMAL,1)) END; ! 2: (LITERAL) MEMORY BEGIN FORMAL[TYPEF]_MBINDT; FORMAL[BINDLEXF]_LITLEXEME(.FL) END; ! 3: (NAMED) MEMORY BEGIN FORMAL[TYPEF]_MBINDT; FORMAL[BINDLEXF]_LEXOUT(BNDVAR,.FL) END TES; FORMAL[NOUPLEVEL]_TRUE; IF .DEL NEQ HPARACLOSE AND .DEL NEQ HCOMMA THEN (ERROR(.LOBRAC,.NDEL,.LASTEND,DCLDELERR); RETURN 0); INITSYMLSTS(.FORMAL); END; END; FNO_OLDPCPS; WHILE .LSF NEQ 0 DO BEGIN FORMAL_.LSF; LSF_.FORMAL[OFFSETF]; FORMAL[OFFSETF]_FNO_.FNO+2; IF ONEOF(.LNKT,BIT2(HBLISLNKGT,IHBLISLNKGT)) THEN FORMAL[OFFSETF]_.FORMAL[OFFSETF]+8; END; RNAME[RNPARMSF]_.NP; IF .DEL EQL HPARACLOSE THEN RUNDE(); RETURN 1 END; ROUTINE GLOBROUT= DO BEGIN LOCAL STVEC SENTRY:LNKGNM; RUND(QLQNAME); GETLNKG(LNKGNM); CKFORWD(GROUTINET); DEFMAP(.SENTRY); SENTRY[LNKGNMF]_.LNKGNM; SENTRY[REGF]_PC; SENTRY[MODE]_ABSOLUTE; RNAMEFOLLOWS(.SENTRY); END WHILE .DEL EQL HCOMMA; ! GENERAL DECLARATION ROUTINES ! ---------------------------- ! !SYNTAX: ,..., ! ! ::= ...: ! ::=/ ! ::=:...: ! ::=/[,...,] ! ::=/ = ! !I. GENERAL: ! ! 1. THE FOLLOWING SEVEN(7) ROUTINES, (SLOCAL, ! SOWN,SGLOBAL,SEXTERNAL,SREGISTER,SBIND,SMAP), ARE ALL ! ROUTINES WHICH DECLARE THE LIST OF IDENTIFIERS ! AS THE TYPE WHICH THEIR NAME IMPLIES. ! ! 2. THEY ARE ALL OF THE SAME FORM, IE THEY ALL CALL ! "GROMLIST" WITH THE FOLLOWING PARAMETERS: ! ! A. #1 - TYPE WHICH SYMBOLS SHOULD BE DECLARED ! AS. NOTE THAT "MAP" HAS NO TYPE ! ASSOCIATED WITH IT. ! ! B. #2 - A POINTER TO A VARIABLE WHICH CONTAINS ! THE TOTAL NUMBER OF VARIABLES OF THAT ! TYPE DECLARED SO FAR. FOR LOCALS, ONLY ! THE DIFFERENCE BETWEEN THAT NUMBER ON ! ENTRANCE AND EXIT OF A BLOCK IS OF ! INTEREST, BU FOR OWNS AND GLOBALS, ! THE TOTAL NUMBER IS NECESSARY, SINCE ! THATS HOW MUCH SPACE SHOULD BE ALLOCATED. ! ! C. #3 - NAME OF A ROUTINE TO HANDLE THE ! PECULIARITIES DUE TO A SPECIFIC ! TYPE OF DECLARATION. ! ! D. #4 - ROUTINE TO HANDLE AN EQUAL SIGN ("=") ! FOLLOWING A NAME (TO BE BOUND). ! ! E. #5 - ROUTINE TO HANDLE "_" AFTER A NAME. ROUTINE SLOCAL=GROMLIST(LOCALT,0,PLOCAL,0,0); ROUTINE SSTACKLOCAL=GROMLIST(LOCALT,0,PSTACKLOCAL,0,0); ROUTINE SOWN=GROMLIST(OWNT,0,POWN,OWNEQ,0); ROUTINE SGLOBAL=(RUND(QLQNAME); IF .SYM EQL HEMPTY THEN SELECT .DEL[HSYNTYP] OF NSET DCLROU: RETURN GLOBROUT(); DCLBIN: RETURN SGLOBBIND(); TESN; PEEKBIT_TRUE; GROMLIST(GLOBALT,0,PGLOBAL,GLOBALEQ,0)); ROUTINE SEXTERNAL=GROMLIST(EXTERNALT,0,PEXTERNAL,0,0); ROUTINE SDCLLABEL=GROMLIST(LABELT,0,PLABEL,0,0); ROUTINE SREGISTER= GROMLIST(REGT,0,PREGISTER,REGEQ,0) ; ROUTINE SGLOBBIND=GROMLIST(MBINDT,0,PGLOBBIND,-GLBINDEQ<0,0>,0); ROUTINE SBIND=GROMLIST(MBINDT,0,PBIND,-BINDEQ<0,0>,0); ROUTINE SROUTINE= DO BEGIN LOCAL STVEC SENTRY:LNKGNM; RUND(QLQNAME); GETLNKG(LNKGNM); CKFORWD(ROUTINET); DEFMAP(.SENTRY); SENTRY[LNKGNMF] _ .LNKGNM; SENTRY[REGF]_PC; SENTRY[MODE]_IF .PICSW THEN RELATIVE ELSE ABSOLUTE; RNAMEFOLLOWS(.SENTRY); END WHILE .DEL EQL HCOMMA; ROUTINE SMAP=GROMLIST(0,0,0,0,0); ROUTINE SSETSIZE(N)= BEGIN DECLSIZE_.N; RUND(QLLEXEME); IF .SYM NEQ HEMPTY THEN RETURN ERROR(.LOBRAC,.NSYM,.LASTEND,DECLSYMERR); IF .DEL[HCLASS] NEQ DCLRTR THEN RETURN ERROR(.LOBRAC,.NDEL,.LASTEND,ERRBYTEFOL); SXCTDECL; DECLSIZE_2; END; ROUTINE SBYTE=SSETSIZE(1); ROUTINE SWORD=SSETSIZE(2); GLOBAL ROUTINE INCRDECRREG= !I. GENERAL: ! ! 1. THIS ROUTINE IS USED TO DECLARE A REGISTER FOR THE ! INDEX OF AN "INCR" OR "DECR" LOOP EXPRESSION. ! !II. SPECIFIC: ! ! 1. * ! ! A. OPEN A NEW BLOCK. ! ! B. SET DECLARATION FLAGS. ! ! C. DECLARE THE REGISTER, AND RETURN IF ! THERE ARE ANY ERRORS. ! ! D. DO THINGS UNIQUE TO REGISTER DECLARATION. BEGIN LOCAL STVEC REGSTE; BLOCKLEVEL_.BLOCKLEVEL+1; OFLAGS_0; OFLAGS[MUSTDECLARE]_1; RUND(QLQNAME); IF NOT DECLARESYM(REGSTE,LOCALT,1) THEN RETURN 0; PLOCAL(0,2,.REGSTE); REGSTE[POSF]_0; REGSTE[SIZEF]_16; RETURN 1; END; ROUTINE SSWITCHES= BEGIN LOCAL LOBRAC; LOBRAC_.NDEL; SWITCHER(SWSWL); DELERR(NEQ HSEMICOLON,DCLDELERR); END; GLOBAL ROUTINE DOMODULE= BEGIN MAP NTVEC SYM; EXTERNAL FLOWINIT; ROUTINE DCLMODNAME = ! ! DECLARE MODULE NAME AS A GLOBAL ROUTINE. ! A CALL ON THIS MUST BE PAIRED, OF COURSE, WITH ! A LATER CALL ON BLOCKPURGE. ! BEGIN LOCAL NTVEC NAME; BLOCKLEVEL_.BLOCKLEVEL+1; ACCUM[0]_.MODNAME[0]; ACCUM[1]_.MODNAME[1]; NAME_SEARCH(UNDECTYPE); STE_STINSERT(.NAME,GROUTINET,0); LNKGLX_.DFLTLNKGLX; DEFASYM(.STE,2,0,16); DEFGLO(.STE,FALSE,0,0); NOVALUE END; FLOWINIT(); IF .DEL EQL HMODULE THEN BEGIN IF .SYM NEQ HEMPTY THEN %%%%%%; RUND(QLQNAME); IF .SYM NEQ HEMPTY THEN (MODNAME[0]_.SYM[ACCUM1]; MODNAME[1]_.SYM[ACCUM2]; CSNAME_.MODNAME; CSFLAG_-1; SYM_HEMPTY); IF .DEL EQL HPARAOPEN THEN BEGIN SWITCHER(ALLSW); IF .DEL NEQ HPARACLOSE THEN EXITCOMPOUND; RUND(QLLEXEME); END; IF .DEL NEQ HEQUAL OR .SYM NEQ HEMPTY THEN BEGIN UNTIL .DEL EQL HBEGIN DO RUND(QLLEXEME); WARNEM(.NDEL,WABADMOD); END ELSE RUND(QLLEXEME); DCLMODNAME(); EXPRESSION(); IF .DEL NEQ HELUDOM THEN WARNEM(0,WAMODDOM); BLOCKPURGE(); END ELSE (EXPRESSION(); IF .DEL EQL HELUDOM THEN WARNEM(.NDEL,WAMODDOM)); GETNCSE(); NOVALUE END; ROUTINE GETCONS= BEGIN IF .DEL EQL HPARACLOSE THEN SYM_ZERO ELSE (RUND(QLLEXEME); IF .SYM EQL HEMPTY THEN SYM_ZERO); .SYM[LTYPF] EQL LITTYP AND (.DEL EQL HCOMMA OR .DEL EQL HPARACLOSE) END; ROUTINE GETSTRING= BEGIN RUND(QLLSLEX); IF .SYM EQL HEMPTY THEN SYM_ZERO; (.SYM[LTYPF] EQL LSLEXTYP OR .SYM[LTYPF] EQL LITTYP) AND (.DEL EQL HCOMMA OR .DEL EQL HPARACLOSE) END; ROUTINE SWITCHER(HIGH)= !I. GENERAL ! ! 1. THIS ROUTINE IS USED TO PROCESS A LIST OF SWITCHES ! SEPARATED BY COMMAS. ! ! 2. THE PARAMETER IS THE INDEX INTO THE PLIT SWTBL ! OF THE LAST SWITCH WHICH IS CONSIDERED VALID IN ! THE CURRENT CONTEXT. BEGIN MACRO SYCHK(X)=IF X THEN WARNEM(.LOBRAC,WASWSYN)$; MAP NTVEC SYM; LOCAL LOBRAC; REGISTER X; LOBRAC_.NDEL; DO BEGIN RUND(QLQNAME); !SWITCH NAME NOW IN SYM X_.SYM[ACCUM1]; X_INCR I FROM 0 TO .HIGH DO IF .X EQL .SWTBL[.I] THEN EXITLOOP .I; CASE 1+.X OF SET WARNEM(.LOBRAC,WASWNONX); !WARNING, NOT FOUND EMFLG_1; ! EXPAND MACRO EMFLG_0; ! DON'T EXPAND MACRO LSTFLG_0; ! LIST LSTFLG_1; ! NO LIST ERRBIT_0; ! ERR MSGS TO TTY ERRBIT_1; ! NO ERR MSGS TO TTY MLFLG_1; ! MACH LIST MLFLG_0; ! NO MACH LIST NPTFLG_0; ! OPTIMIZE NPTFLG_1; ! NO-OPTIMIZE UNAMESW_1; ! GENERATE UNIQUE NAMES UNAMESW_0; ! DO NOT GENERATE UNIQUE NAMES FINALSW_1; ! DO FINAL PEEPHOLE OPTIMIZATION FINALSW_0; ! DO NOT DO FINAL PEEPHOLE OPTIMIZATION MRKFLG_0; ! TURN ON UNCERTAIN OPTIMIZATIONS MRKFLG_1; ! TURN OFF " " ZIPSW_1; ! CHOOSE SPEED OVER TIME ZIPSW_0; ! CHOOSE TIME OVER SPEED DEBFLG_1; ! GENERATE SIX12 SYMBOL & NAME TABLES DEBFLG_0; ! DO NOT DO ABOVE PICSW_1; ! POSITION INDEPENDENT CODE PICSW_0; ! NO POSITION INDEPENDENT CODE SEGSW_1; ! NO DATA ALLOWED IN CODE CSECT SEGSW_0; ! DATA (CASE STMT. TABLES, OFFSET ! FOR $ENABL) ALLOWED IN CODE CSECT SYCHK(SSTART()); ! STARTING ADDRESS DECLARATION SSTACK(DEFAULTSSTK); ! STACK DECLARATION SYCHK(SMAIN()); ! MAIN DECLARATION SYCHK(SRESERVE()); ! RESERVE SPECIFIC REGS. SYCHK(SIDENT()); ! IDENT NOTREE_-1 ! SYNTAX CHECK ONLY TES; END UNTIL .DEL NEQ HCOMMA; 0 END; ROUTINE SIDENT= BEGIN IF .DEL NEQ HEQUAL THEN RETURN 1; IF GETSTRING() THEN (IDENTLEX_.SYM;IDENTFLG_1;RETURN 0); RETURN 1 END; ROUTINE SSTACK(X)= BEGIN MODMAIN[0]_.MODNAME[0]; MODMAIN[1]_.MODNAME[1]; SSTKLEN_.X; MAINDECL_TRUE; END; ROUTINE SMAIN= BEGIN SSTACK(0); IF .DEL EQL HCOMMA OR .DEL EQL HPARACLOSE THEN RETURN 0; IF .DEL NEQ HPARAOPEN THEN RETURN 1; IF NOT GETCONS() THEN RETURN 1; SSTKLEN_LITVALUE(.SYM[ADDRF]); IF .DEL NEQ HPARACLOSE THEN RETURN 1; RUND(QLLEXEME); IF .SYM NEQ HEMPTY THEN RETURN 1; RETURN 0; END; ROUTINE SSTART= BEGIN BIND STVEC STSYM=SYM; IF .DEL NEQ HEQUAL THEN RETURN 1; RUND(QLQNAME); IF .SYM[LTYPF] NEQ UNBNDVAR OR (.DEL NEQ HCOMMA AND .DEL NEQ HPARACLOSE) THEN RETURN 1; MODMAIN[0]_.STSYM[ACCUM1]; MODMAIN[1]_.STSYM[ACCUM2]; RETURN 0; END; ROUTINE SRESERVE= BEGIN LABEL NEXT; IF .DEL NEQ HPARAOPEN THEN RETURN 1; DO NEXT:BEGIN IF NOT GETCONS() THEN RETURN 1; SYM_EXTEND(LITVALUE(.SYM)); IF .SYM LSS 1 OR .SYM GTR 5 THEN (WARNEM(.NSYM,WACANTRES); LEAVE NEXT); RESERVED[.SYM,1]_TRUE END UNTIL .DEL NEQ HCOMMA; RUND(QLLEXEME); IF .SYM NEQ HEMPTY THEN RETURN 1; RETURN 0 END; ROUTINE PPARAM(TYP,INITOFF,RBRACK)= BEGIN LOCAL STVEC PARAM, OFFST; OFFST_.INITOFF; RUND(QLQNAME); IF .SYM EQL HEMPTY AND .DEL EQL .RBRACK THEN (RUNDE(); RETURN 0); DO (IF DECLARESYM(PARAM,.TYP,0) THEN (PARAM[WHICHF]_.OFFST; OFFST_.OFFST+1)) WHILE (IF .DEL EQL HCOMMA THEN (RUND(QLQNAME); 1)); DELERR(NEQ .RBRACK,ERSMSQBCLOSE); RUNDE(); .OFFST-.INITOFF END; ROUTINE SSTRUCTURE= DO BEGIN LOCAL SAVENME; RUND(QLQNAME); SAVENME_.SYM[ADDRF]; IF NOT DECLARESYM(STRUDEF,STRUCTURET,1) THEN RETURN; IF .SAVENME EQL .STRUDVNME THEN STRUDEFV_.STRUDEF; BLOCKLEVEL_.BLOCKLEVEL+1; IF NOT .STRUCP THEN STRUCLEVEL_.BLOCKLEVEL; NINP_STRUDEF[NUMPARM]_IF .DEL EQL HSQBOPEN THEN PPARAM(STRUFT,3,HSQBCLOSE); DELERR(NEQ HEQUAL, ERMEQ); RUND(QLLEXEME); STRUDEF[SIZESTRM]_ IF .SYM EQL HEMPTY AND .DEL EQL HSQBOPEN THEN BEGIN LOCAL STREAM; RUND(QLLEXEME); STREAM_STRUSC(1); DELERR(NEQ HSQBCLOSE, ERSMSQBCLOSE); DEL_HEQUAL; !HIDE THE SPECIAL USE OF [] FROM LEXAN RUND(QLLEXEME); .STREAM END; STRUDEF[BODYSTRM]_STRUSC(0); IF NOT .STRUCP THEN STRUCLEVEL_#777777; IF .DEL EQL HCOMMA THEN FSYMPROTECT(); BLOCKPURGE() END WHILE .DEL EQL HCOMMA; ROUTINE SMACRO= DO BEGIN LOCAL SUBTYP, QUIT, SAVCOPY; MACRO CHKPL(LB,RB,DEF,INITOFF,ZER,NONZER)= IF .DEL EQL LB THEN SUBTYP_.SUBTYP+ (IF (DEF_PPARAM(MACRFT,INITOFF,RB)) EQL 0 THEN ZER ELSE NONZER)$; RUND(QLQNAME); IF NOT DECLARESYM(MACRDEF,MACROT,1) THEN RETURN; BLOCKLEVEL_.BLOCKLEVEL+1; MACRDEF[NUMFIXED]_MACRDEF[NUMITED]_SUBTYP_0; CHKPL(HPARAOPEN,HPARACLOSE,MACRDEF[NUMFIXED],1,0,MACRFIND); CHKPL(HSQBOPEN,HSQBCLOSE,MACRDEF[NUMITED],.MACRDEF[NUMFIXED]+1,MACRRIND,MACRIIND); BLOCKLEVEL_.BLOCKLEVEL-1; MACRDEF[SUBTYPEM]_.SUBTYP; DELERR(NEQ HEQUAL, ERMEQ); % SEE ALSO STRUSC AND STRUCOPY % SAVCOPY_.MACRCP; MACRCP_TRUE; SCANTYPE_"M"; SCANCHANGE_.NDEL; QUIT_FALSE; UNTIL .QUIT DO BEGIN RUND(QLMACR); UNLESSQUOTED(SYM) IF .SYM[LTYPF] EQL UNBNDVAR THEN IF .ST[.NT[.SYM[ADDRF],SYMLINK],TYPEF] EQL MACRFT THEN (SYM[LTYPF]_CLMACRF; SYM[ADDRF]_.ST[.NT[.SYM[ADDRF],SYMLINK],WHICHF]); UNLESSQUOTED(DEL) IF .DEL EQL "$" THEN IF .SYM EQL HEMPTY THEN EXITLOOP ELSE (DEL_0; QUIT_TRUE); STRMAPPEND(WSTBUF,WSTMAX-1)_FORMWINDOW(.SYM,.DEL) END; MACRDEF[STREAMF]_STRMQUIT(WSTBUF); BLOCKLEVEL_.BLOCKLEVEL+1; BLOCKPURGE(); SCANTYPE_" "; MACRCP_.SAVCOPY; IF RUNDE() THEN RETURN; END WHILE .DEL EQL HCOMMA; MACRO RUNSC=UNTIL .DEL EQL HSEMICOLON DO RUND(QLLEXEME)$, KWCHK=IF NOT GETSTRING2() THEN(WARNEM(.LOBRAC,WBADCSECT);RUNSC;RETURN)$; ROUTINE GETSTRING2= BEGIN RUND(QLLSLEX); IF .SYM EQL HEMPTY THEN SYM_ZERO; (.SYM[LTYPF] EQL LSLEXTYP OR .SYM[LTYPF] EQL LITTYP) AND (.DEL EQL HCOMMA OR .DEL EQL HSEMICOLON) END; ROUTINE SCSECT= BEGIN MAP STVEC SYM; LOCAL X,Y,Z,FLG,LOBRAC; LOBRAC_.NDEL; Y_0; IF .DEL EQL HCSECT THEN FLG_1 ELSE FLG_2; DO BEGIN RUND(QLQNAME); Y_.Y+1; IF .SYM EQL HEMPTY THEN (Z_SELECT .DEL OF NSET HOWN : BS(3,OWN); HGLOBAL : BL(GLOBA); HPLIT : BS(4,PLIT); OTHERWISE : 0 TESN; RUND(QLLEXEME); IF .DEL NEQ HEQUAL THEN (WARNEM(.LOBRAC,WBADCSECT);RUNSC;RETURN)) ELSE Z_.SYM[ACCUM1]; X_INCR I FROM 0 TO .KWTBL[-1]-1 DO IF .Z EQL .KWTBL[.I] THEN EXITLOOP .I; IF .X LSS 0 THEN BEGIN IF (.DEL EQL HSEMICOLON) AND (.Y EQL 1) THEN (CSNAME_.Z; CSFLG_.FLG; CSFLAG_-1) ELSE (WARNEM(.LOBRAC,WBADCSECT); RUNSC; RETURN) END ELSE BEGIN BIND FLGPLIT=PLIT(CSCFLG,CSDFLG,CSGFLG,CSOFLG,CSPFLG), NAMEPLIT=PLIT(CSCNAME,CSDNAME,CSGNAME,CSONAME,CSPNAME); KWCHK; .FLGPLIT[.X]_.FLG; .NAMEPLIT[.X]_.SYM END; END UNTIL .DEL NEQ HCOMMA; 0 END; ROUTINE SLNKGDECL= BEGIN BIND NP=30; STRUCTURE V1[I]=(.V1+.I-1)<0,36>; LOCAL STVEC S:LP, V1 P[NP], N,LT; MACRO RERR(EN)=RETURN ERROR(.LOBRAC,.NSYM,.LASTEND,(EN))$; MACRO RERRD(EN)=EXITLOOP ERROR(.LOBRAC,.NSYM,PSPAR,(EN))$; BIND STVEC SYMST=SYM; DO BEGIN LOCAL SAVENME; N_0; RUND(QLQNAME); SAVENME_.SYM[ADDRF]; IF NOT DECLARESYM(S,LNKGNMT,1) THEN RETURN; IF .DEL NEQ HEQUAL THEN RERR(LNKGNOEQUAL); RUND(QLLEXEME); IF .SYM[LTYPF] NEQ BNDVAR THEN RERR(LNKGNOTYP) ELSE IF .SYMST[TYPEF] NEQ LNKGNMT THEN RERR(LNKGNOTYP) ELSE LT_.SYMST[LNKGTF]; IF .SAVENME EQL .ST[.DFLTLNKGLX,NAMEPTR] THEN DFLTLNKGLX_LEXOUT(BNDVAR,.S); IF .DEL EQL HPARAOPEN THEN WHILE 1 DO BEGIN IF (N_.N+1) GTR NP THEN RERRD(LNKGTOOMANYP); RUND(QLQNAME); IF .SYM EQL HEMPTY THEN BEGIN IF .DEL NEQ HREGISTER THEN RERRD(LNKGINVPARM) ELSE BEGIN RUND(QLLEXEME); IF .DEL NEQ HEQUAL THEN RERRD(LNKGNOEQUAL) ELSE BEGIN RUND(QLLEXEME); SYM_BINDBIND(.SYM); IF (IF .SYM[LTYPF] NEQ LITTYP THEN 1 ELSE IF (P[.N]_LITVALUE(.SYM)) LSS 0 THEN 1 ELSE IF .P[.N] GTR 6 THEN 1 ELSE 0) THEN (WARNEM(.NSYM,LNKGNOTREG); P[.N]_1); END; END END ELSE IF .SYMST[ACCUM1] EQL 'STACK' THEN P[.N]_-1 ELSE IF .SYMST[ACCUM1] EQL 'MEMOR' %Y% THEN BEGIN LABEL LAB; IF .DEL NEQ HEQUAL THEN RERRD(LNKGNOEQUAL); RUND(QLLEXEME); EXPRESSION(); SYM_BINDBIND(.SYM); LAB: SELECT .SYM[LTYPF] OF NSET LITTYP: (P[.N]_.SYM; LEAVE LAB); BNDVAR: IF LOADCONST(SYM) THEN (P[.N]_.SYM; LEAVE LAB); ALWAYS: (WARNEM(.NSYM,LNKGINVPARM); P[.N]_-1) TESN END ELSE RERRD(LNKGINVPARM); IF .DEL EQL HPARACLOSE THEN EXITLOOP RUND(QLLEXEME) ELSE IF .DEL NEQ HCOMMA THEN RERRD(LNKGINVSYNTAX); END; LP_GETSPACE(ST,.N+1); LP[LNKGSIZEF]_.N; WHILE .N GTR 0 DO BEGIN LP[PARMTYPE(.N)]_.P[.N]+1; ! THE ABOVE RELIES ON LITTYP BEING 1,BNDVAR BEING 2. LP[PARMLOC(.N)]_.P[.N]; N_.N-1; END; S[LNKGTF]_.LT; S[LNKGDESCF]_.LP; END UNTIL .DEL NEQ HCOMMA; END; %% % PLIT SYNTAX PROCESSING ROUTINES. THE SYNTAX FOR PLITS IS AS FOLLOWS: ::= PLIT ::= ! ! ::= () ::= ! , ::= ! ! : ::= [NOTE: ::= ! ...] % %% BIND PLNEXT=NEXTGLOBAL; GLOBAL ROUTINE SPLIT= BEGIN MACRO MAKENEWNAME= (PLHEAD_.PLHEAD+2; IF .PLHEAD<1,7> EQL "[" THEN (PLHEAD<1,7>_"A"; IF (PLHEAD<8,7>_.PLHEAD<8,7>+1) EQL "[" THEN (PLHEAD<8,7>_"A"; PLHEAD<15,7>_.PLHEAD<15,7>+1)); ACCUM[0]_.PLHEAD; ACCUM[1]_-2)$; LOCAL PLITLEN, STVEC STE, PLITP, ISCOUNTED; ISCOUNTED_(.DEL EQL HPLIT); MAKENEWNAME; STE_.NT[SEARCH(GLOBALT),SYMLINK]; PLITLEN_SPLITB(PLITP); DEFASYM(.STE,2*.PLITLEN,0,16); DEFMAP(.STE); STE[ITSAPLIT]_TRUE; STE[COUNTED]_.ISCOUNTED; DEFGLO(.STE,TRUE,TRUE,.PLITP); SYM_LEXOUT(BNDVAR,.STE) END; GLOBAL ROUTINE SPLITB(GLOSTE) = BEGIN MAP STVEC GLOSTE; LOCAL STVEC TEMPHEAD:NEXTCELL:FIRSTCELL, OFFST, SLBRAC; SLBRAC_.PLLBRAC; PLLBRAC_.NDEL; TEMPHEAD_GETCELL(CHTPLIT,1); INAPLIT_TRUE; OFFST_PLITARG(.TEMPHEAD); INAPLIT_FALSE; TEMPHEAD[LSLENGTH]_.OFFST; .GLOSTE_.TEMPHEAD; PLLBRAC_.SLBRAC; .OFFST END; ROUTINE PLITARG(HEAD) = BEGIN RUND(QLLSLEX); IF .SYM NEQ HEMPTY OR (.DEL NEQ HPARAOPEN AND .DEL NEQ HCOMPOPEN) THEN RETURN LSORLE(.HEAD); BEGIN LOCAL LENTH, SLBRAC, SAVEL; NEWLASTEND(PSPARCOM); SLBRAC_.PLLBRAC; PLLBRAC_.NDEL; LENTH_0; DO (RUND(QLLSLEX); LENTH_.LENTH+TUPLEITEM(.HEAD)) WHILE .DEL EQL HCOMMA; RESLASTEND; IF .DEL NEQ HPARACLOSE THEN RETURN ERROR(.PLLBRAC,.NDEL,.LASTEND,ERSYPLMRP); RUNDE(); PLLBRAC_.SLBRAC; .LENTH END END; ROUTINE TUPLEITEM(HEAD) = BEGIN EXPRESSION(); IF .DEL EQL HCOLON THEN BEGIN LOCAL LEN, STVEC NEWHEAD; SYM_BINDBIND(.SYM); IF NOT LITRESULT THEN (ERROR(.PLLBRAC,.NSYM,0,ERSMPLNLI); SYM_LITLEXEME(1)); NEWHEAD_GETCELL(CHTDUP,1); NEWHEAD[DUPLENGTH]_LEN_LITVALUE(.SYM[ADDRF]); PUSHBOT(.HEAD,.NEWHEAD); .LEN*PLITARG(.NEWHEAD) END ELSE LSORLE(.HEAD) END; ROUTINE LSORLE(HEAD)= BEGIN IF .SYM[LTYPF] EQL LSLEXTYP THEN BEGIN MAP STVEC SYM; LEXTOP(.HEAD,.SYM); RETURN .SYM[LSLENGTH] END ELSE BEGIN CASE WHICHBIND() OF SET (WARNEM(.NSYM,ERSMPLNLO); SYM_ZERO); ; (IF .SYM[LTYPF] EQL BNDVAR THEN IF LOADCONST(SYM) THEN EXITCASE; WARNEM(.NSYM,ERSMPLNLO); SYM_ZERO) TES; RETURN LEXTOP(.HEAD,.SYM) END END; ROUTINE LEXTOP(HEAD,LEX) = BEGIN LOCAL STVEC CELL; CELL_GETCELL(CHTLEX,1); CELL[LEXEMEF]_.SYM; PUSHBOT(.HEAD,.CELL); 1 END; ! THESE ROUTINES HANDLE THE "REQUIRE" DECLARATION ! VERY MACHINE DEPENDENT. ROUTINE SREQUIRE= BEGIN LOCAL DEVICE; REGISTER N; EXTERNAL SCANFOR,FILESELECT,RLS; MACRO FILE=BUFDATA[.CURCHN+1,FILENAMEF]$, EXT=BUFDATA[.CURCHN+1,EXTF]$, PPN=BUFDATA[.CURCHN+1,PPNF]$, THISPPN=BUFDATA[.CURCHN,PPNF]$; BIND CMUDEC=-2; MACRO FUTSYM=SYMPART(.FUTWINDOW)<0,36>$, FUTDEL=DT[.FUTWINDOW[DELIND]]$, SCANSYM=SCANFOR(1,QLQNAME)$, SCANDEL=(SCANFOR(0,QLQNAME); DEL_.DT[.DEL])$, LITP(X)=X[LTYPF] EQL LITTYP$, LITV(X)=LITVALUE(X)$, ABORT(NUM)=RETURN (RLS(.CURCHN+1); ERROR(.LOBRAC,.NDEL,PSSEM,NUM))$; ROUTINE JRUND=(SCANDEL; SCANSYM); ROUTINE CVSIX= BEGIN LOCAL SYMPTR,SIXPTR,SIXSYM; REGISTER R; MACHOP ILDB=#134,IDPB=#136; SIXSYM_0; SYMPTR_NT[.SYM,0,36,7]; SIXPTR_SIXSYM<36,6>; DECR I FROM 5 TO 0 DO (ILDB(R,SYMPTR); IF .R EQL #177 THEN EXITLOOP; IF .R LEQ #132 THEN R_.R-#40; IDPB(R,SIXPTR) ); .SIXSYM END; EXTERNAL SKAN1; FILE_EXT_PPN_0; SCANSYM; DEVICE_IF .FUTDEL EQL HCOLON THEN (N_CVSIX(); JRUND(); .N) ELSE SIXBIT 'DSK '; IF NOT (N_REQUINIT(.DEVICE)) THEN RETURN ERROR(.LOBRAC,.NDEL,PSSEM,(IF .N EQL 0 THEN ERREQDEV ELSE ERREQNEST)); FILE_CVSIX(); IF .FUTDEL EQL HDOT THEN (JRUND(); EXT_(CVSIX())^(-18)); IF .FUTDEL EQL HSQBOPEN THEN BEGIN JRUND(); IF .FUTDEL EQL HSQBCLOSE THEN (IF .SYM EQL HEMPTY THEN (PPN_.THISPPN; SYM_ZERO)) ELSE IF .FUTDEL EQL HCOMMA THEN (IF NOT LITP(.SYM) THEN ABORT(ERREQDPPN); PPN<18,18>_LITV(.SYM); JRUND()); IF .FUTDEL NEQ HSQBCLOSE THEN ABORT(ERREQDPPN); IF LITP(.SYM) THEN (IF (PPN_.PPN OR LITV(.SYM)) EQL 0 THEN PPN_.THISPPN) ELSE BEGIN N_NT[.SYM,0,0,0]; N_PPN<0,0>; IF NOT SKIP(CALLI(N,CMUDEC)) THEN ABORT(ERREQCPPN); END; JRUND() END; IF NOT LKUP(.CURCHN+1) THEN ABORT(ERREQFIND); CURCHN_.CURCHN+1; SKAN1(); !FORCE EOL AND GET NEW LINE FROM REQUIRED FILE SEQNUM_' '; ! BLANK OUT SEQNUM FIELD FOR NEW FILE SCANDEL END; !OF SREQUIRE ROUTINE REQUINIT(DEVICE)= BEGIN REGISTER N; EXTERNAL OPN; MACRO DEVCHR=4$, INPUTF=19,1$, ASCIIMF=0,1$, STATUS=OPENBLOCK[0]$, ODEV=OPENBLOCK[1]$, BUFW=OPENBLOCK[2]$; N_.DEVICE; CALLI(N,DEVCHR); IF .N EQL 0 THEN RETURN 0; IF NOT .N THEN RETURN 0; IF NOT .N THEN RETURN 0; IF (.CURCHN+1) GTR #17 THEN RETURN 2; OPN(.CURCHN+1,.DEVICE,1,2) END; !OF REQUINIT END; END ELUDOM