| 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! |