|
DataMuseum.dkPresents historical artifacts from the history of: Bogika Butler |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Bogika Butler Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - download
Length: 8576 (0x2180)
Types: TextFile
Names: »ACSUB.PRN«
└─⟦cac67a5ae⟧ Bits:30009789/_.ft.Ibm2.50007338.imd Mogens Pelles Zilog 80,000 / EOS projekt
└─⟦this⟧ »ACSUB.PRN«
Pro Pascal Compiler - Version zz 2.1
Compilation of: ACSUB.PAS
Options: LNIAG
1 0000 program sub;
2 0000
3 0000 label 9999;
4 0000
5 0000 const maxAddr = 0EFFFH;
6 0000
7 0000 var command : string(.128.);
8 0000 inFile : text;
9 0000 line : string(.255.);
10 0000
11 0000 maxLength : integer;
12 0000 submitLength : integer;
13 0000
14 0000 param : array(.0..9.) of string(.128.);
15 0000 nextParam : 0..10;
16 0000 paramNo : 1..9;
17 0000
18 0000 BIOS, routineAddr, CONINaddr, CONSTaddr,
19 0000 CATCHaddr, NOTITaddr,
20 0000 CNTvar, ADDRvar, target : integer;
21 0000
22 0000 i, j : integer;
23 0000
24 0000
25 0000 procedure put(byte : integer);
26 0000 begin
27 0000 poke(target, byte);
28 001D target := target+1;
29 002F end;
30 0035
31 0035
32 0035 procedure put2(word : integer);
33 0035 begin
34 0035 put(word mod 256);
35 0056 put(word div 256);
36 006F end;
37 0075
38 0075
39 0075 procedure putSub(ch : char);
40 0075 begin
41 0075 if submitLength = maxLength then begin
42 0093 writeln('Filen er for lang'); goto 9999;
43 00C7 end;
44 00C7 submitLength := submitLength+1;
45 00D9 put(ord(ch));
46 00EA end;
47 00F0
48 00F0
49 00F0 begin
50 00F0 (* Edit the input file name : *)
51 00F0 getcomm(command);
52 0108 command := concat(command, ' ');
53 0122 nextParam := 0;
54 012C while pos(' ', command) = 1 do
55 014B delete(command, 1, 1);
56 015F while command <> '' do begin
57 0173 if nextParam = 10 then begin
58 017F writeln('For mange parametre'); goto 9999;
59 01AD end;
60 01AD i := 1;
61 01BD while command(.i.) <> ' ' do i := i+1;
62 01EC param(.nextParam.) := copy(command, 1, i-1);
63 0225 nextParam := nextParam+1;
64 023B delete(command, 1, i-1);
65 0254 while pos(' ', command) = 1 do
66 0273 delete(command, 1, 1);
67 0287 end; (* while command <> '' *)
68 028A if nextParam = 0 then begin
69 0295 writeln('Kald : sub <filnavn> <parameter>...');
70 02D0 goto 9999;
71 02D8 end;
72 02D8 if pos('.', param(.0.)) = 0 then
73 02F0 insert('.SUB', param(.0.), length(param(.0.))+1);
74 0313
75 0313 (* Open the input file : *)
76 0313 if not fstat(param(.0.)) then begin
77 0326 writeln('Filen kan ikke åbnes : ', param(.0.));
78 0361 goto 9999;
79 0369 end;
80 0369 assign(inFile, param(.0.)); reset(inFile);
81 038A
82 038A (* Make the various routines and see how much
83 038A space is left for the submit-string : *)
84 038A BIOS := peek(6)+peek(7)*256 (* addr. of BDOS entry pt. *)
85 03A7 + 3578; (* addr. of BIOS jump table *)
86 03C5 CNTvar := maxAddr-1; (* addr. of variable CNT *)
87 03D5 ADDRvar := CNTvar-2; (* addr. of variable ADDR *)
88 03EA routineAddr := ADDRvar-56; (* addr. of first routine *)
89 03FF
90 03FF target := routineAddr;
91 0409
92 0409 NOTITaddr := target;
93 0413 put(0EDH); put(057H); (* LD A,I *)
94 042E put(0F3H); (* DI *)
95 043E put(0C3H); put2(0F023H); (* JP 0F023H *)
96 0459
97 0459 CONINaddr := target;
98 0468 put(02AH); put2(CNTvar); (* LD HL,(CNT) *)
99 0482 put(07CH); (* LD A,H *)
100 0492 put(0B5H); (* OR L *)
101 04A2 put(0CAH); put2(NOTITaddr); (* JP Z,NOTIT *)
102 04BC put(02BH); (* DEC HL *)
103 04CC put(022H); put2(CNTvar); (* LD (CNT), HL *)
104 04E6 put(02AH); put2(ADDRvar); (* LD HL,(ADDR) *)
105 0500 put(07EH); (* LD A,(HL) *)
106 0510 put(023H); (* INC HL *)
107 0520 put(022H); put2(ADDRvar); (* LD (ADDR),HL *)
108 053A put(0E1H); (* POP HL *)
109 054A put(0C9H); (* RET *)
110 055A
111 055A CONSTaddr := target;
112 0569 put(02AH); put2(CNTvar); (* LD HL,(CNT) *)
113 0583 put(07CH); (* LD A,H *)
114 0593 put(0B5H); (* OR L *)
115 05A3 put(0CAH); put2(NOTITaddr); (* JP Z,NOTIT *)
116 05BD put(03EH); put(0FFH); (* LD A,0FFH *)
117 05D8 put(0E1H); (* POP HL *)
118 05E8 put(0C9H); (* RET *)
119 05F8
120 05F8 CATCHaddr := target;
121 0607 put(0E1H); (* POP HL *)
122 0617 put(0E5H); (* PUSH HL *)
123 0627 put(07DH); (* LD A,L *)
124 0637 put(0FEH); put(009H); (* CP 09H *)
125 0652 put(0CAH); put2(CONSTaddr); (* JP Z,CONST *)
126 066C put(0FEH); put(00CH); (* CP 0CH *)
127 0687 put(0CAH); put2(CONINaddr); (* JP Z,CONIN *)
128 06A1 put(0C3H); put2(NOTITaddr); (* JP NOTIT *)
129 06BB
130 06BB target := CNTvar; put2(0); (* Just for the moment *)
131 06D5 target := ADDRvar; put2(BIOS+51);
132 06F9 target := 0F020H;
133 0709 put(0C3H); put2(CATCHaddr); (* JP CATCH *)
134 0723
135 0723 maxLength := routineAddr - (BIOS+51);
136 0747 (* Amount of free space from BIOS jump table to the
137 0747 start of the routines above. Equals the max.
138 0747 submit string length. *)
139 0747
140 0747 (* Read from the input file to 'submitString' : *)
141 0747 target := BIOS+51;
142 0761 submitLength := 0;
143 0771 while not eof(inFile) do begin
144 0783 readln(inFile, line);
145 079F i := 1;
146 07AF while i <= length(line) do begin
147 07C9 if line(.i.) = '$' then begin
148 07EA if i = length(line) then begin
149 0803 writeln('Fejl : $ fundet til sidst i en linie');
150 083F goto 9999;
151 0847 end;
152 0847 i := i+1;
153 0859 if line(.i.) = '$' then
154 0874 putSub('$')
155 087C else
156 0882 if line(.i.) in (.'1'..'9'.) then begin
157 08B1 paramNo := ord(line(.i.)) - ord('0');
158 08DD if paramNo >= nextParam then begin
159 08EC writeln(
160 08F4 'Der er ikke angivet tilstrækkelig mange',
161 0928 ' parametre');
162 0942 goto 9999;
163 094A end;
164 094A for j := 1 to length(param(.paramNo.)) do
165 098A putSub(param(.paramNo.)(.j.));
166 09DD end else begin
167 09E4 writeln(
168 09EC 'Følgende $-kombination er ikke tilladt : $',
169 0A23 line(.i.));
170 0A44 goto 9999;
171 0A4C end;
172 0A4C end else
173 0A4E putSub(line(.i.));
174 0A71 i := i+1;
175 0A83 end;
176 0A86 putSub(chr(13));
177 0A91 end;
178 0A94 writeln('Plads til rådighed : ', maxLength:1,
179 0ACB ' Udnyttet : ', submitLength:1);
180 0AF6
181 0AF6 target := CNTvar; put2(submitLength);
182 0B0F 9999:
183 0B0F end.
«eof»