ASMB,Q,C HED ** 16K FTN4 COMPILER (F4.2:PASS2) ** NAM F4.2,5 92060-16096 REV.2026 800423 * *************************************** * FORTRAN-4 COMPILER OVERLAY 2 *************************************** * * THIS OVERLAY TRANSLATES THE PSEUDOCODE GENERATED BY * PASS 1 INTO RELOCATABLE BINARY, GENERATES THE ASSEMBLY * LISTING, AND LISTS THE ASSIGNMENT TABLE. * *************************************************************** * (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. * *************************************************************** * NAME: F4.2, PART OF FTN4 COMPILER. * * SOURCE: 92060-18096 * * RELOC: 92060-16096 * * PGMR: BILL GIBBONS. * *************************************************************** * * 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.AF ADDRESS FIELD CURREXT F.A EXT F.AT ADDRESS TYPE OF CURREXT F.A EXT F.CC CHARACTER COUNT EXT F.CCW FTN OPTION WORD EXT F.D DO TABLE POINTER EXT F.D0 ARRAY ELEMEXT SIZE EXT F.DID ADDRESS OF F.IDI EXT F.DNI ADDRESS OF NID EXT F.DO LWAM - END OF DO TABLE EXT F.DP BASE OF USER SYMBOL TABLE EXT F.END END FLAG EXT F.ERF ERROR FLAG (# OF ER.F CALLS) EXT F.IDI INPUT ARRAY NON-NUMERIC EXT F.IM CURREXT ITEM MODE (REAL, COMPLEX,ECT.) EXT F.IU CURREXT ITEM USAGE (DUM., RELATIVE, ECT.) EXT F.LFF LOCICAL IF FLAG EXT F.LSN F.A OF LAST STATEMEXT NUMBER EXT F.LSP LAST OPERATION FLAG EXT F.NT NAME TAG 0= VAR, 1=CONSTANT. EXT F.NW NO. WORDS THIS TABLE F.A EXTRY. EXT F.R JSB ERR0 FLAG 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 F.SPF SPECIFICATION FLAG SET TO CURREXT STMT. LEVEL * * EXT'S WITH A TRAILING '.F' ARE SUBROUTINES * EXT AA.F ASSIGN ADDRESS SUB. EXT AI.F ASSIGN ITEM EXT CRP.F CROSS REF PAIR SUB. EXT DAF.F DEFINE (F.AF) EXT DIM.F DEFIND (F.IM) EXT DIU.F DEFINE (F.IU) EXT DL.F DEFINE LOCATION SUBROUTINE EXT ER.F ERROR PRINT SUBROUTINE EXT ESC.F ESTABLISH CONSTANT SUBROUTINE EXT FA.F FETCH ASSIGNS EXT FID.F FETCH (ID) TO NID (UNPACK) EXT GNA.F GET NEXT SYMBOL TABLE EXTRY EXT NTI.F MOVE NID TO F.IDI (PACKS) EXT OAI.F OUTPUT ABS. INSTRUCTION EXT OC.F OUTPUT CONSTANT EXT ODF.F OUTPUT DOT FUNCTION EXT OLR.F OUTPUT LOAD ADDRESS EXT OS.F OUTPUT SECTOR TO INTERPASS FILE EXT PDF.F PRODUCE DEF SUBROUTINE EXT PSL.F PRINT LINE ON PRINTER EXT PTM.F PROGRAM TERMINATION CODE GEN. EXT RTN.F SUBROUTINE RETURN HANDLER EXT SKL.F SKIP LINES ON LIST EXT WAR.F ERROR COMMEXT SUBROUTINE (WARNINGS) * * LIBRARY UTILITIES * EXT .MVW MOVE WORDS MACRO * * * OPSYSTEM INTERFACE: * EXT EOF.C EXT C.SC1 * COMPILER LIB ROUTINES * * * SUP SPC 1 A EQU 0 B EQU 1 SPC 1 .TBL EQU 0 SPC 1 DEC 2 OVERLAY # SKP * ***************** * * END PROCESSOR * * ***************** SPC 1 * ASSIGN ADDRESSES TO CONSTANTS * OUTPUT END RECORD FOR LOADER SPC 1 F4.2 ISZ F.END SET THE END FLAG LDB F.LFF LDA K88 88 SZB TRUE BRANCH OF LOGICAL "IF"? JSB ER.F YES. BITCH. * CCA SET UP TO STA F.A FLUSH THE JSB CRP.F FINAL CROSS REFERENCE PAIR LDB F.D LOC OF LAST DO ENTRY IN DO TABLE DTCK1 STB T2STF SAVE DO TABLE PTR CPB F.DO END OF DO TABLE SEARCH? JMP DTCK5 YES. LDA F.LSN IS THIS STATEMENT # A DO TERM? CPA B,I JMP DTCK3 YES. GRIPE. * LDB T2STF OTHERWISE IT IS LDB B,I SURLY UNDEFINED LDA B,I IOR K8 SO SET THE USED FLAG STA B,I SO IT IS REPORTED LATER DTCK2 LDB T2STF COMPUTE ADDRESS OF NEXT ENTRY ADB K5 JMP DTCK1 SPC 1 DTCK3 LDA K30. 30 JSB WAR.F ILLEGAL DO TERMINATOR JMP DTCK2 CONTINUE THE SCAN * DTCK5 LDB F.LSN STB F.A SET F.A INCASE STMT. NUMBER SZB JSB DL.F DEFINE AF=RPL FOR ST# LOC. CCA SET FLAG STA F.CC TO USE SHORT FORM ERROR MESSAGE LDB F.SPF GET CURRENT STMT. LEVEL ADB KM3 TEST IF MORE THAN JUST SPECS AND DATA LDA F.SFF IF BLOCK DATA SUBPROGRAM CPA K2 THEN CMB CHANGE SENSE OF TEST SSB IF PROGRAM AND NO EXECUTABLE OR BLOCK DATA WITH JMP ENDP1 THEN GO SEND ERROR * SZB,RSS IF JUST STMT. FUNCTIONS CPA K2 AND NOT BLOCK DATA JMP ENDP0 THEN * LDA K78 BITCH JSB WAR.F ERROR 78: NO EXECUTABLE STMTS ENDP0 CLA,INA JSB SKL.F SKIP TWO LINES LDB F.LSP IF NO PATH ADB F.LSN THEN SET B TO SHOW LDA F.SBF SUBPROGRAM FLAG SET? STA F.A SZA,RSS JMP ENDP8 NO, MAIN; GENERATE STOP CALL * SZB IF NO PATH TO HERE NO RETURN NEEDED JSB RTN.F RETURN HANDLER JSB FA.F FETCH ASSIGNS LDA F.IU LDB F.SFF IS IT A FUNCTION? SZB XOR VAR YES. THIS AREA (64 WORDS) USED FOR XREF BUFFER LDB A LDA K46 SZB JSB WAR.F FUNCTION NAME NOT USED OR JMP ENDP3 SUBROUTINE NAME USED SPC 1 ENDP8 LDA F.SFF IF BLOCK DATA SUBPROGRAM CPA K2 THEN JMP ENDX3 SKIP REST OF THE END STMT. PROCESSING * SZB IF NO PATH TO HERE SKIP TERM CALL JSB PTM.F GEN PROG TERMINATE EXEC CALL ENDP3 LDA F.DP STA F.A F.A=DATA POOL START ADDRESS ENDP4 CLA CLEAR STA IGNOR THE IGNOR SWITCH FOR LABEL GEN. JSB GNA.F GET NEXT F.A SSA,RSS JMP ENDP6 END OF ASSIGNMENT TABLE JSB FA.F FETCH ASSIGNS LDA F.NW # OF WORDS IN ENTRY ADA KM3 -3 SSA JMP ENDP4 1 OR 2-WORD ENTRIES * LDA F.A,I IF NOT USED AND K8 DON'T OUTPUT CMA,CLE,INA SET E IF NOT REFERENCED * LDA F.NT SZA JMP ENDP5 CONSTANT * LDB F.IU IF ARRAY CPB SUB IF SUB JMP ENDP4 THEN IT IS OK * CPB ARR THEN JMP ENDP4 ALREADY DEFINED * CPA F.IU JMP ENDP9 F.IU=0, STATEMENT # * LDA F.AT IF CPA REL ALREADY DEFINED ISZ IGNOR SET SWITCH SEZ,RSS IF REFERENCED JSB AA.F ASSIGN ADDR TO VARIABLES LDA F.AF GET CURRENT LOAD ADDRESS RAL,CLE,SLA,ERA THEN INA,RSS IT POINTS TO A SYMBOL WITH JMP ENDPI * LDA A,I OFFSET AS THE VALUE LDB F.A GET OFFSET ADB K2 FROM THE ENTRY LDB B,I AND RBL,CLE,ERB CLEAR THE SIGN ADA B PUT FINAL ADDRESS IN A JSB DAF.F DEFINE ADDRESS OF THIS SYMBOL ENDPI LDA F.IM IF CPA ADR ADDRESS RSS SKIP JMP ENDP4 SPC 1 LDA IGNOR IF ADDRESS AND ALREADY DEFINED SZA,RSS NO NOT ALREADY DEFINED JMP ENDP4 FORGET IT * LDA TWPE ELSE DEFINE AS A PGM TMP JSB DIM.F AND CCB GIVE IT ADB TWA A NAME STB TWA LDA F.A ADA K2 STB A,I JMP ENDP4 * K2 DEC 2 K5 DEC 5 KM3 OCT -3 TWA OCT -4000 ADR OCT 70000 K66 DEC 66 K88 DEC 88 T2STF NOP IGNOR NOP K8 DEC 8 K30. DEC 30 K78 DEC 78 K46 DEC 46 REL OCT 1000 AT =1 ARR OCT 600 SUB OCT 200 VAR OCT 400 INT OCT 10000 REA OCT 20000 DIM OCT 6000 AT=6=DIMENSION B20 OCT 20 SPC 1 ENDP1 LDA K66 JSB WAR.F PROGRAM/FUNCTION WITHOUT BODY JMP ENDP0 OR BLOCK DATA WITH EXECUTABLE STATEMENTS SPC 1 ENDP5 LDA F.IU CPA VAR RSS JMP ENDP2 GO TEST IF DIM ENTRY * LDA F.AT SEZ,RSS IF NOT REFERENCED OR CPA REL ALREADY DEFINED JMP ENDP4 ALL IS OK ON TO THE NEXT ONE * LDA F.R IF ALREADY DEFINED SZA SKIP JMP ENDP4 REDEFINITION * JSB OLR.F OUTPUT L.A.=RPL LDA F.IM IF F.IM = 0 THEN A DEF SZA,RSS SO JMP END05 PROCESS AS SPECIAL * LDA F.A JSB OTC.F OUTPUT CONSTANT JMP ENDP4 CONTINUE SYMBOL TABLE SCAN. * * ******************************** * * ROUTINE TO OUTPUT A CONSTANT * * ******************************** * OTC.F NOP STA F.A SET THE A.T. ADDRESS JSB FA.F FETCH ASSIGNS LDA F.R HAS THIS CONSTANT ALREADY SZA,RSS BEEN ALLOCATED A LOCATION? JSB DL.F NO SO DO IT NOW LDA F.A,I FLAG IT DONE IOR B20 TO PREVENT STA F.A,I UN NEEDED DUPUPS LDA F.A MOVE THE CONSTANT ADA K2 TO LDB F.DID F.DID JSB .MVW FOR OUTPUT DEF F.D0+0 FOR OUTPUT NOP JSB OC.F SEND IT JMP OTC.F,I RETURN * * * ************************************************* * * ROUTINE TO ESTABLISH A CONSTANT AND OUTPUT IT * * ************************************************* * * * ENTER E=0 FOR REAL, E=1 FOR INT, A,B= VALUE * BIC.F NOP BUILD INTEGER CONSTANT DST F.IDI SET ITS VALUE LDA INT GET THE TYPE SEZ,RSS IF TO BE REAL LDA REA GET TYPE JSB ESC.F ESTABLISH CONSTANT JSB AI.F ASSIGN IT LDA F.A AND JSB OTC.F OUTPUT IT JMP BIC.F,I RETURN A=0,E=1 * * ENDP2 LDA F.AT IF THIS IS A DIM ENTRY CPA DIM THEN SEZ SKIP JMP ENDPE ELSE CONTINUE SEARCH * LDB F.AF SAVE THE ADDRESS OF THE BCOM ENDPF LDA B,I HAS THE BCOMI ENTRY BEEN REFORMATED YET? AND B20 YES IF NON ZERO CMA,CLE,INA PUT RESULT IN E (SET IF NEEDS TO BE REFORMATED LDA B,I SET BIT NOW IOR B20 IN STA B,I ANY CASE INB SET UP ADDRESS STB DAD IN ANY CASE SEZ,RSS WELL? JMP ENDPH YES DO NOT REARRANGE * DLD DAD,I GET THE TWO WORDS SWP SWITCH THEM DST DAD,I AND RESTORE DAD EQU *-1 ENDPH ISZ DAD POINT ADDRESS AT THE RIGHT WORDS LDA F.RPL REFERENCED DIM ENTRY JSB DAF.F MUST BE EMA- TABLE REFERENCE JSB OLR.F DEFINE LOAD ADDRESS (SETS E) LDA F.A SAVE DIM ADDRESS STA T2STF IN TEMP ADA KM1 COMPUTE ADDRESS ADA F.NW LAST DIMENSION ADDRESS STA T1STF AND SAVE IT ALSO LDA F.IM GET THE NUMBER ALF OF DIMENSIONS STA T3STF AND SAVE IT STA T4STF ALSO AS FLAG. JSB BIC.F SEND FIRST WORD OF THE TABLE LDA T3STF GET DIMENSION COUNT CMA,INA,SZA,RSS SET NEGATIVE JMP ENDPG IF ZERO DIM CASE GO DO OFFSET * STA T3STF AND SET AS COUNTER ENDPB CCA,CCE START LOOP JSB BIC.F BUILD A -1 AND SEND IT ISZ T3STF ONLY ONE DIM.? JMP ENDPC NO GO SEND DIM VALUE. * LDA T2STF GET F.A OF DIM ENTRY ADA K2 INDEX TO F.DAY STA BIC.F SAVE THE ADDRESS LDA A,I SHOULD BE #WORDS PER ELEMENT LDB DAD CACULATE ADDRESS OF BCOMI ENDTRY ADB KM2 AND STB BIC.F,I SET IT IN F.DAY FOR SYMBOL TABLE LIST * * * NOTE WE ARE LOSING THE NO. WORDS/ELEMENT HERE BUT * WE MUST KEEP A POINTER TO THE BCOMI ENTRY SO * THAT THE OFFSET MAY BE PRINTED WITH THE SYMBOL TABLE * LIKE WISE THE POINTER TO THE BCOMI ENTRY SLOT IN * THE DIM ENTRY IS NOW THE LOAD ADDRESS OF THE TABLE * EVEN SO THE S.T. PRINT ROUTINE MUST BE CAREFUL IN * READING THIS INFORMATION AS THE F.AF CAN NOT * BE TRUSTED FOR ARRAYS IN LABELED COMMON. * TO MAKE IT WORST THE ENTRY IS CHANGED ONLY IF * THE ARRAY WAS REFERENCED AT SOME POINT AND THUS * REQUIRED A TABLE ENTRY. * * IS THAT CLEAR? * * JSB BIC.F PUT IT IN THE TABLE ENDPG DLD DAD,I GET THE OFFSET SSA DUMMY ? JMP ENDPK YES. CLE,ERB PACK THE NUMBER RAL,ERA TO A DOUBLE INTEGER (CLEARS E) JSB BIC.F SEND THE DOUBLE WORD ENDPJ LDA T2STF RESTOR STA F.A F.A AND JMP ENDP4 CONTINUE THE SCAN. ENDPK LDA T4STF DUMMY. CHECK IF ZERO-DIM CASE. SZA,RSS AND PICK WHICH TEMP TO GENERATE. LDB DAD,I CMB ASSIGN TEMP. STB F.A JSB DL.F ASSIGN TEMP HERE. CLA JSB OAI.F JSB OAI.F JMP ENDPJ * BCOMI OCT 7000 * ENDPE CPA BCOMI IF BCOMI ENTRY CLA,SEZ AND REFERENCED JMP ENDP4 (NOPE CONTINUE) * STA F.IM SET TO USE ZERO DIM. LDB F.A GET ADDRESS TO B JMP ENDPF AND GO DO IT * * ENDPC CCA CACULATE DIMENSION ADDRESS ADA T1STF AND STA T1STF SAVE FOR NEXT TIME LDA A,I GET A.T. ADDRESS OF CONSTANT LDB A,I CHECK IF NAMED. SSB,RSS JMP ENDPL IF SO, IS TEMP FOR VAR DIM. JSB OTC.F AND PRODUCE IT JMP ENDPB GO CONTINUE LOOP ENDPL STA F.A VAR DIM. ALLOCATE TEMP. JSB DL.F ASSIGN TEMP HERE. CLA JSB OAI.F JMP ENDPB * * END05 JSB PDF.F PRODUCE A DEF JMP ENDP4 GO GET NEXT ENTRY SPC 1 ENDP6 LDA F.DP NOW SCANN FOR THE ASCII STRINGS STA F.A THEY WILL HAVE F.AF < 0. ENDX1 JSB GNA.F AND WILL BE EITHER SSA,RSS F.IM=TWPE,,OR 0 (STATEMENT # FOR FORMAT STMT.) JMP ENDX9 END OF TABLE DONE * JSB FA.F FETCH ASSIGNS. LDA F.AT IT WILL HAVE F.AT= CPA REL REL RSS GOOD JMP ENDX1 NOT THIS ONE TRY NEXT * LDA F.IM NOW TEST THE F.IM SZA ZERO OR CPA TWPE A TWO WORD ONE RSS GOOD JMP ENDX1 NO TRY NEXT ONE * LDA F.AF MUST BE <0 FOR WHAT WE WANT CMA,SSA,INA SET POS AND TEST JMP ENDX1 NOT THIS ONE TRY NEXT * ADA F.RPL UPDATE THE PROGRAM SIZE STA T1FBL SAVE IT LDA F.RPL SET JSB DAF.F THE AF FOR THIS GUY LDA T1FBL NOW STA F.RPL PUSH THE LOCATION COUNTER SSA,RSS IF OVERFLOW SKIP JMP ENDX1 TRY NEXT ENTRY * JMP ENDX2 ABORT THE COMPILE * T1FBL NOP T1STF NOP T3STF NOP T4STF NOP B1000 OCT 1000 .BAD. DEF .TBL+50 KM1 DEC -1 KM2 DEC -2 * ENDX9 LDB .BAD. LDA F.ERF # OF ERRORS IN COMPILATION SZA JSB ODF.F 'JSB .BAD.' CLA JSB SKL.F YES, SKIP A LINE. ENDX3 LDA F.CCW IS FOUR-WORD DOUBLE IN EFFECT? AND B1000 SZA,RSS JMP CRSEC NO, DONE. GO EXIT SEGMENT. LDA F..DP YES. CHANGE NAMES IN FIX-EXT TBL STA F.A F.A=BASE LOC OF FIX-EXT-TBL SWAP0 JSB GNA.F GET NEXT F.A SSB,RSS IS IT IN FIX TBL?? JMP CRSEC NO. DONE. GO EXIT SEGMENT * LDB F.A ADB K2 LDA B,I RENAME THE DOUBLE ROUTINES CPA "SN" IF SINGLE LDA ".N" CHANGE TO '.NGLE' CPA "ID" IF IDINT, LDA "/T" CHANGE TO '/TINT' CPA "DD" IF DDINT, LDA ".Y" CHANGE TO .YINT STA T2STF SAVE FIRST TWO CHAR. AND C377 ISOLATE HIGH CHAR CPA "D" IS IT A 'D'? LDA "." YES CHANGE TO '.' XOR T2STF MUDLE BACK IN AND C377 THE LOW BYTE XOR T2STF THERE I THINK THAT IS RIGHT STA B,I SET IT BACK IN THE FIX-EXT TABLE JMP SWAP0 * C377 BYT 377 "SN" ASC 1,SN "D" OCT 42000 "." OCT 27000 ".N" ASC 1,.N "ID" ASC 1,ID "/T" ASC 1,/T "DD" ASC 1,DD ".Y" ASC 1,.Y TWPE OCT 40000 F.IM=4 DUMMY TWO WORD ENTRY * * ENDP9 LDA F.AT CHECK FOR UNDEFINED ITEMS. CPA REL JMP ENDP4 CPA DUM JMP ENDP4 LDA F.A CPA F.SBF JMP ENDPA SUBROUTINE NAME * JSB FID.F UNPACK THE SYMBOL JSB NTI.F NOW PACK IT BACK TO F.IDI LDA F.DNI,I GET FIRST CHAR. CPA K64 STMT # ? CLB,INB,RSS YES. JMP ENDP4 LDA F.DID ADB ENDK3 JSB .MVW COPY ASCII STMT # DEF K3 NOP ISZ ER.F LOG AS AN ERROR LDA K32 INVALID STMT. NO. (UNDEFINED) JSB WAR.F SEND THE MESSAGE LDA K10.. LDB ENDK3 "UNDEFINED" JSB PSL.F PRINT OUT UNDEFINED MESSAGE ISZ F.ERF F.ERF=F.ERF+1 JMP ENDP4 SPC 1 K32 DEC 32 * ENDPA LDA VAR JSB DIU.F F.IU=VAR. JSB DL.F DEFINE LOC. LDA F.RPL ADA F.D0 STA F.RPL RPL=F.D0+RPL SSA,RSS JMP ENDP4 ALL OK * ENDX2 LDA K84 RPL OVER FLOW JMP F.ABT ABORT * SPC 2 ENDK3 DEF *+1 ASC 10, UNDEFINED K10.. DEC 10 K3 DEC 3 K64 DEC 64 K84 DEC 84 DUM OCT 5000 SPC 2 SPC 1 * UPDATE THE FOLLOWING WHEN REVISING THE COMPILER: * ENDK5 DEF CMPID CMPID DEC 25 WORDCOUNT OF FOLLOWING TEXT ASC 18, FTN4 COMPILER: HP92060-16092 REV. ASC 7,2026 (800423) * * *------------------------* * * START HERE. * * *------------------------* * CRSEC JSB OS.F OUTPUT THE FINAL SECTOR JSB EOF.C END FILE I- FILE DEF C.SC1 JMP PASSE ERROR SEND 99 ERROR * LDB ENDK5 PRINT THE COMPILER ID LDA B,I NOW INB JSB PSL.F CLA JSB SKL.F SKIP A LINE LDB K5 PASS CONTROL TO SEGMENT 5 TO DO PASS2 JMP F.SEG THERE SHE GOES! * PASSE LDA K99 ERROR ON EOF JMP F.ABT ABORT THE COMPILE * K99 DEC 99 END F4.2