We present here a short example program in BASIC. The error handler copes with pre-emption, responding to RC_QUIT by calling BASIC's own error handler. This will not close files, filters wildcards, or memory however, so if you use these features you must modify the error handler to close these things first before calling BASIC. The program here does something which BASIC cannot normally do, which is to read the update date of a file. When the program is run it assembles the code and asks for a filename. It attempts to open the file for DOR access, indicating failure with a system error box, and then reads the update date. Finally, having released the DOR handle, the program displays the explicit filename, expanded by GN_Opf, and the update date.
This listing can be 'loaded' by CLI. Mark a block for the program only in column A below, and save it as a text file. Then execute eg. from the FILER popdown.
1000 DIM code 512 \ space for program 1010 REM 1020 GN_Esp=&4C09 \ return pointer to system error message 1040 GN_Nln=&2E09 \ carriage return, linefeed to std. output 1050 GN_Sop=&3A09 \ output string to std. output 1060 GN_Opf=&6009 \ open file 1070 OS_Erh=&75 \ install error handler 1080 OS_Esc=&6F \ examine special condition 1090 GN_Err=&4A09 \ standard system error box 1100 GN_Sdo=&0E09 \ date and time to standard output 1110 OS_Dor=&87 \ DOR interface 1120 dr_rd=&09 \ read DOR record 1130 dr_fre=&05 \ free DOR handle 1140 op_dor=&06 \ open file for DOR access 1150 rc_quit=&67 \ KILL request error code 1160 rc_esc=&01 \ escape detection error code 1170 1180 FOR pass=0 TO 2 STEP 2 1190 P%=code 1200 [ 1210 OPT pass 1220 LD HL,0 1230 ADD HL,SP \ get stack pointer 1240 LD (bstk),HL \ save current BASIC stack pointer 1250 LD SP,(&1FFE) \ install safe stack pointer 1260 1270 XOR A 1280 LD B,A 1290 LD HL,errhan \ address of error handler 1300 OPT FNsys(OS_Erh) \ install new error handler 1310 LD (obou),A \ save old error handler call level 1320 LD (oerr),HL \ save old error handler address 1330 CALL main \ call main routine 1340 .exit 1350 LD HL,(oerr) \ address of old error handler 1360 LD A,(obou) \ old call level 1370 LD B,0 1380 OPT FNsys(OS_Erh) \ restore old error handler 1390 LD SP,(bstk) \ install BASIC stack pointer 1400 RET \ return to BBC BASIC interpreter 1410 1420 .errhan 1430 RET Z 1440 CP rc_esc \ ESC pressed? 1450 JR NZ,err1 1460 OPT FNsys(OS_Esc) \ acknowledge ESC 1470 LD A,rc_esc 1480 OR A \ return rc_esc back to main program 1490 RET \ Fc = 0, Fz = 0 1500 .err1 1510 CP rc_quit \ KILL request? 1520 JR NZ,err2 1530 LD HL,(oerr) \ re-install old error handler 1540 LD A,(obou) \ old call level 1550 OPT FNsys(OS_Erh) 1560 LD SP,(bstk) \ install BASIC stack pointer 1570 LD HL,(oerr) 1580 LD A, rc_quit \ reload A with RC_QUIT 1590 OR A \ Fz = 0 1400 SCF \ Fc = 1 1410 JP (HL) \ jump to BASIC's error handler 1420 1430 .err2 \ write error message if possible 1440 OR A \ Fc = 0 1450 RET 1460 1470 .bstk DEFW 0 \ storage for BASIC stack pointer 1480 .obou DEFB 0 \ storage for old call level 1490 .oerr DEFW 0 \ storage for old error handler address 1500 1510 \ main routine starts here 1520 .main 1530 LD HL,scratch_1 \ holds address of file to open 1540 LD DE,scratch_2 \ explicit name buffer 1550 LD C,40 \ size of explicit name buffer 1560 LD B,0 \ HL string pointer is local 1570 LD a, op_dor \ get DOR handle 1580 OPT FNsys(GN_Opf) \ open... 1590 JR NC,opened_OK 1600 OPT FNsys(GN_Err) \ report error in standard window 1610 RET 1620 .opened_OK 1630 LD A,dr_rd \ read DOR record 1640 LD B,ASC"U" \ read update information 1650 LD C,6 \ 3 byte internal date, 3 byte int. time 1660 LD DE,scratch_1 \ store returned information at (DE) 1670 OPT FNsys(OS_Dor) \ fetch update date 1680 LD A,dr_fre 1690 OPT FNsys(OS_Dor) \ free DOR handle 1700 LD HL,scratch_2 \ display explicit filename 1710 OPT FNsys(GN_Sop) \ to standard output 1720 LD HL,tab_str 1730 OPT FNsys(GN_Sop) \ tab to column 40 1740 LD HL,scratch_1 1750 OPT FNsys(GN_Sdo) \ output returned update date 1760 OPT FNsys(GN_Nln) \ display newline 1770 RET \ back to BASIC 1780 1790 .scratch_1 DEFM STRING$(40,"X") 1800 .scratch_2 DEFM STRING$(40,"X") 1810 .tab_str DEFM CHR$1+"2X"+CHR$(32+40)+CHR$0 1820 ] 1830 NEXT pass 1840 1850 CLS 1860 PRINT "Read File Update Date and Time" 1870 INPUT "Filename:"A$ 1880 IF LEN(a$)>40 THEN PRINT "String too long": END 1890 A$=A$+CHR$0 \ null-terminate filename string 1900 $scratch_1=A$ 1910 CALL code 1920 END 1930 DEF FNsys(arg) 1940 IF arg>255 THEN [OPT pass: RST &20: DEFW arg] :=pass 1950 [OPT pass: RST &20: DEFB arg] :=pass