return to main page1401 - FORTRAN - Illustrated
Goal: a web page that combines
- the "known" FORTRAN phase descriptions from 1401-IBM-Systems-Journal-FORTRAN.html - with the disassembled and commented "phases" from Van Snyder, up through rev. v3m4. The code in this page was sent by Van Snyder, April 18, 2004 - in a main (mokotoff-9.zip) and an update (mokotoff-9-v3m4.zip). I merged the files, replacing the updated files. Van Snyder and David Macklin have been working on this disassembly.
Links to:
Phase 00, 01, 02, 03, 04, 05, 06, 07, 08, 09,10, 11, 12, 13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49, 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62, 63 The principal function of each phase of the compiler is indicated below. Secondary functions are subordinated; for example, error checking occurs in almost every phase, but is seldom mentioned.
- Phase 00 - Snapshot. Loads a snapshot routine into 350 positions of core storage. This routine lists a specified amount of core storage.
- Phase 01 - System Monitor. Brings in the next phase from the system tape or initiates reading of the next phase from cards, depending on whether the compiler is used as a tape or card system. The monitor and snapshot routines are the only ones that exist in storage throughout compilation. Because the phases act serially, very little is required of this phase which consists of only 20 instructions.
- Phase 02 - Loader. Stores the entire source program, statement by statement, with all non-significant blanks eliminated. The source program is stored backwards in order to use the 1401 machine instructions that cause address registers to decrement when processing data. Appended on the right of each statement is a three-position internal sequence number (001 for the first statement, 002 for the second, etc.). The sequenced source program is printed.
JOB Fortran compiler -- phases 00-02 CTL 6611 * * SNAPSHOT, SYSTEM MONITOR, and LOADER phase. v3m4 * * Read and store the source program, in reverse order, starting * at the top of core, with blanks removed except within * Hollerith fields in FORMAT statements. Each statement begins * with 000. Format statements then have F, while others have R. * Then the label, if any, followed by a colon. The end of each * statement is marked by a group mark with a word mark. After * the last card, a STOP statement is inserted. * ORG 1 * * Starts here if booted from tape * 1start BER lderr Boot error? 6 B beginn No, start up 10lderr H lderr 39 DCW @0 @ * * Left over from the rest of the overlay card * 40 NOP 0,0 47 SW 40,40 54 SW 40,40 61 SW 40,40 68 B beginn 80 DCW @009750023@ * 86 DC @ @ 89X1 DCW @000@ xxxxx1 equ x1 for use in SFX regions 91 DC @00@ 94X2 DCW @000@ xxxxx2 equ x2 for use in SFX regions 96 DC @00@ 99X3 DCW @000@ xxxxx3 equ x3 for use in SFX regions 104 DC @0 @ 110phasid DCW @LOADER@ Phase ID, for snapshot 111 DCW #1 WM cleared if DO statement appears 112 DCW #1 WM cleared if DO statement appears 113 DCW #1 WM cleared if DO statement appears 114 DCW #1 WM cleared when an I/O list of DO is processed 115 DCW #1 WM cleared if I/O list and not limited format 116subscr DCW #1 WM cleared if subscript code needed 117series DCW #1 Need series routine if no WM 118sincos DCW #1 Saw sinf or cosf if no WM 119logf DCW #1 Saw logf if no WM 120expf DCW #1 Saw expf if no WM 121 DCW #1 Saw atanf if no WM 122sawabs DCW #1 Saw absf if no WM 123sawneg DCW #1 Saw negation operator (unary minus) if no WM 124xfixf DCW #1 Saw xfixf if no WM 125floatf DCW #1 Saw floatf if no WM 126 DCW #1 Saw sqrtf if no WM 127 DCW #1 Saw user function R if no WM 128 DCW #1 Saw user function U if no WM 129 DCW #1 Saw user function P if no WM 130 DCW #1 Saw user function W if no WM 131 DCW #1 Saw user function Y if no WM 132 DCW #1 Saw user function Z if no WM 133 DCW #1 Saw user function J if no WM 134 DCW #1 Saw user function K if no WM 135 DCW #1 Saw user function L if no WM 136 DCW #1 Saw user function M if no WM 137 DCW #1 Saw user function D if no WM 138 DCW #1 Saw user function H if no WM 139 DCW #1 Saw xlinkf if no WM 142negar2 DCW #3 Looks like negary -- see phase 20 145tblbot DCW #3 One below numbers, formats, I/O lists 148seqtab DCW #3 Bottom of sequence number table - 2 151docnt DCW #3 Count of DO statements 154botfmt DCW #3 Bottom of format strings or number table - 1 157negar3 DCW #3 Looks like negary -- see phase 20 160arysiz DCW #3 Total array size & 2 163negary DCW #3 16000 - arysiz 180 DC #17 183nstmts DCW #3 Number of statements, including generated stop 184glober DC #1 Global error flag -- WM means error 185gotxl DCW #1 XLINKF was referenced if no WM 188reltab DCW #3 Relocatable function table entry addresses 191subent DCW #3 Entry to subscript routine 194arytop DCW #3 Top of arrays in object code 195 DC #1 199 DCW @V3M4@ ORG 333 * * Snapshot routine * sfx s 333snapsh SBR exit&3 337 SBR sxx&6 341 MCW kz3,adr5-2 Start five-digit address at zero 348 MCW xxxxx3,sx3&6 355 MCW xxxxx1,sx1&6 362 SBR xxxxx1,1 369 SBR xxxxx3,202 376 CS 332 380 CS 381 MCW phasid,210 388 BSS skip,F * * Print a header * 393 CC 1 395 MCW xxxxx2,250 402sxx SBR 216,0 return address was stored in B 409sx3 SBR 256,0 x3 was stored in B 416sx1 SBR 244,0 x1 was stored in B 423 W 424 CC K 426 ZA kp2,w2a 433clearh CS 332 437 CS 438 CC J 440 MCW adr5,306 five-digit address 447 MCW 448 SBR loop&6 452 MCW k9,w2b-1 459loop MCW w2b-1,000 466 MCW dots 470 SBR loop&6 474 A km10,w2b add I0 = -10 481 BWZ loop,w2b-1,2 no zone in counter high digit? 489 A kp1,adr5-2 bump hundreds digit of address 496 W 497get SW 0&X3 move data and wm to print area 501 MCW 0&X1,0&X3 508 BW dowm,0&X1 skip clearing print area wm 516 CW 0&X3 520dowm C xxxxx1,topcor Done? 527 BU cont no 532 W 533 WM 535rx1 MCW sx1&6,xxxxx1 Restore index regs 542 MCW sx3&6,xxxxx3 549 CS 332 553 CS 554 BSS halt,G 559 B exit 563halt H 564exit B 0-0 568cont SBR xxxxx1,1&X1 575 BCE bump3,xxxxx3-2,2 583 SBR xxxxx3,201 590 W 591 WM 593 A kp1,w2a 600 C w2a,kp15 607 BU clearh 612 S w2a 616 CCB clearh,1 621skip MCW xqtd,220 628 W rx1 632bump3 A kp1,xxxxx3 639 B get 651dots DCW @9........@ 653 dcw @9-@ 658adr5 DCW 00000 Five digit address 661kz3 dcw 000 662kp2 DCW &2 664w2a DCW #2 665k9 dcw 9 667km10 DCW @I0@ 669w2b DCW #2 670kp1 dcw &1 672kp15 dcw &15 680xqtd dcw @EXECUTED@ sfx End of snapshot routine * * Storage for parameter card * da 1x19 685pword 5 The word PARAM 688topcor 8 Top core address from PARAM card 690imod 10 Integer modulus -- number of digits 692mantis 12 Floating point mantissa digits 693condns 13 P for condensed deck 694snapsw 14 S for snapshot 695c1410 15 T if run on 1410 in 1401 compatibility mode 696fmtsw 16 X for no format, L for limited format * blank for ordinary, A for A conversion 699param 19 Parameter card is stored here * * Load next overlay * sfx l 700loadnx MCW clrbot-2,k999-2 Set clear end high digit 707clearl CS 0-0 711 SBR clearl&3 715 C clearl&3,k999 722 BU clearl 727 SW clrwm&4 731 MCW clearl&3,clrwm&6 738 CW clrwm&4 742clrl C clrwm&6,clrbot 749 BE cdovly Load the overlay 754clrwm LCA blank,0 Clear with blank and word mark 761 SBR clrwm&6 765 B clrl 769cdovly R 40 Card overlay unless nop 773rdagin MCW einit,ecount Initialize error count 780tpread RTW 1,beginn Load overlay from tape 788 BER tperr Error? 793 B beginn No, run the overlay 797tperr BSP 1 802 S one,ecount 809 BWZ tpread,ecount,B Still positive? 817 H 3333,3333 Too many tape errors 824 B rdagin Read again 830k999 DSA 999 833clrbot DCW #3 Address to clear down to 834blank DCW #1 835einit DCW &9 Initial error count 836one dcw &1 837ecount DCW #1 sfx End of load next overlay routine * * Start here * 838beginn BCE card,1, Being loaded from cards? 846 MCW nop,cdovly Turn off card overlay 853card CS 80 857 SW 1,gm 864 SW 81,84 871 CS 332 875 CS * * Read and check parameter card * 876 R Read parameter card 877 LCA 19,param Save it 884 C param-14,kparam Is it a parameter card? 891 BU noparm No, announce error 896 SW 73 Set word marks for 900 SW 6,7 Fortran margins 907 SW topcor-2 911 MCW 80,pword * * Determine this machine's core size, compare it to * size on parameter card * 918 CS 0-0 922 SBR corsiz 926 MCW topcor,toconv 933 B adconv Covert topcor to five digits 937 MCW convtd,top5 944 MCW corsiz,toconv 951 B adconv Convert corsiz to five digits 955 MCW convtd,cor5 962 A kp1,top5 Top addr + 1 = size 969 A kp1,cor5 Cor addr + 1 = size 976 CS 332 980 CS 981 CC 1 983 CS 332 987 CS 988 MCW stmsg,228 Start Fortran Compilation msg 995 W 996 CC J 998 MCW top5,231 1005 MCW spsize Specified size 1009 W 1010 CS 235 1014 MCW cor5,228 1021 MCW actsiz Actual size 1025 BCE bignuf,c1410,T Compiling for 1410 compatibility? 1033 W 1034 C cor5,top5 1041 BH psgtm Print Spec size gt Mach size 1046 C top5,k3900 Compare top to 3900 1053 BL bignuf 1058 CC J 1060 CS 332 1064 CS 1065 MCW sizerr,218 Machine size error 1072 W 1073 B useact 1077psgtm MCW sgtm,267 Spec. size gt Mach. size msg 1084 MCW sgtm2 Rest of the message 1088 W 1089useact MCW corsiz,topcor Use actual size 1096bignuf MCW topcor,cleard&3 * * Clear from top of this machine's memory down to DOWNTO * 1103cleard CS 0-0 1107 SBR cleard&3 1111 C cleard&3,downto 1118 BU cleard * 1123 R 1124 MZ *-6,azone Set A zone after card storage area 1131 MZ *-6,intrst&7 Set A zone in BCE D-modifier 1138 MZ *-6,blnkok&7 ,, 1145 MZ *-6,intchr-1 Add A zone to interesting chars 1152 MCW prefix,card1-1 Set default prefix 1159 MCW topcor,*&4 1166 CW 0-0 1170 SBR mvchar&6 * * Process next card * 1174rdloop BW movecd,flag 1182 BCE done,1,: * * No system after end card * 1190nosys CC 1 1192 CS 332 1196 CS 1197 MCW msg1,270 1204 W 1205 CC 1 1207halt1 H halt1 * * Move card to save area * 1211movecd MCW 72,card72 Move card to save area 1218 MCW 1219 MCW 1220 BCE done,card1,: 1228c12t BIN prthdg, Unconditional at first, becomes BCV 1233afthdg CS 300 1237 CS 1238 MCW 72,283 Move card to print area 1245 MCW 6,215 1252 BCE lstcmt,card1,C Print now if comment 1260crd1sw B notcnt Becomes NOP after first card 1264 BCE notcnt,card6,0 1272 BCE notcnt,card6, * * Continuation card * 1280 A kp1,cntcnt Bump continuation count 1287 BCE cntok,cntcnt-1,0 Nine or fewer? 1295 MCW cntmsg,300 Put error msg in print area 1302cntok W List the card 1303 MCW card7a,svchar&3 Set save char addr to col 7 * * Process the card (NOTCNT comes back here) * 1310svchar MCW 0-0,char Save a character 1317 SW svchar&1 1321 A k1,svchar&3 Bump addr of char to save 1328 CW svchar&1 1332crd2sw NOP blnkok Branch if copying everything 1336 BCE svchar,char, Skip blanks 1344 MCW char,*&8 1351 BCE intrst,intchr,0 chain5 1364mvchar MCW char,0 1371 SBR mvchar&6 1375bumpns A kp1,nchar Bump character counter 1382 C mvchar&6,botcor Core full of source code? 1389 BE bigsrc 1394crd3sw BCE holler,char,H 1402crd4sw NOP branch,crd3sw * 1409test7 C svchar&3,card7a At column 7? 1416crd5sw BU svchar 1421 SW mvchar&4 1425crd6sw MCW mvchar&6,X2 1432 CW mvchar&4 1436 MCW nop2,crd6sw 1443 MCW nop2,crd5sw 1450 A k10,colcnt 1457 BCE col3,colcnt-1,5 Three columns done? 1465 SW flag 1469 BWZ svchar,colcnt-1,2 More than seven columns done? 1477 MCW brnch2,crd5sw 1484 MCW 0&X2,work7 1491 C kfmt,work7 FORMAT% ? 1498 BU svchar * * Process a format statement * 1503 MCW branch,crd3sw 1510 MCW 0&X3,work6 1517 MCW kf,work6-3 1524 MCW work6,0&X3 1531 B svchar * 1535slash MCW kat,char Convert slash to at-sign 1542 B mvchar * * Not a continuation card * 1546notcnt MCW nop,crd1sw 1553 A kp1,nstmt 1560 MCW nop,crd3sw 1567 MCW nop,crd4sw 1574 MCW 5,211 Move label to print area 1581 S cntcnt Clear continuation count 1585 MCW nop,crd2sw 1592 MCS nstmt,203 Move statement count to print area 1599 W 1600 SW mvchar&4 1604 MCW mvchar&6,mvchr2&6 1611 CW mvchar&4 1615 MCW move,crd6sw 1622mvchr2 LCA gm,0 1629 SBR X3 Save address of first char stored 1633 SBR mvchar&6 1637 MCW colon,card6 Colon after label, if any 1644 MCW brnch2,crd5sw 1651 MCW k20,colcnt Initialize column counter 1658 MCW save2a,svchar&3 1665 B svchar * 1669col3 C 0&X2,kend END card? 1676 BU svchar 1681 CW flag 1685 B svchar * 1689at MCW kminus,char Convert at sign to minus 1696 B mvchar * * Saw an interesting character * 1700intrst BCE testlc,char, Test for A zone 1708 BCE testlc,char,| Record mark 1716 BCE slash,char,/ 1724 BCE at,char,@ 1732 MCW kstar,300 1739 MCW procd 1743 MCW char 1747 B mvchar * * Character is H, probably hollerith * 1751holler MCW mvchar&6,X1 1758 MCW nop,crd3sw 1765 MCW nop,crd4sw 1772 MCW branch,crd2sw 1779 MCW 4&X1,hcount Remember, source is stored backward 1786 BCE at2,hcount-1,@ 1794 BWZ nzhm1,hcount-1,2 1802at2 MCW hcount-2,hcount One digit of hollerith coiunt 1809 MCW kz2 1813 B test7 * * No zone at hcount-1 * 1817nzhm1 BCE at3,hcount,@ 1825 BWZ nzh,hcount,2 1833at3 MCW hcount-2,hcount 1840 MCW kz1,hcount-2 1847 B test7 * * No zone at hcount. Reverse the digits * 1851nzh MCW hcount,workh1 1858 MCW hcount-2,hcount 1865 MCW workh1,hcount-2 1872 B test7 * * Convert address to five digits * sfx c 1876adconv SBR exit&3 1880 S cnvw2a 1884 S cnvw2b 1888 MZ toconv,cnvw2a-1 1895 MZ toconv-2,cnvw2b-1 1902loop1 BWZ loop2,cnvw2b-1,2 1910 A cnvka0,cnvw2b 1917 B loop1 1921loop2 BWZ lp2x,cnvw2a-1,2 1929 A cnvkq4,cnvw2a 1936 B loop2 1940lp2x A cnvw2b-1,cnvw2a 1947 MCW toconv,convtd 1954 MCW cnvw2a 1958 ZA convtd 1962 MZ *-4,convtd Clear zone in output 1969exit B 0-0 sfx * 1973blnkok BCE testlc,char, Test for A zone 1981 S kp1,hcount 1988 C hcount,pze Hollerith count down to zero? 1995 BU mvchar Nope, just move the character 2000 MCW move2,crd4sw 2007 MCW nop2,crd2sw 2014 MCW svchar&3,X1 2021 C 0&X1,comma 2028 BE mvchar 2033 MCW mvchar&6,*&7 2040 MCW 0,0 2047 MCW comma 2051 SBR mvchar&6 2055 A kp1,nchar 2062 B bumpns 2066 B mvchar * * Finished reading the source deck * 2070done MCW mvchar&6,X1 2077 LCA gm,0&X1 2084 SBR X1 2088 CC 1 2090 CS 332 2094 CS 2095 MCS nchar,205 2102 MCW msgchr,222 2109 W 2110 CC J 2112 MCW nstmt,nstmts 2119 LCA stop,0&X1 2126 SBR X1 2130 SW 2&X1 2134 A kp1,nstmts 2141 BCE notbig,3000, 2149 B bigsrc 2153notbig SBR clearl&3,2999 2160 SBR clrbot,beginn Change address to clear down to 2167 BSS snapsh,C 2172 LCA scanr1,phasid SCANNER 2179 CS 80 Get 2183 SW 1,40 ready 2190 SW 47,54 for 2197 SW 61,68 card 2204 SW 72 overlay 2208 BCE loadnx,cdovly,N Running from tape? 2216 R 2217 C 7,scanr2 2224 BE loadnx 2229 B nosys * * Source program too big * 2233bigsrc CS 332 2237 CS 2238 CC 1 2240 MCW msg2,270 2247 W 2248 CC 1 2250 BCE halt2,cdovly,1 Running from cards? 2258 RWD 1 No, rewind the tape 2263halt2 H halt2 * * Print listing page heading * 2267prthdg CC 1 2269 MCW kat,c12t&4 Change to BCV 2276 CS 299 2280 A k1,pagnum 2287 MCS pagnum,299 2294 MCW kpage,295 2301 MCW 80 2305 W 2306 CS 299 2310 MCW paghdg,234 2317 W 2318 CC J 2320 B afthdg * * No parameter card * 2324noparm CC 1 2326 CS 332 2330 CS 2331 MCW msg3,270 2338 W 2339 CC 1 2341 BCE halt3,cdovly,1 Running from cards? 2349 RWD 1 No, rewind the tape 2354halt3 H halt3 * * List comment card * 2358lstcmt MCW final,203 2365 MCW 5,211 2372 W 2373testlc BLC done 2378 R 2379 B rdloop * 2388intchr DCW @$@/| @ Interesting characters 2423paghdg DCW @ SEQ STMNT FORTRAN STATEMENT@ * * Card save area * da 1x78 save2 2 card1 6 card6 11 card7 12 card72 77 azone 78 * * Constants and work areas * 2503colcnt DCW #2 2506card7a DSA card7 Address of column 7 in save area 2509save2a DSA save2 2510k1 dcw 1 2511brnch2 b 2513k20 dc 20 2520work7 DCW #7 2527kfmt DCW @%TAMROF@ 'FORMAT%' spelled backward 2528nop2 DC @N@ 2529gm DC @}@ 2533prefix DCW @000R@ Default statement prefix -- arithmetic 2534colon DCW @:@ 2536k10 dcw 10 2537move dc @m@ 2548procd DCW @ PROCESSED @ 2549nop NOP 2554kparam dcw @PARAM@ 2557corsiz DCW #3 Actual machine size (top addr) 2560toconv DCW #3 Address to be converted to five digits 2565convtd DCW #5 Address converted to five digits 2566kp1 dcw &1 2594stmsg DCW @START OF FORTRAN COMPILATION@ 2620spsize DCW @MACHINE SIZE SPECIFIED IS @ 2643actsiz DCW @ACTUAL MACHINE SIZE IS @ 2648cor5 DCW #5 CORSIZ as five digits 2653top5 DCW #5 TOPCOR as five digits 2658k3900 DCW 03900 2676sizerr DCW @MACHINE SIZE ERROR@ 2722sgtm DCW @SPECIFIED IS GREATER THAN ACTUAL MACHINE SIZE.@ 2743sgtm2 DCW @ERROR - MACHINE SIZE @ 2746downto DSA 2999 dcw @R99@ 2787msg1 DCW @MESSAGE 1-SYSTEM DOES NOT FOLLOW END CARD@ 2802cntmsg DCW @CONTINUE CD ERR@ 2807nchar DCW #5 Number of characters 2810botcor DSA 3000 Bottom of space to store program 2811branch DCW @B@ 2817work6 DCW #6 2818KF DCW @F@ 2819kat dcw @@@ 2822nstmt DCW #3 Number of statements 2824cntcnt DCW #2 Count of continuation cards 2827kend dcw @DNE@ END spelled backward 2828flag DCW #1 Word mark is a flag 2829kminus DCW @-@ 2830kstar DCW @*@ 2831char DCW #1 Character from input 2834hcount DCW #3 Hollerith count 2836kz2 DCW 00 Two zeros 2837kz1 DCW 0 2838workh1 DCW #1 Work space for hollerith count 2840cnvw2a DCW #2 Work space for address conversion 2842cnvw2b DCW #2 Work space for address conversion 2844cnvka0 dcw @A0@ Constant for address conversion 2846cnvkq4 dcw @?4@ Constant for address conversion 2849pze dcw &000 plus zero 2850move2 MCW 2851comma dcw @,@ 2867msgchr DCW @INPUT CHARACTERS@ 2878stop DCW @ }POTS:R000@ STOP spelled backward, etc. 2885scanr1 dcw @SCANNER@ 2892scanr2 dcw @SCANNER@ 2928msg2 DCW @MESSAGE 2 - OBJECT PROGRAM TOO LARGE@ 2931pagnum DCW #3 2939kpage DCW @ PAGE @ 2968msg3 DCW @MESSAGE 3 - NO PARAMETER CARD@ 2971final DCW #3 org 2999 2999gmwm dcw @}@ END beginn
- Phase 03 - Scanner. Determines the type of each statement and appends a code on the right of each statement. For example, D for DO, S for STOP, I for DIMENSION statements, etc.
JOB Fortran compiler -- Scanner -- phase 03 v3m4 * * SCANNER phase: Insert statement numbers (not labels) * Classify statements (format statements already classified) * CTL 6611 * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps snapsh equ 333 Core dump snapshot routine * pword equ 685 The word PARAM topcor equ 688 Top core address from PARAM card imod equ 690 Integer modulus -- number of digits mantis equ 692 Floating point mantissa digits condns equ 693 P for condensed deck snapsw equ 694 S for snapshot c1410 equ 695 T if run on 1410 in 1401 compatibility mode fmtsw equ 696 X for no format, L for limited format * blank for ordinary, A for A conversion param equ 699 Parameter card is stored here * loadnx equ 700 Load next overlay clearl equ 707 Clear instruction in LOADNX loadex equ 793 Branch that exits LOADNX * * Signals used when loading from cards * org 101 dcw @:@ colon 5-8 org 101 dcw @SCANNER@ * ORG 838 * * Start here. * Check modulus and mantissa * 838beginn MCW topcor,corchk&6 845 SW imod-1,mantis-1 852 BCE idef,imod, Integer modulus blank on parameter card? 860 B ispec No, use specified modulus 864idef MCW intdef,imod Yes, use default modulus 871ispec BCE fdef,mantis, Floating point mantissa blank? 879 B fspec No, use specified mantissa 883fdef MCW fltdef,mantis Yes, use default mantissa 890fspec C imod,intmin Compare modulus to minimum 897 BH badmod 902 C imod,digmax Check integer modulus 909 BL badmod 914manchk C mantis,digmax Check floating point mantissa 921 BL badman 926 C mantis,fltmin 933 BH badman * * Report modulus and mantissa * 938badret CS 332 942 CS 943 MCW modmsg,210 950 MCS imod,213 957 W 958 CS 299 962 MCW manmsg,211 969 MCS mantis,214 976 W 977 CC J * 979corchk BCE corchk,0-0,0 TOPCOR stored into B 987 B 988 SBR mvback&6 stores TOPCOR-2 992 SBR mvstmt&3 996mvstmt LCA 0-0,stmtsv Copy statement to work area 1003 SAR mvstmt&3 Ready for next statement 1007 MCW stmtno,stmtsv Insert statement number into stmt 1014 A k1,stmtno and bump it 1021 BCE class2,stmtyp,F Format stmt is already classified * * Skip over the label if any * 1029 SBR chklbl&6,stmtst 1036 SBR stmtpt,stmtst-1 Initialize statement pointer 1043chklbl BCE ststmt,stmtst,: Found the start of the statement? 1051 SBR chklbl&6 1055 SBR chklb2&6 1059chklb2 BCE chklb2,0, Decrease B register 1067 SBR stmtpt Set statement pointer 1071 B chklbl * * Start processing the statement proper. * Check for assignment statement. * 1075ststmt MCW stmtpt,endchk&6 1082 MCW stmtpt,eqtest&6 1089endchk BCE ckword,0,} End of statement? 1097 B 1098 SBR endchk&6 1102eqtest BCE eq,0-0,# 1110 B 1111 SBR eqtest&6 1115 B endchk * * Assignment statement. * 1119eq SW endchk&4 1123 MCW endchk&6,svchar&3 1130 CW endchk&4 1134svchar MCW 0-0,char 1141 SAR svchar&3 1145 BCE lparen,char,% 1153 BCE lparen,char,} 1161 BCE ckword,char,, 1169 B svchar * * Check keyword * 1173ckword MCW stmtpt,*&4 1180 MCW 0-0,word 1187 SW word 1191 SW 1192 MCW word,*&8 1199 BCE bfcs1,kbfcs, Is 1st letter B, F, C or S? 1207 chain3 1210 MCW word-1,*&8 1217tqinua BCE qinua2,kqinua, Is 2nd letter Q, I, N, U or A? 1225 chain4 1229 SW stmtyp 1233 B other * * First letter is B(ackspace), F(ormat), C(ontinue), * S(top) or S(enselight) * 1237bfcs1 C word-2,knse Is word [BFCS].NSE? 1244 BE sense 1249 MCW word,stmtyp Use first letter (BFCS) for stmt type 1256 B classd 1260sense MCW tsense,stmtyp 1267 B classd * * Second letter is (e)Q(uivalence), (d)I(mension), * (e)N(d) or (e)N(dfile), (p)U(nch) or (p)A(use) * 1271qinua2 MCW word-1,stmtyp 1278 BCE n2,tqinua&7,N 1286 B classd * * Second letter is N. Check for ENDFILE. * 1290N2 C word-2,kdfile Is word .NDFILE? 1297 BE classd 1302 MCW tslash,stmtyp Set type to / * * Statement is classified * 1309classd CW word 1313 CW 1314class2 CW stmtyp 1318mvback LCA stmtsv,0 Move the statement back 1325 SBR mvback&6 1329 SBR ckblnk&6 1333 SBR 83 Address below last stmt, for next phase 1337ckblnk BCE done,0-0, 1345 B mvstmt * * Left parenthesis or group mark * 1349lparen MCW eqtest&6,x1 1356 BCE rparen,1&X1,) 1364 B 1365 B class2 1369rparen BCE lpar2,2&X1,% 1377 SBR x1 1381 B rparen 1385lpar2 BCE f,3&X1,F 1393 B class2 1397f BCE class2,6&X1,: 1405 chain2 1407 MCW tarith,stmtyp 1414 SW 195 1418 B class2 * * First letter is not BFCS and second letter is not QINUA * 1422other CW word 1426 CW 1427 C word,kfi IF ( SENSE...? 1434 BU notif 1439 BCE slite,word-8,L 1447 MCW tssw,stmtyp Sense switch 1454 B class2 * * Ninth character is L -- assume IF ( SENSE LIGHT ... ) * 1458slite MCW tslite,stmtyp 1465 B class2 * * Bad modulus message * 1469badmod CS 332 1473 CS 1474 MCW msg42,218 1481 W 1482 CC J 1484 MCW intdef,imod 1491 B manchk * * Bad mantissa message * 1495badman CS 332 1499 CS 1500 MCW msg43,219 1507 W 1508 CC J 1510 MCW fltdef,mantis 1517 B badret * * Not an IF statement, check for others * 1521notif BCE do,word,D 1529 BCE lpar3,word-2,% 1537 BCE lpar5,word-4,% 1545 BCE goto,word,G 1553 BCE print,word,P 1561 BWZ read,word-4,2 1569 BCE rwd,word-5,D 1577 MCW k1,stmtyp 1584 MN word-5,stmtyp Use numeric of sixth char 1591 B notif2 v3m4 * * First letter is D(o) * 1595do MCW tdo,stmtyp 1602 B class2 * * Third character is left parenthesis * 1606lpar3 MCW tif,stmtyp 1613 B class2 * * Fifth character is left parenthesis -- assume computed GOTO * 1617lpar5 MCW tcgo,stmtyp 1624 B class2 * * First character is G * 1628goto MCW tgo,stmtyp 1635 B class2 * * First character is P * 1639print MCW tprint,stmtyp 1646 B class2 * * Fifth character is numeric -- assume it's READ * 1650read MCW tread,stmtyp 1657 B class2 * * Sixth character is D -- assume REWIND * 1661rwd MCW trew,stmtyp 1668 B class2 * * All done * 1672done BSS snapsh,C 1677 SBR loadex&3,1010 1684 SBR clearl&3,2599 1691 LCA sorter,phasid 1698 B loadnx 1702 DCW #1 * stmtst equ 2393 Statement start stmtyp equ 2394 Statement type -- F for format stmtsv equ 2397 * * Constants and work areas * ORG 2398 2400stmtno dcw 001 2401k1 dcw 1 2404stmtpt DCW #3 Statement pointer 2405char DCW #1 Character being examined 2415word DCW #10 2420KQINUA DC @QINUA@ Test second character of statement 2424KBFCS DC @BFCS@ Test first character of statement 2430kfi DCW @ESNES%FI@ IF(SENSE spelled backward 2433trew DC @Z@ Statement code for REWIND 2434tread dc @L@ Statement code for READ 2435tprint dc @P@ Statement code for PRINT 2436tgo dc @G@ Statement code for GOTO 2437tcgo dc @T@ Statement code for computed GOTO 2438tif dc @E@ Statement code for IF 2439tdo dc @D@ Statement code for DO 2440tssw DC @W@ Statement code for IF ( SENSE SWITCH ... 2442intdef DCW 05 Default integer modulus 2444fltdef DCW 08 Default floating point mantissa digits 2446intmin DCW 01 Minimum integer modulus 2448digmax dcw 20 Maximum int mod and max FP mantissa 2450fltmin DCW 02 Minimum floating point mantissa digits 2460modmsg DCW @MODULUS IS@ 2471manmsg DCW @MANTISSA IS@ 2474knse dcw @ESN@ NSE (part of SENSELIGHT) spelt backward 2475tsense DCW @J@ Statement code for SENSE LIGHT 2480kdfile dcw @ELIFD@ DFILE (part of ENDFILE) spelt backward 2481tslash dcw @/@ Statement code for END 2482tarith DCW @R@ Statement code for arithmetic 2483tslite DCW @K@ Statement code for IF ( SENSE LIGHT... 2501msg42 DCW @ERROR 42 - MODULUS@ 2520msg43 DCW @ERROR 43 - MANTISSA@ 2530sorter DCW @SORTER ONE@ 2535k9 DCW 9 v3m4 2535testw6 dc 6531 v3m4 2536notif2 MN word-5,*&8 v3m4 2543 BCE class2,testw6,0 read tape? v3m4 2551 B write tape? v3m4 2552 B read input tape? v3m4 2553 B write output tape? v3m4 2554 MN k9,stmtyp use code 9 v3m4 2561 BIN class2, v3m4 org 2600 2600gmwm dcw @}@ ex beginn END
- Phase 04 - Sort I. Determines if there is enough free storage to expand each statement by three characters.
JOB Fortran compiler -- Sort one phase -- phase 04 CTL 6611 * * SORT ONE phase: Determine whether there is sufficient room * to expand every statement by three characters. * 81-83 is one below the group mark below the last (bottom * address) in core. * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps snapsh equ 333 Core dump snapshot loadnx equ 700 Load next overlay clearl equ 707 CS at start of overlay loader cdovly equ 769 1 if running from cards, N if from tape tpread equ 780 Tape read instruction in overlay loader loadxx equ 793 Exit from overlay loader clrbot equ 833 Bottom of core to clear in overlay loader * * Table of addresses of the first statement of each type, * indexed by 30*(zone of statement type) + 3*(numeric part of * statement code). Filled in next phase, q.v. * ORG 838 840 DCW #3 Blank 843 DCW #3 1 READ TAPE 846 DCW #3 2 849 DCW #3 3 WRITE TAPE 852 DCW #3 4 855 DCW #3 5 READ INPUT TAPE 858 DCW #3 6 WRITE OUTPUT TAPE 861 DCW #3 7 864 DCW #3 8 867 DCW #3 9 870 DCW #3 0 873 DCW #3 / END 876 DCW #3 S STOP 879 DCW #3 T Computed GOTO 882 DCW #3 U PUNCH 885 DCW #3 V 888 DCW #3 W IF ( SENSE SWITCH ... ) 891 DCW #3 X 894 DCW #3 Y 897 DCW #3 Z REWIND 900 DCW #3 ! 903 DCW #3 J SENSE LIGHT 906 DCW #3 K IF ( SENSE LIGHT ... ) 909 DCW #3 L READ 912 DCW #3 M 915 DCW #3 N ENDFILE 918 DCW #3 O 921 DCW #3 P PRINT 924 DCW #3 Q 927 DCW #3 R Arithmetic 930 DCW #3 ? 933 DCW #3 A PAUSE 936 DCW #3 B BACKSPACE 939 DCW #3 C CONTINUE 942 DCW #3 D DO 945 DCW #3 E IF 948 DCW #3 F FORMAT 951 DCW #3 G GOTO 954 DCW #3 H 957 DCW #3 I DIMENSION ORG 1006 1009zones dcw @2SKB@ * * Start here instead of 838 * 1010beginn CS 2599 1014 chain8 1022 MCW 83,x3 Address of end of last statement 1029 MCM 2&X3 1033 MCW 1034 SBR x3 Address of beginning of last statement * * Multiply statement number of last statement by 3 * 1038 MCW 0&X3,seq 1045 ZA seq,seq5 1052 A seq5 1056 A seq,seq5 1063 S kp2,seq5 3 * # stmts - 2 1070 MCW seq5,work5 1077 MCW k16k,seq5 1084 S work5,seq5 16000 - (3 * # stmts - 2) * * Convert to address * 1091 BAV loop clear overflow 1096loop A kp96,seq5-3 1103 BAV loop 1108 MN seq5-3,*&4 1115 MZ zones-0,seq5-2 * 1122 MCW 83,x1 1129 MCW x1,nop&3 1136 MCW seq5,x2 1143 MZ km1,nop&2 set tag for x2 1150nop NOP 0 x1 + x2 1154 SAR x2 1158 S w2a 1162 S w2b 1166 MZ x2,w2a-1 1173 MZ x2-2,w2b-1 1180loop2 BWZ loop2x,w2b-1,2 1188 A k10v,w2b 1195 B loop2 1199loop2x BWZ loop3x,w2a-1,2 1207 A k04v,w2a 1214 B loop2x 1218loop3x A w2b-1,w2a 1225 MCW x2,seq5 1232 MCW w2a 1236 ZA seq5 1240 MZ *-4,seq5 Clear zone in tens digit 1247 C seq5,k2900 1254 BL ok * * Insufficient room to expand every statement by three characters * 1259 CS 332 1263 CS 1264 CC 1 1266 MCW msg2,270 1273 W 1274 CC 1 1276 BCE halt,cdovly,1 1284 RWD 1 1289halt H halt * * Source code will fit after expanding every statement by * three characters * 1293ok MCW x2,83 Replace address of bottom of code 1300 MCM 0&X1 1304 SAR x1 Address below last statement 1308 BSS snapsh,C 1313 SBR tpread&6,1022 Change load address for next phase 1320 SBR clrbot 1324 SBR loadxx&3,1022 Change entry address for next phase 1331 SBR clearl&3,sort2&1 1338 LCA sort2,phasid 1345 B loadnx Load next overlay * * Constants and work areas * 1349 DCW 0 1352seq DCW #3 Sequence number of last statement 1357seq5 DCW #5 Stmt number times 3 1358kp2 DCW &2 1363work5 DCW #5 1368k16k dcw 16000 1370kp96 dcw &96 1371km1 DCW -1 1373w2a DCW #2 1375w2b DCW #2 1377k10v dcw @A0@ Ten, overflowed 1379k04v dcw @?4@ 04, overflowed 1384k2900 DCW 02900 1420msg2 DCW @MESSAGE 2 - OBJECT PROGRAM TOO LARGE@ 1426sort2 DCW @SORT 2@ 1427gmwm dcw @}@ ex beginn END
- Phase 05 - Sort II. Statements of the same type are chained together. Each statement expands by three characters-the machine address of the next statement of the same type.
JOB Fortran compiler -- Sort two phase -- phase 05 CTL 6611 * * SORT TWO phase: Add three characters to each statement and * chain statements of the same type together, leaving the * address of the first statement of each type in TYPTAB, * which starts at 838. * x1 has the address of the group mark word mark after (lower * address) the last (lowest address) statement. * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps snapsh equ 333 Core dump snapshot topcor equ 688 Top core address from PARAM card loadnx equ 700 Load next overlay clearl equ 707 CS at start of overlay loader typtab equ 840 Type table (word marks set in Phase 3) * Indexed by 30*(zone of statement code) + * 3*(numeric part of statement code). Each * entry is the address of the earliest (highest * address) statement of a type. Each statement * has a pointer to the next one (lower in core) * of the same type as its first three (highest * address) characters. * * X1 is the address at the bottom of the last statement * X2 is X1 - 3*(number of statements) * ORG 1022 1022beginn MCW x1,x3 1029 SW gm 1033 MCM 0&X1 Address at bottom of next statement 1037 MN Address of GM below next statement 1038 MN Address at top of this statement 1039 SAR x1 1043 LCA 0&X1,stmt Save this statement 1050 MCM 0&X1 Address at bottom of next statement 1054 SAR x1 1058 MCM 0&X3,0&X2 Move down by 3*(statement number) 1065 SBR x2 1069 LCA stmt&3,1&X2 Move again, this time with its gm 1076 S x3&1 clear x3 1080 MCW 0&X2,work6 Copy statement number and stmt code 1087 MN work6-5,x3 Numeric part of statement code 1094 MCW x3,work6-2 1101 A x3 1105 A work6-2,x3 X3 = 3*(numeric part of stmt code) 1112 BWZ over,work6-5,2 Stmt type has no zone 1120 A kp30,x3 1127 BWZ over,work6-5,S Stmt type has A zone 1135 A kp30,x3 1142 BM over,work6-5 Stmt type has B zone 1150 A kp30,x3 * * Here X3 is 30*(zone of stmt code) + 3*(numeric part of stmt code) * Work is initially an array of 3-character empty fields, but * we store the address of each record in typtab&x3, resulting in * statements of the same type code being chained together * 1157over MCW typtab&X3,1&X2 Link statement to next statement 1164 LCA gm,2&X2 Mark bottom of next statement 1171 SBR typtab&X3 Save statement address in typtab 1175 MCM 2&X2 Move X2 above new statement bottom 1179 SAR x2 1183 C x2,topcor Done? 1190 BU beginn No, do another one * * Done -- load next overlay * 1195 BSS snapsh,C 1200 SBR clearl&3,2899 1207 LCA sort3,phasid 1214 B loadnx * * Data * 1218 DCW 0 1219gm dc @}@ stmt equ 1919 Save area for statement ORG 2000 2005work6 DCW #6 2007kp30 dcw &30 2013sort3 DCW @SORT 3@ 2014gmwm dcw @}@ ex beginn END
- Phase 06 - Sort III. The source program is sorted internally by statement type. The order of sorting is determined by the order in which statements of a given type undergo specific processing by subsequent phases. For example, since DIMENSION statements are processed (Phase 09) before DO statements (Phase 46), the DIMENSION statements are grouped together lower in core than the DO statements.
JOB Fortran compiler -- Sort three phase -- phase 06 CTL 6611 * * SORT THREE phase: Sort statements by type, shift to low * memory. * 81-83 is the address of the last character (lowest in core, * one above gmwm) of the last (lowest in core) statement. * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps snapsh equ 333 Core dump snapshot topcor equ 688 Top core address from PARAM card loadnx equ 700 Load next overlay clearl equ 707 CS at start of overlay loader cdovly equ 769 1 if running from cards, N if from tape tpread equ 780 Tape read instruction in overlay loader loadxx equ 793 Exit from overlay loader clrbot equ 833 Bottom of core to clear in overlay loader typtab equ 840 Type table (word marks set in Phase 3) * Indexed by 30*(zone of statement code) + * 3*(numeric part of statement code). Each * entry is the address of the earliest (highest * address) statement of a type. Each statement * has a pointer to the next one (lower in core) * of the same type as its first three (highest * address) characters. * ORG 1022 1022beginn MCW 83,x3 Address at end of last statement 1029 SW gm 1033 SBR x1,2899 Bottom of free storage 1040 SW 2900 1044 MN 0&X3 Compute address below last statement, 1048 LCA gm put a gmwm there 1052 SBR save&6 and store address below gmwm 1056 SBR w3,tabixs Get last typtab index 1063loop MCW w3,x3 Get next head 1070 MCW 0&X3,x3 of chain to x3 1077 SAR w3 1081 BCE done,x3,X End of the table? 1089 MCW typtab&X3,x3 Head of list of statements of type 1096 BCE loop,x3, No statements of the type * * Move all statements of the type down to low core * 1104save MCW 0&X3,0-0 Move statement to save area 1111 SAR x2 1115 BCE *&5,1&X2,} Did we move the GM? 1123 B noroom No, maybe we're out of space 1127 SBR x2,2&X2 Get back above gmwm, to bottom of stmt 1134more MCM 0&X2 Compute address above top of statement 1138 SBR sx2&6 and save it 1142 MCM 0&X2,1&X1 Move statement to bottom of free area, 1149 SBR x1 bump pointer to bottom, 1153 MN 0&X1 then back down to GM 1157 SBR x1 and save it 1161sx2 SBR x2,0-0 Move up to record mark or GM 1168 BCE more,0&X1,| More to go if stmt contains RM 1176 SBR x1,1&X1 Bump pointer above GM 1183 CW bigflg 1187 MN 0&X1 Now subtract 1191 MN four from 1192 MN x1 to recover 1193 MN space used for 1194 SAR x1 same-type link 1198 LCA gm,0&X1 Mark top of statement 1205 SBR 83 Store address of top of statement 1209 SBR x1 and in x1 1213more2 MCM 1&X1 Compute address above top of statement, 1217 MN get back down to RM or GMWM 1218 SAR x1 and save it 1222 BCE more2,0&X1,| More to go if stmt contains RM 1230 MN 0&X3 Subtract 1234 MN six 1235 MN from 1236 MN x3 1237 MN ,, 1238 MN ,, 1239 SAR x3 ,, 1243 MN 0&X1 Compute -1&x1 into B-star 1247 LCA 3&X3 Copy sequence number 1251 MCW pound,0&X3 1258more3 MCM 2&X3 Point x3 1262 MN back at 1263 MN top of 1264 SAR x3 statement 1268 BCE more3,1&X3,| More to go if stmt contains RM 1276 BCE loop,0&X3, Last statement on chain? 1284 MCW 0&X3,x3 No, get next statement in chain 1291 B save and save it * * No room to move statement below bottom statement * 1295noroom BW toobig,bigflg 1303 SW bigflg 1307 MCW topcor,x2 1314 MN 0&X2 1318 SAR x2 X2 is topcor-1 now 1322 MCW x2,x3 1329moveup LCA 0&X2,0&X3 Move statement up 1336 SAR x2 1340 MCW 0&X3,prefix 1347 BCE moved,prefix-6,# Statement already moved? 1355 LCA 0&X3,0&X3 No, decrement X3 so as not to 1362 SAR x3 clobber recently moved statement 1366moved C save&6,x2 Done? 1373 BU moveup No, move another one 1378 MCW x3,save&6 Below last moved statement 1385 MCW x3,x2 1392 MZ x3,x3999 compute x3 & x00 - 1 1399 MZ 1400 MCW 1401 MZ x1,x1999 compute x1 & x00 - 1 1408 MZ 1409 MCW 1410 C x1999,x3999 1417 BE noclr 1422clr CS 0&X3 Clear from x3 down to x1 & x00 1426 SBR x3 1430 C x3,x1999 1437 BU clr 1442noclr ZA tablen,tabcnt Table length to table counter 1449 S x3&1 * * Fill type table with blanks * 1453clrtab MCW kb3,typtab&X3 Mark end of chain 1460 S kp1,tabcnt 1467 BM clrfin,tabcnt Done clearing table? 1475 A kp3,x3 1482 B clrtab * * Relink moved statements into type table * 1486clrfin MCM 1&X2 Get X1 to top of statement 1490 MN 1491 SAR x2 1495 BCE clrfin,0&X2,| More to do if RM instead of GMWM 1503 SBR x2,1&X2 X2 is now bottom of next statement 1510 S x3&1 1514 C 0&X2 1518 SAR *&4 1522 MCW 0-0,prefix Save prefix 1529 MN prefix-6,x3 3 times 1536 MCW x3,tabcnt numeric part of 1543 A x3 statement code 1547 A tabcnt,x3 to x3 1554 BWZ zonfin,prefix-6,2 add 30 times 1562 A kp30,x3 zone part 1569 BWZ zonfin,prefix-6,S of statement 1577 A kp30,x3 code 1584 BM zonfin,prefix-6 to x3 1592 A kp30,x3 1599zonfin MN 0&X2 minus 2 1603 MN 1604 MCW typtab&X3 Link to next statement same type 1608 C 0&X2 Down to next word mark 1612 SAR typtab&X3 link type table to statement type 1616 C x2,topcor Done? 1623 BU clrfin 1628 MCW w3,x3 Recover x3 1635 NOP 3&X3 1639 SAR w3 plus 3 1643 B loop Back to sorting * * Load next overlay * 1647done BSS snapsh,C 1652 SBR tpread&6,typtab-2 Next overlay read address 1659 SBR clrbot and bottom of clear area 1663 SBR loadxx&3,typtab-2 Next overlay entry address 1670 SBR clearl&3,tabcnt Top of clear 1677 LCA gmmsg,phasid Next phase ID 1684 B loadnx Load it * * Program is too big * 1688toobig CS 332 1692 CS 1693 CC 1 1695 MCW msg2,270 1702 W 1703 CC 1 1705 BCE halt,cdovly,1 1713 RWD 1 1718halt H halt * * Data * * First is table of table indexes in the reverse order * we want statements sorted into low core * 1724 dcw @XXX@ End-of-table sentinel 1727 DSA 117 I DIMENSION 1730 DSA 84 Q 1733 DSA 108 F FORMAT 1736 DSA 9 3 WRITE TAPE 1739 DSA 3 1 READ 1742 DSA 18 6 WRITE OUTPUT TAPE 1745 DSA 81 M 1748 DSA 42 U PUNCH 1751 DSA 15 5 READ INPUT TAPE 1754 DSA 69 L 1757 DSA 87 R ARITHMETIC 1760 DSA 105 E IF 1763 DSA 27 9 1766 DSA 96 B BACKSPACE 1769 DSA 57 Z REWIND 1772 DSA 75 N ENDFILE 1775 DSA 39 T COMPUTED GOTO 1778 DSA 111 G GOTO 1781 DSA 36 S STOP 1784 DSA 93 A PAUSE 1787 DSA 63 J SENSE LIGHT 1790 DSA 66 K IF SENSE LIGHT 1793 DSA 48 W IF SENSE SWITCH 1796 DSA 99 C CONTINUE 1799tabixs DSA 102 D DO Last of table indexes * 1802x1999 DSA 999 x1 & x00 - 1 1805x3999 DCW 999 x3 & x00 - 1 1806gm dc @}@ 1807bigflg dc 0 Word mark set if too big 1810w3 DCW #3 1811pound dcw @#@ 1820prefix DCW #9 Statement prefix 1822tablen dcw &39 Type table length 1825kb3 DCW #3 three blanks -- end of chain sentinel 1826kp1 dcw &1 1827kp3 dcw &3 1829kp30 dcw &30 1839gmmsg DCW @GROUP MARK@ 1875msg2 DCW @MESSAGE 2 - OBJECT PROGRAM TOO LARGE@ ORG 2001 2003tabcnt DCW #3 org 2900 2900gmwm DCW @}@ ex beginn END
- Phase 07 - Insert Group Mark. This is a housekeeping phase.
JOB Fortran compiler -- Insert group-mark phase -- 07 CTL 6611 * * Replace the colon (5-8) that separates each statement from * its appendage (prefix) by a group mark with a word mark. * Replace integer modulus by 05 if it's zero. * Replace mantissa digits by 08 if it's zero. * 81-83 = start (top address) of first (top in memory) * statement. Remember, statements are sorted by type now. * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps snapsh equ 333 Core dump snapshot topcor equ 688 Top core address from PARAM card imod equ 690 Integer modulus -- number of digits mantis equ 692 Floating point mantissa digits loadnx equ 700 Load next overlay clearl equ 707 CS at start of overlay loader * ORG 838 838beginn MCW 83,x1 845 SW gm 849loop BCE colon,0&X1,: 857switch BCE done,0&X1, NOP if working on format 865 BCE seegm,0&X1,} 873 SBR x1 877 B loop 881colon LCA gm,0&X1 Replace colon by GMWM 888 SBR x1 get below colon 892 C 0&X1 and then 896 SAR x1 below bottom word mark 900 B loop Process next statement 904seegm MCW 0&X1,prefix 911 BCE format,prefix-4,F Format statement? 919 MCW branch,switch 926next MN 0&X1 Decrease X1 930 SBR x1 to next statement 934 B loop 938format MCW nop,switch 945 B next * * Clear from top core down to top of statements & X00 * 949done MCW topcor,x2 956 MZ 83,k999 Compute top 963 MZ of statements 964 MCW & x00 965clear CS 0&X2 969 SBR x2 973 C x2,k999 980 BU clear * * Clear from top of statements & X00 to top of statements * 985clear2 C 83,x2 992 BE done2 997 MCW blank,0&X2 1004 CW 0&X2 1008 SBR x2 1012 B clear2 1016done2 SW imod-1 1020 A blank,mantis 1027 C imod,kz2 Integer modulus equal zero? 1034 BU notzi No 1039 MCW k05,imod Yes, use 05 1046notzi C mantis,kz2 Mantissa digits equal zero? 1053 BU notzf No 1058 MCW k08,mantis Yes, use 08 * * Load next overlay * 1065notzf BSS snapsh,C 1070 SBR clearl&3,gmwm Load clear-down-to address 1077 LCA squoze,phasid Load next phase ID 1084 B loadnx Load it 1090k999 DCW 999 1091gm dc @}@ 1096prefix DCW #5 1097branch B 1098nop NOP 1099blank DCW #1 1101kz2 DCW 00 1103k05 DCW 05 1105k08 DCW 08 1111squoze DCW @SQUOZE@ 1112gmwm DCW @}@ ex beginn END
- Phase 08 - Squoze. The words that helped define the type of each statement are eliminated, shrinking the source program. For example, the word "DIMENSION" in DIMENSION statements is eliminated.
JOB Fortran compiler -- Squeeze phase -- phase 08 * * Remove statement keywords * Note unrecognizable statements and remove them * 81-83 = start (top address) of first (top in memory) * statement. Remember, statements are sorted by type now, * and pushed to the bottom of available core. * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps snapsh equ 333 Core dump snapshot loadnx equ 700 Load next overlay clearl equ 707 CS at start of overlay loader loadxx equ 793 Exit from overlay loader * CTL 6611 ORG 838 838beginn MCW 83,x2 845 MCW 83,x1 852next MCW 0&X1,seq 859 MCW 0&X1,prefix 866 BCE arith,prefix-3,R Arithmetic? 874 BCE endstm,prefix-3,/ End? 882switch BCE same,prefix-3,X Initially nonexistent stmt, * later current one * * Compute address of keyword if not the same statement * type as the previous one * 890 MZ prefix-3,switch&7 Move statement code 897 MN prefix-3,switch&7 to switch D-modifier 904 MN prefix-3,w1 911 ZA w1,w3 w3 = 918 A w3 3 * numeric part 922 A w1,w3 of stmt code 929 MZ nozone,w3 936 LCA tabadr,gettab&3 Table address 943 A w3,gettab&3 + 3 * numeric to gettab 950 MZ prefix-3,gettab&2 957 CW gettab&1 961 MCW x2,save Save x2 968 MCW and x1 969 MCM indexs,x1-2 x1,x2,x3 = 27, 54, 81 976gettab MCW 0,x3 Get address of keyword from table 983 MCW save,x2 Retrieve x2 990 MCW and x1 991same LCA 0&X1,0&X2 Move statement up 998 SAR x1 Address of next lower source 1002 C 0&X2 Get B-star below nextg word mark 1006 SAR x2 Address of next lower target 1010 C 0&X1,0&X3 Correct keyword? 1017 SAR x1 Get X1 below keyword 1021 BU wrong 1026mvmore LCA 0&X1,0&X2 Move part of stmt below keyword up 1033 SAR x1 Get below bottom of source statement 1037 C 0&X2 Get below bottom 1041 SAR x2 of target statement 1045ifdone BCE done,0&X1, Done? 1053 B next * * Load next overlay * 1057done CS 0&X2 1061 CS 1062 BSS snapsh,C 1067 SBR loadxx&3,839 Set entry address for next phase 1074 SBR clearl&3,gmwm Top of cleared area 1081 LCA dimen1,phasid Name of next phase 1088 B loadnx * * Keyword doesn't match statement code * 1092wrong CS 332 1096 CS 1097 SW 184 What does this do? 1101 MN seq,249 1108 MN 1109 MN 1110 MCW error1 1114 W 1115 BCV pagovl 1120 B noovl 1124pagovl CC 1 1126noovl MCM 2&X2 Get above statement's top 1130 MN and then 1131 MN down two 1132 SAR x2 1136 BCE noovl,1&X2,| More to move if RM 1144 C 0&X1 Get below keyword 1148 SAR x1 1152 B ifdone Go test if done * * Arithmetic statement * 1156arith LCA 0&X1,0&X2 Move prefix up 1163 SAR x1 and move 1167 LCA 0&X2,0&X2 index registers down 1174 SBR x2 to statement 1178 B mvmore * * End statement * 1182endstm C 0&X1 Get below 1186 C statement 1187 SAR x1 1191 B ifdone * * Table of addresses of statement keywords * 1197table DSA rdtape 1 READ TAPE 1200 DSA 0 1203 DSA wrtape 2 WRITE TAPE 1206 DSA 0 1209 DSA rdintp 5 READ INPUT TAPE 1212 DSA wrottp 6 WRITE OUTPUT TAPE 1215 DSA 0 1218 DSA 0 1221 DSA nozone 9 1224 DSA 0 1227 DSA stop S STOP 1230 DSA cgoto T Computed GOTO 1233 DSA punch U PUNCH 1236 DSA 0 1239 DSA ifsw W IF ( SENSE SWITCH ... 1242 DSA 0 1245 DSA 0 1248 DSA rewind Z REWIND 1251 DSA slite J SENSE LIGHT 1254 DSA ifsl K IF ( SENSE LIGHT ... ) 1257 DSA read L READ 1260 DSA 0 1263 DSA endfil N ENDFILE 1266 DSA 0 1269 DSA print P PRINT 1272 DSA equiv Q 1275 DSA 0 Arithmetic 1278 DSA pause A PAUSE 1281 DSA backsp B BACKSPACE 1284 DSA cont C CONTINUE 1287 DSA do D DO 1290 DSA if E IF 1293 DSA format F FORMAT 1296 DSA goto G GOTO 1299 DSA 0 1302 DSA dim I DIMENSION * * Statement keywords spelled backward * 1306goto DCW @OTOG@ GO TO 1311cgoto dcw @%OTOG@ GO TO ( 1313if dcw @FI@ IF 1327ifsw DCW @HCTIWSESNES%FI@ IF ( SENSE SWITCH 1332pause dcw @ESUAP@ PAUSE 1336stop dcw @POTS@ STOP 1338do DCW @OD@ DO 1346cont dcw @EUNITNOC@ CONTINUE 1353format dcw @%TAMROF@ FORMAT ( 1357read dcw @DAER@ READ 1370rdintp DCW @EPATTUPNIDAER@ READ INPUT TAPE 1375punch dcw @HCNUP@ PUNCH 1380print DCW @TNIRP@ PRINT 1395wrottp DCW @EPATTUPTUOETIRW@ WRITE OUTPUT TAPE 1403rdtape dcw @EPATDAER@ READ TAPE 1412wrtape DCW @EPATETIRW@ WRITE TAPE 1419endfil dcw @ELIFDNE@ END FILE 1425rewind DCW @DNIWER@ REWIND 1434backsp DCW @ECAPSKCAB@ BACKSPACE 1443dim DCW @NOISNEMID@ DIMENSION 1454equiv DCW @ECNELAVIUQE@ EQUIVALENCE 1467ifsl DCW @THGILESNES%FI@ IF ( SENSE LIGHT 1477slite DCW @THGILESNES@ SENSE LIGHT * * Other data * indexs equ *&1 1491 DCW @0270005400081|@ 1494seq DCW #3 Sequence number from statement 1498prefix DCW #4 1499w1 DCW #1 Used to compute 3 * numeric part of code 1502w3 DCW #3 1503nozone DCW #1 1506tabadr DSA table-3 1514save DCW #8 1520dimen1 DCW @DIMEN1@ 1566error1 DCW @ERROR 1 - UNDETERMINABLE STATEMENT, STATEMENT @ 1567gmwm DCW @}@ ex beginn END
- Phase 09 - Dimension I. The DIMENSION statements are scanned, and an array table is generated in free storage. Each table element consists of the name of an array, its dimensions, and sufficient space for additional data to be generated by Phases 11 and 12.
JOB Fortran compiler -- Dimension phase one -- 09 * * A table of arrays is generated at the end of storage. * Each table element consists of the array name, its * dimensions and sufficient space for control statements * and data generated by the equivalence phases and by * dimension phase two. * * Dimension table elements are separated by group mark word mark. * At the top of each element is the array name, spelt backward. * Below that are two cells used to double link the elements. * The upper one points to the next one higher in core (unless * it's blank); the lower one points to the next one lower in * core (unless it's blank). Below that are empty three character * and five character fields. Below that are the dimensions, with * the first dimension at the higher address. The digits of the * dimensions are not reversed. * * 81-83 = start (top address) of first (top in memory) * statement. Remember, statements are sorted by type now, * and pushed to the bottom of available core. * * On exit, 84-86 is the address of the topmost (first) * dimension table. * CTL 6611 * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps glober equ 184 Global error flag -- WM means error snapsh equ 333 Core dump snapshot topcor equ 688 Top core address from PARAM card imod equ 690 Integer modulus -- number of digits mantis equ 692 Floating point mantissa digits loadnx equ 700 Load next overlay clearl equ 707 CS at start of overlay loader cdovly equ 769 Read (1) instruction if running from cards tpread equ 780 Tape read instruction in overlay loader loadxx equ 793 Exit from overlay loader clrbot equ 833 Bottom of core to clear in overlay loader * ORG 838 838diff DCW @0@ WM if FP width /= integer width 839beginn SW gm 843 MCW 83,x1 Top of top (first) statement 850 A kb1,mantis Get rid of zones in mantis 857 MCW mantis,manp2 864 A kp2,manp2 mantis + 2 = total FP width 871 C imod,manp2 FP width == integer width? 878 BU difwid 883 CW diff 887difwid LCA gm,1&X1 Set GMWM above statement 894 LCA topcor,x2 x2 = topcor 901 MN 0&X2 905 MN 906 MCW kb1a 910 SBR x2 x2 = topcor - 3 914prev MCW kb1,1-0 clobber previous less-than sign 921 MCW kless,2&X1 stmt top + 2 = less-than sign 928 NOP 2&X1 932 SAR prev&6 Remember where we put it 936 LCA 0&X1,prefix 943 SAR x1 Point X1 947 SBR x3 and X3 after label 951 BCE done,prefix, No more statements? 959 BCE find,prefix-3,I Dimension statement? 967 BCE end,prefix-3,/ End statement? 975 B done * * Skip over the array name -- must end with left paren * 979find BCE lparen,0&X1,% 987 BCE syntax,0&X1,, 995 BCE syntax,0&X1,) 1003 BCE syntax,0&X1,} 1011 SBR x1 1015 B find * * Found the left paren * 1019lparen SW lpflag 1023 MN 0&X1 Get below 1027 SAR x1 left paren 1031 SW 2&X1 Set word mark at bottom of symbol 1035 MCW x2,savx2 1042 BW first,firstf * * Check whether symbol is in the table. X2 is at bottom * of the bottom symbol entry. * 1050check MCM 1&X2 1054 SAR x2 1058 BCE first,0&X2, Top of the table? 1066higher MCM 2&X2 Move up to next element 1070 MN 1071 MN 1072 SBR x2 Top of element (maybe) 1076 BCE higher,1&X2,| Need to move up more if RM 1084compar C 0&X2,0&X3 Same as already in table? 1091 SAR x2 1095 BU check 1100 BW double,1&X2 1108 B check 1112first MCW savx2,x2 1119 LCA gm,0&X2 Mark top of element 1126 LCA 0&X3 Symbol to element 1130 LCA newx3 chain 1134 SBR x2 below chain in element 1138 MCW newx3,x3 1145 BCE head,x3, 1153 B nohead 1157head A kb1,x3 Convert blank x3 to zeroes 1164nohead LCA k3b,0&X2 Put two three-character 1171 LCA k3b fields into symbol table 1175 SBR 6&X3 Link prev element to this one 1179 SBR newx3 1183 LCA k5b Add five spaces to element 1187 SBR x2 and get x2 below it 1191nother MN dimsav-4 Make x3&2 1195 MN be the high-order 1196 SAR x3 digit of dimsav 1200 SBR x1,0&X1 Strange kind of nop? * * Accumulate characters of dimension * 1207more MCW 0&X1,char Get character from dimension field 1214 SAR x1 and step down to next one 1218 BCE dimfin,char,) 1226 BCE dimfin,char,} 1234 BCE dimfin,char,, 1242 MCW char,2&X3 Store char in dimension save 1249 SBR x3 1253 B more 1257dimfin BCE syntax,1&X1,} 1265 LCA 1&X3,0&X2 Move dimension to symbol table 1272 SBR x2 1276 BCE nother,1&X1,, Get another dimension 1284 MCW prev&6,x3 1291 BCE notbig,0&X3,< 1299 B toobig 1303notbig CW firstf Clear first-time flag 1307tstfin BCE fini,0&X1,} Finished 1315 B with statement? 1316 BCE newvar,0&X1,, Another variable? 1324 B syntax 1328newvar MN 0&X1 Get below comma 1332 SAR x1 1336 SBR x3 1340 B find and go find end of next variable * * Finished with dimension statement * 1344fini C 0&X1 1348 SAR x1 1352 B prev * * Doubly defined array * 1356double CS 332 1360 CS 1361 SW glober 1365 MCW error2,230 1372 MCW compar&6,x2 1379 MN 232 1383 MN 1384 SAR x2 1388 SBR x3,0&X3 1395morech MCW 0&X3,ch 1402 SAR x3 1406 MCW ch,2&X2 1413 SBR x2 1417 BW donech,1&X3 At the end of the variable name? 1425 B morech 1429donech W 1430 BCV ovfl 1435 B noovfl 1439ovfl CC 1 1441noovfl BCE bottom,0&X1,) Bottom of statement? 1449 SBR x1 1453 BCE syntax,1&X1,} 1461 B noovfl 1465bottom MN 0&X1 1469 SAR x1 1473 MCW savx2,x2 1480 B tstfin * * Dimension syntax error * 1484syntax CS 332 1488 CS 1489 SW glober 1493 MN prefix,241 1500 MN 1501 MN 1502 MCW error3 1506 W 1507 BCV ovfl2 1512 B novl2 1516ovfl2 CC 1 1518novl2 MCW savx2,x2 1525 BCE prev,1&X1,} 1533end C 0&X1 1537 SAR x1 1541 B prev * 1545done BW gotlp,lpflag 1553 LCA gm,0&X2 1560 LCA colon 1564 LCA w3 1568 LCA w3 1572 LCA w3 1576 LCA w5 1580 LCA w10 1584 SBR x2 1588gotlp NOP 2&X1 1592 MCM 1593 MCW 1594 SAR x1 1598 MCW 6,86 Topmost table entry address to 86 1605 BSS snapsh,C 1610 SBR tpread&6,839 Load address for next overlay 1617 SBR clrbot and clear bottom 1621 SBR loadxx&3,1034 Exit from loader 1628 SBR clearl&3,1845 Clear top 1635 LCA equiv,phasid 1642 B loadnx * * Program is too big * 1646toobig CS 332 1650 CS 1651 CC 1 1653 MCW msg2,270 1660 W 1661 CC 1 1663 BCE halt,cdovly,1 1671 RWD 1 1676halt H halt * * Data * 1690prefix DCW @0 @ 1691gm dc @}@ 1694newx3 DCW #3 1699dimsav dcw #5 1700lpflag DC #1 WM in low-order character if left paren 1701kb1 DCW #1 1703manp2 DCW #2 mantis + 2 1704kp2 dcw &2 1705kb1a DCW #1 1706kless DCW @<@ 1709savx2 DCW #3 1710firstf DCW #1 WM is first-time flag 1713k3b DCW #3 1718k5b DCW #5 1719char DCW #1 Character from dimension field 1749error2 DCW @ERROR 2 - DOUBLY DEFINED ARRAY@ 1750ch DCW #1 1788error3 DCW @ERROR 3 - DIMENSION SYNTAX, STATEMENT @ 1789colon DCW @:@ 1792w3 DCW #3 1797w5 DCW #5 1799w10 dcw 10 1808equiv DCW @EQUIV ONE@ 1844msg2 DCW @MESSAGE 2 - OBJECT PROGRAM TOO LARGE@ 1845gmwm DCW @}@ ex beginn END
- Phase 10 - Equivalence I. Adds simple variables present in EQUIVALENCE statements to the array table. These variables are treated, in effect, as one-element arrays.
JOB Fortran compiler -- Equivalence phase one -- 10 CTL 6611 * * 1. Assure all arrays present in EQUIVALENCE statements are * defined * 2. Add simple variables present in EQUIVALENCE statements * to the table of arrays generated by the previous phase. * These variables are treated, in effect, as one-element * arrays. * * On entry, 81-83 = start (top address) of first (top in memory) * statement (remember, statements are sorted by type now, and * pushed to the bottom of available core), 84-86 = address of the * topmost (first) dimension table (eleven below the bottom of the * name), x1 = address of the last digit of the sequence number of * the first (topmost) unprocessed statement, x2 = address of the * lowest-address character of the array table, and x3 = address * of the first (topmost) character of the x1 statement (first * character after keyword and left paren if not arithmetic). 6&x2 * is the "next" link and 9&x2 is the "previous" link in each * array table element. Blank means "end of chain". * * Each element of the array table has one or two variable-width * dimension fields (first dimension higher in core), with the * digits of the dimensions not reversed, a five digit offset from * the base of the equivalence class (x2 points at the low-order * digit), a three-character link to the next member of the * equivalence class, a three-character link to the next element, * a three-character link to the previous element, the name * (variable width), and a group mark with a word mark. The GMWM * of the topmost element is at topcor-3, and topcor-2 .. topcor * are blank. * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps snapsh equ 333 Core dump snapshot loadnx equ 700 Load next overlay clearl equ 707 CS at start of overlay loader cdovly equ 769 Read (1) instruction if running from cards tpread equ 780 Tape read instruction in overlay loader loadxx equ 793 Exit from overlay loader clrbot equ 833 Bottom of core to clear in overlay loader * * From dimension one phase * diff equ 838 WM if FP width /= integer width * * In equivalence two phase * done2 equ 1735 notin2 equ 1800 * ORG 839 839gm DC @}@ 849prefix dc #10 852next DCW #3 One below next slot in array table 860 DCW #8 Offset and link work for next phase 868 DCW #8 Offset and link work for next phase 876next3 DCW #8 Offset and link work for next phase 877 DC #1 882 DCW #5 * * Announce syntax error * 883syntax CS 332 887 CS 888 SW 184 Is this a global error flag? 892 MN prefix,243 Sequence 899 MN number to 900 MN error message 901 MCW error4 905 W 906 BCV ovfl1 911 B novfl1 915ovfl1 CC 1 917novfl1 C 0&X1 Get down below prefix of 921 SAR x1 statement -- next word mark 925 B nxstmt * * Get to the next variable in the statement and then * check whether it's already in the array table * 929find BCE atvar,0&X1,, Skip punctuation before variable 937 BCE atvar,0&X1,% 945 BCE atvar,0&X1,) 953 BCE syntax,0&X1,} 961 SBR x1 965 B find * * X1 is now below a variable name in the statement, and * X2 is now at the top of a variable name in the table * 969atvar SW 1&X1 Set WM at bottom of variable 973 MCW next,x2 980uneq BCE notin,2&X2, Top of the table? 988more1 MCM 2&X2 Move up to top of next table element 992 MN and then down 993 MN to table element name 994 SAR x2 998 BCE more1,1&X2,| More to do if RM 1006testv C 0-0,0&X2 Test duplicate variable 1013 SAR x3 Stmt var - len(table var) 1017 BU uneq Not found in the table yet 1022tsteql BW found,1&X3 Equal length in stmt and table? 1030 B uneq No, not found in the table yet * * Start here * 1034beginn MN 0&X2 Get down to 1038 SAR next next available slot 1042 SBR next3 in array table 1046 SW gm 1050 BW difwid,diff FP width /= integer width? 1058 MCW branch,switch 1065difwid MCW x1,savex1 1072 MCW less,2&X1 Mark statement as processed 1079 SBR tstful&6,2&X1 Remember statement end mark addr 1086more2 MCM 2&X2 Get above GMWM above bottom table element 1090 MN and then back 1091 MN below it. x2 now points at first 1092 SAR x2 (topmost) character of name. 1096 BCE more2,1&X2,| More to do if RM 1104 C 0&X2 Skip name 1108 C Skip "next" pointer 1109 C Skip "prev" pointer 1110 C Skip ??? 1111 SAR tabadr 1115nxstmt LCA 0&X1,prefix 1122 SAR x1 X1 is now first char below prefix 1126fintst BCE done,prefix, Done if no sequence number 1134 BCE goteqv,prefix-3,Q EQUIVALENCE statement? 1142finbr B done Done if not EQUIVALENCE statement 1146goteqv BCE gotlp,0&X1,% 1154 B syntax 1158gotlp SW fpflg1,fpflg2 Got left paren -- syntax OK 1165nxtvar MN 0&X1 Skip left paren to get X1 to 1169 SAR x1 top char of variable 1173 SBR testv&3 variable to find in table 1177switch NOP find branch if FP width == integer width * * Check whether variables have same type * 1181chktyp MN 0&X1,tstint&7 Get ready to test first 1188 MZ 0&X1,tstint&7 character of variable name 1195tstint BCE intvar,intchr,X Integer variable name? 1203 chain5 1208 CW fpflg2 1212 B notint 1216intvar CW fpflg1 1220notint BW find,fpflg2 1228 BWZ * * Error -- mixed FP and integer in equivalence while integer * and FP have different width * 1229 CS 332 1233 CS 1234 SW 184 Is this a global error flag? 1238 MN prefix,251 Sequence number 1245 MN to error 1246 MN message 1247 MCW error5 1251 W 1252 BCV ovfl2 1257 B novfl2 1261ovfl2 CC 1 1263novfl2 SW fpflg1,fpflg2 1270 B find * * Not in the table yet. X1 ==(?) X3 = punctuation below * the variable in the statement * 1274notin MCW x1,x3 Does this change X3? 1281 BCE subsnd,0&X1,% Subscript present? 1289 MCW next,x2 One below bottom slot in table 1296 LCA gm,1&X2 Set boundary 1303 SBR x2 Does this change X2? 1307 MCW testv&3,x3 Variable sought in table 1314 LCA 0&X3,0&X2 Move variable to table 1321 SBR x2 X2 now points at "prev" link 1325 MCW tabadr,x3 Current bottom-of-table 1332 LCA tabadr,0&X2 Set "prev" link in new entry 1339 LCA w3 Space for "next" link 1343 LCA w3 Space for ??? 1347 SBR tabadr Set current bottom-of-table 1351 SBR x2 Set X2 nine below name in table 1355 LCA w5,0&X2 1362 LCA k1 Dimension == 1 for scalar 1366 SBR x2 X2 is now one below bottom element 1370 MCW tabadr,6&X3 Set "next" link in prev entry 1377 BCE notab,86, No table yet? * * Save bottom of table and check size * 1385savbot MN 0&X2 1389 SAR next 1393tstful BCE itfits,0,< * * Program is too big -- clobbered the sentinel * 1401 CS 332 1405 CS 1406 CC 1 1408 MCW error2,270 1415 W 1416 CC 1 1418 BCE cards,cdovly,1 1426 RWD 1 1431cards H cards * * No table yet * 1435notab MCW tabadr,86 Store top of table 1442 B savbot Save bottom of table and check size * * Haven't clobbered the sentinel -- the program fits * 1446itfits BCE doneqv,0&X1,) Done with this equivalence? 1454 B moreqv 1458doneqv SW fpflg1,fpflg2 Assume equivalence is OK 1465moreqv MN 0&X1 Skip punctuation below variable 1469 SBR x1 1473 SBR testv&3 Variable to find in table 1477 BCE nother,0&X1,, Another variable in equivalence? 1485 BCE itfits,0&X1,} 1493 BCE nxstmt,1&X1,} 1501 B switch Go test types * * Subscript appears in EQUIVALENCE statement but the variable * was not found in the array table * 1505subsnd CS 299 1509 MCW x3,x1 Does this change X1? 1516 MCW x2,savx2 1523 MN 248 Why not 1527 MN just do 1528 SAR x2 sbr x1,246? 1532 SBR x1,0&X1 This can't change X1 1539findlp MCW 0&X1,savech 1546 SAR x1 1550 BCE gotlp2,savech,% Got to start of subscript? 1558 MCW savech,2&X2 Move saved character to message 1565 SBR x2 reversing variable back into order 1569 B findlp 1573gotlp2 MCW savx2,x2 1580 SW 184 Is this a global error flag? 1584 MN prefix,240 Sequence number 1591 MN to error 1592 MN message 1593 MCW error6 1597 BCV ovfl3 1602 B novfl3 1606ovfl3 CC 1 1608novfl3 W 1609skipv MN 0&X1 1613 SAR x1 1617 BCE nother,0&X1,) Found end of subscript 1625 BCE syntax,0&X1,% Syntax error if left paren 1633 BCE syntax,0&X1,} syntax error if end of statement 1641 BCE skipv,0&X1,, Skip more if comma (is this OK?) 1649 BWZ skipv,0&X1,2 Skip more if numeric 1657 B syntax Else syntax error * * Another variable in equivalence * 1661nother MN 0&X1 1665 SAR x1 1669 B itfits * * Found variable in array table * 1673found BCE skipv,0&X1,% Subscript OK since we found var 1681 B itfits * 1685done SBR fintst&3,done2 These 1692 SBR finbr&3,done2 addresses are 1699 SBR uneq&3,notin2 in next overlay 1706 SBR tsteql&3,chktyp 1713 MCW next,next3 1720 MCW savex1,x1 1727 MCW branch,switch 1734 MCW nop,gotlp 1741 BSS snapsh,C 1746 SBR tpread&6,chktyp Set load addr for next overlay 1753 SBR clrbot 1757 SBR loadxx&3,nxstmt Set entry addr for next overlay 1764 SBR clearl&3,gmwm 1771 LCA equiv2,phasid 1778 B loadnx * * More data * 1821error4 DCW @ERROR 4 - EQUIVALENCE SYNTAX, STATEMENT @ 1822branch B 1823less DCW @<@ Less-than sign 1826tabadr DCW #3 Current array table address 1827fpflg1 DCW #1 1828fpflg2 DCW #1 WM if FP variable 1834intchr DCW @IJKLMN@ First character of integer variables 1882error5 DCW @ERROR 5 - ILLEGAL EQUIVALENCE MIXING, STATEMENT @ 1885w3 DCW #3 Used to create 1887w5 DC #2 empty table entry 1888k1 dcw 1 Dimension for scalars 1924error2 DCW @MESSAGE 2 - OBJECT PROGRAM TOO LARGE@ 1927savx2 DCW #3 1928savech DCW #1 1965error6 DCW @ERROR 6 - UNDEFINED ARRAY, STATEMENT @ 1968savex1 DCW #3 1969nop NOP 1978equiv2 DCW @EQUIV TWO@ 1979gmwm DCW @}@ ex beginn END
- Phase 11 - Equivalence II. The array table is altered to show the relationship between arrays. Equated arrays are chained together. Essentially, the procedure makes known to every array whose first element is equivalent to a secondary element of another array the "distance" to the first element of the latter array.
JOB Fortran compiler -- Equivalence phase two -- 11 CTL 6611 * * The dimension table is altered to show the relationship * between arrays. The procedure, essentially, is to make * every array whose first element is equivalent to a secondary * element of another array know the distance to the first * element of the latter array. * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps glober equ 184 Global error flag -- WM means error snapsh equ 333 Core dump snapshot loadnx equ 700 Load next overlay clearl equ 707 CS at start of overlay loader tpread equ 780 Tape read instruction in overlay loader loadxx equ 793 Exit from overlay loader clrbot equ 833 Bottom of core to clear in overlay loader * * Stuff in the previous overlay * gm equ 839 Group mark, in previous phase prefix equ 849 next equ 852 One below next slot in array table off1 equ 857 Offset work area class1 equ 860 Equivalence class link off2 equ 865 Offset work area class2 equ 868 Equivalence class link off3 equ 873 Offset work area next3 equ 876 Equivalence class link syntax equ 883 Syntax error routine nxstmt equ 1115 Process the next statement gotlp equ 1158 Get to next variable in statement nxtvar equ 1165 Process next variable * * This phase actually starts at NXSTMT in the previous overlay. * Here x1 points one below the bottom character of a variable in * a statement and x2 points at the topmost character of the name * of the corresponding variable in the array table. * * Each element of the array table has one or two variable-width * dimension fields (first dimension higher in core), with the * digits of the dimensions not reversed, a five digit offset * from the base of the equivalence class, a three-character link * to the base member of the equivalence class, a three-character * link to the next element, a three-character link to the * previous element, the name (variable width), and a group mark * with a word mark. The GMWM of the topmost element is at * topcor-3, and topcor-2 .. topcor are blank. * * The next and prev pointers are redirected so that elements of * an equivalence class are consecutive, and ascending order by * offset. * * Below the array table, build a table of classes, each element * having a five-digit offset and a link to the first element of * the class in the array table. * * At exit, X3 is one below the GM at the bottom of the array * table, and X1 is the top (prefix) of the first statement * after (below) the last equivalence. * * Come here from FIND routine in previous phase when it finds * the variable in the array table. * ORG 1181 1181 LCA kz5,off2 1188 NOP 0&X2 1192 MCW Skip name 1193 MCW Skip "next" pointer 1194 MCW Skip "prev" pointer 1195 MCW Skip "class" pointer 1196 SAR x2 X2 now points at 5-digit offset 1200 BAV *&1 Turn off arithmetic overflow flag 1205 S w3 1209more BCE new,1&X2, Offset empty? 1217 A 0&X2,off2 1224 MCW 3&X2,x2 Next element in equivalence class 1231 A kp1,w3 Count elements in class 1238 BAV fixit Error if overflow -- circular list? 1243 B more 1247new MCW x2,class2 1254 BCE subs,0&X1,% Variable in equivalence subscripted? 1262 A k1,off2 Bump offset 1269totop MCW next3,x3 Top of class table 1276 LCA off1,off3 1283 S off2,off3 1290 BM neg,off3 off2 .lt. off1? 1298 LCA class2,0&X3 1305 SBR next3 1309getnxt BCE nxtvar,0&X1,, 1317 BCE eqvfin,0&X1,) Equivalence group done 1325 B syntax 1329eqvfin MN 0&X1 Skip right paren 1333 MN Skip comma if statement not ended 1334 SAR savx1 Left paren if statement not ended 1338 MCW next3,x3 1345 LCA dollar,0&X3 Mark bottom of class table * * Search the class table for the link to the class in CLASS1 * 1352 MCW next,x3 Top of class table 1359tstbot BCE atbot,0&X3,$ At bottom of class table? 1367 MCW 0&X3,wnext 1374 C class1,wnext 1381 BE testri It's either redundant or illegal 1386backri MCW 0&X3,x2 1393 SAR next3 1397 BCE empty,0&X2, 1405 B full Entry has an offset 1409empty MCW 9&X2,x1 Prev to x1 1416emptyl MCW 6&X2,x3 Next from x3 is x3 1423 BCE endtab,x3, At end of array table? 1431 BCE endtab,1&X3, 1439 SBR x2 Next to x2 1443 B emptyl 1447endtab BCE endtb2,x3, At end of array table? 1455 MCW x1,9&X3 1462endtb2 BCE noprev,x1, No prev link? 1470 MCW x3,6&X1 1477endtb3 MCW class1,x1 1484 MCW 6&X1,6&X2 1491 MCW 6&X1,x3 1498 MCW x2,9&X3 1505 MCW next3,x3 1512 MCW 3&X3,x2 1519 MCW x2,6&X1 1526 MCW x1,9&X2 1533 MCW class1,3&X2 1540 MCW 1541 S 0&X3,0&X2 1548 SAR x3 1552 BW tstbot,flag 1560 SW flag 1564 C 0&X2,woff 1571 BE red1 1576 B illegl 1580 B tstbot * * Redundant equivalence * 1584red1 B redund 1588 B tstbot * * Variable in equivalence has subscript * 1592subs MN 877 1596 MN 1597 SAR x3 Why not SBR x3,next3-1? 1601 SBR x1,0&X1 * * Move subscript, in forward order, to class table * 1608subsl MCW 0&X1,chtest 1615 SAR x1 1619 BCE subsx,chtest,) 1627 MCW chtest,2&X3 1634 SBR x3 1638 B subsl * 1642subsx A 1&X3,off2 1649 B totop * 1653neg BCE first,off1, still empty? 1661 LCA class1,0&X3 1668 SBR next3 1672first MCW class2,class1 Current one has least offset 1679 B getnxt * * At bottom of class table * 1683atbot MCW savx1,x1 1690 LCA eoff,off1 Empty offset to off1 1697 MCW next,next3 1704 BCE gotlp,1&X1,, 1712 BCE nxstmt,1&X1,} 1720 B syntax * 1724noprev MCW x3,86 1731 B endtb3 * * Code in previous overlay comes here when equivalence statements * have all been processed * 1735done2 MCW next,x3 1742 MCW gm,1&X3 Mark bottom of array table 1749 MCM 5&X1 1753 MN 1754 MN 1755 SAR x1 Top of statement after last equivalence 1759 BSS snapsh,C 1764 SBR tpread&6,838 1771 SBR clrbot 1775 SBR loadxx&3,838 1782 SBR clearl&3,gmwm 1789 LCA dim2,phasid 1796 B loadnx * * Code in previous overlay comes here for variables in the * EQUIVALENCE statement that are not in the table * 1800notin2 BCE gotrp,0&X1,) 1808 SBR x1 1812 B notin2 1816gotrp MN 0&X1 1820 SAR x1 1824 B nxtvar * * Test for redundant or illegal equivalence * 1828testri MCW 0&X3,x2 1835 SAR x2 1839 C 0&X2,off1 1846 BE red2 1851 B illegl 1855 B backri 1859red2 B redund 1863 B backri * * Illegal equivalence * 1867illegl SBR novfl1&3 1871 CS 332 1875 CS 1876 SW glober 1880 MN prefix,244 1887 MN 1888 MN 1889 MCW error7 1893 W 1894 BCV ovfl1 1899 B novfl1 1903ovfl1 CC 1 1905novfl1 B 0 * * Redundant equivalence * 1909redund SBR novfl2&3 1913 CS 332 1917 CS 1918 SW glober 1922 MN prefix,246 1929 MN 1930 MN 1931 MCW error8 1935 W 1936 BCV ovfl2 1941 B novfl2 1945ovfl2 CC 1 1947novfl2 B 0 * * Print "Correct errors and rerun" message and stop * 1951fixit CC L 1953 CS 332 1957 CS 1958 MCW fixmsg,270 1965 W 1966 CC 1 1968halt H halt * * Offset has a value * 1972full MCW 0&X2,woff 1979 CW flag 1983 B empty * * Data * 1991kz5 DCW @00000@ 1994w3 DCW #3 1995kp1 dcw &1 1996k1 dcw 1 1999savx1 DCW #3 2000dollar DCW @$@ 2003wnext DCW #3 2004chtest DCW #1 2009eoff DCW #5 2018dim2 DCW @DIMEN TWO@ 2059error7 DCW @ERROR 7 - ILLEGAL EQUIVALENCE, STATEMENT @ 2102error8 DCW @ERROR 8 - REDUNDANT EQUIVALENCE, STATEMENT @ 2138fixmsg DCW @CORRECT ERRORS INDICATED AND RESTART@ 2143woff DCW #5 Offset work area 2144flag DCW #1 2145gmwm DCW @}@ ex nxstmt END
- Phase 12 - Dimension II. The object-time addresses which delimit each array are computed and inserted in the array table. These addresses are also printed.
JOB Fortran compiler -- Dimension phase two -- 12 CTL 6611 * * Arrays are assigned their object-time addresses. * * On entry, X3 is one below the group mark below the bottom of * the array table, and 86 is the address of the low-order digit * of the offset field of the topmost (first) array table entry * if there are any arrays, or blank if there is no array table. * * On exit the fixed-width fields of the array table elements are * the base address as five digits, the top address as three * characters with a type zone in the second character, the * array element width (imod or mantis&2) and junk, and the * address of the low-order digit of the first array element * as three characters with a type zone in the second character. * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps glober equ 184 Global error flag -- WM means error arytop equ 194 Top of arrays in object code snapsh equ 333 Core dump snapshot topcor equ 688 Top core address from PARAM card imod equ 690 Integer modulus -- number of digits mantis equ 692 Floating point mantissa digits fmtsw equ 696 X for no format, L for limited format * blank for ordinary, A for A conversion loadnx equ 700 Load next overlay clearl equ 707 CS at start of overlay loader * ORG 838 838beginn BCE ord,fmtsw, Ordinary formatting? 846 SBR x2,base5a 853 BCE oth,fmtsw,A A-conversion formatting? 861 SBR x2,base5l 868 BCE oth,fmtsw,L Limited formatting? 876 SBR x2,base5x 883 BCE oth,fmtsw,X No formatting? 891ord MCW x3,83 898 A kp2,mantis Add exponent width to mantissa width 905 SW gm 909 LCA gm,1&X3 Put a GMWM below bottom of array table 916 BCE noary,86, No arrays? 924 MCW 86,x3 931again S w6 935 MCW 6&X3,next 942 BCE noeqv,1&X3, No equivalence class link? 950 MCW 3&X3,x2 Next member of equivalence class 957 ZA 0&X3,w10-4 Offset 964 M 5&X2,w10-1 971 A 0&X2,w10-1 Offset of next in equivalence class 978 MCW w10-1,0&X3 985noeqvr MCW 0&X3,w6 992 SAR x3 996 S kp1,w6 1003 MCW x3,x2 1010more MCM 2&X2 Get X2 above the GMWM 1014 MN and then 1015 MN back down 1016 SAR x2 below it 1020 BCE more,1&X2,| 1028 MCW 0&X2,ch First character of variable name 1035 MCW ch,*&8 1042 BCE intvar,ijklmn,0 Integer variable? 1050 B 1051 B 1052 B 1053 B 1054 B 1055 A mantis,w6 Floating point variable 1062var MCW w6,14&X3 low-order to what was prev 1069 MCW w6-3,x2 Thousands to X2 1076 A x2 Double it 1080 MZ zones&X2,12&X3 Thousands zones 1087 MZ zones&1&X2,14&X3 to variable address 1094 ZA kz1,w10-4 Clear 1101 MCW 0&X3,w10-4 Get first dimension 1108 MCW kb1 and a blank 1112 SBR prep&6 1116 NOP 0&X3 Get X2 1120 MCW down to 1121 SAR x2 second dimension 1125 BCE nodim2,0&X2,} No second dimension if GM? 1133prep MCW 0&X2,0-0 1140 M 0&X3,w10-4 1147nodim2 LCA kb3,8&X3 Clobber equivalence link 1154 MCW x1,sx1 Save x1 1161 MCW 14&X3,x1 Address to x1 1168 MCW ch,*&8 1175 BCE intvr2,ijklm2,0 Integer variable? 1183 B 1184 B 1185 B 1186 B 1187 B 1188 M mantis,w10-1 First dimension * width 1195 MZ kzab,7&X3 Mark floating-point zone 1202 MCW mantis,10&X3 1209var2 MZ 7&X3,13&X3 Copy type zone 1216 MCW sx1,x1 1223 S 10&X3,w6 Subtract variable width 1230 A w10-1,w6 1237 MN w6,8&X3 Low-order digits 1244 MN to what was the 1245 MN equivalence class link 1246 SAR *&4 1250 MCW 0-0,x2 1257 MCW kz1 1261 A x2 1265 MZ zones&1&X2,8&X3 1272 CW why not 1273 SBR *&7 just 1277 MZ zones&X2,0 MZ ZONES&X2,6&X3 ? 1284 A kp1,w6 1291 S w6,base5 compute base5 = max(base5,w6) 1298 BM negdif,base5 1306 A w6,base5 1313tstmor BCE nomore,next, No more arrays if next is blank 1321 MCW next,x3 1328 B again * 1332intvar A imod,w6 1339 B var * * At the end of an equivalence class (maybe the only one * in it). * 1343noeqv MCW base5,0&X3 1350 B noeqvr * 1354negdif MCW w6,base5 1361 B tstmor * 1365intvr2 M imod,w10-1 First dimension * width 1372 MZ kzb,7&X3 Mark integer zone 1379 MCW imod,10&X3 1386 B var2 * * No more array table elements * * Convert topcor to five digits * 1390nomore S w2a 1394 S w2b 1398 MZ topcor,w2a-1 1405 MZ topcor-2,w2b-1 1412loop1k BWZ mod4,w2b-1,2 multiple of 4k? 1420 A ka0,w2b 1427 B loop1k 1431mod4 BWZ below4,w2a-1,2 1439 A kq4,w2a 1446 B mod4 1450below4 A w2b-1,w2a 1457 MCW topcor,top5 1464 MCW w2a 1468 ZA top5 1472 MZ *-4,top5 * * Test for too big program * 1479 S base5,top5 topcor - top of arrays 1486 S kp1,top5 1493 BM toobig,top5 1501 MN top5,top3 low-order 1508 MN digits of 1509 MN free space 1510 SAR *&4 1514 MCW 0-0,x2 thousands to x2 1521 MCW kz1 and a zero 1525 A x2 double it 1529 MZ zones&1&X2,top3 1536 CW why not 1537 SBR *&7 just 1541 MZ zones&X2,0 MCW ZONES&X2,TOP3-2? 1548 MCW base3,arytop 1555 MA top3,arytop 1562 B notbig 1566toobig BW notbig,w10 Don't repeat error message 1574 CS 332 1578 CS 1579 MCW error2,270 1586 W 1587 SW glober,w10 set global and don't repeat flags 1594 S top5 1598noary MCW topcor,arytop 1605notbig MCW base3,86 1612 CC L 1614 BCV *&5 1619 B *&3 1623 CC 1 1625 CS 332 1629 CS 1630 MCW storge,247 1637 W 1638 CC J 1640 MCW 83,x3 * * Print the arrays and their addresses * 1647nother NOP 10&X3 1651 MCM 1652 SAR x3 1656 CS 299 1660more3 BCE more2,0&X3,| 1668 B 1669 MN 0&X3 1673 MN 1674 SAR x3 1678 BCE noarys,0&X3,: No arrays if colon 1686 MN 201 1690 MN 1691 SAR x2 1695 SBR x3,0&X3 * * Move variable to print area -- need to reverse it * 1702move MCW 0&X3,ch2 1709 SAR x3 1713 MCW ch2,2&X2 1720 SBR x2 1724 BW movfin,1&X3 1732 B move 1736movfin C 0&X3 Skip 1740 C the 1741 C fixed 1742 C width 1743 SAR x2 fields 1747 A top5,5&X2 1754 MA top3,8&X2 1761 MA top3,14&X2 1768 MCS 5&X2,218 1775 MCW 8&X2,234 1782 MZ kb1,233 1789 SW 220 * * Convert top address of array to five digits * 1793 S w2c 1797 S w2d 1801 MZ 8&X2,w2c-1 1808 MZ 6&X2,w2d-1 1815lp1ka BWZ mod4a,w2d-1,2 Multiple of 4k? 1823 A ka0,w2d 1830 B lp1ka 1834mod4a BWZ low4,w2c-1,2 1842 A kq4,w2c 1849 B mod4a 1853low4 A w2d-1,w2c 1860 MCW 8&X2,224 1867 MCW w2c 1871 ZA 224 1875 MZ *-4,224 1882 MCW hyphen,219 1889 MN 5&X2,230 1896 MN 1897 MN 1898 SAR *&4 1902 MCW 0,x2 1909 MCW kz1 1913 A x2 1917 MZ zones&1&X2,230 1924 CW 1925 SBR *&7 1929 MZ zones&X2,0 1936 BCV *&5 1941 B *&3 1945 CC 1 1947 W 1948 CS 299 1952 MCM 1&X3 1956 SAR x3 1960 BCE done,0&X3, 1968 B nother Do another one * 1972more2 MCM 0&X3 1976 SBR x3 1980 B more3 * * Print No Arrays message * 1984noarys CS 332 1988 CS 1989 MCW noarym,209 1996 W 1997 BCV *&5 2002 B done 2006 CC 1 * * Done * 2008done CC L 2010 BSS snapsh,E 2015 SBR clearl&3,gmwm 2022 LCA varbl1,phasid 2029 B loadnx * * Formatting other than ordinary formatting * 2033oth MCW 0&X2,base3 Base address 2040 MCW and decimal equivalent & 1 2041 B ord * * Data * 2049base5 DCW 04280 Decimal format base address for arrays * Eventually, 1 above top of arrays 2052base3 DSA 4279 Base5 - 1 in machine address format 2057 DCW 04617 2060base5a DSA 4616 A format base address for arrays 2065 DCW 02016 2068base5l DSA 2015 L format base address for arrays 2073 DCW 01697 2076base5x DSA 1696 X (no) format base address for arrays 2081top5 DCW 00000 topcor as five digits 2084top3 DCW 000 topcor less arrays as 3 characters 2085gm dc @}@ 2095w10 DCW #10 2096kb1 DCW #1 2098zones DCW @ 9@ 2129 DCW @9Z9R9I99ZZZRZIZ9RZRRRIR9IZIRIII@ 2130kp2 dcw &2 2136w6 DCW #6 2139next DCW #3 2140kp1 dcw &1 2141ch DCW #1 2147ijklmn DCW @IJKLMN@ 2148kz1 DCW 0 2151kb3 DCW #3 2154sx1 DCW #3 Save area for X1 2160ijklm2 DCW @IJKLMN@ 2161kzab dcw &1 A and B zones 2162kzb DCW -1 B zone 2164w2a DCW #2 2166w2b DCW #2 2168ka0 dcw @A0@ 2170kq4 dcw @?4@ 2206error2 DCW @MESSAGE 2 - OBJECT PROGRAM TOO LARGE@ 2251storge DCW @STORAGE ASSIGNMENT-ARRAYS & EQUATED VARIABLES@ 2252ch2 DCW #1 2254w2c DCW #2 2256w2d DCW #2 2257hyphen DCW @-@ 2266noarym DCW @NO ARRAYS@ 2272varbl1 DCW @VARBL1@ 2273gmwm DCW @}@ ex beginn END
- Phase 13 - Variables I. The entire source program is scanned for variables. The following changes are made directly within the text of the source program:
- Simple variables are tagged for later processing by Phase 16.
- Subscripted variables with constant subscripts are replaced by the object-time address of the designated array element.
- All other subscripted variables are put into a canonical form which specifies a computation in terms of variables and constants for determining the object-time address of the array element specified.
- Non-subscripted array names appearing in lists are replaced by the object-time address that delimit the array named.
- Non-subscripted array names appearing elsewhere are replaced by the object-time address of the first element of the array.
JOB Fortran compiler -- Variable Phase One -- 13 CTL 6611 * * The source program is scanned for variables. Simple * variables are merely tagged for later processing by * Variables Phase Four. Subscripted variables whose * subscripts are constants are replaced by the object- * time address of the array element. Subscripted variables * whose subscripts are variable are replaced by the * computation required at object time to determine the * array element selected. Non-subscripted array variables * appearing in lists are replaced by two machine-language * addresses representing the limits of the array. Non- * subscripted array variables appearing elsewhere are * replaced by the address of the first element of the * array. * * On entry, 83 is one below the GM below the bottom of * the array table and x1 is at the top of the first (in sorted * order) statement that's neither dimension nor equivalence. * * On exit the code is moved up against the array table. * x1 equ 89 x2 equ 94 x3 equ 99 * * Stuff in the resident area * phasid equ 110 Phase ID, for snapshot dumps glober equ 184 Global error flag -- WM means error snapsh equ 333 Core dump snapshot loadnx equ 700 Load next overlay clearl equ 707 CS at start of overlay loader loadxx equ 793 Exit from overlay loader * ORG 838 838beginn MCW 83,x2 845 MCW x2,tblbot Save bottom of array table 852 SW gm 856nxtstm BCE done,0&X1, No more statements? 864 LCA 0&X1,prefix 871 SAR x1 Top of statement 875 SBR x3 879 LCA prefix,0&X2 Push up below array table 886 SBR x2 and save the next available 890 BCE format,prefix-3,F Format statement? 898 SW prefix-3 902 MCW prefix-3,*&8 909 BCE datxfr,datxfc,0 Data transfer statement? 917 chain6 * * Not a data transfer statement * 923 MCW nop,swich1 Turn off data transfer 930 MCW nop,swich2 statement switches * * Back here for either data transfer statement or not * 937stmt MCW 0&X1,ch Skip numeric 944 SAR x1 and non-zoned punctuation 948 BWZ stmt,ch,2 characters 956swich1 NOP datxf1 Branch if data transfer statement 960skipp MCW ch,*&8 Skip @*-&.%), 967 BCE stmt,punct,0 punctuation 975 chain7 982 BCE fltcon,ch,E Floating-point constant? 990 BCE gotvar,ch,} GM (bottom of stmt)? 998 MCW 2&X1,ch2 1005 MCW ch2,*&8 1012 BCE gotvar,punct2,0 #,}*@&-%) 1020 chain8 1028 BCE gotvar,prefix-3,D Do statement? 1036syntax CS 332 1040 CS 1041 SW glober Global error flag 1045 MN prefix,240 Sequence number to print line 1052 MN 1053 MN 1054 MCW error9 Variable syntax error 1058 W 1059 BCV ovfl1 1064 B novfl1 1068ovfl1 CC 1 1070novfl1 BW cw1s6,flag1 go clear flag 1 and set flag 6 1078 SBR x1,1&X1 1085 SW flag3 1089 B skp2p2 Skip to punct2 punctuation * 1093suber2 LCA k0q0,0&X2 0?0 1100 SBR x2 1104 SBR x3,1&X1 1111 SBR x1 1115 B varfin * * X1 is at the GM at the bottom of the statement, or one below * the top (first) character of a variable. * Move stuff above and first character up. * 1119gotvar SW 1&X1 1123 LCA 0&X3,0&X2 Move up stuff above (before) var 1130 SBR x2 1134 CW 1&X1 1138 SBR x3,1&X1 X3 now at top (beginning) of variable 1145 SBR check&6,2&X1 1152 MCW semic Replace char above variable or GM 1156 BCE endstm,ch,} End if GM 1164 ZA kp1,w2 * ` * Count characters in name * 1171skp2p2 MCW 0&X1,ch 1178 SAR x1 1182 MCW ch,*&8 1189 BCE gotp2,punct2,0 #,}*@&-%) 1197 chain8 1205 A kp1,w2 1212 B skp2p2 * 1216gotp2 BW subfn1,flag6 1224 BW suber2,flag3 1232 SW 2&X1 At bottom (last) char of token 1236 SAR sx1 Save 1&x1 at punct below name * * Look for variable in array table. X3 is at top (first) * character of the variable. CH is character below (after) * the variable. * 1240lookup MCW tblbot,x1 Get bottom of array table 1247 BCE asg,ch,# Go turn off swich2 if assignment stmt 1255look2 BCE notarr,2&X1, At end of array table? 1263more MCM 2&X1 1267 MN 1268 MN 1269 SAR x1 1273 BCE more,1&X1,| 1281 C 0&X3,0&X1 1288 BU look2 1293 C 0&X1,0&X3 1300 BU look2 1305 C 0&X1 Get x1 down to 1309 chain3 offset field 1312 SAR x1 1316 BW subvr2,flag2 Working on variable subscript? 1324 BCE sub,ch,% Subscripted * * In array table, not subscripted * 1332swich2 NOP datxf2 Branch if data transfer statement 1336 LCA 9&X1,1&X2 Addr of low digit of first array elt 1343 SBR x2 1347lookfn MCW sx1,x1 1354 B varfin * * Whole array * 1358datxf2 LCA 9&X1,1&X2 Addr of low digit of first array elt 1365 LCA 3&X1 Addr of low digit of last array elt 1369 SBR x2 1373 CW 4&X2 between addresses 1377 B lookfn * * Not in array table. X2 is two below the punctuation before * the variable or prefix moved to be below the array table. * 1381notarr MCW sx1,x1 1388 BW subvr3,flag2 Working on variable subscript? 1396 BCE subnot,ch,% 1404 LCA kbundr,1&X2 Blank, underscore 1411 SBR x2 1415notar2 LCA 0&X3,1&X2 Move variable up 1422 SBR x2 1426 CW 1&X2 1430 S kp2,w2 1437 BM short,w2 Variable name is short 1445varfin CW 1&X1 1449 SAR x3 1453varfn2 CW 1&X2 1457 CW flag4,flag3 1464 CW flag5 1468check BCE stmt,0,; Semicolon? 1476 MCW dollar,x1 1483 B done * * Not in array table, but appears to be subscripted * 1487subnot BCE notar2,1&X1,F Last char of var says function? 1495 CS 332 1499 CS 1500 SW glober 1504 MN prefix,240 1511 MN 1512 MN 1513 MCW error6 1517 W 1518 BCV ovfl2 1523 B novfl2 1527ovfl2 CC 1 1529novfl2 LCA kpct3z,1&X2 %000 1536 SBR x2 1540 MZ savzon,3&X2 1547getend BCE endsub,0&X1,) End of subscript? 1555 BCE endst2,0&X1,} End of statement? 1563 SBR x1 1567 B getend 1571endsub MN 0&X1 X1 now below subscript 1575 SAR x1 1579 B varfn2 * * In array table and subscripted * 1583sub ZA 0&X1,w6 High digit of first array element 1590 SAR x3 x3 now at first dimension 1594 SW flag7 In array table and subscripted 1598 ZA 0&X3,w5 First dimension to w5 1605 ZA 5&X1,prod-7 Element size 1612 S kp1,w6 1619 MZ 8&X1,savzon Type tag of array 1626 MCW sx1,x1 X1 back to statement 1633 LCA kbdolr,1&X2 Blank, $ indicates subscript 1640 SBR x2 1644 MN 0&X1 1648 SAR x1 1652 SBR x3 1656tstcon BWZ submor,0&X1,2 Constant subscript? 1664 SBR x1,2&X1 1671 LCA kstar1,0&X1 Star, 1 (1 is prev dim width) 1678 B submor * * Continue variable subscript processing * 1682subvar LCA kbundr,1&X2 Blank, underscore indicates variable 1689 SBR x2 * * Get down to the bottom of the variable * 1693skp2p3 MCW 0&X1,ch 1700 SAR x1 1704 MCW ch,*&8 1711 BCE gotp3,punct3,0 -&), 1719 chain3 1722 B skp2p3 1726gotp3 SW 2&X1 1730 SW 1731 SAR sx1 1735 SW flag2 Working on variable subscript 1739 B lookup * 1743subvr2 LCA 9&X1,2&X2 1750 SBR x2 1754 CW 1&X2 1758 MN 1759 SAR x2 1763 B subvr4 * * Move subscript up * 1767subvr3 LCA 0&X3,1&X2 1774 LCA 1775 SBR x2 1779 CW 2&X2 1783subvr4 MCW sx1,x1 1790 CW 2&X1 1794 BCE short2,3&X2,_ 1802 LCA kbcomm,1&X2 Blank, comma 1809 SBR x2 1813 CW flag2 Done working on variable subscript 1817 BCE morsub,ch,, 1825 BCE subfin,ch,) 1833 MZ ch,prod-7 1840subvr5 MCW x1,x3 1847 B tstcon * * Continue subscript processing * 1851submor SBR x3,bigwrk-2 1858subm2 MCW 0&X1,ch Move subscript 1865 SAR x1 to bigwrk putting 1869 MCW ch,2&X3 its characters 1876 SBR x3 into forward order 1880 BWZ subm2,0&X1,2 Constant subscript? 1888 SBR x1 1892 M prod-7,7&X3 1899 BCE subv1,1&X1,* First variable subscript? 1907 A 7&X3,w6 Add to offset from array base 1914 BCE subfin,1&X1,) Done with subscripts? 1922 BCE morsub,1&X1,, Second subscript? 1930 SW flag1 1934 B syntax * 1938cw1s6 CW flag1 1942 SW flag6 1946 B skp2p2 * 1950subfn1 CW flag6 1954subfin NOP w6-7 1958 SAR x3 1962 SW flag4 Moving variable subscript 1966 B normlz 1970subfn2 LCA dollar,0&X2 Mark end of subscript 1977 SBR x2 1981 MZ savzon,3&X2 1988 B varfin * * First variable subscript * 1992subv1 CW 1&X1,flag7 1999 B normlz 2003 LCA kbstar,0&X2 2010 SBR x2 2014 CW 1&X2 2018 MCW x1,x3 2025 B subvar * * Normalize offset between 0 and 15999, store it * into code at top of core. * 2029normlz SBR normlx&3 2033normlp S kp16k,7&X3 Subtract 16000 2040 BWZ normlp,7&X3,B until negative 2048normln A kp16k,7&X3 Add 16000 2055 BM normln,7&X3 until positive 2063 BW cvtadr,flag4 Moving variable subscript? 2071nortrm SBR x3,1&X3 Trim leading 2078 BCE nortrm,2&X3,0 zeroes 2086 SBR x2,1&X2 2093 LCA kb6 2097norrev MCW 2&X3,ch Move normalized 2104 SAR x3 offset up 2108 MCW ch,0&X2 while reversing 2115 SBR x2 the digits 2119 BWZ norrev,1&X3,2 2127 MZ kb1,1&X2 Clobber last digit zone 2134normlx B 0-0 * * Done * 2138done BSS snapsh,C 2143 SBR loadxx&3,849 2150 SBR clearl&3,gmwm 2157 LCA varbl2,phasid 2164 B loadnx * * data transfer input/output statement * 2168datxfr MCW branch,swich1 Turn on data transfer 2175 MCW branch,swich2 statement switches 2182 MCW prefix-3,*&8 2189 BCE rwt,rwtc,0 Read/write (input/output) tape? 2197 chain3 2200 B stmt read, print or punch 2204rwt SW flag5 2208 B stmt 2212datxf1 BCE datxrp,ch,) 2220 B skipp Go skip punctuation 2224datxrp MCW branch,swich2 2231 B skipp Go skip punctuation * * Bottom (end) of statement * 2235endst2 MN 0&X2 2239 SAR x2 2243endstm LCA gm,1&X2 2250 B nxtstm * * Saw assignment operator (#) * 2254asg MCW nop,swich2 2261 B look2 * * Make sure at least 3 characters * 2265short2 LCA kb2,1&X2 2272 SBR x2 2276 B subvr4 * * Variable name is short -- we need at least three spaces * 2280short LCA kb1,0&X2 2287 SBR x2 2291 CW 1&X2 2295 B varfin * * Looks like a floating-point constant * 2299fltcon BCE gotvar,2&X1,# 2307 BCE gotvar,2&X1,@ 2315 BWZ stmt,2&X1,2 2323 BCE stmt,2&X1,. 2331 B gotvar * * Convert bigwrk to machine address * 2335cvtadr MCW 7&X3,w5b 2342 MN w5b,subadr 2349 MN 2350 MN 2351 SAR *&4 2355 MCW 0-0,x3 thousands 2362 MCW k0 and a zero to x3 2366 A x3 double x3 2370 MZ zones&1&X3,subadr 2377 CW 2378 SBR *&7 2382 MZ zones&X3,0-0 2389 BCE cvtad2,2&X2,, 2397 SBR x2,1&X2 2404cvtad2 LCA subadr,1&X2 2411 SBR x2 2415 CW 1&X2 2419 MZ savzon,2&X2 2426 BW varfin,flag7 In array table and subscripted? 2434 B subfn2 * * Saw a comma, here comes another subscript * 2