systemheader:(RFT )# Start of rftidy macros RFT 1 ##*****************************************************************## RFT 2 ## ## RFT 3 ## RFTIDY ## RFT 4 ## ## RFT 5 ##*****************************************************************## RFT 6 # RFT 7 macro:(head:,' RFT --- Ratmac Tidier (3.2/Oct92) ')# RFT 8 # RFT 9 macro:(linid:,no:)# Include line tags (col73-80) RFT 10 # RFT 11 macro:(lst:, 6)# Error device for errors RFT 12 macro:(inp:,11)# Old input ratmac source RFT 13 macro:(out:,12)# New output ratmac source RFT 14 # RFT 15 macro:(openi:,OPEN(inp:,FILE='RFTOLD',# Open input file RFT 16 STATUS='OLD');REWIND(out:))# RFT 17 macro:(openo:,OPEN(out:,FILE='RFTNEW',# Open output file RFT 18 STATUS='NEW');REWIND(out:))# RFT 19 macro:(openl:,OPEN(lst:))# Open list file RFT 20 macro:(close:,CLOSE($1))# Close file RFT 21 # RFT 22 macro:(itoc:,[CALL CHRINT($1,$2,$3,$4,$5,1)])# General ctoi subr. RFT 23 # RFT 24 macro:(read:,READ(inp:,'(A)',END=$2)$1)# Read input device RFT 25 macro:(write:,WRITE($1,'(A)')$2(1^$3))# Write output RFT 26 macro:(list:,WRITE(lst:,'(A)')$1)# List messages RFT 27 # RFT 28 systemheader:(TIDY)# Tidy-up ratmac source code TIDY 1 #******************************************************************** TIDY 2 # * TIDY 3 # RFTIDY * TIDY 4 # * TIDY 5 #******************************************************************** TIDY 6 PROGRAM RFTIDY# S.r.hall june 85 TIDY 7 # TIDY 8 CHARACTER*1 C,D,BSL# Single character TIDY 9 CHARACTER*80 IBUF,OBUF,EBUF# Input/output buffers TIDY 10 CHARACTER*32 ERR1,ERR2,ERR3,ERR4# Error message buffers TIDY 11 CHARACTER*32 ERR5,ERR6# Error message buffers TIDY 12 CHARACTER*35 HEAD# Program header line TIDY 13 CHARACTER*4 PROG# Program name string TIDY 14 CHARACTER*4 STRG# String for comparison TIDY 15 CHARACTER*8 TEMP# Temporary number chars TIDY 16 INTEGER BRCSTK(50)# Brace level stack TIDY 17 INTEGER CONT# Statement continue flag TIDY 18 INTEGER CASE# Case conversion number TIDY 19 INTEGER FCO# Pointer first comment char TIDY 20 INTEGER FNB# Pointer first non-blk char TIDY 21 INTEGER FSH# Pointer first sharp char TIDY 22 INTEGER I,J,K,N# Working integers TIDY 23 INTEGER IFFG# Active else/if flag TIDY 24 INTEGER JFFG# Active else/if flag TIDY 25 INTEGER KEY# Double sharp comment flag TIDY 26 INTEGER LIC# Pointer last instruct char TIDY 27 INTEGER LNB# Pointer last non-blk char TIDY 28 INTEGER LBRF,RBRF# Left and right brace flags TIDY 29 INTEGER MAC# Macro name l/s signal TIDY 30 INTEGER NB# Number of braces TIDY 31 INTEGER NL# Number of brace levels TIDY 32 INTEGER NP# Number of parenthesis levels TIDY 33 INTEGER NS# Square bracket count TIDY 34 INTEGER PLIN# Input program line count TIDY 35 INTEGER RFLG# Rejection signal TIDY 36 INTEGER TLIN# Input total line count TIDY 37 INTEGER QFLG# '....' string signal TIDY 38 INTEGER XFLG# "...." string signal TIDY 39 DATA HEAD/head:/# TIDY 40 DATA ERR1/' Too many RIGHT braces LINE '/# TIDY 41 DATA ERR2/' Too many LEFT braces LINE '/# TIDY 42 DATA ERR3/' Active code > Col.71 LINE '/# TIDY 43 DATA ERR4/' Too many RIGHT paren.s LINE '/# TIDY 44 DATA ERR5/' Too many LEFT paren.s LINE '/# TIDY 45 DATA ERR6/' Square brack imbalance LINE '/# TIDY 46 DATA TEMP/' '/,PROG/' '/# TIDY 47 DATA NS,NP,NB,NL,CONT,PLIN,TLIN,RFLG/0,0,0,0,0,0,0,0/# TIDY 48 # TIDY 49 # TIDY 50 openi:; openo:; openl:# Open i/o files TIDY 51 IFFG=no:; JFFG=no:# Set packed buffer pointer TIDY 52 BSL='\\'# Store backslash character TIDY 53 CASE=ICHAR('a')-ICHAR('A')# Set case conversion number TIDY 54 XFLG=-1# Set quote string flag TIDY 55 list:(HEAD)# Print program header TIDY 56 # TIDY 57 # LOOP OVER ALL SOURCE LINES TIDY 58 # -------------------------- TIDY 59 # TIDY 60 REPEAT# Loop over all source lines TIDY 61 $(# 0>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1 TIDY 62 #*************** TIDY 63 read:(IBUF,100)# Read line/ if eof goto 100 TIDY 64 #************** TIDY 65 PLIN=PLIN+1; TLIN=TLIN+1# Count each source line TIDY 66 LBRF=no:; RBRF=no:# Reset brace flags TIDY 67 # TIDY 68 # SKIP PROCESSING IF FLAGON:(R) ACTIVE TIDY 69 # ------------------------------------ TIDY 70 # TIDY 71 IF(IBUF(7^10)==':(R)') RFLG=yes:# Set reject flag TIDY 72 IF(RFLG==yes:)# Is flagon:(r) active TIDY 73 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 TIDY 74 IF(IBUF(8^11)==':(R)') RFLG=no:# Test for flagoff:(r) TIDY 75 write:(out:,IBUF,80)# Output source file TIDY 76 NEXT# Skip to next i/p line TIDY 77 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 2 TIDY 78 LNB=0; FNB=81; FSH=81; MAC=no:# Reset character indices TIDY 79 LIC=0; FCO=81; KEY=81# Reset character indices TIDY 80 QFLG=-1; N=0; D=' '# String '....' signal TIDY 81 OBUF(1^)=' '# Blank fill buffer TIDY 82 # TIDY 83 # MOVE INPUT BUFFER TO EXPANSION BUFFER TIDY 84 # ==================================== TIDY 85 # TIDY 86 FOR(I=1; I<=72; I=I+1)# Loop over input buffer TIDY 87 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 3 TIDY 88 C=IBUF(I^)# Get ip char TIDY 89 IF(linid:==yes:&C=='^'&IBUF(I+1^I+1)=='^')# Test for update flags TIDY 90 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 4 TIDY 91 C=' '; IBUF(I+1^I+1)=' '# Blank out update character TIDY 92 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 4 TIDY 93 N=N+1; EBUF(N^N)=C# Get incr op counter & store ch TIDY 94 IF(C==' ') NEXT# Skip blank characters TIDY 95 IF(FNB>80) FNB=N# Save index of first non-blan TIDY 96 IF(N80&(C>='a'&C<='z')&XFLG!=yes:)# Is case change needed TIDY 104 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 5 TIDY 105 C=CHAR(ICHAR(C)-CASE)# Convert l/c to u/c alpha TIDY 106 EBUF(N^N)=C# Transfer ip character TIDY 107 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 5 TIDY 108 # TIDY 109 # PROCESS ACTIVE CODE TIDY 110 # ------------------- TIDY 111 # TIDY 112 IF(N TIDY 113 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 6 TIDY 114 IF((C>='A'&C<='I')\$# Test if l/c character TIDY 115 (C>='J'&C<='R')\$# Test if l/c character TIDY 116 (C>='S'&C<='Z'))# Test if l/c character TIDY 117 $(# 3>>>>>>>>>>>>>>>>>>>>>>>>>>>> 7 TIDY 118 IF(IFFG==no:)# If else/if flag is off TIDY 119 $(# 4>>>>>>>>>>>>>>>>>>>>>>>>>>>> 8 TIDY 120 IF(IBUF(I^I+2)=='IF ' \$# Test for if code TIDY 121 IBUF(I^I+2)=='IF(' ) IFFG=yes:# Test for if code TIDY 122 $)# 4<<<<<<<<<<<<<<<<<<<<<<<<<<<< 8 TIDY 123 ELSE IF(JFFG==yes:)# Switch off else/if flag TIDY 124 $(# 4>>>>>>>>>>>>>>>>>>>>>>>>>>>> 9 TIDY 125 JFFG=no:; IFFG=no:# Reset else/if connection TIDY 126 $)# 4<<<<<<<<<<<<<<<<<<<<<<<<<<<< 9 TIDY 127 $)# 3<<<<<<<<<<<<<<<<<<<<<<<<<<<< 7 TIDY 128 ELSE IF(D=='$')# Test for digraph char TIDY 129 $(# 3>>>>>>>>>>>>>>>>>>>>>>>>>>>> 10 TIDY 130 IF(C=='(')# Test for left brace TIDY 131 $(# 4>>>>>>>>>>>>>>>>>>>>>>>>>>>> 11 TIDY 132 NB=NB+1; NL=NL+1# Incr brace and level count TIDY 133 BRCSTK(NL)=NB# Push down brace stack TIDY 134 $)# 4<<<<<<<<<<<<<<<<<<<<<<<<<<<< 11 TIDY 135 ELSE IF(C==')') NL=NL-1# Decr level count TIDY 136 $)# 3<<<<<<<<<<<<<<<<<<<<<<<<<<<< 10 TIDY 137 ELSE# Not part of digraph TIDY 138 $(# 3>>>>>>>>>>>>>>>>>>>>>>>>>>>> 12 TIDY 139 IF (C=='(') NP=NP+1# Incr parenth counter TIDY 140 ELSE IF(C==')')# Test right parenth TIDY 141 $(# 4>>>>>>>>>>>>>>>>>>>>>>>>>>>> 13 TIDY 142 NP=NP-1# Decr parenth counter TIDY 143 IF(NP==0 & IFFG==yes:) JFFG=yes:# Else/if complete TIDY 144 $)# 4<<<<<<<<<<<<<<<<<<<<<<<<<<<< 13 TIDY 145 ELSE IF(C=='{')# Test left brace TIDY 146 $(# 4>>>>>>>>>>>>>>>>>>>>>>>>>>>> 14 TIDY 147 NB=NB+1; NL=NL+1# Incr brace and level count TIDY 148 BRCSTK(NL)=NB; LBRF=yes:# Push down brace stack TIDY 149 $)# 4<<<<<<<<<<<<<<<<<<<<<<<<<<<< 14 TIDY 150 ELSE IF(C=='}')# Decr brace level count TIDY 151 $(# 4>>>>>>>>>>>>>>>>>>>>>>>>>>>> 15 TIDY 152 NL=NL-1; RBRF=yes:# Decr brace level count TIDY 153 $)# 4<<<<<<<<<<<<<<<<<<<<<<<<<<<< 15 TIDY 154 ELSE IF(C=='[') NS=NS+1# Incr square bracket count TIDY 155 ELSE IF(C==']') NS=NS-1# Decr square bracket count TIDY 156 # TIDY 157 # CONVERT RELATIONAL CODE TIDY 158 # ----------------------- TIDY 159 # TIDY 160 ELSE IF(C=='.' & NS==0)# Test for log. relations TIDY 161 $(# 4>>>>>>>>>>>>>>>>>>>>>>>>>>>> 16 TIDY 162 STRG=IBUF(I^)# Store string for compare TIDY 163 IF(STRG=='.LT.')# Test if less than TIDY 164 $(# 5>>>>>>>>>>>>>>>>>>>>>>>>>>>> 17 TIDY 165 EBUF(N^N)='<'# Replace with '<' TIDY 166 I=I+3# Incr input buffer TIDY 167 $)# 5<<<<<<<<<<<<<<<<<<<<<<<<<<<< 17 TIDY 168 ELSE IF(STRG=='.GT.')# Test if greater than TIDY 169 $(# 5>>>>>>>>>>>>>>>>>>>>>>>>>>>> 18 TIDY 170 EBUF(N^N)='>'# Replace with '>' TIDY 171 I=I+3# Incr input buffer TIDY 172 $)# 5<<<<<<<<<<<<<<<<<<<<<<<<<<<< 18 TIDY 173 ELSE IF(STRG=='.LE.')# Test if less than or = TIDY 174 $(# 5>>>>>>>>>>>>>>>>>>>>>>>>>>>> 19 TIDY 175 EBUF(N^N+1)='<='# Replace with '<=' TIDY 176 I=I+3; N=N+1# Incr input buffer TIDY 177 $)# 5<<<<<<<<<<<<<<<<<<<<<<<<<<<< 19 TIDY 178 ELSE IF(STRG=='.GE.')# Test if great than or = TIDY 179 $(# 5>>>>>>>>>>>>>>>>>>>>>>>>>>>> 20 TIDY 180 EBUF(N^N+1)='>='# Replace with '>=' TIDY 181 I=I+3; N=N+1# Incr input buffer TIDY 182 $)# 5<<<<<<<<<<<<<<<<<<<<<<<<<<<< 20 TIDY 183 ELSE IF(STRG=='.EQ.')# Test if equal TIDY 184 $(# 5>>>>>>>>>>>>>>>>>>>>>>>>>>>> 21 TIDY 185 EBUF(N^N+1)='=='# Replace with '==' TIDY 186 I=I+3; N=N+1# Incr input buffer TIDY 187 $)# 5<<<<<<<<<<<<<<<<<<<<<<<<<<<< 21 TIDY 188 ELSE IF(STRG=='.NE.')# Test if not equal TIDY 189 $(# 5>>>>>>>>>>>>>>>>>>>>>>>>>>>> 22 TIDY 190 EBUF(N^N+1)='!='# Replace with '!=' TIDY 191 I=I+3; N=N+1# Incr input buffer TIDY 192 $)# 5<<<<<<<<<<<<<<<<<<<<<<<<<<<< 22 TIDY 193 ELSE IF(STRG=='.OR.')# Test if or TIDY 194 $(# 5>>>>>>>>>>>>>>>>>>>>>>>>>>>> 23 TIDY 195 EBUF(N^N)=BSL# Replace with backslash '\' TIDY 196 I=I+3# Incr input buffer TIDY 197 $)# 5<<<<<<<<<<<<<<<<<<<<<<<<<<<< 23 TIDY 198 ELSE IF(STRG=='.AND')# Test if and TIDY 199 $(# 5>>>>>>>>>>>>>>>>>>>>>>>>>>>> 24 TIDY 200 EBUF(N^N)='&'# Replace with '&' TIDY 201 I=I+4# Incr input buffer TIDY 202 $)# 5<<<<<<<<<<<<<<<<<<<<<<<<<<<< 24 TIDY 203 ELSE IF(STRG=='.NOT')# Test if not TIDY 204 $(# 5>>>>>>>>>>>>>>>>>>>>>>>>>>>> 25 TIDY 205 EBUF(N^N)='!'# Replace with '!' TIDY 206 I=I+4# Incr input buffer TIDY 207 $)# 5<<<<<<<<<<<<<<<<<<<<<<<<<<<< 25 TIDY 208 $)# 4<<<<<<<<<<<<<<<<<<<<<<<<<<<< 16 TIDY 209 $)# 3<<<<<<<<<<<<<<<<<<<<<<<<<<<< 12 TIDY 210 IF(NP<0)# Test for parenth imbalance TIDY 211 $(# 3>>>>>>>>>>>>>>>>>>>>>>>>>>>> 26 TIDY 212 itoc:(TLIN,ERR4,29,32,K)# Insert line number TIDY 213 list:(ERR4)# Print error message TIDY 214 NP=0# Reset parenth count TIDY 215 $)# 3<<<<<<<<<<<<<<<<<<<<<<<<<<<< 26 TIDY 216 LIC=N# Save index of last instr cha TIDY 217 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 6 TIDY 218 # TIDY 219 # TEST FOR END OF ACTIVE CODE TIDY 220 # --------------------------- TIDY 221 # TIDY 222 ELSE IF(C=='#')# Test for active sharp TIDY 223 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 27 TIDY 224 IF(I>4)# Test for else/if TIDY 225 IF(IBUF(I-4^I-1)=='ELSE') JFFG=yes:# Set else/if connection TIDY 226 IF(FSH>80) FSH=N# Is this first sharp TIDY 227 IF(KEY>80&IBUF(I^I+1)=='##') KEY=N# Flag double sharp comment TIDY 228 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 27 TIDY 229 ELSE IF(FCO>80 & N>FSH) FCO=N# Save index to first com char TIDY 230 LNB=N; D=C# Save index of last non-blank TIDY 231 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 3 TIDY 232 # TIDY 233 I=N+1# Point next character TIDY 234 IF(I<73) EBUF(I^72)=OBUF(I^)# Blank vacated area TIDY 235 IF(EBUF(1^13)=='SYSTEMHEADER:')# Test for top of prog TIDY 236 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 28 TIDY 237 PLIN=1; NL=0; NB=0# Reset sequence count TIDY 238 PROG=IBUF(15^)# Store program name TIDY 239 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 28 TIDY 240 IF(CONT==1) FNB=1# Reset first non-bl for cont TIDY 241 # TIDY 242 # APPLY LOWER CASE CONVERSIONS TIDY 243 # ---------------------------- TIDY 244 # TIDY 245 QFLG=-1# Reset '...' string signal TIDY 246 J=MIN0(KEY,LNB)# Get lower case limit TIDY 247 IF(FSH>1 \ FCO>39)# For lines with active code TIDY 248 FOR(I=J; I>=FNB; I=I-1)# Scan non-blank characters TIDY 249 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 29 TIDY 250 C=EBUF(I^)# Extract current character TIDY 251 IF(MAC==yes:\I>FCO)# Is this a macro name TIDY 252 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 30 TIDY 253 IF((C>='A'&C<='I')\$# Test if l/c character TIDY 254 (C>='J'&C<='R')\$# Test if l/c character TIDY 255 (C>='S'&C<='Z'))# Test if l/c character TIDY 256 EBUF(I^I)=CHAR(ICHAR(C)+CASE)# Insert l/c alphabetic TIDY 257 ELSE IF(C<'0'\C>'9') MAC=no:# Reset when not macro TIDY 258 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 30 TIDY 259 IF(C==':'&I<=LIC&QFLG!=yes:) MAC=yes:# Start of macro name TIDY 260 ELSE IF(C=='''' & I>>>>>>>>>>>>>>>>>>>>>>>>>>> 31 TIDY 268 OBUF(73^76)=PROG# Insert program name TIDY 269 itoc:(PLIN,TEMP,4,8,J)# Convert int to char digits TIDY 270 IF(J<5) OBUF(77^80)=TEMP(J^)# Insert sequence number TIDY 271 ELSE OBUF(76^80)=TEMP(4^)# Insert 5-digit seq number TIDY 272 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 31 TIDY 273 ELSE OBUF(73^80)=IBUF(73^)# Save previous line id TIDY 274 # TIDY 275 # TRANSFER FULL LINE COMMENT TIDY 276 # -------------------------- TIDY 277 # TIDY 278 IF(FSH==1)# Test if comment starts col.1 TIDY 279 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 32 TIDY 280 J=MIN0(71,LNB)# Get length of comment string TIDY 281 OBUF(1^J)=EBUF(1^)# Transfer comment line TIDY 282 IF(NP>0)# Tell user of paren. error TIDY 283 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 33 TIDY 284 itoc:(TLIN,ERR5,29,32,I)# Insert line number TIDY 285 list:(ERR5)# Print error message TIDY 286 NP=0# Reset parenth count TIDY 287 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 33 TIDY 288 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 32 TIDY 289 # TIDY 290 # TIDY 291 # PROCESS STATEMENT BLOCK DELIMITORS $( $) TIDY 292 # ------------------------------------------- TIDY 293 # TIDY 294 ELSE IF(EBUF(1^1)=='$' & LIC==2)# Test for braces $( & $) TIDY 295 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 34 TIDY 296 IF(EBUF(2^2)=='(')# If left brace then TIDY 297 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 35 TIDY 298 OBUF(40^69)='>>>>>>>>>>>>>>>>>>>>>>>>>>>>> '# Mark top of statement TIDY 299 itoc:(NB,OBUF,70,72,I)# Insert brace count TIDY 300 itoc:(NL-1,OBUF,40,40,I)# Insert level TIDY 301 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 35 TIDY 302 ELSE IF(EBUF(2^2)==')')# Else if left brace then TIDY 303 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 36 TIDY 304 OBUF(40^69)='<<<<<<<<<<<<<<<<<<<<<<<<<<<<< '# Mark bot of statement TIDY 305 itoc:(BRCSTK(NL+1),OBUF,70,72,I)# Insert brace count TIDY 306 itoc:(NL,OBUF,40,40,I)# Insert level TIDY 307 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 36 TIDY 308 OBUF(1^2)=EBUF(1^)# Move braces to output TIDY 309 OBUF(3^3)='#'# Insert end sharp TIDY 310 IF(NL<0)# Tell user of brace error TIDY 311 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 37 TIDY 312 itoc:(TLIN,ERR1,29,32,I)# Insert line number TIDY 313 list:(ERR1)# Print error message TIDY 314 NL=0# Reset sequence count TIDY 315 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 37 TIDY 316 IF(NP>0)# Tell user of paren. error TIDY 317 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 38 TIDY 318 itoc:(TLIN,ERR5,29,32,I)# Insert line number TIDY 319 list:(ERR5)# Print error message TIDY 320 NP=0# Reset parenth count TIDY 321 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 38 TIDY 322 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 34 TIDY 323 # TIDY 324 # PROCESS STATEMENT TIDY 325 # --------------------- TIDY 326 # TIDY 327 ELSE IF(LIC==3 & EBUF(1^3)=='END')# Test for end statement TIDY 328 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 39 TIDY 329 IF(NL>0)# Tell user of brace error TIDY 330 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 40 TIDY 331 itoc:(TLIN,ERR2,29,32,I)# Insert line number TIDY 332 list:(ERR2)# Print error message TIDY 333 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 40 TIDY 334 IF(NS!=0)# Tell user of bracket error TIDY 335 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 41 TIDY 336 itoc:(TLIN,ERR6,29,32,I)# Insert line number TIDY 337 list:(ERR6)# Print error message TIDY 338 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 41 TIDY 339 NP=0; NL=0; NB=0; NS=0# Reset brace/parenth levels TIDY 340 OBUF(1^4)='END#'# Insert 'end' line TIDY 341 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 39 TIDY 342 # TIDY 343 # OUTPUT ALL OTHER STATEMENTS TIDY 344 # -------------------------- TIDY 345 # TIDY 346 ELSE# Process all other lines TIDY 347 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 42 TIDY 348 J=LIC-FNB+1; K=J+1# Get length of active code TIDY 349 IF(J>0)# Test active code present TIDY 350 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 43 TIDY 351 IF(J>71)# Tell user if line too long TIDY 352 $(# 3>>>>>>>>>>>>>>>>>>>>>>>>>>>> 44 TIDY 353 itoc:(TLIN,ERR3,29,32,I)# Insert line number TIDY 354 list:(ERR3)# Print error message TIDY 355 J=71# Reset code length TIDY 356 $)# 3<<<<<<<<<<<<<<<<<<<<<<<<<<<< 44 TIDY 357 OBUF(1^J)=EBUF(FNB^)# Move active code to buffer TIDY 358 OBUF(K^K)='#'# Append sharp to code TIDY 359 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 43 TIDY 360 ELSE OBUF(1^1)='#'# Put hash in col. 1 TIDY 361 IF(KEY<81)# When double hash no realign TIDY 362 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 45 TIDY 363 OBUF(KEY^(KEY+1))='##'# Output twin sharps TIDY 364 K=KEY+3# Point to start of comment TIDY 365 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 45 TIDY 366 ELSE IF(J<38) K=40# Test if comment hash require TIDY 367 ELSE K=J+3# Set comment start beyond act TIDY 368 J=MIN0(70-K,LNB-FCO+1)-1# Calc length of comment TIDY 369 IF(J>=0) OBUF(K^K+J)=EBUF(FCO^)# Move comment to buffer TIDY 370 IF(EBUF(LIC^LIC)=='$'&LIC==FSH-1)CONT=1# Test for continuation TIDY 371 ELSE CONT=0# No continuation TIDY 372 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 42 TIDY 373 # TIDY 374 # PROCESS BRACE OCCURENCES TIDY 375 # ------------------------ TIDY 376 # TIDY 377 IF(LBRF+RBRF>0)# Are braces encountered TIDY 378 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 46 TIDY 379 IF(LBRF==yes:)# Has left brace occurred TIDY 380 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 47 TIDY 381 OBUF(68^72)='>>>>>'# Mark top of statement TIDY 382 itoc:(NB,OBUF,71,72,I)# Insert brace count TIDY 383 ###itoc:(NL-1,OBUF,72,72,I)# Insert level TIDY 384 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 47 TIDY 385 IF(RBRF==yes:)# Has right brace occurred TIDY 386 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 48 TIDY 387 OBUF(68^72)='<<<<<'# Mark bot of statement TIDY 388 itoc:(BRCSTK(NL+1),OBUF,71,72,I)# Insert brace count TIDY 389 ###itoc:(NL,OBUF,72,72,I)# Insert level TIDY 390 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 48 TIDY 391 IF(NL<0)# Tell user of brace error TIDY 392 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 49 TIDY 393 itoc:(TLIN,ERR1,29,32,I)# Insert line number TIDY 394 list:(ERR1)# Print error message TIDY 395 NL=0# Reset sequence count TIDY 396 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 49 TIDY 397 IF(NP>0)# Tell user of paren. error TIDY 398 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 50 TIDY 399 itoc:(TLIN,ERR5,29,32,I)# Insert line number TIDY 400 list:(ERR5)# Print error message TIDY 401 NP=0# Reset parenth count TIDY 402 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 50 TIDY 403 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 46 TIDY 404 # TIDY 405 # WRITE THE OUTPUT BUFFER TIDY 406 # ------------------------ TIDY 407 # TIDY 408 DO I=80,1,-1; IF(OBUF(I^I)!=' ')BREAK# Find last non-blank TIDY 409 write:(out:,OBUF,I)# Print the formated line TIDY 410 $)# 0<<<<<<<<<<<<<<<<<<<<<<<<<<<< 1 TIDY 411 100 CONTINUE# TIDY 412 close:(inp:); close:(out:); close:(lst:)# Close all files TIDY 413 STOP# TIDY 414 END# TIDY 415 systemheader:(CHRINT)# Char-to-int and reverse CHRI 1 #******************************************************************** CHRI 2 # * CHRI 3 # CHRINT * CHRI 4 # * CHRI 5 #******************************************************************** CHRI 6 SUBROUTINE CHRINT(INT,STRING,TOP,BOT,LEN,KEY)# CHRI 7 # S.r. hall 1985 CHRI 8 CHARACTER STRING*80,DIGIT*13,BLANK*10,C# CHRI 9 INTEGER POWER(9)# CHRI 10 INTEGER INT,TOP,BOT,LEN,KEY# CHRI 11 INTEGER I,J,K,L,M,N# CHRI 12 DATA BLANK/' '/,DIGIT/'0123456789+-*'/# CHRI 13 DATA POWER/1,10,100,1000,10000,100000,1000000,10000000,100000000/# CHRI 14 # CHRI 15 IF(KEY==0)# Test for c-to-i function CHRI 16 $(# 0>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1 CHRI 17 LEN=0; INT=0# Zero length and integer CHRI 18 DO I=BOT,TOP,-1# Loop over char string CHRI 19 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 2 CHRI 20 C=STRING(I^I)# Extract current character CHRI 21 FOR(J=1; J<=12; J=J+1)# Loop over digit string CHRI 22 IF(C==DIGIT(J^J)) BREAK# Exit on match CHRI 23 IF(J==12) INT=-INT# Negative integer CHRI 24 IF(J>10) NEXT# Ignore no digits CHRI 25 LEN=LEN+1# Incr length counter CHRI 26 INT=INT+POWER(LEN)*(J-1)# Incr integer CHRI 27 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 2 CHRI 28 $)# 0<<<<<<<<<<<<<<<<<<<<<<<<<<<< 1 CHRI 29 # CHRI 30 ELSE# This is i-to-c function CHRI 31 $(# 0>>>>>>>>>>>>>>>>>>>>>>>>>>>> 3 CHRI 32 STRING(TOP^BOT)=BLANK# Blank out string CHRI 33 IF(INT==0)# Test for zero integer CHRI 34 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 4 CHRI 35 STRING(TOP^TOP)=DIGIT(1^)# Insert zero character CHRI 36 LEN=1# Set string length CHRI 37 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 4 CHRI 38 ELSE# Integer is non-zero CHRI 39 $(# 1>>>>>>>>>>>>>>>>>>>>>>>>>>>> 5 CHRI 40 LEN=TOP; N=IABS(INT)# Zero length & local integer CHRI 41 M=N; L=BOT-TOP+1# Integer magnitude & length CHRI 42 IF(INT<0)# Test if negative CHRI 43 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 6 CHRI 44 STRING(TOP^TOP)=DIGIT(12^)# Insert negative CHRI 45 LEN=LEN+1# Incr string length CHRI 46 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 6 CHRI 47 DO I=L,1,-1# Loop over integer powers CHRI 48 $(# 2>>>>>>>>>>>>>>>>>>>>>>>>>>>> 7 CHRI 49 IF(M9) K=12# Test for overflow CHRI 52 STRING(LEN^LEN)=DIGIT(K+1^)# Store single digit CHRI 53 LEN=LEN+1# Incr length counter CHRI 54 $)# 2<<<<<<<<<<<<<<<<<<<<<<<<<<<< 7 CHRI 55 LEN=LEN-TOP# Get length of string CHRI 56 $)# 1<<<<<<<<<<<<<<<<<<<<<<<<<<<< 5 CHRI 57 $)# 0<<<<<<<<<<<<<<<<<<<<<<<<<<<< 3 CHRI 58 RETURN# CHRI 59 END# CHRI 60 endsel:# CHRI 61