TITLE 'TELEFILE ASSEMBLY PROGRAM - APNCD' PCC 0 SPACE 6 * %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% * %%%%% MODULE NAME: APNCD %%%%% * %%%%% LAST UPDATED: MAR 07, 1984 %%%%% * %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% SPACE 2 SPACE 12 * T E L E F I L E P R O P R I E T A R Y P R O D U C T SPACE 2 * THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED * PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION, * DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART, * TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT * SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE * COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF * THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN, * PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN. PAGE SPACE 12 * T E L E F I L E P R O P R I E T A R Y P R O D U C T SPACE 2 * THIS DOCUMENT INCLUDES DATA AND INFORMATION WHICH IS CONSIDERED * PROPRIETARY TO TELEFILE COMPUTER PRODUCTS, INC. REPRODUCTION, * DUPLICATION, DISCLOSURE OR DISSEMINATION, IN WHOLE OR IN PART, * TO OTHERS THAN REPRESENTATIVES OF THE UNITED STATES GOVERNMENT * SHALL NOT BE MADE WITHOUT PRIOR WRITTEN AUTHORIZATION OF TELEFILE * COMPUTER PRODUCTS, INC. NOTWITHSTANDING THE FOREGOING, USE OF * THE DATA OR INFORMATION IN WHOLE OR IN PART FOR DESIGN, * PROCUREMENT OR MANUFACTURE IS STRICTLY FORBIDDEN. PAGE NCDP CSECT 1 PROCEDURE & STATIC DATA * SYSTEM AP%IL * DEF NCDP (FOR MAP) DEF NCDR ENTRY POINT DEF NCDREND END OF ENCODER PROCEDURE DEF CNTERM DEF LINK REF ABORT REF DC%FLAG REF DEDIT BINARY TO EBCDIC DECIMAL CONVERSION REF HWX1SIZE REF OPENX5 OPEN THE SYMT SPILL FILE REF POSITIONX3 REF READX5 REF REWX3 REF SDFCON REF WDX1SIZE REF WRITELO REF WRITEX3 REF WRITEX5 REF READX1,WRITEX1,REWX1,POSITIONX1 REF BYX3SIZE,HWX3SIZE,WDX3SIZE REF READSTD,WRITESTD,REWSTD REF NEXTST,NXSYMB REF EOF%FLAG REF MAJLINE,SUBLINE ASSEMBLY LINE NUMBER IM@MAJOR EQU MAJLINE IM@MINOR EQU SUBLINE REF ND%FLAG REF PD%FLAG REF LS%FLAG REF ENDCORE REF LOWCORE REF SAVAREA REF VAL%S:IVAL VALUE OF S:IVAL (FROM SYSTEM) REF BUFSI REF FIN%X1 REF IM@READ REF IM@NAME,IM@COPY REF IM@SYS REF IM@END REF NIVO REF READC REF X1BUF,X3BUF REF LSTBF,CLRLSTBF REF ROOTRTN REF CIREC#,#BLANKS,LAST%UPDATE,NEXT%UPDATE REF SKIP%COUNT,UPDATE%LINE%COUNT,PLUS,COMPTE%CI REF CIRDREGS,CO%BUF,CO%REGI XAPD1 DSECT 0 * * 'I S' P R O C E D U R E * * GENERATES THE SYNTAX TABLE, ONE STATEMENT (EQUATION) AT A TIME * * ITEMS ARE SEPARATED BY COMMAS, AND MUST BE ONE OF THE FOLLOWING * * (A) A CHARACTER. SPECIFIED AS A CHARACTER CONSTANT, OR * A HEX OR INTEGER CONSTANT LESS THAN 256. * * (B) REFERENCE TO SYNTAX STATEMENT. WRITE THE NAME OF * THE STATEMENT. * * (C) REFERENCE TO A SEMANTIC ROUTINE. WRITE THE NAME OF * THE SEMANTIC ROUTINE. * * FORMAT OF EACH GENERATED SYNTAX ELEMENT: * TYPE: 2 BITS * 00=CHARACTER * 01=SEMANTIC ROUTINE REFERENCE * 10=SYNTAX EQUATION REFERENCE * 'OR' INCREMENT: 4 BITS * CONTAINS NO. OF SYNTAX ENTRIES FROM HERE TO THE * NEXT 'OR' OR 'ENDEQN' ENTRY * * ADDRESS: 10 BITS * FOR TYPE 00 - THE CHARACTER * FOR TYPE 01 - OFFSET FROM LOCATION 'SEMANBAS' (WORDS) * FOR TYPE 10 - OFFSET FROM LOCATION 'SYNTAX' (HALF-WDS) * * EXCEPTION: THE ELEMENT FOLLOWING A 'WRITE' ELEMENT IS * GENERATED AS A 16-BIT VALUE, SO THAT ALL 16 BITS * MAY BE OUTPUT BY THE WRITE ROUTINE. * * ALL OF THE SYNTAX STATEMENTS MUST RESIDE IN LOWER CORE * THAN SEMANTIC ROUTINES, OR THE PROC WILL NOT GENERATE * THE CORRECT RESULTS. * PASS SET S:UFV(PASS)+1 SET A PASS SWITCH IS CNAME PROC ERROR,0,NUM(LF)=0 'MISSING LABEL' LF RES,2 0 DEFINE THE LABEL DO PASS=1 RES,2 NUM(AF)+1 ELSE IND SET 1 INDICATOR TO INDICATE 1ST GROUP GNUM SET 1 TOTAL NUMBER OF GROUPS GRPCT SET 0 SET ALL GROUP COUNTS TO ZERO * NOW COUNT THE GROUPS, AND THE NUMBER OF ELEMENTS IN EACH * A GROUP IS ZERO OR MORE SYNTAX ELEMENTS, TERMINATED BY AN 'OR' * ELEMENT OR THE END OF THE EQUATION. I DO NUM(AF) DO SCOR(AF(I),OR) IND SET IND**4 SHIFT INDICATOR FOR NEXT GROUP GNUM SET GNUM+1 BUMP NUMBER OF GROUPS ELSE GRPCT SET GRPCT+IND ADD TO COUNT IN CURRENT GROUP FIN FIN * GROUPS ARE COUNTED, AND SO ARE THE ELEMENTS IN EACH GROUP * NOW TO GENERATE FOR EACH ITEM I SET 1 TO SEQUENCE THRU ARGUMENT FIELD A SET 0 LAST-ELEMENT-IS-'WRITE',FLAG ERROR,3,GNUM>16 'TOO MANY ''OR'' ELEMENTS' DO GNUM GNUM CONTAINS NUMBER OF GROUPS II SET GRPCT&15 II CONTAINS ELEMENTS IN EACH GROUP GRPCT SET GRPCT**(-4) SHIFT FOR NEXT GROUP DO II DO A DATA,2 AF(I) PREVIOUS ELEMENT WAS 'WRITE' ELSE DO CS(S:UFV(AF(I)))=0 IS ELEMENT A CHARACTER ISGEN 0,II,AF(I) CHARACTER ELSE DO S:UFV(WA(AF(I))NUM(AF) ISGEN 1,0,ENDEQN-SEMANBAS ELSE ISGEN 1,0,OR-SEMANBAS I SET I+1 FIN FIN FIN PEND ISGEN CNAME PROC GEN,2,4,10 AF(1),AF(2),AF(3) PEND * CLOSE A,GNUM,GRPCT,I,II,IND,PASS * * EQUATES FOR ABORT * AR EQU 0 ABORT REGISTER ABORT3 EQU 3 ABORT4 EQU 4 ABORT21 EQU 21 STATEMENT TOO LONG /27493/*D-NCD PAGE * * STORAGE DRIVEREXIT RES 1 LASTCMND RES 1 COMMAND ON LAST LINE LASTIN RES 1 INDEX TO LAST INPUT CHARACTER LOCX RES 1 LOCATION FOR NEXT LOCAL SYMBOL SDFCONNCDR RES 1 ADDRESS OF SYSTEM NAME TABLE #SYSITEM RES 1 NUMBER OF SYSTEM NAMES PLOC RES 1 ORIGIN OF PROC LEVEL LOCAL TABLE PROCLV RES 1 NON-ZERO BETWEEN PROC AND PEND RES ABSVAL(%)&1 BOUND 4 WITH NO DATA GENERATED HED RES 20 ROOT OF BALANCED TREE SYM TAB GET2REGS RES 8 MUST BE ON DBL. WORD BOUND NSRTR1 RES 2 TEMP IN INSERT NSRTR2 EQU NSRTR1+1 ALFLAG RES 1 NON-ZERO WHEN IN A TEXT STRING BUFPTR RES 1 CARDADDR RES 1 CHARTEMP RES 1 TEMP IN CHAR CMPCHAR RES 1 TEMP IN READCARD CNCTRL RES 1 NZ = READING CN CONTROLS CONTIN%ERROR RES 1 NZ FOR ERROR IN CONTINUATION CREATE1STV RES 1 ENTRY TO CREATE1ST CRE8XIT RES 1 XTRA XIT IN SEARCH/CREATE1ST CURRCMND RES 1 COMMAND ON CURRENT LINE CURLOCNT RES 1 LOCALS ON CURRENT LINE DIR RES 1 DIR FLAG IN SPILL MODE DSLNCTRL RES 1 FLAG FOR LINE PRINT UNDER .DS CN CTL FIRSTREC RES 1 FND RES 1 FOUND ADDRESS IN SEARCH INBUF RES 1 ADDRESS OF INPUT BUFFER ORIGIN INBUFLMT RES 1 FIXED BUF START FOR DISK SPILL LOGIC INCOREB# RES 1 BLOCK # OF SPILLED SYMT IN CORE INCOREBMAX RES 1 MAX BLOCK EVER WRITTEN RES ABSVAL(%)&1 INCORELH RES 0 VIRTUAL ADDRESS BOUNDS INCOREL RES 1 LO VIRTUAL ADDR OF SPILLED PAGE INCOREH RES 1 HI VIRTUAL ADDR OF SPILLED PAGE INCORESF RES 1 NZ = CORE PAGE STORED INTO INSERTV RES 1 ENTRY TO INSERT ITEM IN SYMT LVLBASE RES 1 M0 RES 1 TEMP IN SEARCH AND INSERT M1SAVE RES 1 TEMP IN MAP%ADDR NEWENTRYV RES 1 ENTRY TO NEWENTRY NEXTLINE# RES 1 OUTBUF INDEX FOR NEXT LINE NUMBER NUMRECX3 RES 1 NUM REC IN X3 NXTLOC RES 1 NUMBER OF ACTIVE LOCALS SEARCHV RES 1 ENTRY TO SEARCH SYMT SIGFLAG RES 1 TEMP IN SYSTEM SLOC RES 1 ORIGIN OF SOURCE LEVEL LOCAL TABLE SPILLFLG RES 1 NZ = SYMT-SPILL MODE SRCHXIT RES 1 EXIT ADDRESS FOR VARIOUS SYMT RTNS. SYMLMT RES 1 OFF SET OF SPILL PAGE SYMLMTM1 RES 1 OFFSET OF SPILL PAGE (-1) SYMLMTM18 RES 1 OFFSET OF SPILL PAGE (-18) SYMTLMT RES 1 ADDRESS OF SPILLED SYMT PAGE WDOUTRTN RES 1 NUMRECX1 RES 1 NUM REC IN X1 FIRSTST RES 1 1ST SYMBOL TABLE LOC XTSAVE RES 1 OVFLAG RES 1 OVERFLOW FLAG OUTSAVE RES 1 START OF ENCODED LINE CMPOUTSV RES 1 START OF COMP IMAGE PAGE * * STATIC DATA * USECT NCDP * BOUND 8 ZERO DATA 0,0 P1 DATA 1,2 RNG%DFN%DIR ; DATA CNAMEDIR,FNAMEDIR RNG%SPC%DIR ; SPECIAL DIRECTIVE #'S IN STLOOP DATA PENDDIR,FNAMEDIR RNG%SYN%DIR ; DATA CLOSEDIR,PAGEDIR ACUMSPCH TEXTC 'BE..' PAGE * * MISCELLANEOUS EQUATES * FFFSAVE EQU HED+2 12 WORDS OF TEMP IN FLT PT ACUMLNK EQU M0 RETURN FROM ACUM SIGNLNK EQU NSRTR1 RETURN FROM SIGN FFFGNCLNK EQU NSRTR2 RETURN FROM FFFGNC LVLTBL EQU 0 OUTBUF EQU X1BUF ENCODED OUTPUT BUFFER OUTSIZE EQU HWX1SIZE SIZE OF OUTBUF (IN HALFWORDS) SIBUF EQU X3BUF COMPRESSED SOURCE RECORD BUFFER CF1BUF EQU SIBUF SYMBUF EQU OUTBUF FIRSTSTSDF EQU OUTBUF STD DEF FILE FIRSTST NEXTSTSDF EQU OUTBUF+1 STD DEF FILE NEXTST NXSYMBSDF EQU OUTBUF+2 STD DEF FILE NXSYMB HEDSDF EQU OUTBUF+3 STD DEF FILE HED SDFCONSDF EQU OUTBUF+4 STD DEF FILE SDFCON PAGE * * EQUATES FOR THE SYNTAX EQUATIONS FOLLOWING A 'WRITE' * ENDBUF EQU X'20FF' END OF BUFFER ENDLN EQU 0 END OF LINE ENDLIST EQU 2 END LIST ENDSBSYM EQU 3 END SUBSCRIPTED SYMBOL ENDEXP EQU 4 END EXPRESSION BLANKEXP EQU 5 BLANK EXPRESSION BEGINLIST EQU X'6' BEGIN LIST BEGINEXP EQU X'7' BEGIN EXPRESSION INDIROP EQU X'8' INDIRECT OPERATOR TRUNERR EQU X'9' TRUNCATION ERROR SYNERR EQU X'A' SYNTAX ERROR OROP EQU 32 XOROP EQU 33 ANDOP EQU 34 EQUALOP EQU 35 UNEQLOP EQU 36 GTEQOP EQU 37 LTEQOP EQU 38 GRTROP EQU 39 LESSOP EQU 40 MINUSOP EQU 41 PLUSOP EQU 42 DIVOP EQU 43 INCLDIV EQU 44 MPYOP EQU 45 SCALEOP EQU 46 SYMTYPE EQU X'4000' SYMBOL SBSYM EQU X'8000' SUBSCRIPTED SYMBOL SMALLINT EQU X'C000' SMALL INTEGER LARGEINT EQU X'E000' * LARGE INTEGER CONVERSION TYPES CT1 EQU X'100' CT2 EQU X'200' CT3 EQU X'300' CT4 EQU X'400' CT5 EQU X'500' ENCTLOB EQU 2+16 ENCODED TYPE FIELD LOB ENCTYPE EQU X'E000' ENCODE TYPE FIELD ENCVAL EQU X'1FFF' VALUE FIELD ADDRSIZE EQU 10 ADDRESS EQU 1**ADDRSIZE-1 INCRSIZE EQU 4 INCR EQU (1**INCRSIZE-1)**ADDRSIZE TYPESIZE EQU 2 TYPE EQU (1**TYPESIZE-1)**(INCRSIZE+ADDRSIZE) NOTINCR EQU X'C3FF' * * CN PROCESSING * CNFLGFLD EQU X'00FE0000' ALL INTERESTING CN FLAGS CNDSFLG EQU X'020000' CNDSMODE EQU 6 CNERR EQU 2**(31-ENCTLOB) CNIOFLG EQU X'00800000' .IO CNIOFLG1 EQU X'00400000' .IO NAME-LIST CNIOMODE EQU 3 CNOSFLG EQU X'00080000' .OS CNOSMODE EQU 5 CNSSFLG EQU X'00200000' .SS CNSSFLG1 EQU X'00100000' .SS NAME-LIST CNSSMODE EQU 4 * * MISCELLANEOUS TAB EQU 5 * * REGISTER ASSIGNMENTS * XT EQU 1 TEMP IN EQU 2 INDEX TO INBUF (BYTE) OUT EQU 3 INDEX TO OUTBUF (HALFWORD) SYN EQU 4 INDEX TO SYNTAX TBL (HALFWORD) LVL EQU 5 INDEX TO SYNTAX LEVEL TBL (WORD) N EQU 6 TEMP LL EQU 6 SYMBOL TABLE LINK CRG EQU 7 CONTAINS CURRENT INPUT CHARACTER RT1 EQU 8 TEMP RT2 EQU 9 TEMP RT3 EQU 10 TEMP RT4 EQU 11 TEMP LINK EQU 13 LINK REG FOR INPUT MODULE. CT EQU 14 TEMP RL EQU 15 LINK REG FOR SUBROUTINE CALLS RT5 EQU RL TEMP IN SEARCH U EQU N SEARCH AND INSERT V EQU SYN SEARCH AND INSERT W EQU LVL SEARCH AND INSERT X EQU 7 SRCHIST VWX EQU 1 SRCHIST M1 EQU 7 SRCHIST SR1 EQU 8 ************************************ SR2 EQU 9 ************************************ SR3 EQU 10 X1 EQU 1 X2 EQU 2 X3 EQU 3 X4 EQU 4 X5 EQU 5 X6 EQU 6 X7 EQU 7 IOADD EQU 8 I/O BUFFER ADDRESS IOSIZE EQU 9 I/O BUFFER SIZE IORL EQU 10 I/O RETURN LINK REGISTER PAGE * * FIELDS AND MASKS FOR THE BALANCED TREE SYMBOL TABLE * DIRFLD EQU X'40000' DIRECTION FIELD LLWD EQU HED WORD CONTAINING LESSER LINK GLWD EQU HED+1 WORD CONTAINING GREATER LINK SYM1 EQU HED+2 1ST WORD CONTAINING CHARACTERS WDCTWD EQU HED WORD CONTAINING WDCT FIELD BALWD EQU HED WORD CONTAINING BALANCE FIELD DIRWD EQU HED WORD CONTAINING DIRECTION FIELD BALFLD EQU X'30000' BALANCE FIELD SNWD EQU HED+1 WORD CONTAINING SYMBOL NUMBER PTRWD EQU HED WORD CONTAINING PTR FIELD PTRLOB EQU 9 PTR FIELD POSITION PTRFLD EQU 1**(31-PTRLOB) PTR FIELD CLOFLD EQU X'200000' CLO FIELD DSSYMBIT EQU X'00100000' SYMT FLAG FOR .DS CN NAME CF1FLD EQU X'800000' CF1 FIELD GLFLD EQU X'FFFF' GREATER LINK FIELD LLFLD EQU X'FFFF' LESSER LINK FIELD SNFLD EQU X'FFFF0000' BOFFSET EQU BALWD-HED DOFFSET EQU DIRWD-HED GLOFFSET EQU GLWD-HED LLOFFSET EQU LLWD-HED PTROFFSET EQU PTRWD-HED SNOFFSET EQU SNWD-HED PAGE * * D I R E C T I V E B R A N C H T A B L E * DIRBR RES 0 HALF,SYNTAX 0 COMMENT HALF CLOSE 1 HALF LOCAL 2 HALF OPEN 3 HALF SYSTEM 4 HALF PROC 5 HALF 0 6 PEND HALF 0 7 END HALF 0 8 DATA HALF SKIP%OPERAND 9 ASECT HALF SKIP%OPERAND A SOCW HALF SKIP%OPERAND B ELSE HALF SKIP%OPERAND C FIN HALF SKIP%OPERAND D PAGE BOUND 8 * * I N T R I N S I C S Y M B O L T A B L E * I:# SET 0 INTRINSIC SYMBOL # * ISYM CNAME PROC I:# SET I:#+1 TO NEXT # LF EQU I:# DEFINE A POSSIBLE LABEL TEXTC AF(1) PEND * BOUND 4 INTBLO RES 0 COMNT# EQU I:# COMMENT 'DIRECTIVE' CLOSE# ISYM 'CLOSE' LOCAL# ISYM 'LOCAL' OPEN# ISYM 'OPEN' SYSTEM# ISYM 'SYSTEM' PROC# ISYM 'PROC' PEND# ISYM 'PEND' END# ISYM 'END' DATA# ISYM 'DATA' ASECT# ISYM 'ASECT' SOCW# ISYM 'SOCW' ELSE# ISYM 'ELSE' FIN# ISYM 'FIN' PAGE# ISYM 'PAGE' PCC# ISYM 'PCC' DEF# ISYM 'DEF' REF# ISYM 'REF' SREF# ISYM 'SREF' PSR# ISYM 'PSR' BOUND# ISYM 'BOUND' CNAME# ISYM 'CNAME' COM# ISYM 'COM' CSECT# ISYM 'CSECT' DISP# ISYM 'DISP' DO# ISYM 'DO' DO1# ISYM 'DO1' DSECT# ISYM 'DSECT' EQU# ISYM 'EQU' ERROR# ISYM 'ERROR' FNAME# ISYM 'FNAME' GEN# ISYM 'GEN' GOTO# ISYM 'GOTO' LIST# ISYM 'LIST' LOC# ISYM 'LOC' ORG# ISYM 'ORG' PSECT# ISYM 'PSECT' PSYS# ISYM 'PSYS' RES# ISYM 'RES' S:SIN# ISYM 'S:SIN' SET# ISYM 'SET' SPACE# ISYM 'SPACE' TEXT# ISYM 'TEXT' TEXTC# ISYM 'TEXTC' TITLE# ISYM 'TITLE' USECT# ISYM 'USECT' * S:AAD# ISYM 'S:AAD' S:C# ISYM 'S:C' S:D# ISYM 'S:D' S:DPI# ISYM 'S:DPI' S:EXT# ISYM 'S:EXT' S:FL# ISYM 'S:FL' S:FR# ISYM 'S:FR' S:FS# ISYM 'S:FS' S:FX# ISYM 'S:FX' S:INT# ISYM 'S:INT' S:LFR# ISYM 'S:LFR' S:LIST# ISYM 'S:LIST' S:RAD# ISYM 'S:RAD' S:SUM# ISYM 'S:SUM' * S:IVAL# ISYM 'S:IVAL' %# ISYM '%' %%# ISYM '%%' * AF# ISYM 'AF' AFA# ISYM 'AFA' CF# ISYM 'CF' LF# ISYM 'LF' NAME# ISYM 'NAME' * BA# ISYM 'BA' HA# ISYM 'HA' WA# ISYM 'WA' DA# ISYM 'DA' ABSVAL# ISYM 'ABSVAL' CS# ISYM 'CS' NUM# ISYM 'NUM' S:IFR# ISYM 'S:IFR' S:NUMC# ISYM 'S:NUMC' S:PT# ISYM 'S:PT' S:UFV# ISYM 'S:UFV' S:UT# ISYM 'S:UT' * L# ISYM 'L' I:# SET I:#+1 '=' OPERATOR S:KEYS# ISYM 'S:KEYS' SCOR# ISYM 'SCOR' TCOR# ISYM 'TCOR' INTBLE RES 0 * * MISCELLANEOUS PARAMETERIZATION OF INTRINSIC SYMBOLS * CLOSEDIR EQU SYMTYPE+CLOSE# CNAMEDIR EQU SYMTYPE+CNAME# COMNTDIR EQU SYMTYPE+COMNT# COMDIR EQU SYMTYPE+COM# ENDDIR EQU SYMTYPE+END# FNAMEDIR EQU SYMTYPE+FNAME# PAGEDIR EQU SYMTYPE+PAGE# PENDDIR EQU SYMTYPE+PEND# SBLSYM EQU L#+SBSYM BEGIN LITERAL FUNCTION PAGE * * C H A R A C T E R C L A S S T A B L E * * THIS TABLE IS USED TO CLASSIFY INPUT CHARACTERS AS * HEX (BIT 0), OCTAL (BIT 1), DECIMAL (BIT 2), * AND ALPHABETIC (BIT 3). BITS 4 THRU 7 CONTAIN THE * NUMERIC EQUIVALENT OF HEX CHARACTERS. * ALPH EQU 16 BIT THREE DEC EQU 32 BIT TWO HEX EQU 128 BIT ZERO OCT EQU 64 BIT ONE * CONVTBL RES 0 DO1 X'58'/4 DATA 0 00 THRU X'57' DATA ALPH X'5B' IS DOLLAR SIGN DO1 (X'6C'-X'5C')/4 DATA 0 DATA ALPH**16 X'6D' IS BREAK DO1 (X'78'-X'70')/4 DATA 0 DATA ALPH**8+ALPH X'7A' IS COLON, X'7B' IS POUND DATA ALPH**24 X'7C' IS AT SIGN DO1 (X'C0'-X'80')/4 DATA 0 DATA,1 0 X'C0' I DO 6 X'C1' THRU X'C7' A THRU F DATA,1 ALPH+HEX+I+9 FIN DO1 3 DATA,1 ALPH G,H,AND I DO1 X'D1'-X'CA' DATA,1 0 DO1 X'DA'-X'D1' J THRU R DATA,1 ALPH DO1 X'E2'-X'DA' DATA,1 0 DO1 X'EA'-X'E2' S THRU Z DATA,1 ALPH DO1 X'F0'-X'EA' DATA,1 0 I DO 8 0 THRU 7 DATA,1 HEX+OCT+DEC+I-1 FIN DATA,1 HEX+DEC+8,HEX+DEC+9 DO1 X'100'-X'FA' DATA,1 0 BOUND 4 CNERR1%MSG ; TEXT ' ** NO ''.'' IN COL 1 - CN SCAN TERMINATED' SPILL%MSG ; TEXT ' ENCODER SPILL TO RAD STORAGE ' SPILL%MSG%REQ ; TEXT ' TOTAL SPACE REQUIRED IS ' SPILL%MSG%AVL ; TEXT ' TOTAL SPACE AVAILABLE IS ' CIREGS DATA -20,' ',0,0,0,0 INIT%CO%WORD DATA X'3800006C' CO%REGS DATA 32,-26,0 PAGE * * N C D R * THIS IS THE TRANSFER POINT TO BEGIN EXECUTION OF THE PROGRAM * NCDR RES 0 STW,10 ROOTRTN SAVE RETURN ADDRESS TO ROOT BAL,IORL REWX1 BAL,IORL REWX3 LI,N -(BYX3SIZE+1) INITIALIZE STW,N CMPOUTSV COMPRESSED OUT INDEX LI,N 31 SET S:IVAL TO ALLOW SIG9P OPS STW,N VAL%S:IVAL * * INITIALIZE NON-SPILL SYMT MANAGEMENT ENTRY POINTS * LI,N CREATE1ST STW,N CREATE1STV LI,N INSERT STW,N INSERTV LI,N NEWENTRY STW,N NEWENTRYV LI,N SEARCH STW,N SEARCHV * * PRESET THE TEST LIMITS FOR POSSIBLE SPILL. BASICALLY, * WE WANT TO HOLD OUT 4 PAGES FOR INBUF, LEVEL TABLE, LOCAL * TABLE, AND SYSTEM NAME TABLE. IF NOT ENOUGH ROOM, HOWEVER, * LEAVE ONE FIXED PAGE FOR THE SYMBOL TABLE, AND HOLD OUT THE * REST. * LW,XT ENDCORE LW,N ENDCORE SW,N LOWCORE AVAILABLE WORD COUNT AND,N L(-512) CONVERT TO INTEGRAL # PAGES AI,N -512 RESERVE 1 PAGE FOR FIXED AREA IF,GZ IF,G 2048,N LI,N 2048 FI SW,XT N FI STW,XT INBUFLMT AI,XT -512 CW,XT LOWCORE IF,L LW,XT LOWCORE FI STW,XT SYMTLMT ADDRESS OF SPILL PAGE AI,XT -HED STW,XT SYMLMT OFF SET OF SPILL PAGE AI,XT -1 STW,XT SYMLMTM1 OFFSET OF SPILL PAGE (-1) AI,XT -17 STW,XT SYMLMTM18 OFFSET OF SPILL PAGE (-18) LI,N 0 STW,N HED CLEAR ENTRY POINT TO SYMBOL TABLE STW,N #SYSITEM NUMBER OF SYSTEM NAMES STW,N NUMRECX1 NUMBER OF RECORDS IN X1 STW,N CNCTRL CN CONTROL CARD FLAG STW,N FIRSTREC STW,N NUMRECX3 NUMBER OF RECORDS IN X3 STW,N CURRCMND CURRENT COMMAND STW,N NXTLOC NUMBER OF ACTIVE LOCAL SYMBOLS STW,N ALFLAG WITHIN A TEXT STRING FLAG STW,N PROCLV WITHIN A PROC DEFINITION FLAG STW,N SPILLFLG SYMT SPILL FLAG * PRESET STORAGE FOR THE INPUT MODULE STW,N CIREC# NEXT CI RECORD NUMBER STW,N EOF%FLAG END-OF-FILE FLAG STW,N #BLANKS # BLANKS FOR CI STW,N IM@MAJOR MAJOR PART OF LINE NUMBER STW,N IM@MINOR MINOR PART OF LINE NUMBER STW,N LAST%UPDATE FOR '+' CARDS STW,N NEXT%UPDATE FOR '+' CARDS STW,N SKIP%COUNT FOR '+' CARDS STW,N UPDATE%LINE%COUNT FOR '+' CARDS LI,LVL 29 STW,N CO%BUF,LVL CLEAR FIRST 'CO' RECORD BDR,LVL %-1 LW,LVL INIT%CO%WORD STW,LVL CO%BUF I.D. WORD FOR 1ST CO RECORD LCI +3 LM,SR1 CO%REGS STM,SR1 CO%REGI INITIAL CO REGISTERS LCI +6 LM,SR1 CIREGS STM,SR1 CIRDREGS INITIAL CI READ REGISTERS LI,N 1 STW,N PLUS '+' CARD REQUIRED FLAG STW,N COMPTE%CI STW,N DSLNCTRL .DS CN CTRL LINE-PRINT TOGGLE STW,N NXSYMB NEXT SYMBOL NUMBER TO ASSIGN * LW,SR1 ENDCORE LAST CORE LOCATION (+1) AI,SR1 -2 STW,SR1 SLOC STW,SR1 LOCX ************************************ STW,SR1 INBUF SET FOR OVERFLOW TEST IN INSERT LW,SR2 LOWCORE AI,SR2 -HED STW,SR2 NEXTST STW,SR2 FIRSTST SAVE FIRST SYM TAB LOC MTW,0 ND%FLAG READ STANDARD DEF FILE BNEZ INIT0 NO BAL,LVL RDSDF YES B STLOOP INIT0 RES 0 LI,IN INTBLO ORIGIN OF INTRINSICS INIT1 RES 0 LB,XT *IN AI,XT 3 SLS,XT -2 STORE WORD COUNT OF NAME AFTER STB,XT HED ITS MOVED LW,RT1 *IN GET CHAR COUNT & 1ST 3 CHARS AI,IN 1 BUMP ADDRESS LW,RT2 =' ' LB,XT RT1 COMPUTE WORD COUNT IN TEXTC FORMAT CI,XT 3 IF TEXTC CONTAINS A SECOND WORD BLE INIT2 GET THAT WORD LW,RT2 *IN 2ND WORD OF ANME AI,IN 1 BUMP SOURCE ADDRESS INIT2 RES 0 SLD,RT1 8 SHIFT OFF THE CHARACTER COUNT AI,RT2 ' ' INSERT A TRAILING BLANK STD,RT1 SYM1 CALL *SEARCHV CALL *INSERTV INSERT THE INTRINSIC SYMBOL CI,N L# IF,EQ MTW,+1 NXSYMB L#+1 IS DUMMY FOR '=' OPERATOR FI CI,IN INTBLE TEST FOR END OF INTRINSIC TABLE BL INIT1 * STLOOP LI,OUT 0 SET OUT TO ZERO 1ST TIME MTH,0 DC%FLAG BEZ STLOOP1 * * 'CN' OPTION WAS SPECIFIED - PROCESS CONCORDANCE CONTROLS * BEFORE GOING ON TO PROGRAM STATEMENTS. MTW,+1 CNCTRL INDICATE CN CONTROLS TO BE READ CNLOOP RES 0 LI,N 72 STW,N LASTIN STW,OUT OUTSAVE SAVE 1ST OUT LOCATION LI,SYN CNSYN-SYNTAX CALL DRIVER ENCODE THE CN CONTROL MTW,0 CNCTRL BNEZ CNLOOP (TURNED OFF BY .END, EOF, ETC) * LI,OUT 0 SET OUT TO ZERO 1ST TIME STLOOP1 LI,N 72 STW,N LASTIN CI,OUT OUTSIZE-12 5 WDS LEFT IN OUTBUF BLE STLOOP2 YES, BAL,RL IO%X1 NO, WRITE OUTBUF LI,OUT 0 RESET OUT STLOOP2 STW,OUT OUTSAVE SAVE 1ST OUT LOCATION LI,SYN LINE-SYNTAX ENTRY TO PROGRAM SYNTAX EQUATIONS BAL,RL DRIVER ENCODE A STATEMENT. LW,XT CURRCMND TEST FOR A SPECIAL DIRECTIVE CLM,XT RNG%SPC%DIR BOL STLOOP1 BRIF NOT INTERESTING * CI,XT CNAMEDIR BE STLOOP5 CI,XT FNAMEDIR BE STLOOP5 CI,XT COMDIR TEST FOR COM BE STLOOP5 CI,XT ENDDIR TEST FOR END BE STLOOP4 CI,XT PENDDIR TEST FOR PEND BNE STLOOP1 NO. IT'S NOT SPECIAL MTW,0 PROCLV IGNORE PEND IF NOT BEZ STLOOP6 WITHIN A PROC BAL,RL LCLDL1 DELETE PROC LOCAL TABLE LI,XT 0 STW,XT PROCLV RESET 'WITHIN PROC' FLAG STLOOP5 RES 0 BAL,RL EXCHS1 RE-INSTATE SOURCE LEVEL LOCALS STLOOP6 RES 0 LI,XT 0 STW,XT CURRCMND RESET COMMAND ON THIS LINE B STLOOP1 STLOOP4 RES 0 MTW,0 NIVO WITHIN A SYSTEM BEZ ENDIRCTV NO, GO TO 'END' PROCESSING BAL,LINK IM@END CLOSE CURRENT SYSTEM B STLOOP6 PAGE * XAP SYNTAX EQUATIONS SYNTAX ORG,2 % CNSYN IS '.',CNCMND,OR,CNERR1,CNTERM CNCMND IS 'I','O',CNIOCMND,OR,; 'S','S',CNSSCMND,OR,; 'O','S',CNOSCMND,OR,; 'D','S',CNDSCMND,OR,; 'E','N','D',RESETOUT,CNTERM,OR,; CNERR2 CNIOCMND IS SETCNIO,OPTNLIST,ENDCNIO CNSSCMND IS SETCNSS,OPTNLIST,ENDCNSS CNOSCMND IS SETCNOS,CNLIST,WRITE,ENDLN,EXITSYN CNDSCMND IS SETCNDS,CNLIST,ENDCNDS OPTNLIST IS CNLIST,OR,BLANK,RESETOUT CNLIST IS BLANK,SYMBOL,CNSYM,NTHCNSYM,REPEAT NTHCNSYM IS ',',SYMBOL,CNSYM LINE IS LABEL,COMMAND,OPERAND LABEL IS STDLABEL,OR,WRITE,BEGINLIST,ANYLABEL,WRITE,ENDLIST STDLABEL IS BLNKLBL,WRITE,BLANKEXP,OR,SYMBOL,BLANK,WRISYMBOL ANYLABEL IS GF,BLANK,OR,SKIPNB,BLANK,WRITE,SYNERR COMMAND IS SYMBOL,COM1,OR,WRITE,BEGINLIST,CMNDERR,; SKIPNB,BLANK16,WRITE,ENDLIST COM1 IS BLANK16,CF1SYM,OR,WRITE,BEGINLIST,CF1SYM,; GFN,REPEAT,BLANK16,WRITE,ENDLIST PROC IS SETPROCLV,EXCHSLOC,SKIP%OPERAND OPEN IS SYMBOL,OPENSYM,NTHOPEN,REPEAT,ENDLINE,OR,ENDLINE NTHOPEN IS ',',SYMBOL,OPENSYM CLOSE IS SYMBOL,CLOSESYM,NTHCLOSE,REPEAT,ENDLINE,OR,ENDLINE NTHCLOSE IS ',',SYMBOL,CLOSESYM LOCAL IS LCLDLTE,LOCAL1 LOCAL1 IS SYMBOL,LOCALSYM,NTHLOCAL,REPEAT,WRITELOCALCT,; ENDLINE,OR,WRITELOCALCT,ENDLINE NTHLOCAL IS ',',SYMBOL,LOCALSYM SYSTEM IS SYMBOL,STSTSYMB,ENDLINE SKIP%OPERAND IS RESETCHT,ENDLINE OPERAND IS GF,ENDLINE,OR,WRITE,BLANKEXP,ENDLINE GF IS TREE,GFN,REPEAT GFN IS ',',TREE,OR,',',WRITE,BLANKEXP TREE IS '*',EXPR,WRITE,INDIROP,OR,EXPR,OR,'*',; WRITE,BLANKEXP,WRITE,INDIROP EXPR IS PRIM1,DELIM,OR,LIST,OR,; '=',WRITE,SBLSYM+1,EXPR,WRITE,ENDSBSYM,OR,; WRITE,BEGINEXP,TERM,WRITE,ENDEXP LIST IS '(',WRITE,BEGINLIST,GF,')',DELIM,WRITE,ENDLIST TERM IS FA5,CL6,REPEAT CL6 IS ORCHAR,CL6A ORCHAR IS '|',OR,X'B4' CL6A IS ORCHAR,FA5,WRITE,XOROP,OR,FA5,WRITE,OROP FA5 IS FA4,CL5,REPEAT CL5 IS '&',FA4,WRITE,ANDOP FA4 IS FA3,CL4,REPEAT CL4 IS '=',FA3,WRITE,EQUALOP,OR,'~','=',FA3,WRITE,UNEQLOP,; OR,'>','=',FA3,WRITE,GTEQOP,OR,'>',FA3,WRITE,GRTROP,; OR,'<','=',FA3,WRITE,LTEQOP,OR,'<',FA3,WRITE,LESSOP,; OR,X'B5','=',FA3,WRITE,UNEQLOP FA3 IS FA2,CL3,REPEAT CL3 IS '+',FA2,WRITE,PLUSOP,OR,'-',FA2,WRITE,MINUSOP FA2 IS FA1,CL2,REPEAT CL2 IS '*',FA1,WRITE,MPYOP,OR,'/','/',FA1,WRITE,INCLDIV,; OR,'/',FA1,WRITE,DIVOP FA1 IS PRIMARY,CL1,REPEAT CL1 IS '*','*',PRIMARY,WRITE,SCALEOP PRIMARY IS PRIM1,OR,'-',WRITE,SMALLINT,PRIMARY,WRITE,MINUSOP,; OR,'~',MINUS%ONE,PRIMARY,WRITE,XOROP,; OR,'+',WRITE,SMALLINT,PRIMARY,WRITE,PLUSOP,; OR,'(',TERM,')',; OR,X'B5',MINUS%ONE,PRIMARY,WRITE,XOROP PRIM1 IS SYMBOL,ATTRIBCK,OR,INTEGER,OR,'X','''',HEXC,; '''',OR,OPTNLC,'''',ALF,'''',OR,'F',FXDORFLT,; OR,'O','''',OCTC,'''',OR,'D','''',PKDEC,'''',; OR,COMMACK,WRITE,BLANKEXP FXDORFLT IS 'X','''',FXC,'''',OR,'S','''',FSC,'''',OR,; 'L','''',FLC,'''' OPTNLC IS 'C',OR SUBSYMB IS GF,')',WRITE,ENDSBSYM BOUND 4 ORG,4 % GO BACK TO WORD RESOLUTION PAGE * D R I V E R . S Y N T A X T A B L E D R I V E R * THIS ROUTINE CONTROLS THE SYNTAX ANALYSIS PROCESS, UNDER * CONTROL OF THE SYNTAX TABLE AND THE INPUT TO BE ANALYZED. * * THE SYNTAX TABLE CONTAINS THE ACCEPTABLE SYNTAX OF THE LANGUAGE * BEING ANALYZED AS A SEQUENCE OF 16 BIT ENTRIES. SEE 'IS' * PROC FOR THE FORMAT OF EACH ITEM. A SYNTAX ITEM IS ONE OF * THE FOLLOWING: * (A) A (LITERAL) CHARACTER. THE NEXT INPUT CHARACTER IS * MATCHED WITH THIS CHARACTER. IF EQUAL, ANALYSIS * PROCEEDS; OTHERWISE IT FAILS, AND AN ALTERNATE IS * INSPECTED IF PRESENT. * (B) REFERENCE TO A SYNTAX ELEMENT. AN ENTRY IN THE * RECURSIVE 'LEVEL' TABLE IS MADE, AND SYNTAX ANALYSIS * PROCEEDS WITH THE REFERENCED SYNTAX ELEMENT. * (C) REFERENCE TO A SEMANTIC ROUTINE. THE DRIVER BRANCHES * TO THE SEMANTIC (ASSEMBLY CODE) ROUTINE WHICH CAN * GENERATE OUTPUT, CHECK SYNTAX, OR WHATEVER. THESE * ROUTINES RETURN TO THE DRIVER AT LOCATION 'TRUE', * OR 'FALSE' AS APPROPRIATE * * SEMANTIC ROUTINE 'ENDEQN' DOES THE PROCESSING WHEN * AN ENTIRE SYNTAX STATEMENT (OR EQUATION) IS TRUE. * IT DELETES THE CURRENT LEVEL TABLE ENTRY, AND * CONTINUES PROCESSING AT THE NEXT OUTER LEVEL. * * SEMANTIC ROUTINE 'REPEAT' CAUSES THE PREVIOUS SYNTAX * ENTRY (WHICH MUST BE A REFERENCE TO A SYNTAX ELEMENT) * TO BE REPEATED UNTIL IT BECOMES FALSE. WHEN THIS * OCCURS, ANALYSIS PROCEEDS WITH THE NEXT SYNTAX * ELEMENT AS IF THE REPEATED ELEMENT TERMINATED AS TRUE. * * EXIT FROM THE DRIVER IS MADE (AT ANY SYNTAX LEVEL) * BY REFERENCING SEMANTIC ROUTINE 'EXITSYN'. PAGE * DRIVER RES 0 STW,RL DRIVEREXIT LI,IN 0 CLEAR INPUT INDEX STW,IN CONTIN%ERROR CONTINUATION ERROR FLAG LW,LVL LOCX AI,LVL -10 STW,LVL LVLBASE LEVEL TABLE BASE AI,LVL -4 START OF 1ST ENTRY * * SET INPUT BUFFER START MIDWAY BETWEEN END OF SYMBOL TABLE AND * START OF LEVEL TABLE, BUT NOT ABOVE PRE-DETERMINED BOUNDARY * OF AREA TO BE HELD OUT IF DISK SPILL INVOKED. * LW,RL NEXTST AI,RL HED AW,RL LVL SLS,RL -1 CW,RL INBUFLMT IF,G LW,RL INBUFLMT FI STW,RL INBUF FIXED BUFFER START STW,RL BUFPTR LAST RECORD START BAL,RL READCARD READ A RECORD. LW,N IM@MAJOR MTW,0 NIVO WITHIN A SYSTEM BNEZ DRIVR1 BRANCH IF YES. USE IM@MAJOR MTW,0 IM@MINOR IS THIS AN INSERTED LINE BEZ DRIVR1 BRANCH IF NO. USE IM@MAJOR LI,N 0 USE ZERO FOR AN INSERT DRIVR1 RES 0 CI,N 8191 WILL LINE # FIT AS A SMALL INT BG DRIVR2 BRANCH IF NO AI,N SMALLINT B DRIVR3 DRIVR2 RES 0 LI,N LARGEINT+1 BAL,RL WDOUT LW,N IM@MAJOR DRIVR3 RES 0 BAL,RL WDOUT STW,OUT NEXTLINE# INDEX TO CONTINUATION LINE # LW,N SYN NEXTLEVEL RES 0 CW,LVL BUFPTR LEVEL TABLE OVERFLOW BLE OVERFLOW YES LCI 3 SAVE IN, OUT, AND SYN STM,IN LVLTBL,LVL IN THE SYNTAX LEVEL TABLE AI,LVL -3 LW,SYN N TRUE1 RES 0 LH,N SYNTAX,SYN NEXT SYNTAX ELEMENT BGZ NOTSYNREF NOT A REFERENCE TO A SYNTAX EQN AND,N =ADDRESS TRIM ADDRESS AND BRANCH B NEXTLEVEL TO BEGIN A NEW SYNTAX LEVEL NOTSYNREF RES 0 CI,N TYPE TEST FOR A CHARACTER BAZ CHARACTEREF OR SEMANTIC ROUTINE REFERENCE AND,N =ADDRESS B SEMANBAS,N BRANCH TO THE SEMANTIC ROUTINE * SYNTAX ELEMENT IS A CHARACTER CHARACTEREF RES 0 AND,N =ADDRESS BAL,RL CHAR GET NEXT INPUT CHARACTER (IN 'CRG') CW,N CRG BE TRUE * A SYNTAX ELEMENT IS FALSE FALSE RES 0 AI,SYN 1 ADVANCE TO NEXT SYNTAX ELEMENT LH,N SYNTAX,SYN AND,N =NOTINCR CLEAR INCREMENT FIELD CI,N TYPE1REPEAT IS THIS ELEMENT 'REPEAT' BNE FALSE1 NO LCI 2 RESET 'IN' AND 'OUT' FROM THIS LM,IN LVLTBL,LVL SYNTAX LEVEL TRUE RES 0 AI,SYN 1 GO TO NEXT SYNTAX ELEMENT B TRUE1 FALSE2 AI,LVL 3 BACK-UP ONE SYNTAX LEVEL LW,SYN LVLTBL+2,LVL REPLACE NEXT SYN. EQN. ADDRESS B FALSE FALSE1 RES 0 LH,N SYNTAX,SYN ADVANCE SYNTAX TABLE POINTER TO AND,N =INCR THE NEXT 'OR' OR 'ENDEQN' SLS,N -ADDRSIZE ELEMENT AW,SYN N LH,N SYNTAX,SYN CI,N TYPE1OR IS THE ELEMENT AN 'OR' BNE FALSE2 NO LCI 2 YES. RESET REG'S 'IN' AND 'OUT' LM,IN LVLTBL+3,LVL TO RE-START AFTER THE 'OR' ON B TRUE THE SAME LEVEL * SEMANBAS RES 0 * * THE ENTIRE SYNTAX EQUATION IS TRUE ENDEQN NOP 0 OR RES 0 AI,LVL 3 BACK-UP ONE SYNTAX LEVEL LW,SYN LVLTBL+2,LVL B TRUE * REPEAT THE PREVIOUS SYNTAX ELEMENT (MUST BE A SYNTAX EQUATION) REPEAT RES 0 AI,SYN -1 BACK-UP SYNTAX TABLE POINTER B TRUE1 * EXIT FROM THE SYNTAX DRIVER EXITSYN RES 0 B *DRIVEREXIT TYPE1REPEAT EQU X'4000'+(REPEAT-SEMANBAS) TYPE1OR EQU X'4000'+(OR-SEMANBAS) PAGE * * A L F * CONCATINATE THE CHARACTERS OF AN ALPHANUMERIC CONSTANT. * CONSTANT IS TERMINATED BY A SINGLE PRIME (') CHARACTER. * TWO CONSECUTIVE PRIMES CAUSE A SINGLE PRIME TO BE ENTERED * IN THE CONSTANT. CHARACTERS ARE PACKED FOUR/WORD,AND * OUTPUT BY THIS ROUTINE AS MULTIPLE WORD INTEGERS. THE LAST * CHARACTERS ARE LEFT-ADJUSTED. * ALF RES 0 LI,XT 0 STW,XT OVFLAG CLEAR TRUNCATION FLAG MTW,1 ALFLAG SET FOR NO CONTINUATION ALF1 RES 0 BAL,RL CHAR NEXT CHARACTER CI,CRG '''' BNE ALF2 BAL,RL CHAR TEST FOR DOUBLE PRIME CI,CRG '''' BNE ALF5 BRANCH IF ONLY SINGLE PRIME ALF2 RES 0 AI,XT 1 STB,CRG SYM1,XT NO, STORE CHAR B ALF1 ALF5 RES 0 STB,XT SYM1 CW,XT LASTIN BL ALF3 BRANCH IF STILL WITHIN CURR LINE MTW,+1 OVFLAG TRAILING PRIME IS MISSING ALF3 RES 0 AI,IN -1 LI,N LARGEINT+CT2 LARGE INTEGER, CONVERSION TYPE 2 AI,XT 1 CI,XT 1 TEST CHARACTER COUNT BAZ ALF4 BRANCH IF EVEN LI,CRG ' ' AND STORE A TRAILING BLANK STB,CRG SYM1,XT AI,XT 1 MAKE CHARACTER COUNT EVEN ALF4 RES 0 LI,CRG 0 STW,CRG ALFLAG RESET ALFLAG SLS,XT -1 WRICONST RES 0 AW,N XT ADD HALFWORD COUNT TO CONTROL ITEM BAL,RL WDOUT OUTPUT THE TYPE 7 CONTROL ITEM * OUTPUT EACH SIGNIFICANT HALFWORD OF THE CONVERTED CONSTANT ALF7 RES 0 LH,N SYM1,CRG ALF6 BAL,RL WDOUT AI,CRG 1 BDR,XT ALF7 B HEXC11 * * B L A N K A N D B L A N K 1 6 * BLANK ROUTINES. SKIP FROM 1 THROUGH 70 BLANKS. * EXIT IS TO 'TRUE' IF ONE OR MORE BLANKS IS SKIPPED, * ELSE EXIT TO 'FALSE'. * * BLANK16 IS THE ENTRY WHICH SKIPS UP TO 16 BLANKS INSTEAD OF 70. * BLANK RES 0 LI,N 69 B BLNK1 BLANK16 RES 0 LI,N 14 BLNK1 RES 0 BAL,RL CHAR FIRST CHARACTER CI,CRG ' ' BE BLNK2 YES, CONTINUE SCAN BLNKLBL2 RES 0 CI,CRG X'05' NO, TAB BE TRUE YES B FALSE NO BLNK2 RES 0 CB,CRG *INBUF,IN IS NEXT CHAR. BLANK BE BLNK3 YES BAL,RL CHAR INSPECT CHARACTER PAST LAST BLANK CI,CRG X'05' NO, IS IT A TAB BE TRUE YES AI,IN -1 BLNK4 RES 0 CW,IN LASTIN IF 'IN' IS OFF END OF CARD, BLE TRUE RESET BACK TO END * LW,IN LASTIN B TRUE * BLNK3 RES 0 AI,IN 1 BDR,N BLNK2 CHECK NEXT CHAR B BLNK4 COUNT EXHAUSTED * * B L N K L B L * BLNKLBL RES 0 LW,CRG L(' ') CW,CRG *INBUF ARE 1ST 4 CHARS BLANK BE BLNKLBL3 YES LB,CRG *INBUF NO, IS 1ST CHAR BLANK LI,IN 1 CI,CRG ' ' BE BLNKLBL5 YES CI,CRG '*' NO, FIRST CHAR = '*' BNE BLNKLBL2 NO LI,N BLANKEXP YES, COMMENT DIRECTIVE BAL,RL WDOUT LI,N COMNTDIR BAL,RL WDOUT LI,N ENDLN BAL,RL WDOUT B EXITSYN BLNKLBL3 LI,IN 4 LI,N 1 CW,CRG *INBUF,N ARE 2ND 4 CHARS BLANK BNE %+2 NO LI,IN 8 YES BLNKLBL5 RES 0 LI,N 70 SW,N IN LI,CRG ' ' B BLNK2 * * C F 1 S Y M * PROCESS THE COMMAND SYMBOL * * THE FIRST SYMBOL IN THE COMMAND FIELD HAS BEEN READ AND * STORED IN THE ITEM BEGINNING AT HED. THE SYMBOL TABLE * IS SEARCHED, A SYMBOL ITEM IS OUTPUT, AND THE CF1 BIT * IS SET IN THE SYMBOL TABLE. THE OUTPUT COMMAND IS STORED * IN CURRCMND. * CF1SYM RES 0 LW,RT3 CURRCMND STW,RT3 LASTCMND CALL *SEARCHV B CF1S7 NOT FOUND IN SYMBOL TABLE CI,N 8192 IS IT LOCAL BL CF1S8 NO * GET THE NON-LOCAL SYMBOL NUMBER FROM THE APPROPRIATE LOCAL TABLE * ADDRESS = ORIGIN - 2*(LOCAL-SYMBOL-NUMBER) AND,N =ENCVAL SAVE LOCAL-SYMBOL-NUMBER SLS,N 1 MPY BY 2 LW,M1 SLOC USE PROC LOCAL TABLE IF WITHIN LW,CT PROCLV A PROC; OTHERWISE USE SOURCE BEZ %+2 LOCAL TABLE LW,M1 PLOC SW,M1 N LW,N SNOFFSET,M1 AND,N =ENCVAL TRIM THE SYMBOL NUMBER MTW,-1 INCORESF DON'T LET LOCAL STORE CAUSE WRITE B CF1S8 CF1S7 RES 0 CALL *INSERTV CF1S8 RES 0 LW,RT1|1 =CF1FLD SET THE CF1 BIT ON STS,RT1|1 PTROFFSET,M1 MTW,+1 INCORESF SET DIRTY-PAGE FLAG AI,N SYMTYPE MAKE IT A SYMBOL CF1S2 RES 0 STW,N CURRCMND BAL,RL WDOUT OUTPUT THE COMMAND CLM,N RNG%SYN%DIR COULD THIS HAVE A SPECIAL IF,IL -50- SYNTAX EQUATION? AND,N L(ENCVAL) GET LOCATION OF APPROPRIATE LH,N DIRBR,N SYNTAX EQUATION BNEZ NEXTLEVEL * B TRUE * FI -50- CLM,N RNG%DFN%DIR BOL TRUE * CI,N COMDIR IF THIS IS 'COM', 'CNAME', OR BE EXCHSLOC 'FNAME' , DELETE THE CI,N CNAMEDIR CURRENT LOCAL TABLE BE EXCHSLOC ON THE SOURCE LEVEL CI,N FNAMEDIR BNE TRUE B EXCHSLOC * * C M N D E R R * HERE TO OUTPUT A SYNTAX ERROR FOR THE COMMAND FIELD * CMNDERR RES 0 LI,N SYNERR B CF1S2 GO STORE & SET CURRCMND PAGE * * SEMANTIC ROUTINES FOR CONCORDANCE CONTROL COMMAND PROCESSING * * * R E S E T O U T * DELETE THE DUMMY CN LINE NUMBER BY BACKING UP * THE OUTPUT INDEX. * RESETOUT RES 0 LW,OUT OUTSAVE INDEX AT START OF LINE B TRUE * * S E T C N I O * NOTE BEGINNING OF .IO CONCORDANCE COMMAND * SETCNIO RES 0 LV,RT1 CNIOMODE LV,RT2 CNIOFLG B SETCNCOM * * * S E T C N S S * NOTE BEGINNING OF .SS CONCORDANCE COMMAND * SETCNSS RES 0 LW,RT1 CNCTRL CV,RT1 CNOSFLG CANNOT HAVE HAD PREVIOUS .OS BANZ CNERR2 * LV,RT1 CNSSMODE LV,RT2 CNSSFLG B SETCNCOM * * * S E T C N O S * NOTE BEGINNING OF .OS CONCORDANCE COMMAND * SETCNOS RES 0 LW,RT1 CNCTRL CV,RT1 CNSSFLG CANNOT HAVE HAD PREVIOUS .SS BANZ CNERR2 * LV,RT1 CNOSMODE LV,RT2 CNOSFLG B SETCNCOM * * * S E T C N D S * NOTE BEGINNING OF .DS CONCORDANCE COMMAND * SETCNDS RES 0 LV,RT1 CNDSMODE LV,RT2 CNDSFLG * (FALL THROUGH) * SETCNCOM RES 0 LW,N CNCTRL AND,N L(CNFLGFLD) SAVE OLD FLAGS OR,N RT2 MERGE NEW FLAGS STB,RT1 N SET TYPE CODE STW,N CNCTRL B TRUE * * * E N D C N D S * FINISH PROCESSING OF .DS CONCORDANCE COMMAND * ENDCNDS RES 0 LI,N 1 STH,N LS%FLAG OVERRIDE LS OPTION IF SPECIFIED LI,N 0 STW,N DSLNCTRL LW,OUT OUTSAVE DELETE DUMMY LINE NUMBER B EXITSYN * * * E N D C N I O * FINISH PROCESSING OF .IO CONCORDANCE COMMAND * ENDCNIO RES 0 LV,RT1 CNIOFLG1 B ENDCNCOM * * * E N D C N S S * FINISH PROCESSING OF .SS CONCORDANCE COMMAND * ENDCNSS RES 0 LV,RT1 CNSSFLG1 * (FALL THROUGH) * ENDCNCOM RES 0 LW,N CNCTRL CV,N X'FFFF' IF,ANZ OR,N RT1 SET USE FLAG STW,N CNCTRL LV,N ENDLN CALL WDOUT FI B EXITSYN GET OUT OF EQUATIONS * * * C N S Y M * PROCESS THE SYMBOL SPECIFIED IN A CONCORDANCE CONTROL * COMMAND NAME LIST. * CNSYM RES 0 CALL *SEARCHV CALL *INSERTV LB,XT CNCTRL GET ID CODE FOR OPTION IN PROGRESS CV,XT CNDSMODE IF,EQ .DS JUST SETS A BIT IN THE SYMT LV,XT DSSYMBIT STS,XT *FND MTW,+1 INCORESF SET DIRTY-PAGE FLAG ELS ALL OTHERS GO OUT TO ENCODED BUFFER SHIFT,XT 31,16+2 AW,N XT CALL WDOUT FI MTW,+1 CNCTRL TALLY NAME-LIST SYMBOL B TRUE * * * C N T E R M * WRAP UP CONCORDANCE CONTROL COMMAND PROCESSING * CNTERM RES 0 IF,G 1,OUT DON'T WRITE AN EMPTY BUFFER CALL IO%X3 WRITE ANYTHING IN THE BUFFER FI LH,XT DC%FLAG CI,XT 2 DID CN CONTROLS COME FROM X1? IF,EQ BAL,X7 FIN%X1 REWIND X1 FI LW,N CNCTRL AND,N L(CNFLGFLD) SAVE OPTION & NAME-LIST FLAGS AI,N 1**16 LW,XT NUMRECX3 STB,XT N SAVE X3 RECORD COUNT STW,N DC%FLAG LI,XT 0 STW,XT CNCTRL CLEAR CN CONTROL TOGGLE B EXITSYN GET OUT OF EQUATIONS * * * C N E R R 1 * READ A NON-'.' CARD WHILE ACCESSING CN CONTROLS * CNERR1 RES 0 LCI 15 STM,1 SAVAREA SAVE REGS LCI 10 LM,1 CNERR1%MSG STM,1 LSTBF (WRITELO MAY TRY TO MODIFY BUFFER) LI,IOADD LSTBF LI,IOSIZE 40 BAL,IORL WRITELO LCI 15 LM,1 SAVAREA RESTOTE REGS B TRUE * * * C N E R R 2 * ERROR IN PROCESSING A CN CONTROL * CNERR2 RES 0 LV,N CNERR ERROR CODE CALL WDOUT LV,N ENDLN CALL WDOUT B TRUE PAGE * * R E A D C A R D * READ NEXT RECORD AND MOVE TO INBUF. * COMPRESS RECORD AND PUT IN SIBUF. * READCARD RES 0 MTW,0 CNCTRL IF,NZ CN CONTROL COMMANDS BEING SCANNED BAL,IORL READC GET NEXT CN CONTROL B RCMOVE TRANSFER BUFSI TO INPUT AREA * FI BAL,LINK IM@READ READ A RECORD. * 15 SAVED REGISTERS ARE STILL IN SAVAREA MTW,0 LS%FLAG SHALL WE PRINT LS? BEZ AFTER%LS BRANCH IF NO. MTW,0 NIVO DON'T OUTPUT IF BNEZ AFTER%LS WITHIN A SYSTEM * MTW,0 FIRSTREC IF,EZ MTW,+1 FIRSTREC ELS CALL CHK%PRNT PRINT LAST LINE IF NEEDS BE FI BAL,X7 CLRLSTBF LCI 10 MOVE CARD LM,1 BUFSI TO STM,1 LSTBF+5 LISTING LM,1 BUFSI+10 PRINT STM,1 LSTBF+15 BUFFER LI,X2 7 LI,X4 '*' LW,X5 IM@MINOR GET BNEZ LS#3 LINE LW,X5 IM@MAJOR NUMBER, B LS#5 EDIT LINE LS#4 LI,X4 0 NUMBER DW,X4 =10 TO AI,X4 X'F0' EBCDIC, LS#3 STB,X4 LSTBF+2,X2 INSERT ASTERISK LS#5 AI,X2 -1 IF AI,X5 0 LINE IS BNEZ LS#4 FROM UPDATE PACKET, THEN PRINT LINE * AFTER%LS EQU % LI,IN BUFSI SAVE ADDRESS STW,IN CARDADDR OF CARD IMAGE * * COMPRESS A SOURCE RECORD * OPEN RT1,RL,LINK RESOLVE A REGISTER CONFLICT RL EQU 4 LINK EQU 5 RT1 EQU 2 LW,OUT CMPOUTSV LI,CT X'21' LI,XT 19 LW,N L(' ') CW,N BUFSI,XT SEARCH FOR TRAILING BLANKS BNE CMP15 BDR,XT %-2 CW,N BUFSI IS ENTIRE RECORD BLANK BE CMPEND25 YES, WRITE END RECORD ITEM CMP15 AWM,XT CARDADDR NO LCW,XT XT CMP16 CW,N *CARDADDR,XT SEARCH FOR LEADING BLANKS BNE CMP17 AI,CT 4 BIR,XT CMP16 CMP17 MTW,+1 CARDADDR SLS,XT 2 AI,XT -5 CI,CT X'21' ANY LEADING BLANKS BE CMP25 NO AI,CT -1 YES LI,RT1 ' ' SET REPEAT CHAR = ' ' STW,RT1 CMPCHAR B CMP46 GO OUTPUT CMP25 BIR,XT %+2 GET B CMPEND A LB,RT1 *CARDADDR,XT CHAR. CMP26 STW,RT1 CMPCHAR SAVE CI,RT1 X'3F' IS IT A SPECIAL CHAR BG CMP35 NO CI,RT1 X'20' BL CMP35 NO LI,N X'21' YES, WRITE X'21' SPEC. CHAR BAL,RL CMPOUT LW,N RT1 BAL,RL CMPOUT WRITE SPECIAL CHAR B CMP25 CMP35 BIR,XT %+2 GET B CMPEND A LB,RT1 *CARDADDR,XT CHAR. CW,RT1 CMPCHAR SAME AS LAST CHAR BNE CMP55 NO, CMP45 AI,CT 1 ADD 1 TO REPEAT COUNT CMP46 BIR,XT %+2 GET B CMPEND A LB,RT1 *CARDADDR,XT CHAR. CW,RT1 CMPCHAR SAME AS LAST CHAR BE CMP45 YES CMP50 BAL,LINK CMPRPT B CMP26 CMP55 LW,N CMPCHAR BIR,OUT CMP60 BRANCH IF SIBUF NOT FULL * CALL IO%X3 LI,OUT -BYX3SIZE RESET OUT CMP60 RES 0 STB,N SIBUF+WDX3SIZE,OUT B CMP26 CMPRPT CI,CT X'3F' IS COUNT > X'3F' BG CMPRPT5 YES LW,N CT NO, WRITE REPETITION CONTROL BAL,RL CMPOUT LW,N CMPCHAR BAL,RL CMPOUT WRITE CHARACTER LI,CT X'21' EXIT LINK CMPRPT5 AI,CT -31 LI,N X'3F' BAL,RL CMPOUT WRITE REPEAT ITEM LW,N CMPCHAR BAL,RL CMPOUT WRITE CHAR B CMPRPT CMPEND CI,RT1 X'40' LAST CHAR = ' ' BE CMPEND25 YES BG CMPEND15 NO, > X'40' CI,RT1 X'20' NO, SPECIAL BGE CMPEND25 YES CMPEND15 CI,CT X'21' NO BG CMPEND20 YES LW,N RT1 LI,RL CMPEND25 CMPOUT RES 0 BIR,OUT CMPOUT3 BUFFER FULL - NO * CALL IO%X3 LI,OUT -BYX3SIZE RESET OUT CMPOUT3 RES 0 STB,N SIBUF+WDX3SIZE,OUT MOVE CHARACTER EXIT RL CMPEND20 BAL,LINK CMPRPT CMPEND25 LI,N X'20' BAL,RL CMPOUT WRITE END OF RECORD ITEM STW,OUT CMPOUTSV SAVE OUT INDEX CLOSE RT1,RL,LINK END OF REGISTER CONFLICT AREA * * MOVE 18 WORDS FROM THE BUFSI AREA TO THE NEXT * 18 WORDS IN THE INBUF AREA AND STORE A SPECIAL FLAG * WORD AFTER THE NEXT WORD. * RCMOVE RES 0 LW,1 BUFPTR LW,2 =' ; ' BLANK,SEMICOLON,BLANK,BLANK STW,2 18,1 LCI +9 LM,2 BUFSI STM,2 0,1 LM,2 BUFSI+9 STM,2 9,1 AI,1 18 UPDATE BUFPTR FOR NEXT RECORD STW,1 BUFPTR LCI 15 RESTORE REGISTERS LM,1 SAVAREA CW,LVL BUFPTR BG *RL B OVERFLOW * * C H A R * GET THE NEXT INPUT CHARACTER * THE CHARACTER IS MADE AVAILABLE IN REGISTER 'CRG', AND * THE INPUT POINTER IS BUMPED. * CHAR RES 0 LB,CRG *INBUF,IN NEXT INPUT CHARACTER AI,IN 1 BUMP INDEX TO INBUF CI,CRG ';' TEST FOR CONTINUATION CHARACTER BNE *RL NO. CW,IN LASTIN IS CHAR BEYOND END OF INBUF BLE CHAR1 BRANCH IF WITHIN INBUF LI,CRG ' ' RETURN A BLANK IF NOT IN TEXT MTW,+0 ALFLAG BEZ *RL LI,CRG '''' OTHERWISE RETURN A PRIME EXIT RL CHAR1 RES 0 MTW,0 ALFLAG IF WITHIN A TEXT STRING, BNEZ *RL DON'T ALLOW CONTINUATION * HERE TO PROCESS CONTINUATION STW,RL CHARTEMP SAVE EXIT CHAR5 RES 0 LW,RL IN IF THE NEXT CHARACTER HAS ALREADY AI,RL 72 BEEN INPUT, DON'T RE-READ CW,RL LASTIN BLE CHAR2 BAL,RL READCARD READ THE CONTINUATION LINE LI,N 2 SET # HALFWORDS TO 2 LW,LINK IM@MAJOR GET LINE NUMBER MTW,+0 NIVO USE IM@MAJOR IF WITHIN BNEZ LINE#1 A SYSTEM MTW,+0 IM@MINOR USE ZERO IF THIS IS AN INSERT BEZ LINE#1 BRANCH IF NOT AN INSERT LI,LINK 0 LINE#1 RES 0 CI,LINK X'1FFF' WILL LINE # FIT AS SMALL INTEGER BG LINE#2 BRANCH IF NO AI,LINK SMALLINT LI,N 1 * ADD SIZE OF INSERT LINE NUMBER TO EACH 'OUT' ENTRY IN LVLTBL LINE#2 RES 0 LW,IN LVL AI,IN 3 LVL POINTS TO NEXT AVAILABLE LINE#6 RES 0 AWM,N LVLTBL+1,IN ADD SIZE TO 'OUT' ENTRY AI,IN 3 ADVANCE ADDRESS BY LVLTBL SIZE CW,IN LVLBASE BL LINE#6 LINE#7 RES 0 LW,IN OUT AW,IN N STW,IN SAVAREA-1+OUT STORE FINAL ADDRESS OF OUT CI,IN OUTSIZE WILL THE LINE NUMBER FIT IN OUTBUF BL LINE#3 BRANCH IF YES BAL,RL WDOUT TERMINATE OUTBUF BY OUTPUTTING BAL,RL WDOUT TWO DUMMY ENTRIES AI,OUT -2 DELETE THE DUMMY ENTRIES B LINE#7 LINE#3 RES 0 LW,RL OUT PUT SIZE OF LINE IN RL SW,RL NEXTLINE# BEZ LINE#8 NO ENTRIES TO MOVE LINE#4 RES 0 AI,IN -1 MOVE OUTBUF DOWN TO MAKE AI,OUT -1 ROOM FOR THE INSERT LH,RT4 OUTBUF,OUT LINE NUMBER STH,RT4 OUTBUF,IN BDR,RL LINE#4 LINE#8 RES 0 AWM,N NEXTLINE# BUMP ADDRESS FOR NEXT LINE NUMBER CI,N 1 IS LINE # A SINGLE HALFWORD BE LINE#5 YES LI,N LARGEINT+1 NO. OUTPUT LARGE INTEGER CONTROL BAL,RL WDOUT LINE#5 RES 0 LW,N LINK OUTPUT LAST HALFWORD OF LINE # BAL,RL WDOUT LCI +15 RESTORE ALL REGISTERS LM,1 SAVAREA LW,IN LASTIN LI,RL 72 AWM,RL LASTIN B CHAR6 CHAR2 RES 0 LW,RL IN LI,IN 0 CHAR4 RES 0 AI,IN 72 CW,IN RL BL CHAR4 CHAR6 RES 0 LB,CRG *INBUF,IN THE FIRST CHARACTER OF A CI,CRG ' ' CONTINUED RECORD SHOULD BE BLANK BE CHAR7 CI,CRG X'05' IT COULD ALSO BE 'TAB' BE CHAR7 * CI,CRG '*' IS IT A COMMENT BNE CHAR8 NO AI,IN 1 B CHAR5 GO READ NEXT LINE CHAR8 RES 0 MTW,+1 CONTIN%ERROR SET CONTINUATION ERROR FLAG B CHAR9 * ELIMINATE LEADING BLANKS ON THE CONTINUED RECORD CHAR7 RES 0 AI,IN 1 CW,IN LASTIN BAD IF ENTIRE RECORD IS BLANK BE CHAR8 LB,CRG *INBUF,IN CI,CRG ' ' BE CHAR7 * CI,CRG X'05' CHECK FOR 'TAB' BE CHAR7 CHAR9 RES 0 LW,RL CHARTEMP B CHAR * * C L O S E S Y M * 'CLOSE' THE NEXT SYMBOL OF A CLOSE DIRECTIVE * CLOSESYM RES 0 CALL *SEARCHV CALL *INSERTV CI,N 8192 ERROR IF THE SYMBOL IS LOCAL BANZ OPENSYM1 LW,RT2 =CLOFLD SET THE CLOSE BIT ON STS,RT2 PTROFFSET,M1 MTW,+1 INCORESF SET DIRTY-PAGE FLAG B SYMOUT * * C O M M A C K * COMMACK RES 0 BAL,RL CHAR COMMACK1 RES 0 CI,CRG ',' BE RESETCHT B FALSE * * D E L I M * CHECK FOR A DELIMITER. (COMMA,BLANK, OR RT. PAREN.) * DELIM RES 0 BAL,RL CHAR CI,CRG ' ' BE RESETCHT CI,CRG TAB BE RESETCHT CI,CRG ')' BNE COMMACK1 B RESETCHT * * C R E A T E 1 S T * * CREATE A SYMBOL TABLE ENTRY LINKED TO THE MAIN ENTRY * LOCATION OF THE ENTRY TO BE LINKED IS IN M1 * CREATE1ST RES 0 LW,XT NEXTST CW,XT SYMLMTM1 IF,EQ DOIF 2-WD ENTRY WOULD BRIDGE AI,XT 1 SPILL PAGE BOUNDARY. MTW,+1 NEXTST FI LW,CT PTROFFSET,M1 AND,CT =PTRFLD+CLOFLD+CF1FLD STW,CT PTRWD,XT LW,RT1 =PTRFLD LW,RT2 =PTRFLD+CLOFLD+CF1FLD STS,RT1 PTROFFSET,M1 LW,RT1 SNOFFSET,M1 STW,RT1 SNWD,XT STH,XT RT1 LW,RT2 =SNFLD STS,RT1 SNOFFSET,M1 LW,M1 XT AI,M1 HED MTW,2 NEXTST EXIT RL * * E N D L I N E * ENDLINE RES 0 LW,RL CONTIN%ERROR ARE THERE CONTINUATION ERRORS BNEZ ENDLINE2 BRANCH IF YES BAL,RL CHAR CI,CRG ' ' BE ENDLINE1 CI,CRG TAB BE ENDLINE1 ENDLINE2 RES 0 LI,N SYNERR BAL,RL WDOUT OUTPUT THE SYNTAX ERROR ENDLINE1 RES 0 LI,N ENDLN BAL,RL WDOUT B EXITSYN * * E X C H S L O C * EXCHANGE SOURCE LEVEL LOCAL TABLE TABLE WITH SYMBOL TABLE * EXCHSLOC RES 0 BAL,RL EXCHS1 B TRUE EXCHS1 RES 0 LW,XT SLOC * COMPUTE NUMBER OF ENTRIES IN SOURCE LEVEL LOCAL TABLE LCW,CT LOCX USE SLOC-LOCX IF ON SOURCE LEVEL MTW,0 PROCLV BEZ %+2 LCW,CT PLOC USE SLOC-PLOC IF WITHIN A PROC AW,CT SLOC ADD BASE ADDRESS OF SOURCE TABLE SLS,CT -1 B SWAPLOC SWAP LOCAL TABLES AND RETURN * * I N T E G E R * CONVERT THE DIGITS OF A DECIMAL INTEGER. AFTER THE FIRST * NON-DECIMAL CHARACTER IS FOUND, EXIT TO NUMOUT TO OUTPUT * THE CONVERTED NUMBER AND BACK-UP THE INPUT POINTER. * INTEGER RES 0 BAL,RL CHAR FIRST CHARACTER MUST BE LB,RT2 CONVTBL,CRG DECIMAL, OR EXIT TO FALSE CI,RT2 DEC BAZ FALSE AND,RT2 L(X'F') LI,RT1 0 STW,RT1 OVFLAG RESET OVERFLOW FLAG INTGR1 BAL,RL CHAR GET NEXT CHARACTER LB,CRG CONVTBL,CRG IF NOT DECIMAL CI,CRG DEC EXIT TO NUMOUT TO OUTPUT THE BAZ NUMOUT CONVERTED NUMBER AND,CRG L(X'F') CLEAN DIGIT SAD,RT1 1 MULTIPLY ACCUMULATED INTEGER STD,RT1 RT3 BY 10 AND ADD CURRENT DIGIT BNOV %+2 MTW,1 OVFLAG SAD,RT1 2 BNOV %+2 MTW,1 OVFLAG AD,RT1 RT3 BNOV %+2 MTW,1 OVFLAG AW,RT2 CRG BNC CHAR AI,RT1 1 BNOV CHAR MTW,1 OVFLAG B CHAR * * M I N U S % O N E * OUTPUT AN ENCODED MINUS ONE * MINUS%ONE RES 0 AI,IN 1 ADJUST FOR SUBTRACT AT RESETCHT LI,RT1 -1 LI,RT2 -1 B NUMOUT PAGE * * H E X I N T * READ AND CONVERT THE CHARACTERS OF A HEXADECIMAL INTEGER * SAME GROUND RULES AS OCTINT * HEXC RES 0 LI,CT HEX INDICATOR BIT FOR HEX LI,XT 4 SHIFT AMOUNT FOR HEX LW,RT1 =X'10000000' TRUNCATION TEST MASK HEXC1 RES 0 STW,RT1 M0 SAVE TRUNCATION TEST MASK LI,RT1 0 CLEAR CONVERTED NUMBER LI,RT2 0 STW,RT1 OVFLAG CLEAR TRUNCATION FLAG BAL,RL CHAR FIRST CHARACTER LB,CRG CONVTBL,CRG CW,CRG CT MUST BE HEX (OR OCTAL) BANZ HEXC3 IT IS B FALSE HEXC2 RES 0 CW,RT1 M0 TEST FOR TRUNCATION BL %+2 NO MTW,+1 OVFLAG SET TRUNCATION FLAG SAD,RT1 0,XT SHIFT LEFT 3 OR 4 HEXC3 RES 0 AND,CRG L(X'F') OR,RT2 CRG AND INSERT IT IN CONSTANT BAL,RL CHAR NEXT CHARACTER LB,CRG CONVTBL,CRG CW,CRG CT BANZ HEXC2 BRANCH IF HEX (OR OCTAL) * FINISHED WITH CONVERSION. NOW OUTPUT THE CONSTANT NUMOUT RES 0 CI,RT1 0 IS HIGH ORDER 32 BITS ZERO BEZ HEXC6 YES LI,N LARGEINT+4 BAL,RL WDOUT TYPE 7 CONTROL WORD NUMOUT1 LH,N RT1 BAL,RL WDOUT HIGH ORDER 16 BITS,M.S. WORD LW,N RT1 HEXC5 RES 0 BAL,RL WDOUT LOW 16 BITS, M.S. WORD NUMOUT2 RES 0 LH,N RT2 HEXC8 BAL,RL WDOUT HIGH 16 BITS, L.S. WORD LW,N RT2 B HEXC10 HEXC6 RES 0 LH,N RT2 TEST HIGH 16 BITS OF L.S. WORD BEZ HEXC7 LI,N LARGEINT+2 B HEXC5 HEXC7 RES 0 CI,RT2 8191 WILL CONSTANT FIT IN 13 BITS BLE HEXC9 YES. OUTPUT AS A TYPE 6 CONSTANT LI,N LARGEINT+1 B HEXC8 HEXC9 RES 0 LI,N SMALLINT AW,N RT2 HEXC10 RES 0 BAL,RL WDOUT HEXC11 RES 0 LW,N OVFLAG IS TRUNCATION FLAG SET BEZ RESETCHT NO, IT'S NOT LI,N TRUNERR BAL,RL WDOUT B RESETCHT * * L C L D L T E * DELETE THE CURRENT LOCAL TABLE. DON'T DELETE IF CURRENT * COMMAND AND LAST COMMAND ARE LOCAL DIRECTIVES * LCLDLTE RES 0 LI,XT 0 STW,XT CURLOCNT CLEAR CURRENT LOCAL COUNT LW,XT LASTCMND CW,XT CURRCMND BE TRUE BAL,RL LCLDL1 B TRUE LCLDL1 RES 0 * DELETE THE SOURCE LEVEL LOCAL TABLE IF NOT WITHIN A PROC; * OTHERWISE DELETE THE PROC LEVEL LOCAL TABLE LW,XT SLOC LW,RT1 PROCLV BEZ %+2 LW,XT PLOC LW,CT XT COMPUTE NUMBER OF LOCALS SW,CT LOCX IN THE LOCAL TABLE SLS,CT -1 STW,XT LOCX RESET LOCATION FOR NEXT LOCAL LI,RT1 0 STW,RT1 NXTLOC CLEAR NEXT LOCAL NUMBER B SWAPLOC SWAP LOCAL TABLES AND RETURN * * L O C A L S Y M * ENTER A SYMBOL IN THE CURRENT LOCAL SYMBOL TABLE * LOCALSYM RES 0 LW,RL LOCX IS THERE ENOUGN ROOM CW,RL LVLBASE FOR ANOTHER LOCAL SYMBOL BLE LVLMOVE NO CALL *SEARCHV CALL *INSERTV CI,N 8192 IGNORE THIS SYMBOL IF IT'S BANZ TRUE AI,M1 -HED LW,RL PTRWD,M1 LW,RT3 SNWD,M1 LW,XT LOCX STW,RL PTROFFSET,XT MOVE FLAGS TO LOCAL FLAGS LW,RT1 NXTLOC CI,RT1 255 TOO MANY LOCAL SYMBOLS BG OPENSYM1 YES AI,RT1 8192 LW,RT2 L(GLFLD) CW,RL L(PTRFLD) TEST PTR BIT TO FIND WHERE SN IS BANZ LOCSYM1 SLS,RT3 -16 SLD,RT1 16 LOCSYM1 RES 0 STS,RT1 GLWD,M1 STORE LOCAL SYMBOL NUMBER MTW,+1 INCORESF SET DIRTY-PAGE FLAG LW,RT2 =CF1FLD+CLOFLD LI,RT1 0 SET SYMBOL TABLE FLAGS STS,RT1 PTRWD,M1 TO LOCAL MTW,0 SPILLFLG IF,NZ DOIF IN SYMT SPILL MODE LW,M1 M1SAVE GET VIRTUAL OFFSET, RATHER THAN REAL AI,M1 -HED FI STH,M1 RT3 STW,RT3 GLOFFSET,XT STORE SN & GL FIELDS IN LOCAL TABLE MTW,1 NXTLOC BUMP NUMBER OF LOCALS MTW,1 CURLOCNT ADD 1 TO CURRENT LOCAL COUNT MTW,-2 LOCX ADVANCE LOCAL TABLE ADDRESS B TRUE LVLMOVE RES 0 LW,XT LVL LVLMOVE2 LW,RL 0,XT MOVE A WORD STW,RL -20,XT IN LEVEL TABLE AI,XT 1 CW,XT LVLBASE FINISHED BLE LVLMOVE2 NO AI,LVL -20 YES, RESET LVL AI,XT -21 STW,XT LVLBASE RESET LEVEL BASE CW,LVL BUFPTR BLE OVERFLOW B LOCALSYM * * W R I T E L O C A L C T * WRITELOCALCT RES 0 LI,N SMALLINT AW,N CURLOCNT ADD LOCAL COUNT B OPENSYM4 * * O C T I N T * READ AND CONVERT THE CHARACTERS OF AN OCTAL INTEGER. * AFTER THE FIRST NON-OCTAL CHARACTER IS FOUND, THE ROUTINE * BRANCHES TO NUMOUT TO OUTPUT THE CONVERTED NUMBER * AND BACK-UP THE INPUT POINTER. * OCTC RES 0 LI,CT OCT INDICATOR BIT FOR OCTAL LI,XT 3 SHIFT AMOUNT FOR OCTAL LW,RT1 =X'20000000' TRUNCATION TEST MASK B HEXC1 * * O P E N S Y M * 'OPEN' THE NEXT SYMBOL OF AN OPEN DIRECTIVE * OPENSYM RES 0 CALL *SEARCHV B OPENSYM3 NOT FOUND. INSERT AND LEAVE CI,N 8192 BAZ OPENSYM2 OPENSYM1 RES 0 LI,N SYNERR OPENSYM4 RES 0 BAL,RL WDOUT B TRUE OPENSYM2 RES 0 LB,XT *M1 IF,NZ CALL *CREATE1STV FI CALL *NEWENTRYV B SYMOUT * S T S T S Y M B * STSTSYMB RES 0 LI,XT 0 STW,XT OVFLAG CLEAR TRUNCATION FLAG STW,XT SIGFLAG TEMP LI,RT4 SMALLINT INIT TEXT CONTROL WORD LB,XT HED CALCULATE BYTE COUNT OF SLS,XT 2 SYS NAME TO NEAREST WD STW,XT LL STW,XT RT2 AI,XT -1 * PUT SYSTEM NAME IN TEXTC FORMAT SYSTEM15 LB,RT1 SYM1,XT MOVE A BYTE STB,RT1 SYM1,LL CI,RT1 ' ' COUNT NUMBER OF BNE %+2 CHAR IN SYS N NAME AI,RT2 -1 AI,XT -1 BDR,LL SYSTEM15 STB,RT2 SYM1 STORE CHAR COUNT CI,RT2 7 DON'T COMPARE IF THERE'S MORE BG SYSTEM50 THAN 7 CHARACTERS * LW,RT1 SYM1 1ST WORD OF SYSTEM NAME LW,RT2 L(X'FFFFFF') CS,RT1 L(' SIG') IS IT 'SIG' BNE SYSTEM50 NO SYSTEM20 RES 0 LW,RT1 SYM1+1 GET 2ND WORD LI,XT SIGTABEND-(SIGTAB+1) # OF SUBSETS SYSTEM25 RES 0 CW,RT1 SIGTAB,XT CHECK WHICH SIG BE SYSTEM40 BDR,XT SYSTEM25 B SYSTEM50 SYSTEM40 RES 0 LW,RT3 7FDPWORD STW,RT3 SYM1+1 FORCE SIG7FDP LI,RT3 3 STB,RT3 SIGFLAG SET 'SIG' FLAG ON STB,RT3 SYM1 LB,RT1 SYSCODE,XT GET S:IVAL VALUE AW,RT4 RT1 PUT VALUE IN TEXT WD STW,RT1 VAL%S:IVAL SYSTEM50 RES 0 MTW,0 ND%FLAG WAS STD DEF FILE READ BNEZ SYSTEM75 NO, DONT LOOK FOR SYS LW,XT *SDFCONNCDR GET COUNT OF # OF ITEMS AND,XT L(X'FFFF') CLEAN IT AND CHECK FOR 0 BEZ SYSTEM75 YES, ZERO STW,XT #SYSITEM SAVE COUNT LI,XT 4 STW,XT XTSAVE SYSTEM52 LW,XT XTSAVE GET INDEX TO NEXT SYS NAME LB,LL *SDFCONNCDR,XT AWM,LL XTSAVE SET INDEX TO NEXT MTW,1 XTSAVE SYS NAME LW,XT XTSAVE POINT TO LAST CHAR+1 OF NAME CB,LL SYM1 ARE NAMES SAME LENGTH BNE SYSTEM60 NO SYSTEM55 AI,XT -1 LB,RT1 SYM1,LL ARE NAMES CB,RT1 *SDFCONNCDR,XT THE SAME BNE SYSTEM60 NO BDR,LL SYSTEM55 B SYSTEM85 SYSTEM60 MTW,-1 #SYSITEM FINISHED LOOKING FOR SYS NAMES BGZ SYSTEM52 NO * SET UP BYTE POINTER TO SYSTEM NAME SYSTEM75 RES 0 MTW,0 SIGFLAG 'SIG' TYPE SYS BEZ SYSTEM77 NO LI,RT1 7 YES, SET LENGTH STB,RT1 SYM1 TO 7 SYSTEM77 RES 0 LI,RT1 BA(SYM1)+1 STW,RT1 IM@NAME LB,RT1 SYM1 GET COUNT STB,RT1 IM@NAME BAL,LINK IM@COPY OPEN SYSTEM FILE & BUMP SYS LEVEL AI,RT4 X'400' MTW,0 IM@SYS WAS SYSTEM FOUND BEZ SYSTEM85 NO, LEAVE TYPE = 1 AI,RT4 X'400' YES, CONVERT TYPE TO 2 SYSTEM85 RES 0 LW,N RT4 BAL,RL WDOUT WRITE SYSTEM FLAG WORD AI,IN 2 LB,XT SYM1 B ALF3 GO WRITE SYSTEM NAME * SIGTAB EQU %-1 7FDPWORD TEXT '7FDP' TEXT '7FD' TEXT '7FP' TEXT '7DP' TEXT '7D' TEXT '7F' TEXT '7P' TEXT '5FP' TEXT '5P' TEXT '5F' TEXT '7' TEXT '5' TEXT '6FP' TEXT '6F' TEXT '6P' TEXT '6' TEXT '8P' TEXT '8' TEXT '9P' TEXT '9' SIGTABEND RES 0 SYSCODE RES 0 DATA,1 0,15,14,13,11,10,12,9,5,1,4,8,0 DATA,1 15,14,11,10 DATA,1 29,28 SIG8 HAS NO DECIMAL INSTS. DATA,1 31,30 BOUND 4 * * P K D E C * READ, PACK, AND OUTPUT THE CHARACTERS OF A PACKED DECIMAL CONSTANT * PKDEC RES 0 LI,RT2 0 CLEAR THE CONVERTED CONSTANT STW,RT2 OVFLAG CLEAR TRUNCATION FLAG LI,XT -4 STW,RT2 SYM1+4,XT BIR,XT %-1 BAL,RL CHAR GET THE FIRST CHARACTER LI,XT X'C' SIGN IS PLUS UNLESS CONSTANT CI,CRG '-' IS PRECEDED BY '-' BNE PKDEC1 LI,XT X'D' SET SIGN MINUS B PKDEC2 PKDEC1 RES 0 CI,CRG '+' BNE PKDEC3 PKDEC2 RES 0 BAL,RL CHAR GET FIRST NUMERIC DIGIT PKDEC3 RES 0 LB,CT CONVTBL,CRG THIS CHARACTER MUST BE NUMERIC CI,CT DEC BANZ PKDEC4 B FALSE PKDEC5 RES 0 BAL,RL CHAR GET NEXT CHARACTER LB,CT CONVTBL,CRG TEST FOR DECIMAL CI,CT DEC BAZ PKDEC7 NO. END OF CONSTANT * * SHIFT THE PARTIALLY CONVERTED CONSTANT LEFT 1 DIGIT AND CHECK * FOR TRUNCATION * PKDEC4 RES 0 LD,RT1 SYM1 CW,RT1 =X'10000000' TEST FOR TRUNCATION BL %+2 NO MTW,+1 OVFLAG SET TRUNCATION FLAG SAD,RT1 4 STW,RT1 SYM1 LW,RT1 SYM1+1 LW,RT2 SYM1+2 SLD,RT1 4 STW,RT1 SYM1+1 LD,RT1 SYM1+2 SLD,RT1 4 AND,CT L(X'F') SLS,CT 4 OR,RT2 CT STD,RT1 SYM1+2 B PKDEC5 * NUMBER IS CONVERTED. NOW INSERT THE SIGN PKDEC7 RES 0 OR,RT2 XT INSERT THE SIGN STW,RT2 SYM1+3 LI,XT -8 LI,N LARGEINT+CT1 PKDEC8 RES 0 LH,CT SYM1+4,XT BNEZ PKDEC9 BIR,XT PKDEC8 PKDEC9 RES 0 LI,CRG 8 AW,CRG XT LCW,XT XT B WRICONST * * S E T P R O C L V * SPECIAL PROCESSING FOR THE 'PROC' DIRECTIVE * SETPROCLV RES 0 MTW,0 PROCLV IGNORE IF ALREADY BNEZ TRUE WITHIN A PROC MTW,1 PROCLV NON-ZERO TO 'WITHIN PROC' FLAG LW,XT LOCX STORE ORIGIN OF PROC LEVEL STW,XT PLOC LOCAL TABLE LI,XT 0 STW,XT NXTLOC CLEAR NUMBER OF CURRENT LOCALS B TRUE * * S K I P N B * SKIP NON-BLANK CHARACTERS * SKIPNB RES 0 BAL,RL CHAR CI,CRG ' ' BE RESETCHT CI,CRG TAB BNE SKIPNB B RESETCHT * * S W A P L O C * EXCHANGE SYMBOL NUMBERS BETWEEN THE LOCAL SYMBOL TABLE * AND THE MAIN SYMBOL TABLE. * CALLED FROM PROC, PEND, END, COM, AND LOCAL DIRECTIVES * * INPUT: XT CONTAINS ORIGIN ADDRESS OF LOCAL TABLE * CT CONTAINS NUMBER OF ENTRIES IN THE LOCAL TABLE * LOCAL %10 /27466/*D-NCD * /27466/*D-NCD SWAPLOC RES 0 STW,RL SRCHXIT SAVE RETURN /27466/*D-NCD %10 RES 0 /27466/*D-NCD CI,CT 0 BLEZ *SRCHXIT BRIF DONE /27466/*D-NCD * /27466/*D-NCD LW,RT1 SNOFFSET,XT LH,N RT1 SYMBOL TABLE POINTER TO REG N AND,N =GLFLD TRIM TO DROP SIGN EXTENSION MTW,0 SPILLFLG IN RAD-SPILL MODE? /27466/*D-NCD IF,NZ DOIF WE ARE /27466/*D-NCD LW,M1 N /27466/*D-NCD AI,M1 HED GET VIRTUAL ADDRESS /27466/*D-NCD CALL MAP%ADDR MAKE SURE IT'S IN /27466/*D-NCD AI,M1 -HED GET REAL (TO US) OFFSET /27466/*D-NCD STW,M1 N /27466/*D-NCD MTW,+1 INCORESF SET DIRTY-PAGE FLAG /27466/*D-NCD LW,RT1 SNOFFSET,XT RESTORE CLOBBERED REGISTER /27466/*D-NCD FI /27466/*D-NCD LI,RT2 GLFLD LW,RT3 SNWD,N LI,RT4 GLFLD LW,CRG PTROFFSET,XT CW,CRG L(X'01000000') IF MAIN SYMBOL TABLE ENTRY BGE SWPL2 SWAP WITH SN FIELD CW,CRG =PTRFLD BANZ SWPL1 SWPL2 RES 0 SLS,RT3 -16 SLD,RT1 16 SWPL1 RES 0 STS,RT1 GLWD,N STS,RT3 GLOFFSET,XT LW,RT1 PTRWD,N LW,RT2 =PTRFLD+CF1FLD+CLOFLD STS,RT1 PTROFFSET,XT LW,RT1 CRG STS,RT1 PTRWD,N AI,XT -2 AI,CT -1 B %10 /27466/*D-NCD * * W R I S Y M B O L * SEARCH-INSERT THE LAST INPUT SYMBOL, AND OUTPUT IT. * WRISYMBOL RES 0 CALL *SEARCHV OPENSYM3 RES 0 CALL *INSERTV SYMOUT RES 0 AI,N SYMTYPE SYMBOL CONTROL TYPE BAL,RL WDOUT B TRUE * * W R I T E * WRITE THE NEXT SYNTAX ELEMENT IN THE OUTPUT STRING * AND SKIP THAT ELEMENT * WRITE RES 0 AI,SYN 1 ADVANCE SYNTAX POINTER LH,N SYNTAX,SYN GET THE SYNTAX ELEMENT LI,RL TRUE SET EXIT AND FALL THROUGH TO WDOUT * * W D O U T * WRITE AN ELEMENT IN THE OUTPUT STRING * WDOUT RES 0 STW,RL WDOUTRTN SAVE RETURN ADDRESS CI,OUT OUTSIZE-1 IS OUTPUT BUFFER FULL BGE WDOUT1 YES, STH,N OUTBUF,OUT NO, PUT ENCODED ITEM AI,OUT 1 IN ENCODED TEXT BUFFER B *WDOUTRTN EXIT WDOUT1 RES 0 STW,XT XTSAVE LI,XT 1 LW,OUT OUTSAVE IF,EZ DOIF FULL BUFFER /27493/*D-NCD ABORT ABORT21 (STATEMENT TOO LONG) /27493/*D-NCD FI /27493/*D-NCD LH,RT4 OUTBUF,OUT SAVE 1ST WORD OF LINE MTW,0 CNCTRL IF,NZ IN CN CONTROLS CALL IO%X3 ELS IN PROGRAM BAL,RL IO%X1 WRITE OUTBUF FI STH,RT4 OUTBUF MOVE 1ST WORD OF LINE AI,OUT 1 WDOUT3 RES 0 LH,RT3 OUTBUF,OUT MOVE AN ENCODED ITEM STH,RT3 OUTBUF,XT ITEM AI,OUT 1 AI,XT 1 CI,OUT OUTSIZE-1 FINISHED BL WDOUT3 NO, STH,N OUTBUF,XT YES, MOVE LAST WORD AI,XT 1 STW,XT OUT SET OUT TO NEW VALUE LCW,RT1 OUTSAVE SAVE OUT OFFSET AWM,RT1 NEXTLINE# BUMP ADDRESS FOR NEXT LINE NUMBER LI,XT 0 STW,XT OUTSAVE RESET OUTSAVE LW,XT LVL AI,XT 3 WDOUT7 AWM,RT1 LVLTBL+1,XT MODIFY OUT ENTRIES AI,XT 3 CW,XT LVLBASE FINISHED BL WDOUT7 NO WDOUT9 LW,XT XTSAVE B *WDOUTRTN YES, EXIT * * A T T R I B C K * ATTRIBCK RES 0 CI,CRG '(' LAST CHAR = '(' BNE WRISYMBOL * AI,IN 1 CALL *SEARCHV NO CALL *INSERTV AI,N SBSYM SUBSCRIPTED SYMBOL BAL,RL WDOUT LI,N SUBSYMB-SYNTAX GO TO SUBSYMB B NEXTLEVEL EQUATION * * S Y M B O L * SYMBOL RES 0 BAL,RL CHAR LI,RT2 ALPH+DEC TEST FIRST CHARACTER CB,RT2 CONVTBL,CRG FOR ALPHANUMERIC BAZ FALSE LI,XT -64 INDEX TO SYM1 CHARACTERS LW,N =' ' SET FIRST 8 CHARACTERS STW,N SYM1 TO BLANKS STW,N SYM1+1 LI,RT1 ALPH ALPHA FLAG B SYMB2 SYMB1 RES 0 BAL,RL CHAR SYMB2 RES 0 CB,RT1 CONVTBL,CRG BRANCH IF ALPHABETIC BANZ SYMB3 CB,RT2 CONVTBL,CRG BRANCH IF NON-ALPHANUMERIC BAZ FALSE STB,CRG SYM1+16,XT STORE LEADING NUMERIC DIGIT BIR,XT SYMB1 B FALSE 64 NUMERIC DIGITS SYMB3 RES 0 STB,CRG SYM1+16,XT STORE ALPHANUMERIC CHARACTER BIR,XT SYMB4 MTW,+1 CONTIN%ERROR SET CONTINUATION ERROR FLAG LI,XT -1 SYMB4 RES 0 BAL,RL CHAR CB,RT2 CONVTBL,CRG BRANCH IF ALPHANUMERIC BANZ SYMB3 CI,CRG '''' RETURN TO FALSE BE FALSE IF TERMINATOR IS A PRIME AI,XT 64 CI,XT 8 BLE SYMB6 * STORE BLANKS IN TRAILING CHARACTER POSITIONS OF THE CURRENT WORD SYMB5 RES 0 CI,XT 3 BAZ SYMB7 STB,N SYM1,XT AI,XT 1 B SYMB5 SYMB6 RES 0 AI,XT 3 SYMB7 RES 0 SLS,XT -2 STORE WORD COUNT STB,XT HED RESETCHT RES 0 AI,IN -1 B TRUE PAGE * ******** SUBROUTINES FXC AND FSC AND FLC ****** * * INPUTS R1-POSITION OF 1ST BYTE IN CONSTANT (BLDFBA) * BYTP-POSITION OF LAST BYTE (') MINUS 1 (BLDLBA) * * OUTPUTS CON3,CON4 -SINGLE OR DOUBLE WORD CONSTANT. * * FUNCTION CONVERT THE CONSTANT AT IBYT FROM ITS EBCDIC VALUE * INTO A LONG FLOATING POINT NUMBER. IF FXC IS USED, * FIX THIS FLOATING POINT NUMBER ACCORDING TO THE * BINARY SCALE FACTOR. IF FSC IS USED, DISCARD THE * LOW-ORDER 32 BITS OF THE NUMBER. * * *********THE FLGS (R12) ARE SET AS FOLLOWS: * * FLGS MEANING * ******** ********************************** * 000000XX SIGN OF INT0,INT1 (+=EVEN,-=ODD) * 00001000 FXC ENTRY USED * 00002000 FLC ENTRY USED * 20000000 B FOUND * 40000000 E FOUND * 80000000 DECIMAL POINT FOUND * * LOCAL R1,R2,R3,R13,R14,R15,LNKR,WAY,CC,WRK0,WRK1,DEXP,CNT,; PNTR,INT0,INT1,FLGS,BIAS,LINK,CNTR,TMP0,TMP1,ESGN,; HEXP,TMP2,FXFL,FLFL,EFLG,BFLG,DPFL * R1 EQU 1 R2 EQU 2 R3 EQU 3 LNKR EQU 8 R13 EQU 13 R14 EQU 14 WAY EQU 14 R15 EQU 15 * CC EQU 2 WRK0 EQU 4 WRK1 EQU 5 DEXP EQU 6 CNT EQU 7 PNTR EQU 9 INT0 EQU 10 INT1 EQU 11 FLGS EQU 12 BIAS EQU 13 LINK EQU 15 * CNTR EQU 1 TMP0 EQU 2 TMP1 EQU 3 ESGN EQU 7 HEXP EQU 9 TMP2 EQU 14 * FXFL EQU X'1000' FX ENTRY FLFL EQU X'2000' EFLG EQU 4 E FOUND BFLG EQU 2 B FOUND DPFL EQU 8 DEC PT FOUND * * *********PART 1 - ACCUMULATION OF EBCDIC DIGITS * * THIS PART GENERATES: * INT0,INT1-A HEXIDECIMAL INTEGER REPRESENTING THE CONSTANT * DEXP-THE DECIMAL EXPONENT OF INT0,INT1 (SIGNED) * BIAS-THE BINARY SCALE FACTOR OF AN FX CONSTANT (SIGNED) * FLGS-THE SIGN OF INT0,INT1 * * * FXC LI,R15 FXFL SET FX ENTRY FLAG LI,N LARGEINT+CT3+2 B FC1 FLC LI,R15 FLFL SET FL ENTRY FLAG LI,N LARGEINT+CT5+4 B FC1 FSC LI,R15 0 SET FS ENTRY FLAG LI,N LARGEINT+CT4+2 FC1 STW,R15 FLGS SET FLAGS PER ENTRY LCI 6 STM,2 FFFSAVE BAL,R15 SIGN GET SIGN OF CONSTANT OR,FLGS WAY SAVE SIGN IN FLGS LD,DEXP ZERO SET DEXP=CNT=0 LD,INT0 ZERO SET INT0,INT1=0 STW,DEXP OVFLAG CLEAR TRUNCATION FLAG BAL,LINK ACUM ACCUMULATE DIGITS TO 1ST NON-DIGIT LCF CC LOAD CC WITH NON-DIGIT CODE BCR,DPFL FC2 TEST IF NON-DIGIT IS A DEC PT OR,FLGS CC YES, SET DEC PT FLAG IN FLGS BAL,LINK ACUM ACCUMULATE DIGITS TO NEXT NON-DIGIT FC2 CI,CNT 0 TEST IF >0 DIGITS ACCUMULATED BE BLDCONE6 NO,ILLEGAL FORM OR,FLGS CC SET E FOUND OR B FOUND FLAG IN FLGS LCF CC LOAD CC WITH NON-DIGIT CODE BCR,EFLG FC3 TEST IF NON-DIGIT IS AN E BAL,LNKR GET2 YES, GET DIGITS AFTER E AND RETURN * /WITH CC OF NEXT NON-DIGIT AW,DEXP WRK1 ADD EXPONENT TO DEXP FC3 CI,FLGS FXFL TEST IF FX ENTRY WAS USED BAZ FC4 NO, ANY B IS ILLEGAL LCF CC YES, LOAD CC WITH NON-DIGIT CODE BCR,BFLG BLDCONE6 TEST IF NON-DIGIT IS A B (IF NOT AN * /ERROR SINCE FX CONSTS MUST HAVE B) BAL,LNKR GET2 YES, GET DIGITS AFTER B AND RETURN * /WITH CC OF NEXT NON-DIGIT STW,WRK1 BIAS SAVE BINARY SCALE FACTOR IN BIAS LCF FLGS PUT PREVIOUSLY SET FLAGS IN CC BCS,EFLG FC4 TEST IF A PREVIOUS E WAS FOUND LCF CC IF NOT, LOAD CC WITH NON-DIGIT CODE BCR,EFLG FC4 TEST IF NON-DIGIT IS AN E BAL,LNKR GET2 YES, GET DIGITS AFTER E AW,DEXP WRK1 ADD EXPONENT TO DEXP FC4 RES 0 * * *********PART 2 - BUILDING OF THE FLOATING POINT CONSTANT * * THIS PART USES INT0,INT1, DEXP, BIAS, AND FLGS FROM * PART 1 AND GENERATES: * INT0,INT1-A DOUBLEWORD FLOATING POINT NUMBER FOR FSC AND * FLC OR AN INTEGER FOR FXC (IN INT0) * THIS DOUBLEWORD IS RETURNED IN MAC1 AND MAC1+1. * * FIXED POINT CALCULATIONS ARE CARRIED OUT BY MUL AND DIV. * BOTH EXPECT ARG1 IN INT0,INT1 AND GET ARG2 FROM CTBL. * THE INTERNAL FORMAT OF FLOATING POINT NUMBERS IS: * 0.(60 BITS OF SIGNIFICANCE)000 (64 BITS) * WHERE THE HEXIDECIMAL POINT IS AT BIT 0. THE HEXIDECIMAL * EXPONENT IS KEPT IN HEXP. * LD,TMP1 INT0 TEST IF INTEGER IS ZERO BEZ EXITS YES, EXIT LB,ESGN DEXP SET ESGN=0 IF DEXP>=0 OR SLS,ESGN -7 /SET ESGN=1 IF DEXP<0 LAW,DEXP DEXP MAKE DEXP POSITIVE LI,HEXP X'50' SET HEX EXPONENT TO 16 SCD,INT0 3 NORMALIZE INTEGER TO INTERNAL F.P. BAL,LINK NM1 /FORMAT, NAMELY 0.(63 BITS) AND,INT0 L(X'7FFFFFFF') SET SIGN-BIT TO ZERO (PLUS) * * AT THIS POINT WE ARE READY TO PROCESS THE DEC EXPONENT, AS * FOLLOWS: * 1) FOR DEXP>13, MULT/DIV BY 10**13 AND DECREMENT DEXP BY * 13 UNTIL DEXP<=13. * 2) FOR DEXP<=13, DO ONE MULT/DIV BY THIS POWER. * AI,DEXP -13 DECR DEXP BY -13 BLZ MF2 TEST IF DEXP<13 LW,TMP2 DEXP NO, DEXP>=13; SO SAVE DEXP IN TMP2 LI,DEXP 12 /AND SET DEXP=12 MF1 EXU BTBL,ESGN DO A MUL/DIV BY 10**13 AI,TMP2 -13 DECR OLD DEXP BY 13 BGZ MF1 IF DEXP>13, REPEAT MUL/DIV BY 10**13 LW,DEXP TMP2 IF DEXP<=13, RESET DEXP TO NEW VALUE MF2 AI,DEXP 12 RECOVER DEXP-1 BLZ MF3 TEST IF DEXP=0 (IF YES, RESULT OK) EXU BTBL,ESGN NO,SO DO A MUL/DIV BY 10**(DEXP+1) MF3 RES 0 CI,FLGS FXFL BANZ DOFX TEST IF FXC ENTRY WAS USED CI,FLGS FLFL TEST IF FLC ENTRY WAS USED BANZ MF4 YES, DON'T ROUND AI,INT0 X'40' ROUND FS CONSTANTS TO 24 BITS BNOV MF4 TEST IF OVER-FLOW ON ROUND LW,INT0 =X'7FFFFFFF' CONSTANT FOR NO-ROUND CASE CI,HEXP X'7F' CAN NUMBER BE ROUNDED BE MF4 CAN'T ROUND LW,INT0 =X'10000000' AI,HEXP 1 /AND EXPONENT MF4 RES 0 CI,HEXP X'7F' TEST FOR BG BLDCONE6 EXPONENT CI,HEXP 0 OVERFLOW BL BLDCONE6 OR UNDERFLOW SLD,INT0 -7 CHANGE RESULT TO STANDARD F.P. STB,HEXP INT0 /FORMAT, NAMELY 'CCMMMMMMMMMMMMMM' CI,FLGS 1 BAZ EXITS TEST SIGN OF CONSTANT CI,FLGS FLFL COMPLEMENT SINGLE OR DOUBLE BAZ MF5 SINGLE LCD,INT0 INT0 B EXITS MF5 RES 0 LCW,INT0 INT0 EXITS CI,FLGS FLFL BAZ EXS1 TEST IF FLC ENTRY WAS USED XW,INT0 INT1 YES, SO FLIP INT0 AND INT1 STW,INT1 RT1 UPPER TO RT1 EXS1 STW,INT0 RT2 LOWER TO RT2 B BLDCONX1 EXIT DOFX CI,FLGS 1 BAZ DF1 TEST SIGN OF RESULT LCD,INT0 INT0 NEGATIVE, SO COMPLIMENT RESULT DF1 AI,HEXP -X'40' CALCULATE NUMBER OF POSITIONS SLS,HEXP 2 /TO SHIFT SO AS TO ALLIGN HEX POINT SW,HEXP BIAS /ACCORDING TO BINARY SCALE FACTOR AND,HEXP L(X'FF') PREPARE SHIFT INST. AI,HEXP X'500' S,INT0 *HEXP SHIFT (SAD) BNOV EXITS IF NO OVERFLOW-EXIT BLDCONE6 RES 0 MTW,+1 OVFLAG SET TRUNCATION FLAG LD,RT1 ZERO * * * * NORMAL EXIT ROUTINE * BLDCONX1 LCI 6 RESTORE REGISTERS. LM,2 FFFSAVE BAL,RL WDOUT WRITE CONSTANT TYPE. CI,FLGS FLFL FL CONSTANT BANZ NUMOUT1 YES, GEN 4 HALF-WDS B NUMOUT2 NO, GEN 2 HALF-WDS * * SUBROUTINE TO ACCUMULATE DIGITS IN INT0,INT1 * ACUM STW,LINK ACUMLNK SAVE LINK ACUM1 BAL,LINK FFFGNC GET NEXT CHAR. LB,R2 CONVTBL,R3 GET CHAR CODE. CI,R2 DEC DIGIT BAZ ACUMX NO AND,R3 L(X'F') YES,CLEAN IT AI,CNT 1 KEEP COUNT OF NUMBER OF DIGITS STD,INT0 WRK0 START MULTIPLYING CURRENT SLD,WRK0 3 /INTEGER BY 10 BOV AOV2 IF OVERFLOW, JUST INCR DEXP SLD,INT0 1 DO 2ND STEP OF MULTIPLY AD,INT0 WRK0 BOV AOV1 IF OVERFLOW, RECOVER AND INCR DEXP LI,R2 0 AD,INT0 R2 ADD ON NEW DIGIT BOV AOV1 IF OVERFLOW, RECOVER AND INCR DEXP LCF FLGS BCR,DPFL ACUM1 TEST IF DEC PT HAS BEEN ENCOUNTERED AI,DEXP -1 YES, THEN DECR DEXP (I.E.,COUNT B ACUM1 CONTINUE /DIGITS AFTER DEC PT) AOV1 SLD,WRK0 -3 RECOVER PREVIOUS RESULT LD,INT0 WRK0 AOV2 LC FLGS BCS,DPFL ACUM1 TEST IF DEC PT HAS BEEN ENCOUNTERED AI,DEXP 1 YES, THEN INCR DEXP ONLY (SINCE AT B ACUM1 CONTINUE /MAX SIGNIFICANCE ALREADY) ACUMX LI,R2 4 ACUMX1 CB,R3 ACUMSPCH,R2 FIND B,E,. BNE ACUMX2 SLS,R2 29 FOUND,SHIFT TO CC. 2=B,4=E,8=. B *ACUMLNK EXIT ACUMX2 BDR,R2 ACUMX1 NOT FOUND, CC=0 B *ACUMLNK EXIT * * THIS SUBROUTINE SAVES REGISTERS, BRANCHES TO 'CHAR' TO * GET THE NEXT CHARACTER, RESTORES REGISTERS, AND EXITS * FFFGNC RES 0 STW,LINK FFFGNCLNK SAVE LINK LCI 6 STM,2 FFFSAVE+6 SAVE CONVERT REGISTERS. LM,2 FFFSAVE RESTORE ENCODE REGISTERS. BAL,RL CHAR GET NEXT CHAR. LCI 6 STM,2 FFFSAVE SAVE ENCODE REGISTERS. LM,2 FFFSAVE+6 RESTORE CONVERT REGISTERS. LW,R3 FFFSAVE+5 LOAD NEXT CHAR. B *FFFGNCLNK EXIT * * SUBROUTINE TO ACCUMULATE DIGITS AFTER A B OR E (THE RESULT * IS A SIGNED INTEGER RETURNED IN WRK1) * GET2 LCI 8 SAVE 6-13 STM,DEXP GET2REGS BAL,R15 SIGN GET SIGN OF EXPONENT (IN WAY) STW,WAY R13 SAVE SIGN LD,INT0 ZERO SET INT0,INT=0 LI,CNT 0 SET CNT=0 BAL,LINK ACUM ACCUMULATE DIGITS OF EXPONENT CLM,CNT P1 TEST IF 0