Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | / OS/8 BOO DECODING PROGRAM |
2 | ||
3 | / LAST EDIT: 22-OCT-1991 12:00:00 CJL | |
4 | ||
5 | / MAY BE ASSEMBLED WITH '/F' SWITCH SET. | |
6 | ||
7 | / PROGRAM TO DECODE OS/8 FILES FROM "PRINTABLE" ASCII (".BOO") FORMAT TO | |
8 | / BINARY-IMAGE FORMAT. INTERMEDIATE "ASCII" CONVERSION SHOULD BE HARMLESS AS | |
9 | / LONG AS ALL PRINTING DATA CHARACTERS ARE NOT MODIFIED. | |
10 | ||
11 | / DISTRIBUTED BY CUCCA AS "K12DEB.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE. | |
12 | ||
13 | / WRITTEN BY: | |
14 | ||
15 | / CHARLES LASNER (CJL) | |
16 | / CLA SYSTEMS | |
17 | / 72-55 METROPOLITAN AVENUE | |
18 | / MIDDLE VILLAGE, NEW YORK 11379-2107 | |
19 | / (718) 894-6499 | |
20 | ||
21 | / USAGE: | |
22 | ||
23 | / THIS PROGRAM OPERATES ON "PRINTABLE" ASCII FILES WHICH HAVE BEEN CREATED BY | |
24 | / ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES. THE ENCODING FORMAT ALLOWS | |
25 | / FOR CERTAIN "WHITE SPACE" MODIFICATIONS SUCH AS LINE WIDTH REFORMATTING AS | |
26 | / LONG AS ALL PRINTING CHARACTERS ARE UNMODIFIED. EXTRANEOUS <CR>/<LF> PAIRS | |
27 | / AND ALL OTHER CONTROL CHARACTERS (<FF>, <VT>, ETC.) ARE IGNORED. | |
28 | ||
29 | / WHEN CREATING THE DESCENDANT DECODED FILE, THE USER MAY SPECIFY EITHER THE | |
30 | / IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE | |
31 | / OR A SPECIFIED DEVICE: | |
32 | ||
33 | / .RUN DEV DEBOO INVOKE PROGRAM. | |
34 | / *INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT). | |
35 | / *DEV:OUTPUT.EX<INPUT INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:. | |
36 | / *DEV:<INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:. | |
37 | / *OUTPUT.EX<INPUT$ INPUT IS DECODED INTO OUTPUT.EX ON DSK: (DEFAULT). | |
38 | / THE <ESC> CHARACTER WAS USED TO TERMINATE THE LINE | |
39 | / (THIS IS SIGNIFIED BY $). THIS CAUSES PROGRAM EXIT. | |
40 | / . PROGRAM EXITS NORMALLY. | |
41 | ||
42 | / INPUT FILE ASSUMES .BO EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION. | |
43 | ||
44 | / PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE | |
45 | / KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC> | |
46 | / CHARACTER. | |
47 | \f/ .BOO FORMAT IMPLEMENTATION DESCRIPTION. | |
48 | ||
49 | / THIS PROGRAM SUPPORTS STANDARD .BOO FORMAT ENCODED FILES AND OPTIONALLY THE | |
50 | / USE OF LENGTH CORRECTION BYTES AT THE FILE'S END TO ENSURE PROPER LENGTH. IF | |
51 | / NO LENGTH CORRECTION FIELDS ARE FOUND, IT IS ASSUMED THEY AREN'T NEEDED; IT | |
52 | / IS THE RESPONIBILITY OF THE ENCODER TO INSERT THESE FIELDS IF NECESSARY. OS/8 | |
53 | / FILES PROPERLY ENCODED BY THE COMPANION ENBOO-ING PROGRAM (ENBOO AKA K12ENB) | |
54 | / WILL CONTAIN SUCH BYTES AS NECESSARY, AND WILL BE PROPERLY DECODED INTO THEIR | |
55 | / ORIGINAL FORM WITHOUT LOSS. ALL OTHER FILES WILL BE <NUL>-PADDED AS NECESSARY | |
56 | / TO ROUND-UP THE FILE SIZE TO A NUMBER OF COMPLETE OS/8 RECORDS; THEIR | |
57 | / ORIGINAL LENGTH WILL BE LOST. | |
58 | ||
59 | / **** WARNING **** USE OF ENBOO-ING PROGRAMS NOT COMPATIBLE WITH THE OPTIONAL | |
60 | / LENGTH CORRECTION SCHEME CAN PRODUCE FILES DRASTICALLY DIFFERENT FROM THE | |
61 | / ORIGINAL; AN ENTIRE OS/8 RECORD CONTAINING <NUL> CHARACTERS COULD BE APPENDED | |
62 | / TO THE END OF THE FILES. BEYOND THE WASTE OF DISK SPACE, THESE DEFECTIVE | |
63 | / FILES COULD ACTUALLY BE DANGEROUS TO USE UNDER OS/8. | |
64 | ||
65 | / ORDINARILY THESE FILES SHOULDN'T EXIST, BUT COULD BE CREATED BY METHODS SUCH | |
66 | / AS DECODING ON OTHER SYSTEMS FOLLOWED BY USE OF ENCODERS INCOMPATIBLE WITH THE | |
67 | / LENGTH CORRECTION SCHEME. THIS TENDS TO MAKE THE FILE SIZE WRONG BY ONE OR | |
68 | / TWO BYTES, WHICH WHEN DECODED HERE WILL CAUSE THE CREATION OF AN ENTIRE | |
69 | / ERRONEOUS RECORD. IT IS RECOMMENDED THAT FILES STORED ON OTHER SYSTEMS FOR | |
70 | / EVENTUALLY DELIVERY TO OS/8 SYSTEMS BE MAINTAINED IN .BOO FORMAT TO PREVENT | |
71 | / THIS FORM OF FILE CORRUPTION. | |
72 | ||
73 | / ERROR MESSAGES. | |
74 | ||
75 | / ANY MESSAGE PRINTED IS A FATAL ERROR MESSAGE. ALL MESSAGES ARE THE STANDARD | |
76 | / OS/8 "USER" ERROR MESSAGES OF THE FORM: USER ERROR X AT AAAAA WHERE X IS THE | |
77 | / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED. | |
78 | / THE FOLLOWING USER ERRORS ARE DEFINED: | |
79 | ||
80 | / ERROR NUMBER PROBABLE CAUSE | |
81 | ||
82 | / 0 TOO MANY OUTPUT FILES. | |
83 | ||
84 | / 1 NO INPUT FILE OR TOO MANY INPUT FILES. | |
85 | ||
86 | / 2 IMBEDDED OUTPUT FILENAME FORMAT ERROR. | |
87 | ||
88 | / 3 I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME. | |
89 | ||
90 | / 4 ERROR WHILE FETCHING FILE HANDLER. | |
91 | ||
92 | / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE. | |
93 | ||
94 | / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE. | |
95 | ||
96 | / 7 ERROR WHILE CLOSING THE OUTPUT FILE. | |
97 | ||
98 | / 8 I/O ERROR WHILE DECODING FILE DATA OR BAD DATA. | |
99 | ||
100 | / 9 OUTPUT ERROR WHILE DECODING FILE DATA. | |
101 | \f/ ASSEMBLY INSTRUCTIONS. | |
102 | ||
103 | / IT IS ASSUMED THE SOURCE FILE K12DEB.PAL HAS BEEN MOVED AND RENAMED TO | |
104 | / DSK:DEBOO.PA. | |
105 | ||
106 | / .PAL DEBOO<DEBOO/E/F ASSEMBLE SOURCE PROGRAM | |
107 | / .LOAD DEBOO LOAD THE BINARY FILE | |
108 | / .SAVE DEV DEBOO=0 SAVE THE CORE-IMAGE FILE | |
109 | \f/ DEFINITIONS. | |
110 | ||
111 | CLOSE= 4 /CLOSE OUTPUT FILE | |
112 | DECODE= 5 /CALL COMMAND DECODER | |
113 | ENTER= 3 /ENTER TENTATIVE FILE | |
114 | FETCH= 1 /FETCH HANDLER | |
115 | IHNDBUF=7200 /INPUT HANDLER BUFFER | |
116 | INBUFFE=6200 /INPUT BUFFER | |
117 | INFILE= 7617 /INPUT FILE INFORMATION HERE | |
118 | INQUIRE=12 /INQUIRE ABOUT HANDLER | |
119 | NL0001= CLA IAC /LOAD AC WITH 0001 | |
120 | NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 | |
121 | NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 | |
122 | NL7777= CLA CMA /LOAD AC WITH 7777 | |
123 | OHNDBUF=6600 /OUTPUT HANDLER BUFFER | |
124 | OUTBUFF=5600 /OUTPUT BUFFER | |
125 | OUTFILE=7600 /OUTPUT FILE INFORMATION HERE | |
126 | PRGFLD= 00 /PROGRAM FIELD | |
127 | RESET= 13 /RESET SYSTEM TABLES | |
128 | SBOOT= 7600 /MONITOR EXIT | |
129 | TBLFLD= 10 /COMMAND DECODER TABLE FIELD | |
130 | TERMWRD=7642 /TERMINATOR WORD | |
131 | USERROR=7 /USER SIGNALLED ERROR | |
132 | USR= 7700 /USR ENTRY POINT | |
133 | USRFLD= 10 /USR FIELD | |
134 | WRITE= 4000 /I/O WRITE BIT | |
135 | \f *0 /START AT THE BEGINNING | |
136 | ||
137 | *10 /DEFINE AUTO-INDEX AREA | |
138 | ||
139 | XR1, .-. /AUTO-INDEX NUMBER 1 | |
140 | XR2, .-. /AUTO-INDEX NUMBER 2 | |
141 | ||
142 | *20 /GET PAST AUTO-INDEX AREA | |
143 | ||
144 | BUFPTR, .-. /INPUT BUFFER POINTER | |
145 | BYTES, ZBLOCK 3 /DATA BYTES | |
146 | CHRCNT, .-. /CHARACTER COUNTER | |
147 | CMPCNT, .-. /COMPRESSION COUNTER | |
148 | DANGCNT,.-. /DANGER COUNT | |
149 | DATCNT, .-. /DATA COUNTER | |
150 | IDNUMBE,.-. /INPUT DEVICE NUMBER | |
151 | INPUT, .-. /INPUT HANDLER POINTER | |
152 | INRECOR,.-. /INPUT RECORD | |
153 | FNAME, ZBLOCK 4 /OUTPUT FILENAME | |
154 | GETBERR,.-. /ERROR ROUTINE POINTER FOR GETBYTE ROUTINE | |
155 | LATEST, .-. /LATEST OUTPUT BYTE | |
156 | ODNUMBE,.-. /OUTPUT DEVICE NUMBER | |
157 | ONAME, ZBLOCK 10 /OUTPUT NAME FIELD | |
158 | OUTPUT, .-. /OUTPUT HANDLER POINTER | |
159 | OUTRECO,.-. /OUTPUT RECORD | |
160 | PUTEMP, .-. /INPUT TEMPORARY | |
161 | PUTPTR, .-. /OUTPUT POINTER | |
162 | TEMPTR, .-. /TERMPORARY OUTPUT POINTER | |
163 | THIRD, .-. /THIRD BYTE TEMPORARY | |
164 | ||
165 | \f PAGE /START AT THE USUAL PLACE | |
166 | ||
167 | BEGIN, NOP /HERE IN CASE WE'RE CHAINED TO | |
168 | CLA /CLEAN UP | |
169 | START, CIF USRFLD /GOTO USR FIELD | |
170 | JMS I [USR] /CALL USR ROUTINE | |
171 | DECODE /WANT COMMAND DECODER | |
172 | "B^100+"O-300 /.BO IS DEFAULT EXTENSION | |
173 | CDF TBLFLD /GOTO TABLE FIELD | |
174 | TAD I (TERMWRD) /GET TERMINATOR WORD | |
175 | SPA CLA /SKIP IF <CR> TERMINATED THE LINE | |
176 | DCA EXITZAP /ELSE CAUSE EXIT LATER | |
177 | TAD I (OUTFILE) /GET FIRST OUTPUT FILE DEVICE WORD | |
178 | SNA /SKIP IF FIRST OUTPUT FILE PRESENT | |
179 | JMP TSTMORE /JUMP IF NOT THERE | |
180 | AND [17] /JUST DEVICE BITS | |
181 | ODNULL, DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER | |
182 | TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD | |
183 | SNA /SKIP IF THERE | |
184 | TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD | |
185 | SZA CLA /SKIP IF BOTH NOT PRESENT | |
186 | JMP OUTERR /ELSE COMPLAIN | |
187 | TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD | |
188 | SNA /SKIP IF PRESENT | |
189 | JMP INERR /JUMP IF NOT | |
190 | AND [17] /JUST DEVICE BITS | |
191 | DCA IDNUMBER /SAVE INPUT DEVICE NUMBER | |
192 | TAD I (INFILE+2) /GET SECOND INPUT FILE DEVICE WORD | |
193 | SZA CLA /SKIP IF ONLY ONE INPUT FILE | |
194 | JMP INERR /ELSE COMPLAIN | |
195 | TAD I (INFILE+1) /GET FIRST INPUT FILE STARTING RECORD | |
196 | DCA INRECORD /SET IT UP | |
197 | CDF PRGFLD /BACK TO OUR FIELD | |
198 | CIF USRFLD /GOTO USR FIELD | |
199 | JMS I [USR] /CALL USR ROUTINE | |
200 | RESET /RESET SYSTEM TABLES | |
201 | \f TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT | |
202 | DCA IHPTR /STORE IN-LINE | |
203 | TAD IDNUMBER /GET INPUT DEVICE NUMBER | |
204 | CIF USRFLD /GOTO USR FIELD | |
205 | JMS I [USR] /CALL USR ROUTINE | |
206 | FETCH /FETCH HANDLER | |
207 | IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT | |
208 | JMP FERROR /FETCH ERROR | |
209 | TAD IHPTR /GET RETURNED ADDRESS | |
210 | DCA INPUT /STORE AS INPUT HANDLER ADDRESS | |
211 | JMS I (GEOFILE) /GET OUTPUT FILE INFORMATION | |
212 | TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT | |
213 | DCA OHPTR /STORE IN-LINE | |
214 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
215 | CIF USRFLD /GOTO USR FIELD | |
216 | JMS I [USR] /CALL USR ROUTINE | |
217 | FETCH /FETCH HANDLER | |
218 | OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT | |
219 | JMP FERROR /FETCH ERROR | |
220 | TAD OHPTR /GET RETURNED ADDRESS | |
221 | DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS | |
222 | TAD (FNAME) /POINT TO | |
223 | DCA ENTAR1 /STORED FILENAME | |
224 | DCA ENTAR2 /CLEAR SECOND ARGUMENT | |
225 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
226 | CIF USRFLD /GOTO USR FIELD | |
227 | JMS I [USR] /CALL USR ROUTINE | |
228 | ENTER /ENTER TENTATIVE FILENAME | |
229 | ENTAR1, .-. /WILL POINT TO FILENAME | |
230 | ENTAR2, .-. /WILL BE ZERO | |
231 | JMP ENTERR /ENTER ERROR | |
232 | TAD ENTAR1 /GET RETURNED FIRST RECORD | |
233 | DCA OUTRECORD /STORE IT | |
234 | TAD ENTAR2 /GET RETURNED EMPTY LENGTH | |
235 | IAC /ADD 2-1 FOR OS/278 CRAZINESS | |
236 | DCA DANGCNT /STORE AS DANGER COUNT | |
237 | JMS I (DECODIT) /GO DO THE ACTUAL DECODING | |
238 | JMP PROCERR /ERROR WHILE DECODING | |
239 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
240 | CIF USRFLD /GOTO USR FIELD | |
241 | JMS I [USR] /CALL USR ROUTINE | |
242 | CLOSE /CLOSE OUTPUT FILE | |
243 | FNAME /POINTER TO FILENAME | |
244 | OUTCNT, .-. /WILL BE ACTUAL COUNT | |
245 | JMP CLSERR /CLOSE ERROR | |
246 | EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000 | |
247 | JMP I (SBOOT) /EXIT TO MONITOR | |
248 | \f/ OUTPUT FILE ERROR WHILE PROCESSING. | |
249 | ||
250 | OERROR, TAD [3] /SET INCREMENT | |
251 | SKP /DON'T USE NEXT | |
252 | ||
253 | / ERROR WHILE PROCESSING INPUT FILE. | |
254 | ||
255 | PROCERR,NL0002 /SET INCREMENT | |
256 | SKP /DON'T USE NEXT | |
257 | ||
258 | / ERROR WHILE CLOSING THE OUTPUT FILE. | |
259 | ||
260 | CLSERR, NL0001 /SET INCREMENT | |
261 | SKP /DON'T CLEAR IT | |
262 | ||
263 | / OUTPUT FILE TOO LARGE ERROR. | |
264 | ||
265 | SIZERR, CLA /CLEAN UP | |
266 | TAD [3] /SET INCREMENT | |
267 | SKP /DON'T USE NEXT | |
268 | ||
269 | / ENTER ERROR. | |
270 | ||
271 | ENTERR, NL0002 /SET INCREMENT | |
272 | SKP /DON'T USE NEXT | |
273 | ||
274 | / HANDLER FETCH ERROR. | |
275 | ||
276 | FERROR, NL0001 /SET INCREMENT | |
277 | ||
278 | / I/O ERROR WHILE PROCESSING IMBEDDED FILENAME. | |
279 | ||
280 | NIOERR, IAC /SET INCREMENT | |
281 | ||
282 | / FORMAT ERROR WHILE PROCESSING IMBEDDED FILENAME. | |
283 | ||
284 | CHARERR,IAC /SET INCREMENT | |
285 | ||
286 | / INPUT FILESPEC ERROR. | |
287 | ||
288 | INERR, IAC /SET INCREMENT | |
289 | ||
290 | / OUTPUT FILESPEC ERROR. | |
291 | ||
292 | OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER | |
293 | CDF PRGFLD /ENSURE OUR FIELD | |
294 | CIF USRFLD /GOTO USR FIELD | |
295 | JMS I [USR] /CALL USR ROUTINE | |
296 | USERROR /USER ERROR | |
297 | ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER | |
298 | \f/ COMES HERE TO TEST FOR NULL LINE. | |
299 | ||
300 | TSTMORE,TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD | |
301 | SNA /SKIP IF PRESENT | |
302 | TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD | |
303 | SZA CLA /SKIP IF NO OUTPUT FILES | |
304 | JMP OUTERR /ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT | |
305 | TAD I (INFILE) /GET FIRST OUTPUT FILE DEVICE WORD | |
306 | SZA CLA /SKIP IF NO INPUT FILES | |
307 | JMP ODNULL /JUMP IF INPUT WITHOUT OUTPUT | |
308 | CDF PRGFLD /BACK TO OUR FIELD | |
309 | JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST | |
310 | ||
311 | PAGE | |
312 | \fDECODIT,.-. /DECODING ROUTINE | |
313 | TAD (DECERR) /SETUP THE | |
314 | DCA GETBERROR /GETBYTE ERROR ROUTINE | |
315 | DCA DATCNT /CLEAR DATA COUNT | |
316 | NL7777 /SETUP FOR INITIALIZING | |
317 | JMS I (PUTBYTE) /INITIALIZE OUTPUT FILE | |
318 | LOOP, JMS GETCHR /GET A CHARACTER | |
319 | JMP ENDIT /WEREN'T ANY MORE | |
320 | TAD (-176) /COMPARE TO TILDE | |
321 | SZA CLA /SKIP IF IT MATCHES | |
322 | JMP DATPROCESS /JUMP IF NOT | |
323 | JMS GETCHR /GET A CHARACTER | |
324 | DECERR, JMP I DECODIT /WASN'T ANY | |
325 | TAD (-"0!200) /REMOVE PRINTING OFFSET | |
326 | SNA /SKIP IF SIGNIFICENT COMPRESSION | |
327 | JMP DATCORRECT /JUMP IF NOT | |
328 | CIA /INVERT FOR COUNTING | |
329 | DCA CMPCNT /SAVE COMPRESSION COUNT | |
330 | JMS DATOUT /OUTPUT DATA FIELD (IF ANY) AND CLEAR DATA COUNT | |
331 | COMPLP, JMS I (PUTBYTE) /OUTPUT A <NUL> BYTE | |
332 | ISZ CMPCNT /DONE YET? | |
333 | JMP COMPLP /NO, KEEP GOING | |
334 | JMP LOOP /YES, GO BACK FOR MORE FILE ITEMS | |
335 | ||
336 | / ZERO-LENGTH COMPRESSION (CORRECTION) FIELD FOUND. | |
337 | ||
338 | DATCORR,NL7777 /BACKUP | |
339 | TAD DATCNT /NOW HAVE CORRECTED DATA COUNT | |
340 | SPA /SKIP IF COUNT WASN'T ZERO | |
341 | JMP LOOP /IGNORE BECAUSE THERE IS NO DATA | |
342 | SNA /SKIP IF ENOUGH TO CORRECT | |
343 | JMP I DECODIT /TAKE ERROR RETURN IF NOT | |
344 | DCA DATCNT /STORE CORRECTED COUNT | |
345 | JMP LOOP /GO BACK FOR MORE FILE ITEMS | |
346 | \f/ UN-COMPRESSED DATA FOUND. | |
347 | ||
348 | DATPROC,JMS DATOUT /OUTPUT PREVIOUS DATA FIELD (IF ANY), CLEAR DATA COUNT | |
349 | TAD PUTEMP /GET LATEST BACK | |
350 | TAD (-"0!200) /REMOVE DIGIT OFFSET | |
351 | CLL RTL /MOVE UP | |
352 | DCA BYTES /STORE IT | |
353 | JMS GETCHR /GET NEXT CHARACTER | |
354 | JMP I DECODIT /WASN'T ANY | |
355 | AND (17) /JUST LOW-ORDER BITS | |
356 | CLL RTL;RTL /MOVE UP | |
357 | DCA BYTES+1 /STORE IT | |
358 | TAD PUTEMP /GET IT AGAIN | |
359 | RTR;RTR /MOVE DOWN | |
360 | IAC /REMOVE DIGIT BIAS | |
361 | AND (3) /JUST GOOD BITS | |
362 | TAD BYTES /GET OLD BITS | |
363 | DCA BYTES /STORE COMPOSITE | |
364 | JMS GETCHR /GET NEXT CHARACTER | |
365 | JMP I DECODIT /WASN'T ANY | |
366 | TAD (-"0!200) /REMOVE DIGIT OFFSET | |
367 | RTR /MOVE DOWN | |
368 | AND (17) /ISOLATE GOOD BITS | |
369 | TAD BYTES+1 /GET OLD BITS | |
370 | DCA BYTES+1 /STORE COMPOSITE | |
371 | TAD PUTEMP /GET IT AGAIN | |
372 | AND (3) /ISOLATE GOOD BITS | |
373 | CLL RTL;RTL;RTL /MOVE UP | |
374 | DCA BYTES+2 /STORE IT | |
375 | JMS GETCHR /GET NEXT CHARACTER | |
376 | JMP I DECODIT /WASN'T ANY | |
377 | TAD (-"0!200) /REMOVE DIGIT OFFSET | |
378 | TAD BYTES+2 /GET OLD BITS | |
379 | DCA BYTES+2 /STORE COMPOSITE | |
380 | TAD (3) /SETUP THE | |
381 | DCA DATCNT /DATA COUNT | |
382 | JMP LOOP /GO GET NEXT FILE ITEM | |
383 | ||
384 | / COMES HERE AT END-OF-FILE. | |
385 | ||
386 | ENDIT, JMS DATOUT /OUTPUT ANY LEFTOVER DATA | |
387 | SKP /DON'T OUTPUT YET | |
388 | CLOSLUP,JMS I (PUTBYTE) /OUTPUT A <NUL> BYTE | |
389 | TAD PUTPTR /GET THE OUTPUT BUFFER POINTER | |
390 | TAD (-OUTBUFFER) /COMPARE TO RESET VALUE | |
391 | SZA CLA /SKIP IF IT MATCHES | |
392 | JMP CLOSLUP /ELSE KEEP GOING | |
393 | ISZ DECODIT /BUMP TO GOOD RETURN | |
394 | JMP I DECODIT /RETURN TO CALLER | |
395 | \fDATOUT, .-. /DATA OUTPUT ROUTINE | |
396 | TAD DATCNT /GET CURRENT DATA COUNT | |
397 | CMA /SETUP FOR COUNTING | |
398 | DCA DATCNT /STORE IT | |
399 | TAD (BYTES-1) /POINT TO | |
400 | DCA XR1 /DATA AREA | |
401 | JMP DATEST /CHECK BEFORE OUTPUTTING | |
402 | ||
403 | DATLUP, TAD I XR1 /GET A BYTE | |
404 | JMS I (PUTBYTE) /OUTPUT IT | |
405 | DATEST, ISZ DATCNT /DONE YET? | |
406 | JMP DATLUP /NO, KEEP GOING | |
407 | JMP I DATOUT /YES, RETURN TO CALLER | |
408 | ||
409 | GETCHR, .-. /GET A CHARACTER ROUTINE | |
410 | GETCAGN,CLA /GET A CHARACTER | |
411 | JMS I [GETBYTE] /GET A CHARACTER FROM FILE | |
412 | JMP I GETCHR /WASN'T ANY, TAKE IMMEDIATE RETURN | |
413 | TAD [-" !200] /COMPARE TO <SPACE> | |
414 | SPA SNA CLA /SKIP IF NOT CONTROL CHARACTER OR <SPACE> | |
415 | JMP GETCAGN /GO GET ANOTHER ONE | |
416 | TAD PUTEMP /GET GOOD CHARACTER | |
417 | ISZ GETCHR /BUMP RETURN ADDRESS | |
418 | JMP I GETCHR /RETURN TO CALLER | |
419 | ||
420 | PAGE | |
421 | \fPUTBYTE,.-. /OUTPUT A BYTE ROUTINE | |
422 | SPA /ARE WE INITIALIZING? | |
423 | JMP PUTINITIALIZE /YES | |
424 | AND (377) /JUST IN CASE | |
425 | DCA LATEST /SAVE LATEST CHARACTER | |
426 | TAD LATEST /GET LATEST CHARACTER | |
427 | JMP I PUTNEXT /GO WHERE YOU SHOULD GO | |
428 | ||
429 | PUTNEXT,.-. /EXIT ROUTINE | |
430 | JMP I PUTBYTE /RETURN TO MAIN CALLER | |
431 | ||
432 | PUTINIT,CLA /CLEAN UP | |
433 | TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE | |
434 | DCA PUTRECORD /STORE IN-LINE | |
435 | DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH | |
436 | PUTNEWR,TAD POUTBUFFER/(OUTBUFFER) /SETUP THE | |
437 | DCA PUTPTR /BUFFER POINTER | |
438 | PUTLOOP,JMS PUTNEXT /GET A CHARACTER | |
439 | DCA I PUTPTR /STORE IT | |
440 | TAD PUTPTR /GET POINTER VALUE | |
441 | DCA TEMPTR /SAVE FOR LATER | |
442 | ISZ PUTPTR /BUMP TO NEXT | |
443 | JMS PUTNEXT /GET A CHARACTER | |
444 | DCA I PUTPTR /STORE IT | |
445 | JMS PUTNEXT /GET A CHARACTER | |
446 | RTL;RTL /MOVE UP | |
447 | AND [7400] /ISOLATE HIGH NYBBLE | |
448 | TAD I TEMPTR /ADD ON FIRST BYTE | |
449 | DCA I TEMPTR /STORE COMPOSITE | |
450 | TAD LATEST /GET LATEST CHARACTER | |
451 | RTR;RTR;RAR /MOVE UP AND | |
452 | AND [7400] /ISOLATE LOW NYBBLE | |
453 | TAD I PUTPTR /ADD ON SECOND BYTE | |
454 | DCA I PUTPTR /STORE COMPOSITE | |
455 | ISZ PUTPTR /BUMP TO NEXT | |
456 | TAD PUTPTR /GET LATEST POINTER VALUE | |
457 | TAD (-2^200-OUTBUFFER) /COMPARE TO LIMIT | |
458 | SZA CLA /SKIP IF AT END | |
459 | JMP PUTLOOP /KEEP GOING | |
460 | ISZ DANGCNT /TOO MANY RECORDS? | |
461 | SKP /SKIP IF NOT | |
462 | JMP I (SIZERR) /JUMP IF SO | |
463 | JMS I OUTPUT /CALL I/O HANDLER | |
464 | 2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER | |
465 | POUTBUF,OUTBUFFER /BUFFER ADDRESS | |
466 | PUTRECO,.-. /WILL BE LATEST RECORD NUMBER | |
467 | JMP I (OERROR) /OUTPUT ERROR! | |
468 | ISZ I (OUTCNT) /BUMP ACTUAL LENGTH | |
469 | ISZ PUTRECORD /BUMP TO NEXT RECORD | |
470 | JMP PUTNEWRECORD /KEEP GOING | |
471 | \f/ OS/8 FILE UNPACK ROUTINE. | |
472 | ||
473 | GETBYTE,.-. /GET A BYTE ROUTINE | |
474 | SNA CLA /INITIALIZING? | |
475 | JMP I PUTC /NO, GO GET NEXT BYTE | |
476 | TAD INRECORD /GET STARTING RECORD OF INPUT FILE | |
477 | DCA GETRECORD /STORE IN-LINE | |
478 | GETNEWR,JMS I INPUT /CALL I/O HANDLER | |
479 | 2^100 /READ TWO PAGES INTO BUFFER | |
480 | PINBUFF,INBUFFER /BUFFER ADDRESS | |
481 | GETRECO,.-. /WILL BE LATEST RECORD NUMBER | |
482 | JMP I GETBERROR /INPUT ERROR! | |
483 | TAD PINBUFFER/(INBUFFER) /SETUP THE | |
484 | DCA BUFPTR /BUFFER POINTER | |
485 | GETLOOP,DCA THIRD /CLEAR THIRD BYTE NOW | |
486 | JMS PUTONE /OBTAIN AND SEND BACK FIRST BYTE | |
487 | JMS PUTONE /OBTAIN AND SEND BACK SECOND BYTE | |
488 | TAD THIRD /GET THIRD BYTE | |
489 | JMS PUTC /SEND IT BACK | |
490 | TAD BUFPTR /GET THE POINTER | |
491 | TAD (-2^200-INBUFFER) /COMPARE TO LIMIT | |
492 | SZA CLA /SKIP IF AT END | |
493 | JMP GETLOOP /KEEP GOING | |
494 | ISZ GETRECORD /BUMP TO NEXT RECORD | |
495 | JMP GETNEWRECORD /GO DO ANOTHER ONE | |
496 | ||
497 | PUTONE, .-. /SEND BACK A BYTE ROUTINE | |
498 | TAD I BUFPTR /GET LATEST WORD | |
499 | AND [7400] /JUST THIRD-BYTE NYBBLE | |
500 | CLL RAL /MOVE UP | |
501 | TAD THIRD /GET OLD NYBBLE (IF ANY) | |
502 | RTL;RTL /MOVE UP NYBBLE BITS | |
503 | DCA THIRD /SAVE FOR NEXT TIME | |
504 | TAD I BUFPTR /GET LATEST WORD AGAIN | |
505 | JMS PUTC /SEND BACK CURRENT BYTE | |
506 | ISZ BUFPTR /BUMP TO NEXT WORD | |
507 | JMP I PUTONE /RETURN | |
508 | ||
509 | PUTC, .-. /SEND BACK LATEST BYTE ROUTINE | |
510 | AND (177) /KEEP ONLY GOOD BITS | |
511 | DCA PUTEMP /SAVE IT | |
512 | TAD PUTEMP /GET IT BACK | |
513 | TAD (-"Z!300) /COMPARE TO <^Z> | |
514 | SNA CLA /SKIP IF NOT ASCII <EOF> | |
515 | JMP I GETBYTE /RETURN IF ASCII MODE <EOF> | |
516 | TAD PUTEMP /RESTORE THE CHARACTER | |
517 | ISZ GETBYTE /BUMP PAST <EOF> RETURN | |
518 | JMP I GETBYTE /RETURN TO MAIN CALLER | |
519 | \f PAGE | |
520 | \fGEOFILE,.-. /GET OUTPUT FILE ROUTINE | |
521 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
522 | SZA CLA /SKIP IF NOT ESTABLISHED YET | |
523 | JMP GOTOD /JUMP IF DETERMINED ALREADY | |
524 | TAD ("D^100+"S-300) /GET BEGINNING OF "DSK" | |
525 | DCA DEVNAME /STORE IN-LINE | |
526 | TAD ("K^100) /GET REST OF "DSK" | |
527 | DCA DEVNAME+1 /STORE IN-LINE | |
528 | DCA RETVAL /CLEAR HANDLER ENTRY WORD | |
529 | CDF PRGFLD /INDICATE OUR FIELD | |
530 | CIF USRFLD /GOTO USR FIELD | |
531 | JMS I [USR] /CALL USR ROUTINE | |
532 | INQUIRE /INQUIRE ABOUT HANDLER | |
533 | DEVNAME,ZBLOCK 2 /WILL BE DEVICE DSK | |
534 | RETVAL, .-. /BECOMES HANDLER ENTRY POINT WORD | |
535 | HLT /DSK: NOT IN SYSTEM IS IMPOSSIBLE! | |
536 | TAD DEVNAME+1 /GET DEVICE NUMBER FOR DSK: | |
537 | AND [17] /JUST DEVICE BITS | |
538 | DCA ODNUMBER /STORE OUTPUT DEVICE | |
539 | GOTOD, JMS SCANAME /SCAN OFF FILE NAME | |
540 | CDF TBLFLD /BACK TO TABLE FIELD | |
541 | TAD I (OUTFILE+1) /GET OUTPUT FILE FIRST NAME WORD | |
542 | SNA /SKIP IF PRESENT | |
543 | JMP GFLNAME /JUMP IF NOT | |
544 | DCA FNAME /MOVE TO OUR AREA | |
545 | TAD I (OUTFILE+2) /GET SECOND NAME WORD | |
546 | DCA FNAME+1 /MOVE IT | |
547 | TAD I (OUTFILE+3) /GET THIRD NAME WORD | |
548 | DCA FNAME+2 /MOVE IT | |
549 | TAD I (OUTFILE+4) /GET EXTENSION WORD | |
550 | DCA FNAME+3 /MOVE IT | |
551 | CDF PRGFLD /BACK TO OUR FIELD | |
552 | JMP I GEOFILE /RETURN | |
553 | ||
554 | / WE MUST TAKE THE FILENAME FROM THE IMBEDDED FILENAME SUPPLIED. | |
555 | ||
556 | GFLNAME,CDF PRGFLD /BACK TO OUR FIELD | |
557 | TAD ONAME /GET THE FIRST CHARACTER | |
558 | SNA CLA /SKIP IF SOMETHING THERE | |
559 | JMP I (CHARERROR) /COMPLAIN IF NONE THERE | |
560 | TAD (ONAME-1) /SETUP POINTER | |
561 | DCA XR1 /TO NAME CHARACTERS | |
562 | TAD (FNAME-1) /SETUP POINTER | |
563 | DCA XR2 /TO PACKED NAME AREA | |
564 | TAD (-4) /SETUP THE | |
565 | DCA CHRCNT /MOVE COUNT | |
566 | CHRLOOP,TAD I XR1 /GET FIRST CHARACTER | |
567 | CLL RTL;RTL;RTL /MOVE UP | |
568 | TAD I XR1 /ADD ON SECOND CHARACTER | |
569 | DCA I XR2 /STORE THE PAIR | |
570 | ISZ CHRCNT /DONE YET? | |
571 | JMP CHRLOOP /NO, KEEP GOING | |
572 | JMP I GEOFILE /YES, RETURN | |
573 | \fSCANAME,.-. /SCAN OFF FILENAME ROUTINE | |
574 | TAD (NIOERROR) /SETUP THE | |
575 | DCA GETBERROR /I/O ERROR HANDLER | |
576 | ||
577 | / ZERO OUT THE FILENAME AREA. | |
578 | ||
579 | TAD (-10) /SETUP THE | |
580 | DCA CHRCNT /CLEAR COUNTER | |
581 | TAD (ONAME-1) /SETUP THE | |
582 | DCA XR1 /POINTER | |
583 | JMS CLRNAME /CLEAR THE NAME BUFFER | |
584 | ||
585 | / SETUP FOR SCANNING THE NAME PORTION. | |
586 | ||
587 | TAD (-6) /SETUP THE | |
588 | DCA CHRCNT /SCAN COUNT | |
589 | TAD (ONAME-1) /SETUP THE | |
590 | DCA XR1 /POINTER | |
591 | NL7777 /MAKE IT INITIALIZE | |
592 | FNCAGN, JMS I (GETAN) /GET A CHARACTER | |
593 | JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD | |
594 | DCA I XR1 /STASH THE CHARACTER | |
595 | ISZ CHRCNT /DONE ALL YET? | |
596 | JMP FNCAGN /NO, KEEP GOING | |
597 | ||
598 | / THROW AWAY EXTRA NAME CHARACTERS. | |
599 | ||
600 | TOSSNAM,JMS I (GETAN) /GET A CHARACTER | |
601 | JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD | |
602 | CLA /THROW AWAY THE CHARACTER | |
603 | JMP TOSSNAME /KEEP GOING | |
604 | ||
605 | / COMES HERE AFTER "." FOUND. | |
606 | ||
607 | GOTSEPA,JMS CLRNAME /CLEAR OUT THE REMAINING NAME FIELD | |
608 | NL7776 /SETUP THE | |
609 | DCA CHRCNT /SCAN COUNT | |
610 | EXCAGN, JMS I (GETAN) /GET A CHARACTER | |
611 | JMP I (CHARERROR) /GOT "."; COMPLAIN | |
612 | DCA I XR1 /STASH THE CHARACTER | |
613 | ISZ CHRCNT /DONE ENOUGH YET? | |
614 | JMP EXCAGN /NO, KEEP GOING | |
615 | ||
616 | / TOSS ANY EXTRA EXTENSION CHARACTERS. | |
617 | ||
618 | TOSSEXT,JMS I (GETAN) /GET A CHARACTER | |
619 | JMP I (CHARERROR) /GOT "."; COMPLAIN | |
620 | CLA /THROW AWAY THE CHARACTER | |
621 | JMP TOSSEXTENSION /KEEP GOING | |
622 | ||
623 | / COMES HERE WHEN TRAILING <CR> IS FOUND. | |
624 | ||
625 | GOTCR, JMS CLRNAME /CLEAR ANY REMAINING EXTENSION CHARACTERS | |
626 | JMP I SCANAME /RETURN | |
627 | \fCLRNAME,.-. /NAME FIELD CLEARING ROUTINE | |
628 | TAD CHRCNT /GET CHARACTER COUNTER | |
629 | SNA CLA /SKIP IF ANY TO CLEAR | |
630 | JMP I CLRNAME /ELSE JUST RETURN | |
631 | DCA I XR1 /CLEAR A NAME WORD | |
632 | ISZ CHRCNT /COUNT IT | |
633 | JMP .-2 /KEEP GOING | |
634 | JMP I CLRNAME /RETURN | |
635 | ||
636 | PAGE | |
637 | \fGETCHAR,.-. /GET A CHARACTER ROUTINE | |
638 | JMS I [GETBYTE] /GET A CHARACTER | |
639 | JMP I (CHARERROR) /COMPLAIN IF <EOF> REACHED | |
640 | TAD (-"M!300) /COMPARE TO <CR> | |
641 | SNA /SKIP IF OTHER | |
642 | JMP I (GOTCR) /JUMP IF IT MATCHES | |
643 | TAD (-140+"M-300) /COMPARE TO LOWER-CASE LIMIT | |
644 | SPA /SKIP IF LOWER-CASE | |
645 | TAD (40) /RESTORE ORIGINAL IF UPPER-CASE | |
646 | AND (77) /JUST SIX-BIT | |
647 | DCA PUTEMP /SAVE IN CASE WE NEED IT | |
648 | TAD PUTEMP /GET IT BACK | |
649 | JMP I GETCHAR /RETURN | |
650 | ||
651 | GETAN, .-. /GET ALPHANUMERIC ROUTINE | |
652 | GETNAGN,JMS GETCHAR /GET A CHARACTER | |
653 | TAD [-" !200] /COMPARE TO <SPACE> | |
654 | SNA CLA /SKIP IF OTHER | |
655 | JMP GETNAGN /JUMP IF IT MATCHES | |
656 | TAD PUTEMP /GET THE CHARACTER BACK | |
657 | TAD (-".!200) /COMPARE TO "." | |
658 | SNA /SKIP IF OTHER | |
659 | JMP I GETAN /TAKE FIRST RETURN IF IT MATCHES | |
660 | TAD (-":+".) /SUBTRACT UPPER LIMIT | |
661 | CLL /CLEAR LINK FOR TEST | |
662 | TAD (":-"0) /ADD ON RANGE | |
663 | SZL CLA /SKIP IF NOT NUMERIC | |
664 | JMP GETANOK /JUMP IF NUMERIC | |
665 | TAD PUTEMP /GET THE CHARACTER BACK | |
666 | TAD (-"[!300) /SUBTRACT UPPER LIMIT | |
667 | CLL /CLEAR LINK FOR TEST | |
668 | TAD ("[-"A) /ADD ON RANGE | |
669 | SNL CLA /SKIP IF ALPHABETIC | |
670 | JMP I (CHARERROR) /ELSE COMPLAIN | |
671 | GETANOK,TAD PUTEMP /GET GOOD ALPHANUMERIC CHARACTER | |
672 | ISZ GETAN /BUMP TO SKIP RETURN | |
673 | JMP I GETAN /RETURN | |
674 | ||
675 | PAGE | |
676 | \f $ /THAT'S ALL FOLK! |