* Database example machine code program. * Example 1: Demonstrate CREATE by means of a job. INCLUDE flp2_QDOS_TRAP_IN INCLUDE flp2_QDOS_VECT_IN DATA 1024 SD.CURE EQU $E SD.CURS EQU $F SD.TAB EQU $11 * INCLUDE flp2_QDOS_DATA_IN * Organise layout of dataspace. OFFSET 0 WIND DS.L 1 Screen window channel ID DSBRT DS.L 1 Database manager vector DCHAN DS.L 1 Database channel ID DBASE DS.L 1 Database ID WORK * SECTION MAIN * Job header: BRA.L START DC.W 0,$4AFB,6,'CREATE' * Various pieces of data FILENAME DC.W 15,'FLP2_MCTEST_DBS' File name DBFM.NUM EQU 2 2 Fields: DBFORMAT DC.W 1,0,1,0 INT.W,INT.W DBOR.NUM EQU 1 1 Order field only: DBORDER DC.W 2,1 Ascending order on 2nd field. * Extra info string SEXTRA DC.B '"INTW1","INTW2"',$0D,$0A,'Machine code test 1',$0A SXTR.NUM EQU *-SEXTRA String length DS.W 0 * WINDOW DC.B 7,1,0,4 Window definition DC.W 224,186,288,26 * 123456789 123456789 123456789 12345 MESSE DC.W 22,'Press any key to exit ' MESS1 DC.B 00,22,'CREATE demonstration.',$0A DS.W 0 MESS2 DC.W 33,'Overwrite FLP2_MCTEST_DBS (Y/N)? ' MESS3 DC.B 00,19,' Field(s) created.',$0A DS.W 0 MESS4 DC.B 00,13,'Type,length:',$0A DS.W 0 MESS5 DC.B 00,17,' Order field(s).',$0A DS.W 0 MESS6 DC.B 00,17,'Field,direction:',$0A DS.W 0 MESS7 DC.B 00,12,' Record(s).',$0A DS.W 0 * Start by clearing my dataspace START LEA 0(A6,A5.L),SP Set SP to top of dataspace LEA 0(A6,A4.L),A6 Set A6 to bottom MOVE.L A6,A4 CLR_LOOP CLR.B (A4)+ Clear it out CMPA.L A4,SP BNE.S CLR_LOOP * Open a window to use for user IO LEA WINDOW(PC),A1 MOVE.W UT.CON,A2 Open window JSR (A2) BEQ.S PRT_MES1 BRA.S SUICIDE * Print error message and wait for keypress SUI_PRT MOVE.L WIND(A6),A0 MOVE.W UT.ERR,A2 Print the error message JSR (A2) * Exit point to quit SUI_QUIT MOVE.L WIND(A6),A0 MOVE.L D0,-(SP) Save error code LEA MESSE(PC),A1 Print error quit message MOVE.W UT.MTEXT,A2 JSR (A2) (Returns D3=-1) BNE.S SUI_CONT MOVEQ #SD.CURE,D0 Enable cursor TRAP #3 MOVEQ #IO.FBYTE,D0 Wait for keypress TRAP #3 SUI_CONT MOVE.L (SP)+,D0 * Quit program SUICIDE MOVE.L D0,D3 Return error message to activator job MOVEQ #-1,D1 Remove myself MOVEQ #MT.FRJOB,D0 TRAP #1 * Send message 1 to window PRT_MES1 MOVE.L A0,WIND(A6) LEA MESS1(PC),A1 MOVE.W UT.MTEXT,A2 JSR (A2) BNE.S SUICIDE * Open database channel - Not overwrite LEA FILENAME(PC),A0 Filename ptr MOVEQ #-1,D1 For myself MOVEQ #IO.NEW,D3 New file MOVEQ #IO.OPEN,D0 Open the channel TRAP #2 TST.L D0 BEQ.S OP_DB_OK Jump if opened OK CMPI.L #ERR.EX,D0 Quit if error not "already exists" BNE.S SUI_PRT * Print "overwrite?" question, and get answer. MOVE.L WIND(A6),A0 LEA MESS2(PC),A1 MOVE.W UT.MTEXT,A2 Print message JSR (A2) BNE.S SUICIDE * MOVEQ #SD.CURE,D0 Enable cursor TRAP #3 * FT_OVERQ MOVEQ #IO.FBYTE,D0 Fetch byte TRAP #3 TST.L D0 BNE.S SUI_PRT * MOVEQ #ERR.EX,D0 BCLR #5,D1 Make uppercase CMPI.B #'Y',D1 BEQ.S FT_OVERW Overwrite if Y pressed CMPI.B #'N',D1 BEQ.S SUI_PRT Exit if N or ESC pressed CMPI.B #$27,D1 BEQ.L SUI_PRT BRA.S FT_OVERQ Otherwise get another char. * Print Y, turn cursor off. FT_OVERW MOVEQ #IO.SBYTE,D0 PRINT Y TRAP #3 TST.L D0 BNE.L SUI_PRT MOVEQ #SD.CURS,D0 TRAP #3 MOVEQ #$0A,D1 PRINT LF MOVEQ #IO.SBYTE,D0 TRAP #3 TST.L D0 BNE.L SUI_PRT * Open the file OVERWRITE if possible. LEA FILENAME(PC),A0 Filename ptr MOVEQ #-1,D1 For myself MOVEQ #IO.OVERW,D3 Overwrite file MOVEQ #IO.OPEN,D0 Open the channel TRAP #2 TST.L D0 BNE.L SUI_PRT * Now find out database manager OP_DB_OK MOVE.L A0,DCHAN(A6) Save channel ID MOVEQ #-1,D3 MOVEQ #FS.DBASE,D0 Get the vector TRAP #3 TST.L D0 BNE.L SUI_PRT MOVE.L A1,DSBRT(A6) Save vector address MOVE.L A1,A4 * Now CREATE a database * Use internal memory routines (MT.ALCHP, MT.RECHP): set A2 to 0 LEA DBFORMAT(PC),A1 Field list MOVE.W #DBFM.NUM,D2 No. of fields SUBA.L A2,A2 Memory allocate/release address JSR FSD.CRT(A4) BNE.L SUI_PRT MOVE.L A0,DBASE(A6) Save database address * Set extra information string LEA SEXTRA(PC),A1 MOVE.W #SXTR.NUM,D2 JSR FSD.XTRS(A4) BNE.L SUI_PRT * In a loop: set some fields, append a record. LEA WORK(A6),A1 A1 points to workspace MOVEQ #2,D2 Fields word length MOVEQ #4,D5 Create 5 records APPN_LP * Set some fields MOVE.W D5,(A1) Put D5 into field 1 MOVEQ #1,D1 JSR FSD.PUT(A4) BNE.L SUI_PRT SUBQ.W #8,(A1) Put D5 -8 into field 2 MOVEQ #2,D1 JSR FSD.PUT(A4) BNE.L SUI_PRT * Add a new record to database JSR FSD.APPN(A4) Append record BNE.L SUI_PRT DBRA D5,APPN_LP * Order the database LEA DBORDER(PC),A1 Order table MOVEQ #DBOR.NUM,D1 Number of order parameters JSR FSD.ORDR(A4) Order database BNE.L SUI_PRT * Dump the number of fields. MOVEQ #0,D1 JSR FSD.INFO(A4) Get field quantity MOVE.L D2,D6 MOVE.W D2,D1 MOVE.L WIND(A6),A0 Print no. fields MOVE.W UT.MINT,A2 JSR (A2) BNE.L SUI_PRT LEA MESS3(PC),A1 Print "Fields."&LF MOVE.W UT.MTEXT,A5 JSR (A5) BNE.L SUI_PRT LEA MESS4(PC),A1 Print "Type,length:",LF JSR (A5) BNE.L SUI_PRT * Print the field types, field lengths. MOVE.W UT.MINT,A5 Printing routine for integers MOVEQ #1,D4 Start at field 1 FLOUT_LP MOVE.W D4,D1 MOVE.L DBASE(A6),A0 JSR FSD.INFO(A4) BNE.L SUI_PRT MOVE.W D1,-(SP) Store length SWAP D1 MOVE.L WIND(A6),A0 JSR (A5) Print type (D3=-1 on return) BNE.L SUI_PRT MOVEQ #',',D1 Print comma MOVEQ #IO.SBYTE,D0 TRAP #3 TST.L D0 BNE.L SUI_PRT MOVE.W (SP)+,D1 JSR (A5) Print length BNE.L SUI_PRT MOVEQ #$0A,D1 Print LF MOVEQ #IO.SBYTE,D0 TRAP #3 TST.L D0 BNE.L SUI_PRT * ADDQ.W #1,D4 Do all fields CMP.W D4,D6 BCC.S FLOUT_LP * Print a blank line MOVEQ #$0A,D1 Print LF MOVEQ #IO.SBYTE,D0 TRAP #3 TST.L D0 BNE.L SUI_PRT * Print out order information MOVEQ #0,D1 MOVE.L DBASE(A6),A0 JSR FSD.OINF(A4) Get order field quantity MOVE.L D2,D5 MOVE.W D2,D1 BMI.S NO_ORDER MOVE.L WIND(A6),A0 Print no. fields MOVE.W UT.MINT,A2 JSR (A2) BNE.L SUI_PRT LEA MESS5(PC),A1 Print "Order fields."&LF MOVE.W UT.MTEXT,A5 JSR (A5) BNE.L SUI_PRT LEA MESS6(PC),A1 Print "Field,direction:"&LF JSR (A5) BNE.L SUI_PRT * Print the field numbers, field directions. MOVE.W UT.MINT,A5 Printing routine for integers MOVEQ #1,D4 Start at field 1 OROUT_LP MOVE.W D4,D1 MOVE.L DBASE(A6),A0 JSR FSD.OINF(A4) BNE.L SUI_PRT MOVE.W D1,-(SP) Store direction SWAP D1 MOVE.L WIND(A6),A0 JSR (A5) Print number (D3=-1 on return) BNE.L SUI_PRT MOVEQ #',',D1 Print comma MOVEQ #IO.SBYTE,D0 TRAP #3 TST.L D0 BNE.L SUI_PRT MOVE.W (SP)+,D1 JSR (A5) Print direction BNE.L SUI_PRT MOVEQ #$0A,D1 Print LF MOVEQ #IO.SBYTE,D0 TRAP #3 TST.L D0 BNE.L SUI_PRT * ADDQ.W #1,D4 Do all fields CMP.W D4,D5 BCC.S OROUT_LP * Print a blank line MOVEQ #$0A,D1 Print LF MOVEQ #IO.SBYTE,D0 TRAP #3 TST.L D0 BNE.L SUI_PRT NO_ORDER * Print out number of records MOVE.L D6,D7 SWAP D7 MOVE.W D7,D1 BEQ.S NO_RECS MOVE.L WIND(A6),A0 Print no. fields MOVE.W UT.MINT,A2 JSR (A2) BNE.L SUI_PRT LEA MESS7(PC),A1 Print "Records."&LF MOVE.W UT.MTEXT,A5 JSR (A5) BNE.L SUI_PRT * Print each record MOVE.W UT.MINT,A5 Printing routine for integers MOVEQ #0,D5 Start at Record 1 REOUT_LP MOVE.L DBASE(A6),A0 MOVE.W D5,D1 JSR FSD.POSA(A4) Get record BNE.L SUI_PRT * Print each field MOVE.W #1,D4 Start at field 1 RFOUT_LP MOVE.W D4,D1 Field Number MOVEQ #2,D2 Buffer length MOVE.L DBASE(A6),A0 LEA WORK(A6),A1 Buffer address JSR FSD.GET(A4) Get field BNE.L SUI_PRT MOVE.W WORK(A6),D1 Get contents of buffer MOVE.L WIND(A6),A0 JSR (A5) Print contents (D3=-1 on return) BNE.L SUI_PRT MOVE.W D4,D1 LSL.W #3,D1 D1*8 MOVEQ #SD.TAB,D0 TRAP #3 TST.L D0 BNE.L SUI_PRT ADDQ.W #1,D4 Do all fields CMP.W D4,D6 BCC.S RFOUT_LP * MOVEQ #$0A,D1 Print LF MOVEQ #IO.SBYTE,D0 TRAP #3 TST.L D0 BNE.L SUI_PRT * ADDQ.W #1,D5 Do all records CMP.W D5,D7 BHI.S REOUT_LP NO_RECS BRA.L SUI_QUIT END