C;+ C - A L E B R I C****NAME: SUBROUTINE ALEBRI C IDENT: /01MAR0/ C FILE: [201,13]ASUB.FLX C TKB: C C****PURPOSE: PUT OUT LINE OF FORM "BR I32760" FOR ALECS C C****RESTRICTIONS: C C SYSTEM: RSX11M V3.2 C LANGUAGE: FLECS/FORTRAN C AUTHOR: M. OOTHOUDT C DATE: 01-MAR-80 C REVISIONS: C C****CALLING SEQUENCE: CALL ALEBRI(NUMBER,LINENO,IOCLAS) C C INPUT: C C NUMBER=(I*2) NUMBER OF LABEL TO BRANCH TO C LINENO=(I*2) NUMBER OF SOURCE LINE INPUT CAME FROM C IOCLAS=(I*2) I/0 CLASS FOR OUTPUT STREAM C C OUTPUT: NONE C C CMN BLOCK I/O: NONE C C****DIALOG: NONE C C RESOURCES: C LIBRARIES: NONE C OTHER SUBR: ENCODE, [201,13]PUT C DISK FILES: NONE C DEVICES: NONE C SGAS: NONE C EVENT FLAGS: NONE C SYSTEM DIR: NONE C LENGTH/PAR: C C****NOTES: C C;- SUBROUTINE ALEBRI(NUMBER,LINENO,IOCLAS) C C SUBROUTINE CALL DECLARATIONS C INTEGER*2 NUMBER,LINENO,IOCLAS C C LOCAL DECLARATIONS C INTEGER*2 SBRI(9) DATA SBRI/15,2H ,2H ,2H ,2HBR,2H I,2H ,2H ,1H / C ENCODE(5,1,SBRI(7))NUMBER 1 FORMAT(I5) C CALL PUT(LINENO,SBRI,IOCLAS) C RETURN END C;+ C - A L E D O C****NAME: SUBROUTINE ALEDO C IDENT: /20MAR0/ C FILE: [201,13]ASUB.FLX C TKB: C C****PURPOSE: PROCESS DO STATEMENT FOR ALECS C C****RESTRICTIONS: C C SYSTEM: RSX11M V3.2 C LANGUAGE: FLECS/FORTRAN C AUTHOR: M. OOTHOUDT C DATE: 20-MAR-80 C REVISIONS: C C****CALLING SEQUENCE: C C CALL ALEDO(SST,SFLX,ISTART,LEN,CONTNO,NEXTNO,GSTNO,LINENO,MAJCNT, C FORTCL,ERRCL) C C INPUT: C C SST =(I*2) SCRATCH ARRAY C SFLX =(I*2) STRING CONTAINING DO SPECIFIER FROM INPUT LINE C ISTART=(I*2) # OF FIRST CHARACTER OF DO SPECIFIER (SEE NOTE 1) C LEN =(I*2) NUMBER OF CHARACTERS IN DO SPECIFIER C CONTNO=(I*2) LABEL NUMBER FOR HEAD OF LOOP C NEXTNO=(I*2) LABEL NUMBER FOR HEAD OF SCOPE C GSTNO =(I*2) LABEL NUMBER FOR LOOP EXIT JUMP C LINENO=(I*2) LINE # FOR INPUT LINE C MAJCNT=(I*2) COUNT OF MAJOR ERRORS THAT HAVE OCCURRED. C FORTCL=(I*2) CLASS SPECIFIER FOR MAC FILE. C ERRCL =(I*2) CLASS SPECIFIER FOR ERROR OUTPUT LISTING. C C OUTPUT: C C MAJCNT=(I*2) INCREMENTED BY 1 FOR EACH PARSING ERROR. C C CMN BLOCK I/O: NONE C C****DIALOG: NONE C C RESOURCES: C LIBRARIES: NONE C OTHER SUBR: [201,13]PUT C DISK FILES: NONE C DEVICES: NONE C SGAS: NONE C EVENT FLAGS: NONE C SYSTEM DIR: NONE C LENGTH/PAR: C C****NOTES: C 1. WHEN ALEDO IS CALLED BY ALECS, THE STRING SFLX SHOULD C CONTAIN A STRING OF THE FORM " DO (E=E1,E2 [,E3])" WHERE ISTART C POINTS TO THE FIRST PARENTHESIS AND LEN INCLUDES THE LAST PAREN. C NOTE E3 IS OPTIONAL AND IF NOT GIVEN DEFAULTS TO "#1". THE EXPANSION C OF THE DO FOLLOWS DEC FORTRAN CONVENTIONS, EG. THE LOOP IS ALWAYS C EXECUTED AT LEAST ONCE. C C 2. SEVERAL PLACES IN THIS SUBROUTINE LINES OF THE FORM C I="54 OCCUR INSTEAD OF I=1H, THE REASON FOR THIS IS THAT THE FORMER C PUTS I="54 WHEREAS THE LATTER PUTS I="20054! C C 3. THE DO LOOP HAS NOT BEEN IMPLEMENTED BECAUSE IT IS NOT C CLEAR IF IT WOULD REALLY BE USEFUL IN MACRO--WHAT IS REALLY NEEDED C IS A SOB LOOP, WHICH CORRESPONDS TO "DO (RI=N,1,#-1)," A VERY SMALL C SUBSET OF "DO." IN ADDITION THE CODE FOR A DO LOOP IS VERY COMPLEX. C THE EXPANSION GIVEN BELOW FOR REFERENCE IS NEEDED BECAUSE IDELTA C MAY BE POSITIVE OR NEGATIVE. C C DO (I=ISTART,IEND,IDELTA)$ ;($=SCOPE) C C .=.+2 C I32759: .WORD 0 ;LOOP TRAVEL COUNTER C PUSH C MOV IEND,R5 C SUB ISTART,R5 ;R5=IEND-ISTART C SXT R4 ;DIV NEEDS 32 BIT QUOTIENT C DIV IDELTA,R4 ;R4=(IEND-ISTART)/IDELTA C MOV R4,I32759 ;# OF TIMES TO TRAVEL LOOP C POP C MOV ISTART,I ;INITIAL VALUE OF I C BR I'NEXTNO' ;EXECUTE LOOP AT LEAST ONCE C I'CONTNO': C ADD IDELTA,I ;NEXT VALUE OF I C DEC I32759 ;FINISHED? C BLT I'GSTNO' ;<0-->YES C I'NEXTNO': C $ ;SCOPE C BR I'CONTNO' ;CHECK LOOP COUNTER C I'GSTNO': C C NOTE EVERY THING AFTER I'NEXTNO': IS GENERATED ELSEWHERE IN ALECS. C C;- SUBROUTINE ALEDO(SST,SFLX,ISTART,LEN,CONTNO,NEXTNO,GSTNO, 1 LINENO,MAJCNT,FORTCL,ERRCL) C C SUBROUTINE CALL DECLARATIONS C INTEGER SST(1),SFLX(1),ISTART,LEN,CONTNO,NEXTNO,GSTNO,MAJCNT, 1 LINENO,FORTCL,ERRCL C C LOCAL DECLARATIONS C INTEGER*2 SNOTIM(19), SERR(8) C C C DATA SNOTIM //***** (DO LOOPS NOT IMPLEMENTED)// DATA SNOTIM/35,2H**,2H**,2H* ,2H ,2H (,2HDO,2H L,2HOO, 1 2HPS,2H N,2HOT,2H I,2HMP,2HLE,2HME,2HNT,2HED,1H)/ C C DATA SERR //******ALE ERR// DATA SERR/13,2H**,2H**,2H**,2HAL,2HE ,2HER,1HR/ C C MAJCNT=MAJCNT+1 CALL PUT(0,SNOTIM,ERRCL) !DO LOOPS NOT IMPLEMENTED C C MAKE SURE ASSEMBLY LANGUAGE FILE WILL NOT ASSEMBLE C CALL PUT(LINENO,SERR,FORTCL) C C RETURN END C;+ C - A L E I N V C****NAME: SUBROUTINE ALEINV C IDENT: /01MAR0/ C FILE: [201,13]ASUB.FLX C TKB: C C****PURPOSE: PUT OUT PROCEDURE INVOCATION FOR ALECS C C****RESTRICTIONS: C C SYSTEM: RSX11M V3.2 C LANGUAGE: FLECS/FORTRAN C AUTHOR: M. OOTHOUDT C DATE: 01-MAR-80 C REVISIONS: C C****CALLING SEQUENCE: CALL ALEINV(NUMBER,LINENO,IOCLAS) C C INPUT: C C NUMBER=(I*2) LABEL NUMBER FOR ENTRANCE TO PROCEDURE C LINENO=(I*2) LINE NUMBER FOR INPUT LINE C IOCLAS=(I*2) I/O CLASS FOR OUTPUT STREAM C C OUTPUT: NONE C C CMN BLOCK I/O: NONE C C****DIALOG: NONE C C RESOURCES: C LIBRARIES: NONE C OTHER SUBR: ENCODE, [201,13]PUT C DISK FILES: NONE C DEVICES: NONE C SGAS: NONE C EVENT FLAGS: NONE C SYSTEM DIR: NONE C LENGTH/PAR: C C****NOTES: C C;- SUBROUTINE ALEINV(NUMBER,LINENO,IOCLAS) C C SUBROUTINE CALL DECLARATIONS C INTEGER*2 NUMBER,LINENO,IOCLAS C C LOCAL DECLARATIONS C INTEGER*2 SJSRPC(11) C DATA SJSRPC/19,2H ,2H ,2H ,2HJS,2HR ,2HPC,2H,I,2H ,2H ,1H / C ENCODE(5,1,SJSRPC(9))NUMBER 1 FORMAT(I5) C CALL PUT(LINENO,SJSRPC,IOCLAS) C RETURN END C;+ C - A L E S X P C****NAME: SUBROUTINE ALESXP C IDENT: /01MAR0/ C FILE: [201,13]ASUB.FLX C TKB: C C****PURPOSE: PROCESS SELECT SUBCLAUSE FOR ALECS C C****RESTRICTIONS: C C SYSTEM: RSX11M V3.2 C LANGUAGE: FLECS/FORTRAN C AUTHOR: M. OOTHOUDT C DATE: 01-MAR-80 C REVISIONS: C C****CALLING SEQUENCE: C C CALL ALEXSP(SST,SFLX,ISTART,LEN,SEL,NXIFNO,LINENO,IOCLAS) C C INPUT: C C SST =(I*2) SCRATCH ARRAY C SFLX =(STRING) INPUT LINE C ISTART=(I*2) FIRST CHARACTER IN SFLX TO BE EVALUATED C LEN =(I*2) NUMBER OF CHARACTERS IN SFLX TO EVALUATE C SEL =(STRING) CLAUSE FROM SELECT LINE C NXIFNO=(I*2) LABEL NUMBER FOR NEXT SUBCLAUSE C LINENO=(I*2) NUMBER OF INPUT LINE C IOCLAS=(I*2) I/O CLASS FOR OUTPUT STREAM C C OUTPUT: NONE C C CMN BLOCK I/O: NONE C C****DIALOG: NONE C C RESOURCES: C LIBRARIES: NONE C OTHER SUBR: [201,13]CATNUM,CATSTR,CATSUB,CPYSTR,PUT C DISK FILES: NONE C DEVICES: NONE C SGAS: NONE C EVENT FLAGS: NONE C SYSTEM DIR: NONE C LENGTH/PAR: C C****NOTES: C C;- SUBROUTINE ALESXP(SST,SFLX,ISTART,LEN,SEL,NXIFNO, 1 LINENO,IOCLAS) C C SUBROUTINE CALL DECLARATIONS C INTEGER*2 SST(1),SFLX(1),ISTART,LEN,SEL(1),NXIFNO,LINENO,IOCLAS C C LOCAL DECLARATIONS C INTEGER*2 SCMP(6),SCOMMA(2),SBNEI(7) C DATA SCMP /10,2H ,2H ,2H ,2HCM,2HP / DATA SCOMMA /1,1H,/ DATA SBNEI /11,2H ,2H ,2H ,2HBN,2HE ,1HI/ C C PUT IN " CMP $," WHERE "$" IS FROM SELECT SUBCLAUSE C CALL CPYSTR(SST,SCMP) CALL CATSUB(SST,SFLX,ISTART+1,LEN-2) !LEAVE OUT () CALL CATSTR(SST,SCOMMA) C C ADD ON CLAUSE FROM SELECT LINE C CALL CATSUB(SST,SEL,2,SEL(1)-2) !LEAVE OUT () C CALL PUT(LINENO,SST,IOCLAS) !PUT IT OUT C C NOW PUT OUT " BNE I'NXIFNO' C CALL CPYSTR(SST,SBNEI) CALL CATNUM(SST,NXIFNO) CALL PUT(LINENO,SST,IOCLAS) C RETURN END C;+ C - A L E R T S C****NAME: SUBROUTINE ALERTS C IDENT: /01MAR0/ C FILE: [201,13]ASUB.FLX C TKB: C C****PURPOSE: PUT OUT "RETURN FROM PROCEDURE" FOR ALECS C C****RESTRICTIONS: C C SYSTEM: RSX11M V3.2 C LANGUAGE: FLECS/FORTRAN C AUTHOR: M. OOTHOUDT C DATE: 01-MAR-80 C REVISIONS: C C****CALLING SEQUENCE: CALL ALERTS(LINENO,IOCLAS) C C INPUT: C C LINENO=(I*2) LINE NUMBER FOR INPUT LINE C IOCLASCL=(I*2) I/O CLASS FOR OUTPUT STREAM C C OUTPUT: NONE C C CMN BLOCK I/O: NONE C C****DIALOG: NONE C C RESOURCES: C LIBRARIES: NONE C OTHER SUBR: [201,13]PUT C DISK FILES: NONE C DEVICES: NONE C SGAS: NONE C EVENT FLAGS: NONE C SYSTEM DIR: NONE C LENGTH/PAR: C C****NOTES: C C;- SUBROUTINE ALERTS(LINENO,IOCLAS) C C SUBROUTINE CALL DECLARATIONS C INTEGER*2 LINENO,IOCLAS C C LOCAL DECLARATIONS C INTEGER*2 SRTSPC(7) DATA SRTSPC /12,2H ,2H ,2H ,2HRT,2HS ,2HPC/ C C CALL PUT(LINENO,SRTSPC,IOCLAS) C RETURN END C;+ C - P U T L B L C****NAME: SUBROUTINE PUTLBL C IDENT: /20FEB0/ C FILE: DP1:[201,13]ASUB.FLX C TKB: C C****PURPOSE: PUT OUT MACRO LABEL C C****RESTRICTIONS: C C SYSTEM: RSX11M V3.2 C LANGUAGE: FLECS/F4P C AUTHOR: M. OOTHOUDT C DATE: 20-FEB-80 C REVISIONS: C C****CALLING SEQUENCE: CALL PUTLBL(LBLNUM,LINENO,IOCLAS) C C INPUT: C C LBLNUM=(I*2) NUMBER TO PUT IN THE LABEL C LINENO=(I*2) NUMBER OF INPUT LINE FROM WHICH INPUT CAME C IOCLAS=(I*2) I/O CLASS FOR OUTPUT STREAM C C OUTPUT: NONE C C CMN BLOCK I/O: NONE C C****DIALOG: NONE C C RESOURCES: C LIBRARIES: NONE C OTHER SUBR: ENCODE, [201,13]PUT C DISK FILES: NONE C DEVICES: NONE C SGAS: NONE C EVENT FLAGS: NONE C SYSTEM DIR: NONE C LENGTH/PAR: C C****NOTES: C 1. THIS ROUTINE PUTS OUT A LABEL OF THE FORM "I32760:". C C;- SUBROUTINE PUTLBL(LBLNUM,LINENO,IOCLAS) C C SUBROUTINE CALL DECLARATIONS C INTEGER*2 LBLNUM,IOCLAS,LINENO C C LOCAL DECLARATIONS C BYTE BLABEL(8) INTEGER*2 SLABEL(5) EQUIVALENCE (BLABEL(1),SLABEL(2)) C DATA SLABEL/7,2HI ,2H ,2H ,1H:/ C C ENCODE(5,1,BLABEL(2))LBLNUM !INSERT # 1 FORMAT(I5) C CALL PUT(LINENO,SLABEL,IOCLAS) !OUTPUT IT C RETURN END C;+ C - P U T L O G C****NAME: SUBROUTINE PUTLOG C IDENT: /20MAR0/ C FILE: [201,13]ASUB.FLX C TKB: C C****PURPOSE: PUT OUT CODE FOR LOGICAL CONDITIONS FOR ALECS (SEE NOTE 1). C C****RESTRICTIONS: C C SYSTEM: RSX11M V3.2 C LANGUAGE: FLECS/F4P C AUTHOR: M. OOTHOUDT C DATE: 20-MAR-80 C REVISIONS: C C****CALLING SEQUENCE: C C CALL PUTLOG(STRING,IBEGIN,LEN,NOTFLG,GOTONO,LINENO, C MAJCNT,ASSMCL,ERRCL) C C INPUT: C C STRING=(I*2 ARRAY) FLECS "STRING" CONTAINING INPUT LINE (SEE FLECS FOR C FOR DEFINITION OF "STRING" FORMAT). C IBEGIN=(I*2) # OF 1ST CHARACTER IN STRING CONTAINING LOGICAL CONDITION C TO PROCESS (SEE NOTE 2). C LEN =(I*2) NUMBER OF CHARACTERS IN LOGICAL CONDITION. C NOTFLG=(L*2) .T. IF (.NOT.CONDITION) MEANS "SKIP SCOPE;" .F. OTHERWISE. C GOTONO=(I*2) NUMBER OF LABEL TO GOTO IF SCOPE MUST BE SKIPPED. C LINENO=(I*2) NUMBER OF LINE IN ALX FILE THAT STRING CAME FROM. C MAJCNT=(I*2) NUMBER OF ERRORS THAT HAVE OCCURED. C ASSMCL=(I*2) I/O CLASS NUMBER FOR FILE TO PUT ASSEMBLY LANGUAGE OUTPUT INTO. C ERRCL =(I*2) I/O CLASS NUMBER FOR FILE TO PUT ERROR MESSAGES INTO. C C OUTPUT: C C MAJCNT=(I*2) INCREMENTED BY ONE FOR EACH ERROR MESSAGE ISSUED. C C CMN BLOCK I/O: NONE C C****DIALOG: NONE C C RESOURCES: C LIBRARIES: NONE C OTHER SUBR: [201,13]CATNUM,CATSTR,CATSUB,CPYSTR,CPYSUB,NEWNO,PUT C PUTLBL C DISK FILES: NONE C DEVICES: NONE C SGAS: NONE C EVENT FLAGS: NONE C SYSTEM DIR: NONE C LENGTH/PAR: C C****NOTES: C 1. THIS SUBROUTINE HANDLES THE PARSING AND CODE GENERATION FOR ALECS C LOGICAL CONDITIONS. THE CONDITIONS MAY BE: C A LOGICAL VARIABLE, EG. R0.EQ.0-->.FALSE. WHILE R0.NE.0-->.TRUE.; 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:B; C :X.SET: OR :X.CLR: WHERE X=C, N, V, Z; C E1:AND:E2, E1:IOR:E2 WHERE EI IS ANY OF ABOVE. C SEE THE ALECS MANUAL FOR DETAILS. C C 2. THE INPUT "STRING" TO THIS SUBROUTINE SHOULD CONTAIN A LINE C OF THE FORM " WHEN (I:GT:J) CLR R0" WITH IBEGIN POINTING TO THE C LEFT PARENTHESIS (=12 IN THIS EXAMPLE) AND LEN BEING THE # OF CHARACTERS C INCLUDING THE PARENTHESES (=8 IN THE EXAMPLE). C C;- SUBROUTINE PUTLOG(STRING,IBEGIN,LEN,NOTFLG,GOTONO,LINENO, 1 MAJCNT,ASSMCL,ERRCL) C C SUBROUTINE CALL DECLARATIONS C LOGICAL*2 NOTFLG INTEGER*2 STRING(1),IBEGIN,LEN,GOTONO,LINENO,MAJCNT, 1 ASSMCL,ERRCL C C LOCAL DECLARATIONS C BYTE LINE(80),BTEMP(4),ISMOD,LFLAG,I1COND C INTEGER*2 NXTCHR,NCHAR,LENOP,SIGNOP,ITEMP,SLINE(41), 1 STEMP(61),ICOL(6),IOPR1,IOPR2,SKPLBL,EXELBL,ERR, 2 I,I1,ILEN,IOPD1,IOPD2,ITYPE,J,JTYPE,L1,LOPD1,LOPD2,NCOL,L,S C INTEGER*4 IITEMP C EQUIVALENCE (SLINE(2),LINE(1)),(BTEMP(1),ITEMP,IITEMP) C C STRING CONSTANTS--CODE GENERATION C INTEGER*2 SALPHA(14),SBEQ(7),SBGE(7),SBGT(7), 1 SBHI(7),SBHIS(7),SBIT(6),SBLE(7),SBLO(7),SBLOS(7), 2 SBLT(7),SBNE(7),SCC(5),SCCCLR(2,4),SCCSET(2,4),SCMP(6), 3 SCOMMA(2),SSPACE(2),SSPI(2),STST(6) C C STRING CONSTANTS--ERROR MESSAGES C INTEGER*2 SCCOP(20),SERR(8),SILLOP(30),SNOCON(15),SCOM(24), 1 SNOOP(14),SUNBAL(15),SUNDFN(16),SWNC(15),SILLCO(19),SILLMO(15) C C INITIALIZATION FOR STRINGS USED IN CODE GENERATION C C DATA SALPHA //ABCDEFGHIJKLMNOPQRSTUVWXYZ// DATA SALPHA /26,2HAB,2HCD,2HEF,2HGH,2HIJ,2HKL,2HMN,2HOP, 1 2HQR,2HST,2HUV,2HWX,2HYZ/ C C DATA SBEQ // BEQ I// DATA SBEQ /11,2H ,2H ,2H ,2HBE,2HQ ,1HI/ C C DATA SBGE // BGE I// DATA SBGE /11,2H ,2H ,2H ,2HBG,2HE ,1HI/ C C DATA SBGT // BGT I// DATA SBGT /11,2H ,2H ,2H ,2HBG,2HT ,1HI/ C C DATA SBHI // BHI I// DATA SBHI /11,2H ,2H ,2H ,2HBH,2HI ,1HI/ C C DATA SBHI // BHIS I// DATA SBHIS /12,2H ,2H ,2H ,2HBH,2HIS,2H I/ C C DATA BIT // BIT // DATA SBIT /9,2H ,2H ,2H ,2HBI,1HT / C C DATA SBLE // BLE I// DATA SBLE /11,2H ,2H ,2H ,2HBL,2HE ,1HI/ C C DATA SBLO // BLO I// DATA SBLO /11,2H ,2H ,2H ,2HBL,2HO ,1HI/ C C DATA SBLOS // BLOS I// DATA SBLOS /12,2H ,2H ,2H ,2HBL,2HOS,2H I/ C C DATA SBLT // BLT I// DATA SBLT /11,2H ,2H ,2H ,2HBL,2HT ,1HI/ C C DATA SBNE // BNE I// DATA SBNE /11,2H ,2H ,2H ,2HBN,2HE ,1HI/ C C DATA SCC // B// DATA SCC /7,2H ,2H ,2H ,1HB/ C C DATA SCCCLR //CC, VC, NE, PL// DATA SCCCLR /2,2HCC,2,2HVC,2,2HNE,2,2HPL/ C C DATA SCCSET //CS, VS, EQ, MI// DATA SCCSET /2,2HCS,2,2HVS,2,2HEQ,2,2HMI/ C C DATA SCMP // CMP// DATA SCMP / 9,2H ,2H ,2H ,2HCM,1HP/ C C DATA SCOMMA //,// DATA SCOMMA /1,1H,/ C C DATA SSPACE // // DATA SSPACE / 1,1H / C C DATA SSPI // I// DATA SSPI /2,2H I/ C C DATA STST // TST // DATA STST /10,2H ,2H ,2H ,2HTS,2HT / C C INITIALIZATION FOR ERROR MESSAGE STRINGS C C DATA SCCOP //***** (CONDITION CODE HAS OPERAND)// DATA SCCOP /37,2H**,2H**,2H* ,2H ,2H (,2HCO,2HND,2HIT,2HIO, 1 2HN ,2HCO,2HDE,2H H,2HAS,2H O,2HPE,2HRA,2HND,1H)/ C C DATA SCOM //***** (CONDITION CODE MODIFIED BY 1ST TEST)// DATA SCOM/46,2H**,2H**,2H* ,2H ,2H (,2HCO,2HND,2HIT,2HIO, 1 2HN ,2HCO,2HDE,2H M,2HOD,2HIF,2HIE,2HD ,2HBY,2H 1,2HST, 2 2H T,2HES,2HT)/ C C DATA SERR //******ALE ERR// DATA SERR /13,2H**,2H**,2H**,2HAL,2HE ,2HER,1HR/ C C DATA SILLCO //***** (ILLEGAL COMPOUND LOCIGAL)// DATA SILLCO/35,2H**,2H**,2H* ,2H ,2H (,2HIL,2HLE,2HGA, 1 2HL ,2HCO,2HMP,2HOU,2HND,2H L,2HOG,2HIC,2HAL,1H)/ C C DATA SILLMO //***** (ILLEGAL MODIFIER)// DATA SILLMO/27,2H**,2H**,2H* ,2H ,2H (,2HIL,2HLE,2HGA, 1 2HL ,2HMO,2HDI,2HFI,2HER,1H)/ C C DATA SILLOP //***** (ARITHMETIC OPERATOR USED WHERE LOGICAL REQUIRED)// DATA SILLOP /58,2H**,2H**,2H* ,2H ,2H (,2HAR,2HIT,2HHM, 1 2HET,2HIC,2H O,2HPE,2HRA,2HTO,2HR ,2HUS,2HED,2H W,2HHE, 2 2HRE,2H L,2HOG,2HIC,2HAL,2H R,2HEQ,2HUI,2HRE,2HD)/ C C DATA SNOCON //***** (NOTHING IN PAREN)// DATA SNOCON /27,2H**,2H**,2H* ,2H ,2H (,2HNO,2HTH,2HIN, 1 2HG ,2HIN,2H P,2HAR,2HEN,1H)/ C C DATA SNOOP //***** (MISSING OPERAND)// DATA SNOOP /26,2H**,2H**,2H* ,2H ,2H (,2HMI,2HSS,2HIN, 1 2HG ,2HOP,2HER,2HAN,2HD)/ C C DATA SUNBAL //***** (UNBALANCED COLONS)// DATA SUNBAL /28,2H**,2H**,2H* ,2H ,2H (,2HUN,2HBA,2HLA, 1 2HNC,2HED,2H C,2HOL,2HON,2HS)/ C C DATA SUNDFN //***** (UNDEFINED OPERATOR)// DATA SUNDFN /29,2H**,2H**,2H* ,2H ,2H (,2HUN,2HDE,2HFI, 1 2HNE,2HD ,2HOP,2HER,2HAT,2HOR,1H)/ C C DATA SWNC //***** (WRONG # OF COLONS)// DATA SWNC /28,2H**,2H**,2H* ,2H ,2H (,2HWR,2HON,2HG ,2H# , 1 2HOF,2H C,2HOL,2HON,2HS)/ C C---------------------------------------------------------------------- C C DATA DICTIONARY C C WARNING: VARIABLES MARKED "SCRATCH" MAY BE USED FREELY BY ANY C PROCEDURE FOR ANYTHING. OTHER VARIABLES MUST CONFORM TO ENTRY/EXIT C CONDITION SPECIFICATIONS. C C ASSMCL=(EXTERNAL, I*2) I/O CLASS FOR ASSEMBLY LANGUAGE OUTPUT STREAM. C BTEMP =(4L*1) SCRATCH ARRAY. NOTE EQUIV(BTEMP,ITEMP,IITEMP) C ERR =(I*2) PARSING ERROR FLAG C =0, NO ERROR C =1, NO CONTENT IN LOGICAL CONDITION C =2, UNBALANCED COLONS C =3, WRONG # OF COLONS C =4, UNDEFINED OPERATOR OR MODIFIER C =5, CONDITION CODE HAS OPERAND C =6, ILLEGAL COMPOUND LOGICAL C =7, OPERAND MISSING C =8, ILLEGAL OPERATOR C =9, ILLEGAL OPERATOR MODIFIER C =10, CONDITION CODE MODIFIED BY 1ST TEST C ERRCL =(EXTERNAL, I*2) I/O CLASS FOR ERROR MESSAGE STREAM. C EXELBL=(I*2) # OF LABEL TO GOTO IF WILL EXECUTE SCOPE. C GOTONO=(EXTERNAL, I*2) NUMBER OF LABEL TO GOTO IF MUST SKIP SCOPE. C I =(I*2) SCRATCH VARIABLE C I1 =(I*2) POINTER INTO "LINE" TO START OF LOGICAL SUBCONDITION. C I1COND=(L*1) FOR COMPOUND, .T. IF 1ST OPERAND IS CONDITION CODE. C IBEGIN=(EXTERNAL, I*2) POINTER INTO "STRING" TO THE "(" AT BEGINNING C OF THE LOGICAL CONDITION TO PROCESS. C ICOL =(6I*2) POINTERS TO COLONS IN "LINE." C IITEMP=(I*4) SCRATCH VARIABLE. NOTE EQUIV(BTEMP,ITEMP,IITEMP). C ILEN =(I*2) # OF CHAR IN AN OPERATOR EXCLUDING COLONS AND MODIFIER. C IOPD1 =(I*2) POINTER INTO "LINE" TO START OF 1ST OPERAND C IOPD2 =(I*2) POINTER INTO "LINE" TO START OF 2ND OPERAND C IOPR1 =(I*2) POINTER INTO "LINE" TO COLON IN FRONT OF AN OPERATOR. C IOPR2 =(I*2) POINTER INTO "LINE" TO COLON AFTER AN OPERATOR. C ISMOD =(L*1) .T. IF OPERATOR HAS A MODIFIER; .F. OTHERWISE. C ITEMP =(I*2) SCRATCH VARIABLE. NOTE EQUIV(BTEMP,ITEMP,IITEMP). C ITYPE =(I*2) OPERATOR TYPE: C =1, :EQ: C =-1, :NE: C =2, :GT: C =-2, :LE: C =3, :LT: C =-3, :GE: C =4, :AND: C =-4, :IOR: C =5, :SET.IN: C =-5, :CLR.IN: C J =(I*2) SCRATCH VARIABLE C JTYPE =(I*2) SAVED VALUE OF ITYPE C L =(I*2) SCRATCH VARIABLE C L1 =(I*2) LENGTH OF LOGICAL SUBCONDITION POINTED TO BY I1. C LEN =(EXTERNAL, I*2) # OF CHARACTERS IN LOGICAL CONDITION IN "STRING." C LENOP =(I*2) OPERATOR FLAG INDICATING LENGTH OF OPERANDS: C =1, BYTE C =2, WORD (2 BYTES) C =4, LONG WORD (4 BYTES, VAX ONLY) C LINE =(80L*1) ARRAY CONTAINING LOGICAL CONDITION EXCLUDING (). C NOTE EQUIV(SLINE(2),LINE(1)) C LINENO=(EXTERNAL, I*2) # OF LINE IN ALX FILE THAT "STRING" CAME FROM. C LFLAG =(L*1) LOGICAL FLAG RELATED TO NOTFLG. C LOPD1 =(I*2) LENGTH OF OPERAND POINTED TO BY IOPD1 C LOPD2 =(I*2) LENGTH OF OPERAND POINTED TO BY IOPD2 C MAJCNT=(EXTERNAL, I*2) # OF MAJOR ERRORS THAT HAVE OCCURRED. C NCHAR =(I*2) # OF CHARACTERS IN LOGICAL CONDITION IN "LINE." C NCOL =(I*2) # OF COLONS PRESENT IN THE LOGICAL CONDITION IN "LINE." C NOTFLG=(EXTERNAL, L*2) .T. IF (.NOT.CONDITION) MEANS "SKIP SCOPE." C NXTCHR=(I*2) POINTER INTO "LINE" TO NEXT NONBLANK CHARACTER. C S =(I*2) SCRATCH VARIABLE C SALPHA=(14I*2) ALPHABETICAL STRING, CONSTANT. C SBEQ =(7I*2) CODE STRING, CONSTANT. C SBGE =(7I*2) CODE STRING, CONSTANT. C SBGT =(7I*2) CODE STRING, CONSTANT. C SBHI =(7I*2) CODE STRING, CONSTANT. C SBHIS =(7I*2) CODE STRING, CONSTANT. C SBIT =(6I*2) CODE STRING, CONSTANT. C SBLE =(7I*2) CODE STRING, CONSTANT. C SBLO =(7I*2) CODE STRING, CONSTANT. C SBLOS =(7I*2) CODE STRING, CONSTANT. C SBLT =(7I*2) CODE STRING, CONSTANT. C SBNE =(7I*2) CODE STRING, CONSTANT. C SCC =(5I*2) CODE STRING, CONSTANT. C SCCCLR=(2,4I*2) CODE STRING ARRAY, CONSTANTS. C SCCOP =(20I*2) ERROR MESSAGE STRING, CONSTANT. C SCCSET=(2,4I*2) CODE STRING ARRAY, CONSTANTS. C SCMP =(6I*2) CODE STRING, CONSTANT. C SCOMMA=(2I*2) COMMA STRING, CONSTANT. C SERR =(8I*2) ERROR STRING FOR ASSEMBLY LANGUAGE STREAM, CONSTANT. C SIGNOP=(I*2) SIGN STATUS OF OPERAND OF OPERATOR: C =0, UNSIGNED C =1, SIGNED C SILLCO=(19I*2) ERROR MESSAGE STRING, CONSTANT. C SILLMO=(15I*2) ERROR MESSAGE STRING, CONSTANT. C SILLOP=(30I*2) ERROR MESSAGE STRING, CONSTANT. C SKPLBL=(I*2) # OF LABEL TO GOTO IF MUST SKIP SCOPE. C SLINE =(41I*2) STRING CONTAINING LOGICAL CONDITION EXCLUDING (). C NOTE EQUIV (SLINE(2),LINE(1)). C SNOCON=(15I*2) ERROR MESSAGE STRING, CONSTANT. C SNOOP =(14I*2) ERROR MESSAGE STRING, CONSTANT. C SSPACE=(2I*2) SPACE STRING, CONSTANT. C SSPI =(2I*2) CODE STRING, CONSTANT. C STEMP =(61I*2) SCRATCH STRING. C STRING=(EXTERNAL, NI*2) FLECS STRING CONTAINING INPUT LINE. C STST =(6I*2) CODE STRING, CONSTANT. C SUNBAL=(15I*2) ERROR MESSAGE STRING, CONSTANT. C SUNDFN=(16I*2) ERROR MESSAGE STRING, CONSTANT. C SWNC =(15I*2) ERROR MESSAGE STRING, CONSTANT. C C---------------------------------------------------------------------- C C EXECUTABLE CODE C ERR=0 !NO ERRORS IN PARSING YET C C COPY LOGIC PART OF INPUT STRING INTO ARRAY "LINE" AND STRIP C OFF '(' AND ')'. C NCHAR=LEN-2 !# OF CHARACTERS IN "LINE" W/O () CALL CPYSUB(SLINE,STRING,IBEGIN+1,NCHAR) C C # OF COLONS IN THE LINE DETERMINES HOW TO PARSE IT C NCOL=0 I=1 WHILE(I.LE.NCHAR) IF(LINE(I).EQ.1H:) NCOL=NCOL+1 IF(NCOL.LT.7)ICOL(NCOL)=I FIN I=I+1 FIN C NXTCHR=1 !FIND 1ST NONBLANK CHARACTER IN "LINE" GET-NEXT-NONBLANK-CHAR C CONDITIONAL (NXTCHR.GT.NCHAR)ERR=1 !NO CONTENT (NCOL.EQ.0) I1=NXTCHR L1=NCHAR-I1+1 LFLAG=NOTFLG SKPLBL=GOTONO PROCESS-LOGICAL-VARIABLE FIN (NCOL.EQ.2) I1=NXTCHR L1=NCHAR-I1+1 LFLAG=NOTFLG SKPLBL=GOTONO IOPR1=ICOL(1) IOPR2=ICOL(2) PROCESS-SIMPLE-LOGICAL-OR-CONDITION-CODE FIN (NCOL.EQ.4)PROCESS-FOUR-COLONS (NCOL.EQ.6)PROCESS-SIX-COLONS (NCOL/2*2.NE.NCOL)ERR=2 !UNBALANCED COLONS (OTHERWISE)ERR=3 !WRONG # OF COLONS FIN C IF(ERR.NE.0) MAJCNT=MAJCNT+1 C C FOR MAJOR ERRORS MAKE SURE MAC OUTPUT WILL NOT ASSEMBLE C CALL PUT(LINENO,SERR,ASSMCL) C C PUT OUT ERROR MESSAGE IN ERROR STREAM C SELECT(ERR) (1)CALL PUT(0,SNOCON,ERRCL) !NO CONTENT (2)CALL PUT(0,SUNBAL,ERRCL) !UNBALANCED COLONS (3)CALL PUT(0,SWNC ,ERRCL) !WRONG # OF COLONS (4)CALL PUT(0,SUNDFN,ERRCL) !UNDEFINED OPERATOR (5)CALL PUT(0,SCCOP ,ERRCL) !CC WITH OPERAND (6)CALL PUT(0,SILLCO,ERRCL) !ILLEGAL COMPOUND (7)CALL PUT(0,SNOOP ,ERRCL) !MISSING OPERAND (8)CALL PUT(0,SILLOP,ERRCL) !ILLEGAL OPERATOR (9)CALL PUT(0,SILLMO,ERRCL) !ILLEGAL MODIFIER (10)CALL PUT(0,SCOM, ERRCL) !MOD COND CODE FIN FIN C C RETURN TO EVALUATE-ARITHMETIC-OPERATOR C C ITEM OF FORM :EQ:, :NE:, :GT:, :LE:, :LT:, :GE: C C ENTRY: IOPR1=LOCATION IN "LINE" OF 1ST COLON IN OPERATOR C LINE=ARRAY CONTAINING LOGICAL CONDITION. C C EXIT: ITYPE=OPERATOR TYPE=1,-1,2,-2,3,-3 C ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. C BTEMP(1)=LINE(IOPR1+1) !NOTE EQUIV (BTEMP(1),ITEMP) BTEMP(2)=LINE(IOPR1+2) SELECT(ITEMP) (2HEQ)ITYPE=1 (2HNE)ITYPE=-1 (2HGT)ITYPE=2 (2HLE)ITYPE=-2 (2HLT)ITYPE=3 (2HGE)ITYPE=-3 (OTHERWISE)ERR=4 !UNDEFINED OPERATOR FIN FIN TO EVALUATE-BIT-OPERATOR C C ITEM OF FORM :SET.IN: OR :CLR.IN: C C ENTRY: IOPR1=LOCATION OF 1ST COLON IN OPERATOR C LINE=ARRAY CONTAINING LOGICAL CONDITION C C EXIT: ITYPE=OPERATOR TYPE=5,-5 C ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. C WHEN(LINE(IOPR1+5).NE.1HI.OR.LINE(IOPR1+6).NE.1HN)ERR=4 !UNDFN OP ELSE DO (I=1,4)BTEMP(I)=LINE(IOPR1+I) SELECT(IITEMP) (4HSET.)ITYPE=5 (4HCLR.)ITYPE=-5 (OTHERWISE)ERR=4 !UNDEFINED OPERATOR FIN FIN FIN TO EVALUATE-LOGICAL-OPERATOR C C ITEM OF FORM :AND: OR :IOR: C C ENTRY: ISMOD=.T. IF OPERATOR HAS A MODIFIER C IOPR1=LOCATION IN "LINE" OF 1ST COLON IN OPERATOR C LINE=ARRAY CONTAINING LOGICAL CONDITION C C EXIT: ITYPE=OPERATOR TYPE=4,-4 C ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. C DO (I=1,3)BTEMP(I)=LINE(IOPR1+I) BTEMP(4)=1H !NOTE EQUIV (BTEMP(1),IITEMP) CONDITIONAL (ISMOD)ERR=4 !UNDEFINED OPERATOR (IITEMP.EQ.4HAND )ITYPE=4 (IITEMP.EQ.4HIOR )ITYPE=-4 (OTHERWISE)ERR=4 !UNDEFINED OPERATOR FIN FIN TO EVALUATE-OPERATOR C C ENTRY: IOPR1=LOCATION IN "LINE" OF COLON IN FRONT OF OPERATOR. C IOPR2=LOCATION IN "LINE" OF COLON AFTER OPERATOR. C LINE=ARRAY CONTAINING LOGICAL CONDITION C C EXIT: LENOP=# OF BYTES IN OPERAND C SIGNOP=SIGN TYPE OF OPERAND C ISMOD=.T. IF OPERATOR HAS MODIFIER, .F. OTHERWISE. C ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. C ITYPE=OPERATOR TYPE=1,-1,2,-2,3,-3,4,-4,5,-5. C ILEN=LENGTH OF OPERATOR. C C SET DEFAULTS FOR MODIFIERS C LENOP=2 !DEFAULT LENGTH TO "WORD" SIGNOP=1 !DEFAULT TO "SIGNED" C C CHECK FOR EXISTENCE OF MODIFIER C I=IOPR1+1 WHILE(LINE(I).NE.1H:.AND.LINE(I).NE.1H_)I=I+1 ILEN=I-IOPR1-1 !LENGTH OF OPERATOR WHEN(LINE(I).NE.1H_)ISMOD=.FALSE. ELSE ISMOD=.TRUE. J=IOPR2-I-1 !MODIFIER LENGTH WHEN(J.LT.1.OR.J.GT.2)ERR=9 !ILLEGAL MODIFIER ELSE L=0 !NO LENGTH MODIFIERS YET S=0 !NO SIGN MODIFIERS YET DO (ITEMP=1,J) SELECT(LINE(I+ITEMP)) (1HW) LENOP=2 L=L+1 FIN (1HB) LENOP=1 L=L+1 FIN (1HL) LENOP=4 L=L+1 FIN (1HS) SIGNOP=1 S=S+1 FIN (1HU) SIGNOP=0 S=S+1 FIN (OTHERWISE)ERR=9 !ILLEGAL MODIFIER FIN FIN IF(S.GT.1.OR.L.GT.1)ERR=9 !ILLEGAL MODIFIER FIN FIN C C NOW SET VALUE OF ITYPE C IF(ERR.EQ.0) SELECT(ILEN) (2)EVALUATE-ARITHMETIC-OPERATOR (3)EVALUATE-LOGICAL-OPERATOR (6)EVALUATE-BIT-OPERATOR (OTHERWISE)ERR=4 !UNDEFINED OPERATOR FIN FIN FIN TO GET-NEXT-NONBLANK-CHAR C C ENTRY: NXTCHR=LOCATION OF 1ST CHARACTER TO CHECK IN "LINE" C C EXIT: NXTCHR=LOCATION OF 1ST NONBLANK IN "LINE" OR IS C >NCHAR IF IS NONE. C WHILE(NXTCHR.LE.NCHAR.AND.LINE(NXTCHR).EQ.1H )NXTCHR=NXTCHR+1 FIN TO PROCESS-ARITHMETIC-OPERATOR C C ENTRY: LENOP=# OF BYTES IN OPERAND C IOPD1=START OF 1ST OPERAND C LOPD1=LENGTH OF 1ST OPERAND C IOPD2=START OF 2ND OPERAND C LOPD2=LENGTH OF 2ND OPERAND C LFLAG=LOGICAL FLAG C ITYPE=OPERAND TYPE C SIGNOP=SIGN TYPE OF OPERANDS C SKPLBL=# OF LABEL TO BRANCH TO IF MUST SKIP SCOPE C SLINE=STRING CONTAINING CONDITION C ASSMCL=I/O CLASS FOR ASSEMBLY LANGUAGE FILE C LINENO=# OF LINE IN ALX FILE FROM WHICH "STRING" CAME C C EXIT: NONE C C FIRST PUT OUT " CMP[L/B] A,B" C CALL CPYSTR(STEMP,SCMP) SELECT(LENOP) (1)CALL CATSUB(STEMP,SALPHA,2,1) !APPEND B (2)CONTINUE (4)CALL CATSUB(STEMP,SALPHA,12,1) !APPEND L FIN CALL CATSTR(STEMP,SSPACE) CALL CATSUB(STEMP,SLINE,IOPD1,LOPD1) CALL CATSTR(STEMP,SCOMMA) CALL CATSUB(STEMP,SLINE,IOPD2,LOPD2) CALL PUT(LINENO,STEMP,ASSMCL) C C NOW PUT OUT " B[*] I'SKPLBL'" C I=IABS(ITYPE) SELECT(I) (1) WHEN(LFLAG.XOR.ITYPE.LT.0)CALL CPYSTR(STEMP,SBNE) ELSE CALL CPYSTR(STEMP,SBEQ) FIN (2) WHEN(LFLAG.XOR.ITYPE.LT.0) WHEN(SIGNOP.NE.0)CALL CPYSTR(STEMP,SBLE) ELSE CALL CPYSTR(STEMP,SBLOS) FIN ELSE WHEN(SIGNOP.NE.0)CALL CPYSTR(STEMP,SBGT) ELSE CALL CPYSTR(STEMP,SBHI) FIN FIN (3) WHEN(LFLAG.XOR.ITYPE.LT.0) WHEN(SIGNOP.NE.0)CALL CPYSTR(STEMP,SBGE) ELSE CALL CPYSTR(STEMP,SBHIS) FIN ELSE WHEN(SIGNOP.NE.0)CALL CPYSTR(STEMP,SBLT) ELSE CALL CPYSTR(STEMP,SBLO) FIN FIN FIN C C ADD ON LABEL # AND OUTPUT IT C CALL CATNUM(STEMP,SKPLBL) CALL PUT(LINENO,STEMP,ASSMCL) FIN TO PROCESS-BIT-OPERATOR C C ENTRY: LENOP=# OF BYTES IN OPERAND C IOPD1=START OF OPERAND 1 C LOPD1=LENGTH OF OPERAND 1 C IOPD2=START OF OPERAND 2 C LOPD2=LENGTH OF OPERAND 2 C LFLAG=LOGICAL FLAG C ITYPE=TYPE OF OPERATOR C SKPLBL=# OF LABEL TO BRANCH TO IF MUST SKIP SCOPE C SLINE=STRING CONTAINING CONDITION C ASSMCL=I/O STREAM # FOR ASSEMBLY LANGUAGE FILE C LINENO=# OF LINE IN ALX FILE FROM WHICH "STRING" CAME C C EXIT: NONE C C FIRST PUT OUT " BIT[L/B] A,B" C CALL CPYSTR(STEMP,SBIT) SELECT(LENOP) (1)CALL CATSUB(STEMP,SALPHA,2,1) !APPEND B (2)CONTINUE (4)CALL CATSUB(STEMP,SALPHA,12,1) !APPEND L FIN CALL CATSTR(STEMP,SSPACE) CALL CATSUB(STEMP,SLINE,IOPD1,LOPD1) CALL CATSTR(STEMP,SCOMMA) CALL CATSUB(STEMP,SLINE,IOPD2,LOPD2) CALL PUT(LINENO,STEMP,ASSMCL) C C NOW PUT OUT B[EQ/NE] I'SKPLBL' C WHEN(LFLAG.XOR.ITYPE.LT.0)CALL CPYSTR(STEMP,SBEQ) ELSE CALL CPYSTR(STEMP,SBNE) CALL CATNUM(STEMP,SKPLBL) CALL PUT(LINENO,STEMP,ASSMCL) FIN TO PROCESS-CONDITION-CODE C C ITEM OF FORM :*.SET: OR :*.CLR: WHERE *=C,V,N,Z. C C ENTRY: I1=POINTER TO START OF ITEM C L1=LENGTH OF ITEM C IOPR1=POINTER TO 1ST COLON IN ITEM C IOPR2=POINTER TO 2ND COLON IN ITEM C LFLAG=LOGICAL FLAG C SKPLBL=# OF LABEL TO BRANCH TO IF MUST SKIP SCOPE C LINE=ARRAY CONTAINING LOGICAL CONDITION C ASSMCL=I/O STREAM # FOR ASSEMBLY LANGUAGE FILE. C LINENO=# OF LINE IN ALX FILE FROM WHICH "STRING" CAME C C EXIT: NXTCHR=1ST NONBLANK AFTER CONDITION CODE EXPRESSION. C ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. C ITYPE=CONDITION CODE TYPE=1,2,3,4 C CALL CPYSTR(STEMP,SCC) !" B" C C WE KNOW THERE IS NO LEADING OPERAND. BE SURE IS NO TRALING OP C J=IOPR1+1 !1ST CHAR IN OPERATOR NXTCHR=IOPR2+1 GET-NEXT-NONBLANK-CHAR CONDITIONAL (NXTCHR.LE.I1+L1-1.AND.LINE(NXTCHR).NE.1H:)ERR=5 !IS OPERAND ((IOPR2-IOPR1).NE.6)ERR=4 !UNDEFINED OPERATOR (LINE(J).EQ.1HC)ITYPE=1 (LINE(J).EQ.1HV)ITYPE=2 (LINE(J).EQ.1HZ)ITYPE=3 (LINE(J).EQ.1HN)ITYPE=4 (OTHERWISE)ERR=4 !UNDEFINED OPERATOR FIN C IF(ERR.EQ.0) DO (I=1,4)BTEMP(I)=LINE(J+I) !GET TYPE; NOTE EQUIV(BTEMP,IITEMP) SELECT(IITEMP) (4H.SET) WHEN(LFLAG)CALL CATSUB(STEMP,SCCCLR(1,ITYPE),1,2) ELSE CALL CATSUB(STEMP,SCCSET(1,ITYPE),1,2) FIN (4H.CLR) WHEN(LFLAG)CALL CATSUB(STEMP,SCCSET(1,ITYPE),1,2) ELSE CALL CATSUB(STEMP,SCCCLR(1,ITYPE),1,2) FIN (OTHERWISE)ERR=4 !UNDEFINED OPERATOR FIN FIN IF(ERR.EQ.0) C C APPEND LABEL TO BRANCH AND PUT OUT LINE C CALL CATSTR(STEMP,SSPI) CALL CATNUM(STEMP,SKPLBL) CALL PUT(LINENO,STEMP,ASSMCL) FIN FIN TO PROCESS-FOUR-COLONS C C ITEM OF FORM ":C.CLR: :LOP: A" WHERE :LOP: IS A LOGICAL OPERATOR. C NOTE "A :LOP: G:OP:H" (OR "G:OP:H :LOP: A") ARE ILLEGAL SINCE C IT IS AMBIGUOUS; IS IT "(A:LOP:G):OP:H" OR "A:LOP:(G:OP:H)"? C NOTE A:LOP: :C.CLR: IS ILLEGAL SINCE THE TEST ON A CHANGES C THE VALUE OF CBIT! C C ENTRY: ICOL=POINTERS TO COLONS IN "LINE." C NXTCHR=1ST NONBLANK CHARACTER IN "LINE." C GOTONO=LABEL TO GOTO IF MUST SKIP SCOPE C NCHAR=NUMBER OF CHARACTERS IN "LINE." C NOTFLG=.T. IF(.NOT.CONDITIONS)-->SKIP SCOPE. C C EXIT: ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. C C FIRST MAKE SURE CENTRAL OPERATOR IS A LOGICAL OPERATOR C I1COND=LINE(NXTCHR).EQ.1H: WHEN(I1COND) IOPR1=ICOL(3) IOPR2=ICOL(4) FIN ELSE IOPR1=ICOL(1) IOPR2=ICOL(2) FIN EVALUATE-OPERATOR C IF(ERR.EQ.0) EXELBL=NEWNO(0) JTYPE=ITYPE !SAVE TYPE OF CENTRAL OPERATOR SELECT(ITYPE) (4) LFLAG=.TRUE. WHEN(NOTFLG)SKPLBL=GOTONO ELSE SKPLBL=EXELBL FIN (-4) LFLAG=.FALSE. WHEN(NOTFLG)SKPLBL=EXELBL ELSE SKPLBL=GOTONO FIN (OTHERWISE)ERR=6 !ILLEGAL COMPOUND FIN FIN IF(ERR.EQ.0) I1=NXTCHR IOPR1=ICOL(1) IOPR2=ICOL(2) WHEN(I1COND) L1=ICOL(3)-NXTCHR PROCESS-CONDITION-CODE IF(ERR.EQ.0) NXTCHR=ICOL(4)+1 GET-NEXT-NONBLANK-CHAR I1=NXTCHR L1=NCHAR-I1+1 IOPR1=ICOL(3) IOPR2=ICOL(4) SKPLBL=GOTONO LFLAG=NOTFLG PROCESS-LOGICAL-VARIABLE LFLAG=NOTFLG.XOR.(JTYPE.GT.0) IF(LFLAG.AND..NOT.ERR)CALL PUTLBL(EXELBL,LINENO,ASSMCL) FIN FIN ELSE C C ERROR, SINCE 1ST ITEM IS NOT A CONDITION CODE. HOWEVER, C THERE ARE 2 POSSIBLE CASES. C NXTCHR=ICOL(2)+1 GET-NEXT-NONBLANK-CHAR WHEN(NXTCHR.LT.ICOL(3)) ERR=6 !ILLEGAL COMPOUND ELSE ERR=10 !MODIFIED COND CODE FIN FIN FIN TO PROCESS-LOGICAL-VARIABLE C C INPUT WITHOUT ALECS SPECIAL CONDITIONS, EG. WHEN(A.XY(R0)+) C C ENTRY: I1=POINTER INTO "LINE" TO START OF VARIABLE C L1=LENGTH OF ITEM C LFLAG=LOGICAL FLAG C SKPLBL=LABEL # TO JUMP TO IF MUST SKIP SCOPE. C SLINE=STRING CONTAINING INPUT CONDITION C LINENO=# OF LINE INPUT CAME FROM C ASSMCL=I/O STREAM # FOR ASSEMBLY LANGUAGE FILE. C C EXIT: ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. C C FIRST PUT OUT " TST 'CONDITION'" C WHEN(L1.LT.1)ERR=1 !NO CONTENT ELSE CALL CPYSTR(STEMP,STST) CALL CATSUB(STEMP,SLINE,I1,L1) CALL PUT(LINENO,STEMP,ASSMCL) C C PUT OUT B[NE/EQ] I'SKPLBL' C WHEN(LFLAG)CALL CPYSTR(STEMP,SBEQ) ELSE CALL CPYSTR(STEMP,SBNE) CALL CATNUM(STEMP,SKPLBL) CALL PUT(LINENO,STEMP,ASSMCL) FIN FIN TO PROCESS-SIMPLE-AND-OR-IOR-OPERATOR C C ITEM OF FORM O1:LOP:O2 WHERE OI=LOGICAL EXPRESSION (0-->.FALSE., C .TRUE. OTHERWISE), CONDITION CODE (EG. :C.CLR:) OR ARITHMETIC C COMPARISON (EG. A:GT:B) AND LOP="AND" OR "IOR". C C ENTRY: IOPD1=LOCATION OF START OF 1ST OPERAND IN "LINE" C LOPD1=LENGTH OF 1ST OPERAND C IOPD2=LOCATION OF START OF 2ND OPERAND IN "LINE" C LOPD2=LENGTH OF 2ND OPERAND C SKPLBL=# OF LABEL TO JUMP TO IF MUST SKIP SCOPE. C LFLAG=LOGICAL FLAG C SLINE=STRING CONTAINING CONDITION C LINENO=LINE # OF INPUT LINE C ASSMCL=I/O STREAM # FOR ASSEMBLY LANGUAGE FILE C ITYPE=TYPE OF OPERATOR C C EXIT: NONE C WHEN(LFLAG.XOR.ITYPE.LT.0)EXELBL=SKPLBL ELSE EXELBL=NEWNO(0) C C FIRST PUT OUT " TST '1ST OPERAND'" C CALL CPYSTR(STEMP,STST) CALL CATSUB(STEMP,SLINE,IOPD1,LOPD1) CALL PUT(LINENO,STEMP,ASSMCL) C C NEXT " B[EQ/NE] I'EXELBL'" C WHEN(ITYPE.GT.0)CALL CPYSTR(STEMP,SBEQ) ELSE CALL CPYSTR(STEMP,SBNE) CALL CATNUM(STEMP,EXELBL) CALL PUT(LINENO,STEMP,ASSMCL) C C NEXT " TST '2ND OPERAND'" C CALL CPYSTR(STEMP,STST) CALL CATSUB(STEMP,SLINE,IOPD2,LOPD2) CALL PUT(LINENO,STEMP,ASSMCL) C C NEXT " B[EQ/NE] I'SKPLBL'" C WHEN(LFLAG)CALL CPYSTR(STEMP,SBEQ) ELSE CALL CPYSTR(STEMP,SBNE) CALL CATNUM(STEMP,SKPLBL) CALL PUT(LINENO,STEMP,ASSMCL) C IF(LFLAG.XOR.ITYPE.GT.0)CALL PUTLBL(EXELBL,LINENO,ASSMCL) FIN TO PROCESS-SIMPLE-LOGICAL C C ITEM OF FORM "A:OP:B" C C ENTRY: IOPR1=POINTER TO COLON IN FRONT OF OPERATOR C IOPR2=POINTER TO COLON AFTER OPERATOR C NCOL=# OF COLONS IN THE LINE C I1=POINTER TO START OF LOGICAL CONDITION C L1=LENGTH OF CONDITION C C EXIT: ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. C C FIRST GET THE OPERATOR C EVALUATE-OPERATOR IF(ERR.EQ.0) I=IABS(ITYPE) IOPD1=I1 !START OF OPERAND 1 LOPD1=IOPR1-IOPD1 !LENGTH OF OPERAND 1 NXTCHR=IOPR2+1 GET-NEXT-NONBLANK-CHAR IOPD2=NXTCHR !START OF OPERAND 2 LOPD2=(I1+L1)-IOPD2 !LENGTH OF OPERAND 2 CONDITIONAL (LOPD1.LT.1.OR.LOPD2.LT.1)ERR=7 !MISSING OPERAND (NCOL.GT.2.AND.I.EQ.4)ERR=6 !ILLEGAL COMPOUND (OTHERWISE) SELECT(I) (4)PROCESS-SIMPLE-AND-OR-IOR-OPERATOR (5)PROCESS-BIT-OPERATOR (OTHERWISE)PROCESS-ARITHMETIC-OPERATOR FIN FIN FIN FIN FIN TO PROCESS-SIMPLE-LOGICAL-OR-CONDITION-CODE C C ITEM OF FORM "A:OP:B" OR ":*.SET:" C DISTINGUISH BY PRESENCE/ABSENCE OF LEADING OPERAND. C C ENTRY: IOPR1=POINTER TO COLON IN FRONT OF OPERATOR C I1=POINTER TO START OF LOGICAL CONDITION C C EXIT: ERR.NE.0 IF FATAL PARSING ERROR. 0 OTHERWISE. C WHEN(IOPR1.GT.I1)PROCESS-SIMPLE-LOGICAL ELSE PROCESS-CONDITION-CODE FIN TO PROCESS-SIX-COLONS C C ITEM OF FORM ":C.SET: :AND: :V.SET:" OR ":C.SET: :AND: C:GT:D" C OR "A:GT:B :AND: C:GT:D" C NOTE C:GT:D :AND: :C.SET: IS ILLEGAL SINCE CBIT IS C CHANGED BY CMP FOR GT! C C ENTRY: NXTCHR=POINTER TO 1ST NONBLANK CHARACTER IN "LINE." C ICOL=LOCATIONS OF COLONS IN "LINE." C GOTONO=# OF LABEL TO GOTO IF MUST SKIP SCOPE C NOTFLG=.T. IF (.NOT.CONDITION)-->SKIP SCOPE C C EXIT: ERR.NE.0 IF FATAL PARSING ERROR. =0 OTHERWISE. C C FIRST MAKE SURE CENTRAL OPERATOR IS A LOGICAL OPERATOR C IOPR1=ICOL(3) IOPR2=ICOL(4) EVALUATE-OPERATOR C IF(ERR.EQ.0) EXELBL=NEWNO(0) JTYPE=ITYPE !SAVE TYPE OF CENTRAL OPERATOR SELECT(ITYPE) (4) LFLAG=.TRUE. WHEN(NOTFLG)SKPLBL=GOTONO ELSE SKPLBL=EXELBL FIN (-4) LFLAG=.FALSE. WHEN(NOTFLG)SKPLBL=EXELBL ELSE SKPLBL=GOTONO FIN (OTHERWISE)ERR=8 !ILLEGAL OPERATOR FOR COMPOUND FIN FIN IF(ERR.EQ.0) I1=NXTCHR !START OF 1ST LOGICAL SUBCONDITION L1=ICOL(3)-NXTCHR !LENGTH OF IT IOPR1=ICOL(1) IOPR2=ICOL(2) I1COND=IOPR1.EQ.I1 !.T. IF IS CONDITION CODE PROCESS-SIMPLE-LOGICAL-OR-CONDITION-CODE IF(ERR.EQ.0) NXTCHR=ICOL(4)+1 GET-NEXT-NONBLANK-CHAR I1=NXTCHR L1=NCHAR-I1+1 IOPR1=ICOL(5) IOPR2=ICOL(6) WHEN(IOPR1.EQ.I1.AND..NOT.I1COND)ERR=10 ELSE SKPLBL=GOTONO LFLAG=NOTFLG PROCESS-SIMPLE-LOGICAL-OR-CONDITION-CODE LFLAG=NOTFLG.XOR.(JTYPE.GT.0) IF(LFLAG.AND..NOT.ERR)CALL PUTLBL(EXELBL,LINENO,ASSMCL) FIN FIN FIN FIN END