Commit | Line | Data |
---|---|---|
81e70d48 PH |
1 | / OS/8 DECODING PROGRAM |
2 | ||
3 | / LAST EDIT: 08-JUL-1992 22:00:00 CJL | |
4 | ||
5 | / PROGRAM TO DECODE OS/8 FILES FROM "PRINTABLE" ASCII FORMAT TO BINARY-IMAGE | |
6 | / FORMAT. INTERMEDIATE "ASCII" CONVERSION SHOULD BE HARMLESS AS LONG AS ALL | |
7 | / PRINTING DATA CHARACTERS ARE NOT MODIFIED. | |
8 | ||
9 | / DISTRIBUTED BY CUCCA AS "K12DEC.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 | / THIS PROGRAM OPERATES ON "PRINTABLE" ASCII FILES WHICH HAVE BEEN CREATED BY | |
22 | / ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES. THE ENCODING FORMAT ALLOWS | |
23 | / FOR SOME INNOCUOUS CONTENT MODIFICATION SUCH AS EXTRANEOUS WHITE SPACE AND | |
24 | / EXTRA <CR>/<LF> PAIRS, BUT RIGOROUSLY VALIDATES CERTAIN ASPECTS OF THE FORMAT, | |
25 | / SUCH AS A TRAILING CHECKSUM. | |
26 | ||
27 | / CERTAIN IMBEDDED COMMANDS ARE USED SUCH AS (REMARK .........) WHICH ALLOWS FOR | |
28 | / COMMENTARY LINES WITHIN THE FILE FOR IDENTIFICATION PURPOSES. THE (FILE ) AND | |
29 | / (END ) COMMANDS CONTAIN THE SUGGESTED FILENAME FOR THE DESCENDANT DECODED | |
30 | / FILE. | |
31 | \f/ WHEN CREATING THE DESCENDANT DECODED FILE, THE USER MAY SPECIFY EITHER THE | |
32 | / IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE | |
33 | / OR A SPECIFIED DEVICE: | |
34 | ||
35 | / .RUN DEV DECODE INVOKE PROGRAM. | |
36 | / *INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT). | |
37 | / *DEV:OUTPUT.EX<INPUT INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:. | |
38 | / *DEV:<INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:. | |
39 | / *DEV:<INPUT=NNNN/I **** SPECIAL IMAGE TRANSFER MODE **** INPUT IS DECODED | |
40 | / INTO RECORD 0000-[NNNN-1] ON DEVICE DEV:. THE =NNNN | |
41 | / VALUE SHOULD BE CAREFULLY CHOSEN LARGE ENOUGH TO WRITE | |
42 | / ALL DATA RECORDS, BUT NEED NOT BE STATED EXACTLY. | |
43 | / (THE ENCODE PROGRAM REQUIRES PRECISE STATEMENT OF THE | |
44 | / LENGTH IN IMAGE TRANSFER ENCODING MODE. **** NOTE | |
45 | / **** THIS METHOD VIOLATES ALL OS/8 DEVICE STRUCTURE | |
46 | / AND IS MEANT FOR TRANSFER OF COMPLETE DEVICE IMAGES | |
47 | / ONLY; USE WITH CARE! | |
48 | / *DEV:<INPUT=NNNN/I/1 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR | |
49 | / IMAGE MODE EXCEPT ONLY THE FIRST HALF OF THE DATA IS | |
50 | / USED. NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY | |
51 | / BECAUSE IT IS USED TO CALCULATE THE APPROX. 1/2 VALUE | |
52 | / ACTUALLY USED IN THIS HALF OF THE OVERALL TRANSFER. | |
53 | / THIS MODE SHOULD BE USED WITH FILES CREATED FOR THE | |
54 | / EXPRESS PURPOSE OF TRANSMISSION BY HALVES ONLY; USE | |
55 | / WITH CARE! | |
56 | / *DEV:<INPUT=NNNN/I/2 **** SPECIAL IMAGE TRANSFER MODE **** SAME AS REGULAR | |
57 | / IMAGE MODE EXCEPT ONLY THE SECOND HALF OF THE DATA IS | |
58 | / USED. NOTE THAT THE =NNNN VALUE MUST BE GIVEN EXACTLY | |
59 | / BECAUSE IT IS USED TO CALCULATE THE STARTING RECORD OF | |
60 | / THE APPROX. 1/2 VALUE ACTUALLY USED IN THIS HALF OF | |
61 | / THE OVERALL TRANSFER. THIS MODE SHOULD BE USED WITH | |
62 | / FILES CREATED FOR THE EXPRESS PURPOSE OF TRANSMISSION | |
63 | / BY HALVES ONLY; USE WITH CARE! NOTE THAT THERE MUST | |
64 | / BE TWO FILES CREATED, ONE USING /I/1 AND THE OTHER | |
65 | / USING /I/2 TO COMPLETELY TRANSFER A DEVICE IMAGE | |
66 | / UNLESS /I IS USED ALONE! | |
67 | / *OUTPUT.EX<INPUT$ INPUT IS DECODED INTO OUTPUT.EX ON DSK: (DEFAULT). | |
68 | / THE <ESC> CHARACTER WAS USED TO TERMINATE THE LINE | |
69 | / (THIS IS SIGNIFIED BY $). THIS CAUSES PROGRAM EXIT. | |
70 | / . PROGRAM EXITS NORMALLY. | |
71 | \f/ INPUT FILE ASSUMES .EN EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION. | |
72 | / IMAGE TRANSFER MODE DOESN'T USE OUTPUT FILENAMES, AS THE TRANSFER DESTROYS THE | |
73 | / OS/8 FILE STRUCTURE (POSSIBLY PRESENT) ON THE DEVICE. | |
74 | ||
75 | / PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE | |
76 | / KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC> | |
77 | / CHARACTER. | |
78 | ||
79 | / THIS PROGRAM SUPPORTS A PROPER SUBSET OF THE ASCII ENCODING SCHEME DISCUSSED | |
80 | / BY CHARLES LASNER AND FRANK DA CRUZ. THE SCHEME USED IS FIVE-BIT ENCODING | |
81 | / WITH COMPRESSION, (AS OPPOSED TO SIX-BIT WITHOUT COMPRESSION AS USED IN PRIOR | |
82 | / VERSIONS). | |
83 | ||
84 | / RESTRICTIONS: | |
85 | ||
86 | / A) SUPPORTS ONLY ONE DECODABLE FILE PER ENCODED FILE. | |
87 | ||
88 | / B) IGNORES ALL (END ) COMMANDS. | |
89 | ||
90 | / C) <CR> <LF> < ALWAYS INDICATES ENCODED DATA LINES; NO CHECK IS MADE FOR | |
91 | / WHETHER THE > IS ON THE SAME LINE AS THE <. | |
92 | ||
93 | / D) PDP-8 GENERATED CHECKSUM DATA MUST BE THE FINAL DATA IN THE FILE IN | |
94 | / THE PROPER FORMAT: ZCCCCCCCCCCCC WHERE CCCCCCCCCCCC IS THE | |
95 | / TWELVE-CHARACTER PDP-8 CHECKSUM DATA. | |
96 | ||
97 | / IF THE ENCODED FILE IS PASSED THROUGH ANY INTERMEDIARY PROCESS THAT MODIFIES | |
98 | / THE CONTENTS IN A WAY THAT INTERFERES WITH ANY OF THE ABOVE, THIS DECODING | |
99 | / PROGRAM WILL FAIL. IT IS THE USER'S RESPONSIBILITY TO EDIT OUT UNWANTED | |
100 | / CHANGES TO THE ENCODED FILE. ALL OTHER ASPECTS OF THE PROTOCOL ARE OBEYED, | |
101 | / SUCH AS IMBEDDED <FF>, EXTRA <CR> <LF>, OR TRAILING SPACES HAVE NO EFFECT ON | |
102 | / THE RELIABILITY OF THE DECODING PROCESS, ETC. | |
103 | \f/ ERROR MESSAGES. | |
104 | ||
105 | / ANY MESSAGE PRINTED IS A FATAL ERROR MESSAGE. ALL MESSAGES ARE THE STANDARD | |
106 | / OS/8 "USER" ERROR MESSAGES OF THE FORM: USER ERROR X AT AAAAA WHERE X IS THE | |
107 | / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED. | |
108 | / THE FOLLOWING USER ERRORS ARE DEFINED: | |
109 | ||
110 | / ERROR NUMBER PROBABLE CAUSE | |
111 | ||
112 | / 0 TOO MANY OUTPUT FILES. | |
113 | ||
114 | / 1 NO INPUT FILE OR TOO MANY INPUT FILES. | |
115 | ||
116 | / 2 IMBEDDED OUTPUT FILENAME FORMAT ERROR. | |
117 | ||
118 | / 3 I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME. | |
119 | ||
120 | / 4 ERROR WHILE FETCHING FILE HANDLER. | |
121 | ||
122 | / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE. | |
123 | ||
124 | / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE. | |
125 | ||
126 | / 7 ERROR WHILE CLOSING THE OUTPUT FILE. | |
127 | ||
128 | / 8 I/O ERROR WHILE DECODING FILE DATA OR BAD DATA. | |
129 | ||
130 | / ASSEMBLY INSTRUCTIONS. | |
131 | ||
132 | / IT IS ASSUMED THE SOURCE FILE K12DEC.PAL HAS BEEN MOVED AND RENAMED TO | |
133 | / DSK:DECODE.PA. | |
134 | ||
135 | / .PAL DECODE<DECODE ASSEMBLE SOURCE PROGRAM | |
136 | / .LOAD DECODE LOAD THE BINARY FILE | |
137 | / .SAVE DEV DECODE=0 SAVE THE CORE-IMAGE FILE | |
138 | \f/ DEFINITIONS. | |
139 | ||
140 | CLOSE= 4 /CLOSE OUTPUT FILE | |
141 | DECODE= 5 /CALL COMMAND DECODER | |
142 | ENTER= 3 /ENTER TENTATIVE FILE | |
143 | EQUWRD= 7646 /EQUALS PARAMETER HERE IN TABLE FIELD | |
144 | FETCH= 1 /FETCH HANDLER | |
145 | IHNDBUF=7200 /INPUT HANDLER BUFFER | |
146 | INBUFFE=6200 /INPUT BUFFER | |
147 | INFILE= 7617 /INPUT FILE INFORMATION HERE | |
148 | INQUIRE=12 /INQUIRE ABOUT HANDLER | |
149 | NL0001= CLA IAC /LOAD AC WITH 0001 | |
150 | NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 | |
151 | NL4000= CLA CLL CML RAR /LOAD AC WITH 4000 | |
152 | NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 | |
153 | NL7777= CLA CMA /LOAD AC WITH 7777 | |
154 | OHNDBUF=6600 /OUTPUT HANDLER BUFFER | |
155 | OUTBUFF=5600 /OUTPUT BUFFER | |
156 | OUTFILE=7600 /OUTPUT FILE INFORMATION HERE | |
157 | PRGFLD= 00 /PROGRAM FIELD | |
158 | RESET= 13 /RESET SYSTEM TABLES | |
159 | SBOOT= 7600 /MONITOR EXIT | |
160 | SWAL= 7643 /A-/L SWITCHES HERE IN TABLE FIELD | |
161 | SWY9= 7645 /Y-/9 SWITCHES HERE IN TABLE FIELD | |
162 | TBLFLD= 10 /COMMAND DECODER TABLE FIELD | |
163 | TERMWRD=7642 /TERMINATOR WORD | |
164 | USERROR=7 /USER SIGNALLED ERROR | |
165 | USR= 7700 /USR ENTRY POINT | |
166 | USRFLD= 10 /USR FIELD | |
167 | WIDTH= 107-2 /69 DATA CHARACTERS PER LINE (TOTAL 71) | |
168 | WRITE= 4000 /I/O WRITE BIT | |
169 | \f *0 /START AT THE BEGINNING | |
170 | ||
171 | *10 /DEFINE AUTO-INDEX AREA | |
172 | ||
173 | XR1, .-. /AUTO-INDEX NUMBER 1 | |
174 | XR2, .-. /AUTO-INDEX NUMBER 2 | |
175 | ||
176 | *20 /GET PAST AUTO-INDEX AREA | |
177 | ||
178 | BUFPTR, .-. /OUTPUT BUFFER POINTER | |
179 | CCNT, .-. /CHECKSUM COUNTER | |
180 | CHKSUM, ZBLOCK 5 /CHECKSUM TEMPORARY | |
181 | CHRCNT, .-. /CHARACTER COUNTER | |
182 | CSUMTMP,.-. /CHECKSUM TEMPORARY | |
183 | DANGCNT,.-. /DANGER COUNT | |
184 | DATCNT, .-. /DATA COUNTER | |
185 | DSTATE, .-. /DATA STATE VARIABLE | |
186 | IDNUMBE,.-. /INPUT DEVICE NUMBER | |
187 | IMSW, .-. /IMAGE-MODE SWITCH | |
188 | INITFLA,.-. /INITIALIZE INPUT FLAG | |
189 | INPUT, .-. /INPUT HANDLER POINTER | |
190 | INRECOR,.-. /INPUT RECORD | |
191 | FCHKSUM,ZBLOCK 5 /FILE CHECKSUM | |
192 | FNAME, ZBLOCK 4 /OUTPUT FILENAME | |
193 | GWTMP1, .-. /GETWORD TEMPORARY | |
194 | GWTMP2, .-. /GETWORD TEMPORARY | |
195 | GWVALUE,.-. /LATEST WORD VALUE | |
196 | ODNUMBE,.-. /OUTPUT DEVICE NUMBER | |
197 | OUTPUT, .-. /OUTPUT HANDLER POINTER | |
198 | OUTRECO,.-. /OUTPUT RECORD | |
199 | PUTEMP, .-. /OUTPUT TEMPORARY | |
200 | PUTPTR, .-. /OUTPUT POINTER | |
201 | THIRD, .-. /THIRD BYTE TEMPORARY | |
202 | ||
203 | / STATE TABLE. | |
204 | ||
205 | P, SCANIT /0000 LOOKING FOR "(" OR "<" | |
206 | FNDCOMMAND /0001 FOUND "(" AND NOW LOOKING FOR ")" | |
207 | FNDCEND /0002 FOUND ")" AND NOW LOOKING FOR <CR> | |
208 | FNDCR /0003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET | |
209 | STORDATA /4000 FOUND "<" AND PROCESSING 69 DATA BYTES | |
210 | ENDATA /4001 FOUND 69 DATA BYTES AND NOW LOOKING FOR ">" | |
211 | ENDCR /4002 FOUND ">" AND NOW LOOKING FOR <CR> | |
212 | FNDCR/ENDLF /4003 FOUND <CR> AND NOW LOOKING FOR <LF> TO RESET | |
213 | \f PAGE /START AT THE USUAL PLACE | |
214 | ||
215 | BEGIN, NOP /HERE IN CASE WE'RE CHAINED TO | |
216 | CLA /CLEAN UP | |
217 | START, CIF USRFLD /GOTO USR FIELD | |
218 | JMS I [USR] /CALL USR ROUTINE | |
219 | DECODE /WANT COMMAND DECODER | |
220 | "E^100+"N-300 /.EN IS DEFAULT EXTENSION | |
221 | CDF TBLFLD /GOTO TABLE FIELD | |
222 | TAD I (TERMWRD) /GET TERMINATOR WORD | |
223 | SPA CLA /SKIP IF <CR> TERMINATED THE LINE | |
224 | DCA EXITZAP /ELSE CAUSE EXIT LATER | |
225 | DCA IMSW /CLEAR IMAGE-MODE; MIGHT GET SET LATER THOUGH | |
226 | TAD I (OUTFILE) /GET FIRST OUTPUT FILE DEVICE WORD | |
227 | SNA /SKIP IF FIRST OUTPUT FILE PRESENT | |
228 | JMP TSTMORE /JUMP IF NOT THERE | |
229 | AND [17] /JUST DEVICE BITS | |
230 | ODNULL, DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER | |
231 | TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD | |
232 | SNA /SKIP IF THERE | |
233 | TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD | |
234 | SZA CLA /SKIP IF BOTH NOT PRESENT | |
235 | JMP I (OUTERR) /ELSE COMPLAIN | |
236 | TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD | |
237 | SNA /SKIP IF PRESENT | |
238 | JMP I (INERR) /JUMP IF NOT | |
239 | AND [17] /JUST DEVICE BITS | |
240 | DCA IDNUMBER /SAVE INPUT DEVICE NUMBER | |
241 | TAD I (INFILE+2) /GET SECOND INPUT FILE DEVICE WORD | |
242 | SZA CLA /SKIP IF ONLY ONE INPUT FILE | |
243 | JMP I (INERR) /ELSE COMPLAIN | |
244 | TAD I (INFILE+1) /GET FIRST INPUT FILE STARTING RECORD | |
245 | DCA INRECORD /SET IT UP | |
246 | CDF PRGFLD /BACK TO OUR FIELD | |
247 | CIF USRFLD /GOTO USR FIELD | |
248 | JMS I [USR] /CALL USR ROUTINE | |
249 | RESET /RESET SYSTEM TABLES | |
250 | \f TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT | |
251 | DCA IHPTR /STORE IN-LINE | |
252 | TAD IDNUMBER /GET INPUT DEVICE NUMBER | |
253 | CIF USRFLD /GOTO USR FIELD | |
254 | JMS I [USR] /CALL USR ROUTINE | |
255 | FETCH /FETCH HANDLER | |
256 | IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT | |
257 | JMP I (FERROR) /FETCH ERROR | |
258 | TAD IHPTR /GET RETURNED ADDRESS | |
259 | DCA INPUT /STORE AS INPUT HANDLER ADDRESS | |
260 | JMS I (GEOFILE) /GET OUTPUT FILE INFORMATION | |
261 | TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT | |
262 | DCA OHPTR /STORE IN-LINE | |
263 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
264 | CIF USRFLD /GOTO USR FIELD | |
265 | JMS I [USR] /CALL USR ROUTINE | |
266 | FETCH /FETCH HANDLER | |
267 | OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT | |
268 | JMP I (FERROR) /FETCH ERROR | |
269 | TAD OHPTR /GET RETURNED ADDRESS | |
270 | DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS | |
271 | TAD IMSW /GET IMAGE-MODE SWITCH | |
272 | SNA CLA /SKIP IF SET | |
273 | JMP NOIMAGE /JUMP IF NOT | |
274 | ||
275 | / IF /2 IS SET, THE DATA STARTS HALF-WAY INTO THE IMAGE. OTHER IMAGE MODES | |
276 | / START AT RECORD 0000. | |
277 | ||
278 | CDF TBLFLD /GOTO TABLE FIELD | |
279 | TAD I [SWY9] /GET /Y-/9 SWITCHES | |
280 | AND (200) /JUST /2 SWITCH | |
281 | SNA CLA /SKIP IF SET | |
282 | JMP IMAGE1 /JUMP IF /1 OR NEITHER /1, /2 SET | |
283 | TAD I [EQUWRD] /GET EQUALS PARAMETER | |
284 | CLL RAR /%2 | |
285 | IMAGE1, DCA OUTRECORD /STORE STARTING OUTPUT RECORD | |
286 | CDF PRGFLD /BACK TO OUR FIELD | |
287 | SKP /DON'T ENTER FILE NAME | |
288 | NOIMAGE,JMS I (FENTER) /ENTER THE TENTATIVE FILE NAME | |
289 | DCA DSTATE /SET INITIAL DATA STATE | |
290 | JMS I (CLRCHKSUM) /CLEAR OUT CHECKSUM | |
291 | JMS I (DECODIT) /GO DO THE ACTUAL DECODING | |
292 | JMP I (PROCERR) /ERROR WHILE DECODING | |
293 | TAD IMSW /GET IMAGE-MODE SWITCH | |
294 | SZA CLA /SKIP IF CLEAR | |
295 | JMP EXITZAP /JUMP IF SET | |
296 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
297 | CIF USRFLD /GOTO USR FIELD | |
298 | JMS I [USR] /CALL USR ROUTINE | |
299 | CLOSE /CLOSE OUTPUT FILE | |
300 | FNAME /POINTER TO FILENAME | |
301 | OUTCNT, .-. /WILL BE ACTUAL COUNT | |
302 | JMP I (CLSERR) /CLOSE ERROR | |
303 | EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000 | |
304 | JMP I (SBOOT) /EXIT TO MONITOR | |
305 | \f/ COMES HERE TO TEST FOR NULL LINE. | |
306 | ||
307 | TSTMORE,TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD | |
308 | SNA /SKIP IF PRESENT | |
309 | TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD | |
310 | SZA CLA /SKIP IF NO OUTPUT FILES | |
311 | JMP I (OUTERR) /ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT | |
312 | TAD I (INFILE) /GET FIRST OUTPUT FILE DEVICE WORD | |
313 | SZA CLA /SKIP IF NO INPUT FILES | |
314 | JMP ODNULL /JUMP IF INPUT WITHOUT OUTPUT | |
315 | CDF PRGFLD /BACK TO OUR FIELD | |
316 | JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST | |
317 | ||
318 | PAGE | |
319 | \f/ ERROR WHILE PROCESSING INPUT FILE. | |
320 | ||
321 | PROCERR,NL0002 /SET INCREMENT | |
322 | SKP /DON'T USE NEXT | |
323 | ||
324 | / ERROR WHILE CLOSING THE OUTPUT FILE. | |
325 | ||
326 | CLSERR, NL0001 /SET INCREMENT | |
327 | SKP /DON'T CLEAR IT | |
328 | ||
329 | / OUTPUT FILE TOO LARGE ERROR. | |
330 | ||
331 | SIZERR, CLA /CLEAN UP | |
332 | TAD [3] /SET INCREMENT | |
333 | SKP /DON'T USE NEXT | |
334 | ||
335 | / ENTER ERROR. | |
336 | ||
337 | ENTERR, NL0002 /SET INCREMENT | |
338 | SKP /DON'T USE NEXT | |
339 | ||
340 | / HANDLER FETCH ERROR. | |
341 | ||
342 | FERROR, NL0001 /SET INCREMENT | |
343 | ||
344 | / I/O ERROR WHILE PROCESSING (FILE ) COMMAND. | |
345 | ||
346 | NIOERR, IAC /SET INCREMENT | |
347 | ||
348 | / FORMAT ERROR WHILE PROCESSING (FILE ) COMMAND. | |
349 | ||
350 | CHARERR,IAC /SET INCREMENT | |
351 | ||
352 | / INPUT FILESPEC ERROR. | |
353 | ||
354 | INERR, IAC /SET INCREMENT | |
355 | ||
356 | / OUTPUT FILESPEC ERROR. | |
357 | ||
358 | OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER | |
359 | CDF PRGFLD /ENSURE OUR FIELD | |
360 | CIF USRFLD /GOTO USR FIELD | |
361 | JMS I [USR] /CALL USR ROUTINE | |
362 | USERROR /USER ERROR | |
363 | ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER | |
364 | \fDECODIT,.-. /DECODING ROUTINE | |
365 | TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE | |
366 | DCA PUTRECORD /STORE IN-LINE | |
367 | DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH | |
368 | NL7777 /SETUP THE | |
369 | DCA INITFLAG /INITIALIZE FLAG | |
370 | TAD (GWLOOP) /INITIALIZE THE | |
371 | DCA I (GWNEXT) /DECODE PACK ROUTINE | |
372 | PUTNEWR,TAD POUTBUFFER/(OUTBUFFER) /SETUP THE | |
373 | DCA PUTPTR /OUTPUT BUFFER POINTER | |
374 | PUTLOOP,JMS I (GETWORD) /GET A WORD | |
375 | DCA I PUTPTR /STORE IT | |
376 | ISZ PUTPTR /BUMP TO NEXT | |
377 | TAD PUTPTR /GET THE POINTER | |
378 | TAD (-2^200-OUTBUFFER) /COMPARE TO LIMIT | |
379 | SZA CLA /SKIP IF AT END | |
380 | JMP PUTLOOP /KEEP GOING | |
381 | ISZ DANGCNT /TOO MANY RECORDS? | |
382 | SKP /SKIP IF NOT | |
383 | JMP I (SIZERROR) /NOT ENOUGH SPACE AVAILABLE | |
384 | JMS I OUTPUT /CALL OUTPUT HANDLER | |
385 | 2^100+WRITE /WRITE LATEST RECORD | |
386 | POUTBUF,OUTBUFFER /OUTPUT BUFFER ADDRESS | |
387 | PUTRECO,.-. /WILL BE LATEST RECORD NUMBER | |
388 | DECERR, JMP I DECODIT /I/O ERROR | |
389 | ISZ PUTRECORD /BUMP TO NEXT RECORD | |
390 | NOP /JUST IN CASE | |
391 | ISZ I (OUTCNT) /BUMP ACTUAL LENGTH | |
392 | JMP PUTNEWRECORD /GO DO ANOTHER ONE | |
393 | ||
394 | / GOOD RETURN HERE. | |
395 | ||
396 | DECBMP, ISZ DECODIT /BUMP TO GOOD RETURN | |
397 | JMP I DECODIT /RETURN | |
398 | \f/ OS/8 FILE UNPACK ROUTINE. | |
399 | ||
400 | GETBYTE,.-. /GET A BYTE ROUTINE | |
401 | SNA CLA /INITIALIZING? | |
402 | JMP I PUTC /NO, GO GET NEXT BYTE | |
403 | TAD INRECORD /GET STARTING RECORD OF INPUT FILE | |
404 | DCA GETRECORD /STORE IN-LINE | |
405 | GETNEWR,JMS I INPUT /CALL I/O HANDLER | |
406 | 2^100 /READ TWO PAGES INTO BUFFER | |
407 | INBUFFER /BUFFER ADDRESS | |
408 | GETRECO,.-. /WILL BE LATEST RECORD NUMBER | |
409 | JMP I GETBYTE /INPUT ERROR! | |
410 | TAD (INBUFFER) /SETUP THE | |
411 | DCA BUFPTR /BUFFER POINTER | |
412 | GETLOOP,DCA THIRD /CLEAR THIRD BYTE NOW | |
413 | JMS PUTONE /OBTAIN AND SEND BACK FIRST BYTE | |
414 | JMS PUTONE /OBTAIN AND SEND BACK SECOND BYTE | |
415 | TAD THIRD /GET THIRD BYTE | |
416 | JMS PUTC /SEND IT BACK | |
417 | TAD BUFPTR /GET THE POINTER | |
418 | TAD (-2^200-INBUFFER) /COMPARE TO LIMIT | |
419 | SZA CLA /SKIP IF AT END | |
420 | JMP GETLOOP /KEEP GOING | |
421 | ISZ GETRECORD /BUMP TO NEXT RECORD | |
422 | JMP GETNEWRECORD /GO DO ANOTHER ONE | |
423 | ||
424 | PUTONE, .-. /SEND BACK A BYTE ROUTINE | |
425 | TAD I BUFPTR /GET LATEST WORD | |
426 | AND (7400) /JUST THIRD-BYTE NYBBLE | |
427 | CLL RAL /MOVE UP | |
428 | TAD THIRD /GET OLD NYBBLE (IF ANY) | |
429 | RTL;RTL /MOVE UP NYBBLE BITS | |
430 | DCA THIRD /SAVE FOR NEXT TIME | |
431 | TAD I BUFPTR /GET LATEST WORD AGAIN | |
432 | JMS PUTC /SEND BACK CURRENT BYTE | |
433 | ISZ BUFPTR /BUMP TO NEXT WORD | |
434 | JMP I PUTONE /RETURN | |
435 | ||
436 | PUTC, .-. /SEND BACK LATEST BYTE ROUTINE | |
437 | AND (177) /KEEP ONLY GOOD BITS | |
438 | TAD (-"Z!300) /COMPARE TO <^Z> | |
439 | SNA /SKIP IF NOT ASCII <EOF> | |
440 | JMP GETEOF /JUMP IF ASCII MODE <EOF> | |
441 | TAD ("Z&37) /RESTORE THE CHARACTER | |
442 | ISZ GETBYTE /BUMP PAST <EOF> RETURN | |
443 | GETEOF, ISZ GETBYTE /BUMP PAST I/O ERROR RETURN | |
444 | JMP I GETBYTE /RETURN TO MAIN CALLER | |
445 | \f PAGE | |
446 | \f/ GET A DECODED WORD ROUTINE. | |
447 | ||
448 | GETWORD,.-. /GET A WORD ROUTINE | |
449 | JMP I GWNEXT /GO WHERE YOU SHOULD GO | |
450 | ||
451 | GWNEXT, .-. /EXIT ROUTINE | |
452 | SNL /SKIP IF CHECKSUM PREVENTED | |
453 | JMS I (DOCHECK) /ELSE DO CHECKSUM | |
454 | JMP I GETWORD /RETURN TO MAIN CALLER | |
455 | ||
456 | / COMES HERE TO PROCESSED COMPRESSED DATA. | |
457 | ||
458 | GWX, JMS I (GETCHR) /GET NEXT CHARACTER | |
459 | JMS I (GWORD0) /GET 12-BIT WORD | |
460 | JMS I (DOCHECK) /INCLUDE IN CHECKSUM | |
461 | DCA GWVALUE /SAVE AS COMPRESSED VALUE | |
462 | TAD GWTMP2 /GET LATEST CHARACTER | |
463 | AND [7] /ISOLATE BITS[9-11] | |
464 | CLL RTR;RTR /BITS[9-11] => AC[0-2] | |
465 | DCA GWTMP1 /SAVE FOR NOW | |
466 | JMS GBIHEXBINARY /GET A CHARACTER | |
467 | CLL RTL;RTL /BITS[7-11] => AC[3-7] | |
468 | TAD GWTMP1 /ADD ON BITS[0-2] | |
469 | JMS I (DOCHECK) /INCLUDE IN CHECKSUM | |
470 | CLL RTR;RTR /BITS[0-7] => AC[4-11] | |
471 | SNA /SKIP IF NOT 256 | |
472 | TAD [400] /000 => 256 | |
473 | CIA /INVERT FOR COUNTING | |
474 | DCA GWTMP1 /SAVE AS REPEAT COUNTER | |
475 | GWXLUP, TAD GWVALUE /GET THE VALUE | |
476 | STL /PREVENT CHECKSUMMING IT | |
477 | JMS GWNEXT /RETURN IT TO THEM | |
478 | ISZ GWTMP1 /DONE ENOUGH? | |
479 | JMP GWXLUP /NO, KEEP GOING | |
480 | \f/ COMES HERE TO INITIATE ANOTHER DATA GROUP. | |
481 | ||
482 | GWLOOP, JMS I (GETCHR) /GET LATEST FILE CHARACTER | |
483 | TAD (-"Z!200) /COMPARE TO EOF INDICATOR | |
484 | SNA /SKIP IF OTHER | |
485 | JMP GWZ /JUMP IF IT MATCHES | |
486 | TAD (-"X+"Z) /COMPARE TO COMPRESSION INDICATOR | |
487 | SNA CLA /SKIP IF OTHER | |
488 | JMP GWX /JUMP IF IT MATCHES | |
489 | TAD PUTEMP /GET THE CHARACTER BACK | |
490 | JMS I (GWORD0) /GET A 12-BIT WORD | |
491 | JMS GWNEXT /RETURN IT | |
492 | JMS I (GWORD1) /GET NEXT 12-BIT WORD | |
493 | JMS GWNEXT /RETURN IT | |
494 | JMS I (GWORD2) /GET NEXT 12-BIT WORD | |
495 | JMS GWNEXT /RETURN IT | |
496 | JMS I (GWORD3) /GET NEXT 12-BIT WORD | |
497 | JMS GWNEXT /RETURN IT | |
498 | JMS I (GWORD4) /GET NEXT 12-BIT WORD | |
499 | JMS GWNEXT /RETURN IT | |
500 | JMP GWLOOP /KEEP GOING | |
501 | ||
502 | / COMES HERE WHEN EOF INDICATOR FOUND. | |
503 | ||
504 | GWZ, TAD (FCHKSUM-1) /SETUP THE | |
505 | DCA XR1 /CHECKSUM POINTER | |
506 | JMS I (GETCHR) /GET NEXT CHARACTER | |
507 | JMS I (GWORD0) /GET A 12-BIT WORD | |
508 | DCA I XR1 /STORE IT | |
509 | JMS I (GWORD1) /GET NEXT WORD | |
510 | DCA I XR1 /STORE IT | |
511 | JMS I (GWORD2) /GET NEXT WORD | |
512 | DCA I XR1 /STORE IT | |
513 | JMS I (GWORD3) /GET NEXT WORD | |
514 | DCA I XR1 /STORE IT | |
515 | JMS I (GWORD4) /GET NEXT WORD | |
516 | DCA I XR1 /STORE IT | |
517 | TAD (CHKSUM-1) /POINT TO | |
518 | DCA XR1 /CALCULATED CHECKSUM | |
519 | TAD (FCHKSUM-1) /POINT TO | |
520 | DCA XR2 /FILE CHECKSUM | |
521 | TAD [-5] /SETUP THE | |
522 | DCA CCNT /COMPARE COUNT | |
523 | CLL /CLEAR LINK FOR TEST | |
524 | GWCMPLP,RAL /GET CARRY | |
525 | TAD I XR1 /GET A CALCULATED WORD | |
526 | TAD I XR2 /COMPARE TO FILE WORD | |
527 | SZA CLA /SKIP IF OK | |
528 | JMP I (DECERR) /ELSE COMPLAIN | |
529 | ISZ CCNT /DONE ALL? | |
530 | JMP GWCMPLP /NO, KEEP GOING | |
531 | \f/ THE CHECKSUM IS OK, CHECK IF FILE ENDED IN A PLAUSIBLE PLACE. | |
532 | ||
533 | TAD PUTPTR /GET OUTPUT POINTER | |
534 | TAD (-OUTBUFFER-4) /COMPARE TO LIMIT | |
535 | SMA SZA CLA /SKIP IF GOOD VALUE | |
536 | JMP I (DECERROR) /JUMP IF NOT | |
537 | ||
538 | / THE FILE ENDED OK, THERE WERE POSSIBLY A FEW CHARACTERS LEFTOVER BECAUSE OF | |
539 | / ALIGNMENT CONSIDERATIONS. THEY SHOULD BE IGNORED SINCE OS/8 FILES ARE | |
540 | / MULTIPLES OF WHOLE RECORDS. | |
541 | ||
542 | JMP I (DECBMP) /RETURN WITH ALL OK | |
543 | ||
544 | GBIHEXB,.-. /GET BINARY VALUE OF BIHEXADECIMAL CHARACTER | |
545 | CLA /CLEAN UP | |
546 | TAD GBIHEXBINARY /GET OUR CALLER | |
547 | DCA BIHEXBINARY /MAKE IT THEIRS | |
548 | JMS I (GETCHR) /GET A CHARACTER | |
549 | SKP /DON'T EXECUTE HEADER! | |
550 | ||
551 | BIHEXBI,.-. /CONVERT BIHEXADECIMAL TO BINARY | |
552 | TAD (-"A!200) /COMPARE TO ALPHABETIC LIMIT | |
553 | SMA /SKIP IF LESS | |
554 | TAD ("9+1-"A) /ELSE ADD ON ALPHABETIC OFFSET | |
555 | TAD (-"0+"A) /MAKE IT BINARY, NOT ASCII | |
556 | DCA GWTMP2 /SAVE IT | |
557 | TAD GWTMP2 /GET IT BACK | |
558 | JMP I BIHEXBINARY /RETURN | |
559 | ||
560 | PAGE | |
561 | \f/ GET WORD[0] ROUTINE. AC MUST ALREADY CONTAIN THE FIRST BI-HEXADECIMAL | |
562 | / CHARACTER. | |
563 | ||
564 | GWORD0, .-. /GET 12-BIT WORD[0] | |
565 | JMS I (BIHEXBINARY) /CONVERT PASSED VALUE TO BINARY | |
566 | CLL RTR;RTR;RTR /BITS[7-11] => AC[0-4] | |
567 | DCA GWTMP1 /SAVE FOR NOW | |
568 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
569 | CLL RTL /BITS[7-11] => AC[5-9] | |
570 | TAD GWTMP1 /ADD ON BITS[0-4] | |
571 | DCA GWTMP1 /SAVE FOR NOW | |
572 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
573 | RTR;RAR /BITS[7-8] => AC[10-11] | |
574 | AND [3] /ISOLATE BITS[10-11] | |
575 | TAD GWTMP1 /ADD ON BITS[0-9] | |
576 | CLL /CLEAR LINK | |
577 | JMP I GWORD0 /RETURN | |
578 | ||
579 | / GET WORD[1] ROUTINE. GWORD0 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS | |
580 | / THE PREVIOUS CHARACTER. | |
581 | ||
582 | GWORD1, .-. /GET 12-BIT WORD[1] | |
583 | TAD GWTMP2 /GET PREVIOUS CHARACTER | |
584 | AND [7] /ISOLATE BITS[9-11] | |
585 | CLL RTR;RTR /BITS[9-11] => AC[0-2] | |
586 | DCA GWTMP1 /SAVE FOR NOW | |
587 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
588 | CLL RTL;RTL /BITS[7-11] => AC[3-7] | |
589 | TAD GWTMP1 /ADD ON BITS[0-2] | |
590 | DCA GWTMP1 /SAVE FOR NOW | |
591 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
592 | CLL RAR /BITS[7-10] => AC[8-11] | |
593 | TAD GWTMP1 /ADD ON BITS[0-7] | |
594 | CLL /CLEAR LINK | |
595 | JMP I GWORD1 /RETURN | |
596 | \f/ GET WORD[2] ROUTINE. GWORD1 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS | |
597 | / THE PREVIOUS CHARACTER. | |
598 | ||
599 | GWORD2, .-. /GET 12-BIT WORD[2] | |
600 | TAD GWTMP2 /GET PREVIOUS CHARACTER | |
601 | RAR;CLA RAR /BIT[11] => AC[0] | |
602 | DCA GWTMP1 /SAVE FOR NOW | |
603 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
604 | CLL RTL;RTL;RTL /BITS[7-11] => AC[1-5] | |
605 | TAD GWTMP1 /ADD ON BIT[0] | |
606 | DCA GWTMP1 /SAVE FOR NOW | |
607 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
608 | CLL RAL /BITS[7-11] => AC[6-10] | |
609 | TAD GWTMP1 /ADD ON BITS[0-5] | |
610 | DCA GWTMP1 /SAVE FOR NOW | |
611 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
612 | AND (20) /ISOLATE BIT[7] | |
613 | CLL RTR;RTR /BIT[7] => AC[11] | |
614 | TAD GWTMP1 /ADD ON BITS[0-10] | |
615 | CLL /CLEAR LINK | |
616 | JMP I GWORD2 /RETURN | |
617 | ||
618 | / GET WORD[3] ROUTINE. GWORD2 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS | |
619 | / THE PREVIOUS CHARACTER. | |
620 | ||
621 | GWORD3, .-. /GET 12-BIT WORD[3] | |
622 | TAD GWTMP2 /GET PREVIOUS CHARACTER | |
623 | CLL RTR;RTR;RAR /BITS[8-11] => AC[0-3] | |
624 | DCA GWTMP1 /SAVE FOR NOW | |
625 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
626 | CLL RTL;RAL /BITS[7-11] => AC[4-8] | |
627 | TAD GWTMP1 /ADD ON BITS[0-3] | |
628 | DCA GWTMP1 /SAVE FOR NOW | |
629 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
630 | RTR /BITS[7-9] => AC[9-11] | |
631 | AND [7] /ISOLATE BITS[9-11] | |
632 | TAD GWTMP1 /ADD ON BITS[0-8] | |
633 | CLL /CLEAR LINK | |
634 | JMP I GWORD3 /RETURN | |
635 | \f/ GET WORD[4] ROUTINE. GWORD3 MUST HAVE BEEN CALLED LAST, SO GWTMP2 CONTAINS | |
636 | / THE PREVIOUS CHARACTER. | |
637 | ||
638 | GWORD4, .-. /GET 12-BIT WORD[4] | |
639 | TAD GWTMP2 /GET PREVIOUS CHARACTER | |
640 | AND [3] /ISOLATE BITS[10-11] | |
641 | CLL RTR;RAR /BITS[10-11] => AC[0-1] | |
642 | DCA GWTMP1 /SAVE FOR NOW | |
643 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
644 | CLL RTL;RTL;RAL /BITS[7-11] => AC[2-6] | |
645 | TAD GWTMP1 /ADD ON BITS[0-1] | |
646 | DCA GWTMP1 /SAVE FOR NOW | |
647 | JMS I (GBIHEXBINARY) /GET NEXT CHARACTER IN BINARY | |
648 | TAD GWTMP1 /ADD ON BITS[0-6] TO BITS[7-11] | |
649 | CLL /CLEAR LINK | |
650 | JMP I GWORD4 /RETURN | |
651 | ||
652 | DOCHECK,.-. /CHECKSUM ROUTINE | |
653 | DCA CSUMTMP /SAVE PASSED VALUE | |
654 | TAD (CHKSUM-1) /SETUP THE | |
655 | DCA XR1 /INPUT POINTER | |
656 | TAD (CHKSUM-1) /SETUP THE | |
657 | DCA XR2 /OUTPUT POINTER | |
658 | TAD [-5] /SETUP THE | |
659 | DCA CCNT /SUM COUNT | |
660 | TAD CSUMTMP /GET THE VALUE | |
661 | CLL RAR /ADJUST FOR OPENING ITERATION | |
662 | CSUMLUP,RAL /GET CARRY | |
663 | TAD I XR1 /ADD ON A WORD | |
664 | DCA I XR2 /STORE BACK | |
665 | ISZ CCNT /DONE ALL YET? | |
666 | JMP CSUMLUP /NO, KEEP GOING | |
667 | TAD CSUMTMP /GET LATEST VALUE | |
668 | JMP I DOCHECK /RETURN | |
669 | ||
670 | PAGE | |
671 | \fGETCHR, .-. /GET A VALID CHARACTER ROUTINE | |
672 | GETMORE,TAD INITFLAG /GET INITIALIZE FLAG | |
673 | JMS I [GETBYTE] /GET A CHARACTER | |
674 | JMP I (DECERR) /I/O ERROR | |
675 | JMP I (DECERR) /<EOF> | |
676 | DCA PUTEMP /SAVE THE CHARACTER | |
677 | DCA INITFLAG /CLEAR INITIALIZE FLAG | |
678 | TAD DSTATE /GET DATA STATE | |
679 | SPA /SKIP IF NOT ONE OF THE DATA-ORIENTED STATES | |
680 | TAD (4004) /ADD ON DATA-ORIENTED STATES OFFSET | |
681 | TAD (JMP I P) /SETUP JUMP INSTRUCTION | |
682 | DCA .+1 /STORE IN-LINE | |
683 | .-. /AND EXECUTE IT | |
684 | ||
685 | / LOOKING FOR OPENING CHARACTER. | |
686 | ||
687 | SCANIT, TAD PUTEMP /GET THE CHARACTER | |
688 | TAD (-"<!200) /COMPARE TO OPENING DATA CHARACTER | |
689 | SNA /SKIP IF NO MATCH | |
690 | JMP FNDATA /JUMP IF IT MATCHES | |
691 | TAD (-"(+"<) /COMPARE TO OPENING COMMAND CHARACTER | |
692 | SNA CLA /SKIP IF NO MATCH | |
693 | ISZ DSTATE /INDICATE LOOKING FOR END OF COMMAND | |
694 | JMP GETMORE /KEEP GOING | |
695 | ||
696 | / FOUND OPENING COMMAND CHARACTER. | |
697 | ||
698 | FNDCOMM,TAD PUTEMP /GET THE CHARACTER | |
699 | TAD (-")!200) /COMPARE TO CLOSING COMMAND CHARACTER | |
700 | SNA CLA /SKIP IF NO MATCH | |
701 | ISZ DSTATE /INDICATE LOOKING FOR <CR> | |
702 | JMP GETMORE /KEEP GOING | |
703 | ||
704 | / FOUND CLOSING COMMAND CHARACTER. | |
705 | ||
706 | FNDCEND,TAD PUTEMP /GET THE CHARACTER | |
707 | TAD (-"M!300) /COMPARE TO <CR> | |
708 | SNA CLA /SKIP IF NO MATCH | |
709 | ISZ DSTATE /INDICATE LOOKING FOR <LF> | |
710 | JMP GETMORE /KEEP GOING | |
711 | ||
712 | / FOUND <CR> AFTER COMMAND. | |
713 | ||
714 | FNDCR, TAD PUTEMP /GET THE CHARACTER | |
715 | TAD (-"J!300) /COMPARE TO <LF> | |
716 | SNA CLA /SKIP IF NO MATCH | |
717 | DCA DSTATE /RESET TO SCANNING STATE | |
718 | JMP GETMORE /KEEP GOING | |
719 | \f/ FOUND OPENING DATA CHARACTER. | |
720 | ||
721 | FNDATA, TAD (-WIDTH) /SETUP THE | |
722 | DCA DATCNT /DATA COUNTER | |
723 | NL4000 /SETUP THE | |
724 | DCA DSTATE /NEW STATE | |
725 | JMP GETMORE /KEEP GOING | |
726 | ||
727 | / PROCESSING ONE OF 69 DATA CHARACTERS. | |
728 | ||
729 | STORDAT,TAD PUTEMP /GET THE CHARACTER | |
730 | TAD [-140] /SUBTRACT UPPER-CASE LIMIT | |
731 | SPA /SKIP IF LOWER-CASE | |
732 | TAD [40] /RESTORE UPPER-CASE | |
733 | TAD (100) /RESTORE THE CHARACTER | |
734 | DCA PUTEMP /SAVE IT BACK | |
735 | TAD PUTEMP /GET IT AGAIN | |
736 | TAD (-"Z!200-1) /SUBTRACT UPPER LIMIT | |
737 | CLL /CLEAR LINK FOR TEST | |
738 | TAD ("Z-"A+1) /ADD ON RANGE | |
739 | SZL CLA /SKIP IF NOT ALPHABETIC | |
740 | JMP ALPHAOK /JUMP IF ALPHABETIC | |
741 | TAD PUTEMP /GET THE CHARACTER | |
742 | TAD (-"9!200-1) /ADD ON UPPER LIMIT | |
743 | CLL /CLEAR LINK FOR TEST | |
744 | TAD ("9-"0+1) /ADD ON RANGE | |
745 | SNL CLA /SKIP IF OK | |
746 | JMP GETMORE /IGNORE IF NOT | |
747 | ALPHAOK,TAD PUTEMP /GET THE CHARACTER | |
748 | ISZ DATCNT /DONE 69 CHARACTERS? | |
749 | SKP /SKIP IF NOT | |
750 | ISZ DSTATE /ADVANCE TO NEXT STATE | |
751 | JMP I GETCHR /RETURN | |
752 | ||
753 | / PROCESSED 69 DATA CHARACTERS; NOW LOOKING FOR ENDING DATA CHARACTER. | |
754 | ||
755 | ENDATA, TAD PUTEMP /GET THE CHARACTER | |
756 | TAD (-">!200) /COMPARE TO ENDING DATA VALUE | |
757 | SNA CLA /SKIP IF NO MATCH | |
758 | ISZ DSTATE /ELSE ADVANCE TO NEXT STATE | |
759 | JMP GETMORE /KEEP GOING | |
760 | ||
761 | / FOUND ENDING DATA CHARACTER; NOW LOOKING FOR <CR>. | |
762 | ||
763 | ENDCR, TAD PUTEMP /GET THE CHARACTER | |
764 | TAD (-"M!300) /COMPARE TO <CR> | |
765 | SNA CLA /SKIP IF NO MATCH | |
766 | ISZ DSTATE /ELSE ADVANCE TO NEXT STATE | |
767 | JMP GETMORE /KEEP GOING | |
768 | \f/ FOUND ENDING DATA CHARACTER AND <CR>; NOW LOOKING FOR <LF>. | |
769 | ||
770 | /ENDLF, TAD PUTEMP /GET THE CHARACTER | |
771 | / TAD (-"J!300) /COMPARE TO <LF> | |
772 | / SNA CLA /SKIP IF NO MATCH | |
773 | / DCA DSTATE /RESET TO SCANNING STATE | |
774 | / JMP GETMORE /KEEP GOING | |
775 | ||
776 | CLRCHKS,.-. /CLEAR CALCULATED CHECKSUM ROUTINE | |
777 | DCA CHKSUM+0 /CLEAR LOW-ORDER | |
778 | DCA CHKSUM+1 /CLEAR NEXT | |
779 | DCA CHKSUM+2 /CLEAR NEXT | |
780 | DCA CHKSUM+3 /CLEAR NEXT | |
781 | DCA CHKSUM+4 /CLEAR HIGH-ORDER | |
782 | JMP I CLRCHKSUM /RETURN | |
783 | ||
784 | PAGE | |
785 | \fGEOFILE,.-. /GET OUTPUT FILE ROUTINE | |
786 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
787 | SZA CLA /SKIP IF NOT ESTABLISHED YET | |
788 | JMP GOTOD /JUMP IF DETERMINED ALREADY | |
789 | TAD ("D^100+"S-300) /GET BEGINNING OF "DSK" | |
790 | DCA DEVNAME /STORE IN-LINE | |
791 | TAD ("K^100) /GET REST OF "DSK" | |
792 | DCA DEVNAME+1 /STORE IN-LINE | |
793 | DCA RETVAL /CLEAR HANDLER ENTRY WORD | |
794 | CDF PRGFLD /INDICATE OUR FIELD | |
795 | CIF USRFLD /GOTO USR FIELD | |
796 | JMS I [USR] /CALL USR ROUTINE | |
797 | INQUIRE /INQUIRE ABOUT HANDLER | |
798 | DEVNAME,ZBLOCK 2 /WILL BE DEVICE DSK | |
799 | RETVAL, .-. /BECOMES HANDLER ENTRY POINT WORD | |
800 | HLT /DSK: NOT IN SYSTEM IS IMPOSSIBLE! | |
801 | TAD DEVNAME+1 /GET DEVICE NUMBER FOR DSK: | |
802 | AND [17] /JUST DEVICE BITS | |
803 | DCA ODNUMBER /STORE OUTPUT DEVICE | |
804 | GOTOD, CDF TBLFLD /BACK TO TABLE FIELD | |
805 | TAD I (OUTFILE+1) /GET OUTPUT FILE FIRST NAME WORD | |
806 | SNA /SKIP IF PRESENT | |
807 | JMP GFLNAME /JUMP IF NOT | |
808 | DCA FNAME /MOVE TO OUR AREA | |
809 | TAD I (OUTFILE+2) /GET SECOND NAME WORD | |
810 | DCA FNAME+1 /MOVE IT | |
811 | TAD I (OUTFILE+3) /GET THIRD NAME WORD | |
812 | DCA FNAME+2 /MOVE IT | |
813 | TAD I (OUTFILE+4) /GET EXTENSION WORD | |
814 | DCA FNAME+3 /MOVE IT | |
815 | GEOFXIT,CDF PRGFLD /BACK TO OUR FIELD | |
816 | JMP I GEOFILE /RETURN | |
817 | ||
818 | / WE MUST TAKE THE FILENAME FROM THE IMBEDDED (FILE ) COMMAND. THE ONLY | |
819 | / EXCEPTION IS IF WE ARE DOING AN IMAGE TRANSFER. | |
820 | ||
821 | GFLNAME,TAD I (SWAL) /GET /A-/L SWITCHES | |
822 | AND (10) /JUST /I BIT | |
823 | SZA CLA /SKIP IF NOT SET | |
824 | TAD I [EQUWRD] /GET EQUALS PARAMETER | |
825 | SNA /SKIP IF SET TO SOMETHING | |
826 | JMP DOFLNAME /JUMP IF PARAMETERS NOT SET | |
827 | CMA /INVERT IT | |
828 | DCA DANGCNT /STORE AS DANGER COUNT | |
829 | ISZ IMSW /SET IMAGE-MODE SWITCH | |
830 | TAD I [SWY9] /GET /Y-/9 SWITCHES | |
831 | AND (600) /JUST /1, /2 SWITCHES | |
832 | SNA /SKIP IF EITHER SET | |
833 | JMP GEOFXIT /JUMP IF NEITHER SET | |
834 | AND [400] /JUST /1 SWITCH | |
835 | SNA CLA /SKIP IF /1 SET | |
836 | JMP IM2 /JUMP IF /2 SET | |
837 | TAD I [EQUWRD] /GET EQUALS PARAMETER | |
838 | CLL RAR /%2 | |
839 | JMP IMCOMMON /CONTINUE THERE | |
840 | \fIM2, TAD I [EQUWRD] /GET EQUALS PARAMETER | |
841 | CLL RAR /%2 | |
842 | CIA /SUBTRACT PART 1 VALUE | |
843 | TAD I [EQUWRD] /FROM EQUALS PARAMETER | |
844 | IMCOMMO,CMA /INVERT IT | |
845 | DCA DANGCNT /STORE AS DANGER COUNT | |
846 | JMP GEOFXIT /EXIT THERE | |
847 | ||
848 | DOFLNAM,CDF PRGFLD /BACK TO OUR FIELD | |
849 | NL7777 /SETUP THE | |
850 | DCA INITFLAG /INPUT FILE INITIALIZATION | |
851 | JMS I (SCNFILE) /SCAN OFF "(FILE" | |
852 | ||
853 | / HAVING FOUND THE (FILE ) COMMAND, WE MUST FIND THE FILENAME. | |
854 | ||
855 | / ZERO OUT THE FILENAME AREA. | |
856 | ||
857 | TAD (-10) /SETUP THE | |
858 | DCA CHRCNT /CLEAR COUNTER | |
859 | TAD (ONAME-1) /SETUP THE | |
860 | DCA XR1 /POINTER | |
861 | JMS I (CLRNAME) /CLEAR THE NAME BUFFER | |
862 | ||
863 | / SETUP FOR SCANNING THE NAME PORTION. | |
864 | ||
865 | TAD (-6) /SETUP THE | |
866 | DCA CHRCNT /SCAN COUNT | |
867 | TAD (ONAME-1) /SETUP THE | |
868 | DCA XR1 /POINTER | |
869 | FNCAGN, JMS I (GETAN) /GET A CHARACTER | |
870 | JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD | |
871 | DCA I XR1 /STASH THE CHARACTER | |
872 | ISZ CHRCNT /DONE ALL YET? | |
873 | JMP FNCAGN /NO, KEEP GOING | |
874 | ||
875 | / THROW AWAY EXTRA NAME CHARACTERS. | |
876 | ||
877 | TOSSNAM,JMS I (GETAN) /GET A CHARACTER | |
878 | JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD | |
879 | JMP TOSSNAME /KEEP GOING | |
880 | ||
881 | / COMES HERE AFTER "." FOUND. | |
882 | ||
883 | GOTSEPA,JMS I (CLRNAME) /CLEAR OUT THE REMAINING NAME FIELD | |
884 | NL7776 /SETUP THE | |
885 | DCA CHRCNT /SCAN COUNT | |
886 | EXCAGN, JMS I (GETAN) /GET A CHARACTER | |
887 | JMP I [CHARERROR] /GOT "."; COMPLAIN | |
888 | DCA I XR1 /STASH THE CHARACTER | |
889 | ISZ CHRCNT /DONE ENOUGH YET? | |
890 | JMP EXCAGN /NO, KEEP GOING | |
891 | \f/ TOSS ANY EXTRA EXTENSION CHARACTERS. | |
892 | ||
893 | TOSSEXT,JMS I (GETAN) /GET A CHARACTER | |
894 | JMP I [CHARERROR] /GOT "."; COMPLAIN | |
895 | JMP TOSSEXTENSION /KEEP GOING | |
896 | ||
897 | / COMES HERE WHEN TRAILING ")" IS FOUND. | |
898 | ||
899 | GOTRPAR,JMS I (CLRNAME) /CLEAR ANY REMAINING EXTENSION CHARACTERS | |
900 | TAD I (ONAME) /GET THE FIRST CHARACTER | |
901 | SNA CLA /SKIP IF SOMETHING THERE | |
902 | JMP I [CHARERROR] /COMPLAIN IF NONE THERE | |
903 | TAD (ONAME-1) /SETUP POINTER | |
904 | DCA XR1 /TO NAME CHARACTERS | |
905 | TAD (FNAME-1) /SETUP POINTER | |
906 | DCA XR2 /TO PACKED NAME AREA | |
907 | TAD (-4) /SETUP THE | |
908 | DCA CHRCNT /MOVE COUNT | |
909 | CHRLOOP,TAD I XR1 /GET FIRST CHARACTER | |
910 | CLL RTL;RTL;RTL /MOVE UP | |
911 | TAD I XR1 /ADD ON SECOND CHARACTER | |
912 | DCA I XR2 /STORE THE PAIR | |
913 | ISZ CHRCNT /DONE YET? | |
914 | JMP CHRLOOP /NO, KEEP GOING | |
915 | JMP I GEOFILE /YES, RETURN | |
916 | ||
917 | PAGE | |
918 | \fSCNFILE,.-. /SCAN "(FILE" ROUTINE | |
919 | MATAGN, JMS GETNSPC /GET A CHARACTER | |
920 | TAD (-"(!200) /COMPARE TO "(" | |
921 | SZA CLA /SKIP IF IT MATCHES | |
922 | JMP MATAGN /JUMP IF NOT | |
923 | JMS GETNSPC /GET NEXT CHARACTER | |
924 | TAD (-"F!300) /COMPARE TO "F" | |
925 | SZA CLA /SKIP IF IT MATCHES | |
926 | JMP MATAGN /JUMP IF NOT | |
927 | JMS GETNSPC /GET NEXT CHARACTER | |
928 | TAD (-"I!300) /COMPARE TO "I" | |
929 | SZA CLA /SKIP IF IT MATCHES | |
930 | JMP MATAGN /JUMP IF NOT | |
931 | JMS GETNSPC /GET NEXT CHARACTER | |
932 | TAD (-"L!300) /COMPARE TO "L" | |
933 | SZA CLA /SKIP IF IT MATCHES | |
934 | JMP MATAGN /JUMP IF NOT | |
935 | JMS GETNSPC /GET NEXT CHARACTER | |
936 | TAD (-"E!300) /COMPARE TO "E" | |
937 | SZA CLA /SKIP IF IT MATCHES | |
938 | JMP MATAGN /JUMP IF NOT | |
939 | JMP I SCNFILE /RETURN | |
940 | ||
941 | CLRNAME,.-. /NAME FIELD CLEARING ROUTINE | |
942 | TAD CHRCNT /GET CHARACTER COUNTER | |
943 | SNA CLA /SKIP IF ANY TO CLEAR | |
944 | JMP I CLRNAME /ELSE JUST RETURN | |
945 | DCA I XR1 /CLEAR A NAME WORD | |
946 | ISZ CHRCNT /COUNT IT | |
947 | JMP .-2 /KEEP GOING | |
948 | JMP I CLRNAME /RETURN | |
949 | ||
950 | GETNSPC,.-. /GET NON-<SPACE> CHARACTER | |
951 | GETNAGN,JMS GETCHAR /GET A CHARACTER | |
952 | TAD (-" !200) /COMPARE TO <SPACE> | |
953 | SNA CLA /SKIP IF OTHER | |
954 | JMP GETNAGN /JUMP IF IT MATCHES | |
955 | TAD PUTEMP /GET THE CHARACTER BACK | |
956 | JMP I GETNSPC /RETURN | |
957 | ||
958 | GETCHAR,.-. /GET A CHARACTER ROUTINE | |
959 | CLA /CLEAN UP | |
960 | TAD INITFLAG /GET INITIALIZE FLAG | |
961 | JMS I [GETBYTE] /GET A CHARACTER | |
962 | JMP I (NIOERROR) /COMPLAIN IF AN ERROR | |
963 | JMP I [CHARERROR] /COMPLAIN IF <EOF> REACHED | |
964 | TAD [-140] /COMPARE TO LOWER-CASE LIMIT | |
965 | SPA /SKIP IF LOWER-CASE | |
966 | TAD [40] /RESTORE ORIGINAL IF UPPER-CASE | |
967 | AND (77) /JUST SIX-BIT | |
968 | DCA PUTEMP /SAVE IN CASE WE NEED IT | |
969 | DCA INITFLAG /CLEAR INITIALIZE FLAG | |
970 | TAD PUTEMP /GET IT BACK | |
971 | JMP I GETCHAR /RETURN | |
972 | \fGETAN, .-. /GET ALPHANUMERIC ROUTINE | |
973 | JMS GETNSPC /GET A NON-<SPACE> CHARACTER | |
974 | TAD (-".!200) /COMPARE TO "." | |
975 | SNA /SKIP IF OTHER | |
976 | JMP I GETAN /TAKE FIRST RETURN IF IT MATCHES | |
977 | TAD (-")+".) /COMPARE TO ")" | |
978 | SNA /SKIP IF OTHER | |
979 | JMP I (GOTRPAREN) /TAKE DEDICATED RETURN IF IT MATCHES | |
980 | TAD (-":+")) /SUBTRACT UPPER LIMIT | |
981 | CLL /CLEAR LINK FOR TEST | |
982 | TAD (":-"0) /ADD ON RANGE | |
983 | SZL CLA /SKIP IF NOT NUMERIC | |
984 | JMP GETANOK /JUMP IF NUMERIC | |
985 | TAD PUTEMP /GET THE CHARACTER BACK | |
986 | TAD (-"[!300) /SUBTRACT UPPER LIMIT | |
987 | CLL /CLEAR LINK FOR TEST | |
988 | TAD ("[-"A) /ADD ON RANGE | |
989 | SNL CLA /SKIP IF ALPHABETIC | |
990 | JMP I [CHARERROR] /ELSE COMPLAIN | |
991 | GETANOK,TAD PUTEMP /GET GOOD ALPHANUMERIC CHARACTER | |
992 | ISZ GETAN /BUMP TO SKIP RETURN | |
993 | JMP I GETAN /RETURN | |
994 | ||
995 | ONAME, ZBLOCK 10 /OUTPUT NAME FIELD | |
996 | ||
997 | FENTER, .-. /FILE ENTER ROUTINE | |
998 | TAD (FNAME) /POINT TO | |
999 | DCA ENTAR1 /STORED FILENAME | |
1000 | DCA ENTAR2 /CLEAR SECOND ARGUMENT | |
1001 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER | |
1002 | CIF USRFLD /GOTO USR FIELD | |
1003 | JMS I [USR] /CALL USR ROUTINE | |
1004 | ENTER /ENTER TENTATIVE FILENAME | |
1005 | ENTAR1, .-. /WILL POINT TO FILENAME | |
1006 | ENTAR2, .-. /WILL BE ZERO | |
1007 | JMP I (ENTERR) /ENTER ERROR | |
1008 | TAD ENTAR2 /GET RETURNED EMPTY LENGTH | |
1009 | IAC /ADD 2-1 FOR OS/278 CRAZINESS | |
1010 | DCA DANGCNT /STORE AS DANGER COUNT | |
1011 | TAD ENTAR1 /GET RETURNED FIRST RECORD | |
1012 | DCA OUTRECORD /SETUP OUTPUT RECORD | |
1013 | JMP I FENTER /RETURN | |
1014 | \f PAGE | |
1015 | ||
1016 | $ /THAT'S ALL FOLK! |