.TITLE GENCOM - GENERATE A DYNAMIC REGION AS SHARED COMMON .IDENT /V1/ ;JULY 78 .IDENT /V2/ ;DEC 78 ;DBC001 ; ; WRITTEN BY D.B.CURTIS OF THE ; FERMI NATIONAL LAB ; ; MODIFICATIONS: ; ; D.B.CURTIS DEC 78 ;ADDED FOLLOWING CHANGES ;DBC001 ; 1) COMMON IMAGES ARE OBTAINED ;DBC001 ; SY:[CURRENT UIC] ;DBC001 ; 2) ADDED PARAMITER TO SPECIFY ;DBC001 ; WHERE COMMON IS TO BE MAPPED TO ;DBC001 ; 3) MADE ARGUMENT LIST WITH SYMBLE OFFSETS ;DBC001 ; 4) ADDED CODE TO FIX BUG IN COMMON NAMES ;DBC001 ; WITH LESS THEN 6 LETTERS ;DBC001 ; ;DBC001 ; ;DBC001 ;+ ; GENCOM IS A ROUTINE THAT IS CALLED TO GENERATE A ; DYNAMIC AREA AND INITALIZING IT ; FROM A FILE ON SY:XXXXXX.TSK ;DBC001 ; ;**-1 ; THIS FILE IS GENERATED IN THE SAME MANNER AS ANY OTHER SHARED COMMON BLOC ; ; THE ROUTINE IS FORTRAN CALLABLE AND IS A LOGICAL*1 SUBROUTINE ; AS SUCH, THIS ROUTINE SAVES NO REGISTERS ; ;CALLING SEQUENCE: ; ; LOGICAL*1 GENCOM ; IF (.NOT.GENCOM(COMNAM,MAPOFS,OFFSET,SIZE,STATUS,DATE))GOTO ERROR ;DBC001 ; ;**-1 ; WHERE ; COMNAM IS THE NAME OF THE COMMON TO BE MADE ; 6 RAD50 CHAR LONG ; MAPOFS IS THE APR TO MAP THE COMMON TO ;DBC001 ; ;DBC001 ; NEXT ARGUMENTS ARE RETURNED BY THE SUBROUTINE ;DBC001 ; ;DBC001 ; OFFSET IS THE APR ADDRESS (I.E. 160000) ; SIZE IS THE LENGTH OF THE COMMON IN WORDS ; STATUS IS 1 IF NO ERROR AND SOME NEGATIVE NUMBER IF AN ERROR ; -1=NOT ABLE TO FIND COMMON FILE ; -2=COMMON NAMES DO NOT MACH IN FILE AND REQUESTED NAME ; -3=FILE HAS WRONG ATTRUBUTES ; -4=WASNOT ABLE TO CREAT REGION ; DATE IS A 3 WORD ARRARY THAT WILL CONTAIN THE DATE ; THE COMMON WAS CREATED ; DATE(1)=YEAR-1900 ; DATE(2)=MONTH ; DATE(3)=DAY ; ; RETURNS LOGICAL*1 TRUE IF COMMON CREATED ; RETURNS LOGICAL*1 FALSE IF COMMON NOT ABLE TO BE CREATED ; ; ASSEMBLY STRING: ; =[1,1]EXEMC/ML,[X,X]GENCOM ;- ; ARGUMENT OFFSETS ;DBC001 NOARG=0 ;DBC001 COMNAM=2 ;DBC001 MATOFS=4 ;DBC001 OFFSET=6 ;DBC001 SIZE=10 ;DBC001 STATUS=12 ;DBC001 DATE=14 ;DBC001 ;DBC001 .MCALL WTSE$,ERR$DF .MCALL FDBDF$,FDRC$A,FDBK$A,FDOP$A,FSRSZ$,RDBBK$,WDBBK$,NMBLK$ ERR$DF ;DEFINE ERROR LOGGING MACROS DFDACN ;DEFINE THE DA CONSTANTS ; ; GENERATE THE NAME OF THE COMMON AREA TO GENERATE THE SYSTEM IN ; COMPAR: PARNAM ;GENERATE 2 RAD50 WORDS OF PARTITION NAME ; ; FILE DATA STRUCTURES ; FDB: FDBDF$ FDRC$A FD.RWM FDBK$A HB,512.,,,IOSB FDOP$A LB0.LN,DSPT,DFNB, IOSB: .BLKW 2 FSRSZ$ 0 DFNB: NMBLK$ XXXXXX,TSK,0,SY,0 ;DBC001 ;DBC001 DSPT: .WORD 0,0 ;DBC001 .WORD 0,0 ;DBC001 .WORD NAMSZ,NAM ;DBC001 ;**-8 NAM: .ASCII /DACOMN/ NAMSZ=.-NAM .EVEN BLKN: .BLKW 2 WTDSK: WTSE$ 32. ; ; REGION DATA STRUCTURES ; RDB: RDBBK$ 0,0,GEN,,166000 WDB: WDBBK$ 5,0,0,0,0,,0 ; ; HB HEADER BLOCK TEMPERARY STORAGE ; HB: .BLKB 520. ; ; CODE ; .MCALL OPEN$,READ$,DIR$,CRRG$S,CRAW$S,CLOSE$ ; ; TRUE=200 FALSE=0 .MCALL LBLDF$ LBLDF$ ;INVOKE TSK HEADER OFFSETS .ENABL LSB GENCOM:: MOV COMNAM(R5),R4 ;GET ADDRESS OF COMMON NAME ;DBC001 MOV (R4),R0 ;SEE IF COMMON NAME IS BLANK ;DBC001 BIS 2(R4),R0 ;FOR BOTH PARTS OF NAME ;DBC001 BNE 11$ ;IF NOT EQUAL => OK ;DBC001 JMP FOPNER ;ERROR BY SAYING COULD NOT FIND COMMON ;DBC001 ;DBC001 11$: MOV DSPT+12,R0 ;GET PLACE IN DSP BLOCK TO PUT NAME ;DBC001 MOV (R4)+,R1 ;GET THE RAD50 NAME ;**-2 CALL $C5TA ;CONVERTO TO ASCII MOV (R4),R1 ;AND REST OF NAME CALL $C5TA ;AND CONVERT ALSO 12$: DEC R0 ;BACK UP TO REMOVE SPACES FROM COUNT ;DBC001 CMPB #' ,(R0) ;IS IT A SPACE ;DBC001 BEQ 12$ ;IF EQ YES CONTINUE ;DBC001 ;DBC001 INC R0 ;ADJUST TO POINT PAST LAST LETTER ;DBC001 SUB DSPT+12,R0 ;GENERATE NUMBER OF CHAR IN STRING MOV R0,DSPT+10 ;AND SAVE IN THE DISCRIPTER TABLE OPEN$ #FDB ;OPEN THIS FILE BCC 1$ JMP FOPNER ;FILE OPEN ERROR 1$: READ$ R0 ;READ A BLOCK (BLOCK 1) DIR$ #WTDSK ;WAIT FOR DISK TO BE READY SUB #2,R4 ;RESET R4 BACK TO NAME CMP (R4)+,HB+L$BPAR ;COMPARE COMMON NAMES BNE 2$ CMP (R4),HB+L$BPAR+2 ;CONTINUE COMPARING BEQ 3$ 2$: JMP WNGCOM ;MISMATCH IN COMMON NAMES ; 3$: BIC #100000,HB+L$BFLG ;CLEAR OFF PIC FLAG ;DBC001 CMP #40100,HB+L$BFLG ;CHECK THAT THIS TASK IMMAGE IS A COMMON;DBC001 BEQ 4$ ;**-1 JMP ATBERR 4$: MOV #HB+L$BDAT,R0 ;GET THE ADDRESS OF THE DATE MOV DATE(R5),R3 ;AND WHERE TO PUT IT ;DBC001 MOV (R0)+,(R3)+ ;GET YEAR ;DBC001 MOV (R0)+,(R3)+ ;AND MONTH ;DBC001 MOV (R0)+,(R3)+ ;AND DAY ;DBC001 MOV HB+L$BSA,@OFFSET(R5) ;TELL CALLER WHAT THE BASE ADDRESS IS ;DBC001 MOV HB+L$BMXZ,R3 ;GET THE SIZE OF THE COMMON IN 64. BYTE ;**-5 SUB #2,R4 ;BLOCKS AND RESET R4 MOV (R4)+,RDB+R.GNAM ;PUT NAME IN REGION MOV (R4),RDB+R.GNAM+2 MOV R3,RDB+R.GSIZ ;AND PUT IN SIZE MOV RDB+R.GSIZ,WDB+W.NSIZ ;SET IN WINDOW SIZE MOV COMPAR,R.GPAR+RDB ;OTHERWISE, SET IN NAME MOV COMPAR+2,R.GPAR+RDB+2 ; CRRG$S #RDB ;GENERATE THE REGION BCC 5$ ERRLOG ABRT, 5$: TST RDB+R.GID ;CHECK THAT WE GOT AN ID BNE 6$ ;IF NE YES JMP RGNCER ;REGION CREAT ERROR ; 6$: MOV RDB+R.GID,WDB+W.NRID ;PUT REGION ID IN WINDO BLOCK MOV RDB+R.GSIZ,WDB+W.NLEN ;AND ALSO LENGTH MOVB @MATOFS(R5),WDB+W.NAPR ;SELECT APR ;DBC001 CRAW$S #WDB ;MAP THE WINDOW ;DBC001 ASH #6,R3 ;CONVERT NUMBER OF 64. BYTES TO BYTES ;**-1 CLR BLKN ;CLEAR THE BLOCK NUMBER MOV HB+L$BHRB,BLKN+2 ;SET IN TH BLOCK NUMBERT OFFSET INC BLKN+2 ;MAKE USEABLE READ$ #FDB,WDB+W.NBAS,R3,#BLKN ;READ IN THE COMMON AREA IN TO THE COMM;DBC001 DIR$ #WTDSK ;DBC001 ASR R3 ;ADJUST BYTES TO WORDS ;DBC001 MOV R3,@SIZE(R5) ;SEND BACK TO CALLER ;DBC001 MOV #1,@STATUS(R5) ;SEND OK STATUS BACK TO CALLER ;DBC001 CLOSE$ #FDB ;**-5 MOV #TRUE,R0 ;SHOW COMPLEATED OK BR LEAV ; ; ERRORS ; FOPNER: MOV #-1,R1 BR EREX1 WNGCOM: MOV #-2,R1 BR EREX ATBERR: MOV #-3,R1 BR EREX RGNCER: MOV #-4,R1 BR EREX EREX: CLOSE$ #FDB EREX1: MOV R1,@STATUS(R5) ;DBC001 MOV #FALSE,R0 ;**-1 ;EXIT LEAV: RETURN .END