/Renumber program for FORTRAN *300;STRTUP, TEXT x[FORTRAN [I[V [RENUMBER, [VERSION 03.03^%x /Written by: / Stephen R. Besch / Dept. of Physiology / SUNY at Buffalo / Buffalo, N.Y. 14214 / APR 6, 1984 /Run time options: / /I Run in interactive mode. / /P Print pass 2 on TTY / /H Print identifier /Interactive mode prints program to TTY, stopping at each /statement definition for user input. /The program responds to ^S by stopping output till some /other character is typed. A second ^S will cause one /character to be typed. /Updates: / 4/25/86: Added Statement Number literals. /Note that the addition of #SN type literals was done in such a way /that they are replaced even in comment fields. This is a really nice /feature in that it can be used to renumber references to sections /which appear in comments by including the "#" character in the /statement number reference. This does place some restrictions on the /use of the "#" character in comments, but only if followed directly /by a number. Even an intervening space will cause it to be ignored. /Assemble, Load and Save: / .PAL RENUM4-LS /Listing if desired / .LO RENUM4 / .SAVE SYS:RENUM;200=3401 BSIZE=3 /I/O buffer size LOAD=JMS I [DLOAD STORE=JMS I [DSTORE NEG=JMS I [DNEG ADD=JMS I [DADD DSNA=JMS I [DDSNA DSZA=JMS I [DDSZA DSMA=JMS I [DDSMA ROTAT=JMS I [DROTAT /Input buffer and startup routine. *200 INBUF, START, JMP PMSG /Enter here from Keyboard Monitor. TLS /Force flag up DCA START /Zap the CD flag CDF 10 /Enter here if chained to (CCL) TAD I (7643 /Load the A-L option word AND (20 /Is "/H" set SNA CLA /Skip if it is JMP NOMSG /Don't print the message CDF 0 /Reset field 0 PMSG, TLS /Set tty flag JMS PRINT /Call print routine. STRTUP /Startup message TAD START /Load AC neg if not chain NOMSG, CDF CIF 10 /Set for IF 1. JMP I (FILEIO /Get file stuff done. *400^BSIZE+200 /*1400 for BSIZE=3 OUTBUF, /Routine to input a statement # from the TTY. Used only in pass 0 INPSTM, 0 TAD INTRCT /Load interactive flag SNA CLA /Skip if interactive JMP BUMPST /Just bump statement # JMS I [PUTCHR /Move STMT terminator JMS MOVLIN /and rest of line to TTY TAD (INPLIN DCA INPUT CTRLU, TAD [215 /load a CR JMS I [TYPE /print it DCA LINCT /Zero # of characters TAD (LINEB /Load address of input buffer DCA INPTR /Store pointer KBDLP, KSF /Test KBD flag JMP .-1 KRB /Read character AND [177 /Zap parity TAD [200 /Force it back DCA I INPTR /Save character TAD I INPTR /reload it JMS I [SORTJ /Sort the character -215;CLOSE /Close the input -377;RUBOUT /Obvious -203;7600 /Obvious TAD I INPTR /load the character JMS I [DIGIT JMP KBDLP /Ignore non-digit characters TAD LINCT /Load input line count TAD (-5 /See if already 5 characters SMA CLA /Skip if less than 5 JMP KBDLP /5 is MAX, wait for CR or RUB TAD I INPTR /Load the character JMS I [TYPE /Echo it ISZ INPTR /Bump pointer ISZ LINCT /Bump character count JMP KBDLP RUBOUT, CLA CMA TAD LINCT /load line count SPA /Skip if positive (or 0) JMP KBDLP /Can't rubout anymore DCA LINCT /Back up counter then CLA CMA /AC=-1 TAD INPTR DCA INPTR /Back up input pointer too TAD (210 /Load backspace JMS I [TYPE TAD [" /Load a " " JMS I [TYPE TAD (210 JMS I [TYPE /Backspace again JMP KBDLP /Back to input loop CLOSE, TAD (211 /Load a TAB JMS I [TYPE /to clear up unused characters TAD I INPTR /Load closing CR JMS I [TYPE /Type it TAD (LINEB DCA INPTR /Reset input pointer JMS I INPUT /Get first character into CHAR JMS STMT /Get statement # JMP BUMPST /ZERO means bump last statement # STSTMT, STORE; LAST /This statement number is new last one STORE;INDX 1 VTSET2, 0 /In value table (LOOKUP sets INDX 1) TAD (STMGCH /Load normal character fetch address DCA INPUT /Reset input character vector JMP I INPSTM /return BUMPST, LOAD; LAST /Load last statement number ADD; TEN /add 10 to it JMP STSTMT /Go store it START2, DCA OUTLEN /Save length of output file TAD I (FRSTB /Load address of first block CDF 0 DCA I (OUTBLK JMP PASS1 /And start pass1 /Enter here for both passes. Pass 1 does not use the output /buffer, so this code is safe. PASS2, TAD (-"# /Load the SN literal test DCA SNLCHR /Store in MOVLIN PASS1, CDF 10 TAD I (7620 /Load block of 1st input file CDF 0 DCA INBLK /Set input block # TAD (RDBUFF DCA COEXIT /Reset co-routine in GETCHR JMP ZAPCH /And start it up PAGE MSSG01, TEXT x^[ERROR LOADING INPUT HANDLER^%x MSSG02, TEXT x^[NO OUTPUT FILE^%x MSSG03, TEXT x^[ERROR LOADING OUTPUT HANDLER^%x MSSG04, TEXT x^[ERROR OPENING OUTPUT FILE^%x MSSG06, TEXT x^[MULTIPLE SYMBOL DEFINITION^%x MSSG11, TEXT x^[SYMBOL TABLE OVERFLOW^%x MSSG12, TEXT x^[NO INPUT FILE^%x *400^BSIZE+OUTBUF / Page /3200 if BSIZE=3 /Loop here while in the statement field of any given line. ZAPCH, DCA THISCH /Remove last character CHRLP, JMS I [COPY /Get a character from input buffer CHRTST, JMS I [SORTJ /Do a presort on CHAR -212;CHRLP /Move line feeds MTAB, -211;TABCHR /Move tabs too /MTAB, -211;CHRLP /Move tabs too MCR, -215;EMPTLN /CR (usually means empty line here) -"!;NEWLIN /Comment field character -240 /Space code DFNFLG, ZAPCH /Initial setting to remove spaces /DFNFLG gets incremented to remove /space stripping. /None of the above, fall through. /Here for continuation col. check. If it is, go process this line /as if it is still the last. Note that the link is used to /indicate if we're before or after the continuation col. /Next time through, after a continuation, EOLFLG will not be /zero, and we proceed to OLDLIN. TAD COLUMN /Load current column CLL /Zero link TAD (-6 /See if continuation col. SNA CLA /Skip if not continuation col JMP CONTIN /Otherwise process continuations TAD EOLFLG /Load end of line flag SZA CLA /Skip if this isn't continuation JMP OLDLIN /If it is, continue with it TAD [NEWLIN /reset pending operation DCA PEND /and continue OLDLIN, SZL /Skip if before continuation col. JMP BODY /Process body of line TAD CHAR /Load our character JMS I [DIGIT /See if it's a digit JMP NEWLIN /If not, comment is only possibility JMP DFNITN /Define statement number if digit /Here for the body of the line. Test the TAB flag. It will be zero if /we exited the statement field with a tab, or if we have already output /a psuedo-tab. BODY, TAD TABFLG /Load the flag JMS INSRT /Insert spaces if needed JMS I [SORTJ /Sort and jump -"A;ASSIGN /FORTRAN ASSIGN -"D;DO / " DO -"G;GOTO / " GOTO -"I;IF / " IF -"R;READ / " READ -"W;WRITE / " WRITE -",;CHRLP /Ignore commas too ACHRLP=.-1 BAKSP, 210 /Must use real terminator here /If we fall out the bottom the character must be either a /digit after col. 8 (non-definition type statement #), or /the first character of some non-keyword symbol. Either /Goto NEWLIN to get rid of the rest of the line, or /call any pending operation to deal with an expected /statement number. JMP I PEND /Call pending operation or NEWLIN NEWLIN, JMS MOVLIN /Move the rest of the current line EMPTLN, JMS EOLIN /End line, resetting vector JMP CHRLP /For branch after continuations /Here for lines with only a CR on them EOLIN, 0 TAD (ZAPCH /Load zap character address DCA DFNFLG /Reset definition flag DCA EOLFLG /Indicate end of line TAD (-10 TABCHR, DCA TABFLG /Set Psuedo tab flag/count JMP CHRLP /Here to get next statement #, either a definition (DFNITN), or /a reference (GETSTN). GETSTN, TAD ACHRLP /Address of CHRLP DCA DFNFLG /To indicate non-definition DFNITN, DCA THISCH /Drop first character from output TAD BAKSP JMS I [TYPE /Print a backspace to correct TTY JMS STMT /Get statement # JMP I [NEWLIN /Process new line if no # /Maybe should be JMP I PEND? JMS LOOKUP /Lookup the symbol JMS OUTSTM /Send it to output JMS I [PUTCHR /Move the terminating character too JMP CHRTST /Test next character /Here to process the start of a continuation line. Output the right /number of spaces and leave TABFLG zero. (see INSRT) CONTIN, TAD (-5 /Load count JMS INSRT /Insert 5 spaces ISZ EOLFLG /Set flag cleared at end of last line ISZ DFNFLG /Stop stripping spaces too JMP I EOLIN /Return to CHRLP or SIGNIF /Test for keyword SYMB, 0 TAD PASS /See if pass 0 SNA CLA /Skip if not JMP I [NEWLIN /Get a new line TAD I SYMB /Load address of keyword ISZ SYMB /Bump return DCA AINDX /Store SYMTLP, JMS I [SIGNIF /Get next significant character TAD I AINDX /Compare a word SNA /Skip if not a match JMP SYMTLP /Loop till no match CIA /If list term, AC=-CHAR TAD CHAR SZA CLA /Skip if match JMP I [NEWLIN /Else just end the line TAD CHAR /Load the termiating character JMP I SYMB /Return, successful /Routine to copy the rest of a line to the output. During pass1, /we don't test for the S.N. literals. Since all NULLS are stripped by /GETCHR, the -200 test will always fail. During pass2, the SNLCHR is /set to -"#. MOVLIN, 0 JMS I [COPY /Get next character JMS I [SORTJ /Sort and jump -215;SCRX /Exit already SNLCHR, -200;SNLIT /Statement number literal 0 /read list terminator JMP MOVLIN+1 /Next character if not CR SCRX, JMP I MOVLIN /Return SNLIT, JMS I [COPY /Copy out the "#" and get digit JMP GETSTN /And get the statement number PAGE /3400 if BSIZE=3 /Here when end of file detected. Set next pass CTRLZ, TAD SLASHP /Load echo sw for pass 2 DCA ECHOSW /Set it here TAD PASS /Load it ISZ PASS /Increment pass SNA CLA /Skip if ending pass 2 JMP PASS2 /Start pass 2 TAD K232 /Load an ^Z JMS I [PUTCHR /Output it /Loop here to fill output buffer to a page boundary. /We must call PUTCHR at least 2x to insure that /THISCH gets dumped. Thats why there a separate call /to PUTCHR for the CTZ. TAD [200 /Load a NULL FILLB, JMS I [PUTCHR /Move ^Z out TAD OBPTR /Load output pointer AND [177 /See if on page boundary SZA CLA JMP FILLB /Loop till it is JMS WRBUF /Write partial output buffer JMP DIRTY /List un-referenced S.N. /Routine to create a statement number from input stream. We can't /use SIGNIF because we don't want to copy these characters to the /output file. STMT, 0 JMS I [ZERO /Zero Double AC JMP STMID /Enter the loop in the middle STLOOP, JMS I INPUT /Get a character from input STMID, TAD CHAR /Load a character JMS I [DIGIT /Test it JMP STMRTN /Return on first non-digit TAD CHAR AND K17 /De-"ASCII"fy digit DCA TEMP2 DCA TEMP2+1 /Just in case it's not 0 STORE; TEMP /Store double AC in TEMP ROTAT; -2 /Rotate DBL AC twice left ADD; TEMP /Add TEMP ROTAT; -1 /And rotate again ADD; TEMP2 /Add in new digit JMP STLOOP /Next character STMRTN, JMS I [SORTJ /See what kind of character ended -"(;BADSTN /If "(" -"=;BADSTN /or "=", don't accept it K232, 232 /Term. and constant DSNA /Skip if STMT #.NE.0 JMP DUMPCH /Print last character ISZ STMT /Bump return if there's a symbol JMP I STMT /Return now BADSTN, JMS OUTSTM /Send number to output DUMPCH, TAD CHAR /Load unused term. character JMS I [PUTCHR /and output it JMP I STMT /Then exit /Get character routine for STMT STMGCH, 0 STMSP, DCA TABFLG /Zero count TAD PASS /Load pass switch SNA CLA /Skip if pass 1 TAD CHAR /Load character if pass 0 JMS I [TYPE /Print it JMS I [GETCHR /Get character from input JMS I [SORTJ /Look at character -240;SETM1 /Space -211;ZCXIT /Zero count and exit K17, 17 /Terminator and constant JMP I STMGCH /Exit here ZCXIT, DCA TABFLG /Zap the flag JMP I STMGCH /And exit SETM1, CLA CMA /AC=-1 means space terminated JMP STMSP /Print the character but ignore it /Routine to lookup a statement number. /Statement # in question comes in double AC /Symbols are stored positive until they are referenced at /least once. LOOKUP, 0 STORE; TEMP2 /Save original number DCA INDX 1 /Use first Statement # LKPLP, LOAD;INDX 1;STMTBL /Load next stmt number from table DSNA /Skip if double AC non-0 JMP UNDEF /Undefined symbol DSMA /Skip if minus NEG /Or negate it STORE; TEMP /Store negative ADD; TEMP2 /Subtract test STMT # DSNA /Skip if not a match JMP FOUND /Found it, go load it's value ISZ INDX 1 /Bump entry number JMP LKPLP /Loop back for next symbol FOUND, TAD PASS /Which pass SNA CLA /Skip if pass 1 EROR06, JMS I [ERROR /Multiple definition TAD DFNFLG TAD (-ZAPCH /Are we in a definition field SNA CLA /If not, mark symbol as referenced JMP CLEAN LOAD; TEMP /Load negated value STORE;INDX 1;STMTBL /Store negative in table CLEAN, LOAD;INDX 1 /Get the replacement value VTSET1, 0 /Address of value table in here JMP I LOOKUP /Return UNDEF, TAD PASS /Load pass switch SZA CLA /Skip if pass 0 EROR07, JMS I [ERROR /Undefined symbol TAD INDX 1 /Load symbol number TAD MAXSTM /See if too many SMA CLA /Skip if OK EROR11, JMS I [ERROR /Table overflow LOAD; TEMP2 /Load the symbol STORE;INDX 1;STMTBL /Add it to the table JMS INPSTM /Get replacement definition JMP I LOOKUP /return PAGE /3600 if BSIZE=3 /Zero double AC ZERO, 0 CLA CLL DCA DBLELO DCA DBLEHI JMP I ZERO /Rotate double AC DROTAT, 0 TAD I DROTAT DCA INDX RLP, CLL /Get junk out of LINK TAD DBLELO /Load low order word RAL DCA DBLELO TAD DBLEHI RAL DCA DBLEHI ISZ INDX JMP RLP ISZ DROTAT JMP I DROTAT /Routine to load double AC DLOAD, 0 TAD DLOAD /Get return address JMS OFFSET /Compute effective address TAD I DLOAD /Load low order word from E.A. DCA DBLELO /Store low order word ISZ DLOAD /Bump pointer TAD I DLOAD /Hi word DCA DBLEHI /Store it JMP I DSTORE /Store Double AC DSTORE, 0 TAD DSTORE JMS OFFSET TAD DBLELO DCA I DLOAD /Store low order word ISZ DLOAD TAD DBLEHI DCA I DLOAD /Store high order word JMP I DSTORE /return /Add to double AC DADD, 0 TAD DADD JMS OFFSET /Set address CLL CLA /Make sure link=0 TAD I DLOAD /Load low order word ISZ DLOAD /Bump pointer TAD DBLELO /Add to low order word in AC DCA DBLELO /Store result KRAL, RAL /Overflow to AC 11 TAD DBLEHI /Add to high word TAD I DLOAD /Add upper word of addend DCA DBLEHI /Store it JMP I DSTORE /Return /Calculate effective address OFFSET, 0 DCA DSTORE /Save R.A. in common location TAD I DSTORE /Load argument AND (7770 /remove INDEX bits SZA CLA /Skip if indexed instruction JMP DIRECT /Else use direct addressing TAD I DSTORE /Load index address DCA DLOAD /Save for indirect reference ISZ DSTORE /Correct return address TAD I DLOAD /Load index value CLL RAL /Multiply by 2 DIRECT, TAD I DSTORE /Add on base address ISZ DSTORE /Bump past address arg DCA DLOAD /Store effective address JMP I OFFSET /Return now /Negate double AC DNEG, 0 CLA CLL TAD DBLELO /Load low order double ac CIA /Take it's negative DCA DBLELO TAD DBLEHI /Load high order CMA /Complement it SZL /Skip if no overflow from lo IAC /Increment AC on overflow DCA DBLEHI /Store the word JMP I DNEG DDSNA, 0 MQL /Store AC TAD DBLELO /Load low order word SNA /Skip if not 0 TAD DBLEHI /Load high order word SZA CLA /Skip if both 0 ISZ DDSNA /Bump return MQA /re-load AC JMP I DDSNA /Return DDSZA, 0 MQL /Store AC TAD DBLELO /Load low order word SNA /Skip if not 0 TAD DBLEHI /Load high order word SNA CLA /Skip if either non-0 ISZ DDSZA /Bump return MQA /re-load AC JMP I DDSZA /Return DDSMA, 0 MQL /Save AC TAD DBLEHI /load hi word SPA CLA /Skip if pos. ISZ DDSMA /Inc. return if minus MQA /Reload AC JMP I DDSMA /Return /Insert spaces into output buffer without printing them on TTY. /Routine uses TABFLG as a counter so it gets left 0. INSRT, 0 SNA JMP I INSRT /Return on zero count DCA TABFLG /Store the count INSLP, TAD THISCH /Load last character DCA CHAR /Make it this character TAD [240 /Load space character DCA THISCH /Save as last character TAD CHAR /Load current character CIA /Negative so JMS I [PUTCHR /PUTCHR doesn't re-TYPE it ISZ TABFLG /Bump count JMP INSLP /Loop then JMP I INSRT /RETURN /Skip if DIGIT routine DIGIT, 0 TAD (-"0 /Subtract ASCII 0 CLL /Clear link TAD (-12 /Set link if>9 SNL CLA /Skip if not digit ISZ DIGIT /Bump return JMP I DIGIT PAGE /4000 if BSIZE=3 /Routine to copy a character from the input file to the output /buffer. COPY, 0 JMS GETCHR JMS I [PUTCHR JMP I COPY /Routine to read a character from the input file GETCHR, 0 NXTCHR, JMP I .+1 /Get next character COEXIT, RDBUFF /First set to read buffer AND [177 /Strip parity and other junk SNA JMP NXTCHR /Remove nulls TAD [200 /Normalize parity JMS I [SORTJ /Sort and jump -211;TAB /TAB: Adjust Col. # -215;ENDLIN /CR:End of line MCTZ, -232;CTZX /End of file -212;GCXIT /Line feed, don't bump col. ISZ COLUMN /Bump Col. number GCXIT, JMP I GETCHR /Return with character in CHAR ENDLIN, DCA COLUMN /Zero col. number JMP I GETCHR /Exit CTZX, TAD COLUMN /Is COL.=0 SNA CLA /Skip if not JMP CTRLZ /Call "^Z" processor /If the last line did not end with a CR code, then return a /CRLF sequence before calling "^Z" TAD [215 /Load a CR character JMS COEXIT /Return a CR on ^Z TAD [212 /Load a LF character JMS COEXIT /Followed by a LF JMP CTRLZ /And call ^Z code TAB, TAD COLUMN /Load col. # TAD (10 /Next tab stop AND (7770 /Strip off partial tab DCA COLUMN /Pop into column JMP I GETCHR /Return with it /Sequential routines to do OS8 unpacking CHAR1, TAD I IBPTR /Get word from input buffer AND [7400 /Save high bytes RTR CLL /Move to byte boundary DCA CHAR3 /Save it for now TAD I IBPTR /Load same word again JMS COEXIT /return with first character ISZ IBPTR /Bump pointer TAD I IBPTR /Load next word JMS COEXIT /Return with second character TAD I IBPTR /Load the second word again ISZ IBPTR /Bump the pointer AND [7400 /Strip the garbage BSW /Align on lower byte boundary TAD CHAR3 /Add on pending character half RTR CLL /Move down to bottom of AC JMS COEXIT /Return with character 3 ISZ CHARCT /Bump character count JMP CHAR1 /Get next character RDBUFF, JMS I INHND /Call input handler INFUN, 200^BSIZE /Initial function word IBADR, INBUF /address of input buffer INBLK, 0 /Input block number EROR08, JMS I [ERROR /Error processor TAD IBADR /Load input buffer address DCA IBPTR /Store buffer pointer TAD INFUN /Load input function word CIA /Neg. is # of double words DCA CHARCT /Store character count TAD INBLK /Load block address TAD (BSIZE /Add blocks per buffer load DCA INBLK /Store it back JMP CHAR1 /Back to get first character CHAR3, 0 IBPTR, 0 CHARCT, 0 TABCT, 0 /Type routine. Echo switch is set on startup to a /CLA CLL for no echoing, or the a SNA for echoing. TYPE, 0 ECHOSW, CLA /Echo switch set on startup JMP I TYPE /Return if echoing off, or 0 char TAD MCTZ /^Z? SNA /Skip if not TAD (215-232 /Convert to CR TAD (232-212 /Line feed SZA /Skip if it is ISZ TABCT /So we don't count LF in TABCT IAC /TAB? (211-212=-1 in AC) SNA /Skip if not JMP OUTTAB /Print the tab IAC /Backspace? SNA /Skip if not JMP BACK /Back up col. count BKDUP, TAD (210-215 /CR? SNA /Skip if not DCA TABCT /Zero tab count if CR TAD [215 /Repair other characters JMS I [TYPE2 /Actually print the character KSF /See if KBD has anything JMP I TYPE /return KRS /Read it static TAD (-223 /See if ^S SZA CLA /Skip on ^S JMP I TYPE /Return if not KCF /Clear flag KSF /Now wait for another JMP .-1 JMP I TYPE /return when we get it BACK, STA CLL RAL /AC=-2 TAD TABCT /Decrease col count DCA TABCT /By 2, since we ISZ'd already JMP BKDUP /Return ISZ TABCT /Bump tab count OUTTAB, TAD [240 /Load a SPACE code JMS I [TYPE2 /Type it TAD TABCT /Load tab count AND [7 /Test for tabstop SZA CLA /Skip when at tab stop JMP OUTTAB-1 /Try again JMP I TYPE /And exit PAGE /4200 if BSIZE=3 /Routine to write to output buffer in OS8 format PUTCHR, 0 SMA SZA /Skip if neg or zero DCA CHAR /Set character if it's in AC TAD CHAR /Load input character JMS I [TYPE /Print the character TAD PASS /Pass 0 SNA CLA /Skip if it not JMP I PUTCHR /Yes, then just return TAD THISCH /Load this character SNA /Skip if not 0 JMP WREXIT+1 /Or ignore it JMP I .+1 /Call co-routine WREXIT, WCH1 /Char 1 to start TAD CHAR /Get next character ready DCA THISCH /for next call JMP I PUTCHR JMS WREXIT /Exit WCH1, DCA I OBPTR /Store character for now JMS WREXIT /And exit DCA CHAR2 /Store second character JMS WREXIT /And exit RTL CLL /Move middle to byte boundary MQL;MQA /Store in MQ CLL RTL /Move to upper bits AND [7400 /Strip off lower 1/2 TAD I OBPTR /Complete word 1 DCA I OBPTR ISZ OBPTR /Increment pointer now MQA /Load back aligned word BSW /Lower 1/2 to upper bits AND [7400 /Strip off junk TAD CHAR2 /Load on second character DCA I OBPTR /Store it ISZ OBPTR /Second bump ISZ OUTCNT /Bump word count JMP WCH1-1 /Exit if buffer not full JMS WRBUF /Write output buffer JMP WCH1-1 /And exit WRBUF, 0 TAD OUTCNT /Load output count TAD (200^BSIZE /Subtract from buffer size SNA /Skip if anything in buffer JMP I WRBUF /Else just return AND (3700 /Remove junk DCA OUTTMP /Save this word CLA STL RAR /AC=4000: write function TAD OUTTMP /Add in page count DCA OUTF /Store in handler call TAD OUTBLK TAD RELBLK /Add relative block DCA HNDBLK /to make up this disk block TAD OUTTMP /Load number of output blocks BSW /Move to low bits CLL RAR /Divide by 2 SZL /Skip if even block IAC CLL /Round up if odd TAD RELBLK /Add to relative block # DCA RELBLK /Store away current file length CLL TAD OUTLEN TAD RELBLK /See if room for write SZL CLA /Skip if room for output file EROR10, JMS I [ERROR /FILE OVERFLOW JMS I OUTHND /Call output handler OUTF, 0 OUTBUF /Address of output buffer HNDBLK, .-. /Address of output block EROR09, JMS I [ERROR /Output error TAD (-200^BSIZE DCA OUTCNT /Set output word count TAD (OUTBUF DCA OBPTR /Set output buffer pointer JMP I WRBUF /Return RELBLK, 0 OUTBLK, 0 OUTTMP, 0 OUTCNT, -200^BSIZE CHAR2, 0 /Here to print referenced statement numbers DIRTY, DCA INDX 1 DCA INDX 4 DCA TABFLG TAD (SNA DCA ECHOSW /Enable echoing DCA PASS /Disable output DIRT, LOAD;INDX 1;STMTBL /Load a statement number DSNA /Skip if not terminator JMP WASH /Return to OS8 DSMA /Skip if referenced SKP JMP FILTH TAD INDX 4 /Header yet? SZA CLA JMP .+4 ISZ INDX 4 JMS PRINT GRIME LOAD;INDX 1 VSTMNX, 0 JMS OUTSTM JMS PRINT CRSEQ /CR code FILTH, ISZ INDX 1 JMP DIRT WASH, CIF 10 JMP PERM /Call to close output file PAGE /4400 if BSIZE=3 GRIME, TEXT x^^[UNUSED [S.[N.'S:^x CRSEQ, TEXT x^%x /Here for assign. If the first sig. character after an /assign is not a digit, then it is an error. ASSIGN, JMS SYMB /Determine if ASSIGN SSIGN-1 /Address of keyword JMS I [DIGIT /Test for legality ERR13, JMS I [ERROR /Error if not digit /Enter here to get last statement number, while turning off /pending operations LASTST, TAD [NEWLIN /Turn off pending operations DCA PEND JMP GETSTN /Get statement number & replace GOTO, JMS SYMB /Determine if GOTO OTO-1 /Address of KEYWORD TAD (-"( /Is it a parens SNA CLA /Skip if not JMP COMPUT /Computed GOTO CGTST, TAD CHAR /Reload character JMS I [DIGIT /See if a digit JMP I [NEWLIN /Assigned GOTO, or end COMP. GOTO JMP GETSTN /Regular GOTO, get STMT # COMPUT, TAD (CGTST /Set pending operation DCA PEND /Till the computed GOTO is finished ISZ EOLFLG /Force continuation check JMP CHRLP /Get the first statement # /"DO" is a bit funny. Variables starting with "DO" will mostly /be detected when we attempt to find a statement number since the /statement number decoder will return to PEND if it finds an /alphabetic character. However, a variable such as DO123 would /still be a problem, since the digits look like a statement number. /The compiler avoids such problems by compiling a line as an /arithmetic statement first, which would succeed, and DO123 would /never be tested as a keyword. We solve the problem here by making /any statement number which ends with either "=" or "(" as being /invalid, and thus not part of a DO statement. (See GETSTN) DO, JMS SYMB O-1 /See if really DO CLA CLL JMP LASTST /Get and replace statement # /Here for the IF statements IF, JMS SYMB F-1 /See if really IF /Loop here till the parentheses match. IFLOOP, JMS SIGNIF /Get next character JMS I [SORTJ /Sort the character -"(;DECCT -");INCCT 0 /real terminator necessary JMP IFLOOP /Dump all other characters PCOUNT, 0 /Count of unpaired parens DECCT, CLA CMA TAD PCOUNT /Decrement PARENS count DCA PCOUNT JMP IFLOOP /Keep going INCCT, ISZ PCOUNT /Count unpaired parens JMP IFLOOP /Till there are none JMP COMPUT /Merge with computed GOTO READ, JMS SYMB EAD-1 RW, ISZ EOLFLG /Force continuation check JMS PEND /Set pending operation address TAD CHAR /Load the current character RW2, JMS SIGNIF /Get next character JMS I [SORTJ /Look for possible characters -");RSTPND /End of R/W statement -",;FORMAT /Formatted read or END=,ERR= -"=;FORMAT /Statement # follows 0 /Must use real term. here JMP RW2 /All other characters ignored FORMAT, JMS SIGNIF /Get first char. of STMT # in CHAR TAD (-"E /Is it an "E" from END= or ERR= SZA CLA /Skip if it is JMP GETSTN /Get the statement # then JMP RW2 /Get next character WRITE, JMS SYMB /See if really WRITE RITE-1 JMP RW /Rest same as read RSTPND, TAD [NEWLIN /Reset NEWLIN DCA PEND /As pending op address JMP I [NEWLIN /And go there /Ignore leading spaces, and tabs. CR starts new line. SIGNIF, 0 SNA CLA /Skip fetching new character IGNR2, JMS I [COPY /Copy 1 to output, leave in CHAR JMS I [SORTJ /See what's in CHAR -211;IGNR2 /Ignore tabs -" ;IGNR2 /and spaces -215;TRAPCH /Start new line on CR TAD CHAR /Load character before exit JMP I SIGNIF TRAPCH, JMS EOLIN /Call EOLIN, setting continuation JMP IGNR2 /Keep testing characters /List of character strings for FORTRAN keywords which /take a statement number. SSIGN, -"S;-"S;-"I;-"G;-"N;0 OTO, -"O;-"T O, -"O;0 F, -"F;0 EAD, -"E;-"A;-"D;0 RITE, -"R;-"I;-"T;-"E;0 PAGE /4600 if BSIZE=3 OUTSTM, 0 TAD CHAR /Load next character DCA CHSAV /Save it (hasn't been used yet) DCA INDX /Zero index DCA INDX 5 TAD (SUPRES /Load zero suppression DCA OSRTN /Into co-routine link NXTDIG, CLA CMA /Start at -1 DCA CHAR /as output count DIVLP, STORE; TEMP2 /Store our number ISZ CHAR /Bump the character K260, "0 /Skip protection ADD;INDX;TENK /Subtract a number DSMA /Skip if minus JMP DIVLP /Divide loop LOAD; TEMP2 /Reload last value ISZ INDX /Next divide factor TAD CHAR /Load answer JMP I OSRTN /Call co-routine OSRTN, SUPRES JMP ASCIFY /Go print character SUPRES, SNA /Skip if it isn't JMP NXTDIG /Ignore leading 0's JMS OSRTN /Link in next section ASCIFY, TAD K260 /Add an ASCII "0" to digit JMS I [PUTCHR /Dump this character ISZ INDX 5 TAD INDX /Load current fact address TAD (-5 /See if last digit SZA CLA JMP NXTDIG /Do next digit /Here when statement number is finished. If the input statemtent /number terminated with any character but a space, we are finished. /If it ended with a space, we may need to insert one or more /spaces. The number depends on whether this was a reference or a /definition. If a reference, just output a single /space. If a definition, output a psuedo tab. We can play a simple /trick to determine what to do, since the input statement routine /has already stripped spaces and left TABFLG=-1 if a space terminated. TAD TABFLG /Load tab flag SNA CLA /Skip if space terminated JMP LEAVE /Exit TAD DFNFLG /Load stmt def. flag TAD (-ZAPCH /See if it's a definition SZA CLA /Skip if it is JMP ONESP /Do one space ISZ DFNFLG /Allow only one/line TAD INDX 5 /Load number of digits TAD (-10 /Characters to next tab stop DCA TABFLG /Set number of spaces ONESP, TAD [" /Load a space code JMS I [PUTCHR /Print the space ISZ TABFLG /Bump the count JMP ONESP /Loop if more to go LEAVE, TAD CHSAV /Replace the saved character DCA CHAR JMP I OUTSTM /Return now MSSG05, TEXT x^[CLOSE ERROR^%x MSSG07, TEXT x^[UNDEFINED SYMBOL^%x MSSG08, TEXT x^[INPUT ERROR^%x MSSG09, TEXT x^[OUTPUT ERROR^%x MSSG10, TEXT x^[FILE OVERFLOW^%x MSSG13, TEXT x^[ILLEGAL STATEMENT # IN DO OR ASSIGN^%x PAGE /5000 if BSIZE=3 /Routine to SORT input character and vector to an address /on a match. List of character address pairs follows the /call. List terminator may be any positive number, and /will be executed upon returning. This means TAD, ISZ /and DCA are OK as terminators, as are any small /constants which look like an AND instruction. SORTJ, 0 SZA /Skip if character already in CHAR DCA CHAR /Store character SJLOOP, TAD I SORTJ /Load first test SMA /Skip if not a terminator JMP SJEXIT /return ISZ SORTJ /Bump return TAD CHAR /See if match SNA CLA /Skip if not JMP JUMP /Take JUMP pathway ISZ SORTJ /Ignore address word JMP SJLOOP /Loop till terminator found JUMP, TAD I SORTJ /Load address DCA SORTJ /Save it SJEXIT, CLA CLL /Clear link (and AC) JMP I SORTJ /Take address branch SNTCHR="%&77 /Value of sentinel character CLFCHR="^&77 /Embedded CRLF character UCFCHR="[&77 /Uppercase flag character /Six bit printing routine. All characters are assumed to be lower /case unless preceeded by the upper case flag character. PRINT, 0 /Routine to unpack and print 6-bit ASCII SZA /Skip if AC=0 JMP ADINAC /Address in AC TAD I PRINT /Load address of message ISZ PRINT /Bump return address ADINAC, DCA PPTR /Save pointer to message /Flow through to initialize co-routine linkage. PRINT1, JMS PSUB /Go reset co-routine linkage BSW /Move upper byte down JMS PSUB /Set new co-routine link OUTXIT, ISZ PPTR /Bump pointer after byte 2 JMP PRINT1 /Loop back for first character PCRLF, TAD [215 /Do a CRLF here JMS I [TYPE2 TAD [212 JMS I [TYPE2 PBACK, TAD I PPTR /Load a word of messsage JMP I PSUB /Call co-routine PSUB, 0 /Returns using JMS to set co-routine AND [77 /Strip off unused byte SNA /Skip if null character JMP SETLC /Ignore nulls, but set flag below JMS SORTJ /Sort and JUMP -SNTCHR;PREXIT /Return on sentinel -CLFCHR;PCRLF /Test for imbedded CRLF -UCFCHR;SETUCF /Look for upper case flag TAD CHAR /Reload character TAD (-40 /Make non-alpha characters negative SPA /Skip if Non-alpha TAD UCF /Add 100 for upper case, 140 for lower TAD [240 /Convert all to 8-bit JMS TYPE2 /Type the character SETLC, TAD LOWER /Load 1st. 1/2 of UCF if lower case SETUCF, TAD (100 /Load only 2nd. half for upper case DCA UCF /Save result as upper case flag JMP PBACK /Back for more characters PREXIT, JMP I PRINT UCF, 140 /Value of flag is for lower case LOWER, 40 /Set to 0 if upper case only /Print regardless of pass number TYPE2, 0 TSF JMP .-1 TLS CLA CLL JMP I TYPE2 TENK, 4360;7775 /-10000 6030;7777 /-1000 7634;7777 /-100 7766;7777 /-10 7777;7777 /-1 /Routine to get characters from input line buffer INPLIN, 0 TAD I INPTR /Load next character ISZ INPTR DCA CHAR JMP I INPLIN LINEB, ZBLOCK 6 ERROR, 0 CLA CMA /AC=-1 TAD ERROR /Load error address TAD I ENUM /Compare to list SNA CLA /Skip if no match JMP GOTERR /Found it ISZ ENUM /Ignore unused message address JMP ERROR+1 /Try again GOTERR, TAD I ENUM /Load message address JMS PRINT /Print it JMP I (7605 /return to monitor, saving core. ELST, -EROR01;MSSG01 /Input handler -EROR02;MSSG02 /No output file -EROR03;MSSG03 /Output handler -EROR04;MSSG04 /Oper error -EROR05;MSSG05 /Close error -EROR06;MSSG06 /Mult. definition -EROR07;MSSG07 /Undefined symbol -EROR08;MSSG08 /Read error -EROR09;MSSG09 /Write error -EROR10;MSSG10 /File overflow -EROR11;MSSG11 /Symbol table overflow -EROR12;MSSG12 /No input file -ERR13;MSSG13 /Illegal statement number PAGE /5200 if BSIZE=3 STMTBL, ZBLOCK 7600-. /Room for table, assuming no handlers /Page 0 *0 INDX, ZBLOCK 10 *10 AINDX, 0 ENUM, ELST-1 *20 OBPTR, OUTBUF /Output buffer pointer EOLFLG, 0 /Zero means new line INTRCT, 0 /Interactive mode SLASHP, 0 /Gets echo-switch for /P CHAR, 0 COLUMN, 0 OUTLEN, 0 PEND, NEWLIN /Pending operation address JMP I PEND /So JMS's to here can SET address TEMP, 0;0 TEMP2, 0;0 INPUT, STMGCH INPTR, 0 LINCT, 0 OUTHND, 0 INHND, 0 DBLELO, 0 DBLEHI, 0 PASS, 0 PPTR, 0 THISCH, 0 /Char N-1 in here LAST, 132;0 /Default last statement # TEN, 12;0 /Auto-statment increment MAXSTM, 0 CHSAV, 0 TABFLG, -10 /Psuedo-tab count FIELD 1 *2000 / PAGE 12000 CDFLAG, 0 FILEIO, DCA CDFLAG /If NEG, do CD; if 0, do not. JMS I (7700 10 /Load USR TAD CDFLAG SMA CLA;JMP NOCD /If 0, skip the Command Decode. JMS I (200 /Call USR in field 1 5 /Decode FTEX, 0624 /".FT" assumed input extension 0 NOCD, TAD I (7617 /Load device number SNA /Skip if input file specified EROR12, JMS ERROR1 /NO INPUT FILE JMS HNDLIN /Get handler in EROR01, JMS ERROR1 /Handler load error DCA I (INHND /Store handler address CDF 10 TAD I (7600 /Load output device number SNA /Skip if device specified EROR02, JMS ERROR1 /Otherwise it's an error JMS HNDLIN /Get the handler DF 0 on return EROR03, JMS ERROR1 /call error processor DCA I (OUTHND /Store this too /Now get the handler entry point which is lowest in memory /so we can properly calculate the size of the tables. TAD I (OUTHND /Load the second entry point. TAD (-7607 /See if SYS SZA CLA /Skip if SYS JMP NOTSYS /If not SYS, second entry is lowest TAD I (INHND /Load other handler entry point SKP /Skip to calculate size of STMTBL NOTSYS, TAD I (OUTHND /Reload second handler entry point AND (7600 /Get page only TAD (-STMTBL /Compute room CLL RAR /Divide by CLL RAR /4, the hard way CIA /Neg DCA I (MAXSTM /Store max. number of symbols TAD I (MAXSTM /Load it CIA /Make POS CLL RAL /Times 2 TAD (STMTBL /Add to STMTBL address DCA I (VTSET1 /Store address of value table TAD I (VTSET1 DCA I (VTSET2 /intwo places TAD I (VTSET1 DCA I (VSTMNX CDF 10 /Do up the slash options TAD I (7643 /Get slash I AND (10 /Remove others CDF 0 DCA I (INTRCT /Set interactive flag TAD I (INTRCT /reload it SZA CLA /Skip if not set TAD (SNA-CLA /Load value for ECHOSW TAD (CLA /CLA for off, SNA for on DCA I (ECHOSW /Set echo switch for pass 0 CDF 10 TAD I (7644 /Load /P word AND (400 /Extract option bit SZA CLA /Skip if not set TAD (SNA-CLA /Load value for pass 2 echoing TAD (CLA /CLA for OFF, SNA for ON CDF 0 DCA I (SLASHP /Store on page 0, field 0 CDF 10 TAD (7601 DCA FRSTB /Store file name address /Define default output extension TAD I (7604 /Load extension SNA /Skip if not 0 TAD FTEX /Load ".FT" if no extension DCA I (7604 /replace it TAD I (7600 /Load device number JMS I (200 /Call usr 3 /ENTER FRSTB, 7601 /File at 7600 field 1 MAXLEN, 0 /returned output length EROR04, JMS ERROR1 /call error processor TLS /Reset after command decode TAD MAXLEN CIF 0 /Set IF and DF JMP I (START2 /And continue prog PERM, TAD I (RELBLK DCA FINLEN CDF 10 TAD I (7600 /Load device number JMS I (200 /Call USR 4 /Close permanent file 7601 /File name at 7600 FINLEN, 0 /Final output length EROR05, JMS ERROR1 CDF CIF 0 JMP I (7600 /Return to OS8 ERROR1, 0 /Roundabout call to ERROR TAD ERROR1 CDF CIF 0 DCA I (ERROR JMP I (ERROR+1 SLASHI, 0 /Temp to store /I switch PAGE /12200 /Routine to stack 2 handlers in memory, using the least space. /The 7600 bits of SLOT are always the page of the last handler /loaded, starting with SYS, since SYS is always resident. /From there we back up one page at a time until we have both /handlers in. /Note, that if this routine is called more than twice, /or if one of the handlers are already loaded at some other address, /the routine may get very confused, usually with disasterous results! HNDLIN, 0 DCA DN /Save device number TAD SLOT /Load last handler address AND (7600 /Only page bits LOAD2P, TAD (7600 /Back up a page DCA SLOT /Next possible handler address TAD DN /Load device number JMS I (200 /and call USR 1 /to fetch the handler SLOT, 7600 /Stuff with next available slot. JMP TPAGE /Can't load handler ISZ HNDLIN /Bump return meaning success TAD SLOT /Load entry point CDF 0 /Set data field 0 JMP I HNDLIN /return TPAGE, TAD SLOT /Load unsuccessful load address RAR CLL /See if bit 11 SZL CLA /indicating we tried a 2 PAGE JMP I HNDLIN /return, ERROR CLA IAC /Force 2 page bit TAD SLOT /Load old address JMP LOAD2P /Try loading 2 page handler DN, 0 /TEMP for device number