projects / pdp8.git / blob
? search:
summary | shortlog | log | commit | commitdiff | tree
blame | history | raw | HEAD
A large commit.
[pdp8.git] / sw / kermit / hachti / K12ENB.PA
1 / OS/8 BOO ENCODING PROGRAM
2
3 / LAST EDIT: 01-OCT-1991 15:00:00 CJL
4
5 / MAY BE ASSEMBLED WITH '/F' SWITCH SET.
6
7 / PROGRAM TO ENCODE ANY TYPE OF OS/8 FILE INTO "PRINTABLE" ASCII (".BOO")
8 / FORMAT. THIS IS A COMMON DISTRIBUTION FORMAT FOR MANY COLUMBIA KERMIT FILES
9 / AND IS AN ALTERNATIVE TO ENCODE FORMAT FOR PDP-8 AND DECMATE USERS.
10
11 / DISTRIBUTED BY CUCCA AS "K12ENB.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 / .RUN DEV ENBOO INVOKE PROGRAM
24 / *OUTPUT<INPUT PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <CR>)
25 / *OUTPUT<INPUT$ PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <ESC>)
26 / . PROGRAM EXITS NORMALLY
27
28 / INPUT FILE ASSUMES .SV EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION.
29
30 / PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE
31 / KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC>
32 / CHARACTER.
33
34 / THIS PROGRAM SUPPORTS THE .BOO FORMAT FOR FILE ENCODING WHICH IS POPULAR IN
35 / OTHER SYSTEMS. THIS VERSION IMPLEMENTS THE FILE LENGTH PROTECTION SCHEME
36 / DEVELOPED BY CHARLES LASNER TO ENSURE PRECISE FILE LENGTH.
37
38 / MANY .BOO PROGRAMS HAVE PROBLEMS MAINTAINING PRECISE FILE LENGTH. THE ACTUAL
39 / LENGTH MAY BE IMPRECISELY STATED BY ONE OR TWO BYTES DUE TO AN INHERENT
40 / WEAKNESS IN THE ORIGINAL .BOO ENCODING FORMAT DESIGN. THIS IMPLEMENTATION
41 / APPENDS CORRECTION BYTES AS NECESSARY TO THE BASIC .BOO FILE TO ENSURE PROPER
42 / DECODING BY PROGRAMS COMPATIBLE WITH THIS EXTENSION.
43
44 / FILES CREATED BY THIS PROGRAM MAY BE USED WITH EARLIER .BOO DECODERS; THE
45 / RESULTANT FILES MAY INACCURATELY RECREATE THE ORIGINAL FILES BY AS MUCH AS TWO
46 / EXTRANEOUS TRAILING BYTES. THERE WILL BE NO PROBLEMS (BEYOND THE LENGTH
47 / ANOMALY) AS LONG AS THE DECODERS IMPLEMENT ZERO-LENGTH COMPRESSION FIELDS AS
48 / NO OPERATION. IT IS POSSIBLE THAT CERTAIN DECODERS COULD ERRONEOUSLY APPEND
49 / MASSIVE QUANTITIES OF ZEROES ONTO THE END OF THE DECODED FILES, BUT THIS
50 / ACTION WOULD CERTAINLY BE CAUSED BY DEFECTIVE PROGRAM CODE WITHIN THE DECODER.
51 / (ALTHOUGH NOT LIKELY SEEN BEFORE ENCOUNTERING FILES WITH LENGTH CORRECTION
52 / BYTES, THIS WOULD BE A LATENT BUG IN THESE DECODING PROGRAMS. UPDATED
53 / VERSIONS SHOULD BE SOUGHT IF THIS PROBLEM SURFACES.)
54 \f/ ERROR MESSAGES.
55
56 / ERROR MESSAGES ARE ONE OF TWO VARIETIES: COMMAND DECODER MESSAGES AND USER
57 / (PROGRAM-SIGNALLED) MESSAGES.
58
59 / COMMAND DECODER MESSAGES ARE NON-FATAL AND MERELY REQUIRE RETYPING THE
60 / COMMAND. ATTEMPTING TO USE MORE THAN ONE OUTPUT FILE WILL YIELD THE COMMAND
61 / DECODER MESSAGE "TOO MANY FILES" AND CAUSE A REPEAT OF THE COMMAND DECODER
62 / PROMPT REQUIRING USER INPUT. THE USER IS DIRECTED TO OTHER DOCUMENTATION OF
63 / THE "SPECIAL" MODE OF THE COMMAND DECODER, AS THAT IS THE ONLY MODE USED BY
64 / THIS UTILITY PROGRAM.
65
66 / ANY USER MESSAGE PRINTED IS A FATAL ERROR MESSAGE CAUSED BY A PROBLEM BEYOND
67 / THE SCOPE OF THE COMMAND DECODER. ALL USER MESSAGES ARE THE STANDARD OS/8
68 / "USER" ERROR MESSAGES OF THE FORM: "USER ERROR X AT AAAAA", WHERE X IS THE
69 / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED.
70 / THE FOLLOWING USER ERRORS ARE DEFINED:
71
72 / ERROR NUMBER PROBABLE CAUSE
73
74 / 0 NO OUTPUT FILE.
75
76 / 1 INPUT FILE ERROR (CAN'T FIND INPUT FILE) OR NO INPUT
77 / FILE SPECIFIED OR TOO MANY INPUT FILES SPECIFIED.
78 / 2 ILLEGAL OUTPUT FILE NAME (WILD CARDS NOT ALLOWED).
79
80 / 3 NO OUTPUT FILE NAME (DEVICE ONLY IS NOT ALLOWED).
81
82 / 4 ERROR WHILE FETCHING FILE HANDLER.
83
84 / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE.
85
86 / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE.
87
88 / 7 ERROR WHILE CLOSING THE OUTPUT FILE.
89
90 / 8 I/O ERROR WHILE ENCODING FILE DATA.
91
92 / 9 OUTPUT ERROR WHILE ENCODING FILE DATA.
93
94 / ASSEMBLY INSTRUCTIONS.
95
96 / IT IS ASSUMED THE SOURCE FILE K12ENB.PAL HAS BEEN MOVED AND RENAMED TO
97 / DSK:ENBOO.PA.
98
99 / .PAL ENBOO<ENBOO/E/F ASSEMBLE SOURCE PROGRAM
100 / .LOAD ENBOO LOAD THE BINARY FILE
101 / .SAVE DEV ENBOO=2001 SAVE THE CORE-IMAGE FILE
102 \f/ DEFINITIONS.
103
104 CLOSE= 4 /CLOSE OUTPUT FILE
105 DECODE= 5 /CALL COMMAND DECODER
106 ENTER= 3 /ENTER TENTATIVE FILE
107 FETCH= 1 /FETCH HANDLER
108 IHNDBUF=7200 /INPUT HANDLER BUFFER
109 INBUFFE=6200 /INPUT BUFFER
110 INFILE= 7605 /INPUT FILE INFORMATION HERE
111 LOOKUP= 2 /LOOKUP INPUT FILE
112 NL0001= CLA IAC /LOAD AC WITH 0001
113 NL0002= CLA CLL CML RTL /LOAD AC WITH 0002
114 NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776
115 NL7777= CLA CMA /LOAD AC WITH 7777
116 OHNDBUF=6600 /OUTPUT HANDLER BUFFER
117 OUTBUFF=5600 /OUTPUT BUFFER
118 OUTFILE=7600 /OUTPUT FILE INFORMATION HERE
119 PRGFLD= 00 /PROGRAM FIELD
120 RESET= 13 /RESET SYSTEM TABLES
121 SBOOT= 7600 /MONITOR EXIT
122 TBLFLD= 10 /COMMAND DECODER TABLE FIELD
123 TERMWRD=7642 /TERMINATOR WORD
124 USERROR=7 /USER SIGNALLED ERROR
125 USR= 0200 /USR ENTRY POINT
126 USRENT= 7700 /USR ENTRY POINT WHEN NON-RESIDENT
127 USRFLD= 10 /USR FIELD
128 USRIN= 10 /LOCK USR IN CORE
129 WIDTH= 114 /LINES MUST BE 76 WIDE OR LESS
130 WRITE= 4000 /I/O WRITE BIT
131 \f *0 /START AT THE BEGINNING
132
133 *20 /GET PAST AUTO-INDEX AREA
134
135 BUFPTR, .-. /OUTPUT BUFFER POINTER
136 CHAR, .-. /LATEST INPUT BYTE
137 CHARPTR,.-. /OUTPUT BYTE POINTER
138 CHARS, ZBLOCK 3 /OUTPUT BYTES HERE
139 CMPCNT, .-. /MATCH COUNT FOR COMPRESSION
140 COLUMN, .-. /LATEST COLUMN
141 DANGCNT,.-. /DANGER COUNT
142 IDNUMBE,.-. /INPUT DEVICE NUMBER
143 IFNAME, ZBLOCK 4 /INPUT FILENAME
144 INLEN, .-. /INPUT FILE LENGTH
145 INPTR, .-. /INPUT BUFFER POINTER
146 INPUT, .-. /INPUT HANDLER POINTER
147 INRECOR,.-. /INPUT RECORD
148 FNAME, ZBLOCK 4 /OUTPUT FILENAME
149 LATEST, .-. /LATEST OUTPUT CHARACTER
150 ODNUMBE,.-. /OUTPUT DEVICE NUMBER
151 OUTPUT, .-. /OUTPUT HANDLER POINTER
152 OUTRECO,.-. /OUTPUT RECORD
153 PIFTEMP,.-. /PRINT INPUT FILENAME TEMPORARY
154 TEMPTR, .-. /TEMPORARY POINTER
155 THIRD, .-. /THIRD INPUT BYTE UNPACKING TEMPORARY
156 \f PAGE /START AT THE USUAL PLACE
157
158 BEGIN, NOP /IN CASE WE'RE CHAINED TO
159 CLA /CLEAN UP
160 START, CIF USRFLD /GOTO USR FIELD
161 JMS I (USRENT) /CALL USR ROUTINE
162 USRIN /GET IT LOCKED IN
163 CIF USRFLD /GOTO USR FIELD
164 JMS I [USR] /CALL USR ROUTINE
165 DECODE /WANT COMMAND DECODER
166 "*^100 /USING SPECIAL MODE
167 CDF TBLFLD /GOTO TABLE FIELD
168 TAD I (TERMWRD) /GET TERMINATOR WORD
169 SPA CLA /SKIP IF <CR> TERMINATED THE LINE
170 DCA EXITZAP /ELSE CAUSE EXIT LATER
171 TAD I (OUTFILE) /GET OUTPUT FILE DEVICE WORD
172 SNA /SKIP IF FIRST OUTPUT FILE PRESENT
173 JMP TSTMORE /JUMP IF NOT THERE
174 AND [17] /JUST DEVICE BITS
175 DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER
176 TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
177 SNA /SKIP IF PRESENT
178 JMP INERR /JUMP IF NOT
179 AND [17] /JUST DEVICE BITS
180 DCA IDNUMBER /SAVE INPUT DEVICE NUMBER
181 TAD I (INFILE+5) /GET SECOND INPUT FILE DEVICE WORD
182 SZA CLA /SKIP IF ONLY ONE INPUT FILE
183 JMP INERR /ELSE COMPLAIN
184 JMS I (MIFNAME) /MOVE INPUT FILENAME WITH ADJUSTED EXTENSION
185 TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD
186 SNA CLA /SKIP IF NAME PRESENT
187 JMP NONAME /JUMP IF DEVICE ONLY
188 JMS I (MOFNAME) /MOVE OUTPUT FILENAME
189 CDF PRGFLD /BACK TO OUR FIELD
190 CIF USRFLD /GOTO USR FIELD
191 JMS I [USR] /CALL USR ROUTINE
192 RESET /RESET SYSTEM TABLES
193 TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT
194 DCA OHPTR /STORE IN-LINE
195 TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
196 CIF USRFLD /GOTO USR FIELD
197 JMS I [USR] /CALL USR ROUTINE
198 FETCH /FETCH HANDLER
199 OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
200 JMP FERROR /FETCH ERROR
201 TAD OHPTR /GET RETURNED ADDRESS
202 DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS
203 TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT
204 DCA IHPTR /STORE IN-LINE
205 \f TAD IDNUMBER /GET INPUT DEVICE NUMBER
206 CIF USRFLD /GOTO USR FIELD
207 JMS I [USR] /CALL USR ROUTINE
208 FETCH /FETCH HANDLER
209 IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT
210 JMP FERROR /FETCH ERROR
211 TAD IHPTR /GET RETURNED ADDRESS
212 DCA INPUT /STORE AS INPUT HANDLER ADDRESS
213 JMS I (GEIFILE) /GO LOOKUP INPUT FILE
214 TAD (FNAME) /POINT TO
215 DCA ENTAR1 /STORED FILENAME
216 DCA ENTAR2 /CLEAR SECOND ARGUMENT
217 TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
218 CIF USRFLD /GOTO USR FIELD
219 JMS I [USR] /CALL USR ROUTINE
220 ENTER /ENTER TENTATIVE FILENAME
221 ENTAR1, .-. /WILL POINT TO FILENAME
222 ENTAR2, .-. /WILL BE ZERO
223 JMP ENTERR /ENTER ERROR
224 TAD ENTAR1 /GET RETURNED FIRST RECORD
225 DCA OUTRECORD /STORE IT
226 TAD ENTAR2 /GET RETURNED EMPTY LENGTH
227 IAC /ADD 2-1 FOR OS/278 CRAZINESS
228 DCA DANGCNT /STORE AS DANGER COUNT
229 JMS I (ENCODIT) /GO DO THE ACTUAL ENCODING
230 JMP PROCERR /ERROR WHILE ENCODING
231 TAD ODNUMBER /GET OUTPUT DEVICE NUMBER
232 CIF USRFLD /GOTO USR FIELD
233 JMS I [USR] /CALL USR ROUTINE
234 CLOSE /CLOSE OUTPUT FILE
235 FNAME /POINTER TO FILENAME
236 OUTCNT, .-. /WILL BE ACTUAL COUNT
237 JMP CLSERR /CLOSE ERROR
238 EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000
239 JMP I (SBOOT) /EXIT TO MONITOR
240 \f/ OUTPUT FILE ERROR WHILE PROCESSING.
241
242 ENCERRO,TAD [3] /SET INCREMENT
243 SKP /DON'T USE NEXT
244
245 / ERROR WHILE PROCESSING INPUT FILE.
246
247 PROCERR,NL0002 /SET INCREMENT
248 SKP /DON'T USE NEXT
249
250 / ERROR WHILE CLOSING THE OUTPUT FILE.
251
252 CLSERR, NL0001 /SET INCREMENT
253 SKP /DON'T CLEAR IT
254
255 / OUTPUT FILE TOO LARGE ERROR.
256
257 SIZERR, CLA /CLEAN UP
258 TAD [3] /SET INCREMENT
259 SKP /DON'T USE NEXT
260
261 / ENTER ERROR.
262
263 ENTERR, NL0002 /SET INCREMENT
264 SKP /DON'T USE NEXT
265
266 / HANDLER FETCH ERROR.
267
268 FERROR, NL0001 /SET INCREMENT
269
270 / NO OUTPUT FILENAME ERROR.
271
272 NONAME, IAC /SET INCREMENT
273
274 / ILLEGAL OUTPUT FILE NAME ERROR.
275
276 BADNAME,IAC /SET INCREMENT
277
278 / INPUT FILESPEC ERROR.
279
280 INERR, IAC /SET INCREMENT
281
282 / OUTPUT FILESPEC ERROR.
283
284 OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER
285 CDF PRGFLD /ENSURE OUR FIELD
286 CIF USRFLD /GOTO USR FIELD
287 JMS I [USR] /CALL USR ROUTINE
288 USERROR /USER ERROR
289 ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER
290 \f/ COMES HERE TO TEST FOR NULL LINE.
291
292 TSTMORE,TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD
293 SZA CLA /SKIP NO INPUT OR OUTPUT GIVEN
294 JMP OUTERR /ELSE COMPLAIN
295 CDF PRGFLD /BACK TO OUR FIELD
296 JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST
297
298 PAGE
299 \fENCODIT,.-. /ENCODING ROUTINE
300 NL7777 /SETUP INITIALIZE VALUE
301 JMS I [DOBYTE] /INITIALIZE OUTPUT ROUTINE
302 JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME
303 JMS I (PCRLF) /OUTPUT <CR>/<LF> AND CLEAR COLUMN COUNTER
304 DCA CMPCNT /CLEAR COMPRESSION
305 TAD [CHARS] /SETUP THE
306 DCA CHARPTR /OUTPUT POINTER
307 NL7777 /MAKE IT INITIALIZE
308 LOOP, JMS I (GETBYTE) /GET LATEST BYTE
309 JMP ENDCHECK /AREN'T ANY MORE, FINISH THE FILE
310
311 / TEST IF ALREADY WITHIN A DEVELOPING COMPRESSION FIELD.
312
313 TAD CMPCNT /GET COMPRESSION COUNT
314 SNA CLA /SKIP IF COMPRESSION IN PROGRESS
315 JMP NOCOMP /JUMP IF NOT
316
317 / CHECK IF LATEST INPUT BYTE IS ZERO.
318
319 TAD CHAR /GET LATEST
320 SZA CLA /SKIP IF SO
321 JMP ENDCOMPRESS /JUMP IF NOT
322 SETCOMP,ISZ CMPCNT /BUMP COMPRESSION COUNT
323 TAD CMPCNT /GET LATEST COUNT
324 TAD (-116) /COMPARE TO MAXIMUM ALLOWED
325 SNA CLA /SKIP IF NOT
326 JMS I (COMPRESSOUT) /OUTPUT MAXIMUM COMPRESSION AND CANCEL COMPRESSION
327 JMP LOOP /GO GET ANOTHER ONE
328
329 / IF LATEST IS NON-ZERO, THEN COMPLETE EXISTING COMPRESSION FIELD.
330
331 ENDCOMP,NL7777 /-1
332 TAD CMPCNT /COMPARE TO COMPRESSION COUNT
333 SZA CLA /SKIP IF TRIVIAL CASE
334 JMP OUTCOMPRESS /JUMP IF NOT
335
336 / CANCEL TRIVIAL CASE OF ONE BYTE COMPRESSION.
337
338 DCA CMPCNT /CLEAR COMPRESSION MODE
339 DCA CHARS /FIRST BYTE WAS ZERO
340 TAD (CHARS+1) /SETUP OUTPUT POINTER TO
341 DCA CHARPTR /STORE INTO SECOND BYTE
342 JMP BYTEINSERT /CONTINUE THERE
343 \f/ OUTPUT LATEST COMPRESSION AND PROCESS NEW NON-ZERO BYTE.
344
345 OUTCOMP,JMS I (COMPRESSOUT) /OUTPUT COMPRESSION FIELD AND CANCEL COMPRESSION
346
347 / COMES HERE IF NOT WITHIN A COMPRESSION REGION.
348
349 NOCOMP, TAD CHARPTR /GET POINTER
350 TAD (-CHARS) /CHECK IF AT BEGINNING
351 SZA CLA /SKIP IF BUFFER EMPTY
352 JMP BYTEINSERT /JUMP IF NOT
353
354 / IF AT BEGINNING OF THREE BYTES, TEST IF LATEST STARTS A COMPRESSION FIELD.
355
356 TAD CHAR /GET LATEST BYTE
357 SNA CLA /SKIP IF NOT ZERO
358 JMP SETCOMPRESSION /JUMP IF SO
359 BYTEINS,TAD CHAR /GET LATEST BYTE
360 DCA I CHARPTR /STORE IT
361 ISZ CHARPTR /BUMP TO NEXT
362 TAD CHARPTR /GET THE UPDATED POINTER
363 TAD (-CHARS-2-1) /COMPARE TO UPPER LIMIT
364 SNA CLA /SKIP IF LESS THAN THREE PRESENT
365 JMS I (OUT3) /ELSE OUTPUT THE THREE BYTES AND RESET THE BUFFER
366 JMP LOOP /GO GET ANOTHER ONE
367
368 / COMES HERE AT END OF INPUT.
369
370 ENDCHEC,NL7776 /-2
371 TAD CMPCNT /COMPARE TO COMPRESSION COUNT
372 SMA /SKIP IF AT TRIVIAL CASE OR NO COMPRESSION CURRENTLY
373 JMP ENDFCOMPRESS /FINISH WITH A COMPRESSION FIELD
374 IAC /CHECK FURTHER
375 SZA CLA /SKIP IF TRIVIAL COMPRESSION AT END
376 JMP NORMEND /JUMP IF NOT WITHIN COMPRESSION
377
378 / THE TRIVIAL CASE CONVERTS TO AN INCOMPLETE OUTPUT, COMPLETE WITH CORRECTION
379 / BYTES TO INDICATE THE SHORT FIELD.
380
381 DCA CHARS /MOVE ZERO BYTE TO FIRST POSITION
382 NORM1, DCA CHARS+1 /CLEAR SECOND POSITION
383 DCA CHARS+2 /CLEAR THIRD POSITION
384 JMS I (OUT3) /OUTPUT THE THREE BYTES
385 DCA CMPCNT /CLEAR COMPRESSION COUNT
386 JMS I (COMPRESSOUT) /OUTPUT NULL COMPRESSION FIELD TO CANCEL THIRD BYTE
387 /NEXT WILL CANCEL SECOND BYTE
388
389 / COMES HERE IF FILE ENDS ON A COMPRESSION FIELD.
390
391 ENDFCOM,JMS I (COMPRESSOUT) /OUTPUT COMPRESSION FIELD AND CANCEL COMPRESSION
392 JMP CLOSFILE /FINISH IT THERE
393 \f/ COMES HERE IF FILE ENDS IN SOME FORM OF DATA FIELD.
394
395 NORMEND,TAD CHARPTR /GET CHARACTER POINTER
396 TAD (-CHARS-2) /COMPARE TO TWO PRESENT VALUE
397 SNA /SKIP IF NOT THE CASE
398 JMP NORM2 /JUMP IF SO
399 IAC /BUMP TO ONE PRESENT VALUE
400 SNA CLA /SKIP IF NOT THE CASE
401 JMP NORM1 /JUMP IF SO
402 CLOSFIL,TAD COLUMN /GET CURRENT COLUMN COUNTER
403 SZA CLA /SKIP IF AT BEGINNING ALREADY
404 JMS I (PCRLF) /ELSE OUTPUT <CR>/<LF> NOW
405 TAD ("Z&37) /GET <^Z>
406 CLOSLUP,JMS I [DOBYTE] /OUTPUT A BYTE (^Z OR NULL)
407 TAD BUFPTR /GET THE OUTPUT BUFFER POINTER
408 TAD (-OUTBUFFER) /COMPARE TO RESET VALUE
409 SZA CLA /SKIP IF IT MATCHES
410 JMP CLOSLUP /ELSE KEEP GOING
411 ISZ ENCODIT /NO ERRORS
412 JMP I ENCODIT /RETURN
413
414 / COMES HERE IF FILE ENDS WITH ONLY TWO DATA CHARACTERS.
415
416 NORM2, DCA CHARS+2 /CLEAR THIRD CHARACTER
417 JMS I (OUT3) /OUTPUT THE THREE BYTES
418 JMP ENDFCOMPRESS /FINISH IT THERE
419
420 PAGE
421 \f/ GET AN INPUT BYTE ROUTINE.
422
423 GETBYTE,.-. /GET A BYTE ROUTINE
424 SNA CLA /INITIALIZING?
425 JMP I PUTC /NO, GO GET NEXT BYTE
426 TAD INRECORD /GET INPUT FILE STARTING RECORD
427 DCA GETRECORD /STORE IN-LINE
428 GETNEWR,JMS I INPUT /CALL INPUT HANDLER
429 2^100 /READ TWO PAGES
430 PINBUFF,INBUFFER /INTO INPUT BUFFER
431 GETRECO,.-. /WILL BE LATEST INPUT FILE RECORD
432 JMP I (PROCERR) /INPUT READ ERROR, GO COMPLAIN
433 TAD PINBUFFER/(INBUFFER) /SETUP THE
434 DCA INPTR /BUFFER POINTER
435 GETLOOP,DCA THIRD /CLEAR THIRD BYTE NOW
436 JMS PUTONE /OBTAIN AND SEND BACK FIRST BYTE
437 JMS PUTONE /OBTAIN AND SEND BACK SECOND BYTE
438 TAD THIRD /GET THIRD BYTE
439 JMS PUTC /SEND IT BACK
440 TAD INPTR /GET THE POINTER
441 TAD (-2^200-INBUFFER) /COMPARE TO LIMIT
442 SZA CLA /SKIP IF AT END
443 JMP GETLOOP /KEEP GOING
444 ISZ GETRECORD /BUMP TO NEXT RECORD
445 NOP /JUST IN CASE
446 ISZ INLEN /DONE ALL INPUT RECORDS?
447 JMP GETNEWRECORD /NO, KEEP GOING
448
449 / AT END-OF-FILE, SO JUST TAKE IMMEDIATE RETURN.
450
451 JMP I GETBYTE /RETURN TO CALLER
452
453 PUTONE, .-. /SEND BACK A BYTE ROUTINE
454 TAD I INPTR /GET LATEST WORD
455 AND [7400] /JUST THIRD-BYTE NYBBLE
456 CLL RAL /MOVE UP
457 TAD THIRD /GET OLD NYBBLE (IF ANY)
458 RTL;RTL /MOVE UP NYBBLE BITS
459 DCA THIRD /SAVE FOR NEXT TIME
460 TAD I INPTR /GET LATEST WORD AGAIN
461 JMS PUTC /SEND BACK CURRENT BYTE
462 ISZ INPTR /BUMP TO NEXT WORD
463 JMP I PUTONE /RETURN
464
465 PUTC, .-. /SEND BACK LATEST BYTE ROUTINE
466 AND (377) /KEEP ONLY GOOD BITS
467 DCA CHAR /SAVE AS LATEST BYTE
468 ISZ GETBYTE /BUMP PAST <EOF> RETURN
469 JMP I GETBYTE /RETURN TO MAIN CALLER
470 \f/ COMPRESSION FIELD OUTPUT ROUTINE.
471
472 COMPRES,.-. /COMPRESSION OUTPUT ROUTINE
473 CLA /CLEAN UP
474 TAD COLUMN /GET CURRENT COLUMN COUNTER
475 TAD (-WIDTH+2) /COMPARE TO UPPER LIMIT
476 SMA SZA CLA /SKIP IF NOT ABOVE LIMIT
477 JMS PCRLF /ELSE DO <CR>/<LF> FIRST
478 TAD (176) /GET TILDE VALUE
479 JMS I [DOBYTE] /OUTPUT IT
480 TAD CMPCNT /GET COMPRESSION COUNT
481 JMS PDIGIT /OUTPUT IT
482 DCA CMPCNT /CLEAR COMPRESSION
483 JMP I COMPRESSOUT /RETURN
484
485 / DATA FIELD OUTPUT ROUTINE.
486
487 OUT3, .-. /OUTPUT THREE BYTES ROUTINE
488 TAD COLUMN /GET CURRENT COLUMN COUNTER
489 TAD (-WIDTH+4) /COMPARE TO UPPER LIMIT
490 SMA SZA CLA /SKIP IF NOT ABOVE LIMIT
491 JMS PCRLF /ELSE DO <CR>/<LF> FIRST
492 TAD CHARS /GET FIRST BYTE
493 RTR /WANT HIGH SIX BITS FIRST
494 JMS PDIGIT /OUTPUT THEM
495 TAD CHARS /GET IT AGAIN
496 AND [3] /JUST TWO LOWEST BITS
497 CLL RTR;RTR;RAR /MOVE UP
498 TAD CHARS+1 /GET SECOND BYTE
499 RTR;RTR /MOVE DOWN
500 JMS PDIGIT /OUTPUT THEM
501 TAD CHARS+2 /GET THIRD BYTE
502 AND (300) /JUST TWO HIGHEST BITS NEEDED
503 CLL RTL;RTL;RAL /MOVE INTO POSITION
504 TAD CHARS+1 /GET SECOND BYTE
505 RTL /MOVE UP
506 AND [77] /JUST DESIRED BITS
507 JMS PDIGIT /OUTPUT THEM
508 TAD CHARS+2 /GET THIRD BYTE
509 AND [77] /JUST SIX BITS
510 JMS PDIGIT /OUTPUT THEM
511 TAD [CHARS] /RESET THE
512 DCA CHARPTR /OUTPUT POINTER
513 JMP I OUT3 /RETURN
514
515 PDIGIT, .-. /PRINT AS A DIGIT INTO FILE ROUTINE
516 AND [177] /REMOVE JUNK BITS
517 TAD ("0&177) /TURN PASSED VALUE INTO A DIGIT
518 JMS I [DOBYTE] /OUTPUT IT
519 JMP I PDIGIT /RETURN
520 \fPCRLF, .-. /PRINT <CR>/<LF> INTO FILE ROUTINE
521 TAD ("M&37) /GET A <CR>
522 JMS I [DOBYTE] /OUTPUT IT
523 TAD ("J&37) /GET A <LF>
524 JMS I [DOBYTE] /OUTPUT IT
525 DCA COLUMN /CLEAR COLUMN COUNTER
526 JMP I PCRLF /RETURN
527
528 PAGE
529 \fPUTBYTE,.-. /OUTPUT A BYTE ROUTINE
530 SPA /ARE WE INITIALIZING?
531 JMP PUTINITIALIZE /YES
532 AND [177] /JUST IN CASE
533 DCA LATEST /SAVE LATEST CHARACTER
534 TAD LATEST /GET LATEST CHARACTER
535 JMP I PUTNEXT /GO WHERE YOU SHOULD GO
536
537 PUTNEXT,.-. /EXIT ROUTINE
538 ISZ PUTBYTE /BUMP TO GOOD RETURN
539 PUTERRO,CLA CLL /CLEAN UP
540 JMP I PUTBYTE /RETURN TO MAIN CALLER
541
542 PUTINIT,CLA /CLEAN UP
543 TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE
544 DCA PUTRECORD /STORE IN-LINE
545 DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH
546 PUTNEWR,TAD (OUTBUFFER) /SETUP THE
547 DCA BUFPTR /BUFFER POINTER
548 PUTLOOP,JMS PUTNEXT /GET A CHARACTER
549 DCA I BUFPTR /STORE IT
550 TAD BUFPTR /GET POINTER VALUE
551 DCA TEMPTR /SAVE FOR LATER
552 ISZ BUFPTR /BUMP TO NEXT
553 JMS PUTNEXT /GET A CHARACTER
554 DCA I BUFPTR /STORE IT
555 JMS PUTNEXT /GET A CHARACTER
556 RTL;RTL /MOVE UP
557 AND [7400] /ISOLATE HIGH NYBBLE
558 TAD I TEMPTR /ADD ON FIRST BYTE
559 DCA I TEMPTR /STORE COMPOSITE
560 TAD LATEST /GET LATEST CHARACTER
561 RTR;RTR;RAR /MOVE UP AND
562 AND [7400] /ISOLATE LOW NYBBLE
563 TAD I BUFPTR /ADD ON SECOND BYTE
564 DCA I BUFPTR /STORE COMPOSITE
565 ISZ BUFPTR /BUMP TO NEXT
566 TAD BUFPTR /GET LATEST POINTER VALUE
567 TAD (-2^200-OUTBUFF)/COMPARE TO LIMIT
568 SZA CLA /SKIP IF AT END
569 JMP PUTLOOP /KEEP GOING
570 ISZ DANGCNT /TOO MANY RECORDS?
571 SKP /SKIP IF NOT
572 JMP I (SIZERR) /JUMP IF SO
573 JMS I OUTPUT /CALL I/O HANDLER
574 2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER
575 OUTBUFFER /BUFFER ADDRESS
576 PUTRECO,.-. /WILL BE LATEST RECORD NUMBER
577 JMP PUTERROR /OUTPUT ERROR!
578 ISZ I (OUTCNT) /BUMP ACTUAL LENGTH
579 ISZ PUTRECORD /BUMP TO NEXT RECORD
580 JMP PUTNEWRECORD /KEEP GOING
581 \f/ INPUT FILENAME MOVE ROUTINE; USES DEFAULT EXTENSION IF NONE PROVIDED BY USER.
582
583 MIFNAME,.-. /MOVE INPUT FILENAME ROUTINE
584 TAD I (INFILE+1) /GET FIRST INPUT FILENAME WORD
585 DCA IFNAME /STASH IT
586 TAD I (INFILE+2) /GET SECOND INPUT FILENAME WORD
587 DCA IFNAME+1 /STASH IT
588 TAD I (INFILE+3) /GET THIRD INPUT FILENAME WORD
589 DCA IFNAME+2 /STASH IT
590 TAD I [INFILE+4] /GET FOURTH INPUT FILENAME WORD
591 SNA /SKIP IF SOMETHING THERE
592 TAD ("S^100+"V-300) /ELSE USE DEFAULT EXTENSION VALUE
593 DCA IFNAME+3 /STASH IT EITHER WAY
594 JMP I MIFNAME /RETURN
595
596 DOBYTE, .-. /OUTPUT A BYTE ROUTINE
597 JMS PUTBYTE /OUTPUT PASSED VALUE
598 JMP I (ENCERROR) /COULDN'T DO IT
599 ISZ COLUMN /BUMP COLUMN COUNTER
600 JMP I DOBYTE /RETURN
601
602 PAGE
603 \f/ INPUT FILE ROUTINE.
604
605 GEIFILE,.-. /GET INPUT FILE ROUTINE
606 JMS LUKUP /TRY TO LOOKUP THE FILE
607 SKP /SKIP IF IT WORKED
608 JMP TRYNULL /TRY NULL EXTENSION VERSION
609 NULLOK, TAD LARG1 /GET FIRST INPUT RECORD
610 DCA INRECORD /STASH IT
611 TAD LARG2 /GET NEGATED LENGTH
612 DCA INLEN /STASH IT
613 JMP I GEIFILE /RETURN
614
615 / COMES HERE IF LOOKUP FAILED.
616
617 TRYNULL,CDF TBLFLD /GOTO TABLE FIELD
618 TAD I [INFILE+4] /GET ORIGINAL FILENAME'S EXTENSION
619 CDF PRGFLD /BACK TO OUR FIELD
620 SZA CLA /SKIP IF IT WAS NULL ORIGINALLY
621 JMP I (INERR) /ELSE COMPLAIN OF EXPLICIT LOOKUP FAILURE
622 DCA IFNAME+3 /NOW TRY NULL VERSION INSTEAD OF DEFAULT VERSION
623 JMS LUKUP /TRY TO LOOK IT UP AGAIN
624 JMP NULLOK /THAT WORKED!
625 JMP I (INERR) /COMPLAIN OF LOOKUP FAILURE
626
627 LUKUP, .-. /LOW-LEVEL LOOKUP ROUTINE
628 TAD (IFNAME) /GET OUR FILENAME POINTER
629 DCA LARG1 /STORE IN-LINE
630 DCA LARG2 /CLEAR SECOND ARGUMENT
631 TAD IDNUMBER /GET INPUT DEVICE NUMBER
632 CIF USRFLD /GOTO USR FIELD
633 JMS I [USR] /CALL USR ROUTINE
634 LOOKUP /WANT LOOKUP FUNCTION
635 LARG1, .-. /WILL BE POINTER TO OUR FILENAME
636 LARG2, .-. /WILL RETURN FILE LENGTH (HOPEFULLY)
637 ISZ LUKUP /LOOKUP FAILED, SO BUMP RETURN ADDRESS
638 JMP I LUKUP /RETURN EITHER WAY
639 \f/ INPUT FILENAME PRINT ROUTINE.
640
641 PIFNAME,.-. /PRINT INPUT FILENAME ROUTINE
642 TAD IFNAME /GET FIRST PAIR
643 JMS PIF2 /PRINT IT
644 TAD IFNAME+1 /GET SECOND PAIR
645 JMS PIF2 /PRINT IT
646 TAD IFNAME+2 /GET THIRD PAIR
647 JMS PIF2 /PRINT IT
648 TAD (".&177) /GET SEPARATOR
649 JMS PIFOUT /PRINT IT
650 TAD IFNAME+3 /GET FOURTH PAIR
651 JMS PIF2 /PRINT IT
652 JMP I PIFNAME /RETURN
653
654 PIF2, .-. /PRINT A PAIR ROUTINE
655 DCA PIFTEMP /SAVE PASSED PAIR
656 TAD PIFTEMP /GET IT BACK
657 RTR;RTR;RTR /MOVE DOWN
658 JMS PIFOUT /PRINT HIGH-ORDER FIRST
659 TAD PIFTEMP /GET IT AGAIN
660 JMS PIFOUT /PRINT LOW-ORDER
661 JMP I PIF2 /RETURN
662
663 PIFOUT, .-. /FILENAME CHARACTER OUTPUT ROUTINE
664 AND [77] /JUST SIXBIT
665 SNA /SKIP IF SOMETHING THERE
666 JMP I PIFOUT /ELSE IGNORE IT
667 TAD [40] /INVERT IT
668 AND [77] /REMOVE EXCESS
669 TAD [40] /INVERT IT AGAIN
670 JMS I [DOBYTE] /OUTPUT IT
671 JMP I PIFOUT /RETURN
672
673 MOFNAME,.-. /MOVE OUTPUT FILENAME ROUTINE
674 TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD
675 JMS CHKNAME /CHECK IF LEGAL
676 DCA FNAME /STASH IT
677 TAD I (OUTFILE+2) /GET SECOND OUTPUT FILENAME WORD
678 JMS CHKNAME /CHECK IF LEGAL
679 DCA FNAME+1 /STASH IT
680 TAD I (OUTFILE+3) /GET THIRD OUTPUT FILENAME WORD
681 JMS CHKNAME /CHECK IF LEGAL
682 DCA FNAME+2 /STASH IT
683 TAD I (OUTFILE+4) /GET FOURTH OUTPUT FILENAME WORD
684 JMS CHKNAME /CHECK IF LEGAL
685 DCA FNAME+3 /STASH IT
686 JMP I MOFNAME /RETURN
687 \f/ OUTPUT NAME CHECK ROUTINE.
688
689 CHKNAME,.-. /OUTPUT NAME CHECK ROUTINE
690 DCA LUKUP /SAVE PASSED VALUE
691 TAD LUKUP /GET IT BACK
692 RTR;RTR;RTR /MOVE DOWN
693 JMS CHKIT /CHECK HIGH-ORDER AND GET IT BACK
694 JMS CHKIT /CHECK LOW-ORDER AND GET IT BACK
695 JMP I CHKNAME /RETURN
696
697 CHKIT, .-. /ONE CHARACTER CHECK ROUTINE
698 AND [77] /JUST SIX BITS
699 TAD (-"?!200) /COMPARE TO "?"
700 SZA /SKIP IF ALREADY BAD
701 TAD (-"*+"?) /ELSE COMPARE TO "*"
702 SNA CLA /SKIP IF NEITHER BAD CASE
703 JMP I (BADNAME) /COMPLAIN OF WILD CHARACTER
704 TAD LUKUP /GET THE PAIR BACK FOR NEXT TIME
705 JMP I CHKIT /RETURN
706
707 PAGE
708 \f $ /THAT'S ALL FOLK!
My complete PDP-8 universe