.TITLE DBSFOR ... DBSMNG FORTRAN Interface .IDENT /010383/ .ENABL LC ; ; ; ; ; Written by Ray Di Marco ; 4-Jul-82. ; ; ; Version 040882/03. ; ; ;--------------------------------------------------------------------------- ; ; This module contains the DBSFOR routine that allows a FORTRAN program to ; interface with one or more DBSMNG databases. This module supports Run Time ; Loading of a TEMPLATE file; optionally the TEMPLATE may be linked in when ; the user program is assembled. The module entries are ; ; DBSFOR ... general entry point ; DBSFIN ... special initialization entry point ; ; The DBSFIN entry is a special entry point that is used to initialize the ; a TEMPLATE that was linked in when the program was built; this entry is ; no longer required (as DBSFOR may be used to perform equivalent functions); ; it is provided to maintain compatiablity with the older version of this ; module. ; ; The FORTRAN instruction ; ; CALL DBSFOR (ICODE,ARG1,....,ARGn) ; ; is used to invoke the DBSFOR routine. The first argument (ICODE) is an ; opcode that determines the operation to be performed. Opcodes are supported ; to ; ; * INITIALIZE and SELECT DATABASEs ; * Access records ; * Access field ; * Access KEYs ; * Access database parameters ; .SBTTL Modifications ; ; 29-Nov-82 change date support routines from functions to subroutines. ; 22-Dec-82 correct .SAVEST/.REOPEN (R1)+ error in CH.SAV and CH.OPN ; 01-Mar-83 add in new call of form DBSFOR (15,INDEX,NAME,IDEV) ; This new call like DBSFOR (10,INDEX,NAME) ; extra argument IDEV ; is the name of the device in RAD50 upon which the database ; files reside (instead of DBS which is default). ; .SBTTL Documentation .IF EQ,-1 The DBSFOR module allows the FORTRAN programmer to access DBSMNG databases. Like all other DBSMNG modules, DBSFOR uses a TEMPLATE to gain access to a database. The user may link in the object version of the Template when the application program is built, or use DBSMNG to load the TEMPLATE at run time. While either method may be used, it is suggested that the first option (linking in the Template) be only used in small systems where the extra disk access needed to load the Template is unacceptable. While the rest of this text is addressed to applications that load the TEMPLATE at run time, all facilities described below are available even when the Template is linked in. When using DBSFOR, the programmer must make allowance for the three I/O channels and memory used by the DBSMNG routines and the database TEMPLATEs. The I/O channels are obtained from the FORTRAN OTS, and are used to access the DAT, KEY and PAR database files; to conserve I/O channels the same set of three channels are multiplexed for all databases. DBSFOR allows an application program to access a number of databases simultaneously. To do this, the TEMPLATE for each database must be loaded at run time, and assigned to an INDEX (in the range 0 to 4); the INDEX number is used to determine which database is being used at a particular time. DBSFOR allows the user to dynamically SELECT any of the loaded databases; once a database is selected, all DBSFOR operations function on that database until a new selection is performed. The format of a DBSFOR call is CALL DBSFOR (ICODE,ARG1,...,ARGn) where ICODE determines the operation to be performed and ARG1,..,ARGn are the arguments that are to be used in the operation. CALL DBSFOR (0,I) record read results in record number I (first record is numbered 1), for the currently SELECTED TEMPLATE being loaded into memory. CALL DBSFOR (1,I) record write results in record number I (first record is numbered 1), for the currently SELECTED TEMPLATE being overwritten with data in memory. CALL DBSFOR (2,NAME,BUF,ISIZE,ITYPE) get field results in contents of the field, whose name is NAME, for the currently loaded record, for the currently SELECTED database being returned in BUF; ISIZE and ITYPE are the number of data bytes returned and the type of data in the field respectively. CALL DBSFOR (3,NAME,BUF,ISIZE,ITYPE) put field results in contents of the field, whose name is NAME, for the currently loaded record, for the currently SELECTED database being updated to BUF; ISIZE and ITYPE are the field size and type attributes that must be correctly specified by the caller; this is a security check to prevent accidental modification of the wrong field. The update does not become "permanent" untill the record is written out. CALL DBSFOR (4,I,IKEYS) results in the 16 (integer) keys associated with record I of the currently selected database being returned in the array IKEYS. CALL DBSFOR (5,IKEYS) results in the 16 (integer) keys associated with record I of the currently selected database being changed in IKEYS; note that DBSMNG automatically regenerates the record keys (to match the data in the record) whenever a record is written out. CALL DBSFOR (6,NAME,IKEY) returns in IKEY the number of the key (in range 1 to 16) that is associated with field NAME of the currently selected database. CALL DBSFOR (7,I) returns the number of slots/records (ie the ENTRIES) in the currently selected database. CALL DBSFOR (8,NAME) returns the six letter name of the currently selected database. CALL DBSFOR (9,INDEX) SELECTs database INDEX; all operations will affect the selected database. CALL DBSFOR (10,INDEX,NAME) LOADS, INITIALIZES and SELECTS the database whose TEMPLATE is in the file NAME; the database is assigned to INDEX, which is an integer value (0-4) that is used henceforth to identify the database. If NAME is not specified, the Templated linked in when the program was built is INITIALIZED and SELECTED; all databases must be INTIALIZED before they can be used. CALL DBSFOR (11,IDATE) returns the current system date in DBSMNG format. CALL DBSFOR (12,IDATE,ID,IM,IY) returns in IDATE the DBSMNG format date equivalent to the day, month and year (to base 1900) counts passed in ID, IM and IY. CALL DBSFOR (13,IDATE,ID,IM,IY) converts the DBSMNG format date (IDATE) to the equivalent day, month and year (to base 1900) counts returned in ID, IM and IY. CALL DBSFOR (14,IDATE1,IDATE2,IFLAG) compares the two DBSMNG format dataes IDATE1 and IDATE2; IFLAG on return will be -1, 0 or +1 to indicate that IDATE1 is less than, equal or greater than IDATE2 respectively. Literal arguments passed to DBSFOR must be in standard .ASCIZ format (viz strings of characters terminated by a NULL>; FORTRAN literal constants are of this form, but literal strings input from the terminal are not, and require that the programmer insert a NULL in the string before the trailing spaces appended to literals by FORTTRAN. .ENDC .SBTTL Declarations ; ; .MCALL .PRINT,.EXIT ; used for error abort .MCALL .PUSH,.POP ; used for stacking .MCALL .SAVEST,.REOPEN,.PURGE ; channel control .MCALL .SETTOP ; used to gain memory .MCALL .DATE ; returns date .MCALL FILSPT ; get file support macros ; FILSPT ; set up file support system ; .GLOBL DBSFOR,DBSFIN ; entry points .GLOBL $$FORM,FORM$$ ; TEMPLATE pointer and address ; .GLOBL FIL.NA ; FILSPT - setup file name in ascii .GLOBL FILINT ; FILEIO - initialization .GLOBL FIL.DW,FIL.DR ; FILEIO - data I/O .GLOBL FIL.KW,FIL.KR ; FILEIO - Key I/O .GLOBL KEY.OT,KEY$$B ; KEYMNG - Key management .GLOBL LOCFLD ; LOCFLD - Locate NAMEd FIELD ; .GLOBL IGETSP ; OTS - gets space .GLOBL IGETC ; OTS - gets CHANNEL ; ; .PSECT CODE ; open code section ; ====== ==== ; ; .MACRO ERROR TEXT JSR R5,ERROR .ASCII /'TEXT'/<200> .EVEN .ENDM ERROR ; ; .SBTTL Entry - "DBSFOR" ... Database FORTRAN inteface ; ; This code ensures that the FORTRAN caller has specified a valid OPCODE, ; and that the right number of arguments have been passed. A program ABORT ; is performed if an error is detected. ; DBSFOR: CMPB (R5),#2 ; have at least 2 args? BLO 1000$ ; no -> abort MOV @2(R5),R0 ; R0 = opcode ASH #2,R0 ; R0 = offset equivalent to opcode CMP R0,#710$-700$ ; valid offset? BHI 1100$ ; no -> abort CMPB (R5),700$(R0) ; right number of arguments? BNE 1200$ ; no -> abort TST $$FORM ; TEMPLATE activated? BNE 600$ ; yes -> skip CMP @2(R5),#10. ; OPCODE -> need activate TEMPLATE BLO 1300$ ; yes -> abort 600$: JMP @700$+2(R0) ; pass control ; ; This table relates the opcode to the number of arguments ; needed and the address of routine that will perform the function ; 700$: .WORD 2,REC.RD ; read record into memory .WORD 2,REC.WD ; write record from memory .WORD 5,FLD.GT ; return contents of field .WORD 5,FLD.PT ; update contents of field .WORD 3,KEY.GT ; return keys associated with a record .WORD 3,KEY.PT ; update keys associated with a record .WORD 3,KEY.OF ; return KEY number of field .WORD 2,RET.NM ; return database size .WORD 2,NAME ; return DBS name .WORD 2,SWITCH ; switch to another TEMPLATE .WORD 3,LOAD ; load TEMPLATE .WORD 2,DATESY ; return system date .WORD 5,DATEBN ; generate DBSMNG date from day,month, year .WORD 5,DATESP ; seperate date into day, month, year .WORD 4,DATECM ; compare two dates .WORD 4,LOADSP ; load TEMPLATE and change DEVICE spec 710$: ; End Of Table ; ; Control is passed here upon the detection of an error. ; 1000$: ERROR 1100$: ERROR 1200$: ERROR 1300$: ERROR ; .SBTTL Routine - "REC.RD" ... Read RECORD into Memory ; ; This routine causes the specified record to be read into memory ; REC.RD: CALL RECNUM ; R0 = record number CALL FIL.DR ; read in a record BCS 1000$ ; failed -> abort RETURN ; exit 1000$: ERROR ; abort nicely ; ; .SBTTL Routine - "REC.WD" ... Write RECORD to file ; ; ; This routine causes the contents of the memory buffer to be written ; into the specified record on disk. ; REC.WD: CALL RECNUM ; R0 = record number CALL FIL.DW ; write out record BCS 1000$ ; failed -> abort CALL KEY.OT ; write out keys BCS 1100$ ; failed -> abort RETURN ; exit 1000$: ERROR ; abort point 1 1100$: ERROR ; abort point 2 ; ; .SBTTL Routine - "FLD.GT" ... Return contents of a FIELD ; ; This routine is called to return the contents of a FIELD; the name ; of the field is passed as an argument. The routine will also return ; the FIELD Type and Lenght attributes. ; ; FLD.GT: CALL FIELD ; R0 -> BUFFER ; R1 -> Feild FDT entry ; R2 = number bytes in field ; R3 -> field data ; R4 = field type MOV R4,@12(R5) ; return TYPE MOV R2,@10(R5) ; return LENGHT 110$: MOVB (R3)+,(R0)+ ; return contents ... SOB R2,110$ ; ... of field RETURN ; exit .SBTTL Routine - "FLD.PT" ... Update contents of a FIELD ; ; ; This routine is used to copy the contents of a buffer into a FIELD; the ; caller must correctly identify the FIELD by name, and as a security check, ; the field's type and lenght attributes. ; FLD.PT: CALL FIELD ; R0 -> BUFFER ; R1 -> Feild FDT entry ; R2 = number bytes in field ; R3 -> field data ; R4 = field type CMP R4,@12(R5) ; TYPE correct BNE 1000$ ; no -> abort CMP R2,@10(R5) ; Length correct BNE 1000$ ; no -> abort 110$: MOVB (R0)+,(R3)+ ; update contents ... SOB R2,110$ ; ... of field RETURN ; exit 1000$: ERROR ; .SBTTL Routine - "KEY.GT" ... Return KEYS associated with record ; ; ; This routine returns the 16 keys associated with the specified record ; in the buffer whose address is passed. ; KEY.GT: CALL RECNUM ; R0 = RECORD Number for Keys CALL FIL.KR ; read in keys MOV #KEY$$B,R0 ; R0 -> Key buffer MOV 6(R5),R1 ; R1 -> user buffer MOV #16.,R2 ; R2 = number keys per record 100$: MOV (R0)+,(R1)+ ; copy ... SOB R2,100$ ; ... all keys RETURN ; done ; ; .SBTTL Routine - "KEY.PT" ... Update KEYS associated with record ; ; ; This routine is used to associate 16 keys with a specified record. Note ; that as DBSMNG updates the keys associated with a record each time ; a WRITE RECORD is performed, an explicit KEY.PT need not normally be ; done. ; KEY.PT: MOV #KEY$$B,R0 ; R0 -> Key buffer MOV 6(R5),R1 ; R1 -> user buffer MOV #16.,R2 ; R2 = number key 100$: MOV (R1)+,(R0)+ ; copy data into ... SOB R2,100$ ; ... Key buffer CALL RECNUM ; R0 = Record number CALL FIL.KW ; write out key RETURN ; done ; ; ; .SBTTL Routine - "KEY.OF" ... Map KEY name into number ; ; This routine returns the number of the KEY whose name is passed as ; an argument; the first key is number 1 and the last 16. ; KEY.OF: MOV $$FORM,R0 ; R0 -> RDT ADD #30,R0 ; R0 -> KDT MOV 4(R5),R1 ; R1 -> Name of KEY field CALL LOCFLD ; R1 -> KDT entry for KEY BCS 1000$ ; failed -> abort MOV $$FORM,R0 ; R0 -> TEMPLATE SUB 30+2(R0),R1 ; R1 = offset of KEY entry in KDT ASH #-5,R1 ; R1 = KEY number INC R1 ; Base 0 -> 1 MOV R1,@6(R5) ; return argument MOV R1,R0 ; return as function as well RETURN ; exit 1000$: ERROR ; .SBTTL Routine - "RET.NM" ... Return number of entries in DBS ; ; ; This routine returns the number of entries/slots that make up the database. ; This is the ENTRIES argument specified when the database TEMPLATE was ; built. ; RET.NM: MOV $$FORM,R0 ; R0 -> FORM$$ MOV 14(R0),R0 ; R0 = number of entries MOV R0,@4(R5) ; return RETURN ; exit ; ; ; .SBTTL Routine - "LOAD" ... Load TEMPLATE and activate it ; ; ; This routine will cause the TEMPLATE whose name is passed @6(R5) to be ; loaded into memory and activated; the TEMPLATE will be associated with ; INDEX @4(R5). ; ; LOAD: CALL CH.FRE ; ensure have channels available CALL INDEX ; R1 = offset equivalent to index @4(R5) TST (R1) ; is slot free? BNE 1100$ ; no -> abort MOV 6(R5),R0 ; R0 -> TEMPLATE name CMP R0,#-1 ; blank argument? BEQ 1000$ ; yes -> skip CALL LOADER ; load TEMPLATE 400$: MOV R0,(R1)+ ; save TEMPLATE address MOV R0,$$FORM ; select TEMPLATE CALL DBSFIN ; activate TEMPLATE MOV R1,R0 ; R0 -> TEMPLATE entry in TAB CALL CH.SAV ; save channel data CALL CH.REO ; reopen channels RETURN ; all done 1000$: MOV $$FORM,R0 ; must want to use default TEMPLATE BNE 400$ ; got one -> continue ERROR 1100$: ERROR ; .SBTTL Routine - "LOADSP" ... Load (special) TEMPLATE and activate ; ; ; This routine will cause the TEMPLATE whose name is passed @6(R5) to be ; loaded into memory and activated; the TEMPLATE will be associated with ; INDEX @4(R5). LOAD is similar to LOAD; the diffence is that an optional ; argument must be passed; this optional argument is the name of the device ; (in RAD50) upon which the database files are stored. ; ; LOADSP: CALL CH.FRE ; ensure have channels available CALL INDEX ; R1 = offset equivalent to index @4(R5) TST (R1) ; is slot free? BNE 1100$ ; no -> abort MOV 6(R5),R0 ; R0 -> TEMPLATE name CMP R0,#-1 ; blank argument? BEQ 1000$ ; yes -> skip CALL LOADER ; load TEMPLATE 400$: MOV R0,(R1)+ ; save TEMPLATE address MOV R0,$$FORM ; select TEMPLATE ; .PUSH ; save MOV @10(R5),R1 ; R1 = device name .IRP X,<16,20,22> ; --- 3 FDBs to patch --- MOV $$FORM,R0 ; R0 -> template MOV X(R0),R5 ; R5 -> FDB MOV R1,@(R5) ; setup device name CALL FIL.NA ; setup file name in ascii .ENDR ; ----------------------- .POP ; restore ; CALL DBSFIN ; activate TEMPLATE MOV R1,R0 ; R0 -> TEMPLATE entry in TAB CALL CH.SAV ; save channel data CALL CH.REO ; reopen channels RETURN ; all done 1000$: MOV $$FORM,R0 ; must want to use default TEMPLATE BNE 400$ ; got one -> continue ERROR 1100$: ERROR ; .SBTTL Routine - "SWITCH" ... Switch Databases ; ; ; This routine is called to activate the TEMPLATE associated with INDEX ; @4(R5), thereby switching to an alternate database. ; SWITCH: CALL INDEX ; R1 = offset equivalent to index @4(R5) TST (R1) ; TEMPLATE assigned? BEQ 1100$ ; no -> abort CMP (R1),$$FORM ; TEMPLATE already selected? BEQ 700$ ; yes -> skip CALL CH.FRE ; ensure channels are free MOV (R1)+,$$FORM ; select TEMPLATE MOV R1,R0 ; R0 -> channel data CALL CH.REO ; re-open channels 700$: RETURN ; all done 1100$: ERROR ; .SBTTL Routine - "NAME" ... return DBS NAME ; ; This routine returns the name of the currently active TEMPLATE database. ; ; NAME: MOV 4(R5),R0 ; R0 -> buffer MOV $$FORM,R1 ; R1 -> TEMPLATE ADD #40,R1 ; R1 -> name MOV #6.,R2 ; R2 = number bytes to copy 1000$: MOVB (R1)+,(R0)+ ; copy .... SOB R2,1000$ ; .... across name RETURN ; all done ; ; .SBTTL Routine - "DATE??" ... general date support routines ; ; ; return system date in DBSMNG format ; DATESY: .DATE ; R0 = system date BIC #^C37777,R0 ; discard unwanted bits CLR R1 ; R0:R1 system date ASHC #-5,R0 ; seperate out year bits ADD R1,R0 ; R0 = DBSMNG format date MOV R0,@4(R5) ; return in IDATE RETURN ; done ; ; ; convert DAY,MONTH,YEAR counts to DBSMNG format ; DATEBN: MOV @12(R5),R0 ; R0 = year SUB #72.,R0 ; convert from base 1900 to 1972 ASH #6,R0 ; make room for month count ADD @10(R5),R0 ; add in month count ASH #5,R0 ; make room for day count ADD @6(R5),R0 ; add in day count MOV R0,@4(R5) ; return in IDATE RETURN ; R0 = date, therefore done ; ; ; convert DBSMNG format to DAY,MONTH,YEAR counts ; DATESP: MOV @4(R5),R1 ; R0 = date MOV R1,R0 ; R1 = date BIC #^C31.,R0 ; R0 = day count MOV R0,@6(R5) ; save it MOV R1,R0 ; R0 = date ASH #-5,R0 ; move month count to LSB BIC #^C15.,R0 ; R0 = month count MOV R0,@10(R5) ; save it ASH #-11.,R1 ; R1 = year count BIC #^C31.,R1 ; ensure unwanted bits clear ADD #72.,R1 ; base 1972 -> base 1900 MOV R1,@12(R5) ; return year count RETURN ; done! ; ; ; compare two DBSMNG format dates ; DATECM: CMP @4(R5),@6(R5) ; compare dates BHI 100$ ; if 1 > 2 --> 100$ BLO 200$ ; if 1 < 2 --> 200$ CLR @10(R5) ; must be equal RETURN ; exit 100$: MOV #1,@10(R5) ; indicate 1 > 2 RETURN ; exit 200$: MOV #-1,@10(R5) ; indicate 1 < 2 RETURN ; exit ; .SBTTL Primitive - "RECNUM" ... map FORTRAN arg into Record Number ; ; This routine returns the DBSMNG Record Number for the record whose number ; was passed in @4(R5) in R0; execution is aborted if an invalid record ; number is passed. ; RECNUM: MOV @4(R5),R0 ; R0 = record number MOV $$FORM,R1 ; R1 -> TEMPLATE CMP R0,14(R1) ; valid record number? BHI 1000$ ; no -> abort RETURN ; all done 1000$: ERROR ; flag error ; ; ; .SBTTL Primitive - "FIELD" ... Return FIELD attributes ; ; ; This routine is called to return the attributes associated with the ; field whose name is passed @4(R5); the attributes are returned in the ; registers as follows ; ; R0 -> user BUFFER ; R1 -> FDT entry for filed ; R2 = number bytes in field ; R3 -> address of field data area ; R4 = field Type ; FIELD: MOV $$FORM,R0 ; R0 -> RDT table MOV 4(R5),R1 ; R1 -> Name of field CALL LOCFLD ; locate field entry BCS 1000$ ; failed -> abort MOV 6(R5),R0 ; R0 -> BUFFER MOV (R1),R4 ; R4 = Type+Flags BIC #^C377,R4 ; R4 = Type MOV 4(R1),R3 ; R3 = offset in record of field ADD @$$FORM,R3 ; R3 -> field MOV 2(R1),R2 ; R2 = field size CMP R4,#2. ; ascii type field?? BLOS 400$ ; yes -> lenght right MOV #2.,R2 ; no -> 2 byte field 400$: RETURN ; all done 1000$: ERROR .SBTTL Primitive - "INDEX" ... map INDEX into TAB offset ; ; ; This routine offset into the TAB table equivalent to the INDEX that ; is passed in @4(R5). ; INDEX: MOV @4(R5),R1 ; R1 = DBS Number ASH #5,R1 ; R1 = Offset into table CMP R1,#TABE-TAB ; valid index? BHI 1000$ ; no -> skip ADD #TAB,R1 ; R1 -> entry RETURN ; all done 1000$: ERROR .SBTTL Primitive - "LOADER" ... Load TEMPLATE into memory ; ; ; This primitive is called to load the TEMPLATE contained in the file whose ; name is passed in R0 into MEMORY; the TEMPLATE is relocated by this routine ; and its load address returned in R0. ; ; ; We start of by associating a FDB via which we can access the template. ; LOADER: .PUSH ; save registers MOV R0,R4 ; R4 -> name PURGE #LDRFDB ; ensure FDB free NAME STRING=R4,EXTENS=#^RSAV,ERROR=700$ LOOKUP ERROR=710$ ; locate file ; ; Have to read in file header so that can calculate the start address ; (as block number and offset within block) and size of TEMPLATE. ; MOV #HEADER,R4 ; R4 -> Buffer READ BUFFER=R4,SIZE=#40,ERROR=720$; read in header block CALL 1000$ ; setup registers ; ; ; Work out where TEMPLATE will actually start and then proceed ; with LOAD procedure if got enough memory. ; CMP R0,770$+10 ; got amount memory needed? BNE 740$ ; no -> abort ; ; Read the TEMPLATE into memory. ; READ BUFFER=<770$+14>,BLOCK=R2,SIZE=R3,ERROR=730$; read in file ; ; ; ; Relocate pointers in the RDT and KDT tables. MOV R1,R2 ; R2 = start of template SUB R4,R1 ; R1 = relocation offset .IRP X,<0,2,16,20,22,30,32> ; ... relocate the index pointers ... ADD R1,X'(R2) ; reloacte pointers .ENDR ; ----------------------------------- .IRP X,<16,20,22> ; ... adjust the FDBs ... MOV X'(R2),R3 ; R3 -> FDB ADD R1,FDB.NR(R3) ; .RAD50 file name pointer ADD R1,FDB.NA(R3) ; .ASCII file name pointer ADD R1,FDB.BF(R3) ; buffer address .ENDR ; ----------------------------------- MOV 2(R2),R3 ; R3 -> first FDE MOV 4(R2),R4 ; R4 = number of field entries BEQ 750$ ; none -> fatal 600$: ADD R1,22(R3) ; update pointer to name ADD #40,R3 ; R3 -> next field entry SOB R4,600$ ; loop till all done ; ----------------------------------- MOV 32(R2),R3 ; R3 -> first KDE MOV 34(R2),R4 ; R4 = number of key entries BEQ 760$ ; none -> fatal 610$: ADD R1,22(R3) ; update pointer to name ADD #40,R3 ; R3 -> next key entry SOB R4,610$ ; loop till all done ; ----------------------------------- ; ; Exit with R0 pointing to start of template ; PURGE ; release the FDB MOV R2,R0 ; R0 -> template .POP ; restore RETURN ; all done ; ; ; Error abort points ; 700$: ERROR 710$: ERROR 720$: 730$: ERROR 740$: ERROR 750$: ERROR 760$: ERROR ; ; Argument block for calling IGETSP OTS routine. ; 770$: .WORD 3,770$+10,770$+12,770$+14; FTN argument call block .WORD 0,0,0 ; arguments ; ; ; This code is called with R4 pointing to the start of the file header ; block that has been read into memory; its function is to set up the ; registers as follows ; ; R1 address at which TEMPLATE will be loaded ; R2 number of block in file at which TEMPLATE starts ; R3 size of TEMPLATE in words ; R4 original (in file) address of TEMPLATE ; ; 1000$: MOV 50(R4),R3 ; R3 = estimate of template top BIT #1,40(R4) ; is start address set up? BNE 500$ ; no -> skip MOV 40(R4),R3 ; R3 = better estimate of top address 500$: MOV 42(R4),R2 ; R2 = start of template BIC #777,R2 ; truncate to block boundary SUB R2,R3 ; R3 = estimated template size MOV 42(R4),R1 ; R1 = base address of template SUB R2,R1 ; R1 = template offset ASH #-9.,R2 ; R2 = base template, block number INC R3 ; R3 = number of words ... ASR R3 ; .... in template INC R3 ; allow for extra word MOV 42(R4),R4 ; R4 = original template address ; ; Must now get memory from the OTS so that can load in TEMPLATE. ; .PUSH ; save registers MOV #770$,R5 ; R5 -> argblk MOV R3,10(R5) ; set up MIN and MAX ... MOV R3,12(R5) ; ... arguments CALL IGETSP ; ask for space .POP ; restore registers ADD 770$+14,R1 ; R1 = load address RETURN .SBTTL Primitive - "DBSFIN" ... Activate TEMPLATE ; ; This routine is called to activate the TEMPLATE whose address is in the ; $$FORM pointer; the routine patchs the three FDBs associated with the ; TEMPLATE so that they use valid RT-11 channel numbers that have been ; allocated by the FORTRAN OTS for exclusive DBSMNG use. ; DBSFIN: .PUSH ; save registers CALL CH.FRE ; get three channels MOV #CHNTAB,R0 ; R0 -> channel table .IRP X,<16,20,22> ; --- 3 FDB need channels --- MOV $$FORM,R1 ; R1 -> TEMPLATE MOV X(R1),R1 ; R1 -> FDB MOV (R0)+,FDB.CH(R1); allocate FDB a channel .ENDR ; ---------------------------- CALL FILINT ; initialize files .POP ; restore registers RETURN ; all done .SBTTL Primitive - "CH.FRE" ... Ensure that have channels available ; ; ; This primitive ensures that channels are available for DBSMNG routines to ; use; it ensures that 3 RT-11 channels are available, and sets up thier ; numbers in the CHNTAB table. Note that on the first time through the OTS ; IGETC routine is called to allocate channels for DBSMNG's exclusive use. ; CH.FRE: .PUSH ; save registers 70$: BR 500$ ; once only *** PATECHED *** 100$: MOV #CHNTAB,R1 ; R1 -> channel table MOV #3.,R2 ; R2 = number of channels 110$: .PURGE (R1) ; release channel ADD #2,R1 ; bump pointer SOB R2,110$ ; loop till all done .POP ; restore RETURN ; exit ; ; This code is execute once only, and causes three channels to be allocated ; for DBSMNG's exclusive use; it also patchs the LDRFDB to cause loader to ; us the first allocated channel in the CHNTAB table. ; 500$: MOV #CHNTAB,R1 ; R1 -> channel table MOV #3.,R2 ; R2 = number channels needed 540$: .PUSH ; save registers CALL IGETC ; get an RT-11 channel .POP ; restore registers MOV R0,(R1)+ ; save channel number BMI 1000$ ; failed -> abort SOB R2,540$ ; loop till have 3 channels MOV CHNTAB,LDRFDB+FDB.CH; allocate LOADER a channel MOV #NOP,70$ ; disable channel allocation code BR 100$ ; perform normal initialization 1000$: ERROR ; ; ; .SBTTL Primitive - "CH.SAV" ... Save Channel Status for later ; ; ; This routine is called to save the CHANNEL STATUS thereby free the ; channels for re-use; the user must point R0 to a 15 (decimal) word ; block of memory that can be used to save the channel data. ; CH.SAV: .PUSH ; save registers MOV #CHNTAB,R1 ; R1 -> channel table MOV #3.,R2 ; R2 = number of channels MOV R0,R3 ; R3 -> start save block 100$: .SAVEST #EMTBLK,(R1),R3 ; save channel data ADD #2,R1 ; bump channel pointer ADD #10.,R3 ; R3 -> next channel block SOB R2,100$ ; loop .POP ; restore RETURN ; all done ; .SBTTL Primitive - "CH.REO" ... Reopen Channels ; ; ; This routine is called to re-open (restore) the CHANNELs from the data ; that was saved in the block of memory (by CH.SAV) pointed to by R0. ; CH.REO: .PUSH ; save registers MOV #CHNTAB,R1 ; R1 -> channel table MOV #3.,R2 ; R2 = number of channels MOV R0,R3 ; R3 -> start save block 100$: .REOPEN #EMTBLK,(R1),R3 ; reopen channel ADD #2,R1 ; bump channel pointer ADD #10.,R3 ; R3 -> next channel block SOB R2,100$ ; loop .POP ; restore RETURN ; all done ; ; ; .SBTTL Primitive - "ERROR" ... abort because of error @R5 ; ; ERROR: .PRINT #ERRM00 ; identify module .PRINT R5 ; show cause of error .PRINT #ERRM01 ; terminate message TRAP 0 ; abort ; .NLIST BIN ERRM00: .ASCII <12><12><15>/DBSFOR-fatal-/<200> ERRM01: .ASCII /!/<200> .EVEN .LIST BIN .SBTTL Data area ; .PSECT DATA ; ; $$FORM: .WORD FORM$$ ; holds address of TEMPLATE CHNTAB: .WORD 0,0,0,0 ; used to hold channel number FDB LDRFDB,CHANNEL=1,SIZE=400 ; used to access database template EMTBLK: ; used for passing EMT args HEADER: .BLKW 40 ; used to input file header TAB: .WORD 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ; TEMPLATE ... .WORD 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ; ... addresses ... .WORD 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ; ... and CHANNEL ... .WORD 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ; ... status .WORD 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ; ................... TABE: ; End of Table .END