TITLE 'CS-B00,08/22/73,DWG702985' SYSTEM SIG7F CSECT 1 PCC 0 CONTROL CARDS NOT PRINTED. CS@ RES 0 ORIGIN OF CODESTRINGER MODULE. * * REF'S AND DEF'S * DEF CS@ = START OF CS MODULE. DEF CS1 ENTER TO CODESTRING ALL OF IMAGE. DEF CSN ENTER TO CODESTRING PART OF IMAGE. DEF CSZ ENTER TO FINISH CODESTRING. DEF ERLSCAN ENTER TO PRODUCE LINE-SCAN ERROR. DEF RESXTEND RESUME AFTER CALLING INPXTEND. SPACE 3 * REFS TO PROCEDURE: REF GIVEBACK TO GIVE BACK UNUSED WDS OF DATA BLK. REF CMDREC COMMAND RECOGNIZER. REF DELCK ON DEL, GO TO FUNDEF MODULE FOR CKS. REF LSCANERR LINE-SCAN ERROR ROUTINE. REF ERXEQ LINE-SCAN ERR ATTEMPTING 'EXECUTE'. REF CSERRH HANDLE CODESTRING ERROR. REF DREF DE-REFERENCES BAD CODESTRING BLK. REF ACQNXCC ACQUIRE NEXT CHAR AND ITS CODE. REF ACQNB ACQUIRE NON-BLANK CHAR AND ITS CODE. REF ACQNXNB ACQ NEXT NON-BLANK & ITS CODE. REF ACQCONST TRIES TO ACQUIRE A CONSTANT. REF ACQNAME ACQUIRES A NAME. REF ALOCNONX ALLOCS DATA BLK, HEADER + N WDS. REF GARBCOLL GARBAGE COLLECTOR. REF BCONTOFF EXIT IN CASE OF HANG-UP DURING REF INPXTEND INPUT FOR LINE EXTENSION. SPACE 2 * REFS TO CONTEXT: REF LINKCS LINKAGE TO CODESTRINGER. REF MODE INPUT MODE. REF CURRCS CODESTRING DATA BLOCK PTR (HDR+2). REF STATEPTR PTS AT TOP STATE-ENTRY IN STACK. REF IMAGE INTERNAL CHAR IMAGE OF INPUT LINE. REF BREAKFLG SET NEG. IF HANG-UP OCCURS. REF ERRCOL BYTE ADDR.OF ERR DETECTION COLUMN. REF HICOL BYTE ADDR.OF NEWLINE'S COL. IN IMAGE REF OFFSETK PTR TO CODE DESIG BEFORE CONSTANT. REF OFFSET PTR TO CODE DESIG (USUALLY LATEST). REF CONSTKEY BYTE ADDR.OF 1ST CHAR OF CONSTANT. REF CONSTBUF CONSTANT BUFFER. REF CONSTTYP TYPE OF CONSTANT. REF QCNT ODD IF 1ST IMAGE HAS UNBALANCED 'S. REF FREETBL PTS AT 1ST FREE LOC FOR NEW DATA BLK REF BLKWANTD ACTUAL SIZE ALLOCATED FOR LATEST DB. REF SYMT PTS AT 1ST WD OF SYMBOL TABLE. REF SYMTSIZE NO.OF SYMBOL TABLE ENTRIES. SPACE * REFS TO CONSTANTS: REF X1FFFF X'1FFFF' REF F0F9 '0','9' REF NONAME 10,138 = CODE DESIGS NOT NAME-CHARS SPACE REFS TO ERROR I.D. EQU'S: * SPACE REF IDSYMFUL SYM TBL FULL. REF IDWSFULL WS FULL. * * STANDARD EQU'S * REGISTERS R1 EQU 1 R2 EQU 2 R3 EQU 3 R4 EQU 4 R5 EQU 5 R6 EQU 6 R7 EQU 7 R8 EQU 8 R9 EQU 9 R10 EQU 10 R11 EQU 11 R12 EQU 12 R13 EQU 13 R14 EQU 14 R15 EQU 15 * * CODESTRING DESIGNATORS * BYNCODE EQU 10 BYTE-FORM INTEGER SCALAR (10 - 255). INTGCODE EQU 11 WORD-FORM INTEGER SCALAR. REALCODE EQU 12 REAL SCALAR. TEXTCODE EQU 13 TEXT SCALAR. VLCODE EQU 14 LOGICAL VECTOR. VICODE EQU 15 INTEGER VECTOR. VRCODE EQU 16 REAL VECTOR. VTXCODE EQU 17 TEXT VECTOR. VTXLCODE EQU 18 LONG TEXT VECTOR (EXCEEDS 255 CHARS) ERRCODE EQU 19 ERROR. LAMPCODE EQU 20 COMMENT NAMECODE EQU 23 NAME (BUT NOT STOP OR TRACE NAME). BOSCODE EQU 37 BEGINNING-OF-STMT. MONADIC EQU 50 1ST MONADIC OPERATOR. DOMCODE EQU 80 DOMINO OPERATOR. DYADIC EQU DOMCODE 1ST DYADIC OPERATOR. BANGCODE EQU 101 EXCLAMATION POINT OPERATOR. COLNCODE EQU 135 COLON. DMYCODE EQU 138 DUMMY. * * OTHER EQU'S * NEWLINE EQU X'15' END MARK. EFLAG EQU X'10000' 'EXECUTE' FLAG FOR QUAD-STATE. TYPECS EQU 7 CODESTRING TYPE OF DATA BLOCK. * * DOUBLEWORD CONSTANTS * BOUND 8 ZEROONE DATA 0,1 ZERONINE DATA 0,9 POSSMON DATA DOMCODE,BANGCODE CODESTR.OPS CONVERTIBLE TO MONADICS. PAGE ************************************************************************ * * * EASY AND SPECIAL DEFINITIONS FOR CODESTRINGING. * * * * THESE DEFINE A VALUE FOR EACH 'IN2CODE' CHARACTER IN THE * * RANGE BETWEEN -- COMMENT (LAMP) AND COLON. * * THE VALUES ARE ORDERED AND ARE ASSOCIATED WITH: * * LC4TBL -- LEFT CONTEXT ASSIGNMENTS * * ITEMCNTX -- SCAN ITEM CONTEXT (FOR CONTACT ANALYSIS) * * CSV -- A VECTORED TABLE WITHIN THE CODESTRING * * ROUTINE. * * * EASY EQU 0 EASILY HANDLED SCAN ITEMS QUADS EQU EASY SEMICOLN EQU QUADS+1 LBRACKET EQU SEMICOLN+1 RBRACKET EQU LBRACKET+1 LPAREN EQU RBRACKET+1 RPAREN EQU LPAREN+1 BRANCH EQU RPAREN+1 ASSIGN EQU BRANCH+1 SMCIRCLE EQU ASSIGN+1 SPECIAL EQU SMCIRCLE+1 SPECIALLY HANDLED SCAN ITEMS BLANK EQU SPECIAL DEL EQU BLANK+1 NEGATIVE EQU DEL+1 QUOTE EQU NEGATIVE+1 COMMENT EQU QUOTE+1 ENDMARK EQU COMMENT+1 DOT EQU ENDMARK+1 COP EQU DOT+1 (OP MAY TAKE COORDINATE SPECIFICTN.) OP EQU COP+1 BAD EQU OP+1 BAD SCAN ITEMS PAGE ************************************************************************ * * * SCANITEM -- A TABLE OF BYTES. THERE IS A BYTE CORRESPONDING TO * * EACH 'IN2CODE' CHARACTER VALUE BETWEEN COMMENT (LAMP) AND * * COLON. IT IS CONSIDERED IMPOSSIBLE TO OBTAIN SCAN ITEMS * * OUTSIDE THIS RANGE (DIGITS AND NAME-START CHARS ARE DEALT * * WITH SEPARATELY). NOT ALL VALUES WITHIN THIS RANGE ARE * * POSSIBLE EITHER--SUCH ENTRIES ARE MARKED WITH AN ASTERISK * * IN THE COMMENTS FIELD. * * THE VALUE CONTAINED IN EACH BYTE OF THE TABLE IS DEFINED * * BY THE EASY AND SPECIAL DEFINITIONS ABOVE. * * * * HEX OF * * VALUE INTERNAL INTERNAL CHARACTER * * FORM * * -------- --- ---------------------------------- * * * SCANITEM DATA,1 COMMENT @ 20 COMMENT (LAMP) DATA,1 BAD @ 21 * DATA,1 BAD @ 22 * DATA,1 BAD @ 23 * DATA,1 BAD @ 24 UNUSED DATA,1 QUADS @ 25 QUAD+0 DATA,1 QUADS @ 26 QUAD-1 DATA,1 QUADS @ 27 QUAD-2 DATA,1 QUADS @ 28 QUAD-3 DATA,1 QUADS @ 29 QUAD-4 DATA,1 QUADS @ 30 QUAD-5 DATA,1 QUADS @ 31 QUAD-6 DATA,1 QUADS @ 32 QUAD-7 DATA,1 QUADS @ 33 QUAD-8 DATA,1 QUADS @ 34 QUAD-9 DATA,1 QUADS @ 35 QUAD DATA,1 QUADS @ 36 QUOTE-QUAD DATA,1 BAD @ 37 * DATA,1 SEMICOLN @ 38 SEMICOLON DATA,1 LBRACKET @ 39 LEFT BRACKET DATA,1 RBRACKET @ 40 RIGHT BRACKET DATA,1 LPAREN @ 41 LEFT PAREN DATA,1 RPAREN @ 42 RIGHT PAREN DATA,1 BRANCH @ 43 BRANCH ARROW DATA,1 ASSIGN @ 44 ASSIGN ARROW DATA,1 DOT @ 45 DOT OR DECIMAL PT DATA,1 SMCIRCLE @ 46 SMALL CIRCLE DATA,1 BAD @ 47 UNUSED DATA,1 BAD @ 48 UNUSED DATA,1 BAD @ 49 UNUSED DATA,1 ENDMARK @ 50 END-OF-INPUT (KEY CHAR) DATA,1 BLANK @ 51 BLANK (KEY CHAR) DATA,1 QUOTE @ 52 QUOTE (KEY CHAR) DATA,1 BAD @ 53 * DATA,1 BAD @ 54 * DATA,1 BAD @ 55 * DATA,1 BAD @ 56 * DATA,1 BAD @ 57 * DATA,1 BAD @ 58 * DATA,1 BAD @ 59 * DATA,1 BAD @ 60 * DATA,1 BAD @ 61 * DATA,1 BAD @ 62 * DATA,1 BAD @ 63 * DATA,1 BAD @ 64 * DATA,1 BAD @ 65 * DATA,1 BAD @ 66 * DATA,1 BAD @ 67 * DATA,1 BAD @ 68 * DATA,1 BAD @ 69 * DATA,1 BAD @ 70 * DATA,1 BAD @ 71 BAD CHAR (KEY CHAR) DATA,1 BAD @ 72 UNUSED DATA,1 BAD @ 73 UNUSED DATA,1 OP @ 74 I-BEAM DATA,1 OP @ 75 GRADE-UP DATA,1 OP @ 76 GRADE-DOWN DATA,1 OP @ 77 NOT DATA,1 OP @ 78 UNUSED DATA,1 OP @ 79 UNUSED DATA,1 OP @ 80 MATRIX-DIVIDE DATA,1 OP @ 81 ROLL OR DEAL DATA,1 OP @ 82 T-BAR DATA,1 OP @ 83 COMPRESS OR REDUCE ON 1ST COORD DATA,1 COP @ 84 COMPRESS OR REDUCE DATA,1 OP @ 85 IOTA DATA,1 OP @ 96 RHO DATA,1 COP @ 87 COMMA DATA,1 OP @ 88 REVERSE OR ROTATE ON 1ST COORD DATA,1 COP @ 89 REVERSE OR ROTATE DATA,1 OP @ 90 TRANSPOSE DATA,1 OP @ 91 PLUS DATA,1 OP @ 92 MINUS DATA,1 OP @ 93 TIMES DATA,1 OP @ 94 DIVIDE DATA,1 OP @ 95 EXPONENT DATA,1 OP @ 96 LOG DATA,1 OP @ 97 CIRCLE DATA,1 OP @ 98 MAX OR CEILING DATA,1 OP @ 99 MIN OR FLOOR DATA,1 OP @100 ABSOLUTE OR RESIDUE DATA,1 OP @101 EXCLAMATION PT DATA,1 OP @102 LESS THAN DATA,1 OP @103 LESS THAN OR EQUAL DATA,1 OP @104 GREATER THAN DATA,1 OP @105 GREATER THAN OR EQUAL DATA,1 OP @106 NOT EQUAL DATA,1 OP @107 EQUAL DATA,1 OP @108 AND DATA,1 OP @109 OR DATA,1 OP @110 NAND DATA,1 OP @111 NOR DATA,1 OP @112 UNUSED DATA,1 OP @113 UNUSED DATA,1 OP @114 DECODE DATA,1 OP @115 ENCODE DATA,1 OP @116 TAKE DATA,1 OP @117 DROP DATA,1 OP @118 EXPAND ON 1ST COORD DATA,1 COP @119 EXPAND DATA,1 OP @120 EPSILON DATA,1 BAD @121 UNUSED DATA,1 BAD @122 UNUSED DATA,1 BAD @123 DIERESIS DATA,1 NEGATIVE @124 NEGATIVE SIGN DATA,1 BAD @125 UNDERSCORE DATA,1 BAD @126 DOLLAR SIGN DATA,1 BAD @127 ALPHA DATA,1 BAD @128 OMEGA DATA,1 DEL @129 DEL DATA,1 DEL @130 LOCKED DEL DATA,1 BAD @131 LEFT CUP DATA,1 BAD @132 RIGHT CUP DATA,1 BAD @133 CAP DATA,1 BAD @134 CUP DATA,1 BAD @135 COLON * BOUND 4 INSURE WORD BOUNDARY AFTER SCANITEM * PAGE ************************************************************************ * * * LCBITS -- LEFT CONTEXT BITS. EACH ENTRY SIGNIFIES A LEFT CONTEXT * * ASSOCIATED WITH AN ITEM DESCRIBED IN THE COMMENTS FIELD. * * BIT ENTRY (FOR M -- WHICH MUST BE MOST SIGNIFICANT). * * * * NOTE -- IT IS ESSENTIAL THAT NO LEFT CONTEXT BIT REACH * * BIT POSITION 16. * LCBITS EQU 1 LEFT CONTEXT BIT SETTINGS D EQU LCBITS DOT B EQU D**1 BRANCH A EQU B**1 ASSIGN RO EQU A**1 RPAREN OR SMALL CIRCLE LB EQU RO**1 LBRACKET RB EQU LB**1 RBRACKET ZC EQU RB**1 ENDMARK OR COMMENT S EQU ZC**1 SEMICOLN LQ EQU S**1 LPAREN OR QUADS CN EQU LQ**1 CONSTANT OR NAME O EQU CN**1 OPERATOR M EQU O**1 MONADIC IMPLIED (M MUST HAVE THE * HIGHEST BIT SETTING) PAGE ************************************************************************ * * * 'LC4' DEFINITIONS * * DEFINES A LEFT CONTEXT FOR ITEMS DESCRIBED IN THE COMMENTS * * FIELD. * * * * THE PRESENCE OF A PARTICULAR BIT INDICATES THAT LEFT CONTEXT * * IS CORRECT FOR A SCAN ITEM (SEE ALSO 'ITEM' DEFINITIONS, * * BELOW) HAVING MATCHING BIT SET. * * * * THE M BIT POSITION IMPLIES THAT THE SCAN ITEM IS A MONADIC * * OPERATOR IF IT HAPPENS TO BE AN OPERATOR AT ALL. * * * LC4STNAM EQU A STOPNAME OR TRACENAME LC4NAME EQU O+CN+LQ+S+ZC+RB+LB+RO+A ORDINARY NAME LC4RB EQU O+CN+LQ+S+ZC+RB+LB+RO+A RIGHT BRACKET LC4QUADS EQU O+CN+S+ZC+RB+LB+RO+A QUADS LC4CONST EQU O+CN+S+ZC+RB+LB+RO CONSTANT LC4RP EQU O+CN+S+ZC+RB+LB+RO RIGHT PAREN LC4SEMI EQU M+O+CN+LQ+S+ZC+RB+B SEMICOLON LC4BOS EQU M+O+CN+LQ+S+ZC+B BEGINNING-OF-STMT LC4BRNCH EQU M+O+CN+LQ+S+ZC BRANCH LC4LB EQU M+O+CN+LQ+S+RB LEFT BRACKET LC4COP EQU M+O+CN+LQ+LB COORDINATIBLE OPERATOR LC4OP EQU M+O+CN+LQ+D OPERATOR LC4ASS EQU M+O+CN+LQ ASSIGN LC4LP EQU M+O+CN+LQ LEFT PAREN LC4DOT EQU O DOT (NOT DEC.PT.) LC4SMCRC EQU D SMALL CIRCLE LC4ALL EQU X'7FFF' BAD CHAR (ALL SCAN ITEMS ACCEPTED) PAGE ************************************************************************ * * * LC4TBL -- ORDERED TABLE OF HALFWORDS USED TO ASSIGN A LEFT CONTEXT * * SETTING FOR THE ITEM DESCRIBED IN THE COMMENTS FIELD. * * (SEE 'EASY' AND 'SPECIAL' DEFINITIONS FOR ASSOCIATION OF * * THE CHOSEN ORDERING.) * * * LC4TBL DATA,2 LC4QUADS @ QUADS DATA,2 LC4SEMI @ SEMICOLON DATA,2 LC4LB @ LEFT BRACKET DATA,2 LC4RB @ RIGHT BRACKET DATA,2 LC4LP @ LEFT PAREN DATA,2 LC4RP @ RIGHT PAREN DATA,2 LC4BRNCH @ BRANCH DATA,2 LC4ASS @ ASSIGN DATA,2 LC4SMCRC @ SMALL CIRCLE DATA,2 0 @ (BLANK DOESN'T AFFECT LEFT CONTEXT) DATA,2 0 @ DEL (SHOULD OPEN OR CLOSE FUNCTION) DATA,2 0 @ NEGATIVE SIGN (CONTEXT SET SPECIAL) DATA,2 LC4CONST @ QUOTE (I.E. TEXT CONSTANT) DATA,2 ITEMEND @ COMMENT (ENDMARK GUARANTEED NEXT) DATA,2 LC4ALL @ (ENDMARK DOESN'T HAVE LEFT CONTEXT) DATA,2 LC4DOT @ DOT DATA,2 LC4COP @ COP DATA,2 LC4OP @ OP * BOUND 4 INSURE WORD BOUNDARY AFTER LC4TBL * PAGE ************************************************************************ * * * 'ITEM' DEFINITIONS * * DEFINES A CURRENT CONTEXT FOR A SCAN ITEM DESCRIBED IN THE * * COMMENTS FIELD. * * * * THE SCAN ITEM IS IN PROPER CONTEXT (I.E. CONTACT ANALYSIS * * FOR CODESTRINGING) IF A MATCHING BIT OCCURS IN THE LEFT * * CONTEXT SETTING MOST RECENTLY ESTABLISHED. * * * * THE M BIT POSITION IS USED TO DETERMINE IF LEFT CONTEXT * * IMPLIES THAT AN OPERATOR (ITEMOPER) IS MONADIC. * * * ITEMOPER EQU M+O ANY OPERATOR ITEMCNST EQU CN CONSTANT ITEMNAME EQU CN NAME ITEMQUAD EQU LQ QUADS ITEMLP EQU LQ LEFT PAREN ITEMSEMI EQU S SEMICOLON ITEMEND EQU ZC END-OF-INPUT ITEMLAMP EQU ZC COMMENT ITEMRB EQU RB RIGHT BRACKET ITEMLB EQU LB LEFT BRACKET ITEMSMCR EQU RO SMALL CIRCLE ITEMRP EQU RO RIGHT PAREN ITEMASS EQU A ASSIGN ITEMBRCH EQU B BRANCH ITEMDOT EQU D DOT ITEMBAD EQU 0 BAD CHAR (NO LEFT CONTEXT MATTERS) ITEMDEL EQU ZC DEL ITEMBLNK EQU X'7FFF' BLANK (ANY LEFT CONTEXT IS OK) PAGE ************************************************************************ * * * ITEMCNTX -- ORDERED TABLE OF HALFWORDS USED TO ESTABLISH CURRENT * * CONTEXT FOR A SCAN ITEM DESCRIBED IN THE COMMENTS FIELD. * * (SEE 'EASY' AND 'SPECIAL' DEFINITIONS FOR ASSOCIATION OF * * THE CHOSEN ORDERING.) * * * ITEMCNTX DATA,2 ITEMQUAD QUADS @ DATA,2 ITEMSEMI SEMICOLON @ DATA,2 ITEMLB LEFT BRACKET @ DATA,2 ITEMRB RIGHT BRACKET @ DATA,2 ITEMLP LEFT PAREN @ DATA,2 ITEMRP RIGHT PAREN @ DATA,2 ITEMBRCH BRANCH @ DATA,2 ITEMASS ASSIGN @ DATA,2 ITEMSMCR SMALL CIRCLE @ DATA,2 ITEMBLNK BLANK @ DATA,2 ITEMDEL DEL OR LOCKED DEL @ DATA,2 ITEMCNST NEGATIVE SIGN @ DATA,2 ITEMCNST QUOTE @ DATA,2 ITEMLAMP COMMENT @ DATA,2 ITEMEND ENDMARK @ DATA,2 ITEMDOT|ITEMCNST DOT OR DECIMAL PT @ DATA,2 ITEMOPER COP @ DATA,2 ITEMOPER OP @ DATA,2 ITEMBAD BAD @ * BOUND 4 INSURE WORD BOUNDARY AFTER ITEMCNTX * CSTEXT STW,R7 OFFSET SAVE POS OF LATEST CODE DESIGNATOR. CSTCHAR AI,R1 1 PT AT NEXT INTERNAL CHAR. LB,R2 0,R1 GET IT. CI,R2 '''' CK FOR QUOTE MARK. BNE CSTXMARK NO. AI,R1 1 YES, LOOK AHEAD IN CASE DBL-QUOTE. LB,R2 0,R1 CI,R2 '''' BE CSTXMARK DBL-QUOTE, USE 2ND QUOTE. LI,R3 TEXTCODE END TEXT, ASSUME TEXT SCALAR. LW,R12 R7 = POS OF LAST ITEM STRUNG. SW,R12 OFFSET = SIZE OF TEXT STRUNG. CI,R12 1 JUST ONE MARK... BE CSTEXIT YES, IT IS A TEXT SCALAR. LI,R3 VTXCODE NO, ASSUME (ORDINARY) TEXT VECTOR. CI,R12 X'FF' IS SIZE BYTE-SIZE... BLE CSLENGTH YES. LI,R3 VTXLCODE NO, USE LONG TEXT VECTOR DESIGNATOR. SCS,R12 -8 GET MOST SIGNIFICANT BYTE AI,R7 1 AND PUT IT IN STB,R12 *CURRCS,R7 CODESTRING. SCS,R12 8 THEN GET LEAST SIGNIFICANT BYTE. CSLENGTH AI,R7 1 PUT LENGTH BYTE IN CODESTRING. STB,R12 *CURRCS,R7 CSTEXIT BDR,R1 CSSETLC BACK UP ONE CHAR POS AND GO SET * LEFT CONTEXT AND SO FORTH. CSTXMARK AI,R7 1 STRING LATEST TEXT MARK. STB,R2 *CURRCS,R7 CI,R2 NEWLINE WAS IT END-OF-CURRENT LINE... BNE CSTCHAR NO, TRY NEXT CHAR. LI,R11 0 YES, EXTENSION NEEDED. STW,R11 CONSTKEY RESET PTR TO KEY CHAR OF CONSTANT. STW,R7 OFFSETK SAVE CURRENT CODESTRING OFFSET. B INPXTEND INPUT THE NEXT IMAGE FOR EXTENSION; RESXTEND LW,R11 BREAKFLG AFTER RESUMING, TEST FOR HANG-UP... BLZ HANGUP YES. LW,R11 HICOL NO. AI,R11 1-BA(IMAGE) = NO.OF CHARS TO CODESTRING. SLS,R11 1 DBL TO GET NO.OF WDS FOR THAT STUFF. LW,R2 CURRCS PT AT CURRENT CODESTRING OFFSET WD. INT,R3 -2,R2 = CURRENT SIZE OF DATA BLK. LI,R12 X'7FFFC' COMPUTE APPROXIMATE NO.OF WDS AND,R12 OFFSETK ACTUALLY USED SO FAR. SLS,R12 -2 SW,R12 R3 = - APPX. AMT LEFT OVER IN THAT BLK. AW,R11 R12 = APPX. NEW AMT NEEDED. BLEZ RESUME RESUME IF WE ALREADY HAVE ENUF. AW,R3 R2 PT AT 2ND WD AFTER CURRENT CS BLOCK. SW,R3 FREETBL = (2 - NO.OF WDS BETWEEN CURRENT CS * DATA BLK & 1ST FREE LOC) OR * = 2 - SIZE OF LONG-NAME DATA BLKS * THAT FOLLOW CURRENT CODESTR. * NOTE -- ONLY LONG-NAME DATA BLKS COULD FOLLOW SINCE THE ODD QCNT * FORCED GARBAGE COLLECTION PRIOR TO CODESTRING DB ALLOCATION * AND THEY ARE THE ONLY DATA BLKS ALLOCATED WHILE CODESTRINGING * BAL,R14 ALOCNONX ALLOC NEW AMT, IF POSSIBLE... B WSFULLN OOPS -- WS FULL. LW,R11 BLKWANTD OK, GET SIZE ACTUALLY ADDED. AWM,R11 -2,R2 ADD THAT TO CODESTR. DATA BLK HDR. AI,R3 -2 = - SIZE OF ANY LONG-NAME DATA BLKS. BEZ RESUME NONE BARRING CODESTRING EXTENSION. STW,R4 CONSTBUF+1 SOME, SAVE PTR TO WD AFTER LAST ONE. AW,R4 R3 PT AT 1ST WD OF 1ST LONG NAME DATA * BLK BARRING CODESTRING EXTENSION. STW,R4 CONSTBUF NOW CONSTBUF IS A DBLWD THAT BOUNDS * THE LONG NAME DATA BLOCK BARRIER. * ALSO, CONSTBUF ITSELF ACTS AS A * SOURCE-BOUNDARY FOR MOVING THE BAR AW,R4 BLKWANTD COMPUTE THE DESTINATION-BOUNDARY FOR STW,R4 CONSTBUF+2 MOVING THE BARRIER & SAVE IT. LCW,R3 R3 = SIZE OF BARRIER. READY TO MOVE * THE LONG-NAME DATA BLOCKS TO THE * END OF THE NEW ALLOCATION, WORK * FROM HI END TO LO END OF THE * BARRIER WHEN MOVING IT. MOVEQ AI,R3 -15 DO 15 WDS REMAIN TO MOVE... BGEZ MOVE15 YES, MOVE THE HI 15 STILL REMAININ AI,R3 15 NO, GET SMALL AMT LEFT; SHIFT FOR SCS,R3 -4 ADDR = 0 & AMT IN BITS 0-3, AND LC R3 PUT AMT IN CONDITION CODE. B MOVE MOVE15 LCI 15 SET TO MOVE HIGHEST 15 REMAINING. MOVE LM,R4 *CONSTBUF,R3 GET WDS ACCORDING TO SOURCE-BOUND. STM,R4 *CONSTBUF+2,R3 STORE ACCORDING TO DESTINATION-BOUND AND,R3 X1FFFF TEST FOR ANY AMT REMAINING TO MOVE. BGZ MOVEQ KEEP MOVING IF ANY REMAIN. LW,R1 SYMT DONE. PT AT 1ST WD OF SYMBOL TBL. LI,R6 0 SET FOR SELECTIVE LOADS. LI,R7 X'1FFFF' LW,R11 BLKWANTD GET SIZE ADDED (FOR DISPLACEMENTS). LI,R14 20 = MAX NO. OF WDS PER NAME. LW,R2 SYMTSIZE = NO.OF SYMBOL TABLE ENTRIES. AI,R1 1 PT AT 1ST NAME-INDICATOR WD ON SYMT. SYMLOOK CB,R14 *R1 IS THIS A LONG OR SHORT NAME... BL NEXTSYM SHORT, SKIP IT. LS,R6 0,R1 LONG, GET ITS LONG-NAME PTR. CLM,R6 CONSTBUF IN RANGE OF LONG-NAME BLKS JUST HIT. BCS,9 NEXTSYM NO, GO ON TO NEXT SYM TBL ENTRY. AWM,R11 0,R1 YES, DISPLACE BY SIZE ADDED. NEXTSYM AI,R1 2 PT AT NEXT SYMBOL TABLE ENTRY BDR,R2 SYMLOOK AND LOOP TILL DONE. RESUME LI,R1 BA(IMAGE)-1 PT JUST BEFORE 1ST NEW IMAGE CHAR. LW,R7 OFFSETK RESTORE CODESTRING OFFSET. LI,R5 QUOTE RESTORE SCAN ITEM INDICATOR. LI,R4 CSACQCK RESET R4 FOR LATER CHAR ACQUISITIONS B CSTCHAR RESUME ADDING TO THE TEXT VECTOR. SYMFULL LI,R8 IDSYMFUL = ERROR I.D. FOR 'SYM TBL FULL'. CSERROUT LI,R7 CSERRH HANDLE CODESTRING ERROR B THROWOUT AFTER THROWING CODESTRING AWAY. WSFULLN LI,R8 IDWSFULL = ERROR I.D. FOR 'WS FULL'. B CSERROUT WSFULLC LI,R8 IDWSFULL = ERROR I.D. FOR 'WS FULL'. B CSERRH HANDLE CODESTRING ERR (NONE ALLOC'D) HANGUP BAL,R7 THROWOUT THROW CODESTRING AWAY. B BCONTOFF DO LIKE A )CONTINUE CMD. ERLSCAN STW,R1 ERRCOL = BYTE ADDR.OF ERROR PT IN IMAGE. LW,R14 MODE CK FOR FUNCTION DEFINITION MODE. BEZ ERLSCANF YES, COMPLETE (MAYBE FIX) CODESTRING AI,R14 -2 CK FOR EVAL-INPUT MODE. BNEZ ERLSCAND NO. LI,R14 EFLAG MAYBE, CK FOR 'EXECUTE'. CW,R14 *STATEPTR BANZ ERLSCANX YES, PRETEND THAT WE CAN EXECUTE, * BUT WE WILL HIT SYNTAX ERR THEN. ERLSCAND LI,R7 LSCANERR DISPLAY -- LINE-SCAN ERROR -- SOON. THROWOUT LI,R4 0 THROW OUT CURRENT CODESTRING: XW,R4 CURRCS ELIMINATE REFERENCE TO DATA BLK, AI,R4 -2 PT AT ITS HEADER, AND B DREF GO TO ERR ROUTINE AFTER DE-REFING. ERLSCANF LI,R14 LSCANERR EXIT VIA 'LINKCS' TO 'LSCANERR', STW,R14 LINKCS FORGETTING ORIGINAL LINKAGE. ERLSCANX LW,R14 CONSTKEY HAS CONSTANT BEEN STARTED... BEZ ERLSCANT NO, LAST CODE DESIGNATOR IS OK. LW,R1 CONSTKEY YES, PT AT KEY (START) OF LATEST * CONSTANT; WE'LL BACK UP THAT FAR LW,R7 OFFSETK FORGETTING ANY CODESTRING FROM * THAT POINT ON (GOOD OR BAD). ERLSCANT AI,R1 -1 BACK UP 1 CHAR TO COUNTER 'CSCOMC'. LI,R3 ERRCODE = CODESTRING DESIGNATOR FOR ERROR. LI,R5 ENDMARK THIS PREVENTS LOOPING INDEFINITELY * FOR CONTACT ERROR AT THE ENDMARK * (THE ENDMARK IS RE-ACQ'D AND ITS * CONTEXT CK'D BEFORE EXIT BY 'CSZ') LI,R4 CSACQCK RE-SET RETURN FROM 'ACQNXCC'. CSCOMMNT STW,R7 OFFSET SAVE PTR TO LAST ACCEPTED DESIGNATOR CSCOMC AI,R1 1 PEEK AT NEXT CHAR IN IMAGE. LB,R2 0,R1 CI,R2 NEWLINE CK FOR END MARK... BE CSCOMNL YES AI,R7 1 NO, PLANT IT IN CODESTRING. STB,R2 *CURRCS,R7 B CSCOMC CSCOMNL CI,R3 ERRCODE WAS THIS A LINE-SCAN ERROR... BNE CSCOMEND NO, END THE COMMENT. LW,R12 R1 YES, CALC. NO.OF CHARS TO THE RT SW,R12 ERRCOL OF THE ERROR PT. (INCL. ENDMARK) AI,R7 1 PLANT THIS 'ERROR-POINTER' AT THE STB,R12 *CURRCS,R7 SPOT THE END MARK WOULD OCCUPY. CSCOMEND LW,R12 R7 CALC. LENGTH OF CODESTRING SINCE SW,R12 OFFSET LAST ACCEPTED CODESTRING DESIG. B CSLENGTH CSDOTPT AI,R1 1 PEEK AHEAD FOR DIGIT... LB,R13 0,R1 AI,R1 -1 CLM,R13 F0F9 BCR,9 CSPT YES, FRACTION CONSTANT. CI,R12 ITEMDOT NO, CK CONTEXT FOR A DOT. BANZ CSSETLC OK, SET LEFT CONTEXT, STRING, GO ON. B ERLSCAN BAD -- LINE-SCAN ERROR. CSPT RES 0 @ CSNEG RES 0 @ (ASSUME CONSTANT COMING UP). CSNUM CI,R12 ITEMCNST @ CK CONTEXT FOR A CONSTANT ITEM... BANZ CSCNST OK, TRY FOR A CONSTANT. B ERLSCAN BAD -- LINE-SCAN ERROR. CSCNST STW,R7 OFFSETK SAVE CODESTRING OFFSET. STW,R1 CONSTKEY SAVE POS OF 1ST CHAR OF CONST. BAL,R4 ACQCONST @ ACQUIRE CONSTANT (UNLESS FALSE-STRT) BDR,R1 ERLSCAN @ OVERFLOW, PT AT THE LAST CHAR (PROB. * @ A DIGIT) OF NO. -- LINE-SCAN ERROR LW,R7 OFFSETK @ NO O'FLO -- RESTORE OFFSET. AI,R6 -1 TEST LENGTH OF CONSTANT... BEZ CSS 1 -- SCALAR. BLZ ERLSCAN 0 -- FALSE START (NOT NUMBER). AI,R6 1 >1-- VECTOR, R6 = LENGTH AGAIN. LI,R5 0 SET ELEMENT COUNTER. LW,R13 CONSTTYP WHAT TYPE OF VECTOR... CLM,R13 ZEROONE (0 OR 1 MEANS LOGICAL) BCS,9 CSVIR INTEGER OR REAL. LI,R13 VLCODE LOGICAL -- VECTOR-LOGL CODE DESIG. CSLV AI,R7 1 PT AT NEXT BYTE FOR CODESTRING. LI,R14 8 8 BITS PER LOGICAL BYTE VALUE. CSLVN SLS,R8 1 SHIFT TO MAKE ROOM FOR EACH BIT. OR,R8 CONSTBUF,R5 PLUG IN THAT BIT. AI,R5 1 PT AT NEXT ELEMENT, IF ANY. AI,R6 -1 DECR LENGTH. BEZ CSLVD DONE -- LENGTH IS IN R5 NOW. BDR,R14 CSLVN LOOP TILL BYTE FULL. STB,R8 *CURRCS,R7 FULL -- STRING BYTE. B CSLV START A NEW ONE. CSLVS SLS,R8 1 SHIFT TO LEFT JUSTIFY LAST LOGL BYTE CSLVD BDR,R14 CSLVS FINAL LOOP. STB,R8 *CURRCS,R7 STRING LAST LOGL BYTE VALUE. B CSCLEN PLUG IN NO.OF ELEMS. & CODE DESIG. CSDMY LI,R8 DMYCODE DUMMY CODESTRING DESIGNATOR USED TO STB,R8 *CURRCS,R7 FILL OUT TO A WD BOUNDARY. CSWSET AI,R7 1 PT AT NEXT BYTE OF CODESTRING. CI,R7 3 TEST FOR WD BOUND... BANZ CSDMY NOT YET. SLS,R7 -2 NOW -- SHIFT TO WD RESOLUTION. B *R14 EXIT FROM CSWSET. CSVIR BAL,R14 CSWSET SET TO WD BOUNDARY CODESTRING. LW,R13 CONSTTYP WHICH TYPE OF NUMERIC CONSTANT... BGZ CSIV INTEGER VECTOR. LI,R13 VRCODE REAL VECTOR -- CODE DESIGNATOR. LI,R14 CSRVN RETURN FROM 'CSRIWD' TO 'CSRVN'. CSRVN LD,R8 CONSTBUF,R5 GET REAL NUMBER. STW,R8 *CURRCS,R7 STRING MOST SIGNIFICANT WD. AI,R7 1 PT TO NEXT WD IN CODESTRING. B CSRIWD STRING IT AND TEST FOR LAST ELEMENT. CSIV LI,R13 VICODE CODESTRING DESIGNATOR--VECTOR INTG. LI,R14 CSIVN RETURN FROM 'CSRIWD' TO 'CSIVN'. CSIVN LW,R9 CONSTBUF,R5 GET INTEGER. CSRIWD STW,R9 *CURRCS,R7 STRING NUMBER IN R9. AI,R7 1 PT TO NEXT WD OF CODESTRING. AI,R5 1 PT AT NEXT ELEMENT, IF ANY. BDR,R6 *R14 LOOP TILL LAST (THEN R5 = LENGTH). SLS,R7 2 RESUME BYTE BOUNDARY FOR STRINGING. B CSCLENB STRING LENGTH & NO.OF ELEMENTS. CSS LW,R13 CONSTTYP REAL NUMBER... BGEZ CSI NO, INTEGER (INCLUDES LOGICAL). LI,R13 REALCODE SCALAR REAL CODESTRING DESIGNATOR. BAL,R14 CSWSET SET TO WORD BOUNDARY IN CODESTRING. LD,R8 CONSTBUF GET THE REAL NO. STW,R8 *CURRCS,R7 STRING MOST SIGNIFICANT WD. AI,R7 1 PT TO NEXT WD IN CODESTRING. CSSWD STW,R9 *CURRCS,R7 STRING NUMBER IN R9. AI,R7 1 PT TO NEXT WD IN CODESTRING. SLS,R7 2 RESUME BYTE BOUNDARY FOR STRINGING. B CSCCD0 STRING CONSTANT'S CODE DESIGNATOR. CSI LW,R13 CONSTBUF GET THE INTEGER. CLM,R13 ZERONINE IF 0 THRU 9, INTEGER IS ITS OWN BCR,9 CSCCD CODESTRING DESIGNATOR. CI,R13 X'FFF00' WELL, DOES INTG ONLY OCCUPY 1 BYTE BAZ CSIBYTE YEP. LI,R13 INTGCODE NOPE, INTEGER CODE DESIGNATOR. LW,R9 CONSTBUF GET IT AGAIN. LI,R14 CSSWD GO TO 'CSSWD' AFTER B CSWSET SETTING CODESTRING TO WD BOUNDARY. CSIBYTE LI,R13 BYNCODE BYTE-NUMBER CODESTRING DESIGNATOR. LW,R5 CONSTBUF GET THE NO. THAT FITS IN 1 BYTE. CSCLEN AI,R7 1 PT TO NEXT BYTE OF CODESTRING. CSCLENB STB,R5 *CURRCS,R7 PLUG IN LENGTH BYTE OR SMALL INTG. CSCCD AI,R7 1 PT TO NEXT BYTE OF CODESTRING. CSCCD0 STB,R13 *CURRCS,R7 PLUG IN CODESTRING DESIGNATOR. LI,R12 LC4CONST SET LEFT CONTEXT FOR CONSTANT. B CSARSET REGS WERE PREPARED EARLIER, CK THE * NON-BLANK CHAR THAT TERMINATED * THE CONSTANT. CSZ STH,R7 *CURRCS SET OFFSET--TO LAST CODESTRING BYTE. SLS,R7 -2 CALC ACTUAL SIZE OF DATA BLK NEEDED AI,R7 3 FOR THIS CODESTRING. LW,R4 CURRCS PT AT THE DATA BLOCK HEADER. AI,R4 -2 INT,R11 0,R4 GET SIZE FIELD. SW,R11 R7 = AMT THAT COULD BE GIVEN BACK TO LW,R7 LINKCS THE FREE TABLE. EXIT VIA LINK B GIVEBACK AFTER GIVING BACK EVEN AMOUNT. CSNON LB,R5 SCANITEM-(LAMPCODE**-2),R3 CONTACT CK THE SCAN ITEM CH,R12 ITEMCNTX,R5 R12 CONTAINS LEFT CONTEXT. BANZ CSSPECCK OK. B ERLSCAN BAD, LINE-SCAN ERROR. CSSPECCK CI,R5 SPECIAL IS THIS A SPECIAL CHAR... BGE CSV-SPECIAL,R5 YES, BRANCH INTO CSV-RANGE. CSSETLC LH,R12 LC4TBL,R5 SET NEW LEFT CONTEXT. AI,R7 1 STRING NEW CODESTRING DESIGNATOR. STB,R3 *CURRCS,R7 * B %+1 FALLS INTO CSV-RANGE FOR NEXT CHAR * ACQ. NOTE THAT R4 STILL PTS TO * 'CSACQCK'. CSV B ACQNXCC CSV-RANGE--BRANCH TBL: @ BLANK B DELCK * @ DEL B CSNEG * @ NEGATIVE-SIGN B CSTEXT * @ TEXT CONSTANT B CSCOMMNT * (SEE ALSO THE @ COMMENT B CSZ * 'SPECIAL' @ END-OF-CODESTRING B CSDOTPT * DEFINITIONS-- @ DOT OR DEC.PT B CSOP * I.E. EQU-CARDS) @ COORDINATIBLE OP CSOP AI,R12 -M * @ ORDINARY OP BLZ CSSETLC BRANCH IF NOT MONADIC CONTEXT. CLM,R3 POSSMON MONADIC CONTEXT. CONVERT OP... BCS,9 CSSETLC NO, LEAVE IT ALONE. AI,R3 MONADIC-DYADIC YES, MAKE IT A MONADIC OPERATOR. B CSSETLC PAGE ************************************************************************ * * * THE CODESTRINGER * * * * CS1--ENTRY PT TO START CODESTRINGING AT THE BEGINNING OF IMAGE BUF. * * CSN--ENTRY PT TO START CODESTRING AT A GIVEN POSITION IN IMAGE BUF. * * REGS FOR CSN ENTRY: * * R1 PTS AT THAT POSITION. * * R2 CONTAINS THAT CHAR.--REQUIRED TO BE NON-BLANK. * * R3 CONTAINS ITS CODE. * * REGS FOR CS1 AND CSN ENTRY: * * R12 LINK REGISTER. EXIT VIA SAVED LINK (IN LINKCS) * * REGS AT NORMAL EXIT (EXIT FROM CODESTRINGER NORMALLY OCCURS * * BY ENTERING 'GIVEBACK' TO RETURN ANY UNUSED WORDS * * FOR THE CODESTRING DATA BLOCK): * * R4 PTS AT DATA BLOCK HEADER. * * R11 CONTAINS AMOUNT OF UNUSED WORDS. * * R7 LINKAGE TO CS1 OR CSN. * * ALL OTHER REGS CAN BE PRESUMED VOLATILE. * * (ERROR EXIT IS TO 'LSCANERR' -- LINE-SCAN ERROR -- ALSO TAKES * * PLACE VIA 'GIVEBACK' FOR FUNCTION LINES. FOR THESE LINES, A * * PORTION OF THE LINE IS CODESTRUNG AS AN ERROR DESCRIPTION: * * TEXT,ERROR-PTR,LENGTH,ERROR-CODESTRING-DESIGNATOR. FOR NON- * * FUNCTION LINES, CODESTRING IS THROWN AWAY. SEE 'ERLSCAN'.) * * * CS1 LI,R1 BA(IMAGE) PT AT 1ST BYTE OF INTERNAL IMAGE. BAL,R4 ACQNB ACQ NON-BLANK CHAR. AND CODE. CSN CI,R2 ')' IF 1ST 'CODESTRINGABLE' CHAR IS RT. BE CMDREC PAREN, GO TO CMND. PROCESSOR. STW,R12 LINKCS SAVE LINK TO CODESTRINGER. LI,R12 1 DOES IMAGE CONTAIN AN ODD NO. OF AND,R12 QCNT QUOTES... BEZ ONELINER NO. BAL,R8 GARBCOLL YES, TAMP SO CS DATA BLK CAN GRO ONELINER LI,R12 0 STW,R12 CONSTKEY RESET PTR TO KEY CHAR OF CONSTANT. LW,R11 HICOL = LOC OF ENDMARK IN INTERNAL IMAGE. SW,R11 R1 AI,R11 1 = NO.OF CHARS TO CODESTRING. SLS,R11 1 DBL THAT = NO.OF WDS TO ALLOCATE * FOR CODESTRING; IT IS UNLIKELY * THAT THIS MANY WDS WILL BE USED. BAL,R14 ALOCNONX ALLOC THOSE WDS PLUS DATA BLK HDR. B WSFULLC YUCK -- WS FULL BEFORE ANY CS. LI,R11 TYPECS SET DATA BLK TYPE FIELD--CODESTRING. STB,R11 *R4 AI,R4 2 PT AT 1ST WD TO RECEIVE CODESTRING. STW,R4 CURRCS = PTR TO CODESTRING BLOCK, CURRCS * WILL BE OK EVEN IF DATA BLK MOVES. LI,R7 2 CODESTR STARTS AT BYTE 2. CSBOS LI,R13 BOSCODE PUT BEGINNING-OF-STMT CODESTRING STB,R13 *CURRCS,R7 DESIGNATOR INTO CODESTR. BLOCK. LI,R12 LC4BOS = LEFT CONTEXT FOR BEGINNING-OF-STMT CSARSET LI,R4 CSACQCK SET RETURN FROM 'ACQNXCC'. CSACQCK CLM,R3 NONAME CK LATEST ACQUISITION... BCR,9 CSNON NOT A NAME OR NUMBER START BCS,1 CSNUM DIGIT, STARTS NUMBER * NAME-START CHAR STW,R7 OFFSET SAVE POS OF LATEST CODESTR DESIGNATR CI,R12 ITEMNAME CK FOR CONTACT ERROR FOR NAME. BANZ CSANAME OK. B ERLSCAN OOPS -- LINE-SCAN ERROR. CSANAME BAL,R12 ACQNAME ACQUIRE THE NAME--PTR AND TYPE. B SYMFULL (SYM TBL FULL RETURN) B WSFULLN (WS FULL RETURN, DUE TO LONG NAME) LW,R7 OFFSET RESTORE CODESTRING PTR. CI,R2 ':' DID NAME END ON A COLON... BNE CSNAME NO. CI,R7 2 YES, HAS CODESTRING REALLY BEGUN... BNE ERLSCAN YEP -- LINE-SCAN ERROR. LW,R4 MODE NOPE -- FUNCTION DEFN MODE... BNEZ ERLSCAN NO -- LINE-SCAN ERROR. CI,R13 NAMECODE YES, AN ORDINARY NAME... BNE ERLSCAN YUCK, STOP OR TRACE -- LINE-SCAN ERR LI,R13 COLNCODE GET COLON CODESTRING DESIGNATOR. B CSLBLN START LABEL NAME OVER BOSCODE. CSUNLBL LI,R12 LC4NAME SET LEFT CONTEXT FOR ORDINARY NAME. AI,R13 -NAMECODE IS IT... BEZ CSARSET YES, RESUME WITH CHAR AFTER NAME. LI,R12 LC4STNAM NO, STOP OR TRACE NAME. B CSARSET CSNAME AI,R7 1 UPDATE CODESTRING PTR. CSLBLN SCS,R6 -8 CODESTRING THE NAME PTR-- STB,R6 *CURRCS,R7 MOST SIGNIFICANT BYTE AI,R7 1 FOLLOWED BY SCS,R6 8 STB,R6 *CURRCS,R7 LEAST. AI,R7 1 UPDATE CODESTRING PTR. STB,R13 *CURRCS,R7 ENTER NAME TYPE (OR COLON CODE). CI,R13 COLNCODE WAS IT A LABEL... BNE CSUNLBL NO. LI,R13 NAMECODE YES, REPLACE COLON CODE WITH STB,R13 *CURRCS,R7 ORDINARY NAME CODE. AI,R7 1 LI,R13 COLNCODE THEN PLUG IN THE COLON CODE. STB,R13 *CURRCS,R7 AI,R7 1 PREPARE TO RESTART CODESTRINGING LI,R4 CSBOS BY PUTTING BEGINNING-OF-STMT CODE B ACQNXNB AFTER THE COLON. EXIT TO CSBOS * AFTER GETTING NEXT NON-BLANK. PAGE ************************************************************************ SPACE 2 Z SET %-CS@ SIZE OF CS IN HEX. SPACE Z SET Z+Z/10*6+Z/100*96+Z/1000*1536 SIZE IN DECIMAL. SPACE 2 END