Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | / OS/8 ENCODING PROGRAM |
2 | ||
3 | / LAST EDIT: 08-JUL-1992 22:00:00 CJL | |
4 | ||
5 | / MUST BE ASSEMBLED WITH '/F' SWITCH SET. | |
6 | ||
7 | / PROGRAM TO ENCODE OS/8 FILES INTO "PRINTABLE" ASCII FORMAT ("ENCODE"). | |
8 | ||
9 | / DISTRIBUTED BY CUCCA AS "K12ENC.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE. | |
10 | ||
11 | / WRITTEN BY: | |
12 | ||
13 | / CHARLES LASNER (CJL) | |
14 | / CLA SYSTEMS | |
15 | / 72-55 METROPOLITAN AVENUE | |
16 | / MIDDLE VILLAGE, NEW YORK 11379-2107 | |
17 | / (718) 894-6499 | |
18 | ||
19 | / USAGE: | |
20 | ||
21 | / .RUN DEV ENCODE INVOKE PROGRAM | |
22 | / *OUTPUT<INPUT PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <CR>) | |
23 | / *OUTPUT<DEV:=NNNN/I **** SPECIAL IMAGE TRANSFER MODE **** INPUT IS RECORD | |
24 | / 0000-[NNNN-1] ON DEVICE DEV:. THE =NNNN VALUE MUST BE | |
25 | / STATED PRECISELY TO TRANSFER THE REQUISITE AMOUNT OF | |
26 | / THE DEVICE AS REQUIRED. THE VALUE IS GENERALLY THE | |
27 | / TOTAL LENGTH OF THE DEVICE, BUT COULD BE LESS AS | |
28 | / NECESSARY; LARGER VALUES WILL GENERALLY FAIL. THIS | |
29 | / MODE SHOULD ONLY BE USED TO EFFECT TRANSFER OF | |
30 | / COMPLETE DEVICE IMAGES WHERE THE NORMAL OS/8 FILE | |
31 | / STRUCTURE IS UNSUITABLE. IN THIS MODE, THE OS/8 FILE | |
32 | / (POSSIBLY PRESENT) ON THE DEVICE IS IGNORED. **** | |
33 | / NOTE **** THIS METHOD VIOLATES ALL OS/8 DEVICE | |
34 | / STRUCTURE AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE | |
35 | / IMAGES ONLY; USE WITH CARE! | |
36 | / *OUTPUT<DEV:=NNNN/I/1 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR | |
37 | / IMAGE MODE EXCEPT ONLY THE FIRST HALF OF THE DATA IS | |
38 | / USED. THE DECODER MUST BE GIVEN THE EQUIVALENT | |
39 | / PARAMETERS TO TRANSFER THE FIRST HALF. | |
40 | / *OUTPUT<DEV:=NNNN/I/2 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR | |
41 | / IMAGE MODE EXCEPT ONLY THE SECOND HALF OF THE DATA IS | |
42 | / USED. NOTE THAT THERE MUST BE TWO FILES CREATED, ONE | |
43 | / USING /I/1 AND THE OTHER USING /I/2 TO COMPLETELY | |
44 | / TRANSFER A DEVICE IMAGE UNLESS /I IS USED ALONE! | |
45 | / *OUTPUT<INPUT$ PASS ONE INPUT AND ONE OUTPUT FILE ONLY (WITH <ESC>) | |
46 | / . PROGRAM EXITS NORMALLY | |
47 | ||
48 | / INPUT FILE ASSUMES .SV EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION. IF | |
49 | / IMAGE MODE IS USED, THERE IS NO INPUT FILE SPECIFICATION; ONLY A DEVICE IS | |
50 | / GIVEN ALONG WITH A LENGTH AND THE MANDATORY /I SWITCH. | |
51 | ||
52 | / PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE | |
53 | / KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC> | |
54 | / CHARACTER. | |
55 | \f/ THIS PROGRAM SUPPORTS A SUBSET OF THE ASCII FILE ENCODING SCHEME DEVELOPED BY | |
56 | / CHARLES LASNER AND FRANK DA CRUZ. THE SCHEME USED IS FIVE-BIT ENCODING WITH | |
57 | / COMPRESSION, (AS OPPOSED TO SIX-BIT WITHOUT COMPRESSION AS USED IN PRIOR | |
58 | / VERSIONS). | |
59 | ||
60 | / RESTRICTIONS: | |
61 | ||
62 | / A) NO SUPPORT FOR MULTIPLE DECODABLE FILES PER ENCODED FILE. | |
63 | ||
64 | / B) CREATES ENCODED PDP-8 60-BIT CHECKSUM AT END OF FILE. | |
65 | ||
66 | / C) CUSTOMIZED (REMARK) COMMANDS MUST BE SEPARATELY ADDED BY THE USER. | |
67 | ||
68 | / D) THE FILENAME IN THE (FILE ) AND (END ) COMMANDS WILL BE IDENTICAL TO | |
69 | / THE ACTUAL INVOKED INPUT FILE. THE USER MUST SEPARATELY MODIFY THESE | |
70 | / COMMANDS WHEN EXPORTING THE ENCODED FILE TO A SYSTEM WITH DIFFERENT | |
71 | / NAMING CONVENTIONS. | |
72 | ||
73 | / ERROR MESSAGES. | |
74 | ||
75 | / ERROR MESSAGES ARE ONE OF TWO VARIETIES: COMMAND DECODER MESSAGES AND USER | |
76 | / (PROGRAM-SIGNALLED) MESSAGES. | |
77 | ||
78 | / COMMAND DECODER MESSAGES ARE NON-FATAL AND MERELY REQUIRE RETYPING THE | |
79 | / COMMAND. ATTEMPTING TO USE MORE THAN ONE OUTPUT FILE WILL YIELD THE COMMAND | |
80 | / DECODER MESSAGE "TOO MANY FILES" AND CAUSE A REPEAT OF THE COMMAND DECODER | |
81 | / PROMPT REQUIRING USER INPUT. THE USER IS DIRECTED TO OTHER DOCUMENTATION OF | |
82 | / THE "SPECIAL" MODE OF THE COMMAND DECODER, AS THAT IS THE ONLY MODE USED BY | |
83 | / THIS UTILITY PROGRAM. | |
84 | ||
85 | / ANY USER MESSAGE PRINTED IS A FATAL ERROR MESSAGE CAUSED BY A PROBLEM BEYOND | |
86 | / THE SCOPE OF THE COMMAND DECODER. ALL USER MESSAGES ARE THE STANDARD OS/8 | |
87 | / "USER" ERROR MESSAGES OF THE FORM: "USER ERROR X AT AAAAA", WHERE X IS THE | |
88 | / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED. | |
89 | / THE FOLLOWING USER ERRORS ARE DEFINED: | |
90 | ||
91 | / ERROR NUMBER PROBABLE CAUSE | |
92 | ||
93 | / 0 NO OUTPUT FILE. | |
94 | ||
95 | / 1 INPUT FILE ERROR (CAN'T FIND INPUT FILE) OR NO INPUT | |
96 | / FILE SPECIFIED OR TOO MANY INPUT FILES SPECIFIED. | |
97 | / 2 ILLEGAL OUTPUT FILE NAME (WILD CARDS NOT ALLOWED). | |
98 | ||
99 | / 3 NO OUTPUT FILE NAME (DEVICE ONLY IS NOT ALLOWED). | |
100 | ||
101 | / 4 ERROR WHILE FETCHING FILE HANDLER. | |
102 | ||
103 | / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE. | |
104 | ||
105 | / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE. | |
106 | ||
107 | / 7 ERROR WHILE CLOSING THE OUTPUT FILE. | |
108 | ||
109 | / 8 I/O ERROR WHILE ENCODING FILE DATA. | |
110 | \f/ ASSEMBLY INSTRUCTIONS. | |
111 | ||
112 | / IT IS ASSUMED THE SOURCE FILE K12ENC.PAL HAS BEEN MOVED AND RENAMED TO | |
113 | / DSK:ENCODE.PA. | |
114 | ||
115 | / .PAL ENCODE<ENCODE/E/F ASSEMBLE SOURCE PROGRAM | |
116 | / .LOAD ENCODE LOAD THE BINARY FILE | |
117 | / .SAVE DEV ENCODE=2001 SAVE THE CORE-IMAGE FILE | |
118 | \f/ DEFINITIONS. | |
119 | ||
120 | AIWCNT= 1404 /ADDITIONAL INFORMATION WORDS COUNT HERE | |
121 | AIWXR= 0017 /POINTER TO ADDITIONAL INFORMATION WORDS | |
122 | CLOSE= 4 /CLOSE OUTPUT FILE | |
123 | DATEXT= 7777 /DATE EXTENSION HERE | |
124 | DATWRD= 7666 /OS/8 DATE WORD | |
125 | DECODE= 5 /CALL COMMAND DECODER | |
126 | ENTER= 3 /ENTER TENTATIVE FILE | |
127 | EQUWRD= 7646 /EQUALS PARAMETER HERE IN TABLE FIELD | |
128 | FETCH= 1 /FETCH HANDLER | |
129 | IHNDBUF=7200 /INPUT HANDLER BUFFER | |
130 | INBUFFE=6200 /INPUT BUFFER | |
131 | INFILE= 7605 /INPUT FILE INFORMATION HERE | |
132 | LOOKUP= 2 /LOOKUP INPUT FILE | |
133 | NL0001= CLA IAC /LOAD AC WITH 0001 | |
134 | NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 | |
135 | NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 | |
136 | NL7777= CLA CMA /LOAD AC WITH 7777 | |
137 | OHNDBUF=6600 /OUTPUT HANDLER BUFFER | |
138 | OUTBUFF=5600 /OUTPUT BUFFER | |
139 | OUTFILE=7600 /OUTPUT FILE INFORMATION HERE | |
140 | PRGFLD= 00 /PROGRAM FIELD | |
141 | RESET= 13 /RESET SYSTEM TABLES | |
142 | REVISIO=1 /PROGRAM REVISION | |
143 | SBOOT= 7600 /MONITOR EXIT | |
144 | SWAL= 7643 /A-/L SWITCHES HERE IN TABLE FIELD | |
145 | SWY9= 7645 /Y-/9 SWITCHES HERE IN TABLE FIELD | |
146 | TBLFLD= 10 /COMMAND DECODER TABLE FIELD | |
147 | TERMWRD=7642 /TERMINATOR WORD | |
148 | USERROR=7 /USER SIGNALLED ERROR | |
149 | USR= 0200 /USR ENTRY POINT | |
150 | USRENT= 7700 /USR ENTRY POINT WHEN NON-RESIDENT | |
151 | USRFLD= 10 /USR FIELD | |
152 | USRIN= 10 /LOCK USR IN CORE | |
153 | VERSION=2 /PROGRAM VERSION | |
154 | WIDTH= 107-2 /69 DATA CHARACTERS PER LINE (TOTAL 71) | |
155 | WRITE= 4000 /I/O WRITE BIT | |
156 | \f *0 /START AT THE BEGINNING | |
157 | ||
158 | *10 /DEFINE AUTO-INDEX AREA | |
159 | ||
160 | XR1, .-. /AUTO-INDEX NUMBER 1 | |
161 | XR2, .-. /AUTO-INDEX NUMBER 2 | |
162 | ||
163 | *20 /GET PAST AUTO-INDEX AREA | |
164 | ||
165 | BUFPTR, .-. /OUTPUT BUFFER POINTER | |
166 | CCNT, .-. /CHECKSUM COUNTER | |
167 | CHKFLG, .-. /CHECKSUMMING ALLOWED FLAG | |
168 | CHKSUM, ZBLOCK 5 /CHECKSUM | |
169 | CMPCNT, .-. /MATCH COUNT FOR COMPRESSION | |
170 | DANGCNT,.-. /DANGER COUNT | |
171 | FDATE, .-. /FILE DATE | |
172 | FILLVAL,.-. /FILL VALUE FOR SPECIAL OUTPUT CHARACTERS | |
173 | IDNUMBE,.-. /INPUT DEVICE NUMBER | |
174 | IFNAME, ZBLOCK 4 /INPUT FILENAME | |
175 | IMSW, .-. /IMAGE-MODE SWITCH | |
176 | INLEN, .-. /INPUT FILE LENGTH | |
177 | INPTR, .-. /INPUT BUFFER POINTER | |
178 | INPUT, .-. /INPUT HANDLER POINTER | |
179 | INRECOR,.-. /INPUT RECORD | |
180 | FNAME, ZBLOCK 4 /OUTPUT FILENAME | |
181 | LATEST, .-. /LATEST OUTPUT CHARACTER | |
182 | OBOUND, .-. /OUTPUT BOUNDARY COUNTER | |
183 | OCTCNT, .-. /OCTAL OUTPUT ROUTINE COUNTER | |
184 | OCTEMP, .-. /OCTAL OUTPUT ROUTINE TEMPORARY | |
185 | ODNUMBE,.-. /OUTPUT DEVICE NUMBER | |
186 | OUTPUT, .-. /OUTPUT HANDLER POINTER | |
187 | OUTRECO,.-. /OUTPUT RECORD | |
188 | PRTEMP, .-. /DATE OUTPUT TEMPORARY | |
189 | PUTEMP, .-. /OUTPUT TEMPORARY | |
190 | PUTLATE,.-. /LATEST 5-BIT CHARACTER | |
191 | PUTPREV,.-. /PREVIOUS OUTPUT TEMPORARY | |
192 | QUO, .-. /DIVIDE QUOTIENT | |
193 | REM, .-. /DIVIDE REMAINDER | |
194 | SCRCASE,.-. /CURRENT MESSAGE CASE | |
195 | SCRCHAR,.-. /LATEST MESSAGE CHARACTER | |
196 | SCRPTR, .-. /MESSAGE POINTER | |
197 | TDATE, .-. /TODAY'S DATE | |
198 | TEMP, .-. /TEMPORARY | |
199 | TEMPTR, .-. /TEMPORARY OUTPUT POINTER | |
200 | WIDCNT, .-. /LINE WIDTH COUNTER | |
201 | \f PAGE /START AT THE USUAL PLACE | |
202 | ||
203 | BEGIN, NOP /IN CASE WE'RE CHAINED TO | |
204 | CLA /CLEAN UP | |
205 | START, CIF USRFLD /GOTO USR FIELD | |
206 | JMS I (USRENTRY) /CALL USR ROUTINE | |
207 | USRIN /GET IT LOCKED IN | |
208 | CIF USRFLD /GOTO USR FIELD | |
209 | JMS I [USR] /CALL USR ROUTINE | |
210 | DECODE /WANT COMMAND DECODER | |
211 | "*^100 /USING SPECIAL MODE | |
212 | CDF TBLFLD /GOTO TABLE FIELD | |
213 | TAD I (TERMWRD) /GET TERMINATOR WORD | |
214 | SPA CLA /SKIP IF <CR> TERMINATED THE LINE | |
215 | DCA EXITZAP /ELSE CAUSE EXIT LATER | |
216 | DCA IMSW /CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH | |
217 | TAD I (OUTFILE) /GET OUTPUT FILE DEVICE WORD | |
218 | SNA /SKIP IF OUTPUT FILE PRESENT | |
219 | JMP TSTMORE /JUMP IF NOT THERE | |
220 | AND [17] /JUST DEVICE BITS | |
221 | DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER | |
222 | TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD | |
223 | SNA /SKIP IF PRESENT | |
224 | JMP INERR /JUMP IF NOT | |
225 | AND [17] /JUST DEVICE BITS | |
226 | DCA IDNUMBER /SAVE INPUT DEVICE NUMBER | |
227 | TAD I (INFILE+5) /GET SECOND INPUT FILE DEVICE WORD | |
228 | SZA CLA /SKIP IF ONLY ONE INPUT FILE | |
229 | JMP INERR /ELSE COMPLAIN | |
230 | JMS I (MIFNAME) /MOVE INPUT FILENAME WITH ADJUSTED EXTENSION | |
231 | TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD | |
232 | SNA CLA /SKIP IF NAME PRESENT | |
233 | JMP NONAMERROR /JUMP IF DEVICE ONLY | |
234 | JMS I (MOFNAME) /MOVE OUTPUT FILENAME | |
235 | CDF PRGFLD /BACK TO OUR FIELD | |
236 | CIF USRFLD /GOTO USR FIELD | |
237 | JMS I [USR] /CALL USR ROUTINE | |
238 | RESET /RESET SYSTEM TABLES | |
239 | TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT | |
240 | DCA OHPTR /STORE IN-LINE | |
241 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
242 | CIF USRFLD /GOTO USR FIELD | |
243 | JMS I [USR] /CALL USR ROUTINE | |
244 | FETCH /FETCH HANDLER | |
245 | OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT | |
246 | JMP FERROR /FETCH ERROR | |
247 | TAD OHPTR /GET RETURNED ADDRESS | |
248 | DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS | |
249 | TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT | |
250 | DCA IHPTR /STORE IN-LINE | |
251 | \f TAD IDNUMBER /GET INPUT DEVICE NUMBER | |
252 | CIF USRFLD /GOTO USR FIELD | |
253 | JMS I [USR] /CALL USR ROUTINE | |
254 | FETCH /FETCH HANDLER | |
255 | IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT | |
256 | JMP FERROR /FETCH ERROR | |
257 | TAD IHPTR /GET RETURNED ADDRESS | |
258 | DCA INPUT /STORE AS INPUT HANDLER ADDRESS | |
259 | TAD IMSW /GET IMAGE-MODE SWITCH | |
260 | SNA CLA /SKIP IF IMAGE MODE SET | |
261 | JMS I (GEIFILE) /GO LOOKUP INPUT FILE | |
262 | TAD (FNAME) /POINT TO | |
263 | DCA ENTAR1 /STORED FILENAME | |
264 | DCA ENTAR2 /CLEAR SECOND ARGUMENT | |
265 | JMS I (INDATE) /GET INPUT FILE'S DATE | |
266 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
267 | CIF USRFLD /GOTO USR FIELD | |
268 | JMS I [USR] /CALL USR ROUTINE | |
269 | ENTER /ENTER TENTATIVE FILENAME | |
270 | ENTAR1, .-. /WILL POINT TO FILENAME | |
271 | ENTAR2, .-. /WILL BE ZERO | |
272 | JMP ENTERR /ENTER ERROR | |
273 | TAD ENTAR1 /GET RETURNED FIRST RECORD | |
274 | DCA OUTRECORD /STORE IT | |
275 | TAD ENTAR2 /GET RETURNED EMPTY LENGTH | |
276 | IAC /ADD 2-1 FOR OS/278 CRAZINESS | |
277 | DCA DANGCNT /STORE AS DANGER COUNT | |
278 | JMS I (CLRCHKSUM) /CLEAR THE CHECKSUM | |
279 | JMS I (ENCODIT) /GO DO THE ACTUAL ENCODING | |
280 | JMP PROCERR /ERROR WHILE ENCODING | |
281 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
282 | CIF USRFLD /GOTO USR FIELD | |
283 | JMS I [USR] /CALL USR ROUTINE | |
284 | CLOSE /CLOSE OUTPUT FILE | |
285 | FNAME /POINTER TO FILENAME | |
286 | OUTCNT, .-. /WILL BE ACTUAL COUNT | |
287 | JMP CLSERR /CLOSE ERROR | |
288 | EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000 | |
289 | JMP I (SBOOT) /EXIT TO MONITOR | |
290 | \f/ ERROR WHILE PROCESSING INPUT FILE. | |
291 | ||
292 | PROCERR,NL0002 /SET INCREMENT | |
293 | SKP /DON'T USE NEXT | |
294 | ||
295 | / ERROR WHILE CLOSING THE OUTPUT FILE. | |
296 | ||
297 | CLSERR, NL0001 /SET INCREMENT | |
298 | SKP /DON'T CLEAR IT | |
299 | ||
300 | / OUTPUT FILE TOO LARGE ERROR. | |
301 | ||
302 | SIZERR, CLA /CLEAN UP | |
303 | TAD [3] /SET INCREMENT | |
304 | SKP /DON'T USE NEXT | |
305 | ||
306 | / ENTER ERROR. | |
307 | ||
308 | ENTERR, NL0002 /SET INCREMENT | |
309 | SKP /DON'T USE NEXT | |
310 | ||
311 | / HANDLER FETCH ERROR. | |
312 | ||
313 | FERROR, NL0001 /SET INCREMENT | |
314 | ||
315 | / NO OUTPUT FILENAME ERROR. | |
316 | ||
317 | NONAMER,IAC /SET INCREMENT | |
318 | ||
319 | / ILLEGAL OUTPUT FILE NAME ERROR. | |
320 | ||
321 | BADNAME,IAC /SET INCREMENT | |
322 | ||
323 | / INPUT FILESPEC ERROR. | |
324 | ||
325 | INERR, IAC /SET INCREMENT | |
326 | ||
327 | / OUTPUT FILESPEC ERROR. | |
328 | ||
329 | OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER | |
330 | CDF PRGFLD /ENSURE OUR FIELD | |
331 | CIF USRFLD /GOTO USR FIELD | |
332 | JMS I [USR] /CALL USR ROUTINE | |
333 | USERROR /USER ERROR | |
334 | ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER | |
335 | ||
336 | / COMES HERE TO TEST FOR NULL LINE. | |
337 | ||
338 | TSTMORE,TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD | |
339 | SZA CLA /SKIP NO INPUT OR OUTPUT GIVEN | |
340 | JMP OUTERR /ELSE COMPLAIN | |
341 | CDF PRGFLD /BACK TO OUR FIELD | |
342 | JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST | |
343 | \f PAGE | |
344 | \fENCODIT,.-. /ENCODING ROUTINE | |
345 | TAD INRECORD /GET INPUT FILE STARTING RECORD | |
346 | DCA INREC /STORE IN-LINE | |
347 | NL7777 /SETUP INITIALIZE VALUE | |
348 | JMS I [DOBYTE] /INITIALIZE OUTPUT ROUTINE | |
349 | JMS I (TDMESSAGE) /OUTPUT TODAY'S DATE MESSAGE | |
350 | JMS I (FDMESSAGE) /OUTPUT FILE DATE MESSAGE | |
351 | JMS I [SCRIBE] /OUTPUT THE | |
352 | FILMSG /(FILE MESSAGE | |
353 | JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME | |
354 | JMS I [SCRIBE] /OUTPUT THE | |
355 | EMSG /LINE ENDING | |
356 | TAD [-WIDTH] /SETUP THE | |
357 | DCA WIDCNT /LINE WIDTH COUNTER | |
358 | JMS I (OUTSETUP) /SETUP PACKING ROUTINE AND CLEAR FILL | |
359 | TAD [-5] /INITIALIZE | |
360 | DCA OBOUND /BOUNDARY COUNTER | |
361 | ENCLOOP,JMS I INPUT /CALL INPUT HANDLER | |
362 | 2^100 /READ TWO PAGES | |
363 | PINBUFF,INBUFFER /INTO INPUT BUFFER | |
364 | INREC, .-. /WILL BE LATEST INPUT FILE RECORD | |
365 | ENCERRO,JMP I ENCODIT /INPUT ERROR, TAKE IMMEDIATE RETURN | |
366 | ISZ INREC /BUMP TO NEXT RECORD | |
367 | NOP /JUST IN CASE | |
368 | TAD PINBUFFER/(INBUFFER) /SETUP THE | |
369 | DCA INPTR /BUFFER POINTER | |
370 | LOOP, JMS I (CHKBND) /CHECK IF ON A GOOD BOUNDARY | |
371 | JMP NOCOMPRESSION /COMPRESS IS NOT ALLOWED AT THIS TIME | |
372 | TAD INPTR /GET CURRENT POINTER | |
373 | DCA XR1 /STASH FOR SEARCH | |
374 | DCA CMPCNT /CLEAR MATCH COUNT | |
375 | CMPLUP, TAD XR1 /GET INDEX VALUE | |
376 | TAD (-2^200-INBUFFER+1) /COMPARE TO LIMIT | |
377 | SNA CLA /SKIP IF NOT AT END OF BUFFER | |
378 | JMP CMPEND /JUMP IF AT END OF BUFFER | |
379 | TAD I XR1 /GET A CANDIDATE WORD | |
380 | CIA /INVERT FOR TEST | |
381 | TAD I INPTR /COMPARE TO CURRENT TEST VALUE | |
382 | SZA CLA /SKIP IF IT MATCHES | |
383 | JMP CMPEND /JUMP IF THIS IS NOT A REPEAT | |
384 | ISZ CMPCNT /BUMP MATCH COUNT | |
385 | JMP CMPLUP /TRY TO FIND MORE | |
386 | \f/ COMES HERE POSSIBLY WITH SOME COMPRESSED VALUES COUNTED. | |
387 | ||
388 | CMPEND, NL7776 /-2 | |
389 | TAD CMPCNT /DID WE FIND ENOUGH MATCHES? | |
390 | SPA CLA /SKIP IF SO | |
391 | JMP NOCOMPRESSION /FORGET IT | |
392 | TAD ("X-"0) /SETUP COMPRESSION INDICATOR | |
393 | JMS I (OUTSETUP) /SETUP SPECIAL MODE | |
394 | JMS I (PUT5) /OUTPUT "X" | |
395 | JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE | |
396 | TAD I INPTR /GET THE VALUE | |
397 | JMS I [PUTIT] /OUTPUT IT | |
398 | ISZ CMPCNT /ACCOUNT FOR ORIGINAL | |
399 | TAD CMPCNT /GET COMPRESSION COUNT | |
400 | CLL RTL;RTL /*16 | |
401 | JMS I [PUTIT] /OUTPUT BITS[0-7] ONLY | |
402 | JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE AGAIN | |
403 | TAD INPTR /GET INPUT POINTER | |
404 | TAD CMPCNT /UPDATE PAST ALL COMPRESSED VALUES | |
405 | DCA INPTR /STORE BACK | |
406 | JMP TEST /CONTINUE THERE | |
407 | ||
408 | / COMES HERE IF NO COMPRESSION FOUND (OR NOT ALLOWED). | |
409 | ||
410 | NOCOMPR,TAD I INPTR /GET LATEST VALUE | |
411 | JMS I [PUTIT] /OUTPUT IT | |
412 | ISZ INPTR /BUMP TO NEXT | |
413 | ISZ OBOUND /BUMP TO NEXT WORD | |
414 | JMP TEST /KEEP GOING | |
415 | TAD [-5] /RESET THE | |
416 | DCA OBOUND /BOUNDARY COUNTER | |
417 | TEST, TAD INPTR /GET INPUT POINTER | |
418 | TAD (-2^200-INBUFFER) /COMPARE TO UPPER LIMIT | |
419 | SZA CLA /SKIP IF AT END OF BUFFER | |
420 | JMP LOOP /ELSE JUST KEEP GOING | |
421 | ISZ INLEN /DONE ALL INPUT RECORDS? | |
422 | JMP ENCLOOP /NO, KEEP GOING | |
423 | ||
424 | / WE MUST FINISH THE LAST [5 WORDS => 12 BYTES] SEQUENCE. | |
425 | ||
426 | ENDLUP, JMS I (CHKBND) /AT A GOOD BOUNDARY? | |
427 | SKP /SKIP IF NOT | |
428 | JMP ENDONE /JUMP IF SO | |
429 | JMS I [PUTIT] /OUTPUT SOME WASTE BYTES | |
430 | ISZ OBOUND /AT A GOOD BOUNDARY NOW? | |
431 | JMP ENDLUP /NO, TRY AGAIN | |
432 | \fENDONE, TAD ("Z-"0) /GET END INDICATOR | |
433 | JMS I (OUTSETUP) /SETUP SPECIAL MODE | |
434 | JMS I (PUT5) /OUTPUT A "Z" | |
435 | JMS I (INVCHKSUM) /INVERT THE CHECKSUM | |
436 | JMS I (OUTSETUP) /SETUP NORMAL NUMERICAL MODE | |
437 | JMS I (CHKOUT) /OUTPUT THE CHECKSUM | |
438 | JMS I [SCRIBE] /OUTPUT THE | |
439 | ENDMSG /END MESSAGE | |
440 | JMS I (PIFNAME) /OUTPUT THE INPUT FILENAME | |
441 | JMS I [SCRIBE] /OUTPUT THE | |
442 | EMSG /LINE ENDING | |
443 | JMS I [SCRIBE] /OUTPUT THE | |
444 | EOFMSG /FINAL MESSAGE | |
445 | TAD ("Z&37) /GET <^Z> | |
446 | CLOSLUP,JMS I [DOBYTE] /OUTPUT A BYTE (^Z OR NULL) | |
447 | TAD BUFPTR /GET THE OUTPUT BUFFER POINTER | |
448 | TAD (-OUTBUFFER) /COMPARE TO RESET VALUE | |
449 | SZA CLA /SKIP IF IT MATCHES | |
450 | JMP CLOSLUP /ELSE KEEP GOING | |
451 | ISZ ENCODIT /NO ERRORS | |
452 | JMP I ENCODIT /RETURN | |
453 | ||
454 | PAGE | |
455 | \fPUTIT, .-. /WORD OUTPUT ROUTINE | |
456 | DCA PUTEMP /SAVE PASSED VALUE | |
457 | JMS I (CALCHKSUM) /UPDATE CHECKSUM | |
458 | JMP I PUTNXT /GO WHERE YOU SHOULD GO | |
459 | ||
460 | PUTNXT, PUT0 /OUTPUT EXIT ROUTINE | |
461 | TAD PUTEMP /GET LATEST VALUE | |
462 | DCA PUTPREV /SAVE FOR NEXT TIME | |
463 | JMP I PUTIT /RETURN TO MAIL CALLER | |
464 | ||
465 | PUTLUP, JMS PUTNXT /GET ANOTHER WORD | |
466 | PUT0, TAD PUTEMP /GET WORD[0] | |
467 | RTL;RTL;RTL /BITS[0-4] => AC[7-11] | |
468 | JMS PUT5 /OUTPUT A CHARACTER | |
469 | TAD PUTEMP /GET WORD[0] AGAIN | |
470 | RTR /BITS[5-9] => AC[7-11] | |
471 | JMS PUT5 /OUTPUT A CHARACTER | |
472 | JMS PUTNXT /GET ANOTHER WORD | |
473 | PUT1, TAD PUTPREV /GET WORD[0] | |
474 | AND [3] /ISOLATE BITS[10-11] | |
475 | CLL RTL;RAL /BITS[10-11] => AC[7-8] | |
476 | DCA PUTPREV /SAVE FOR NOW | |
477 | TAD PUTEMP /GET WORD[1] | |
478 | RTL;RTL /BITS[0-2] => AC[9-11] | |
479 | AND [7] /ISOLATE DESIRED BITS | |
480 | TAD PUTPREV /ADD ON WORD[0] BITS IN AC[7-8] | |
481 | JMS PUT5 /OUTPUT A CHARACTER | |
482 | TAD PUTEMP /GET WORD[1] | |
483 | RTR;RTR /BITS[3-7] => AC[7-11] | |
484 | JMS PUT5 /OUTPUT A CHARACTER | |
485 | JMS PUTNXT /GET ANOTHER WORD | |
486 | PUT2, TAD PUTEMP /GET WORD[2] | |
487 | RAL /BIT[0] => L | |
488 | CLA /CLEAN UP | |
489 | TAD PUTPREV /GET WORD[1] | |
490 | RAL /BITS[8-11],L => AC[7-11] | |
491 | JMS PUT5 /OUTPUT A CHARACTER | |
492 | TAD PUTEMP /GET WORD[2] | |
493 | RTR;RTR;RTR /BITS[1-5] => AC[7-11] | |
494 | JMS PUT5 /OUTPUT A CHARACTER | |
495 | TAD PUTEMP /GET WORD[2] | |
496 | RAR /BITS[6-10] => AC[7-11] | |
497 | JMS PUT5 /OUTPUT A CHARACTER | |
498 | JMS PUTNXT /GET ANOTHER WORD | |
499 | \fPUT3, TAD PUTPREV /GET WORD[2] | |
500 | RAR /BIT[11] => L | |
501 | CLA /CLEAN UP | |
502 | TAD PUTEMP /GET WORD[3] | |
503 | RTL;RTL;RAL /L, BITS[0-3] => AC[7-11] | |
504 | JMS PUT5 /OUTPUT A CHARACTER | |
505 | TAD PUTEMP /GET WORD[3] | |
506 | RTR;RAR /BITS[4-8] => AC[7-11] | |
507 | JMS PUT5 /OUTPUT A CHARACTER | |
508 | JMS PUTNXT /GET ANOTHER WORD | |
509 | PUT4, TAD PUTPREV /GET WORD[3] | |
510 | AND [7] /ISOLATE BITS[9-11] | |
511 | CLL RTL /BITS[9-11] => AC[7-9] | |
512 | DCA PUTPREV /SAVE FOR NOW | |
513 | TAD PUTEMP /GET WORD[4] | |
514 | RTL;RAL /BITS[0-1] => AC[10-11] | |
515 | AND [3] /ISOLATE BITS[10-11] | |
516 | TAD PUTPREV /ADD ON WORD[3] BITS IN AC[7-9] | |
517 | JMS PUT5 /OUTPUT A CHARACTER | |
518 | TAD PUTEMP /GET WORD[4] | |
519 | RTR;RTR;RAR /BITS[2-6] => AC[7-11] | |
520 | JMS PUT5 /OUTPUT A CHARACTER | |
521 | TAD PUTEMP /GET WORD[4] BITS[7-11] IN AC[7-11] | |
522 | JMS PUT5 /OUTPUT A CHARACTER | |
523 | JMP PUTLUP /GO DO ANOTHER GROUP OF FIVE WORDS | |
524 | ||
525 | CHKNL, .-. /CHECK IF AT NEW LINE ROUTINE | |
526 | TAD WIDCNT /GET LINE WIDTH COUNTER | |
527 | TAD (WIDTH) /COMPARE TO MAXIMIM VALUE | |
528 | SZA CLA /SKIP IF AT MAXIMUM | |
529 | ISZ CHKNL /TAKE SKIP RETURN IF NOT AT MAXIMUM | |
530 | JMP I CHKNL /RETURN EITHER WAY | |
531 | ||
532 | OUTSETU,.-. /OUTPUT SETUP ROUTINE | |
533 | DCA FILLVALUE /STORE PASSED FILL VALUE | |
534 | TAD (PUT0) /SETUP THE | |
535 | DCA PUTNXT /OUTPUT CO-ROUTINE | |
536 | JMP I OUTSETUP /RETURN | |
537 | \fPUT5, .-. /FIVE-BIT OUTPUT ROUTINE | |
538 | AND [37] /JUST 5 BITS | |
539 | DCA PUTLATEST /SAVE IT | |
540 | JMS CHKNL /CHECK IF AT BEGINNING OF LINE | |
541 | SKP /SKIP IF NOT | |
542 | JMP PUTNORMAL /JUMP IF SO | |
543 | TAD ("<&177) /GET BEGINNING BRACKET | |
544 | JMS I [DOBYTE] /OUTPUT IT | |
545 | PUTNORM,TAD PUTLATEST /GET LATEST VALUE | |
546 | TAD ("0-"9-1) /COMPARE TO FIRST LIMIT | |
547 | SMA CLA /SKIP IF LESS | |
548 | TAD ["A-"9-1] /CONVERT LARGER VALUES TO A-V | |
549 | TAD PUTLATEST /ADD ON LATEST VALUE | |
550 | TAD ["0&177] /MAKE IT ASCII | |
551 | TAD FILLVALUE /ADD ON FILL VALUE FOR SPECIAL MODE | |
552 | JMS I [DOBYTE] /OUTPUT IT | |
553 | ISZ WIDCNT /BUMP LINE COUNTER | |
554 | TAD WIDCNT /GET LINE COUNTER | |
555 | SZA CLA /SKIP IF AT END OF LINE | |
556 | JMP I PUT5 /ELSE JUST RETURN | |
557 | TAD (">&177) /GET DATA CLOSING CHARACTER | |
558 | JMS I [DOBYTE] /OUTPUT IT | |
559 | TAD ["M&37] /GET A <CR> | |
560 | JMS I [DOBYTE] /OUTPUT IT | |
561 | TAD ["J&37] /GET A <LF> | |
562 | JMS I [DOBYTE] /OUTPUT IT | |
563 | TAD [-WIDTH] /RESET THE | |
564 | DCA WIDCNT /LINE WIDTH COUNTER | |
565 | JMP I PUT5 /RETURN | |
566 | ||
567 | PAGE | |
568 | \f/ MESSAGE PRINT ROUTINE. | |
569 | ||
570 | SCRIBE, .-. /MESSAGE PRINT ROUTINE | |
571 | TAD I SCRIBE /GET IN-LINE POINTER ARGUMENT | |
572 | DCA SCRPTR /STASH THE POINTER | |
573 | ISZ SCRIBE /BUMP PAST ARGUMENT | |
574 | TAD (140) /INITIALIZE TO | |
575 | DCA SCRCASE /LOWER-CASE | |
576 | SCRLUP, TAD I SCRPTR /GET LEFT HALF-WORD | |
577 | RTR;RTR;RTR /MOVE OVER | |
578 | JMS SCRPRNT /PRINT IT | |
579 | TAD I SCRPTR /GET RIGHT HALF-WORD | |
580 | JMS SCRPRNT /PRINT IT | |
581 | ISZ SCRPTR /BUMP TO NEXT PAIR | |
582 | JMP SCRLUP /KEEP GOING | |
583 | ||
584 | SCRPRNT,.-. /CHARACTER PRINT ROUTINE | |
585 | AND [77] /JUST SIX BITS | |
586 | SNA /END OF MESSAGE? | |
587 | JMP I SCRIBE /YES, RETURN TO ORIGINAL CALLER | |
588 | DCA SCRCHAR /NO, SAVE FOR NOW | |
589 | TAD SCRCHAR /GET IT BACK | |
590 | TAD (-"%!200) /IS IT "%"? | |
591 | SNA /SKIP IF NOT | |
592 | JMP SCRCRLF /JUMP IF IT MATCHES | |
593 | TAD (-"^+100+"%) /IS IT "^" | |
594 | SNA CLA /SKIP IF NOT | |
595 | JMP SCRFLIP /JUMP IF IT MATCHES | |
596 | TAD SCRCHAR /GET THE CHARACTER | |
597 | AND [40] /DOES CASE MATTER? | |
598 | SNA CLA /SKIP IF NOT | |
599 | TAD SCRCASE /ELSE GET PREVAILING CASE | |
600 | TAD SCRCHAR /GET THE CHARACTER | |
601 | SCRPRLF,JMS I [DOBYTE] /OUTPUT THE CHARACTER | |
602 | JMP I SCRPRNT /RETURN | |
603 | ||
604 | SCRCRLF,TAD ["M&37] /GET A <CR> | |
605 | JMS I [DOBYTE] /OUTPUT IT | |
606 | TAD ["J&37] /GET A <LF> | |
607 | JMP SCRPRLF /CONTINUE THERE | |
608 | ||
609 | SCRFLIP,TAD SCRCASE /GET CURRENT CASE | |
610 | CIA /INVERT IT | |
611 | TAD (140+100) /ADD SUM OF POSSIBLE VALUES | |
612 | DCA SCRCASE /STORE NEW INVERTED CASE | |
613 | JMP I SCRPRNT /RETURN | |
614 | \fPUTBYTE,.-. /OUTPUT A BYTE ROUTINE | |
615 | SPA /ARE WE INITIALIZING? | |
616 | JMP PUTINITIALIZE /YES | |
617 | AND (177) /JUST IN CASE | |
618 | DCA LATEST /SAVE LATEST CHARACTER | |
619 | TAD LATEST /GET LATEST CHARACTER | |
620 | JMP I PUTNEXT /GO WHERE YOU SHOULD GO | |
621 | ||
622 | PUTNEXT,.-. /EXIT ROUTINE | |
623 | ISZ PUTBYTE /BUMP TO GOOD RETURN | |
624 | PUTERRO,CLA CLL /CLEAN UP | |
625 | JMP I PUTBYTE /RETURN TO MAIN CALLER | |
626 | ||
627 | PUTINIT,CLA /CLEAN UP | |
628 | TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE | |
629 | DCA PUTRECORD /STORE IN-LINE | |
630 | DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH | |
631 | PUTNEWR,TAD (OUTBUFFER) /SETUP THE | |
632 | DCA BUFPTR /BUFFER POINTER | |
633 | PUTLOOP,JMS PUTNEXT /GET A CHARACTER | |
634 | DCA I BUFPTR /STORE IT | |
635 | TAD BUFPTR /GET POINTER VALUE | |
636 | DCA TEMPTR /SAVE FOR LATER | |
637 | ISZ BUFPTR /BUMP TO NEXT | |
638 | JMS PUTNEXT /GET A CHARACTER | |
639 | DCA I BUFPTR /STORE IT | |
640 | JMS PUTNEXT /GET A CHARACTER | |
641 | RTL;RTL /MOVE UP | |
642 | AND [7400] /ISOLATE HIGH NYBBLE | |
643 | TAD I TEMPTR /ADD ON FIRST BYTE | |
644 | DCA I TEMPTR /STORE COMPOSITE | |
645 | TAD LATEST /GET LATEST CHARACTER | |
646 | RTR;RTR;RAR /MOVE UP AND | |
647 | AND [7400] /ISOLATE LOW NYBBLE | |
648 | TAD I BUFPTR /ADD ON SECOND BYTE | |
649 | DCA I BUFPTR /STORE COMPOSITE | |
650 | ISZ BUFPTR /BUMP TO NEXT | |
651 | TAD BUFPTR /GET LATEST POINTER VALUE | |
652 | TAD (-2^200-OUTBUFFERR) /COMPARE TO LIMIT | |
653 | SZA CLA /SKIP IF AT END | |
654 | JMP PUTLOOP /KEEP GOING | |
655 | ISZ DANGCNT /TOO MANY RECORDS? | |
656 | SKP /SKIP IF NOT | |
657 | JMP I (SIZERR) /JUMP IF SO | |
658 | JMS I OUTPUT /CALL I/O HANDLER | |
659 | 2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER | |
660 | OUTBUFFER /BUFFER ADDRESS | |
661 | PUTRECO,.-. /WILL BE LATEST RECORD NUMBER | |
662 | JMP PUTERROR /OUTPUT ERROR! | |
663 | ISZ I (OUTCNT) /BUMP ACTUAL LENGTH | |
664 | ISZ PUTRECORD /BUMP TO NEXT RECORD | |
665 | JMP PUTNEWRECORD /KEEP GOING | |
666 | \fDOBYTE, .-. /OUTPUT A BYTE ROUTINE | |
667 | JMS PUTBYTE /OUTPUT PASSED VALUE | |
668 | JMP I (ENCERROR) /COULDN'T DO IT | |
669 | JMP I DOBYTE /RETURN | |
670 | ||
671 | PAGE | |
672 | \f/ INPUT FILE ROUTINE. | |
673 | ||
674 | GEIFILE,.-. /GET INPUT FILE ROUTINE | |
675 | JMS LUKUP /TRY TO LOOKUP THE FILE | |
676 | SKP /SKIP IF IT WORKED | |
677 | JMP TRYNULL /TRY NULL EXTENSION VERSION | |
678 | NULLOK, TAD LARG2 /GET NEGATED LENGTH | |
679 | DCA INLEN /STASH IT | |
680 | TAD LARG1 /GET FIRST INPUT RECORD | |
681 | DCA INRECORD /STASH IT | |
682 | JMP I GEIFILE /RETURN | |
683 | ||
684 | / COMES HERE IF LOOKUP FAILED. | |
685 | ||
686 | TRYNULL,CDF TBLFLD /GOTO TABLE FIELD | |
687 | TAD I [INFILE+4] /GET ORIGINAL FILENAME'S EXTENSION | |
688 | CDF PRGFLD /BACK TO OUR FIELD | |
689 | SZA CLA /SKIP IF IT WAS NULL ORIGINALLY | |
690 | JMP I (INERR) /ELSE COMPLAIN OF EXPLICIT LOOKUP FAILURE | |
691 | DCA IFNAME+3 /NOW TRY NULL VERSION INSTEAD OF DEFAULT VERSION | |
692 | JMS LUKUP /TRY TO LOOK IT UP AGAIN | |
693 | JMP NULLOK /THAT WORKED! | |
694 | JMP I (INERR) /COMPLAIN OF LOOKUP FAILURE | |
695 | ||
696 | LUKUP, .-. /LOW-LEVEL LOOKUP ROUTINE | |
697 | TAD (IFNAME) /GET OUR FILENAME POINTER | |
698 | DCA LARG1 /STORE IN-LINE | |
699 | DCA LARG2 /CLEAR SECOND ARGUMENT | |
700 | TAD IDNUMBER /GET INPUT DEVICE NUMBER | |
701 | CIF USRFLD /GOTO USR FIELD | |
702 | JMS I [USR] /CALL USR ROUTINE | |
703 | LOOKUP /WANT LOOKUP FUNCTION | |
704 | LARG1, .-. /WILL BE POINTER TO OUR FILENAME | |
705 | LARG2, .-. /WILL RETURN FILE LENGTH (HOPEFULLY) | |
706 | ISZ LUKUP /LOOKUP FAILED, SO BUMP RETURN ADDRESS | |
707 | JMP I LUKUP /RETURN EITHER WAY | |
708 | \f/ INPUT FILENAME PRINT ROUTINE. | |
709 | ||
710 | PIFNAME,.-. /PRINT INPUT FILENAME ROUTINE | |
711 | TAD IMSW /GET IMAGE-MODE SWITCH | |
712 | SNA CLA /SKIP IF SET | |
713 | JMP DOIFNAME /JUMP IF NOT | |
714 | JMS I [SCRIBE] /OUTPUT THE | |
715 | IFMSG /IMAGE MESSAGE | |
716 | CDF TBLFLD /GOTO TABLE FIELD | |
717 | TAD I [EQUWRD] /GET EQUALS PARAMETER | |
718 | CDF PRGFLD /BACK TO OUR FIELD | |
719 | JMS I (OCTOUT) /OUTPUT IT | |
720 | CDF TBLFLD /GOTO TABLE FIELD | |
721 | TAD I [SWY9] /GET /Y-/9 SWITCHES | |
722 | CDF PRGFLD /BACK TO OUR FIELD | |
723 | AND [600] /JUST /1, /2 BITS | |
724 | SNA /SKIP IF SOMETHING SET | |
725 | JMP I PIFNAME /JUST RETURN IF NOT | |
726 | AND [400] /JUST /1 BIT | |
727 | SNA CLA /SKIP IF /1 SET | |
728 | JMP PIFPT2 /JUMP IF /2 SET | |
729 | JMS I [SCRIBE] /OUTPUT THE | |
730 | PT1MSG /PART ONE MESSAGE | |
731 | JMP I PIFNAME /RETURN | |
732 | ||
733 | PIFPT2, JMS I [SCRIBE] /OUTPUT THE | |
734 | PT2MSG /PART TWO MESSAGE | |
735 | JMP I PIFNAME /RETURN | |
736 | ||
737 | DOIFNAM,TAD IFNAME /GET FIRST PAIR | |
738 | JMS PIF2 /PRINT IT | |
739 | TAD IFNAME+1 /GET SECOND PAIR | |
740 | JMS PIF2 /PRINT IT | |
741 | TAD IFNAME+2 /GET THIRD PAIR | |
742 | JMS PIF2 /PRINT IT | |
743 | TAD (".&177) /GET SEPARATOR | |
744 | JMS PIFOUT /PRINT IT | |
745 | TAD IFNAME+3 /GET FOURTH PAIR | |
746 | JMS PIF2 /PRINT IT | |
747 | JMP I PIFNAME /RETURN | |
748 | ||
749 | PIF2, .-. /PRINT A PAIR ROUTINE | |
750 | DCA SCRCHAR /SAVE PASSED PAIR | |
751 | TAD SCRCHAR /GET IT BACK | |
752 | RTR;RTR;RTR /MOVE DOWN | |
753 | JMS PIFOUT /PRINT HIGH-ORDER FIRST | |
754 | TAD SCRCHAR /GET IT AGAIN | |
755 | JMS PIFOUT /PRINT LOW-ORDER | |
756 | JMP I PIF2 /RETURN | |
757 | \fPIFOUT, .-. /FILENAME CHARACTER OUTPUT ROUTINE | |
758 | AND [77] /JUST SIXBIT | |
759 | SNA /SKIP IF SOMETHING THERE | |
760 | JMP I PIFOUT /ELSE IGNORE IT | |
761 | TAD [40] /INVERT IT | |
762 | AND [77] /REMOVE EXCESS | |
763 | TAD [40] /INVERT IT AGAIN | |
764 | JMS I [DOBYTE] /OUTPUT IT | |
765 | JMP I PIFOUT /RETURN | |
766 | ||
767 | MOFNAME,.-. /MOVE OUTPUT FILENAME ROUTINE | |
768 | TAD I [OUTFILE+1] /GET FIRST OUTPUT FILENAME WORD | |
769 | JMS CHKNAME /CHECK IF LEGAL | |
770 | DCA FNAME /STASH IT | |
771 | TAD I (OUTFILE+2) /GET SECOND OUTPUT FILENAME WORD | |
772 | JMS CHKNAME /CHECK IF LEGAL | |
773 | DCA FNAME+1 /STASH IT | |
774 | TAD I (OUTFILE+3) /GET THIRD OUTPUT FILENAME WORD | |
775 | JMS CHKNAME /CHECK IF LEGAL | |
776 | DCA FNAME+2 /STASH IT | |
777 | TAD I (OUTFILE+4) /GET FOURTH OUTPUT FILENAME WORD | |
778 | JMS CHKNAME /CHECK IF LEGAL | |
779 | DCA FNAME+3 /STASH IT | |
780 | JMP I MOFNAME /RETURN | |
781 | ||
782 | / OUTPUT NAME CHECK ROUTINE. | |
783 | ||
784 | CHKNAME,.-. /OUTPUT NAME CHECK ROUTINE | |
785 | DCA LUKUP /SAVE PASSED VALUE | |
786 | TAD LUKUP /GET IT BACK | |
787 | RTR;RTR;RTR /MOVE DOWN | |
788 | JMS CHKIT /CHECK HIGH-ORDER AND GET IT BACK | |
789 | JMS CHKIT /CHECK LOW-ORDER AND GET IT BACK | |
790 | JMP I CHKNAME /RETURN | |
791 | ||
792 | CHKIT, .-. /ONE CHARACTER CHECK ROUTINE | |
793 | AND [77] /JUST SIX BITS | |
794 | TAD (-"?!200) /COMPARE TO "?" | |
795 | SZA /SKIP IF ALREADY BAD | |
796 | TAD (-"*+"?) /ELSE COMPARE TO "*" | |
797 | SNA CLA /SKIP IF NEITHER BAD CASE | |
798 | JMP I (BADNAME) /COMPLAIN OF WILD CHARACTER | |
799 | TAD LUKUP /GET THE PAIR BACK FOR NEXT TIME | |
800 | JMP I CHKIT /RETURN | |
801 | \f PAGE | |
802 | \fCALCHKS,.-. /CALCULATE CHECKSUM ROUTINE | |
803 | TAD CHKFLG /SHOULD WE CHECKSUM? | |
804 | SZA CLA /SKIP IF SO | |
805 | JMP I CALCHKSUM /JUMP IF NOT | |
806 | JMS CHKSETUP /SETUP | |
807 | TAD PUTEMP /GET PASSED VALUE | |
808 | CLL RAR /CLEAR LINK AND MOVE OVER | |
809 | ADDLUP, RAL /MOVE OVER CARRY | |
810 | TAD I XR1 /ADD A WORD | |
811 | DCA I XR2 /STORE BACK | |
812 | ISZ CCNT /DONE ENOUGH? | |
813 | JMP ADDLUP /NO, KEEP GOING | |
814 | JMP I CALCHKSUM /YES, RETURN | |
815 | ||
816 | CHKOUT, .-. /OUTPUT THE CHECKSUM ROUTINE | |
817 | JMS CHKSETUP /SETUP | |
818 | ISZ CHKFLG /DISABLE CHECKSUMMING | |
819 | TAD I XR1 /GET A WORD | |
820 | JMS I [PUTIT] /OUTPUT IT | |
821 | ISZ CCNT /DONE YET? | |
822 | JMP .-3 /NO, KEEP GOING | |
823 | JMP I CHKOUT /YES, WE'RE DONE | |
824 | ||
825 | CLRCHKS,.-. /CLEAR CHECKSUM ROUTINE | |
826 | JMS CHKSETUP /SETUP | |
827 | DCA I XR1 /CLEAR A WORD | |
828 | ISZ CCNT /DONE YET? | |
829 | JMP .-2 /NO, DO ANOTHER | |
830 | DCA CHKFLG /ENABLE CHECKSUMMING | |
831 | JMP I CLRCHKSUM /RETURN | |
832 | ||
833 | INVCHKS,.-. /CHECKSUM INVERSION ROUTINE | |
834 | JMS CHKSETUP /SETUP | |
835 | STL /FORCE INITIAL CARRY | |
836 | COMLUP, TAD I XR1 /GET A WORD | |
837 | CMA /INVERT IT | |
838 | SZL /SKIP IF NO CARRY | |
839 | CLL IAC /ELSE ADD ONE AND CLEAR CARRY FOR NEXT TIME | |
840 | DCA I XR2 /STORE BACK | |
841 | ISZ CCNT /DONE ALL YET? | |
842 | JMP COMLUP /NO, KEEP GOING | |
843 | JMP I INVCHKSUM /YES, RETURN | |
844 | ||
845 | CHKSETU,.-. /CHECKSUM SETUP ROUTINE | |
846 | TAD (CHKSUM-1) /POINT TO | |
847 | DCA XR1 /CHECKSUM AREA | |
848 | TAD (CHKSUM-1) /POINT TO | |
849 | DCA XR2 /CHECKSUM AREA | |
850 | TAD [-5] /SETUP THE | |
851 | DCA CCNT /CHECKSUM COUNT | |
852 | JMP I CHKSETUP /RETURN | |
853 | \f/ FILE DATE ROUTINE. | |
854 | ||
855 | FDMESSA,.-. /PUT FILE DATE IN MESSAGE ROUTINE | |
856 | TAD FDATE /GET INPUT FILE'S DATE | |
857 | SNA CLA /SKIP IF ANY | |
858 | JMP I FDMESSAGE /RETURN IF NONE | |
859 | JMS I [SCRIBE] /PRINT OUT THE | |
860 | DATMSG /DATE BLURB | |
861 | TAD FDATE /GET IT BACK | |
862 | JMS PRDATE /PRINT THE DATE | |
863 | JMS I [SCRIBE] /PRINT THE | |
864 | EMSG /END MESSAGE | |
865 | JMP I FDMESSAGE /RETURN | |
866 | ||
867 | TDMESSA,.-. /PUT TODAY'S DATE IN MESSAGE ROUTINE | |
868 | JMS I [SCRIBE] /OUTPUT THE | |
869 | REMMSG /OPENING REMARKS | |
870 | CDF TBLFLD /GOTO TABLE FIELD | |
871 | TAD I (DATWRD) /GET DATE WORD | |
872 | CDF PRGFLD /BACK TO OUR FIELD | |
873 | SNA /SKIP IF THERE | |
874 | JMP NOTDATE /JUMP IF NOT | |
875 | DCA TDATE /SAVE TODAY'S DATE | |
876 | JMS I [SCRIBE] /OUTPUT THE | |
877 | ONMSG /BRIDGING MESSAGE | |
878 | TAD TDATE /GET TODAY'S DATE | |
879 | JMS PRDATE /PRINT TODAY'S DATE | |
880 | NOTDATE,JMS I [SCRIBE] /OUTPUT THE | |
881 | EMSG /END MESSAGE | |
882 | JMP I TDMESSAGE /RETURN | |
883 | \fPRDATE, .-. /DATE PRINT ROUTINE | |
884 | DCA PRTEMP /SAVE PASSED VALUE | |
885 | TAD PRTEMP /GET IT BACK | |
886 | RTR;RAR /MOVE DOWN | |
887 | AND [37] /JUST DAY BITS | |
888 | JMS I (DEC2) /PRINT AS TWO DIGITS | |
889 | TAD PRTEMP /GET DATE AGAIN | |
890 | AND [7400] /JUST MONTH BITS | |
891 | CLL RTL;RTL;RTL /MOVE DOWN | |
892 | TAD (MONLST-2-1) /POINT TO PROPER ELEMENT | |
893 | DCA XR1 /STASH THE POINTER | |
894 | TAD I XR1 /GET FIRST PAIR | |
895 | DCA I (MMSG+1) /STORE IN MESSAGE | |
896 | TAD I XR1 /GET SECOND PAIR | |
897 | DCA I (MMSG+2) /STORE IN MESSAGE | |
898 | JMS I [SCRIBE] /OUTPUT THE | |
899 | MMSG /MONTH MESSAGE | |
900 | TAD PRTEMP /GET DATE AGAIN | |
901 | AND [7] /JUST YEAR BITS | |
902 | DCA TEMP /SAVE IT | |
903 | CDF TBLFLD /GOTO TABLE FIELD | |
904 | TAD I (DATWRD) /GET CURRENT DATE WORD | |
905 | CDF PRGFLD /BACK TO OUR FIELD | |
906 | AND [7] /JUST YEAR BITS | |
907 | CIA /INVERT FOR TEST | |
908 | TAD TEMP /COMPARE TO DESIRED YEAR | |
909 | SMA SZA CLA /SKIP IF THEY MATCH OR ARE EARLIER | |
910 | TAD (-10) /ELSE BACKUP A GROUP | |
911 | TAD TEMP /ADD TO YEAR | |
912 | DCA TEMP /STORE BACK | |
913 | TAD I (DATEXT) /GET EXTENSION WORD | |
914 | AND [600] /JUST EXTENSION BITS | |
915 | CLL RTR;RTR /MAKE IT GROUP COUNT | |
916 | TAD TEMP /ADD ON RELATIVE YEAR | |
917 | TAD (106) /MAKE IT ABSOLUTE YEAR (70-99) | |
918 | JMS I (DEC2) /PRINT AS TWO DIGITS | |
919 | JMP I PRDATE /RETURN | |
920 | ||
921 | PAGE | |
922 | \fDEC2, .-. /PRINT TWO DIGITS ROUTINE | |
923 | JMS DIVIDE /DIVIDE | |
924 | 12 /BY 10 | |
925 | TAD ["0&177] /MAKE IT ASCII | |
926 | JMS I [DOBYTE] /OUTPUT IT | |
927 | TAD REM /GET SECOND DIGIT | |
928 | TAD ["0&177] /MAKE IT ASCII | |
929 | JMS I [DOBYTE] /OUTPUT IT | |
930 | JMP I DEC2 /RETURN | |
931 | ||
932 | / DIVIDE ROUTINE. | |
933 | ||
934 | DIVIDE, .-. /DIVIDE ROUTINE | |
935 | DCA REM /SAVE IN REMAINDER | |
936 | DCA QUO /CLEAR QUOTIENT | |
937 | TAD REM /GET IT BACK | |
938 | STL CIA /INVERT | |
939 | SKP /DON'T FIRST TIME | |
940 | DVLOOP, ISZ QUO /BUMP UP QUOTIENT | |
941 | TAD I DIVIDE /ADD ON ARGUMENT | |
942 | SNA SZL /UNDERFLOW? | |
943 | JMP DVLOOP /NO, KEEP GOING | |
944 | CIA /YES, INVERT IT BACK | |
945 | TAD I DIVIDE /RESTORE LOST VALUE | |
946 | DCA REM /SAVE AS REMAINDER | |
947 | TAD QUO /GET THE QUOTIENT | |
948 | ISZ DIVIDE /BUMP PAST ARGUMENT | |
949 | JMP I DIVIDE /RETURN | |
950 | ||
951 | INDATE, .-. /GET INPUT FILE'S DATE WORD | |
952 | CDF TBLFLD /GOTO TABLE FIELD | |
953 | TAD IMSW /GET IMAGE-MODE SWITCH | |
954 | SNA CLA /SKIP IF SET | |
955 | JMP NOIMG /JUMP IF NOT | |
956 | TAD I (DATWRD) /USE TODAY'S DATE | |
957 | JMP NOAIW /CONTINUE THERE | |
958 | ||
959 | NOIMG, TAD I (AIWCNT) /GET AIW COUNT | |
960 | SNA /SKIP IF ANY | |
961 | JMP NOAIW /JUMP IF NOT | |
962 | TAD I [AIWXR] /GET ENTRY POINTER | |
963 | DCA TEMP /STASH FIRST AIW POINTER | |
964 | TAD I TEMP /GET FIRST AIW | |
965 | NOAIW, DCA FDATE /SAVE AS FILE'S DATE | |
966 | CDF PRGFLD /BACK TO OUR FIELD | |
967 | JMP I INDATE /RETURN | |
968 | \f/ INPUT FILENAME MOVE ROUTINE; USES DEFAULT EXTENSION IF NONE PROVIDED BY USER. | |
969 | ||
970 | MIFNAME,.-. /MOVE INPUT FILENAME ROUTINE | |
971 | TAD I (INFILE+1) /GET FIRST INPUT FILENAME WORD | |
972 | SNA /SKIP IF SOMETHING THERE | |
973 | JMP IMTEST /JUMP IF NOT | |
974 | IFNAMOK,DCA IFNAME /STASH IT | |
975 | TAD I (INFILE+2) /GET SECOND INPUT FILENAME WORD | |
976 | DCA IFNAME+1 /STASH IT | |
977 | TAD I (INFILE+3) /GET THIRD INPUT FILENAME WORD | |
978 | DCA IFNAME+2 /STASH IT | |
979 | TAD I [INFILE+4] /GET FOURTH INPUT FILENAME WORD | |
980 | SNA /SKIP IF SOMETHING THERE | |
981 | TAD ("S^100+"V-300) /ELSE USE DEFAULT EXTENSION VALUE | |
982 | DCA IFNAME+3 /STASH IT EITHER WAY | |
983 | JMP I MIFNAME /RETURN | |
984 | ||
985 | / TEST IF IMAGE-MODE IS SET. ASSUME /1 AND /2 ARE NOT SET. | |
986 | ||
987 | IMTEST, TAD I (SWAL) /GET /A-/L SWITCHES | |
988 | AND (10) /JUST /I BIT | |
989 | SZA CLA /SKIP IF NOT SET | |
990 | TAD I [EQUWRD] /GET EQUALS PARAMETER | |
991 | SNA /SKIP IF SOMETHING THERE | |
992 | JMP I (INERR) /ELSE COMPLAIN | |
993 | CIA /INVERT IT | |
994 | DCA INLEN /USE AS INPUT RECORD COUNT | |
995 | DCA INRECORD /START AT THE BEGINNING OF THE DEVICE | |
996 | ISZ IMSW /INDICATE IMAGE-MODE SET | |
997 | ||
998 | / TEST IF /1 OR /2 IS SET. | |
999 | ||
1000 | TAD I [SWY9] /GET /Y-/9 SWITCHES | |
1001 | AND [600] /JUST /1, /2 SWITCHES | |
1002 | SNA /SKIP IF EITHER SET | |
1003 | JMP IFNAMOK /JUMP IF NEITHER SET | |
1004 | ||
1005 | / TEST IF /1 IS SET. IF NOT, /2 MUST BE SET. | |
1006 | ||
1007 | AND [400] /JUST /1 SWITCH | |
1008 | SNA CLA /SKIP IF /1 SET | |
1009 | JMP IM2 /JUMP IF /2 SET | |
1010 | ||
1011 | / FOR A FIRST HALF, USE THE ROUNDED-DOWN FIRST HALF LENGTH. THE DATA STARTS AT | |
1012 | / RECORD ZERO (ALREADY SET). | |
1013 | ||
1014 | TAD I [EQUWRD] /GET EQUALS PARAMETER | |
1015 | CLL RAR /%2 | |
1016 | IM2ENTR,CIA /INVERT IT | |
1017 | DCA INLEN /SET COUNT FOR HALF OF THE DEVICE | |
1018 | JMP IFNAMOK /KEEP GOING | |
1019 | \f/ FOR A SECOND HALF, THE DATA STARTS AT THE HALFWAY POINT (ROUNDED DOWN). | |
1020 | ||
1021 | IM2, TAD I [EQUWRD] /GET EQUALS PARAMETER | |
1022 | CLL RAR /%2 | |
1023 | DCA INRECORD /SETUP STARTING RECORD | |
1024 | ||
1025 | / FOR A SECOND HALF, THE COUNT IS THE ORIGINAL AMOUNT MINUS THE COUNT FOR THE | |
1026 | / FIRST HALF. | |
1027 | ||
1028 | TAD I [EQUWRD] /GET EQUALS PARAMETER | |
1029 | CLL RAR /%2 | |
1030 | CIA /INVERT IT | |
1031 | TAD I [EQUWRD] /SUBTRACT FROM EQUALS PARAMETER | |
1032 | JMP IM2ENTRY /CONTINUE THERE | |
1033 | ||
1034 | CHKBND, .-. /CHECK IF ON GOOD OUTPUT BOUNDARY ROUTINE | |
1035 | TAD OBOUND /GET BOUNDARY COUNTER | |
1036 | TAD (5) /COMPARE TO BEGINNING VALUE | |
1037 | SNA CLA /SKIP IF NOT AT BEGINNING | |
1038 | ISZ CHKBND /SET SKIP RETURN IF AT BEGINNING | |
1039 | JMP I CHKBND /RETURN EITHER WAY | |
1040 | ||
1041 | OCTOUT, .-. /OCTAL OUTPUT ROUTINE | |
1042 | DCA OCTEMP /SAVE IT | |
1043 | TAD (-4) /SETUP THE | |
1044 | DCA OCTCNT /DIGIT COUNTER | |
1045 | OCTLUP, TAD OCTEMP /GET THE VALUE | |
1046 | RTL;RAL /MOVE UP A DIGIT | |
1047 | DCA OCTEMP /STORE BACK | |
1048 | TAD OCTEMP /GET IT AGAIN | |
1049 | RAL /PUT INTO CORRECT BITS | |
1050 | AND [7] /JUST ONE DIGIT | |
1051 | TAD ["0&177] /MAKE IT ASCII | |
1052 | JMS I [DOBYTE] /OUTPUT IT | |
1053 | ISZ OCTCNT /DONE ENOUGH? | |
1054 | JMP OCTLUP /NO, GO BACK FOR MORE | |
1055 | JMP I OCTOUT /YES, RETURN TO CALLER | |
1056 | ||
1057 | PAGE | |
1058 | \f/ FILE TEXT MESSAGES. | |
1059 | ||
1060 | DATMSG, TEXT "(^REMARK F^ILE ^D^ATE: " | |
1061 | EMSG, TEXT ")%^" | |
1062 | ENDMSG, TEXT ">%(^END ^" | |
1063 | EOFMSG, TEXT "(^REMARK E^ND OF ^F^ILE)%" | |
1064 | FILMSG, TEXT "(^FILE " | |
1065 | IFMSG, TEXT "^B^LOCK-^I^MAGE-^F^ILE =^" | |
1066 | \fMMSG, TEXT "-^D^EC-19" | |
1067 | ONMSG, TEXT ": ^" | |
1068 | PT1MSG, TEXT " ^F^IRST ^H^ALF" | |
1069 | PT2MSG, TEXT " ^S^ECOND ^H^ALF^" | |
1070 | \fREMMSG, TEXT "(^REMARK PDP-8/DEC^MATE ^E^NCODING ^P^ROGRAM ^V^ERSION ^" | |
1071 | "0+VERSION^100+".-200; "0+REVISION^100+" -200 | |
1072 | TEXT " C^HARLES ^L^ASNER)%" | |
1073 | \f TEXT "(^REMARK I^MAGE ^F^ILE ^C^REATED BY ^PDP^-8" | |
1074 | ||
1075 | / MONTH TEXT TABLE. | |
1076 | ||
1077 | MONLST, TEXT "J^AN" /JANUARY | |
1078 | TEXT "F^EB" /FEBRUARY | |
1079 | TEXT "M^AR" /MARCH | |
1080 | TEXT "A^PR" /APRIL | |
1081 | TEXT "M^AY" /MAY | |
1082 | TEXT "J^UN" /JUNE | |
1083 | TEXT "J^UL" /JULY | |
1084 | TEXT "A^UG" /AUGUST | |
1085 | TEXT "S^EP" /SEPTEMBER | |
1086 | TEXT "O^CT" /OCTOBER | |
1087 | TEXT "N^OV" /NOVEMBER | |
1088 | TEXT "D^EC" /DECEMBER | |
1089 | \f $ /THAT'S ALL FOLK! |