C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C C CONTENTS C -------- C C NAME DESCRIPTION C ____ ___________ C C C PUSH PUSH AN INTEGER ON THE LEXICAL STACK C POP POP AN INTEGER OFF OF THE LEXICAL STACK C COMPAR COMPARE TWO STRINGS C SEARCH SEARCH A TABLE FOR A MATCH TO A CHARACTER STRING C SRCHI SEARCH THE USER SYMBOL TABLE INDIRECTLY C CHOP FIND THE NEXT RELEVANT CHARACTER IN A STRING C TRANSF TRANSFER A STRING FROM ONE PLACE TO ANOTHER C TRANS TRANSFER A STRING FROM LEXICAL STACK TO AN ARRAY (8 CHARS) C TRANS4 TRANSFER A STRING FROM LEXICAL STACK TO AN ARRAY (4 CHARS) SUBROUTINE PUSH(IVALUE) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 13-JUN-78 C C THIS MODULE IS A UTILITY TO PUSH AN INTEGER ONTO THE LEXICAL STACK C C COMPILATION INSTRUCTIONS: C C PUSH,PUSH/-SP=PUSH C C MODIFICATION HISTORY: C C V01.00 EAS/RC 18-SEP-75 ORIGINAL CODE C V01.01 RLA 13-JUN-78 ERROR DETECTION ADDED. C C C PAGE 2 - PUSH - DOCUMENTATION. C C THE LEXICAL STACK POINTER IS DECREMENTED AND THE LOCATION IN LEXSTK C POINTED TO BY IT IS LOADED WITH THE VALUE C C CALLING SEQUENCE: C C CALL BY: CALL PUSH (IVALUE) C C WHERE: IVALUE IS THE QUANTITY TO BE PUT ON THE STACK C C C ON EXIT: THE VALUE IS PUSHED ON THE STACK AND THE STACK POINTER C IS MODIFIED TO REFLECT THAT FACT. C C ERROR CONDITIONS: C C IF THE PUSH OPERATION WOULD CAUSE THE STACK LIMIT (LEXMX) TO BE EXCEEDED C THIS IS REGARDED AS A FATAL ERROR. C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C MSG C C PAGE 3 - PUSH - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C INTEGER IVALUE !VALUE TO BE PUT ON THE STACK C C PARAMETER STATEMENTS C C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C C C COMMON AREAS C INTEGER LEXSTK(8) !LEXICAL STACK INTEGER LEXSP !LEXICAL STACK POINTER INTEGER LEXMX !LEXICAL STACK LIMIT COMMON / LEXATT / LEXSTK,LEXSP,LEXMX C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - PUSH C IF (LEXSP .EQ. 1) CALL DSKMSG(14,4) LEXSP=LEXSP-1 LEXSTK(LEXSP)=IVALUE RETURN END SUBROUTINE POP (IVALUE) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 13-JUN-78 C C THIS ROUTINE POPS A VALUE OFF OF THE LEXICAL STACK C C COMPILATION INSTRUCTIONS: C C POP,POP/-SP=POP C C MODIFICATION HISTORY: C C V01.00 EAS/RC 18-SEP-75 ORIGINAL CODE C V01.01 RLA 13-JUN-78 ERROR DETECTION ADDED C C C PAGE 2 - POP - DOCUMENTATION. C C THE VARIABLE IS LOADED WITH THE VALUE OF THE ENTRY OF LEXSTK POINTED C TO BY THE LEXICAL STACK POINTER AND THE POINTER IS INCREMENTED. C C CALLING SEQUENCE: C C CALL BY: CALL POP (IVALUE) C C WHERE: IVALUE IS THE RETURN VARIABLE FOR THE ROUTINE C C C ON EXIT: THE LEXICAL STACK POINTER HAS BEEN INCREMENTED C C ERROR CONDITIONS: C C IF THE LEXICAL STACK POINTER HAS BEEN POPPED TOO OFTEN, A FATAL ERROR C IS DECLARED. C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C MSG C C PAGE 3 - POP - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C INTEGER IVALUE !RETURN VALUE C C PARAMETER STATEMENTS C C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C C C COMMON AREAS C INTEGER LEXSTK(8) !LEXICAL STACK INTEGER LEXSP !LEXICAL STACK POINTER INTEGER LEXMX !LEXICAL STACK LIMIT COMMON / LEXATT / LEXSTK,LEXSP,LEXMX C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - POP C IF (LEXSP .GT. LEXMX) CALL DSKMSG(15,4) IVALUE=LEXSTK(LEXSP) LEXSP=LEXSP+1 RETURN END LOGICAL FUNCTION COMPAR (LIT1,LIT2,LEN) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 22-JUL-78 C C THIS FUNCTION SUBROUTINE COMPARES TWO CHARACTER STRINGS AND RETURNS C THE VALUE .TRUE. IF THEY ARE IDENTICAL AND .FALSE. IF THEY ARE DIFFERENT. C C COMPILATION INSTRUCTIONS: C C COMPAR,COMPAR/-SP=COMPAR C C MODIFICATION HISTORY: C C V01.00 RLA 18-APR-78 ORIGINAL CODE C V01.01 RLA 22-JUL-78 ADD CASE CONVERSION LOGIC C C C PAGE 2 - COMPAR - DOCUMENTATION. C C THIS ROUTINE IS A LOGICAL FUNCTION. IT COMPARES THE SPECIFIED NUMBER OF C CHARACTERS OF TWO STRINGS. IF THEY ARE IDENTICAL, IT RETURNS THE VALUE C .TRUE. ELSE IT RETURNS THE VALUE .FALSE. C C CALLING SEQUENCE: C C CALL BY: LVAL=COMPAR(LIT1,LIT2,LEN) C OR IF (COMPAR(LIT1,LIT2,LEN)) ACTION C C WHERE: LIT1 IS ONE OF THE INPUT STRINGS (LENGTH LEN) C LIT2 IS THE OTHER INPUT STRING (LENGTH LEN) C LEN IS THE NUMBER OF CHARACTERS OF EACH STRING TO BE COMPARED. C C C ON EXIT: COMPAR TAKES ON THE LOGICAL VALUE OF EITHER .T. OR .F. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C VERSION V01.01 MODIFIES THE CODE OF COMPAR SO THAT THE INPUT STRINGS C MAY BE UPPER CASE, LOWER CASE, OR MIXED CASE. BEFORE THE COMPARISON C IS PERFORMED, THE CHARACTERS ARE CONVERTED TO UPPER CASE INTERNALLY. C HENCE THE STRING "TEST" WILL MATCH WITH THE STRING "Test". C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - COMPAR - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C INTEGER LEN !LENGTH OF INPUT STRINGS BYTE LIT1(LEN) !ONE INPUT STRING BYTE LIT2(LEN) !THE OTHER INPUT STRING C C PARAMETER STATEMENTS C C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DO INDEX BYTE LA !LOWER CASE A BYTE LZ !LOWER CASE Z BYTE LDIFF !LOWER-TO-UPPER CASE CONVERSION FACTOR BYTE L1 !CHARACTER STORAGE FOR LIT1 BYTE L2 !CHARACTER STORAGE FOR LIT2 C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C DATA LA, LZ, LDIFF / 'a', 'z', 32 / C C PAGE 4 - COMPAR C COMPAR=.TRUE. !ASSUME THE STRINGS MATCH DO 10 I=1,LEN L1=LIT1(I) IF ((L1 .LE. LZ) .AND. (L1 .GE. LA)) L1=L1-LDIFF L2=LIT2(I) IF ((L2 .LE. LZ) .AND. (L2 .GE. LA)) L2=L2-LDIFF IF (L1 .NE. L2) COMPAR=.FALSE. 10 CONTINUE RETURN END SUBROUTINE SEARCH (ITABLE, NTABLE, ISYMBL, IENTRY) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V02.00 C C AUTHOR: RL AURBACH MAPC 6-JUN-78 C C THIS ROUTINE SEARCHES A TABLE FOR A MATCH WITH A SYMBOL AND RETURNS C THE TABLE INDEX. IF NO MATCH IS FOUND, THE ROUTINE RETURNS 0. C C COMPILATION INSTRUCTIONS: C C SEARCH,SEARCH/-SP=SEARCH C C MODIFICATION HISTORY: C C V01.00 EAS 5-JAN-76 ORIGINAL CODE C V02.00 RLA 6-JUN-76 A) USE COMPAR C B) TERMINATE SEARCH EITHER ON A ZERO C TABLE ENTRY OR AFTER NTABLE TRIES. C C C PAGE 2 - SEARCH - DOCUMENTATION. C C THIS ROUTINE SEARCHES A TABLE FOR A MATCH BETWEEN A GIVEN 8-CHARACTER LONG C SYMBOL AND SOME 8-CHARACTER LONG SYMBOL IN THE TABLE. IF A MATCH IS FOUND C THE TABLE INDEX OF THE FIRST SUCH MATCH IS RETURNED IN IENTRY. IF NO MATCH C IS FOUND, IENTRY=0. THE SEARCH CONTINUES UNTIL A MATCH IS FOUND, A ZERO C TABLE ENTRY IS FOUND, OR UNTIL THE LAST TABLE ENTRY (TABLE IS OF LENGTH C NTABLE) IS TRIED UNSUCCESSFULLY. C C CALLING SEQUENCE: C C CALL BY: CALL SEARCH (ITABLE, NTABLE, ISYMBL, IENTRY) C C WHERE: ITABLE IS THE TABLE OF SYMBOLS TO BE SEARCHED C NTABLE IS THE NUMBER OF ENTRIES IN THAT TABLE C ISYMBOL IS THE SYMBOL BEING SEARCHED FOR IN THE TABLE. C IENTRY IS RETURNED BY THE ROUTINE. C C ON ENTRY: ITABLE IS AN (8 X NTABLE) BYTE ARRAY OF SYMBOLS. C ISYMBL IS AN 8-CHARACTER STRING. C C ON EXIT: IF ITABLE(*,J) IS THE FIRST MATCH FOR ISYMBL(*) IN C THE TABLE, IENTRY=J. IF NO MATCH IS FOUND, IENTRY=0. C C ERROR CONDITIONS: C C IF NO MATCH IS FOUND, IENTRY=0 C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C COMPAR C C PAGE 3 - SEARCH - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C INTEGER NTABLE !NUMBER OF TABLE ENTRIES BYTE ITABLE(8,NTABLE) !THE TABLE BYTE ISYMBL(8) !TEST SYMBOL INTEGER IENTRY !RETURNED BY THE ROUTINE C C PARAMETER STATEMENTS C C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DO INDEX LOGICAL COMPAR !LOGICAL PROCEDURE NAME C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - SEARCH C IENTRY=0 DO 10 I=1,NTABLE IF (ITABLE(1,I) .EQ. 0) RETURN IF (.NOT. COMPAR(ITABLE(1,I),ISYMBL,8)) GOTO 10 IENTRY=I RETURN 10 CONTINUE RETURN END SUBROUTINE SRCHI (ISYMBL,ISYMTB,IENTRY) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.02 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C SRCHI IS A LOCAL SUBROUTINE WHICH SEARCHES FOR A MATCH BETWEEN A USER C SYMBOL AND A SYMBOL IN A SPECIFIED UST.DAT TABLE (CREATED BY LIBIN). C THE UST.DAT TABLE IS INDEXED INDIRECTLY VIA THE CONTENTS OF LIBENT, SO THAT C ONLY THE SYMBOLS WHICH ARE USED FOR THIS CARD ARE CHECKED FOR A MATCH. C C COMPILATION INSTRUCTIONS: C C SRCHI,SRCHI/-SP=SRCHI C [FILE WIRCOM.FTN INCLUDED] C [FILE PARAM.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 18-SEP-75 ORIGINAL CODE C V01.01 RLA 13-JUN-78 USE COMPAR C V01.02 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - SRCHI - DOCUMENTATION. C C THE CURRENT VALUE OF IENTRY + 1 IS THE STARTING INDEX FOR THE SEARCH. C FOR ALL OF THE LEGAL VALUES OF IENTRY EQUAL TO OR GREATER THAN THE STARTING C VALUE (THAT IS, FOR ALL VALUES UP TO NENT WHICH IS THE TOTAL NUMBER OF C ENTRIES), THE SYMBOL ISYMBL IS CHECKED AGAINST THE UST.DAT SYMBOL ASSOCIATED C WITH THAT INTERNAL CHIP NUMBER. IF THEY MATCH, THAT INTERNAL CHIP NUMBER C IS RETURNED IN IENTRY. IF NOT, THE NEXT ENTRY IS CHECKED. IF NO MATCH IS C FOUND FROM THE STARTING POINT TO THE END OF THE LEGAL ENTRIES, ZERO IS C RETURNED IN IENTRY. C C CALLING SEQUENCE: C C CALL BY: CALL SRCHI (ISYMBL,ISYMTB,IENTRY) C C WHERE: ISYMBL IS THE (8-CHARACTER) SYMBOL TO BE MATCHED AGAINST C ISYMTB IS THE NAME OF THE SEARCH ARRAY C IENTRY IS THE ENTRY INDEX. ON ENTRY INTO THE ROUTINE, C IENTRY INDICATES THE STARTING INTERNAL CHIP NUMBER C FOR THE SEARCH. ON EXIT, IENTRY CONTAINS THE NUMBER C OF THE NEXT CHIP FOR WHICH ISYMBL MATCHES AN ENTRY C OF ISYMTB. C C ON ENTRY: IENTRY IS THE INTERNAL CHIP NUMBER OF THE NEXT C CHIP TO CHECK (THAT IS, ARRAY INDEX IENTRY+1 IS NEXT) C C ON EXIT: IENTRY IS THE INTERNAL CHIP NUMBER OF THE NEXT C MATCHING CHIP OR ZERO IS NO MATCH WAS FOUND C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C COMPAR C C PAGE 3 - SRCHI - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C BYTE ISYMBL (1) !USER SYMBOL STRING BYTE ISYMTB (8,1) !DUMMY ARRAY ARGUMENT FOR ONE OF THE UST.DAT !TABLES INTEGER IENTRY !INTERNAL CHIP NUMBER OF MATCHING ENTRY C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARAM.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER ITMP !LOCAL STORAGE FOR INTERNAL_CHIP_NUMBER !TO UST.DAT_TABLE MAPPING INTEGER I !DUMMY DO INDEX LOGICAL COMPAR !LOGICAL FUNCTION TYPE DEFINITION C C COMMON AREAS C INTEGER LIBSIZ !NUMBER OF ENTRIES IN UST.DAT TABLES BYTE UST1(8,IUSTLN) !STORAGE FOR NAME FIELD BYTE SPSYM(8,IUSTLN) !STORAGE FOR SPACING SYMBOL FIELD BYTE ELSYM(8,IUSTLN) !STORAGE FOR ELECTRICAL SYMBOL FIELD BYTE LPINS(IUSTLN) !STORAGE FOR NUMBER OF PINS FIELD BYTE DTYPE(IUSTLN) !STORAGE FOR DEVICE TYPE FIELD BYTE CONN(8,IUSTLN) !STORAGE FOR CONNECTOR FIELD INTEGER LIBENT(NMCHIP) !STORAGE FOR CHIP MAPPING ARRAY BYTE IW(2+34*IUSTLN+2*NMCHIP) !WORK SPACE ALLOCATION EQUIVALENCE (LIBSIZ,IW(1)) EQUIVALENCE (UST1(1,1),IW(3)) EQUIVALENCE (SPSYM(1,1),IW(3+8*IUSTLN)) EQUIVALENCE (ELSYM(1,1),IW(3+16*IUSTLN)) EQUIVALENCE (LPINS(1),IW(3+24*IUSTLN)) EQUIVALENCE (DTYPE(1),IW(3+25*IUSTLN)) EQUIVALENCE (CONN(1,1),IW(3+26*IUSTLN)) EQUIVALENCE (LIBENT(1),IW(3+34*IUSTLN)) COMMON / WORK / IW C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - SRCHI C C C CALCULATE STARTING INTERNAL NUMBER FOR THE SEARCH C IENTRY=IENTRY+1 IF (IENTRY .GT. NENT) GOTO 30 !IF TRUE, NOTHING TO SEARCH C C SEARCH LOOP C DO 10 I=IENTRY,NENT ITMP=LIBENT(I) !ITMP IS INDEX INTO UST.DAT TABLES FOR !THIS DEVICE IF (ITMP .EQ. 0) GOTO 10 !THIS DEVICE IS DEFINED ELSEWHERE THAN !IN THE UST.DAT TABLES IF (.NOT. COMPAR(ISYMBL,ISYMTB(1,ITMP),8)) GOTO 10 IENTRY = I !FOUND A MATCH. WE ARE DONE, SO RETURN !GET OUT OF THE LOOP NOW. 10 CONTINUE C C NO MATCH FOUND C 30 IENTRY=0 RETURN END SUBROUTINE CHOP C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THIS ROUTINE FINDS THE NEXT CHARACTER IN A LINE WHICH IS NOT A TAB OR A C SPACE. C C COMPILATION INSTRUCTIONS: C C CHOP,CHOP/-SP=CHOP C [FILE WIRCOM.FTN INCLUDED] C [FILE LEXATT.COM INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 8-JUN-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - CHOP - DOCUMENTATION. C C THIS ROUTINE STARTS AT THE CURRENT POSITION IN LINBUF AND LOOKS FOR THE C FIRST CHARACTER WHICH IS NOT A TAB OR A SPACE. THE LEXICAL STACK IS LEFT C UNCHANGED. C C CALLING SEQUENCE: C C CALL BY: CALL CHOP C C C ON ENTRY: LINBUF CONTAINS MEANINGFUL INFORMATION. C C ON EXIT: NEXCHR POINTS TO THE NEXT RELEVANT PIECE OF INFORMATION C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C GETLEX C C PAGE 3 - CHOP - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'LEXATT.COM' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER ITMP !GETLEX ASSOCIATED VARIABLE INTEGER ISP !TEMPORARY STORAGE FOR LEXSP C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - CHOP C ISP=LEXSP 20 CALL GETLEX(ITMP) GOTO (40, 40, 30, 40, 40) ITMP 30 IF ((LINBUF(INX) .EQ. ' ') .OR. (LINBUF(INX) .EQ. 9)) GOTO 20 C C 40 LEXSP=ISP RETURN END SUBROUTINE TRANSF(SRC,ISRC,DEST,IDEST) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.00 C C AUTHOR: RL AURBACH MAPC 5-MAY-78 C C THIS ROUTINE TRANSFERS A LITERAL STRING FROM THE SOURCE TO THE DESTINATION. C C COMPILATION INSTRUCTIONS: C C TRANSF,TRANSF/-SP=TRANSF C C MODIFICATION HISTORY: C C V01.00 RLA 5-MAY-78 ORIGINAL CODE C C C PAGE 2 - TRANSF - DOCUMENTATION. C C THE SOURCE STRING IS MOVED TO THE DESTINATION ARRAY. FULL PROVISION IS MADE C FOR SOURCE AND DESTINATION ARRAY LENGTHS BEING DIFFERENT. C C CALLING SEQUENCE: C C CALL BY: CALL TRANSF(SRC,ISRC,DEST,IDEST) C C WHERE: SRC IS THE SOURCE BYTE ARRAY OF LENGTH ISRC C ISRC IS THE LENGTH OF THE INPUT STRING C DEST IS THE DESTINATION BYTE ARRAY OF LENGTH IDEST C IDEST IS THE LENGTH OF THE FIELD TO BE FILLED BY THE ROUTINE. C C C ON EXIT: IF ISRC < IDEST, ISRC CHARACTERS WILL HAVE BEEN C TRANSFERRED. THE (IDEST-ISRC) REMAINING SPACES C IN DEST WILL HAVE BEEN FILLED WITH ASCII SPACES. C IF ISRC > IDEST, IDEST CHARACTERS WILL HAVE BEEN C TRANSFERRED. C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C NONE C C PAGE 3 - TRANSF - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C BYTE SRC(ISRC) !INPUT BYTE ARRAY INTEGER ISRC !LENGTH OF SOURCE FIELD BYTE DEST(IDEST) !OUTPUT BYTE ARRAY INTEGER IDEST !LENGTH OF DESTINATION FIELD C C PARAMETER STATEMENTS C C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER I !DO INDEX INTEGER M !DO LIMIT VARIABLE C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - TRANSF C C C FILL THE DESTINATION WITH BLANKS C DO 10 I=1,IDEST 10 DEST(I)=' ' C C CALCULATE THE NUMBER OF CHARACTERS TO MOVE. C M=MIN0(ISRC,IDEST) C C MOVE THE CHARACTERS C DO 20 I=1,M 20 DEST(I)=SRC(I) C RETURN END SUBROUTINE TRANS (IARRAY) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.02 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THE ROUTINE TRANSFERS A SYMBOL ON THE LEXICAL STACK TO A USER-SPECIFIED C BUFFER. THE ROUTINE SUPPORTS SYMBOLS WHICH ARE UP TO 8 CHARACTERS LONG. C C COMPILATION INSTRUCTIONS: C C TRANS,TRANS/-SP=TRANS C [FILE WIRCOM.FTN INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 EAS/RC 18-SEP-75 ORIGINAL CODE C V01.01 RLA 13-APR-78 USE TRANSF C V01.02 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - TRANS - DOCUMENTATION. C C THE ROUTINE ASSUMES THAT THE SYMBOL HAS BEEN LOCATED BY GETLEX. THIS MEANS C THAT THE LENGTH OF THE SYMBOL AND THE POINTER TO THE FIRST CHARACTER OF THE C SYMBOL ARE ON THE LEXICAL STACK. THE ROUTINE POPS THESE DATA OFF OF THE C STACK. IT PREPARES THE OUTPUT ARRAY FOR THE SYMBOL BY WRITING 8 SPACES IN C IT AND THEN TRANSFERS THE APPROPRIATE NUMBER OF CHARACTERS FROM THE LINE C BUFFER TO THE DESTINATION. C C CALLING SEQUENCE: C C CALL BY: CALL TRANS (IARRAY) C C WHERE: IARRAY IS THE DESTINATION FOR THE SYMBOL. THIS AREA MUST BE C ABLE TO STORE 8 BYTES OF INFORMATION. C C ON ENTRY: IT IS ASSUMED THAT THE SYMBOL LENGTH AND ADDRESS ARE C ON THE LEXICAL STACK (AS PUT THERE BY GETLEX) C C ON EXIT: THE TWO LEXICAL STACK ENTRIES ASSOCIATED WITH THE SYMBOL C ARE POPPED OFF OF THE STACK AND THE DESTINATION IS C FILLED WITH A LEFT-JUSTIFIED CHARACTER STRING. IF THE C SYMBOL IS LESS THAN 8 CHARACTERS LONG, THE REMAINING C SPACES IN THE DESTINATION (WHICH HAS FIELD LENGTH 8) C ARE FILLED WITH BLANKS C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C POP TRANSF C C PAGE 3 - TRANS - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C BYTE IARRAY(8) !DESTINATION ARRAY C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER ICHR !SYMBOL ADDRESS POINTER INTEGER NCHR !SYMBOL LENGTH C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - TRANS C CALL POP(NCHR) CALL POP(ICHR) CALL TRANSF(LINBUF(ICHR),NCHR,IARRAY(1),8) RETURN END SUBROUTINE TRANS4 (IARRAY) C C C ************************************************************************ C * C THIS PROGRAM IS PROVIDED ON AN "AS IS" BASIS ONLY. DIGITAL EQUIPMENT * C COMPUTER USER'S SOCIETY, DIGITAL EQUIPMENT CORPORATION, MONSANTO, AND * C THE AUTHOR DISCLAIM ALL WARRANTIES ON THE PROGRAM, INCLUDING WITHOUT * C LIMITATION, ALL IMPLIED WARRANTIES OF MERCHANTABLITY AND FITNESS. * C * C FULL PERMISSION AND CONSENT IS HEREBY GIVEN TO DECUS AND TO THE DECUS * C SPECIAL INTEREST GROUPS TO REPRODUCE, DISTRIBUTE, AND PUBLISH AND * C PERMIT OTHERS TO REPRODUCE IN WHOLE OR IN PART, IN ANY FORM AND * C WITHOUT RESTRICTION, THIS PROGRAM AND ANY INFORMATION RELATING THERETO * C * C ************************************************************************ C C C VERSION: V01.01 C C AUTHOR: RL AURBACH MAPC 1-SEP-78 C C THE ROUTINE TRANSFERS A SYMBOL ON THE LEXICAL STACK TO A USER-SPECIFIED C BUFFER. THE ROUTINE SUPPORTS SYMBOLS WHICH ARE UP TO 4 CHARACTERS LONG. C C COMPILATION INSTRUCTIONS: C C TRANS4,TRANS4/-SP=TRANS4 C [FILE WIRCOM.FTN INCLUDED] C [FILE PARSE.COM INCLUDED] C C MODIFICATION HISTORY: C C V01.00 RLA 13-APR-78 ORIGINAL CODE C V01.01 RLA 1-SEP-78 REORGANIZE INCLUDED COMMON AREAS C C C PAGE 2 - TRANS4 - DOCUMENTATION. C C THE ROUTINE ASSUMES THAT THE SYMBOL HAS BEEN LOCATED BY GETLEX. THIS MEANS C THAT THE LENGTH OF THE SYMBOL AND THE POINTER TO THE FIRST CHARACTER OF THE C SYMBOL ARE ON THE LEXICAL STACK. THE ROUTINE POPS THESE DATA OFF OF THE C STACK. IT PREPARES THE OUTPUT ARRAY FOR THE SYMBOL BY WRITING 4 SPACES IN C IT AND THEN TRANSFERS THE APPROPRIATE NUMBER OF CHARACTERS FROM THE LINE C BUFFER TO THE DESTINATION. C C CALLING SEQUENCE: C C CALL BY: CALL TRANS4 (IARRAY) C C WHERE: IARRAY IS THE DESTINATION FOR THE SYMBOL. THIS AREA MUST BE C ABLE TO STORE 4 BYTES OF INFORMATION. C C ON ENTRY: IT IS ASSUMED THAT THE SYMBOL LENGTH AND ADDRESS ARE C ON THE LEXICAL STACK (AS PUT THERE BY GETLEX) C C ON EXIT: THE TWO LEXICAL STACK ENTRIES ASSOCIATED WITH THE SYMBOL C ARE POPPED OFF OF THE STACK AND THE DESTINATION IS C FILLED WITH A LEFT-JUSTIFIED CHARACTER STRING. IF THE C SYMBOL IS LESS THAN 4 CHARACTERS LONG, THE REMAINING C SPACES IN THE DESTINATION (WHICH HAS FIELD LENGTH 4) C ARE FILLED WITH BLANKS C C ERROR CONDITIONS: C C NONE C C SPECIAL NOTES: C C NONE C C SUBROUTINES CALLED: C C POP TRANSF C C PAGE 3 - TRANS4 - DATA STORAGE DESCRIPTIONS. C C CALLING PARAMETERS: C BYTE IARRAY(4) !DESTINATION ARRAY C C PARAMETER STATEMENTS C INCLUDE 'WIRCOM.FTN' INCLUDE 'PARSE.COM' C C LOCAL VARIABLE AND ARRAY DEFINITIONS: C INTEGER ICHR !SYMBOL ADDRESS POINTER INTEGER NCHR !SYMBOL LENGTH C C COMMON AREAS C C C LOCAL VARIABLE AND ARRAY INITIALIZATION: C C C PAGE 4 - TRANS4 C CALL POP(NCHR) CALL POP(ICHR) CALL TRANSF(LINBUF(ICHR),NCHR,IARRAY(1),4) RETURN END