| 1 | / OS/8 BOO DECODING PROGRAM |
| 2 | |
| 3 | / LAST EDIT: 22-OCT-1991 12:00:00 CJL |
| 4 | |
| 5 | / MAY BE ASSEMBLED WITH '/F' SWITCH SET. |
| 6 | |
| 7 | / PROGRAM TO DECODE OS/8 FILES FROM "PRINTABLE" ASCII (".BOO") FORMAT TO |
| 8 | / BINARY-IMAGE FORMAT. INTERMEDIATE "ASCII" CONVERSION SHOULD BE HARMLESS AS |
| 9 | / LONG AS ALL PRINTING DATA CHARACTERS ARE NOT MODIFIED. |
| 10 | |
| 11 | / DISTRIBUTED BY CUCCA AS "K12DEB.PAL" AS PART OF THE CUCCA KERMIT-12 PACKAGE. |
| 12 | |
| 13 | / WRITTEN BY: |
| 14 | |
| 15 | / CHARLES LASNER (CJL) |
| 16 | / CLA SYSTEMS |
| 17 | / 72-55 METROPOLITAN AVENUE |
| 18 | / MIDDLE VILLAGE, NEW YORK 11379-2107 |
| 19 | / (718) 894-6499 |
| 20 | |
| 21 | / USAGE: |
| 22 | |
| 23 | / THIS PROGRAM OPERATES ON "PRINTABLE" ASCII FILES WHICH HAVE BEEN CREATED BY |
| 24 | / ENCODING THE CONTENTS OF ARBITRARY (BINARY) FILES. THE ENCODING FORMAT ALLOWS |
| 25 | / FOR CERTAIN "WHITE SPACE" MODIFICATIONS SUCH AS LINE WIDTH REFORMATTING AS |
| 26 | / LONG AS ALL PRINTING CHARACTERS ARE UNMODIFIED. EXTRANEOUS <CR>/<LF> PAIRS |
| 27 | / AND ALL OTHER CONTROL CHARACTERS (<FF>, <VT>, ETC.) ARE IGNORED. |
| 28 | |
| 29 | / WHEN CREATING THE DESCENDANT DECODED FILE, THE USER MAY SPECIFY EITHER THE |
| 30 | / IMBEDDED FILENAME OR AN ALTERNATE FILENAME ON EITHER THE DEFAULT (DSK:) DEVICE |
| 31 | / OR A SPECIFIED DEVICE: |
| 32 | |
| 33 | / .RUN DEV DEBOO INVOKE PROGRAM. |
| 34 | / *INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DSK: (DEFAULT). |
| 35 | / *DEV:OUTPUT.EX<INPUT INPUT IS DECODED INTO OUTPUT.EX ON DEVICE DEV:. |
| 36 | / *DEV:<INPUT INPUT IS DECODED INTO IMBEDDED NAME ON DEVICE DEV:. |
| 37 | / *OUTPUT.EX<INPUT$ INPUT IS DECODED INTO OUTPUT.EX ON DSK: (DEFAULT). |
| 38 | / THE <ESC> CHARACTER WAS USED TO TERMINATE THE LINE |
| 39 | / (THIS IS SIGNIFIED BY $). THIS CAUSES PROGRAM EXIT. |
| 40 | / . PROGRAM EXITS NORMALLY. |
| 41 | |
| 42 | / INPUT FILE ASSUMES .BO EXTENSION; THERE IS NO ASSUMED OUTPUT EXTENSION. |
| 43 | |
| 44 | / PROGRAM EXIT IS THE NORMAL OS/8 METHOD OF EITHER PRESSING <^C> ON THE CONSOLE |
| 45 | / KEYBOARD DURING THE COMMAND, OR ENDING THE COMMAND INPUT LINE WITH AN <ESC> |
| 46 | / CHARACTER. |
| 47 | \f/ .BOO FORMAT IMPLEMENTATION DESCRIPTION. |
| 48 | |
| 49 | / THIS PROGRAM SUPPORTS STANDARD .BOO FORMAT ENCODED FILES AND OPTIONALLY THE |
| 50 | / USE OF LENGTH CORRECTION BYTES AT THE FILE'S END TO ENSURE PROPER LENGTH. IF |
| 51 | / NO LENGTH CORRECTION FIELDS ARE FOUND, IT IS ASSUMED THEY AREN'T NEEDED; IT |
| 52 | / IS THE RESPONIBILITY OF THE ENCODER TO INSERT THESE FIELDS IF NECESSARY. OS/8 |
| 53 | / FILES PROPERLY ENCODED BY THE COMPANION ENBOO-ING PROGRAM (ENBOO AKA K12ENB) |
| 54 | / WILL CONTAIN SUCH BYTES AS NECESSARY, AND WILL BE PROPERLY DECODED INTO THEIR |
| 55 | / ORIGINAL FORM WITHOUT LOSS. ALL OTHER FILES WILL BE <NUL>-PADDED AS NECESSARY |
| 56 | / TO ROUND-UP THE FILE SIZE TO A NUMBER OF COMPLETE OS/8 RECORDS; THEIR |
| 57 | / ORIGINAL LENGTH WILL BE LOST. |
| 58 | |
| 59 | / **** WARNING **** USE OF ENBOO-ING PROGRAMS NOT COMPATIBLE WITH THE OPTIONAL |
| 60 | / LENGTH CORRECTION SCHEME CAN PRODUCE FILES DRASTICALLY DIFFERENT FROM THE |
| 61 | / ORIGINAL; AN ENTIRE OS/8 RECORD CONTAINING <NUL> CHARACTERS COULD BE APPENDED |
| 62 | / TO THE END OF THE FILES. BEYOND THE WASTE OF DISK SPACE, THESE DEFECTIVE |
| 63 | / FILES COULD ACTUALLY BE DANGEROUS TO USE UNDER OS/8. |
| 64 | |
| 65 | / ORDINARILY THESE FILES SHOULDN'T EXIST, BUT COULD BE CREATED BY METHODS SUCH |
| 66 | / AS DECODING ON OTHER SYSTEMS FOLLOWED BY USE OF ENCODERS INCOMPATIBLE WITH THE |
| 67 | / LENGTH CORRECTION SCHEME. THIS TENDS TO MAKE THE FILE SIZE WRONG BY ONE OR |
| 68 | / TWO BYTES, WHICH WHEN DECODED HERE WILL CAUSE THE CREATION OF AN ENTIRE |
| 69 | / ERRONEOUS RECORD. IT IS RECOMMENDED THAT FILES STORED ON OTHER SYSTEMS FOR |
| 70 | / EVENTUALLY DELIVERY TO OS/8 SYSTEMS BE MAINTAINED IN .BOO FORMAT TO PREVENT |
| 71 | / THIS FORM OF FILE CORRUPTION. |
| 72 | |
| 73 | / ERROR MESSAGES. |
| 74 | |
| 75 | / ANY MESSAGE PRINTED IS A FATAL ERROR MESSAGE. ALL MESSAGES ARE THE STANDARD |
| 76 | / OS/8 "USER" ERROR MESSAGES OF THE FORM: USER ERROR X AT AAAAA WHERE X IS THE |
| 77 | / ERROR NUMBER AND AAAAA IS THE PROGRAM ADDRESS WHERE THE ERROR WAS DETECTED. |
| 78 | / THE FOLLOWING USER ERRORS ARE DEFINED: |
| 79 | |
| 80 | / ERROR NUMBER PROBABLE CAUSE |
| 81 | |
| 82 | / 0 TOO MANY OUTPUT FILES. |
| 83 | |
| 84 | / 1 NO INPUT FILE OR TOO MANY INPUT FILES. |
| 85 | |
| 86 | / 2 IMBEDDED OUTPUT FILENAME FORMAT ERROR. |
| 87 | |
| 88 | / 3 I/O ERROR WHILE LOCATING IMBEDDED OUTPUT FILENAME. |
| 89 | |
| 90 | / 4 ERROR WHILE FETCHING FILE HANDLER. |
| 91 | |
| 92 | / 5 ERROR WHILE ATTEMPTING TO ENTER OUTPUT FILE. |
| 93 | |
| 94 | / 6 OUTPUT FILE LARGER THAN AVAILABLE FILE SPACE. |
| 95 | |
| 96 | / 7 ERROR WHILE CLOSING THE OUTPUT FILE. |
| 97 | |
| 98 | / 8 I/O ERROR WHILE DECODING FILE DATA OR BAD DATA. |
| 99 | |
| 100 | / 9 OUTPUT ERROR WHILE DECODING FILE DATA. |
| 101 | \f/ ASSEMBLY INSTRUCTIONS. |
| 102 | |
| 103 | / IT IS ASSUMED THE SOURCE FILE K12DEB.PAL HAS BEEN MOVED AND RENAMED TO |
| 104 | / DSK:DEBOO.PA. |
| 105 | |
| 106 | / .PAL DEBOO<DEBOO/E/F ASSEMBLE SOURCE PROGRAM |
| 107 | / .LOAD DEBOO LOAD THE BINARY FILE |
| 108 | / .SAVE DEV DEBOO=0 SAVE THE CORE-IMAGE FILE |
| 109 | \f/ DEFINITIONS. |
| 110 | |
| 111 | CLOSE= 4 /CLOSE OUTPUT FILE |
| 112 | DECODE= 5 /CALL COMMAND DECODER |
| 113 | ENTER= 3 /ENTER TENTATIVE FILE |
| 114 | FETCH= 1 /FETCH HANDLER |
| 115 | IHNDBUF=7200 /INPUT HANDLER BUFFER |
| 116 | INBUFFE=6200 /INPUT BUFFER |
| 117 | INFILE= 7617 /INPUT FILE INFORMATION HERE |
| 118 | INQUIRE=12 /INQUIRE ABOUT HANDLER |
| 119 | NL0001= CLA IAC /LOAD AC WITH 0001 |
| 120 | NL0002= CLA CLL CML RTL /LOAD AC WITH 0002 |
| 121 | NL7776= CLA CLL CMA RAL /LOAD AC WITH 7776 |
| 122 | NL7777= CLA CMA /LOAD AC WITH 7777 |
| 123 | OHNDBUF=6600 /OUTPUT HANDLER BUFFER |
| 124 | OUTBUFF=5600 /OUTPUT BUFFER |
| 125 | OUTFILE=7600 /OUTPUT FILE INFORMATION HERE |
| 126 | PRGFLD= 00 /PROGRAM FIELD |
| 127 | RESET= 13 /RESET SYSTEM TABLES |
| 128 | SBOOT= 7600 /MONITOR EXIT |
| 129 | TBLFLD= 10 /COMMAND DECODER TABLE FIELD |
| 130 | TERMWRD=7642 /TERMINATOR WORD |
| 131 | USERROR=7 /USER SIGNALLED ERROR |
| 132 | USR= 7700 /USR ENTRY POINT |
| 133 | USRFLD= 10 /USR FIELD |
| 134 | WRITE= 4000 /I/O WRITE BIT |
| 135 | \f *0 /START AT THE BEGINNING |
| 136 | |
| 137 | *10 /DEFINE AUTO-INDEX AREA |
| 138 | |
| 139 | XR1, .-. /AUTO-INDEX NUMBER 1 |
| 140 | XR2, .-. /AUTO-INDEX NUMBER 2 |
| 141 | |
| 142 | *20 /GET PAST AUTO-INDEX AREA |
| 143 | |
| 144 | BUFPTR, .-. /INPUT BUFFER POINTER |
| 145 | BYTES, ZBLOCK 3 /DATA BYTES |
| 146 | CHRCNT, .-. /CHARACTER COUNTER |
| 147 | CMPCNT, .-. /COMPRESSION COUNTER |
| 148 | DANGCNT,.-. /DANGER COUNT |
| 149 | DATCNT, .-. /DATA COUNTER |
| 150 | IDNUMBE,.-. /INPUT DEVICE NUMBER |
| 151 | INPUT, .-. /INPUT HANDLER POINTER |
| 152 | INRECOR,.-. /INPUT RECORD |
| 153 | FNAME, ZBLOCK 4 /OUTPUT FILENAME |
| 154 | GETBERR,.-. /ERROR ROUTINE POINTER FOR GETBYTE ROUTINE |
| 155 | LATEST, .-. /LATEST OUTPUT BYTE |
| 156 | ODNUMBE,.-. /OUTPUT DEVICE NUMBER |
| 157 | ONAME, ZBLOCK 10 /OUTPUT NAME FIELD |
| 158 | OUTPUT, .-. /OUTPUT HANDLER POINTER |
| 159 | OUTRECO,.-. /OUTPUT RECORD |
| 160 | PUTEMP, .-. /INPUT TEMPORARY |
| 161 | PUTPTR, .-. /OUTPUT POINTER |
| 162 | TEMPTR, .-. /TERMPORARY OUTPUT POINTER |
| 163 | THIRD, .-. /THIRD BYTE TEMPORARY |
| 164 | |
| 165 | \f PAGE /START AT THE USUAL PLACE |
| 166 | |
| 167 | BEGIN, NOP /HERE IN CASE WE'RE CHAINED TO |
| 168 | CLA /CLEAN UP |
| 169 | START, CIF USRFLD /GOTO USR FIELD |
| 170 | JMS I [USR] /CALL USR ROUTINE |
| 171 | DECODE /WANT COMMAND DECODER |
| 172 | "B^100+"O-300 /.BO IS DEFAULT EXTENSION |
| 173 | CDF TBLFLD /GOTO TABLE FIELD |
| 174 | TAD I (TERMWRD) /GET TERMINATOR WORD |
| 175 | SPA CLA /SKIP IF <CR> TERMINATED THE LINE |
| 176 | DCA EXITZAP /ELSE CAUSE EXIT LATER |
| 177 | TAD I (OUTFILE) /GET FIRST OUTPUT FILE DEVICE WORD |
| 178 | SNA /SKIP IF FIRST OUTPUT FILE PRESENT |
| 179 | JMP TSTMORE /JUMP IF NOT THERE |
| 180 | AND [17] /JUST DEVICE BITS |
| 181 | ODNULL, DCA ODNUMBER /SAVE OUTPUT DEVICE NUMBER |
| 182 | TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD |
| 183 | SNA /SKIP IF THERE |
| 184 | TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD |
| 185 | SZA CLA /SKIP IF BOTH NOT PRESENT |
| 186 | JMP OUTERR /ELSE COMPLAIN |
| 187 | TAD I (INFILE) /GET FIRST INPUT FILE DEVICE WORD |
| 188 | SNA /SKIP IF PRESENT |
| 189 | JMP INERR /JUMP IF NOT |
| 190 | AND [17] /JUST DEVICE BITS |
| 191 | DCA IDNUMBER /SAVE INPUT DEVICE NUMBER |
| 192 | TAD I (INFILE+2) /GET SECOND INPUT FILE DEVICE WORD |
| 193 | SZA CLA /SKIP IF ONLY ONE INPUT FILE |
| 194 | JMP INERR /ELSE COMPLAIN |
| 195 | TAD I (INFILE+1) /GET FIRST INPUT FILE STARTING RECORD |
| 196 | DCA INRECORD /SET IT UP |
| 197 | CDF PRGFLD /BACK TO OUR FIELD |
| 198 | CIF USRFLD /GOTO USR FIELD |
| 199 | JMS I [USR] /CALL USR ROUTINE |
| 200 | RESET /RESET SYSTEM TABLES |
| 201 | \f TAD (IHNDBUFFER+1) /GET INPUT BUFFER POINTER+TWO-PAGE BIT |
| 202 | DCA IHPTR /STORE IN-LINE |
| 203 | TAD IDNUMBER /GET INPUT DEVICE NUMBER |
| 204 | CIF USRFLD /GOTO USR FIELD |
| 205 | JMS I [USR] /CALL USR ROUTINE |
| 206 | FETCH /FETCH HANDLER |
| 207 | IHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT |
| 208 | JMP FERROR /FETCH ERROR |
| 209 | TAD IHPTR /GET RETURNED ADDRESS |
| 210 | DCA INPUT /STORE AS INPUT HANDLER ADDRESS |
| 211 | JMS I (GEOFILE) /GET OUTPUT FILE INFORMATION |
| 212 | TAD (OHNDBUFFER+1) /GET BUFFER POINTER+TWO-PAGE BIT |
| 213 | DCA OHPTR /STORE IN-LINE |
| 214 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER |
| 215 | CIF USRFLD /GOTO USR FIELD |
| 216 | JMS I [USR] /CALL USR ROUTINE |
| 217 | FETCH /FETCH HANDLER |
| 218 | OHPTR, .-. /WILL BE BUFFER POINTER+TWO-PAGE BIT |
| 219 | JMP FERROR /FETCH ERROR |
| 220 | TAD OHPTR /GET RETURNED ADDRESS |
| 221 | DCA OUTPUT /STORE AS OUTPUT HANDLER ADDRESS |
| 222 | TAD (FNAME) /POINT TO |
| 223 | DCA ENTAR1 /STORED FILENAME |
| 224 | DCA ENTAR2 /CLEAR SECOND ARGUMENT |
| 225 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER |
| 226 | CIF USRFLD /GOTO USR FIELD |
| 227 | JMS I [USR] /CALL USR ROUTINE |
| 228 | ENTER /ENTER TENTATIVE FILENAME |
| 229 | ENTAR1, .-. /WILL POINT TO FILENAME |
| 230 | ENTAR2, .-. /WILL BE ZERO |
| 231 | JMP ENTERR /ENTER ERROR |
| 232 | TAD ENTAR1 /GET RETURNED FIRST RECORD |
| 233 | DCA OUTRECORD /STORE IT |
| 234 | TAD ENTAR2 /GET RETURNED EMPTY LENGTH |
| 235 | IAC /ADD 2-1 FOR OS/278 CRAZINESS |
| 236 | DCA DANGCNT /STORE AS DANGER COUNT |
| 237 | JMS I (DECODIT) /GO DO THE ACTUAL DECODING |
| 238 | JMP PROCERR /ERROR WHILE DECODING |
| 239 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER |
| 240 | CIF USRFLD /GOTO USR FIELD |
| 241 | JMS I [USR] /CALL USR ROUTINE |
| 242 | CLOSE /CLOSE OUTPUT FILE |
| 243 | FNAME /POINTER TO FILENAME |
| 244 | OUTCNT, .-. /WILL BE ACTUAL COUNT |
| 245 | JMP CLSERR /CLOSE ERROR |
| 246 | EXITZAP,JMP START /**** <ESC> TERMINATION **** 0000 |
| 247 | JMP I (SBOOT) /EXIT TO MONITOR |
| 248 | \f/ OUTPUT FILE ERROR WHILE PROCESSING. |
| 249 | |
| 250 | OERROR, TAD [3] /SET INCREMENT |
| 251 | SKP /DON'T USE NEXT |
| 252 | |
| 253 | / ERROR WHILE PROCESSING INPUT FILE. |
| 254 | |
| 255 | PROCERR,NL0002 /SET INCREMENT |
| 256 | SKP /DON'T USE NEXT |
| 257 | |
| 258 | / ERROR WHILE CLOSING THE OUTPUT FILE. |
| 259 | |
| 260 | CLSERR, NL0001 /SET INCREMENT |
| 261 | SKP /DON'T CLEAR IT |
| 262 | |
| 263 | / OUTPUT FILE TOO LARGE ERROR. |
| 264 | |
| 265 | SIZERR, CLA /CLEAN UP |
| 266 | TAD [3] /SET INCREMENT |
| 267 | SKP /DON'T USE NEXT |
| 268 | |
| 269 | / ENTER ERROR. |
| 270 | |
| 271 | ENTERR, NL0002 /SET INCREMENT |
| 272 | SKP /DON'T USE NEXT |
| 273 | |
| 274 | / HANDLER FETCH ERROR. |
| 275 | |
| 276 | FERROR, NL0001 /SET INCREMENT |
| 277 | |
| 278 | / I/O ERROR WHILE PROCESSING IMBEDDED FILENAME. |
| 279 | |
| 280 | NIOERR, IAC /SET INCREMENT |
| 281 | |
| 282 | / FORMAT ERROR WHILE PROCESSING IMBEDDED FILENAME. |
| 283 | |
| 284 | CHARERR,IAC /SET INCREMENT |
| 285 | |
| 286 | / INPUT FILESPEC ERROR. |
| 287 | |
| 288 | INERR, IAC /SET INCREMENT |
| 289 | |
| 290 | / OUTPUT FILESPEC ERROR. |
| 291 | |
| 292 | OUTERR, DCA ERRNUMBER /STORE ERROR NUMBER |
| 293 | CDF PRGFLD /ENSURE OUR FIELD |
| 294 | CIF USRFLD /GOTO USR FIELD |
| 295 | JMS I [USR] /CALL USR ROUTINE |
| 296 | USERROR /USER ERROR |
| 297 | ERRNUMB,.-. /WILL BE PASSED ERROR NUMBER |
| 298 | \f/ COMES HERE TO TEST FOR NULL LINE. |
| 299 | |
| 300 | TSTMORE,TAD I (OUTFILE+5) /GET SECOND OUTPUT FILE DEVICE WORD |
| 301 | SNA /SKIP IF PRESENT |
| 302 | TAD I (OUTFILE+12) /ELSE GET THIRD OUTPUT FILE DEVICE WORD |
| 303 | SZA CLA /SKIP IF NO OUTPUT FILES |
| 304 | JMP OUTERR /ELSE COMPLAIN OF SECOND/THIRD (WITHOUT FIRST) OUTPUT |
| 305 | TAD I (INFILE) /GET FIRST OUTPUT FILE DEVICE WORD |
| 306 | SZA CLA /SKIP IF NO INPUT FILES |
| 307 | JMP ODNULL /JUMP IF INPUT WITHOUT OUTPUT |
| 308 | CDF PRGFLD /BACK TO OUR FIELD |
| 309 | JMP EXITZAP /MIGHT BE LAST TIME, SO GO THERE FIRST |
| 310 | |
| 311 | PAGE |
| 312 | \fDECODIT,.-. /DECODING ROUTINE |
| 313 | TAD (DECERR) /SETUP THE |
| 314 | DCA GETBERROR /GETBYTE ERROR ROUTINE |
| 315 | DCA DATCNT /CLEAR DATA COUNT |
| 316 | NL7777 /SETUP FOR INITIALIZING |
| 317 | JMS I (PUTBYTE) /INITIALIZE OUTPUT FILE |
| 318 | LOOP, JMS GETCHR /GET A CHARACTER |
| 319 | JMP ENDIT /WEREN'T ANY MORE |
| 320 | TAD (-176) /COMPARE TO TILDE |
| 321 | SZA CLA /SKIP IF IT MATCHES |
| 322 | JMP DATPROCESS /JUMP IF NOT |
| 323 | JMS GETCHR /GET A CHARACTER |
| 324 | DECERR, JMP I DECODIT /WASN'T ANY |
| 325 | TAD (-"0!200) /REMOVE PRINTING OFFSET |
| 326 | SNA /SKIP IF SIGNIFICENT COMPRESSION |
| 327 | JMP DATCORRECT /JUMP IF NOT |
| 328 | CIA /INVERT FOR COUNTING |
| 329 | DCA CMPCNT /SAVE COMPRESSION COUNT |
| 330 | JMS DATOUT /OUTPUT DATA FIELD (IF ANY) AND CLEAR DATA COUNT |
| 331 | COMPLP, JMS I (PUTBYTE) /OUTPUT A <NUL> BYTE |
| 332 | ISZ CMPCNT /DONE YET? |
| 333 | JMP COMPLP /NO, KEEP GOING |
| 334 | JMP LOOP /YES, GO BACK FOR MORE FILE ITEMS |
| 335 | |
| 336 | / ZERO-LENGTH COMPRESSION (CORRECTION) FIELD FOUND. |
| 337 | |
| 338 | DATCORR,NL7777 /BACKUP |
| 339 | TAD DATCNT /NOW HAVE CORRECTED DATA COUNT |
| 340 | SPA /SKIP IF COUNT WASN'T ZERO |
| 341 | JMP LOOP /IGNORE BECAUSE THERE IS NO DATA |
| 342 | SNA /SKIP IF ENOUGH TO CORRECT |
| 343 | JMP I DECODIT /TAKE ERROR RETURN IF NOT |
| 344 | DCA DATCNT /STORE CORRECTED COUNT |
| 345 | JMP LOOP /GO BACK FOR MORE FILE ITEMS |
| 346 | \f/ UN-COMPRESSED DATA FOUND. |
| 347 | |
| 348 | DATPROC,JMS DATOUT /OUTPUT PREVIOUS DATA FIELD (IF ANY), CLEAR DATA COUNT |
| 349 | TAD PUTEMP /GET LATEST BACK |
| 350 | TAD (-"0!200) /REMOVE DIGIT OFFSET |
| 351 | CLL RTL /MOVE UP |
| 352 | DCA BYTES /STORE IT |
| 353 | JMS GETCHR /GET NEXT CHARACTER |
| 354 | JMP I DECODIT /WASN'T ANY |
| 355 | AND (17) /JUST LOW-ORDER BITS |
| 356 | CLL RTL;RTL /MOVE UP |
| 357 | DCA BYTES+1 /STORE IT |
| 358 | TAD PUTEMP /GET IT AGAIN |
| 359 | RTR;RTR /MOVE DOWN |
| 360 | IAC /REMOVE DIGIT BIAS |
| 361 | AND (3) /JUST GOOD BITS |
| 362 | TAD BYTES /GET OLD BITS |
| 363 | DCA BYTES /STORE COMPOSITE |
| 364 | JMS GETCHR /GET NEXT CHARACTER |
| 365 | JMP I DECODIT /WASN'T ANY |
| 366 | TAD (-"0!200) /REMOVE DIGIT OFFSET |
| 367 | RTR /MOVE DOWN |
| 368 | AND (17) /ISOLATE GOOD BITS |
| 369 | TAD BYTES+1 /GET OLD BITS |
| 370 | DCA BYTES+1 /STORE COMPOSITE |
| 371 | TAD PUTEMP /GET IT AGAIN |
| 372 | AND (3) /ISOLATE GOOD BITS |
| 373 | CLL RTL;RTL;RTL /MOVE UP |
| 374 | DCA BYTES+2 /STORE IT |
| 375 | JMS GETCHR /GET NEXT CHARACTER |
| 376 | JMP I DECODIT /WASN'T ANY |
| 377 | TAD (-"0!200) /REMOVE DIGIT OFFSET |
| 378 | TAD BYTES+2 /GET OLD BITS |
| 379 | DCA BYTES+2 /STORE COMPOSITE |
| 380 | TAD (3) /SETUP THE |
| 381 | DCA DATCNT /DATA COUNT |
| 382 | JMP LOOP /GO GET NEXT FILE ITEM |
| 383 | |
| 384 | / COMES HERE AT END-OF-FILE. |
| 385 | |
| 386 | ENDIT, JMS DATOUT /OUTPUT ANY LEFTOVER DATA |
| 387 | SKP /DON'T OUTPUT YET |
| 388 | CLOSLUP,JMS I (PUTBYTE) /OUTPUT A <NUL> BYTE |
| 389 | TAD PUTPTR /GET THE OUTPUT BUFFER POINTER |
| 390 | TAD (-OUTBUFFER) /COMPARE TO RESET VALUE |
| 391 | SZA CLA /SKIP IF IT MATCHES |
| 392 | JMP CLOSLUP /ELSE KEEP GOING |
| 393 | ISZ DECODIT /BUMP TO GOOD RETURN |
| 394 | JMP I DECODIT /RETURN TO CALLER |
| 395 | \fDATOUT, .-. /DATA OUTPUT ROUTINE |
| 396 | TAD DATCNT /GET CURRENT DATA COUNT |
| 397 | CMA /SETUP FOR COUNTING |
| 398 | DCA DATCNT /STORE IT |
| 399 | TAD (BYTES-1) /POINT TO |
| 400 | DCA XR1 /DATA AREA |
| 401 | JMP DATEST /CHECK BEFORE OUTPUTTING |
| 402 | |
| 403 | DATLUP, TAD I XR1 /GET A BYTE |
| 404 | JMS I (PUTBYTE) /OUTPUT IT |
| 405 | DATEST, ISZ DATCNT /DONE YET? |
| 406 | JMP DATLUP /NO, KEEP GOING |
| 407 | JMP I DATOUT /YES, RETURN TO CALLER |
| 408 | |
| 409 | GETCHR, .-. /GET A CHARACTER ROUTINE |
| 410 | GETCAGN,CLA /GET A CHARACTER |
| 411 | JMS I [GETBYTE] /GET A CHARACTER FROM FILE |
| 412 | JMP I GETCHR /WASN'T ANY, TAKE IMMEDIATE RETURN |
| 413 | TAD [-" !200] /COMPARE TO <SPACE> |
| 414 | SPA SNA CLA /SKIP IF NOT CONTROL CHARACTER OR <SPACE> |
| 415 | JMP GETCAGN /GO GET ANOTHER ONE |
| 416 | TAD PUTEMP /GET GOOD CHARACTER |
| 417 | ISZ GETCHR /BUMP RETURN ADDRESS |
| 418 | JMP I GETCHR /RETURN TO CALLER |
| 419 | |
| 420 | PAGE |
| 421 | \fPUTBYTE,.-. /OUTPUT A BYTE ROUTINE |
| 422 | SPA /ARE WE INITIALIZING? |
| 423 | JMP PUTINITIALIZE /YES |
| 424 | AND (377) /JUST IN CASE |
| 425 | DCA LATEST /SAVE LATEST CHARACTER |
| 426 | TAD LATEST /GET LATEST CHARACTER |
| 427 | JMP I PUTNEXT /GO WHERE YOU SHOULD GO |
| 428 | |
| 429 | PUTNEXT,.-. /EXIT ROUTINE |
| 430 | JMP I PUTBYTE /RETURN TO MAIN CALLER |
| 431 | |
| 432 | PUTINIT,CLA /CLEAN UP |
| 433 | TAD OUTRECORD /GET STARTING RECORD OF TENTATIVE FILE |
| 434 | DCA PUTRECORD /STORE IN-LINE |
| 435 | DCA I (OUTCNT) /CLEAR ACTUAL FILE LENGTH |
| 436 | PUTNEWR,TAD POUTBUFFER/(OUTBUFFER) /SETUP THE |
| 437 | DCA PUTPTR /BUFFER POINTER |
| 438 | PUTLOOP,JMS PUTNEXT /GET A CHARACTER |
| 439 | DCA I PUTPTR /STORE IT |
| 440 | TAD PUTPTR /GET POINTER VALUE |
| 441 | DCA TEMPTR /SAVE FOR LATER |
| 442 | ISZ PUTPTR /BUMP TO NEXT |
| 443 | JMS PUTNEXT /GET A CHARACTER |
| 444 | DCA I PUTPTR /STORE IT |
| 445 | JMS PUTNEXT /GET A CHARACTER |
| 446 | RTL;RTL /MOVE UP |
| 447 | AND [7400] /ISOLATE HIGH NYBBLE |
| 448 | TAD I TEMPTR /ADD ON FIRST BYTE |
| 449 | DCA I TEMPTR /STORE COMPOSITE |
| 450 | TAD LATEST /GET LATEST CHARACTER |
| 451 | RTR;RTR;RAR /MOVE UP AND |
| 452 | AND [7400] /ISOLATE LOW NYBBLE |
| 453 | TAD I PUTPTR /ADD ON SECOND BYTE |
| 454 | DCA I PUTPTR /STORE COMPOSITE |
| 455 | ISZ PUTPTR /BUMP TO NEXT |
| 456 | TAD PUTPTR /GET LATEST POINTER VALUE |
| 457 | TAD (-2^200-OUTBUFFER) /COMPARE TO LIMIT |
| 458 | SZA CLA /SKIP IF AT END |
| 459 | JMP PUTLOOP /KEEP GOING |
| 460 | ISZ DANGCNT /TOO MANY RECORDS? |
| 461 | SKP /SKIP IF NOT |
| 462 | JMP I (SIZERR) /JUMP IF SO |
| 463 | JMS I OUTPUT /CALL I/O HANDLER |
| 464 | 2^100+WRITE /WRITE SOME PAGES FROM OUTPUT BUFFER |
| 465 | POUTBUF,OUTBUFFER /BUFFER ADDRESS |
| 466 | PUTRECO,.-. /WILL BE LATEST RECORD NUMBER |
| 467 | JMP I (OERROR) /OUTPUT ERROR! |
| 468 | ISZ I (OUTCNT) /BUMP ACTUAL LENGTH |
| 469 | ISZ PUTRECORD /BUMP TO NEXT RECORD |
| 470 | JMP PUTNEWRECORD /KEEP GOING |
| 471 | \f/ OS/8 FILE UNPACK ROUTINE. |
| 472 | |
| 473 | GETBYTE,.-. /GET A BYTE ROUTINE |
| 474 | SNA CLA /INITIALIZING? |
| 475 | JMP I PUTC /NO, GO GET NEXT BYTE |
| 476 | TAD INRECORD /GET STARTING RECORD OF INPUT FILE |
| 477 | DCA GETRECORD /STORE IN-LINE |
| 478 | GETNEWR,JMS I INPUT /CALL I/O HANDLER |
| 479 | 2^100 /READ TWO PAGES INTO BUFFER |
| 480 | PINBUFF,INBUFFER /BUFFER ADDRESS |
| 481 | GETRECO,.-. /WILL BE LATEST RECORD NUMBER |
| 482 | JMP I GETBERROR /INPUT ERROR! |
| 483 | TAD PINBUFFER/(INBUFFER) /SETUP THE |
| 484 | DCA BUFPTR /BUFFER POINTER |
| 485 | GETLOOP,DCA THIRD /CLEAR THIRD BYTE NOW |
| 486 | JMS PUTONE /OBTAIN AND SEND BACK FIRST BYTE |
| 487 | JMS PUTONE /OBTAIN AND SEND BACK SECOND BYTE |
| 488 | TAD THIRD /GET THIRD BYTE |
| 489 | JMS PUTC /SEND IT BACK |
| 490 | TAD BUFPTR /GET THE POINTER |
| 491 | TAD (-2^200-INBUFFER) /COMPARE TO LIMIT |
| 492 | SZA CLA /SKIP IF AT END |
| 493 | JMP GETLOOP /KEEP GOING |
| 494 | ISZ GETRECORD /BUMP TO NEXT RECORD |
| 495 | JMP GETNEWRECORD /GO DO ANOTHER ONE |
| 496 | |
| 497 | PUTONE, .-. /SEND BACK A BYTE ROUTINE |
| 498 | TAD I BUFPTR /GET LATEST WORD |
| 499 | AND [7400] /JUST THIRD-BYTE NYBBLE |
| 500 | CLL RAL /MOVE UP |
| 501 | TAD THIRD /GET OLD NYBBLE (IF ANY) |
| 502 | RTL;RTL /MOVE UP NYBBLE BITS |
| 503 | DCA THIRD /SAVE FOR NEXT TIME |
| 504 | TAD I BUFPTR /GET LATEST WORD AGAIN |
| 505 | JMS PUTC /SEND BACK CURRENT BYTE |
| 506 | ISZ BUFPTR /BUMP TO NEXT WORD |
| 507 | JMP I PUTONE /RETURN |
| 508 | |
| 509 | PUTC, .-. /SEND BACK LATEST BYTE ROUTINE |
| 510 | AND (177) /KEEP ONLY GOOD BITS |
| 511 | DCA PUTEMP /SAVE IT |
| 512 | TAD PUTEMP /GET IT BACK |
| 513 | TAD (-"Z!300) /COMPARE TO <^Z> |
| 514 | SNA CLA /SKIP IF NOT ASCII <EOF> |
| 515 | JMP I GETBYTE /RETURN IF ASCII MODE <EOF> |
| 516 | TAD PUTEMP /RESTORE THE CHARACTER |
| 517 | ISZ GETBYTE /BUMP PAST <EOF> RETURN |
| 518 | JMP I GETBYTE /RETURN TO MAIN CALLER |
| 519 | \f PAGE |
| 520 | \fGEOFILE,.-. /GET OUTPUT FILE ROUTINE |
| 521 | TAD ODNUMBER /GET OUTPUT DEVICE NUMBER |
| 522 | SZA CLA /SKIP IF NOT ESTABLISHED YET |
| 523 | JMP GOTOD /JUMP IF DETERMINED ALREADY |
| 524 | TAD ("D^100+"S-300) /GET BEGINNING OF "DSK" |
| 525 | DCA DEVNAME /STORE IN-LINE |
| 526 | TAD ("K^100) /GET REST OF "DSK" |
| 527 | DCA DEVNAME+1 /STORE IN-LINE |
| 528 | DCA RETVAL /CLEAR HANDLER ENTRY WORD |
| 529 | CDF PRGFLD /INDICATE OUR FIELD |
| 530 | CIF USRFLD /GOTO USR FIELD |
| 531 | JMS I [USR] /CALL USR ROUTINE |
| 532 | INQUIRE /INQUIRE ABOUT HANDLER |
| 533 | DEVNAME,ZBLOCK 2 /WILL BE DEVICE DSK |
| 534 | RETVAL, .-. /BECOMES HANDLER ENTRY POINT WORD |
| 535 | HLT /DSK: NOT IN SYSTEM IS IMPOSSIBLE! |
| 536 | TAD DEVNAME+1 /GET DEVICE NUMBER FOR DSK: |
| 537 | AND [17] /JUST DEVICE BITS |
| 538 | DCA ODNUMBER /STORE OUTPUT DEVICE |
| 539 | GOTOD, JMS SCANAME /SCAN OFF FILE NAME |
| 540 | CDF TBLFLD /BACK TO TABLE FIELD |
| 541 | TAD I (OUTFILE+1) /GET OUTPUT FILE FIRST NAME WORD |
| 542 | SNA /SKIP IF PRESENT |
| 543 | JMP GFLNAME /JUMP IF NOT |
| 544 | DCA FNAME /MOVE TO OUR AREA |
| 545 | TAD I (OUTFILE+2) /GET SECOND NAME WORD |
| 546 | DCA FNAME+1 /MOVE IT |
| 547 | TAD I (OUTFILE+3) /GET THIRD NAME WORD |
| 548 | DCA FNAME+2 /MOVE IT |
| 549 | TAD I (OUTFILE+4) /GET EXTENSION WORD |
| 550 | DCA FNAME+3 /MOVE IT |
| 551 | CDF PRGFLD /BACK TO OUR FIELD |
| 552 | JMP I GEOFILE /RETURN |
| 553 | |
| 554 | / WE MUST TAKE THE FILENAME FROM THE IMBEDDED FILENAME SUPPLIED. |
| 555 | |
| 556 | GFLNAME,CDF PRGFLD /BACK TO OUR FIELD |
| 557 | TAD ONAME /GET THE FIRST CHARACTER |
| 558 | SNA CLA /SKIP IF SOMETHING THERE |
| 559 | JMP I (CHARERROR) /COMPLAIN IF NONE THERE |
| 560 | TAD (ONAME-1) /SETUP POINTER |
| 561 | DCA XR1 /TO NAME CHARACTERS |
| 562 | TAD (FNAME-1) /SETUP POINTER |
| 563 | DCA XR2 /TO PACKED NAME AREA |
| 564 | TAD (-4) /SETUP THE |
| 565 | DCA CHRCNT /MOVE COUNT |
| 566 | CHRLOOP,TAD I XR1 /GET FIRST CHARACTER |
| 567 | CLL RTL;RTL;RTL /MOVE UP |
| 568 | TAD I XR1 /ADD ON SECOND CHARACTER |
| 569 | DCA I XR2 /STORE THE PAIR |
| 570 | ISZ CHRCNT /DONE YET? |
| 571 | JMP CHRLOOP /NO, KEEP GOING |
| 572 | JMP I GEOFILE /YES, RETURN |
| 573 | \fSCANAME,.-. /SCAN OFF FILENAME ROUTINE |
| 574 | TAD (NIOERROR) /SETUP THE |
| 575 | DCA GETBERROR /I/O ERROR HANDLER |
| 576 | |
| 577 | / ZERO OUT THE FILENAME AREA. |
| 578 | |
| 579 | TAD (-10) /SETUP THE |
| 580 | DCA CHRCNT /CLEAR COUNTER |
| 581 | TAD (ONAME-1) /SETUP THE |
| 582 | DCA XR1 /POINTER |
| 583 | JMS CLRNAME /CLEAR THE NAME BUFFER |
| 584 | |
| 585 | / SETUP FOR SCANNING THE NAME PORTION. |
| 586 | |
| 587 | TAD (-6) /SETUP THE |
| 588 | DCA CHRCNT /SCAN COUNT |
| 589 | TAD (ONAME-1) /SETUP THE |
| 590 | DCA XR1 /POINTER |
| 591 | NL7777 /MAKE IT INITIALIZE |
| 592 | FNCAGN, JMS I (GETAN) /GET A CHARACTER |
| 593 | JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD |
| 594 | DCA I XR1 /STASH THE CHARACTER |
| 595 | ISZ CHRCNT /DONE ALL YET? |
| 596 | JMP FNCAGN /NO, KEEP GOING |
| 597 | |
| 598 | / THROW AWAY EXTRA NAME CHARACTERS. |
| 599 | |
| 600 | TOSSNAM,JMS I (GETAN) /GET A CHARACTER |
| 601 | JMP GOTSEPARATOR /GOT "."; GOTO NEXT FIELD |
| 602 | CLA /THROW AWAY THE CHARACTER |
| 603 | JMP TOSSNAME /KEEP GOING |
| 604 | |
| 605 | / COMES HERE AFTER "." FOUND. |
| 606 | |
| 607 | GOTSEPA,JMS CLRNAME /CLEAR OUT THE REMAINING NAME FIELD |
| 608 | NL7776 /SETUP THE |
| 609 | DCA CHRCNT /SCAN COUNT |
| 610 | EXCAGN, JMS I (GETAN) /GET A CHARACTER |
| 611 | JMP I (CHARERROR) /GOT "."; COMPLAIN |
| 612 | DCA I XR1 /STASH THE CHARACTER |
| 613 | ISZ CHRCNT /DONE ENOUGH YET? |
| 614 | JMP EXCAGN /NO, KEEP GOING |
| 615 | |
| 616 | / TOSS ANY EXTRA EXTENSION CHARACTERS. |
| 617 | |
| 618 | TOSSEXT,JMS I (GETAN) /GET A CHARACTER |
| 619 | JMP I (CHARERROR) /GOT "."; COMPLAIN |
| 620 | CLA /THROW AWAY THE CHARACTER |
| 621 | JMP TOSSEXTENSION /KEEP GOING |
| 622 | |
| 623 | / COMES HERE WHEN TRAILING <CR> IS FOUND. |
| 624 | |
| 625 | GOTCR, JMS CLRNAME /CLEAR ANY REMAINING EXTENSION CHARACTERS |
| 626 | JMP I SCANAME /RETURN |
| 627 | \fCLRNAME,.-. /NAME FIELD CLEARING ROUTINE |
| 628 | TAD CHRCNT /GET CHARACTER COUNTER |
| 629 | SNA CLA /SKIP IF ANY TO CLEAR |
| 630 | JMP I CLRNAME /ELSE JUST RETURN |
| 631 | DCA I XR1 /CLEAR A NAME WORD |
| 632 | ISZ CHRCNT /COUNT IT |
| 633 | JMP .-2 /KEEP GOING |
| 634 | JMP I CLRNAME /RETURN |
| 635 | |
| 636 | PAGE |
| 637 | \fGETCHAR,.-. /GET A CHARACTER ROUTINE |
| 638 | JMS I [GETBYTE] /GET A CHARACTER |
| 639 | JMP I (CHARERROR) /COMPLAIN IF <EOF> REACHED |
| 640 | TAD (-"M!300) /COMPARE TO <CR> |
| 641 | SNA /SKIP IF OTHER |
| 642 | JMP I (GOTCR) /JUMP IF IT MATCHES |
| 643 | TAD (-140+"M-300) /COMPARE TO LOWER-CASE LIMIT |
| 644 | SPA /SKIP IF LOWER-CASE |
| 645 | TAD (40) /RESTORE ORIGINAL IF UPPER-CASE |
| 646 | AND (77) /JUST SIX-BIT |
| 647 | DCA PUTEMP /SAVE IN CASE WE NEED IT |
| 648 | TAD PUTEMP /GET IT BACK |
| 649 | JMP I GETCHAR /RETURN |
| 650 | |
| 651 | GETAN, .-. /GET ALPHANUMERIC ROUTINE |
| 652 | GETNAGN,JMS GETCHAR /GET A CHARACTER |
| 653 | TAD [-" !200] /COMPARE TO <SPACE> |
| 654 | SNA CLA /SKIP IF OTHER |
| 655 | JMP GETNAGN /JUMP IF IT MATCHES |
| 656 | TAD PUTEMP /GET THE CHARACTER BACK |
| 657 | TAD (-".!200) /COMPARE TO "." |
| 658 | SNA /SKIP IF OTHER |
| 659 | JMP I GETAN /TAKE FIRST RETURN IF IT MATCHES |
| 660 | TAD (-":+".) /SUBTRACT UPPER LIMIT |
| 661 | CLL /CLEAR LINK FOR TEST |
| 662 | TAD (":-"0) /ADD ON RANGE |
| 663 | SZL CLA /SKIP IF NOT NUMERIC |
| 664 | JMP GETANOK /JUMP IF NUMERIC |
| 665 | TAD PUTEMP /GET THE CHARACTER BACK |
| 666 | TAD (-"[!300) /SUBTRACT UPPER LIMIT |
| 667 | CLL /CLEAR LINK FOR TEST |
| 668 | TAD ("[-"A) /ADD ON RANGE |
| 669 | SNL CLA /SKIP IF ALPHABETIC |
| 670 | JMP I (CHARERROR) /ELSE COMPLAIN |
| 671 | GETANOK,TAD PUTEMP /GET GOOD ALPHANUMERIC CHARACTER |
| 672 | ISZ GETAN /BUMP TO SKIP RETURN |
| 673 | JMP I GETAN /RETURN |
| 674 | |
| 675 | PAGE |
| 676 | \f $ /THAT'S ALL FOLK! |