(FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00001 ASUB,ASUB/-SP=ASUB 00001 C;+ 00002 C - A L E B R I 00003 C****NAME: SUBROUTINE ALEBRI 00004 C IDENT: /01MAR0/ 00005 C FILE: [201,13]ASUB.FLX 00006 C TKB: 00007 C 00008 C****PURPOSE: PUT OUT LINE OF FORM "BR I32760" FOR ALECS 00009 C 00010 C****RESTRICTIONS: 00011 C 00012 C SYSTEM: RSX11M V3.2 00013 C LANGUAGE: FLECS/FORTRAN 00014 C AUTHOR: M. OOTHOUDT 00015 C DATE: 01-MAR-80 00016 C REVISIONS: 00017 C 00018 C****CALLING SEQUENCE: CALL ALEBRI(NUMBER,LINENO,IOCLAS) 00019 C 00020 C INPUT: 00021 C 00022 C NUMBER=(I*2) NUMBER OF LABEL TO BRANCH TO 00023 C LINENO=(I*2) NUMBER OF SOURCE LINE INPUT CAME FROM 00024 C IOCLAS=(I*2) I/0 CLASS FOR OUTPUT STREAM 00025 C 00026 C OUTPUT: NONE 00027 C 00028 C CMN BLOCK I/O: NONE 00029 C 00030 C****DIALOG: NONE 00031 C 00032 C RESOURCES: 00033 C LIBRARIES: NONE 00034 C OTHER SUBR: ENCODE, [201,13]PUT 00035 C DISK FILES: NONE 00036 C DEVICES: NONE 00037 C SGAS: NONE 00038 C EVENT FLAGS: NONE 00039 C SYSTEM DIR: NONE 00040 C LENGTH/PAR: 00041 C 00042 C****NOTES: 00043 C 00044 C;- 00045 SUBROUTINE ALEBRI(NUMBER,LINENO,IOCLAS) 00046 C 00047 C SUBROUTINE CALL DECLARATIONS 00048 C 00049 INTEGER*2 NUMBER,LINENO,IOCLAS 00050 C 00051 C LOCAL DECLARATIONS 00052 C 00053 INTEGER*2 SBRI(9) 00054 DATA SBRI/15,2H ,2H ,2H ,2HBR,2H I,2H ,2H ,1H / 00055 C (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00002 ASUB,ASUB/-SP=ASUB 00056 ENCODE(5,1,SBRI(7))NUMBER 00057 1 FORMAT(I5) 00058 C 00059 CALL PUT(LINENO,SBRI,IOCLAS) 00060 C 00061 RETURN 00062 END (FLECS VERSION 22.38) 00063 C;+ 00064 C - A L E D O 00065 C****NAME: SUBROUTINE ALEDO 00066 C IDENT: /20MAR0/ 00067 C FILE: [201,13]ASUB.FLX 00068 C TKB: 00069 C 00070 C****PURPOSE: PROCESS DO STATEMENT FOR ALECS 00071 C 00072 C****RESTRICTIONS: 00073 C 00074 C SYSTEM: RSX11M V3.2 00075 C LANGUAGE: FLECS/FORTRAN 00076 C AUTHOR: M. OOTHOUDT 00077 C DATE: 20-MAR-80 00078 C REVISIONS: 00079 C 00080 C****CALLING SEQUENCE: 00081 C 00082 C CALL ALEDO(SST,SFLX,ISTART,LEN,CONTNO,NEXTNO,GSTNO,LINENO,MAJCNT, 00083 C FORTCL,ERRCL) 00084 C 00085 C INPUT: 00086 C 00087 C SST =(I*2) SCRATCH ARRAY 00088 C SFLX =(I*2) STRING CONTAINING DO SPECIFIER FROM INPUT LINE 00089 C ISTART=(I*2) # OF FIRST CHARACTER OF DO SPECIFIER (SEE NOTE 1) 00090 C LEN =(I*2) NUMBER OF CHARACTERS IN DO SPECIFIER 00091 C CONTNO=(I*2) LABEL NUMBER FOR HEAD OF LOOP 00092 C NEXTNO=(I*2) LABEL NUMBER FOR HEAD OF SCOPE 00093 C GSTNO =(I*2) LABEL NUMBER FOR LOOP EXIT JUMP 00094 C LINENO=(I*2) LINE # FOR INPUT LINE 00095 C MAJCNT=(I*2) COUNT OF MAJOR ERRORS THAT HAVE OCCURRED. 00096 C FORTCL=(I*2) CLASS SPECIFIER FOR MAC FILE. 00097 C ERRCL =(I*2) CLASS SPECIFIER FOR ERROR OUTPUT LISTING. 00098 C 00099 C OUTPUT: 00100 C 00101 C MAJCNT=(I*2) INCREMENTED BY 1 FOR EACH PARSING ERROR. 00102 C 00103 C CMN BLOCK I/O: NONE 00104 C 00105 C****DIALOG: NONE 00106 C 00107 C RESOURCES: 00108 C LIBRARIES: NONE (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00003 ASUB,ASUB/-SP=ASUB 00109 C OTHER SUBR: [201,13]PUT 00110 C DISK FILES: NONE 00111 C DEVICES: NONE 00112 C SGAS: NONE 00113 C EVENT FLAGS: NONE 00114 C SYSTEM DIR: NONE 00115 C LENGTH/PAR: 00116 C 00117 C****NOTES: 00118 C 1. WHEN ALEDO IS CALLED BY ALECS, THE STRING SFLX SHOULD 00119 C CONTAIN A STRING OF THE FORM " DO (E=E1,E2 [,E3])" WHERE ISTART 00120 C POINTS TO THE FIRST PARENTHESIS AND LEN INCLUDES THE LAST PAREN. 00121 C NOTE E3 IS OPTIONAL AND IF NOT GIVEN DEFAULTS TO "#1". THE EXPANSION 00122 C OF THE DO FOLLOWS DEC FORTRAN CONVENTIONS, EG. THE LOOP IS ALWAYS 00123 C EXECUTED AT LEAST ONCE. 00124 C 00125 C 2. SEVERAL PLACES IN THIS SUBROUTINE LINES OF THE FORM 00126 C I="54 OCCUR INSTEAD OF I=1H, THE REASON FOR THIS IS THAT THE FORMER 00127 C PUTS I="54 WHEREAS THE LATTER PUTS I="20054! 00128 C 00129 C 3. THE DO LOOP HAS NOT BEEN IMPLEMENTED BECAUSE IT IS NOT 00130 C CLEAR IF IT WOULD REALLY BE USEFUL IN MACRO--WHAT IS REALLY NEEDED 00131 C IS A SOB LOOP, WHICH CORRESPONDS TO "DO (RI=N,1,#-1)," A VERY SMALL 00132 C SUBSET OF "DO." IN ADDITION THE CODE FOR A DO LOOP IS VERY COMPLEX. 00133 C THE EXPANSION GIVEN BELOW FOR REFERENCE IS NEEDED BECAUSE IDELTA 00134 C MAY BE POSITIVE OR NEGATIVE. 00135 C 00136 C DO (I=ISTART,IEND,IDELTA)$ ;($=SCOPE) 00137 C 00138 C .=.+2 00139 C I32759: .WORD 0 ;LOOP TRAVEL COUNTER 00140 C PUSH 00141 C MOV IEND,R5 00142 C SUB ISTART,R5 ;R5=IEND-ISTART 00143 C SXT R4 ;DIV NEEDS 32 BIT QUOTIENT 00144 C DIV IDELTA,R4 ;R4=(IEND-ISTART)/IDELTA 00145 C MOV R4,I32759 ;# OF TIMES TO TRAVEL LOOP 00146 C POP 00147 C MOV ISTART,I ;INITIAL VALUE OF I 00148 C BR I'NEXTNO' ;EXECUTE LOOP AT LEAST ONCE 00149 C I'CONTNO': 00150 C ADD IDELTA,I ;NEXT VALUE OF I 00151 C DEC I32759 ;FINISHED? 00152 C BLT I'GSTNO' ;<0-->YES 00153 C I'NEXTNO': 00154 C $ ;SCOPE 00155 C BR I'CONTNO' ;CHECK LOOP COUNTER 00156 C I'GSTNO': 00157 C 00158 C NOTE EVERY THING AFTER I'NEXTNO': IS GENERATED ELSEWHERE IN ALECS. 00159 C 00160 C;- 00161 SUBROUTINE ALEDO(SST,SFLX,ISTART,LEN,CONTNO,NEXTNO,GSTNO, 00162 1 LINENO,MAJCNT,FORTCL,ERRCL) 00163 C (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00004 ASUB,ASUB/-SP=ASUB 00164 C SUBROUTINE CALL DECLARATIONS 00165 C 00166 INTEGER SST(1),SFLX(1),ISTART,LEN,CONTNO,NEXTNO,GSTNO,MAJCNT, 00167 1 LINENO,FORTCL,ERRCL 00168 C 00169 C LOCAL DECLARATIONS 00170 C 00171 INTEGER*2 SNOTIM(19), SERR(8) 00172 C 00173 C 00174 C DATA SNOTIM //***** (DO LOOPS NOT IMPLEMENTED)// 00175 DATA SNOTIM/35,2H**,2H**,2H* ,2H ,2H (,2HDO,2H L,2HOO, 00176 1 2HPS,2H N,2HOT,2H I,2HMP,2HLE,2HME,2HNT,2HED,1H)/ 00177 C 00178 C DATA SERR //******ALE ERR// 00179 DATA SERR/13,2H**,2H**,2H**,2HAL,2HE ,2HER,1HR/ 00180 C 00181 C 00182 MAJCNT=MAJCNT+1 00183 CALL PUT(0,SNOTIM,ERRCL) !DO LOOPS NOT IMPLEMENTED 00184 C 00185 C MAKE SURE ASSEMBLY LANGUAGE FILE WILL NOT ASSEMBLE 00186 C 00187 CALL PUT(LINENO,SERR,FORTCL) 00188 C 00189 C 00190 RETURN 00191 END (FLECS VERSION 22.38) 00192 C;+ 00193 C - A L E I N V 00194 C****NAME: SUBROUTINE ALEINV 00195 C IDENT: /01MAR0/ 00196 C FILE: [201,13]ASUB.FLX 00197 C TKB: 00198 C 00199 C****PURPOSE: PUT OUT PROCEDURE INVOCATION FOR ALECS 00200 C 00201 C****RESTRICTIONS: 00202 C 00203 C SYSTEM: RSX11M V3.2 00204 C LANGUAGE: FLECS/FORTRAN 00205 C AUTHOR: M. OOTHOUDT 00206 C DATE: 01-MAR-80 00207 C REVISIONS: 00208 C 00209 C****CALLING SEQUENCE: CALL ALEINV(NUMBER,LINENO,IOCLAS) 00210 C 00211 C INPUT: 00212 C 00213 C NUMBER=(I*2) LABEL NUMBER FOR ENTRANCE TO PROCEDURE 00214 C LINENO=(I*2) LINE NUMBER FOR INPUT LINE 00215 C IOCLAS=(I*2) I/O CLASS FOR OUTPUT STREAM 00216 C (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00005 ASUB,ASUB/-SP=ASUB 00217 C OUTPUT: NONE 00218 C 00219 C CMN BLOCK I/O: NONE 00220 C 00221 C****DIALOG: NONE 00222 C 00223 C RESOURCES: 00224 C LIBRARIES: NONE 00225 C OTHER SUBR: ENCODE, [201,13]PUT 00226 C DISK FILES: NONE 00227 C DEVICES: NONE 00228 C SGAS: NONE 00229 C EVENT FLAGS: NONE 00230 C SYSTEM DIR: NONE 00231 C LENGTH/PAR: 00232 C 00233 C****NOTES: 00234 C 00235 C;- 00236 SUBROUTINE ALEINV(NUMBER,LINENO,IOCLAS) 00237 C 00238 C SUBROUTINE CALL DECLARATIONS 00239 C 00240 INTEGER*2 NUMBER,LINENO,IOCLAS 00241 C 00242 C LOCAL DECLARATIONS 00243 C 00244 INTEGER*2 SJSRPC(11) 00245 C 00246 DATA SJSRPC/19,2H ,2H ,2H ,2HJS,2HR ,2HPC,2H,I,2H ,2H ,1H / 00247 C 00248 ENCODE(5,1,SJSRPC(9))NUMBER 00249 1 FORMAT(I5) 00250 C 00251 CALL PUT(LINENO,SJSRPC,IOCLAS) 00252 C 00253 RETURN 00254 END (FLECS VERSION 22.38) 00255 C;+ 00256 C - A L E S X P 00257 C****NAME: SUBROUTINE ALESXP 00258 C IDENT: /01MAR0/ 00259 C FILE: [201,13]ASUB.FLX 00260 C TKB: 00261 C 00262 C****PURPOSE: PROCESS SELECT SUBCLAUSE FOR ALECS 00263 C 00264 C****RESTRICTIONS: 00265 C 00266 C SYSTEM: RSX11M V3.2 00267 C LANGUAGE: FLECS/FORTRAN 00268 C AUTHOR: M. OOTHOUDT 00269 C DATE: 01-MAR-80 (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00006 ASUB,ASUB/-SP=ASUB 00270 C REVISIONS: 00271 C 00272 C****CALLING SEQUENCE: 00273 C 00274 C CALL ALEXSP(SST,SFLX,ISTART,LEN,SEL,NXIFNO,LINENO,IOCLAS) 00275 C 00276 C INPUT: 00277 C 00278 C SST =(I*2) SCRATCH ARRAY 00279 C SFLX =(STRING) INPUT LINE 00280 C ISTART=(I*2) FIRST CHARACTER IN SFLX TO BE EVALUATED 00281 C LEN =(I*2) NUMBER OF CHARACTERS IN SFLX TO EVALUATE 00282 C SEL =(STRING) CLAUSE FROM SELECT LINE 00283 C NXIFNO=(I*2) LABEL NUMBER FOR NEXT SUBCLAUSE 00284 C LINENO=(I*2) NUMBER OF INPUT LINE 00285 C IOCLAS=(I*2) I/O CLASS FOR OUTPUT STREAM 00286 C 00287 C OUTPUT: NONE 00288 C 00289 C CMN BLOCK I/O: NONE 00290 C 00291 C****DIALOG: NONE 00292 C 00293 C RESOURCES: 00294 C LIBRARIES: NONE 00295 C OTHER SUBR: [201,13]CATNUM,CATSTR,CATSUB,CPYSTR,PUT 00296 C DISK FILES: NONE 00297 C DEVICES: NONE 00298 C SGAS: NONE 00299 C EVENT FLAGS: NONE 00300 C SYSTEM DIR: NONE 00301 C LENGTH/PAR: 00302 C 00303 C****NOTES: 00304 C 00305 C;- 00306 SUBROUTINE ALESXP(SST,SFLX,ISTART,LEN,SEL,NXIFNO, 00307 1 LINENO,IOCLAS) 00308 C 00309 C SUBROUTINE CALL DECLARATIONS 00310 C 00311 INTEGER*2 SST(1),SFLX(1),ISTART,LEN,SEL(1),NXIFNO,LINENO,IOCLAS 00312 C 00313 C LOCAL DECLARATIONS 00314 C 00315 INTEGER*2 SCMP(6),SCOMMA(2),SBNEI(7) 00316 C 00317 DATA SCMP /10,2H ,2H ,2H ,2HCM,2HP / 00318 DATA SCOMMA /1,1H,/ 00319 DATA SBNEI /11,2H ,2H ,2H ,2HBN,2HE ,1HI/ 00320 C 00321 C PUT IN " CMP $," WHERE "$" IS FROM SELECT SUBCLAUSE 00322 C 00323 CALL CPYSTR(SST,SCMP) 00324 CALL CATSUB(SST,SFLX,ISTART+1,LEN-2) !LEAVE OUT () (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00007 ASUB,ASUB/-SP=ASUB 00325 CALL CATSTR(SST,SCOMMA) 00326 C 00327 C ADD ON CLAUSE FROM SELECT LINE 00328 C 00329 CALL CATSUB(SST,SEL,2,SEL(1)-2) !LEAVE OUT () 00330 C 00331 CALL PUT(LINENO,SST,IOCLAS) !PUT IT OUT 00332 C 00333 C NOW PUT OUT " BNE I'NXIFNO' 00334 C 00335 CALL CPYSTR(SST,SBNEI) 00336 CALL CATNUM(SST,NXIFNO) 00337 CALL PUT(LINENO,SST,IOCLAS) 00338 C 00339 RETURN 00340 END (FLECS VERSION 22.38) 00341 C;+ 00342 C - A L E R T S 00343 C****NAME: SUBROUTINE ALERTS 00344 C IDENT: /01MAR0/ 00345 C FILE: [201,13]ASUB.FLX 00346 C TKB: 00347 C 00348 C****PURPOSE: PUT OUT "RETURN FROM PROCEDURE" FOR ALECS 00349 C 00350 C****RESTRICTIONS: 00351 C 00352 C SYSTEM: RSX11M V3.2 00353 C LANGUAGE: FLECS/FORTRAN 00354 C AUTHOR: M. OOTHOUDT 00355 C DATE: 01-MAR-80 00356 C REVISIONS: 00357 C 00358 C****CALLING SEQUENCE: CALL ALERTS(LINENO,IOCLAS) 00359 C 00360 C INPUT: 00361 C 00362 C LINENO=(I*2) LINE NUMBER FOR INPUT LINE 00363 C IOCLASCL=(I*2) I/O CLASS FOR OUTPUT STREAM 00364 C 00365 C OUTPUT: NONE 00366 C 00367 C CMN BLOCK I/O: NONE 00368 C 00369 C****DIALOG: NONE 00370 C 00371 C RESOURCES: 00372 C LIBRARIES: NONE 00373 C OTHER SUBR: [201,13]PUT 00374 C DISK FILES: NONE 00375 C DEVICES: NONE 00376 C SGAS: NONE 00377 C EVENT FLAGS: NONE (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00008 ASUB,ASUB/-SP=ASUB 00378 C SYSTEM DIR: NONE 00379 C LENGTH/PAR: 00380 C 00381 C****NOTES: 00382 C 00383 C;- 00384 SUBROUTINE ALERTS(LINENO,IOCLAS) 00385 C 00386 C SUBROUTINE CALL DECLARATIONS 00387 C 00388 INTEGER*2 LINENO,IOCLAS 00389 C 00390 C LOCAL DECLARATIONS 00391 C 00392 INTEGER*2 SRTSPC(7) 00393 DATA SRTSPC /12,2H ,2H ,2H ,2HRT,2HS ,2HPC/ 00394 C 00395 C 00396 CALL PUT(LINENO,SRTSPC,IOCLAS) 00397 C 00398 RETURN 00399 END (FLECS VERSION 22.38) 00400 C;+ 00401 C - P U T L B L 00402 C****NAME: SUBROUTINE PUTLBL 00403 C IDENT: /20FEB0/ 00404 C FILE: DP1:[201,13]ASUB.FLX 00405 C TKB: 00406 C 00407 C****PURPOSE: PUT OUT MACRO LABEL 00408 C 00409 C****RESTRICTIONS: 00410 C 00411 C SYSTEM: RSX11M V3.2 00412 C LANGUAGE: FLECS/F4P 00413 C AUTHOR: M. OOTHOUDT 00414 C DATE: 20-FEB-80 00415 C REVISIONS: 00416 C 00417 C****CALLING SEQUENCE: CALL PUTLBL(LBLNUM,LINENO,IOCLAS) 00418 C 00419 C INPUT: 00420 C 00421 C LBLNUM=(I*2) NUMBER TO PUT IN THE LABEL 00422 C LINENO=(I*2) NUMBER OF INPUT LINE FROM WHICH INPUT CAME 00423 C IOCLAS=(I*2) I/O CLASS FOR OUTPUT STREAM 00424 C 00425 C OUTPUT: NONE 00426 C 00427 C CMN BLOCK I/O: NONE 00428 C 00429 C****DIALOG: NONE 00430 C (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00009 ASUB,ASUB/-SP=ASUB 00431 C RESOURCES: 00432 C LIBRARIES: NONE 00433 C OTHER SUBR: ENCODE, [201,13]PUT 00434 C DISK FILES: NONE 00435 C DEVICES: NONE 00436 C SGAS: NONE 00437 C EVENT FLAGS: NONE 00438 C SYSTEM DIR: NONE 00439 C LENGTH/PAR: 00440 C 00441 C****NOTES: 00442 C 1. THIS ROUTINE PUTS OUT A LABEL OF THE FORM "I32760:". 00443 C 00444 C;- 00445 SUBROUTINE PUTLBL(LBLNUM,LINENO,IOCLAS) 00446 C 00447 C SUBROUTINE CALL DECLARATIONS 00448 C 00449 INTEGER*2 LBLNUM,IOCLAS,LINENO 00450 C 00451 C LOCAL DECLARATIONS 00452 C 00453 BYTE BLABEL(8) 00454 INTEGER*2 SLABEL(5) 00455 EQUIVALENCE (BLABEL(1),SLABEL(2)) 00456 C 00457 DATA SLABEL/7,2HI ,2H ,2H ,1H:/ 00458 C 00459 C 00460 ENCODE(5,1,BLABEL(2))LBLNUM !INSERT # 00461 1 FORMAT(I5) 00462 C 00463 CALL PUT(LINENO,SLABEL,IOCLAS) !OUTPUT IT 00464 C 00465 RETURN 00466 END (FLECS VERSION 22.38) 00467 C;+ 00468 C - P U T L O G 00469 C****NAME: SUBROUTINE PUTLOG 00470 C IDENT: /20MAR0/ 00471 C FILE: [201,13]ASUB.FLX 00472 C TKB: 00473 C 00474 C****PURPOSE: PUT OUT CODE FOR LOGICAL CONDITIONS FOR ALECS (SEE NOTE 1 00475 C 00476 C****RESTRICTIONS: 00477 C 00478 C SYSTEM: RSX11M V3.2 00479 C LANGUAGE: FLECS/F4P 00480 C AUTHOR: M. OOTHOUDT 00481 C DATE: 20-MAR-80 00482 C REVISIONS: 00483 C (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00010 ASUB,ASUB/-SP=ASUB 00484 C****CALLING SEQUENCE: 00485 C 00486 C CALL PUTLOG(STRING,IBEGIN,LEN,NOTFLG,GOTONO,LINENO, 00487 C MAJCNT,ASSMCL,ERRCL) 00488 C 00489 C INPUT: 00490 C 00491 C STRING=(I*2 ARRAY) FLECS "STRING" CONTAINING INPUT LINE (SEE FLECS FOR 00492 C FOR DEFINITION OF "STRING" FORMAT). 00493 C IBEGIN=(I*2) # OF 1ST CHARACTER IN STRING CONTAINING LOGICAL CONDITION 00494 C TO PROCESS (SEE NOTE 2). 00495 C LEN =(I*2) NUMBER OF CHARACTERS IN LOGICAL CONDITION. 00496 C NOTFLG=(L*2) .T. IF (.NOT.CONDITION) MEANS "SKIP SCOPE;" .F. OTHERWISE 00497 C GOTONO=(I*2) NUMBER OF LABEL TO GOTO IF SCOPE MUST BE SKIPPED. 00498 C LINENO=(I*2) NUMBER OF LINE IN ALX FILE THAT STRING CAME FROM. 00499 C MAJCNT=(I*2) NUMBER OF ERRORS THAT HAVE OCCURED. 00500 C ASSMCL=(I*2) I/O CLASS NUMBER FOR FILE TO PUT ASSEMBLY LANGUAGE OUTPUT 00501 C ERRCL =(I*2) I/O CLASS NUMBER FOR FILE TO PUT ERROR MESSAGES INTO. 00502 C 00503 C OUTPUT: 00504 C 00505 C MAJCNT=(I*2) INCREMENTED BY ONE FOR EACH ERROR MESSAGE ISSUED. 00506 C 00507 C CMN BLOCK I/O: NONE 00508 C 00509 C****DIALOG: NONE 00510 C 00511 C RESOURCES: 00512 C LIBRARIES: NONE 00513 C OTHER SUBR: [201,13]CATNUM,CATSTR,CATSUB,CPYSTR,CPYSUB,NEWNO,PUT 00514 C PUTLBL 00515 C DISK FILES: NONE 00516 C DEVICES: NONE 00517 C SGAS: NONE 00518 C EVENT FLAGS: NONE 00519 C SYSTEM DIR: NONE 00520 C LENGTH/PAR: 00521 C 00522 C****NOTES: 00523 C 1. THIS SUBROUTINE HANDLES THE PARSING AND CODE GENERATION FOR 00524 C LOGICAL CONDITIONS. THE CONDITIONS MAY BE: 00525 C A LOGICAL VARIABLE, EG. R0.EQ.0-->.FALSE. WHILE R0.NE.0-->.TRUE.; 00526 C A:EQ:B, A:NE:B, A:GT:B, A:GE:B, A:LT:B, A:LE:B, A:SET.IN:B, A:CLR.IN: 00527 C :X.SET: OR :X.CLR: WHERE X=C, N, V, Z; 00528 C E1:AND:E2, E1:IOR:E2 WHERE EI IS ANY OF ABOVE. 00529 C SEE THE ALECS MANUAL FOR DETAILS. 00530 C 00531 C 2. THE INPUT "STRING" TO THIS SUBROUTINE SHOULD CONTAIN A LINE 00532 C OF THE FORM " WHEN (I:GT:J) CLR R0" WITH IBEGIN POINTING TO THE 00533 C LEFT PARENTHESIS (=12 IN THIS EXAMPLE) AND LEN BEING THE # OF CHARACTE 00534 C INCLUDING THE PARENTHESES (=8 IN THE EXAMPLE). 00535 C 00536 C;- 00537 SUBROUTINE PUTLOG(STRING,IBEGIN,LEN,NOTFLG,GOTONO,LINENO, 00538 1 MAJCNT,ASSMCL,ERRCL) (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00011 ASUB,ASUB/-SP=ASUB 00539 C 00540 C SUBROUTINE CALL DECLARATIONS 00541 C 00542 LOGICAL*2 NOTFLG 00543 INTEGER*2 STRING(1),IBEGIN,LEN,GOTONO,LINENO,MAJCNT, 00544 1 ASSMCL,ERRCL 00545 C 00546 C LOCAL DECLARATIONS 00547 C 00548 BYTE LINE(80),BTEMP(4),ISMOD,LFLAG,I1COND 00549 C 00550 INTEGER*2 NXTCHR,NCHAR,LENOP,SIGNOP,ITEMP,SLINE(41), 00551 1 STEMP(61),ICOL(6),IOPR1,IOPR2,SKPLBL,EXELBL,ERR, 00552 2 I,I1,ILEN,IOPD1,IOPD2,ITYPE,J,JTYPE,L1,LOPD1,LOPD2,NCOL,L,S 00553 C 00554 INTEGER*4 IITEMP 00555 C 00556 EQUIVALENCE (SLINE(2),LINE(1)),(BTEMP(1),ITEMP,IITEMP) 00557 C 00558 C STRING CONSTANTS--CODE GENERATION 00559 C 00560 INTEGER*2 SALPHA(14),SBEQ(7),SBGE(7),SBGT(7), 00561 1 SBHI(7),SBHIS(7),SBIT(6),SBLE(7),SBLO(7),SBLOS(7), 00562 2 SBLT(7),SBNE(7),SCC(5),SCCCLR(2,4),SCCSET(2,4),SCMP(6), 00563 3 SCOMMA(2),SSPACE(2),SSPI(2),STST(6) 00564 C 00565 C STRING CONSTANTS--ERROR MESSAGES 00566 C 00567 INTEGER*2 SCCOP(20),SERR(8),SILLOP(30),SNOCON(15),SCOM(24), 00568 1 SNOOP(14),SUNBAL(15),SUNDFN(16),SWNC(15),SILLCO(19),SILLMO(15) 00569 C 00570 C INITIALIZATION FOR STRINGS USED IN CODE GENERATION 00571 C 00572 C DATA SALPHA //ABCDEFGHIJKLMNOPQRSTUVWXYZ// 00573 DATA SALPHA /26,2HAB,2HCD,2HEF,2HGH,2HIJ,2HKL,2HMN,2HOP, 00574 1 2HQR,2HST,2HUV,2HWX,2HYZ/ 00575 C 00576 C DATA SBEQ // BEQ I// 00577 DATA SBEQ /11,2H ,2H ,2H ,2HBE,2HQ ,1HI/ 00578 C 00579 C DATA SBGE // BGE I// 00580 DATA SBGE /11,2H ,2H ,2H ,2HBG,2HE ,1HI/ 00581 C 00582 C DATA SBGT // BGT I// 00583 DATA SBGT /11,2H ,2H ,2H ,2HBG,2HT ,1HI/ 00584 C 00585 C DATA SBHI // BHI I// 00586 DATA SBHI /11,2H ,2H ,2H ,2HBH,2HI ,1HI/ 00587 C 00588 C DATA SBHI // BHIS I// 00589 DATA SBHIS /12,2H ,2H ,2H ,2HBH,2HIS,2H I/ 00590 C 00591 C DATA BIT // BIT // 00592 DATA SBIT /9,2H ,2H ,2H ,2HBI,1HT / 00593 C (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00012 ASUB,ASUB/-SP=ASUB 00594 C DATA SBLE // BLE I// 00595 DATA SBLE /11,2H ,2H ,2H ,2HBL,2HE ,1HI/ 00596 C 00597 C DATA SBLO // BLO I// 00598 DATA SBLO /11,2H ,2H ,2H ,2HBL,2HO ,1HI/ 00599 C 00600 C DATA SBLOS // BLOS I// 00601 DATA SBLOS /12,2H ,2H ,2H ,2HBL,2HOS,2H I/ 00602 C 00603 C DATA SBLT // BLT I// 00604 DATA SBLT /11,2H ,2H ,2H ,2HBL,2HT ,1HI/ 00605 C 00606 C DATA SBNE // BNE I// 00607 DATA SBNE /11,2H ,2H ,2H ,2HBN,2HE ,1HI/ 00608 C 00609 C DATA SCC // B// 00610 DATA SCC /7,2H ,2H ,2H ,1HB/ 00611 C 00612 C DATA SCCCLR //CC, VC, NE, PL// 00613 DATA SCCCLR /2,2HCC,2,2HVC,2,2HNE,2,2HPL/ 00614 C 00615 C DATA SCCSET //CS, VS, EQ, MI// 00616 DATA SCCSET /2,2HCS,2,2HVS,2,2HEQ,2,2HMI/ 00617 C 00618 C DATA SCMP // CMP// 00619 DATA SCMP / 9,2H ,2H ,2H ,2HCM,1HP/ 00620 C 00621 C DATA SCOMMA //,// 00622 DATA SCOMMA /1,1H,/ 00623 C 00624 C DATA SSPACE // // 00625 DATA SSPACE / 1,1H / 00626 C 00627 C DATA SSPI // I// 00628 DATA SSPI /2,2H I/ 00629 C 00630 C DATA STST // TST // 00631 DATA STST /10,2H ,2H ,2H ,2HTS,2HT / 00632 C 00633 C INITIALIZATION FOR ERROR MESSAGE STRINGS 00634 C 00635 C DATA SCCOP //***** (CONDITION CODE HAS OPERAND)// 00636 DATA SCCOP /37,2H**,2H**,2H* ,2H ,2H (,2HCO,2HND,2HIT,2HIO, 00637 1 2HN ,2HCO,2HDE,2H H,2HAS,2H O,2HPE,2HRA,2HND,1H)/ 00638 C 00639 C DATA SCOM //***** (CONDITION CODE MODIFIED BY 1ST TEST)// 00640 DATA SCOM/46,2H**,2H**,2H* ,2H ,2H (,2HCO,2HND,2HIT,2HIO, 00641 1 2HN ,2HCO,2HDE,2H M,2HOD,2HIF,2HIE,2HD ,2HBY,2H 1,2HST, 00642 2 2H T,2HES,2HT)/ 00643 C 00644 C DATA SERR //******ALE ERR// 00645 DATA SERR /13,2H**,2H**,2H**,2HAL,2HE ,2HER,1HR/ 00646 C 00647 C DATA SILLCO //***** (ILLEGAL COMPOUND LOCIGAL)// 00648 DATA SILLCO/35,2H**,2H**,2H* ,2H ,2H (,2HIL,2HLE,2HGA, (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00013 ASUB,ASUB/-SP=ASUB 00649 1 2HL ,2HCO,2HMP,2HOU,2HND,2H L,2HOG,2HIC,2HAL,1H)/ 00650 C 00651 C DATA SILLMO //***** (ILLEGAL MODIFIER)// 00652 DATA SILLMO/27,2H**,2H**,2H* ,2H ,2H (,2HIL,2HLE,2HGA, 00653 1 2HL ,2HMO,2HDI,2HFI,2HER,1H)/ 00654 C 00655 C DATA SILLOP //***** (ARITHMETIC OPERATOR USED WHERE LOGICAL R 00656 DATA SILLOP /58,2H**,2H**,2H* ,2H ,2H (,2HAR,2HIT,2HHM, 00657 1 2HET,2HIC,2H O,2HPE,2HRA,2HTO,2HR ,2HUS,2HED,2H W,2HHE, 00658 2 2HRE,2H L,2HOG,2HIC,2HAL,2H R,2HEQ,2HUI,2HRE,2HD)/ 00659 C 00660 C DATA SNOCON //***** (NOTHING IN PAREN)// 00661 DATA SNOCON /27,2H**,2H**,2H* ,2H ,2H (,2HNO,2HTH,2HIN, 00662 1 2HG ,2HIN,2H P,2HAR,2HEN,1H)/ 00663 C 00664 C DATA SNOOP //***** (MISSING OPERAND)// 00665 DATA SNOOP /26,2H**,2H**,2H* ,2H ,2H (,2HMI,2HSS,2HIN, 00666 1 2HG ,2HOP,2HER,2HAN,2HD)/ 00667 C 00668 C DATA SUNBAL //***** (UNBALANCED COLONS)// 00669 DATA SUNBAL /28,2H**,2H**,2H* ,2H ,2H (,2HUN,2HBA,2HLA, 00670 1 2HNC,2HED,2H C,2HOL,2HON,2HS)/ 00671 C 00672 C DATA SUNDFN //***** (UNDEFINED OPERATOR)// 00673 DATA SUNDFN /29,2H**,2H**,2H* ,2H ,2H (,2HUN,2HDE,2HFI, 00674 1 2HNE,2HD ,2HOP,2HER,2HAT,2HOR,1H)/ 00675 C 00676 C DATA SWNC //***** (WRONG # OF COLONS)// 00677 DATA SWNC /28,2H**,2H**,2H* ,2H ,2H (,2HWR,2HON,2HG ,2H# , 00678 1 2HOF,2H C,2HOL,2HON,2HS)/ 00679 C 00680 C---------------------------------------------------------------------- 00681 C 00682 C DATA DICTIONARY 00683 C 00684 C WARNING: VARIABLES MARKED "SCRATCH" MAY BE USED FREELY BY ANY 00685 C PROCEDURE FOR ANYTHING. OTHER VARIABLES MUST CONFORM TO ENTRY/EXIT 00686 C CONDITION SPECIFICATIONS. 00687 C 00688 C ASSMCL=(EXTERNAL, I*2) I/O CLASS FOR ASSEMBLY LANGUAGE OUTPUT STREAM. 00689 C BTEMP =(4L*1) SCRATCH ARRAY. NOTE EQUIV(BTEMP,ITEMP,IITEMP) 00690 C ERR =(I*2) PARSING ERROR FLAG 00691 C =0, NO ERROR 00692 C =1, NO CONTENT IN LOGICAL CONDITION 00693 C =2, UNBALANCED COLONS 00694 C =3, WRONG # OF COLONS 00695 C =4, UNDEFINED OPERATOR OR MODIFIER 00696 C =5, CONDITION CODE HAS OPERAND 00697 C =6, ILLEGAL COMPOUND LOGICAL 00698 C =7, OPERAND MISSING 00699 C =8, ILLEGAL OPERATOR 00700 C =9, ILLEGAL OPERATOR MODIFIER 00701 C =10, CONDITION CODE MODIFIED BY 1ST TEST 00702 C ERRCL =(EXTERNAL, I*2) I/O CLASS FOR ERROR MESSAGE STREAM. 00703 C EXELBL=(I*2) # OF LABEL TO GOTO IF WILL EXECUTE SCOPE. (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00014 ASUB,ASUB/-SP=ASUB 00704 C GOTONO=(EXTERNAL, I*2) NUMBER OF LABEL TO GOTO IF MUST SKIP SCOPE. 00705 C I =(I*2) SCRATCH VARIABLE 00706 C I1 =(I*2) POINTER INTO "LINE" TO START OF LOGICAL SUBCONDITION. 00707 C I1COND=(L*1) FOR COMPOUND, .T. IF 1ST OPERAND IS CONDITION CODE. 00708 C IBEGIN=(EXTERNAL, I*2) POINTER INTO "STRING" TO THE "(" AT BEGINNING 00709 C OF THE LOGICAL CONDITION TO PROCESS. 00710 C ICOL =(6I*2) POINTERS TO COLONS IN "LINE." 00711 C IITEMP=(I*4) SCRATCH VARIABLE. NOTE EQUIV(BTEMP,ITEMP,IITEMP). 00712 C ILEN =(I*2) # OF CHAR IN AN OPERATOR EXCLUDING COLONS AND MODIFIER. 00713 C IOPD1 =(I*2) POINTER INTO "LINE" TO START OF 1ST OPERAND 00714 C IOPD2 =(I*2) POINTER INTO "LINE" TO START OF 2ND OPERAND 00715 C IOPR1 =(I*2) POINTER INTO "LINE" TO COLON IN FRONT OF AN OPERATOR. 00716 C IOPR2 =(I*2) POINTER INTO "LINE" TO COLON AFTER AN OPERATOR. 00717 C ISMOD =(L*1) .T. IF OPERATOR HAS A MODIFIER; .F. OTHERWISE. 00718 C ITEMP =(I*2) SCRATCH VARIABLE. NOTE EQUIV(BTEMP,ITEMP,IITEMP). 00719 C ITYPE =(I*2) OPERATOR TYPE: 00720 C =1, :EQ: 00721 C =-1, :NE: 00722 C =2, :GT: 00723 C =-2, :LE: 00724 C =3, :LT: 00725 C =-3, :GE: 00726 C =4, :AND: 00727 C =-4, :IOR: 00728 C =5, :SET.IN: 00729 C =-5, :CLR.IN: 00730 C J =(I*2) SCRATCH VARIABLE 00731 C JTYPE =(I*2) SAVED VALUE OF ITYPE 00732 C L =(I*2) SCRATCH VARIABLE 00733 C L1 =(I*2) LENGTH OF LOGICAL SUBCONDITION POINTED TO BY I1. 00734 C LEN =(EXTERNAL, I*2) # OF CHARACTERS IN LOGICAL CONDITION IN "STRING 00735 C LENOP =(I*2) OPERATOR FLAG INDICATING LENGTH OF OPERANDS: 00736 C =1, BYTE 00737 C =2, WORD (2 BYTES) 00738 C =4, LONG WORD (4 BYTES, VAX ONLY) 00739 C LINE =(80L*1) ARRAY CONTAINING LOGICAL CONDITION EXCLUDING (). 00740 C NOTE EQUIV(SLINE(2),LINE(1)) 00741 C LINENO=(EXTERNAL, I*2) # OF LINE IN ALX FILE THAT "STRING" CAME FROM. 00742 C LFLAG =(L*1) LOGICAL FLAG RELATED TO NOTFLG. 00743 C LOPD1 =(I*2) LENGTH OF OPERAND POINTED TO BY IOPD1 00744 C LOPD2 =(I*2) LENGTH OF OPERAND POINTED TO BY IOPD2 00745 C MAJCNT=(EXTERNAL, I*2) # OF MAJOR ERRORS THAT HAVE OCCURRED. 00746 C NCHAR =(I*2) # OF CHARACTERS IN LOGICAL CONDITION IN "LINE." 00747 C NCOL =(I*2) # OF COLONS PRESENT IN THE LOGICAL CONDITION IN "LINE." 00748 C NOTFLG=(EXTERNAL, L*2) .T. IF (.NOT.CONDITION) MEANS "SKIP SCOPE." 00749 C NXTCHR=(I*2) POINTER INTO "LINE" TO NEXT NONBLANK CHARACTER. 00750 C S =(I*2) SCRATCH VARIABLE 00751 C SALPHA=(14I*2) ALPHABETICAL STRING, CONSTANT. 00752 C SBEQ =(7I*2) CODE STRING, CONSTANT. 00753 C SBGE =(7I*2) CODE STRING, CONSTANT. 00754 C SBGT =(7I*2) CODE STRING, CONSTANT. 00755 C SBHI =(7I*2) CODE STRING, CONSTANT. 00756 C SBHIS =(7I*2) CODE STRING, CONSTANT. 00757 C SBIT =(6I*2) CODE STRING, CONSTANT. 00758 C SBLE =(7I*2) CODE STRING, CONSTANT. (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00015 ASUB,ASUB/-SP=ASUB 00759 C SBLO =(7I*2) CODE STRING, CONSTANT. 00760 C SBLOS =(7I*2) CODE STRING, CONSTANT. 00761 C SBLT =(7I*2) CODE STRING, CONSTANT. 00762 C SBNE =(7I*2) CODE STRING, CONSTANT. 00763 C SCC =(5I*2) CODE STRING, CONSTANT. 00764 C SCCCLR=(2,4I*2) CODE STRING ARRAY, CONSTANTS. 00765 C SCCOP =(20I*2) ERROR MESSAGE STRING, CONSTANT. 00766 C SCCSET=(2,4I*2) CODE STRING ARRAY, CONSTANTS. 00767 C SCMP =(6I*2) CODE STRING, CONSTANT. 00768 C SCOMMA=(2I*2) COMMA STRING, CONSTANT. 00769 C SERR =(8I*2) ERROR STRING FOR ASSEMBLY LANGUAGE STREAM, CONSTANT. 00770 C SIGNOP=(I*2) SIGN STATUS OF OPERAND OF OPERATOR: 00771 C =0, UNSIGNED 00772 C =1, SIGNED 00773 C SILLCO=(19I*2) ERROR MESSAGE STRING, CONSTANT. 00774 C SILLMO=(15I*2) ERROR MESSAGE STRING, CONSTANT. 00775 C SILLOP=(30I*2) ERROR MESSAGE STRING, CONSTANT. 00776 C SKPLBL=(I*2) # OF LABEL TO GOTO IF MUST SKIP SCOPE. 00777 C SLINE =(41I*2) STRING CONTAINING LOGICAL CONDITION EXCLUDING (). 00778 C NOTE EQUIV (SLINE(2),LINE(1)). 00779 C SNOCON=(15I*2) ERROR MESSAGE STRING, CONSTANT. 00780 C SNOOP =(14I*2) ERROR MESSAGE STRING, CONSTANT. 00781 C SSPACE=(2I*2) SPACE STRING, CONSTANT. 00782 C SSPI =(2I*2) CODE STRING, CONSTANT. 00783 C STEMP =(61I*2) SCRATCH STRING. 00784 C STRING=(EXTERNAL, NI*2) FLECS STRING CONTAINING INPUT LINE. 00785 C STST =(6I*2) CODE STRING, CONSTANT. 00786 C SUNBAL=(15I*2) ERROR MESSAGE STRING, CONSTANT. 00787 C SUNDFN=(16I*2) ERROR MESSAGE STRING, CONSTANT. 00788 C SWNC =(15I*2) ERROR MESSAGE STRING, CONSTANT. 00789 C 00790 C---------------------------------------------------------------------- 00791 C 00792 C EXECUTABLE CODE 00793 C 00794 ERR=0 !NO ERRORS IN PARSING YET 00795 C 00796 C COPY LOGIC PART OF INPUT STRING INTO ARRAY "LINE" AND STRIP 00797 C OFF '(' AND ')'. 00798 C 00799 NCHAR=LEN-2 !# OF CHARACTERS IN "LINE" W/O () 00800 CALL CPYSUB(SLINE,STRING,IBEGIN+1,NCHAR) 00801 C 00802 C # OF COLONS IN THE LINE DETERMINES HOW TO PARSE IT 00803 C 00804 NCOL=0 00805 I=1 00806 WHILE(I.LE.NCHAR) 00807 . IF(LINE(I).EQ.1H:) 00808 . . NCOL=NCOL+1 00809 . . IF(NCOL.LT.7)ICOL(NCOL)=I 00810 . ...FIN 00811 . I=I+1 00812 ...FIN 00813 C (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00016 ASUB,ASUB/-SP=ASUB 00814 NXTCHR=1 !FIND 1ST NONBLANK CHARACTER IN "LINE" 00815 GET-NEXT-NONBLANK-CHAR 00816 C 00817 CONDITIONAL 00818 . (NXTCHR.GT.NCHAR)ERR=1 !NO CONTENT 00819 . (NCOL.EQ.0) 00820 . . I1=NXTCHR 00821 . . L1=NCHAR-I1+1 00822 . . LFLAG=NOTFLG 00823 . . SKPLBL=GOTONO 00824 . . PROCESS-LOGICAL-VARIABLE 00825 . ...FIN 00826 . (NCOL.EQ.2) 00827 . . I1=NXTCHR 00828 . . L1=NCHAR-I1+1 00829 . . LFLAG=NOTFLG 00830 . . SKPLBL=GOTONO 00831 . . IOPR1=ICOL(1) 00832 . . IOPR2=ICOL(2) 00833 . . PROCESS-SIMPLE-LOGICAL-OR-CONDITION-CODE 00834 . ...FIN 00835 . (NCOL.EQ.4)PROCESS-FOUR-COLONS 00836 . (NCOL.EQ.6)PROCESS-SIX-COLONS 00837 . (NCOL/2*2.NE.NCOL)ERR=2 !UNBALANCED COLONS 00838 . (OTHERWISE)ERR=3 !WRONG # OF COLONS 00839 ...FIN 00840 C 00841 IF(ERR.NE.0) 00842 . MAJCNT=MAJCNT+1 00843 C . 00844 C . FOR MAJOR ERRORS MAKE SURE MAC OUTPUT WILL NOT ASSEMBLE 00845 C . 00846 . CALL PUT(LINENO,SERR,ASSMCL) 00847 C . 00848 C . PUT OUT ERROR MESSAGE IN ERROR STREAM 00849 C . 00850 . SELECT(ERR) 00851 . . (1)CALL PUT(0,SNOCON,ERRCL) !NO CONTENT 00852 . . (2)CALL PUT(0,SUNBAL,ERRCL) !UNBALANCED COLONS 00853 . . (3)CALL PUT(0,SWNC ,ERRCL) !WRONG # OF COLONS 00854 . . (4)CALL PUT(0,SUNDFN,ERRCL) !UNDEFINED OPERATOR 00855 . . (5)CALL PUT(0,SCCOP ,ERRCL) !CC WITH OPERAND 00856 . . (6)CALL PUT(0,SILLCO,ERRCL) !ILLEGAL COMPOUND 00857 . . (7)CALL PUT(0,SNOOP ,ERRCL) !MISSING OPERAND 00858 . . (8)CALL PUT(0,SILLOP,ERRCL) !ILLEGAL OPERATOR 00859 . . (9)CALL PUT(0,SILLMO,ERRCL) !ILLEGAL MODIFIER 00860 . . (10)CALL PUT(0,SCOM, ERRCL) !MOD COND CODE 00861 . ...FIN 00862 ...FIN 00863 C 00864 C 00865 RETURN ---------------------------------------- (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00017 ASUB,ASUB/-SP=ASUB 00866 TO EVALUATE-ARITHMETIC-OPERATOR 00867 C . 00868 C . ITEM OF FORM :EQ:, :NE:, :GT:, :LE:, :LT:, :GE: 00869 C . 00870 C . ENTRY: IOPR1=LOCATION IN "LINE" OF 1ST COLON IN OPERATOR 00871 C . LINE=ARRAY CONTAINING LOGICAL CONDITION. 00872 C . 00873 C . EXIT: ITYPE=OPERATOR TYPE=1,-1,2,-2,3,-3 00874 C . ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. 00875 C . 00876 . BTEMP(1)=LINE(IOPR1+1) !NOTE EQUIV (BTEMP(1),ITEMP) 00877 . BTEMP(2)=LINE(IOPR1+2) 00878 . SELECT(ITEMP) 00879 . . (2HEQ)ITYPE=1 00880 . . (2HNE)ITYPE=-1 00881 . . (2HGT)ITYPE=2 00882 . . (2HLE)ITYPE=-2 00883 . . (2HLT)ITYPE=3 00884 . . (2HGE)ITYPE=-3 00885 . . (OTHERWISE)ERR=4 !UNDEFINED OPERATOR 00886 . ...FIN 00887 ...FIN ---------------------------------------- 00888 TO EVALUATE-BIT-OPERATOR 00889 C . 00890 C . ITEM OF FORM :SET.IN: OR :CLR.IN: 00891 C . 00892 C . ENTRY: IOPR1=LOCATION OF 1ST COLON IN OPERATOR 00893 C . LINE=ARRAY CONTAINING LOGICAL CONDITION 00894 C . 00895 C . EXIT: ITYPE=OPERATOR TYPE=5,-5 00896 C . ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. 00897 C . 00898 . WHEN(LINE(IOPR1+5).NE.1HI.OR.LINE(IOPR1+6).NE.1HN)ERR=4 !UNDFN OP 00899 . ELSE 00900 . . DO (I=1,4)BTEMP(I)=LINE(IOPR1+I) 00901 . . SELECT(IITEMP) 00902 . . . (4HSET.)ITYPE=5 00903 . . . (4HCLR.)ITYPE=-5 00904 . . . (OTHERWISE)ERR=4 !UNDEFINED OPERATOR 00905 . . ...FIN 00906 . ...FIN 00907 ...FIN ---------------------------------------- 00908 TO EVALUATE-LOGICAL-OPERATOR 00909 C . 00910 C . ITEM OF FORM :AND: OR :IOR: 00911 C . 00912 C . ENTRY: ISMOD=.T. IF OPERATOR HAS A MODIFIER 00913 C . IOPR1=LOCATION IN "LINE" OF 1ST COLON IN OPERATOR 00914 C . LINE=ARRAY CONTAINING LOGICAL CONDITION (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00018 ASUB,ASUB/-SP=ASUB 00915 C . 00916 C . EXIT: ITYPE=OPERATOR TYPE=4,-4 00917 C . ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. 00918 C . 00919 . DO (I=1,3)BTEMP(I)=LINE(IOPR1+I) 00920 . BTEMP(4)=1H !NOTE EQUIV (BTEMP(1),IITEMP) 00921 . CONDITIONAL 00922 . . (ISMOD)ERR=4 !UNDEFINED OPERATOR 00923 . . (IITEMP.EQ.4HAND )ITYPE=4 00924 . . (IITEMP.EQ.4HIOR )ITYPE=-4 00925 . . (OTHERWISE)ERR=4 !UNDEFINED OPERATOR 00926 . ...FIN 00927 ...FIN ---------------------------------------- 00928 TO EVALUATE-OPERATOR 00929 C . 00930 C . ENTRY: IOPR1=LOCATION IN "LINE" OF COLON IN FRONT OF OPERATOR. 00931 C . IOPR2=LOCATION IN "LINE" OF COLON AFTER OPERATOR. 00932 C . LINE=ARRAY CONTAINING LOGICAL CONDITION 00933 C . 00934 C . EXIT: LENOP=# OF BYTES IN OPERAND 00935 C . SIGNOP=SIGN TYPE OF OPERAND 00936 C . ISMOD=.T. IF OPERATOR HAS MODIFIER, .F. OTHERWISE. 00937 C . ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. 00938 C . ITYPE=OPERATOR TYPE=1,-1,2,-2,3,-3,4,-4,5,-5. 00939 C . ILEN=LENGTH OF OPERATOR. 00940 C . 00941 C . SET DEFAULTS FOR MODIFIERS 00942 C . 00943 . LENOP=2 !DEFAULT LENGTH TO "WORD" 00944 . SIGNOP=1 !DEFAULT TO "SIGNED" 00945 C . 00946 C . CHECK FOR EXISTENCE OF MODIFIER 00947 C . 00948 . I=IOPR1+1 00949 . WHILE(LINE(I).NE.1H:.AND.LINE(I).NE.1H_)I=I+1 00950 . ILEN=I-IOPR1-1 !LENGTH OF OPERATOR 00951 . WHEN(LINE(I).NE.1H_)ISMOD=.FALSE. 00952 . ELSE 00953 . . ISMOD=.TRUE. 00954 . . J=IOPR2-I-1 !MODIFIER LENGTH 00955 . . WHEN(J.LT.1.OR.J.GT.2)ERR=9 !ILLEGAL MODIFIER 00956 . . ELSE 00957 . . . L=0 !NO LENGTH MODIFIERS YET 00958 . . . S=0 !NO SIGN MODIFIERS YET 00959 . . . DO (ITEMP=1,J) 00960 . . . . SELECT(LINE(I+ITEMP)) 00961 . . . . . (1HW) 00962 . . . . . . LENOP=2 00963 . . . . . . L=L+1 00964 . . . . . ...FIN 00965 . . . . . (1HB) 00966 . . . . . . LENOP=1 (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00019 ASUB,ASUB/-SP=ASUB 00967 . . . . . . L=L+1 00968 . . . . . ...FIN 00969 . . . . . (1HL) 00970 . . . . . . LENOP=4 00971 . . . . . . L=L+1 00972 . . . . . ...FIN 00973 . . . . . (1HS) 00974 . . . . . . SIGNOP=1 00975 . . . . . . S=S+1 00976 . . . . . ...FIN 00977 . . . . . (1HU) 00978 . . . . . . SIGNOP=0 00979 . . . . . . S=S+1 00980 . . . . . ...FIN 00981 . . . . . (OTHERWISE)ERR=9 !ILLEGAL MODIFIER 00982 . . . . ...FIN 00983 . . . ...FIN 00984 . . . IF(S.GT.1.OR.L.GT.1)ERR=9 !ILLEGAL MODIFIER 00985 . . ...FIN 00986 . ...FIN 00987 C . 00988 C . NOW SET VALUE OF ITYPE 00989 C . 00990 . IF(ERR.EQ.0) 00991 . . SELECT(ILEN) 00992 . . . (2)EVALUATE-ARITHMETIC-OPERATOR 00993 . . . (3)EVALUATE-LOGICAL-OPERATOR 00994 . . . (6)EVALUATE-BIT-OPERATOR 00995 . . . (OTHERWISE)ERR=4 !UNDEFINED OPERATOR 00996 . . ...FIN 00997 . ...FIN 00998 ...FIN ---------------------------------------- 00999 TO GET-NEXT-NONBLANK-CHAR 01000 C . 01001 C . ENTRY: NXTCHR=LOCATION OF 1ST CHARACTER TO CHECK IN "LINE" 01002 C . 01003 C . EXIT: NXTCHR=LOCATION OF 1ST NONBLANK IN "LINE" OR IS 01004 C . >NCHAR IF IS NONE. 01005 C . 01006 . WHILE(NXTCHR.LE.NCHAR.AND.LINE(NXTCHR).EQ.1H )NXTCHR=NXTCHR+1 01007 ...FIN ---------------------------------------- 01008 TO PROCESS-ARITHMETIC-OPERATOR 01009 C . 01010 C . ENTRY: LENOP=# OF BYTES IN OPERAND 01011 C . IOPD1=START OF 1ST OPERAND 01012 C . LOPD1=LENGTH OF 1ST OPERAND 01013 C . IOPD2=START OF 2ND OPERAND 01014 C . LOPD2=LENGTH OF 2ND OPERAND 01015 C . LFLAG=LOGICAL FLAG (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00020 ASUB,ASUB/-SP=ASUB 01016 C . ITYPE=OPERAND TYPE 01017 C . SIGNOP=SIGN TYPE OF OPERANDS 01018 C . SKPLBL=# OF LABEL TO BRANCH TO IF MUST SKIP SCOPE 01019 C . SLINE=STRING CONTAINING CONDITION 01020 C . ASSMCL=I/O CLASS FOR ASSEMBLY LANGUAGE FILE 01021 C . LINENO=# OF LINE IN ALX FILE FROM WHICH "STRING" CAME 01022 C . 01023 C . EXIT: NONE 01024 C . 01025 C . FIRST PUT OUT " CMP[L/B] A,B" 01026 C . 01027 . CALL CPYSTR(STEMP,SCMP) 01028 . SELECT(LENOP) 01029 . . (1)CALL CATSUB(STEMP,SALPHA,2,1) !APPEND B 01030 . . (2)CONTINUE 01031 . . (4)CALL CATSUB(STEMP,SALPHA,12,1) !APPEND L 01032 . ...FIN 01033 . CALL CATSTR(STEMP,SSPACE) 01034 . CALL CATSUB(STEMP,SLINE,IOPD1,LOPD1) 01035 . CALL CATSTR(STEMP,SCOMMA) 01036 . CALL CATSUB(STEMP,SLINE,IOPD2,LOPD2) 01037 . CALL PUT(LINENO,STEMP,ASSMCL) 01038 C . 01039 C . NOW PUT OUT " B[*] I'SKPLBL'" 01040 C . 01041 . I=IABS(ITYPE) 01042 . SELECT(I) 01043 . . (1) 01044 . . . WHEN(LFLAG.XOR.ITYPE.LT.0)CALL CPYSTR(STEMP,SBNE) 01045 . . . ELSE CALL CPYSTR(STEMP,SBEQ) 01046 . . ...FIN 01047 . . (2) 01048 . . . WHEN(LFLAG.XOR.ITYPE.LT.0) 01049 . . . . WHEN(SIGNOP.NE.0)CALL CPYSTR(STEMP,SBLE) 01050 . . . . ELSE CALL CPYSTR(STEMP,SBLOS) 01051 . . . ...FIN 01052 . . . ELSE 01053 . . . . WHEN(SIGNOP.NE.0)CALL CPYSTR(STEMP,SBGT) 01054 . . . . ELSE CALL CPYSTR(STEMP,SBHI) 01055 . . . ...FIN 01056 . . ...FIN 01057 . . (3) 01058 . . . WHEN(LFLAG.XOR.ITYPE.LT.0) 01059 . . . . WHEN(SIGNOP.NE.0)CALL CPYSTR(STEMP,SBGE) 01060 . . . . ELSE CALL CPYSTR(STEMP,SBHIS) 01061 . . . ...FIN 01062 . . . ELSE 01063 . . . . WHEN(SIGNOP.NE.0)CALL CPYSTR(STEMP,SBLT) 01064 . . . . ELSE CALL CPYSTR(STEMP,SBLO) 01065 . . . ...FIN 01066 . . ...FIN 01067 . ...FIN 01068 C . 01069 C . ADD ON LABEL # AND OUTPUT IT 01070 C . (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00021 ASUB,ASUB/-SP=ASUB 01071 . CALL CATNUM(STEMP,SKPLBL) 01072 . CALL PUT(LINENO,STEMP,ASSMCL) 01073 ...FIN ---------------------------------------- 01074 TO PROCESS-BIT-OPERATOR 01075 C . 01076 C . ENTRY: LENOP=# OF BYTES IN OPERAND 01077 C . IOPD1=START OF OPERAND 1 01078 C . LOPD1=LENGTH OF OPERAND 1 01079 C . IOPD2=START OF OPERAND 2 01080 C . LOPD2=LENGTH OF OPERAND 2 01081 C . LFLAG=LOGICAL FLAG 01082 C . ITYPE=TYPE OF OPERATOR 01083 C . SKPLBL=# OF LABEL TO BRANCH TO IF MUST SKIP SCOPE 01084 C . SLINE=STRING CONTAINING CONDITION 01085 C . ASSMCL=I/O STREAM # FOR ASSEMBLY LANGUAGE FILE 01086 C . LINENO=# OF LINE IN ALX FILE FROM WHICH "STRING" CAME 01087 C . 01088 C . EXIT: NONE 01089 C . 01090 C . FIRST PUT OUT " BIT[L/B] A,B" 01091 C . 01092 . CALL CPYSTR(STEMP,SBIT) 01093 . SELECT(LENOP) 01094 . . (1)CALL CATSUB(STEMP,SALPHA,2,1) !APPEND B 01095 . . (2)CONTINUE 01096 . . (4)CALL CATSUB(STEMP,SALPHA,12,1) !APPEND L 01097 . ...FIN 01098 . CALL CATSTR(STEMP,SSPACE) 01099 . CALL CATSUB(STEMP,SLINE,IOPD1,LOPD1) 01100 . CALL CATSTR(STEMP,SCOMMA) 01101 . CALL CATSUB(STEMP,SLINE,IOPD2,LOPD2) 01102 . CALL PUT(LINENO,STEMP,ASSMCL) 01103 C . 01104 C . NOW PUT OUT B[EQ/NE] I'SKPLBL' 01105 C . 01106 . WHEN(LFLAG.XOR.ITYPE.LT.0)CALL CPYSTR(STEMP,SBEQ) 01107 . ELSE CALL CPYSTR(STEMP,SBNE) 01108 . CALL CATNUM(STEMP,SKPLBL) 01109 . CALL PUT(LINENO,STEMP,ASSMCL) 01110 ...FIN ---------------------------------------- 01111 TO PROCESS-CONDITION-CODE 01112 C . 01113 C . ITEM OF FORM :*.SET: OR :*.CLR: WHERE *=C,V,N,Z. 01114 C . 01115 C . ENTRY: I1=POINTER TO START OF ITEM 01116 C . L1=LENGTH OF ITEM 01117 C . IOPR1=POINTER TO 1ST COLON IN ITEM 01118 C . IOPR2=POINTER TO 2ND COLON IN ITEM 01119 C . LFLAG=LOGICAL FLAG (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00022 ASUB,ASUB/-SP=ASUB 01120 C . SKPLBL=# OF LABEL TO BRANCH TO IF MUST SKIP SCOPE 01121 C . LINE=ARRAY CONTAINING LOGICAL CONDITION 01122 C . ASSMCL=I/O STREAM # FOR ASSEMBLY LANGUAGE FILE. 01123 C . LINENO=# OF LINE IN ALX FILE FROM WHICH "STRING" CAME 01124 C . 01125 C . EXIT: NXTCHR=1ST NONBLANK AFTER CONDITION CODE EXPRESSION. 01126 C . ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. 01127 C . ITYPE=CONDITION CODE TYPE=1,2,3,4 01128 C . 01129 . CALL CPYSTR(STEMP,SCC) !" B" 01130 C . 01131 C . WE KNOW THERE IS NO LEADING OPERAND. BE SURE IS NO TRALING OP 01132 C . 01133 . J=IOPR1+1 !1ST CHAR IN OPERATOR 01134 . NXTCHR=IOPR2+1 01135 . GET-NEXT-NONBLANK-CHAR 01136 . CONDITIONAL 01137 . . (NXTCHR.LE.I1+L1-1.AND.LINE(NXTCHR).NE.1H:)ERR=5 !IS OPERAND 01138 . . ((IOPR2-IOPR1).NE.6)ERR=4 !UNDEFINED OPERATOR 01139 . . (LINE(J).EQ.1HC)ITYPE=1 01140 . . (LINE(J).EQ.1HV)ITYPE=2 01141 . . (LINE(J).EQ.1HZ)ITYPE=3 01142 . . (LINE(J).EQ.1HN)ITYPE=4 01143 . . (OTHERWISE)ERR=4 !UNDEFINED OPERATOR 01144 . ...FIN 01145 C . 01146 . IF(ERR.EQ.0) 01147 . . DO (I=1,4)BTEMP(I)=LINE(J+I) !GET TYPE; NOTE EQUIV(BTEMP,IITEMP) 01148 . . SELECT(IITEMP) 01149 . . . (4H.SET) 01150 . . . . WHEN(LFLAG)CALL CATSUB(STEMP,SCCCLR(1,ITYPE),1,2) 01151 . . . . ELSE CALL CATSUB(STEMP,SCCSET(1,ITYPE),1,2) 01152 . . . ...FIN 01153 . . . (4H.CLR) 01154 . . . . WHEN(LFLAG)CALL CATSUB(STEMP,SCCSET(1,ITYPE),1,2) 01155 . . . . ELSE CALL CATSUB(STEMP,SCCCLR(1,ITYPE),1,2) 01156 . . . ...FIN 01157 . . . (OTHERWISE)ERR=4 !UNDEFINED OPERATOR 01158 . . ...FIN 01159 . ...FIN 01160 . IF(ERR.EQ.0) 01161 C . . 01162 C . . APPEND LABEL TO BRANCH AND PUT OUT LINE 01163 C . . 01164 . . CALL CATSTR(STEMP,SSPI) 01165 . . CALL CATNUM(STEMP,SKPLBL) 01166 . . CALL PUT(LINENO,STEMP,ASSMCL) 01167 . ...FIN 01168 ...FIN ---------------------------------------- 01169 TO PROCESS-FOUR-COLONS 01170 C . 01171 C . ITEM OF FORM ":C.CLR: :LOP: A" WHERE :LOP: IS A LOGICAL OPERATOR (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00023 ASUB,ASUB/-SP=ASUB 01172 C . NOTE "A :LOP: G:OP:H" (OR "G:OP:H :LOP: A") ARE ILLEGAL SINCE 01173 C . IT IS AMBIGUOUS; IS IT "(A:LOP:G):OP:H" OR "A:LOP:(G:OP:H)"? 01174 C . NOTE A:LOP: :C.CLR: IS ILLEGAL SINCE THE TEST ON A CHANGES 01175 C . THE VALUE OF CBIT! 01176 C . 01177 C . ENTRY: ICOL=POINTERS TO COLONS IN "LINE." 01178 C . NXTCHR=1ST NONBLANK CHARACTER IN "LINE." 01179 C . GOTONO=LABEL TO GOTO IF MUST SKIP SCOPE 01180 C . NCHAR=NUMBER OF CHARACTERS IN "LINE." 01181 C . NOTFLG=.T. IF(.NOT.CONDITIONS)-->SKIP SCOPE. 01182 C . 01183 C . EXIT: ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. 01184 C . 01185 C . FIRST MAKE SURE CENTRAL OPERATOR IS A LOGICAL OPERATOR 01186 C . 01187 . I1COND=LINE(NXTCHR).EQ.1H: 01188 . WHEN(I1COND) 01189 . . IOPR1=ICOL(3) 01190 . . IOPR2=ICOL(4) 01191 . ...FIN 01192 . ELSE 01193 . . IOPR1=ICOL(1) 01194 . . IOPR2=ICOL(2) 01195 . ...FIN 01196 . EVALUATE-OPERATOR 01197 C . 01198 . IF(ERR.EQ.0) 01199 . . EXELBL=NEWNO(0) 01200 . . JTYPE=ITYPE !SAVE TYPE OF CENTRAL OPERATOR 01201 . . SELECT(ITYPE) 01202 . . . (4) 01203 . . . . LFLAG=.TRUE. 01204 . . . . WHEN(NOTFLG)SKPLBL=GOTONO 01205 . . . . ELSE SKPLBL=EXELBL 01206 . . . ...FIN 01207 . . . (-4) 01208 . . . . LFLAG=.FALSE. 01209 . . . . WHEN(NOTFLG)SKPLBL=EXELBL 01210 . . . . ELSE SKPLBL=GOTONO 01211 . . . ...FIN 01212 . . . (OTHERWISE)ERR=6 !ILLEGAL COMPOUND 01213 . . ...FIN 01214 . ...FIN 01215 . IF(ERR.EQ.0) 01216 . . I1=NXTCHR 01217 . . IOPR1=ICOL(1) 01218 . . IOPR2=ICOL(2) 01219 . . WHEN(I1COND) 01220 . . . L1=ICOL(3)-NXTCHR 01221 . . . PROCESS-CONDITION-CODE 01222 . . . IF(ERR.EQ.0) 01223 . . . . NXTCHR=ICOL(4)+1 01224 . . . . GET-NEXT-NONBLANK-CHAR 01225 . . . . I1=NXTCHR 01226 . . . . L1=NCHAR-I1+1 (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00024 ASUB,ASUB/-SP=ASUB 01227 . . . . IOPR1=ICOL(3) 01228 . . . . IOPR2=ICOL(4) 01229 . . . . SKPLBL=GOTONO 01230 . . . . LFLAG=NOTFLG 01231 . . . . PROCESS-LOGICAL-VARIABLE 01232 . . . . LFLAG=NOTFLG.XOR.(JTYPE.GT.0) 01233 . . . . IF(LFLAG.AND..NOT.ERR)CALL PUTLBL(EXELBL,LINENO,ASSMCL) 01234 . . . ...FIN 01235 . . ...FIN 01236 . . ELSE 01237 C . . . 01238 C . . . ERROR, SINCE 1ST ITEM IS NOT A CONDITION CODE. HOWEVER, 01239 C . . . THERE ARE 2 POSSIBLE CASES. 01240 C . . . 01241 . . . NXTCHR=ICOL(2)+1 01242 . . . GET-NEXT-NONBLANK-CHAR 01243 . . . WHEN(NXTCHR.LT.ICOL(3)) ERR=6 !ILLEGAL COMPOUND 01244 . . . ELSE ERR=10 !MODIFIED COND CODE 01245 . . ...FIN 01246 . ...FIN 01247 ...FIN ---------------------------------------- 01248 TO PROCESS-LOGICAL-VARIABLE 01249 C . 01250 C . INPUT WITHOUT ALECS SPECIAL CONDITIONS, EG. WHEN(A.XY(R0)+) 01251 C . 01252 C . ENTRY: I1=POINTER INTO "LINE" TO START OF VARIABLE 01253 C . L1=LENGTH OF ITEM 01254 C . LFLAG=LOGICAL FLAG 01255 C . SKPLBL=LABEL # TO JUMP TO IF MUST SKIP SCOPE. 01256 C . SLINE=STRING CONTAINING INPUT CONDITION 01257 C . LINENO=# OF LINE INPUT CAME FROM 01258 C . ASSMCL=I/O STREAM # FOR ASSEMBLY LANGUAGE FILE. 01259 C . 01260 C . EXIT: ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. 01261 C . 01262 C . FIRST PUT OUT " TST 'CONDITION'" 01263 C . 01264 . WHEN(L1.LT.1)ERR=1 !NO CONTENT 01265 . ELSE 01266 . . CALL CPYSTR(STEMP,STST) 01267 . . CALL CATSUB(STEMP,SLINE,I1,L1) 01268 . . CALL PUT(LINENO,STEMP,ASSMCL) 01269 C . . 01270 C . . PUT OUT B[NE/EQ] I'SKPLBL' 01271 C . . 01272 . . WHEN(LFLAG)CALL CPYSTR(STEMP,SBEQ) 01273 . . ELSE CALL CPYSTR(STEMP,SBNE) 01274 . . CALL CATNUM(STEMP,SKPLBL) 01275 . . CALL PUT(LINENO,STEMP,ASSMCL) 01276 . ...FIN 01277 ...FIN (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00025 ASUB,ASUB/-SP=ASUB ---------------------------------------- 01278 TO PROCESS-SIMPLE-AND-OR-IOR-OPERATOR 01279 C . 01280 C . ITEM OF FORM O1:LOP:O2 WHERE OI=LOGICAL EXPRESSION (0-->.FALSE., 01281 C . .TRUE. OTHERWISE), CONDITION CODE (EG. :C.CLR:) OR ARITHMETIC 01282 C . COMPARISON (EG. A:GT:B) AND LOP="AND" OR "IOR". 01283 C . 01284 C . ENTRY: IOPD1=LOCATION OF START OF 1ST OPERAND IN "LINE" 01285 C . LOPD1=LENGTH OF 1ST OPERAND 01286 C . IOPD2=LOCATION OF START OF 2ND OPERAND IN "LINE" 01287 C . LOPD2=LENGTH OF 2ND OPERAND 01288 C . SKPLBL=# OF LABEL TO JUMP TO IF MUST SKIP SCOPE. 01289 C . LFLAG=LOGICAL FLAG 01290 C . SLINE=STRING CONTAINING CONDITION 01291 C . LINENO=LINE # OF INPUT LINE 01292 C . ASSMCL=I/O STREAM # FOR ASSEMBLY LANGUAGE FILE 01293 C . ITYPE=TYPE OF OPERATOR 01294 C . 01295 C . EXIT: NONE 01296 C . 01297 . WHEN(LFLAG.XOR.ITYPE.LT.0)EXELBL=SKPLBL 01298 . ELSE EXELBL=NEWNO(0) 01299 C . 01300 C . FIRST PUT OUT " TST '1ST OPERAND'" 01301 C . 01302 . CALL CPYSTR(STEMP,STST) 01303 . CALL CATSUB(STEMP,SLINE,IOPD1,LOPD1) 01304 . CALL PUT(LINENO,STEMP,ASSMCL) 01305 C . 01306 C . NEXT " B[EQ/NE] I'EXELBL'" 01307 C . 01308 . WHEN(ITYPE.GT.0)CALL CPYSTR(STEMP,SBEQ) 01309 . ELSE CALL CPYSTR(STEMP,SBNE) 01310 . CALL CATNUM(STEMP,EXELBL) 01311 . CALL PUT(LINENO,STEMP,ASSMCL) 01312 C . 01313 C . NEXT " TST '2ND OPERAND'" 01314 C . 01315 . CALL CPYSTR(STEMP,STST) 01316 . CALL CATSUB(STEMP,SLINE,IOPD2,LOPD2) 01317 . CALL PUT(LINENO,STEMP,ASSMCL) 01318 C . 01319 C . NEXT " B[EQ/NE] I'SKPLBL'" 01320 C . 01321 . WHEN(LFLAG)CALL CPYSTR(STEMP,SBEQ) 01322 . ELSE CALL CPYSTR(STEMP,SBNE) 01323 . CALL CATNUM(STEMP,SKPLBL) 01324 . CALL PUT(LINENO,STEMP,ASSMCL) 01325 C . 01326 . IF(LFLAG.XOR.ITYPE.GT.0)CALL PUTLBL(EXELBL,LINENO,ASSMCL) 01327 ...FIN ---------------------------------------- (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00026 ASUB,ASUB/-SP=ASUB 01328 TO PROCESS-SIMPLE-LOGICAL 01329 C . 01330 C . ITEM OF FORM "A:OP:B" 01331 C . 01332 C . ENTRY: IOPR1=POINTER TO COLON IN FRONT OF OPERATOR 01333 C . IOPR2=POINTER TO COLON AFTER OPERATOR 01334 C . NCOL=# OF COLONS IN THE LINE 01335 C . I1=POINTER TO START OF LOGICAL CONDITION 01336 C . L1=LENGTH OF CONDITION 01337 C . 01338 C . EXIT: ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. 01339 C . 01340 C . FIRST GET THE OPERATOR 01341 C . 01342 . EVALUATE-OPERATOR 01343 . IF(ERR.EQ.0) 01344 . . I=IABS(ITYPE) 01345 . . IOPD1=I1 !START OF OPERAND 1 01346 . . LOPD1=IOPR1-IOPD1 !LENGTH OF OPERAND 1 01347 . . NXTCHR=IOPR2+1 01348 . . GET-NEXT-NONBLANK-CHAR 01349 . . IOPD2=NXTCHR !START OF OPERAND 2 01350 . . LOPD2=(I1+L1)-IOPD2 !LENGTH OF OPERAND 2 01351 . . CONDITIONAL 01352 . . . (LOPD1.LT.1.OR.LOPD2.LT.1)ERR=7 !MISSING OPERAND 01353 . . . (NCOL.GT.2.AND.I.EQ.4)ERR=6 !ILLEGAL COMPOUND 01354 . . . (OTHERWISE) 01355 . . . . SELECT(I) 01356 . . . . . (4)PROCESS-SIMPLE-AND-OR-IOR-OPERATOR 01357 . . . . . (5)PROCESS-BIT-OPERATOR 01358 . . . . . (OTHERWISE)PROCESS-ARITHMETIC-OPERATOR 01359 . . . . ...FIN 01360 . . . ...FIN 01361 . . ...FIN 01362 . ...FIN 01363 ...FIN ---------------------------------------- 01364 TO PROCESS-SIMPLE-LOGICAL-OR-CONDITION-CODE 01365 C . 01366 C . ITEM OF FORM "A:OP:B" OR ":*.SET:" 01367 C . DISTINGUISH BY PRESENCE/ABSENCE OF LEADING OPERAND. 01368 C . 01369 C . ENTRY: IOPR1=POINTER TO COLON IN FRONT OF OPERATOR 01370 C . I1=POINTER TO START OF LOGICAL CONDITION 01371 C . 01372 C . EXIT: ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. 01373 C . 01374 . WHEN(IOPR1.GT.I1)PROCESS-SIMPLE-LOGICAL 01375 . ELSE PROCESS-CONDITION-CODE 01376 ...FIN ---------------------------------------- (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00027 ASUB,ASUB/-SP=ASUB 01377 TO PROCESS-SIX-COLONS 01378 C . 01379 C . ITEM OF FORM ":C.SET: :AND: :V.SET:" OR ":C.SET: :AND: C:GT:D" 01380 C . OR "A:GT:B :AND: C:GT:D" 01381 C . NOTE C:GT:D :AND: :C.SET: IS ILLEGAL SINCE CBIT IS 01382 C . CHANGED BY CMP FOR GT! 01383 C . 01384 C . ENTRY: NXTCHR=POINTER TO 1ST NONBLANK CHARACTER IN "LINE." 01385 C . ICOL=LOCATIONS OF COLONS IN "LINE." 01386 C . GOTONO=# OF LABEL TO GOTO IF MUST SKIP SCOPE 01387 C . NOTFLG=.T. IF (.NOT.CONDITION)-->SKIP SCOPE 01388 C . 01389 C . EXIT: ERR.NE.0 IF FATAL PARSING ERROR. =0 OTHERWISE. 01390 C . 01391 C . FIRST MAKE SURE CENTRAL OPERATOR IS A LOGICAL OPERATOR 01392 C . 01393 . IOPR1=ICOL(3) 01394 . IOPR2=ICOL(4) 01395 . EVALUATE-OPERATOR 01396 C . 01397 . IF(ERR.EQ.0) 01398 . . EXELBL=NEWNO(0) 01399 . . JTYPE=ITYPE !SAVE TYPE OF CENTRAL OPERATOR 01400 . . SELECT(ITYPE) 01401 . . . (4) 01402 . . . . LFLAG=.TRUE. 01403 . . . . WHEN(NOTFLG)SKPLBL=GOTONO 01404 . . . . ELSE SKPLBL=EXELBL 01405 . . . ...FIN 01406 . . . (-4) 01407 . . . . LFLAG=.FALSE. 01408 . . . . WHEN(NOTFLG)SKPLBL=EXELBL 01409 . . . . ELSE SKPLBL=GOTONO 01410 . . . ...FIN 01411 . . . (OTHERWISE)ERR=8 !ILLEGAL OPERATOR FOR COMPOUND 01412 . . ...FIN 01413 . ...FIN 01414 . IF(ERR.EQ.0) 01415 . . I1=NXTCHR !START OF 1ST LOGICAL SUBCONDITION 01416 . . L1=ICOL(3)-NXTCHR !LENGTH OF IT 01417 . . IOPR1=ICOL(1) 01418 . . IOPR2=ICOL(2) 01419 . . I1COND=IOPR1.EQ.I1 !.T. IF IS CONDITION CODE 01420 . . PROCESS-SIMPLE-LOGICAL-OR-CONDITION-CODE 01421 . . IF(ERR.EQ.0) 01422 . . . NXTCHR=ICOL(4)+1 01423 . . . GET-NEXT-NONBLANK-CHAR 01424 . . . I1=NXTCHR 01425 . . . L1=NCHAR-I1+1 01426 . . . IOPR1=ICOL(5) 01427 . . . IOPR2=ICOL(6) 01428 . . . WHEN(IOPR1.EQ.I1.AND..NOT.I1COND)ERR=10 01429 . . . ELSE 01430 . . . . SKPLBL=GOTONO 01431 . . . . LFLAG=NOTFLG (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00028 ASUB,ASUB/-SP=ASUB 01432 . . . . PROCESS-SIMPLE-LOGICAL-OR-CONDITION-CODE 01433 . . . . LFLAG=NOTFLG.XOR.(JTYPE.GT.0) 01434 . . . . IF(LFLAG.AND..NOT.ERR)CALL PUTLBL(EXELBL,LINENO,ASSMCL) 01435 . . . ...FIN 01436 . . ...FIN 01437 . ...FIN 01438 ...FIN 01439 END ---------------------------------------- PROCEDURE CROSS-REFERENCE TABLE 00866 EVALUATE-ARITHMETIC-OPERATOR 00992 00888 EVALUATE-BIT-OPERATOR 00994 00908 EVALUATE-LOGICAL-OPERATOR 00993 00928 EVALUATE-OPERATOR 01196 01342 01395 00999 GET-NEXT-NONBLANK-CHAR 00815 01135 01224 01242 01348 01423 01008 PROCESS-ARITHMETIC-OPERATOR 01358 01074 PROCESS-BIT-OPERATOR 01357 01111 PROCESS-CONDITION-CODE 01221 01375 01169 PROCESS-FOUR-COLONS 00835 01248 PROCESS-LOGICAL-VARIABLE 00824 01231 01278 PROCESS-SIMPLE-AND-OR-IOR-OPERATOR 01356 01328 PROCESS-SIMPLE-LOGICAL 01374 01364 PROCESS-SIMPLE-LOGICAL-OR-CONDITION-CODE 00833 01420 01432 01377 PROCESS-SIX-COLONS 00836 (FLECS VERSION 22.38) 18-NOV-82 16:13:24 PAGE 00029 ASUB,ASUB/-SP=ASUB (FLECS VERSION 22.38) ASUB,ASUB/-SP=ASUB