ASMB,R,L HED RTE-M FORTRAN--SEGMENT 1--PASS 1 NAM FTN1,5 92064-16046 REV.1650 761118 SUP * * * ********************************************************* * * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1976. * * * * * * ALL RIGHTS RESERVED. NO PART OF THIS PROGRAM MAY BE * * * PHOTOCOPIED, REPRODUCED, OR TRANSLATED TO ANOTHER * * * PROGRAM LANGUAGE WITHOUT THE PRIOR WRITTEN CONSENT OF * * * HEWLETT-PACKARD COMPANY. * * ********************************************************* * * ENT FTN1 * EXT .STOP,POST,FCONT,LIMEM,READF,WRITF,TERM EXT IDCB0,IDCB2,IDCB3,FMPER,SEGLD,IMESS * COM TCLIS COM MCBUF(40) COM PTYPE COM BUFAD COM OPT(3) COM ...T * COM AI(6),AO(6),AL(6),AS1(6) COM ERRS,OPTS1,OPTS2,OPTS3,NAME,LINES COM FDVL,OPT4 * * * * SKP BUFOR DEF MCBUF MULTI-COMPILE BUFFER BUFND DEF MCBUF+40 END OF BUFFER +1 MOVA. DEF MOVA MOVA ENTRY POINT DOND DEF DOEN LWA+1 OF DO-TABLE MDOAD DEF DOAD BEGIN OF DO-TABLE WPREV BSS 2 .TEMP BSS 5 RS1 EQU .TEMP RS2 EQU .TEMP+1 RS3 EQU .TEMP+2 RS4 EQU .TEMP+3 REOSF EQU .TEMP+4 BSS 1 * TILT EQU * CORE OVERFLOW ERROR JSB LNK20,I DO END,END$ SEQUENCE * STYPE BSS 1 STATEMENT TYPE (SET BY SCANNER) TYPE EQU STYPE LABL BSS 3 ADDITIONAL INPUT FOR PUTAWAY BCLIS BSS 1 BOTTOM OF TEMP CONLIST HIGH EQU BCLIS FWA BSS 1 FWA OF ALPHA OR BETA FWBET EQU FWA LFWA EQU FWA RFWAN EQU FWA LWA BSS 1 LWA+1 OF ALPHA OR BETA ALFA EQU LWA LLWA EQU LWA TOP OF USED CORE NWBET EQU LWA ENTRY DEF START ENTRY POINT ADDR.OF CONTROL1, * 4=REAL FUNCTION PTYP EQU PTYPE * OPT - OPTION FLAGS: 0 FOR NONE * NE.0 FOR OPTION. ORDER: LIST. * ASSEMBLY LIST, BINARY OUTPUT C1 OCT 52000 C2 OCT 100 FUNCTION CODE FOR EOF * * BEGIN COMPILATION HERE. * * FTN0, USED AT THE START OF EACH PASS, REWINDS * THE READ POINTER ON THE FORTRAN MIDDLE OUTPUT FILE * AND THEN BRANCHES TO THE LOCATION : ENTRY. * FTN1 CLA INITIALIZE STA OPT4 COMMON LDA C1 STA ...T * * NOREW LDA BUFOR GET MULTI-COMPILE BUFFER ORIGIN STA BUFAD TO USE FOR BUFFER. JMP ENTRY,I JMP TO START PASS 1 SKP * * L I S T * * WRITES RECORD TO LIST FILE OR CAUSES PAGE EJECT. * * LDA WDCNT(-1 FOR PAGE EJECT) * LDB ADDRESS OF BUFFER * JSB LIST * LIST NOP STA SAVE1 SAVE A-REG LDA PNT01 INITIALIZE FMP ERROR STA NAME FILE NAME POINTER LDA SAVE1 RESTORE A-REG SSA JMP PEJ SZA,RSS JMP PSKP CMA,INA STA PBUFL STB PBUFF * JSB WRITF WRITE A DEF PLST1 RECORD TO DEF IDCB2 THE LIST DEF ERRS FILE PBUFF BSS 1 DEF PBUFL PLST1 EQU * SSA ERROR OCCUR? JMP FMPER YES.GO REPORT IT ISZ LCOUT NO.DONE A PAGE? JMP LIST,I NO.RETURN LDA LINES YES.RE-INITIALIZE STA LCOUT THE LINE COUNTER CCA GO EJECT JMP PEJ A PAGE * PNT01 DEF AL+1 LINK TO LIST FILE NAME PBUFL NOP SAVE1 NOP LCOUT BSS 1 LINES PER PAGE COUNTER SKP * PSKP CLA,INA PEJ STA PPRAM JSB FCONT DO A DEF PSKP1 PAGE DEF IDCB2 EJECT DEF ERRS DEF PCNW1 DEF PPRAM PSKP1 EQU * SSA,RSS ERROR OCCUR? JMP LIST,I NO.RETURN LDA ERRS YES.IS IT CMA,INA FMP ERROR CPA O14 -012? JMP LIST,I YES.RETURN JMP FMPER NO.REPORT ERROR * PCNW1 OCT 1100 PPRAM NOP SKP * **************************************************** * XSTOP BSS 1 AESIZ BSS 1 SIZE OF ASF-ERAS.STORAGE ALOC BSS 1 SIZE OF PROG.FOR DECLAR.CODE ARSIZ BSS 1 SIZE OF COMBINED ARRAYS ASFLG BSS 1 ASF-FLAG,NE.0 : ASF PROCESSING CLOC BSS 1 SIZE OF COMMON CONAD OCT 0 ADDEND TO STATEMENT LABEL. DVLS1 BSS 1 CURRENT ADDR.IN SYMBOL TABLE LDVL EQU DVLS1 RALFI EQU LDVL ERCNT BSS 1 ERAS.COUNT (ASF AND PROGRAM ) ERSIZ BSS 1 SIZE OF PROG.-ERAS.STORAGE FNLIS DEF FNTAB FWA OF INTRINSIC FUNC.TABLE FNLS1 DEF FNTB1 FWA OF EXT. FUNCTION TABLE LABEL BSS 1 STATEMENT LABEL VALUE LBCNT BSS 1 INTERNAL-LABEL COUNT (10000 UP) LBORD BSS 1 CURRENT LABEL ORDINAL LOCNT BSS 1 LOCATION COUNTER LVORD BSS 1 CURRENT LOCAL VAR.ORDINAL MODE BSS 1 MODE OF ARITHMETIC FOR PUTAWAY PREVS OCT 0 STATEMENT TYPE OF PREVIOUS * EXECUTABLE STATEMENT RTYPE BSS 1 1=PUTAWAY CODE,2=BETA CODE,3= * SOURCE LIST+ DIAGNOST.,4=DVLIS * (MULTI-COMPILE) SFPAD BSS 1 -(NO.OF PARAMS+1) FOR ASF.USED * IN PUTAWAY,SET IN ASF PROCESSOR TDVL BSS 1 CONTAINS FWA OF TEMP SYMBTAB IN * PASS 1,FWA OF POINTER TABLE * IN PASS 2 * * LINKS IS THE TABLE OF ENTRY POINT ADDRESSES. * IT IS ALSO USED AS JUMP-TABLE IN CONTROL. * LINKS DEF MSP11 FORMAT LNK1 DEF MSP6 IF LNK2 DEF MSP4 GOTO N LNK3 DEF MSP5 GOTO ( ),N LNK4 DEF MSP2 STOP LNK5 DEF MSP1 PAUSE LNK6 DEF MSP3 RETURN FORMT DEF M3SFR FORMAT (NO JUMPS) LNK8 DEF MSP9 CALL LNK9 DEF MSP7 DO (BEGIN) LNK10 DEF WARTH ARITH MPYA DEF .MPYA MPY: DECPRO+PRO ALPHA LNK12 DEF LSTIO I/O LNK13 DEF LSTIO I/O LNK14 DEF LSTIO I/O LNK15 DEF LSTIO I/O LNK16 DEF LSTIO I/O LNK17 DEF LSTIO I/O LNK18 DEF LSTIO I/O LNK19 DEF MSP10 END LNK20 DEF FINS1 END$ LNK21 DEF MASF1 ASF LNK22 DEF SCAN SCANNER LNK23 DEF NEST DECLAR. PROCESSOR LNK24 DEF PRA PROCESS ALPHA LNK25 DEF WPRB PROCESS BETA LNK26 DEF WSSEV SUBSCRIPT EVALUATOR LNK27 DEF WRITB WRITE RROUT DEF ASCQ ASCN LNK29 DEF MSP8 END DO LNK30 DEF MSP7A IMPLIED DO MPUT1 DEF PUTA PUTAWAY LNK32 DEF MDOTL DO-TAB SEARCH ROUTINE LNK33 DEF FINIS END$ PROCESSING LNK34 DEF SDVL SEARCH DECL VAR LNK35 DEF ECSUB CONSTANT ROUTINE LNK31 EQU MPUT1 * .CON0 OCT 0 O1 OCT 1 O2 OCT 2 O3 OCT 3 O4 OCT 4 O5 OCT 5 O6 OCT 6 O7 OCT 7 O10 OCT 10 O11 OCT 11 O12 OCT 12 O13 OCT 13 O14 OCT 14 O15 OCT 15 O16 OCT 16 O17 OCT 17 O20 OCT 20 O21 OCT 21 O22 OCT 22 O23 OCT 23 O25 OCT 25 O26 OCT 26 O27 OCT 27 O30 OCT 30 O31 OCT 31 O32 OCT 32 O33 OCT 33 O34 OCT 34 O35 OCT 35 O36 OCT 36 O37 OCT 37 O40 OCT 40 O44 OCT 44 O52 OCT 52 O377 OCT 377 O400 OCT 400 O4000 OCT 4000 M1 OCT -1 M2 OCT -2 M3 OCT -3 M4 OCT -4 MO100 OCT -100 .MU1 OCT 177400 UPPER 8-BITS IBIT OCT 100000 M5 OCT -5 M6 OCT -6 M7 OCT -7 M8 DEC -8 M9 DEC -9 O77 OCT 77 MLBLM DEC -10000 MD1K DEC -1000 MD100 DEC -100 MD10 DEC -10 RLW4Z OCT 177760 MC01 OCT 140000 MC02 OCT 40000 MC03 OCT 37777 W6060 OCT 30060 CONVERSION FACTOR TO ASCII MPAR OCT 37400 * A EQU 0 B EQU 1 * *** BETA-FORMATS *** * W.PLS OCT 11001 + W.MIN OCT 21001 - W.TMS OCT 32001 * W.SLS OCT 42001 / W.EXP OCT 54001 ** W.EQ OCT 67401 = W.LP OCT 100002 ( W.RP OCT 140002 ) W.LPC OCT 100042 ( FOR CONST SUBSCRIPT W.LPV OCT 100022 (-BASE FOR VARIABLE SUBSCRIPT W.CMA OCT 40002 , W.RPC OCT 140042 ) FOR CONST. SUBSCR SKP * *CNASC CONVERTS A BINARY NUMBER LT.10000 TO ASCII. *ENTER:A= NUMBER. RETURNS: A,B = ASCII CODE * CNASC NOP LDB MD1K -1000D JSB WGETD GET 1ST DIGIT STB CEQS LDB MD100 -100D JSB WGETD 2ND DIGIT STB CENTR LDB MD10 -10D JSB WGETD 3RD DIGIT STB CSFRM STA RCEQS LDA CEQS ALF,ALF ADA CENTR ADD IN 2ND DIGIT LDB CSFRM 3RD DIGIT BLF,BLF ADB RCEQS ADD IN 4TH DIGIT ADA W6060 CONVERT TO ASCII ADB W6060 JMP CNASC,I * *WGETD SUPPLIES THE MOST SIGNIFICANT DEC.DIGIT FOR A *BINARY VALUE. ENTER: A=VALUE,B=-VALUE TO CNMPARE *AGAINST.RETURNS: A=REMAINDER, B= DIGIT * WGETD NOP STB CSAVE+1 SAVE COMPARISON VALUE CLB 0 TO DIGIT WGTD1 STA CSAVE SAVE REMAINDER ADA CSAVE+1 SSA LARGER ? JMP WGTD2 NO,READY INB YES, BUMP DIGIT IN B JMP WGTD1 CONTINUE * WGTD2 LDA CSAVE A=REMAINDER JMP WGETD,I EXIT SKP * *ERRR IS THE ERROR-DIAGNOSTIC WRITE ROUTINE FOR *PASS1 AND PASS 2. ENTER WITH A= ERROR CODE. THE OUT *PUT FORMAT IS:E-CODE: LABL +ADDEND,WHERE ALL NUMERIC *FIELDS HAVE 4 DECIMAL DIGITS. * ERRR NOP STA SAVE2 SAVE ERROR CODE JSB CNASC CONVERT CODE TO ASCII STA ERBUF+1 STB ERBUF+2 LDA LABEL JSB CNASC CONVERT LABEL TO ASCII STA ERBUF+4 STB ERBUF+5 LDA CONAD JSB CNASC CONVERT ADDEND TO ASCII STA ERBUF+7 STB ERBUF+8 LDA O3 STA RTYPE RECORD TYPE=3 FOR ASCII OUTPUT LDA O22 NO. OF CHARS=18 LDB ERBUF-1 ADDR. OF ERBUF JSB LNK27,I WRITE ERROR DIAGNOSTIC (WRITB) LDA SAVE2 WAS IT SYMBOL CPA O16 TABLE OVERFLOW? JMP SYMEX YES.GO TERMINATE FTN JMP ERRR,I NO.EXIT * DEF *+1 ERBUF ASC 1,E- BSS 2 ASC 1,: BSS 2 ASC 1, + BSS 2 SAVE2 BSS 1 TEMPORARY STORAGE SKP * *CEQS SEARCHES CONLIST. TCLIS= TOP OF CONLIST +1. *ENTER CEQS WITH A=CONSTANT VALUE,B= ADDR.POINTER IN *CONLIST. ALT.EXIT IS TO CALLING ADDR.+2 WHEN NO *EQUALITY IS FOUND. * CEQS NOP CPB TCLIS TOP OF CONLIST+1 JMP CEQS1 YES,NOT FOUND CPA 1,I EQUALITY ? JMP CEQS,I YES,NORMAL EXIT INB NO,CONTINUE SEARCH JMP CEQS+1 * CEQS1 ISZ CEQS BUMP RETURN ADDR. FOR JMP CEQS,I ALTERNATE RDTURN * *ICEQS IS THE INTEGER CONSTANT LOOK-UP AND INSERT *ROUTINE. ENTER WITH: A=CONST.VALUE. IT RETURNS THE *ALPHA(BETA) FORMAT OF THE CONST.IN A. IN CASE OF *CORE OVERFLOW A JMP TO TILT IS EXECUTED. * ICEQS NOP LDB BCLIS BOTTOM OF CONLIST JSB CEQS SEARCH FOR INT CONST. RSS FOUND,GET FORMAT JSB CENTR NOT FOUN(,ENTER CONST LDA O3 B=ADDR OF CONST, A=3 FOR INT CONV JSB CSFRM FORM CONST. FORMAT IN B JMP ICEQS,I EXIT WITH FORMAT IN B * SKP * *CENTR ENTERS A CONST.IN CONLIST AT (BCLIS)-1. IT *JUMPS TO TILT IN CASE OF CORE OVERFLOW. IT RETURNS *B= ADDR OF CONST * CENTR NOP CCB ADB BCLIS CPB LWA EQUAL TO LOW CORE? JMP TILT YES,CORE OVERFLOW STB BCLIS SET NEW VALUE FOR BCLIS STA 1,I ENTER CONST. JMP CENTR,I * *CSFRM FORMS A CONST FORMAT. THE ADDR.OF THE CONST *IS IN B UPON ENTRY, A= CLASS IDENT. (1 FOR INT. CON., *21B FOR REAL CONST.) * CSFRM NOP CMB COMPLEM-1 ADB TCLIS POINTER= TCLIS - ADDR.-1 BLF RBL,RBL SHIFT POINTER TO UPPER 10 BITS ADA 1 ADD IN CLASS IDENT (1=INT,21=RL) JMP CSFRM,I EXIT SKP * *RCEQS IS THE REAL CONST LOOKUP AND INSERT ROUTINE *ENTER WITH THE CONST IN A,B. IT RETURNS THE INT. *FORMAT IN A. A JMP TO TILT IS EXECUTED IN CASE OF *CORE OVERFLOW. * RCEQS NOP STA CSAVE SAVE CONST STB CSAVE+1 LDB BCLIS BOTTOM OF CONLIST RCEQ2 JSB CEQS SEARCH FOR UPPER PART JMP RCEQ1 FOUND, TEST LOWER PART RCEQ3 LDA CSAVE+1 NOT FOUND,ENTER LOWER PART JSB CENTR LDA CSAVE ENTER UPPER PART JSB CENTR LDA O23 23B=CLASS IDENT. FOR REAL CONST. JSB CSFRM GET FORMAT IN A JMP RCEQS,I EXIT * RCEQ1 INB BUMP ADDR CPB TCLIS TOP OF CONLIST ? JMP RCEQ3 YES,NOT FOUND LDA CSAVE+1 LOWER PART OF CONST. CPA 1,I EQUALITY ? JMP *+3 YES,FINISH LDA CSAVE RESTORE A=UPPER PART OF CONST JMP RCEQ2 CONTINUE SEARCH ADB M1 ADDR. BACK TO FWA JMP RCEQ3+4 GET FORMAT AND EXIT * CSAVE BSS 2 SKP * *WFCS FETCHES A REAL CONST. ENTER WITH B=ADDR.OF *CONST. FORMAT IN BETA. RETURNS CONST. IN A AND B. * WFCS NOP LDB 1,I CONST. FORMAT IN B JSB WFCS1 GET CONST IN A AND B JMP WFCS,I * *WFCS1 FETCHES A REAL CONST.FROM TEMP.CONLIST * WFCS1 NOP JSB WPFAD GET POINTER CMA ADA TCLIS LWA+1 OF TEMP CONLIST LDB 0 INB SET B= ADDR.OF LOWER PART LDA 0,I UPPER PART LDB 1,I LOWER PART JMP WFCS1,I EXIT * *SDVLL SEARCHES SYMBTAB FOR A LABEL FOR WHICH THE *VALUE IS SUPPLIED THROUGH A. IT RETURNS:THE DVLIST *ORD.IN A OR -1,IF NOT FOUND,AND B= LOC.OF LABEL REL *ADDR.IN SYMBTAB ENTRY * SDVLL NOP STA EDVLL SAVE VALUE OF LABEL LDB FDVL FWA OF DECLARED VAR LIST SDVL1 CPB LDVL END OF SYMBOL TABLE ? JMP SDVL2 YES,LABEL NOT FOUND LDA 1,I NO, TEST SZA LABEL ? JMP SDVL3 NO,CONTINUE SEARCH INB YES,BUMP POINTER LDA 1,I GET LABEL VALUE INB BUMP POINTER FOR RETURN CPA EDVLL SAME VALUE ? JMP SDVLL,I YES,EXIT ADB M2 NO, -2 TO RESET AT ENTRY-FWA SDVL3 JSB NDVLE,I GET FWA OF NEXT ENTRY JMP SDVL1 CONTINUE SEARCH * SDVL2 CCA A=-1 TO INDICATE NO FIND JMP SDVLL,I EXIT * SKP *EDVLL INSERTS A LABEL IN SYMBTAB. ENTER WITH VALUE *OF LABEL IN A. RETURNS WITH B=ADDR.IN SYMBTAB OF *REL.LOC.OF LABEL. IN ADDITION EDVLL WILL MOVE BETA *+ POINTER TABLE+ TEMP.CONLIST,SET INC= 4,AND ADD 4 *TO FWAPT,FWA,LWA,AND HICOR. IN THIS PROCESS IT WILL *CHECK FOR (HICOR) GE.(BCLIS).CORE OVERFLOW IF TRUE. * EDVLL NOP CLB STB DVLS1,I 0 TO 1ST WORD IN ENTRY ISZ DVLS1 BUMP ADDR. STA DVLS1,I SET VALUE IN ENTRY ISZ DVLS1 BUMP ADDR.IN DVLIS CCA STA DVLS1,I -1 TO UNDEFINE REL.ADDR. ISZ DVLS1 LDA LBORD STA DVLS1,I SET LABEL ORD.IN ENTRY ISZ LBORD BUMP LABEL ORDINAL COUNT ISZ DVLS1 BUMP POINTER ISZ DORDT BUMP ORDINAL COUNTER FOR DVLIS LDA FWA CMA,INA ADA DVLS1 SSA,RSS CORE OVERFLOW IF SYMBOL JMP TILT TABLE GROWS BEYOND FWA OF BETA LDB DVLS1 ADB M2 -2 TO GET ADDR. OF LABEL ADDR. JMP EDVLL,I EXIT * SKP *SCATR SCATTERS A SYMBTAB ENTRY FOR WHICH THE BETA *FORMAT IS GIVEN IN A. IT RETURNS: A= ADDR.+1 OF *ENTRY IN SYMBTAB, B= NO.OF WORDS IN NAME OF ENTRY+1 *OTHER VALUES THROUGH PARAMETERS. * SCATR NOP LDB 0 FORMAT TO A FOR WPFAD JSB WPFAD CMA,INA STA CSAVE SET COUNT LDA FDVL FWA OF DVLIS JSB NENT GET FWA OF NEXT ENTRY ISZ CSAVE READY? JMP *-2 NO,GET NEXT ENTRY STA CSAVE YES, SAVE FWA OF ENTRY INA STA CSAVE+1 SAVE FWA+1 LDA CSAVE,I 1ST WORD IN ENTRY RAL,RAL AND O3 STA V SET V-FIELD ADA M3 STA SDVLL SAVE FLAG LDA CSAVE,I AND O7 GET NO. OF CHARS. ADA O3 ARS STA WFCS SAVE NO.OF WORDS IN NAME +1 ADA CSAVE+1 A=ADDR. OF ORD LDB 0,I STB ORD SET ORDINAL LDB 0 LDA CSAVE,I ALF,ALF AND O77 STA PARAM PARAMETER NUMBER SZA,RSS FORMAL PARAM INB NO,BUMP TO NEXT DVL-LOC LDA 1,I STA DIM1 SET 1ST DIM ISZ SDVLL ONE DIMENSION? INB LDA 1,I SKP STA DIM12 DIM1*DIM2 (=DIM1 IF 1 DIM) LDA CSAVE,I AND O20 STA T T-FIELD VALUE (0 OR 20B) LDA CSAVE,I AND O10 STA CBIT C-FIELD VALUE (0 OR 10B) LDA CSAVE,I ALF,ALF RAL,RAL AND O3 STA F F-FIELD VALUE (0-2) LDA CSAVE+1 A= ADDR.OF ENTRY +1 LDB WFCS B= NO.OF WORDS+1 IN NAME JMP SCATR,I EXIT * V BSS 1 V-FIELD VALUE:0 THRU 3 PARAM BSS 1 PARAM NUMBER:1 THRU 63,OR 0 F BSS 1 F-FIELD VALUE:0 THRU 2 T BSS 1 TYPE:0=INTEGER,20B= REAL CBIT BSS 1 COMMON-BIT: 1=COMMON, 0=PROG. ORD BSS 1 REL.PROG.ADDR.OF FWA OF ARRAY DIM1 BSS 1 VALUE OF 1ST DIMENSION DIM12 BSS 1 DIM1 * DIM2 FFLAG BSS 1 FORMAT FLAG DORDT BSS 1 MAX. ORDINAL FWAPT DEF LFNTB FWA OF POINTER TABLE(4K ONLY) SKP *GETS POINTER OF BETA FORMAT. ENTER WITH B=BETA *FORMAT. RETURNS A=POINTER * WPFAD NOP NOCHR EQU WPFAD LDA 1 AND MO100 GET UPPER 10 BITS ALF,ALF RAL,RAL SHIFT 10 JMP WPFAD,I EXIT * *LOKUP LOOKS UP AN ENTRY IN SYMBTAB. ENTER WITH B= *BETA FORMAT. RETURNS: A=(FWA OF ENTRY) +1,B= NO. *OF LOCS IN SYMBOL NAME * LOKUP NOP LDA 1 OPERAND TO A JSB SCATR CRACK SYMBTAB ENTRY JMP LOKUP,I * **FIND LOC OF NEXT ALPHA ENTRY********** * ENTER A= LOC ALPHA * EXIT A= LOC NEXT ALPHA * NELM NOP STA LOKUP SAVE A = CURRENT ALPHA ADDR LDA 0,I 1ST WORD ALF,ALF ALF NO CHAR AND O17 MASK TO 4 BITS STA NOCHR NO OF CHARS ADA M6 SSA GT 5 ? JMP *+3 NO,EXIT LDA O4 YES, ERROR IN NAME JSB ERRR PRINT ERROR LDA NOCHR RELOAD NO OF CHARS ARS NO CHAR/2+1 IS NO WORDS INA ADA LOKUP +LOC = NEXT LOC JMP NELM,I SKP *FIND NEXT DVL ENTRY ********* *ENTER A= LOC DVL EXIT A=LOC NEXT ENTRY * NENT NOP LDB 0 JSB NDVLE,I LDA 1 JMP NENT,I * NDVLE BSS 1 LOC OF ROUTINE SET TO ADD 8 OR * COMPUTE NEXT LOC BY DECL PROC * * *PERMANENT STORAGE EPAR BSS 1 *INTERMEDIATE STORAGE LNWA BSS 1 NWALF EQU LNWA TEMP BSS 4 ALEN EQU TEMP CFLG EQU TEMP+1 PFWA BSS 1 NWCE BSS 1 BWCE BSS 1 CWCE BSS 1 SBCE BSS 1 LSYM BSS 1 MTLDO NOP