ASMB,Q,C HED ** 16K FTN4 COMPILER (F4.5:PASS2) ** NAM F4.5,5 92060-16101 790103 REV. 1913 *************************************** * FORTRAN-4 COMPILER OVERLAY 5 *************************************** * * THIS OVERLAY TRANSLATES THE PSEUDOCODE GENERATED BY * PASS 1 INTO RELOCATABLE BINARY, AND GENERATES THE ASSEMBLY * LISTING. * * * * *************************************************************** * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1977. ALL RIGHTS * * RESERVED. NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED, RE- * * REPRODUCED, OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITH- * * OUT THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY. * *************************************************************** * * * * * * EXT'S WITH A LEADING 'F.' ARE VARIABLES OR JUMP TARGETS * * THE COLUMN THE EXT STARTS IN DEFINES THE SUBROUTINE IT IS * DEFINED IN AS FOLLOWS * 2 -- OA.F (WRITE PASS FILE ROUTINES) * 3 -- NEX.F (STATEMEXTS THAT DON'T CONTAIN EXPRESSIONS) * 4 -- FA.F (THE ASSIGNMEXT TABLE ROUTINES) * 5 -- EX.F (STATEMEXTS USING THE EXPRESSION EVALUATOR) * 6 -- IC.F (THE CHARACTER INPUT ROUTINES) * 7 -- IDN.F (THE TOKEN INPUT ROUTINES) * 8 -- FTN4 ( THE MAIN) EXT F..DP BASE OF SYMBOL TABLE EXT F.A ASSIGNMEXT TABLE ADDRESS (CURRENT ENTRY) EXT F.ABT ABORT COMPILE EXTRY EXT F.CCW FTN OPTION WORD EXT F.CSZ COMMON SIZE EXT F.D.T ADDRESS OF '.' FUN. TABLE EXT F.DNB DEF OF NBUF (NAM RECORD) EXT F.DP BASE OF USER SYMBOL TABLE EXT F.EMA F.A OF EMA EXT ENTRY, WINDOW SIZE EXT F.EMS EMA SIZE DOUBLE WORD, (INTERNAL FORMAT) EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.LO END OF ASSIGNMEXT TABLE+1 EXT F.REL SUB. PROG. RETURN LOCATION EXT F.RPL PROGRAM LOCATION COUNTER EXT F.SBF 0= MAIN, ELSE SUBROUTINE EXT F.SEG LOAD A NEW SEGMENT EXT F.SFF SUBROUTINE/FUNCTION FLAG 0/1 * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT ASC.F CONVERT TO 4 ASCII DIGITS EXT EJP.F PAGE EJECT SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT FA.F FETCH ASSIGNS EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT MPN.F MOVE PROGRAM NAME (TO NAM RECORD ECT.) EXT PSL.F PRINT LINE ON PRINTER EXT SKL.F SKIP LINES ON LIST EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * LIBRARY UTILITIES * EXT .MVW MOVE WORDS MACRO EXT IFBRK BREAK CHECK ROUTINE * * * OPSYSTEM INTERFACE: * EXT RED.C READ FILE ROUTINE EXT WRT.C WRITE FILE ROUTINE EXT RWN.C REWIND FILE ROUTINE EXT C.SC1 SCRATCH FILE FCB EXT C.BIN BINARY FILE FCB * COMPILER LIB ROUTINES * * * SUP SPC 1 A EQU 0 B EQU 1 SPC 1 K5 DEC 5 OVERLAY # SKP F4.5 LDA F.CCW CHECK IF 4 WORD DOUBLE? AND B1000 WELL SZA,RSS COME ON ... COME ON! JMP CRSEC NO SKIP THE WHOLE THING * LDB KM44 CHECK 44 SYMBOLES STB T2STF SET COUNTER LDB D.DTO ADDRESS OF .DTOI ENDPZ LDA B,I GET THE FIRST TWO CHAR OF SYMBOL CPA ".D" IF '.D' THEN RSS SKIP CPA ".X" IF '.D' OR '.X' LDA ".T" CHANGE TO '.T' STA B,I SET SYMBOL BACK ADB K3 INDEX TO THE NEXT SYMBOL ISZ T2STF IS THERE ONE? JMP ENDPZ YES GO DO IT * LDA ".D" RESTORE THOSE CHANGED BY THE SHOTGUN STA .DIO. STA .DTA. LDA "T" FIX THOSE THAT END IN D BUT SHOULD NOW BE T STA RTODX STA DTODX LDA "TB" NOW GET THE TWO WITH D'S IN THE MIDDLE STA IDBLX STA CDBLX INA CHANGE TO 'TC' STA .DCMX AND GET ..DCM -> ..TCM JMP CRSEC PAINFUL WASN'T IT? * * T2STF NOP B1000 OCT 1000 "T" ASC 1,T ".D" ASC 1,.D ".X" ASC 1,.X ".T" ASC 1,.T "TB" ASC 1,TB KM44 DEC -44 D.DTO DEF .DTOI DEF OF .DTOI IN '.' TABLE BLKM ASC 7, BLOCK COMMON SIZE = BLKN BSS 3 RESERVED FOR BLOCK NAME ASC 4, SIZE = BLKSZ BSS 3 SIZE DMBLK DEF BLKN DMBLM DEF BLKM * * CRSEC LDA F.CCW SET UP LOCAL FLAGS AND B40 ISOLATE THE BINARY FLAG STA BFLG SAVE IT LDA F.CCW NOW PUT RAR,RAR M BIT IN LOW PART OF STA CCW LOCAL WORD CLA NEWBL STA COMCO SET COUT OF CURRENT BLOCK COMMON MODULE CCA SET TO NOT IGNOR STA IGNOR ANY THING JSB RWN.C REWIND INT CODE FILE DEF C.SC1 JMP ERROR ERROR ON PASS FILE ACCESS SPC 1 LDA F.SFF IF CPA K2 NOT A BLOCK DATA CLA,RSS SUBPROGRAM JMP OTNAM GO SEND THE NAME RECORD * * ******************************************* * * BLOCK DATA SUBPROGRAM FIND MASTER ENTRY * * ******************************************* * STA T1FBL CLEAR THE LOCAL COUNT LDA F.DP SCAN THE STA F.A A.T. FBL00 JSB GNA.F FOR THE MASTER BLOCK ENTRY SSA,RSS IF END OF TABEL THEN JMP SYTBM DONE GO PRINT THE SYMBOL TABLE * LDA F.A,I GET THE FLAG ENTRY AND NTATI =B107600 ISOLATE NT,AT,IU FIELDS CPA B7200 IF NT=0 & AT=BCOMI & IU=SUB RSS THEN THIS IS A MASTER ENTRY JMP FBL00 ELSE TRY NEXT ONE] * LDA T1FBL IS THIS THE ONE WE CPA COMCO WANT? JMP FBL02 IF YES JUMP * ISZ T1FBL ELSE NOTE IT AND JMP FBL00 CONTINUE THE SCAN. * NTATI OCT 107600 B7200 OCT 7200 IGNOR NOP COMCO NOP T1FBL NOP COMMS NOP CURRENT MASTER ADDRESS K9 DEC 9 * FBL02 LDA F.A FOUND THE MASTER STA COMMS SET IT UP INA GET THE SIZE LDA A,I AND STA F.RPL SET FOR THE NAM RECORD JSB TTHOU CONVERT STB BLKSZ FOR THE MESSAGE JSB ASC.F STB BLKSZ+1 STA BLKSZ+2 AND SET CLA CLEAR THE ENTRY POINT WORD STA F.REL AND STA IGNOR SET TO IGNOR DATA * * * ********************* * * OUTPUT NAM RECORD * * ********************* SPC 1 OTNAM LDA F.DNB MOVE NAM RECORD FROM NBUF LDB A,I GET NAM REC WORDCOUNT STB MC LDB WBP0 TO WBUF FOR CHECKSUM. JSB .MVW DEF MC NOP LDB WBP0 GET THE PROGRAM ADB K9 TYPE LDB B,I AND STB PGMTY SAVE IT CCA SET NAME FLAG STA T1EX FOR DUP NAME CHECK STA T4EX LDA F.SFF IF BLOCK DATA SUBPROGRAM CPA K2 THEN RSS JMP NAM2 * DLD BLNKS BLANK THE NAME WORD 2,3 DST WBUF+4 LDB F.A CLEAR BIT 15 IN NAME. ADB K2 LDA B,I RAL,CLE,ERA STA B,I LDB F.A AND MOVE IN JSB STOL THE NAME FROM THE A.T. DBL WBUF+3 LDA WBP3 NOW JSB MPN.F SET UP THE NAME IN MOST OF THE OTHER PLACES LDA WBP3 MOVE IT LDB DMBLK INTO THE JSB .MVW THE DEF K3 MESSAGE NOP NAM2 LDA WBP5 GET ADDRESS OF NAME JSB EXLNC CHECK LENGTH LDA KK20 NAM REC TYPE IDENT STA WBP1,I LDA F.RPL STORE PROGRAM SIZE STA WBUF+6 LDA F.CSZ STORE COMMON SIZE STA WBUF+8 LDA MC RECORD SIZE JSB .WRIT OUTPUT NAM RECORD SKP * ********************* * * OUTPUT ENT RECORD * * ********************* SPC 1 * PROGRAM NAME IN NAM RECORD IS OUTPUT AS AN * ENTRY POINT. NEEDED FOR SEGMENT LINK BACK TO MAIN. * LDA F.REL PROGRAM ENTRY LOCATION STA WBUF+6 ENTRY INTO ENT RECORD LDA KK400 ENT REC TYPE IDENT INA STA WBP1,I LDA K7 7 WORD RECORD JSB .WRIT OUTPUT ENT LDA F.SFF IF BLOCK DATA SUBPROGRAM CPA K2 THEN JMP GETCW SKIP CHECK FOR USER EXTS. * SPC 1 * ************************ * * OUTPUT EXT RECORD(S) * * ************************ SPC 1 * OUTPUT NAMES OF LIBRARY SUBRS USED * JSB SET LDA F.D.T EXT ORDINAL TABLE STA CWA LDA NOF. STA CTR1 CMA,INA SET POSITIVE ADA CWA STA E.TBL END OF IT LDA ADEXT STA PTEXT LPTBL LDB CWA,I WAS EXT ORDINAL ASSIGNED? SSB,RSS JMP ADVPT NO. THIS SYMBOL NOT USED. CMB,INB SET ORD POSITIVE LDA KM3 STA CTR2 CONTU ISZ WLOC LDA PTEXT,I COPY SYMBOL NAME TO BUFFER. STA WLOC,I ISZ PTEXT ISZ CTR2 JMP CONTU AND KK774 ADA B ATTACH ORD ISZ WORD STA WLOC,I JMP ADVCT * MC NOP PGMTY NOP K17 DEC 17 T1EX NOP T2EX NOP T3EX NOP T4EX NOP C377 OCT 177400 K91 DEC 91 K85 DEC 85 NOF. ABS -NO.F NEG. OF NUMBER OF DOT FUNCTIONS SKP ADVPT LDA PTEXT SET PTEXT TO NEXT ENTRY ADA B3 STA PTEXT ADVCT LDA WLOC CPA WBP59 RECORD FULL? JSB CLOSE YES. END IT. ISZ CWA ISZ CTR1 JMP LPTBL * * NOW DO NAMES OF USER'S SUBROUTNES. * ISZ T4EX CLEAR T4EX (IT IS -1) NOP THIS WORD SKIPPED LDA F..DP SET CWA FOR FIXED EXT INA CKLO STA CWA CURR WORD ADDRESS STA T1EX SET NEW TOP OF LIST CPA F.LO JMP FINAL DONE. * LDA CWA,I GET NEXT SYMBOL AND K7 ADDRESS ADA CWA AND STA SNE SAVE IT LDA CWA,I COMPUTE ITEM USAGE AND B600 CPA B200 USED AS SUBPROG? RSS YES. JMP NXENT ISZ CWA COMPUTE EXT ORD LDB CWA,I LDA T1EX GET SYMBOL ADDRESS CMB,SSB,INB CPA F.EMA IF ORDINAL OR IF EMA RSS THEN PROCESS FURTHER JMP NXENT NO ORD: NOT EXTERNAL SYMBOL. * STB EXORD SAVE ORDINAL (POSITIVE) CPA F.EMA THIS EMA MASTER? CLA,RSS YES SKIP JMP NXEMA NO SKIP * LDA PGMTY YES CHECK IF PROGRAM TYPE ALLOWS CPA K5 EMA PRODUCTION JMP N.EMA NO GO CHECK FOR ZERO ORDINAL * LDA F.SBF NOT SEGMENT MAIN IS IT A MAIN? SZA,RSS WELL? JMP D.EMA YES GO SET UP EMA * N.EMA SZB,RSS IF SYMBOL ORDINAL IS ZERO THEN JMP NXENT DON'T NEED ANY EXT RECORD * JMP NXEMA ELSE JUST A STD. EXT RECORD * D.EMA LDB F.EMA SET EMA FLAG STB T5EX FOR LATER CPA WORD IF SOME DATA IN RECORD RSS THEN JSB CLOSE CLOSE IT NXEMA LDA KM3 STA TEMP ISZ CWA LDB SNE LDSYM LDA BLNKS CPB CWA ALL SYMBOL COPIED? JMP LDSY1 YES. PAD WITH BLANKS. LDA CWA,I AND KK757 FOR LABELLED COMMON, CLEAR BIT 15. STA CWA,I ISZ CWA LDSY1 ISZ WLOC WLOC ADV IS LATE STA WLOC,I ISZ TEMP JMP LDSYM ISZ WORD LDA WLOC ADDRESS TO A JSB EXLNC CHECK FOR EXCESSIVE LENGTH AND KK774 177400 COMBINE LAST CHAR ADA EXORD WITH EXT ORD. STA WLOC,I LDA T1EX IF EMA CPA T5EX THEN JMP YEMA GO WRAP UP THE RECORD * LDA WLOC CPA WBP59 RECORD FULL? JSB CLOSE YES. DUMP IT. NXENT LDA SNE GO TO NEXT ENTRY CPA F.DP START OF USER TABLE? ISZ T4EX YES SET THE FLAG TO SO INDICATE JMP CKLO AND AROUND WE GO * YEMA ISZ WLOC STEP TO THE SEG SIZE WORD DLD F.EMA GET THE M-SEG. WORD STB WLOC,I AND SET IT DLD F.EMS GET THE EMA SIZE CLE,ERB RAL,ERA ADJUST TO STD. DOUBLE WORD INTEGER ADA B1777 ROUND UP TO NEXT HIGHER PAGE SEZ STEP B IF INB NEEDED ASR 7 DIVIDE BY 1024 CLB CLEAR HIGH THREE BITS IN CASE ASR 3 FINISH DIVIDE IOR EMTYP ADD THE EMA TYPE BITS STA WBP1,I SET IN WORD TWO OF THE RECORD LDA K7 7 WORD RECORD JSB .WRIT WRITE IT JSB SET SET UP TO CONTINUE THE EXT'S JMP NXENT CONTINUE EXT'S * * EMTYP OCT 140000 TEMP NOP T5EX NOP * ******************************************** * CHECK FOR 6 CHAR. EXT NAMES SHORTEN TO 5 * BY DROPING CHAR. 5. NOTE IN LISTING **************************************************** * EXLNC NOP STA EXTM SAVE ADDRESS OF NAME LDA A,I GET LAST TWO CHARS. STA ERM6 SAVE LAST TWO CHAR IN MESSAGE BUF LDA K3 SET STA SIZE SIZE UP FOR DUP. TEST LDB KM2 SET UP THE MESSAGE ADB EXTM ADDRESS OF NAME LDA B,I FIRST TWO CHAR TO A STA ERM1 SET IN THE MESSAGE STA ERM2 NEW NAME IS SAME HERE INB NEXT TWO CHAR LDA B,I GET THEM CPA DBNK IF BLANKS RSS SKIP INCREMENTING ISZ SIZE SIZE STA ERM3 STA ERM4 ALSO SAME LDA EXTM,I GET LAST CHAR CPA DBNK IF BLANKS RSS ISZ SIZE STA ERM5 FORM NAME AND B377 ISOLATE THE LAST CHAR CPA B40 IF BLANK JMP EXLNX NAME IS OK * LDA ER68 ELSE LDB T4EX IT IS NOT AN ERROR OR EVEN A WARNNING SZB TO SHORTEN AN ENTRY IN THE FIXEXT TABLE JSB WAR.F SEND ERROR MESSAGE LDA ERM5 NOW DELETE THE 5'TH CHAR. ALF,ALF MOVE 6'TH CHAR TO 5'TH SPOT AND KK774 ISOLATE IT IOR B40 ADD THE BLANK STA ERM6 SET IN MESSAGE STA EXTM,I AND IN THE PASSED BUFFER LDA K14 SENT THE MESSAGE LDB DERM LENGTH AND ADDRESS TO A,B JSB PSL.F PRINT IT EXLNX LDA F..DP A SYMBOL WAS OUTPUT, NOW STA F.A TEST FOR A DUPLICATE? * EX01 JSB GNA.F GET THE NEXT ASSIGN ENTRY SSA,RSS JMP EX09 END ALL OK OR REPORTED * LDA F.A,I GET THE TAG WORD AND B600 IS IT A CPA B200 SUB? RSS YES SKIP JMP EX01 NO TRY NEXT ENTRY * LDA F.A,I CHECK SIZE AND K7 MUST CPA SIZE HAVE THE SAME NO. OF WORDS TO MATCH CMA,INA,RSS YES SKIP JMP EX01 NO TOO SHORT * ADA K2 KEEP NUMBER OF WORDS IN SYM STA T3EX LDA F.A MUST HAVE AN INA ORDINAL (NEGATIVE) LDA A,I OR BE IN FIX-EXT PART SSB SKIP IF NOT IN FIX-EXT PART OF TABLE CCA ELSE FOURCE SSA,RSS FURTHER TEST JMP EX01 INTERNAL STMT. FUNCTION OK * STB T2EX SAVE FIX-EXT FLAG. (FROM GNA.F) LDB F.A GET ADDRESS CPB T1EX IF SAME ADDRESS THEN JMP EX01 IT IS THE SAME SYMBOL OK * ADB K2 OF THE SYMBOL LDA B,I GET 1'ST TWO CHAR. AND KK757 UNHIDE THE SYMBOL. CPA ERM1 MATCH? INB,RSS YES JMP EX01 NO ALL OK TRY NEXT SYMB. * ISZ T3EX STEP COUNT DONE? RSS NO TRY NEXT TWO CHAR JMP EX05 MATCH GO CHECK FURTHER * LDA B,I GET 2'ED TWO CHARS. CPA ERM3 MATCH? CCE,INB,RSS YES SKIP JMP EX01 NO TRY NEXT SYMBOL * ISZ T3EX STEP COUNT DONE? RSS NO SKIP JMP EX05 YES A MATCH * LDA B,I GET LAST TWO CHARS. LDB A TO BOTH A AND B * AND B377 ISOLATE SIXTH CHAR CPA B40 IF LAST IS BLANK SKIP CLE,RSS ELSE BLF,BLF SWAP 5'TH AND 6'TH CHARS. LDA B NOW AND C377 MAKE SURE IOR B40 LEAST CHAR. IS CPA ERM6 BLANK AND TEST IT RSS BIG TROUBLE A DUPLICATE JMP EX01 MAKE IT BY SKIN OF TEETH! * * EX05 LDA T1EX CHECK IF NAM BUFFER INA,SZA,RSS IF SO ALWAYS JMP EX08 REPORT * LDA A,I IF ORDINALS LDB F.A ARE INB CPA B,I THE SAME JMP EX01 WE ALREADY REPORTED THIS ONE * EX08 LDA K91 ERROR 91 IF HIS SYMBOLS LDB T4EX IF ORGIONAL SYMBOL IN FIX-EXT TBL. SZB,RSS THEN JMP EX07 SET TO SEND 92 * LDB T2EX IF MATCHING SYMBOL IS IN FIX-EXT SSB,RSS WELL JMP EX02 NO REPORT ERR 91 * EX07 LDB F.A FIX-EXT INB DID HE LDB B,I USE IT? INA 92 IF HE DID SSB,RSS IF ORDINAL ASSIGNED HE DID USE IT LDA K85 NO USAGE CHANGE TO WARNING CPA K85 IF WARNING JMP EX04 SKIP ERROR FLAG SET * EX02 ISZ ER.F SET FLAG TO PRODUCE ERROR ISZ F.ERF STEP ERROR COUNT EX04 STA T3EX SAVE THE ERROR NUMBER JSB WAR.F SEND THE MESSAGE (CAN'T USE ER.F LDA K3