A large commit.
[pdp8.git] / sw / kermit / hachti / K12DEB.PA
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!