Home » Archimedes archive » Acorn User » AU 1998-08.adf » Freeware » PD/Xuen11/!Xuen/Resources/libs/OS

PD/Xuen11/!Xuen/Resources/libs/OS

This website contains an archive of files for the Acorn Electron, BBC Micro, Acorn Archimedes, Commodore 16 and Commodore 64 computers, which Dominic Ford has rescued from his private collection of floppy disks and cassettes.

Some of these files were originally commercial releases in the 1980s and 1990s, but they are now widely available online. I assume that copyright over them is no longer being asserted. If you own the copyright and would like files to be removed, please contact me.

Tape/disk: Home » Archimedes archive » Acorn User » AU 1998-08.adf » Freeware
Filename: PD/Xuen11/!Xuen/Resources/libs/OS
Read OK:
File size: 0869 bytes
Load address: 0000
Exec address: 0000
File contents
   80REM *******************************************************
   90
  100REM function to deal with errors
  110DEFPROCerror(err$)
  120!errorblock%=255
  130$(errorblock%+4)=err$+CHR$0
  160SYS "Wimp_ReportError",errorblock%,1,app$
  180
  190REM Press Break/Pause to Halt program
  191REM For example, if an multiple errors occur
  200IF INKEY-45 THEN STOP
  210ENDPROC
  220
  230
  260REM ************************************************
  270REM Get leaf name of a full path name
  280REM ************************************************
  290DEFFNGetLeafName(ptr%)
  300LOCAL a$,leafptr%,size%
  310REM Determine size of zstring
  320size%=0
  330WHILE ?(ptr%+size%)>31
  340size%+=1
  350ENDWHILE
  360REM Determine offset of leafname
  370leafptr%=size%
  380WHILE (?(ptr%+leafptr%)<>ASC(".")) AND leafptr%>0
  390leafptr%-=1
  400ENDWHILE
  410leafptr%+=1
  420REM Build leafname
  430a$=""
  440WHILE leafptr%<size%
  450a$+=CHR$(?(ptr%+leafptr%))
  460leafptr%+=1
  470ENDWHILE
  480=a$
  490
  500REM *******************************************************
  510
  520DEFPROCensuredir(edir$)
  530LOCAL result%
  540REM Does the directory exist?
  550$string%=edir$+CHR$0
  560SYS"OS_File",17,string% TO result%
  570REM If not, create one.
  580IF (result%=0) THEN OSCLI("CDIR "+edir$+CHR$0)
  590SYS"OS_File",17,string% TO result%
  600REM Has it created it? If not, error.
  610IF (result%=0) THEN
  620PROCerror("Fatal : Couldn't create "+edir$+CHR$0)
  630REM =0
  640ENDIF
  650REM=1
  660ENDPROC
  670
  680REM *******************************************************
  690
  700REM Extract the wstring stored at addr%.
  710DEF FNgetname(addr%)
  720LOCAL b$
  730WHILE ?addr%>31
  740b$+=CHR$(?addr%)
  750addr%+=1
  760ENDWHILE
  770=b$
  780
  790REM *******************************************************
  800
  810DEFFNstring(sptr%)
  820LOCAL a$
  830WHILE ?sptr%<>0 AND LEN(a$)<254
  840a$+=CHR$(?sptr%):sptr%+=1
  850ENDWHILE
  860=a$
  870
  880DEFFNget_line(filehandle%)
  890LOCAL a$,z%
  900z%=0
  910a$=""
  920REPEAT
  930IF (NOT(EOF#filehandle%)) THEN z%=BGET#filehandle%
  940IF z%>=32 a$+=CHR$(z%)
  950UNTIL z%<32 OR EOF#filehandle%
  960=a$+CHR$0
  970
  980DEFPROCput_line(filehandle%, A$)
  990LOCAL a$,z%
 1000z%=1
 1010FORz%=1TO LEN(A$)
 1020a$=MID$(A$,z%,1)
 1030IF (ASC(a$)>0) THEN BPUT#filehandle%, ASC(a$)
 1040NEXT
 1050BPUT#filehandle%, 10
 1060ENDPROC
 1070
 1080REM ***************************************************
 1090
 1091
 1092DEFPROCexecute_string(str_ptr%)
 1093A$=FNstring(str_ptr%)
 1094IF A$<>"" THEN OSCLI(A$)
 1095ENDPROC
 1096
 1097
 1098REM ***************************************************
P=� *******************************************************
Z
d"� function to deal with errors
n��error(err$)
x!errorblock%=255
�$(errorblock%+4)=err$+�0
�,ș "Wimp_ReportError",errorblock%,1,app$
�
�'� Press Break/Pause to Halt program
�.� For example, if an multiple errors occur
�� �-45 � �
��
�
�
6� ************************************************
'� Get leaf name of a full path name
6� ************************************************
"ݤGetLeafName(ptr%)
,� a$,leafptr%,size%
6� Determine size of zstring
@size%=0
Jȕ ?(ptr%+size%)>31
Tsize%+=1
^�
h"� Determine offset of leafname
rleafptr%=size%
|.ȕ (?(ptr%+leafptr%)<>�(".")) � leafptr%>0
�leafptr%-=1
��
�leafptr%+=1
�� Build leafname
�	a$=""
�ȕ leafptr%<size%
�a$+=�(?(ptr%+leafptr%))
�leafptr%+=1
��
�=a$
�
�=� *******************************************************
�
��ensuredir(edir$)

� result%
� Does the directory exist?
&$string%=edir$+�0
0$ș"OS_File",17,string% � result%
:� If not, create one.
D'� (result%=0) � �("CDIR "+edir$+�0)
N$ș"OS_File",17,string% � result%
X'� Has it created it? If not, error.
b� (result%=0) �
l/�error("Fatal : Couldn't create "+edir$+�0)
v� =0
��
��=1
��
�
�=� *******************************************************
�
�*� Extract the wstring stored at addr%.
�� �getname(addr%)
�� b$
�ȕ ?addr%>31
�b$+=�(?addr%)
�addr%+=1
��
=b$

=� *******************************************************
 
*ݤstring(sptr%)
4� a$
>ȕ ?sptr%<>0 � �(a$)<254
Ha$+=�(?sptr%):sptr%+=1
R�
\=a$
f
pݤget_line(filehandle%)
z� a$,z%
�z%=0
�	a$=""
��
�+� (�(�#filehandle%)) � z%=�#filehandle%
�� z%>=32 a$+=�(z%)
�� z%<32 � �#filehandle%
�
=a$+�0
�
���put_line(filehandle%, A$)
�� a$,z%
�z%=1
��z%=1� �(A$)
�a$=�A$,z%,1)
&� (�(a$)>0) � �#filehandle%, �(a$)
�
�#filehandle%, 10
$�
.
89� ***************************************************
B
C
D��execute_string(str_ptr%)
EA$=�string(str_ptr%)
F� A$<>"" � �(A$)
G�
H
I
J9� ***************************************************
�
00000000  0d 00 50 3d f4 20 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |..P=. **********|
00000010  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |****************|
*
00000030  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 2a 2a 0d 00 5a  |*************..Z|
00000040  04 0d 00 64 22 f4 20 66  75 6e 63 74 69 6f 6e 20  |...d". function |
00000050  74 6f 20 64 65 61 6c 20  77 69 74 68 20 65 72 72  |to deal with err|
00000060  6f 72 73 0d 00 6e 11 dd  f2 65 72 72 6f 72 28 65  |ors..n...error(e|
00000070  72 72 24 29 0d 00 78 14  21 65 72 72 6f 72 62 6c  |rr$)..x.!errorbl|
00000080  6f 63 6b 25 3d 32 35 35  0d 00 82 1c 24 28 65 72  |ock%=255....$(er|
00000090  72 6f 72 62 6c 6f 63 6b  25 2b 34 29 3d 65 72 72  |rorblock%+4)=err|
000000a0  24 2b bd 30 0d 00 a0 2c  c8 99 20 22 57 69 6d 70  |$+.0...,.. "Wimp|
000000b0  5f 52 65 70 6f 72 74 45  72 72 6f 72 22 2c 65 72  |_ReportError",er|
000000c0  72 6f 72 62 6c 6f 63 6b  25 2c 31 2c 61 70 70 24  |rorblock%,1,app$|
000000d0  0d 00 b4 04 0d 00 be 27  f4 20 50 72 65 73 73 20  |.......'. Press |
000000e0  42 72 65 61 6b 2f 50 61  75 73 65 20 74 6f 20 48  |Break/Pause to H|
000000f0  61 6c 74 20 70 72 6f 67  72 61 6d 0d 00 bf 2e f4  |alt program.....|
00000100  20 46 6f 72 20 65 78 61  6d 70 6c 65 2c 20 69 66  | For example, if|
00000110  20 61 6e 20 6d 75 6c 74  69 70 6c 65 20 65 72 72  | an multiple err|
00000120  6f 72 73 20 6f 63 63 75  72 0d 00 c8 0e e7 20 a6  |ors occur..... .|
00000130  2d 34 35 20 8c 20 fa 0d  00 d2 05 e1 0d 00 dc 04  |-45 . ..........|
00000140  0d 00 e6 04 0d 01 04 36  f4 20 2a 2a 2a 2a 2a 2a  |.......6. ******|
00000150  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |****************|
*
00000170  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 0d 01 0e 27 f4 20  |**********...'. |
00000180  47 65 74 20 6c 65 61 66  20 6e 61 6d 65 20 6f 66  |Get leaf name of|
00000190  20 61 20 66 75 6c 6c 20  70 61 74 68 20 6e 61 6d  | a full path nam|
000001a0  65 0d 01 18 36 f4 20 2a  2a 2a 2a 2a 2a 2a 2a 2a  |e...6. *********|
000001b0  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |****************|
*
000001d0  2a 2a 2a 2a 2a 2a 2a 0d  01 22 17 dd a4 47 65 74  |*******.."...Get|
000001e0  4c 65 61 66 4e 61 6d 65  28 70 74 72 25 29 0d 01  |LeafName(ptr%)..|
000001f0  2c 17 ea 20 61 24 2c 6c  65 61 66 70 74 72 25 2c  |,.. a$,leafptr%,|
00000200  73 69 7a 65 25 0d 01 36  1f f4 20 44 65 74 65 72  |size%..6.. Deter|
00000210  6d 69 6e 65 20 73 69 7a  65 20 6f 66 20 7a 73 74  |mine size of zst|
00000220  72 69 6e 67 0d 01 40 0b  73 69 7a 65 25 3d 30 0d  |ring..@.size%=0.|
00000230  01 4a 17 c8 95 20 3f 28  70 74 72 25 2b 73 69 7a  |.J... ?(ptr%+siz|
00000240  65 25 29 3e 33 31 0d 01  54 0c 73 69 7a 65 25 2b  |e%)>31..T.size%+|
00000250  3d 31 0d 01 5e 05 ce 0d  01 68 22 f4 20 44 65 74  |=1..^....h". Det|
00000260  65 72 6d 69 6e 65 20 6f  66 66 73 65 74 20 6f 66  |ermine offset of|
00000270  20 6c 65 61 66 6e 61 6d  65 0d 01 72 12 6c 65 61  | leafname..r.lea|
00000280  66 70 74 72 25 3d 73 69  7a 65 25 0d 01 7c 2e c8  |fptr%=size%..|..|
00000290  95 20 28 3f 28 70 74 72  25 2b 6c 65 61 66 70 74  |. (?(ptr%+leafpt|
000002a0  72 25 29 3c 3e 97 28 22  2e 22 29 29 20 80 20 6c  |r%)<>.(".")) . l|
000002b0  65 61 66 70 74 72 25 3e  30 0d 01 86 0f 6c 65 61  |eafptr%>0....lea|
000002c0  66 70 74 72 25 2d 3d 31  0d 01 90 05 ce 0d 01 9a  |fptr%-=1........|
000002d0  0f 6c 65 61 66 70 74 72  25 2b 3d 31 0d 01 a4 14  |.leafptr%+=1....|
000002e0  f4 20 42 75 69 6c 64 20  6c 65 61 66 6e 61 6d 65  |. Build leafname|
000002f0  0d 01 ae 09 61 24 3d 22  22 0d 01 b8 15 c8 95 20  |....a$=""...... |
00000300  6c 65 61 66 70 74 72 25  3c 73 69 7a 65 25 0d 01  |leafptr%<size%..|
00000310  c2 1b 61 24 2b 3d bd 28  3f 28 70 74 72 25 2b 6c  |..a$+=.(?(ptr%+l|
00000320  65 61 66 70 74 72 25 29  29 0d 01 cc 0f 6c 65 61  |eafptr%))....lea|
00000330  66 70 74 72 25 2b 3d 31  0d 01 d6 05 ce 0d 01 e0  |fptr%+=1........|
00000340  07 3d 61 24 0d 01 ea 04  0d 01 f4 3d f4 20 2a 2a  |.=a$.......=. **|
00000350  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |****************|
*
00000380  2a 2a 2a 2a 2a 0d 01 fe  04 0d 02 08 16 dd f2 65  |*****..........e|
00000390  6e 73 75 72 65 64 69 72  28 65 64 69 72 24 29 0d  |nsuredir(edir$).|
000003a0  02 12 0d ea 20 72 65 73  75 6c 74 25 0d 02 1c 1f  |.... result%....|
000003b0  f4 20 44 6f 65 73 20 74  68 65 20 64 69 72 65 63  |. Does the direc|
000003c0  74 6f 72 79 20 65 78 69  73 74 3f 0d 02 26 15 24  |tory exist?..&.$|
000003d0  73 74 72 69 6e 67 25 3d  65 64 69 72 24 2b bd 30  |string%=edir$+.0|
000003e0  0d 02 30 24 c8 99 22 4f  53 5f 46 69 6c 65 22 2c  |..0$.."OS_File",|
000003f0  31 37 2c 73 74 72 69 6e  67 25 20 b8 20 72 65 73  |17,string% . res|
00000400  75 6c 74 25 0d 02 3a 19  f4 20 49 66 20 6e 6f 74  |ult%..:.. If not|
00000410  2c 20 63 72 65 61 74 65  20 6f 6e 65 2e 0d 02 44  |, create one...D|
00000420  27 e7 20 28 72 65 73 75  6c 74 25 3d 30 29 20 8c  |'. (result%=0) .|
00000430  20 ff 28 22 43 44 49 52  20 22 2b 65 64 69 72 24  | .("CDIR "+edir$|
00000440  2b bd 30 29 0d 02 4e 24  c8 99 22 4f 53 5f 46 69  |+.0)..N$.."OS_Fi|
00000450  6c 65 22 2c 31 37 2c 73  74 72 69 6e 67 25 20 b8  |le",17,string% .|
00000460  20 72 65 73 75 6c 74 25  0d 02 58 27 f4 20 48 61  | result%..X'. Ha|
00000470  73 20 69 74 20 63 72 65  61 74 65 64 20 69 74 3f  |s it created it?|
00000480  20 49 66 20 6e 6f 74 2c  20 65 72 72 6f 72 2e 0d  | If not, error..|
00000490  02 62 13 e7 20 28 72 65  73 75 6c 74 25 3d 30 29  |.b.. (result%=0)|
000004a0  20 8c 0d 02 6c 2f f2 65  72 72 6f 72 28 22 46 61  | ...l/.error("Fa|
000004b0  74 61 6c 20 3a 20 43 6f  75 6c 64 6e 27 74 20 63  |tal : Couldn't c|
000004c0  72 65 61 74 65 20 22 2b  65 64 69 72 24 2b bd 30  |reate "+edir$+.0|
000004d0  29 0d 02 76 08 f4 20 3d  30 0d 02 80 05 cd 0d 02  |)..v.. =0.......|
000004e0  8a 07 f4 3d 31 0d 02 94  05 e1 0d 02 9e 04 0d 02  |...=1...........|
000004f0  a8 3d f4 20 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |.=. ************|
00000500  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |****************|
*
00000520  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 0d 02 b2 04 0d  |***********.....|
00000530  02 bc 2a f4 20 45 78 74  72 61 63 74 20 74 68 65  |..*. Extract the|
00000540  20 77 73 74 72 69 6e 67  20 73 74 6f 72 65 64 20  | wstring stored |
00000550  61 74 20 61 64 64 72 25  2e 0d 02 c6 15 dd 20 a4  |at addr%...... .|
00000560  67 65 74 6e 61 6d 65 28  61 64 64 72 25 29 0d 02  |getname(addr%)..|
00000570  d0 08 ea 20 62 24 0d 02  da 10 c8 95 20 3f 61 64  |... b$...... ?ad|
00000580  64 72 25 3e 33 31 0d 02  e4 11 62 24 2b 3d bd 28  |dr%>31....b$+=.(|
00000590  3f 61 64 64 72 25 29 0d  02 ee 0c 61 64 64 72 25  |?addr%)....addr%|
000005a0  2b 3d 31 0d 02 f8 05 ce  0d 03 02 07 3d 62 24 0d  |+=1.........=b$.|
000005b0  03 0c 04 0d 03 16 3d f4  20 2a 2a 2a 2a 2a 2a 2a  |......=. *******|
000005c0  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |****************|
*
000005f0  0d 03 20 04 0d 03 2a 13  dd a4 73 74 72 69 6e 67  |.. ...*...string|
00000600  28 73 70 74 72 25 29 0d  03 34 08 ea 20 61 24 0d  |(sptr%)..4.. a$.|
00000610  03 3e 1c c8 95 20 3f 73  70 74 72 25 3c 3e 30 20  |.>... ?sptr%<>0 |
00000620  80 20 a9 28 61 24 29 3c  32 35 34 0d 03 48 1a 61  |. .(a$)<254..H.a|
00000630  24 2b 3d bd 28 3f 73 70  74 72 25 29 3a 73 70 74  |$+=.(?sptr%):spt|
00000640  72 25 2b 3d 31 0d 03 52  05 ce 0d 03 5c 07 3d 61  |r%+=1..R....\.=a|
00000650  24 0d 03 66 04 0d 03 70  1b dd a4 67 65 74 5f 6c  |$..f...p...get_l|
00000660  69 6e 65 28 66 69 6c 65  68 61 6e 64 6c 65 25 29  |ine(filehandle%)|
00000670  0d 03 7a 0b ea 20 61 24  2c 7a 25 0d 03 84 08 7a  |..z.. a$,z%....z|
00000680  25 3d 30 0d 03 8e 09 61  24 3d 22 22 0d 03 98 05  |%=0....a$=""....|
00000690  f5 0d 03 a2 2b e7 20 28  ac 28 c5 23 66 69 6c 65  |....+. (.(.#file|
000006a0  68 61 6e 64 6c 65 25 29  29 20 8c 20 7a 25 3d 9a  |handle%)) . z%=.|
000006b0  23 66 69 6c 65 68 61 6e  64 6c 65 25 0d 03 ac 16  |#filehandle%....|
000006c0  e7 20 7a 25 3e 3d 33 32  20 61 24 2b 3d bd 28 7a  |. z%>=32 a$+=.(z|
000006d0  25 29 0d 03 b6 1b fd 20  7a 25 3c 33 32 20 84 20  |%)..... z%<32 . |
000006e0  c5 23 66 69 6c 65 68 61  6e 64 6c 65 25 0d 03 c0  |.#filehandle%...|
000006f0  0a 3d 61 24 2b bd 30 0d  03 ca 04 0d 03 d4 1f dd  |.=a$+.0.........|
00000700  f2 70 75 74 5f 6c 69 6e  65 28 66 69 6c 65 68 61  |.put_line(fileha|
00000710  6e 64 6c 65 25 2c 20 41  24 29 0d 03 de 0b ea 20  |ndle%, A$)..... |
00000720  61 24 2c 7a 25 0d 03 e8  08 7a 25 3d 31 0d 03 f2  |a$,z%....z%=1...|
00000730  10 e3 7a 25 3d 31 b8 20  a9 28 41 24 29 0d 03 fc  |..z%=1. .(A$)...|
00000740  10 61 24 3d c1 41 24 2c  7a 25 2c 31 29 0d 04 06  |.a$=.A$,z%,1)...|
00000750  26 e7 20 28 97 28 61 24  29 3e 30 29 20 8c 20 d5  |&. (.(a$)>0) . .|
00000760  23 66 69 6c 65 68 61 6e  64 6c 65 25 2c 20 97 28  |#filehandle%, .(|
00000770  61 24 29 0d 04 10 05 ed  0d 04 1a 15 d5 23 66 69  |a$)..........#fi|
00000780  6c 65 68 61 6e 64 6c 65  25 2c 20 31 30 0d 04 24  |lehandle%, 10..$|
00000790  05 e1 0d 04 2e 04 0d 04  38 39 f4 20 2a 2a 2a 2a  |........89. ****|
000007a0  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |****************|
*
000007c0  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 0d  |***************.|
000007d0  04 42 04 0d 04 43 04 0d  04 44 1e dd f2 65 78 65  |.B...C...D...exe|
000007e0  63 75 74 65 5f 73 74 72  69 6e 67 28 73 74 72 5f  |cute_string(str_|
000007f0  70 74 72 25 29 0d 04 45  18 41 24 3d a4 73 74 72  |ptr%)..E.A$=.str|
00000800  69 6e 67 28 73 74 72 5f  70 74 72 25 29 0d 04 46  |ing(str_ptr%)..F|
00000810  14 e7 20 41 24 3c 3e 22  22 20 8c 20 ff 28 41 24  |.. A$<>"" . .(A$|
00000820  29 0d 04 47 05 e1 0d 04  48 04 0d 04 49 04 0d 04  |)..G....H...I...|
00000830  4a 39 f4 20 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |J9. ************|
00000840  2a 2a 2a 2a 2a 2a 2a 2a  2a 2a 2a 2a 2a 2a 2a 2a  |****************|
*
00000860  2a 2a 2a 2a 2a 2a 2a 0d  ff                       |*******..|
00000869