EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 2 1 .TITLE EVAL -- LINE EVALUATION ROUTINES 2 .IDENT /V02/ 3 ; ;RLB001 4 ; NO. DATE AUTHOR MODIFICATION ;RLB001 5 ; --- ---- ------ ------------ ;RLB001 6 ; 001 5-APR-77 REID L BROWN ADDED RSX/IAS SUPPORT VIA CONDITIONALS ;RLB001 7 ; 002 30-OCT-79 GARY L MAXWELL UPGRADED VERSION (V02) FOR 11M V3.1 8 ; ;RLB001 9 ; ;RLB001 10 ;RLB001 11 .IF NDF R$$SX ;RLB001 12 ;RLB001 13 .MCALL ..V2..,.REGDEF 14 ..V2.. 15 .REGDEF 16 .ENDC ;RLB001 17 ;RLB001 18 .MCALL DIR$,WTSE$S,CALL,RETURN 19 20 .GLOBL EVL18,EVL19,EVL20 21 .GLOBL EVL1,EVL40,EVL0,EVL4,EVL10,EVL15,EVL14,EVL2,EVL5 22 .GLOBL EVL7,EVL8,EVL9,EVL13,EVL15,EVL16,EVL17,EVL3,EVL11 23 .GLOBL EVL6,VARTYP,LINPTR,TYPE,TYPECH,PRTLIN,LINTYP 24 .GLOBL GETVAR,GETLBL,IFRTN,LINENO,LINE 25 .GLOBL ARGFLG 26 000000 .CSECT EVAL 27 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 3 29 30 31 ; EVAL RTN 0 IS FOR THOSE ROUTINES THAT DO NOT NEED 32 ; TO BE EVALUATED 33 000000 EVL0: RETURN 34 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 4 36 37 38 ;EVLRTN 1 IS TO SCAN AN ARITHMETIC LINE 39 000002 012767 000000G 000000G EVL1: MOV #LINE,LINPTR 40 000010 012767 000000G 000000G MOV #VTASNS,VARTYP ;SET VARTYPE TO ARTH SET = TO 41 000016 CALL PAREXP ; GET OBJECT OF ASSIGNMENT 42 000022 122777 000075 000000G CMPB #'=,@LINPTR ; IS '=' THERE? 43 000030 001011 BNE 20$ ; NO, BAIL OUT WITH ERROR 44 000032 005267 000000G INC LINPTR ; BUMP POINTER 45 000036 012767 000000G 000000G MOV #VTARTH,VARTYP ; SET VARIABLE TYPE 46 000044 CALL PAREXP ; PARSE EXPRESSION 47 000050 103401 BCS 20$ ; PROBLEM 48 000052 RETURN ; ELSE RETURN 49 000054 000167 002670 20$: JMP EVL40 ; ERROR ESCAPE EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 5 51 52 53 ; EVL RTN 2 IS FOR I/O STATEMENTS ACCEPT,READ,PRINT,TYPE 54 ; OF THE FORM KEY WORD F,LIST 55 000060 005067 000000G EVL2: CLR ARGFLG 56 000064 022767 000000G 000000G CMP #KYACC,LINTYP ;WAS I/O STATEMENT ACCEPT 57 000072 001004 BNE 10$ ;NO 58 000074 012767 000000G 000000G MOV #VTACC,VARTYP ;YES SET HOW USED NEMONIC CODE TO 'AC' 59 000102 000423 BR E2EVL 60 000104 022767 000000G 000000G 10$: CMP #KYRDUF,LINTYP ;READ 61 000112 001004 BNE 20$ 62 000114 012767 000000G 000000G MOV #VTREAD,VARTYP 63 000122 000413 BR E2EVL 64 000124 022767 000000G 000000G 20$: CMP #KYPRIN,LINTYP ;PRINT 65 000132 001004 BNE 30$ 66 000134 012767 000000G 000000G MOV #VTPRIN,VARTYP 67 000142 000403 BR E2EVL 68 000144 012767 000000G 000000G 30$: MOV #VTTYPE,VARTYP ;DEFALT IS TYPE 69 000152 E2EVL: CALL GETLBL ;GET FORMAT NO 70 000156 005767 000000G E2LB: TST ARGFLG ;REACHED END OF LINE YET 71 000162 001003 BNE E2DNE ;YES 72 000164 CALL GETVAR ;NO SCAN UNTILL YES 73 000170 000772 BR E2LB 74 000172 E2DNE: RETURN 75 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 6 77 78 79 ; EVL RTN 3 SCANS ASSIGN 80 000174 012767 000000G 000000G EVL3: MOV #VTASN,VARTYP ;SET NEMONIC TO 'AS' 81 000202 CALL GETLBL ;GET LABEL 82 000206 062767 000002 000000G ADD #2,LINPTR ;SKIP THE 'TO' IN ASSIGN N TO X 83 000214 CALL GETVAR ;GET VAR NAME 84 000220 RETURN 85 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 7 87 88 89 ; EVL RTN 4 BACKSPACE,ENDFILE,REWIND MAY USE EXPRESSION 90 ; IN PLAC EOF A NUMBER 91 000222 022767 000000G 000000G EVL4: CMP #KYBKSP,LINTYP ;BACKSPACE?? 92 000230 001004 BNE 10$ 93 000232 012767 000000G 000000G MOV #VTBKSP,VARTYP 94 000240 000413 BR E4EVL 95 000242 022767 000000G 000000G 10$: CMP #KYENDF,LINTYP ;ENDFILE??? 96 000250 001004 BNE 20$ 97 000252 012767 000000G 000000G MOV #VTENDF,VARTYP 98 000260 000403 BR E4EVL 99 000262 012767 000000G 000000G 20$: MOV #VTRWND,VARTYP ;REWIND IS DEFALT 100 000270 E4EVL: CALL PAREXP ; PARSE UNIT EXPRESSION 101 000274 RETURN EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 8 103 104 105 ; EVL RTN 5 EVALUATES CALL SUBROUTINE 106 000276 005067 000000G EVL5: CLR ARGFLG 107 000302 012767 000000G 000000G MOV #VTCALL,VARTYP ;1ST NAME GOTTEN IS SUB NAME 108 000310 004767 000000G JSR PC,GETVAR 109 000314 012767 000000G 000000G MOV #VTARG,VARTYP ;REST ARE ARGUMENTS 110 000322 005767 000000G E5LB: TST ARGFLG ;REPEAT UNTILL END OF LINE FOUND 111 000326 001003 BNE E5DNE 112 000330 CALL GETVAR 113 000334 000772 BR E5LB 114 000336 E5DNE: RETURN 115 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 9 117 118 119 ; EVL RTN 6 COMMON LIST AND COMMON/NAME/LIST 120 000340 117700 000000G EVL6: MOVB @LINPTR,R0 ;GET NXT CHR 121 000344 122700 000057 CMPB #'/,R0 ;NAMED COMMON???? 122 000350 001011 BNE BLNKCM ;NO BLAMK COMMON 123 000352 005267 000000G INC LINPTR 124 000356 012767 000000G 000000G MOV #VTCOMN,VARTYP ;SET HOW USE NEMONIC TO COMMON NAME 125 000364 CALL GETVAR 126 000370 005267 000000G INC LINPTR ;SKIP 2ND '/' 127 000374 012767 000000G 000000G BLNKCM: MOV #VTCOM,VARTYP ;COMMON LIST NEM 128 000402 005067 000000G CLR ARGFLG 129 000406 E6LB: CALL GETVAR 130 000412 005767 000000G TST ARGFLG ;END OF LINE YET?? 131 000416 001773 BEQ E6LB ;KEEP LOOPING UTILL YES 132 000420 RETURN 133 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 10 135 136 137 ; EVL 7 RTN HANDLES DATA LINES 138 000422 012767 000000G 000000G EVL7: MOV #VTDATA,VARTYP 139 000430 005067 000000G CLR ARGFLG ; CLEAR FLAG 140 000434 E7: CALL GETVAR ; GET NEXT VARIABLE 141 000440 005767 000000G TST ARGFLG ; CHECK FLAG 142 000444 001035 BNE E7EX ; EOL - EXIT 143 000446 117700 000000G MOVB @LINPTR,R0 ; GET CHAR THAT FOLLOWS 144 000452 001433 BEQ E7ER ; EOL NOT GOOD 145 000454 022700 000057 CMP #'/,R0 ; SLASH FOUND? 146 000460 001401 BEQ 10$ ; YES, GO PARSE LIST 147 000462 000764 BR E7 ; ELSE GO GET NEXT VAR 148 149 000464 005267 000000G 10$: INC LINPTR ; BUMP PAST '/' 150 000470 CALL GETVAR ; PASS OVER A DATA SPECIFIER 151 000474 005767 000000G TST ARGFLG ; END OF LINE? 152 000500 001020 BNE E7ER ; YES, THAT'S NOT GOOD 153 000502 117700 000000G MOVB @LINPTR,R0 ; GET CHAR THAT FOLLOWS SPEC 154 000506 022700 000052 CMP #<'*>,R0 ; MULTIPLE SPECIFIER? 155 000512 001764 BEQ 10$ ; YES, PASS OVER AND GET REST 156 000514 022700 000054 CMP #<',>,R0 ; FOUND A COMMA? 157 000520 001761 BEQ 10$ ; YES, BUMP OVER AND PARSE NEXT SPEC 158 000522 022700 000057 CMP #<'/>,R0 ; FOUND DELIMITING SLASH? 159 000526 001005 BNE E7ER ; NO, SOMETHING ILLEGAL THERE 160 000530 062767 000002 000000G ADD #2,LINPTR ; ELSE BUMP OVER '/,' COMBINATION 161 000536 000736 BR E7 ; AND TRY FOR MORE VARIABLES 162 163 000540 E7EX: RETURN ; RETURN 164 000542 000167 002202 E7ER: JMP EVL40 ; ERROR ESCAPE EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 11 166 167 168 ; EVL 8 DECODE ENCODE 169 000546 022767 000000G 000000G EVL8: CMP #KYDCOD,LINTYP ;DECODE 170 000554 001004 BNE 10$ 171 000556 012767 000000G 000000G MOV #VTDCOD,VARTYP 172 000564 000403 BR E8EVL 173 000566 012767 000000G 000000G 10$: MOV #VTENC,VARTYP ;DEFALT IS ENCODE 174 000574 005067 000000G E8EVL: CLR ARGFLG 175 000600 CALL GETVAR ;IF CHR CNT SPECIFIED BY VAR-GET IT 176 000604 005267 000000G INC LINPTR ;SKIP ',' 177 000610 CALL GETLBL ;GET FORMAT NUMBER 178 000614 005267 000000G INC LINPTR ; SKIP ',' 179 000620 CALL GETVAR ; GET BUFFER NAME 180 000624 122777 000051 000000G CMPB #'),@LINPTR ; END OF IMBEDDED SPECS? 181 000632 001404 BEQ 20$ ; YES, GO PARSE I/O LIST 182 000634 005267 000000G INC LINPTR ; ELSE BUMP PAST ',' 183 000640 CALL NDERCK ; GET 'ERR=' SPEC 184 185 000644 005267 000000G 20$: INC LINPTR ; BUMP PAST ')' 186 000650 005767 000000G E8LB: TST ARGFLG 187 000654 001003 BNE E8DNE ;ALL REST IS I/O VAR NAME & LIST LOOP UNTIL GOT 188 000656 CALL GETVAR 189 000662 000772 BR E8LB 190 000664 E8DNE: RETURN 191 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 12 193 194 195 ;EVL 9 DEFINE FILE 196 000666 012767 000000G 000000G EVL9: MOV #VTDEFF,VARTYP 197 000674 CALL GETVAR ;GET L.U.N IF IT IS VARIABLE 198 000700 005267 000000G INC LINPTR ;SKIP'(' 199 000704 CALL PAREXP ;GET RECORD CNT IF VAR 200 000710 005267 000000G INC LINPTR ;SKIP ',' 201 000714 CALL PAREXP ;GET REC SIZE IF VAR 202 000720 062767 000003 000000G ADD #3,LINPTR ;SIP ',U,' 203 000726 CALL GETVAR ;GET INDEX VAR 204 000732 062767 000002 000000G ADD #2,LINPTR ;SKIP '),' 205 000740 105777 000000G TSTB @LINPTR ;ANOTHER D.F. SPEC??? 206 000744 001350 BNE EVL9 ;YES REPEAT 207 000746 RETURN 208 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 13 210 211 212 ; EVL 10 DIMENSION, EQUIVALENCE,EXTERNAL 213 000750 005067 000000G EVL10: CLR ARGFLG 214 000754 022767 000000G 000000G CMP #KYDIM,LINTYP ;DIMENSION 215 000762 001004 BNE 10$ 216 000764 012767 000000G 000000G MOV #VTDIM,VARTYP 217 000772 000423 BR E10EVL 218 000774 022767 000000G 000000G 10$: CMP #KYEQV,LINTYP ;EQUIVALENCE 219 001002 001004 BNE 20$ 220 001004 012767 000000G 000000G MOV #VTEQV,VARTYP 221 001012 000413 BR E10EVL 222 001014 022767 000000G 000000G 20$: CMP #KYEXT,LINTYP ; EXTERNAL? 223 001022 001004 BNE 30$ 224 001024 012767 000000G 000000G MOV #VTEXT,VARTYP 225 001032 000403 BR E10EVL 226 001034 012767 000000G 000000G 30$: MOV #VTVIR,VARTYP ; DEFAULT IS VIRTUAL 227 001042 E10EVL: CALL GETVAR ;GET LIST 228 001046 005767 000000G TST ARGFLG 229 001052 001773 BEQ E10EVL ;UNTIL END OF LINE FOUND 230 001054 RETURN 231 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 14 233 234 ; EVL 11 DO N VAR=A,B,C 235 001056 012767 000000G 000000G EVL11: MOV #VTDO,VARTYP 236 001064 CALL GETLBL ;GET END OF LOOP LABLE 237 001070 CALL GETVAR ;GET INDEX VAR 238 001074 005267 000000G INC LINPTR ;SKIP '=' 239 001100 005067 000000G CLR ARGFLG ; RESET DONE FLAG 240 001104 E11LB: CALL PAREXP ;IF ANY OF INDEX SPECS SPECIFED BY VAR-GET 241 001110 005267 000000G INC LINPTR 242 001114 005767 000000G TST ARGFLG 243 001120 001771 BEQ E11LB 244 001122 RETURN 245 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 15 247 248 249 ; EVL 12 IS END AND HANDLED ELSE WARE AS IT OUTPUTS ALL INFO 250 ; ACCUMULATED AND RESETS FOR NEW RUN 251 ; 252 ; SEE MODULE 'OUTPUT' FOR EVL12 ENTRY POINT EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 16 254 255 256 ; EVL 13 FIND(L.U.N'INDEX) 257 001124 012767 000000G 000000G EVL13: MOV #VTFIND,VARTYP 258 001132 005067 000000G CLR ARGFLG 259 001136 016701 000000G MOV LINPTR,R1 ; GET CURRENT POINTER 260 001142 122721 000047 10$: CMPB #<''>,(R1)+ ; LOOK FOR APOSTROPHE 261 001146 001375 BNE 10$ ; KEEP LOOKING 262 263 001150 005301 DEC R1 ; POINT BACK TO "'" 264 001152 112711 000045 MOVB #'%,(R1) ; FOOL PARSER BY CHANGING IT 265 266 001156 E13LB: CALL PAREXP 267 001162 005267 000000G INC LINPTR 268 001166 CALL PAREXP ; PARSE RECORD NO. 269 001172 RETURN 270 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 17 272 273 274 ; EVL 14 FUNCTION/SUBROUTINE/ENTRY/PROGRAM/BLOCK DATA 275 001174 005067 000000G EVL14: CLR ARGFLG 276 001200 022767 000000G 000000G CMP #KYFUNC,LINTYP ;IS IT FUNCTION 277 001206 001004 BNE 10$ 278 001210 012767 000000G 000000G MOV #VTFUNC,VARTYP 279 001216 000433 BR E14EVL 280 001220 022767 000000G 000000G 10$: CMP #KYSUB,LINTYP ;SUBROUTINE 281 001226 001004 BNE 20$ 282 001230 012767 000000G 000000G MOV #VTSUB,VARTYP 283 001236 000423 BR E14EVL ; GO EVALUATE 284 001240 022767 000000G 000000G 20$: CMP #KYENT,LINTYP ; ENTRY POINT? 285 001246 001004 BNE 30$ ; NO 286 001250 012767 000000G 000000G MOV #VTENT,VARTYP ; YES, SET BYTE TYPE 287 001256 000413 BR E14EVL ; GO PARSE 288 001260 022767 000000G 000000G 30$: CMP #KYBKDT,LINTYP ; BLOCK DATA? 289 001266 001004 BNE 40$ ; NO 290 001270 012767 000000G 000000G MOV #VTBKDT,VARTYP ; YES, SET TYPE 291 001276 000403 BR E14EVL ; GO PARSE 292 001300 012767 000000G 000000G 40$: MOV #VTPROG,VARTYP ; ASSUME PROGRAM BY DEFAULT 293 001306 E14EVL: CALL GETVAR 294 001312 012767 000000G 000000G MOV #VTARG,VARTYP 295 001320 005767 000000G E14LB: TST ARGFLG 296 001324 001005 BNE E14DN 297 001326 005267 000000G INC LINPTR ; BUMP OVER '(' AND ',' 298 001332 CALL GETVAR 299 001336 000770 BR E14LB 300 001340 E14DN: RETURN 301 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 18 303 ;+ 304 ; EVL15 - PROCESS TYPE VAR / TYPE*N VAR / TYPE FUNCTION VAR*N 305 ; 306 ; THE FOLLOWING MACRO GENERATES COMPARATIVE SEARCH CODE TO 307 ; DETERMINE THE TYPE OF THE STATEMENT. UPON SUCCESSFUL FIND, 308 ; R2 BECOMES AN INDEX TO THE KEY VALUES FOR EACH TYPE IN THE 309 ; TABLE VBAS. 310 ;- 311 .MACRO COMPAR KEYVAL 312 CMP #KEYVAL,R0 ; IS THERE A MATCH? 313 BEQ TFND ; YES, STOP COMPARING 314 INC R2 ; NO, BUMP TO NEXT TYPE 315 .ENDM 316 ; 317 001342 EVL15:: 318 001342 005002 CLR R2 ; CLEAR INDEXER 319 001344 016700 000000G MOV LINTYP,R0 ; GET LINE TYPE FOR COMPARISON 320 001350 COMPAR KYREAL ; REAL LINE? 321 001360 COMPAR KYINT ; INTEGER? 322 001370 COMPAR KYDBP ; DOUBLE PRECISION 323 001400 COMPAR KYLOGI ; LOGICAL? 324 001410 COMPAR KYCPX ; COMPLEX? 325 ; ASSUME BYTE BY DEFAULT 326 001420 TFND: 327 001420 005067 000000G CLR ARGFLG ; CLEAR FLAG 328 001424 006302 ASL R2 ; FORM BYTE OFFSET INTO TABLE 329 001426 062702 001526' ADD #VBAS,R2 ; POINT TO GENERIC TYPE 330 001432 117700 000000G MOVB @LINPTR,R0 ; GET CHAR AFTER TYPE 331 001436 022700 000052 CMP #'*,R0 ; '*N'? 332 001442 001004 BNE FCMP ; NO, GO CHECK FOR FUNCTION 333 001444 062767 000002 000000G ADD #2,LINPTR ; YES, SKIP OVER IT 334 001452 000420 BR NTFN ; CAN'T BE FUNCTION, SO BAIL OUT 335 ; 336 001454 016701 000000G FCMP: MOV LINPTR,R1 ; GET LINE POINTER 337 001460 012703 001542' MOV #ASFN,R3 ; POINT TO FUNCTION STRING 338 001464 122123 10$: CMPB (R1)+,(R3)+ ; CHARS MATCH FOR FUNCTION? 339 001466 001012 BNE NTFN ; NO, NOT A FUNCTION 340 001470 105713 TSTB (R3) ; AT END OF FUNCTION STRING? 341 001472 003374 BGT 10$ ; NO, KEEP COMPARING 342 001474 005202 INC R2 ; MATCH! NOW POINT TO FUNCTION KEY 343 001476 010167 000000G MOV R1,LINPTR ; SAVE NEW LINE POINTER 344 001502 111200 MOVB (R2),R0 ; GRAB KEY VARIABLE VALUE 345 001504 010067 000000G MOV R0,VARTYP ; AND STUFF IT IN 346 001510 000167 177572 JMP E14EVL ; PARSE AS A FUNCTION NOW 347 ; 348 001514 111200 NTFN: MOVB (R2),R0 ; GET KEY VAR VAL 349 001516 010067 000000G MOV R0,VARTYP ; STUFF IT IN 350 001522 000167 177314 JMP E10EVL ; PARSE LIKE DIMENSION STATEMENT 351 ;+ 352 ; DATA AREA 353 ;- 354 001526 000G 000G VBAS: .BYTE VTREAL,VTRFUN ; REAL VAR / REAL FUNCTION 355 001530 000G 000G .BYTE VTINT,VTIFUN ; INTEGER / INTEGER FUNCTION 356 001532 000G 000G .BYTE VTDBP,VTDFUN ; DOUBLE PRECICION / DBL PREC. FUNCTION 357 001534 000G 000G .BYTE VTLOGI,VTLFUN ; LOGICAL / LOGICAL FUNCTON 358 001536 000G 000G .BYTE VTCPX,VTCFUN ; COMPLEX / COMPLEX FUNCTION 359 001540 000G 000G .BYTE VTBYTE,VTBFUN ; BYTE / BYTE FUNCTION EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 18-1 360 001542 106 125 116 ASFN: .ASCIZ /FUNCTION/ 001545 103 124 111 001550 117 116 000 361 .EVEN EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 19 363 364 365 ; EVL 16 HANDLES IF()A,B,B OR IF ()INSTR 366 001554 012767 000000G 000000G EVL16: MOV #VTIF,VARTYP 367 001562 005067 000000G CLR ARGFLG 368 369 001566 CALL PAREXP ; PARSE EXPRESSION IN '(..)' 370 001572 103450 BCS E16ER ; SOME SORT OF PROBLEM 371 001574 005767 000000G TST ARGFLG ; END OF LINE? 372 001600 001045 BNE E16ER ; YES, A NO-NO 373 001602 016701 000000G MOV LINPTR,R1 ; GET CURRENT POINTER 374 001606 122721 000051 CMPB #'),(R1)+ ; IS CLOSING ')' THERE? 375 001612 001040 BNE E16ER ; NO, NOT ALLOWED 376 001614 111100 MOVB (R1),R0 ; YES, GET CHAR THAT FOLLOWS 377 001616 CALL TYPE ; FIND OUT WHAT IT IS 378 001622 005767 000000G TST TYPECH ; CHECK FLAG 379 001626 002432 BLT E16ER ; TERMINAL? NOT GOOD 380 001630 001421 BEQ STDIF ; NUMBER - ARITHMETIC IF 381 001632 012716 000000G MOV #IFRTN,(SP) ;LETTER-INST TYPE IF-RESET RETURN 382 ;FROM SUBROUTINE TO SPECIAL 383 ;REENTRY POINT IN MAIN PROGRAM 384 001636 005767 000056 TST CMPVRS ; CHECK COMPILER USEAGE 385 001642 001402 BEQ 10$ ; USING F4P, DON'T INCREMENT LINE NO. 386 001644 005267 000000G INC LINENO ;FOR COMPATABILITY WITH COMPILER 387 001650 012702 000000G 10$: MOV #LINE,R2 388 001654 112122 E16LB3: MOVB (R1)+,(R2)+ ;SHIFT PART OF IF AFTER COND. TO 389 ;BEGINNING OF LINE-MAKE SCANER THINK 390 ; NEW LINE 391 001656 001376 BNE E16LB3 ;NULL MEANS END OF LINE 392 001660 112122 MOVB (R1)+,(R2)+ 393 001662 112122 MOVB (R1)+,(R2)+ ;ADD SOME MORE NULLS JUST TO BE SAFE 394 001664 012767 000000G 000000G MOV #LINE,LINPTR 395 001672 RETURN 396 001674 STDIF: CALL GETLBL 397 001700 005267 000000G INC LINPTR 398 001704 005767 000000G TST ARGFLG 399 001710 001771 BEQ STDIF 400 001712 RETURN 401 001714 000167 001030 E16ER: JMP EVL40 ; ERROR ESCAPE 402 403 001720 000000 CMPVRS:: .WORD 0 ; COMPILER USE: 0 => F4P, 1 => FOR 404 ; SINCE F4P DOES NOT COUNT THE IF 405 ; CLAUSE AS A SINGLE STATEMENT 406 001722 000000 PLEVEL: .WORD 0 407 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 20 409 ; EVL17 READ()/WRITE()--(N),(N'M),(N,M),(N'M,F) 410 ; WITH POSSIBLE END= AND/OR ERR= IN ANY COMBINATION 411 ; 412 001724 005067 177772 EVL17: CLR PLEVEL ; RESET PAREN LEVEL 413 001730 005067 000000G CLR ARGFLG ; NOT AT END OF LINE YET 414 001734 022767 000000G 000000G CMP #KYRDF,LINTYP ; READ? 415 001742 001004 BNE 10$ ; NO 416 001744 012767 000000G 000000G MOV #VTREAD,VARTYP ; YES, SET READ TYPE 417 001752 000403 BR E17EVL ; GO GET LUN 418 001754 012767 000000G 000000G 10$: MOV #VTWRIT,VARTYP ; ASSUME WRITE TYPE 419 420 001762 E17EVL: CALL PAREXP ; PARSE LUN SPECIFICATION 421 001766 103532 BCS E17ER ; SOME SORT OF PROBLEM 422 001770 117700 000000G MOVB @LINPTR,R0 ; GET NEXT CHAR 423 001774 001527 BEQ E17ER ; EOL NOT GOOD 424 001776 005267 000000G INC LINPTR ; BUMP POINTER 425 002002 022700 000047 CMP #<''>,R0 ; DIRECT ACCESS READ/WRITE? 426 002006 001010 BNE 20$ ; NO, KEEP CHECKING 427 002010 CALL PAREXP ; YES, GET RECORD SPEC 428 002014 103517 BCS E17ER ; SOME SORT OF PROBLEM 429 002016 117700 000000G MOVB @LINPTR,R0 ; GET CHAR THAT FOLLOWS 430 002022 001514 BEQ E17ER ; EOL - REJECT 431 002024 005267 000000G INC LINPTR ; BUMP POINTER 432 433 002030 022700 000054 20$: CMP #<',>,R0 ; FOUND A COMMA? 434 002034 001034 BNE 30$ ; NO, KEEP CHECKING 435 002036 117700 000000G MOVB @LINPTR,R0 ; YES, GET CHAR THAT FOLLOWS IT 436 002042 CALL TYPE ; GET ITS TYPE 437 002046 005767 000000G TST TYPECH ; CHECK FLAG 438 002052 003021 BGT 25$ ; LETTER, GO PARSE 'END=', 'ERR=' 439 002054 001406 BEQ 200$ ; NUMBER, GO PARSE LABEL 440 002056 022700 000052 CMP #<'*>,R0 ; LIST DIRECTED FORMAT? 441 002062 001074 BNE E17ER ; NO, ANYTHING ELSE ILLEGAL 442 002064 005267 000000G INC LINPTR ; YES, BUMP OVER IT 443 002070 000402 BR 210$ ; AND KEEP PARSING 444 445 002072 200$: CALL GETLBL ; GET FORMAT SPECIFIER 446 002076 117700 000000G 210$: MOVB @LINPTR,R0 ; GET CHAR AFTER IT 447 002102 001464 BEQ E17ER ; EOL NOT GOOD 448 002104 005267 000000G INC LINPTR ; BUMP POINTER PAST 449 002110 022700 000054 CMP #<',>,R0 ; FOUND A COMMA? 450 002114 001004 BNE 30$ ; NO, KEEP CHECKING 451 452 002116 25$: CALL NDERCK ; PARSE 'END=', 'ERR=' 453 002122 117700 000000G MOVB @LINPTR,R0 ; GET CHAR THAT FOLLOWS 454 455 002126 022700 000051 30$: CMP #'),R0 ; CLOSING PAREN THERE? 456 002132 001050 BNE E17ER ; NO, WE HAVE SOMETHING STRANGE 457 458 002134 40$: CALL GETVAR ; PARSE AN ARGUMENT 459 002140 005767 000000G TST ARGFLG ; CHECK FOR END 460 002144 001042 BNE E17DN ; FOUND - GO EXIT 461 002146 000772 BR 40$ ; NO, GO GET NEXT ARG 462 EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 21 464 ;+ 465 ; THIS ROUTINE PARSES 'END=' AND 'ERR=' SPECS IN ANY ORDER 466 ;- 467 468 002150 016701 000000G NDERCK: MOV LINPTR,R1 469 002154 122721 000105 CMPB #'E,(R1)+ 470 002160 001006 BNE RTN 471 002162 122721 000116 CMPB #'N,(R1)+ 472 002166 001004 BNE RCK 473 002170 122721 000104 CMPB #'D,(R1)+ 474 002174 001410 BEQ EQTST 475 002176 RTN: RETURN 476 002200 005301 RCK: DEC R1 477 002202 122721 000122 CMPB #'R,(R1)+ 478 002206 001373 BNE RTN 479 002210 122721 000122 CMPB #'R,(R1)+ 480 002214 001370 BNE RTN 481 002216 122721 000075 EQTST: CMPB #'=,(R1)+ 482 002222 001365 BNE RTN 483 002224 010167 000000G MOV R1,LINPTR 484 002230 CALL GETLBL 485 002234 127727 000000G 000051 CMPB @LINPTR,#') 486 002242 001755 BEQ RTN 487 002244 005267 000000G INC LINPTR 488 002250 000737 BR NDERCK 489 ; 490 002252 E17DN: RETURN ; EXIT 491 002254 000167 000470 E17ER: JMP EVL40 ; ERROR EXIT EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 22 493 494 495 ; EVL 18 GO TO 10 GO TO A GO TO ( , , ,),X ETC 496 002260 012767 000000G 000000G EVL18: MOV #VTGOTO,VARTYP ;SET NEM TYPE 497 002266 005067 000000G CLR ARGFLG 498 002272 117700 000000G MOVB @LINPTR,R0 499 002276 CALL TYPE ;WHAT THYPE OF GO TO IS IT 500 002302 005767 000000G TST TYPECH 501 002306 003025 BGT ASGNGT ;CHR IS LETTER-ASSIGNED GO TO 502 002310 001421 BEQ UNCDGT ;NUMBER -UNCONDITIONAL GO TO 503 002312 005267 000000G E18LB1: INC LINPTR ;COMPUTED GO TO-SKIP'(' 504 002316 CALL GETLBL ;GET LABEL 505 002322 005767 000000G TST ARGFLG ;END OF LINE 506 002326 001030 BNE E18ER ;IF YES THATS AN ERROR 507 002330 127727 000000G 000051 CMPB @LINPTR,#') ;END OF SPECIFIED LABELS? 508 002336 001365 BNE E18LB1 ;NO CONTINUE 509 002340 E18LB2: CALL GETVAR ;GET THE VAR NME 510 002344 005767 000000G TST ARGFLG ;DONE?? 511 002350 001773 BEQ E18LB2 ;NO-GOT PUNCTUATION INSTEAD 512 002352 RETURN 513 002354 UNCDGT: CALL GETLBL ;GET LABEL 514 002360 RETURN 515 002362 ASGNGT: CALL GETVAR ;GET VAR NAME 516 002366 005767 000000G E18LB3: TST ARGFLG ;END OF LINE-OPTIONAL LABLE LIST CAN FOLLOW 517 002372 001005 BNE E18DN 518 002374 005267 000000G INC LINPTR 519 002400 CALL GETLBL 520 002404 000770 BR E18LB3 521 002406 E18DN: RETURN 522 002410 000167 000334 E18ER: JMP EVL40 ; GO TO ERROR ROUTINE 523 ; EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 23 525 ; EVL19 - PARSES OPEN AND CLOSE STATEMENTS 526 ; 527 002414 EVL19: 528 529 002414 022767 000000G 000000G CMP #KYOPEN,LINTYP ; OPEN STATEMENT? 530 002422 001004 BNE 5$ ; NO, ASSUME CLOSE 531 002424 012767 000000G 000000G MOV #VTOPEN,VARTYP ; YES, SET VAR TYPE 532 002432 000403 BR 10$ 533 002434 012767 000000G 000000G 5$: MOV #VTCLOS,VARTYP 534 535 002442 005067 000076 10$: CLR EQFLG ; CLEAR KEY/EXPRESSION FLAG 536 002446 CALL NDERCK ; CHECK FOR ERR= 537 002452 117700 000000G 12$: MOVB @LINPTR,R0 ; GET CHARACTER LEFT 538 002456 001431 BEQ E19RET ; EXIT IF NULL 539 002460 CALL TYPE ; SEE WHAT KIND IT IS 540 002464 005767 000000G TST TYPECH ; CHECK FLAG 541 002470 002406 BLT 15$ ; NOT ALPHA OR NUM - KEEP CHECKING 542 002472 005767 000046 TST EQFLG ; KEYWORD OR EXP. COMING? 543 002476 003012 BGT 25$ ; EXPRESSION - GO PARSE IT 544 002500 005267 000000G INC LINPTR ; BUMP PAST KEY CHARACTER 545 002504 000762 BR 12$ ; SEE IF WE'VE REACHED TERMINAL 546 547 002506 005267 000000G 15$: INC LINPTR ; PUSH POINTER PAST TERMINAL CHAR 548 002512 022700 000075 CMP #'=,R0 ; AT AN EQUALS SIGN? 549 002516 001005 BNE 30$ ; NO, GO CHECK FOR COMMA 550 002520 005267 000020 INC EQFLG ; YES! SET FLAG FOR EXPRESSION 551 002524 25$: CALL GETVAR ; PARSE VARIABLE 552 002530 000750 BR 12$ ; AND CHECK NEXT CHAR 553 554 002532 022700 000054 30$: CMP #<',>,R0 ; WAS IT A COMMA? 555 002536 001741 BEQ 10$ ; YES! GO RESET FLAG AND PARSE KEY 556 002540 000744 BR 12$ ; ELSE PARSE AS EXPRESSION 557 558 002542 E19RET: RETURN ; ELSE EXIT 559 560 002544 000000 EQFLG: .WORD 0 EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 24 562 ; EVL20 - PARSE PARAMETER STATEMENTS 563 564 002546 005067 000000G EVL20: CLR ARGFLG ; CLEAR END OF LINE FLAG 565 002552 012767 000000G 000000G MOV #VTPARM,VARTYP ; PARAMETER DEFINITION TYPE 566 002560 5$: CALL GETVAR ; PARSE DEFINITION 567 002564 005767 000000G TST ARGFLG ; UNEXPECTED EOL? 568 002570 003012 BGT E20RET ; YES 569 002572 016701 000000G MOV LINPTR,R1 ; GET WHERE WE LEFT OFF 570 002576 112100 10$: MOVB (R1)+,R0 ; GET NEXT CHAR 571 002600 001406 BEQ E20RET ; NULL - EXIT 572 002602 022700 000054 CMP #<',>,R0 ; REACHED THE COMMA YET? 573 002606 001373 BNE 10$ ; NO, KEEP LOOKING 574 002610 010167 000000G MOV R1,LINPTR ; RESET LINE POINTER 575 002614 000761 BR 5$ ; AND PARSE IT 576 ; 577 002616 E20RET: RETURN ; RETURN EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 25 579 ;+ 580 ; PROCESS FORMAT STATEMENTS, WHICH CAN HAVE OBJECT TIME 581 ; FORMAT SPECIFIERS (FORTRAN PLUS ONLY) OF THE FORM 582 ; 583 ; 584 ; 585 ; WITH THE 'EXPRESSION' ENCLOSED IN ANGLE BRACKETS. 586 ;- 587 588 002620 EVL22:: 589 002620 012767 000000G 000000G MOV #VTFMT,VARTYP ; SET VARIABLE TYPE 590 002626 005067 000000G CLR ARGFLG ; CLEAR FLAG 591 592 ;+ 593 ; LOOP, LOOKING FOR <...> CONSTRUCTS (OUTSIDE OF LITERALS 594 ; AND HOLLERINTHS, OF COURSE). WE CAN USE THE SKPNUM ROUTINE 595 ; TO SKIP OVER ANY POTENTIAL HOLLERINTHS. 596 ;- 597 598 002632 016701 000000G 10$: MOV LINPTR,R1 ; GET FRESH POINTER 599 002636 112100 MOVB (R1)+,R0 ; GET CHAR 600 002640 001440 BEQ E22EX ; EXIT IF NULL 601 002642 022700 000074 CMP #<'<>,R0 ; FOUND AN ANGLE BRACKET? 602 002646 001014 BNE 20$ ; NO, SKIP AHEAD 603 604 002650 010167 000000G MOV R1,LINPTR ; POINT TO START OF EXPRESSION 605 002654 CALL PAREXP ; PARSE IT 606 002660 103431 BCS E22ER ; SOME PROBLEM IN EXPRESSION 607 002662 122777 000076 000000G CMPB #<'>>,@LINPTR ; CLOSING BRACKET THERE? 608 002670 001025 BNE E22ER ; NO, A SYNTAX ERROR 609 002672 005267 000000G INC LINPTR ; YES, BUMP PAST IT 610 002676 000755 BR 10$ ; AND RESTART SCAN 611 612 002700 022700 000047 20$: CMP #<''>,R0 ; FOUND AN APOSTROPHE? 613 002704 001003 BNE 30$ ; NO, SKIP AHEAD 614 002706 CALL GETVAR ; YES, LET GETVAR PARSE LITERAL 615 002712 000747 BR 10$ ; AND GO RESTART SCAN 616 617 002714 30$: CALL TYPE ; OK, FIND THE TYPE OF CHAR 618 002720 005767 000000G TST TYPECH ; CHECK FLAG 619 002724 001003 BNE 40$ ; NOT A DIGIT - SKIP AHEAD 620 002726 CALL SKPNUM ; SKIP OVER NUMBERS AND HOLLERINTHS 621 002732 000737 BR 10$ ; GO RESTART SCAN 622 623 002734 005267 000000G 40$: INC LINPTR ; FOR ALL OTHERS, SKIP A CHAR 624 002740 000734 BR 10$ ; AND GO RESCAN 625 626 002742 E22EX: RETURN ; EXIT WHEN DONE 627 002744 000167 000000 E22ER: JMP EVL40 ; JUMP TO ERROR ROUTINE EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 26 629 ; EVL 40--ERROR REPORTING 630 002750 012700 003132' EVL40: MOV #ERRLNO,R0 ; GET PLACE TO STUFF LINE NUMBER 631 002754 016701 000000G MOV LINENO,R1 ; GET LINE NUM 632 002760 010002 MOV R0,R2 ; DON'T SUPPRESS LEADING ZEROS 633 002762 CALL $CBDSG ; CONVERT TO ASCII 634 002766 016746 000000G MOV NOSRC,-(SP) ; PUSH /NS VALUE 635 002772 005067 000000G CLR NOSRC ; FORCE OUTPUT OUT 636 002776 012700 003050' MOV #ERRMSG,R0 ; GET ADDRESS OF MESSAGE 637 003002 010067 000000C MOV R0,QIO+Q.IOPL ; STUFF INTO QIO BLOCK 638 003006 CALL PRTLIN ; PRINT THE LINE ON LIST 639 003012 012667 000000G MOV (SP)+,NOSRC ; RESTORE /NS VALUE 640 003016 012767 000075 000000C MOV #ERRLEN,QIO+Q.IOPL+2 ; STUFF MESSAGE LENGTH 641 003024 DIR$ #QIO ; WRITE TO TERMINAL 642 003032 103405 BCS E40RET ; BAH! IGNORE ERROR 643 003034 WTSE$S QIO+Q.IOEF ; WAIT FOR COMPLETION 644 003046 E40RET: RETURN ; RETURN 645 646 .NLIST BIN 647 003050 ERRMSG: .ASCII <12>/ **** UNKNOWN LINE TYPE OR SYNTAX ERROR AT LINE / 648 003132 ERRLNO: .BLKB 5 649 003137 .ASCII / ****/<15> 650 ERRLEN = .-ERRMSG 651 003145 .BYTE 0 652 .LIST BIN 653 .EVEN 654 000001 .END EVAL -- LINE EVALUATION ROUTINE MACRO M1113 15-FEB-80 10:07 PAGE 26-1 SYMBOL TABLE ARGFLG= ****** G E10EVL 001042R 002 E8LB 000650R 002 PAREXP= ****** GX VTDBP = ****** GX ASFN 001542R 002 E11LB 001104R 002 FCMP 001454R 002 PLEVEL 001722R 002 VTDCOD= ****** GX ASGNGT 002362R 002 E13LB 001156R 002 GETLBL= ****** G PRTLIN= ****** G VTDEFF= ****** GX BLNKCM 000374R 002 E14DN 001340R 002 GETVAR= ****** G QIO = ****** GX VTDFUN= ****** GX CMPVRS 001720RG 002 E14EVL 001306R 002 IFRTN = ****** G Q.IOEF= ****** GX VTDIM = ****** GX EQFLG 002544R 002 E14LB 001320R 002 KYACC = ****** GX Q.IOPL= ****** GX VTDO = ****** GX EQTST 002216R 002 E16ER 001714R 002 KYBKDT= ****** GX RCK 002200R 002 VTENC = ****** GX ERRLEN= 000075 E16LB3 001654R 002 KYBKSP= ****** GX RTN 002176R 002 VTENDF= ****** GX ERRLNO 003132R 002 E17DN 002252R 002 KYCPX = ****** GX R$$SX = 000000 VTENT = ****** GX ERRMSG 003050R 002 E17ER 002254R 002 KYDBP = ****** GX SKPNUM= ****** GX VTEQV = ****** GX EVL0 000000RG 002 E17EVL 001762R 002 KYDCOD= ****** GX STDIF 001674R 002 VTEXT = ****** GX EVL1 000002RG 002 E18DN 002406R 002 KYDIM = ****** GX TFND 001420R 002 VTFIND= ****** GX EVL10 000750RG 002 E18ER 002410R 002 KYENDF= ****** GX TYPE = ****** G VTFMT = ****** GX EVL11 001056RG 002 E18LB1 002312R 002 KYENT = ****** GX TYPECH= ****** G VTFUNC= ****** GX EVL13 001124RG 002 E18LB2 002340R 002 KYEQV = ****** GX UNCDGT 002354R 002 VTGOTO= ****** GX EVL14 001174RG 002 E18LB3 002366R 002 KYEXT = ****** GX VARTYP= ****** G VTIF = ****** GX EVL15 001342RG 002 E19RET 002542R 002 KYFUNC= ****** GX VBAS 001526R 002 VTIFUN= ****** GX EVL16 001554RG 002 E2DNE 000172R 002 KYINT = ****** GX VTACC = ****** GX VTINT = ****** GX EVL17 001724RG 002 E2EVL 000152R 002 KYLOGI= ****** GX VTARG = ****** GX VTLFUN= ****** GX EVL18 002260RG 002 E2LB 000156R 002 KYOPEN= ****** GX VTARTH= ****** GX VTLOGI= ****** GX EVL19 002414RG 002 E20RET 002616R 002 KYPRIN= ****** GX VTASN = ****** GX VTOPEN= ****** GX EVL2 000060RG 002 E22ER 002744R 002 KYRDF = ****** GX VTASNS= ****** GX VTPARM= ****** GX EVL20 002546RG 002 E22EX 002742R 002 KYRDUF= ****** GX VTBFUN= ****** GX VTPRIN= ****** GX EVL22 002620RG 002 E4EVL 000270R 002 KYREAL= ****** GX VTBKDT= ****** GX VTPROG= ****** GX EVL3 000174RG 002 E40RET 003046R 002 KYSUB = ****** GX VTBKSP= ****** GX VTREAD= ****** GX EVL4 000222RG 002 E5DNE 000336R 002 LINE = ****** G VTBYTE= ****** GX VTREAL= ****** GX EVL40 002750RG 002 E5LB 000322R 002 LINENO= ****** G VTCALL= ****** GX VTRFUN= ****** GX EVL5 000276RG 002 E6LB 000406R 002 LINPTR= ****** G VTCFUN= ****** GX VTRWND= ****** GX EVL6 000340RG 002 E7 000434R 002 LINTYP= ****** G VTCLOS= ****** GX VTSUB = ****** GX EVL7 000422RG 002 E7ER 000542R 002 L$$INC= 000003 VTCOM = ****** GX VTTYPE= ****** GX EVL8 000546RG 002 E7EX 000540R 002 NDERCK 002150R 002 VTCOMN= ****** GX VTVIR = ****** GX EVL9 000666RG 002 E8DNE 000664R 002 NOSRC = ****** GX VTCPX = ****** GX VTWRIT= ****** GX E$$IS = 000000 E8EVL 000574R 002 NTFN 001514R 002 VTDATA= ****** GX $CBDSG= ****** GX . ABS. 000000 000 000000 001 EVAL 003146 002 ERRORS DETECTED: 0 VIRTUAL MEMORY USED: 1611 WORDS ( 7 PAGES) DYNAMIC MEMORY: 2822 WORDS ( 10 PAGES) ELAPSED TIME: 00:00:19 EVAL,EVAL/-SP=RSXPRE,EVAL