...
| Code Block | ||
|---|---|---|
| ||
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 |
...