-h- csc.for Mon Apr 7 16:44:51 1986 ARISIA$DRC0:[003001.TMP]CSC.FOR;2 SUBROUTINE CSC INCLUDE 'TEXT.BLK' C C THIS PROGRAM IS THE CONCEPTUAL SCHEMA COMPILER FOR RIM. CSC C COMPILES RIM CONCEPTUAL SCHEMAS INTO RIM INTERNAL SCHEMAS. ALL C CONCEPTUAL SCHEMAS ARE EXPRESSED IN TERMS OF THE RELATIONAL MODEL. C INCLUDE 'CONST4.BLK' INCLUDE 'CONST8.BLK' INCLUDE 'RMKEYW.BLK' INCLUDE 'RIMCOM.BLK' INCLUDE 'FLAGS.BLK' INCLUDE 'FILES.BLK' INCLUDE 'MISC.BLK' C LOGICAL EQKEYW LOGICAL EQ INTEGER ERROR INTEGER EFLAG,RFLAG INTEGER DBSTAT INCLUDE 'DCLAR2.BLK' INCLUDE 'DCLAR6.BLK' C EFLAG = 0 RFLAG = 0 NUMELE = 0 ERROR = 0 NEWCSN = 0 CALL RMDATE(IDAY) C C SET THE PROMPT CHARACTER TO D (DEFINE) C CALL LXSET(K4PROM,K4DP) C C BEGIN PROCESSING. C WRITE (NOUT,9000) 9000 FORMAT(/,29H BEGIN RIM SCHEMA COMPILATION,/) GO TO 110 C 100 CONTINUE C C EDIT DATA BASE NAME. C CALL LODREC C C CHECK FOR END,INPUT, OR HELP C IF(EQKEYW(1,KWEND,3)) GO TO 800 110 CONTINUE IF((EQKEYW(1,KWDEFI,6)).AND.(LXITEM(IDUMMY).EQ.2)) GO TO 120 WRITE (NOUT,9001) 9001 FORMAT(31H -ERROR- MISSING DATA BASE NAME) IF(.NOT.BATCH) GO TO 100 ERROR = ERROR + 1 IF(ERROR.LT.10) GO TO 100 GO TO 950 120 CONTINUE C C CHECK THAT THE NAME IS LESS THAN 6 CHARACTERS. C IF((LXLENC(2).GE.1).AND.(LXLENC(2).LE.6)) GO TO 145 WRITE (NOUT,9002) 9002 FORMAT(39H -ERROR- THE DATABASE NAME MUST BE 1-6 , X 23HALPHANUMERIC CHARACTERS,/) IF(.NOT.BATCH) GO TO 100 ERROR = ERROR + 1 IF(ERROR.LT.10) GO TO 100 GO TO 950 C C STORE DATA BASE NAME C 145 CONTINUE NAMDB = BLANK CALL LXSREC(2,1,8,NAMDB,1) C C CALL RMDBLK TO MAKE SURE THE DATABASE MAY BE MODIFIED C CALL RMDBLK(NAMDB) IF(RMSTAT.NE.0) GO TO 150 CALL RMDBGT(NAMDB,DBSTAT) IF(DBSTAT.NE.0) GO TO 100 CALL RMOPEN(NAMDB) IF((RMSTAT.EQ.15).OR.(RMSTAT.EQ.0)) GO TO 155 150 CALL WARN(RMSTAT,DBNAME,0) GO TO 999 155 CONTINUE NEWCSN = 1 IF(DFLAG) RFLAG = 1 C C EDIT OWNER CLAUSE C 200 CONTINUE CALL LODREC C C CHECK FOR END,INPUT, OR HELP C IF(EQKEYW(1,KWEND,3)) GO TO 800 IF(EQKEYW(1,KWOWNE,5)) GO TO 220 IF((DFLAG).AND.(EQ(OWNER,USERID))) GO TO 350 GO TO 230 C 220 CONTINUE IF(LXITEM(IDUMMY).EQ.2) GO TO 260 230 CONTINUE WRITE (NOUT,9003) 9003 FORMAT(35H -ERROR- AN OWNER MUST BE SPECIFIED) IF(.NOT.BATCH) GO TO 200 ERROR = ERROR + 1 IF(ERROR.LT.10) GO TO 200 GO TO 950 C 260 CONTINUE IF(.NOT.DFLAG) GO TO 290 NAMOWN = BLANK CALL LXSREC(2,1,8,NAMOWN,1) IF(EQ(OWNER,NAMOWN)) GO TO 300 WRITE (NOUT,9004) 9004 FORMAT(59H -ERROR- UNAUTHORIZED ACCESS TO DATA BASE SCHEMA DEFINIT XION) IF(.NOT.BATCH) GO TO 200 ERROR = ERROR + 1 IF(ERROR.LT.10) GO TO 200 GO TO 950 290 CONTINUE IF((LXLENC(2).GE.1).AND.(LXLENC(2).LE.8)) GO TO 295 CALL WARN(7,KWOWNE,BLANK) IF(.NOT.BATCH) GO TO 200 ERROR = ERROR + 1 IF(ERROR.LT.10) GO TO 200 GO TO 950 295 CONTINUE OWNER = BLANK CALL LXSREC(2,1,8,OWNER,1) C C SEARCH FOR ATTRIBUTES, RELATIONS, RULES, PASSWORDS, OR END C 300 CONTINUE CALL LODREC 350 CONTINUE IF(EQKEYW(1,KWELEM,8)) GO TO 400 IF(EQKEYW(1,KWATTR,10)) GO TO 400 IF(EQKEYW(1,KWRELA,9)) GO TO 500 IF(EQKEYW(1,KWRULS,5)) GO TO 600 IF(EQKEYW(1,KWPASS,9)) GO TO 700 IF(EQKEYW(1,KWEND,3)) GO TO 800 C C ERROR. C CALL WARN(4,0,0) IF(.NOT.BATCH) GO TO 300 ERROR = ERROR + 1 IF(ERROR.LT.10) GO TO 300 GO TO 950 C C PROCESS ATTRIBUTES. C 400 CONTINUE CALL LODELE(NUMELE,ERROR) EFLAG = 1 GO TO 350 C C C PROCESS RELATIONS. C 500 CONTINUE IF(DFLAG) GO TO 525 IF(EFLAG.EQ.1) GO TO 525 WRITE (NOUT,9005) 9005 FORMAT(' -ERROR- NO ATTRIBUTES DEFINED - RELATION DEFINITION I' X'S IMPOSSIBLE') C y005 FORMAT(66H -ERROR- NO ATTRIBUTES DEFINED - ‰ELATION DEFINIT ON IS C XIMPOSSIBLE) ERROR = ERROR + 1 GO TO 300 525 CONTINUE  CALL LODREL(NUMELE,ERROR) RFLAG = 1 GO Th350ÂC [ PROCESS RULESW C 60‘ CONTINUE IF(RFLAG.EQ.1) GO TO 625 WRITE (NOUT,9006)’ 9006 ŹFRMAT(7`H -ERROR- RELATiNNS AND ATTRIBUTES MUST8qE DEFI…ED IN OWD =ĚR TO DĂÔINE RUčES) ‡ ERRORđ= ERROR$+ 1 *k GO TO ó00 C CSU 625 C?PTINUE ä CA)P LODRUhé GË TO 35 C C PűmCESS PASSWORDS. C 700 CONTINUE IF(RFLAG.EQ.1) GO TO 725 WRITE (NOUT,9007) 9007 FORMAT(63H -ERROR- RELATIONS MUST BE DEFINED IN ORDER TO ASSIGN PA XSSWORDS) ERROR = ERROR + 1 GO TO 300 C 725 CONTINUE CALL LODPAS(ERROR) GO TO 350 C C PROCESS END. C 800 CONTINUE C C SET THE RETURN CODE AND MAKE SURE A SCHEMA HAS BEEN DEFINED C NEXTOP = K8RIM IF(NEWCSN.EQ.0) GO TO 999 IF(.NOT.BATCH) ERROR = 0 IF(ERROR.NE.0) GO TO 950 WRITE (NOUT,9008) DBNAME 9008 FORMAT(/,28H RIM SCHEMA COMPILATION FOR ,A8,12H IS COMPLETE,/) C C BUFFER THE SCHEMA AND DATABASE OUT C DFLAG = .TRUE. IFMOD = .TRUE. CALL RMOPEN(DBNAME) IF(RMSTAT.NE.0) CALL WARN(RMSTAT,DBNAME,0) GO TO 999 C C ERROR PROCESSING. C 950 CONTINUE WRITE (NOUT,9009) 9009 FORMAT(43H -WARNING- ERRORS IN RIM SCHEMA COMPILATION) DFLAG = .TRUE. IFMOD = .TRUE. CALL RMOPEN(DBNAME) IF(RMSTAT.NE.0) CALL WARN(RMSTAT,DBNAME,0) C C RETURN. C 999 CONTINUE C C RESET THE PROMPT CHARACTER TO R C CALL LXSET(K4PROM,K4RP) CALL BLKCLR(10) RETURN END -h- intcon.fsp Mon Apr 7 16:44:51 1986 ARISIA$DRC0:[003001.TMP]INTCON.FSP;2 SUBROUTINE INTCON(INTOPT) INCLUDE 'TEXT.BLK' C C PURPOSE: THIS ROUTINE PROMPTS THE USER FOR THE EXECUTION C OPTION DESIRED (CREATE,UPDATE OR QUERY) AND CALLS C THE APPROPRIATE SUBROUTINES. C C PARAMETERS: INTOPT - MENU MODE OPTION CODE C 4HMENU - DISPLAY MENU C 3HCRE -- CREATE MODE C 3HUPD -- UPDATE MODE C 3HQUE -- QUERY MODE C INCLUDE 'RMATTS.BLK' INCLUDE 'RMKEYW.BLK' INCLUDE 'CONST4.BLK' INCLUDE 'FLAGS.BLK' INCLUDE 'FILES.BLK' INCLUDE 'RIMCOM.BLK' INCLUDE 'MISC.BLK' C INTEGER DBSTAT LOGICAL EQKEYW INCLUDE 'DCLAR2.BLK' C C ****************************************************** C C I N I T I A L I Z A T I O N C C ****************************************************** C NAMDB = DBNAME IF((INTOPT.EQ.K4CRE).OR.(INTOPT.EQ.K4UPD)) GO TO 150 IF(INTOPT.EQ.K4LOD) GO TO 255 C C REQUEST THE EXECUTION OPTION - IDBT C IDBT = 1: CREATE A NEW DATABASE C IDBT = 2: UPDATE AN EXISTING DATABASE C IDBT = 3: QUERY C IDBT = 4: COMMAND MODE C IDBT = 5: EXIT C IDBT = 0 100 WRITE(NOUT,110) 110 FORMAT(/,1X,35HSelect the execution option desired,/ 1 5X,24H1) CREATE a new database,/ 2 5X,30H2) UPDATE an existing database,/ 3 5X,29H3) QUERY an existing database,/ 4 5X,21H4) Enter COMMAND mode,/ 5 5X, 7H5) Exit,/) CALL LXLREC(DUM1,0,LXERR) IXID1 = LXID(1) IF(IXID1.EQ.K4EOF) GO TO 998 IXREC1 = 0 IF(IXID1.EQ.KZINT) IXREC1 = LXIREC(1) IF(EQKEYW(1,KWQUIT,4)) GO TO 997 IF(EQKEYW(1,KWEXIT,4)) GO TO 998 IDBT = IXREC1 IF(IDBT.EQ.4) GO TO 400 IF(IDBT.EQ.5) GO TO 998 IF(IDBT.GT.0.AND.IDBT.LT.5) GO TO 120 WRITE(NOUT,8001) GO TO 100 C C REQUEST THE DATABASE NAME - NAMDB C 120 WRITE(NOUT,130) 130 FORMAT(/,1X,30HEnter the NAME of the database,/) CALL LXLREC(DUM1,0,LXERR) IXID1 = LXID(1) IF(IXID1.EQ.K4EOF) GO TO 120 IXREC1 = LXWREC(1,1) IF(EQKEYW(1,KWQUIT,4)) GO TO 997 IXLEN = LXLENC(1) IF((IXID1.EQ.KZTEXT).AND.(IXLEN.LE.6)) GO TO 140 WRITE(NOUT,8002) GO TO 120 140 NAMDB = BLANK CALL LXSREC(1,1,8,NAMDB,1) IF(IDBT.NE.1) GO TO 180 C C CREATE MODE - CALL INTDEF TO DEFINE THE SCHEMA C INTOPT = K4CRE C C CHECK THAT THE DATABASE MAY BE MODIFIED C CALL RMDBLK(NAMDB) IF(RMSTAT.NE.0) GO TO 215 CALL INTDEF(NAMDB,INTOPT) IF(INTOPT.EQ.0) GO TO 100 GO TO 999 C C DETERMINE IF THE DATABASE IS TO BE LOADED INTERACTIVELY C 150 CONTINUE C C DETERMINE IF THE DATABASE IS TO BE LOADED C 160 WRITE(NOUT,170) 170 FORMAT(/,1X,41HDo you want to LOAD the database - Y or N,/) CALL LXLREC(DUM1,0,LXERR) IXID1 = LXID(1) IF(IXID1.EQ.K4EOF) GO TO 260 IXREC1 = 0 IF(IXID1.EQ.KZINT) IXREC1 = LXIREC(1) IF(IXID1.EQ.KZTEXT) IXREC1 = LXWREC(1,1) IF(EQKEYW(1,KWQUIT,4)) GO TO 997 IF(IXREC1.EQ.K4Y) GO TO 250 IF(IXREC1.EQ.K4N) GO TO 260 WRITE(NOUT,8004) GO TO 160 C C QUERY AND UPDATE MODE - GET THE DATABASE C 180 CONTINUE CALL RMDBGT(NAMDB,DBSTAT) IF(DBSTAT.EQ.0) GO TO 200 IF(DBSTAT.EQ.1) GO TO 100 GO TO 997 200 CONTINUE C C CHECK THAT USER DATABASE NAME MATCHES THE FILE DATABASE NAME C CALL RMOPEN(NAMDB) IF(RMSTAT.EQ.0) GO TO 210 CALL WARN(RMSTAT,NAMDB,0) RMSTAT = 0 GO TO 120 210 CONTINUE IF(IDBT.EQ.3) GO TO 300 C C CHECK THAT THE DATABASE MAY BE MODIFIED C CALL RMDBLK(NAMDB) IF(RMSTAT.EQ.0) GO TO 220 215 CALL WARN(RMSTAT,NAMDB,0) RMSTAT = 0 GO TO 100 C C REQUEST THE UPDATE OPTION C 1 -- DEFINE ADDITIONAL RELATIONS C (BRANCH TO THE DEFINE SECTION) C 2 -- LOAD ADDITIONAL DATA C (BRANCH TO THE LOAD SECTION) C 220 WRITE(NOUT,230) 230 FORMAT(/,1X,32HSelect the UPDATE option desired,/ 1 5X,30H1) Define additional relations,/ 2 5X,23H2) Load additional data,/) CALL LXLREC(DUM1,0,LXERR) IXID1 = LXID(1) IF(IXID1.EQ.K4EOF) GO TO 220 IXREC1 = 0 IF(IXID1.EQ.KZINT) IXREC1 = LXIREC(1) IF(IXID1.EQ.KZTEXT) IXREC1 = LXWREC(1,1) IF(EQKEYW(1,KWQUIT,4)) GO TO 997 IF(IXREC1.EQ.1) GO TO 240 IF(IXREC1.EQ.2) GO TO 250 WRITE(NOUT,8003) GO TO 220 C C ADD NEW RELATIONS C 240 CONTINUE INTOPT = K4UPD CALL INTDEF(NAMDB,INTOPT) IF(INTOPT.EQ.0) GO TO 100 GO TO 999 C C LOAD ADDITIONAL DATA C 250 CONTINUE INTOPT = 0 255 CONTINUE CALL INTLOD(INTOPT) IF(INTOPT.EQ.K4QUE) GO TO 260 GO TO 999 C C DETERMINE IF THE DATABASE IS TO BE QUERIED C 260 CONTINUE C C DETERMINE IF THE DATABASE IS TO BE QUERIED C 270 WRITE(NOUT,280) NAMDB 280 FORMAT(/,1X,5HThe ",A7,35H" Database has been created/updated,/,/, 1 1X,48HDo you want to QUERY the database at this time -, 2 7H Y or N,/) CALL LXLREC(DUM1,0,LXERR) IXID1 = LXID(1) IF(IXID1.EQ.K4EOF) GO TO 100 IXREC1 = 0 IF(IXID1.EQ.KZINT) IXREC1 = LXIREC(1) IF(IXID1.EQ.KZTEXT) IXREC1 = LXWREC(1,1) IF(IXREC1.EQ.K4QUIT) GO TO 997 IF(IXREC1.EQ.K4Y) GO TO 300 IF(IXREC1.EQ.K4N) GO TO 100 WRITE(NOUT,8004) GO TO 270 C C QUERY C 300 CONTINUE WRITE(NOUT,310) 310 FORMAT(/,1X,16HRIM Command mode,/) INTOPT = K4QUE GO TO 999 C C COMMAND MODE C 400 CONTINUE INTOPT = K4COM WRITE(NOUT,310) GO TO 999 C C QUIT C 997 CONTINUE INTOPT = K4QUIT GO TO 999 C C EXIT C 998 CONTINUE INTOPT = K4EXIT CALL RMCLOS 999 CONTINUE RETURN C C ERROR MESSAGES --------------------------------------- C 8001 FORMAT(/,1X,49H-ERROR- Either "1","2","3" or "4" must be entered, 1 /) 8002 FORMAT(/,1X,38H-ERROR- The database NAME must be 1-6 , 1 23Halphanumeric characters,/) 8003 FORMAT(/,1X,41H-ERROR- Either "1" or "2" must be entered,/) 8004 FORMAT(/,1X,41H-ERROR- Either "Y" or "N" must be entered,/) C END -h- joirel.fsp Mon Apr 7 16:44:51 1986 ARISIA$DRC0:[003001.TMP]JOIREL.FSP;2 SUBROUTINE JOIREL INCLUDE 'TEXT.BLK' C C THIS ROUTINE FINDS THE JOIN OF TWO RELATIONS BASED UPON JOINING C TWO ATTRIBUTES. THE RESULT FROM THIS PROCESS IS A PHYSICAL C RELATION WHICH HAS TUPLES CONTRUCTED FROM BOTH RELATIONS C WHERE THE SPECIFIED ATTRIBUTES MATCH AS REQUESTED. C C THE SYNTAX FOR THE JOIN COMMAND IS: C C JOIN REL1 USING ATT1 WITH REL2 USING ATT2 FORMING REL3 WHERE EQ C INCLUDE 'RMATTS.BLK' INCLUDE 'RMKEYW.BLK' INCLUDE 'CONST4.BLK' INCLUDE 'FLAGS.BLK' INCLUDE 'RIMCOM.BLK' INCLUDE 'TUPLER.BLK' INCLUDE 'TUPLEA.BLK' INCLUDE 'FILES.BLK' INCLUDE 'BUFFER.BLK' INCLUDE 'WHCOM.BLK' INCLUDE 'MISC.BLK' C INTEGER PTABLE LOGICAL EQ LOGICAL NE LOGICAL EQKEYW INCLUDE 'DCLAR1.BLK' INCLUDE 'DCLAR3.BLK' C C CALL RMDBLK TO MAKE SURE THE DATABASE MAY BE MODIFIED C CALL RMDBLK(DBNAME) IF(RMSTAT.EQ.0) GO TO 40 CALL WARN(RMSTAT,DBNAME,0) GO TO 9999 C C LOCAL ARRAYS AND VARIABLES : C C PTABLE (MATRIX 10) USED TO CONTROL POINTERS C ROWS1,2 -- ATTRIBUTE NAME C ROW3 -- ATTRIBUTE LOCATION IN RELATION 1 C ROW4 -- ATTRIBUTE LOCATION IN RELATION 2 C ROW5 -- ATTRIBUTE LOCATION IN RELATION 3 C ROW6 -- LENGTH IN WORDS C ROW7 -- ATTRIBUTE TYPE C C EDIT COMMAND SYNTAX C 40 CONTINUE CALL BLKCLN IF(.NOT.EQKEYW(3,KWUSIN,5)) GO TO 9900 IF(.NOT.EQKEYW(5,KWWITH,4)) GO TO 9900 IF(.NOT.EQKEYW(7,KWUSIN,5)) GO TO 9900 IF(.NOT.EQKEYW(9,KWFORM,7)) GO TO 9900 ITEMS = LXITEM(IDUMMY) C C SET DEFAULT WHERE CONDITION (EQ OR NK = 2) C NK = 2 IF(ITEMS.LE.10) GO TO 50 C C CHECK WHERE COMPARISON. C IF(.NOT.EQKEYW(11,KWWHER,5)) GO TO 9900 NK = LOCBOO(LXWREC(12,1)) IF(NK.EQ.0) GO TO 9900 IF(NK.EQ.1) GO TO 9900 50 CONTINUE C C KEYWORD SYNTAX OKAY C RNAME1 = BLANK CALL LXSREC(2,1,8,RNAME1,1) I = LOCREL(RNAME1) IF(I.EQ.0) GO TO 100 C C MISSING FIRST RELATION. C CALL WARN(1,RNAME1,0) GO TO 9999 100 CONTINUE C C SAVE DATA ABOUT RELATION 1 C I1 = LOCPRM(RNAME1,1) IF(I1.EQ.0) GO TO 110 CALL WARN(9,RNAME1,0) GO TO 9999 110 CONTINUE NCOL1 = NCOL NATT1 = NATT RPW1 = RPW MPW1 = MPW C C CHECK THE COMPARISON ATTRIBUTE. C ANAME1 = BLANK CALL LXSREC(4,1,8,ANAME1,1) I = LOCATT(ANAME1,RNAME1) IF(I.NE.0) CALL WARN(3,ANAME1,RNAME1) IF(I.NE.0) GO TO 9999 RNAME2 = BLANK CALL LXSREC(6,1,8,RNAME2,1) I = LOCREL(RNAME2) IF(I.EQ.0) GO TO 200 C C MISSING SECOND RELATION. C CALL WARN(1,RNAME2,0) GO TO 9999 200 CONTINUE C C SAVE DATA ABOUT RELATION 2 C I2 = LOCPRM(RNAME2,1) IF(I2.EQ.0) GO TO 210 CALL WARN(9,RNAME2,0) GO TO 9999 210 CONTINUE NCOL2 = NCOL NATT2 = NATT RPW2 = RPW MPW2 = MPW C C CHECK THE COMPARISON ATTRIBUTE. C ANAME2 = BLANK CALL LXSREC(8,1,8,ANAME2,1) I = LOCATT(ANAME2,RNAME2) IF(I.NE.0) CALL WARN(3,ANAME2,RNAME2) IF(I.NE.0) GO TO 9999 C C CHECK FOR LEGAL RNAME3 C IF((LXLENC(10).GE.1).AND.(LXLENC(10).LE.8)) GO TO 250 CALL WARN(7,KWRELA,BLANK) GO TO 9999 250 CONTINUE C C CHECK FOR DUPLICATE RELATION 3 C RNAME3 = BLANK CALL LXSREC(10,1,8,RNAME3,1) I = LOCREL(RNAME3) IF(I.NE.0) GO TO 300 C C ERROR C WRITE(NOUT,9000) 9000 FORMAT(55H -ERROR- RESULTANT RELATION DOES NOT HAVE A UNIQUE NAME) GO TO 9999 C C CHECK USER READ SECURITY C 300 CONTINUE IF((I1.NE.0).OR.(I2.NE.0)) GO TO 9999 C C RELATION NAMES OKAY -- CHECK THE ATTRIBUTES C C SET UP PTABLE IN MATRIX POSITION 10 C CALL BLKDEF(10,7,NATT1+NATT2) PTABLE = BLKLOC(10) NATT3 = 0 ICT = 1 C C STORE DATA FROM RELATION 1 IN PTABLE C I = LOCATT(BLANK,RNAME1) DO 500 I=1,NATT1 CALL ATTGET(ISTAT) IF(ISTAT.NE.0) GO TO 500 NATT3 = NATT3 + 1 BUFFER(PTABLE) = IBLANK CALL STRMOV(ATTNAM,1,8,BUFFER(PTABLE),1) BUFFER(PTABLE+2) = ATTCOL BUFFER(PTABLE+4) = ICT NWORDS = ATTWDS BUFFER(PTABLE+5) = ATTLEN IF(NWORDS.EQ.0) NWORDS = 1 ICT = ICT + NWORDS BUFFER(PTABLE+6) = ATTYPE PTABLE = PTABLE + 7 500 CONTINUE C C STORE DATA FROM RELATION 2 IN PTABLE C KATT3 = NATT3 I = LOCATT(BLANK,RNAME2) DO 550 I=1,NATT2 CALL ATTGET(ISTAT) IF(ISTAT.NE.0) GO TO 550 C C FIRST CHECK TO SEE IF ATTRIBUTE IS ALREADY IN PTABLE. C KQ1 = BLKLOC(10) - 7 DO 520 J=1,KATT3 KQ1 = KQ1 + 7 IF(BUFFER(KQ1+3).NE.0) GO TO 520 IF(NE(BUFFER(KQ1),ATTNAM)) GO TO 520 WRITE(NOUT,9003) ATTNAM 9003 FORMAT(11H -WARNING- ,A8,30H is a DUPLICATE attribute name) WRITE(NOUT,9004) 9004 FORMAT(53H You should rename it before doing queries or updates) GO TO 530 520 CONTINUE 530 CONTINUE C C ADD THE DATA TO PTABLE. C NATT3 = NATT3 + 1 BUFFER(PTABLE) = IBLANK CALL STRMOV(ATTNAM,1,8,BUFFER(PTABLE),1) BUFFER(PTABLE+3) = ATTCOL BUFFER(PTABLE+4) = ICT NWORDS = ATTWDS BUFFER(PTABLE+5) = ATTLEN IF(NWORDS.EQ.0) NWORDS = 1 ICT = ICT + NWORDS BUFFER(PTABLE+6) = ATTYPE PTABLE = PTABLE + 7 550 CONTINUE ICT = ICT - 1 C C PTABLE IS CONSTRUCTED C C NOW CREATE ATTRIBUTE AND RELATION TABLES AND THE RELATION C IF(ICT.GT.MAXCOL) GO TO 9850 C C SET UP THE WHERE CLAUSE FOR THE JOIN. C I = LOCATT(ANAME2,RNAME2) CALL ATTGET(ISTAT) IF(ATTWDS.GT.300) GO TO 9870 KEYCOL = ATTCOL KEYTYP = ATTYPE KEYLEN = ATTLEN NBOO = 1 BOO(1) = K4AND I = LOCATT(ANAME1,RNAME1) CALL ATTGET(ISTAT) KATTP(1) = ATTCOL KATTL(1) = ATTLEN C C MAKE SURE THE ATTRIBUTE TYPES MATCH. C IF(KEYTYP.NE.ATTYPE) GO TO 9800 IF(KEYLEN.NE.ATTLEN) GO TO 9700 KATTY(1) = ATTYPE IF(KEYTYP.EQ.KZIVEC) KATTY(1) = KZINT IF(KEYTYP.EQ.KZRVEC) KATTY(1) = KZREAL IF(KEYTYP.EQ.KZDVEC) KATTY(1) = KZDOUB IF(KEYTYP.EQ.KZIMAT) KATTY(1) = KZINT IF(KEYTYP.EQ.KZRMAT) KATTY(1) = KZREAL IF(KEYTYP.EQ.KZDMAT) KATTY(1) = KZDOUB KOMTYP(1) = NK KOMPOS(1) = 1 KOMLEN(1) = 1 KOMPOT(1) = 1 KSTRT = ATTKEY IF(NK.NE.2) KSTRT = 0 MAXTU = ALL9S LIMTU = ALL9S C C SET UP RELATION TABLE. C NAME = RNAME3 CALL RMDATE(RDATE) NCOL = ICT NCOL3 = ICT NATT = NATT3 NTUPLE = 0 RSTART = 0 REND = 0 RPW = RPW1 MPW = MPW1 IF(EQ(RPW,NONE).AND.NE(RPW2,NONE)) RPW = RPW2 IF(EQ(MPW,NONE).AND.NE(MPW2,NONE)) MPW = MPW2 CALL RELADD C CALL ATTNEW(NAME,NATT) PTABLE = BLKLOC(10) DO 700 K=1,NATT3 ATTNAM = BLANK CALL STRMOV(BUFFER(PTABLE),1,8,ATTNAM,1) RELNAM = NAME ATTCOL = BUFFER(PTABLE+4) ATTLEN = BUFFER(PTABLE+5) ATTYPE = BUFFER(PTABLE+6) ATTKEY = 0 CALL ATTADD PTABLE = PTABLE + 7 700 CONTINUE C C CALL JOIN TO CONSTRUCT MATN3 C CALL BLKDEF(11,MAXCOL,1) KQ3 = BLKLOC(11) PTABLE = BLKLOC(10) I = LOCREL(RNAME2) CALL JOIN(RNAME1,RNAME3,BUFFER(KQ3),NCOL3,NATT3,BUFFER(PTABLE), XKEYCOL,KEYTYP) GO TO 9999 C C MISMATCHED DATA TYPES. C 9700 CONTINUE WRITE(NOUT,9006) 9006 FORMAT(46H -ERROR- JOIN attributes are different lengths ) GO TO 9999 9800 CONTINUE WRITE(NOUT,9005) 9005 FORMAT(44H -ERROR- JOIN attributes are different types) GO TO 9999 C C TUPLE LENGTH EXCEEDS MAXCOL C 9850 CONTINUE WRITE(NOUT,9860) MAXCOL 9860 FORMAT(36H -ERROR- Relation ROW LENGTH Exceeds,I5) GO TO 9999 9870 CONTINUE WRITE (NOUT,9880) 9880 FORMAT(32H -ERROR- JOIN attribute too long ) GO TO 9999 C C SYNTAX ERROR IN JOIN COMMAND C 9900 CONTINUE CALL WARN(4,0,0) C C C DONE WITH INTERSECT C 9999 CONTINUE CALL BLKCLR(10) CALL BLKCLR(11) RETURN END -h- lxline.for Mon Apr 7 16:44:51 1986 ARISIA$DRC0:[003001.TMP]LXLINE.FOR;4 SUBROUTINE LXLINE(RECORD,LENREC,NUML,LINE,LEN,LOC) INCLUDE 'TEXT.BLK' C C THIS ROUTINE GETS THE NEXT LINE FOR LXLREC TO PARSE. IF LENREC C IS ZERO, FILE NIN IS READ, ELSE THE LINE IS EXTRACTED FROM RECORD. C IF LOC IS NOT ZERO NEW LINE IS ALREADY IN LINE, SIMPLY C MOVE THE DATA TO THE FRONT OF LINE. C INCLUDE 'LXCARD.BLK' INCLUDE 'PROM.BLK' INCLUDE 'LXCON.BLK' DIMENSION LINE(80) INTEGER RECORD(*) IF(LOC.NE.0) GO TO 200 NUML = NUML + 1 IF(LENREC.NE.0) GO TO 100 C C FROM FILE NIN C LEN = 80 C IF(NIN.EQ.5) WRITE(6,5) PROM 5 FORMAT(1X,A2,$) READ (NIN,10,END=13) LINE 10 FORMAT(80A1) LXEOF = .FALSE. C FORCE CHARS FROM TERMINALS TO BE UPPER CASE IF(NIN.NE.5)GOTO 14 C ONLY CHANGE CHARS FROM A TTY C ALSO STOP CHANGING IF WE GET TO A " CHARACTER DO 11 N=1,80 NN=MOD(LINE(N),256) IF(NN.EQ.34)GOTO 14 C 34 IS " CHARACTER IN ASCII C REPLACE a-z BY A-Z AND LEAVE ALL ELSE ALONE. C TRY TO LEAVE HIGH PARTS OF INTEGER ALONE. IF(NN.GE.97.AND.NN.LE.122)LINE(N)=(LINE(N)/256)*256+(NN-32) 11 CONTINUE GO TO 14 13 CONTINUE LXEOF = .TRUE. 14 CONTINUE C IF(LXEOF) GO TO 1000 IF(NOUT.EQ.0) GO TO 1000 IF(.NOT.ECHO) GO TO 1000 WRITE(NOUT,20) LINE 20 FORMAT(16H INPUT LINE ... ,80A1) GO TO 1000 100 CONTINUE C C GET LINE FROM RECORD C LEN = 0 I1 = 80*(NUML-1) + 1 I2 = 80*NUML IF(I1.GT.LENREC) GO TO 1000 IF(I2.GT.LENREC) I2 = LENREC DO 150 I=I1,I2 LEN = LEN + 1 CALL GETT(RECORD,I,LINE(LEN)) 150 CONTINUE GO TO 1000 200 CONTINUE NEWLEN = LEN - LOC IF(NEWLEN.LE.0) GO TO 230 DO 220 I=1,NEWLEN LOC = LOC + 1 LINE(I) = LINE(LOC) 220 CONTINUE 230 CONTINUE LEN = NEWLEN LOC = 0 1000 CONTINUE IF(LEN.LE.0) RETURN C C IGNORE TRAILING BLANKS C ICHECK = LEN + 1 DO 1100 I=1,LEN ICHECK = ICHECK - 1 IF(LINE(ICHECK).NE.BLANKS) GO TO 1200 1100 CONTINUE ICHECK = 1 1200 CONTINUE LEN = ICHECK RETURN END -h- lxline.fsp Mon Apr 7 16:44:51 1986 ARISIA$DRC0:[003001.TMP]LXLINE.FSP;2 SUBROUTINE LXLINE(RECORD,LENREC,NUML,LINE,LEN,LOC) INCLUDE 'TEXT.BLK' C C THIS ROUTINE GETS THE NEXT LINE FOR LXLREC TO PARSE. IF LENREC C IS ZERO, FILE NIN IS READ, ELSE THE LINE IS EXTRACTED FROM RECORD. C IF LOC IS NOT ZERO NEW LINE IS ALREADY IN LINE, SIMPLY C MOVE THE DATA TO THE FRONT OF LINE. C INCLUDE 'LXCARD.BLK' INCLUDE 'PROM.BLK' INCLUDE 'LXCON.BLK' DIMENSION LINE(80) INTEGER RECORD(*) IF(LOC.NE.0) GO TO 200 NUML = NUML + 1 IF(LENREC.NE.0) GO TO 100 C C FROM FILE NIN C LEN = 80 C 7001 CONTINUE IF(NIN.EQ.5) WRITE(6,5) PROM 5 FORMAT(1X,A2,$) READ (NIN,10,END=13) LINE 10 FORMAT(80A1) LXEOF = .FALSE. C FORCE CHARS FROM TERMINALS TO BE UPPER CASE IF(NIN.NE.5)GOTO 14 C ONLY CHANGE CHARS FROM A TTY C ALSO STOP CHANGING IF WE GET TO A " CHARACTER C IF 1ST CHAR IS } THEN DO COMMAND... IF(MOD(LINE(1),256).NE.125)GOTO 12 CALL USRCMD(LINE(2)) GOTO 7001 12 CONTINUE DO 11 N=1,80 NN=MOD(LINE(N),256) IF(NN.EQ.34)GOTO 14 C 34 IS " CHARACTER IN ASCII C REPLACE a-z BY A-Z AND LEAVE ALL ELSE ALONE. C TRY TO LEAVE HIGH PARTS OF INTEGER ALONE. IF(NN.GE.97.AND.NN.LE.122)LINE(N)=(LINE(N)/256)*256+(NN-32) 11 CONTINUE GO TO 14 13 CONTINUE LXEOF = .TRUE. 14 CONTINUE C IF(LXEOF) GO TO 1000 IF(NOUT.EQ.0) GO TO 1000 IF(.NOT.ECHO) GO TO 1000 WRITE(NOUT,20) LINE 20 FORMAT(16H INPUT LINE ... ,80A1) GO TO 1000 100 CONTINUE C C GET LINE FROM RECORD C LEN = 0 I1 = 80*(NUML-1) + 1 I2 = 80*NUML IF(I1.GT.LENREC) GO TO 1000 IF(I2.GT.LENREC) I2 = LENREC DO 150 I=I1,I2 LEN = LEN + 1 CALL GETT(RECORD,I,LINE(LEN)) 150 CONTINUE GO TO 1000 200 CONTINUE NEWLEN = LEN - LOC IF(NEWLEN.LE.0) GO TO 230 DO 220 I=1,NEWLEN LOC = LOC + 1 LINE(I) = LINE(LOC) 220 CONTINUE 230 CONTINUE LEN = NEWLEN LOC = 0 1000 CONTINUE IF(LEN.LE.0) RETURN C C IGNORE TRAILING BLANKS C ICHECK = LEN + 1 DO 1100 I=1,LEN ICHECK = ICHECK - 1 IF(LINE(ICHECK).NE.BLANKS) GO TO 1200 1100 CONTINUE ICHECK = 1 1200 CONTINUE LEN = ICHECK RETURN END -h- makerim.com Mon Apr 7 16:44:51 1986 ARISIA$DRC0:[003001.TMP]MAKERIM.COM;7 $ ! $ ! PROCEDURE TO INSTALL RIM VERSION 5 ON THE VAX $ ! $ ! Define the Fortran command we will use. $for:==fortran/f77/nocheck/nolist/nodebug/i4 $ ! CREATE THE RELOCATABLE LIBRARY $! note: To build a version that allows lowercase input and that $! allows }command to spawn command to DCL use the *.FSP routines $! and link with those. $ ! $ LIBRARY RIMLIB/CREATE $ ! $ ! NOW COMPILE ALL ROUTINES $ ! $FOR ADDDAT $LIBR RIMLIB ADDDAT $DEL ADDDAT.OBJ;* $FOR ATTADD $LIBR RIMLIB ATTADD $DEL ATTADD.OBJ;* $FOR ATTDEL $LIBR RIMLIB ATTDEL $DEL ATTDEL.OBJ;* $FOR ATTGET $LIBR RIMLIB ATTGET $DEL ATTGET.OBJ;* $FOR ATTNEW $LIBR RIMLIB ATTNEW $DEL ATTNEW.OBJ;* $FOR ATTPAG $LIBR RIMLIB ATTPAG $DEL ATTPAG.OBJ;* $FOR ATTPUT $LIBR RIMLIB ATTPUT $DEL ATTPUT.OBJ;* $FOR BLKCHG $LIBR RIMLIB BLKCHG $DEL BLKCHG.OBJ;* $FOR BLKCLN $LIBR RIMLIB BLKCLN $DEL BLKCLN.OBJ;* $FOR BLKCLR $LIBR RIMLIB BLKCLR $DEL BLKCLR.OBJ;* $FOR BLKDEF $LIBR RIMLIB BLKDEF $DEL BLKDEF.OBJ;* $FOR BLKEXT $LIBR RIMLIB BLKEXT $DEL BLKEXT.OBJ;* $FOR BLKLOC $LIBR RIMLIB BLKLOC $DEL BLKLOC.OBJ;* $FOR BLKMOV $LIBR RIMLIB BLKMOV $DEL BLKMOV.OBJ;* $FOR BTADD $LIBR RIMLIB BTADD $DEL BTADD.OBJ;* $FOR BTGET $LIBR RIMLIB BTGET $DEL BTGET.OBJ;* $FOR BTINIT $LIBR RIMLIB BTINIT $DEL BTINIT.OBJ;* $FOR BTLKI $LIBR RIMLIB BTLKI $DEL BTLKI.OBJ;* $FOR BTLKR $LIBR RIMLIB BTLKR $DEL BTLKR.OBJ;* $FOR BTLKT $LIBR RIMLIB BTLKT $DEL BTLKT.OBJ;* $FOR BTMOVE $LIBR RIMLIB BTMOVE $DEL BTMOVE.OBJ;* $FOR BTPUT $LIBR RIMLIB BTPUT $DEL BTPUT.OBJ;* $FOR BTREP $LIBR RIMLIB BTREP $DEL BTREP.OBJ;* $FOR BTSERT $LIBR RIMLIB BTSERT $DEL BTSERT.OBJ;* $FOR BUILD $LIBR RIMLIB BUILD $DEL BUILD.OBJ;* $FOR CHANGE $LIBR RIMLIB CHANGE $DEL CHANGE.OBJ;* $FOR CHKATT $LIBR RIMLIB CHKATT $DEL CHKATT.OBJ;* $FOR CHKREL $LIBR RIMLIB CHKREL $DEL CHKREL.OBJ;* $FOR CHKRUL $LIBR RIMLIB CHKRUL $DEL CHKRUL.OBJ;* $FOR CHKTUP $LIBR RIMLIB CHKTUP $DEL CHKTUP.OBJ;* $FOR CMPUTE $LIBR RIMLIB CMPUTE $DEL CMPUTE.OBJ;* $FOR CSC $LIBR RIMLIB CSC $DEL CSC.OBJ;* $FOR DBLOAD $LIBR RIMLIB DBLOAD $DEL DBLOAD.OBJ;* $FOR DELDAT $LIBR RIMLIB DELDAT $DEL DELDAT.OBJ;* $FOR DELDUP $LIBR RIMLIB DELDUP $DEL DELDUP.OBJ;* $FOR DELETE $LIBR RIMLIB DELETE $DEL DELETE.OBJ;* $FOR DROPF $LIBR RIMLIB DROPF $DEL DROPF.OBJ;* $FOR EQ $LIBR RIMLIB EQ $DEL EQ.OBJ;* $FOR EQKEYW $LIBR RIMLIB EQKEYW $DEL EQKEYW.OBJ;* $FOR F1CLO $LIBR RIMLIB F1CLO $DEL F1CLO.OBJ;* $FOR F1OPN $LIBR RIMLIB F1OPN $DEL F1OPN.OBJ;* $FOR F2CLO $LIBR RIMLIB F2CLO $DEL F2CLO.OBJ;* $FOR F2OPN $LIBR RIMLIB F2OPN $DEL F2OPN.OBJ;* $FOR F3CLO $LIBR RIMLIB F3CLO $DEL F3CLO.OBJ;* $FOR F3OPN $LIBR RIMLIB F3OPN $DEL F3OPN.OBJ;* $FOR FILCH $LIBR RIMLIB FILCH $DEL FILCH.OBJ;* $FOR GETDAT $LIBR RIMLIB GETDAT $DEL GETDAT.OBJ;* $FOR GETT $LIBR RIMLIB GETT $DEL GETT.OBJ;* $FOR GTSORT $LIBR RIMLIB GTSORT $DEL GTSORT.OBJ;* $FOR HASH $LIBR RIMLIB HASH $DEL HASH.OBJ;* $FOR HASHIN $LIBR RIMLIB HASHIN $DEL HASHIN.OBJ;* $FOR HTOI $LIBR RIMLIB HTOI $DEL HTOI.OBJ;* $FOR IEXP $LIBR RIMLIB IEXP $DEL IEXP.OBJ;* $FOR IFRT $LIBR RIMLIB IFRT $DEL IFRT.OBJ;* $FOR INTCON.FSP $LIBR RIMLIB INTCON $DEL INTCON.OBJ;* $FOR INTDEF $LIBR RIMLIB INTDEF $DEL INTDEF.OBJ;* $FOR INTLOD $LIBR RIMLIB INTLOD $DEL INTLOD.OBJ;* $FOR ISCAN $LIBR RIMLIB ISCAN $DEL ISCAN.OBJ;* $FOR ISECT $LIBR RIMLIB ISECT $DEL ISECT.OBJ;* $FOR ISREL $LIBR RIMLIB ISREL $DEL ISREL.OBJ;* $FOR ITOC $LIBR RIMLIB ITOC $DEL ITOC.OBJ;* $FOR ITOH $LIBR RIMLIB ITOH $DEL ITOH.OBJ;* $FOR JOIN $LIBR RIMLIB JOIN $DEL JOIN.OBJ;* $FOR JOIREL.FSP $LIBR RIMLIB JOIREL $DEL JOIREL.OBJ;* $FOR KMPARD $LIBR RIMLIB KMPARD $DEL KMPARD.OBJ;* $FOR KMPARI $LIBR RIMLIB KMPARI $DEL KMPARI.OBJ;* $FOR KMPARR $LIBR RIMLIB KMPARR $DEL KMPARR.OBJ;* $FOR KMPART $LIBR RIMLIB KMPART $DEL KMPART.OBJ;* $FOR KOMPXX $LIBR RIMLIB KOMPXX $DEL KOMPXX.OBJ;* $FOR LFIND $LIBR RIMLIB LFIND $DEL LFIND.OBJ;* $FOR LOADIT $LIBR RIMLIB LOADIT $DEL LOADIT.OBJ;* $FOR LOCATT $LIBR RIMLIB LOCATT $DEL LOCATT.OBJ;* $FOR LOCBOO $LIBR RIMLIB LOCBOO $DEL LOCBOO.OBJ;* $FOR LOCPRM $LIBR RIMLIB LOCPRM $DEL LOCPRM.OBJ;* $FOR LOCREL $LIBR RIMLIB LOCREL $DEL LOCREL.OBJ;* $FOR LODELE $LIBR RIMLIB LODELE $DEL LODELE.OBJ;* $FOR LODPAS $LIBR RIMLIB LODPAS $DEL LODPAS.OBJ;* $FOR LODREC $LIBR RIMLIB LODREC $DEL LODREC.OBJ;* $FOR LODREL $LIBR RIMLIB LODREL $DEL LODREL.OBJ;* $FOR LODRUL $LIBR RIMLIB LODRUL $DEL LODRUL.OBJ;* $FOR LSTREL $LIBR RIMLIB LSTREL $DEL LSTREL.OBJ;* $FOR LSTRNG $LIBR RIMLIB LSTRNG $DEL LSTRNG.OBJ;* $FOR LXCONS $LIBR RIMLIB LXCONS $DEL LXCONS.OBJ;* $FOR LXCREC $LIBR RIMLIB LXCREC $DEL LXCREC.OBJ;* $FOR LXEND $LIBR RIMLIB LXEND $DEL LXEND.OBJ;* $FOR LXGENR $LIBR RIMLIB LXGENR $DEL LXGENR.OBJ;* $FOR LXGENS $LIBR RIMLIB LXGENS $DEL LXGENS.OBJ;* $FOR LXGETI $LIBR RIMLIB LXGETI $DEL LXGETI.OBJ;* $FOR LXGETR $LIBR RIMLIB LXGETR $DEL LXGETR.OBJ;* $FOR LXID $LIBR RIMLIB LXID $DEL LXID.OBJ;* $FOR LXIREC $LIBR RIMLIB LXIREC $DEL LXIREC.OBJ;* $FOR LXITEM $LIBR RIMLIB LXITEM $DEL LXITEM.OBJ;* $FOR LXLENC $LIBR RIMLIB LXLENC $DEL LXLENC.OBJ;* $FOR LXLENW $LIBR RIMLIB LXLENW $DEL LXLENW.OBJ;* $FOR LXLINE.FSP $LIBR RIMLIB LXLINE $DEL LXLINE.OBJ;* $FOR LXLREC $LIBR RIMLIB LXLREC $DEL LXLREC.OBJ;* $FOR LXMASK $LIBR RIMLIB LXMASK $DEL LXMASK.OBJ;* $FOR LXNEXI $LIBR RIMLIB LXNEXI $DEL LXNEXI.OBJ;* $FOR LXSET $LIBR RIMLIB LXSET $DEL LXSET.OBJ;* $FOR LXSREC $LIBR RIMLIB LXSREC $DEL LXSREC.OBJ;* $FOR LXSTOR $LIBR RIMLIB LXSTOR $DEL LXSTOR.OBJ;* $FOR LXUSET $LIBR RIMLIB LXUSET $DEL LXUSET.OBJ;* $FOR LXWREC $LIBR RIMLIB LXWREC $DEL LXWREC.OBJ;* $FOR MINMAX $LIBR RIMLIB MINMAX $DEL MINMAX.OBJ;* $FOR MODIFY $LIBR RIMLIB MODIFY $DEL MODIFY.OBJ;* $FOR MOTSCN $LIBR RIMLIB MOTSCN $DEL MOTSCN.OBJ;* $FOR NE $LIBR RIMLIB NE $DEL NE.OBJ;* $FOR NSCAN $LIBR RIMLIB NSCAN $DEL NSCAN.OBJ;* $FOR PARVAL $LIBR RIMLIB PARVAL $DEL PARVAL.OBJ;* $FOR PJECT $LIBR RIMLIB PJECT $DEL PJECT.OBJ;* $FOR PRJTUP $LIBR RIMLIB PRJTUP $DEL PRJTUP.OBJ;* $FOR PRULE $LIBR RIMLIB PRULE $DEL PRULE.OBJ;* $FOR PTRS $LIBR RIMLIB PTRS $DEL PTRS.OBJ;* $FOR PUTDAT $LIBR RIMLIB PUTDAT $DEL PUTDAT.OBJ;* $FOR PUTT $LIBR RIMLIB PUTT $DEL PUTT.OBJ;* $FOR QUERY $LIBR RIMLIB QUERY $DEL QUERY.OBJ;* $FOR RELADD $LIBR RIMLIB RELADD $DEL RELADD.OBJ;* $FOR RELDEL $LIBR RIMLIB RELDEL $DEL RELDEL.OBJ;* $FOR RELGET $LIBR RIMLIB RELGET $DEL RELGET.OBJ;* $FOR RELOAD $LIBR RIMLIB RELOAD $DEL RELOAD.OBJ;* $FOR RELPAG $LIBR RIMLIB RELPAG $DEL RELPAG.OBJ;* $FOR RELPUT $LIBR RIMLIB RELPUT $DEL RELPUT.OBJ;* $FOR REUSE $LIBR RIMLIB REUSE $DEL REUSE.OBJ;* $FOR RIM $LIBR RIMLIB RIM $DEL RIM.OBJ;* $FOR RIOIN $LIBR RIMLIB RIOIN $DEL RIOIN.OBJ;* $FOR RIOOPN $LIBR RIMLIB RIOOPN $DEL RIOOPN.OBJ;* $FOR RIOOUT $LIBR RIMLIB RIOOUT $DEL RIOOUT.OBJ;* $FOR RMCLOS $LIBR RIMLIB RMCLOS $DEL RMCLOS.OBJ;* $FOR RMCONS $LIBR RIMLIB RMCONS $DEL RMCONS.OBJ;* $FOR RMDATE $LIBR RIMLIB RMDATE $DEL RMDATE.OBJ;* $FOR RMDBGT $LIBR RIMLIB RMDBGT $DEL RMDBGT.OBJ;* $FOR RMDBLK $LIBR RIMLIB RMDBLK $DEL RMDBLK.OBJ;* $FOR RMDBPT $LIBR RIMLIB RMDBPT $DEL RMDBPT.OBJ;* $FOR RMDEL $LIBR RIMLIB RMDEL $DEL RMDEL.OBJ;* $FOR RMFIND $LIBR RIMLIB RMFIND $DEL RMFIND.OBJ;* $FOR RMGATT $LIBR RIMLIB RMGATT $DEL RMGATT.OBJ;* $FOR RMGET $LIBR RIMLIB RMGET $DEL RMGET.OBJ;* $FOR RMGREL $LIBR RIMLIB RMGREL $DEL RMGREL.OBJ;* $FOR RMGTSO $LIBR RIMLIB RMGTSO $DEL RMGTSO.OBJ;* $FOR RMHELP $LIBR RIMLIB RMHELP $DEL RMHELP.OBJ;* $FOR RMLATT $LIBR RIMLIB RMLATT $DEL RMLATT.OBJ;* $FOR RMLOAD $LIBR RIMLIB RMLOAD $DEL RMLOAD.OBJ;* $FOR RMLOOK $LIBR RIMLIB RMLOOK $DEL RMLOOK.OBJ;* $FOR RMLREL $LIBR RIMLIB RMLREL $DEL RMLREL.OBJ;* $ FOR RMMAIN.FSP $ ! $FOR RMOPEN $LIBR RIMLIB RMOPEN $DEL RMOPEN.OBJ;* $FOR RMPUT $LIBR RIMLIB RMPUT $DEL RMPUT.OBJ;* $FOR RMRES $LIBR RIMLIB RMRES $DEL RMRES.OBJ;* $FOR RMRULE $LIBR RIMLIB RMRULE $DEL RMRULE.OBJ;* $FOR RMSAV $LIBR RIMLIB RMSAV $DEL RMSAV.OBJ;* $FOR RMSORT $LIBR RIMLIB RMSORT $DEL RMSORT.OBJ;* $FOR RMSTRT $LIBR RIMLIB RMSTRT $DEL RMSTRT.OBJ;* $FOR RMTIME $LIBR RIMLIB RMTIME $DEL RMTIME.OBJ;* $FOR RMTOL $LIBR RIMLIB RMTOL $DEL RMTOL.OBJ;* $FOR RMUSER $LIBR RIMLIB RMUSER $DEL RMUSER.OBJ;* $FOR RMVARC $LIBR RIMLIB RMVARC $DEL RMVARC.OBJ;* $FOR RMWHER $LIBR RIMLIB RMWHER $DEL RMWHER.OBJ;* $FOR RMZIP $LIBR RIMLIB RMZIP $DEL RMZIP.OBJ;* $FOR RNAMEA $LIBR RIMLIB RNAMEA $DEL RNAMEA.OBJ;* $FOR RNAMER $LIBR RIMLIB RNAMER $DEL RNAMER.OBJ;* $FOR ROUN $LIBR RIMLIB ROUN $DEL ROUN.OBJ;* $FOR RTOC $LIBR RIMLIB RTOC $DEL RTOC.OBJ;* $FOR RTOF $LIBR RIMLIB RTOF $DEL RTOF.OBJ;* $FOR RULDEL $LIBR RIMLIB RULDEL $DEL RULDEL.OBJ;* $FOR RULES $LIBR RIMLIB RULES $DEL RULES.OBJ;* $FOR RXREC $LIBR RIMLIB RXREC $DEL RXREC.OBJ;* $FOR SELECT $LIBR RIMLIB SELECT $DEL SELECT.OBJ;* $FOR SELOUT $LIBR RIMLIB SELOUT $DEL SELOUT.OBJ;* $FOR SELPAR $LIBR RIMLIB SELPAR $DEL SELPAR.OBJ;* $FOR SELPUT $LIBR RIMLIB SELPUT $DEL SELPUT.OBJ;* $FOR SETIN $LIBR RIMLIB SETIN $DEL SETIN.OBJ;* $FOR SETOUT $LIBR RIMLIB SETOUT $DEL SETOUT.OBJ;* $FOR SETRUL $LIBR RIMLIB SETRUL $DEL SETRUL.OBJ;* $FOR SORT $LIBR RIMLIB SORT $DEL SORT.OBJ;* $FOR SPOUT $LIBR RIMLIB SPOUT $DEL SPOUT.OBJ;* $FOR STATUS $LIBR RIMLIB STATUS $DEL STATUS.OBJ;* $FOR STRMOV $LIBR RIMLIB STRMOV $DEL STRMOV.OBJ;* $FOR SUBREL $LIBR RIMLIB SUBREL $DEL SUBREL.OBJ;* $FOR SUBTRC $LIBR RIMLIB SUBTRC $DEL SUBTRC.OBJ;* $FOR SWCON $LIBR RIMLIB SWCON $DEL SWCON.OBJ;* $FOR SWCOST $LIBR RIMLIB SWCOST $DEL SWCOST.OBJ;* $FOR SWFILO $LIBR RIMLIB SWFILO $DEL SWFILO.OBJ;* $FOR SWFLFS $LIBR RIMLIB SWFLFS $DEL SWFLFS.OBJ;* $FOR SWHART $LIBR RIMLIB SWHART $DEL SWHART.OBJ;* $FOR SWHRTD $LIBR RIMLIB SWHRTD $DEL SWHRTD.OBJ;* $FOR SWHRTI $LIBR RIMLIB SWHRTI $DEL SWHRTI.OBJ;* $FOR SWHRTR $LIBR RIMLIB SWHRTR $DEL SWHRTR.OBJ;* $FOR SWICST $LIBR RIMLIB SWICST $DEL SWICST.OBJ;* $FOR SWIDCP $LIBR RIMLIB SWIDCP $DEL SWIDCP.OBJ;* $FOR SWIICP $LIBR RIMLIB SWIICP $DEL SWIICP.OBJ;* $FOR SWINPO $LIBR RIMLIB SWINPO $DEL SWINPO.OBJ;* $FOR SWIRCP $LIBR RIMLIB SWIRCP $DEL SWIRCP.OBJ;* $FOR SWITCP $LIBR RIMLIB SWITCP $DEL SWITCP.OBJ;* $FOR SWSHEL $LIBR RIMLIB SWSHEL $DEL SWSHEL.OBJ;* $FOR SWSINK $LIBR RIMLIB SWSINK $DEL SWSINK.OBJ;* $FOR SWSMFL $LIBR RIMLIB SWSMFL $DEL SWSMFL.OBJ;* $FOR SWSMVL $LIBR RIMLIB SWSMVL $DEL SWSMVL.OBJ;* $FOR SWUNLO $LIBR RIMLIB SWUNLO $DEL SWUNLO.OBJ;* $FOR SWUNVL $LIBR RIMLIB SWUNVL $DEL SWUNVL.OBJ;* $FOR SWVLFS $LIBR RIMLIB SWVLFS $DEL SWVLFS.OBJ;* $FOR SWVLLO $LIBR RIMLIB SWVLLO $DEL SWVLLO.OBJ;* $FOR TALLY $LIBR RIMLIB TALLY $DEL TALLY.OBJ;* $FOR TOLED $LIBR RIMLIB TOLED $DEL TOLED.OBJ;* $FOR TOLER $LIBR RIMLIB TOLER $DEL TOLER.OBJ;* $FOR TTY $LIBR RIMLIB TTY $DEL TTY.OBJ;* $FOR TYPER $LIBR RIMLIB TYPER $DEL TYPER.OBJ;* $FOR UNDATA $LIBR RIMLIB UNDATA $DEL UNDATA.OBJ;* $FOR UNDEF $LIBR RIMLIB UNDEF $DEL UNDEF.OBJ;* $FOR UNLOAD $LIBR RIMLIB UNLOAD $DEL UNLOAD.OBJ;* $FOR USRCMD.FSP $LIBR RIMLIB USRCMD $DEL USRCMD.OBJ; $FOR WARN $LIBR RIMLIB WARN $DEL WARN.OBJ;* $FOR WHERE $LIBR RIMLIB WHERE $DEL WHERE.OBJ;* $FOR WHETOL $LIBR RIMLIB WHETOL $DEL WHETOL.OBJ;* $FOR WRLINE $LIBR RIMLIB WRLINE $DEL WRLINE.OBJ;* $FOR XHIBIT $LIBR RIMLIB XHIBIT $DEL XHIBIT.OBJ;* $FOR ZEROIT $LIBR RIMLIB ZEROIT $DEL ZEROIT.OBJ;* $LIBR/COMPRESS RIMLIB $PUR RIMLIB.OLB -h- rimcrd.doc Mon Apr 7 16:44:51 1986 ARISIA$DRC0:[003001.TMP]RIMCRD.DOC;2 RIM Handy Reference Card DEFINING A DATABASE SCHEMA DEFINE dbname OWNER password ATTRIBUTES attname {REAL} [{length}][KEY] INT VAR TEXT DOUB RVEC IVEC DVEC attname {RMAT} {row,col} [KEY] IMAT row,VAR DMAT VAR,VAR RELATIONS relname WITH attname1 [attname2...] PASSWORDS {READ PASSWORD} FOR {relname} IS password RPW ALL {MODIFY PASSWORD} FOR {relname} IS password MPW ALL RULES attname [IN relname] {EQ} value [{AND}...] NE OR GT GE LT LE attname IN relname {EQA} attname IN relname [{AND}...] NEA OR GTA GEA LTA LEA END LOADING A RELATION LOAD relname value1 value2 ... valueN END value: SCALARS val1 TEXT "text string" VECTOR (val1, val2, ...) MATRIX(r1c1,r2c1,...),(r1c2,r2c2,...)...) QUERYING A RELATION SELECT {attname1 [=fid1],attname2[=fid2],...} FROM relname + attnum1 [=fid1],... attname1(i),... attname1(i,j)... ALL [SORTED BY attname1 [={A}],[attname2 [={A}]...]]+ D D [WHERE ...] TALLY attname [={A}] FROM relname [WHERE...] D WHERE CLAUSE: WHERE attname {EXISTS} [{AND}...] FAILS OR EQS value EQ {value} NE MAX GT MIN LT LE GE WHERE attname {EQA} attname [{AND}...] NEA OR GTA GEA LTA LEA WHERE ROWS {EQ} rownumber [{AND}...] NE OR LT LE GE GT WHERE {attname} {EQ} list [{AND}...] ROWS NE OR WHERE LIMIT EQ number [{AND}...] OR ... QUERYING THE SCHEMA LISTREL [relname] ALL EXHIBIT attname1 [attname2...] PRINT RULES COMPUTATION COMMAND COMPUTE {COUNT} attname FROM relname [WHERE...] MIN MAX AVE SUM MODIFICATION COMMANDS CHANGE {attname} TO value [IN relname] WHERE ... attname(i) attname(i,j) CHANGE {RPW} TO newpass FOR relname MPW CHANGE OWNER TO newowner DELETE ROWS FROM relname WHERE ... DELETE DUPLICATES [attname1,attname2,...] FROM relname DELETE RULE rulenumber RENAME ATTRIBUTE attname TO newname [IN relname] RENAME RELATION relname TO newname REMOVE relname RELATIONAL ALGEBRA COMMANDS INTERSECT relname1 WITH relname2 FORMING relname3 + [USING attname1 [attname2,...]] JOIN relname1 Using attname1 WITH relname2 USING attname2 + FORMING relname3 [WHERE {EQ}] NE GT GE LT LE SUBTRACT relname1 FROM relname2 FORMING relname3 + [USING attname1 [attname2,...]] PROJECT relname1 FROM relname2 USING + {attname1,[attname2,...]} [WHERE ...] ALL REPORT COMMANDS NEWPAGE BLANK n TITLE "title" DATE LINES n WIDTH n KEY COMMANDS BUILD KEY FOR attname IN relname DELETE KEY FOR attname IN relname RIM-TO-RIM COMMAND UNLOAD [dbname [=newdbname]] {SCHEMA} [relname1 [=mpw] + DATA ALL [relname2 [=mpw],...] GENERAL COMMANDS INPUT {filename} TERMINAL OUTPUT {filename} TERMINAL EXIT QUIT MENU HELP [command name] USER password ECHO NOECHO CHECK NOCHECK TOLERANCE xx.xx [PERCENT] RELOAD CLOSE HOST DEPENDENT COMMANDS (note: may be CDC syntax) OPEN dbname [=filename],[UN=account],[PW=password],+ [DIRECT={R}] W ZIP "jet statement" }ANY DCL COMMAND executes "any dcl command" via spawn (VMS) -h- rmmain.fsp Mon Apr 7 16:44:51 1986 ARISIA$DRC0:[003001.TMP]RMMAIN.FSP;3 PROGRAM RMMAIN C C **************************************************************** C C RELATIONAL INFORMATION MANAGEMENT SYSTEM (RIM) - VERSION 5 C C THIS PROGRAM IS AN IMPLEMENTATION OF THE RELATIONAL ALGEBRA C MODEL OF DATA BASE MANAGEMENT. C C THE PRINCIPAL AUTHORS ARE C C WAYNE J. ERICKSON C DATA MANAGEMENT CONSULTANT C 2029 5TH STREET S.E. C PUYALLUP,WASHINGTON 98371 C FREDERIC P. GRAY JR. C BOEING COMERCIAL AIRPLANE COMPANY (BCAC) C GEOFFREY VONLIMBACH C BOEING COMPUTER SERVICES COMPANY (BCS) C C CONTRIBUTIONS TO RIM-5 CODE WERE ALSO MADE BY C C LAURA B. HAMED (UNLOAD) AND C STIG O. WAHLSTROM (SORT) OF BCS AND BCAC RESPECTIVELY. C C RIM-5 EXTENDS THE CAPABILITIES OF RIM-4 C PRIMARILY BY ADDING CAPABILITY FOR VARIABLE LENGTH C ATTRIBUTES,ADDING SEVERAL ATTRIBUTE TYPES,IMPLEMENTING C BOTH DIRECT AND MENU MODE,EXPANDING THE COMMAND LANGUAGE C AND ENTENDING THE FORTRAN INTERFACE CAPABILITIES C C RIM-5 IS WRITTEN IN FORTRAN 77 AND IS INTENDED TO C BE EASILY IMPLEMENTED ON COMPUTERS SUPPORTING THIS C LANGUAGE. C C RIM WAS ORIGINALLY DEVELOPED UNDER THE IPAD PROJECT C (NASA CONTRACT NAS-14700) BY WAYNE ERICKSON AND C DENNIS COMFORT BOTH AT THAT TIME WITH BCS. EXTENSIONS C TO RIM WERE THEN MADE BY WAYNE ERICKSON AND FRED GRAY C RESULTING IN VERSION 4 (RIM-4) IN LATE 1980. C C MAJOR MILESTONES IN THE DEVELOPMENT OF RIM: C C 1/78 TO 3/78 - WAYNE ERICKSON AND DENNIS COMFORT DEVELOP C VERSION 1 OF RIM AS PART OF THE IPAD PROJECT C 4/78 TO 9/78 - WAYNE AND DENNIS MAKE FURTHER ENHANCEMENTS TO C MAKE VERSION 2 WHILE AT IPAD C 6/79 TO 9/79 - WAYNE MAKES VERSION 3 OF RIM AT THE UNIVERSITY C OF WASHINGTON. THIS VERSION USED THE CDC C SEGMENTED LOADER AND THE FASTIO PACKAGE. C 9/79 TO 5/80 - WAYNE MAKES VERSION 4 OF RIM FOR THE UNIVERSITY C OF WASHINGTON AND BOEING/NASA. THIS VERSION COULD C HANDLE RELATIONS OF ANY LENGTH AND HAD KEY ELEMENTS C 5/80 TO 1/81 - FRED GRAY EXTENDS VERSION 4 AT BOEING TO INCLUDE C AN ENHANCED COMMAND LANGUAGE AND A MENU MODE OF C EXECUTION. C 9/80 TO 1/81 - WAYNE DEVELOPES A VAX VERSION OF RIM BASED ON THE C CDC VERSION. C 2/81 TO 9/81 - WAYNE TOGETHER WITH JEFF VON LIMBACH AND FRED GRAY C OF BOEING DEVELOP THE RIM PORTABLE VERSION (RIM-5). C C **************************************************************** C C RIM IS SUBJECT TO THE RESTRICTIONS AND DISCLAIMERS LISTED BELOW. C C RESTRICTIONS AND DISCLAIMERS C C THIS SOFTWARE IS PROVIDED BY THE BOEING COMPANY UNDER NASA CONTRACT C NAS1-14700 (IPAD). BOEING DEVELOPED AND/OR DISTRIBUTED IPAD SOFTWARE C AND DOCUMENTATION MAY BE USED BY AUTHORIZED RECIPIENTS SUBJECT TO THE C FOLLOWING LEGENDS. C C BECAUSE OF ITS POSSIBLE COMMERCIAL VALUE, THIS DATA DEVELOPED C UNDER U.S. GOVERNMENT CONTRACT NAS1-14700 IS BEING DISSEMINATED C WITHIN THE U.S. IN ADVANCE OF GENERAL PUBLICATION. THIS DATA MAY C BE DUPLICATED AND USED BY THE RECIPIENT WITH THE EXPRESSED LIMIT- C ATIONS THAT THE DATA WILL NOT BE PUBLISHED NOR WILL IT BE RELEASED C TO FOREIGN PARTIES WITHOUT PRIOR PERMISSION OF THE BOEING COMPANY. C RELEASE OF THIS DATA TO OTHER DOMESTIC PARTIES BY THE RECIPIENT C SHALL ONLY BE MADE SUBJECT TO THESE LIMITATIONS. THE LIMITATIONS C CONTAINED IN THIS LEGEND WILL BE CONSIDERED VOID AFTER OCT. 15, C 1985. THIS LEGEND SHALL BE MARKED ON ANY REPRODUCTION OF THIS C DATA IN WHOLE OR IN PART. C C BY ACCEPTANCE OF AND IN CONSIDERATION OF THE RECEIPT OF THE DOCU- C MENT, DATA, OR SOFTWARE, PRODUCED BY THE BOEING COMPANY (BOEING) C UNDER NATIONAL AERONAUTICS AND SPACE ADMINISTRATION (NASA) DEVEL- C OPMENT CONTRACT NO. NAS1-14700 (IPAD), THE THIRD PARTY RECIPIENT, C ITS SUCCESSORS AND ASSIGNS AGREE AS FOLLOWS: C C DISTRIBUTION OF THIS SOFTWARE (INCLUDING RELATED DATA AND C OTHER DOCUMENTATION) IS MADE BY BOEING ONLY AS AN C ACCOMODATION TO NASA. THIS SOFTWARE IS PROVIDED TO ALL C RECIPIENTS IN AN "AS IS" CONDITION. IN CONSIDERATION OF C RECEIPT OF THIS SOFTWARE, THE REQUESTOR AND ANY SUBSEQUENT C RECIPIENT ("RECIPIENT" HEREIN), AND THEIR SUCCESSORS AND C ASSIGNS, AGREE AS FOLLOWS: THE BOEING COMPANY MAKES NO C WARRANTY WHATSOEVER IN CONNECTION WITH THIS SOFTWARE, AND THE C RECIPIENT HEREBY WAIVES, RELEASES AND RENOUNCES ALL C WARRANTIES,GUARANTEES, OBLIGATIONS, LIABILITIES, RIGHTS AND C REMEDIES, EXPRESS OR IMPLIED, ARISING BY LAW, CONTRACT OR C OTHERWISE WITH RESPECT TO SUCH SOFTWARE. THE RECIPIENT SHALL C INCLUDE VERBATIM THE ENTIRE CONTENTS OF THIS DISCLAIMER, C INCLUDING THIS SENTENCE, WITH ANY AND ALL COPIES OF THIS C SOFTWARE WHICH IS PROVIDED TO ANY OTHER RECIPIENT. C C **************************************************************** C C PURPOSE: THIS PROGRAM CONTROLS THE TWO MAIN BRANCHES OF THE C RIM SYSTEM -- MENU AND COMMAND. IF THE USER C SELECTS THE MENU MODE, CONTROL IS PASSED TO THE C SUBROUTINE INTCON, IF THE COMMAND MODE IS SELECTED CONTROL C IS PASSED TO THE SUBROUTINE RIM. UPON AN "EXIT" THE C RETURNING AND/OR REPLACING OF THE DATABASE FILES IS C HANDLED BY MACHINE DEPENDENT ROUTINES, IE CDCPUT. C INCLUDE 'CONST4.BLK' INCLUDE 'CONST8.BLK' INCLUDE 'RMKEYW.BLK' INCLUDE 'CDCDBS.BLK' INCLUDE 'FLAGS.BLK' INCLUDE 'FILES.BLK' INCLUDE 'SELCOM.BLK' INCLUDE 'DCLAR6.BLK' LOGICAL TTY INTEGER VER INTEGER UDXX INTEGER MACH(2) DATA VER /3H5.1/ DATA UDXX /4HUD23/ DATA MACH(1),MACH(2) /4H-VAX,4H-VMS/ C CBCS **** START C C INITIALIZE - BATCH SHOULD BE FALSE ON OTHER MACHINES C NUMOPN = 0 BATCH = .FALSE. K = 0 IF(.NOT.TTY(K)) BATCH = .TRUE. C CBCS **** END C C OPEN THE INPUT AND OUTPUT FILES AND INITIALIZE C NINT = 5 NOUT = 6 NOUTR = 6 CALL LXCONS CALL RMSTRT CALL SETIN(K8IN) CALL SETOUT(K8OUT) ULPP = 0 UMCPL = 0 INTOPT = 0 NEXTOP = K8BEGI ECHO = .FALSE. CALL LXSET(KWECHO,K4OFF) IF(.NOT.BATCH) GO TO 50 ECHO = .TRUE. CALL LXSET(KWECHO,K4ON) 50 CONTINUE C C GET THE DATE AND TIME C CALL RMDATE(IDAY) CALL RMTIME(ITIME) C C SET THE PROMPT CHARACTER - CDC ONLY C CBCS **** START C CALL LXSET(K4PROM,K4RP) C CBCS **** END C C SET THE VERSION AND UPDATE IDENTIFIER C C C PRINT THE RIM EXECUTION HEADER C WRITE(NOUT,100) MACH(1),MACH(2),VER,UDXX,IDAY,ITIME 100 FORMAT(/,1X,11HBegin RIM -,2A4,8H Version,1X,A3, X 3X,A4,10X,A8,4X,A8,/) WRITE(NOUT,7200) 7200 FORMAT(' Updated 3/1986. }command spawns command.') C C EXECUTION OPTION IS COMMAND BY DEFAULT - PRINT MESSAGE C IF(BATCH) GO TO 500 IF(.NOT.CONNI) GO TO 500 WRITE(NOUT,200) 200 FORMAT(/,1X,16HRIM Command mode,/, X 1X,26HEnter "MENU" for MENU mode,/) GO TO 500 C C **************************************************************** C C I N T E R A C T I V E S E C T I O N C C **************************************************************** C 350 WRITE(NOUT,360) 360 FORMAT(/,1X,13HRIM menu mode) 400 CONTINUE INTOPT = 0 410 CONTINUE CALL INTCON(INTOPT) IF(INTOPT.EQ.K4EXIT) GO TO 900 IF(INTOPT.EQ.K4QUIT) GO TO 850 IF(INTOPT.EQ.K4COM) GO TO 600 IF(INTOPT.EQ.K4QUE) GO TO 600 IF(INTOPT.EQ.K4LOD) GO TO 800 IF((INTOPT.NE.K4CRE).AND.(INTOPT.NE.K4UPD)) GO TO 400 C C SET THE INPUT FILE TO SCHEMA AND READ THE FIRST RECORD C CALL SETIN(K8SCH) LENREC = 0 CALL LXLREC(DUM,LENREC,DUM) C C COMPILE THE SCHEMA AND SET INPUT BACK TO "INPUT" C CALL CSC CALL SETIN(K8IN) GO TO 410 C C **************************************************************** C C D I R E C T S E C T I O N C C **************************************************************** C 500 CONTINUE IF(NEXTOP.EQ.K8BEGI) GO TO 600 IF(NEXTOP.EQ.K8RIM ) GO TO 600 IF(NEXTOP.EQ.K8DEFI) GO TO 700 IF(NEXTOP.EQ.K8LOAD) GO TO 800 IF(NEXTOP.EQ.K8MENU) GO TO 350 C C BRANCH TO STATEMENT 400 IF RIM WAS CALLED FROM THE C MENU MODE C IF(INTOPT.EQ.K4QUE) GO TO 400 IF(NEXTOP.EQ.K8EXIT ) GO TO 900 C C CALL RIM FOR QUERY FUNCTIONS C 600 CONTINUE CALL RIM GO TO 500 C C CALL CSC TO DEFINE THE SCHEMA C 700 CONTINUE CALL CSC NEXTOP = K8RIM GO TO 500 C C CALL DBLOAD TO LOAD THE DATABASE C 800 CONTINUE CALL DBLOAD NEXTOP = K8RIM IF(INTOPT.EQ.K4LOD) GO TO 410 GO TO 500 C C **************************************************************** C C E X I T S E C T I O N C C **************************************************************** C C DROP THE DATABASE FILES - QUIT C 850 CONTINUE GO TO 9999 900 CONTINUE IF(BATCH) GO TO 999 IF(.NOT.CONNI) GO TO 999 IF(.NOT.CONNO) CALL SETOUT(K8OUT) CALL RMDBPT(NAMDB,DBSTAT) C C PRINT THE CLOSING MESSAGE AND EXIT C 999 CONTINUE CALL RMDATE(IDAY) CALL RMTIME(ITIME) WRITE(NOUT,7001) IDAY,ITIME 7001 FORMAT(/,1X,17HEnd RIM execution,25X,A8,4X,A8,/,/) C C ERROR MESSAGES ------------------------------------------------- C 8001 FORMAT(/,1X,41H-ERROR- Either "1" or "2" must be entered,/) C 9999 CONTINUE CALL EXIT END -h- text.blk Mon Apr 7 16:44:51 1986 ARISIA$DRC0:[003001.TMP]TEXT.BLK;4 C ********************************************************** C C THIS ROUTINE IS PART OF RIM VERSION 5 (RIM-5) C C RIM-5 WAS DEVELOPED IN 1981 (MAY-AUGUST) BY BOEING'S C BESS AND IPAD (NASA CONTRACT NAS-14700) PROJECTS. C THIS PROGRAM IS SUBJECT TO THE RESTRICTIONS AND C DISCLAIMERS LISTED IN THE RIM-5 MAIN PROGRAM (RMMAIN). C C THE PRINCIPAL AUTHORS ARE C C WAYNE J. ERICKSON C DATA MANAGEMENT CONSULTANT C 2029 5TH STREET S.E. C PUYALLUP,WASHINGTON 98371 C FREDERIC P. GRAY JR. C BOEING COMERCIAL AIRPLANE COMPANY (BCAC) C GEOFFREY VONLIMBACH C BOEING COMPUTER SERVICES COMPANY (BCS) C C ********************************************************** -h- usrcmd.fsp Mon Apr 7 16:44:51 1986 ARISIA$DRC0:[003001.TMP]USRCMD.FSP;5 C COPYRIGHT (C) 1983 GLENN EVERHART C PERMISSION IS GIVEN TO ANYONE TO USE, DISTRIBUTE, OR COPY THIS C PROGRAM FREELY BUT NOT TO SELL IT COMMERICALLY. SUBROUTINE USRCMD(CMDLIN) CHARACTER*80 CMDSTR BYTE CMLN(80) EQUIVALENCE(CMLN,CMDSTR) C DUMMY PLACE FOR USER COMMANDS TO PARSE CMDLIN AND HANDLE INTEGER*4 CMDLIN(79) INTEGER*4 ISTTS C C INSERT CODE FOR ADDING A LIB$SPAWN CALL HERE TO PASS COMMANDS TO C DCL IF THEY BEGIN WITH A $ CHARACTER. C C HERE CALL THE LIB$SPAWN WITH THE COMMAND LINE AS AN ARGUMENT... C MUST COPY TO A STRING FIRST SINCE I*4 LINE IS NOT USABLE BY LIB$SPAWN. DO 1000 NN=1,79 CMLN(NN)=MOD(CMDLIN(NN),256) C FORCE REMOVAL OF CTL CHARS IF(CMLN(NN).LT.32)CMLN(NN)=32 1000 CONTINUE c CMLN(80)=13 ! ADD C.R. AFTER LINE CMLN(80)=32 ! ADD space C ABOVE, INSERT A CR AFTER CMD LINE ISTTS=LIB$SPAWN(CMDSTR) 9990 CONTINUE RETURN END