File MACEXP.MA (MACREL macro assembler source file)

Directory of image this file is from
This file as a plain text file

/32 MACREL EXPRESSION MODULE	POST FT1
/ 8-MAR-78	COMMENTED IN CHANGE FOR AUXILIARY SECT CHUNK SUPPORT
/	ALLOW USE OF SECT NAME IN EXPRESSION
/	16-AUG-78	FIX ^"
/	17-AUG-78	ADDED .LEVEL
/	23-AUG-78	FSECT LITERALS
/			( IN ASECT WITH PC<200 ACTS AS [
	.INCLUDE MGLOB.MA
	.ASECT MACEXP
/
/
/
/
/
/
/
/
/
/COPYRIGHT  (C)  1977 BY DIGITAL EQUIPMENT CORPORATION
/
/
/
/
/
/
/
/
/
/
/THE INFORMATION IN THIS DOCUMENT IS SUBJECT TO CHANGE WITHOUT NOTICE
/AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
/CORPORATION.  DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY
/FOR ANY ERRORS THAT MAY APPEAR IN THIS DOCUMENT.
/
/THE SOFTWARE DESCRIBED IN THIS DOCUMENT IS FURNISHED TO THE PURCHASER
/UNDER A LICENSE FOR USE ON A SINGLE COMPUTER SYSTEM AND CAN BE COPIED
/(WITH INCLUSION OF DIGITAL'S COPYRIGHT NOTICE) ONLY FOR USE IN SUCH
/SYSTEM, EXCEPT AS MAY OTHERWISE BE PROVIDED IN WRITING BY DIGITAL.
/
/DIGITAL EQUIPMENT CORPORATION ASSUMES NO RESPONSIBILITY FOR THE USE
/OR RELIABILITY OF ITS SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY
/DIGITAL.
/
/
/
/
/
/
/
/
/
/

.GLOBAL PUSHL,POPL,PEX1,PEX2 .GLOBAL OK2A /TEMP .GLOBAL $XEDF,$LEVEL,CNVCNV .EXTERNAL ASEMLV,BACKUP,BRANCH,CREF,CRLF,DPRINT,ENTER,EOS,ERROR .EXTERNAL FSCHEK,GETCHR,GETKAR,GETSYM,LETTER,LISTER,LOOKUP,ORIG,OUT,PARSYM .EXTERNAL PASS3,POP,PUSH,PUNBIT,PUTBIT,PUTSYM,PUXBIN,READLN,ROTL6,SCAN .EXTERNAL BRAN,LOAD,HARDY,IMUL,IDIV,DIGIT,HRDTRM,ZSECTG,FLDYX .EXTERNAL XXEDF,KRFSIM .EXTERNAL SNGLQQ,UPAROQ,CURPAG,PAGE0,MARGS,MORCRF .EXTERNAL KLU8,KLU9,LEVXX,KLU11 .GLOBAL COMN .GLOBAL LITABS,LITREL,EXPR,PRVOPR,LITKOM .GLOBAL CNTCON,DFLG,GETNUM,HLDRAD,POPL,PUSHL,TERM,UNARYM .GLOBAL $DOT,DNUM,DOLCHK,$I,$Z .GLOBAL $EDF,$CDF,$CIF,$FLD .GLOBAL $NARGS,$NCHARS .GLOBAL ER10,ER22,ER24,ER69,ER92,ER203,ER34,ER41,ER56,ER60,ER67 /RETURNS WITH /EXPABS: ABSOLUTE PART OF RESULT /EXPREL: RELATIVE PART OF RESULT /EXPCOD: TYPE OF RELOCATION / JMS TERM / <NO TERM FOUND> / RETURNS /TRMABS: ABSOLUTE PART OF TERM /TRMREL: RELATIVE PART OF TERM /TRMCOD: TYPE OF RELOCATION / RELOCATION TYPES: / 0 SIMPLE RELOCATION, ADD ABSOLUTE PART TO RELATIVE PART / 1 F-SECT RELOCATION / 2 ADD FIELD OF RELATIVE PART ^10 TO ABSOLUTE PART / -1 VALUE OF EXPRESSION IS TOP ENTRY OF LINKER STACK /CALL WHEN YOU WANT TO EVALUATE AN EXPRESSION /BEGINNING WITH THE NEXT CHARACTER (NOT ALREADY GOTTEN) / JMS EXPR / <GOOD RETURN> /VALUE LEFT IN AC / IF AC IS NON-ZERO, ALLOW VACUOUS EXPRESSION
*3000 PRVOPR, 0 /PREVIOUS OPERATOR EXPR, 0 DCA VACFLG /AC MAY BE NON-ZERO DCA PRVOPR /NO PREVIOUS OPERATOR DCA EXPABS /NO RESULT YET DCA EXPREL DCA EXPCOD EXP1, JMS I (TERM /PARSE A TERM JMP VACEXP /TERM NOT FOUND - EXPRESSION IS VACUOUS TAD TRMCOD SNA TAD EXPCOD SNA TAD TRMREL SNA TAD EXPREL SNA CLA JMP EASY /BOTH OPERANDS ARE ABSOLUTE CLL STA RAL /-2 TAD PRVOPR SPA SNA CLA JMP EASY /OPERATOR IS +, -, OR NULL TAD PRVOPR /TEMPORARY TAD (-5 SZA TAD (5-10 SZA CLA JMP HARD /NOT OR CLL STA RAL /-2 TAD EXPCOD SNA CLA JMP CIFCOD TAD EXPREL TAD EXPABS SZA CLA JMP HARD TAD EXPCOD SPA CLA JMP HARD TAD TRMCOD SPA CLA JMP HARD TAD TRMREL /ALLOW OR WITH ABSOLUTE 0 DCA EXPREL /NEEDED TEMPORARILY FOR I AND Z TAD TRMCOD DCA EXPCOD EASY, TAD PRVOPR JMS I (BRAN NOPREV /0 NONE ADD /1 + SUB /2 - MUL /3 ^ DIV /4 % POR, OR /5 SPACE OR TAB ANDY /6 & SHIFT /7 ! MEANING 'SHIFT' OR /10 ! MEANING 'OR' VACFLG, 0 /NON-0 IF VACUOUS EXPRESSION PERMITTED
CIFCOD, TAD EXPREL SZA CLA JMP HARD /LEFT OPERAND CAN NOT BE CDF RELOCATABLE TAD TRMCOD CLL RAR SZL CLA JMP HARD /CDF F-SECT OR CDF STACK TAD TRMREL SNA JMP I POR /CDF 30 RESULT IS CDF DCA EXPREL /CDF FOO " JMP I (GETOP /DECISION TABLE FOR ! OPERATOR / ! ABS REL FSCT CDF STACK / / A OR * * * * / REL_0 / COD_0 / / R * * * * * / / F * * * * * / / C OR 1 * 1 * / REL_0 / COD_0 / / S * * * * * /
$CIF, 0 TAD (CIF DCA TRMABS DCA TRMREL STL RTL /2 DCA TRMCOD JMP I $CIF $CDF, 0 STA JMS $CIF JMP I $CDF HARD, CLA JMS I (HA JMS I (HARDY JMP I (GETOP
VACEXP, TAD PRVOPR SNA JMP VACY TAD (-5 SZA CLA ER56, JMS I QQERROR /DANGLING OPERATOR OTHER THAN SPACE OR TAB ENDEXP, TAD EXPREL SZA CLA JMP .+4 TAD EXPCOD SMA SZA CLA DCA EXPCOD /CDF ABS IS TO BE ABS NOT CDF TAD EXPABS /RETURN WITH RESULT IN AC (ABSOLUTE PART) JMP I EXPR VACY, TAD VACFLG SNA CLA /IS VACUOUS EXPRESSION LEGAL? ER60, JMS I QQERROR /NO / DCA EXPABS / DCA EXPREL / DCA EXPCOD JMP I EXPR /RETURN IFDEF PLM < / /ALGORITHM FOR 'EXPR' : (NOT LATEST - CONSULT FLOW CHARTS) / /1. PUSH DOWN ALL LOCAL VARIABLES, NAMELY 'RESULT', 'EXPREL', / 'PRVOPR', 'UNARYM', AND THE RETURN ADDRESS 'EXPR' . / THIS MAKES EXPR RECURSIVE. /2. UNARYM=EXPABS=PRVOPR=EXPREL=0. / SPECIFIES NO UNARY OPERATORS SEEN YET, / NO PREVIOUS BINARY OPERATOR, AND INITIAL 0 RESULT. /3. SCAN OVER BLANKS, IF COME TO END OF STATEMENT, JUMP TO / 'VACEXP' SINCE EXPRESSION IS VACUOUS. /4. IF NEXT CHARACTER IS A LETTER, GOTO 'SYM', OTHERWISE / BRANCH TO APPROPRIATE ROUTINE DEPENDING ON SPECIAL CHARACTER. /5. IF NEXT CHARACTER IS ILLEGAL, GENERATE AN ERROR MESSAGE / AND GO BACK TO STEP 3. >
MAYBOK, TAD FLAG AND QQ70 SNA /IS IT A SECT NAME? JMP I (OK /NO TAD QM10 SZA CLA /ASECT? JMP I (NOTASC /NO TAD SYMSCT /YES JMS I (CNVADR CIF 20 JMS I (KLU9 PAGE
/ A V B == A & <NOT B> + B OR, TAD TRMABS CMA AND EXPABS DCA EXPABS TAD EXPABS JMP CMNOP4 ADD, JMS CHKCOD TAD EXPABS TAD TRMABS DCA EXPABS /ADD TOGETHER ABSOLUTE PARTS DCA TRMABS /0 THIS IN CASE OF GLOBAL ARITHMETIC /DON'T WANT TO ADD AGAIN TAD TRMREL SNA CLA JMP GETOP /TERM WAS ABSOLUTE. RESULT HAS SAME RELOCATABILITY TAD EXPREL SZA CLA JMP I (HARD /R + R TAD TRMREL CMNOP3, DCA EXPREL JMP GETOP SUB, JMS CHKCOD TAD TRMABS CIA TAD EXPABS DCA EXPABS DCA TRMABS /0 IN CASE OF GLOBAL ARITHM TAD TRMREL SNA JMP GETOP / - ABSOLUTE CIA TAD EXPREL SNA CLA JMP CMNOP3 / R - R = ABSOLUTE JMP I (HARD /HAVE LINKER DO IT
/RELERR,DCA UNARYM / DCA TRMABS / DCA TRMREL /ER68, JMS I QQERROR /RELOCATION ERROR / JMP GETOP SHIFT, TAD EXPABS AND QQ77 JMS I QQROTL6 JMP CMNOP4 CHKCOD, 0 TAD EXPCOD SNA TAD TRMCOD SZA CLA JMP I (HARD /NOT SIMPLE RELOCATION JMP I CHKCOD /SIMPLE RELOCATION
MUL, JMS I (LOD TAD EXPABS JMS I (IMUL TRMABS JMP CMNOP2 DIV, JMS I (LOD TAD TRMABS SNA CLA ER92, JMS I QQERROR /DIVIDE BY 0 TAD EXPABS JMS I (IDIV TRMABS JMP CMNOP2 ANDY, TAD EXPABS AND TRMABS JMP CMNOP2
NOPREV, TAD TRMREL DCA EXPREL TAD TRMCOD DCA EXPCOD CMNOP4, TAD TRMABS CMNOP2, DCA EXPABS /ASSUME WE HAVE NEXT CHARACTER ALREADY IN 'CHAR' GETOP, TAD BITS AND (100 SNA CLA JMP I (ENDEXP JMS I QQBRANCH /BRANCH ON IT -40;OROP /SPACE -11;OROP /TAB -53;ADDOP /+ -55;SUBOP /- -136;MULOP /^ -45;DIVOP /% -46;ANDOP /& -41;EXCLOP /! 0 HLT /CAN NEVER GET HERE
EXCLOP, TAD I (ENABWD RTL /SHIFT BIT TO LINK CLA CML RAL /1 IF ! MEANS OR IAC ANDOP, IAC OROP, IAC DIVOP, IAC MULOP, IAC SUBOP, IAC ADDOP, IAC DCA I (PRVOPR JMP I (EXP1 IFDEF PLM < /CODE USED FOR PREVIOUS OPERATOR / /0 NONE /1 PLUS /2 MINUS /3 TIMES /4 DIVIDE /5 OR /6 AND /7 ! MEANING 'SHIFT' /10 ! MEANING 'OR' >
LNKPT2, ISZ IFLAG SKP ER69, JMS I QQERROR /ILLEGAL REFERENCE TAD QQ7 DCA I (LNKGEN STA DCA IFLAG JMP I (RETRY $I, 0 STA DCA IFLAG DCA TRMREL DCA TRMABS DCA TRMCOD JMP I $I PAGE
TERM, 0 DCA UNARYM SKP UNOPM, ISZ UNARYM /4096 CONSECUTIVE UNARY MINUSES WILL BE TREATED AS 1 TRM1, JMS I QQGETCHR /GET THE NEXT CHARACTER JMS I QQSCAN JMS I QQEOS /WAS IT END-OF-STATEMENT? VACTRM, JMP I TERM /YES, VACUOUS RETURN (#1) JMS I QQLETTER /NO SKP JMP I (SYMM JMS I (DIGIT SKP JMP NUMBR JMS I QQBRANCH /BRANCH ON CHARACTER -55;UNOPM /- -50;OPENP /OPEN PARENTHESIS -133;OPENB /OPEN SQUARE BRACKET -42;DBLQ /" -47;SNGLQ /' -136;UPAROW /^ -53;TRM1 /+ -74;OPENA /< -76;VACTRM /> 0 ER22, JMS I QQERROR /UNEXPECTED CHARACTER WHILE LOOKING FOR EXPRESSION JMP TRM1
PUSHL, 0 /PUSH A LIST TAD I PUSHL DCA PSHPTR ISZ PUSHL PUSHL1, TAD I PSHPTR SNA JMP I PUSHL /0 ENDS LIST - DONE DCA TEMP TAD I TEMP JMS I QQPUSH ISZ PSHPTR JMP PUSHL1 POPL, 0 TAD I POPL DCA PSHPTR ISZ POPL POPL1, TAD I PSHPTR SNA JMP I POPL /END OF LIST (0 AT BEGINNING) DCA P JMS I QQPOP DCA I P STA TAD PSHPTR /LIST SCANS DOWNWARD DCA PSHPTR JMP POPL1 0 PEX1, EXPABS EXPREL EXPCOD PRVOPR UNARYM EXPR PEX2, TERM 0
NUMBR, DCA TRMREL /NUMBERS ARE ABSOLUTE DCA I (HLDRAD /SIGNAL 'GETNUM' THAT WE'RE NOT COMING FROM ^O ROUTINE JMS I (GETNUM NUMCMN, DCA TRMABS /STORE VALUE AWAY PPFIX, DCA TRMCOD PREFIX, TAD UNARYM /NEGATE VALUE OF TERM IF ODD NUMBER RAR /OF UNARY MINUS SIGNS SNL CLA /IS 'UNARYM' ODD? JMP TRMRET /NO, RETURN JMS HA /HARD STIFF AHEAD JMS I (HRDTRM TRMRET, ISZ TERM /TAKE NORMAL RETURN JMP I TERM UNARYM, 0 /NUMBER OF UNARY MINUSES SEEN
/PSEUDOMACROS CANNOT BE IN AN OVERLAY! PSM, JMS I SYMVAL /NO, CALL ROUTINE TO GET VALUE JMP PREFIX P, 0 $FLD, 0 JMS HA JMS I (FLDYX JMP I $FLD PSHPTR, 0 $LEVEL, 0 JMS HA JMS I (LEVXX JMP I $LEVEL $NCHARS,0 JMS I QQSCAN DCA KNT JMS I QQBACKUP L$: JMS I QQGETKAR JMP 4$ CLA ISZ KNT JMP L$ 4$: TAD KNT DCA TRMABS DCA TRMREL DCA TRMCOD JMP I $NCHARS
HA, 0 JMS I (LOAD AUXOVR+6 JMP I HA PAGE
SYMM, JMS I QQPARSYM GOTSYM, JMS I QQLOOKUP JMP NOTHER JMS I QQGETSYM JMS I (KRFSIM TAD FLAG AND QQ7 JMS I (BRAN MAYBOK /0 REGULAR SYMBOL OR SECT ER10 /1 USER MACRO PSM /2 PSEUDO-MACRO ER10 /3 PSEUDO-OP OK /4 ENTRY OK /5 GLOBAL XT /6 EXTERNAL ZT /7 EXTERNAL PAGE 0 (ZTERNAL) ER10, JMS I QQERROR OK, TAD FLAG /IF SYMBOL IS NOT DEFINED, SET UNDEF RAL /MRI BIT TO SIGN BIT SPA CLA /IS IT AN MRI? JMP MR /YES /DEFINED BIT IS IN LINK SNL /IS IT UNDEFINED? JMP UND /YES OK2, TAD SYMSCT OK2A, DCA TRMREL OK2B, DCA TRMCOD TAD SYMVAL DCA TRMABS JMP I (PREFIX
/UND, TAD I (ERRLVL / SPA CLA / JMP UND2 /WITH /F WE DON'T REPORT DUPLICATE US'S / SKP NOTHER, JMS I QQCREF UND, STA TAD PASS SZA CLA /UNDEFINED SYMBOLS OK ON PASS 1 ER24, JMS I QQERROR /UNDEFINED SYMBOL UND2, CLA IAC DCA UNDEF ABS0, DCA TRMABS ABS1, DCA TRMREL DCA TRMCOD JMP I (PREFIX
MR, JMS I QQSCAN /PASS UP SPACES JMS I QQBACKUP DCA ZFLAG /*** ? TAD SYMVAL JMS I QQPUSH JMS I (PUSHL PEX1 CLA IAC /ALLOW VACUOUS EXPRESSION JMS I QQEXPR DCA REFABS /**** CHECK EXPREL AND EXPCOD HERE TAD EXPREL DCA REFREL TAD EXPCOD DCA REFCOD / JMS I QQFSCHEK /LITERAL CHECKER WILL CATCH THIS JMS I (POPL /RESTORE CONTEXT PEX2 JMS I QQPOP DCA MRIVAL TAD REFCOD SZA CLA JMP I (LINK RETRY, TAD REFREL /LOOK AT SECT OF EXPRESSION SNA JMP ABSREF /REF IS ABSOLUTE JMS I QQGETSYM /GET INFO ABOUT SECT OF REFERENCE TAD FLAG AND QQ70 /ISOLATE TYPE OF SECT CLL RTR RAR TAD (-5 CLL RAR SNA CLA /SKIP IF NOT X- OR Z-SECT JMP I (ZREF /PAGE 0 REFERENCE /ACTUALLY, SHOULD BRANCH TO XZSECT AND /DO VALIDITY CHECK ENSURING REF .LT. 200 TAD CURSCT /NOT AN X- OR Z-SECT CIA /COMPARE SECT OF REF WITH CURRENT SECT TAD REFREL SNA CLA /ARE THEY THE SAME? JMP CHKPAG /YES JMP I (LINK /NO, REF IS NOT RELATIVE TO CURRENT SECT /ACTUALLY, BEFORE BRANCHING TO 'LINK', SHOULD CHECK IF CURRENT SECT IS /AN F-SECT AND SEE IF SECT OF REF IS RESTRICTED TO SAME PAGE. /IF SO, BRANCH TO 'WASZ' .
ABSREF, TAD REFABS /IS VALUE OF REF <200? AND QQ7600 SNA CLA JMP NOTCUR /YES, NO CURRENT PAGE BIT TAD CSTYPE /NO TAD QM10 SZA CLA /IS CURRENT SECT AN A-SECT? JMP I (LINK /NO CHKPAG, TAD REFABS /YES AND QQ7600 /ISOLATE PAGE OF REF CIA TAD PC /COMPARE WITH PAGE OF PC AND QQ7600 SZA CLA /IS VALUE OF REF ON CURRENT PAGE? JMP I (LINK /NO, PROBABLY GENERATE LINK WASZ, ISZ ZFLAG /YES, WAS Z SPECIFIED? (KEEP LABEL) SKP /NO ER67, JMS I QQERROR /YES, Z SPECIFIED WITH SAME PAGE REFERENCE CPAGE, TAD REFABS /SET CURRENT PAGE BIT AND QQ177 TAD QQ200 SKP NOTCUR, TAD REFABS /PAGE 0 REFERENCE JMS I (SETI /SET I BIT IF NECESSARY TAD CSTYPE TAD (-30 /FSECT SZA CLA JMP OK2A /NOT F-SECT, RESULT IS ABSOLUTE TAD REFREL DCA TRMREL CLA IAC /RESULT IS F-SECT RELOCATABLE JMP OK2B /*** BUG IF REF WAS EXTERNAL WITH Z RESULT IS NOT ABSOLUTE **** REFABS, 0 REFREL, 0 REFCOD, 0 MRIVAL, 0 PAGE
HLDRAD, 0 /HOLDS CURRENT RADIX TEMPORARILY SNGLQ, JMS LOD JMS I (SNGLQQ JMP I (ABS1 ZT, JMS $Z /PRETEND SAW 'Z' WITH ZTERNAL XT, DCA SYMVAL /NON-PERMANENT 0 OF SYMVAL /THIS IS BECAUSE SYMVAL IS 1 ON A SECREF TAD SYMNUM /EXTERNAL IS REALLY 0 RELATIVE TO ITSELF JMP I (OK2A UPAROW, JMS LOD JMS I (UPAROQ JMP I (PPFIX LOD, 0 JMS I (LOAD AUXOVR+32 JMP I LOD
LINK, TAD FLAG AND QQ7 /GET TYPE OF REF TAD (-6 /6=EXT, 7=ZTRN CLL RAR SZA CLA JMP GENLNC /NOT XTERN OR ZTERN TAD ZFLAG /LINK=1 MEANS ZTERN CMA /AC=0 NOW MEANS SAW 'Z' SNL SZA CLA /OR JMP GENLNC /NO 'Z' AND XTERN ZREF, TAD I (REFABS /'Z' OR ZTERN JMS SETI /SET I BIT IF NECESSARY (REF MAY HAVE VALUE) TAD I (REFREL /CONVERT TO EXPRESSION+ZTERNAL JMP I (OK2A NOTASC, DCA SYMVAL /YES, SECT NAMES IN EXPRESSION JMP XT /ARE TREATED AS 0 RELATIVE TO SECT
SETI, 0 /AC NON-0 TAD I (MRIVAL ISZ IFLAG /DID WE SEE AN I? SKP /NO TAD (400 /YES, ADD IN INDIRECT BIT DCA SYMVAL DCA ZFLAG DCA IFLAG JMP I SETI TMP, $Z, 0 STA DCA ZFLAG DCA TRMREL DCA TRMABS DCA TRMCOD JMP I $Z $DOT, 0 TAD I (EXTPC SZA CLA JMP I (ER24 /WHAT A HACK! TAD CSTYPE TAD QM10 SZA CLA /ARE WE IN AN ASECT? TAD CURSCT /NO, . IS RELATIVE TO SECT DCA TRMREL /YES, . IS ABSOLUTE TAD PC DCA TRMABS DCA TRMCOD JMP I $DOT
DBLQ, TAD (100 CNTCON, TAD QQ77 DCA TMP /SAVE MASK JMS I QQGETKAR /GET CHAR FOLLOWING " OR ^" JMP I (ER60 /DANGLING OPERATOR (" OR ^") AND TMP /AND WITH 177 FOR ", OR AND WITH 77 FOR ^" DCA TMP TAD I (ENABWD CMA /ISOLATE 'BIT' BIT AND QQ200 /1 NOW MEANS 8-BIT TAD TMP /ADD HIGH-ORDER BIT (0 OR 1) INTO WORD DCA TRMABS JMS I QQGETCHR JMP I (ABS1
GENLNC, TAD I (REFABS DCA I (LITABS TAD I (REFREL DCA I (LITREL TAD I (REFCOD DCA I (LITCOD JMS I (LITSRCH CURPAG-1 CIA TAD QQ200 TAD LITPAG DCA I (REFABS TAD CSTYPE TAD QM10 SZA CLA TAD CURSCT DCA I (REFREL TAD CLTLOC SNA JMP 1$ CIA CLL TAD I (REFABS SZL CLA JMP 2$ 1$: TAD I (REFABS DCA CLTLOC 2$: DCA I (REFCOD JMP I (LNKPT2 PAGE
/*** CHECK 'PARSYM' TO MAKE SURE THERE ARE NO SIDE AFFECTS DFLG, 0 /0 IF A DECIMAL OVERRIDE GETNUM, 0 DCA NUM DCA DNUM /DO DECIMAL ARITHMETIC ON SIDE DCA RADFLG NUM1, JMS I (DIGIT /IS IT A DIGIT? JMP NOTDIG /NO, MUST BE AT END OF NUMBER TAD CHAR AND (17 DCA N TAD N CLL CMA TAD I (RADXWD SNL CLA ISZ RADFLG /SET RADFLG IF DIGIT IS GE RADIX TAD I (RADXWD CIA DCA KNT TAD NUM ISZ KNT JMP .-2 TAD N /ADD IN NEW DIGIT DCA NUM /TO GET NEXT PARTIAL VALUE TAD DNUM /JUST IN CASE THERE'S A DOT AT THE END CLL RTL /DO DECIMAL CALCULATION TOO TAD DNUM / X 5 CLL RAL / X 10 TAD N DCA DNUM JMS I QQGETCHR JMP NUM1 NOTDIG, TAD CHAR /LOOK AT NEXT CHARACTER TAD (-56 /. DCA DFLG TAD DFLG SZA CLA /IS IT A DOT? JMP NOTDOT /NO JMS I QQGETCHR /YES TAD DNUM /INTERPRET AS DECIMAL JMP I GETNUM /RETURN DECIMAL INTERPRETATION IN AC
NOTDOT, TAD I (HLDRAD SNA CLA JMS DOLCHK /DON'T ALLOW $ IF SAW ^O OR ^D JMP NOTDEC /COULD FALL INTO IT JMP I (GOTSYM DOLCHK, 0 TAD CHAR TAD (-44 MAGI, SZA CLA /IS IT A $? JMP I DOLCHK /NO JMS I QQGETCHR /PASS IT UP TAD MAGI /YES, CREATE SPECIAL NAME (7640) DCA NAME1 /CREATE MAGIC NAME OUT OF THIS NUMBER TAD DNUM /USING ITS DECIMAL REPRESENTATION DCA NAME2 TAD (44 /PUT "$" AT END DCA NAME3 TAD TAGLOC /? SNA /? JMS I QQERROR /PROBABLY CAN'T OCCUR DCA QUAL /*** SET NAME4? /+HANDLE SIDE-AFFECTS /+SET LOCAL BIT ISZ DOLCHK JMP I DOLCHK /TAKE SPECIAL RETURN / HLDRAD=0 MEANS ALLOW $ AT END
NOTDEC, TAD RADFLG /NOT DECIMAL SZA CLA /DID WE SEE ANY DIGITS WHICH WERE TOO LARGE? ER34, JMS I QQERROR /YES - ERROR, BAD DIGIT FOR THIS RADIX TAD NUM /NO, RETURN RADICAL INTERPRETATION OF THIS NUMBER JMP I GETNUM /IN AC DNUM, 0 /DECIMAL VALUE OF NUMBER
OPENA, TAD I (PRVOPR TAD (-5 SNA CLA /WAS LAST OP SPACE OR TAB? JMP I (ENDEXP /YES, IT'S NOT AN 'OR' IN THIS CONTEXT JMS I (PUSHL /PUSH OLD CONTEXT PEX1 JMS I QQEXPR /CALL EXPRESSION STUFF RECURSIVELY DCA TRMABS /GOT RESULT OF EXPRESSION TAD EXPREL DCA TRMREL TAD EXPCOD DCA TRMCOD JMS I (POPL /POP BACK ORIGINAL CONTEXT PEX2 TAD CHAR TAD (-76 /CLOSE ANGLE BRACKET SZA CLA /DID WE FIND MATCHING CLOSE? ER41, JMS I QQERROR /NO MATCHING CLOSE ANGLE BRACKET JMS I QQGETCHR /PASS UP CLOSE ANGLE BRACKET / JMS I QQFSCHEK /DON'T ALLOW FSECTABILITY YET TAD TRMABS DCA DNUM TAD TRMCOD TAD TRMREL SNA CLA JMS DOLCHK /IF EXPRESSION IS ABSOLUTE, ALLOW <N>$ TO BE LOCAL SYMBOL JMP I (PREFIX JMP I (GOTSYM /IF $
N, $EDF, 0 DCA TRMABS DCA TRMREL STL RTL DCA TRMCOD JMP I $EDF MOREP, TAD PASS TAD (-4 SNA CLA JMS I (MORCRF JMP I (PREFIX RADFLG, /NON-ZERO MEANS SAW DIGIT GE RADIX $XEDF, 0 JMS I (HA JMS I (XXEDF JMP I $XEDF PAGE
OPENP, TAD CSTYPE TAD QM10 SZA CLA JMP 1$ TAD PC AND (7600 SNA CLA /*** NOTE BUG IF TRY TO USE ) IN SUCH A CASE JMP OPENB /IN AN ASECT TREAT THIS ( LIKE A [ IF PC<200 1$: JMS PROPEN JMS LITSRCH /SEARCH LITERAL TABLE CURPAG-1 /FOR CURRENT PAGE LITERAL CIF 20 /AC NON-0 JMS I (KLU11 TAD (-51 /) LITCMN, TAD CHAR /DID WE FIND MATCHING CLOSE PAREN QQBRACKET]? SNA CLA JMS I QQGETCHR /YES, SKIP IT STA TAD PASS SNA CLA ISZ UNDEF /LITERALS ARE UNDEFINED ON PASS 1 DCA ZFLAG JMP I (MOREP /END OF LITERAL OPENB, JMS PROPEN JMS LITSRCH /SEARCH FOR LITERAL PAGE0-1 /IN PAGE 0 LITERAL TABLE TAD (-1 DCA TRMABS /PAGE 0 LITERALS FLOW UPWARD TAD I (ZSECTN SNA /ANY LITERALS GENERATED YET? JMS ZSCTG /NO, GENERATE NEW SECT /OR GENERATE PAGE 0 LITERAL IN UNNAMED SECT CIF 20 JMP I (KLU8 ZSCTG, 0 JMS I (LOAD AUXOVR+31 JMS I (ZSECTG JMP I ZSCTG CNVCNV, 0 JMS I (CNVADR CIF 20 JMP I CNVCNV
COMN, TAD TRMABS DCA ZLTLOC /REMEMBER WHERE WE LAST GENERATED A PAGE 0 LITERAL LITKOM, TAD (-135 /] JMP LITCMN /*** FSECT LITERALS BEHAVE DIFFERENTLY /MAJOR NOTE: IF THE METHOD OF STORING LITERALS IS CHANGED /TO STORING THE LSD NUMBERS (8-BIT) INSTEAD OF THE 15-BIT PTRS /THEN THERE WILL BE AN EXTRA 4 BITS LEFT, IN WHICH CASE /WE COULD ALLOW FSECT RELOCATABLE EXPRESSIONS IN A LITERAL. /BUT IS THERE ANY USE FOR SUCH A THING?
PROPEN, 0 JMS I (PUSHL PEX1 JMS I QQEXPR DCA LITABS TAD EXPREL DCA LITREL TAD EXPCOD DCA LITCOD JMS I (POPL /RESTORE CONTEXT PEX2 JMP I PROPEN
/ JMS LITSRCH / PAGE-1 / /CALLED WITH LITERAL VALUE IN LITABS,LITREL,LITCOD / -2 MEANS LITERAL ALREADY OUTPUT /LITERAL TABLE CONTAINS PAIRS: / (I) SECT (-1 MEANS END OF TABLE) / (II) VALUE /IT RETURNS THE ENTRY NUMBER INTO THE TABLE /*** MUST RE-INITIALIZE -1 AFTER DUMPING LITERALS LITSRCH,0 TAD LITCOD SZA CLA ER203, JMS I QQERROR DCA TRMCOD TAD I LITSRCH /GET APPROPRIATE TABLE TO SEARCH DCA XR5 ISZ LITSRCH /POINT PAST ARGUMENT DCA LITNUM /INITIALIZE 'LITNUM' TO ZERO LITLUP, CDF 10 ISZ LITNUM /THIS IS THE NEXT LITERAL LOOKED AT TAD I XR5 /GET SECT OF NEXT LITERAL IAC SNA /AT END OF LITERAL TABLE? JMP LNOTFND /YES IAC SNA /LITERAL ALREADY OUTPUT? JMP MISSCT /YES CIA /RESTORE VALUE AND NEGATE IT IAC IAC TAD LITREL /COMPARE WITH SECT OF CURRENT LITERAL SZA CLA /ARE THEY THE SAME? JMP MISSCT /NO, THEREFORE NOT SAME LITERAL TAD I XR5 /GET VALUE OF NEXT LITERAL CIA TAD LITABS /COMPARE AGAINST VALUE OF CURRENT LITERAL SZA CLA /ARE THEY THE SAME? JMP LITLUP /NO LITRET, CDF 0 /YES TAD LITNUM /RETURN ENTRY NUMBER IN AC JMP I LITSRCH
/*** TEST FOR TABLE OVERFLOW LNOTFND,STA TAD XR5 DCA XR5 TAD LITREL DCA I XR5 TAD LITABS DCA I XR5 STA /MARK NEW END OF TABLE DCA I XR5 JMP LITRET MISSCT, ISZ XR5 /SKIP VALUE JMP LITLUP
LITNUM, 0 /ENTRY NUMBER IN LITERAL TABLE LITABS, 0 /VALUE OF CURRENT LITERAL LITREL, 0 LITCOD, 0
$NARGS, 0 / CDF 10 /SHOULD CHECK WE'RE IN MGET / TAD I (STREAM / CDF 0 / TAD (-MGET / SZA CLA / JMS I QQERROR CDF 10 TAD I (MARGS CDF 0 DCA TRMABS DCA TRMREL DCA TRMCOD JMP I $NARGS PAGE



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search