...
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.
| Code Block | ||
|---|---|---|
| ||
1000.J AUTO DIM code 512 \ space for program 1010 REM 1020 512 : REM space for program GN_Esp=&4C09 \4C09 : REM return pointer to system error message 1040 GN_Soe=&3C09 : REM Write string at extended address to standard output GN_Nln=&2E09 \2E09 : REM carriage return, linefeed to std. output 1050 GN_Sop=&3A09 \3A09 : REM output string to std. output 1060 GN_Opf=&6009 \6009 : REM open file 1070 OS_Erh=&75 \75 : REM install error handler 1080 OS_Esc=&6F \6F : REM examine special condition 1090 GN_Err=&4A09 \4A09 : REM standard system error box 1100 GN_Sdo=&0E09 \0E09 : REM date and time to standard output 1110 OS_Dor=&87 \87 : REM DOR interface 1120 dr_rd=&09 \09 : REM read DOR record 1130 dr_fre=&05 \05 : REM free DOR handle 1140 op_dor=&06 \06 : REM open file for DOR access 1150 rc_quit=&67 \67 : REM KILL request error code 1160 rc_esc=&01 \01 : REM escape detection error code 1170 1180 FOR pass=0 TO 2 STEP 2 1190 P%=code 1200 [ 1210 OPT pass 1220pass LD HL,0 0 1230ADD ADD HL,SP SP \ get current BASIC stack pointer LD 1240 LD (bstk),HL \ save current BASIC stack pointer 1250 LD HL \ preserve it LD SP,(&1FFE) \ install system (safe) stack pointer pointer 1260 XOR 1270 XORA A LD 1280 LD B,A A LD 1290 LD HL,errhan errhan \ address of error handler 1300OPT OPT FNsys(OS_Erh) \ install new error handler LD 1310 LD (obou),A A \ save old error handler call level 1320LD LD (oerr),HL HL \ save old error handler address 1330 CALL main \ Here is the call to your assembler language routine which should be \ included at the end of this code. CALL main \ call main routine 1340 .exit exit LD 1350 LD HL,(oerr) \ address of old error handler LD 1360 LD A,(obou) \ old call level LD 1370 LD B,0 0 1380OPT OPT FNsys(OS_Erh) \ restore oldprevious error handler LD 1390 LD SP,(bstk) \ installrestore BASIC stack pointer 1400 RET RET \ return to BBC BASIC interpreter 1410 1420 .errhan errhan 1430RET RET Z Z CP 1440 CP rc_esc esc \ ESC pressed? 1450JR JR NZ,err1 err1 1460OPT OPT FNsys(OS_Esc) \ acknowledge ESC LD 1470 LD A,rc_esc esc OR A 1480 OR A \ return rc_esc back to main program 1490 RET RET \ Fc = 0, Fz = 0 1500 .err1 err1 CP 1510 CP rc_quit quit \ KILL request? JR 1520 JR NZ,err2 err2 LD 1530 LD HL,(oerr) \ re-install old error handler LD 1540 LD A,(obou) \ old call level 1550OPT OPT FNsys(OS_Erh) LD 1560 LD SP,(bstk) \ install BASIC stack pointer LD 1570 LD HL,(oerr) LD 1580 LD A, rc_quit quit \ reload A with RC_QUIT 1590 OR A OR A \ Fz = 0 1400 SCF SCF \ Fc = 1 JP 1410 JP (HL) \ jump to BASIC's error handler 1420 1430 .err2 .err2 \ write error message if possible 1440 OR A OPT FNsys(GN_Esp) \ Get ext. pointer to system error message OPT FNsys(GN_Soe) \ Write error message to std. output OPT FNsys(GN_Nln) \ New line to std. output OR A \ Fc = 0 1450 RET 1460 1470 .bstk DEFW 0 0 \ storage for BASIC stack pointer 1480 .obou DEFB 0 0 \ storage for old call level 1490 .oerr DEFW 0 0 \ storage for old error handler address 1500 1510\ ---------------------------------------------------------------------- \ main routine starts here .main 1520LD .main 1530 LD HL,scratch_1 1 \ holds address of file to open LD 1540 LD DE,scratch_2 2 \ explicit name buffer LD 1550 LD C,40 40 \ size of explicit name buffer LD 1560 LD B,0 0 \ HL string pointer is local 1570LD LD a, op_dor dor \ get DOR handle 1580OPT OPT FNsys(GN_Opf) \ open... 1590JR JR NC,opened_OK 1600OPT OPT FNsys(GN_Err) \ report error in standard window 1610window RET 1620 .opened_OK OK LD 1630 LD A,dr_rd rd \ read DOR record LD 1640 LD B,ASC"U" \ read update information 1650LD LD C,6 6 \ 3 byte internal date, 3 byte int. time LD 1660 LD DE,scratch_1 1 \ store returned information at (DE) 1670OPT OPT FNsys(OS_Dor) \ fetch update date date LD 1680 LD A,dr_fre fre 1690OPT OPT FNsys(OS_Dor) \ free DOR handle 1700LD LD HL,scratch_2 2 \ display explicit filename 1710OPT OPT FNsys(GN_Sop) \ to standard output output LD 1720 LD HL,tab_str str 1730OPT OPT FNsys(GN_Sop) \ tab to column 40 40 LD 1740 LD HL,scratch_1 1 1750OPT OPT FNsys(GN_Sdo) \ output returned update date 1760OPT OPT FNsys(GN_Nln) \ display newline 1770 RET RET \ back to BASIC 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 1860CHR$0 \ main routine ends here \ ---------------------------------------------------------------------- ] NEXT pass CLS PRINT "Read File Update Date and Time" 1870 INPUT "Filename:"A$ 1880A$ IF LEN(a$A$)>40 THEN PRINT "String too long": END END 1890 A$=A$+CHR$0 \CHR$0 : REM null-terminate filename string 1900 $scratch_1=A$ A$ 1910 CALL code code 1920END END : 1930 DEF FNsys(arg) 1940 IF arg>255 THEN PROC_Rst20Defw(arg) ELSE PROC_Rst20Defb(arg) =pass : DEF PROC_Rst20Defw(arg) [OPT pass: RST &20: DEFW arg ] ENDPROC :=pass 1950DEF PROC_Rst20Defb(arg) [OPT pass: RST &20: DEFB arg ] :=passENDPROC |