Trailing-Edge
-
PDP-10 Archives
-
BB-BT99V-BB_1990
-
10,7/dpatch/dpatch.mac
There is 1 other file named dpatch.mac in the archive. Click here to see a list.
TITLE DPATCH - FILE STRUCTURE DAMAGE ASSEMENT AND RESTORATION PROGRAM
SUBTTL D. P. MASTROVITO /DPM
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION
; 1988, 1989, 1990
; ALL RIGHTS RESERVED.
;
;
;THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
;ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
;INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
;COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
;OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
;TRANSFERRED.
;
;THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
;AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
;CORPORATION.
;
;DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
;SOFTWARE ON EQUIPMENT WHICH IS NOT SUPPLIED BY DIGITAL.
;VERSION NUMBERS
VERMAJ==1 ;MAJOR VERSION
VERMIN==0 ;MINOR VERSION
VEREDT==56 ;EDIT LEVEL
VERWHO==0 ;WHO LAST EDITED
SEARCH UUOSYM ;TOPS-10 UUO SYMBOLS
SALL ;CLEAN LISTINGS
.DIRECT FLBLST ;CLEANER LISTINGS
SUBTTL TABLE OF CONTENTS
; TABLE OF CONTENTS FOR DPATCH
;
;
; SECTION PAGE
; 1. TABLE OF CONTENTS......................................... 2
; 2. REVSION HISTORY........................................... 3
; 3. ASSEMBLY PARAMETERS....................................... 4
; 4. DEFINITIONS
; 4.1 BYTE MANIPULATION................................. 5
; 4.2 MESSAGE MACROS.................................... 6
; 4.3 TEXT JUSTIFICATION MACRO.......................... 7
; 4.4 COMMAND PROCESSING................................ 8
; 4.5 FORMAT DESCRIPTOR................................. 10
; 4.6 SCAN BLOCK........................................ 11
; 4.7 FILE BLOCKS....................................... 12
; 4.8 FILE I/O DATA BASE................................ 13
; 4.9 LOGICAL BLOCK NUMBERS............................. 15
; 4.10 SPECIAL PROGRAM SYMBOLS........................... 16
; 4.11 BAT BLOCK......................................... 17
; 4.12 HOM BLOCK......................................... 18
; 4.13 RIB BLOCK......................................... 21
; 4.14 UNIT BLOCKS....................................... 24
; 4.15 SAT STORAGE....................................... 25
; 4.16 DATA FILE......................................... 26
; 4.17 TASK TABLE........................................ 27
; 5. PROGRAM INITIALIZATION
; 5.1 ENTRY POINT....................................... 28
; 5.2 CHKPRV - CHECK FOR PRIVILEGES..................... 29
; 6. TOP LEVEL COMMAND PROCESSING.............................. 30
; 7. DDT COMMAND............................................... 32
; 8. DELETE COMMAND............................................ 33
; 9. DIRECT COMMAND............................................ 34
; 10. DUMP COMMAND.............................................. 45
; 11. DUMP COMMAND
; 11.1 DMP7BT - 7-BIT ASCII.............................. 52
; 11.2 DMP8BT - 8-BIT ASCII.............................. 54
; 11.3 DMPATO - AUTOMATIC BLOCK DETECTION................ 56
; 11.4 DMPBAT - BAT BLOCK................................ 57
; 11.5 DMPDEC - DECIMAL.................................. 59
; 11.6 DMPDIR - DIRECTORY................................ 60
; 11.7 DMPHOM - HOM BLOCK................................ 61
; 11.8 DMPMIX - MIXED FORMAT............................. 63
; 11.9 DMPOCT - OCTAL.................................... 65
; 11.10 DMPRIB - RIB...................................... 66
; 11.11 DMPSIX - SIXBIT................................... 69
; 11.12 DMPSPC - SPECIAL.................................. 70
; 11.13 MISCELLANEOUS..................................... 71
; 12. EXIT COMMAND.............................................. 72
; 13. FILE COMMAND.............................................. 73
; 14. FINISH COMMAND............................................ 75
; 15. FORMAT COMMAND
; 15.1 ENTRY POINT....................................... 76
; 15.2 FMTDMP - DUMP..................................... 78
; 15.3 FMTIOT - I/O TRACE................................ 80
; 16. GET COMMAND............................................... 91
; 17. HELP COMMAND.............................................. 92
; 18. PATCH COMMAND............................................. 97
; 19. PUT COMMAND............................................... 106
; 20. READ COMMAND.............................................. 107
; 21. SET COMMAND
; 21.1 .SET - ENTRY POINT................................ 108
; 21.2 SETBAT - BAT-UPDATES.............................. 110
; 21.3 SETBPR - BLOCKS-PER-READ.......................... 111
; 21.4 SETCED - CHECKSUM-ERROR........................... 112
; 21.5 SETCPI - CHECKPOINT-INTERVAL...................... 113
; 21.6 SETDFM - DUMP-FORMAT.............................. 114
; 21.7 SETEDV - ERSATZ DEVICE............................ 115
; 21.8 SETFAC - SET FILE-ACCESS.......................... 116
; 21.9 SETHOM - HOM-UPDATES.............................. 117
; 21.10 SETIBC - INHIBIT-CLEARING......................... 118
; 21.11 SETIOT - I/O TRACE................................ 119
; 21.12 SETLIP - LOGGED-IN PPN............................ 120
; 21.13 SETLKP - SET LOOKUP TYPE.......................... 121
; 21.14 SETNO - "NO" PREFIX HANDLING...................... 122
; 21.15 SETOFN - "OFF/ON" HANDLING........................ 123
; 21.16 SETPTH - PATH..................................... 124
; 21.17 SETPPN - CURRENT PPN.............................. 125
; 21.18 SETPSZ - PATCH-BUFFER-SIZE........................ 126
; 21.19 SETRNG - SET RANGE................................ 127
; 21.20 SETRIB - RIB-UPDATES.............................. 128
; 21.21 SETSAT - SAT-UPDATES.............................. 129
; 21.22 SETSRT - SORT BUFFER SIZE......................... 130
; 21.23 SETZRS - ZERO-RIBSIZ.............................. 131
; 22. START COMMAND............................................. 132
; 23. STRUCTURE COMMAND
; 23.1 .STRUC - ENTRY POINT.............................. 137
; 23.2 HOMDAT - COPY HOME BLOCK DATA..................... 139
; 23.3 HOMFIX - FIXUP INCONSISTANCIES.................... 140
; 23.4 HOMRD - READ HOM BLOCKS........................... 148
; 23.5 HOMRPT - REPORT HOM CONSISTANCY ERRORS............ 149
; 23.6 RDDISK - READ AND VALIDATE DATA................... 150
; 23.7 STRFIX - FINAL VALUE FIXUPS....................... 157
; 24. SHOW COMMAND.............................................. 159
; 25. TRANSLATE COMMAND......................................... 162
; 26. TYPE COMMAND.............................................. 174
; 27. WRITE COMMAND............................................. 175
; 28. ZERO COMMAND.............................................. 176
; 29. COMMAND SCANNING
; 29.1 C$ATOM - READ INTO ATOM BUFFER.................... 178
; 29.2 C$AYNQ - ASK A YES/NO QUESTION.................... 179
; 29.3 C$BACK - BACK UP THE BYTE PONTER.................. 180
; 29.4 C$TYI - READ A CHARACTER.......................... 181
; 29.5 C$CEOL - CHECK FOR END OF LINE.................... 182
; 29.6 C$CURR - GET CURRENT CHARACTER.................... 183
; 29.7 C$FILE - PARSE A FILESPEC......................... 184
; 29.8 C$DFIL - DEFAULT A SCAN BLOCK..................... 188
; 29.9 C$ZFIL - ZERO OUT A SCAN BLOCK.................... 189
; 29.10 C$HELP - TREE STRUCTURED HELP PROCESSOR........... 190
; 29.11 C$HLPT - TABLE DRIVEN HELP........................ 191
; 29.12 C$KEYW - READ A KEYWORD........................... 192
; 29.13 C$NUMI - READ A NUMBER............................ 194
; 29.14 C$OCTW - WILDCARDED OCTAL INPUT................... 196
; 29.15 C$OPTN - SET OPTION PARAMETERS.................... 197
; 29.16 C$READ - READ A COMMAND LINE...................... 198
; 29.17 C$RNGE - RANGE CHECK NUMBERS...................... 202
; 29.18 C$SAVE - SAVE COMMAND TABLE POINTERS.............. 203
; 29.19 C$SIXQ - QUOTED/WILD SIXBIT TEXT.................. 204
; 29.20 C$SKIP - SKIP TABS AND SPACES..................... 206
; 29.21 TBLSET - TABLE SETUP.............................. 207
; 29.22 COMMON ERROR ROUTINES............................. 208
; 30. DATA FILE PROCESSING
; 30.1 D$ACTV - CHECK FOR ACTIVE FILE.................... 209
; 30.2 D$EDVF - FIND ERSATZ DEVICE....................... 210
; 30.3 D$EDVL - LOAD ERSATZ DEVICE TABLE................. 212
; 30.4 D$EDVM - MODIFY AN ERSATZ DEVICE.................. 214
; 30.5 D$FBLK - FIND AN FB GIVEN A BLOCK................. 215
; 30.6 D$FNUM - FIND AN FB GIVEN A FILE NUMBER........... 216
; 30.7 D$RBAT - READ BAT BLOCKS.......................... 217
; 30.8 D$SORT - SORT FILE BLOCKS......................... 218
; 30.9 D$FILE - OPEN DATA FILE........................... 226
; 30.10 D$INIT - INITIALIZE PARAMETERS.................... 232
; 30.11 D$RBTS - READ BOOT BLOCKS......................... 233
; 30.12 D$RHOM - READ HOM BLOCKS.......................... 234
; 30.13 D$RRIB - READ RETRIEVAL INFORMATION BLOCKS........ 235
; 30.14 D$RSAT - READ SAT BLOCKS.......................... 240
; 30.15 D$IOER - REPORT I/O ERROR......................... 247
; 30.16 D$RHDR/D$WHDR - READ/WRITE HEADER................. 248
; 30.17 D$READ - READ A BLOCK............................. 249
; 30.18 D$WRIT - WRITE A BLOCK............................ 250
; 30.19 D$SHWD - SHOW DATA FILE INFO...................... 251
; 30.20 D$SERR - SHOW ERROR SUMMARY....................... 252
; 30.21 D$SSAT - SHOW SAT-BLOCKS.......................... 255
; 30.22 D$SDMP - SHOW DUMP DESCRIPTORS.................... 256
; 30.23 D$SIOT - SHOW I/O TRACE DESCRIPTORS............... 257
; 30.24 D$SHWE - SHOW ERSATZ DEVICES...................... 259
; 30.25 D$SHWP - SHOW PARAMETERS.......................... 260
; 30.26 D$SHPT - SHOW PATCH DATA.......................... 263
; 30.27 D$SHWS - SHOW STRUCTURE DATA...................... 264
; 30.28 D$TSKS - SCHEDULE A TASK.......................... 265
; 30.29 D$VARS - SET VARIOUS RUNTIME VARIABLES............ 266
; 30.30 D$VGET - ALLOCATE VARIABLE STORAGE................ 269
; 30.31 D$VGIV - DEALLOCATE VARIABLE STORAGE.............. 270
; 30.32 D$WILD - DO WILDCARD COMPARRISIONS................ 271
; 31. FILE SERVICE
; 31.1 F$ADVP - ADVANCE POSITION WITHIN FILE............. 272
; 31.2 F$BLKS - CONVERT UNIT/BLOCK TO STRUCTURE.......... 273
; 31.3 F$BLKU - CONVERT BLOCK NUMBER TO UNIT............. 274
; 31.4 F$BUFS - BUFFER SETUP............................. 275
; 31.5 F$CHKS - GENERATE A CHECKSUM...................... 276
; 31.6 F$CLOS - CLOSE A FILE............................. 277
; 31.7 F$CVTF - CONVERT FILE BLOCK TO SCAN BLOCK......... 278
; 31.8 F$DEL - DELETE A FILE............................. 279
; 31.9 F$ECOD - STORE AN ERROR CODE...................... 281
; 31.10 F$ETXT - RETURN ERROR TEXT........................ 282
; 31.11 F$FIN - FINISH I/O PROCESSING..................... 283
; 31.12 F$FMOD - FETCH WILDCARD MODE...................... 284
; 31.13 F$FSCN - FIXUP SCAN BLOCK DEFAULTS................ 285
; 31.14 F$RHOM - READ A HOM BLOCK......................... 289
; 31.15 F$IBUF - INPUT.................................... 290
; 31.16 F$IBYT - INPUT A BYTE............................. 291
; 31.17 F$INI - INITIAL FOR FILE I/O...................... 292
; 31.18 F$LKP - LOOKUP.................................... 293
; 31.19 F$OBUF - OUTPUT................................... 302
; 31.20 F$OBYT - OUTPUT A BYTE............................ 303
; 31.21 F$POS - POSITION FOR I/O.......................... 304
; 31.22 F$RBAT - READ A BAT BLOCK......................... 305
; 31.23 F$RSET - RESET FILE SYSTEM........................ 306
; 31.24 F$REST - RESTORE THE FILE SYSTEM.................. 307
; 31.25 F$SAVE - SAVE THE FILE SYSTEM..................... 308
; 31.26 F$SETU - POST LOOKUP SET UP....................... 309
; 31.27 F$TRAC - I/O TRACE................................ 310
; 31.28 F$DRIB - DEALLOCATE ALL CLUSTERS.................. 311
; 31.29 F$VRIB - VALIDATE A RIB........................... 312
; 31.30 F$XFRB - COUNT BLOCKS TRANSFERED.................. 317
; 31.31 F$DSAT - DEALLOCATE BITS IN A SAT................. 318
; 31.32 F$RSAT - READ A SAT BLOCK FROM DISK............... 319
; 31.33 F$WSAT - WRITE A SAT BLOCK TO DISK................ 320
; 32. LISTING CONTROL
; 32.1 L$CHAR - CHARACTER OUTPUT......................... 323
; 32.2 L$CLOS - CLOSE FILE............................... 324
; 32.3 L$ENVI - LIST ENVIRONMENT......................... 325
; 32.4 L$FILE - SET UP OUTPUT SCAN BLOCK................. 326
; 32.5 L$HDRS - SET HEADER SUBROUTINE.................... 327
; 32.6 L$HDRZ - ZERO HEADER COUNTERS..................... 328
; 32.7 L$HEAD - GENERATE BANNER/HEADER................... 329
; 32.8 L$OPEN - OPEN FILE................................ 330
; 32.9 L$PGSZ - RETURN PAGE SIZE......................... 334
; 32.10 L$TABS - TAB TO SPECIFIED COLUMN.................. 335
; 32.11 L$TEST - TEST PAGE................................ 336
; 33. MEMORY MANAGER
; 33.1 M$GETW - ALLOCATE CORE............................ 337
; 33.2 M$GIVW - DEALLOCATE CORE.......................... 339
; 33.3 M$INIT - INITIALIZATION........................... 342
; 34. TEXT PROCESSING
; 34.1 T$INIT - INITIALIZATION........................... 343
; 34.2 T$ADDR - PRINT AN ADDRESS......................... 344
; 34.3 T$ASCI - ASCII WORD............................... 345
; 34.4 T$BPTR - PRINT A BYTE POINTER..................... 346
; 34.5 T$CHAR - PRINT A CHARACTER........................ 347
; 34.6 T$DATE - 15-BIT DATE.............................. 348
; 34.7 T$DIRB - DIRECTORY................................ 349
; 34.8 T$DTTM - DATE/TIME................................ 350
; 34.9 T$ETIM - ELAPSED TIME............................. 351
; 34.10 T$FCHR - FUNNY CHARACTER.......................... 352
; 34.11 T$FILE - FILE (SCAN) BLOCK........................ 353
; 34.12 T$HTIM - HIGH PRECISION TIME...................... 354
; 34.13 T$JUST - JUSTIFY OUTPUT........................... 355
; 34.14 T$RDXW - PRINT NUMBERS............................ 358
; 34.15 T$PATH - PATH BLOCK............................... 359
; 34.16 T$PPN - PPN....................................... 360
; 34.17 T$PPNB - BRACKETED MASKED PPN..................... 361
; 34.18 T$PPNM - MASKED PPN............................... 362
; 34.19 T$RNGD - RANGE.................................... 363
; 34.20 T$SETO - SET ALTERNATE CHARACTER OUTPUT ROUTINE... 364
; 34.21 T$SIXN - PRINT A SIXBIT WORD...................... 365
; 34.22 T$TIME - TIME..................................... 366
; 34.23 T$STRG - PRINT A STRING........................... 367
; 34.24 T$VERW - VERSION.................................. 368
; 34.25 T$VMSG - VERBOSITY CONTROLLED MESSAGE............. 369
; 34.26 T$XLAT - TRANSLATE DATA TO STRING STORAGE......... 371
; 34.27 SPECIAL SINGLE CHARACTERS......................... 372
; 34.28 MISCELLANEOUS ROUTINES............................ 373
; 35. UNIT PROCESSING
; 35.1 U$CLOS - CLOSE A CHANNEL.......................... 374
; 35.2 U$OPEN - OPEN A CHANNEL........................... 375
; 35.3 U$POSI - POSITION FOR I/O......................... 376
; 35.4 U$READ/U$WRIT - READ & WRITE...................... 377
; 36. AC SAVE CO-ROUTINES....................................... 378
; 37. FILE COPYING ROUTINES
; 37.1 CPYBLK - SETUP UUO BLOCKS......................... 379
; 37.2 CPYCLS - CLOSE FILE............................... 380
; 37.3 CPYCMD - READ FILESPECS........................... 381
; 37.4 CPYENT - CREATE OUTPUT FILE....................... 383
; 37.5 CPYFSC - FIXUP SCAN BLOCK......................... 384
; 37.6 CPYFEX - FIXUP FILENAME & EXTENSION............... 386
; 37.7 CPYFLP - FLIP SCAN BLOCKS......................... 387
; 37.8 CPYLKP - LOOKUP A FILE............................ 388
; 37.9 CPYRFS - READ RETURNED FILESPEC................... 389
; 37.10 CPYSUM - PRINT SUMMARY............................ 390
; 38. MISCELLANEOUS ROUTINES
; 38.1 BIT MAP HANDLING.................................. 391
; 38.2 DATE/TIME CONVERSION.............................. 393
; 38.3 GET DISK CHARACTERISTICS.......................... 397
; 38.4 PDP-11 STRING PROCESSING.......................... 398
; 39. LITERAL POOL.............................................. 401
; 40. IMPURE STORAGE............................................ 402
SUBTTL REVSION HISTORY
; 1 DPM 10-AUG-88
; CREATE FROM THE RUINS OF SEVERAL OTHER PROGRAMS. PURPOSE: TO
; PROVIDE A FACILITY TO PATCH DISKS AND RESTORE FILE STRUCTURES
; AFTER A SERIOUS SYSTEM FAILURE.
;
; 2 DPM 25-SEP-88
; LOAD HOM, BAT, AND BOOT BLOCKS INTO DATA FILE FOR LATER EVALUATION.
;
; 3 DPM 10-OCT-88
; CLEAN UP RIB READING CODE. CORRECT SOME BUGS IN BLOCK POSITIONING.
;
; 4 DPM 18-OCT-88
; ADD REAL MEMORY MANAGER STOLEN FROM GLXLIB AND OPTIMIZED TO SUIT
; OUR NEEDS.
;
; 5 DPM 20-OCT-88
; CORRECT BUG IN RRBCHK WHICH MIGHT LET A BLOCK WITHOUT RIBCOD PASS
; FOR A REAL RIB.
;
; 6 DPM 24-OCT-88
; IMPLEMENT FILE BLOCK SORT ROUTINES. TEACH DIRECTORY COMMAND TO
; FOLLOW FILE BLOCK SORT LINKS. FIX OFF-BY-ONE BUF IN D$FNUM WHICH
; CAUSED THE WRONG DATA FILE BLOCK TO BE SELECTED IF THE TARGET FILE
; NUMBER WAS AN EVEN MULTIPLE OF FILE BLOCKS PER DISK BLOCK.
;
; 7 DPM 27-OCT-88
; IMPLEMENT FILESPEC SCANNER AND SELECTIVE DIRECTORY OF FILES.
;
; 10 DPM 17-NOV-88
; FIX ANOTHER BUG IN I/O ERROR RECOVERY WHICH CAUSED MULTIPLE FILE
; BLOCKS TO BE INSERTED INTO THE DATA FILE BECAUSE OF POSITIONING
; ERRORS.
;
; 11 DPM 21-NOV-88
; FIX A PROBLEM WITH THE FILE BLOCK COMPARE ROUTINE WHICH CAUSED
; THE SORTED ORDER OF FILES TO BE WRONG WHEN SFDS WERE INVOLVED.
;
; 12 DPM 28-NOV-88
; MERGE KEYWORDS FOR ENABLE & DISABLE INTO THE SET COMMAND. SEPARATE
; OUT THE INITIAL STRUCTURE & UNIT PROMPTING CODE AND PUT INTO THE
; STRUCTURE COMMAND. THIS WILL ALLOW PARAMETER SETTING BEGORE ANY
; UNIT OR STRUCTURE SPECIFICATIONS.
;
; 13 DPM 29-NOV-88
; ADD A "START" COMMAND TO COMMENCE DAMAGE ASSESSMEMT.
;
; 14 DPM 30-NOV-88
; ENABLE CHECKPOINT/RESTARTS. SORT CHECKPOINTS DON'T WORK YET.
;
; 15 DPM 2-DEC-88
; FIX LOGIC WHICH DETERMINES RIB TYPES.
;
; 16 DPM 5-DEC-88
; BEGIN FILSER SIMULATION. ADD CODE TO "OPEN", INPUT FROM, AND
; "CLOSE" A FILE.
;
; 17 DPM 14-DEC-88
; IMPLEMENT TASK HANDLING/CHECKPOINT ROUTINES.
;
; 20 DPM 21-DEC-88
; ADD DUMP COMMAND TO DUMP ARBITRARY BLOCKS ON THE SELECTED STRUCTURE,
; UNITS WITHIN THAT STRUCTURE, OR RELATIVE BLOCKS OF FILES ON THAT
; STRUCTURE.
;
; 21 DPM 22-DEC-88
; START ADDING LISTING CONTROL PRIMATIVES.
;
; 22 DPM 28-DEC-88
; FINISH UP LISTING CODE. CLEAN UP DIRECTORY AND DUMP COMMAND
; INTERFACES AS FAR AS LISTINGS ARE CONCERNED.
;
; 23 DPM 20-JUN-89
; CLEAN UP SOME COMMAND INTERFACE STUFF.
;
; 24 DPM 22-JUN-88
; ADD CODE TO IGNORE CERTAIN PARTS OF THE DISK WHEN SCANNING
; FOR RIBS. THE DATA IN FILES SUCH AS SWAP.SYS AND CRASH.EXE
; CAN BE EXCLUDED, AS THESE FILES CAN CONTAIN RIBS FROM MONITOR
; BUFFERS.
;
; 25 DPM 4-JAN-90
; FIX LOOKUP BY HOM BLOCKS.
;
; 26 DPM 31-MAR-90
; FURTHER REFINE LOOKUP BY HOM BLOCKS. ALMOST THERE, BUT MORE
; OR LESS USABLE RIGHT NOW.
;
; 27 DPM 2-APR-90
; ADD PATCHING FACILITY.
;
; 30 DPM 5-APR-90
; DO MORE CLEANUP ON THE LOOKUP CODE. NEARLY EVERYTHING WORKS
; NOW EXCEPT F.DIRB AND F.DIRP OPTIONS. ADD TRANSLATE COMMAND
; TO CONVERT DATA FROM ONE FORMAT INTO ANOTHER.
;
; 31 DPM 9-APR-90
; REPLACE THE RATHER COMPLEX MEMORY MANAGER WITH A JOBFF-STYLE
; CORE ALLOCATOR. THIS IS BEST SUITED TO OUR NEEDS AND USES
; OVER 2P LESS CODE.
;
; 32 DPM 12-APR-90
; DO MISCELLANEOUS CLEANUP. MAKE SURE ALL CALLS TO U$READ AND
; U$WRTE HAVE SETUP UP THE UNIT AND BLOCK ON UNIT PROPERLY.
; MAKE OPENING A CHANNEL TO THE CORRECT UNIT AUTOMATIC. ROUTINES
; WISHING TO DO I/O NO LONGER NEED TO MAKE CALLS TO U$OPEN.
; REPLACE ALL HALTS WITH APPROPRIATE ERROR MESSAGES OR RETURNS.
;
; 33 DPM 24-APR-90
; FIX PROBLEMS WITH FILE-ACCESS VIA DATA FILE. A SIDE EFFECT WAS
; FORCING RETURNED FILE BLOCK AND SCAN BLOCKS POINTED TO BY THE
; DATA FILE TO BE FILLED AT THE TIME OF THE LOOKUP. CALLS TO
; F$INI NO LONGER HAVE THE OPTION OF SPECIFYING UNIQUE RETURNED
; FILESPEC BLOCKS.
;
; 34 DPM 1-MAY-90
; ADD ERSATZ DEVICE SUPPORT. HAVE LOOKUP CODE RESOLVE SCAN BLOCK
; FIXUPS INSTEAD OF DOING IT IN THE FILESPEC SCANNER.
;
; 35 DPM 4-MAY-90
; FIX SOME MINOR BUGS WHICH SURFACED WHILE REPAIRING A DAMAGED DISK.
; REMOVE THE DEFAULT INPUT, OUTPUT, AND LISTING FILESPECS. THEY
; WERE NOT USEFUL. ADD SET ERSATZ-DEVICE, PATH, AND PPN COMMANDS.
;
; 36 DPM 11-MAY-90
; ADD F$POS TO DO POSITIONING WITHIN FILES. WITH THIS ROUTINE,
; IT IS POSSIBLE TO PATCH BLOCKS WITHIN A FILE. MAKE DATA FILE
; HEADER SIZE COMPUTATION EASIER. MOVE THE FILE I/O DATA STORAGE
; FOR PATCHING TO THE STATIC PORTION OF THE HEADER. FORGOT ABOUT
; HOMBTS IN THE HOM BLOCK DUMP CODE. DUMP AND EXPAND THE WORD.
;
; 37 DPM 14-MAY-90
; REMOVE "SET IGNORE" FACILITY. IT CANNOT EASILY BE MADE TO WORK
; AND IS LESS THAN USEFUL IN ITS CURRENT STATE.
;
; 40 DPM 16-MAY-90
; BE MORE DEFENSIVE ABOUT FILE FORMAT SKEWS. DON'T MEMORIZE HOM
; BAD BAT BLOCKS IN THE DATA FILE. INSTEAD, JUST KEEP A BIT MASK
; OF THE BLOCKS IN ERROR. ADD "SHOW ERROR-SUMMARY" COMMAND TO
; DISPLAY THE ERRORS. ALSO MOVE THE CHECKPOINT/RESTART DATA FOR
; RIB SCANNING INTO THE VARIABLE PORTION OF THE FILE HEADER.
;
; 41 DPM 23-MAY-90
; MODIFY FILE SERVICE TO RECOGNIZE SYS:SAT.SYS SO IT MAY BE READ
; SEQUENTIALLY WITHOUT HAVING TO IGNORE UNSED BLOCKS. ADD CODE
; TO LOAD THE SAT BLOCKS INTO THE DATA FILE. ADD SAT ERRORS TO
; SHOW ERROR DISPLAY.
;
; 42 DPM 29-MAY-90
; DON'T TRUST THE CONTENTS OF RIBFLR IF PROCESSING A PRIME RIB
; IN F$SETU. OLD RIBS CONTAIN JUNK IN THIS WORD.
;
; 43 DPM 31-MAY-90
; ADD CODE TO READ AND WRITE THE SATS. CURRENTLY THERE IS NO LOGIC
; TO DO ACTUAL CLUSTER ALLOCATION OR DEALLOCATION.
;
; 44 DPM 4-JUN-90
; INCLUDE HOMOVR IN TOTAL FREE BLOCK CALCULATIONS. MEMORIZE THIS
; PARAMETER WHEN THE STRUCTURE COMMAND IS GIVEN.
;
; 45 DPM 7-JUN-90
; ADD FORMAT DESCRIPTORS, I/O TRACE FACILITY, AND DUMP "SPECIAL".
;
; 46 DPM 12-JUN-90
; ADD DELETE COMMAND. IT IS FUNCTIONALLY EQUIVALENT TO THE DELFIL
; /S OPTION.
;
; 47 DPM 13-JUN-90
; ADD GET COMMAND TO PULL FILES OFF THE SELECTED STRUCTURE.
;
; 50 DPM 15-JUN-90
; IMPLEMENT CHECKSUM ERROR DETECTION AND A WAY TO OVERRIDE THE
; FEATURE.
;
; 51 DPM 9-JUL-90
; FIX BUGS IN DATA FILE SAT MANAGEMENT WHICH CAUSED SATS FROM THE
; DATA FILE TO APPEAR INVALID.
;
; 52 DPM 18-SEP-90
; MAKE COSMETIC IMPROVEMENTS.
;
; 53 DPM 19-SEP-90
; FIX BUG IN SETEDV WHICH PREVENTED CHANGING ERSATZ DEVICE PPN
; ASSIGNMENTS. ALSO DON'T LET ERSATZ DEVICE SEARCHES TO SUCCEED
; IF THE PPN IS ZERO.
;
; 54 DPM 27-SEP-90
; REWRITE FILE BLOCK SORT ROUTINE TO HANDLE CASES WHERE THE TOTAL
; NUMBER OF FILE BLOCKS WILL NOT FIT INTO CORE. IMPLEMENT A NEW
; SET COMMAND (SET SORT-BUFFER-SIZE) TO CONTROL THE NUMBER OF
; FILE BLOCKS WHICH CAN BE SORTED AT ONCE. FOR PRACTICAL REASONS,
; AN ARBITRARY LIMIT OF MAXSRT FILE BLOCKS WILL BE IMPOSED.
;
; 55 DPM 28-SEP-90
; REMOVE REFERENCES TO "HIDDEN" MFD DATA. THIS WAS NEVER USED.
; ADD TRANSLATE ERROR TO DISPLAY THE ERROR TEXT ASSOCIATED WITH
; AN ERROR MNEMONIC. THESE MNEMONICS ARE DISPLAYED BY THE
; SHOW ERROR COMMAND WHEN SPECIAL BLOCKS ON UNITS ARE IN ERROR.
;
; 56 DPM 9-OCT-90
; TREAT <EOL> AS "ON" IN SET COMMANDS. ALSO PROVIDE HELP ON
; RESTRICTIONS AND PRACTICAL LIMITATIONS.
SUBTTL ASSEMBLY PARAMETERS
;ACCULUMATORS
P=1 ;PUSH DOWN LIST POINTER
T4=<1+<T3=1+<T2=1+<T1=2>>>> ;FOUR CONSECUTIVE TEMPORARY ACS
P4=<1+<P3=1+<P2=1+<P1=6>>>> ;FOUR CONSECUTIVE PRESERVED ACS
D=12 ;DATA FILE HEADER ADDRESS
U=13 ;UNIT BLOCK
R=14 ;RETRIEVAL POINTER
F=15 ;FILE I/O DIRECTORY LEVEL DATA POINTER
;CHANNELS
DATCHN==1 ;DATA FILE I/O
LSTCHN==2 ;LISTINGS
CPYCHN==3 ;FILE COPYING
DSKCHN==4 ;DISK I/O
;JOBDAT LOCATIONS
JOBREL==44 ;HIGHEST ADDRESS IN LOW SEGMENT
JOBDDT==74 ;DDT END,,START ADDRESSES
JOBBPT==76 ;UNSOLICITED BREAKPOINT ADDRESS
JOBSYM==116 ;SYMBOL TABLE POINTER
JOBUSY==117 ;UNDEFINED SYMBOL TABLE POINTER
JOBSA==120 ;INITIAL SIZE,,PROGRAM START ADDR
JOBFF==121 ;FIRST FREE WORD AT END OF LOW SEGMENT
JOBREN==124 ;REENTER ADDRESS
JOBINT==134 ;INTERCEPT BLOCK
JOBVER==137 ;VERSION
JOBDA==140 ;FIRST WORD NOT USED BY JOB DATA AREA
;DEFAULT PARAMETERS
IFNDEF DEFCPI,<DEFCPI==^D1000> ;DEFAULT CHECKPOINT INTERVAL
IFNDEF DEFLPP,<DEFLPP==^D55> ;DEFAULT LPT LINES PER PAGE
IFNDEF DEFLWD,<DEFLWD==^D72> ;DEFAULT LPT WIDTH
IFNDEF DEFPRD,<DEFPRD==^D200> ;DEFAULT BLOCKS PER READ REQUEST
IFNDEF DEFPSZ,<DEFPSZ==^D128> ;DEFAULT PATCH BUFFER SIZE
IFNDEF DEFSRT,<DEFSRT==^D1000> ;DEFAULT SORT BUFFER SIZE
IFNDEF DEFTPP,<DEFTPP==^D24> ;DEFAULT TERMINAL LINES PER PAGE
IFNDEF DEFTWD,<DEFTWD==^D72> ;DEFAULT TERMINAL WIDTH
IFNDEF PRVBIT,<PRVBIT==JP.POK> ;NECESSARY PRIVS TO RUN WITH JACCT
CMDSIZ==^D120 ;NUMBER OF CHARACTERS IN COMMAND BUFFER
CMDWDS==CMDSIZ/5 ;NUMBER OF WORDS IN COMMAND BUFFER
BLKSIZ==200 ;SIZE OF A DISK BLOCK
CRDSIZ==BLKSIZ+10 ;NUMBER OF WORDS FOR CHECKPOINT RESTART DATA
LSTSIZ==^D120*3 ;NUMBER CHARACTERS IN LISTING BANNER/HEADER
LSTWDS==LSTSIZ/5 ;NUMBER WORDS IN LISTING BANNER/HEADER
MAXDMP==12 ;MAXIMUM NUMBER OF DUMP DESCRIPTORS
MAXEDV==200 ;PROBABLE NUMBER OF ERSATZ DEVICES (MUST
; BE GREATER THAN THE ACTUAL NUMBER)
MAXIOT==12 ;MAXIMUM NUMBER OF I/O TRACE DESCRIPTORS
MAXHKS==4 ;MAXIMUM HEADER KEYWORD SIZE IN WORDS
MAXPAT==BLKSIZ*4 ;MAXIMUM SIZE OF PATCH BUFFER
MAXSAT==^D100 ;MAXIMUM NUMBER OF SATS PER STRUCTURE
MAXSFD==24 ;MAXIMUM NUMBER OF SFDS ALLOWED
MAXSRT==^D1000 ;MAXIMUM NUMBER OF FILE BLOCKS TO SORT AT ONCE
MAXUNI==20 ;MAXIMUM NUMBER OF UNITS PER STRUCTURE
OURNAM=='DPATCH' ;OUR NAME
OURPFX=='DPA' ;PREFIX FOR ERRORS, ETC.
P11SIZ==3 ;MAXIMUM WORDS IN PDP-11 TRANSLATION BUFFER
PATSIZ==200 ;PATCH SPACE
PDLSIZ==100 ;PUSH DOWN LIST SIZE
;OPDEFS
OPDEF IFIW [1B0] ;INSTRUCTION FORMAT INDIRECT WORD
OPDEF PJRST [JUMPA 17,] ;PUSHJ/POPJ
.NODDT IFIW, PJRST
SUBTTL DEFINITIONS -- BYTE MANIPULATION
;COMPUTE WIDTH OF MASK, I.E. LENGTH OF LEFTMOST STRING OF ONES
DEFINE WID (MASK),<<^L<-<<MASK>_<^L<MASK>>>-1>>>
;COMPUTE POSITION OF MASK, I.E. BIT POSITION OF RIGHTMOST ONE IN MASK
DEFINE POS (MASK),<<^L<<MASK>&<-<MASK>>>>>
;CONSTRUCT BYTE POINTER TO MASK
DEFINE POINTR (LOC,MASK),<<POINT WID(MASK),LOC,POS(MASK)>>
;INSERT A RIGHT-JUSTIFIED VALUE INTO FIELD SPECIFIED BY MASK
DEFINE INSVL. (VALUE,MASK),<<<<VALUE>B<POS(<MASK>)>>&<MASK>>>
SUBTTL DEFINITIONS -- MESSAGE MACROS
;MACRO TO GENERATE A MESSAGE
DEFINE STOPCD (PFX,TXT,MOR),< .MSG. (0,PFX,0,<TXT>,MOR)>
DEFINE FATAL (PFX,CON,TXT,MOR),<.MSG. (1,PFX,CON,<TXT>,MOR)>
DEFINE WARN (PFX,CON,TXT,MOR),<.MSG. (2,PFX,CON,<TXT>,MOR)>
DEFINE INFO (PFX,CON,TXT,MOR),<.MSG. (3,PFX,CON,<TXT>,MOR)>
DEFINE .MSG. (TYP,PFX,CON,TXT,MOR),<
PUSHJ P,[XLIST
PUSHJ P,T$VMSG
XWD ''PFX'',[ASCIZ |TXT|]
XWD TYP,CON
XWD MOR,0
LIST]
>
SUBTTL DEFINITIONS -- TEXT JUSTIFICATION MACRO
;MACRO TO JUSTIFY TEXT
DEFINE JUSTIFY (POS,COL,CHR,RTN,ADR),<
XLIST
IFIDN <POS><L>,<ZZ==0>
IFIDN <POS><C>,<ZZ==1>
IFIDN <POS><R>,<ZZ==2>
LIST
PUSHJ P,[XLIST
PUSHJ P,T$JUST
EXP RTN
BYTE(2)ZZ(7)0(9)^D<COL>(10)0(8)CHR]
PURGE ZZ
LIST
> ;END DEFINE JUSTIFY
SUBTTL DEFINITIONS -- COMMAND PROCESSING
;MACRO TO GENERATE COMMAND SCANNING TABLES
DEFINE KEYTAB (PFX,TBL),<
XLIST
...TBL==0
...NAM==0
...PRC==0
...HLP==0
...CMD==0
IRP TBL,<
IFIDN <TBL><TBL>,<...TBL==1>
IFIDN <TBL><NAM>,<...NAM==1>
IFIDN <TBL><PRC>,<...PRC==1>
IFIDN <TBL><HLP>,<...HLP==1>
IFIDN <TBL><CMD>,<...CMD==1>
> ;;END IRP TBL
;;GENERATE TABLE OF TABLE ADDRESSES
IFN ...TBL,<
PFX'.T: EXP <IFDEF PFX'.N,<PFX'.N>>!<IFNDEF PFX'.N,<0>>
EXP <IFDEF PFX'.P,<PFX'.P>>!<IFNDEF PFX'.P,<0>>
EXP <IFDEF PFX'.H,<PFX'.H>>!<IFNDEF PFX'.H,<0>>
EXP <IFDEF PFX'.C,<PFX'.C>>!<IFNDEF PFX'.C,<0>>
> ;;END IFN ...TBL
;;KEYTAB MACRO (CONTINUED)
;;GENERATE KEYWORD NAME TABLE
DEFINE KEY (NAM,PRC,HLP,CMD),<IFIW [ASCIZ /NAM/]>
IFN ...NAM,<
PFX'.N: XWD -PFX'.L,0
KEYS
PFX'.L==.-PFX'.N
>
;;GENERATE PROCESSOR TABLE
DEFINE KEY (NAM,PRC,HLP,CMD),<IFIW PRC> ;'NAM
IFN ...PRC,<
PFX'.P: XWD -PFX'.L,0
KEYS
PFX'.L==.-PFX'.P
>
;;GENERATE HELP TABLE
DEFINE KEY (NAM,PRC,HLP,CMD),<IFIW HLP> ;'NAM
IFN ...HLP,<
PFX'.H: XWD -PFX'.L,0
KEYS
PFX'.L==.-PFX'.H
>
;;GENERATE NEXT COMMAND TABLE
DEFINE KEY (NAM,PRC,HLP,CMD),<IFIW CMD> ;'NAM
IFN ...CMD,<
PFX'.C: XWD -PFX'.L,0
KEYS
PFX'.L==.-PFX'.C
>
SALL
PURGE ...TBL,...NAM,...PRC,...HLP,...CMD
LIST
> ;END DEFINE KEYTAB
SUBTTL DEFINITIONS -- FORMAT DESCRIPTOR
.ORG 0
.FMBPT:! BLOCK 1 ;BYTE POINTER TO DATA
.FMKEY:! BLOCK MAXHKS ;ASCIZ KEYWORD
.FMLEN:! ;LENGTH OF BLOCK
.ORG
;DETERMINE THE MAXIMUM SIZE OF A FORMAT DESCRIPTOR BUFFER
ZZ==0
IFG MAXDMP-ZZ,<ZZ==MAXDMP> ;DUMP
IFG MAXIOT-ZZ,<ZZ==MAXIOT> ;I/O TRACE
MAXFMT==ZZ ;MAXIMUM SIZE OF BUFFER
SUBTTL DEFINITIONS -- SCAN BLOCK
.ORG 0
.SBFLG:! BLOCK 1 ;SCANNER FLAGS
SB.DEV==1B0 ;DEVICE SPECIFIED
SB.NAM==1B1 ;FILE NAME SPECIFIED
SB.EXT==1B2 ;EXTENSION SPECIFIED
SB.DIR==1B3 ;DIRECTORY SPECIFIED
SB.DPT==1B4 ;DEFAULT PATH ([-]) SPECIFIED
SB.DCP==1B5 ;DEFAULT CURRENT PPN ([,]) SPECIFIED
SB.DLP==1B6 ;DEFAULT LOGGED-IN PPN ([/]) SPECIFIED
SB.DFF==1B7 ;DIRECTORY/FILE NAME FIXUP NEEDED
SB.PPN==1B8 ;PPN FIXED UP
SB.GDV==1B9 ;GLOBAL DEVICE
SB.GNM==1B10 ;GLOBAL FILE NAME
SB.GEX==1B11 ;GLOBAL EXTENSION
SB.GDI==1B12 ;GLOBAL DIRECTORY
SB.WLD==1B13 ;WILDCARDED FILESPEC
.SBDEV:! BLOCK 1 ;DEVICE
.SBDVM:! BLOCK 1 ;DEVICE MASK
.SBNAM:! BLOCK 1 ;FILE NAME
.SBNMM:! BLOCK 1 ;FILE NAME MASK
.SBEXT:! BLOCK 1 ;EXTENSION,,MASK
.SBDIR:! BLOCK 1 ;PPN
.SBDIM:! BLOCK 1 ;PPN MASK
.SBMIN:! ;MINIMUM LENGTH OF BLOCK
.ORG
SUBTTL DEFINITIONS -- FILE BLOCKS
;MACRO TO DEFINE ERROR FLAGS
;NOTE THAT DEFINITIONS OF THE FORM %NN ARE PLACE HOLDERS. WHEN A
;NEW BIT NEEDS TO BE DEFINED, TAKE THE FIRST AVAILABLE PLACE HOLDER.
;ERROR CODE NUMBERING STARTS WITH ONE, NOT ZERO. THEREFORE, %00
;MUST NOT BE USED AND THERE IS A LIMIT OF 17 (DECIMAL) ERROR TYPES
;FOR A FILE BLOCK.
DEFINE FBERR,<
X (%00,<>)
X (ALC,<Incorrect file allocation>)
X (FIR,<Invalid RIBFIR>)
X (IOE,<I/O error scanning directory tree>)
X (MPD,<Missing parent directory>)
X (MRE,<Missing retrieval entries>)
X (NUB,<Missing or malformed change of unit pointer>)
X (PTR,<Incorrect retrieval pointer(s)>)
X (SFD,<SFDs nested too deeply>)
X (SLF,<Incorrect RIBSLF>)
X (XRW,<Extended RIB pointer wrong>)
X (%11,<>)
X (%12,<>)
X (%13,<>)
X (%14,<>)
X (%15,<>)
X (%16,<>)
X (%17,<>)
> ;END DEFINE FBERR
DEFINE X (NAM,TXT),<
XLIST ;;SUPPRESS LISTING
FBENUM==FBENUM+1 ;;ADVANCE COUNTER
IF1,<IFLE 44-FBENUM,<PRINTX ?File block error mask overflow>>
LIST ;;REINSTATE LISTING
FB.'NAM==1B<FBENUM> ;;ASSIGN A VALUE
> ;END DEFINE X
FBENUM==-1 ;CODE ZERO NOT USED
.ORG 0
.FBIDN:! BLOCK 1 ;IDENTIFICATION WORD
FB.NUM==777777B17 ;FILE NUMBER
FB.SRT==777777B35 ;NEXT (SORTED) FILE NUMBER
.FBXTR:! BLOCK 1 ;EXTENDED RIB WORD
.FBBLK:! BLOCK 1 ;RIB BLOCK NUMBER (FROM CFP)
.FBUFD:! BLOCK 1 ;BLOCK NUMBER WITHIN OWNING DIRECTORY
.FBFLG:! BLOCK 1 ;FLAGS (LH = ERRORS, RH = MISCELLANEOUS)
FBERR ;DEFINE ERROR BITS
FB.RIB==1B24 ;POSSIBLE RIB
FB.PRM==1B25 ;PRIME RIB
FB.SPR==1B26 ;SPARE RIB
FB.XTR==1B27 ;EXTENDED RIB
FB.XRN==377B35 ;EXTENDED RIB NUMBER
.FBNAM:! BLOCK 1 ;FILE NAME
.FBEXT:! BLOCK 1 ;EXTENSION,,PROTECTION
.FBCRE:! BLOCK 1 ;CREATION DATE/TIME
.FBVER:! BLOCK 1 ;VERSION
.FBALC:! BLOCK 1 ;ALLOCATION
.FBPPN:! BLOCK 1 ;PPN
.FBMIN:! ;MIMIMUM LENGTH OF BLOCK
.ORG
SUBTTL DEFINITIONS -- FILE I/O DATA BASE
;THE FILE I/O BLOCKS ARE DIVIDED INTO TWO SECTIONS. THE FIRST IS
;NECESSARY FOR I/O TO A SINGLE FILE. THE SECOND PART IS REQUIRED FOR
;DIRECTORY TREE SCANNING. THESE TWO SECTIONS MUST BE KEPT DISTINCT.
;THE SYMBOL ".FWMIN" DENOTES THE END OF THE FIRST PART; THOSE WORDS
;NECESSARY ONLY FOR SIMPLE FILE I/O.
.ORG 0
.FWADR:! BLOCK 1 ;DISK ADDRESS (BLOCK) OF TARGET RIB
.FWBLK:! BLOCK 1 ;BLOCK WITHIN FILE
.FWBRH:! BLOCK 3 ;BUFFER RING HEADER
.FWCLS:! BLOCK 1 ;NON-ZERO IF WORDS IN BUFFER NOT WRITTEN
.FWECD:! BLOCK 1 ;ERROR CODE
.FWFBF:! BLOCK 1 ;FILE BLOCK FLAGS
.FWFBN:! BLOCK 1 ;FILE-RELATIVE BLOCK ON LAST I/O
.FWIOD:! BLOCK 1 ;I/O DIRECTION (0 = READ, 1 = WRITE)
.FWIOW:! BLOCK 1 ;IOWD TO BUFFER
.FWLFT:! BLOCK 1 ;BLOCKS LEFT IN CURRENT POINTER
.FWMOD:! BLOCK 1 ;MODE
.FWOPF:! BLOCK 1 ;NON-ZERO IF FILE "OPENED"
.FWOPT:! BLOCK 1 ;OLD RETRIEVAL POINTER (FOR CHECKSUMS)
.FWRIF:! BLOCK 1 ;RIB I/O POSITION
.FWRRB:! BLOCK 1 ;NON-ZERO IF RIB MUST BE REWRITTEN
.FWPRM:! BLOCK 1 ;DISK ADDRESS (BLOCK) OF PRIME RIB
.FWRBO:! BLOCK 1 ;RIB/BLOCK OFFSET FOR POSITIONING WITH XRIBS
.FWRPT:! BLOCK 1 ;AOBJN POINTER TO RETRIEVAL PTRS IN .FWRIB
.FWRIB:! BLOCK BLKSIZ ;RIB BUFFER
.FWRWC:! BLOCK 1 ;REMAINING WORD COUNT IN FILE
.FWSAT:! BLOCK 1 ;NON-ZERO IF READING SAT.SYS
.FWSBN:! BLOCK 1 ;STRUCTURE-RELATIVE BLOCK ON LAST I/O
.FWSFB:! BLOCK 1 ;-1 TO SKIP BLOCK IN RIB (PRIME/EXTENDED RIB)
.FWSLB:! BLOCK 1 ;-1 TO SKIP BLOCK IN RIB (SPARE RIB)
.FWUBN:! BLOCK 1 ;UNIT-RELATIVE BLOCK ON LAST I/O
.FWUNI:! BLOCK 1 ;CURRENT LOGICAL UNIT FOR I/O
.FWMIN:! ;MINIMUM LENGTH OF BLOCK
.FWBUF:! BLOCK BLKSIZ ;DIRECTORY BLOCK DATA BUFFER
.FWCON:! BLOCK 1 ;-1 TO CONTINUE SCANNING PREVIOUS LEVEL
.FWDIF:! BLOCK 1 ;NON-ZERO IF CURRENT ENTRY IS A DIRECTORY
.FWDIR:! BLOCK 2 ;TARGET DIRECTORY NAME AND MASK
.FWEXT:! BLOCK 2 ;TARGET EXTENSION & MASK
.FWFIL:! BLOCK 2 ;COUNT OF FILES SCANNED & MATCHED
.FWLVL:! BLOCK 1 ;THIS DIRECTORY LEVEL
.FWLVP:! BLOCK 1 ;POINTER TO THIS DIRECTORY LEVEL
.FWNAM:! BLOCK 2 ;TARGET FILE NAME & MASK
.FWPAS:! BLOCK 1 ;DIRECTORY SCAN PASS COUNT
.FWPTR:! BLOCK 1 ;POINTER WITHIN CURRENT BUFFER
.FWLEN:! ;LENGTH OF BLOCK
.ORG
;SPECIAL "MODE" WORD FLAGS IN THE LEFT HALF OF TOPS-10 MODE WORD
F.DIRA==1B0 ;RETURN DIRECTORY AFTER ITS CONTENTS
F.DIRB==1B1 ;RETURN DIRECTORY BEFORE ITS CONTENTS
F.DIRP==1B2 ;RETURN PARENT DIRECTORY IF LOW LEVEL WILD
F.NOIO==1B3 ;NO I/O (ONLY LOOKUP)
F.RETA==1B12 ;DIRECTORY RETURNED "AFTER"
F.RETB==1B13 ;DIRECTORY RETURNED "BEFORE"
F.RETP==1B13 ;RETURNED FILE FROM PARENT DIRECTORY
F.WILD==7B17 ;MASK OF WILDCARD SCAN ROUTINE INDEX
;MACRO TO GENERATE FILE SERVICE ERRORS
DEFINE FERR (NAM,RET),<
PUSHJ P,[PUSHJ P,F$ECOD
XWD FE'NAM'%,RET]
> ;END DEFINE FERR
;MACRO TO BUILD ERROR TEXT TABLE
;NOTE THE REFERENCE TO FBERR. FILE BLOCK ERROR CODE DEFINITIONS
;MUST PRECEDE ALL OTHERS, SINCE THERE IS A DIRECT RELATIONSHIP
;BETWEEN A FILE BLOCK ERROR CODE AND ITS CORRESPONDING BIT IN THE
;FILE BLOCK ERROR MASK.
DEFINE FERRT,<
FBERR
X (CKS,<Checksum error>)
X (DLF,<Directory lookup failure>)
X (DNO,<Data file not opened>)
X (EOD,<End of directory>)
X (EOF,<End of file>)
X (FNF,<File not found>)
X (HRE,<HOM block read error>)
X (IBN,<Illegal block number on structure>)
X (IDV,<Illegal device>)
X (IER,<Input error>)
X (IFN,<Illegal file number>)
X (IMD,<Illegal I/O mode>)
X (INI,<File I/O not properly initialized>)
X (NMF,<No more files>)
X (NXR,<No extended RIB>)
X (OER,<Output error>)
X (SBZ,<SAT block zero>)
X (SPN,<Structure parameters not initialized>)
X (STP,<I/O stopped by user>)
X (TRN,<Transmission error>)
X (XLI,<Extended RIB file LOOKUP illegal>)
X (XRI,<Extended RIB input error>)
> ;END DEFINE FERRT
DEFINE X (NAM,TXT),<FE'NAM'%==<ZZ==ZZ+1>>
ZZ==FBENUM-1
FERRT
SUBTTL DEFINITIONS -- LOGICAL BLOCK NUMBERS
LBNHOM==^D1 ;FIRST HOME BLOCK
LB2HOM==^D10 ;SECOND HOME BLOCK
LBOBAT==1 ;OFFSET FROM HOME BLOCK TO BAT BLOCK
LBOISW==2 ;OFFSET FROM HOME BLOCK TO INITIAL SWAPPING SAT
FBOOTB==^D4 ;STARTING BLOCK NUMBER FOR BOOTS
NBOOTB==4 ;NUMBER OF BLOCKS IN BOOTS
DEFINE SYM (FLG,NAM,VAL),<
IFIDN <FLG><G>,<NAM==:VAL>
IFIDN <FLG><L>,<NAM==VAL>
> ;END DEFINE SYM
SUBTTL DEFINITIONS -- SPECIAL PROGRAM SYMBOLS
DEFINE SYMPGM,<
SYM (G,BUF, DATHDR+.DFPBF) ;PATCH BUFFER ADDRESS
SYM (G,DEBUG, DEBUG) ;PROGRAM DEBUGGING START ADDRESS
SYM (G,FBOOTB,FBOOTB) ;STARTING BLOCK NUMBER FOR BOOTS
SYM (G,JOBSYM,JOBSYM) ;SYMBOL TABLE POINTER
SYM (G,JOBUSY,JOBUSY) ;UNDEFINED SYMBOL TABLE POINTER
SYM (G,LBNHOM,LBNHOM) ;LOGICAL BLOCK NUMBER OF THE FIRST HOM BLOCK
SYM (G,LB2HOM,LB2HOM) ;LOGICAL BLOCK NUMBER OF THE SECOND HOM BLOCK
SYM (G,LBOBAT,LBOBAT) ;OFFSET FROM A HOM BLOCK TO A BAT BLOCK
SYM (G,LBOISW,LBOISW) ;OFFSET TO THE INITIAL SWAPPING SAT
SYM (G,NBOOTB,NBOOTB) ;NUMBER OF BLOCKS IN BOOTS
SYM (G,PATCH, PATCH) ;PATCH SPACE
SYM (G,RET, RET) ;ADDRESS TO RETURN TO PROGRAM
SYM (G,SAVSYM,SAVSYM) ;SAVED ORIGINAL SYMBOL TABLE POINTER
SYM (G,SAVUSY,SAVUSY) ;SAVED ORIGINAL UNDEFINED SYMBOL TABLE POINTER
SYM (G,START, START) ;PROGRAM START ADDRESS
SYM (G,SYMTAB,SYMTAB) ;PATCH SYMBOL TABLE
SYM (P,DPATCH,0) ;PROGRAM NAME (MUST BE LAST)
> ;END DEFINE SYMPGM
SUBTTL DEFINITIONS -- BAT BLOCK
DEFINE SYMBAT,<
SYM (L,BAFNAM,0) ;"BAT" IN SIXBIT
SYM (L,BAFFIR,1) ;AOBJN POINTER TO BAD REGION WORD PAIRS
SYM (L,BAFNBS,2) ;# BAD BLOCKS FOUND BY MAP PROGRAM
SYM (L,BASNBS,^D9) ;BYTE SIZE
SYM (L,BANNBS,^D8) ;BYTE POSITION
SYM (L,BAFNBR,BAFNBS) ;# OF BAD REGIONS FOUND BY MAP PROGRAM
SYM (L,BASNBR,^D9) ;BYTE SIZE
SYM (L,BANNBR,^D17) ;BYTE POSITION
SYM (L,BAFKDC,2) ;KONTROLLER DEVICE CODE USED BY MAP PROGRAM
SYM (L,BASKDC,^D7) ;BYTE SIZE
SYM (L,BANKDC,^D24) ;BYTE POSITION
SYM (L,BAFCNT,3) ;# BAD REGIONS FOUND BY MONITOR
SYM (L,BAFREG,4) ;OFFSET OF FIRST BAD REGION WORD PAIR
;BAD REGION WORD PAIR DEFINITIONS
SYM (L,BAFNBB,0) ;# BAD BLOCKS-1 IN THIS REGION
SYM (L,BASNBB,^D9) ;BYTE SIZE
SYM (L,BANNBB,^D8) ;BYTE POSITION
SYM (L,BAFNUM,777) ;MAX NUMBER OF BAD BLOCKS IN A REGION-1
SYM (L,BAFOTH,0) ;BIT NON-ZERO IF BAD REGION IS DETECTED ON ANOTHER
;KONTROLLER OR PROCESSOR THAN THE ONE WHICH ADDED
;THE ENTRY IN THE FIRST PLACE
SYM (L,BAPOTH,400) ;BIT POS IN LH
SYM (L,BAFPUB,0) ;PHYSICAL UNIT BIT WITHIN CONTROLLER
SYM (L,BASPUB,^D8) ;BYTE SIZE
SYM (L,BANPUB,^D17) ;BYTE POSITION
SYM (L,BAFKNM,0) ;LOGICAL KONTROLLER NUMBER OF THIS TYPE
SYM (L,BASKNM,^D3) ;BYTE SIZE
SYM (L,BANKNM,^D20) ;BYTE POSITION
SYM (L,BAPNTP,40000) ;BIT ON FOR NEW-STYLE BAT BLOCK ENTRIES
SYM (L,BAFAPN,0) ;ARITHMETIC PROCESSOR NUMBER WHICH DETECTED ERROR
SYM (L,BASAPN,^D14) ;BYTE SIZE
SYM (L,BANAPN,^D35) ;BYTE POSITION
SYM (L,BAFELB,1) ;FIRST LOGICAL BLOCK (WITHIN UNIT) OF BAD REGION
SYM (L,BAJCNI,-^D6) ;-VE # OF LOW ORDER STATUS BITS WHICH DO NOT CONTAIN
; INTERESTING CONI ERROR STATUS BITS.
;LH OF BAFELB IS USED FOR CONI BITS 12 THROUGH 29
; ON RC-10 AND RP-10 UNITS.
SYM (L,BAFVER,1) ;BITS 0-2 VERSION NUMBER OF ENTRY
SYM (L,BAFERR,1) ;ERROR BITS
SYM (L,BAPOTR,40000) ;OTHER (L,NOT DATA OR SEARCH ERROR)
SYM (L,BAPDTR,20000) ;DATA ERROR (L,PARITY OR ECC HARD)
SYM (L,BAPHDR,10000) ;SEARCH ERROR OR HEADER COMPARE ERROR
SYM (L,BATMSK,777000) ;MASK (LH) FOR BAT ENTRY BLOCK NUMBER
SYM (L,MBTMSK,700777) ;MASK FOR JUST ERROR BITS FOR BAT ENTRY
SYM (L,BAFCOD,176) ;CONTAINS UNLIKELY CODE
SYM (L,CODBAT,606060) ;UNLIKELY CODE FOR BAT BLOCK
SYM (L,BAFSLF,177) ;BLOCK # WITHIN UNIT OF THIS BLOCK
SYM (P,BAT,0) ;PROGRAM NAME (MUST BE LAST)
> ;END DEFINE SYMBAT
SYMBAT
SUBTTL DEFINITIONS -- HOM BLOCK
DEFINE SYMHOM,<
SYM (L,HOMNAM,0) ;"HOM" IN SIXBIT
SYM (L,HOMHID,1) ;SIXBIT UNIT ID
SYM (L,HOMPHY,2) ;LH = PHYSICAL ADDRESS OF THIS HOM BLOCK
;RH = PHYSICAL ADDRESS OF OTHER HOM BLOCK
SYM (L,HOMSRC,3) ;LOCICAL POSITION OF STR IN SSL
SYM (L,HOMSNM,4) ;SIXBIT STR NAME THIS UNIT BELONGS TO
SYM (L,HOMNXT,5) ;SIXBIT UNIT ID OF NEXT UNIT IN THIS STR
SYM (L,HOMPRV,6) ;SIXBIT UNIT ID OF PREVIOUS UNIT IN THIS STR
SYM (L,HOMLOG,7) ;SIXBIT LOGICAL UNIT # WITHIN STR OF THIS UNIT
SYM (L,HOMLUN,10) ;LOGICAL UNIT # WITHIN STR OF THIS UNIT
SYM (L,HOMPPN,11) ;PPN OF USER WHO REFRESHED DISK UNDER TIMESHARING
SYM (L,HOMHOM,12) ;LH = LOGICAL BLOCK # WITHIN UNIT FOR 1ST HOM BLOCK
;RH = LOGICAL BLOCK # WITHIN UNIT FOR 2ND HOM BLOCK
SYM (L,HOMGRP,13) ;# BLOCKS TO TRY FOR ON SEQUENTIAL OUTPUT ALLOCATION
SYM (L,HOMBSC,14) ;# BLOCKS PER SUPER CLUSTER IN THIS STR
SYM (L,HOMSCU,15) ;# SUPER CLUSTERS PER UNIT
SYM (L,HOMCNP,16) ;BYTE PTR FOR CLUSTER COUNT IN A RETRIEVAL PTR
SYM (L,HOMCKP,17) ;BYTE PTR FOR CHECKSUM IN A RETRIEVAL PTR
SYM (L,HOMCLP,20) ;BYTE PTR FOR CLUSTER ADDRESS IN A RETRIEVAL PTR
SYM (L,HOMBPC,21) ;# BLOCKS PER CLUSTER
SYM (L,HOMK4S,22) ;# OF K WORDS OF THIS UNIT USED FOR SWAPPING
SYM (L,HOMREF,23) ;NON-ZERO IF STR MUST BE REFRESHED
SYM (L,HOMSIC,24) ;# SAT BLOCKS IN CORE
SYM (L,HOMSID,25) ;SWAPPING ID - SIXBIT UNIT ID OF NEXT UNIT IN ASL
SYM (L,HOMSUN,26) ;LOGICAL UNIT # IN ASL
SYM (L,HOMSLB,27) ;FIRST LOGICAL BLOCK ON UNIT FOR SWAPPING
SYM (L,HOMCFS,30) ;SWAPPING CLASS FOR UNIT
SYM (L,HOMSPU,31) ;# SAT BLOCKS PER UNIT
SYM (L,HOMOVR,32) ;-# OF BLOCKS OF OVERDRAW ALLOWED A USER ON THIS STR
SYM (L,HOMGAR,33) ;UPPER BOUND ON BLOCKS GUARRANTEED BY RESERVED QUOTAS
SYM (L,HOMTAB,34) ;FIRST LOC OF TABLE OF LOG. BLOCK NOS OF SYSTEM FILES
SYM (L,HOMSAT,HOMTAB) ;LOGICAL BLOCK # WITHIN STR OF RIB FOR SAT.SYS
SYM (L,HOMHMS,35) ; " FOR HOME.SYS
SYM (L,HOMSWP,36) ; " FOR SWAP.SYS
SYM (L,HOMMNT,37) ; " MAINT.SYS
SYM (L,HOMBAD,40) ; " BADBLK.SYS
SYM (L,HOMCRS,41) ; " FOR CRASH.EXE
SYM (L,HOMSNP,42) ; " SNAP.SYS
SYM (L,HOMRCV,43) ; " RECOV.SYS
SYM (L,HOMSUF,44) ; " SYS UFD
SYM (L,HOMPUF,45) ; " PRINTR UFD
SYM (L,HOMMFD,46) ; " FOR MFD [1,1].UFD
SYM (L,HOMPT1,47) ;COPY OF 1ST RETRIEVAL PTR FOR MFD FOR STR
SYM (L,HOMUN1,50) ;LOGICAL UNIT # OF UNIT ON WHICH MFD BEGINS
SYM (L,HOMLEN,51) ;FIRST ADDRESS OF TABLE OF LENGTHS OF SYSTEM FILES
SYM (L,HOMUTP,57) ;UNIT TYPE ON WHICH HOM BLOCK WAS WRITTEN (UNYUTP)
SYM (L,HOMRIP,60) ;USED BY RIPOFF
SYM (L,HOMKLB,61) ;20 WORDS USED BY PDP-11 IN KL10 SYSTEMS
SYM (L,HOMFEB,HOMKLB) ;FIRST DATA BLOCK # OF FE.SYS
SYM (L,FEVALID,100000) ;VALID ADDRESS IF ON
SYM (L,HOMFEL,62) ;LENGTH OF FE.SYS
SYM (L,HOMFEA,101) ;FE-FILE ADDRESS FOR KS10
SYM (L,HOMFES,102) ;FE-FILE LENGTH FOR KS10
SYM (L,HOMTCS,103) ;TRACK/CYL/SECTOR FOR KS10
SYM (L,HOMKLE,104) ;TO FIND FILES FOR BOOTSTRAP/DUMP
SYM (L,HOMK4C,105) ;K FOR CRASH.SAV (NEW DISK)
SYM (L,HOMBTS,106) ;BITS IN THE HOM BLOCK
SYM (L,HOMPVS,HOMBTS) ;WORD CONTAINING BIT WHICH SAYS PRIVATE STR
SYM (L,HOPPVS,1B35) ;ON IF THIS UNIT IS CONTAINED IN A PRIVATE STR
SYM (L,HOSPVS,1) ;BYTE SIZE
SYM (L,HONPVS,^D35) ;BYTE POSITION
SYM (L,HOMSET,HOMBTS) ;WORD CONTAINING BYTE WHICH SPECIFIES DISK SET FOR STR
SYM (L,HOSSET,6) ;BYTE SIZE
SYM (L,HONSET,^D32) ;BYTE POSITION
SYM (L,HOMSDL,107) ;POSITION OF THIS STR IN SYSTEM DUMP LIST
SYM (L,HOMOPP,110) ;OWNER PPN OF THIS STR
SYM (L,HOMMSU,111) ;FOR FUTURE USE
SYM (L,HOMCUS,112) ;4 WORDS RESERVED TO CUSTOMERS
SYM (L,HOMCUL,115) ;LAST WORD IN THE HOM BLOCK RESERVED TO CUSTOMERS
SYM (L,HOMEND,115) ;LAST WORD CONTAINING VALID DATA IN HOM BLOCK
SYM (L,HOMVID,165) ;VOLUME ID (3 WORDS, 12 PDP-11 BYTES)
SYM (L,HOMOKC,170) ;K FOR CRASH.SAV (OLD DISK)
SYM (L,HOMOWN,170) ;OWNER NAME
SYM (L,HOMVSY,173) ;SYSTEM TYPE (TOPS-10)
SYM (L,HOMCOD,176) ;CONTAINS UNLIKELY CODE
SYM (L,CODHOM,707070) ;THE UNLIKELY CODE FOR THE HOM BLOCK
SYM (L,HOMSLF,177) ;BLOCK # WITHIN UNIT OF THIS BLOCK
SYM (P,HOM,0) ;PROGRAM NAME (MUST BE LAST)
> ;END DEFINE SYMHOM
SYMHOM
SUBTTL DEFINITIONS -- RIB BLOCK
DEFINE SYMRIB,<
SYM (L,RIBFIR,0) ;AOBJN POINTER TO FIRST RETRIEVAL POINTER
SYM (L,RIBPPN,1) ;PPN WHICH OWNS FILE
SYM (L,RIBNAM,2) ;FILE NAME
SYM (L,RIBEXT,3) ;LH = EXTENSION
;RH = ACCESS DATE
SYM (L,RIBATT,4) ;FILE ATTRIBUTES
SYM (L,RIBPRV,RIBATT) ;00-08 ACCESS CODE
SYM (L,RISPRV,^D9) ;BYTE SIZE
SYM (L,RINPRV,^D8) ;BYTE POSITION
;09-12 CREATION TIME IN MINUTES SINCE MIDNIGHT
;24-35 CREATION DATE
SYM (L,RIBSIZ,5) ;WRITTEN LENGTH IN WORDS
SYM (L,RIBVER,6) ;VERSION NUMBER
SYM (L,RIBSPL,7) ;SPOOLED FILE NAME
SYM (L,RIBEST,10) ;ESTIMATED FILE LENGTH
SYM (L,RIBALC,11) ;# OF BLOCKS ALLOCATED TO FILE INCLUDING RIBS
SYM (L,RIBPOS,12) ;LOGICAL BLOCK WITHIN STR OF LAST ALLOCATED GROUP
SYM (L,RIBFT1,13) ;PRIVILEGED ARG FOR DIGITAL TO DEFINE
SYM (L,RIBUNI,RIBFT1) ;UNITS WHICH WROTE FILE
;BITS 10-17 = UNIT
;BITS 18-20 = KONTROLLER
;BITS 21-35 = APR SERIAL NUMBER
SYM (L,RIBNCA,14) ;UNPRIVILEGED ARG FOR EACH CUSTOMER TO DEFINE
SYM (L,RIBLNA,RIBNCA) ;LAST UNPRIVILEGED ARG
SYM (L,RIBMTA,15) ;36-BIT TAPE LABEL IF FILE HAS BEEN PUT ON MAGTAPE
SYM (L,RIBDEV,16) ;FILE STRUCTURE NAME FILE STARTS ON
SYM (L,RIBSTS,17) ;STATUS BITS FOR ALL FILES IN UFD(LH), THIS FILE (RH)
SYM (L,RIPLOG,400000) ;(LH) USER LOGGED IN
SYM (L,RIPCHG, 10000) ;(LH) ANY FILE WRITTEN/RENAMED
SYM (L,RIPDIR,400000) ;(RH) DIRECTORY FILE
SYM (L,RIPNDL,200000) ;(RH) NO DELETE
SYM (L,RIPDMP,100000) ;(RH) CONTAINS AN UNPROCESSED MONITOR CRASH
SYM (L,RIPNFS, 40000) ;(RH) NO FAILSAFE
SYM (L,RIPABC, 20000) ;(RH) ALWAYS BAD CHECKSUM
SYM (L,RIPCBS, 10000) ;(RH) COMPRESS BIT SET ON ENTRY TO COMPRESSOR
SYM (L,RIPABU, 4000) ;(LH/RH) ALWAYS BACKUP
SYM (L,RIPNQC, 2000) ;(LH/RH) NON QUOTA-CHECKED FILE
SYM (L,RIPCMP, 1000) ;(RH) THIS UFD IS BEING COMPRESSED
SYM (L,RIPSCE, 400) ;(LH/RH) SOFTWARE CHECKSUM ERROR
SYM (L,RIPHWE, 200) ;(LH/RH) HARD WRITE DATA ERROR
SYM (L,RIPHRE, 100) ;(LH/RH) HARD READ DATA ERROR
SYM (L,RIPRMS, 40) ;(RH) RMS FILE
SYM (L,RIPPAL, 20) ;(RH) PRE-ALLOCATED FILE
SYM (L,RIPBFA, 10) ;(LH/RH) FILE(S) FOUND BAD BY FAILSAFE
SYM (L,RIPCRH, 4) ;(LH/RH) FILE(S) CLOSED AFTER A CRASH
SYM (L,RIPBDA, 1) ;(LH/RH) FILE(S) FOUND BAD BY DAMAGE ASSESSMENT CUSP
SYM (L,RIBELB,20) ;LOGICAL BLOCK WITH ERROR IN WHICH BAD REGION BEGINS
SYM (L,RIBEUN,21) ;LH=LOGICAL UNIT ON WHICH ERROR REGION OCCURED
SYM (L,RIBNBB,RIBEUN) ;RH=# OF CONSECUTIVE LOGICAL BLOCKS IN BAD REGION
SYM (L,RIBQTF,22) ;(UFD ONLY) FIRST COME FIRST SERVE LOGGED IN QUOTA
SYM (L,RIBTYP,RIBQTF) ;(DATA FILE) FILE TYPE AND FLAGS
SYM (L,RIBQTO,23) ;(UFD ONLY) LOGGED-OUT QUOTA
SYM (L,RIBBSZ,RIBQTO) ;(DATA FILE) BYTE SIZE WORD
SYM (L,RIBQTR,24) ;(UFD ONLY) RESERVED LOGGED IN QUOTA
SYM (L,RIBRSZ,RIBQTR) ;(DATA FILE) RECORD AND BLOCK SIZES
SYM (L,RIBUSD,25) ;(UFD ONLY) COUNT OF BLOCKS USED
SYM (L,RIBAPW,RIBUSD) ;(DATA FILE) APPLICATION WORD
SYM (L,RIBAUT,26) ;PPN OF AUTHOR OF FILE
SYM (L,RIBNXT,27) ;NAME OF NEXT FILE STRUCTURE IF FILE IS CONTINUED
SYM (L,RIBPRD,30) ;NAME OF PREDECESSOR FILE STRUCTURE
SYM (L,RIBPCA,31) ;PRIVILEGED ARG FOR EACH CUSTOMER TO DEFINE
SYM (L,RIBUFD,32) ;LOGICAL BLOCK WITHIN STR OF UFD DATA BLOCK
SYM (L,RIBFLR,33) ;RELATIVE BLOCK IN FILE OF FIRST BLOCK IN RIB
SYM (L,RIBXRA,34) ;EXTENDED RIB ADDRESS
SYM (L,DESRBC,^D8) ;COUNT OF RIBS, BYTE SIZE
SYM (L,DENRBC,^D8) ;BYTE POSITION, POINTER IS DEYRBC
SYM (L,DESRBU,^D4) ;LOGICAL UNIT WITHIN STR, BYTE SIZE
SYM (L,DENRBU,^D12) ;BYTE POSITION, POINTER IS DEYRBU
SYM (L,DESRBA,^D23) ;CLUSTER ADDRESS, BYTE SIZE
SYM (L,DENRBA,^D35) ;BYTE POSITION, POINTER IS DEYRBA
SYM (L,RIBTIM,35) ;CREATION DATE & TIME IN NEW DATE FORMAT
SYM (L,RIBLAD,36) ;(UFD ONLY) LAST ACCOUNTING DATE
SYM (L,RIBDED,37) ;(UFD ONLY) DIRECTORY EXPIRATION DATE
SYM (L,RIBACT,40) ;AOBJN POINTER TO ACCOUNT STRING
;FIRST RETRIEVAL POINTER STORED HERE. THERE IS NO SYMBOL ASSIGNED.
;RIBFIR IS THE ONLY POINTER TO THIS AREA.
SYM (L,RIPNUB,400000) ;BIT SET IN NEW UNIT PTR. TO INSURE NON-ZERO
SYM (L,RIBCOD,176) ;CONTAINS UNLIKELY CODE
SYM (L,CODRIB,777777) ;THE UNLIKELY CODE FOR THE RIB BLOCK
SYM (L,RIBSLF,177) ;BLOCK # WITHIN UNIT OF THIS BLOCK
SYM (P,RIB,0) ;PROGRAM NAME (MUST BE LAST)
> ;END DEFINE SYMRIB
SYMRIB
SUBTTL DEFINITIONS -- UNIT BLOCKS
.ORG 0
.UNNAM:! BLOCK 1 ;SIXBIT PHYSICAL UNIT NAME
.UNLOG:! BLOCK 1 ;SIXBIT LOGICAL UNIT NAME WITHIN STRUCTURE
.UNLUN:! BLOCK 1 ;LOGICAL UNIT WITHIN STRUCTURE
.UNSNM:! BLOCK 1 ;STRUCTURE NAME
.UNBSC:! BLOCK 1 ;BLOCKS PER SUPER CLUSTER
.UNCNP:! BLOCK 1 ;BP FOR CLUSTER COUNT IN RETRIEVAL POINTER
.UNCKP:! BLOCK 1 ;BP FOR CHECKSUM IN RETRIEVAL POINTER
.UNCLP:! BLOCK 1 ;BP FOR CLUSTER ADDRESS IN RETRIEVAL POINTER
.UNUSZ:! BLOCK 1 ;UNIT SIZE IN BLOCKS
.UNBPC:! BLOCK 1 ;BLOCKS PER CLUSTER
.UNSPU:! BLOCK 1 ;SATS PER UNIT (FROM HOM BLOCK)
.UNOVR:! BLOCK 1 ;OVERDRAW BLOCK COUNT
.UNHLB:! BLOCK 1 ;HIGHEST LEGAL BLOCK NUMBER
.UNPOS:! BLOCK 1 ;DESIRED POSITION
.UNBLK:! BLOCK 1 ;CURRENT BLOCK NUMBER
.UNCHN:! BLOCK 1 ;I/O CHANNEL NUMBER
.UNFLG:! BLOCK 1 ;FLAGS
UN.OUT==1B0 ;DOING OUTPUT
UN.OFL==1B1 ;OFFLINE
UN.NER==1B2 ;NO (IGNORE) I/O ERRORS
.UNIOC:! BLOCK 2 ;I/O COMMAND LIST
.UNIOM:! BLOCK 1 ;I/O MODE (OPEN BITS)
.UNIOS:! BLOCK 1 ;I/O STATUS
.UNLEN:! ;LENGTH OF BLOCK
.ORG
SUBTTL DEFINITIONS -- SAT STORAGE
.ORG 0
.SDNUM:! BLOCK 1 ;SAT BLOCK NUMBER (1 TO N)
.SDUNI:! BLOCK 1 ;LOGICAL UNIT NUMBER
.SDUBN:! BLOCK 1 ;UNIT-RELATIVE BLOCK FOR THIS SAT
.SDERR:! BLOCK 1 ;BYTE POINTER TO ERROR BYTE FOR THIS SAT
.SDBLK:! BLOCK 1 ;DATA FILE DISK BLOCK FOR THIS SD
.SDTAL:! BLOCK 1 ;NUMBER OF FREE CLUSTERS IN THIS SAT BLOCK
.SDCPS:! BLOCK 1 ;CLUSTERS IN THIS SAT
.SDMIN:! ;MINIMUM LENGTH OF SAT DESCRIPTOR BLOCK
;WORDS BEFORE THIS ARE KEPT INCORE, THOSE AFTER
;IN THE DATA FILE
.SDHDR:! BLOCK 1 ;OFFSET IN DATA FILE HEADER OF THIS SD
.SDFIR:! BLOCK 1 ;STARTING CLUSTER IN THIS SAT
.SDLAS:! BLOCK 1 ;ENDING CLUSTER IN THIS SAT
.SDWPS:! BLOCK 1 ;-VE WORDS IN THIS SAT,,0
.SDSCN:! BLOCK 1 ;LH = -VE WORD COUNT
;RH = BLOCK OFFSET TO START LOOKING FOR FREE SPACE
.SDUPD:! BLOCK 1 ;NON-ZERO IF UPDATE IN PROGRESS
.SDVAL:! BLOCK 1 ;NON-ZERO IF DISK,,COMPUTED & MULTPLY-USED BLOCKS VALID
.SDDSK:! BLOCK BLKSIZ ;DISK SAT
.SDCOM:! BLOCK BLKSIZ ;COMPUTED SAT
.SDMUL:! BLOCK BLKSIZ ;MULTIPLY-USED SAT
BLOCK <.!<BLKSIZ-1>>-.+1 ;ROUND UP TO THE NEXT BLOCK BOUNDRY
.SDLEN:! ;LENGTH OF SAT DESCRIPTOR BLOCK
.ORG
SUBTTL DEFINITIONS -- DATA FILE
VARSIZ==0 ;CLEAR COUNT OF VARIABLE WORDS NEEDED
DEFINE VDATA (LEN),<
BLOCK 1 ;;RESERVE WORD FOR OFFSET TO VARIABLE DATA
XLIST ;;SUPPRESS LISTING
VARSIZ==VARSIZ+LEN ;;TALLY UP WORDS NEEDED FOR STORAGE
LIST ;;TURN LISTING BACK ON
> ;END DEFINE VDATA
DEFINE VSUM (STT,COM,ACT,HDR),<
IF1,<
PRINTX Static storage: 'STT
PRINTX Computed variable storage: 'COM
PRINTX Actual storage available: 'ACT
PRINTX Data file header size: 'HDR
> ;END IF1
> ;END DEFINE VSUM
.ORG 0
.DFNAM:! BLOCK 1 ;PROGRAM NAME
.DFVER:! BLOCK 1 ;VERSION
.DFSIZ:! BLOCK 1 ;HEADER SIZE IN WORDS
.DFFMT:! BLOCK 1 ;FILE FORMAT
%FMT==1 ;FILE FORMAT
.DFEOF:! BLOCK 1 ;NEXT BLOCK TO WRITE AT EOF
.DFTSK:! BLOCK MAXHKS ;TASK NAME
.DFCRS:! BLOCK 1 ;CHECKPOINT/RESTART STATE
.DFCRD:! VDATA (CRDSIZ) ;OFFSET TO CHECKPOINT/RESTART DATA
;PARAMETERS
.DFFLG:! BLOCK 1 ;FLAGS
DF.DSK==1B0 ;DSK WRITING (0=OFF, 1=ON)
DF.HOM==1B1 ;HOM WRITING (0=OFF, 1=ON)
DF.BAT==1B2 ;BAT WRITING (0=OFF, 1=ON)
DF.SAT==1B3 ;SAT WRITING (0=OFF, 1=ON)
DF.RIB==1B4 ;RIB WRITING (0=OFF, 1=ON)
DF.LBA==1B5 ;LOOKUP BY ANY RIB
DF.LBP==1B6 ;LOOKUP BY PRIME RIB
DF.LBS==1B7 ;LOOKUP BY SPARE RIB
DF.PIP==1B8 ;PATCH IN PROGRESS
DF.IBC==1B9 ;INHIBIT PATCH BUFFER CLEARING
DF.PFS==1B10 ;PREFER DATA FILE SAT OVER DISK SAT
DF.ZRS==1B11 ;ZERO RIBSIZ ON ZERO COMMANDS
DF.IOT==1B12 ;I/O TRACE
DF.CED==1B13 ;CHECKSUM ERROR DETECTION (0=OFF, 1=ON)
DF.DMP==17B32 ;DUMP FORMAT CODE
DF.FAC==7B35 ;FILE ACCESS CODE
.DFBPR:! BLOCK 1 ;BLOCKS PER READ
.DFCPI:! BLOCK 1 ;CHECKPOINT INTERVAL (IN BLOCKS)
.DFDFM:! BLOCK MAXHKS ;DEFAULT DUMP FORMAT (KEYWORD)
.DFDMP:! BLOCK MAXDMP*.FMLEN ;DUMP FORMAT DESCRIPTORS
.DFDPS:! BLOCK 1 ;DEFAULT PATCH BUFFER SIZE
.DFEDV:! VDATA (MAXEDV) ;-LENGTH,,OFFSET TO ERSATZ DEVICE TABLE
.DFFAC:! BLOCK MAXHKS ;FILE ACCESS (KEYWORD)
.DFIOT:! BLOCK MAXIOT*.FMLEN ;I/O TRACE FORMAT DESCRIPTORS
.DFLPN:! BLOCK 1 ;LOGGED-IN PPN
.DFLVL:! BLOCK 1 ;MAXIMUM SFD LEVEL
.DFMFD:! BLOCK 1 ;MFD PPN
.DFPPN:! BLOCK 1 ;CURRENT PPN
.DFPTH:! VDATA (.PTPPN+MAXSFD) ;-LENGTH,,OFFSET TO PATH BLOCK
.DFRNG:! BLOCK 2 ;DUMP RANGE
.DFSRT:! BLOCK 1 ;SORT BUFFER SIZE
.DFSBL:! BLOCK 1 ;LENGTH OF A SCAN BLOCK
.DFCMD:! VDATA (.SBMIN+MAXSFD) ;OFFSET TO SCAN BLOCK FOR COMMANDS
.DFINP:! VDATA (.SBMIN+MAXSFD) ;OFFSET TO SCAN BLOCK FOR INPUT SPEC
.DFISV:! VDATA (.SBMIN+MAXSFD) ;OFFSET TO SCAN BLOCK FOR SAVED INPUT SPEC
.DFOUT:! VDATA (.SBMIN+MAXSFD) ;OFFSET TO SCAN BLOCK FOR OUTPUT SPEC
.DFRFB:! VDATA (.FBMIN+MAXSFD) ;OFFSET TO FILE BLOCK FOR RETURNED SPEC
.DFRSB:! VDATA (.SBMIN+MAXSFD) ;OFFSET TO SCAN BLOCK FOR RETURNED SPEC
.DFRSV:! VDATA (.SBMIN+MAXSFD) ;OFFSET TO SCAN BLOCK FOR SAVED RETURNED SPEC
.DFFBB:! BLOCK 1 ;NUMBER OF FILE BLOCKS PER DISK BLOCK
.DFFBL:! BLOCK 1 ;LENGTH OF FILE BLOCK
.DFFBT:! VDATA (.FBMIN+MAXSFD) ;OFFSET TO TEMPORARY FILE BLOCK
;STRUCTURE DATA
.DFSTR:! BLOCK 1 ;STRUCTURE NAME
.DFSTN:! BLOCK 1 ;NUMBER OF UNITS IN STRUCTURE
.DFBPC:! BLOCK 1 ;BLOCKS PER CLUSTER
.DFBSC:! BLOCK 1 ;BLOCKS PER SUPER CLUSTER
.DFCKP:! BLOCK 1 ;BP FOR CHECKSUM IN RETRIEVAL POINTER
.DFCLP:! BLOCK 1 ;BP FOR CLUSTER ADDRESS RETRIEVAL POINTER
.DFCNP:! BLOCK 1 ;BP FOR CLUSTER COUNT IN RETRIEVAL POINTER
.DFSCU:! BLOCK 1 ;SUPER CLUSTERS PER UNIT
.DFBUS:! BLOCK 1 ;BIGGEST UNIT SIZE
.DFFIN:! BLOCK 1 ;NON-ZERO IF FINISHED SCANNING
.DFHLB:! BLOCK 1 ;HIGHEST LEGAL BLOCK
.DFOVR:! BLOCK 1 ;OVERDRAW
;UNIT DATA
.DFUNI:! BLOCK MAXUNI*.UNLEN ;UNIT DATA
;SPECIAL DISK BLOCK DATA
.DFBAT:! BLOCK 1 ;BAT BLOCK ERROR BITS (1ST,,2ND)
.DFBTS:! BLOCK NBOOTB+1 ;BOOT BLOCKS IN ERROR (0,4,5,6,7)
.DFHOM:! BLOCK 1 ;HOM BLOCK ERROR BITS (1ST,,2ND)
.DFNSB:! BLOCK 1 ;NUMBER OF SAT BLOCKS
.DFSAT:! VDATA (MAXSAT*.SDMIN) ;OFFSET TO IN CORE SD
.DFSEB:! BLOCK <MAXSAT>/4 ;SAT ERROR BYTE STORAGE
.DFSRB:! BLOCK 1 ;BLOCK NUMBER OF RIB FOR SAT.SYS
;FILE DATA
.DFFBN:! BLOCK 1 ;NUMBER OF FILE BLOCKS
.DFFIL:! BLOCK 1 ;OFFSET TO FILE BLOCKS
.DFFSF:! BLOCK 1 ;FIRST SORTED FILE BLOCK NUMBER
.DFLSF:! BLOCK 1 ;LAST SORTED FILE BLOCK NUMBER
;PATCH DATA
.DFPBF:! BLOCK MAXPAT ;PATCH BUFFER
.DFPFL:! VDATA (.SBMIN+MAXSFD) ;OFFSET TO FILESPEC
.DFPFW:! VDATA (.FWMIN) ;OFFSET TO FILE I/O BLOCK
.DFPLR:! BLOCK 1 ;LAST BLOCK READ
.DFPLW:! BLOCK 1 ;LAST BLOCK WRITTEN
.DFPIO:! BLOCK 1 ;LAST I/O DIRECTION (0 = READ, 1 = WRITE)
.DFPMD:! BLOCK 1 ;PATCH MODE (-1=STR, 0=UNIT, +1=FILE)
.DFPNM:! BLOCK 1 ;LOGICAL UNIT OR STRUCTURE NAME
;VARIABLE DATA STORAGE (MUST BE LAST AND ORDER NOT CHANGED)
;NOTE THAT THE COMPUTATION OF THE "PROBABLE" QUANTITIES IS
;NECESSITATED BY THE FACT THAT THERE ARE SO MANY FORWARD REFRENCES
;AND, UNDERSTANBLY, MACRO CANNOT HANDLE THEM.
.DFVFW:! BLOCK 1 ;VARIABLE STORAGE FREE WORDS
PRBHDR==<.+VARSIZ+44>/44 ;PROBABLE SIZE OF MAP FOR HEADER MINUS MAP
PRBMAP==PRBHDR+<<PRBHDR+44>/44> ;PROBABLE SIZE OF MAP
PRBDAT==.+PRBHDR+PRBMAP+VARSIZ ;PROBABLE SIZE OF DEFINED DATA
PRBLEN==<PRBDAT!<BLKSIZ-1>>+1 ;PROBABLE LENGTH OF HEADER
MAPSIZ==<PRBLEN+44>/44 ;SIZE OF ACTUAL BIT MAP FOR ENTIRE HEADER
.DFVMP:! BLOCK MAPSIZ ;VARIABLE STORAGE BIT MAP
.DFVAR:! BLOCK VARSIZ ;RESERVE SPACE FOR VARIABLE STORAGE
BLOCK <.!<BLKSIZ-1>>-.+1 ;ROUND UP TO THE NEXT BLOCK BOUNDRY
.DFLEN:! ;LENGTH IN WORDS
.ORG
VSUM (\.DFVMP,\VARSIZ,\<.DFLEN-.DFVAR>,\.DFLEN)
SUBTTL DEFINITIONS -- TASK TABLE
.ORG 0
.TKABO:! BLOCK 1 ;ABORT ROUTINE
.TKPTR:! BLOCK 1 ;WORKING AOBJN POINTER
.TKRTN:! ;START OF SUBROUTINES
.ORG
;MACRO TO GENERATE TASK TABLE HEADERS
DEFINE TASKH (ABO),<
...TSK==. ;;SET TEMP SYMBOL TO RELOC COUNTER
XLIST ;;SUPPRESS LISTING
EXP ABO ;;ABORT ROUTINE
EXP 0 ;;WORKING AOBJN POINTER
LIST ;;REINSTATE LISTING
> ;END DEFINE TASKH
;MACRO TO GENERATE TASK TABLE SUBROUTINE ENTRIES
DEFINE TASKS (ADR),<IFIW ADR>
;MACRO TO TERMINATE TASK TABLE
DEFINE TASKT,<
XLIST ;;SUPPRESS LISTING
.XCREF ;;SUPPRESS USELES SYMBOLS
ZZ==.-...TSK ;;TOTAL LENGTH OF TABLE
.ORG ...TSK+.TKPTR ;;CHANGE RELOCATION COUNTER
XWD -<ZZ-.TKRTN>,0 ;;AOBJN POINTER TO SUBROUTINES
.ORG ;;RESTORE RELOCATION COUNTER
PURGE ZZ, ...TSK ;;REMOVE USELESS SYMBOLS
.CREF ;;TURN CREF BACK ON
LIST ;;REINSTATE LISTING
> ;END DEFINE TASKT
SUBTTL PROGRAM INITIALIZATION -- ENTRY POINT
RELOC 0
LOC JOBINT ;INTERCEPT BLOCK ADDRESS
EXP INTBLK
LOC JOBVER ;VERSION NUMBER
EXP <BYTE(3)VERWHO(9)VERMAJ(6)VERMIN(18)VEREDT>
RELOC
START: JFCL ;NO CCL
TDZA P,P ;NOT DEBUGGING
DEBUG: MOVNI P,1 ;GET DEBUG FLAG
MOVEM P,DEBUGF ;SAVE FOR LATER
RESET ;STOP I/O
SETZB 0,Z.BEG ;CLEAR AC 0 & FIRST WORD OF STORAGE
MOVE 17,[Z.BEG,,Z.BEG+1] ;SET UP BLT
BLT 17,Z.END-1 ;CLEAR ALL STORAGE
MOVEI 17,1 ;SET UP BLT
BLT 17,17 ;CLEAR THE ACS
MOVE P,[IOWD PDLSIZ,PDL] ;SET UP STACK
PUSHJ P,CHKPRV ;TURN ON PRIVS
PUSHJ P,DDTSAV ;SAVE DDT ADDRESSES
PUSHJ P,PATSYM ;FIXUP PATCHING SYMBOL TABLE
PUSHJ P,M$INIT ;INITIALIZE MEMORY MANAGER
PUSHJ P,T$INIT ;INITIALIZE TEXT PROCESSOR
PUSHJ P,D$INIT ;INITIALIZE DATA FILE PARAMETERS
PUSHJ P,D$VARS ;SET VARIABLES FROM DEFAULTS
JRST MAIN ;ENTER TOP LEVEL COMMAND LOOP
SUBTTL PROGRAM INITIALIZATION -- CHKPRV - CHECK FOR PRIVILEGES
CHKPRV: GETPPN T1, ;GET OUR PPN
JFCL ;INCASE OF JACCT
MOVE T2,[%LDFFA] ;NEED THE PPN FOR [OPR]
GETTAB T2, ;ASK MONITOR
MOVE T2,[1,,2] ;TYPICAL VALUE
CAMN T1,T2 ;GODLY?
JRST CHKPR1 ;YES
HRROI T1,.GTPRV ;WILL NEED TO CHECK PRIVS
GETTAB T1, ;ASK MONITOR
SETZ T1, ;FAILED
TDNN T1,[PRVBIT] ;HAVE THE NECESSARY PRIVS TO RUN JACCT PROGRAM?
JRST NOPRIV ;NOPE
MOVE T1,[3,,T2] ;POKE. UUO AC
MOVE T2,[.GTSTS,,.GTSLF] ;NEED ADDR OF JBTSTS IN MONITOR
GETTAB T2, ;ASK MONITOR
FATAL (CRJ,NOPRIV,<Cannot read base address of JBTSTS in monitor>)
HRRZS T2 ;ISOLATE TABLE ADDRESS
PJOB T3, ;GET OUR JOB
ADDI T2,(T3) ;INDEX BY OUR JOB NUMBER
HRROI T3,.GTSTS ;OUR JOB STATUS WORD
GETTAB T3, ;READ IT
FATAL (CRS,NOPRIV,<Cannot read job status word in monitor>,)
MOVE T4,T3 ;COPY IT
TLOE T4,1 ;TURN ON JACCT
JRST CHKPR1 ;ALREADY HAVE IT!
POKE. T1, ;ENABLE PRIVS
JRST NOPRIV ;FAILED
CHKPR1: SETZM CCTRAP ;ALLOW CONTROL-C TO WORK
POPJ P, ;YES
NOPRIV: FATAL (NPV,.+1,<No privileges to perform super I/O>,)
EXIT 1, ;DIE QUIETLY
JRST .-1 ;THE FOOL TYPED CONTINUE
SUBTTL TOP LEVEL COMMAND PROCESSING
REENTR: MOVE P,[IOWD PDLSIZ,PDL] ;RESET THE STACK
SETZM INTBLK+.EROPC ;RE-ENABLE INTERRUPTS
PUSHJ P,DDTRES ;RESTORE DDT START AND BREAKPOINT ADDRESSES
PUSHJ P,L$RSET ;RESET OPENED LISTING FILE (IF ANY)
SKIPN CNAME ;COMMAND IN PROGRESS?
JRST MAIN ;NOPE
WARN (CAB,MAIN,<>,E..CAB)
E..CAB: MOVE T1,CNAME ;GET COMMAND NAME
PUSHJ P,T$STRG ;PRINT IT
MOVEI T1,[ASCIZ / command aborted/]
PJRST T$STRG ;PRINT TEXT AND RETURN
MAIN: MOVE P,[IOWD PDLSIZ,PDL] ;RESET THE STACK
PUSHJ P,F$RSET ;RESET FILE I/O IN PROGRESS (IF ANY)
SETZM CMDOPF ;INVALIDATE ANY STALE PARSE OPTIONS
SETZM CNAME ;CLEAR OUT LAST COMMAND NAME
SETZM CCTRAP ;ALLOW EXIT ON CONTROL-C
MOVEI T1,REENTR ;GET REENTER ADDRESS
MOVEM T1,JOBREN ;TELL MONITOR WHERE TO LOOK
XMOVEI T1,MAIN.T ;POINT TO COMMAND TABLES
PUSHJ P,C$TSET ;SET UP SCANNER
;MATCH ANGLE BRACKETS <
MOVEI T1,[ASCIZ /DPATCH>/] ;PROMPT STRING
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST MAIN2 ;NO INPUT
PUSHJ P,C$ATOM ;GET THE COMMAND NAME
JRST [PUSHJ P,C$EILC ;REPORT ILLEGAL CHARACTER
JRST MAIN] ;TRY AGAIN
MAIN1: XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,MAIN.N ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
JRST [PUSHJ P,C$EKEY ;FAILED
JRST MAIN] ;TRY AGAIN
MOVEM T1,CNAME ;SAVE ADDRESS OF FULL COMMAND NAME
HRRZ T3,MAIN.P(T2) ;GET DISPATCH ADDRESS
JUMPE T3,[PUSHJ P,C$EUNK ;NOT A VALID OPTION
JRST MAIN] ;TRY AGAIN
PUSHJ P,@MAIN.P(T2) ;DISPATCH
JFCL ;INCASE OF SKIP RETURN
MAIN2: SKIPE CMDEOF ;WAS LAST CHARACTER CONTROL-Z?
PUSHJ P,.EXIT ;YES--RETURN TO MONITOR
JFCL ;IGNORE NON-SKIP
JRST MAIN ;LOOP BACK FOR ANOTHER
DEFINE KEYS,<
KEY (<DDT>, .DDT ,DDTHLP, )
KEY (<DELETE>, .DELET,DELHLP, )
KEY (<DIRECTORY>, .DIREC,DIRHLP, )
KEY (<DUMP>, .DUMP ,DUMHLP,DUMP.T)
KEY (<EXIT>, .EXIT ,EXIHLP, )
KEY (<FILE>, .FILE ,FILHLP, )
KEY (<FINISH>, .FINIS,FINHLP, )
KEY (<FORMAT>, .FORMA,FORHLP,FORM.T)
KEY (<GET>, .GET ,GETHLP, )
KEY (<HELP>, .HELP ,HLPHLP, )
KEY (<PATCH>, .PATCH,PATHLP, )
KEY (<PUT>, .PUT ,PUTHLP, )
KEY (<READ>, .READ ,REDHLP, )
KEY (<SET>, .SET ,SETHLP,SETX.T)
KEY (<SHOW>, .SHOW ,SHWHLP,SHOW.T)
KEY (<START>, .START,STAHLP,TASK.T)
KEY (<STRUCTURE>, .STRUC,STRHLP, )
KEY (<TRANSLATE>, .TRANS,TRNHLP,TRAN.T)
KEY (<TYPE>, .TYPE ,TYPHLP, )
KEY (<WRITE>, .WRITE,WRTHLP, )
KEY (<ZERO>, .ZERO ,ZERHLP, )
>
KEYTAB (MAIN,<TBL,NAM,PRC,HLP,CMD>)
SUBTTL DDT COMMAND
.DDT: PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
MOVEM 0,CRSHAC+0 ;SAVE AC 0
MOVE 0,[1,,CRSHAC+1] ;SET UP BLT
BLT 0,CRSHAC+17 ;SAVE THE ACS
SKIPN T1,JOBBPT ;GET UNSOLICITED BREAKPOINT ADDRESS
SKIPN T1,JOBDDT ;GET DDT START ADDRESS
TLOA T1,(JSR) ;MAKE BPT JUMP
HRLI T1,(JRST) ;ELSE NORMAL JUMP TO START ADDR
MOVEM T1,DDTGO ;SAVE FOR A MOMENT
MOVE T1,CRSHAC+T1 ;RELOAD AC
MOVSI T1,(DF.PIP) ;BIT TO TEST
TDNN T1,.DFFLG(D) ;PATCH IN PROGRESS?
WARN (NPP,.+1,<No patch in progress>,)
XCT DDTGO ;ENTRE DDT
RET: MOVE 0,[CRSHAC+1,,1] ;SET UP BLT
BLT 0,17 ;RESTORE THE ACS
MOVE 0,CRSHAC ;RELOAD AC 0
JRST CPOPJ1 ;RETURN
DDTSAV: MOVE T1,JOBDDT ;GET DDT START ADDRESS
MOVEM T1,SAVDDT ;SAVE IT
MOVE T1,JOBBPT ;GET UNSOLICITED BREAKPOINT ADDRESS
MOVEM T1,SAVBPT ;SAVE IT
POPJ P, ;RETURN
DDTHLP: ASCIZ \
The DDT command enters DDT. It may be used to examine and/or modify
the patch buffer. The command syntax is:
DDT
A special symbol table is set up containing all the necessary
structure and special block symbols. The following symbols are
available:
BUF - Patch buffer
FBOOTB - First block where BOOTS resides
NBOOTB - Length of BOOTS in blocks
LBNHOM - Logical block number of the first HOM block
LB2HOM - Logical block number of the second HOM block
LBOBAT - Offset from a HOM block to a BAT block
LBOISW - Offset from a HOM block to the initial swapping SAT
PATCH - Patch space
RET - The DDT return address
In addition, the following groups of symbols are defined:
All HOM block symbols
All BAT block symbols
All RIB block symbols
\
SUBTTL DELETE COMMAND
.DELET: MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;INITIALIZE IT
PUSHJ P,C$CEOL ;AT END OF LINE?
SKIPA ;NO
FATAL (NIF,CPOPJ,<No input filespec>,)
;READ FILESPEC
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
MOVSI T3,(T1) ;GET RETURNED SCAN BLOCK
HRR T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
HRRZ T4,T3 ;POINT TO DESTINATION
ADD T4,.DFSBL(D) ;COMPUTE ENDING ADDRESS
BLT T3,-1(T4) ;COPY SCAN BLOCK
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
DELET1: PUSHJ P,SAVE3 ;SAVE SOME ACS
SETZB P1,P2 ;ZERO COUNT OF FILES DELETED, BLOCKS FREED
MOVEI T1,.IOIMG ;MODE = IMAGE
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;IOWD
PUSHJ P,F$INI ;INITIALIZE FOR FILE I/O
FATAL (IOF,CPOPJ,<I/O set up failed for >,T$FERR)
DELET2: PUSHJ P,F$LKP ;FIND A FILE
JRST DELET5 ;CAN'T
PUSHJ P,F$DEL ;DELETE THE FILE, FREE UP BLOCKS IF POSSIBLE
JRST DELET4 ;CAN'T
ADD P2,T1 ;TALLY UP ALLOCATED BLOCKS FREED
MOVE P3,T1 ;MAKE A COPY
PUSHJ P,F$CLOS ;CLOSE
JUMPN P1,DELET3 ;JUMP IF BEEN HERE BEFORE
XMOVEI T1,[ASCIZ / Files deleted:/]
PUSHJ P,T$STRG ;PRINT TEXT
PUSHJ P,T$CRLF ;END LINE
DELET3: PUSHJ P,T$SPAC ;SPACE OVER
MOVE T1,.DFRSB(D) ;GET OFFSET TO RETURNED FILESPEC SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,T$FILE ;PRINT FILE DELETED
XMOVEI T1,[ASCIZ / (/]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,P3 ;COPY BLOCKS IN THIS FILE
PUSHJ P,T$DECW ;PRINT IT
XMOVEI T1,[ASCIZ / blocks)/]
CAIN P3,1 ;JUST ONE?
XMOVEI T1,[ASCIZ / block)/]
PUSHJ P,T$STRG ;PRINT TEXT
PUSHJ P,T$CRLF ;END LINE
AOJA P1,DELET2 ;LOOP BACK FOR MORE FILES
DELET4: MOVE T2,.DFRSB(D) ;GET OFFSET TO RETURNED FILESPEC SCAN BLOCK
ADDI T2,(D) ;RELOCATE
WARN (EDF,.+1,<Error deleting >,T$FERR)
PUSHJ P,F$CLOS ;CLOSE FILE
JRST DELET5 ;FAILED
JRST DELET2 ;LOOP BACK FOR ANOTHER FILE
DELET5: CAIN T1,FENMF% ;NO MORE FILES?
JRST DELET6 ;ALMOST DONE
CAIN T1,FEFNF% ;FILE NOT FOUND?
SKIPA T2,.DFINP(D) ;MUST USE INPUT SPEC
MOVE T2,.DFRSB(D) ;ELSE USE TRANSLATION SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (LKP,F$FIN,<LOOKUP failed for >,T$FERR)
DELET6: PUSHJ P,F$FIN ;CLEAN UP
JRST CPOPJ1 ;RETURN
DELHLP: ASCIZ \ The DELETE command deletes files. Once deleted, a
file will no longer be pointed to by its parent directory. The
command syntax is:
DELETE filespec
"filespec" may be a wildcarded input file specification (the default).
\
SUBTTL DIRECT COMMAND
.DIREC: MOVE T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;INITIALIZE IT
MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;INITIALIZE IT
MOVE T1,.DFFBT(D) ;GET OFFSET TO TEMP FILE BLOCK
ADDI T1,(D) ;RELOCATE
SETZM (T1) ;CLEAR FIRST WORD
HRLS T1 ;PUT IN BOTH HALVES
AOS T1 ;MAKE A BLT POINTER
HLRZ T2,T1 ;GET FILE BLOCK STARTING ADDRESS
ADD T2,.DFFBL(D) ;COMPUTE END
BLT T1,-1(T2) ;CLEAR IT OUT
PUSHJ P,C$CEOL ;AT END OF LINE?
JRST DIREC1 ;NO
SETZB T1,T2 ;NO SCAN BLOCK
PUSHJ P,L$FILE ;DEFAULT LISTING SCAN BLOCK
JRST DIREC4 ;GO INPUT FILE APPLY DEFAULTS
;READ POSSIBLE OUTPUT FILESPEC
DIREC1: PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
PUSH P,T1 ;SAVE SCAN BLOCK ADDRESS
CAIE T2,"=" ;OUTPUT FILE?
SETZ T1, ;NO
PUSHJ P,L$FILE ;PROCESS LISTING SCAN BLOCK
POP P,T1 ;RESTORE SCAN BLOCK ADDRESS
JUMPE T1,DIREC4 ;NO FILESPEC AT ALL?
CAIE T2,"=" ;WAS THIS THE OUTPUT FILESPEC?
JRST DIREC3 ;NO
PUSHJ P,C$SKIP ;SKIP LEADING TABS AND SPACES
;HERE FOR AN INPUT FILSPEC
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
DIREC3: MOVSI T3,(T1) ;GET RETURNED SCAN BLOCK
HRR T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
HRRZ T4,T3 ;POINT TO DESTINATION
ADD T4,.DFSBL(D) ;COMPUTE ENDING ADDRESS
BLT T3,-1(T4) ;COPY SCAN BLOCK
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
DIREC4: XMOVEI T1,DIRDIB ;POINT TO DEFAULT OUTPUT BLOCK
MOVEI T2,DIRDIL ;GET ITS LENGTH
MOVE T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
PUSHJ P,C$DFIL ;APPLY DEFAULTS
DIREC5: MOVE T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,L$OPEN ;CREATE LISTING FILE
POPJ P, ;FAILED
PUSHJ P,L$ENVI ;PRINT ENVIRONMENTAL DATA (IF NECESSARY)
PUSHJ P,T$FORM ;START WITH A FORM FEED
XMOVEI T1,DIRHDR ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRN ;SET FOR LATER
PUSHJ P,DIRXXX ;PRINT DIRECTORY LISTING
PUSHJ P,L$CLOS ;CLOSE OF LISTING FILE
JRST CPOPJ1 ;RETURN
;DEFAULT INPUT SCAN BLOCK (DSK:*.*[-])
DIRDIB: EXP SB.NAM!SB.EXT!SB.DPT ;SCANNER FLAGS
EXP 0 ;DEVICE
EXP 0 ;DEVICE MASK
EXP '* ' ;FILE NAME
EXP 0 ;FILE NAME MASK
XWD '* ',0 ;EXTENSION,,MASK
DIRDIL==.-DIRDIB ;LENGTH OF BLOCK
;DEFAULT OUTPUT SCAN BLOCK
DIRDOB: EXP SB.DEV!SB.EXT ;SCANNER FLAGS
EXP 'TTY ' ;DEVICE
EXP -1 ;DEVICE MASK
EXP 0 ;FILE NAME
EXP 0 ;FILE NAME MASK
XWD 'DIR',-1 ;EXTENSION,,MASK
DIRDOL==.-DIRDOB ;LENGTH OF BLOCK
DIRHLP: ASCIZ \
The DIRECTORY command will print a directory of the files on the
structure. The command syntax is:
DIRECTORY listing-file = filespec
"listing-file" is optional and defaults to TTY:str.LST[-] where "str"
is the name of the currently selected structure. "filespec" may be a
wildcarded input file specification (the default).
\
DIRXXX: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE T1,[F.NOIO+.IOIMG] ;SUPPRESS I/O, USE IMAGE MODE
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;BUFFER (NOT USED)
PUSHJ P,F$INI ;INITIALIZE FOR I/O
FATAL (IOF,CPOPJ,<I/O set up failed for >,T$FERR)
DIRXX1: PUSHJ P,F$LKP ;FIND A FILE
JRST DIRXX2 ;CAN'T
MOVE P3,.DFRFB(D) ;GET OFFSET TO RETURNED FILE BLOCK
ADDI P3,(D) ;RELOCATE
PUSHJ P,DIRPNT ;PRINT DIRECTORY LINE
PUSHJ P,F$CLOS ;CLOSE FILE
JFCL ;DON'T CARE ABOUT FAILURES
JRST DIRXX1 ;LOOP FOR ALL FILES
DIRXX2: CAIN T1,FENMF% ;NO MORE FILES?
PJRST F$FIN ;ALL DONE
CAIN T1,FEFNF% ;FILE NOT FOUND?
SKIPA T2,.DFINP(D) ;MUST USE INPUT SPEC
MOVE T2,.DFRSB(D) ;ELSE USE TRANSLATION SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (LKP,F$FIN,<LOOKUP failed for >,T$FERR)
;PAGE HEADER ROUTINE
DIRHDR: PUSHJ P,DIRSAM ;SAME AS PREVIOUS PATH?
TDZA T1,T1 ;NO
MOVEI T1,1 ;REMEMBER CONTINUATION
PUSH P,T1 ;SAVE FLAG
PUSHJ P,DIRSAV ;SAVE POSSIBLY NEW PATH
PUSHJ P,DIRPTH ;NOW PRINT THE PATH
POP P,T1 ;GET FLAG BACK
JUMPE T1,DIRHD1 ;CONTINUATION?
XMOVEI T1,[ASCIZ / (continued)/]
PUSHJ P,T$STRG ;PRINT TEXT
DIRHD1: XMOVEI T1,DIRTTL ;POINT TO TITLE TEXT
PJRST T$STRG ;PRINT IT AND RETURN
DIRPNT: PUSHJ P,DIRSAM ;SAME AS PREVIOUS PATH?
SKIPA ;NO
JRST DIRPN1 ;DON'T PUT OUT PATH AGAIN
;PATH
MOVEI T1,2+2+2 ;LINE COUNT
PUSHJ P,L$TEST ;MAKE ROOM FOR PATH, TITLE, AND FILE LISTING
PUSHJ P,T$CRLF ;START WITH A NEW LINE
SETZ T1, ;NOT AT A PAGE BREAK
PUSHJ P,DIRHDR ;PRINT HEADER
JRST DIRPN2 ;PRESS ON
DIRPN1: MOVEI T1,2+1 ;LINE COUNT
PUSHJ P,L$TEST ;MAKE ROOM FOR FILE LISTING & SUMMARY
;FILE NUMBER
DIRPN2: PUSHJ P,T$SPAC ;SPACE OVER
LDB T1,[POINTR (.FBIDN(P3),FB.NUM)] ;FILE NUMBER
JUSTIFY (R,6," ",T$DECW)
;BLOCK NUMBER
PUSHJ P,T$SPAC ;SPACE OVER
MOVE T1,.FBBLK(P3) ;BLOCK NUMBER
JUSTIFY (R,^D7," ",T$DECW)
;RIB TYPE
PUSHJ P,DIRRIB ;PRINT RIB TYPE
;FILE NAME AND EXTENSION
PUSHJ P,DIRFIL ;PRINT FILE NAME AND EXTENSION
;ALLOCATION
PUSHJ P,T$SPAC ;SPACE OVER
MOVE T1,.FBALC(P3) ;GET ALLOCATED BLOCKS
JUSTIFY (R,^D7," ",T$DECW)
;PROTECTION
PUSHJ P,T$SPAC ;SPACE OVER
PUSHJ P,T$LANG ;PRINT LEFT ANGLE BRACKET
HRRZ T1,.FBEXT(P3) ;PROTECTION CODE
JUSTIFY (R,3,"0",T$OCTW) ;PRINT IT
PUSHJ P,T$RANG ;PRINT RIGHT ANGLE BRACKET
;CREATION DATE/TIME
PUSHJ P,DIRDTM ;PRINT DATE AND TIME
;VERSION
PUSHJ P,T$SPAC ;SPACE OVER
MOVE T1,.FBVER(P3) ;GET VERSION
JUSTIFY (R,^D15," ",T$VERW)
;ERROR BITS
PUSHJ P,DIRERR ;PRINT ERROR BITS
PJRST T$CRLF ;END LINE AND RETURN
DIRTTL: ASCIZ \
File Block RIB Name & Ext. Alloc Prot. Creation Version
------ ------- --- ------------- ------- ----- --------------- ---------------
\
;PRINT DATE AND TIME
DIRDTM: PUSHJ P,T$SPAC ;SPACE OVER
SKIPE .FBCRE(P3) ;GET CREATION DATE/TIME
JRST DIRDT1 ;HAVE IT
MOVEI T1,[ASCIZ /(undated)/]
JUSTIFY (C,^D15," ",T$STRG) ;PRINT TEXT
POPJ P, ;RETURN
DIRDT1: HLRZ T1,.FBCRE(P3) ;GET DATE COMPONENT
PUSHJ P,T$DATE ;PRINT IT
PUSHJ P,T$SPAC ;SPACE OVER
HRRZ T1,.FBCRE(P3) ;GET TIME IN MINUTES PAST MIDNIGHT
IDIVI T1,^D60 ;GET HOURS IN T1, MINUTES IN T2
CAIGE T1,^D10 ;SINGLE DIGIT?
PUSHJ P,T$SPAC ;YES--PAD WITH A LEADING SPACE
PUSHJ P,T$DECW ;PRINT HOURS
PUSHJ P,T$COLN ;AND A COLON
MOVEI T2,"0" ;GET A ZERO
EXCH T1,T2 ;SWAP AROUND
CAIGE T2,^D10 ;SINGLE DIGIT?
PUSHJ P,T$CHAR ;YES--PUT OUT A LEADING ZERO
MOVE T1,T2 ;GET NUMBER BACK
PJRST T$DECW ;PRINT IT AND RETURN
;PRINT ERROR INFORMATION
DIRERR: HLLZ T1,.FBFLG(P3) ;GET ERROR BITS
JUMPE T1,CPOPJ ;RETURN IF THERE AREN'T ANY
PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,T1 ;COPY BITS
SETZ P2, ;INIT TABLE INDEX
PUSHJ P,T$CRLF ;START WITH A NEW LINE
XMOVEI T1,[ASCIZ / Errors:/]
PUSHJ P,T$STRG ;PRINT INTRODUCTION
DIRER1: ROT P1,1 ;GET A BIT
TRZN P1,1 ;CLEAR FOR NEXT TIME
JRST DIRER2 ;NO ERROR HERE
AOS FBXETD(P2) ;COUNT ERRORS FOR DIRECTORY
AOS FBXETC(P2) ;COUNT ERRORS FOR TOTAL
PUSHJ P,T$SPAC ;START WITH A SPACE
HLLZ T1,FETEXT(P2) ;GET A MNEMONIC
PUSHJ P,T$SIXN ;PRINT IT
DIRER2: AOS P2 ;ADVANCE TABLE INDEX
JUMPN P1,DIRER1 ;LOOP BACK FOR MORE
POPJ P, ;RETURN
;PRINT FILE NAME AND EXTENSION
DIRFIL: PUSHJ P,T$SPAC ;SPACE OVER
HLRZ T1,.FBEXT(P3) ;GET EXTENSION
CAIE T1,'UFD' ;USER FILE DIRECTORY?
JRST DIRFI1 ;NO
SKIPG T1,.FBNAM(P3) ;GET PPN, SEE IF SIXBIT
JRST DIRFI1 ;SIXBIT, SO HANDLE LIKE NORMAL FILE NAME
HLRZS T1 ;ISOLATE PROJECT NUMBER
JUSTIFY (R,6," ",T$OCTW) ;PRINT IT
PUSHJ P,T$COMA ;PRINT COMMA
HRRZ T1,.FBNAM(P3) ;GET PROGRAMMER NUMBER
JUSTIFY (L,6," ",T$OCTW) ;PRINT IT
POPJ P, ;RETURN IGNORING EXTENSION
DIRFI1: PUSHJ P,T$SPAC ;SPACE OVER
MOVE T1,.FBNAM(P3) ;GET SIXBIT FILE NAME
JUSTIFY (L,6," ",T$SIXN) ;PRINT IT
MOVEI T1,[ASCIZ / /] ;SPACE
PUSHJ P,T$STRG ; OVER
HLLZ T1,.FBEXT(P3) ;EXTENSION
JUSTIFY (L,4," ",T$SIXN) ;PRINT IT
POPJ P, ;RETURN
;PRINT PATH
DIRPTH: PUSHJ P,T$SPAC ;SPACE OVER
PUSHJ P,T$LBRK ;PRINT LEFT SQUARE BRACKET
HLRZ T1,.FBPPN(P3) ;PROJECT NUMBER
PUSHJ P,T$OCTW
PUSHJ P,T$COMA ;PRINT COMMA
HRRZ T1,.FBPPN(P3) ;PROGRAMMER NUMBER
PUSHJ P,T$OCTW
MOVN T4,.DFLVL(D) ;GET MAXIMUM SFD LEVEL
HRLZS T4 ;PUT IN LH
HRRI T4,.FBMIN(P3) ;OFFSET TO START OF SFD
DIRPT1: SKIPN (T4) ;HAVE AN SFD?
JRST DIRPT2 ;NO--END OF PATH
PUSHJ P,T$COMA ;PRINT COMMA
MOVE T1,(T4) ;GET SFD NAME
PUSHJ P,T$SIXN ;PRINT IT
AOBJN T4,DIRPT1 ;LOOP BACK FOR MORE
DIRPT2: PUSHJ P,T$RBRK ;PRINT RIGHT SQUARE BRACKET
POPJ P, ;RETURN
;PRINT RIB TYPE
DIRRIB: PUSHJ P,T$SPAC ;SPACE OVER
MOVSI T1,'???' ;UNCASE UNKNOWN
MOVE T2,.FBFLG(P3) ;GET FLAG WORD
TRNE T2,FB.PRM ;PRIME RIB?
MOVSI T1,'P ' ;YES
TRNE T2,FB.SPR ;SPARE RIB?
MOVSI T1,'S ' ;YES
TRNE T2,FB.XTR ;EXTENDED RIB?
JRST DIRRI1 ;YES
JUSTIFY (C,3," ",T$SIXN) ;PRINT CHARACTER
POPJ P, ;RETURN
DIRRI1: LDB T1,[POINTR (T2,FB.XRN)] ;GET EXTENDED RIB NUMBER
JUSTIFY (R,3," ",T$DECW) ;PRINT EXTENDED RIB NUMBER
POPJ P, ;RETURN
;SEE IF PATH HAS CHANGED
DIRSAM: AOS FBXCTT ;COUNT TOTAL FILES
MOVN T1,.DFLVL(D) ;GET -VE SFD LEVEL
SOS T1 ;INCLUDE ONE FOR THE PPN
HRLZS T1 ;MAKE AN AOBJN POINTER
MOVE T2,.DFFBT(D) ;GET OFFSET TO TEMP FILE BLOCK
ADDI T2,(D) ;RELOCATE
ADDI T2,.FBPPN ;AND TO THE PPN WORD
MOVEI T3,.FBPPN(P3) ;POINT TO THE CURRENT DIRECTORY
DIRSA1: MOVE T4,(T2) ;GET A DIRECTORY COMPONENT
CAME T4,(T3) ;MATCH THE PREVIOUS ONE?
JRST DIRSA2 ;NO
AOS T2 ;ADVANCE
AOS T3 ; POINTERS
AOBJN T1,DIRSA1 ;LOOP FOR ENTIRE PATH
AOS FBXCTD ;COUNT FILES IN THIS DIRECTORY
JRST CPOPJ1 ;RETURN INDICATING SAME PATH
DIRSA2: MOVE T1,[FBXETD,,FBXETD+1] ;SET UP BLT
SETZM FBXETD ;CLEAR FIRST WORD
BLT T1,FBXETD+FBENUM-1 ;CLEAR PER-DIRECTORY STORAGE
SETZM FBXCTD ;ZAP COUNT OF FILES IN DIRECTORY
POPJ P, ;RETURN
;SAVE CURRENT PATH INFORMATION
DIRSAV: MOVSI T1,(P3) ;POINT TO FILE BLOCK
HRR T1,.DFFBT(D) ;GET OFFSET TO TEMP FILE BLOCK
ADDI T1,(D) ;RELOCATE
HRRZ T2,T1 ;GET FB ADDR AGAIN
ADD T2,.DFFBL(D) ;COMPUTE END OF BLT
BLT T1,-1(T2) ;SAVE NEW PATH INFORMATION
POPJ P, ;RETURN
SUBTTL DUMP COMMAND
.DUMP: SETOM DMPFMT ;NO FORMAT SPECIFIED YET
MOVE T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;INITIALIZE IT
MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;INITIALIZE IT
PUSHJ P,C$CEOL ;AT END OF LINE?
JRST DUMP1 ;NO
SETZB T1,T2 ;NO SCAN BLOCK
PUSHJ P,L$FILE ;DEFAULT LISTING SCAN BLOCK
JRST DUMP4 ;GO INPUT FILE APPLY DEFAULTS
;READ POSSIBLE OUTPUT FILESPEC
DUMP1: PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
PUSH P,T1 ;SAVE SCAN BLOCK ADDRESS
CAIE T2,"=" ;OUTPUT FILE?
SETZ T1, ;NO
PUSHJ P,L$FILE ;PROCESS LISTING SCAN BLOCK
POP P,T1 ;RESTORE SCAN BLOCK ADDRESS
JUMPE T1,DUMP4 ;NO FILESPEC AT ALL?
CAIE T2,"=" ;WAS THIS THE OUTPUT FILESPEC?
JRST DUMP3 ;NO
PUSHJ P,C$SKIP ;SKIP LEADING TABS AND SPACES
;HERE FOR AN INPUT FILSPEC
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
DUMP3: MOVSI T3,(T1) ;GET RETURNED SCAN BLOCK
HRR T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
HRRZ T4,T3 ;POINT TO DESTINATION
ADD T4,.DFSBL(D) ;COMPUTE ENDING ADDRESS
BLT T3,-1(T4) ;COPY SCAN BLOCK
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
DUMP4: MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
MOVSI T2,(SB.NAM!SB.EXT!SB.DIR) ;BITS WHICH DESCRIBE FILES
TDNE T2,.SBFLG(T1) ;FILE-ORIENTED DUMP?
JRST DMPFIL ;YES
MOVSI T2,(SB.DEV) ;GET A BIT
MOVE T3,.DFSTR(D) ;AND THE STRUCTURE NAME
TDNN T2,.SBFLG(T1) ;DEVICE SPECIFIED?
MOVEM T3,.SBDEV(T1) ;DEFAULT USING THE STRUCTURE NAME
IORM T2,.SBFLG(T1) ;SET FLAG BIT ACCORDINGLY
MOVE T2,.SBDEV(T1) ;GET DEVICE
CAMN T2,.DFSTR(D) ;STRUCTURE-ORIENTED DUMP?
JRST DMPSTR ;YES
MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
DUMP5: CAMN T2,.UNLOG(U) ;LOGICAL UNIT NAME?
JRST DMPLOG ;YES
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,DUMP5 ;TRY ALL UNIT BLOCKS
FATAL (IDF,CPOPJ,<Invalid input filespec for DUMP>,)
DMPFIL: MOVEI T1,1 ;GET A FLAG
MOVEM T1,DMPMOD ;INDICATE FILE MODE
XMOVEI T1,DMPDIB ;POINT TO DEFAULT INPUT BLOCK
MOVEI T2,DMPDIL ;GET ITS LENGTH
MOVE T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
PUSHJ P,C$DFIL ;APPLY DEFAULTS
DMPFI1: MOVE T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,L$OPEN ;OPEN LISTING FILE
POPJ P, ;FAILED
PUSHJ P,L$ENVI ;PRINT ENVIRONMENTAL DATA (IF NECESSARY)
MOVEI T1,.IOASC ;MODE = ASCII
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;IOWD
PUSHJ P,F$INI ;INITIALIZE FOR FILE I/O
FATAL (IOF,CPOPJ,<I/O set up failed for >,T$FERR)
DMPFI2: PUSHJ P,F$LKP ;FIND A FILE
JRST DMPFI5 ;CAN'T
MOVEI T1,1 ;START WITH BLOCK 1
MOVE T2,[377777,,-2] ;STOP ON EOF
PUSHJ P,DMPINI ;SET RANGE
DMPFI3: PUSHJ P,DMPNXT ;GET NEXT BLOCK TO DUMP
JRST DMPFI6 ;DONE
PUSHJ P,F$POS ;POSITION FOR I/O
JRST DMPFI4 ;CHECK FOR ERRORS
PUSHJ P,F$IBUF ;READ A BUFFER
JRST DMPFI4 ;CHECK ERRORS
XMOVEI T1,CPYBUF ;POINT TO BUFFER
PUSHJ P,DMPBLK ;DUMP ITS CONTENTS
JRST DMPFI3 ;LOOP BACK FOR MORE BLOCKS
DMPFI4: CAIN T1,FEEOF% ;END OF FILE?
JRST DMPFI6 ;YES
MOVE T2,.DFRSB(D) ;GET OFFSET TO RETURNED SCAN BLOCK
ADDI T2,(D) ;RELOCATE
WARN (ERF,DMPFI6,<Error reading >,T$FERR)
DMPFI5: CAIN T1,FENMF% ;NO MORE FILES?
JRST DMPFI7 ;THAT'S NOT REALLY AN ERROR
CAIN T1,FEFNF% ;FILE NOT FOUND?
SKIPA T2,.DFINP(D) ;MUST USE INPUT SPEC
MOVE T2,.DFRSB(D) ;ELSE USE TRANSLATION SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (LKP,DMPFI7,<LOOKUP failed for >,T$FERR)
DMPFI6: PUSHJ P,F$CLOS ;CLOSE FILE
JFCL ;IGNORE ERRORS
JRST DMPFI2 ;LOOP BACK FOR ANOTHER FILE
DMPFI7: PUSHJ P,F$FIN ;ALL DONE
PUSHJ P,L$CLOS ;CLOSE LISTING FILE
JRST CPOPJ1 ;AND RETURN
;DEFAULT INPUT SCAN BLOCK (DSK:*.*[-])
DMPDIB: EXP SB.NAM!SB.EXT!SB.DPT ;SCANNER FLAGS
EXP 0 ;DEVICE
EXP 0 ;DEVICE MASK
EXP '* ' ;FILE NAME
EXP 0 ;FILE NAME MASK
XWD '* ',0 ;EXTENSION,,MASK
DMPDIL==.-DMPDIB ;LENGTH OF BLOCK
;LOGICAL UNIT DUMP
DMPLOG: SETZM DMPMOD ;INDICATE LOGICAL UNIT MODE
MOVE T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,L$OPEN ;OPEN LISTING FILE
POPJ P, ;GIVE UP
PUSHJ P,L$ENVI ;PRINT ENVIRONMENTAL DATA (IF NECESSARY)
SETZ T1, ;START WITH BLOCK 0
MOVE T2,.UNUSZ(U) ;AND STOP WHEN WE GET HERE
SOS T2 ;RANGE IS INCLUSIVE
PUSHJ P,DMPINI ;SET RANGE
DMPLO1: PUSHJ P,DMPNXT ;GET NEXT BLOCK TO DUMP
JRST DMPLO2 ;DONE
MOVE T2,[IOWD BLKSIZ,RIB] ;GET IOWD
PUSHJ P,U$READ ;READ A BLOCK
JRST DMPLO1 ;TRY THE NEXT BLOCK
XMOVEI T1,RIB ;POINT TO BUFFER
PUSHJ P,DMPBLK ;DUMP THE BLOCK
JRST DMPLO1 ;LOOP BACK FOR MORE
DMPLO2: PUSHJ P,L$CLOS ;CLOSE LISTING FILE
JRST CPOPJ1 ;RETURN
;STRUCTURE DUMP
DMPSTR: SETOM DMPMOD ;INDICATE STRUCTURE MODE
MOVE T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,L$OPEN ;OPEN LISTING FILE
POPJ P, ;GIVE UP
PUSHJ P,L$ENVI ;PRINT ENVIRONMENTAL DATA (IF NECESSARY)
SETZ T1, ;START WITH BLOCK ZERO
MOVE T2,.DFHLB(D) ;GET HIGHEST BLOCK ON STRUCTURE
PUSHJ P,DMPINI ;SET RANGE
DMPST1: PUSHJ P,DMPNXT ;GET NEXT BLOCK TO DUMP
JRST DMPST2 ;DONE
PUSHJ P,F$BLKU ;SET UP UNIT AND BLOCK ON UNIT
JRST DMPST2 ;ILLEGAL BLOCK--END OF ON STRUCTURE
MOVE T2,[IOWD BLKSIZ,RIB] ;GET IOWD
PUSHJ P,U$READ ;READ A BLOCK
JRST DMPST1 ;TRY THE NEXT BLOCK
XMOVEI T1,RIB ;POINT TO BUFFER
PUSHJ P,DMPBLK ;DUMP THE BLOCK
JRST DMPST1 ;LOOP BACK FOR MORE
DMPST2: PUSHJ P,L$CLOS ;CLOSE LISTING FILE
JRST CPOPJ1 ;RETURN
DUMHLP: ASCIZ \
The DUMP command will display one or more disk blocks of the currently
selected structure, of units that comprise the structure, or of a file
that resides on the structure. The command syntax is:
DUMP listing-file = filespec
"listing-file" is optional and defaults to TTY:str.LST[-] where "str"
is the name of the currently selected structure. "filespec" may be
either the selected structure name, a logical unit name which belongs
to the structure, or the name of a file that resides on the structure.
The listing format can vary depending upon the options selected. The
default format is to match each block with a format that best displays
the contents of that block.
\
DEFINE KEYS,<
KEY (<7-BIT>, DMP7BT,HDM7BT, )
KEY (<8-BIT>, DMP8BT,HDM8BT, )
KEY (<AUTOMATIC>, DMPATO,HDMATO, )
KEY (<BAT-BLOCK>, DMPBAT,HDMBAT, )
KEY (<DIRECTORY>, DMPDIR,HDMDIR, )
KEY (<DECIMAL>, DMPDEC,HDMDEC, )
KEY (<HOM-BLOCK>, DMPHOM,HDMHOM, )
KEY (<MIXED-MODE>,DMPMIX,HDMMIX, )
KEY (<OCTAL>, DMPOCT,HDMOCT, )
KEY (<RIB-BLOCK>, DMPRIB,HDMRIB, )
KEY (<SIXBIT>, DMPSIX,HDMSIX, )
KEY (<SPECIAL>, DMPSPC,HDMSPC, )
>
KEYTAB (DUMP,<TBL,NAM,PRC,HLP,CMD>)
DEFDMP: ASCIZ /AUTOMATIC/ ;DEFAULT FORMAT
BLOCK MAXHKS-<.-DEFDMP> ;PAD OUR REMAINDER
DEFINE DUMP (NAM,TXT,SUB),<
PUSHJ P,[PUSHJ P,DUMPER
EXP <SIXBIT /'NAM/>
XWD 'NAM,[ASCIZ \'TXT\]
MOVE T1,'NAM(T2)
SUB]
> ;END DEFINE DUMP
DUMPER: EXCH P1,(P) ;SAVE P1, GET ADDRESS OF ARGS FROM VALL
HRRZS P1 ;STRIP OFF LH JUNK
PUSHJ P,T$SPAC ;SPACE OVER
MOVE T1,0(P1) ;GET SYMBOL NAME
JUSTIFY (L,7," ",T$SIXN) ;PRINT IT
PUSHJ P,T$LPAR ;PRINT LEFT PARANTHESIS
HLRZ T1,1(P1) ;GET OFFSET VALUE
JUSTIFY (R,3,"0",T$OCTW) ;PRINT IT
MOVEI T1,[ASCIZ /) - /]
PUSHJ P,T$STRG ;PRINT SEPARATOR
HRRZ T1,1(P1) ;GET TEXT ADDRESS
PUSHJ P,T$STRG ;PRINT IT
MOVE T2,(P) ;GET BLOCK ADDRESS
XCT 2(P1) ;LOAD UP T1 WITH QUANTITY TO PRINT
PUSHJ P,@3(P1) ;PRINT SOMETHING
PUSHJ P,T$CRLF ;END LINE
POP P,P1 ;RESTORE P1
POPJ P, ;RETURN
;ROUTINE TO DUMP A BLOCK
;CALL: MOVE T1, ADDRESS OF BLOCK
; PUSHJ P,DMPBLK
DMPBLK: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;GET BLOCK ADDRESS
MOVSI P2,-BLKSIZ ;AOBJN POINTER
PUSHJ P,L$PGSZ ;READ PAGE SIZE
HLRZS T1 ;ISOLATE WIDTH
MOVEI P3,-7(T1) ;CONVERT TO -VE USABLE COLUMNS AND SAVE
SETZM DMPIDN ;ASSUME NO SPECIAL BLOCK IDENTIFIER
SKIPGE T1,DMPFMT ;GET REQUESTED DUMP FORMAT
LDB T1,[POINTR (.DFFLG(D),DF.DMP)] ;USE DEFAULT
PUSHJ P,@DUMP.P(T1) ;PRINT BLOCK BASED ON FORMAT TYPE
POPJ P,
;ROUTINE TO SET UP INITIAL BLOCK FOR DUMPING
;CALL: MOVE T1, DEFAULT STARTING BLOCK
; MOVE T2, DEFAULT ENDING BLOCK
; PUSHJ P,DMPINI
DMPINI: SKIPN T3,.DFRNG+0(D) ;GET LOW RANGE
SKIPA T3,T1 ;USE SUPPLIED VALUES
SKIPA T4,.DFRNG+1(D) ;GET HIGH RANGE
MOVE T4,T2 ;USE SUPPLIED VALUES
SOS T3 ;WILL INCREMENT BEFORE CHECKING
AOS T4 ;BECAUSE RANGE IS INCLUSIVE
MOVEM T3,DMPCBN ;STORE "CURRENT" BLOCK NUMBER
MOVEM T4,DMPLBN ;SAVE LAST BLOCK TO DUMP
POPJ P, ;RETURN
;ROUTINE TO GET NEXT BLOCK FOR DUMPING
;CALL: PUSHJ P,DMPNXT
; <NON-SKIP> ;ALL DONE
; <SKIP> ;T1 := DMPCBN (BLOCK TO DUMP)
DMPNXT: AOS T1,DMPCBN ;ADVANCE BLOCK
CAMGE T1,DMPLBN ;PAST THE LAST BLOCK?
AOS (P) ;NO--DUMP THIS BLOCK
POPJ P, ;RETURN
SUBTTL DUMP COMMAND -- DMP7BT - 7-BIT ASCII
DMP7BT: XMOVEI T1,DMPHDR ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
MOVEI T1,^D8 ;COLUMNS NEEDED PER WORD (5 PLUS " +N")
PUSHJ P,DMPCOL ;COMPUTE ITEMS PER LINE (SET P3 & P4)
DMP7B1: TRNN P4,-1 ;FIRST TIME ON THIS LINE?
PUSHJ P,DMPOFS ;YES--PRINT BLOCK OFFSET
HLRZ T1,(P1) ;GET LH WORD
PUSHJ P,ASC7BT ;PRINT AS 7-BIT ASCII
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
AOBJN P4,DMP7B2 ;COUNT ITEMS PRINTED
PUSHJ P,T$CRLF ;END LINE
MOVE P4,P3 ;RESET COUNTER
DMP7B2: AOS P1 ;ADVANCE POINTER
AOBJN P2,DMP7B1 ;LOOP THROUGH BLOCK
POPJ P, ;RETURN
HDM7BT: ASCIZ \
The 7-BIT option will cause the contents of a block to be displayed as
7-bit ASCII.
\
;ROUTINE TO DO THE ACTUAL OUTPUT
ASC7BT: MOVE T2,[POINT 7,(P1)] ;GET BYTE POINTER
MOVSI T3,-5 ;AND BYTE COUNT
ASC7B1: ILDB T1,T2 ;GET A CHARACTER
CAIL T1," " ;WEED OUT CONTROL CHARACTERS
CAIN T1,177 ;AND RUBOUT
MOVEI T1," " ;CONVERT IT
PUSHJ P,T$CHAR ;PRINT CHARACTER
AOBJN T3,ASC7B1 ;LOOP
PUSHJ P,T$SPAC ;SPACE OVER
PUSHJ P,T$PLUS ;ADD A PLUS SIGN
MOVE T1,(P1) ;GET WORD
ANDI T1,1 ;ISOLATE LSN BIT
ADDI T1,"0" ;MAKE READABLE
PJRST T$CHAR ;PRINT IT AND RETURN
SUBTTL DUMP COMMAND -- DMP8BT - 8-BIT ASCII
DMP8BT: XMOVEI T1,DMPHDR ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
MOVEI T1,^D8 ;COLUMNS NEEDED PER WORD (4 PLUS " +NN")
PUSHJ P,DMPCOL ;COMPUTE ITEMS PER LINE (SET P3 & P4)
DMP8B1: TRNN P4,-1 ;FIRST TIME ON THIS LINE?
PUSHJ P,DMPOFS ;YES--PRINT BLOCK OFFSET
HLRZ T1,(P1) ;GET LH WORD
PUSHJ P,ASC8BT ;PRINT AS 8-BIT ASCII
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
AOBJN P4,DMP8B2 ;COUNT ITEMS PRINTED
PUSHJ P,T$CRLF ;END LINE
MOVE P4,P3 ;RESET COUNTER
DMP8B2: AOS P1 ;ADVANCE POINTER
AOBJN P2,DMP8B1 ;LOOP THROUGH BLOCK
POPJ P, ;RETURN
HDM8BT: ASCIZ \
The 8-BIT option will cause the contents of a block to be displayed as
8-bit ASCII. \
;ROUTINE TO DO THE ACTUAL OUTPUT
ASC8BT: MOVE T2,[POINT 8,(P1)] ;GET BYTE POINTER
MOVSI T3,-4 ;AND BYTE COUNT
ASC8B1: ILDB T1,T2 ;GET A CHARACTER
ANDI T1,177 ;REDUCE FOR COMPARRISON
CAIL T1," " ;WEED OUT CONTROL CHARACTERS
CAIN T1,177 ;AND RUBOUT
SKIPA T1,[" "] ;CONVERT IT
LDB T1,T2 ;RELOAD CHARACTER
PUSHJ P,T$CHAR ;PRINT CHARACTER
AOBJN T3,ASC8B1 ;LOOP
PUSHJ P,T$SPAC ;SPACE OVER
PUSHJ P,T$PLUS ;ADD A PLUS SIGN
MOVE T1,(P1) ;GET WORD
ANDI T1,17 ;ISOLATE JUNK BITS
JUSTIFY (R,2,"0",T$OCTW) ;PRINT BITS
POPJ P, ;RETURN
SUBTTL DUMP COMMAND -- DMPATO - AUTOMATIC BLOCK DETECTION
DMPATO: SKIPLE DMPMOD ;STRUCTURE OR UNIT MODE?
JRST DMPAT1 ;NO
MOVE T1,DMPCBN ;GET CURRENT BLOCK NUMBER
CAIE T1,LBNHOM ;FIRST HOM BLOCK?
CAIN T1,LB2HOM ;REDUNDANT HOM BLOCK?
PJRST DMPHOM ;YES
CAIE T1,LBNHOM+LBOBAT ;FIRST BAT BLOCK?
CAIN T1,LB2HOM+LBOBAT ;REDUNDANT BAT BLOCK?
PJRST DMPBAT ;YES
SKIPE DMPMOD ;UNIT MODE?
JRST DMPAT2 ;NO
PUSHJ P,F$BLKS ;TRANSLATE TO BLOCK ON STRUCTURE
MOVE T1,DMPCBN ;THAT'S OK, MIGHT NOT BE A PRIME RIB
JRST DMPAT2 ;CONTINUE
DMPAT1: MOVE T1,.FWSBN(F) ;GET LAST BLOCK READ
DMPAT2: MOVE T2,P1 ;POINT TO BUFFER
PUSHJ P,F$VRIB ;SEE IF WE HAVE A RIB
PJRST DMPMIX ;NO--DEFAULT TO MIXED MODE
PJRST DMPRIB ;GO DECODE A RIB
HDMATO: ASCIZ \
The AUTOMATIC option will cause each block to be examined to see if it
conforms to a known format (i.e. BAT, HOM, RIB, etc.) and if so, change
the display format automatically to present the best representation of
that block. The format selected for a particular block may be one of
the standard display formats.
\
SUBTTL DUMP COMMAND -- DMPBAT - BAT BLOCK
DMPBAT: XMOVEI T1,DHDBAT ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
XMOVEI T1,[ASCIZ /, BAT block/]
MOVEM T1,DMPIDN ;SAVE SPECIAL BLOCK IDENTIFIER
PUSHJ P,T$FORM ;START WITH A FORM-FEED
DUMP (BAFNAM,<BAT block identifier: >,T$SIXN)
DUMP (BAFFIR,<Pointer to words for mapping bad regions: >,DMPAOB)
DUMP (BAFNBS,<Number of bad blocks found by map program: >,DMPNBS)
DUMP (BAFNBR,<Number of bad regions found by map program: >,DMPNBR)
DUMP (BAFKDC,<Controller device code used by map program: >,DMPKDC)
DUMP (BAFCNT,<Number of bad regions found by monitor: >,T$DECW)
DUMP (BAFCOD,<Unlikely code: >,T$XWD)
DUMP (BAFSLF,<Self pointer: >,T$DECW)
PUSHJ P,T$CRLF
SKIPN BAFCNT(P1) ;ANY BAD REGIONS TO REPORT?
POPJ P, ;NO
XMOVEI T1,BATHDR ;POINT TO HEADER
PUSHJ P,T$STRG ;PRINT IT
MOVN P2,BAFCNT(P1) ;GET BAD REGIONS FOUND BY MONITOR
HRLZS P2 ;PUT IN LH
HRR P2,BAFFIR(P1) ;OFFSET TO START OF BAD REGION WORD PAIRS
HRRZ T1,BAFFIR(P1) ;...
ADD P1,T1 ;POINT TO IT
DMPBA1: PUSHJ P,DMPOFS ;PRINT BLOCK OFFSET
XMOVEI T1,[ASCIZ /New /] ;ASSUME NEW FORMAT ENTRIES
MOVEI T2,BAPNTP ;IF OLD STYLE
TDNN T2,BAFAPN(P1) ;CHECK IT
XMOVEI T1,[ASCIZ /Old /] ;OLD-STYLE
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,[POINT 3,BAFVER(P1),2] ;GET VERSION CODE
PUSHJ P,T$OCTW ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
XMOVEI T1,[ASCIZ /No /] ;ASSUME ONLY DETECTED ONCE
MOVSI T2,BAPOTH ;BIT TO TEST
TDNE T2,BAFOTH(P1) ;BAD REGION DETECTED BY MORE THAN ONE CPU/KONT?
XMOVEI T1,[ASCIZ /Yes/] ;YES
PUSHJ P,T$STRG ;PRINT YES/NO
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
MOVE T1,BAFELB(P1) ;GET START OF REGION
TLZ T1,BATMSK ;MASK OUT ALL BUT ADDR
MOVEI T2,BAPNTP ;IF OLD STYLE
TDNN T2,BAFAPN(P1) ;CHECK IT
HRRZS T1 ;ONLY 18 BITS COUNT
JUSTIFY (R,7," ",T$DECW) ;PRINT START ADDRESS OF BAD REGION
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
LDB T1,[POINT BASNBB,BAFNBB(P1),BANNBB] ;GET BAD BLOCKS-1 IN REGION
AOS T1 ;ADJUST SO NUMBER IS PLEASING TO THE EYE
JUSTIFY (R,3," ",T$DECW) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
LDB T1,[POINT BASAPN,BAFAPN(P1),BANAPN] ;CPU WHICH DETECTED ERROR
JUSTIFY (R,5," ",T$DECW) ;PRINT SERIAL NUMBER
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
LDB T1,[POINT BASKNM,BAFKNM(P1),BANKNM] ;GET KONT NUMBER
JUSTIFY (R,3," ",T$DECW) ;PRINT IT
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
MOVE T1,BAFPUB(P1) ;GET WORD CONTAINING UNIT NUMBER
LSH T1,14 ;LEFT JUSTIFY MASK
JFFO T1,.+1 ;FIND FIRST BIT
MOVEI T1,7 ;HIGHEST LEGAL UNIT IN A BAT BLOCK
SUBI T1,(T2) ;COMPUTE ACTUAL UNIT NUMBER
JUSTIFY (R,2," ",T$DECW) ;PRINT UNIT NUMBER
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
HLRZ T1,BAFELB(P1) ;GET POSSIBLE CONI BITS
LSH T1,-BAJCNI ;POSITION THEM
MOVEI T2,BAPNTP ;IF OLD STYLE
TDNN T2,BAFAPN(P1) ;CHECK IT
JUSTIFY (R,6,"0",T$OCTW) ;PRINT CONI
XMOVEI T1,[ASCIZ / /]
TDNE T2,BAFAPN(P1) ;CHECK AGAIN
PUSHJ P,T$STRG ;FILL OUT THE COLUMN WITH BLANKS
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN
DMPBA2: MOVE T2,BAFERR(P1) ;GET ERROR WORD
XMOVEI T1,[ASCIZ /???/]
TLNE T2,BAPOTR ;OTHER?
XMOVEI T1,[ASCIZ /Other/]
TLNE T2,BAPDTR ;DATA ERROR?
XMOVEI T1,[ASCIZ /Data/]
TLNE T2,BAPHDR ;SEARCH OR HEADER COMPARE?
MOVEI T1,[ASCIZ /Search or header compare/]
PUSHJ P,T$STRG ;PRINT ERROR TYPE
PUSHJ P,T$CRLF ;END LINE
DMPBA3: AOS P1 ;ADVANCE POINTER
AOS P2 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN P2,DMPBA1 ;LOOP FOR ALL BAD REGIONS
POPJ P, ;RETURN
HDMBAT: ASCIZ \
The BAT-BLOCK option will cause blocks to be interpreted as if they
contained BAT block data. In this mode, each recorded bad region will
be decoded and displayed in a broken down fashion. Data in the FORMAT
column refers to the style of bad region entry. Basically, this
amounts to a flag which indicates either an old or new-style entry and
a 3-bit version number. Items under the MUL column are either a "NO"
or "YES", indicating whether or not the bad region was detected by
CPUs or controllers other than the one which created the original
entry. The BLOCK column is the starting block number of the bad
region. The NO column contains the number of blocks in the bad
region. The CPU, CTL, and UNIT columns record information about the
hardware configuration which detected the bad region. The CONI bits
are valid only for old-style entries. The column will be blank for
new entries. The ERROR column displays the type of error for the bad
region.
\
DHDBAT: PUSHJ P,DMPHDR ;PRINT BLOCK HEADER
HLRE T2,P2 ;GET REMAINING WORD COUNT
MOVMS T2 ;MAKE POSITIVE
CAIN T2,BLKSIZ ;DOING THE RETRIEVAL POINTER BREAKDOWN?
POPJ P, ;NO--ALL DONE
XMOVEI T1,BATHDR ;POINT TO ADDITIONAL HEADER TEXT
PJRST T$STRG ;PRINT IT AND RETURN
BATHDR: ASCIZ \
Bad Region Breakdown
Format Mul Block No. CPU Ctl Unit CONI Error
------ --- ------- --- ----- --- ---- ------ -----
\
;DUMP BAD BLOCKS FOUND BY MAP PROGRAM
DMPNBS: LDB T1,[POINT BASNBS,T1,BANNBS]
PJRST T$DECW
;DUMP BAD REGIONS FOUND BY MAP PROGRAM
DMPNBR: LDB T1,[POINT BASNBR,T1,BANNBR]
PJRST T$DECW
;DUMP CONTROLLER DEVICE CODE USED BY MAP PROGRAM
DMPKDC: LDB T1,[POINT BASKDC,T1,BANKDC]
LSH T1,2 ;CONVERT 7-BIT TO 9-BIT
JUSTIFY (R,3,"0",T$OCTW) ;PRINT DEVICE CODE
POPJ P, ;RETURN
SUBTTL DUMP COMMAND -- DMPDEC - DECIMAL
DMPDEC: XMOVEI T1,DMPHDR ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
MOVEI T1,^D13 ;COLUMNS NEEDED PER WORD (12 PLUS ".")
PUSHJ P,DMPCOL ;COMPUTE ITEMS PER LINE (SET P3 & P4)
PUSHJ P,T$FORM ;START WITH A FORM-FEED
DMPDE1: TRNN P4,-1 ;FIRST TIME ON THIS LINE?
PUSHJ P,DMPOFS ;YES--PRINT BLOCK OFFSET
HLRZ T1,(P1) ;GET LH WORD
JUSTIFY (R,12," ",T$DECW) ;PRINT DECIMAL
PUSHJ P,T$DOT ;TERMINATE WITH A PERIOD
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
AOBJN P4,DMPDE2 ;COUNT ITEMS PRINTED
PUSHJ P,T$CRLF ;END LINE
MOVE P4,P3 ;RESET COUNTER
DMPDE2: AOS P1 ;ADVANCE POINTER
AOBJN P2,DMPDE1 ;LOOP THROUGH BLOCK
POPJ P, ;RETURN
HDMDEC: ASCIZ \
The DECIMAL option will cause the contents of a block to be displayed
as a series of decimal numbers.
\
SUBTTL DUMP COMMAND -- DMPDIR - DIRECTORY
DMPDIR: XMOVEI T1,DHDDIR ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
XMOVEI T1,[ASCIZ /, directory block/]
MOVEM T1,DMPIDN ;SAVE SPECIAL BLOCK IDENTIFIER
PUSHJ P,T$FORM ;START WITH A FORM-FEED
DMPDI1: MOVE T2,P1 ;COPY BLOCK POINTER
MOVE T3,P2 ;COPY AOBJN POINTER
DMPDI2: SKIPN 0(T2) ;ZERO FILE NAME?
SKIPE 1(T2) ;ZERO EXTENSION AND CFP?
JRST DMPDI3 ;NO
ADDI T2,2 ;ADVANCE POINTER
AOBJN T3,.+1 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN T3,DMPDI2 ;LOOP THROUGH BLOCK
DMPDI3: HRRZ T1,T3 ;GET ENDING POINT
CAME T3,P2 ;FIRST TIME THROUGH?
CAIG T1,2(P2) ;ONE ENTRY DIFFERENCE?
JRST DMPDI4 ;YES
SUBI T2,2 ;BACK OFF TO
SUB T3,[2,,2] ; LAST ZERO ENTRY
PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / Words /]
PUSHJ P,T$STRG ;PRINT TEXT
HRRZ T1,P2 ;GET STARTING POINT
PUSHJ P,T$OCTW ;PRINT IT
XMOVEI T1,[ASCIZ / through /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVEI T1,1(T3) ;GET ENDING POINT
PUSHJ P,T$OCTW ;PRINT IT
XMOVEI T1,[ASCIZ / contain zeros/]
PUSHJ P,T$STRG ;PRINT TEXT
PUSHJ P,T$CRLF ;END LINE
MOVE P1,T2 ;UPDATE BLOCK POINTER
MOVE P2,T3 ;UPDATE AOBJN POINTER
JRST DMPDI7 ;CONTINUE
DMPDI4: PUSHJ P,DMPOFS ;PRINT BLOCK OFFSET
HLRZ T1,1(P1) ;GET EXTENSION
CAIN T1,'UFD' ;USER FILE DIRECTORY?
SKIPG T1,0(P1) ;YES--GET PPN, SEE IF SIXBIT
JRST DMPDI5 ;SIXBIT, SO HANDLE LIKE NORMAL FILE NAME
HLRZS T1 ;ISOLATE PROJECT NUMBER
JUSTIFY (R,6," ",T$OCTW) ;PRINT IT
PUSHJ P,T$COMA ;PRINT COMMA
HRRZ T1,0(P1) ;GET PROGRAMMER NUMBER
JUSTIFY (L,6," ",T$OCTW) ;PRINT IT
JRST DMPDI6 ;CONTINUE
DMPDI5: PUSHJ P,T$SPAC ;SPACE OVER
MOVE T1,0(P1) ;GET SIXBIT FILE NAME
JUSTIFY (L,6," ",T$SIXN) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
HLLZ T1,1(P1) ;EXTENSION
JUSTIFY (L,4," ",T$SIXN) ;PRINT IT
DMPDI6: MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
HRRZ T1,1(P1) ;GET CFP
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
MOVEI T1,4 ;SPACE
PUSHJ P,T$SPAN ; OVER
HRRZ T1,1(P1) ;GET CFP AGAIN
IDIV T1,.DFSCU(D) ;DIVIDE BY SUPER CLUSTERS PER UNIT
IMUL T2,.DFBSC(D) ;COMPUTE BLOCK NUMBER
JUSTIFY (R,2," ",T$DECW) ;PRINT UNIT
MOVEI T1,4 ;SPACE
PUSHJ P,T$SPAN ; OVER
MOVE T1,T2 ;GET BLOCK NUMBER
JUSTIFY (R,7," ",T$DECW) ;PRINT IT
DMPDI7: PUSHJ P,T$CRLF ;END LINE
ADDI P1,2 ;ADVANCE POINTER
AOBJN P2,.+1 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN P2,DMPDI1 ;LOOP THROUGH BLOCK
POPJ P, ;RETURN
HDMDIR: ASCIZ \
The DIRECTORY option will cause the contents of a block to be
interpreted as a directory data block. a word pair is treated as a
single entry consisting of a SIXBIT 6-character file name, 3-character
extension, and an 18-bit octal Compressed File Pointer. The CFP is
further broken down into its unit and block numbers.
\
DHDDIR: PUSHJ P,DMPHDR ;PRINT BLOCK HEADER
XMOVEI T1,DBKHDR ;POINT TO ADDITIONAL HEADER TEXT
PJRST T$STRG ;PRINT IT AND RETURN
DBKHDR: ASCIZ \
Name & Ext. C.F.P. Unit Block
------------- ------ ---- -------
\
SUBTTL DUMP COMMAND -- DMPHOM - HOM BLOCK
DMPHOM: XMOVEI T1,DMPHDR ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
XMOVEI T1,[ASCIZ /, HOM block/]
MOVEM T1,DMPIDN ;SAVE SPECIAL BLOCK IDENTIFIER
PUSHJ P,T$FORM ;START WITH A FORM-FEED
DUMP (HOMNAM,<HOM block identifier: >,T$SIXN)
DUMP (HOMHID,<Unit Id: >,T$SIXN)
DUMP (HOMPHY,<HOM block disk addresses>,CPOPJ)
XMOVEI T1,[ASCIZ / #1 at cylinder /]
PUSHJ P,T$STRG ;PRINT INTRODUCTION
LDB T1,[POINT 8,HOMPHY(P1),7] ;CYLINDER
PUSHJ P,T$OCTW
XMOVEI T1,[ASCIZ / surface /]
PUSHJ P,T$STRG
LDB T1,[POINT 5,HOMPHY(P1),12] ;SECTOR
PUSHJ P,T$OCTW
XMOVEI T1,[ASCIZ / sector /]
PUSHJ P,T$STRG
LDB T1,[POINT 5,HOMPHY(P1),17] ;SURFACE
PUSHJ P,T$OCTW
PUSHJ P,T$CRLF
XMOVEI T1,[ASCIZ / #2 at cylinder /]
PUSHJ P,T$STRG ;PRINT INTRODUCTION
LDB T1,[POINT 8,HOMPHY(P1),25] ;CYLINDER
PUSHJ P,T$OCTW
XMOVEI T1,[ASCIZ / surface /]
PUSHJ P,T$STRG
LDB T1,[POINT 5,HOMPHY(P1),30] ;SECTOR
PUSHJ P,T$OCTW
XMOVEI T1,[ASCIZ / sector /]
PUSHJ P,T$STRG
LDB T1,[POINT 5,HOMPHY(P1),35] ;SURFACE
PUSHJ P,T$OCTW
PUSHJ P,T$CRLF
DUMP (HOMSRC,<Position in SSL: >,T$DECW)
DUMP (HOMSNM,<Structure name: >,T$SIXN)
DUMP (HOMNXT,<Unit Id of next unit in structure: >,T$SIXN)
DUMP (HOMPRV,<Unit Id of Previous unit in structure: >,T$SIXN)
DUMP (HOMLOG,<Logical unit name: >,T$SIXN)
DUMP (HOMLUN,<Logical unit within structure: >,T$OCTW)
DUMP (HOMPPN,<PPN which refreshed under timesharing: >,DMPPPN)
DUMP (HOMHOM,<Block numbers for HOM blocks: >,CPOPJ)
XMOVEI T1,[ASCIZ / #1 at /]
PUSHJ P,T$STRG
HLRZ T1,HOMHOM(P1)
PUSHJ P,T$DECW
PUSHJ P,T$CRLF
XMOVEI T1,[ASCIZ / #2 at /]
PUSHJ P,T$STRG
HRRZ T1,HOMHOM(P1)
PUSHJ P,T$DECW
PUSHJ P,T$CRLF
DUMP (HOMGRP,<Blocks to try for on output: >,T$DECW)
DUMP (HOMBSC,<Blocks per super cluster: >,T$DECW)
DUMP (HOMSCU,<Super clusters per unit: >,T$DECW)
DUMP (HOMCNP,<Byte pointer to cluster count: >,T$BPTR)
DUMP (HOMCKP,<Byte pointer to checksum: >,T$BPTR)
DUMP (HOMCLP,<Byte pointer to cluster address: >,T$BPTR)
DUMP (HOMBPC,<Blocks per cluster: >,T$DECW)
DUMP (HOMK4C,<K for swapping on unit: >,T$DECW)
DUMP (HOMREF,<Needs refreshing: >,T$YN)
DUMP (HOMSIC,<SAT blocks in core: >,T$DECW)
DUMP (HOMSID,<Unit ID of next unit in ASL: >,T$SIXN)
DUMP (HOMSUN,<Logical unit in ASL: >,T$DECW)
DUMP (HOMSLB,<First swapping block on unit: >,T$DECW)
DUMP (HOMCFS,<Swapping class: >,T$DECW)
DUMP (HOMSPU,<SAT blocks on unit: >,T$DECW)
DUMP (HOMOVR,<Blocks of overdraw allowed: >,T$DECW)
DUMP (HOMGAR,<Upper bound of blocks guaranteed: >,T$DECW)
DUMP (HOMSAT,<Logical block & length for SAT.SYS: >,DMPLBX)
DUMP (HOMHMS,<Logical block & length for HOME.SYS: >,DMPLBX)
DUMP (HOMSWP,<Logical block & length for SWAP.SYS: >,DMPLBX)
DUMP (HOMMNT,<Logical block & length for MAINT.SYS: >,DMPLBX)
DUMP (HOMBAD,<Logical block & length for BADBLK.SYS: >,DMPLBX)
DUMP (HOMSNP,<Logical block & length for SNAP.SYS: >,DMPLBX)
DUMP (HOMRCV,<Logical block & length for RECOV.SYS: >,DMPLBX)
DUMP (HOMSUF,<Logical block & length for SYS UFD: >,DMPLBX)
DUMP (HOMPUF,<Logical block & length for printer UFD: >,DMPLBX)
DUMP (HOMMFD,<Logical block & length for MFD UFD: >,DMPLBX)
DUMP (HOMPT1,<First retrieval pointer for MFD: >,T$XWD)
DUMP (HOMUN1,<Logical unit on which MFD begins: >,T$OCTW)
DUMP (HOMUTP,<Unit type on which HOM block was written: >,T$OCTW)
DUMP (HOMRIP,<RIPOFF word: >,T$XWD)
DUMP (HOMFEB,<KL10 FE block number: >,DMPFEB)
DUMP (HOMFEL,<KL10 FE file length: >,T$DECW)
MOVE T1,['HOMKLB'] ;BASE SYMBOL
MOVEI T2,HOMKLB ;AND VALUE
MOVE T3,[-<20-<HOMFEL-HOMKLB>-1>,,HOMFEL+1] ;AOBJN POINTER
PUSHJ P,DMPXWD ;PRINT REMAINING KL10 FE WORDS
DUMP (HOMFEA,<KS10 FE block number: >,T$DECW)
DUMP (HOMFES,<KS10 FE file length:>,T$DECW)
DUMP (HOMTCS,<KS10 FE Track/Cylinder/Sector: >,DMPTCS)
DUMP (HOMKLE,<Word to find files for bootstrap/dump: >,T$XWD)
SKIPE HOMVSY(P1) ;SKIP IF OLD DISK
DUMP (HOMK4C,<K for CRASH.SAV: >,T$DECW)
DUMP (HOMSDL,<Position in SDL: >,T$DECW)
DUMP (HOMBTS,<Bits: >,T$XWD)
XMOVEI T1,[ASCIZ / Private: /]
PUSHJ P,T$STRG
LDB T1,[POINT HOSPVS,HOMBTS(P1),HONPVS]
MOVE T1,YNQKEY+1(T1)
PUSHJ P,T$STRG
PUSHJ P,T$CRLF
XMOVEI T1,[ASCIZ / Disk-set: /]
PUSHJ P,T$STRG
LDB T1,[POINT HOSSET,HOMBTS(P1),HONSET]
PUSHJ P,T$DECW
PUSHJ P,T$CRLF
DUMP (HOMOPP,<Owner PPN: >,DMPPPN)
DUMP (HOMMSU,<Multi-unit disk word: >,T$XWD)
DUMP (HOMCUS,<Customer words:>,CPOPJ)
MOVE T1,['HOMCUS'] ;SYMBOL
MOVEI T2,HOMCUS ;BASE ADDRESS
MOVE T3,[-<HOMCUL-HOMCUS>,,HOMCUS] ;AOBJN POINTER
PUSHJ P,DMPXWD ;PRINT BLOCK
DUMP (HOMVID,<PDP-11 Volume Id: >,DMPP11)
SKIPN HOMVSY(P1) ;SKIP IF NEW DISK
DUMP (HOMOKC,<K for CRASH.SAV: >,T$DECW)
DUMP (HOMOWN,<PDP-11 Owner: >,DMPP11)
DUMP (HOMVSY,<PDP-11 System Id: >,DMPP11)
DUMP (HOMCOD,<Unlikely code: >,T$XWD)
DUMP (HOMSLF,<Self pointer: >,T$DECW)
POPJ P, ;RETURN
HDMHOM: ASCIZ \
The HOM-BLOCK option will cause blocks to be interpreted as if they
contained HOM block data.
\
DMPAOB: PUSH P,T1 ;SAVE AOBJN POINTER
HLRES T1 ;GET -VE LH
PUSHJ P,T$OCTW ;PRINT IT
PUSHJ P,T$COMA ;SEPARATE WITH A COMMAN
POP P,T1 ;GET QUANTITY BACK
HRRES T1 ;ISOLATE RH
PJRST T$OCTW ;PRINT IT AND RETURN
DMPLBX: PUSHJ P,T$DECW ;PRINT LOGICAL BLOCK NUMBER
PUSHJ P,T$COMA ;SEPARATE AND
PUSHJ P,T$SPAC ;SPACE OVER
MOVE T1,2(P1) ;GET INSTRUCTION TO FETCH LBN
SUBI T1,HOMTAB ;REDUCE TO OFFSET WITHIN TABLE
ADDI T1,HOMLEN ;INDEX INTO LENGTH TABLE
XCT T1 ;LOAD UP T1 WITH LENGTH
PJRST T$DECW ;PRINT IT AND RETURN
DMPP11: MOVE T2,-1(P) ;FETCH BUFFER ADDRESS
MOVE T3,2(P1) ;GET INSTRUCTION TO FETCH QUANTITY
TLZ T3,(MOVE) ;CLEAR OUT "MOVE"
TLO T3,(XMOVEI) ;MAKE IMMEDIATE
XCT T3 ;LOAD UP T1 WITH ADDRESS
MOVEI T2,3*4 ;3 WORDS WITH 4 BYTES EACH
PUSHJ P,P11GET ;TRANSLATE STRING
PJRST T$STRG ;PRINT TEXT AND RETURN
DMPPPN: JUMPN T1,T$PPN ;OK IF A REAL PPN
XMOVEI T1,[ASCIZ /(none)/]
PJRST T$STRG ;PRINT TEXT AND RETURN
DMPXWD: PUSH P,T1 ;SAVE BASE SYMBOL NAME
PUSH P,T2 ;AND VALUE
DMPXW1: MOVEI T1,^D16 ;SPACE
PUSHJ P,T$SPAN ; OVER
MOVE T1,-1(P) ;GET NAME
PUSHJ P,T$SIXN ;PRINT IT
PUSHJ P,T$PLUS ;ADD SEPARATOR
HRRZ T1,T3 ;GET OFFSET INTO HOME BLOCK
SUB T1,(P) ;REDUCE
JUSTIFY (R,2,"0",T$OCTW) ;PRINT IT
PUSHJ P,T$COLN ;PRINT A COLON
PUSHJ P,T$SPAC ;AND A SPACE
HRRZ T1,T3 ;GET HOM BLOCK OFFSET
ADD T1,P1 ;INDEX INTO BLOCK
MOVE T1,(T1) ;FETCH CONTENTS
PUSHJ P,T$XWD ;PRINT AS HALF-WORDS
PUSHJ P,T$CRLF ;END LINE
AOBJN T3,DMPXW1 ;LOOP FOR ALL WORDS
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
DMPFEB: PUSH P,T1 ;SAVE BLOCK NUMBER, ETC.
HRRZS T1 ;ISOLOATE IT
PUSHJ P,T$DECW ;AND PRINT IT
XMOVEI T1,[ASCIZ / (valid)/] ;BE OPTIMISTIC
MOVEI T2,FEVALID ;BIT TO TEST
TDNN T2,(P) ;BLOCK NUMBER OK?
XMOVEI T1,[ASCIZ / (invlaid)/]
PUSHJ P,T$STRG ;PRINT SOMETHING
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
DMPTCS: PUSH P,T1 ;SAVE WORD
LDB T1,[POINT 5,(P),27] ;GET TRACK
PUSHJ P,T$OCTW ;PRINT IT
PUSHJ P,T$SLSH ;SEPARATE
LDB T1,[POINT 9,(P),11] ;GET CYLINDER
PUSHJ P,T$OCTW ;PRINT IT
PUSHJ P,T$SLSH ;SEPARATE
LDB T1,[POINT 5,(P),35] ;GET SECTOR
PUSHJ P,T$OCTW ;PRINT IT
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL DUMP COMMAND -- DMPMIX - MIXED FORMAT
DMPMIX: XMOVEI T1,DHDMIX ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
PUSHJ P,T$FORM ;START WITH A FORM-FEED
DMPMI1: MOVE T2,P1 ;COPY BLOCK POINTER
MOVE T3,P2 ;COPY AOBJN POINTER
DMPMI2: SKIPE (T2) ;ZERO?
JRST DMPMI3 ;NO
AOS T2 ;ADVANCE POINTER
AOBJN T3,DMPMI2 ;LOOP THROUGH BLOCK
DMPMI3: HRRZ T1,T3 ;GET ENDING POINT
CAME T3,P2 ;FIRST TIME THROUGH?
CAIN T1,1(P2) ;ONE WORD DIFFERENCE?
JRST DMPMI4 ;YES
PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / Words /]
PUSHJ P,T$STRG ;PRINT TEXT
HRRZ T1,P2 ;GET STARTING POINT
PUSHJ P,T$OCTW ;PRINT IT
XMOVEI T1,[ASCIZ / through /]
PUSHJ P,T$STRG ;PRINT TEXT
HRRZ T1,T3 ;GET ENDING POINT
PUSHJ P,T$OCTW ;PRINT IT
XMOVEI T1,[ASCIZ / contain zeros/]
PUSHJ P,T$STRG ;PRINT TEXT
PUSHJ P,T$CRLF ;END LINE
MOVE P1,T2 ;UPDATE BLOCK POINTER
MOVE P2,T3 ;UPDATE AOBJN POINTER
JRST DMPMI5 ;AND CONTINUE
DMPMI4: PUSHJ P,DMPOFS ;PRINT BLOCK OFFSET
MOVE T1,(P1) ;GET WORD
JUSTIFY (R,12," ",T$DECW) ;PRINT DECIMAL
PUSHJ P,T$DOT ;TERMINATE WITH A PERIOD
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
HLRZ T1,(P1) ;GET LH WORD
JUSTIFY (R,6,"0",T$OCTW) ;PRINT OCTAL
PUSHJ P,T$SPAC ;SEPARATE
HRRZ T1,(P1) ;GET RH WORD
JUSTIFY (R,6,"0",T$OCTW) ;PRINT OCTAL
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
MOVE T1,(P1) ;GET WORD
JUSTIFY (L,6," ",T$SIXN) ;PRINT SIXBIT
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
PUSHJ P,ASC7BT ;PRINT 7-BIT ASCII
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
PUSHJ P,ASC8BT ;PRINT 7-BIT ASCII
DMPMI5: PUSHJ P,T$CRLF ;END LINE
AOS P1 ;ADVANCE BLOCK POINTER
AOBJN P2,DMPMI1 ;LOOP THROUGH BLOCK
POPJ P, ;RETURN
DHDMIX: PUSHJ P,DMPHDR ;PRINT BLOCK HEADER
XMOVEI T1,MIXHDR ;POINT TO ADDITIONAL HEADER TEXT
PJRST T$STRG ;PRINT IT AND RETURN
MIXHDR: ASCIZ \
Decimal Octal SIXBIT 7 Bit 8 Bit
------------- ------------- ------ -------- --------
\
HDMMIX: ASCIZ \
The MIXED-MODE option will display blocks in 5 different formats, viz.
DECIMAL, OCTAL, SIXBIT, 7-BIT, and 8-BIT.
\
SUBTTL DUMP COMMAND -- DMPOCT - OCTAL
DMPOCT: XMOVEI T1,DMPHDR ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
MOVEI T1,^D13 ;COLUMNS NEEDED PER WORD (6+6 PLUS " ")
PUSHJ P,DMPCOL ;COMPUTE ITEMS PER LINE (SET P3 & P4)
PUSHJ P,T$FORM ;START WITH A FORM-FEED
DMPOC1: TRNN P4,-1 ;FIRST TIME ON THIS LINE?
PUSHJ P,DMPOFS ;YES--PRINT BLOCK OFFSET
HLRZ T1,(P1) ;GET LH WORD
JUSTIFY (R,6,"0",T$OCTW) ;PRINT OCTAL
PUSHJ P,T$SPAC ;SEPARATE
HRRZ T1,(P1) ;GET RH WORD
JUSTIFY (R,6,"0",T$OCTW) ;PRINT OCTAL
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
AOBJN P4,DMPOC2 ;COUNT ITEMS PRINTED
PUSHJ P,T$CRLF ;END LINE
MOVE P4,P3 ;RESET COUNTER
DMPOC2: AOS P1 ;ADVANCE POINTER
AOBJN P2,DMPOC1 ;LOOP THROUGH BLOCK
POPJ P, ;RETURN
HDMOCT: ASCIZ \
The OCTAL option will cause the contents of a block to be displayed as
a series of octal numbers.
\
SUBTTL DUMP COMMAND -- DMPRIB - RIB
DMPRIB: XMOVEI T1,DHDRIB ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
XMOVEI T1,[ASCIZ /, RIB block/]
MOVEM T1,DMPIDN ;SAVE SPECIAL BLOCK IDENTIFIER
PUSHJ P,T$FORM ;START WITH A FORM-FEED
DUMP (RIBFIR,<Pointer to first retrieval pointer: >,DMPAOB)
DUMP (RIBPPN,<PPN: >,T$PPN)
DUMP (RIBNAM,<File name: >,DMPNAM)
DUMP (RIBEXT,<Extension: >,DMPEXT)
DUMP (RIBATT,<File attributes: >,CPOPJ)
XMOVEI T1,[ASCIZ / RIBPRV: /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,[POINT RISPRV,RIBPRV(P1),RINPRV] ;GET ACCESS CODE
JUSTIFY (R,3,"0",T$OCTW) ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
DUMP (RIBSIZ,<Written length: >,T$DECW)
DUMP (RIBVER,<Version: >,T$VERW)
DUMP (RIBSPL,<Spooled file name: >,T$SIXN)
DUMP (RIBEST,<Estimated length: >,T$DECW)
DUMP (RIBALC,<Allocated length: >,T$DECW)
DUMP (RIBPOS,<Position of last allocated group: >,T$DECW)
DUMP (RIBUNI,<Written on CPU/controller/unit: >,DMPUNI)
DUMP (RIBNCA,<Unprivileged customer word: >,T$XWD)
DUMP (RIBMTA,<Magtape label: >,T$SIXN)
DUMP (RIBDEV,<Structure file starts on: >,T$SIXN)
DUMP (RIBSTS,<Status: >,T$XWD)
DUMP (RIBELB,<Logical block with error: >,DMPELX)
DUMP (RIBEUN,<Logical unit on which error occured: >,DMPELX)
DUMP (RIBNBB,<Number of consecutice blocks in bad region: >,DMPELX)
HLRZ T1,RIBEXT(P1) ;GET EXTENSION
CAIE T1,'UFD' ;USER FILE DIRECTORY?
JRST DMPRI1 ;NO
DUMP (RIBQTF,<Logged-in quota: >,T$DECW)
DUMP (RIBQTO,<Logged-out quota: >,T$DECW)
DUMP (RIBQTR,<Reserved quota: >,T$DECW)
DUMP (RIBUSD,<Blocks used: >,T$DECW)
JRST DMPRI2 ;CONTINUE
DMPRI1: DUMP (RIBTYP,<File type and flags: >,T$XWD)
DUMP (RIBBSZ,<Byte size word: >,T$XWD)
DUMP (RIBRSZ,<Record and block size: >,T$XWD)
DUMP (RIBAPW,<Application word: >,T$XWD)
DMPRI2: DUMP (RIBAUT,<Author PPN: >,T$PPN)
DUMP (RIBNXT,<Name of next structure: >,T$SIXN)
DUMP (RIBPRD,<Name of predessor structure: >,T$SIXN)
DUMP (RIBPCA,<Privileged customer word: >,T$XWD)
DUMP (RIBUFD,<UFD data block number: >,T$DECW)
DUMP (RIBFLR,<Rel. block in file of first block in RIB: >,T$DECW)
DUMP (RIBXRA,<Extended RIB address: >,T$XWD)
SKIPN RIBXRA(P1) ;HAVE ONE?
JRST DMPRI3 ;NO
XMOVEI T1,[ASCIZ / RIB number: /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,[POINT DESRBC,RIBXRA(P1),DENRBC] ;GET RIB NUMBER
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / Logical unit: /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,[POINT DESRBU,RIBXRA(P1),DENRBU] ;GET UNIT
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / Cluster address: /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,[POINT DESRBA,RIBXRA(P1),DENRBA] ;GET CLUSTER ADDRESS
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
DMPRI3: DUMP (RIBTIM,<Creation date & time: >,T$DTTM)
HLRZ T1,RIBEXT(P1) ;GET EXTENSION
CAIE T1,'UFD' ;USER FILE DIRECTORY?
JRST DMPRI4 ;NO
DUMP (RIBLAD,<Last accounting date & time: >,T$DTTM)
DUMP (RIBDED,<Directory expiration date: >,DMPDED)
JRST DMPRI5 ;ONWARD
DMPRI4: DUMP (RIBACT,<AOBJN pointer to account string: >,DMPAOB)
XMOVEI T1,[ASCIZ / No account string set/]
HRRZ T2,RIBACT(P1) ;GET OFFSET TO STRING
ADD T2,P1 ;INDEX TO BEGINING OF BLOCK
SKIPN T2 ;ANYTHING THERE?
PJRST T$STRG ;NO
XMOVEI T1,[ASCIZ / Account string: "/]
PUSHJ P,T$STRG ;PRINT INTRODUCTION
MOVE T1,T2 ;COPY ADDRESS
PUSHJ P,T$STRG ;PRINT STRING
PUSHJ P,T$DQUO ;CLOSE QUOTES
PUSHJ P,T$CRLF ;END LINE
DMPRI5: DUMP (RIBCOD,<Unlikely code: >,T$XWD)
DUMP (RIBSLF,<Self pointer: >,T$DECW)
MOVE T1,RIBFIR(P1) ;GET AOBJN POINTER TO RET POINTERS
ADDI T1,(P1) ;RELOCATE
SKIPE (T1) ;END
AOBJN T1,.-1 ;COUNT POINTERS
SUBI T1,(P1) ;KEEP ONLY THE STARTING OFFSET
SUB T1,RIBFIR(P1) ;STRIP OFFSET LEAVING COUNT OF RET POINTERS
HRRZS T1 ;ON LH JUNK
ADDI T1,RIBHDL+1 ;ACCOUNT FOR HEADER + 1 DATA LINE
PUSHJ P,L$TEST ;TEST PAGE
XMOVEI T1,RIBHDR ;POINT TO HEADER
PUSHJ P,T$STRG ;PRINT IT
MOVE P2,RIBFIR(P1) ;AOBJN POINTER TO RETRIEVEL POINTERS
HRRZ T1,P2 ;ISOLATE OFFSET
ADD P1,T1 ;SET BLOCK POINTER ACCORDINGLY
MOVSI P3,1 ;NO UNIT NUMBER YET
DMPRI6: SKIPN R,(P1) ;GET RETRIEVAL POINTER
POPJ P, ;DONE
PUSHJ P,DMPOFS ;PRINT BLOCK OFFSET
MOVE T1,R ;COPY POINTER
PUSHJ P,T$XWD ;PRINT AS OCTAL HALF-WORDS
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
TDNE R,[-1-RIPNUB-MAXUNI] ;CHANGE OF UNIT POINTER?
JRST DMPRI7 ;NO
TRZ R,RIPNUB ;CLEAR CHANGE BIT
MOVEI P3,(R) ;COPY NEW UNIT NUMBER
DMPRI7: PUSHJ P,T$SPAC ;SPACE OVER
MOVE T1,P3 ;GET UNIT
JUSTIFY (R,2," ",T$DECW) ;PRINT IT
CAMN P3,R ;NEW UNIT?
JRST DMPRI8 ;YES--SHORT LINE
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
LDB T1,.DFCNP(D) ;GET CLUSTER COUNT
JUSTIFY (R,6," ",T$DECW) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
LDB T1,.DFCKP(D) ;GET CHECKSUM
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
LDB T1,.DFCLP(D) ;GET CLUSTER ADDRESS
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
LDB T1,.DFCLP(D) ;GET CLUSTER ADDRESS AGAIN
IMUL T1,.DFBSC(D) ;COMPUTE BLOCK NUMBER
JUSTIFY (R,7," ",T$DECW) ;PRINT IT
DMPRI8: PUSHJ P,T$CRLF ;END LINE
AOS P1 ;ADVANCE POINTER
AOBJN P2,DMPRI6 ;LOOP BACK FOR MORE
POPJ P, ;RETURN
HDMRIB: ASCIZ \
The RIB-BLOCK option will cause blocks to be interpreted as if they
contained Retrieval Information Block data. In addition to displaying
the contents of various RIB words, the retrieval pointers are broken
down. The CONTENTS column merely shows the retrieval pointer as two
18-bot octal half-words. The pointer is then broken down into its
integral parts of unit numbers, cluster counts, checksums, and cluster
addresses, and displayed in the UNIT, # CLUS, CHKSUM, and ADDR columns
respectely. Cluster addresses are also converted to block numbers and
displayed under the BLOCK column.
\
RIBHDL==5 ;LENGTH OF HEADER IN LINES
RIBHDR: ASCIZ \
Retrieval Pointer Breakdown
Contents Unit # Clus Chksum Addr Block
-------------- ---- ------ ------ ------ -------
\
DMPELX: MOVE T2,T1 ;PRESERVE QUANTITY
XMOVEI T1,[ASCIZ /(no errors in file)/]
MOVE T3,-1(P) ;GET BLOCK ADDRESS
SKIPN RIBELB(T3) ;ANY ERRORS?
PJRST T$STRG ;NO
MOVE T1,T2 ;RESTORE T1
PJRST T$DECW ;PRINT NUMBER AND RETURN
DMPEXT: HLLZS T1 ;ISOLATE EXTENSION
PJRST T$SIXN ;PRINT IT AND RETURN
DMPDED: MOVE T2,T1 ;COPY POSSIBLE DATA/TIME WORD
XMOVEI T1,[ASCIZ /Never/]
SKIPE T2 ;IS THAT TRUE?
CAMN T2,[EXP -1] ;...
PJRST T$STRG ;YES
XMOVEI T1,[ASCIZ /Eternity/]
CAMN T2,[377777,,-1] ;IS THAT THE CASE?
PJRST T$STRG ;YES
MOVE T1,T2 ;ELSE GET THE UDT
PJRST T$DTTM ;AND PRINT IT
DMPNAM: JUMPLE T1,T$SIXN ;CHECK FOR SIXBIT
PJRST T$PPN ;ELSE TREAT AS A PPN
DMPUNI: PUSH P,T1 ;SAVE WORD
LDB T1,[POINT 14,(P),35] ;GET CPU NUMBER
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$SLSH ;SEPARATE
LDB T1,[POINT 3,(P),20] ;GET KONTROLLER
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$SLSH ;SEPARATE
POP P,T1 ;GET WORD BACK
LSH T1,14 ;LEFT JUSTIFY MASK
JFFO T1,.+1 ;FIND FIRST BIT
MOVEI T1,7 ;HIGHEST LEGAL UNIT IN A BAT BLOCK
SUBI T1,(T2) ;COMPUTE ACTUAL UNIT NUMBER
PJRST T$DECW ;PRINT UNIT AND RETURN
DHDRIB: PUSHJ P,DMPHDR ;PRINT BLOCK HEADER
HLRE T2,P2 ;GET REMAINING WORD COUNT
MOVMS T2 ;MAKE POSITIVE
CAIN T2,BLKSIZ ;DOING THE RETRIEVAL POINTER BREAKDOWN?
POPJ P, ;NO--ALL DONE
XMOVEI T1,RIBHDR ;POINT TO ADDITIONAL HEADER TEXT
PJRST T$STRG ;PRINT IT AND RETURN
SUBTTL DUMP COMMAND -- DMPSIX - SIXBIT
DMPSIX: XMOVEI T1,DMPHDR ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
MOVEI T1,^D6 ;COLUMNS NEEDED PER WORD (6 CHARACTERS)
PUSHJ P,DMPCOL ;COMPUTE ITEMS PER LINE (SET P3 & P4)
PUSHJ P,T$FORM ;START WITH A FORM-FEED
DMPSI1: TRNN P4,-1 ;FIRST TIME ON THIS LINE?
PUSHJ P,DMPOFS ;YES--PRINT BLOCK OFFSET
MOVE T1,(P1) ;GET WORD
JUSTIFY (L,6," ",T$SIXN) ;PRINT SIXBIT
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
AOBJN P4,DMPSI2 ;COUNT ITEMS PRINTED
PUSHJ P,T$CRLF ;END LINE
MOVE P4,P3 ;RESET COUNTER
DMPSI2: AOS P1 ;ADVANCE POINTER
AOBJN P2,DMPSI1 ;LOOP THROUGH BLOCK
POPJ P, ;RETURN
HDMSIX: ASCIZ \
The SIXBIT option will cause the contents of a block to be displayed
as a series of sixbit words.
\
SUBTTL DUMP COMMAND -- DMPSPC - SPECIAL
DMPSPC: XMOVEI T1,DMPHDR ;ROUTINE TO GENERATE A HEADER
PUSHJ P,L$HDRS ;SET FOR LATER
PUSHJ P,T$FORM ;START WITH A FORM-FEED
MOVSI T1,-MAXDMP ;-VE FORMAT BUFFER ENTRIES
HRRI T1,.DFDMP(D) ;AND BUFFER ADDRESS
MOVSI T2,-BLKSIZ ;-VE DATA BUFFER WORD COUNT
HRRI T2,(P1) ;AND BUFFER ADDRESS
XMOVEI T3,FMTD.T ;TABLE OF DISPATCH TABLES
SETZ T4, ;NO LINE IDENTIFIER
PUSHJ P,FMTDPY ;DISPLAY THE BLOCK
JFCL ;WILL ALWAYS SKIP
POPJ P, ;RETURN
HDMSPC: ASCIZ \
The SPECIAL option will cause the contents of a block to be displayed
according to a predefined format descriptor. This descriptor is
defined using the FORMAT DUMP-DESCRIPTOR command.
\
SUBTTL DUMP COMMAND -- MISCELLANEOUS
;ROUTINE TO PRINT BLOCK HEADER
DMPHDR: PUSH P,T1 ;SAVE SUB-PAGE COUNTER
XMOVEI T1,[ASCIZ / *** Dump of /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,DMPMOD ;GET MODE
MOVE T1,[IFIW [ASCIZ /structure /]
IFIW [ASCIZ /logical unit /]
IFIW [ASCIZ /file /]]+1(T1)
PUSHJ P,T$STRG ;PRINT TEXT
SKIPG DMPMOD ;CHECK MODE
SKIPA T1,.DFINP(D) ;USE INPUT SCAN BLOCK FOR STR OR LOG UNIT
MOVE T1,.DFRSB(D) ;GET OFFSET TO RETURNED FILESPEC SCAN BLOCK
ADDI T1,(D) ;RELOCATE
SKIPG DMPMOD ;CHECK MODE AGAIN
SKIPA T1,.SBDEV(T1) ;GET STRUCTURE OR LOGICAL UNIT NAME
SKIPA T2,[IFIW T$FILE] ;FILE MODE
XMOVEI T2,T$SIXN ;STRUCTURE/LOGICAL UNIT MODE
PUSHJ P,(T2) ;PRINT INPUT SPEC
XMOVEI T1,[ASCIZ /, block /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,DMPCBN ;GET CURRENT BLOCK NUMBER
PUSHJ P,T$DECW ;PRINT IT
SKIPE T1,DMPIDN ;HAVE A SPECIAL BLOCK IDENTIFIER?
PUSHJ P,T$STRG ;YES--PRINT IT
XMOVEI T1,[ASCIZ / ***/]
POP P,T2 ;GET COUNT BACK
SKIPE T2 ;CONTINUATION?
XMOVEI T1,[ASCIZ / (continued) ***/]
PUSHJ P,T$STRG ;PRINT TEXT
PUSHJ P,T$CRLF ;END LINE
PJRST T$CRLF ;ONE MORE FOR CLARITY
;ROUTINE TO PRINT BLOCK OFFSET
DMPOFS: PUSHJ P,T$SPAC ;SPACE OVER
HRRZ T1,P2 ;GET WORD NUMBER
JUSTIFY (R,3,"0",T$OCTW) ;PRINT IT
XMOVEI T1,[ASCIZ ./ .]
PJRST T$STRG ;PRINT SEPARATOR AND RETURN
;ROUTINE TO SET THE NUMBER OF ITEMS PER LINE
DMPCOL: ADDI T1,3 ;ACCOUNT FOR COLUMN SEPARATORS
IDIVI P3,(T1) ;DIVIDE BY COLUMNS NEEDED PER WORD
CAILE P3,10 ;WITHIN REASON?
MOVEI P3,10 ;REDUCE SO BLOCK OFFSETS ARE EASY TO READ
MOVNS P3 ;MAKE NEGATIVE
HRLZS P3 ;PUT IN LH
MOVE P4,P3 ;SET WORKING COPY
POPJ P, ;RETURN
SUBTTL EXIT COMMAND
.EXIT: PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
PUSHJ P,MONRET ;RETURN TO MONITOR
JRST CPOPJ1 ;CONTINUE
MONRET: SETZ T1, ;CLEAR AN AC
MOVEM T1,JOBBPT ;ZAP UNSOLICED BREAKPOINT ENTRY TO DDT
SETDDT T1, ;AND THE DDT START ADDRESS
SETZM CMDEOF ;INCASE THE TOAD TYPED "EXIT^Z"
EXIT 1, ;RETURN TO MONITOR QUIETLY
DDTRES: MOVE T1,SAVBPT ;GET SAVED BREAKPOINT ENTRY ADDRESS
MOVEM T1,JOBBPT ;RESTORE
MOVE T1,SAVDDT ;GET DDT START ADDRESS
SETDDT T1, ;RESET IT
POPJ P, ;THE FOOL TYPED CONTINUE
EXIHLP: ASCIZ \
The EXIT command causes control to be returned to the monitor.
This is equivalent to typing Control-Z.
\
SUBTTL FILE COMMAND
.FILE: PUSHJ P,C$CEOL ;CHECK FOR EOL
SKIPA ;NOT YET
JRST FILE1 ;USE DEFAULT
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
MOVSI T3,(T1) ;GET RETURNED SCAN BLOCK
HRR T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
HRRZ T4,T3 ;POINT TO DESTINATION
ADD T4,.DFSBL(D) ;COMPUTE ENDING ADDRESS
BLT T3,-1(T4) ;COPY SCAN BLOCK
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
JRST FILE2 ;ENTER COMMON CODE
FILE1: PUSHJ P,STRCHK ;WAS STRUCTURE COMMAND GIVEN?
POPJ P, ;NO
MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;CLEAR IT OUT
FILE2: PUSHJ P,FILDE1 ;DO SCAN BLOCK DEFAULTING
POPJ P, ;FAILED--ERROR ALREADY ISSUED
XMOVEI T1,FILDIB ;POINT TO DEFAULT SCAN BLOCK
MOVEI T2,FILDIL ;GET ITS LENGTH
MOVE T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
PUSHJ P,C$DFIL ;DEFAULT EMPTY FIELDS
MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,D$FILE ;OPEN DATA FILE
POPJ P, ;FAILED
PUSHJ P,D$WHDR ;UPDATE HEADER
JRST CPOPJ1 ;RETURN
;DEFAULT THE DATA FILE SPEC
FILDEF: MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;CLEAR IT OUT
FILDE1: MOVSI T2,(SB.WLD) ;BIT TO TEST
TDNE T2,.SBFLG(T1) ;WILDCARDED SPEC?
FATAL (WFI,CPOPJ,<Wildcarded data file spec illegal; >,T$FILE)
MOVSI T2,(SB.NAM) ;BIT TO TEST
MOVE T3,.DFSTR(D) ;INCASE NO NAME GIVEN
TDNE T2,.SBFLG(T1) ;HAVE A FILENAME?
JRST FILDE2 ;ONWARD
IORM T2,.SBFLG(T1) ;REMEMBER WE HAVE A FILENAME
MOVEM T3,.SBNAM(T1) ;NOW WE DO
SETOM .SBNMM(T1) ;SET MASK ACCORDINGLY
FILDE2: XMOVEI T1,FILDIB ;POINT TO DEFAULT SCAN BLOCK
MOVEI T2,FILDIL ;GET ITS LENGTH
MOVE T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
PUSHJ P,C$DFIL ;DEFAULT EMPTY FIELDS
JRST CPOPJ1 ;RETURN
;DEFAULT INPUT SCAN BLOCK
FILDIB: EXP SB.DEV!SB.NAM!SB.EXT ;SCANNER FLAGS
EXP 'DSK ' ;DEVICE
EXP -1 ;DEVICE MASK
EXP OURNAM ;FILE NAME
EXP -1 ;FILE NAME MASK
XWD OURPFX,-1 ;EXTENSION,,MASK
FILDIL==.-FILDIB ;LENGTH OF BLOCK
FILHLP: ASCIZ \
The FILE command
\
SUBTTL FINISH COMMAND
.FINIS: PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
MOVSI T1,(DF.PIP) ;GET BIT
TDNE T1,.DFFLG(D) ;MAKE FOR PRETTY DISPLAY
INFO (PTM,.+1,<Patching terminated for >,PATSPC)
PUSHJ P,PATZAP ;ZERO OUT IMPORTANT STORAGE
PUSHJ P,D$WHDR ;UPDATE HEADER
JRST CPOPJ1 ;RETURN
FINHLP: ASCIZ \
The FINISH command is used to terminate patching. It performs no I/O.
Data remaining in the patch buffer must be written out by a WRITE
command. Its only purpose is to provide an orderly cleanup of the
data file and internal storage used to maintain the patching
facilities.
\
SUBTTL FORMAT COMMAND -- ENTRY POINT
.FORMA: PUSHJ P,C$CEOL ;CHECK FOR END OF LINE
SKIPA ;NO
PJRST C$ENAS ;NO ARGUMENTS SPECIFIED
PUSHJ P,SAVE4 ;SAVE SOME ACS
XMOVEI T1,FORM.T ;POINT TO COMMAND TABLES
PUSHJ P,C$TSET ;SET UP SCANNER
PUSHJ P,C$ATOM ;READ A KEYWORD
FATAL (ILC,CPOPJ,<Illegal character; >,T$FCHR)
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,FORM.N ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
PJRST C$EKEY ;FAILED
PUSHJ P,@FORM.P(T2) ;DISPATCH
POPJ P, ;FAILED
PUSHJ P,D$WHDR ;UPDATE HEADER
JRST CPOPJ1 ;RETURN
FORHLP: ASCIZ \
The FORMAT command is used to define customized data displays. Once
defined, the data display information is referred to as a group of
format descriptors. The descriptors are stored in the data file and
may be displayed by a SHOW command. The command syntax is:
FORMAT <keyword>
When the command is given, a dialogue will be invoked which will allow
the specification of words or bytes and the method of display.
\
;FORMAT KEYWORD TABLE
DEFINE KEYS,<
KEY (<DUMP-DESCRIPTORS>, FMTDMP,FMTDMH, )
KEY (<IO-DESCRIPTORS>, FMTIOT,FMTIOH, )
>
KEYTAB (FORM,<TBL,NAM,PRC,HLP,CMD>)
SUBTTL FORMAT COMMAND -- FMTDMP - DUMP
FMTDMP: MOVSI P1,-MAXDMP ;-VE NUMBER OF ENTRIES
XMOVEI P2,FMTD.N ;POINT TO KEYWORD TABLE
XMOVEI P3,DEFFMD ;AND TO DEFAULT KEYWORD
XMOVEI P4,FMTD.P ;GET PROCESSOR TABLE (FOR BYTE SIZE DEFAULTS)
PUSHJ P,FORMAT ;GO SET UP DESCRIPTORS
MOVSI T1,FORBUF ;GET TEMP STORAGE
HRRI T1,.DFDMP(D) ;AND ADDR OF STORAGE IN DATA FILE HEADER
BLT T1,.DFDMP+<MAXDMP*.FMLEN>-1(D) ;COPY
JRST CPOPJ1 ;RETURN
FMTDMH: ASCIZ \
The FORMAT DUMP-DESCRIPTORS command will invoke a dialogue which is
used to define DUMP descriptors. When DUMP format "SPECIAL" is
selected, the defined DUMP descriptors will be used to decode and
display the data. The command syntax is:
FORMAT DUMP-DESCRIPTORS
Once the command is completed, a question and answer dialogue will
allow the specification of buffer addresses, bytes, and the format in
which to display the data.
\
;FORMAT DUMP TABLE
DEFINE KEYS,<
KEY (<7-BIT>, FMT7BT,HDM7BT, )
KEY (<8-BIT>, FMT8BT,HDM8BT, )
KEY (<DECIMAL>, FMTDEC,HDMDEC, )
KEY (<HALF-WORD>, FMTHLF,HDMHOM, )
KEY (<OCTAL>, FMTOCT,HDMOCT, )
KEY (<SIXBIT>, FMTSIX,HDMSIX, )
>
KEYTAB (FMTD,<TBL,NAM,PRC,HLP>)
DEFFMD: ASCIZ /OCTAL/ ;DEFAULT FORMAT
BLOCK MAXHKS-<.-DEFFMD> ;PAD OUR REMAINDER
SUBTTL FORMAT COMMAND -- FMTIOT - I/O TRACE
;I/O TRACE
FMTIOT: MOVSI P1,-MAXIOT ;-VE NUMBER OF ENTRIES
XMOVEI P2,FMTI.N ;POINT TO KEYWORD TABLE
XMOVEI P3,DEFFMI ;AND TO DEFAULT KEYWORD
XMOVEI P4,FMTI.P ;GET PROCESSOR TABLE (FOR BYTE SIZE DEFAULTS)
PUSHJ P,FORMAT ;GO SET UP DESCRIPTORS
MOVSI T1,FORBUF ;GET TEMP STORAGE
HRRI T1,.DFIOT(D) ;AND ADDR OF STORAGE IN DATA FILE HEADER
BLT T1,.DFIOT+<MAXIOT*.FMLEN>-1(D) ;COPY
JRST CPOPJ1 ;RETURN
FMTIOH: ASCIZ \
The FORMAT IO-DESCRIPTORS command will invoke a dialogue which is used
to define data descriptors. When I/O tracing is enabled, the data
descriptors are used to decode data in the I/O buffers and display a
portion of that data while normal file I/O is in progress. The
command syntax is:
FORMAT IO-DESCRIPTORS
Once the command is completed, a question and answer dialogue will
allow the specification of buffer addresses, bytes, and the format in
which to display the data.
\
;FORMAT I/O TRACE TABLE
DEFINE KEYS,<
KEY (<7-BIT>, FMT7BT,HDM7BT, )
KEY (<8-BIT>, FMT8BT,HDM8BT, )
KEY (<DECIMAL>, FMTDEC,HDMDEC, )
KEY (<HALF-WORD>, FMTHLF,HDMHOM, )
KEY (<OCTAL>, FMTOCT,HDMOCT, )
KEY (<PAUSE-IO>, FMTPAU,HDMOCT, )
KEY (<SIXBIT>, FMTSIX,HDMSIX, )
>
KEYTAB (FMTI,<TBL,NAM,PRC,HLP>)
DEFFMI: ASCIZ /OCTAL/ ;DEFAULT FORMAT
BLOCK MAXHKS-<.-DEFFMI> ;PAD OUR REMAINDER
FORMAT: HRRI P1,FORBUF ;POINT TO BUFFER
MOVE T1,[FORBUF,,FORBUF+1] ;GET BLT POINTER
SETZM FORBUF ;CLEAR FIRST WORD
BLT T1,FORBUF+MAXFMT-1 ;CLEAR ENTIRE BUFFER
SETZM FOROFS ;SET "NEXT" OFFSET
MOVEI T1,44 ;SET "NEXT" BYTE SIZE
MOVEM T1,FORBSZ ;...
FORMA1: SETZM .FMBPT(P1) ;CLEAR BYTE POINTER TO DATA
SETZM .FMKEY(P1) ;CLEAR DISPLAY FORMAT INDEX
PUSHJ P,FMTDIS ;GET DISPLAY FORMAT
MOVE T1,.FMKEY+0(P1) ;COPY ANSWER
MOVE T2,.FMKEY+1(P1) ;...
CAMN T1,[ASCII "PAUSE"] ;PAUSE I/O?
CAME T2,[ASCIZ "-IO" ] ;...
SKIPA ;NO
JRST FORMA2 ;ONWARD
PUSHJ P,FMTOFS ;GET BLOCK OFFSET
PUSHJ P,FMTBSZ ;GET BYTE SIZE
CAIN T1,44 ;FULL-WORD QUANTITY?
TDZA T1,T1 ;SET POSITION TO LSB & DON'T ASK QUESTION
PUSHJ P,FMTPOS ;GET BIT POSITION
DPB T1,[POINT 6,.FMBPT(P1),5] ;STORE
FORMA2: ADDI P1,.FMLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJP P1,[WARN (FTF,FORMA3,<Format descriptor table is now full>,)]
PUSHJ P,FMTMOR ;WANT TO CREATE MORE DESCRIPTORS?
JUMPN T1,FORMA1 ;LOOP FOR MORE
FORMA3: POPJ P, ;RETURN
;READ BLOCK OFFSET VALUE
FMTOFS: HRROI T1,12 ;-VE OPTION TABLE LENGTH,,RADIX
MOVEM T1,STRSFT+0 ;SAVE HEADER WORD
MOVEI T1,BLKSIZ-1 ;MAXIMUM BLOCK OFFSET
MOVEM T1,STRSFT+1 ;STORE UPPER LIMIT OF RANGE
MOVE T1,FOROFS ;GET "NEXT" DEFAULT OFFSET
XMOVEI T2,T$DECW ;ROUTINE TO CALL
PUSHJ P,T$XLAT ;TRANSLATE TO TEXT
MOVE T3,T1 ;COPY STRING ADDRESS
XMOVEI T1,T$DECW ;OUTPUT ROUTINE ADDRESS
XMOVEI T2,STRSFT ;OPTION TABLE ADDRESS
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Block offset/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST FMTOFS ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST FMTOFS ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST FMTOFS] ;TRY AGAIN
XMOVEI T2,STRSFT ;POINT TO RANGE TABLE
PUSHJ P,C$RNGE ;CHECK FOR A MATCH
JRST [PUSHJ P,C$ERNG ;VALUE OUT OF RANGE
JRST FMTOFS] ;TRY AGAIN
MOVEM T1,.FMBPT(P1) ;SAVE
MOVEI T2,1(T1) ;GET "NEXT" OFFSET
MOVEM T2,FOROFS ;AND SAVE IT
POPJ P, ;RETURN
;READ BYTE SIZE VALUE
FMTBSZ: HRROI T1,12 ;-VE OPTION TABLE LENGTH,,RADIX
MOVEM T1,STRSFT+0 ;SAVE HEADER WORD
MOVE T1,[1,,44] ;MIN,,MAX BYTE SIZE
MOVEM T1,STRSFT+1 ;SAVE IN TABLE
MOVE T1,FORBSZ ;GET "NEXT" VALUE
XMOVEI T2,T$DECW ;ROUTINE TO CALL
PUSHJ P,T$XLAT ;TRANSLATE TO TEXT
MOVE T3,T1 ;COPY STRING ADDRESS
XMOVEI T1,T$DECW ;OUTPUT ROUTINE ADDRESS
XMOVEI T2,STRSFT ;OPTION TABLE ADDRESS
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Byte size/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST FMTBSZ ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST FMTBSZ ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST FMTBSZ] ;TRY AGAIN
XMOVEI T2,STRSFT ;POINT TO RANGE TABLE
PUSHJ P,C$RNGE ;CHECK FOR A MATCH
JRST [PUSHJ P,C$ERNG ;VALUE OUT OF RANGE
JRST FMTBSZ] ;TRY AGAIN
DPB T1,[POINT 6,.FMBPT(P1),11] ;SAVE
MOVEM T1,FORBSZ ;SAVE "NEXT" BYTE SIZE TOO
POPJ P, ;RETURN WITH BYTE SIZE IN T1
;READ BIT POSITION VALUE
FMTPOS: HRROI T1,12 ;-VE OPTION TABLE LENGTH,,RADIX
MOVEM T1,STRSFT+0 ;SAVE HEADER WORD
MOVEI T1,43 ;GET FIRST,,LAST BIT POSITION
MOVEM T1,STRSFT+1 ;SAVE IN TABLE
LDB T1,[POINT 6,.FMBPT(P1),11] ;GET BYTE SIZE
SUBI T1,1 ;THIS IS THE RIGHT-MOST BIT POSITION
XMOVEI T2,T$DECW ;ROUTINE TO CALL
PUSHJ P,T$XLAT ;TRANSLATE TO TEXT
MOVE T3,T1 ;COPY STRING ADDRESS
XMOVEI T1,T$DECW ;OUTPUT ROUTINE ADDRESS
XMOVEI T2,STRSFT ;OPTION TABLE ADDRESS
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Bit position/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST FMTPOS ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST FMTPOS ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST FMTPOS] ;TRY AGAIN
XMOVEI T2,STRSFT ;POINT TO RANGE TABLE
PUSHJ P,C$RNGE ;CHECK FOR A MATCH
JRST [PUSHJ P,C$ERNG ;VALUE OUT OF RANGE
JRST FMTPOS] ;TRY AGAIN
MOVNS T1 ;NEGATE
ADDI T1,43 ;GET DIFFERENCE
DPB T1,[POINT 6,.FMBPT(P1),5] ;STORE
POPJ P, ;RETURN WITH BIT POSITION IN T1
;READ DISPLAY FORMAT VALUE
FMTDIS: XMOVEI T1,T$STRG ;OUTPUT ROUTINE ADDRESS
MOVE T2,P2 ;KEYWORD TABLE ADDRESS
MOVE T3,P3 ;POINT TO DEFAULT DISPLAY TYPE
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Display/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST FMTDIS ;TRY AGAIN
PUSHJ P,C$ATOM ;GET ANSWER
JRST FMTDIS ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST FMTDIS] ;TRY AGAIN
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
MOVE T2,P2 ;AND TO KEYWORD TABLE
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
JRST [PUSHJ P,C$EKEY ;REPORT ERROR
JRST FMTDIS] ;TRY AGAIN
ADD T2,P4 ;INDEX INTO PROCESSOR TABLE
MOVE T2,(T2) ;GET ADDR OF PROCESSOR
MOVE T2,-1(T2) ;NOW GET DEFAULT BYTE SIZE
MOVEM T2,FORBSZ ;SAVE FOR NEXT PROMPT
HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER TO FORMAT KEYWORD
MOVEI T2,.FMKEY(P1) ;POINT TO STORAGE
HRLI T2,(POINT 7,) ;MAKE A BYTE POINTER
MOVSI T3,-<<MAXHKS*5>-1> ;SET UP MAXIMUM BYTE COUNT
FMTDI1: ILDB T4,T1 ;GET A CHARACTER
FMTDI2: IDPB T4,T2 ;PUT A CHARACTER
SKIPE T4 ;END?
AOBJN T3,FMTDI1 ;LOOP FOR ENTIRE STRING
SETZ T4, ;TERMINATE STRING
AOBJN T3,FMTDI2 ;PAD OUT REMAINDER WITH ZEROS
POPJ P, ;RETURN
FMTMOR: MOVEI T1,[ASCIZ / Create more descriptors/]
MOVEI T2,0 ;ASSUME "NO"
PUSHJ P,C$AYNQ ;ASK YES/NO QUESTION
MOVE T1,T2 ;COPY ANSWER
POPJ P, ;RETURN
;ROUTINE TO DO A FORMATTED DISPLAY
;CALL: MOVE T1, AOBJN POINTER TO BUFFER
; MOVE T2, IOWD TO DATA BUFFER
; MOVE T3, TABLE OF DISPATCH TABLES
; MOVE T4, LINE IDENTIFIER ROUTINE
; PUSHJ P,FMTDPY
; <NON-SKIP> ;I/O STOPPED BY USER
; <SKIP> ;CONTINUE I/O
FMTDPY: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;COPY AOBJN POINTER TO TABLE
HRRZI P2,1(T2) ;COPY DATA BUFFER ADDRESS
HLRE P3,T2 ;COPY -VE WORD COUNT
MOVMS P3 ;MAKE POSITIVE
MOVE P4,T3 ;COPY TABLE OF DISPATCH TABLES
PUSH P,T4 ;SAVE LINE IDENTIFIER ROUTINE
SETZM FORSTP ;CLEAR "STOP I/O" FLAG
FMTDP1: SKIPN .FMKEY(P1) ;END OF DESCRIPTORS?
JRST FMTDP5 ;YES
MOVE T1,.FMKEY+0(P1) ;COPY ANSWER
MOVE T2,.FMKEY+1(P1) ;...
CAMN T1,[ASCII "PAUSE"] ;PAUSE I/O?
CAME T2,[ASCIZ "-IO" ] ;...
SKIPA ;NO
JRST FMTDP2 ;SKIP BYTE DISPLAY STUFF
HRRZ T1,.FMBPT(P1) ;GET BUFFER OFFSET
CAIL T1,(P3) ;WITHIN RANGE?
JRST FMTDP4 ;NO
SKIPE (P) ;HAVE A LINE IDENTIFIER ROUTINE?
PUSHJ P,@(P) ;YES--CALL IT NOW
PUSHJ P,T$SPAC ;SPACE OVER
PUSHJ P,T$PLUS ;PRINT OFFST INDICATOR
HRRZ T1,.FMBPT(P1) ;GET OFFSET AGAIN
JUSTIFY (R,3,"0",T$DECW) ;PRINT OFFSET
PUSHJ P,T$LANG ;PRINT LEFT ANGLE BRACKET
LDB T1,[POINT 6,.FMBPT(P1),5] ;GET RIGHT-MOST BIT (BPT FORMAT)
LDB T2,[POINT 6,.FMBPT(P1),11] ;GET BYTE SIZE
MOVNS T1 ;NEGATE
ADDI T1,43 ;THIS IS THE RIGHT-MOST BIT
PUSH P,T1 ;SAVE
SKIPE T1 ;FULL WORD QUANTITY?
SUBI T1,-1(T2) ;THIS IS THE STARTING BIT NUMBER
JUSTIFY (R,2,"0",T$DECW) ;PRINT IT
PUSHJ P,T$COLN ;PRINT SEPARATOR
POP P,T1 ;GET RIGHT-MOST BIT BACK
SKIPN T1 ;FULL WORD QUANTITY?
MOVEI T1,43 ;YES
JUSTIFY (R,2,"0",T$DECW) ;PRINT IT
PUSHJ P,T$RANG ;PRINT RIGHT ANGLE BRACKET
MOVEI T1,3 ;SPACE
PUSHJ P,T$SPAN ; OVER
JRST FMTDP3 ;SKIP PAUSE STUFF
FMTDP2: SKIPE (P) ;HAVE A LINE IDENTIFIER ROUTINE?
PUSHJ P,@(P) ;YES--CALL IT NOW
FMTDP3: XMOVEI T1,.FMKEY(P1) ;POINT TO KEYWORD
MOVE T2,0(P4) ;AND TO KEYWORD TABLE
PUSHJ P,C$KEYW ;FIND A MATCH
SKIPA T2,[[FMTERR]] ;FORMAT DESCRIPTOR ERROR
ADD T2,1(P4) ;INDEX INTO DISPATCH TABLE
MOVE T2,(T2) ;FETCH PROCESSOR ADDRESS
MOVE T1,.FMBPT(P1) ;GET BYTE POINTER
TLO T1,P2 ;INCLUDE INDEX AC WHICH POINTS TO BUFFER
LDB T1,T1 ;FETCH DATA
PUSHJ P,(T2) ;PRINT SOMETHING
JFCL ;INCASE OF SKIP RETURN
PUSHJ P,T$CRLF ;END LINE
FMTDP4: ADDI P1,.FMLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P1,FMTDP1 ;LOOP FOR ALL DESCRIPTORS
FMTDP5: POP P,(P) ;PHASE STACK
SKIPN FORSTP ;STOP I/O?
AOS (P) ;NO
POPJ P, ;RETURN
;7-BIT DISPLAY
EXP 7 ;DEFAULT BYTE SIZE
FMT7BT: ANDI T1,177 ;KEEP ONLY 7 BITS
PJRST T$FCHR ;PRINT AS POSSIBLY FUNNY CHARACTER
;8-BIT DISPLAY
EXP 10 ;DEFAULT BYTE SIZE
FMT8BT: ANDI T1,377 ;KEEP ONLY 8 BITS
PJRST T$FCHR ;PRINT AS POSSIBLY FUNNY CHARACTER
;DECIMAL DISPLAY
EXP 44 ;DEFAULT BYTE SIZE
FMTDEC: JUSTIFY (R,^D12," ",T$DECW) ;PRINT AS DECIMAL
;HALF-WORD DISPLAY
EXP 44 ;DEFAULT BYTE SIZE
FMTHLF: PJRST T$XWD ;PRINT AS HALF-WORDS
;OCTAL DISPLAY
EXP 44 ;DEFAULT BYTE SIZE
FMTOCT: JUSTIFY (R,^D12," ",T$OCTW) ;PRINT AS OCTAL
POPJ P, ;RETURN
;SIXBIT DISPLAY
EXP 44 ;DEFAULT BYTE SIZE
FMTSIX: JUSTIFY (L,6," ",T$SIXN) ;PRINT AS SIXBIT
POPJ P, ;RETURN
POPJ P,
;FORMAT DESCRIPTOR INCONSISTANCY ERRORS
FMTERR: PUSHJ P,T$XWD ;PRINT AS HALF-WORDS
XMOVEI T1,[ASCIZ / (format descriptor error)/]
PJRST T$STRG ;REPORT INCONSISTANCY AND RETURN
;PAUSE I/O
FMTPAU: XMOVEI T1,[ASCIZ . Pausing I/O.]
PUSHJ P,T$STRG ;PRINT TEXT
PUSHJ P,T$CRLF ;END LINE
FMTPA1: MOVEI T1,[ASCIZ / Type "C" to continue, "Q" to quit/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST FMTPA1 ;NO INPUT
PUSHJ P,C$ATOM ;READ SOMETHING
JRST FMTPA1 ;TRY AGAIN
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST FMTPA1 ;TRY AGAIN
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,PAUKEY ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
JRST FMTPA1 ;TRY AGAIN
CAIN T2,1 ;CONTINUE?
SETZM FORSTP ;CLEAR "STOP I/O" FLAG
CAIN T2,2 ;QUIT?
SETOM FORSTP ;SET "STOP I/O" FLAG
POPJ P, ;RETURN
PAUKEY: XWD -2,0 ;-VE LENGTH,,TYPE=KEYWORD
IFIW [ASCIZ /CONTINUE/]
IFIW [ASCIZ /QUIT/]
SUBTTL GET COMMAND
.GET: SETZB T1,T2 ;NO DEFAULT SCAN BLOCKS
PUSHJ P,CPYCMD ;READ OUTPUT=INPUT FILESPECS
POPJ P, ;SYNTAX ERROR
MOVEI T1,.IOIMG ;MODE = IMAGE
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;IOWD
PUSHJ P,F$INI ;INITIALIZE FOR FILE I/O
FATAL (IOF,CPOPJ,<I/O set up failed for >,T$FERR)
PUSHJ P,F$LKP ;FIND A FILE
JRST GETLKE ;CAN'T
MOVE T1,.DFRSB(D) ;USE RETURNED SCAN BLOCK AS SOURCE
ADDI T1,(D) ;RELOCATE
MOVE T2,.DFOUT(D) ;USE OUTPUT SCAN BLOCK AS DESTINATION
ADDI T2,(D) ;RELOCATE
PUSHJ P,CPYFEX ;DEFAULT THE FILENAME & EXTENSION
MOVE T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,CPYENT ;CREATE OUTPUT FILE
PJRST F$FIN ;FAILED
GET1: PUSHJ P,F$IBYT ;READ A BYTE
JRST GET2 ;GO CHECK INPUT ERROR
SOSGE CPYBRH+.BFCTR ;COUNT BYTES
JRST [OUT CPYCHN, ;WRITE BUFFER OUT
JRST .-1 ;LOOP BACK AND STORE BYTE
JRST GETOER] ;GO CHECK OUT ERROR
IDPB T1,CPYBRH+.BFPTR ;STORE CHARACTER
JRST GET1 ;LOOP THROUGH ENTIRE FILE
GET2: CAIN T1,FEEOF% ;EOF?
PUSHJ P,F$CLOS ;YES--CLOSE FILE
JRST GETIER ;FAILED
PUSHJ P,F$FIN ;CLEAN UP
PUSHJ P,CPYCLS ;CLOSE OUTPUT FILE
PUSHJ P,CPYSUM ;PRINT SUMMARY
JRST CPOPJ1 ;RETURN
GETLKE: MOVE T1,.FWECD(F) ;GET ERROR CODE
CAIN T1,FEFNF% ;FILE NOT FOUND?
SKIPA T2,.DFINP(D) ;MUST USE INPUT SPEC
MOVE T2,.DFRSB(D) ;ELSE USE TRANSLATION SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (LKP,GETERR,<LOOKUP failed for >,T$FERR)
GETIER: MOVE T1,.FWECD(F) ;GET ERROR CODE
MOVE T2,.DFRSB(D) ;AND OFFSET TO RETURNED SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (IER,GETERR,<I/O error reading >,T$FERR)
GETOER: GETSTS CPYCHN,T1 ;READ I/O STATUS
FATAL (OER,GETERR,<Output file output error >,T$IOST)
GETERR: PUSHJ P,F$FIN ;CLEAN UP
PUSHJ P,CPYRST ;RESET OUTPUT FILE
POPJ P, ;RETURN
GETHLP: ASCIZ \
The GET command allows files to be copied off the damaged disk onto
another disk. The command syntax is:
GET output-filespec = input filespec
The output device name cannot be the same as the structure undergoing
damage assessment. This is because the ability to reliably read
and/or write a file simultaneously on a damaged disk cannot be
guaranteed. Also, the damaged structure may not necessarily be
mounted on the system. Attempts to circumvent this level of
protection through the use of logical or assigned names may produce
disasterous results.
\
SUBTTL HELP COMMAND
.HELP: PUSHJ P,C$CEOL ;AT EOL?
PJRST C$HELP ;NO--DO FANCY STUFF
MOVEI T1,HLPHLP ;POINT TO OUR HELP TEXT
PUSHJ P,T$STRG ;PRINT IT
XMOVEI T1,[ASCIZ /Additional help is available for:/]
PUSHJ P,C$HLPT ;LIST THE COMMANDS
PUSHJ P,C$SAVE ;SAVE THE COMMAND TABLES
XMOVEI T1,HELP.T ;POINT TO TOPIC TABLE
PUSHJ P,C$TSET ;SET UP COMMAND TABLES
XMOVEI T1,[ASCIZ /Help is also available on the following topics:/]
PUSHJ P,C$HLPT ;PRINT LIST OF TOPICS
POPJ P, ;RETURN
HLPHLP: ASCIZ \
The HELP command allows you to display the function, command syntax,
arguments, and and other necessary information about any command. The
command syntax is:
HELP optional-keyword-list
HELP without any keywords lists this text. HELP followed by one or
more keywords will display informative text on the selected subject.
If more information is available on a subject, a list of additional
keywords will be displayed following the text.
\
DEFINE KEYS,<
KEY (<Getting-started>, ,GTSHLP, )
KEY (<Limitations>, ,LIMHLP, )
KEY (<Restrictions>, ,RSTHLP, )
>
KEYTAB (HELP,<TBL,NAM,HLP>)
GTSHLP: ASCIZ \
This program provides the facilities necessary to examine and modify a
TOPS-10 file structure for the purpose of correcting disk
inconsistancies caused by hardware or software failure. Because this
can often be a lengthy process, a system failure during the structure
restoration could cause all work to be lost. However, information
regarding the state of the structure can be captured in a data file
and preserved across system crashes or other interruptions.
Generally, one of two commands is necessary to begin the process of
structure restoration. The STRUCTURE command is used to select which
file structure or physical disk units will be the target of all damage
assessment and recovery operations. The FILE command allows the
specification of a data file, in which, information about the state of
the structure can be captured and preserved across system failures.
After a such a failure, damage assessment or restoration work may be
continued at the point of interruption by using the FILE command.
More help on individual options may be obtained by typing "HELP"
followed by a command name.
\
LIMHLP: ASCIZ \
Regardless of its size, a TOPS-10 file structure may contain 262143
files. This artificial limit is determined by the definition of a
Compressed File Pointer (CFP), which is limited to 18-bits in width.
Therefore, on a structure which contains the maximum number of files,
there must exist a minimum of 262143*2 Retrieval Information Blocks
(RIBs). Of course, other RIBs may exist such as extended RIBs or RIBs
for deleted files.
When RIB scanning is done, each block on disk is evaluated to
determine if it contains a valid RIB of any type. This process
assigns an integer number to each RIB found. This number is critical
to all file operations. A half-word (18 bits) is reserved for the
file number. Once can seen that a structure with the maximum number
of files cannot be accomodated using this scheme. However, it is
unlikely such a structure exists. The choise to use half-words for
file number storage was one of practicality, opting for a more
conservative use of memory.
\
RSTHLP: ASCIZ \
Time did not permit the completion of this program. There are a few
pieces of functionality which, although desirable, do not exist.
However, their absense does not prevent doing disk damage assment and
repair.
Lost block recovery
---- ----- --------
While most of the data structures exist, there is no code to support
lost block recovery.
Memory manager
------ -------
The memory manager will not do core contraction upon deallocation of
chunks at the end of the low segment.
SAT block updates
--- ----- -------
Turning on SAT block updates may cause corrupted disk SATs. However,
after doing any disk repair, running DSKRAT or KLEPTO a reasonable
sanity check. Should the SATs become corrupted, it could be easily
corrected.
Wildcarded directories
---------- -----------
Occasionally, when performing a full widcarded directory of the disk,
usung the directory information from the disk, the MFD will be listed
twice. This proves only top be a cosmetic error.
\
SUBTTL PATCH COMMAND
.PATCH: MOVSI T1,(DF.PIP) ;BIT TO TEST
TDNE T1,.DFFLG(D) ;PATCH IN PROGRESS?
FATAL (PIP,CPOPJ,<Patch in progress for >,PATSPC)
PUSHJ P,C$CEOL ;AT END OF LINE?
SKIPA ;NO
FATAL (IRP,CPOPJ,<Input spec required for patching>,)
PUSHJ P,PATZAP ;ZERO OUT BUFFER AND RELATED STORAGE
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
MOVSI T2,(SB.WLD) ;BIT TO TEST
TDNE T2,.SBFLG(T1) ;WILDCARDED SPEC?
FATAL (WPI,CPOPJ,<Wildcarded patch spec illegal>,)
MOVSI T2,(SB.NAM!SB.EXT!SB.DIR) ;BITS WHICH DESCRIBE FILES
TDNE T2,.SBFLG(T1) ;FILE-ORIENTED DUMP?
JRST PATFIL ;YES
MOVE T2,.SBDEV(T1) ;GET DEVICE
CAMN T2,.DFSTR(D) ;STRUCTURE-ORIENTED DUMP?
JRST PATSTR ;YES
MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
PATCH1: CAMN T2,.UNLOG(U) ;LOGICAL UNIT NAME?
JRST PATLOG ;YES
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,PATCH1 ;TRY ALL UNIT BLOCKS
FATAL (IPF,CPOPJ,<Invalid input filespec for patching>,)
PATHLP: ASCIZ \
The PATCH command allows blocks within a structure, logical unit, or a
file to be read, modified, and written back to disk. Data I/O is
limited to multiples of 128 words in length with a maximum of 512
words in a buffer. The PATCH command initiates patching, while READ
and WRITE commands control the I/O, and a FINISH command terminates
patching. The DDT command allows access to the buffer.
\
;PATCH A FILE
PATFIL: MOVE T2,.DFINP(D) ;GET OFFSET TO STORAEG
ADDI T2,(D) ;RELOCATE
HRLZS T1 ;PUT SOURCE IN LH
HRRI T1,(T2) ;MAKE A BLT POINTER
ADD T2,.DFSBL(D) ;COMPUTE END
BLT T1,-1(T2) ;COPY TO INPUT SCAN BLOCK
MOVEI T1,.IOIMG ;MODE = IMAGE
MOVSI T2,(DF.IBC) ;BIT TO TEST
TDNE T2,.DFFLG(D) ;WANT TO INHIBIT BUFFER CLEARING?
TLO T1,(UU.IBC) ;YES
MOVN T2,.DFDPS(D) ;GET -VE PATCH BUFFER LENGTH
HRLZS T2 ;PUT IN LH
HRRI T2,.DFPBF-1(D) ;MAKE AN IOWD
PUSHJ P,F$INI ;INITIALIZE FOR FILE I/O
FATAL (IOF,CPOPJ,<I/O set up failed for >,T$FERR)
PUSHJ P,F$LKP ;FIND A FILE
JRST [MOVE T2,.DFINP(D) ;GET OFFSET TO SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (LKP,F$FIN,<LOOKUP failed for >,T$FERR)]
MOVE T1,.DFSBL(D) ;GET SCAN BLOCK LENGTH
PUSHJ P,D$VGET ;ALLOCATE STORAGE
MOVEM T2,.DFPFL(D) ;STORE OFFSET
ADDI T2,(D) ;RELOCATE
MOVE T1,.DFRSB(D) ;GET OFFSET TO RETURNED SCAN BLOCK
ADDI T1,(D) ;RELOCATE
HRLZS T1 ;PUT IN LH
HRR T1,T2 ;MAKE A BLT POINTER
ADD T2,.DFSBL(D) ;COMPUTE END ADDRESS
BLT T1,-1(T2) ;COPY SCAN BLOCK
MOVEI T1,.FWMIN ;WORDS NEEDED
PUSHJ P,D$VGET ;ALLOCATE STORAGE
MOVEM T2,.DFPFW(D) ;SAVE OFFSET
ADDI T2,(D) ;RELOCATE
MOVSI T1,(F) ;POINT TO FILE I/O DATA
HRRI T1,(T2) ;MAKE A BLT POINTER
BLT T1,.FWMIN-1(T2) ;COPY INTO PATCH STORAGE AREA
PUSHJ P,F$CLOS ;CLOSE FILE
JFCL ;IGNORE ERRORS
PUSHJ P,F$FIN ;FINISH I/O
MOVEI T1,1 ;GET A FLAG
SETZ T2, ;NO PATCH NAME
PJRST PATXIT ;FINISH UP
;PATCH A LOGICAL UNIT
PATLOG: MOVEI T1,0 ;GET A FLAG
MOVE T2,.UNLOG(U) ;GET LOGICAL UNIT ID
PJRST PATXIT ;AND FINISH UP
;PATCH A STRUCTURE
PATSTR: MOVNI T1,1 ;GET A FLAG
MOVE T2,.DFSTR(D) ;GET STRUCTURE NAME
; PJRST PATXIT ;AND FINISH UP
;COMMON EXIT CODE
PATXIT: MOVEM T1,.DFPMD(D) ;STORE PATCH MODE
MOVEM T2,.DFPNM(D) ;STORE PATCH NAME (IF ANY)
MOVSI T1,(DF.PIP) ;GET BIT
IORM T1,.DFFLG(D) ;MARK PATCH IN PROGRESS
PUSHJ P,D$WHDR ;UPDATE HEADER
INFO (PAT,CPOPJ1,<Patching >,PATSPC)
;ROUTINE TO READ A BUFFER
;CALL: MOVE T1, BLOCK NUMBER
; PUSHJ P,PATRED
PATRED: PUSH P,T1 ;SAVE FOR A MOMENT
PUSHJ P,PATZBF ;ZERO OUT THE BUFFER
MOVE T1,(P) ;RESTORE BLOCK NUMBER
MOVE T2,.DFPMD(D) ;GET PATCH MODE
JRST @[EXP <IFIW PATRE1>,<IFIW PATRE2>,<IFIW PATRE3>]+1(T2)
;STRUCTURE READ
PATRE1: PUSHJ P,F$BLKU ;TRANSLATE TO BLOCK ON UNIT
JRST PATIBS ;ILLEGAL BLOCK
;LOGICAL UNIT READ
PATRE2: CAIL T1,0 ;RANGE
CAMLE T1,.UNUSZ(U) ; CHECK
JRST PATIBU ;ILLEGAL BLOCK
MOVSI T2,(DF.IBC) ;BIT TO TEST
TDNN T2,.DFFLG(D) ;WANT TO SUPPRESS BUFFER CLEARING?
PUSHJ P,PATZBF ;NO--ZERO BUFFER
MOVN T2,.DFDPS(D) ;GET -VE PATCH BUFFER LENGTH
HRLZS T2 ;PUT IN LH
HRRI T2,.DFPBF-1(D) ;MAKE AN IOWD
PUSHJ P,U$READ ;LOAD DATA INTO THE BUFFER
JRST TPOPJ ;I/O ERROR ALREADY REPORTED
JRST PATREX ;GO FINISH UP
;FILE READ
PATRE3: JUMPL T1,PATIBF ;JUMP IF ILLEGAL BLOCK NUMBER
MOVE F,.DFPFW(D) ;GET OFFSET TO FILE I/O DATA
ADDI F,(D) ;RELOCATE
PUSHJ P,F$POS ;POSITION FOR I/O
JRST PATERF ;REPORT ERROR
MOVSI T2,(DF.IBC) ;BIT TO TEST
MOVSI T3,(UU.IBC) ;AND BIT TO FLIP
ANDCAM T3,.FWMOD(F) ;FIRST CLEAR
TDNE T2,.DFFLG(D) ;WANT TO INHIBIT CLEARING BUFFER?
IORM T3,.FWMOD(F) ;YES
MOVN T2,.DFDPS(D) ;GET -VE PATCH BUFFER LENGTH
HRLZS T2 ;PUT IN LH
HRRI T2,.DFPBF-1(D) ;MAKE AN IOWD
MOVEM T2,.FWIOW(F) ;SET IOWD
PUSHJ P,F$IBUF ;READ A BUFFER
JRST PATERF ;REPORT ERROR
PATREX: POP P,T1 ;GET TARGET BLOCK BACK
MOVEM T1,.DFPLR(D) ;REMEMBER LAST BLOCK READ
SETZM .DFPIO(D) ;AND THE DIRECTION OF I/O
PUSHJ P,D$WHDR ;CHECKPOINT DATA FILE
INFO (PBR,CPOPJ1,<Patch buffer read from block >,T$DECW)
;ROUTINE TO PRINT THE PATCH SPEC
PATSPC: MOVSI T1,(DF.PIP) ;BIT TO TEST
TDNN T1,.DFFLG(D) ;PATCH IN PROGRESS?
POPJ P, ;NOTHING TO REPORT
SKIPE T1,.DFPNM(D) ;GET LOGICAL UNIT OR STRUCTURE NAME
PJRST T$SIXN ;PRINT IT AND RETURN
MOVE T1,.DFPFL(D) ;GET OFFSET TO FILESPEC
ADDI T1,(D) ;INDEX TO STORAGE
PJRST T$FILE ;PRINT IT AND RETURN
PATIBS: POP P,T1 ;GET TARGET BLOCK
FATAL (IBS,CPOPJ,<Illegal block on structure; >,T$DECW)
PATIBU: POP P,T1 ;GET TARGET BLOCK
FATAL (IBU,CPOPJ,<Illegal block on unit; >,T$DECW)
PATIBF: POP P,T1 ;GET TARGET BLOCK
FATAL (IBF,CPOPJ,<Illegal block in file; >,T$DECW)
PATERF: POP P,(P) ;PHASE STACK
HRRZ T2,.DFPFL(D) ;GET OFFSET TO SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (ERF,CPOPJ,<Error reading >,T$FERR)
PATEWF: POP P,(P) ;PHASE STACK
HRRZ T2,.DFPFL(D) ;GET OFFSET TO SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (EWF,CPOPJ,<Error writing >,T$FERR)
;ROUTINE TO WRITE A BUFFER
;CALL: MOVE T1, BLOCK NUMBER
; PUSHJ P,PATWRT
PATWRT: PUSH P,T1 ;SAVE FOR A MOMENT
MOVE T2,.DFPMD(D) ;GET PATCH MODE
JRST @[EXP <IFIW PATWR1>,<IFIW PATWR2>,<IFIW PATWR3>]+1(T2)
;STRUCTURE WRITE
PATWR1: PUSHJ P,F$BLKU ;TRANSLATE TO BLOCK ON UNIT
JRST PATIBS ;ILLEGAL BLOCK
;LOGICAL UNIT WRITE
PATWR2: CAIL T1,0 ;RANGE
CAMLE T1,.UNUSZ(U) ; CHECK
JRST PATIBU ;ILLEGAL BLOCK
MOVN T2,.DFDPS(D) ;GET -VE PATCH BUFFER LENGTH
HRLZS T2 ;PUT IN LH
HRRI T2,.DFPBF-1(D) ;MAKE AN IOWD
PUSHJ P,U$WRIT ;WRITE THE BUFFER OUT TO DISK
JRST TPOPJ ;I/O ERROR ALREADY REPORTED
MOVSI T2,(DF.IBC) ;BIT TO TEST
TDNN T2,.DFFLG(D) ;WANT TO SUPPRESS BUFFER CLEARING?
PUSHJ P,PATZBF ;NO--ZERO BUFFER
JRST PATWRX ;GO FINISH UP
;FILE WRITE
PATWR3: JUMPL T1,PATIBF ;JUMP IF ILLEGAL BLOCK NUMBER
MOVE F,.DFPFW(D) ;GET OFFSET TO FILE I/O DATA
ADDI F,(D) ;RELOCATE
PUSHJ P,F$POS ;POSITION FOR I/O
JRST PATEWF ;REPORT ERROR
MOVSI T2,(DF.IBC) ;BIT TO TEST
MOVSI T3,(UU.IBC) ;AND BIT TO FLIP
ANDCAM T3,.FWMOD(F) ;FIRST CLEAR
TDNE T2,.DFFLG(D) ;WANT TO INHIBIT CLEARING BUFFER?
IORM T3,.FWMOD(F) ;YES
MOVN T2,.DFDPS(D) ;GET -VE PATCH BUFFER LENGTH
HRLZS T2 ;PUT IN LH
HRRI T2,.DFPBF-1(D) ;MAKE AN IOWD
MOVEM T2,.FWIOW(F) ;SET IOWD
PUSHJ P,F$OBUF ;WRITE A BUFFER
JRST PATEWF ;REPORT ERROR
PATWRX: POP P,T1 ;GET TARGET BLOCK BACK
MOVEM T1,.DFPLW(D) ;REMEMBER LAST BLOCK WRITTEN
MOVEI T2,1 ;AND THE DIRECTION
MOVEM T2,.DFPIO(D) ; OF I/O
PUSHJ P,D$WHDR ;CHECKPOINT DATA FILE
INFO (PBW,CPOPJ1,<Patch buffer written to block >,T$DECW)
;ROUTINE TO ZERO OUT PATCH BUFFER AND RELATED STORAGE
PATZAP: MOVSI T1,(DF.PIP) ;GET A BIT
ANDCAM T1,.DFFLG(D) ;CLEAR PATCH IN PROGRESS
MOVE T1,.DFSBL(D) ;GET SCAN BLOCK LENGTH
SKIPE T2,.DFPFL(D) ;AND OFFSET
PUSHJ P,D$VGIV ;DEALLOCATE STORAGE
SETZM .DFPFL(D) ;CLEAR OFFSET
MOVEI T1,.FWMIN ;GET WORD COUNT
SKIPE T2,.DFPFW(D) ;AND OFFSET TO FILE I/O DATA
PUSHJ P,D$VGIV ;DEALLOCATE STORAGE
SETZM .DFPFW(D) ;CLEAR OFFSET
;HERE TO ONLY ZERO THE BUFFER
PATZBF: PUSH P,T1 ;SAVE T1
MOVSI T1,.DFPBF+0(D) ;GET START ADDRESS
HRRI T1,.DFPBF+1(D) ;MAKE A BLT POINTER
SETZM .DFPBF(D) ;CLEAR FIRST WORD
BLT T1,.DFPBF+MAXPAT-1(D) ;CLEAR OUT BUFFER
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
PATSYM: PUSHJ P,SAVE3 ;SAVE SOME ACS
AOSE SAVFLG ;BEEN HERE BEFORE?
JRST PATSY0 ;SKIP SAVING
MOVE T1,JOBSYM ;GET SYMBOL TABLE POINTER
MOVE T2,JOBUSY ;AND THAT OF THE UNDEFINED TABLE TOO
MOVEM T1,SAVSYM ;SAVE
MOVEM T2,SAVUSY ; THEM
PATSY0: MOVE T1,[PATORG,,PATCH+PATSIZ-PATLEN] ;SET UP BLT
BLT T1,PATCH+PATSIZ-1 ;COPY UNDEFINED SYMBOL TABLE
MOVE T1,[SYMORG,,SYMTAB] ;SET UP BLT
BLT T1,SYMTAB+SYMLEN-1 ;COPY TO WORKING STORAGE
MOVE P1,[-SYMLEN,,SYMTAB] ;AOBJN POINTER TO SYMBOL TABLE
PATSY1: MOVE P2,P1 ;GET WORKING COPY OF TABLE POINTER
SETZ P3, ;CLEAR COUNT OF CHANGES THIS PASS
PATSY2: MOVE T1,0(P2) ;GET RADIX50 NAME
MOVE T2,2(P2) ;NEXT ENTRY TOO
TLZE T1,(74B5) ;PROGRAM
TLZN T2,(74B5) ; NAME?
JRST PATSY4 ;YES
CAML T1,T2 ;COMPARE
JRST PATSY3 ;ALREADY IN DESCENDING ORDER
MOVE T1,0(P2) ;GET NAME OF FIRST ENTRY
EXCH T1,2(P2) ;SWAP WITH NEXT
MOVEM T1,0(P2) ;UPDATE
MOVE T1,1(P2) ;GET VALUE OF FIRST ENTRY
EXCH T1,3(P2) ;SWAP WITH NEXT
MOVEM T1,1(P2) ;UPDATE
AOS P3 ;REMEMBER THE CHANGE
PATSY3: AOBJN P2,.+1 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN P2,PATSY2 ;LOOP
PATSY4: JUMPN P3,PATSY1 ;LOOP BACK IF ANY CHANGES MADE
MOVE P1,P2 ;UPDATE FROM WORKING COPY
AOBJN P1,.+1 ;POINT PAST THE PROGRAM NAME
AOBJN P1,PATSY1 ;LOOP FOR ALL PORTIONS OF THE TABLE
SKIPL SAVFLG ;TABLE POINTERS SAVED?
SKIPA T1,SAVSYM ;USE SAVED SYMBOL TABLE
SKIPA T1,JOBSYM ;USE ORIGINAL SYMBOL TABLE
SKIPA T2,SAVUSY ;USE SAVED UNDEFINED TABLE
MOVE T2,JOBUSY ;USE ORIGINAL UNDEFINED TABLE
SKIPE DEBUGF ;DEBUGGING?
JRST PATSY5 ;NO CHANGE SYMBOL TABLE POINTERS
MOVE T1,[-SYMLEN,,SYMTAB] ;GET SPECIAL SYMBOL TABLE
MOVEI T2,PATCH+PATSIZ-PATLEN-1 ;POINT TO END OF PATCH AREA
PATSY5: MOVEM T1,JOBSYM ;STORE SYMBOL TABLE POINTER
MOVEM T2,JOBUSY ;STORE UNDEFINED SYMBOL TABLE POINTER
POPJ P, ;RETURN
DEFINE SYM (FLG,NAM,VAL),<
IFIDN <FLG><P>,<RADIX50 00,NAM>
IFIDN <FLG><G>,<RADIX50 04,NAM>
IFIDN <FLG><L>,<RADIX50 10,NAM>
EXP VAL
> ;END DEFINE SYM
;UNDEFINED SYMBOL TABLE
PATORG: SYM (G,PAT..,<XWD -4,PATCH>)
SYM (P,PAT..,PATCH)
PATLEN==.-PATORG
SYMORG: SYMPGM ;BUILD PROGRAM SYMBOLS (MUST BE FIRST)
SYMHOM ;BUILD HOM BLOCK SYMBOL TABLE
SYMBAT ;BUILD BAT BLOCK SYMBOL TABLE
SYMRIB ;BUILD RIB BLOCK SYMBOL TABLE
SYMLEN==.-SYMORG ;LENGTH OF TABLE
SUBTTL PUT COMMAND
.PUT: SETZB T1,T2 ;NO DEFAULT SCAN BLOCKS
PUSHJ P,CPYCMD ;READ OUTPUT=INPUT FILESPECS
POPJ P, ;SYNTAX ERROR
MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,CPYLKP ;LOOKUP INPUT FILE
POPJ P, ;FAILED
MOVE T1,.DFINP(D) ;USE INPUT SCAN BLOCK AS SOURCE
ADDI T1,(D) ;RELOCATE
MOVE T2,.DFOUT(D) ;USE OUTPUT SCAN BLOCK AS DESTINATION
ADDI T2,(D) ;RELOCATE
PUSHJ P,CPYFEX ;DEFAULT THE FILENAME & EXTENSION
PUSHJ P,CPYFLP ;FLIP CONTENTS OF THE SCAN BLOCKS
MOVEI T1,.IOIMG ;MODE = IMAGE
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;IOWD
PUSHJ P,F$INI ;INITIALIZE FOR FILE I/O
FATAL (IOF,CPOPJ,<I/O set up failed for >,T$FERR)
PUSHJ P,F$LKP ;CREATE A FILE
JRST PUTENE ;CAN'T
PUSHJ P,F$BUFS ;SET UP OUTPUT BUFFERS
JRST PUT2 ;FAILED
PUT1: SOSGE CPYBRH+.BFCTR ;COUNT BYTES
JRST [IN CPYCHN, ;WRITE BUFFER OUT
JRST .-1 ;LOOP BACK AND STORE BYTE
JRST PUTIER] ;GO CHECK OUT ERROR
ILDB T1,CPYBRH+.BFPTR ;LOAD CHARACTER
PUSHJ P,F$OBYT ;WRITE A BYTE
JRST PUT2 ;GO CHECK INPUT ERROR
JRST PUT1 ;LOOP THROUGH ENTIRE FILE
PUT2: CAIN T1,FEEOF% ;EOF?
PUT3: PUSHJ P,F$CLOS ;YES--CLOSE FILE
JRST PUTOER ;FAILED
PUSHJ P,F$FIN ;CLEAN UP
PUSHJ P,CPYCLS ;CLOSE OUTPUT FILE
MOVE T1,.DFRSB(D) ;GET OFFSET TO RETURNED SCAN BLOCK
ADDI T1,(D) ;RELOCATE
MOVE T2,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T2,(D) ;RELOCATE
PUSHJ P,CPYFLP ;FLIP THE CONTENTS AROUND
MOVE T2,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T2,(D) ;RELOCATE
PUSHJ P,CPYFLP ;FLIP CONTENTS AROUND
PUSHJ P,CPYSUM ;PRINT SUMMARY
JRST CPOPJ1 ;RETURN
PUTENE: MOVE T1,.FWECD(F) ;GET ERROR CODE
CAIN T1,FEFNF% ;FILE NOT FOUND?
SKIPA T2,.DFINP(D) ;MUST USE INPUT SPEC
MOVE T2,.DFRSB(D) ;ELSE USE TRANSLATION SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (ENT,PUTERR,<ENTER failed for >,T$FERR)
PUTOER: MOVE T1,.FWECD(F) ;GET ERROR CODE
MOVE T2,.DFRSB(D) ;AND OFFSET TO RETURNED SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (OER,PUTERR,<I/O error writing >,T$FERR)
PUTIER: GETSTS CPYCHN,T1 ;READ I/O STATUS
TRNE T1,IO.EOF ;END OF FILE ON INPUT?
JRST PUT3 ;YES--THAT'S OK
FATAL (IER,PUTERR,<Input file output error >,T$IOST)
PUTERR: PUSHJ P,F$FIN ;CLEAN UP
PUSHJ P,CPYRST ;RESET OUTPUT FILE
POPJ P, ;RETURN
PUTHLP: ASCIZ \
The PUT command allows files to be copied onto the selected disk from
another disk. The command syntax is:
PUT output-filespec = input filespec
The input device name cannot be the same as the structure undergoing
damage assessment. This is because the ability to reliably read
and/or write a file simultaneously on a damaged disk cannot be
guaranteed. Also, the damaged structure may not necessarily be
mounted on the system. Attempts to circumvent this level of
protection through the use of logical or assigned names may produce
disasterous results.
\
SUBTTL READ COMMAND
.READ: MOVSI T1,(DF.PIP) ;BIT TO TEST
TDNN T1,.DFFLG(D) ;PATCH IN PROGRESS?
FATAL (NPI,CPOPJ,<No patch in progress>,)
PUSHJ P,C$CEOL ;AT END OF LINE?
SKIPA ;NO
FATAL (BNR,CPOPJ,<Block number required for reading>,)
PUSHJ P,C$DECI ;PARSE A BLOCK NUMBER
POPJ P, ;SYNTAX ERROR
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
PJRST PATRED ;GO READ DATA INTO BUFFER
REDHLP: ASCIZ \
The READ command will cause the specified block to be read into the
patch buffer from disk. The command syntax is:
READ n
where "n" is the block number to read. The size of the transfer is
controlled by the SET PATCH-BUFFER-SIZE command.
\
SUBTTL SET COMMAND -- .SET - ENTRY POINT
.SET: PUSHJ P,C$CEOL ;CHECK FOR END OF LINE
SKIPA ;NO
PJRST C$ENAS ;NO ARGUMENTS SPECIFIED
PUSHJ P,SAVE2 ;SAVE P1 AND P2
XMOVEI T1,SETX.T ;POINT TO COMMAND TABLES
PUSHJ P,C$TSET ;SET UP SCANNER
MOVEI P2,1 ;ASSUME A POSITIVE SET
SET1: PUSHJ P,C$ATOM ;READ A KEYWORD
FATAL (ILC,CPOPJ,<Illegal character; >,T$FCHR)
MOVE P1,T1 ;REMEMBER TERMINATOR
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,SETX.N ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
PJRST C$EKEY ;FAILED
MOVE T1,P1 ;GET TERMINATOR BACK
PUSHJ P,@SETX.P(T2) ;DISPATCH
POPJ P, ;SET FAILED
PUSHJ P,D$WHDR ;UPDATE HEADER
JUMPE P1,SET2 ;EOL?
CAIE P1," " ;ELSE ALLOW A SPACE
CAIN P1,"," ;OR A COMMA
CAIA ;AND NO OTHER CHARACTERS
FATAL (ILC,CPOPJ,<Illegal character; >,T$FCHR)
PUSHJ P,C$CEOL ;END OF LINE YET?
JRST SET1 ;NO--TRY FOR ANOTHER KEYWORD
SET2: SOJE P2,CPOPJ1 ;RETURN UNLESS PENDING "NO"
FATAL (UTN,CPOPJ,<Unterminated "NO" at end of command">,)
SETHLP: ASCIZ \
The SET command allows you to set various parameters as defined by the
available keywords. The command syntax is:
SET keyword <data>
Several parameters may be enabled by placing more than one keyword on
the command line. The keywords may be separated by either commas or
spaces. <data> is an optional argument to the keyword. If required,
it may be separated from the keyword by either a space or a colon.
\
DEFINE KEYS,<
KEY (<BAT-UPDATES>, SETBAT,SETBAH, )
KEY (<BLOCKS-PER-READ>, SETBPR,SETBPH, )
KEY (<CHECKPOINT-INTERVAL>, SETCPI,SETCPH, )
KEY (<CHECKSUM-ERROR>, SETCED,SETCEH, )
KEY (<DUMP-FORMAT>, SETDFM,SETDFH,DUMP.T)
KEY (<ERSATZ-DEVICE>, SETEDV,SETEDH, )
KEY (<FILE-ACCESS>, SETFAC,SETFAH, )
KEY (<HOM-UPDATES>, SETHOM,SETHOH, )
KEY (<INHIBIT-CLEARING>, SETIBC,SETIBH, )
KEY (<IO-TRACE>, SETIOT,SETIOH, )
KEY (<LOGGED-IN-PPN>, SETLIP,SETLIH, )
KEY (<LOOKUP>, SETLKP,SETLKH, )
KEY (<NO>, SETNO ,SETNOH, )
KEY (<PATCH-BUFFER-SIZE>, SETPSZ,SETPSH, )
KEY (<PATH>, SETPTH,SETPAH, )
KEY (<PPN>, SETPPN,SETPPH, )
KEY (<RANGE>, SETRNG,SETRNH, )
KEY (<RIB-UPDATES>, SETRIB,SETRIH, )
KEY (<SAT-UPDATES>, SETSAT,SETSAH, )
KEY (<SORT-BUFFER-SIZE>, SETSRT,SETSRH, )
KEY (<ZERO-RIBSIZ>, SETZRS,SETZRH, )
>
KEYTAB (SETX,<TBL,NAM,PRC,HLP,CMD>)
SUBTTL SET COMMAND -- SETBAT - BAT-UPDATES
;SET BAT-UPDATES
SETBAT: PUSHJ P,SETOFN ;GET OFF/ON STATE
POPJ P, ;FAILED
DPB T1,[POINTR (.DFFLG(D),DF.BAT)] ;SET STATE
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETBAH: ASCIZ \
BAT blocks can be updated if hard disk errors are encountered while
performing I/O to the selected structure. The SET command will turn
the facility on or off. The command syntax is:
SET [NO] BAT-UPDATES [OFF!ON]
Note that the "NO" prefix cannot be combined with the "OFF" or "ON"
suffix.
\
SUBTTL SET COMMAND -- SETBPR - BLOCKS-PER-READ
;SET BLOCKS-PER-READ
SETBPR: SOJN P2,SETNOE ;DON'T ALLOW "NO" MODIFIER
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$DECI ;READ A DECIMAL NUMBER
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
MOVEM T1,.DFBPR(D) ;SAVE BLOCKS PER DISK READ
MOVE P1,T2 ;GET NEW TERMINATOR
AOJA P2,CPOPJ1 ;SET "NO" FLAG TO POSITIVE STATE AND RETURN
SETBPH: ASCIZ \
The number of disk blocks read during damage assessment scanning can
be varied. The command syntax is:
SET BLOCKS-PER-READ n
The default number of blocks is 200. Higher numbers allow improved
performance, but at the expense of using more core.
\
SUBTTL SET COMMAND -- SETCED - CHECKSUM-ERROR
;SET CHECKSUM-ERROR
SETCED: PUSHJ P,SETOFN ;GET OFF/ON STATE
POPJ P, ;FAILED
DPB T1,[POINTR (.DFFLG(D),DF.CED)] ;SET STATE
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETCEH: ASCIZ \
A retrieval pointer describes a group of blocks on a structure. The
checksum for the first word in each group is stored in the retrieval
pointer. On reading, the monitor would normally compare the checksums
in the retrieval pointer against the actual checksum from disk. This
feature can be enabled through the use of the SET CHECKSUM command.
The command syntax is:
SET [NO] CHECKSUM [OFF!ON]
Note that the "NO" prefix cannot be combined with the "OFF" or "ON"
suffix.
\
SUBTTL SET COMMAND -- SETCPI - CHECKPOINT-INTERVAL
;SET CHECKPOINT-INTERVAL
SETCPI: SOJN P2,SETNOE ;DON'T ALLOW "NO" MODIFIER
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$DECI ;READ A DECIMAL NUMBER
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
MOVEM T1,.DFCPI(D) ;SAVE INTERVAL
MOVE P1,T2 ;GET NEW TERMINATOR
AOJA P2,CPOPJ1 ;SET "NO" FLAG TO POSITIVE STATE AND RETURN
SETCPH: ASCIZ \
For structures which contain a large number of files evenly spread
across the disk, the checkpoint interval is largely goverened by the
number of calls to append a single disk block containing several file
blocks. However, on sparsely populated structures, many disk blocks
may be scanned before it is necessary to append additional file blocks
to the data file. Consequently, the ability to control how often (in
terms of disk blocks) the checkpoints are made can be quite useful.
The command syntax is:
SET CHECKPOINT-INTERVAL n
\
SUBTTL SET COMMAND -- SETDFM - DUMP-FORMAT
;SET DUMP-FORMAT
SETDFM: SOJN P2,SETNOE ;DON'T ALLOW "NO" MODIFIER
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$ATOM ;GET ANSWER
FATAL (NKS,CPOPJ,<No keyword specified>,)
MOVE P1,T1 ;REMEMBER TERMINATOR
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,DUMP.N ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
PJRST C$EKEY ;ERROR
DPB T2,[POINTR (.DFFLG(D),DF.DMP)] ;STORE ANSWER
MOVSI T2,CMDATB ;POINT TO KEYWORD
HRRI T2,.DFDFM(D) ;AND TO STORAGE
BLT T2,.DFDFM+MAXHKS-1(D) ;COPY
AOJA P2,CPOPJ1 ;SET "NO" FLAG TO POSITIVE STATE AND RETURN
SETDFH: ASCIZ \
A default dump format is used in conjunction with the DUMP command.
The format specifies how dump disk blocks are to be interpreted. The
command syntax is:
SET DUMP-FORMAT <keyword>
The list of available keywords is the same as those accepted by the
DUMP command.
\
SUBTTL SET COMMAND -- SETEDV - ERSATZ DEVICE
;SET ERSATZ DEVICE
SETEDV: SOJN P2,SETNOE ;DON'T ALLOW "NO" MODIFIER
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$ATOM ;GET DEVICE NAME
FATAL (NDS,CPOPJ,<No device name specified>,)
CAIN T1,":" ;FOOLISH TERMINATOR?
PUSHJ P,C$TYI ;GET NEXT CHARACTER
CAIE T1,11 ;TAB?
CAIN T1," " ;SPACE?
PUSHJ P,C$SKIP ;SKIP LEADING SPACES AND TABS
CAIE T1,"=" ;MUST BE "DEV = PPN"
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$SKIP ;ADVANCE TO NEXT NON-BLANK CHARACTER
MOVE T1,CMDAT6 ;GET SIXBIT RESULT
TRNE T1,-1 ;LIMITED TO 3 CHARACTERS
FATAL (G3C,CPOPJ,<Device name greater than 3 characters; >,T$SIXN)
MOVE P1,T1 ;SAVE FOR NOW
PUSHJ P,C$CEOL ;CHECK FOR EOL
SKIPA ;NOT YET
JRST SETED1 ;"DEV = " MEANS DELETE DEFINITION
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
HRR P1,T2 ;SAVE TERMINATOR
MOVE T2,.SBFLG(T1) ;GET SCAN BLOCK FLAGS
TDNN T2,[-1-<SB.DEV!SB.DCP!SB.DLP!SB.DIR!SB.GDV>] ;ALLOWED OPTIONS
PUSHJ P,F$FSCN ;DO SCAN BLOCK FIXUPS
FATAL (IPS,CPOPJ,<Illegal PPN specification>,)
MOVE T2,.SBDIR(T1) ;EXTRACT PPN
HLLZ T1,P1 ;GET DEVICE NAME
JRST SETED2 ;AND CONTINUE
SETED1: HLLZ T1,P1 ;GET DEVICE NAME
CAMN T1,['MFD '] ;SPECIAL DEVICE?
FATAL (CZM,CPOPJ,<Cannot zero the PPN for the MFD>,)
SETZ T2, ;CLEARING PPN
SETED2: PUSHJ P,D$EDVM ;MODIFY THE TABLE ENTRY
FATAL (NSD,CPOPJ,<No such ersatz device; >,T$SIXN)
HRRZS P1 ;ISOLATE TERMINATOR
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETEDH: ASCIZ \
The SET ERSATZ-DEVICE command is used to modify or delete the PPN
associated with the specified ersatz device stored in the data file.
Use of an ersatz device in a file specification causes the PPN portion
of the path to be overridden regardless of the PPN actually typed in.
The command syntax is:
SET ERSATZ-DEVICE nam = [project,programmer]
or
SET ERSATZ-DEVICE nam =
where "nam" is a 3-character device name. Note that the second
example causes the PPN to be deleted.
\
SUBTTL SET COMMAND -- SETFAC - SET FILE-ACCESS
SETFAC: SOJN P2,SETNOE ;DON'T ALLOW "NO" MODIFIER
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$ATOM ;GET ANSWER
FATAL (NKS,CPOPJ,<No keyword specified>,)
MOVE P1,T1 ;REMEMBER TERMINATOR
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,FLKP.N ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
PJRST C$EKEY ;ERROR
DPB T2,[POINTR (.DFFLG(D),DF.FAC)] ;SET STATE
MOVSI T2,CMDATB ;POINT TO KEYWORD
HRRI T2,.DFFAC(D) ;AND TO STORAGE
BLT T2,.DFFAC+MAXHKS-1(D) ;COPY
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETFAH: ASCIZ \
The SET FILE-ACCESS command controls how files are scanned for
wildcarded lookups. File access may be performed in one of two ways.
A file may be found using information stored in the data file or the
file may be located using actual disk directory data.
Data-file access, althouth slower in terms of LOOKUP time, is
generally more reliable because errors regarding the state of the RIBs
involved is known before the LOOKUP is attempted. It also affords the
possibility of locating a file using the Spare RIB in cases where the
Prime RIB is unusable. Deleted files may also be located using the
data file. Data-file access is further broken down into two methods:
Files may be scanned by position of the file on disk or in sorted
order.
File access using actual disk directory data, while noticably faster,
depends upon detecting any possible errors while the LOOKUP is in
progress. It is also limited to locating those files which reside in
a readable directory, using the Prime RIB only.
The command syntax is:
SET FILE-ACCESS DISK-DIRECTORY
or
SET FILE-ACCESS POSITIONAL-FILE-BLOCK
or
SET FILE-ACCESS SORTED-FILE-BLOCK
\
SUBTTL SET COMMAND -- SETHOM - HOM-UPDATES
;SET HOM-UPDATES
SETHOM: PUSHJ P,SETOFN ;GET OFF/ON STATE
POPJ P, ;FAILED
DPB T1,[POINTR (.DFFLG(D),DF.HOM)] ;SET STATE
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETHOH: ASCIZ \
HOM blocks can be updated if discrepancies are encountered while
performing I/O to the selected structure. The SET command will turn
the facility on or off. The command syntax is:
SET [NO] HOM-UPDATES [OFF!ON]
Note that the "NO" prefix cannot be combined with the "OFF" or "ON"
suffix.
\
SUBTTL SET COMMAND -- SETIBC - INHIBIT-CLEARING
;SET INHIBIT-CLEARING
SETIBC: PUSHJ P,SETOFN ;GET OFF/ON STATE
POPJ P, ;FAILED
DPB T1,[POINTR (.DFFLG(D),DF.IBC)] ;SET STATE
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETIBH: ASCIZ \
The SET INHIBIT-CLEARING command controls whether or not the patch
buffer is automatically cleared prior to reads and after writes. The
command syntax is:
SET [NO] INHIBIT-CLEARING [OFF!ON]
Note that the "NO" prefix cannot be combined with the "OFF" or "ON"
suffix.
\
SUBTTL SET COMMAND -- SETIOT - I/O TRACE
;SET IO-TRACE
SETIOT: PUSHJ P,SETOFN ;GET OFF/ON STATE
POPJ P, ;FAILED
DPB T1,[POINTR (.DFFLG(D),DF.IOT)] ;SET STATE
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETIOH: ASCIZ \
I/O tracing is useful in situations where large amounts of data on
disk are of unknown formats. As each buffer is read from disk,
portions of the data are displayed according to the format descriptors
defined by the FORMAT IO-DESCRIPTORS command. Additionally, data
writes to disk are also intercepted and displayed. The command syntax
is:
SET [NO] IO-TRACE [OFF!ON]
Note that the "NO" prefix cannot be combined with the "OFF" or "ON"
suffix.
\
SUBTTL SET COMMAND -- SETLIP - LOGGED-IN PPN
;SET LOGGED-IN-PPN
SETLIP: SOJN P2,SETNOE ;DON'T ALLOW "NO" MODIFIER
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
MOVE P1,T2 ;GET NEW TERMINATOR
MOVE T2,.SBFLG(T1) ;GET SCAN BLOCK FLAGS
TDNN T2,[-1-<SB.DEV!SB.DCP!SB.DLP!SB.DIR!SB.GDV>] ;ALLOWED OPTIONS
PUSHJ P,F$FSCN ;DO SCAN BLOCK FIXUPS
FATAL (IPS,CPOPJ,<Illegal PPN specification>,)
MOVE T2,.SBDIR(T1) ;EXTRACT PPN
MOVEM T2,.DFLPN(D) ;STORE IT
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETLIH: ASCIZ \
The SET LOGGED-IN-PPN command will change the logged-in PPN stored in
the data file. This PPN is used to substitute missing project and/or
programmer numbers in path specifications. The command syntax is:
SET PPN [project,programmer]
\
SUBTTL SET COMMAND -- SETLKP - SET LOOKUP TYPE
;SET LOOKUP
SETLKP: CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$ATOM ;GET ANSWER
FATAL (NKS,CPOPJ,<No keyword specified>,)
MOVE P1,T1 ;REMEMBER TERMINATOR
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,LKPTAB ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
PJRST C$EKEY ;ERROR
PUSH P,T2 ;SAVE TABLE INDEX
PUSHJ P,SETOFN ;CHECK FOR OFF/ON
TDZA T3,T3 ;INDICATE FAILURE
MOVEI T3,1 ;INDICATE SUCCESS
POP P,T2 ;RESTORE TABLE INDEX
JUMPE T3,CPOPJ ;RETURN ON ERRORS
MOVE T3,.DFFLG(D) ;GET BITS
SKIPG T1 ;POSITIVE RESPONSE?
TDZA T3,LKPBIT-1(T2) ;NO--CLEAR BIT
TDO T3,LKPBIT-1(T2) ;ELSE SET BIT
TLNN T3,(DF.LBP!DF.LBS) ;ARE ANY BITS SET?
WARN (RLB,.+1,<Reseting LOOKUP bits to a usable state>,)
TLNN T3,(DF.LBP!DF.LBS) ;ARE ANY BITS SET?
TLO T3,(DF.LBP!DF.LBS) ;RESET TO USABLE STATE
MOVEM T3,.DFFLG(D) ;UPDATE
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
LKPTAB: -3,,0 ;-VE TABLE LENGTH,,TYPE=KEYWORD
IFIW [ASCIZ /ANY-RIB/]
IFIW [ASCIZ /PRIME-RIB/]
IFIW [ASCIZ /SPARE-RIB/]
LKPBIT: DF.LBA ;LOOKUP BY ANY RIB
DF.LBP ;LOOKUP BY PRIME RIB
DF.LBS ;LOOKUP BY SPARE RIB
SETLKH: ASCIZ \
The SET LOOKUP command controls which types of RIBs are used to locate
files on a LOOKUP. When files are accessed by reading file blocks in
the data file, LOOKUPs may be done using the Prime or Spare RIBs.
Both may be enabled in which case, successive LOOKUPs will find the
same file twice (assuming both RIBs existed). When files are accessed
using the disk directory, only the Prime RIB can be used. The "any"
RIB option may be selected to access those files for which the RIB
type cannot be determined.
The command syntax is:
SET [NO] LOOKUP ANY-RIB [OFF!ON]
or
SET [NO] LOOKUP PRIME-RIB [OFF!ON]
or
SET [NO] LOOKUP SPARE-RIB [OFF!ON]
Note that the "NO" prefix cannot be combined with the "OFF" or "ON"
suffix. Also, if both types of LOOKUPs are disables, the LOOKUP mode
will be reset to a usable state.
\
SUBTTL SET COMMAND -- SETNO - "NO" PREFIX HANDLING
;SET NO
SETNO: CAIE P1," " ;"NO" MUST BE FOLLOWED BY A SPACE
PJRST C$EILD ;ILLEGAL DELIMITER
TRC P2,1 ;FLIP THE "NO" BIT
HRROS P2 ;REMEMBER "NO" WAS SEEN
JRST CPOPJ1 ;AND RETURN
SETNOH: ASCIZ \
The "NO" keyword may preceed a keyword for the purposes of negating
its action. Not all keywords will accept the "NO" modifier. "NO"
must be followed by a space.
\
SETNOE: FATAL (NMI,CPOPJ,<"NO" modifier illegal on >,T$STRG)
SUBTTL SET COMMAND -- SETOFN - "OFF/ON" HANDLING
SETOFN: HRRZ T1,P2 ;GET POTENTIAL STATE TO SET
JUMPL P2,CPOPJ1 ;RETURN IF "NO" PREFIX WAS TYPED
MOVEI T1,(P1) ;RESTORE TERMINATOR INCASE OF ERROR
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
JRST SETOF1 ;EITHER WILL DO
JUMPN P1,C$EILD ;ILLEGAL DELIMITER IF NOT EOL
MOVEI T1,1 ;ELSE EOL MEANS "ON"
JRST CPOPJ1 ;RETURN
SETOF1: PUSHJ P,C$ATOM ;GET ANSWER
FATAL (NKS,CPOPJ,<No keyword specified>,)
MOVE P1,T1 ;REMEMBER TERMINATOR
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,OFNKEY ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
PJRST C$EKEY ;ERROR
MOVEI T1,-1(T2) ;GET ANSWER
JRST CPOPJ1 ;AND RETURN
OFNKEY: XWD -2,0 ;-VE LENGTH,,TYPE=KEYWORD
IFIW [ASCIZ /OFF/]
IFIW [ASCIZ /ON/]
SUBTTL SET COMMAND -- SETPTH - PATH
;SET PATH
SETPTH: SOJN P2,SETNOE ;DON'T ALLOW "NO" MODIFIER
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
MOVE P1,T2 ;GET NEW TERMINATOR
MOVE T2,.SBFLG(T1) ;GET SCAN BLOCK FLAGS
TDNN T2,[-1-<SB.DEV!SB.DCP!SB.DLP!SB.DIR!SB.GDV!SB.GDI>]
PUSHJ P,F$FSCN ;DO SCAN BLOCK FIXUPS
FATAL (IPS,CPOPJ,<Illegal path specification>,)
ADDI T1,.SBDIR ;INDEX TO START OF DIRECTORY INFORMATION
MOVE T2,.DFPTH(D) ;GET -VE LEN,,OFFSET TO PATH
ADDI T2,.PTPPN(D) ;RELOCATE TO START OF PATH INFORMATION
SETPT1: MOVE T3,(T1) ;GET A WORD FROM THE SCAN BLOCK
MOVEM T3,(T2) ;PUT IT INTO THE PATH BLOCK
ADDI T1,2 ;ADVANCE SCAN BLOCK POINTER
AOBJN T2,SETPT1 ;LOOP FOR ALL ENTRIES
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETPAH: ASCIZ \
The SET PATH command will change thepath stored in the data file.
This path is used to indicate where logical "DSK" points to on file
operations. The command syntax is:
SET PATH [directory]
\
SUBTTL SET COMMAND -- SETPPN - CURRENT PPN
;SET PPN
SETPPN: SOJN P2,SETNOE ;DON'T ALLOW "NO" MODIFIER
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
MOVE P1,T2 ;GET NEW TERMINATOR
MOVE T2,.SBFLG(T1) ;GET SCAN BLOCK FLAGS
TDNN T2,[-1-<SB.DEV!SB.DCP!SB.DLP!SB.DIR!SB.GDV>] ;ALLOWED OPTIONS
PUSHJ P,F$FSCN ;DO SCAN BLOCK FIXUPS
FATAL (IPS,CPOPJ,<Illegal PPN specification>,)
MOVE T2,.SBDIR(T1) ;EXTRACT PPN
MOVEM T2,.DFPPN(D) ;STORE IT
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETPPH: ASCIZ \
The SET PPN command will change the current PPN stored in the data
file. This PPN is used to substitute missing project and/or
programmer numbers in path specifications. The command syntax is:
SET PPN [project,programmer]
\
SUBTTL SET COMMAND -- SETPSZ - PATCH-BUFFER-SIZE
;SET PATCH-BUFFER-SIZE
SETPSZ: SOJN P2,SETNOE ;DON'T ALLOW "NO" MODIFIER
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$DECI ;READ A DECIMAL NUMBER
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
CAIL T1,BLKSIZ ;RANGE
CAILE T1,MAXPAT ; CHECK
CAIA ;NO GOOD
TRNE T1,BLKSIZ-1 ;MUST BE AN EVEN MULTIPLE OF A BLOCK
FATAL (IPS,CPOPJ,<Illegal patch buffer size; >,T$DECW)
MOVEM T1,.DFDPS(D) ;SAVE BUFFER SIZE
MOVE P1,T2 ;GET NEW TERMINATOR
AOJA P2,CPOPJ1 ;SET "NO" FLAG TO POSITIVE STATE AND RETURN
SETPSH: ASCIZ \
The SET PATCH-BUFFER-SIZE command sets the number of words which will
be transfered in or out of the patch buffer when read and write
commands are used. The command syntax is:
SET PATCH-BUFFER-SIZE n
The supplied value must be an even multiple of 128 words; the maximum
being 512 words. If this command is given after a READ but before a
WRITE command, the specified buffer size will take effect on the next
READ command.
\
SUBTTL SET COMMAND -- SETRNG - SET RANGE
;SET RANGE
SETRNG: SOJN P2,SETRN3 ;"NO" MEANS CLEAR THE RANGE
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$DECI ;READ A DECIMAL NUMBER
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
MOVEM T1,DMPCBN ;SAVE LOW VALUE TEMPORARILY
MOVEM T1,DMPLBN ;INCASE ONLY ONE SPECIFIED ...
JUMPE T2,SETRN2 ;EOL?
CAIE T2," " ;ACCEPT A SPACE
CAIN T2,":" ;OR A COLON
JRST SETRN1 ;EITHER WILL DO
CAIL T2,"0" ;RANGE
CAILE T2,"9" ; CHECK
JRST SETRN2 ;ONLY ONE VALUE GIVEN
SETRN1: PUSHJ P,C$DECI ;GET UPPER BOUND
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
MOVEM T1,DMPLBN ;STORE HIGH VALUE TEMPORARILY
SETRN2: SKIPGE T1,DMPCBN ;GET LOWER BOUNDRY
FATAL (LBN,CPOPJ,<Lower bound cannot be negative>,)
MOVE T2,DMPLBN ;AND UPPER BOUNDRY
CAMGE T2,T1 ;REASONABLE?
FATAL (UBL,CPOPJ,<Upper bound cannot be smaller than lower bound>,)
CAIA ;ONWARD
SETRN3: SETZB T1,T2 ;CLEAR SPECIFIED RANGE
MOVEM T1,.DFRNG+0(D) ;STORE LOWER LIMIT
MOVEM T2,.DFRNG+1(D) ;AND UPPER LIMIT
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;RETURN
SETRNH: ASCIZ \
The SET RANGE command accepts a range of block numbers which are used
as the lower and upper bounds for dumping disk blocks. The command
syntax is:
SET RANGE <lower-bounds> <upper-bounds>
or
SET NO RANGE
\
SUBTTL SET COMMAND -- SETRIB - RIB-UPDATES
;SET RIB-UPDATES
SETRIB: PUSHJ P,SETOFN ;GET OFF/ON STATE
POPJ P, ;FAILED
DPB T1,[POINTR (.DFFLG(D),DF.RIB)] ;SET STATE
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETRIH: ASCIZ \
RIB blocks can be updated if disk damage error recovery is desired.
The SET command will turn the facility off or on. The command syntax
is:
SET [NO] RIB-UPDATES [OFF!ON]
Note that the "NO" prefix cannot be combined with the "OFF" or "ON"
suffix.
\
SUBTTL SET COMMAND -- SETSAT - SAT-UPDATES
;SET SAT-UPDATES
SETSAT: PUSHJ P,SETOFN ;GET OFF/ON STATE
POPJ P, ;FAILED
DPB T1,[POINTR (.DFFLG(D),DF.SAT)] ;SET STATE
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETSAH: ASCIZ \
SAT blocks can be updated if lost block error recovery is desired.
The SET command will turn the facility off or on. The command syntax
is:
SET [NO] SAT-UPDATES [OFF!ON]
Note that the "NO" prefix cannot be combined with the "OFF" or "ON"
suffix.
\
SUBTTL SET COMMAND -- SETSRT - SORT BUFFER SIZE
;SET SORT-BUFFER
SETSRT: SOJN P2,SETNOE ;DON'T ALLOW "NO" MODIFIER
CAIE P1," " ;ACCEPT A SPACE
CAIN P1,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
HRROI T1,12 ;-VE OPTION TABLE LENGTH,,RADIX
MOVEM T1,STRSFT+0 ;SAVE HEADER WORD
HRLZ T1,.DFFBB(D) ;GET FILE BLOCKS PER DISK BLOCK
HRRI T1,MAXSRT ;AND THE MAXIMUM REASONANABLE SIZE
MOVEM T1,STRSFT+1 ;STORE IN RANGE TABLE
PUSHJ P,C$DECI ;GET A NUMBER
JRST C$EILC ;ILLEGAL CHARACTER
MOVE P1,T2 ;GET NEW TERMINATOR
XMOVEI T2,STRSFT ;POINT TO RANGE TABLE
PUSHJ P,C$RNGE ;CHECK FOR A MATCH
JRST C$ERNG ;VALUE OT OF RANGE
MOVEM T1,.DFSRT(D) ;SAVE FOR LATER
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETSRH: ASCIZ \
The SET SORT-BUFFER-SIZE command determines the size of the buffer
used for sorting file blocks. The command syntax is:
SET SORT-BUFFER-SIZE n
where "n" is the number of file blocks which will be sorted in a
single pass.
\
SUBTTL SET COMMAND -- SETZRS - ZERO-RIBSIZ
;SET ZERO-RIBSIZ
SETZRS: PUSHJ P,SETOFN ;GET OFF/ON STATE
POPJ P, ;FAILED
DPB T1,[POINTR (.DFFLG(D),DF.ZRS)] ;SET STATE
MOVEI P2,1 ;RESET "NO" BIT
JRST CPOPJ1 ;AND RETURN
SETZRH: ASCIZ \
When a file is zeroed, the option exists to either leave the written
size of the file as it was before being zeroed, or setting the written
length of the file to zero. RIBSIZ is the word in the RIB of the file
which contains the number of words written. The command syntax is:
SET [NO] ZERO-RIBSIZ [OFF!ON]
Note that the "NO" prefix cannot be combined with the "OFF" or "ON"
suffix.
\
SUBTTL START COMMAND
.START: MOVEI T1,0 ;SILENCE FLAG
PUSHJ P,D$ACTV ;DATA FILE OPENED?
FATAL (DNO,CPOPJ,<Data file not opened; use FILE command first>,)
PUSHJ P,C$CEOL ;CHECK FOR END OF LINE
SKIPA ;NO
JRST START1 ;GO SEE IF TASK IN PROGRESS
SKIPE .DFTSK(D) ;TASK IN PROGRESS?
FATAL (TIP,CPOPJ,<Task in progress; cannot start another task>,)
XMOVEI T1,TASK.T ;POINT TO COMMAND TABLES
PUSHJ P,C$TSET ;SET UP SCANNER
PUSHJ P,C$ATOM ;READ A KEYWORD
FATAL (ILC,CPOPJ,<Illegal character; >,T$FCHR)
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,TASK.N ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
PJRST C$EKEY ;FAILED
PUSH P,T2 ;SAVE DISPATCH TABLE OFFSET
MOVEI T1,CRDSIZ ;WORDS NEEDED
PUSHJ P,D$VGET ;ALLOCATE STORAGE
MOVEM T2,.DFCRD(D) ;STORE OFFSET
MOVEI T1,.DFTSK(D) ;POINT TO TASK NAME STORAGE
HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
POP P,T2 ;GET DISPATCH TABLE OFFSET
ADDI T2,TASK.N ;INDEX INTO KEYWORD TABLE
MOVE T2,(T2) ;GET ADDRESS OF TASK NAME
HRLI T2,(POINT 7,) ;MAKE A BYTE POINTER
MOVSI T3,-<<MAXHKS*5>-1> ;SET UP MAXIMUM BYTE COUNT
ILDB T4,T2 ;GET A CHARACTER
IDPB T4,T1 ;PUT A CHARACTER
SKIPE T4 ;END?
AOBJN T3,.-3 ;LOOP FOR ENTIRE STRING
SETZ T4, ;TERMINATE STRING
IDPB T4,T1 ;STORE A NUL
AOBJN T3,.-2 ;PAD OUT REMAINDER WITH ZEROS
JRST START2 ;SKIP RESTART STUFF
START1: SKIPN .DFTSK(D) ;SOMETHING IN PROGRESS?
FATAL (NAT,CPOPJ,<No active task>,)
XMOVEI T1,.DFTSK(D) ;POINT TO TASK NAME
INFO (TSK,START2,<Restarting task >,T$STRG)
START2: PUSHJ P,D$TSKS ;GET TASK ROUTINE
PUSHJ P,(T1) ;DO SOMETHING
MOVE T1,.DFCRD(D) ;GET OFFSET TO CHECKPOINT/RESTART DATA
ADDI T1,(D) ;RELOCATE
MOVSI T2,0(T1) ;COPY ADDRESS
HRRI T2,1(T1) ;MAKE A BLT POINTER
SETZM (T1) ;CLEAR FIRST WORD
BLT T2,CRDSIZ-1(T1) ;CLEAR ALL WORDS
MOVE T1,.DFCRS(D) ;GET STATE
AOBJP T1,START3 ;ADVANCE TO NEXT STATE
MOVEM T1,.DFCRS(D) ;UPDATE POINTER
PUSHJ P,D$WHDR ;UPDATE DISK
JRST START2 ;CONTINUE
START3: MOVSI T1,.DFTSK+0(D) ;POINT TO START OF TASK NAME
HRRI T1,.DFTSK+1(D) ;MAKE A BLT POINTER
SETZM .DFTSK(D) ;CLEAR FIRST WORD
BLT T1,.DFTSK+MAXHKS-1(D) ;CLEAR ENTIRE NAME
SETZM .DFCRS(D) ;MARK ALL TASKS COMPLETE
MOVEI T1,CRDSIZ ;GET WORDS USED
SKIPE T2,.DFCRD(D) ;AND OFFSET TO STORAGE
PUSHJ P,D$VGIV ;DEALLOCATE
SETZM .DFCRD(D) ;CLEAR OFFSET
PUSHJ P,D$WHDR ;UPDATE HEADER
JRST CPOPJ1 ;RETURN
STAHLP: ASCIZ \
The START command initiates a task. The purpose of a task is to
perform some asessment or work on the selected structure that may
involve lengthy computations. Tasks are not affected by system or
program restarts. Information about the state of a task is written
(checkpointed) in the data file. The command syntax is:
START task-name
or
START
If an argument is given to the START command, the specified task is
initiated. The absence of a task-name is an indication that a task
which is already in progress will be restarted.
\
DEFINE KEYS,<
KEY (<FILE-SORT>, TSKFBS,TSKFBH, )
KEY (<RIB-SCAN>, TSKRIB,TSKRIH, )
KEY (<SAT-SCAN>, TSKSAT,TSKSAH, )
>
KEYTAB (TASK,<TBL,NAM,PRC,HLP>)
;FILE-SORT
TSKFBS: TASKH (CPOPJ)
TASKS (SRTZER) ;ZERO FILE BLOCK SORT LINKS
TASKS (D$SORT) ;SORT FILE BLOCKS
TASKT ;TERMINATE TABLE
TSKFBH: ASCIZ \
The START FILE-SORT command causes all the file blocks in the data
file to be sorted.
\
;RIB-SCAN
TSKRIB: TASKH (CPOPJ)
TASKS (D$RBTS) ;READ BOOT BLOCKS
TASKS (D$RHOM) ;READ HOM BLOCKS
TASKS (D$RBAT) ;READ BAT BLOCKS
TASKS (D$RSAT) ;READ SAT BLOCKS
TASKS (D$RRIB) ;READ RIB BLOCKS
TASKS (D$SORT) ;SORT FILE BLOCKS
TASKT ;TERMINATE TABLE
TSKRIH: ASCIZ \
The START RIB-SCAN command does a number of things. The HOM and BAT
blocks are read into the data file. Then the disk is scanned for all
blocks that look like possible RIBs. The time required for this
process to complete will vary greatly based on the size of the
structure and the number of RIBs, both actual in-use RIBs and those
which have been deleted but whose blocks have not yet been reclaimed.
When this process finishes other commands may then be used to examine
and optionally repair any disk damage.
\
;SAT-SCAN
TSKSAT: TASKH (CPOPJ)
TASKS (D$RBTS) ;READ BOOT BLOCKS
TASKS (D$RHOM) ;READ HOM BLOCKS
TASKS (D$RBAT) ;READ BAT BLOCKS
TASKS (D$RSAT) ;READ SAT BLOCKS
TASKT ;TERMINATE TABLE
TSKSAH: ASCIZ \
The START SAT-SCAN command will cause the SAT blocks on disk to be
read and the data file set up for SAT block manipulations. Note that
this command does not cause lost block evaluation to occur.
\
SUBTTL STRUCTURE COMMAND -- .STRUC - ENTRY POINT
.STRUC: MOVEI T1,0 ;FATAL FLAG
PUSHJ P,D$ACTV ;DATA FILE OPENED?
SKIPA ;NO--THAT'S GOOD
FATAL (DFO,CPOPJ,<Data file already opened>,)
PUSHJ P,SAVE1 ;SAVE P1
PUSHJ P,STRINI ;INIT STRUCTURE DATA
PUSHJ P,UNIINI ;INIT UNIT DATA
PUSHJ P,C$CEOL ;AT EOL?
PUSHJ P,C$ATOM ;NO--GET THE DEVICE NAME
JRST C$ENAS ;NO ARGUMENTS SPECIFIED
CAIE T1,0 ;EOL?
FATAL (ILC,CPOPJ,<Illegal character; >,T$FCHR)
SKIPN T1,CMDAT6 ;GET NAME
FATAL (NSS,CPOPJ,<No structure specified>,)
MOVEM T1,.DFSTR(D) ;SAVE NAME
;HERE FROM D$FILE ON RESTARTS
STRUC1: MOVSI P1,-MAXUNI ;AOBJN POINTER TO UNITS
MOVE T1,.DFSTR(D) ;GET STRUCTURE NAME
PUSHJ P,GETDCH ;READ DISK CHARACTERISTICS
JRST STRUC3 ;NOT MOUNTED
CAIE T1,.DCTFS ;FILE STRUCTURE?
JRST STRUC3 ;NO--SAY NOT MOUNTED
;HERE WHEN THE SPECIFIED STRUCTURE IS MOUNTED
STRUC2: HRRZ T1,P1 ;GET LOGICAL UNIT
PUSHJ P,STRLOG ;BUILD NAME
PUSHJ P,GETDCH ;SEE IF IT EXISTS
JRST STRUC4 ;IT DOESN'T SO THAT'S THE END
PUSHJ P,UNISTO ;SETUP U, STORE INITIAL INFORMATION
AOBJN P1,STRUC2 ;LOOP FOR ALL UNITS
FATAL (TMU,CPOPJ,<Too many units in structure>,)
;HERE WHEN THE SPECIFIED STRUCTURE IS NOT MOUNTED
STRUC3: HRRZ T1,P1 ;GET LOGICAL UNIT
PUSHJ P,UNIPMT ;GENERATE A PROMPT STRING
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST STRUC4 ;DONE
PUSHJ P,C$ATOM ;SCAN OFF AN ATOM
JRST STRUC3 ;ATOM BUFFER OVERFLOW
PUSHJ P,C$CEOL ;AT EOL?
JRST [PUSHJ P,C$EEOL ;REPORT JUNK AT EOL
JRST STRUC3] ;TRY AGAIN
MOVE T1,CMDAT6 ;GET SIXBIT RESULT
PUSHJ P,GETDCH ;READ DISK CHARACTERISTICS
SKIPA T1,. ;NOT A DISK
EXCH T1,T2 ;SWAP AROUND
CAIE T2,.DCTPU ;PHYSICAL UNIT?
WARN (DNU,STRUC3,<Device is not a disk unit; >,T$SIXN)
PUSHJ P,UNISTO ;SETUP U, STORE INITIAL INFORMATION
AOBJN P1,STRUC3 ;LOOP BACK FOR MORE
FATAL (TMU,CPOPJ,<Too many units in structure>,)
STRUC4: HRRZM P1,.DFSTN(D) ;STORE NUMBER OF UNITS IN STRUCTURE
PUSHJ P,RDDISK ;READ THE HOM BLOCKS
SKIPA ;FAILED
JRST CPOPJ1 ;RETURN
PUSHJ P,D$INIT ;RESET INCORE DATA FILE HEADER
PUSHJ P,D$VARS ;...
POPJ P, ;RETURN
STRHLP: ASCIZ \
The STRUCTURE command is used to select which file structure will be
operated upon. If the structure is mounted, the program will
determine the physical disk units that make up the structure. (All
disk I/O is performed via the physical disk units.) If the structure
is not currently mounted, you will be prompted for the physical disk
units. Once this information has been given, a dialogue will commence
to verify some critical structure parameters. All questions will
normally include a list of valid responses as well as a default
answer. The command syntax is:
STRUCTURE name
\
SUBTTL STRUCTURE COMMAND -- HOMDAT - COPY HOME BLOCK DATA
HOMDAT: MOVE T2,HOMSNM(T1) ;STRUCTURE NAME
MOVEM T2,.UNSNM(U) ;SAVE FOR THIS UNIT
CAME T2,.DFSTR(D) ;SAME FOR ALL UNITS?
AOS STRERR ;NO
MOVE T2,HOMSCU(T1) ;SUPER CLUSTERS PER UNIT
CAMLE T2,.DFSCU(D) ;FOUND LARGEST SO FAR?
MOVEM T2,.DFSCU(D) ;SAVE LARGER VALUE
MOVE T2,HOMBSC(T1) ;BLOCKS PER SUPER CLUSTER
SKIPN .DFBSC(D) ;ALREADY HAVE IT?
MOVEM T2,.DFBSC(D) ;SET IT NOW
MOVEM T2,.UNBSC(U) ;SAVE FOR THIS UNIT
CAME T2,.DFBSC(D) ;SAME FOR ALL UNTIS?
AOS STRERR ;NO
MOVE T2,.UNUSZ(U) ;GET BLOCKS ON UNIT
IDIV T2,HOMBPC(T1) ;BLOCKS/CLUSTER
IMUL T2,HOMBPC(T1) ;COMPUTE HIGHEST LEGAL BLOCK ON UNIT
SUBI T2,1 ;-1
MOVEM T2,.UNHLB(U) ;SAVE
MOVE T2,HOMBPC(T1) ;GET BLOCKS/CLUSTER AGAIN
SKIPN .DFBPC(D) ;ALREADY HAVE IT?
MOVEM T2,.DFBPC(D) ;SET IT NOW
MOVEM T2,.UNBPC(U) ;SAVE FOR THIS UNIT
CAME T2,.DFBPC(D) ;SAME FOR ALL UNITS?
AOS STRERR ;NO
MOVE T2,HOMCNP(T1) ;BP FOR CLUSTER COUNT IN RETRIEVAL POINTER
TLZ T2,(Z 0,@(17)) ;STRIP POSSIBLE JUNK
HRRI T2,R ;POINT TO OUR STORAGE
SKIPN .DFCNP(D) ;ALREADY HAVE IT?
MOVEM T2,.DFCNP(D) ;SET IT NOW
MOVEM T2,.UNCNP(U) ;SAVE FOR THIS UNIT
CAME T2,.DFCNP(D) ;SAME FOR ALL UNITS?
AOS STRERR ;NO
MOVE T2,HOMCKP(T1) ;BP FOR CHECKSUM IN RETRIEVAL POINTER
TLZ T2,(Z 0,@(17)) ;STRIP POSSIBLE JUNK
HRRI T2,R ;POINT TO OUR STORAGE
SKIPN .DFCKP(D) ;ALREADY HAVE IT?
MOVEM T2,.DFCKP(D) ;SET IT NOW
MOVEM T2,.UNCKP(U) ;SAVE FOR THIS UNIT
CAME T2,.DFCKP(D) ;SAME FOR ALL UNITS?
AOS STRERR ;NO
MOVE T2,HOMCLP(T1) ;BP FOR CLUSTER ADDRESS IN RETRIEVAL POINTER
TLZ T2,(Z 0,@(17)) ;STRIP POSSIBLE JUNK
HRRI T2,R ;POINT TO OUR STORAGE
SKIPN .DFCLP(D) ;ALREADY HAVE IT?
MOVEM T2,.DFCLP(D) ;SET IT NOW
MOVEM T2,.UNCLP(U) ;SAVE FOR THIS UNIT
CAME T2,.DFCLP(D) ;SAME FOR ALL UNITS?
AOS STRERR ;NO
MOVM T2,HOMOVR(T1) ;OVERDRAW
SKIPN .DFOVR(D) ;ALREADY HAVE IT?
MOVEM T2,.DFOVR(D) ;SET IT NOW
MOVEM T2,.UNOVR(U) ;SAVE FOR THIS UNIT
CAME T2,.DFOVR(D) ;SAME FOR ALL UNTIS?
AOS STRERR ;NO
MOVE T2,HOMSPU(T1) ;SATS PER UNIT
MOVEM T2,.UNSPU(U) ;SAVE
POPJ P, ;RETURN
SUBTTL STRUCTURE COMMAND -- HOMFIX - FIXUP INCONSISTANCIES
HOMFIX: PUSHJ P,SAVE1 ;SAVE P1
HOMF2: MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
MOVE T1,.DFSTR(D) ;GET STRUCTURE NAME
HOMF2A: CAME T1,.UNSNM(U) ;MATCH?
JRST HOMF2B ;NO
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,HOMF2A ;LOOP
JRST HOMF3 ;TRY NEXT QUANTITY
HOMF2B: SKIPE STRFIL ;FROM DATA FILE?
WARN (SNM,HOMF3,<Structure name mismatch>,E..HFX)
XMOVEI T1,[ASCIZ / Structure name/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST HOMF2B ;TRY AGAIN
PUSHJ P,C$ATOM ;GET NAME
JRST HOMF2B ;???
SKIPN T1,CMDAT6 ;GET SIXBIT RESULTS
JRST HOMF2B ;NONE THERE
MOVEM T1,.DFSTR(D) ;FIX NAME
JRST HOMF3 ;CONTINUE
;BLOCKS PER SUPER CLUSTER
HOMF3: MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
MOVE T1,.DFBSC(D) ;GET BLOCKS PER SUPER CLUSTER
HOMF3A: CAME T1,.UNBSC(U) ;MATCH?
JRST HOMF3B ;NO
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,HOMF3A ;LOOP
SKIPE STRFIL ;FROM DATA FILE?
JRST HOMF4 ;YES--SKIP CHATTER
XMOVEI T2,T$DECW ;ROUTINE TO CALL
PUSHJ P,T$XLAT ;TRANSLATE TO TEXT
SKIPA T3,T1 ;COPY STRING ADDRESS
HOMF3B: SETZ T3, ;UNLESS DEFAULT SUPPRESSED
SKIPE STRFIL ;FROM DATA FILE?
WARN (BSC,HOMF4,<Blocks per super cluster mismatch>,E..HFX)
XMOVEI T1,T$DECW ;OUTPUT ROUTINE ADDRESS
XMOVEI T2,HOMF3T ;OPTION TABLE ADDRESS
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Blocks per super cluster/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST HOMF3 ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST HOMF3 ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST HOMF3] ;TRY AGAIN
XMOVEI T2,HOMF3T ;POINT TO RANGE TABLE
PUSHJ P,C$RNGE ;CHECK FOR A MATCH
JRST [PUSHJ P,C$ERNG ;VALUE OUT OF RANGE
JRST HOMF3] ;TRY AGAIN
MOVEM T1,.DFBSC(D) ;SAVE
JRST HOMF4 ;CONTINUE
HOMF3T: XWD -1,^D10 ;RANGE TABLE
XWD 3,377777 ;LOW,,HIGH VALUES
;BITS FOR CLUSTER COUNT
HOMF4: MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
LDB T1,[POINT 6,.DFCNP(D),11] ;GET BITS FOR CLUSTER COUNT
HOMF4A: LDB T2,[POINT 6,.UNCNP(U),11] ;GET FROM UNIT
CAME T1,T2 ;MATCH?
JRST HOMF4B ;NO
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,HOMF4A ;LOOP
SKIPE STRFIL ;FROM DATA FILE?
JRST HOMF5 ;YES--SKIP CHATTER
XMOVEI T2,T$DECW ;ROUTINE TO CALL
PUSHJ P,T$XLAT ;TRANSLATE TO TEXT
SKIPA T3,T1 ;COPY STRING ADDRESS
HOMF4B: SETZ T3, ;UNLESS DEFAULT SUPPRESSED
SKIPE STRFIL ;FROM DATA FILE?
WARN (BCC,HOMF5,<Bits for cluster count mismatch>,E..HFX)
XMOVEI T1,T$DECW ;OUTPUT ROUTINE ADDRESS
XMOVEI T2,HOMF4T ;OPTION TABLE ADDRESS
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Bits for cluster count/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST HOMF4 ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST HOMF4 ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST HOMF4] ;TRY AGAIN
XMOVEI T2,HOMF4T ;POINT TO RANGE TABLE
PUSHJ P,C$RNGE ;CHECK FOR A MATCH
JRST [PUSHJ P,C$ERNG ;VALUE OUT OF RANGE
JRST HOMF4] ;TRY AGAIN
DPB T1,[POINT 6,.DFCNP(D),11] ;UPDATE
JRST HOMF5 ;CONTINUE
HOMF4T: XWD -1,^D10 ;RANGE TABLE
XWD 3,22 ;LOW,,HIGH VALUES
;BITS FOR CHECKSUM
HOMF5: MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
LDB T1,[POINT 6,.DFCKP(D),11] ;GET BITS FOR CHECKSUM
HOMF5A: LDB T2,[POINT 6,.UNCKP(U),11] ;GET FROM UNIT
CAME T1,T2 ;MATCH?
JRST HOMF5B ;NO
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,HOMF5A ;LOOP
SKIPE STRFIL ;FROM DATA FILE?
JRST HOMF6 ;YES--SKIP CHATTER
XMOVEI T2,T$DECW ;ROUTINE TO CALL
PUSHJ P,T$XLAT ;TRANSLATE TO TEXT
SKIPA T3,T1 ;COPY STRING ADDRESS
HOMF5B: SETZ T3, ;UNLESS DEFAULT SUPPRESSED
SKIPE STRFIL ;FROM DATA FILE?
WARN (BCK,HOMF6,<Bits for checksum mismatch>,E..HFX)
XMOVEI T1,T$DECW ;OUTPUT ROUTINE ADDRESS
XMOVEI T2,HOMF5T ;OPTION TABLE ADDRESS
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Bits for checksum/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST HOMF5 ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST HOMF5 ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST HOMF5] ;TRY AGAIN
XMOVEI T2,HOMF5T ;POINT TO RANGE TABLE
PUSHJ P,C$RNGE ;CHECK FOR A MATCH
JRST [PUSHJ P,C$ERNG ;VALUE OUT OF RANGE
JRST HOMF5] ;TRY AGAIN
DPB T1,[POINT 6,.DFCKP(D),11] ;UPDATE
JRST HOMF6 ;CONTINUE
HOMF5T: XWD -1,^D10 ;RANGE TABLE
XWD 3,22 ;LOW,,HIGH VALUES
;BITS FOR CLUSTER ADDRESS
HOMF6: MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
LDB T1,[POINT 6,.DFCLP(D),11] ;GET BITS FOR CLUSTER ADDRESS
HOMF6A: LDB T2,[POINT 6,.UNCLP(U),11] ;GET FROM UNIT
CAME T1,T2 ;MATCH?
JRST HOMF6B ;NO
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,HOMF6A ;LOOP
SKIPE STRFIL ;FROM DATA FILE?
JRST HOMF7 ;YES--SKIP CHATTER
XMOVEI T2,T$DECW ;ROUTINE TO CALL
PUSHJ P,T$XLAT ;TRANSLATE TO TEXT
SKIPA T3,T1 ;COPY STRING ADDRESS
HOMF6B: SETZ T3, ;UNLESS DEFAULT SUPPRESSED
SKIPE STRFIL ;FROM DATA FILE?
WARN (BCA,HOMF7,<Bits for cluster address mismatch>,E..HFX)
XMOVEI T1,T$DECW ;OUTPUT ROUTINE ADDRESS
XMOVEI T2,HOMF6T ;OPTION TABLE ADDRESS
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Bits for cluster address/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST HOMF6 ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST HOMF6 ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST HOMF6] ;TRY AGAIN
XMOVEI T2,HOMF6T ;POINT TO RANGE TABLE
PUSHJ P,C$RNGE ;CHECK FOR A MATCH
JRST [PUSHJ P,C$ERNG ;VALUE OUT OF RANGE
JRST HOMF6] ;TRY AGAIN
DPB T1,[POINT 6,.DFCLP(D),11] ;UPDATE
JRST HOMF7 ;CONTINUE
HOMF6T: XWD -1,^D10 ;RANGE TABLE
XWD 3,22 ;LOW,,HIGH VALUES
;BLOCKS PER CLUSTER
HOMF7: MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
MOVE T1,.DFBPC(D) ;GET BLOCKS PER CLUSTER
HOMF7A: CAME T1,.UNBPC(U) ;MATCH?
JRST HOMF7B ;NO
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,HOMF7A ;LOOP
SKIPE STRFIL ;FROM DATA FILE?
JRST HOMF8 ;YES--SKIP CHATTER
XMOVEI T2,T$DECW ;ROUTINE TO CALL
PUSHJ P,T$XLAT ;TRANSLATE TO TEXT
SKIPA T3,T1 ;COPY STRING ADDRESS
HOMF7B: SETZ T3, ;UNLESS DEFAULT SUPPRESSED
SKIPE STRFIL ;FROM DATA FILE?
WARN (BPC,HOMF8,<Blocks per cluster mismatch>,E..HFX)
XMOVEI T1,T$DECW ;OUTPUT ROUTINE ADDRESS
XMOVEI T2,HOMF7T ;OPTION TABLE ADDRESS
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Blocks per cluster/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST HOMF7 ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST HOMF7 ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST HOMF7] ;TRY AGAIN
XMOVEI T2,HOMF7T ;POINT TO RANGE TABLE
PUSHJ P,C$RNGE ;CHECK FOR A MATCH
JRST [PUSHJ P,C$ERNG ;VALUE OUT OF RANGE
JRST HOMF7] ;TRY AGAIN
MOVEM T1,.DFBPC(D) ;UPDATE
JRST HOMF8 ;CONTINUE
HOMF7T: XWD -1,^D10 ;RANGE TABLE
XWD 3,377777 ;LOW,,HIGH VALUES
;OVERDRAW
HOMF8: MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
MOVE T1,.DFOVR(D) ;GET OVERDRAW
HOMF8A: CAME T1,.UNOVR(U) ;MATCH?
JRST HOMF8B ;NO
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,HOMF8A ;LOOP
SKIPE STRFIL ;FROM DATA FILE?
JRST HOMF9 ;YES--SKIP CHATTER
XMOVEI T2,T$DECW ;ROUTINE TO CALL
PUSHJ P,T$XLAT ;TRANSLATE TO TEXT
SKIPA T3,T1 ;COPY STRING ADDRESS
HOMF8B: SETZ T3, ;UNLESS DEFAULT SUPPRESSED
SKIPE STRFIL ;FROM DATA FILE?
WARN (OVR,HOMF9,<Overdraw mismatch>,E..HFX)
XMOVEI T1,T$DECW ;OUTPUT ROUTINE ADDRESS
SETZ T2, ;NO OPTION TABLE
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Overdraw/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST HOMF8 ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST HOMF8 ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST HOMF8] ;TRY AGAIN
MOVE T2,T1 ;COPY ANSWER
MOVE T1,.DFSTN(D) ;NUMBER OF UNITS IN STRUCTURE
IMUL T1,.DFBUS(D) ;TIMES BIGGEST UNIT SIZE
CAIL T2,0 ;RANGE
CAML T2,T1 ; CHECK
FATAL (OVR,HOMF8,<Overdraw must be in the range of 0 to >,T$DECW)
MOVEM T2,.DFOVR(D) ;UPDATE
JRST HOMF9 ;CONTINUE
;FIXUP LARGEST UNIT SIZE
HOMF9: SKIPE STRFIL ;FROM DATA FILE?
JRST HOMF10 ;YES
MOVE T1,.DFSTN(D) ;NUMBER OF UNITS IN STRUCTURE
IMUL T1,.DFBUS(D) ;TIMES BIGGEST UNIT SIZE
SUBI T1,1 ;-1
MOVEM T1,.DFHLB(D) ;STORE HIGHEST LEGAL BLOCK NUMBER
HOMF10: SKIPE STRFIL ;FROM DATA FILE?
SKIPN STRFIE ;AND ERRORS WHILE READING DATA FILE?
JRST CPOPJ1 ;NO--ALL DONE
WARN (PSF,.+1,<Parameter skews while reading data file>,)
MOVEI T1,[ASCIZ / Proceed/]
MOVEI T2,0 ;ASSUME "NO"
PUSHJ P,C$AYNQ ;ASK YES/NO QUESTION
JUMPE T2,CPOPJ ;JUMP IF "NO"
JRST CPOPJ1 ;PROCEED ANYWAY
E..HFX: AOS STRFIE ;ERROR WHILE READING DATA FILE
XMOVEI T1,[ASCIZ / on unit /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,.UNNAM(U) ;GET UNIT NAME
PJRST T$SIXN ;PRINT IT AND RETURN
SUBTTL STRUCTURE COMMAND -- HOMRD - READ HOM BLOCKS
HOMRD: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVEI P1,RIB ;COVENIENT BUFFER
MOVNI P2,1 ;FLAG FIRST TIME THROUGH
HOMRD1: SKIPA T1,[LBNHOM] ;FIRST HOME BLOCK NUMBER
HOMRD2: MOVEI T1,LB2HOM ;SECOND HOME BLOCK
MOVSI T2,-BLKSIZ ;NUMBER OF WORDS
HRRI T2,-1(P1) ;BUFFER ADDRESS
PUSHJ P,U$READ ;READ THE BLOCK
JRST HOMRD4 ;I/O ERROR
JRST HOMRD5 ;GO CHECK IT OUT
HOMRD3: WARN (HBC,.+1,<HOME block consistancy error on >,HOMERR)
HOMRD4: AOJE P2,HOMRD2 ;TRY OTHER HOME BLOCK
MOVE T1,.UNNAM(U) ;GET UNIT NAME
FATAL (CRH,CPOPJ,<Cannot read HOME blocks on unit >,T$SIXN)
HOMRD5: MOVS T1,HOMNAM(P1) ;GET SIXBIT 'HOM'
CAIE T1,'HOM' ;CHECK IT
JRST HOMRD3 ;NO GOOD
MOVE T1,HOMCOD(P1) ;GET MAGIC CODE
CAIE T1,CODHOM ;MATCH?
JRST HOMRD3 ;NO
MOVE T1,HOMSLF(P1) ;GET SELF POINTER
CAME T1,.UNPOS(U) ;MATCH REQUESTED BLOCK NUMBER?
JRST HOMRD3 ;NO
MOVE T1,P1 ;COPY BUFFER ADDRESS
JRST CPOPJ1 ;RETURN GOODNESS
HOMERR: MOVE T1,.UNNAM(U) ;GET UNIT NAME
PUSHJ P,T$SIXN ;PRINT IT
MOVEI T1,[ASCIZ /, block /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,.UNPOS(U) ;GET POSITION BEFORE I/O
PJRST T$DECW ;PRINT IT AND RETURN
SUBTTL STRUCTURE COMMAND -- HOMRPT - REPORT HOM CONSISTANCY ERRORS
HOMRPT: PUSHJ P,SAVE1 ;SAVE P1
SKIPE STRERR ;ANY ERRORS?
WARN (SPM,.+1,<Structure parameter mismatch>,)
MOVE T1,.DFSTN(D) ;GET COUNT OF UNITS IN STRUCTURE
SOJLE T1,CPOPJ ;SKIP FANCY DISPLAY IF JUST ONE
MOVEI T1,SKEWHD ;POINT TO HEADER
PUSHJ P,T$STRG ;PRINT IT
MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
HOMRP1: PUSHJ P,T$SPAC ;START WITH A LEADING SPACE
MOVE T1,.UNNAM(U) ;NAME
JUSTIFY (L,6," ",T$SIXN) ;PRINT WORD
MOVEI T1,[ASCIZ / /]
PUSHJ P,T$STRG ;SPACE OVER
MOVE T1,.UNLUN(U) ;GET LOGICAL UNIT
PUSHJ P,STRLOG ;TRANSLATE TO NAME
JUSTIFY (L,7," ",T$SIXN) ;PRINT WORD
MOVEI T1,[ASCIZ / /]
PUSHJ P,T$STRG ;SPACE OVER
MOVE T1,.UNSNM(U) ;STRUCTURE NAME
JUSTIFY (L,6," ",T$SIXN) ;PRINT WORD
MOVEI T1,[ASCIZ / /] ;SPACE
PUSHJ P,T$STRG ; OVER
MOVE T1,.UNBSC(U) ;BLOCKS PER SUPER CLUSTER
JUSTIFY (R,6," ",T$DECW) ;PRINT WORD
MOVEI T1,[ASCIZ / /] ;SPACE
PUSHJ P,T$STRG ; OVER
LDB T1,[POINT 6,.UNCNP(U),11] ;BITS FOR CLUSTER COUNT
JUSTIFY (R,^D8, ,T$DECW) ;PRINT IT
MOVEI T1,[ASCIZ / /] ;SPACE
PUSHJ P,T$STRG ; OVER
LDB T1,[POINT 6,.UNCKP(U),11] ;BITS FOR CHECKSUM
JUSTIFY (R,^D8, ,T$DECW) ;PRINT IT
MOVEI T1,[ASCIZ / /] ;SPACE
PUSHJ P,T$STRG ; OVER
LDB T1,[POINT 6,.UNCLP(U),11] ;BITS FORS CLUSTER ADDRESS
JUSTIFY (R,^D8, ,T$DECW) ;PRINT IT
MOVEI T1,[ASCIZ / /] ;SPACE
PUSHJ P,T$STRG ; OVER
MOVE T1,.UNBPC(U) ;BLOCKS PER CLUSTER
JUSTIFY (R,4," ",T$DECW) ;PRINT WORD
MOVEI T1,[ASCIZ / /] ;SPACE
PUSHJ P,T$STRG ; OVER
MOVE T1,.UNOVR(U) ;OVERDRAW
JUSTIFY (R,^D8," ",T$DECW) ;PRINT WORD
PUSHJ P,T$CRLF ;END LINE
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,HOMRP1 ;LOOP FOR ALL UNITS
PUSHJ P,T$CRLF ;ONE MORE CRLF
POPJ P, ;RETURN
SKEWHD: ASCIZ \
Unit Logical Struct SupCls Bits for Bits for Bits for Clst Blocks
Name Unit-ID Name Size Clst cnt Checksum Clst adr Size Overdraw
------ ------- ------ ------ -------- -------- -------- ---- --------
\
SUBTTL STRUCTURE COMMAND -- RDDISK - READ AND VALIDATE DATA
RDDISK: PUSHJ P,SAVE1 ;SAVE P1
MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
RDDIS1: PUSHJ P,HOMRD ;READ HOME BLOCKS
RDDIS2: AOSA STRERR ;COUNT THE ERROR
PUSHJ P,HOMDAT ;LOAD UP DATA FROM HOME BLOCKS
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,RDDIS1 ;LOOP BACK FOR ALL UNITS
PUSHJ P,HOMRPT ;REPORT INCONSISTANCIES
PUSHJ P,HOMFIX ;ALLOW FIXUPS
POPJ P, ;GIVE UP
SKIPE STRFIL ;READING DATA FILE?
JRST RDDIS3 ;YES--AVOID RECURSION
PUSHJ P,STRFIX ;DO FINAL VALUE FIXUPS
JUMPE T1,CPOPJ1 ;RETURN IF NO DATA FILE WANTED
PUSHJ P,D$FILE ;OPEN THE FILE
WARN (PWF,CPOPJ1,<Proceeding without data file>,)
RDDIS3: PUSHJ P,D$WHDR ;UPDATE HEADER
JRST CPOPJ1 ;RETURN
;INITIALIZE STRUCTURE STORAGE IN DATA FILE HEADER
STRINI: SETZM STRFIL ;CLEAR "FROM DATA FILE" FLAG
SETZM STRFIE ;CLEAR DATA FILE ERROR COUNT
SETZM .DFBPC(D) ;BLOCKS/CLUSTER
SETZM .DFBSC(D) ;BLOCKS PER SUPER CLUSTER
SETZM .DFBUS(D) ;BIGGEST UNIT SIZE (.UNUSZ)
SETZM .DFCKP(D) ;BP FOR CHECKSUM IN RETRIEVAL POINTER
SETZM .DFCLP(D) ;BP FOR CLUSTER ADDRESS RETRIEVAL POINTER
SETZM .DFCNP(D) ;BP FOR CLUSTER COUNT IN RETRIEVAL POINTER
SETZM .DFSTR(D) ;STRUCTURE NAME
SETZM .DFSTN(D) ;NUMBER OF UNITS IN STRUCTURE
SETZM .DFSCU(D) ;SUPER CLUSTER PER UNIT
POPJ P, ;RETURN
;GENERATE A LOGICAL UNIT NAME
STRLOG: SETZB T3,T4 ;CLEAR RESULT AND COUNTER
STRLO1: IDIVI T1,12 ;DIVIDE BY RADIX
ADDI T2,'0' ;MAKE SIXBIT
LSHC T2,-6 ;SAVE CHARACTER
SKIPE T1 ;DONE?
AOJA T4,STRLO1 ;LOOP FOR ALL DIGITS
MOVEI T1,77 ;CHARACTER MASK
STRLO2: TDNE T1,.DFSTR(D) ;FOUND RIGHT-MOST CHARACTER IN NAME?
JRST STRLO3 ;YES
LSH T1,6 ;POSITION OVER ONE CHARACTER
AOJA T4,STRLO2 ;LOOP
STRLO3: IMULI T4,6 ;COMPUTE BITS TO REPOSITION
LSHC T2,(T4) ;DO IT
MOVE T1,.DFSTR(D) ;GET STRUCTURE NAME
IOR T1,T2 ;MERGE NAME WITH LOGICAL UNIT NUMBER
POPJ P, ;RETURN
;INITIALIZE UNIT STORAGE
UNIINI: MOVSI T1,.DFUNI(D) ;POINT TO START OF UNIT DATA
HRRI T1,.DFUNI+1(D) ;MAKE A BLT POINTER
SETZM .DFUNI(D) ;CLEAR FIRST WORD
BLT T1,.DFUNI+MAXUNI*.UNLEN-1(D) ;CLEAR STORAGE
PJRST UNIRST ;DO RESTART THINGS AND RETURN
UNIPMT: PUSH P,T1 ;SAVE LOGICAL UNIT NAME
XMOVEI T1,UNIPM1 ;POINT TO ROUTINE
PUSHJ P,T$SETO ;SET OUTPUT ROUTINE
EXCH T1,(P) ;SWAP AROUND
PUSH P,T1 ;AND SAVE
MOVE T1,[POINT 7,SELBUF] ;BYTE POINTER TO STORAGE
MOVEM T1,SELPTR ;SAVE
XMOVEI T1,[ASCIZ / Disk drive for logical unit /]
PUSHJ P,T$STRG ;PRINT INTRODUCTION
POP P,T1 ;GET NUMBER BACK
PUSHJ P,T$DECW ;PRINT IT
POP P,T1 ;GET OLD CHARACTER TYPER
PUSHJ P,T$SETO ;RESET IT
XMOVEI T1,SELBUF ;POINT TO SELECTION PROMPT BUFFER
POPJ P, ;AND RETURN
UNIPM1: IDPB T1,SELPTR ;STORE CHARACTER
POPJ P, ;RETURN
;INITIALIZE ON RESTARTS
UNIRST: MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
UNIRS1: SETZM .UNNAM(U) ;DON'T KNOW UNIT NAME YET
SETOM .UNCHN(U) ;NO OPENED CHANNEL
SETOM .UNBLK(U) ;NO CURRENT BLOCK
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,UNIRS1 ;LOOP FOR ALL UNIT BLOCKS
POPJ P, ;RETURN
;SETUP UP U, STORE INITIAL INFORMATION
UNISTO: HRRZ U,P1 ;GET UNIT NUMBER
IMULI U,.UNLEN ;TIMES WORDS PER UNIT STORAGE
ADDI U,.DFUNI(D) ;INDEX TO BLOCK FOR THIS UNIT
MOVE T1,DCHBLK+.DCUPN ;PHYSICAL DRIVE NAME
MOVEM T1,.UNNAM(U) ;SAVE
HRRZM P1,.UNLUN(U) ;SAVE LOGICAL UNIT
HRRZ T1,P1 ;GET LOGICAL UNIT NUMBER
PUSHJ P,STRLOG ;BUILD LOGICAL UNIT NAME
MOVEM T1,.UNLOG(U) ;SAVE IT
MOVE T1,DCHBLK+.DCUSZ ;GET UNIT SIZE
MOVEM T1,.UNUSZ(U) ;SAVE IT
CAMLE T1,.DFBUS(D) ;BIGGEST SO FAR?
MOVEM T1,.DFBUS(D) ;YES
SETOM .UNCHN(U) ;NO CHANNEL OPENED YET
AOS .DFSTN(D) ;COUNT THE UNIT
POPJ P, ;RETURN
SUBTTL STRUCTURE COMMAND -- STRFIX - FINAL VALUE FIXUPS
STRFIX: HRROI T1,12 ;-VE OPTION TABLE LENGTH,,RADIX
MOVEM T1,STRSFT+0 ;SAVE HEADER WORD
HRLZ T1,.DFLVL(D) ;GET CURRENT SFD LEVEL
HRRI T1,MAXSFD ;PUT MAXIMUM IN LH
MOVEM T1,STRSFT+1 ;SAVE IN OPTION TABLE
HLRZS T1 ;ISOLATE DEFAULT
XMOVEI T2,T$DECW ;ROUTINE TO CALL
PUSHJ P,T$XLAT ;TRANSLATE TO TEXT
MOVE T3,T1 ;COPY STRING ADDRESS FOR DEFAULTING
XMOVEI T1,T$DECW ;POINT TO OUTPUT ROUTINE
XMOVEI T2,STRSFT ;OPTION TABLE
PUSHJ P,C$OPTN ;SETUP OPTIONS
XMOVEI T1,[ASCIZ / Maximum number of SFDs/] ;PROMPT STRING
PUSHJ P,C$READ ;GET RESPONSE
JRST STRFIX ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST STRFIX ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST STRFIX] ;TRY AGAIN
XMOVEI T2,STRSFT ;POINT TO RANGE TABLE
PUSHJ P,C$RNGE ;CHECK FOR A MATCH
JRST [PUSHJ P,C$ERNG ;VALUE OUT OF RANGE
JRST STRFIX] ;TRY AGAIN
MOVEM T1,.DFLVL(D) ;SAVE FOR LATER
STRFI1: MOVEI T1,[ASCIZ / Create data file/]
MOVEI T2,1 ;ASSUME "YES"
PUSHJ P,C$AYNQ ;ASK YES/NO QUESTION
JUMPE T2,STRFI3 ;JUMP IF "NO"
STRFI2: PUSHJ P,FILDEF ;BUILD DEFAULT SCAN BLOCK
JFCL ;CAN'T FAIL
XMOVEI T1,STRFIZ ;POINT TO ROUTINE
PUSHJ P,T$SETO ;SET OUTPUT ROUTINE
PUSH P,T1 ;AND SAVE
MOVE T1,[POINT 7,SELBUF] ;BYTE POINTER TO STORAGE
MOVEM T1,SELPTR ;SAVE
MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,T$FILE ;FILL THE BUFFER
MOVEI T1,0 ;GET A NUL
IDPB T1,SELPTR ;TERMINATE STRING
POP P,T1 ;GET OLD CHARACTER TYPER
PUSHJ P,T$SETO ;RESET IT
XMOVEI T1,T$STRG ;POINT TO OUTPUT ROUTINE
SETZ T2, ;NO OPTION TABLE
XMOVEI T3,SELBUF ;POINT TO DEFAULT TEXT BUFFER
PUSHJ P,C$OPTN ;SETUP OPTIONS
XMOVEI T1,[ASCIZ / Data file/] ;PROMPT STRING
PUSHJ P,C$READ ;GET RESPONSE
JRST STRFIX ;TRY AGAIN
PUSHJ P,C$FILE ;READ FILESPEC
JRST STRFI2 ;SYNTAX ERROR
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;JUNK AT EOL
JRST STRFI2] ;TRY AGAIN
MOVE T1,.DFCMD(D) ;POINT TO COMMAND SCAN BLOCK
ADDI T1,(D) ;RELOCATE
HRLZS T1 ;PUT IN LH
MOVE T2,.DFINP(D) ;POINT TO INPUT SCAN BLOCK
ADDI T2,(D) ;RELOCATE
HRRI T1,(T2) ;MAKE A BLT POINTER
ADD T2,.DFSBL(D) ;COMPUTE END OF BLT
BLT T1,-1(T2) ;LOAD INPUT SCAN BLOCK
PUSHJ P,FILDE1 ;DO DEFAULTING
JRST STRFI2 ;FAILED
MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SPEC
ADDI T1,(D) ;RELOCATE
POPJ P, ;RETURN
STRFI3: SETZ T1, ;NO DATA FILE
POPJ P, ;AND RETURN
;ROUTINE TO STORE A CHARACTER FOR FILESPEC GENERATION
STRFIZ: IDPB T1,SELPTR ;STORE CHARACTER
POPJ P, ;RETURN
STRCHK: SKIPN .DFSTR(D) ;STRUCTURE COMMAND GIVEN?
FATAL (NSG,CPOPJ,<No STRUCTURE command given>,)
JRST CPOPJ1 ;RETURN
SUBTTL SHOW COMMAND
.SHOW: MOVE T1,[PUSHJ P,T$JUST] ;ROUTINE TO DO JUSTIFICATION
MOVEM T1,CMDJST+0 ;SAVE FOR LATER
PUSHJ P,LSTPSZ ;NOW DETERMINE PAGE SIZE
PUSHJ P,C$CEOL ;AT EOL?
SKIPA ;NO--ARGUMENT FOLLOWING
JRST SHOW1 ;DEFAULT TO "ALL"
PUSHJ P,C$ATOM ;READ A KEYWORD
FATAL (ILC,CPOPJ,<Illegal character; >,T$FCHR)
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
JRST SHOW2 ;ENTER COMMON CODE
SHOW1: XMOVEI T1,[ASCIZ /ALL/]
SHOW2: XMOVEI T2,SHOW.N ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
PJRST C$EKEY ;FAILED
PUSHJ P,@SHOW.P(T2) ;DISPATCH
POPJ P, ;SET FAILED
JRST CPOPJ1 ;RETURN
SHWHLP: ASCIZ \
The SHOW command will display a variety of information pertaining to
the selected structure, the set parameters, and the data file used to
the information necessary to perform operations on the structure.
\
DEFINE KEYS,<
KEY (<ALL>, SHWALL,SHWALH, )
KEY (<DATA-FILE>, D$SHWD,SHWDFH, )
KEY (<DUMP-DESCRIPTORS>, D$SDMP,SHWDMH, )
KEY (<ERSATZ-DEVICES>, D$SHWE,SHWEDH, )
KEY (<ERROR-SUMMARY>, D$SERR,SHWERH, )
KEY (<IO-DESCRIPTORS>, D$SIOT,SHWIOH, )
KEY (<PARAMETERS>, D$SHWP,SHWPRH, )
KEY (<PATCH-DATA>, D$SHPT,SHWPTH, )
KEY (<SAT-BLOCKS>, D$SSAT,SHWSAH, )
KEY (<STRUCTURE>, D$SHWS,SHWSTH, )
>
KEYTAB (SHOW,<TBL,NAM,PRC,HLP>)
SHWALL: PUSHJ P,D$SHWS ;DISPLAY STRUCTURE DATA
PUSHJ P,D$SHWP ;DISPLAY PARAMETERS
PUSHJ P,D$SHWD ;DISPLAY DATA FILE INFO
PUSHJ P,D$SHPT ;DISPLAY PATCH DATA
PUSHJ P,D$SSAT ;DISPLAY SAT BLOCKS
PUSHJ P,D$SERR ;DISPLAY ERROR SUMMARY
PUSHJ P,D$SHWE ;DISPLAY ERSATZ DEVICES
POPJ P, ;RETURN
SHWALH: ASCIZ \
The SHOW ALL command displays structure, parameter, and data file
information on the terminal. It is equivalent to typing the all of
the individual SHOW commands.
\
SHWDFH: ASCIZ \
The SHOW DATA-FILE command displays information about the data file on
the terminal. The operations are performed on the selected structure,
the data file is filled with information for locating files, HOM
blocks, SAT blocks, etc. The maintenance of this data base
necessarily requires some amount of overhead in the data file. The
SHOW DATA-FILE displays the overhead information.
\
SHWDMH: ASCIZ \
The SHOW DUMP-DESCRIPTORS command displays the user-defined DUMP
descriptors. These quantities are used to format data when DUMP
format "SPECIAL" has been selected.
\
SHWEDH: ASCIZ \
The SHOW ERSATZ-DEVICE command displays the ersatz devices defined by
the monitor and the user user. In cases where a monitor PPN
definition has been superseded by a user-specified value, both PPNs
are displayed.
\
SHWERH: ASCIZ \
The SHOW ERROR-SUMMARY command displays errors in critical disk
blocks. Errors may be either those detected by consistancy checks of
the contents of a block for by an I/O error.
\
SHWIOH: ASCIZ \
The SHOW IO-DESCRIPTORS command displays the user-defined I/O trace
descriptors. These quantities are used to format data being
transfered to and from the disk when I/O tracing is enabled.
\
SHWPRH: ASCIZ \
The SHOW PARAMETERS command displays on the terminal, the various
parameters that may be changed throughout the course of structure
damage assessment and repair.
\
SHWPTH: ASCIZ \
The SHOW PATCH-DATA command displays information about any active
patch work. Once a patch is initiated by the PATCH command, this
display will contain all the information recorded in the data file for
the patch.
\
SHWSAH: ASCIZ \
The SHOW SAT-BLOCKS command displays information about the SAT blocks.
Included in this display is the SAT block number, count of free
clusters, the position of the block on each unit and the range of
cluster addresses which are described by the SAT.
\
SHWSTH: ASCIZ \
The SHOW STRUCTURE command displays information about the selected
structure on the terminal. The data is generally made up of fixed
quantities which cannot be changed.
\
SUBTTL TRANSLATE COMMAND
.TRANS: PUSHJ P,C$CEOL ;CHECK FOR END OF LINE
SKIPA ;NO
PJRST C$ENAS ;NO ARGUMENTS SPECIFIED
PUSHJ P,SAVE4 ;SAVE SOME ACS
XMOVEI T1,TRAN.T ;POINT TO COMMAND TABLES
PUSHJ P,C$TSET ;SET UP SCANNER
PUSHJ P,C$ATOM ;READ A KEYWORD
FATAL (ILC,CPOPJ,<Illegal character; >,T$FCHR)
MOVE P1,T1 ;REMEMBER TERMINATOR
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,TRAN.N ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
PJRST C$EKEY ;FAILED
MOVE T1,P1 ;GET TERMINATOR BACK
PUSHJ P,@TRAN.P(T2) ;DISPATCH
POPJ P, ;SET FAILED
POPJ P,
TRNHLP: ASCIZ \
The TRANSLATE command converts data from one format to another. The
types of data that can be converted are defined by te available
keywords. The command syntax is:
TRANSLATE keyword <data>
\
DEFINE KEYS,<
KEY (<BLOCK>, TRNBLK,TRNBLH, )
KEY (<CFP>, TRNCFP,TRNCFH, )
KEY (<DATE>, TRNDAT,TRNDAH, )
KEY (<ERROR>, TRNERR,TRNERH, )
KEY (<EXTENDED-RIB-ADDRESS>,TRNXRA,TRNXRH, )
KEY (<RETRIEVAL-POINTER>, TRNRET,TRNREH, )
KEY (<UDT>, TRNUDT,TRNUDH, )
KEY (<UNIT>, TRNUNI,TRNUNH, )
>
KEYTAB (TRAN,<TBL,NAM,PRC,HLP,CMD>)
;TRANSLATE BLOCK
TRNBLK: PUSHJ P,STRCHK ;WAS STRUCTURE COMMAND GIVEN?
POPJ P, ;NO
PUSHJ P,C$DECI ;READ A NUMBER
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
MOVE P1,T1 ;REMEMBER BLOCK NUMBER
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
PUSHJ P,F$BLKU ;CONVERT TO BLOCK ON LOGICAL UNIT
FATAL (IBS,CPOPJ,<Illegal block on structure; >,T$DECW)
TRNBL1: MOVE P2,T1 ;SAVE BLOCK RELATIVE TO UNIT
MOVE T1,P1 ;GET BLOCK BACK
IDIV T1,.DFBPC(D) ;DIVIDE BY BLOCKS PER CLUSTER
SKIPN T2 ;A REMAINDER?
SKIPA P3,T1 ;NO--COPY CFP
MOVNI P3,1 ;ELSE INVALID CFP
PUSHJ P,TRNDPY ;DISPLAY RESULTS
JRST CPOPJ1 ;RETURN
TRNBLH: ASCIZ \
The TRANSLATE BLOCK command will convert a logical block number
relative to a structure to its equivalent block number relative to a
logical unit. The specified block number could also represent a valid
CFP, in which case it the proper conversion will also be done. The
command syntax is:
TRANSLATE BLOCK n
\
;TRANSLATE CFP
TRNCFP: PUSHJ P,STRCHK ;WAS STRUCTURE COMMAND GIVEN?
POPJ P, ;NO
PUSHJ P,C$OCTI ;READ A NUMBER
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
TLNE T1,-1 ;WEED OUT JUNK
FATAL (ICF,CPOPJ,<Invalid CFP>,T$OCTW)
MOVE P3,T1 ;COPY CFP FOR LATER
IDIV T1,.DFSCU(D) ;DIVIDE BY SUPER CLUSTERS PER UNIT
IMUL T2,.DFBSC(D) ;COMPUTE BLOCK NUMBER
CAML T1,.DFSTN(D) ;REASONABLE UNIT NUMBER?
FATAL (NSU,CPOPJ,<No such unit; >,T$DECW)
MOVEI U,(T1) ;GET UNIT NUMBER
IMULI U,.UNLEN ;TIMES WORDS PER UNIT STORAGE
ADDI U,.DFUNI(D) ;INDEX TO BLOCK FOR THIS UNIT
MOVE P2,T2 ;SAVE BLOCK RELATIVE TO UNIT
PUSHJ P,F$BLKS ;CONVERT TO LOGICAL BLOCK ON STRUCTURE
JRST [MOVE T1,P2 ;GET BAD BLOCK NUMBER
FATAL (IBN,CPOPJ,<Illegal block on unit; >,T$DECW)]
MOVE P1,T1 ;SAVE LOGICAL BLOCK
PUSHJ P,TRNDPY ;DISPLAY RESULTS
JRST CPOPJ1 ;RETURN
TRNCFH: ASCIZ \
The TRANSLATE CFP command will convert a compressed file pointer (CFP)
to a structure relative logical block number and to its equivalent
block number relative to a logical unit.
TRANSLATE CFP n
\
;TRANSLATE DATE
TRNDAT: PUSHJ P,C$OCTI ;READ A NUMBER
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
TDNE T1,[-1,,700000] ;OVERFLOW?
FATAL (DOV,CPOPJ,<Date overflow(greater than 15 bits); >,T$OCTW)
PUSHJ P,T$DATE ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
PUSHJ P,T$CRLF ;ONE MORE
JRST CPOPJ1 ;RETURN
TRNDAH: ASCIZ \
The TRANSLATE DATE command 15-bit DECsystem-10 date (an octal integer)
to an eye readable representation. The command syntax is:
TRANSLATE DATE n
\
;TRANSLATE ERROR
TRNERR: PUSHJ P,C$ATOM ;GET THE COMMAND NAME
PJRST C$EILC ;ILLEGAL CHARACTER
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
MOVS T1,CMDAT6 ;GET SIXBIT RESULT
TLNE T1,-1 ;LIMITED TO 3 CHARACTERS
JRST TRNER2 ;JUNK SUPPLIED
MOVEI T2,0 ;SET INDEX
TRNER1: HLRZ T3,FETEXT(T2) ;GET A MNEMONIC
CAIN T3,(T1) ;SAME AS THE ONE SPECIFIED?
JRST TRNER3 ;YES
SKIPE FETEXT+1(T2) ;END OF TABLE?
AOJA T2,TRNER1 ;NOT YET
TRNER2: XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
FATAL (IEM,CPOPJ,<Invalid error mnemonic; >,T$STRG)
TRNER3: MOVSS T1 ;COPY TO LH
PUSHJ P,T$SIXN ;PRINT IT
XMOVEI T1,[ASCIZ / = /]
PUSHJ P,T$STRG ;PRINT SEPARATOR
HRRZ T1,FETEXT(T2) ;GET ASSOCIATED TEXT
PUSHJ P,T$STRG ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
PUSHJ P,T$CRLF ;ONE MORE
JRST CPOPJ1 ;RETURN
TRNERH: ASCIZ \
The TRANSLATE ERROR command converts an error mnemonic to its
associated text string. These mnemonics are can be displayed as part
of a SHOW ERROR command, when a unit or particular block is found to
be in error. The command syntax is:
TRANSLATE ERROR mnemonic
\
;TRANSLATE RETRIEVAL-POINTER
TRNRET: PUSHJ P,STRCHK ;WAS STRUCTURE COMMAND GIVEN?
POPJ P, ;NO
PUSHJ P,TRNHWD ;READ A PAIR OF OCTAL HALF-WORDS
POPJ P, ;FAILED
MOVE R,P1 ;SET UP FOR DECODING
TDNN R,[-1-RIPNUB-MAXUNI] ;CHANGE OF UNIT POINTER?
JRST TRNRE4 ;YES
MOVE T1,.DFSTN(D) ;GET COUNT OF UNITS
SOJE T1,TRNRE2 ;DON'T PROMPT IF SINGLE UNIT STRUCTURE
HRROI T1,12 ;-VE OPTION TABLE LENGTH,,RADIX
MOVEM T1,STRSFT+0 ;SAVE HEADER WORD
HRRZ T1,.DFSTN(D) ;GET NUMBER OF UNITS IN STR
SUBI T1,1 ;-1 CUZ WE COUNT FROM 0 TO N-1
MOVEM T1,STRSFT+1 ;STORE
TRNRE1: XMOVEI T1,T$DECW ;OUTPUT ROUTINE ADDRESS
XMOVEI T2,STRSFT ;OPTION TABLE ADDRESS
SETZ T3, ;NO DEFAULT
PUSHJ P,C$OPTN ;SET OPTIONS
XMOVEI T1,[ASCIZ / Logical unit/]
PUSHJ P,C$READ ;READ A COMMAND LINE
JRST TRNRE1 ;TRY AGAIN
PUSHJ P,C$DECI ;GET A NUMBER
JRST TRNRE1 ;???
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST TRNRE1] ;TRY AGAIN
CAIL T1,0 ;RANGE
CAML T1,.DFSTN(D) ; CHECK
FATAL (IUN,CPOPJ,<Illegal unit number; >,T$DECW)
TRNRE2: MOVEI U,(T1) ;GET UNIT NUMBER
IMULI U,.UNLEN ;TIMES WORDS PER UNIT STORAGE
ADDI U,.DFUNI(D) ;INDEX TO BLOCK FOR THIS UNIT
PUSHJ P,T$CRLF ;START WITH A NEW LINE
XMOVEI T1,[ASCIZ / Retrieval pointer: /]
PUSHJ P,T$STRG ;PRINT TEXT
HLRZ T1,R ;GET LH
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
PUSHJ P,T$COMA ;SEPARATE
PUSHJ P,T$COMA ; ...
HRRZ T1,R ;GET RH
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
PUSHJ P,T$CRLF ;ONE MORE
XMOVEI T1,[ASCIZ / Cluster count: /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,.DFCNP(D) ;GET CLUSTER COUNT
PUSHJ P,T$DECW ;PRINT IT
XMOVEI T1,[ASCIZ / (/]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,.DFCNP(D) ;GET CLUSTER COUNT
IMUL T1,.DFBSC(D) ;COMPUTE NUMBER OF BLOCKS
PUSHJ P,T$DECW ;PRINT IT
XMOVEI T1,[ASCIZ / blocks)/]
PUSHJ P,T$STRG ;PRINT TEXT
PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / Cluster address: /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,.DFCLP(D) ;GET CLUSTER ADDRESS
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / Checksum: /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,.DFCKP(D) ;GET CHECKSUM
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
LDB P2,.DFCLP(D) ;GET CLUSTER ADDRESS AGAIN
IMUL P2,.DFBPC(D) ;COMPUTE BLOCK NUMBER
MOVE T1,.UNLUN(U) ;GET UNIT NUMBER
MOVE T2,P2 ;AND BLOCK ON UNIT
PUSHJ P,F$BLKS ;TRANSLATE TO BLOCK ON STRUCTURE
JRST [MOVNI P2,1 ;INVALIDATE BLOCK ON UNIT
JRST TRNRE3] ;AND CONTINUE
MOVE P1,T1 ;COPY STRUCTURE-RELATIVE BLOCK
IDIV T1,.DFBPC(D) ;DIVIDE BY BLOCKS PER CLUSTER
SKIPN T2 ;A REMAINDER?
SKIPA P3,T1 ;NO--COPY CFP
TRNRE3: MOVNI P3,1 ;ELSE INVALID CFP
PUSHJ P,TRNDPY ;DISPLAY RESULTS
JRST CPOPJ1 ;RETURN
TRNRE4: PUSHJ P,T$CRLF ;START WITH A NEW LINE
XMOVEI T1,[ASCIZ / Change of unit pointer: /]
PUSHJ P,T$STRG ;PRINT TEXT
XMOVEI T1,[ASCIZ / New logical unit number: /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,R ;COPY POINTER
ANDI T1,MAXUNI ;ISOLATE NEW UNIT
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
PUSHJ P,T$CRLF ;ONE MORE
JRST CPOPJ1 ;RETURN
TRNREH: ASCIZ \
The TRANSLATE RETRIEVAL-POINTER command will convert a binary
retrieval pointer into its component parts. The command syntax is:
TRANSLATE RETRIEVAL-POINTER n
where "n" is an octal quantity. Half-words may be specified by
separating the left and right half values with double colons (",,").
\
;TRANSLATE UDT
TRNUDT: PUSHJ P,TRNHWD ;READ A PAIR OF OCTAL HALF-WORDS
POPJ P, ;FAILED
MOVE T1,P1 ;COPY UDT
PUSHJ P,T$DTTM ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
PUSHJ P,T$CRLF ;ONE MORE
JRST CPOPJ1 ;RETURN
TRNUDH: ASCIZ \
The TRANSLATE UDT command will convert a Smithsonian Universal
Date/Time quantity to an eye readable representation. The command
syntax is:
TRANSLATE UDT dtm
where "dtm" is an octal quantity. Half-words may be specified by
separating the left and right half values with double colons (",,").
\
;TRANSLATE UNIT
TRNUNI: PUSHJ P,STRCHK ;WAS STRUCTURE COMMAND GIVEN?
POPJ P, ;NO
PUSHJ P,C$DECI ;READ UNIT NUMBER
POPJ P, ;SYNTAX ERROR
CAIL T1,0 ;RANGE
CAML T1,.DFSTN(D) ; CHECK
FATAL (IUN,CPOPJ,<Illegal unit number; >,T$DECW)
MOVEI U,(T1) ;GET UNIT NUMBER
IMULI U,.UNLEN ;TIMES WORDS PER UNIT STORAGE
ADDI U,.DFUNI(D) ;INDEX TO BLOCK FOR THIS UNIT
PUSHJ P,C$CEOL ;CHECK FOR END OF LINE
SKIPA ;NOT YET
FATAL (BNR,CPOPJ,<Block number required>,)
CAIE T2," " ;ACCEPT A SPACE
CAIN T2,":" ;OR A COLON
CAIA ;EITHER WILL DO
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$DECI ;READ BLOCK NUMBER
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
MOVE P2,T1 ;COPY FOR LATER
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
MOVE T2,T1 ;FOR NEXT CALL
MOVE T1,.UNLUN(U) ;GET LOGICAL UNIT NUMBER
PUSHJ P,F$BLKS ;CONVERT TO BLOCK ON STRUCTURE
JRST [MOVE T1,P2 ;GET BLOCK ON UNIT
FATAL (IBU,CPOPJ,<Illegal block on unit; >,T$DECW)]
MOVE P1,T1 ;SAVE BLOCK ON STRUCTURE
IDIV T1,.DFBPC(D) ;DIVIDE BY BLOCKS PER CLUSTER
SKIPN T2 ;A REMAINDER?
SKIPA P3,T1 ;NO--COPY CFP
MOVNI P3,1 ;ELSE INVALID CFP
PUSHJ P,TRNDPY ;DISPLAY RESULTS
JRST CPOPJ1 ;RETURN
TRNUNH: ASCIZ \
The TRANSLATE UNIT command will convert a block number relative to
the specified unit, to a logical block on a structure. The specified
unit and block number could also represent a valid CFP, in which case
it the proper conversion will also be done. The command syntax is:
TRANSLATE UNIT u n
The unit and block numbers may be separated by either a space or a colon.
\
;TRANSLATE EXTENDED RIB ADDRESS
TRNXRA: PUSHJ P,STRCHK ;WAS STRUCTURE COMMAND GIVEN?
POPJ P, ;NO
PUSHJ P,TRNHWD ;READ A PAIR OF OCTAL HALF-WORDS
POPJ P, ;FAILED
MOVE R,P1 ;COPY XRA FOR SAFE KEEPING
PUSHJ P,T$CRLF ;START WITH A BLANK LINE
XMOVEI T1,[ASCIZ / Extended RIB address: /]
PUSHJ P,T$STRG ;PRINT TEXT
HLRZ T1,R ;GET LH
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
PUSHJ P,T$COMA ;SEPARATE
PUSHJ P,T$COMA ; ...
HRRZ T1,R ;GET RH
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
PUSHJ P,T$CRLF ;ONE MORE
XMOVEI T1,[ASCIZ / RIB number: /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,[POINT DESRBC,R,DENRBC] ;GET RIB NUMBER
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / Logical unit: /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,[POINT DESRBU,R,DENRBU] ;GET UNIT
PUSHJ P,T$DECW ;PRINT IT
CAMGE T1,.DFSTN(D) ;IS IT VALID?
JRST TRNXR1 ;YES
XMOVEI T1,[ASCIZ / (invalid)/]
PUSHJ P,T$STRG ;PRINT TEXT
TRNXR1: PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / Cluster address: /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,[POINT DESRBA,R,DENRBA] ;GET CLUSTER ADDRESS
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
TRNXR2: LDB T1,[POINT DESRBU,R,DENRBU] ;GET UNIT
CAML T1,.DFSTN(D) ;IS IT VALID?
POPJ P, ;NO--CAN DO NO MORE
LDB T2,[POINT DESRBA,R,DENRBA] ;GET CLUSTER ADDRESS
IMUL T2,.DFBPC(D) ;CONVERT TO BLOCK ON UNIT
MOVE P2,T2 ;SAE UNIT-RELATIVE BLOCK
PUSHJ P,F$BLKS ;CONVERT TO BLOCK ON STRUCTURE
JRST [MOVE T1,P2 ;COPY FAILING BLOCK
FATAL (IBU,CPOPJ,<Illegal block on unit; >,T$DECW)]
MOVE P1,T1 ;SAVE STRUCTURE-RELATIVE BLOCK
IDIV T1,.DFBPC(D) ;DIVIDE BY BLOCKS PER CLUSTER
SKIPN T2 ;A REMAINDER?
SKIPA P3,T1 ;NO--COPY CFP
MOVNI P3,1 ;ELSE INVALID CFP
PUSHJ P,TRNDPY ;DISPLAY RESULTS
JRST CPOPJ1 ;RETURN
TRNXRH: ASCIZ \
The TRANSLATE EXTENDED-RIB-ADDRESS command will convert a binary
extended RIB pointer into its component parts. The command syntax is:
TRANSLATE EXTENDED-RIB-ADDRESS n
where "n" is an octal quantity. Half-words may be specified by
separating the left and right half values with double colons (",,").
\
TRNDPY: PUSHJ P,T$CRLF ;START WITH A BLANK LINE
XMOVEI T1,[ASCIZ / Logical block /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,P1 ;GET LBN
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / Logical unit /]
SKIPN U ;UNIT VALID?
XMOVEI T1,[ASCIZ / Logical unit invalid/]
PUSHJ P,T$STRG ;PRINT TEXT
JUMPE U,TRNDP1 ;JUMP IF INVALID UNIT
MOVE T1,.UNLUN(U) ;GET LOGICAL UNIT NUMBER
PUSHJ P,T$DECW ;PRINT IT
XMOVEI T1,[ASCIZ /, block /]
SKIPGE P2 ;BLOCK VALID?
XMOVEI T1,[ASCIZ /, block invalid/]
PUSHJ P,T$STRG ;PRINT TEXT
JUMPL P2,TRNDP1 ;JUMP IF INVALID BLOCK
MOVE T1,P2 ;GET BLOCK ON UNIT
PUSHJ P,T$DECW ;PRINT IT
TRNDP1: PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / CFP /]
PUSHJ P,T$STRG ;PRINT IT
JUMPL P3,TRNDP2 ;JUMP IF A BAD CFP
MOVE T1,P3 ;GET CFP
JUSTIFY (R,6,"0",T$OCTW) ;PRINT CFP
JRST TRNDP3 ;ONWARD
TRNDP2: XMOVEI T1,[ASCIZ /invalid/]
PUSHJ P,T$STRG ;PRINT TEXT
TRNDP3: PUSHJ P,T$CRLF ;END LINE
PJRST T$CRLF ;ADD AN EXTRA CRLF AND RETURN
;READ A PAIR OF OCTAL HALF-WORDS
TRNHWD: PUSHJ P,C$OCTI ;READ A NUMBER
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
MOVE P1,T1 ;REMEMBER IT
PUSHJ P,C$CEOL ;CHECK FOR EOL
SKIPA ;NOT YET
JRST TRNHW1 ;DIDN'T USE ",," NOTATION
HRLZS P1 ;POSITION LH QUANTITY
CAIE T2,"," ;HALF-WORD SEPARATOR?
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$TYI ;GET NEXT CHARACTER
CAIE T1,"," ;RH ON THE WAY?
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$OCTI ;GET RH WORD
PJRST C$ENAS ;NO ARGUMENT SPECIFIED
TLNE T1,-1 ;OVERFLOW?
FATAL (HWO,CPOPJ,<Half-word overflow in specified data; >,T$OCTW)
HRR P1,T1 ;SAVE RESULT
TRNHW1: PUSHJ P,C$CEOL ;MUST BE EOL NOW
PJRST C$EEOL ;ERROR AT EOL
JRST CPOPJ1 ;RETURN WITH ANSWER IN P1
SUBTTL TYPE COMMAND
.TYPE: MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;INITIALIZE IT
PUSHJ P,C$CEOL ;AT END OF LINE?
SKIPA ;NO
FATAL (NIF,CPOPJ,<No input filespec>,)
;READ FILESPEC
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
MOVSI T3,(T1) ;GET RETURNED SCAN BLOCK
HRR T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
HRRZ T4,T3 ;POINT TO DESTINATION
ADD T4,.DFSBL(D) ;COMPUTE ENDING ADDRESS
BLT T3,-1(T4) ;COPY SCAN BLOCK
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
TYPE1: MOVEI T1,.IOASC ;MODE = ASCII
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;IOWD
PUSHJ P,F$INI ;INITIALIZE FOR FILE I/O
FATAL (IOF,CPOPJ,<I/O set up failed for >,T$FERR)
TYPE3: PUSHJ P,F$LKP ;FIND A FILE
JRST TYPE6 ;CAN'T
MOVE T1,.DFRSB(D) ;GET OFFSET TO RETURNED FILESPEC SCAN BLOCK
ADDI T1,(D) ;RELOCATE
INFO (FIL,.+1,<File >,T$FILE)
TYPE4: PUSHJ P,F$IBYT ;GET A CHARACTER
JRST TYPE5 ;CHECK ERRORS
SKIPE T1 ;IS IT A <NUL>?
PUSHJ P,T$CHAR ;NO--PRINT IT
JRST TYPE4 ;LOOP BACK FOR MORE CHARACTERS
TYPE5: CAIN T1,FEEOF% ;END OF FILE?
JRST TYPE7 ;YES
MOVE T2,.DFRSB(D) ;GET OFFSET TO RETURNED FILESPEC SCAN BLOCK
ADDI T2,(D) ;RELOCATE
WARN (ERF,TYPE7,<Error reading >,T$FERR)
TYPE6: CAIN T1,FENMF% ;NO MORE FILES?
PJRST F$FIN ;ALL DONE
CAIN T1,FEFNF% ;FILE NOT FOUND?
SKIPA T2,.DFINP(D) ;MUST USE INPUT SPEC
MOVE T2,.DFRSB(D) ;ELSE USE TRANSLATION SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (LKP,F$FIN,<LOOKUP failed for >,T$FERR)
TYPE7: PUSHJ P,F$CLOS ;CLOSE FILE
JFCL ;IGNORE ERRORS
JRST TYPE3 ;LOOP BACK FOR ANOTHER FILE
TYPHLP: ASCIZ \
The TYPE command will print the specified on the terminal. The
command syntax is:
TYPE filespec
"filespec" may be a wildcarded input file specification (the default).
\
SUBTTL WRITE COMMAND
.WRITE: MOVSI T1,(DF.PIP) ;BIT TO TEST
TDNN T1,.DFFLG(D) ;PATCH IN PROGRESS?
FATAL (NPI,CPOPJ,<No patch in progress>,)
PUSHJ P,C$CEOL ;AT END OF LINE?
SKIPA ;NO
FATAL (BNR,CPOPJ,<Block number required for writing>,)
PUSHJ P,C$DECI ;PARSE A BLOCK NUMBER
POPJ P, ;SYNTAX ERROR
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
PJRST PATWRT ;GO WRITE DATA TO DISK
WRTHLP: ASCIZ \
The WRITE command will cause the specified block to be written from
the patch buffer to disk. The command syntax is:
WRITE n
where "n" is the block number to write. The size of the transfer is
controlled by the SET PATCH-BUFFER-SIZE command.
\
SUBTTL ZERO COMMAND
.ZERO: PUSHJ P,SAVE1 ;SAVE P1
MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;INITIALIZE IT
PUSHJ P,C$CEOL ;AT END OF LINE?
SKIPA ;NO
FATAL (NIF,CPOPJ,<No input filespec>,)
;READ FILESPEC
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
MOVSI T3,(T1) ;GET RETURNED SCAN BLOCK
HRR T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
HRRZ T4,T3 ;POINT TO DESTINATION
ADD T4,.DFSBL(D) ;COMPUTE ENDING ADDRESS
BLT T3,-1(T4) ;COPY SCAN BLOCK
PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
PUSHJ P,ZERINP ;PROCESS INPUT SPEC
POPJ P, ;DO NOT ZERO FILE
MOVSI P1,(DF.ZRS) ;OK TO ZERO RIBSIZ IF REQUESTED
ZERO1: MOVEI T1,.IOIMG ;MODE = IMAGE
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;IOWD
PUSHJ P,F$INI ;INITIALIZE FOR FILE I/O
FATAL (IOF,CPOPJ,<I/O set up failed for >,T$FERR)
PUSHJ P,F$LKP ;FIND A FILE
JRST ZERO3 ;CAN'T
MOVE T1,[CPYBUF,,CPYBUF+1] ;SET UP BLT
SETZM CPYBUF ;CLEAR FIRST WORD
BLT T1,CPYBUF+BLKSIZ-1 ;CLEAR OUT BUFFER
ZERO2: PUSHJ P,F$OBUF ;WRITE A BLOCK
CAIA ;FAILED
JRST ZERO2 ;LOOP FOR ALL BLOCKS
CAIN T1,FEEOF% ;END OF FILE?
INFO (ZER,ZERO5,<>,E..ZER) ;YES
MOVE T2,.DFRSB(D) ;GET OFFSET TO RETURNED FILESPEC SCAN BLOCK
ADDI T2,(D) ;RELOCATE
WARN (EWF,ZERO4,<Error writing >,T$FERR)
ZERO3: MOVE T2,.DFINP(D) ;GET OFFSET TO INPUT FILESPEC SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (LKP,F$FIN,<LOOKUP failed for >,T$FERR)
ZERO4: MOVEI P1,0 ;DON'T RESET RIBSIZ ON ERRORS
ZERO5: TDNN P1,.DFFLG(D) ;WANT TO ZERO RIBSIZ?
JRST ZERO7 ;NO
SETZM .FWRIB+RIBSIZ(F) ;ZERO WORDS WRITTEN
MOVE T1,.FWPRM(F) ;GET DISK ADDRESS OF TARGET
PUSHJ P,F$BLKU ;SETUP U
JRST ZERO7 ;ILLEGAL BLOCK??
MOVSI T2,-BLKSIZ ;-VE LENGTH OF BUFFER
HRRI T2,.FWRIB-1(F) ;MAKE AN IOWD
PUSHJ P,U$WRIT ;READ A RIB
JRST ZERO6 ;PROBABLY I/O ERROR
JRST ZERO7 ;CONTINUE
ZERO6: MOVE T2,.DFRSB(D) ;GET OFFSET TO RETURNED SCAN BLOCK
ADDI T2,(D) ;RELOCATE
WARN (EZR,ZERO7,<Error zeroing RIBSIZ for >,T$FERR)
ZERO7: PUSHJ P,F$CLOS ;CLOSE FILE
JFCL ;IGNORE ERRORS
PUSHJ P,F$FIN ;CLEAN UP
JRST CPOPJ1 ;RETURN
E..ZER: MOVE T1,.DFRSB(D) ;GET OFFSET TO RETURNED FILESPEC SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,T$FILE ;PRINT FILESPEC
XMOVEI T1,[ASCIZ / zeroed/]
PJRST T$STRG ;PRINT TEXT AND RETURN
ZERHLP: ASCIZ \
The ZERO command will cause the contents of the specified file to be
zeroed. A data file or a directory can be specified. The command
syntax is:
ZERO filespec
Note that wildcards are not allowed.
\
;PROCESS INPUT SPEC
ZERINP: MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,F$FSCN ;RESOLVE DEVICE/DIRECTORY INFO
JRST ZERIN6 ;FAILED
MOVE T2,.SBFLG(T1) ;GET FLAGS
TLNE T2,(SB.WLD) ;WILDCARDS?
FATAL (WFI,CPOPJ,<Wildcarded filespec illegal; >,T$FILE)
;CHECK OUT TYPE OF FILE
ZERIN1: TLNN T2,(SB.NAM!SB.EXT) ;HAVE A FILE NAME OR EXTENSION?
JRST ZERIN2 ;NO--POSSIBLY A DIRECTORY
TLNE T2,(SB.NAM) ;MUST HAVE A FILE NAME
TLNN T2,(SB.EXT) ;AND AN EXTENSION TOO
FATAL (FEM,CPOPJ,<Filename and extension missing; >,T$FILE)
HLRZ T2,.SBEXT(T1) ;GET EXTENSION
CAIE T2,'UFD' ;USER-FILE DIRECTORY?
CAIN T2,'SFD' ;SUB-FILE DIRECTORY?
JRST ZERIN4 ;YES--SEE IF USER REALLY WANTS TO DO THIS
JRST ZERIN5 ;ELSE EVERYTHING ELSE IS PROBABLY OK
;HERE WHEN A POSSIBLE DIRECTORY HAS BEEN SPECIFIED
ZERIN2: TLNN T2,(SB.DIR) ;A DIRECTORY MUST BE SPECIFIED
FATAL (NDS,CPOPJ,<No directory specified in filespec; >,T$FILE)
MOVEI T2,.SBDIR(T1) ;POINT TO START OF PATH
ZERIN3: SKIPN 0(T2) ;DIRECTORY COMPONENT SPECIFIED?
SKIPE 1(T2) ;NO--END OF PATH?
AOJA T2,[AOJA T2,ZERIN3] ;SEARCH FOR END
SUBI T2,2 ;BACK OFF TO LAST COMPONENT
SETZ T3, ;CLEAR AC
EXCH T3,0(T2) ;GET DIRECTORY COMPONENT, ZERO STORAGE
MOVEM T3,.SBNAM(T1) ;STORE AS FILE NAME
SETZ T3, ;CLEAR AC
EXCH T3,1(T2) ;GET MASK, ZERO STORAGE
MOVEM T3,.SBNMM(T1) ;STORE IT TOO
HRLOI T3,'UFD' ;ASSUME A UFD
CAIE T2,.SBDIR(T1) ;AT THE BEGINING (PPN)?
HRLI T3,'SFD' ;NO--MUST BE AN SFD
MOVEM T3,.SBEXT(T1) ;STORE EXTENSION & MASK
MOVE T3,.DFMFD(D) ;GET MFD PPN
CAIN T2,.SBDIR(T1) ;AT THE BEGINING (PPN)?
MOVEM T3,.SBDIR(T1) ;YES--STORE MFD FOR PPN
SETOM .SBDIM(T1) ;MAKE SURE MASK IS SET FOR PPN COMPONENT
MOVSI T2,(SB.NAM!SB.EXT) ;GET DESCRIPTIVE BITS
IORM T2,.SBFLG(T1) ;SAY THE USER TYPED THESE THINGS
;MAKE SURE THE USER REALLY WANTS TO BLOW AWAY A DIRECTORY
ZERIN4: WARN (ZDR,.+1,<Specified file is a directory; >,T$FILE)
WARN (ABL,.+1,<Allocated blocks will become "lost">,)
MOVEI T1,[ASCIZ / Proceed/]
MOVEI T2,0 ;ASSUME "NO"
PUSHJ P,C$AYNQ ;ASK YES/NO QUESTION
JUMPE T2,CPOPJ ;DO NOTHING IF "NO"
;END IF INPUT SPEC PROCESSING
ZERIN5: JRST CPOPJ1 ;RETURN WITH SCAN BLOCK IN T1
;FATAL ERROR FROM F$FSCN
ZERIN6: MOVE T2,.DFINP(D) ;GET OFFSET TO INPUT FILESPEC SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (LKP,F$FIN,<LOOKUP failed for >,T$FERR)
SUBTTL COMMAND SCANNING -- C$ATOM - READ INTO ATOM BUFFER
C$ATOM: PUSH P,T2 ;SAVE T2
MOVE T1,[CMDATB,,CMDATB+1] ;SET UP BLT
SETZB T2,CMDATB ;CLEAR FIRST WORD
BLT T1,CMDATB+ATMWDS-1 ;CLEAR BUFFER
MOVEI T1,ATMWDS*5-1 ;MAXIMUM LENGTH
MOVEM T1,CMDATC ;SAVE COUNT
MOVE T1,[POINT 7,CMDATB] ;BYTE POINTER TO STORAGE
MOVEM T1,CMDATP ;SAVE IT
MOVE T1,[POINT 6,T2] ;BYTE POINTER TO TEMP SIXBIT STORAGE
MOVEM T1,CMDAT6 ;SAVE
PUSHJ P,C$SKIP ;SKIP LEADING SPACES AND TABS
CAIA ;ENTER LOOP
CATOM1: PUSHJ P,C$TYI ;READ A CHARACTER
CAIN T1,"-" ;ALLOW DASHES
JRST CATOM2 ;GO STORE
CAIL T1,"0" ;RANGE
CAILE T1,"9" ; CHECK
CAIL T1,"A" ; THE
CAILE T1,"Z" ; CHARACTER
JRST CATOM4 ;NO GOOD--FINISH UP
CATOM2: SOSGE CMDATC ;COUNT DOWN
FATAL (ABO,CATOM3,<Atom buffer overflow>,)
IDPB T1,CMDATP ;STORE CHARACTER
SUBI T1,40 ;CONVERT TO SIXBIT
TRNN T2,77 ;WORD FULL?
IDPB T1,CMDAT6 ;STORE SIXBIT CHARACTER
JRST CATOM1 ;LOOP BACK FOR MORE
CATOM3: SETZB T2,CMDATB ;ZAP BUFFER
CATOM4: MOVEM T2,CMDAT6 ;SAVE SIXBIT RESULT
POP P,T2 ;RESTORE T2
SKIPE CMDATB ;HAVE ANY INPUT?
AOS (P) ;YES--SKIP
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$AYNQ - ASK A YES/NO QUESTION
;ASK A YES/NO QUESTION
;CALL: MOVE T1, PROMPT STRING
; MOVE T2, DEFAULT (0-NO, 1-YES)
; PUSHJ P,C$AYNQ
C$AYNQ: PUSH P,T1 ;SAVE PROMPT STRING
ANDI T2,1 ;MAKE SURE NO JUNK OFFSETS
PUSH P,T2 ;SAVE DEFAULT TABLE OFFSET
XMOVEI T2,YNQKEY+1 ;POINT TO FIRST DATA WORD IN OPTION TABLE
ADD T2,(P) ;OFFSET INTO THE TABLE
MOVE T2,(T2) ;POINT TO THE STRING ITSELF
MOVEM T2,(P) ;SAVE ADDRESS ON STACK
CAYNQ1: PUSH P,T3 ;SAVE T3
XMOVEI T1,T$STRG ;OUTPUT ROUTINE
XMOVEI T2,YNQKEY ;OPTION TABLE
MOVE T3,-1(P) ;GET DEFAULT STRING
PUSHJ P,C$OPTN ;SET OPTION PARAMETERS
POP P,T3 ;RESTORE T3
MOVE T1,-1(P) ;GET PROMPT STRING BACK
PUSHJ P,C$READ ;READ A COMMAND LINE
JFCL ;CAN NEVER FAIL SINCE DEFAULT ALWAYS GIVEN
PUSHJ P,C$ATOM ;GET ANSWER
FATAL (NKS,CAYNQ1,<No keyword specified>,)
PUSHJ P,C$CEOL ;CHECK FOR EOL
JRST [PUSHJ P,C$EEOL ;ERROR AT EOL
JRST CAYNQ1] ;TRY AGAIN
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
XMOVEI T2,YNQKEY ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
JRST [PUSHJ P,C$EKEY ;FAILED
JRST CAYNQ1] ;TRY AGAIN
SUBI T2,1 ;ADJUST RELATIVE TO FIRST DATA WORD
POP P,(P) ;PHASE
POP P,(P) ; STACK
POPJ P, ;RETURN
YNQKEY: XWD -2,0 ;-VE LENGTH,,TYPE=KEYWORD
IFIW [ASCIZ /NO/]
IFIW [ASCIZ /YES/]
SUBTTL COMMAND SCANNING -- C$BACK - BACK UP THE BYTE PONTER
;BACKUP UP THE COMMAND LINE BYTE POINTER
C$BACK: MOVE T1,CMDPTR ;GET THE BYTE POINTER
ADD T1,[70000,,0] ;BACKUP 1 CHARACTER
SKIPG T1 ;OVER A WORD BOUNDRY?
SUB T1,[430000,,1] ;YES--BACKUP A WORD
MOVEM T1,CMDPTR ;SAVE UPDATED POINTER
PJRST C$CURR ;GO LOAD THE NOW "CURRENT" CHARACTER
SUBTTL COMMAND SCANNING -- C$TYI - READ A CHARACTER
;GET A CHARACTER FROM THE TEXT BUFFER
;CALL: PUSHJ P,C$TYI TO GET A CHARACTER WITH CONVERSIONS
; PUSHJ P,C$TYIN TO GET A CHARACTER WITH NO CONVERSIONS
;
;ON RETURN, T1:= CHARACTER OR 0 IF EOL
C$TYI: TDZA T1,T1 ;INDICATE CONVERSIONS
C$TYIN: MOVEI T1,1 ;INDICATE NO CONVERSIONS
MOVEM T1,CMDCNV ;SAVE CONVERSION FLAG
SETZM CMDEOL ;CLEAR SEARCH FOR EOL FLAG
CTYI1: SETZ T1, ;INCASE OF EOL
SOSG CMDCTR ;COUNT CHARACTERS
POPJ P, ;EOL
ILDB T1,CMDPTR ;GET A CHARACTER
SKIPE CMDEOL ;SEARCHING FOR EOL?
JRST CTYI2 ;YES
CAIE T1,";" ;OLD STYLE COMMENT?
CAIN T1,"!" ;NEW STYLE COMMENT?
SETOM CMDEOL ;YES--START SEARCHING FOR EOL
SKIPE CMDCNV ;WANT CONVERSIONS?
JRST CTYI3 ;NO
CTYI2: CAIN T1,11 ;TAB?
MOVEI T1," " ;YES--CONVERT TO A SPACE
CAIG T1,"Z"+40 ;CHECK FOR A LOWER CASE
CAIGE T1,"A"+40 ; CHARACTER THAT NEEDS TO BE
SKIPA ; CONVERTED TO AN UPPER CASE
TRZ T1," " ; CHARACTER
CTYI3: SKIPE CMDEOL ;SEARCHING FOR EOL
JUMPG T1,CTYI1 ;YES--KEEP LOOKING
POPJ P, ;NO--RETURN
SUBTTL COMMAND SCANNING -- C$CEOL - CHECK FOR END OF LINE
;CHECK FOR EOL
C$CEOL: PUSH P,T1 ;SAVE T1
PUSHJ P,C$CURR ;GET CURRENT CHARACTER
JUMPE T1,CCEOL1 ;ALREADY AT EOL?
PUSHJ P,C$SKIP ;EAT LEADING SPACES AND TABS
PUSHJ P,C$BACK ;BACKUP THE BYTE POINTER
SKIPG T1 ;CHECK FOR EOL
CCEOL1: AOS -1(P) ;IT'S NOT--SKIP
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$CURR - GET CURRENT CHARACTER
C$CURR: MOVE T1,[POINT 7,CMDBUF] ;GET INITIAL BYTE POINTER
CAMN T1,CMDPTR ;VIRGIN?
IBP CMDPTR ;YES--ADVANCE POINTER
LDB T1,CMDPTR ;GET CURRENT CHARACTER
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$FILE - PARSE A FILESPEC
C$FILE: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,.DFCMD(D) ;GET OFFSET TO COMMAND SCAN BLOCK
ADDI P1,(D) ;RELOCATE
SETZ P2, ;INIT FLAGS
MOVE T1,P1 ;POINT TO SCAN BLOCK
PUSHJ P,C$ZFIL ;ZERO IT OUT
PUSHJ P,C$CURR ;GET CURRENT CHARACTER
JUMPE T1,CFILX ;RETURN IF NO INPUT
CAIE T1,11 ;TAB?
CAIN T1," " ;SPACE?
PUSHJ P,C$SKIP ;SKIP LEADING SPACES AND TABS
JUMPE T1,CFILX ;RETURN IF NO INPUT
PUSHJ P,C$BACK ;ELSE BACK UP THE BYTE POINTER
CFIL1: PUSHJ P,C$SIXQ ;GET A FILESPEC PART
JUMPN T1,CFIL4 ;SEE WHAT WE GOT
CFIL2: CAIN T3,"." ;AN EXTENSION?
JRST CFIL5 ;YES
CAIE T3,"[" ;A PATH?
CAIN T3,"<" ;2741 STYLE?
JRST CFIL6 ;YES TO EITHER
CAIN T3," " ;SPACE?
JRST CFIL1 ;KEEP SCANNING
TLZE P2,(SB.DFF) ;DIRECTORY/FILE NAME FIXUP?
TLO P2,(SB.DIR) ;YES--MAKE DEFAULTED DIRECTORY STICK
CFILX: MOVEM P2,.SBFLG(P1) ;SAVE FLAGS
MOVE T1,P1 ;POINT TO SCAN BLOCK
MOVEI T2,(T3) ;COPY TERMINATING CHARACTER
JRST CPOPJ1 ;RETURN
;DEVICE
CFIL3: TLOE P2,(SB.DEV) ;ALREADY HAVE A DEVICE?
FATAL (DDI,CPOPJ,<Double device illegal; >,T$SIXN)
MOVEM T1,.SBDEV(P1) ;SAVE DEVICE
MOVEM T2,.SBDVM(P1) ;SAVE DEVICE MASK
TLNN P2,(SB.NAM) ;ALREADY HAVE A FILE NAME?
TLO P2,(SB.GDV) ;NO--REMEMBER GLOBAL DEVICE
PUSHJ P,CFILW ;CHECK FOR WILDCARDS
JRST CFIL1 ;KEEP SCANNING
;FILE NAME
CFIL4: CAIN T3,":" ;A DEVICE?
JRST CFIL3 ;YES
TLOE P2,(SB.NAM) ;ALREADY HAVE A FILE NAME?
FATAL (DFI,CPOPJ,<Double file name illegal; >,T$SIXN)
MOVEM T1,.SBNAM(P1) ;SAVE FILE NAME
MOVEM T2,.SBNMM(P1) ;SAVE FILE NAME MASK
TLNN P2,(SB.DEV!SB.EXT!SB.DIR) ;ALREADY HAVE OTHER PARTS?
TLO P2,(SB.GNM) ;NO--REMEMBER GLOBAL FILE NAME
PUSHJ P,CFILW ;CHECK FOR WILDCARDS
JRST CFIL2 ;GO EXAMINE TERMINATOR
;EXTENSION
CFIL5: PUSHJ P,C$SIXQ ;GET A WORD
TLOE P2,(SB.EXT) ;ALREADY HAVE AN EXTENSION
FATAL (DEI,CPOPJ,<Double extension illegal; >,T$SIXN)
HLLZM T1,.SBEXT(P1) ;SAVE EXTENSION
HLRM T2,.SBEXT(P1) ;SAVE EXTENSION MASK
TLNN P2,(SB.NAM) ;ALREADY HAVE A FILE NAME?
TLO P2,(SB.GEX) ;NO--REMEMBER GLOBAL EXTENSION
PUSHJ P,CFILW ;CHECK FOR WILDCARDS
CAMN T1,[SIXBIT /UFD/] ;A UFD EXTENSION?
TLNE P2,(SB.NAM) ; AND NO FILE NAME?
JRST CFIL2 ;NO--CAN'T FUDGE UP SCAN BLOCK
HLRZ T1,P2 ;GET SCAN BLOCK LENGTH
MOVEI T2,.SBMIN(P1) ;GET ADDRESS OF FIRST SFD
CAIG T1,.SBMIN ;SCAN BLOCK INCLUDE SFDS?
MOVEI T2,[EXP 0] ;NO--FAKE OUT NEXT INSTRUCTION
SKIPE (T2) ;DO WE HAVE ANY SFDS?
JRST CFIL2 ;YES
MOVE T1,.SBDIR(P1) ;GET DIRECTORY
MOVE T2,.SBDIM(P1) ;GET DIRECTORY MASK
MOVEM T1,.SBNAM(P1) ;SAVE AS FILE NAME
MOVEM T2,.SBNMM(P1) ;SAVE AS FILE NAME MASK
MOVE T1,.DFMFD(D) ;GET MFD PPN
MOVEM T1,.SBDIR(P1) ;SAVE AS DIRECTORY
SETOM .SBDIM(P1) ;SAVE MASK TOO
TLZ P2,(SB.DIR!SB.GNM!SB.GDI) ;CLEAR FILE NAME AND DIRECTORY
TLO P2,(SB.DFF!SB.NAM) ;HAVE FILE NAME, BUT CAN OVERRIDE PPN
JRST CFIL2 ;GO EXAMINE TERMINATOR
;PATH
CFIL6: TLOE P2,(SB.DIR) ;ALREADY HAVE A DIRECTORY?
FATAL (DDI,CPOPJ,<Double directory illegal>,)
PUSHJ P,C$SKIP ;EAT LEADING SPACES AND TABS
CAIN T1,"-" ;WANT DEFAULT PATH?
JRST CFIL8 ;YES
PUSHJ P,C$BACK ;BACKUP THE BYTE POINTER
PUSHJ P,C$OCTW ;GET PROJECT NUMBER
PUSHJ P,CFLCPJ ;CHECK FOR PROJECT DEFAULTING
HLLZM T1,.SBDIR(P1) ;SAVE IT
HLLZM T2,.SBDIM(P1) ;SAVE MASK
PUSHJ P,CFILW ;CHECK FOR WILDCARDS
CAIE T3,"," ;MUST HAVE A COMMA HERE
FATAL (CDR,CPOPJ,<Comma required in directory>,)
PUSHJ P,C$OCTW ;GET PROGRAMMER NUMBER
PUSHJ P,CFLCPG ;CHECK FOR PPN DEFAULTING
HLRM T1,.SBDIR(P1) ;SAVE IT
HLRM T2,.SBDIM(P1) ;SAVE MASK
PUSHJ P,CFILW ;CHECK FOR WILDCARDS
MOVN P4,.DFSBL(D) ;GET SCAN BLOCK LENGTH
ADDI P4,.SBMIN ;COMPUTE LENGTH OF DIRECTORY/MASK WORDS
HRLI P4,.SBMIN(P1) ;POINT TO START OF FREE BLOCK
MOVSS P4 ;MAKE AN AOBJN POINTER
CAIE T3,"," ;SFDS ON THE WAY?
JRST CFIL9 ;NO
CFIL7: PUSHJ P,C$SIXQ ;GET AN SFD
SKIPN T1 ;HAVE SOMETHING?
FATAL (NSF,CPOPJ,<Null SFD illegal>,)
MOVEM T1,0(P4) ;SAVE IT
MOVEM T2,1(P4) ;SAVE MASK
PUSHJ P,CFILW ;CHECK FOR WILDCARDS
AOBJN P4,.+1 ;ACCOUNT FOR TWO WORD PAIRS
CAIE T3,"," ;LEGAL SEPARATOR?
JRST CFIL9 ;NO
AOBJN P4,CFIL7 ;LOOP
MOVE T1,.DFSBL(D) ;GET SCAN BLOCK LENGTH
SUBI T1,.SBMIN ;COMPUTE SFD PAIRS
LSH T1,-1 ;DIVIDE BY TWO
FATAL (SND,CPOPJ,<SFDs nested deeper than >,T$DECW)
CFIL8: TLO P2,(SB.DPT) ;REQUEST DEFAULT PATH FIXUP
PUSHJ P,C$SKIP ;EAT SPACES AND TABS
MOVE T3,T1 ;GET CHARACTER
JRST CFIL10 ;CHECK FOR END OF PATH DELIMITER
CFIL9: AOBJP P4,CFIL10 ;PARSED THE LOWEST LEVEL SFD?
SETOM 1(P4) ;SET MASK
AOBJN P4,CFIL9 ;LOOP FOR REMAINING LEVELS
CFIL10: JUMPE T3,CFIL2 ;END OF LINE?
CAIE T3,"]" ;END OF PATH?
CAIN T3,">" ;2741 STYLE?
JRST CFIL1 ;YES--LOOP BACK FOR MORE
JRST CFIL2 ;NO--CHECK OTHER TERMINATORS
;CHECK FOR PROJECT DEFAULTING
CFLCPJ: CAIE T3,"/" ;USING LOGGED-IN RATHER THAN CURRENT PPN?
JRST CFLCJ1 ;NO
TLO P2,(SB.DLP) ;REMEMBER IT
MOVEI T3,"," ;AND CHANGE TO CONVENTIONAL DELIMITER
CFLCJ1: SKIPE CMDNUL ;ANYTHING TYPED?
POPJ P, ;YES--USE WHAT WE HAVE
TLO P2,(SB.DCP) ;REQUEST DEFAULT FIXUP
SETZ T1, ;NO PPN HALF-WORD
MOVSI T2,-1 ;BUT RETURN A NON-WILD MASK
POPJ P, ;AND RETURN
;CHECK FOR PROGRAMMER DEFAULTING
CFLCPG: SKIPE CMDNUL ;ANYTHING TYPED?
JRST CFLCG1 ;YES
TLO P2,(SB.DCP) ;REQUEST DEFAULT FIXUP
SETZ T1, ;NO PPN HALF-WORD
MOVSI T2,-1 ;BUT RETURN A NON-WILD MASK
CFLCG1: TLNN P2,(SB.DCP) ;DEFAULTING SOME PART OF THE PPN?
POPJ P, ;NO--JUST RETURN
TLNE P2,(SB.DLP) ;WAS THE LOGGED-IN PPN SPECIFIED?
TLZ P2,(SB.DCP) ;THEN KEEP ONLY THAT BIT
POPJ P, ;AND RETURN
;CHECK FOR WILDCARDS AND LITE SB.WLD IF NECESSARY
CFILW: SKIPE CMDWLD ;WILDCARDED?
TLO P2,(SB.WLD) ;YES
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$DFIL - DEFAULT A SCAN BLOCK
;APPLY DEFAULTS TO A SCAN BLOCK
;CALL: MOVE T1, DEFAULT SCAN BLOCK ADDRESS
; MOVE T2, DEFAULT SCAN BLOCK LENGTH
; MOVE T3, TARGET SCAN BLOCK ADDRESS
; PUSHJ P,C$DFIL
C$DFIL: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;COPY DEFAULT SCAN BLOCK ADDRESS
MOVE P2,T2 ;COPY DEFAULT SCAN BLOCK LENGTH
MOVE P3,T3 ;COPY TARGET SCAN BLOCK ADDRESS
;DEVICE
CDFIL1: CAIGE P2,.SBDVM ;DEFAULT BLOCK LONG ENOUGH?
POPJ P, ;NO--RETURN
MOVSI P4,(SB.DEV) ;BIT TO TEST
TDNE P4,.SBFLG(P1) ;DEFAULT DEVICE?
TDNE P4,.SBFLG(P3) ;AND WAS WAS SPECIFIED?
JRST CDFIL2 ;SKIP THIS
IORB P4,.SBFLG(P3) ;UPDATE FLAGS
MOVS T1,.SBDEV(P1) ;DEFAULT DEVICE NAME
CAIN T1,'TTY' ;IS IT THE CONTROLLING TERMINAL?
TLNN P4,(SB.NAM!SB.EXT!SB.DIR) ;BUT WERE OTHER COMPONENTED GIVEN?
CAIA ;USE SPECIFIED DEFAULT
MOVEI T1,'DSK' ;ELSE SUBSTITUTE GENERIC DISK
MOVSM T1,.SBDEV(P3)
MOVE T1,.SBDVM(P1) ;DEFAULT DEVICE MASK
MOVEM T1,.SBDVM(P3)
;FILE NAME
CDFIL2: CAIGE P2,.SBNMM ;DEFAULT BLOCK LONG ENOUGH?
POPJ P, ;NO--RETURN
MOVSI P4,(SB.NAM) ;BIT TO TEST
TDNE P4,.SBFLG(P1) ;DEFAULT FILE NAME?
TDNE P4,.SBFLG(P3) ;AND WAS WAS SPECIFIED?
JRST CDFIL3 ;SKIP THIS
IORM P4,.SBFLG(P3) ;UPDATE FLAGS
MOVE T1,.SBNAM(P1) ;DEFAULT FILE NAME
MOVEM T1,.SBNAM(P3)
MOVE T1,.SBNMM(P1) ;DEFAULT FILE NAME MASK
MOVEM T1,.SBNMM(P3)
;EXTENSION
CDFIL3: CAIGE P2,.SBEXT ;DEFAULT BLOCK LONG ENOUGH?
POPJ P, ;NO--RETURN
MOVSI P4,(SB.EXT) ;BIT TO TEST
TDNE P4,.SBFLG(P1) ;DEFAULT EXTENSION?
TDNE P4,.SBFLG(P3) ;AND WAS WAS SPECIFIED?
JRST CDFIL4 ;SKIP THIS
IORM P4,.SBFLG(P3) ;UPDATE FLAGS
MOVE T1,.SBEXT(P1) ;DEFAULT EXTENSION,,MASK
MOVEM T1,.SBEXT(P3)
;DIRECTORY
CDFIL4: CAIGE P2,.SBDIM ;DEFAULT BLOCK LONG ENOUGH?
POPJ P, ;NO--RETURN
MOVSI P4,(SB.DIR) ;BIT TO TEST
TDNE P4,.SBFLG(P1) ;DEFAULT DIRECTORY?
TDNE P4,.SBFLG(P3) ;AND WAS WAS SPECIFIED?
POPJ P, ;SKIP THIS
IORM P4,.SBFLG(P3) ;UPDATE FLAGS
MOVE T1,.SBDIR(P1) ;GET THE PPN
MOVE T2,.SBDIM(P1) ;AND THE MASK
MOVEM T1,.SBDIR(P3) ;SAVE THE PPN
MOVEM T2,.SBDIM(P3) ;AND THE MASK
ADDI P1,.SBMIN ;OFFSET TO START OF SFDS IN DEFAULT BLOCK
ADDI P3,.SBMIN ;OFFSET TO START OF SFDS IN TARGET BLOCK
SUBI P2,.SBMIN ;LEAVE ONLY THE SFD WORD PAIRS
CDFIL5: MOVE T1,0(P1) ;GET SFD NAME
MOVE T2,1(P1) ;AND THE MASK
MOVEM T1,0(P3) ;SAVE THE NAME
MOVEM T2,1(P3) ;AND THE MASK
ADDI P1,2 ;ADVANCE DEFAULT BLOCK POINTER
ADDI P3,2 ;ADVANCE TARGET BLOCK POINTER
SUBI P2,1 ;ACCOUNT FOR WORD PAIRS
SOJG P2,CDFIL5 ;LOOP FOR REMAINING SFD WORD PAIRS
POPJ P, ;AND RETURN
SUBTTL COMMAND SCANNING -- C$ZFIL - ZERO OUT A SCAN BLOCK
;ZERO (INITIALIZE) A SCAN BLOCK
;CALL: MOVE T1, SCAN BLOCK ADDRESS
; PUSHJ P,C$ZFIL
C$ZFIL: MOVSI T2,(T1) ;STARTING ADDRESS
HRRI T2,1(T1) ;MAKE A BLT POINTER
MOVE T3,T1 ;GET ADDRESS AGAIN
ADD T3,.DFSBL(D) ;COMPUTE END
SETZM (T1) ;CLEAR FIRST WORD
BLT T2,-1(T3) ;CLEAR SCAN BLOCK
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$HELP - TREE STRUCTURED HELP PROCESSOR
C$HELP: PUSHJ P,C$SAVE ;SAVE THE CURRENT COMMAND TABLE POINTERS
PUSHJ P,C$CEOL ;AT EOL?
SKIPA ;NO--POSSIBLY WANTS SOMETHING SPECIFIC
JRST CHELP5 ;DUMP TABLE
CHELP1: PUSHJ P,C$ATOM ;READ A POSSIBLE KEYWORD
WARN (ILC,CHELP5,<Illegal character; >,T$FCHR)
XMOVEI T1,CMDATB ;INCASE OF ERROR
SKIPN CMDNAM ;HAVE A KEYWORD NAME TABLE?
WARN (NHA,CPOPJ,<No help is available for >,E..UNK)
CHELP2: XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
MOVE T2,CMDNAM ;AND TO KEYWORDS
PUSHJ P,C$KEYW ;CHECK FOR A MATCH
SKIPA ;FAILED
JRST CHELP3 ;NO ERRORS
HRRZ T3,CMDTBL ;GET COMMAND TABLE
CAIN T3,MAIN.T ;TOP LEVEL?
JRST [XMOVEI T1,HELP.T ;TRY THE "TOPIC" TABLE
PUSHJ P,C$TSET ;SET UP COMMAND TABLES
JRST CHELP2] ;AND TRY AGAIN
SKIPE T2 ;SKIP IF UNKNOWN
WARN (AMB,CHELP5,<Ambiguous topic >,E..AMB)
WARN (UNK,CHELP5,<Unknown topic >,E..UNK)
CHELP3: PUSHJ P,C$CEOL ;AT EOL?
SKIPA ;NO--DIG DEEPER
JRST CHELP4 ;GO PUT OUT INFORMATION FOR THIS LEVEL
XMOVEI T1,CMDATB ;POINT TO ATOM BUFFER
SKIPN CMDNXT ;HAVE ANOTHER TABLE?
WARN (NHA,CPOPJ,<No help available for >,E..UNK)
MOVE T1,CMDNXT ;GET NEXT TABLE ADDRESS
ADDI T1,(T2) ;OFFSET BY KEYWORD INDEX
MOVE T1,(T1) ;FETCH NEW COMMAND TABLE POINTER
PUSHJ P,C$TSET ;SET IT UP
JRST CHELP1 ;AND LOOP BACK FOR MORE INPUT
CHELP4: MOVE T1,CMDHLP ;POINT TO EXTENDED HELP TEXT TABLE
ADDI T1,(T2) ;OFFSET BY KEYWORD INDEX
MOVE T1,(T1) ;FETCH STRING ADDRESS
PUSHJ P,T$STRG ;PRINT IT
PUSHJ P,T$CRLF ;PUT OUT A BLANK LINE
SKIPN T1,CMDNXT ;SEE IF AN ADDITIONAL TABLE
POPJ P, ;NO MORE
ADDI T1,(T2) ;OFFSET BY KEYWORD INDEX
SKIPE T1,(T1) ;FETCH NEW COMMAND TABLE POINTER
CAMN T1,[IFIW] ;IS THERE REALLY ONE THERE?
POPJ P, ;END OF THE ROAD
PUSHJ P,C$TSET ;SET UP NEW TABLES
XMOVEI T1,[ASCIZ /Additional help is available for/]
PJRST C$HLPT ;PRINT SHORT TABLE DRIVEN HELP AND RETURN
CHELP5: XMOVEI T1,[ASCIZ /Help is available for/]
PUSHJ P,C$HLPT ;PRINT SHORT TABLE DRIVEN HELP
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$HLPT - TABLE DRIVEN HELP
C$HLPT: PUSHJ P,SAVE4 ;SAVE SOME ACS
SKIPN P1,CMDNAM ;POINT TO TABLE
WARN (NHA,CPOPJ,<No help is available>)
PUSHJ P,T$CRLF ;START WITH A BLANK LINE
PUSHJ P,T$STRG ;PRINT INTRODUCTORY TEXT
PUSHJ P,T$CRLF ;APPEND A CRLF
PUSHJ P,T$CRLF ;ONE MORE
MOVE T1,[PUSHJ P,T$JUST] ;CALL TO JUSTIFY
MOVEM T1,CMDJST+0 ;SAVE
XMOVEI T1,T$STRG ;SUBROUTINE TO USE
MOVEM T1,CMDJST+1 ;SAVE
MOVEI T1," " ;PAD CHARACTER
MOVEM T1,CMDJST+2 ;SAVE
HLLZ P2,(P1) ;GET LENGTH OF KEYWORD TABLE
AOS P1 ;POINT TO FIRST ENTRY
SETZ P3, ;INIT LENGTH OF LONGEST STRING
CHLPT1: SETZ P4, ;INIT LENGTH OF THIS STRING
MOVE T1,(P1) ;POINT TO A STRING
HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
CHLPT2: ILDB T2,T1 ;GET A CHARACTER
SKIPE T2 ;END OF STRING?
AOJA P4,CHLPT2 ;COUNT THEM UP
CAILE P4,(P3) ;THIS STRING LONGER?
MOVEI P3,(P4) ;YES--REMEMBER NEW LENGTH
AOS P1 ;ADVANCE POINTER
AOBJN P2,CHLPT1 ;LOOP FOR ALL KEYWORDS
ADDI P3,6 ;ACCOUNT FOR 6 SPACES BETWEEN COLUMNS
HRLM P3,CMDJST+2 ;SAVE JUSTIFICATION COLUMN COUNT
MOVE P1,CMDNAM ;POINT TO NAME TABLE AGAIN
HLLZ P2,(P1) ;GET LENGTH OF KEYWORD TABLE
AOS P1 ;POINT TO FIRST ENTRY
MOVEI T1,^D80 ;GET WIDTH WE'LL USE
IDIVI T1,(P3) ;HOW MANY STRINGS WILL FIT ON A LINE?
MOVN P3,T1 ;GET -VE COUNT
HRLZS P3 ;MAKE AN AOBJN POINTER
MOVE P4,P3 ;AND A COPY TOO
CHLPT3: MOVE T1,(P1) ;GET A STRING
PUSHJ P,CMDJST ;PRINT LEFT JUSTIFIED
AOBJN P4,CHLPT4 ;CONTINUE IF MORE ROOM ON THIS LINE
PUSHJ P,T$CRLF ;END LINE
MOVE P4,P3 ;RESET COLUMN COUNT
CHLPT4: AOS P1 ;ADVANCE TO NEXT KEYWORD
AOBJN P2,CHLPT3 ;LOOP FOR ALL KEYWORDS
PUSHJ P,T$CRLF ;END PARTIAL LINE
TRNE P4,-1 ;NEED ONE MORE?
PUSHJ P,T$CRLF ;YES
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$KEYW - READ A KEYWORD
C$KEYW: PUSHJ P,SAVE4 ;SAVE SOME ACS
PUSH P,[EXP -1] ;INIT "BEST" MATCH SO FAR
PUSH P,[EXP 0] ;INIT COUNT OF MATCHES
MOVE P1,T1 ;GET KEYWORD TO CHECK
MOVE P2,T2 ;COPY ADDRESS OF KEYWORD TABLE
XMOVEI P3,1(P2) ;POINT TO FIRST DATA WORD IN TABLE
HLLZ P4,(P2) ;GET -VE LENGTH
CKEYW1: MOVE T1,P1 ;COPY TEST STRING ADDRESS
MOVE T2,(P3) ;GET A TABLE ENTRY
PUSHJ P,STCMP ;COMPARE STRINGS
JUMPN T1,CKEYW2 ;JUMP IF STRING WASN'T A SUBSET
MOVEM P3,-1(P) ;SAVE POSSIBLE MATCH
AOS (P) ;INCREMENT MATCH COUNT
CKEYW2: AOS P3 ;ADVANCE POINTER
AOBJN P4,CKEYW1 ;LOOP THROUGH TABLE
POP P,T2 ;AND MATCH COUNT
CAIE T2,1 ;ONLY ONE MATCH?
JRST CKEYW3 ;UNKNOWN OR AMBIGUOUS KEYWORD
POP P,T2 ;GET "BEST" MATCH ADDRESS
MOVE T1,(T2) ;POINT TO FULL KEYWORD NAME
SUB T2,P2 ;COMPUTE OFFSET INTO TABLE
JRST CPOPJ1 ;AND RETURN
CKEYW3: MOVE T1,P1 ;POINT BACK TO FAILING TEST STRING
POP P,(P) ;PHASE STACK
POPJ P, ;AND RETURN
;COMPARE STRINGS
STCMP: HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
HRLI T2,(POINT 7,) ;...
STCMP1: ILDB T3,T1 ;GET A CHARACTER
ILDB T4,T2 ;...
CAIG T3,"Z"+40 ;RANGE
CAIGE T3,"A"+40 ; CHECK
CAIA
SUBI T3,40 ;CONVERT LOWER TO UPPER CASE
CAIG T4,"Z"+40 ;RANGE
CAIGE T4,"A"+40 ; CHECK
CAIA
SUBI T4,40 ;CONVERT LOWER TO UPPER CASE
CAIE T3,(T4) ;MATCH?
JRST STCMP2 ;NO--GO INVESTIGATE
JUMPN T3,STCMP1 ;KEEP SEARCHING UNLESS END OF STRING
SETZ T1, ;A PERFECT MATCH
JRST CPOPJ1 ;RETURN
STCMP2: JUMPE T3,STCMP3 ;JUMP IF TEST STRING ENDED
CAMG T3,T4 ;STRINGS UNEQUAL
SKIPA T1,[EXP -1] ;TEST STRING LESS
MOVEI T1,1 ;TEST STRING GREATER
POPJ P, ;RETURN
STCMP3: MOVEI T1,0 ;TEST STRING IS A SUBSET
ADD T2,[7B5] ;DECREMENT BASE BYTE POINTER ONE BYTE
POPJ P, ;RETRN
SUBTTL COMMAND SCANNING -- C$NUMI - READ A NUMBER
;SCAN A NUMBER IN ANY RADIX
;CALL: MOVE T1, RADIX
; PUSHJ P,C$NUMI
;
;SCAN AN OCTAL OR DECIMAL NUMBER
;CALL: PUSHJ P,C$OCTI
; PUSHJ P,C$DECI
;
;ON RETURN, T1:= NUMBER AND T2:= LAST SCANNED CHARACTER
C$OCTI: SKIPA T1,[10] ;RADIX 8
C$DECI: MOVEI T1,12 ;RADIX 10
C$NUMI: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;COPY RADIX
SETZB T2,P3 ;CLEAR RESULTS
SETO P2, ;ASSUME NEGATIVE NUMBER INPUT
SETZ P4, ;CLEAR INPUT FLAG
PUSHJ P,C$SKIP ;SKIP LEADING SPACES AND TABS
CAIE T1,"#" ;WANTS OCTAL INPUT?
JRST CNUMI1 ;NO
MOVEI P1,10 ;YES--SET RADIX 8
PUSHJ P,C$TYI ;GET A CHARACTER
CNUMI1: CAIE T1,"-" ;NEGATIVE NUMBER?
TDZA P2,P2 ;NO
CNUMI2: PUSHJ P,C$TYI ;GET A CHARACTER
CAIL T1,"0" ;RANGE CHECK
CAILE T1,"9" ; THE CHARACTER
JRST CNUMI4 ;OUT OF RANGE
AOS P4 ;INDICATE SOME IMPUT DONE
IMULI T2,(P1) ;MULTIPLY RESULT BY RADIX
ADDI T2,-"0"(T1) ;INCLUDE DIGIT
IMULI P3,^D10 ;MULTIPLY
ADDI P3,-"0"(T1) ;INCLUDE DIGIT
JRST CNUMI2 ;LOOP
CNUMI4: CAIE T1,"." ;FORCING DECIMAL?
JRST CNUMI5 ;NO
MOVEI P1,^D10 ;GET RADIX
MOVE T2,P3 ;GET DECIMAL NUMBER
CNUMI5: PUSHJ P,NUMMUL ;HANDLE SUFFIX MULTIPLIER
EXCH T1,T2 ;MAKE T1:= RESULT AND T2:= CHARACTER
SKIPE P2 ;NEGATIVE NUMBER?
MOVNS T1 ;YES--NEGATE IT
SKIPE P4 ;ANY INPUT?
AOS (P) ;YES--SKIP
POPJ P, ;RETURN
;HANDLE SUFFIX MULTIPLIERS - K, M, OR G
NUMMUL: CAIN P1,10 ;OCTAL?
JRST OCTMUL ;HANDLE SUFFIX MULTIPLIER
CAIN P1,12 ;DECIMAL?
JRST DECMUL ;HANDLE DECIMAL MULTIPLIER
POPJ P, ;RETURN
;OCTAL - K = 10**9, M = 10**18, G =10**27
OCTMUL: XMOVEI P3,T$OCTW ;GET TYPEOUT ROUTINE
; MOVEM P3,G$ETYP ;SAVE INCASE OF ERROR
MOVEI P3,0 ;INIT MULTIPLIER
CAIN T1,"K" ;K = 1 000
MOVEI P3,^D9
CAIN T1,"M" ;M = 1 000 000
MOVEI P3,^D18
CAIN T1,"G" ;G = 1 000 000 000
MOVEI P3,^D27
LSH T2,(P3) ;APPLY TO NUMBER
CAILE P3,1 ;HAVE A SUFFIX?
PUSHJ P,C$TYI ;YES--GET A CHARACTER
POPJ P, ;RETURN
;DECIMAL - K = 10**3, M = 10**6, G = 10**9
DECMUL: XMOVEI P3,T$DECW ;GET TYPEOUT ROUTINE
; MOVEM P3,G$ETYP ;SAVE INCASE OF ERROR
CAIN T1,"." ;FORCING DECIMAL?
PUSHJ P,C$TYI ;YES--GET A CHARACTER
MOVEI P3,1 ;INIT MULTIPLIER
CAIN T1,"K" ;K = 1 000
MOVEI P3,^D1000
CAIN T1,"M" ;M = 1 000 000
MOVE P3,[^D1000000]
CAIN T1,"G" ;G = 1 000 000 000
MOVE P3,[^D1000000000]
IMUL T2,P3 ;APPLY TO NUMBER
CAILE P3,1 ;HAVE A SUFFIX?
PUSHJ P,C$TYI ;YES--GET A CHARACTER
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$OCTW - WILDCARDED OCTAL INPUT
;INPUT A POSSIBLY WILDCARDED OCTAL HALF-WORD QUANTITY
;CALL: PUSHJ P,C$OCTW
;
; ON RETURN, T1:= WORD, T2:= MASK AND T3:= TERMINATING CHARACTER
C$OCTW: MOVEI T2,777777 ;CLEAR RESULT AND INIT MASK
SETZM CMDNUL ;CLEAR NULL INPUT FLAG
SETZM CMDWLD ;CLEAR WILDCARD FLAG
PUSHJ P,C$SKIP ;EAT LEADING SPACES AND TABS
CAIN T1,"*" ;ALL DIGITS WILD?
JRST COCTW4 ;YES
CAIL T1,"A" ;CHECK FOR
CAILE T1,"Z" ; A LETTER
JRST COCTW2 ;ASSUME A DIGIT
PUSHJ P,C$BACK ;BACKUP THE BYTE POINTER
PJRST C$SIXQ ;GO INPUT SIXBIT
COCTW1: PUSHJ P,C$TYI ;GET A CHARACTER
COCTW2: CAIN T1,"?" ;WILD DIGIT?
JRST COCTW3 ;YES
CAIL T1,"0" ;RANGE CHECK
CAILE T1,"7" ;AN OCTAL DIGIT
JRST COCTW5 ;NO GOOD--FINISH UP
AOS CMDNUL ;INDICATE INPUT DONE
TDZ T2,[700000,,700000] ;PREVENT OVERFLOW
LSH T2,3 ;SHIFT RESULT AND MASK
SUBI T1,"0" ;CONVERT ASCII TO OCTAL
TLO T1,7 ;GET MASK
TSO T2,T1 ;INCLUDE DIGIT AND MASK
JRST COCTW1 ;LOOP
COCTW3: AOS CMDNUL ;INDICATE INPUT DONE
AOS CMDWLD ;INDICATE WILDCARD
TDZ T2,[700000,,700000] ;PREVENT OVERFLOW
LSH T2,3 ;SHIFT RESULT AND MASK
TLO T2,7 ;DIGIT WAS WILD
JRST COCTW1 ;LOOP FOR ANOTHER DIGIT
COCTW4: AOS CMDNUL ;INDICATE INPUT DONE
AOS CMDWLD ;INDICATE WILDCARD
MOVSI T2,777777 ;SET RESULT AND MASK
PUSHJ P,C$TYI ;GET NEXT CHARACTER
COCTW5: MOVE T3,T1 ;GET TERMINATING CHARACTER
HLLZ T1,T2 ;GET RESULT
HRLZS T2 ;GET MASK
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$OPTN - SET OPTION PARAMETERS
;SET OPTION PARAMETERS
;CALL: MOVE T1, OUTPUT ROUTINE ADDRESS
; MOVE T2, OPTION TABLE ADDRESS
; MOVE T3, DEFAULT STRING ADDRESS
; PUSHJ P,C$OPTN
C$OPTN: MOVEM T1,CMDOTY ;SAVE OPTION OUTPUT ROUTINE
MOVEM T2,CMDOTB ;SAVE OPTION TABLE ADDRESS
MOVEM T3,CMDDEF ;SAVE DEFAULT STRING ADDRESS
SETOM CMDOPF ;INDICATE OPTION DATA VALID
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$READ - READ A COMMAND LINE
;CALL: MOVE T1, PROMPT STRING ADDRESS
; MOVE T2, OUTPUT ROUTINE
; MOVE T3, OPTION TABLE
; MOVE T4, DEFAULT ANSWER
; PUSHJ P,C$READ
C$READ: PUSH P,T1 ;SAVE PROMPT STRING
MOVE T1,[Z.CMDB,,Z.CMDB+1] ;SET UP BLT
SETZM Z.CMDB ;CLEAR FIRST WORD
BLT T1,Z.CMDE-1 ;CLEAR STORAGE
POP P,CMDPMT ;SAVE PROMPT STRING
MOVE T1,[PUSHJ P,TYI] ;***
MOVEM T1,CMDXCT ;***
CREAD1: MOVE T1,[POINT 7,CMDBUF] ;BYTE POINTER TO STORAGE
MOVEM T1,CMDPTR ;SAVE IT
MOVEI T1,CMDWDS*5-1 ;MAXIMUM STRING LENGTH
MOVEM T1,CMDCTR ;SAVE COUNT
PUSHJ P,CRDPMT ;PROMPT
;MAIN CHARACTER INPUT LOOP
CREAD2: PUSHJ P,GETCHR ;READ A CHARACTER
JUMPE T1,CREAD4 ;DONE?
SKIPE CMDBUF ;ANY INPUT YET?
JRST CREAD3 ;YES
CAIE T1,11 ;LEADING TAB?
CAIN T1," " ; OR SPACE?
JRST CREAD2 ;IGNORE IT
CREAD3: SOSGE CMDCTR ;COUNT DOWN
WARN (CBO,CREAD1,<Command buffer overflow>,)
IDPB T1,CMDPTR ;STORE CHARACTER
JRST CREAD2 ;LOOP BACK FOR MORE
CREAD4: MOVE T1,[POINT 7,CMDBUF] ;BYTE POINTER TO STORAGE
MOVEM T1,CMDPTR ;RESET IT
AOSN CMDOPF ;IS OPTION DATA VALID?
SKIPE CMDBUF ;AND ANY INPUT?
JRST CREAD7 ;JUST FINISH UP
MOVE T1,CMDDEF ;POINT TO DEFAULT STRING
HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
PUSH P,T1 ;SAVE TEMPORARILY
CREAD5: ILDB T1,(P) ;GET A CHARACTER
JUMPE T1,CREAD6 ;DONE?
SOSGE CMDCTR ;COUNT DOWN
JRST [SETZM CMDBUF ;BUFFER OVERFLOW LOADING DEFAULT STRING
JRST CREAD7] ;FINISH UP
IDPB T1,CMDPTR ;PUT A CHARACTER
JRST CREAD5 ;LOOP BACK FOR MORE
CREAD6: POP P,(P) ;PHASE STACK
CREAD7: MOVE T1,[POINT 7,CMDBUF] ;BYTE POINTER TO STORAGE
MOVEM T1,CMDPTR ;RESET IT
SKIPE CMDBUF ;HAVE ANY INPUT?
AOS (P) ;YES--SKIP
POPJ P, ;RETURN
CRDPMT: PUSHJ P,SAVT ;SAVE SOME ACS
PUSHJ P,T$NEWL ;PRINT A CRLF IF NEEDED
SKIPE T1,CMDPMT ;GET PROMPT STRING
PUSHJ P,T$STRG ;PUT IT OUT
SKIPL CMDOPF ;IS OPTION DATA VALID?
JRST CRDPM2 ;NO
SKIPN T2,CMDOTB ;GET OPTION TABLE
JRST CRDPM1 ;THERE ISN'T ONE
HLLZ T3,(T2) ;GET -VE TABLE LENGTH
ADD T3,[1,,0] ;SKIP PAST THE WORD COUNT WORD
AOS T2 ;POINT TO FIRST DATA WORD
MOVEI T1,[ASCIZ / (/] ;START OF LIST
PUSHJ P,T$STRG ;PRINT STRING
HRRZ T1,-1(T2) ;GET TABLE TYPE INDICATOR
XMOVEI T4,PMTKEY ;ASSUME KEYWORD ORIENTED
SKIPE T1 ;RANGE TABLE?
XMOVEI T4,PMTRNG ;YES
PUSHJ P,(T4) ;SPLICE INTO PROMPT STRING
PUSHJ P,T$RPAR ;PRINT RIGHT PARENTHESIS
;CHECK FOR DEFAULT STRING
CRDPM1: SKIPN CMDDEF ;HAVE DEFAULT TEXT?
JRST CRDPM2 ;NO
MOVEI T1,[ASCIZ / [/] ;START OF DEFAULT
PUSHJ P,T$STRG ;PRINT STRING
MOVE T1,CMDDEF ;GET ADDRESS
PUSHJ P,T$STRG ;PRINT DEFAULT TEXT
PUSHJ P,T$RBRK ;PRINT RIGHT BRACKET
;CHECK NEED FOR PROMPT TERMINATOR
CRDPM2: SKIPN T1,CMDPMT ;HAVE A PROMPT STRING?
POPJ P, ;NO--ALL DONE
HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
SETZ T2, ;INIT "PREVIOUS" CHARACTER
CRDPM3: ILDB T3,T1 ;GET A CHARACTER
JUMPE T3,CRDPM4 ;DONE?
MOVEI T2,(T3) ;SAVE NEW PREVIOUS
JRST CRDPM3 ;FIND THE END
CRDPM4: CAIL T2,"A"+40 ;LOWER
CAILE T2,"Z"+40 ; CASE?
CAIA ;NO
SUBI T2,40 ;TRANSLATE TO UPPER CASE
CAIL T2,"0" ;RANGE
CAILE T2,"9" ; CHECK
CAIL T2,"A" ; THE
CAILE T2,"Z" ; CHARACTER
POPJ P, ;RETURN IF NOT ALPHANUMERIC
MOVEI T1,[ASCIZ /: /] ;ELSE GET END OF PROMPT
PJRST T$STRG ;PRINT IT AND RETURN
;KEYWORD PROMPT
PMTKEY: TRNE T3,-1 ;FIRST TIME THROUGH
PUSHJ P,T$COMA ;SEPARATE
MOVE T1,(T2) ;GET SOMETHING
PUSHJ P,@CMDOTY ;PRINT IT
AOS T2 ;ADVANCE POINTER
AOBJN T3,PMTKEY ;LOOP THROUGH TABLE
POPJ P, ;RETURN
;RANGE TABLE PROMPT
PMTRNG: TRNE T3,-1 ;FIRST TIME THROUGH
PUSHJ P,T$COMA ;SEPARATE
HLRE T1,(T2) ;GET LOW RANGE
PUSHJ P,@CMDOTY ;PRINT IT
HLRE T4,(T2) ;GET LOW RANGE BACK
HRRE T1,(T2) ;NOW GET HIGH RANGE
CAML T4,T1 ;IS LOW VALUE GREATER THAN HIGH VALUE?
JRST PMTRN1 ;YES--THEN NOT A RANGE (SINGLE NUMBER)
PUSHJ P,T$DASH ;PRINT A DASH
PUSHJ P,@CMDOTY ;PRINT IT
PMTRN1: AOS T2 ;ADVANCE POINTER
AOBJN T3,PMTRNG ;LOOP THROUGH TABLE
POPJ P, ;RETURN
DEFINE BREAK (CHR),<
.XCREF
...BRK==0
IRP CHR,<...BRK==...BRK!1B35_CHR>
EXP ...BRK
PURGE ...BRK
.CREF
> ;END DEFINE BREAK
GETCHR: PUSH P,T2 ;SAVE T2
GETCH1: SETZM CMDEOF ;CLEAR EOF SEEN
XCT CMDXCT ;GET A CHARACTER
JUMPE T1,GETCH4 ;NULL?
CAIN T1,15 ;CR?
JRST GETCH1 ;IGNORE IT
MOVEI T2,1 ;GET A BIT
LSH T2,(T1) ;POSITION IT
CAIE T1,177 ;RUBOUT?
TDNE T2,[BREAK <3,7,12,13,14,22,24,32,33>] ;A BREAK?
SKIPA ;YES
JRST GETCH5 ;JUST FINISH UP
SKIPE CMDTTY ;INPUT FROM A TTY?
TDNN T2,[BREAK <7,22,24,33>] ;YES--BREAK NEED A CRLF?
JRST GETCH2 ;NO
MOVEI T1,15 ;GET CR
PUSHJ P,T$CHAR ;OUTPUT IT
MOVEI T1,12 ;GET A LINE FEED
PUSHJ P,T$CHAR ;OUTPUT IT
GETCH2: CAIE T1,3 ;CONTROL-C?
JRST GETCH3 ;NO
PUSHJ P,MONRET ;RETURN TO MONITOR
JRST GETCH1 ;THE FOOL TYPED CONTINUE
GETCH3: CAIN T1,32 ;CONTROL-Z?
SETOM CMDEOF ;REMEMBER EOF
GETCH4: SETZ T1, ;MARK EOL
GETCH5: POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
TYI: SETOM CMDTTY ;FLAG READING FROM THE TERMINAL
INCHWL T1 ;GET A CHARACTER
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$RNGE - RANGE CHECK NUMBERS
C$RNGE: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;GET NUMBER TO CHECK
MOVE P2,T2 ;COPY ADDRESS OF KEYWORD TABLE
XMOVEI P3,1(P2) ;POINT TO FIRST DATA WORD IN TABLE
HLLZ P4,(P2) ;GET -VE LENGTH
CRNGE1: HLRE T1,(P3) ;GET LOW RANGE
HRRE T2,(P3) ;AND HIGH RANGE
CAML T1,T2 ;IS LOW VALUE GREATER THAN HIGH VALUE?
MOVE T1,T2 ;YES--THEN NOT A RANGE (SINGLE NUMBER)
CAML P1,T1 ;RANGE
CAMLE P1,T2 ; CHECK
AOSA P3 ;NO MATCH HERE
JRST CRNGE2 ;GO RETURN ANSWER
AOBJN P4,CRNGE1 ;LOOP THROUGH TABLE
JRST CRNGE3 ;NO MATCH ANYWHERE
CRNGE2: MOVE T2,P3 ;GET ENTRY ADDRESS
SUB T2,P2 ;COMPUTE OFFSET INTO TABLE
AOS (P) ;SKIP
CRNGE3: MOVE T1,P1 ;PUT NUMBER BACK IN T1
MOVE T2,P2 ;GET RANGE TABLE BACK
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$SAVE - SAVE COMMAND TABLE POINTERS
;CO-ROUTINE TO SAVE THE POINTERS TO COMMAND TABLES
;CALL: PUSHJ P,C$SAVE
C$SAVE: PUSH P,CMDTBL ;SAVE THE TABLE OF POINTERS
PUSHJ P,@-1(P) ;CALL THE CALLER
SKIPA ;NON-SKIP RETURN
AOS -2(P) ;ADJUST RETURN PC
EXCH T1,(P) ;SAVE T1 AND GET ADDRESS OF TABLE
PUSHJ P,C$TSET ;RESET THE POINTERS
POP P,T1 ;RESTORE T1
SUB P,[1,,1] ;ADJUST STACK
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$SIXQ - QUOTED/WILD SIXBIT TEXT
;INPUT A POSSIBLY QUOTED OR WILDCARDED SIXBIT WORD
;CALL: PUSHJ P,C$SIXQ
;
;ON RETURN, T1:= WORD, T2:= MASK AND T3:= TERMINATING CHARACTER
C$SIXQ: PUSHJ P,SAVE1 ;SAVE P1
SETZM CMDQUO ;ASSUME NOT QUOTED STRING
SETZM CMDWLD ;CLEAR WILDCARD FLAG
SETZM CMDNUL ;CLEAR NULL INPUT FLAG
MOVE T3,[POINT 6,CMDAT6] ;SET UP BYTE POINTER TO WORD
MOVE T4,[POINT 6,CMDMSK] ;SET UP BYTE POINTER TO MASK
SETZM CMDAT6 ;CLEAR RESULT
SETZM CMDMSK ;CLEAR MASK
MOVEI T2,77 ;GET MASK FOR ONE CHARACTER
SETZ P1, ;CLEAR COUNTER
PUSHJ P,C$SKIP ;EAT LEADING TABS AND SPACES
CAIN T1,"#" ;WANTS TO INPUT IN OCTAL?
PJRST C$OCTW ;YES--GO DO IT
SKIPA ;ANALYZE CHARACTER
CSIXQ1: PUSHJ P,C$TYI ;GET A CHARACTER
CAIN T1,"""" ;QUOTE CHARACTER?
JRST CSIXQ2 ;YES
SKIPE CMDQUO ;QUOTING?
JUMPN T1,CSIXQ4 ;ALL CHARACTERS ARE LEGAL
CAIE T1,"*" ;REMAINDER OF WORD WILD?
CAIN T1,"?" ;OR A WILD CHARACTER?
AOSA CMDWLD ;INDICATED WILDCARD
JRST CSIXQ3 ;NO
JRST CSIXQ4 ;GO STORE CHARACTER
CSIXQ2: PUSHJ P,C$TYIN ;GET NEXT CHARACTER
CAIN T1,"""" ;ANOTHER QUOTE?
JRST CSIXQ4 ;SAVE IT
SETCMM CMDQUO ;NO--TOGGLE QUOTE FLAG
SKIPN CMDQUO ;QUOTING?
CSIXQ3: CAIL T1,"0" ;RANGE
CAILE T1,"9" ; CHECK
CAIL T1,"A" ; THE
CAILE T1,"Z" ; CHARACTER
JRST CSIXQ5 ;NOT A GOOD CHARACTER
CSIXQ4: AOS CMDNUL ;INDICATE INPUT DONE
CAIL P1,6 ;WORD FULL YET?
JRST CSIXQ1 ;YES--IGNORE CHARACTER
SUBI T1," " ;CONVERT ASCII TO SIXBIT
IDPB T1,T3 ;SAVE THE CHARACTER
CAIN T1,'*' ;REMAINDER OF WORD WILD?
JRST CSIXQ6 ;YES--FINISH UP
IBP T4 ;POSITION TO NEXT MASK
CAIE T1,'?' ;WILD CHARACTER?
DPB T2,T4 ;SAVE IT
AOJA P1,CSIXQ1 ;GET ANOTHER ONE
POPJ P, ;RETURN
CSIXQ5: CAIL P1,6 ;COUNT CHARACTERS
JRST CSIXQ7 ;FINISH UP
IDPB T2,T4 ;SAVE MASK OF CHARACTER
AOJA P1,CSIXQ5 ;LOOP
CSIXQ6: AOS CMDNUL ;INDICATE INPUT DONE
PUSHJ P,C$TYI ;GET NEXT CHARACTER
CSIXQ7: MOVE T3,T1 ;GET TERMINATING CHARACTER
MOVE T1,CMDAT6 ;GET WORD
MOVE T2,CMDMSK ;GET MASK
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- C$SKIP - SKIP TABS AND SPACES
;SKIP LEADING TABS AND SPACES
C$SKIP: PUSHJ P,C$TYI ;GET A CHARACTER
JUMPE T1,CPOPJ ;STOP IF EOL
CAIE T1,11 ;TAB?
CAIN T1," " ;SPACE?
JRST C$SKIP ;YES TO EITHER
POPJ P, ;ELSE RETURN
SUBTTL COMMAND SCANNING -- TBLSET - TABLE SETUP
;SET UP COMMAND, KEYWORD OR SWITCH TABLES
;CALL: MOVE T1, ADDRESS OF TABLE POINTERS
; PUSHJ P,C$TSET
C$TSET: PUSH P,T2 ;SAVE T2
MOVEI T2,CMDTBL ;POINT TO COMMAND TABLE STORAGE
MOVEM T1,(T2) ;SAVE TABLE ADDRESS
PUSH T2,0(T1) ;SAVE NAME TABLE
PUSH T2,1(T1) ;SAVE PROCESSOR TABLE
PUSH T2,2(T1) ;SAVE HELP TABLE
PUSH T2,3(T1) ;SAVE NEXT COMMAND TABLE
POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
SUBTTL COMMAND SCANNING -- COMMON ERROR ROUTINES
C$EKEY: SKIPE T2 ;SKIP IF UNKNOWN
C$EAMB: FATAL (AMB,CPOPJ,<Ambiguous keyword >,E..AMB)
C$EUNK: FATAL (UNK,CPOPJ,<Unknown keyword >,E..UNK)
E..AMB:!
E..UNK: PUSHJ P,T$DQUO ;PRINT DOUBLE QUOTES
PUSHJ P,T$STRG ;PRINT KEYWORD IN ERROR
PJRST T$DQUO ;PRINT DOUBLE QUOTES AND RETURN
C$ENOP: FATAL (NOP,CPOPJ,<>,E..NOP)
E..NOP: PUSHJ P,T$DQUO ;PRINT DOUBLE QUOTES
PUSHJ P,T$STRG ;PRINT KEYWORD IN ERROR
PUSHJ P,T$DQUO ;CLOSE QUOTES
XMOVEI T1,[ASCIZ / is not a valid command option/]
PJRST T$STRG ;PRINT TEXT AND RETURN
C$EEOL: FATAL (EXA,CPOPJ,<Extra characters starting with >,E..EXA)
C$EILC: FATAL (ILC,CPOPJ,<Illegal character >,E..ILC)
C$EILD: FATAL (ILD,CPOPJ,<Illegal delimiter >,E..ILD)
E..EXA:!
E..ILC:!
E..ILD: PUSHJ P,T$DQUO ;PRINT DOUBLE QUOTES
PUSHJ P,C$CURR ;GET CURRENT CHARACTER
PUSHJ P,T$FCHR ;PRINT OFFENDING CHARACTER
PJRST T$DQUO ;PRINT DOUBLE QUOTES AND RETURN
C$ENAS: FATAL (NAS,CPOPJ,<No argument specified>,)
C$ERNG: FATAL (VOR,CPOPJ,<Specified value >,E..VOR)
E..VOR: PUSH P,T1 ;SAVE VALUE TO PRINT
PUSH P,T2 ;AND RANGE TABLE ADDRESS
HRRZ T2,(T2) ;GET RADIX FROM RANGE TABLE
PUSHJ P,T$RDXW ;PRINT IT
MOVEI T1,[ASCIZ / out of range/]
PUSHJ P,T$STRG ;PRINT TEXT
POP P,T2 ;RESTORE RANGE TABLE ADDRESS
POP P,T1 ;RESTORE VALUE
POPJ P, ;AND RETURN
SUBTTL DATA FILE PROCESSING -- D$ACTV - CHECK FOR ACTIVE FILE
;CHECK FOR AN ACTIVE (OPEN) DATA FILE
;CALL: MOVE T1, FLAG ;0 = SILENCE, 1 = FATAL ERROR
; PUSHJ P,D$ACTV
; <NON-SKIP> ;NO FILE OPEN
; <SKIP> ;FILE OPEN
D$ACTV: SKIPE DATACT ;FILE OPENED?
JRST CPOPJ1 ;RETURN
JUMPE T1,CPOPJ ;SILENT CHECK?
FATAL (DNO,CPOPJ,<Data file not opened>,)
SUBTTL DATA FILE PROCESSING -- D$EDVF - FIND ERSATZ DEVICE
;SCAN THE ERSATZ DEVICE TABLE
;CALL: MOVE T1, DEVICE NAME OR ZERO
; MOVE T2, PPN OR ZERO
; PUSHJ P,D$EDVF
; <NON-SKIP> ;NO SUCH DEVICE/PPN
; <RETURN> ;T1 := DEVICE, T2 := PPN
D$EDVF: CAME T1,['MFD '] ;THIS IS EASY TO FIND
JRST DEDVF1 ;DO IT THE HARD WAY
MOVE T2,.DFMFD(D) ;GET ASSOCIATED PPN
JRST CPOPJ1 ;AND RETURN
DEDVF1: PUSHJ P,SAVE3 ;SAVE SOME ACS
PUSHJ P,EDVFND ;FIND THE ENTRY
POPJ P, ;FAILED--NO SUCH DEVICE
MOVE T1,0(P3) ;COPY DEVICE NAME
SKIPE T2,1(P3) ;AND ASSOCIATED PPN (MUST BE NON-ZERO)
AOS (P) ; FOR IT TO BE TRUELY USEABLE
POPJ P, ;RETURN
EDVFND: MOVE P1,T1 ;COPY POSSIBLE DEVICE
MOVE P2,T2 ;COPY POSSIBLE PPN
IOR T1,T2 ;MAKE SURE BOTH NOT ZERO
JUMPE T1,EDVFN3 ;ERROR
SKIPN P3,.DFEDV(D) ;ANY DEVICES DEFINED?
JRST EDVFN3 ;NO
ADDI P3,(D) ;RELOCATE
EDVFN1: SKIPN 0(P3) ;BLANK ENTRY?
JRST EDVFN2 ;YES--IGNORE IT
CAMN P1,0(P3) ;NAME MATCH?
JRST CPOPJ1 ;YES
SKIPN P4,1(P3) ;PICK UP PPN
JRST EDVFN2 ;ZERO??
CAMN P2,P4 ;COMPARE PPNS
JRST CPOPJ1 ;FOUND IT
EDVFN2: ADDI P3,1 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN P3,EDVFN1 ;LOOP THROUGH TABLE
EDVFN3: MOVE T1,P1 ;GET REQUESTED DEVICE BACK
MOVE T2,P2 ;AND THE PPN TOO
POPJ P, ;RETURN NOTHING FOUND
SUBTTL DATA FILE PROCESSING -- D$EDVL - LOAD ERSATZ DEVICE TABLE
;ROUTINE TO READ ERSATZ DEVICES FROM THE MONITOR AND STORE
;THEM IN THE DATA FILE
;CALL: PUSHJ P,D$EDVL
; <RETURN>
D$EDVL: PUSHJ P,SAVE3 ;SAVE SOME ACS
MOVE T1,[.GTEDN,,.GTSLF] ;NEED SELF POINTER FOR EDV TABLE
GETTAB T1, ;READ FROM MONITOR
SETZ T1, ;???
LSH T1,-33 ;POSITION COUNT
TRNE T1,1 ;ODD NUMBER?
ADDI T1,1 ;MAKE IT EVEN
PUSH P,T1 ;SAVE COUNT
ADDI T1,1 ;PLUS 1 (FOR SORTING)
ASH T1,1 ;TIMES 2 FOR 2-WORD ENTRIES
PUSHJ P,D$VGET ;ALLOCATE STORAGE
POP P,T1 ;GET COUNT BACK
MOVNS T1 ;NEGATE
HRLZS T1 ;PUT IN LH
HRR T1,T2 ;INCLUDE FILE OFFSET
MOVEM T1,.DFEDV(D) ;STORE
ADDI T1,(D) ;RELOCATE
SETZ T2, ;INIT A COUNTER
DEDVL1: HRLZ T3,T2 ;GET COUNT
HRRI T3,.GTEDN ;INCLUDE TABLE NUMBER
GETTAB T3, ;READ A DEVICE NAME
JRST DEDVL2 ;NO MORE
TRZ T3,-1 ;CLEAR OUT S/L FLAGS
MOVEM T3,0(T1) ;STORE NAME
MOVEM T3,PTHBLK ;STORE FOR A MOMENT
MOVE T3,[3,,PTHBLK] ;SET UP UUO AC
PATH. T3,UU.PHY ;TRANSLATE TO A PPN
TDZA T3,T3 ;FAILED
MOVE T3,PTHBLK+2 ;GET PPN
MOVEM T3,1(T1) ;STORE IT
AOS T2 ;ADVANCE COUNTER
ADDI T1,1 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN T1,DEDVL1 ;LOOP FOR MORE
DEDVL2: MOVE T1,.DFEDV(D) ;GET -LENGTH,,OFFSET
ADDI T1,(D) ;RELOCATE
SKIPE 0(T1) ;NEED AT LEAST ONE ENTRY
PUSHJ P,EDVSRT ;SORT THE TABLE BY NAME
MOVSI T1,'MFD' ;SPECIAL DEVICE
SETZ T2, ;DON'T KNOW THE PPN YET
PUSHJ P,EDVFND ;FIND THE ENTRY
SKIPA T2,[1,,1] ;FAILED--USE EXPECTED VALUE
MOVE T2,1(P3) ;GET ASSOCIATED PPN
MOVEM T2,.DFMFD(D) ;STORE RESULTS FOR QUICK REFERENCE
POPJ P, ;RETURN
EDVSRT: PUSHJ P,SAVE2 ;SAVE P1 AND P2
EDVSR1: MOVE P1,.DFEDV(D) ;GET -LENGTH,,OFFSET
ADDI P1,(D) ;RELOCATE
SETZ P2, ;CLEAR A COUNTER
EDVSR2: SKIPE T1,0(P1) ;GET A NAME
CAMG T1,2(P1) ;IN ASCENDING ORDER?
JRST EDVSR3 ;YES
EXCH T1,2(P1) ;SWAP
MOVEM T1,0(P1) ;...
MOVE T1,1(P1) ;GET MONITOR PPN
EXCH T1,3(P1) ;SWAP
MOVEM T1,1(P1) ;...
AOS P2 ;COUNT THE CHANGE
EDVSR3: ADDI P1,1 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN P1,EDVSR2 ;LOOP FOR ALL ENTRIES
JUMPN P2,EDVSR1 ;DO IT AGAIN IF THERE WERE CHANGES
PUSHJ P,D$WHDR ;UPDATE HEADER
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$EDVM - MODIFY AN ERSATZ DEVICE
;THIS ROUTINE WILL MODIFY THE PPN IN AN ERSATZ DEVICE TABLE ENTRY
;CALL: MOVE T1, DEVICE NAME
; MOVE T2, PPN (OR ZERO)
; PUSHJ P,D$EDVM
; <NON-SKIP> ;NO SUCH DEVICE
; <SKIP> ;ENTRY MODIFIED
D$EDVM: PUSHJ P,SAVE3 ;SAVE SOME ACS
PUSHJ P,EDVFND ;FIND THE ENTRY
POPJ P, ;FAILED--NO SUCH DEVICE
MOVEM T2,1(P3) ;UPDATE PPN
CAMN T1,['MFD '] ;SPECIAL DEVICE?
MOVEM T2,.DFMFD(D) ;REMEMBER HERE TOO
JRST CPOPJ1 ;RETURN
SUBTTL DATA FILE PROCESSING -- D$FBLK - FIND AN FB GIVEN A BLOCK
;FIND A FILE BLOCK GIVEN A BLOCK NUMBER
;CALL: MOVE T1, BLOCK NUMBER
; PUSHJ P,D$FBLK
; <NON-SKIP> ;NO SUCH FILE
; <SKIP> ;T1 := ADDR OF FB, T2 := DATA FILE BLOCK
D$FBLK: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;SAVE TARGET BLOCK NUMBER
MOVN P2,.DFFBN(D) ;GET NUMBER OF FILE BLOCKS
HRLZS P2 ;MAKE AN AOBJN POINTER
MOVE P3,.DFFIL(D) ;POINT TO FIRST FILE BLOCK WITHIN DATA FILE
DFBLK1: MOVE T1,P3 ;DATA FILE BLOCK NUMBER
MOVE T2,[IOWD BLKSIZ,DATBUF] ;IOWD
PUSHJ P,D$READ ;READ A BLOCK
HLLZ P4,.DFFBB(D) ;GET -VE FILE BLOCKS PER DISK BLOCK
HRRI P4,DATBUF ;INCLUDE STARTING ADDRESS
DFBLK2: CAMN P1,.FBBLK(P4) ;FILE FB MATCH TARGET?
JRST DFBLK3 ;YES
AOBJP P2,CPOPJ ;RETURN IF NO MORE FILE BLOCKS
HRRZ T1,.DFFBL(D) ;GET FILE BLOCK LENGTH
HRLI T1,1 ;JUST ONE BLOCK
ADD P4,T1 ;INCREMENT POINTER
JUMPL P4,DFBLK2 ;LOOP BACK FOR MORE
AOJA P3,DFBLK1 ;ADVANCE TO NEXT DATA FILE BLOCK
DFBLK3: MOVEI T1,(P4) ;POINT TO FILE BLOCK
MOVE T2,P3 ;GET DATA FILE BLOCK FOR LATER UPDATES
JRST CPOPJ1 ;AND RETURN
SUBTTL DATA FILE PROCESSING -- D$FNUM - FIND AN FB GIVEN A FILE NUMBER
;FIND A FILE BLOCK GIVEN A FILE NUMBER
;CALL: MOVE T1, FILE NUMBER
; PUSHJ P,D$FNUM
; <NON-SKIP> ;NO SUCH FILE
; <SKIP> ;T1 := ADDR OF FB, T2 := DATA FILE BLOCK
D$FNUM: PUSHJ P,SAVE3 ;SAVE SOME ACS
SKIPLE P1,T1 ;WEED OUT JUNK
CAMLE P1,.DFFBN(D) ;WITHIN RANGE?
POPJ P, ;SAY NO SUCH FILE
PUSH P,P1 ;SAVE TEMPORARILY
SOS P1 ;FILE BLOCK NUMBERS RANGE FROM 0 TO N-1
HRRZ P3,.DFFBB(D) ;GET FILE BLOCKS PER DISK BLOCK
IDIVI P1,(P3) ;COMPUTE BLOCK FOR TARGET FILE
IMUL P2,.DFFBL(D) ;GET OFFSET TO TARGET + 1 FILE BLOCK
ADD P1,.DFFIL(D) ;OFFSET BY STARTING DATA FILE BLOCK
MOVE T1,P1 ;DATA FILE BLOCK NUMBER
MOVE T2,[IOWD BLKSIZ,DATBUF] ;IOWD
PUSHJ P,D$READ ;READ A BLOCK
MOVEI T1,DATBUF(P2) ;GET ADDRESS OF TARGET FILE BLOCK
MOVE T2,P1 ;SAVE BLOCK NUMBER FOR LATER UPDATES
POP P,P1 ;GET FILE NUMBER BACK
LDB P2,[POINTR (.FBIDN(T1),FB.NUM)] ;GET FILE NUMBER FROM FB
CAIE P1,(P2) ;MUST MATCH
STOPCD (FMM,<File number mismatch; FB must exist but doesn't>)
JRST CPOPJ1 ;RETURN WITH FILE BLOCK ADDRESS IN T1
SUBTTL DATA FILE PROCESSING -- D$RBAT - READ BAT BLOCKS
D$RBAT: INFO (RBB,.+1,<Reading BAT blocks>,)
MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
SETZM .DFBAT(D) ;START OFF CLEANLY
DRBAT1: MOVEI T1,CPYBUF ;POINT TO A SCRATCH BUFFER
PUSHJ P,F$RBAT ;READ BAT BLOCKS
MOVN T2,.UNLUN(U) ;GET LOGICAL UNIT
LSH T1,(T2) ;POSITION FOR THIS UNIT
IORM T1,.DFBAT(D) ;REMEMBER THE ERRORS
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,DRBAT1 ;LOOP BACK FOR MORE
PUSHJ P,D$WHDR ;UPDATE HEADER
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$SORT - SORT FILE BLOCKS
D$SORT: INFO (SRT,.+1,<Sorting file blocks>,)
PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE T1,.DFSRT(D) ;GET MAXIMUM FILE BLOCKS TO SORT AT ONCE
IMUL T1,.DFFBL(D) ;AMOUNT OF CORE NECESSARY TO HOLD ALL
PUSHJ P,M$GETW ;ALLOCATE CORE
MOVEM T1,SRTMEM ;SAVE LENGTH
MOVEM T2,SRTMEM+1 ; AND ADDRESS
SETZM SRTPAS ;CLEAR PASS COUNT
SORT1: PUSHJ P,SRTRDF ;READ FILE BLOCKS AND SORT
JRST SORT2 ;DONE
PUSHJ P,SRTWTF ;WRITE FILE BLOCK SORT LINKS
AOS SRTPAS ;COUNT THE PASS
JRST SORT1 ;LOOP UNTIL DONE
SORT2: MOVE T1,SRTMEM ;GET WORDS USED FOR A BUFFER
MOVE T2,SRTMEM+1 ;AND THE ADDRESS
PUSHJ P,M$GIVW ;DEALLOCATE CORE
INFO (SCP,.+1,<Sort completed in >,E..SCP)
POPJ P, ;RETURN
E..SCP: MOVE T1,SRTPAS ;GET PASS COUNT
PUSHJ P,T$DECW ;PRINT IT
MOVE T2,SRTPAS ;GET COUNT AGAIN
XMOVEI T1,[ASCIZ / passes/] ;ASSUME PLURAL
CAIN T2,1 ;ONLY ONE?
XMOVEI T1,[ASCIZ / pass/]
PJRST T$STRG ;PRINT TEXT AND RETURN
SRTCOR: PUSHJ P,SAVE4 ;SAVE P1-P4
PUSH P,U ;SAVE U (USED AS FRAME)
MOVE P1,SRTMEM+1 ;POINT TO START OF SORT BUFFER
MOVE T1,SRTFBN ;GET FILE BLOCK COUNT
MOVEI U,(T1) ;SET FRAME
SRTCO1: LSH U,-1 ;CUT BY TWO
JUMPE U,SRTCO6 ;JUMP IF ZERO FRAME
MOVEI T1,(U) ;GET FRAME
IMUL T1,.DFFBL(D) ;COMPUTE NUMBER OF ENTRIES
MOVEM T1,SRTFRM ;SAVE IT
MOVEI P2,(U) ;MAKE AN AOBJN WORD
SUB P2,SRTFBN ;...
HRLZS P2 ;...
HRRI P2,(P1) ;...
SRTCO2: MOVEI P3,(P2) ;SET UPPER POINTER
SRTCO3: MOVEI P4,(P3) ;SET LOWER POINTER
ADD P4,SRTFRM ;...
PUSHJ P,SRTCMP ;COMPARE THE TWO FILE BLOCKS
SKIPA ;WRONG ORDR
JRST SRTCO5 ;RIGHT ORDER
PUSHJ P,SRTFLP ;FLIP THEM AROUND
SUB P3,SRTFRM ;CAN WE LOOP BACK?
CAIL P3,(P1) ;...
JRST SRTCO3 ;YES
SRTCO5: MOVE T1,.DFFBL(D) ;GET FILE BLOCK LENGTH
ADDI P2,-1(T1) ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P2,SRTCO2 ;LOOP
JRST SRTCO1 ;NEXT CUT
SRTCO6: POP P,U ;RESTORE U
POPJ P, ;RETURN
;COMPARE TWO FILE BLOCKS
;CALL: MOVE P3, FILE BLOCK 1
; MOVE P4, FILE BLOCK 2
; PUSHJ P,SRTCMP
; <NON-SKIP> ;FILE BLOCK 2 IS SMALLER
; <SKIP> ;FILE BLOCK 1 IS SMALLER
SRTCMP:
;PPN
SKIPGE T1,.FBPPN(P3) ;FIRST PPN
TLC T1,(1B0) ;DEFEND AGAINST SIXBIT
SKIPGE T2,.FBPPN(P4) ;SECOND PPN
TLC T2,(1B0) ;DEFEND AGAINST SIXBIT
CAMLE T1,T2 ;FIRST SMALLER?
POPJ P, ;NO--SECOND IS SMALLER
CAME T1,T2 ;DON'T CONTINUE UNLESS THE
JRST CPOPJ1 ; THE PPNS ARE THE SAME
;DIRECTORY COMPONENTS
MOVEI T1,.FBPPN+1(P3) ;POINT TO START OF PATH
MOVEI T2,.FBPPN+1(P4)
SKIPN T3,.DFLVL(D) ;GET MAXIMUM SFD LEVEL
JRST SRTCM2 ;NO SFD SUPPORT
PUSH P,T3 ;SAVE COUNTER
;DIRECTORY COMPONENTS
SRTCM1: MOVSI T3,(1B0) ;FOR UNSIGNED COMPARES
MOVSI T4,(1B0) ;...
XOR T3,(T1) ;GET AN SFD NAME
XOR T4,(T2) ;...
CAMLE T3,T4 ;FIRST SMALLER (SIXBIT COMPARE)?
JRST [POP P,(P) ;NO--SECOND IS SMALLER
POPJ P,] ;RETURN
CAME T3,T4 ;DON'T CONTINUE UNLESS THE
JRST [POP P,(P) ; THE SFD NAMES ARE THE SAME
JRST CPOPJ1] ; ...
AOS T1 ;ADVANCE
AOS T2 ; POINTERS
SOSLE (P) ;COUNT DOWN
JRST SRTCM1 ;LOOP FOR ALL SFDS
POP P,(P) ;PHASE STACK
;FILE NAME
SRTCM2: MOVSI T1,(1B0) ;FOR UNSIGNED COMPARES
MOVSI T2,(1B0) ;...
XOR T1,.FBNAM(P3) ;FIRST FILE NAME
XOR T2,.FBNAM(P4) ;SECOND FILE NAME
CAMLE T1,T2 ;FIRST SMALLER?
POPJ P, ;NO--SECOND IS SMALLER
CAME T1,T2 ;DON'T CONTINUE UNLESS THE
JRST CPOPJ1 ; THE FILE NAMES ARE THE SAME
;EXTENSION
HLRZ T1,.FBEXT(P3) ;EXTENSION
HLRZ T2,.FBEXT(P4) ;DITTO
CAILE T1,(T2) ;FIRST SMALLER?
POPJ P, ;NO--SECOND IS SMALLER
CAIE T1,(T2) ;DON'T CONTINUE UNLESS THE
JRST CPOPJ1 ; THE EXTENSIONS ARE THE SAME
;CREATION DATE
MOVE T1,.FBCRE(P3) ;CREATION DATE
CAMLE T1,.FBCRE(P4) ;FIRST SMALLER?
POPJ P, ;NO--SECOND IS SMALLER
CAME T1,.FBCRE(P4) ;DON'T CONTINUE UNLESS THE
JRST CPOPJ1 ; CREATION DATES ARE THE SAME
;BLOCK NUMBER OF RIB
MOVE T1,.FBBLK(P3) ;BLOCK NUMBER OF RIB
CAMLE T1,.FBBLK(P4) ;FIRST SMALLER?
POPJ P, ;NO--SECOND IS SMALLER
; CAME T1,.FBBLK(P4) ;DON'T CONTINUE UNLESS THE
; JRST CPOPJ1 ; RIB BLOCK NUMBERS ARE THE SAME
;HERE IF THE FIRST FILE IS SMALLER THAN THE SECOND
JRST CPOPJ1 ;RETURN
;FLIP THE TWO FILE BLOCKS AROUND
;CALL: MOVE P3, FIRST FILE BLOCK
; MOVE P4, SECOND FILE BLOCK
; PUSHJ P,SRTFLP
; <RETURN> ;P2 IS INCREMENTED TO REFLECT CHANGE
SRTFLP: MOVSI T1,(P3) ;POINT TO FIRST FILE BLOCK
HRR T1,.DFFBT(D) ;GET OFFSET TO TEMP FILE BLOCK
ADDI T1,(D) ;RELOCATE
HRR T2,T1 ;GET STORAGE ADDRESS
ADD T2,.DFFBL(D) ;COMPUTE END
BLT T1,-1(T2) ;COPY TO TEMPORARY STORAGE
MOVSI T1,(P4) ;POINT TO SECOND FILE BLOCK
HRRI T1,(P3) ;MAKE A BLT POINTER
MOVE T2,P3 ;GET STORAGE ADDRESS
ADD T2,.DFFBL(D) ;COMPUTE END
BLT T1,-1(T2) ;COPY IT AWAY
MOVE T1,.DFFBT(D) ;GET OFFSET TO TEMP FILE BLOCK
ADDI T1,(D) ;RELOCATE
HRLZS T1 ;PUT IN LH
HRRI T1,(P4) ;MAKE A BLT POINTER
MOVE T2,P4 ;GET STORAGE ADDRESS
ADD T2,.DFFBL(D) ;COMPUTE END
BLT T1,-1(T2) ;COPY IT AWAY
POPJ P, ;RETURN
;ROUTINE TO INITIALIZE DATA BUFFER
;CALL: PUSHJ P,SRTIDB
; <RETURN>
SRTIDB: PUSH P,T2 ;SAVE T2
AOS T1,SRTBLK ;GET BLOCK NUMBER
MOVE T2,[IOWD BLKSIZ,DATBUF] ;IOWD
PUSHJ P,D$READ ;READ A BLOCK
HLLZ T1,.DFFBB(D) ;GET -VE FILE BLOCKS PER DISK BLOCK
HRRI T1,DATBUF ;MAKE AN AOBJN POINTER
MOVEM T1,SRTDPT ;SET POINTER
POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
;ROUTINE TO INITIALIZE SORT BUFFER
;CALL: PUSHJ P,SRTISB
; <RETURN>
SRTISB: PUSH P,T1 ;SAVE T1
MOVE T1,SRTMEM+1 ;GET BUFFER ADDRESS
MOVSI T2,0(T1) ;COPY STARTING ADDRESS
HRRI T2,1(T1) ;MAKE A BLT POINTER
SETZM (T1) ;CLEAR FIRST WORD
ADD T1,SRTMEM+0 ;COMPUTE END OF BLT
BLT T2,-1(T1) ;CLEAR BUFFER
SETZM SRTFBN ;CLEAR COUNT OF FILE BLOCKS IN BUFFER
MOVN T2,.DFSRT(D) ;-VE NUMBER OF POSSIBLE ENTRIES
HRLZS T2 ;PUT IN RH
HRR T2,SRTMEM+1 ;MAKE AN AOBJN POINTER
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
;ROUTINE TO READ FILE BLOCKS INTO THE SORT BUFFER
;CALL: PUSHJ P,SRTRDF
; <NON-SKIP> ;DONE PROCESSING FILE BLOCKS
; <SKIP> ;NEED TO SORT
SRTRDF: PUSH P,P3 ;SAVE P3
PUSH P,P4 ;SAVE P4
MOVE T1,.DFFIL(D) ;GET START OF FILE BLOCKS IN DATA FILE
SUBI T1,1 ;WILL INCREMENT UPON READING
MOVEM T1,SRTBLK ;SAVE
SETZM SRTDPT ;NO DATA FILE BUFFER POINTER YET
SETZM SRTSPT ;OR A SORT BUFFER POINTER EITHER
SETZM SRTFCT ;CLEAR FILE COUNTER
SETZM SRTCHG ;CLEAR CHANGE FLAG
SRTRD1: AOS T1,SRTFCT ;COUNT ENTRIES
CAMLE T1,.DFFBN(D) ;DONE ALL FILE BLOCKS YET?
JRST SRTRD5 ;YES
SKIPL T1,SRTDPT ;UNPROCESSED FILE BLOCKS IN DATA FILE BUFFER?
PUSHJ P,SRTIDB ;NO--INITIALIZE DATA FILE BUFFER
LDB T3,[POINTR (.FBIDN(T1),FB.SRT)] ;SORT LINK
JUMPN T3,SRTRD4 ;JUMP IF THIS FILE BLOCK IS ALREADY SORTED
LDB T3,[POINTR (.FBIDN(T1),FB.NUM)] ;GET THIS FILE BLOCK NUMBER
MOVE T4,.DFLSF(D) ;GET LAST SORTED FILE NUMBER
CAMN T3,T4 ;BUT IS THIS THE LAST ONE SORTED?
JUMPN T4,SRTRD4 ;YES--THEN IGNORE IT
SKIPN T2,SRTSPT ;UNPROCESSED FILE BLOCKS IN SORT BUFFER?
PUSHJ P,SRTISB ;NO--INITIALIZE STORAGE
JUMPL T2,SRTRD2 ;JUMP IF SORT BUFFER NOT FULL YET
HRRZ P3,T1 ;POINT TO FILE BLOCK IN DATA FILE BUFFER
HRRZ P4,T2 ;AND TO THE LAST ONE IN THE SORT BUFFER
PUSHJ P,SRTCMP ;COMPARE THE TWO
JRST SRTRD4 ;ALREADY IN PROPER ORDER
MOVE T1,SRTDPT ;RELOAD DATA FILE BUFFER POINTER
MOVE T2,SRTSPT ;AND SORT BUFFER POINTER
SRTRD2: MOVSI T3,(T1) ;POINT TO A FILE BLOCK
HRRI T3,(T2) ;AND TO STORAGE
MOVEI T4,(T2) ;COPY ADDRESS
ADD T4,.DFFBL(D) ;COMPUTE END OF BLT
BLT T3,-1(T4) ;COPY FILE BLOCK INTO SORT BUFFER
AOS SRTCHG ;REMEMBER THE CHANGE
JUMPG T2,SRTRD3 ;JUMP IF AT END OF SORT BUFFER
AOS SRTFBN ;COUNT ENTRIES IN SORT BUFFER
ADD T2,[1,,0] ;COUNT ENTRIES
SKIPG T2 ;NEVER POINT BEYOND LAST ENTRY
ADD T2,.DFFBL(D) ;ADVANCE POINTER
MOVEM T2,SRTSPT ;UPDATE
JRST SRTRD4 ;ONWARD
SRTRD3: PUSHJ P,SRTCOR ;MAINTAIN PROPER ORDER
MOVSI T1,400000 ;GET A BIT
IORM T1,SRTCHG ;FLAG NO SORT NEEDED AT END OF PASS
SRTRD4: MOVE T1,SRTDPT ;RELOAD DATA FILE BUFFER POINTER
ADD T1,.DFFBL(D) ;ADVANCE TO NEXT STORAGE
ADD T1,[1,,0] ;...
MOVEM T1,SRTDPT ;UPDATE POINTER
JRST SRTRD1 ;LOOP BACK FOR NEXT FILE BLOCK
SRTRD5: POP P,P4 ;RESTORE P4
POP P,P3 ;RESTORE P3
SKIPN SRTCHG ;ANYTHING CHANGE THIS TIME?
POPJ P, ;NO--ALL DONE
SKIPL SRTCHG ;NEED SORT NOW?
PUSHJ P,SRTCOR ;YES
JRST CPOPJ1 ;RETURN
;WRITE SORTED FILE BLOCK LINKS TO DATA FILE
;CALL: PUSHJ P,SRTWTF
; <RETURN>
SRTWTF: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVN P1,SRTFBN ;GET -VE FILE BLOCK IN BUFFER
AOS P1 ;LOOP FROM 0 TO N-1
HRLZS P1 ;PUT IN LH
MOVE P2,SRTMEM+1 ;POINT TO START OF BUFFER
SKIPN T1,.DFLSF(D) ;HAVE A LAST SORTED FILE?
JRST SRTWT1 ;NO
SUB P1,[1,,1] ;PRE-DECREMENT
SUB P2,.DFFBL(D) ;...
JRST SRTWT2 ;ENTER LOOP
SRTWT1: LDB T1,[POINTR (.FBIDN(P2),FB.NUM)] ;GET FILE NUMBER FROM BUFFER
SKIPE .DFFSF(D) ;ALREADY SET FIRST SORTED FILE BLOCK NUMBER?
JRST SRTWT2 ;YES
MOVEM T1,.DFFSF(D) ;SET IT NOW
PUSHJ P,D$WHDR ;UPDATE THE DATA FILE HEADER
SRTWT2: AOBJP P1,SRTWT3 ;DON'T WALK OFF THE END OF THE EARTH
PUSHJ P,D$FNUM ;READ THAT FILE BLOCK FROM DATA FILE
STOPCD (SLF,<Sort LOOKUP failed by file number>,)
ADD P2,.DFFBL(D) ;OFFSET TO NEXT FILE BLOCK
LDB T3,[POINTR (.FBIDN(P2),FB.NUM)] ;GET FILE NUMBER FROM BUFFER
DPB T3,[POINTR (.FBIDN(T1),FB.SRT)] ;SET SORT LINK
MOVE T1,T2 ;GET DATA FILE BLOCK NUMBER
MOVE T2,[IOWD BLKSIZ,DATBUF] ;IOWD
PUSHJ P,D$WRIT ;UPDATE DATA FILE
SRTWT3: LDB T1,[POINTR (.FBIDN(P2),FB.NUM)] ;GET FILE NUMBER
MOVEM T1,.DFLSF(D) ;SET AS LAST SORTED FILE
PUSHJ P,D$WHDR ;UPDATE HEADER
JUMPL P1,SRTWT1 ;LOOP FOR ALL FILE BLOCKS IN SORT BUFFER
POPJ P, ;RETURN
;ROUTINE TO ZERO OUT THE FILE BLOCK SORT LINKS IN THE DATA FILE
;CALL: PUSHJ P,SRTZER
; <RETURN>
SRTZER: INFO (ZSL,.+1,<Zeroing file block sort links>,)
PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,.DFFIL(D) ;GET START OF FILE BLOCKS IN DATA FILE
MOVE P2,.DFFBN(D) ;GET COUNT OF FILE BLOCKS
SRTZE1: MOVE T1,P1 ;GET DATA FILE BLOCK NUMBER
MOVE T2,[IOWD BLKSIZ,DATBUF] ;IOWD
PUSHJ P,D$READ ;READ A BLOCK
HLLZ T1,.DFFBB(D) ;GET -VE FILE BLOCKS PER DISK BLOCK
MOVEI T2,DATBUF ;INCLUDE STARTING ADDRESS
MOVEI T3,0 ;GET A ZERO
SRTZE2: DPB T3,[POINTR (.FBIDN(T2),FB.SRT)] ;ZERO LINK
ADD T2,.DFFBL(D) ;ADVANCE TO NEXT FILE BLOCK
SOSLE P2 ;COUNT DOWN FILE BLOCKS
AOBJN T1,SRTZE2 ;LOOP FOR ALL FILE BLOCKS IN BUFFER
SRTZE3: MOVE T1,P1 ;GET DATA FILE BLOCK NUMBER
MOVE T2,[IOWD BLKSIZ,DATBUF] ;IOWD
PUSHJ P,D$WRIT ;UPDATE BLOCK
SKIPLE P2 ;ALL LINKDS ZEROSD?ED?
AOJA P1,SRTZE1 ;NO--ADVANCE TO NEXT DATA FILE BLOCK
SETZM .DFFSF(D) ;ZAP FIRST SORTED FILE BLOCK NUMBER
SETZM .DFLSF(D) ;AND THE LAST ONE TOO
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$FILE - OPEN DATA FILE
;OPEN DATA FILE
;CALL: MOVE T1, SCAN BLOCK ADDRESS
; PUSHJ P,D$FILE
; <NON-SKIP> ;ERROR
; <SKIP> ;FILE OPENED
D$FILE: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,T1 ;COPY SCAN BLOCK ADDRESS
MOVEI P2,0 ;ASSUME FILE DOES NOT EXIST YET
PUSHJ P,DATINI ;INITIALIZE LOOKUP/ENTER BLOCKS
OPEN DATCHN,DATOPN ;OPEN A CHANNEL
FATAL (COD,CPOPJ,<Cannot OPEN data file I/O channel>,)
LOOKUP DATCHN,DATLEB ;SEE IF THE FILE ALREADY EXISTS
SKIPA T2,DATLEB+.RBEXT ;INVESTIGATE ERROR
AOJA P2,DFILE1 ;ALREADY EXISTS
HRRZS T2 ;ISOLATE ERROR CODE
MOVE T1,P1 ;GET SCAN BLOCK ADDRESS BACK
CAIN T2,ERFNF% ;FILE NOT FOUND?
JRST DFILE3 ;GO CREATE FILE
FATAL (LKE,CPOPJ,<LOOKUP error (>,E..LKE)
E..LKE: MOVE T1,T2 ;GET ERROR CODE
PUSHJ P,T$OCTW ;PRINT IT
XMOVEI T1,[ASCIZ /) for /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,P1 ;GET SCAN BLOCK ADDRESS
PJRST T$FILE ;PRINT IT AND RETURN
;HERE WHEN FILE ALREADY EXISTS
DFILE1: SKIPN .DFSTR(D) ;ALREADY KNOW STRUCTURE?
JRST DFILE4 ;READ EXISTING FILE
WARN (DFI,.+1,<Data file already exists which may contain different parameters>,)
MOVEI T1,[ASCIZ / Supersede existing file/]
MOVEI T2,0 ;ASSUME "NO"
PUSHJ P,C$AYNQ ;ASK YES/NO QUESTION
JUMPE T2,DFILE4 ;JUMP IF "NO"
DFILE2: PUSHJ P,DATDEL ;DELETE THE OLD FILE
POPJ P, ;FAILED
MOVEI P2,0 ;FLAG NON-EXISTANT FILE NOW
DFILE3: PUSHJ P,DATCRE ;CREATE A NEW FILE
POPJ P, ;FAILED
DFILE4: PUSHJ P,DATUPD ;SET UPDATE MODE
POPJ P, ;FAILED
SETOM DATACT ;INDICATE DATA FILE ACTIVE (OPEN)
JUMPE P2,DFILEX ;JUMP IF A NEW FILE
PUSHJ P,D$RHDR ;READ THE HEADER INTO CORE
SETOM STRFIL ;REMEMBER PARAMETERS COMING FROM DATA FILE
MOVE T1,.DFSTR(D) ;GET STRUCTURE NAME
INFO (IPS,.+1,<Initializing parameters for structure >,T$SIXN)
PUSHJ P,DATFIX ;FIXUP SIMPLE VERSION SKEWS
POPJ P, ;CAN'T
PUSHJ P,UNIRST ;RESET UNIT PARAMETERS
PUSHJ P,STRUC1 ;ENTER STRUCTURE LOOP
DFILEX: PUSHJ P,D$WHDR ;UPDATE HEADER
JRST CPOPJ1 ;RETURN
;ALLOCATE FILE BLOCKS FROM DATA FILE VARIABLE STORAGE
DATFBX: MOVE T1,.DFLVL(D) ;GET MAXIMUM SFD LEVEL
ADDI T1,.FBMIN ;PLUS MINUMUM LENGTH OF A FILE BLOCK
MOVEM T1,.DFFBL(D) ;SAVE IT
MOVEI T1,BLKSIZ ;GET DISK BLOCK SIZE
IDIV T1,.DFFBL(D) ;COMPUTE NUMBER OF FILE BLOCKS PER DISK BLOCK
MOVEM T1,.DFFBB(D) ;SAVE
MOVNS T1 ;NEGATE
HRLM T1,.DFFBB(D) ;SAVE IT TOO
MOVE T1,.DFFBL(D) ;GET FILE BLOCK LENGTH
PUSHJ P,D$VGET ;ALLOCATE A RETURNED FILESPEC FILE BLOCK
MOVEM T2,.DFRFB(D) ;SAVE OFFSET
MOVE T1,.DFFBL(D) ;GET FILE BLOCK LENGTH
PUSHJ P,D$VGET ;ALLOCATE ONE TEMP FILE BLOCK
MOVEM T2,.DFFBT(D) ;SAVE OFFSET
POPJ P, ;RETURN
DATINI: MOVEI T1,.IODMP ;DUMP MODE
MOVEM T1,DATOPN+.OPMOD
MOVE T1,.SBDEV(P1) ;DEVICE
MOVEM T1,DATOPN+.OPDEV
SETZM DATOPN+.OPBUF ;NO BUFFERS
MOVEI T1,.RBMAX ;LOOKUP/ENTER BLOCK LENGTH
MOVEM T1,DATLEB+.RBCNT
SKIPE T1,.SBDIR(P1) ;NON-ZERO PATH?
MOVEI T1,DATPTH ;PATH BLOCK ADDRESS
MOVEM T1,DATLEB+.RBPPN
MOVE T1,.SBNAM(P1) ;FILE NAME
MOVEM T1,DATLEB+.RBNAM
HLLZ T1,.SBEXT(P1) ;EXTENSION
MOVEM T1,DATLEB+.RBEXT
MOVSI T2,-<.PTMAX-.PTPPN>+1 ;-VE WORD COUNT
HRRI T2,DATPTH+.PTPPN ;STORAGE ADDRESS
MOVEI T3,.SBDIR(P1) ;POINT TO PATH
DATIN1: MOVE T1,(T3) ;GET A WORD
MOVEM T1,(T2) ;PUT A WORD
ADDI T3,2 ;ADVANCE TO NEXT LEVEL
AOBJN T2,DATIN1 ;LOOP FOR ALL LEVELS
SETZM (T2) ;TERMINATE PATH
MOVE T1,JOBVER ;VERSION NUMBER
MOVEM T1,DATLEB+.RBVER
MOVE T1,[OURNAM] ;OUR NAME
MOVEM T1,DATLEB+.RBSPL
MOVSI T1,(RB.DEC) ;DEC FORMATTED FILE
MOVEI T2,.RBDBI ;BINARY (IMAGE) FILE
DPB T2,[POINTR (T1,RB.DTY)]
MOVEM T1,DATLEB+.RBTYP
SETZ T1, ;CLEAR DESTINATION
MOVEI T2,44 ;BYTE SIZE
DPB T2,[POINTR (T1,RB.BSZ)]
MOVEI T2,.RBRVR ;VARIABLE LENGTH RECORDS
DPB T2,[POINTR (T1,RB.RFM)]
MOVEI T2,.RBRRL ;RELATIVE RECORD STRUCTURE
DPB T2,[POINTR (T1,RB.RFO)]
MOVEM T1,DATLEB+.RBBSZ
GETPPN T1, ;OUR PPN
JFCL ;INCASE OF JACCT
MOVEM T1,DATLEB+.RBAUT
MOVE T1,.DFSIZ(D) ;GET WORD COUNT
MOVNS T1 ;NEGATE
HRLZS T1 ;PUT IN LH
HRRI T1,DATHDR-1 ;MAKE AN IOWD
MOVEM T1,DATIOW ;SAVE FOR LATER
SETZM DATIOW+1 ;TERMINATE LIST
POPJ P, ;RETURN
;CREATE DATA FILE
DATCRE: CLOSE DATCHN, ;CLEAN UP
PUSHJ P,DATINI ;RESET BLOCKS
ENTER DATCHN,DATLEB ;CREATE FILE
JRST DATCR1 ;FAILED
CLOSE DATCHN, ;MAKE IT APPEAR ON DISK
JRST CPOPJ1 ;AND RETURN
DATCR1: HRRZ T1,DATLEB+.RBEXT ;GET ERROR CODE
WARN (CCD,CPOPJ,<Cannot create data file; error >,T$OCTW)
;DELETE DATA FILE
DATDEL: SETZM DATLEB+.RBNAM ;ZAP FILE NAME
RENAME DATCHN,DATLEB ;DELETE THE FILE
SKIPA T1,DATLEB+.RBEXT ;FAILED
JRST CPOPJ1 ;RETURN
HRRZS T1 ;ISOLATE ERROR CODE
CAIN T1,ERFNF% ;FILE NOT FOUND??
JRST CPOPJ1 ;THEN NO ONE REALLY CARES
WARN (CDD,CPOPJ,<Cannot delete old data file; error >,T$OCTW)
;OPEN FILE FOR UPDATE
DATUPD: CLOSE DATCHN, ;CLEAN UP
PUSHJ P,DATINI ;RESET BLOCKS
LOOKUP DATCHN,DATLEB ;FIND THE FILE
SKIPA ;FAILED
ENTER DATCHN,DATLEB ;SET UPDATE MODE
SKIPA T1,DATLEB+.RBEXT ;FAILED
JRST CPOPJ1 ;RETURN
WARN (CUF,CPOPJ,<Cannot update data file; error >,T$OCTW)
DATFIX: PUSHJ P,SAVE1 ;SAVE P1
MOVE T1,.DFFMT(D) ;GET FILE FORMAT
CAIE T1,%FMT ;COMPATIBLE?
FATAL (FFI,CPOPJ,<File format incompatibility>,)
MOVSI T1,(Z 0,@(17)) ;GET MASK OF JUNK IN THE BP
ANDCAM T1,.DFCKP(D) ;CLEAR
ANDCAM T1,.DFCLP(D) ; JUNK
ANDCAM T1,.DFCNP(D) ; ...
MOVEI T1,R ;GET OUR AC FOR BP MANIPULATIONS
HRRM T1,.DFCKP(D) ;UPDATE
HRRM T1,.DFCLP(D) ; ...
HRRM T1,.DFCNP(D) ; ...
MOVNI P1,1 ;INIT A FLAG
DATFI1: MOVSI T1,.DFDFM(D) ;POINT TO KEYWORD IN HEADER
SKIPN .DFDFM(D) ;ANYTHING SET?
MOVSI T1,DEFDMP ;POINT TO DEFAULT DUMP KEYWORD
HRRI T1,.DFDFM(D) ;MAKE A BLT POINTER
BLT T1,.DFDFM+MAXHKS-1(D) ;COPY
XMOVEI T1,.DFDFM(D) ;POINT TO KEYWORD
XMOVEI T2,DUMP.N ;AND KEYWORD TABLE
PUSHJ P,C$KEYW ;FIND NAME
WARN (CDF,DATFI2,<Cannot set default DUMP format to >,T$STRG)
DPB T2,[POINTR (.DFFLG(D),DF.DMP)] ;SET DEFAULT DUMP FORMAT
MOVNI P1,1 ;RESET FLAG
JRST DATFI3 ;ONWARD
DATFI2: AOSE P1 ;FIRST TIME HERE
STOPCD (CDF,<Cannot determine default DUMP format>,)
SETZM .DFDFM(D) ;FORCE A NEW DEFAULT
XMOVEI T1,DEFDMP ;POINT TO DEFAULT
WARN (RDD,DATFI1,<Resetting default to >,T$STRG)
DATFI3: MOVSI T1,.DFFAC(D) ;POINT TO KEYWORD IN HEADER
SKIPN .DFFAC(D) ;ANYTHING SET?
MOVSI T1,DEFFAC ;POINT TO DEFAULT DUMP KEYWORD
HRRI T1,.DFFAC(D) ;MAKE A BLT POINTER
BLT T1,.DFFAC+MAXHKS-1(D) ;COPY
XMOVEI T1,.DFFAC(D) ;POINT TO KEYWORD
XMOVEI T2,FLKP.N ;AND KEYWORD TABLE
PUSHJ P,C$KEYW ;FIND NAME
WARN (CFA,DATFI4,<Cannot set FILE-ACCESS type to >,T$STRG)
DPB T2,[POINTR (.DFFLG(D),DF.FAC)] ;SET FILE ACCESS TYPE
JRST DATFI5 ;ONWARD
DATFI4: AOSE P1 ;FIRST TIME HERE
STOPCD (CFA,<Cannot determine default FILE-ACCESS type>,)
SETZM .DFFAC(D) ;FORCE A NEW DEFAULT
XMOVEI T1,DEFFAC ;POINT TO DEFAULT
WARN (RDF,DATFI3,<Resetting default to >,T$STRG)
JRST DATFI3 ;AND TRY AGAIN
DATFI5: JRST CPOPJ1 ;RETURN
DEFINE KEYS,<
KEY (NO ,DFILE2, , , , ,<Supersede file>)
KEY (YES ,DFILE4, , , , ,<Use existing file>)
>
KEYTAB (FILE,<TBL,NAM,PRC,HLP>)
SUBTTL DATA FILE PROCESSING -- D$INIT - INITIALIZE PARAMETERS
D$INIT: SETZM DATACT ;SAY FILE NOT ACTIVE
CLOSE DATCHN, ;CLOSE AND
RELEAS DATCHN, ; RELEASE CHANNEL
MOVEI D,DATHDR ;POINT TO INCORE HEADER STORAGE
MOVSI T1,0(D) ;GET START ADDRESS
HRRI T1,1(D) ;MAKE A BLT POINTER
SETZM (D) ;CLEAR FIRST WORD
BLT T1,.DFLEN-1(D) ;CLEAR ENTIRE BLOCK
MOVEI T1,%FMT ;FILE FORMAT
MOVEM T1,.DFFMT(D)
MOVE T1,[OURNAM] ;OUR NAME
MOVEM T1,.DFNAM(D)
MOVEI T1,.DFLEN ;LENGTH OF HEADER
MOVEM T1,.DFSIZ(D)
MOVEI T1,<.DFLEN/BLKSIZ>+1 ;NEXT BLOCK TO WRITE AT EOF
MOVEM T1,.DFEOF(D) ;SET LENGTH OF FILE AT EOF
MOVE T1,JOBVER ;VERSION
MOVEM T1,.DFVER(D)
MOVEI T1,DEFCPI ;DEFAULT CHECKPOINT INTERVAL
MOVEM T1,.DFCPI(D)
MOVEI T1,DEFPRD ;DEFAULT BLOCKS PER READ
MOVEM T1,.DFBPR(D)
MOVEI T1,DEFPSZ ;DEFAULT PATCH BUFFER SIZE
MOVEM T1,.DFDPS(D)
MOVEI T1,DEFSRT ;DEFAULT SORT BUFFER SIZE
MOVEM T1,.DFSRT(D)
MOVSI T1,(DF.LBP!DF.LBS) ;GET BITS TO SET
IORM T1,.DFFLG(D) ;ENABLE LOOKUP BY PRIME AND SPARE RIBS
PUSHJ P,DATFIX ;FIXUP/INIT SOME PARAMETERS
JFCL ;CAN'T FAIL HERE
MOVE T1,[%LDSFD] ;WANT MAXIMUM NUMBER OF SFD LEVELS
GETTAB T1, ;ASK MONITOR
MOVEI T1,5 ;ASSUME THE USUAL
MOVEM T1,.DFLVL(D) ;SAVE
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$RBTS - READ BOOT BLOCKS
D$RBTS: INFO (RBB,.+1,<Reading boot blocks>,)
PUSHJ P,SAVE3 ;SAVE SOME ACS
XMOVEI P1,.DFBTS(D) ;POINT TO BIT MAP STORAGE
MOVSI P2,-<NBOOTB+1> ;-VE COUNT FOR ALL BOOT BLOCKS
DRBTS1: SETZM (P1) ;START OFF CLEAN
MOVSI P3,400000 ;GET BIT FOR FIRST UNIT
MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
DRBTS2: HRRZ T1,P2 ;GET A BLOCK NUMBER
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;IOWD
PUSHJ P,U$READ ;READ THE BLOCK
IORM P3,(P1) ;REMEMBER THE ERROR
LSH P3,-1 ;POSITION BIT FOR NEXT UNIT
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,DRBTS2 ;LOOP FOR ALL UNITS
AOS P1 ;ADVANCE STORAGE
TRNN P2,-1 ;FIRST TIME HERE?
HRRI P2,FBOOTB-1 ;YES--SKIP SOME BLOCKS
AOBJN P2,DRBTS1 ;LOOP FOR ALL BLOCKS
PUSHJ P,D$WHDR ;UPDATE HEADER
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$RHOM - READ HOM BLOCKS
D$RHOM: INFO (RHM,.+1,<Reading HOM blocks>,)
MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
SETZM .DFHOM(D) ;START OFF CLEANLY
DRHOM1: MOVEI T1,CPYBUF ;POINT TO A SCRATCH BUFFER
PUSHJ P,F$UHOM ;READ HOM BLOCKS ON UNIT
JFCL ;WARNINGS ISSUED
MOVN T2,.UNLUN(U) ;GET LOGICAL UNIT
LSH T1,(T2) ;POSITION FOR THIS UNIT
IORM T1,.DFHOM(D) ;REMEMBER THE ERRORS
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,DRHOM1 ;LOOP BACK FOR MORE
PUSHJ P,D$WHDR ;UPDATE HEADER
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$RRIB - READ RETRIEVAL INFORMATION BLOCKS
;DEFINE LOCAL CHECKPOINT/RESTART DATA OFFSETS
.ORG 0
BLKNUM:! BLOCK 1 ;CURRENT BLOCK ON STRUCTURE
BLKCKP:! BLOCK 1 ;LAST CHECKPOINTED BLOCK NUMBER
BLKPTR:! BLOCK 1 ;FILE BLOCK BUFFER POINTER
BLKBUF:! BLOCK BLKSIZ ;FILE BLOCK BUFFER
IF1,<IFG <.-.DFCRD-CRDSIZ>,<PRINTX ?Checkpoint data overflow for D$RRIB>>
.ORG
D$RRIB: INFO (RRB,.+1,<Reading RIB blocks>,)
PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE T1,.DFBPR(D) ;GET BLOCKS PER READ REQUEST
IMULI T1,BLKSIZ ;COMPUTE WORDS NEEDED FOR BUFFER
PUSHJ P,M$GETW ;ALLOCATE CORE
MOVNS T1 ;NEGATE WORD COUNT
HRLZS T1 ;PUT IN LH
HRR T1,T2 ;INCLUDE ADDRESS
SUBI T1,1 ;MAKE AN IOWD
MOVEM T1,BUFPTR ;SAVE IT
MOVE P4,.DFCRD(D) ;GET OFFSET TO CHECKPOINT/RESTART DATA
ADDI P4,(D) ;RELOCATE
DRRIB1: MOVE T1,BLKNUM(P4) ;GET CURRENT POSITION ON STRUCTURE
DRRIB2: PUSHJ P,F$BLKU ;SET UP UNIT AND BLOCK ON UNIT
JRST DRRIB6 ;ILLEGAL BLOCK--END OF STRUCTURE
MOVE P2,BUFPTR ;GET IOWD
MOVE T2,P2 ;COPY IOWD
MOVSI T3,(UN.NER) ;BIT TO SET
IORM T3,.UNFLG(U) ;SILENCE I/O ERROR WARNINGS
PUSHJ P,U$READ ;READ A BUFFER
SKIPA ;FAILED
JRST DRRIB5 ;ONWARD
SETOM .UNBLK(U) ;FORCE REPOSITIONING
DRRIB3: MOVE T1,BLKNUM(P4) ;GET CURRENT POSITION
MOVE T2,P2 ;COPY FAILING IOWD
HRLI T2,-BLKSIZ ;MAKE IT A SINGLE BLOCK TRANSFER
PUSHJ P,U$READ ;TRY IT AGAIN
SKIPA T1,.UNIOS(U) ;GET I/O STATUS
JRST DRRIB4 ;SUCCESS
TRNE T1,IO.BKT!IO.EOF ;END OF DISK?
JRST DRRIB6 ;YES
AOS BLKNUM(P4) ;ADVANCE ONE BLOCK BEYOND THE ERROR
ADD P2,[BLKSIZ,,BLKSIZ] ;ACCOUNT FOR ONE BLOCK DIFFERENCE
SETOM .UNBLK(U) ;FORCE REPOSITIONING ON ERROR
JUMPGE P2,DRRIB2 ;DONE?
JRST DRRIB3 ;TRY THE NEXT BLOCK
DRRIB4: PUSH P,P2 ;SAVE IOWD
HRLI P2,-BLKSIZ ;ONLY DO ONE BLOCK
PUSHJ P,RRBCHK ;CHECK RIBS IN BUFFER
POP P,P2 ;RESTORE POINTER
AOS BLKNUM(P4) ;ADVANCE TO NEXT BLOCK
ADD P2,[BLKSIZ,,BLKSIZ] ;ACCOUNT FOR ONE BLOCK DIFFERENCE
JUMPL P2,DRRIB3 ;CONTINUE IOWD BREAKDOWN IF IOWD OK
JRST DRRIB1 ;ELSE START FRESH
DRRIB5: PUSHJ P,RRBCHK ;CHECK RIBS IN BUFFER
MOVE T1,.DFBPR(D) ;GET BLOCKS PER READ
ADDM T1,BLKNUM(P4) ;ADVANCE
JRST DRRIB1 ;LOOP BACK
DRRIB6: PUSHJ P,RRBFIN ;WRITE OUT REMAINDER OF FILE BLOCK BUFFER
HLRE T1,BUFPTR ;GET -VE WORD COUNT
MOVMS T1 ;MAKE POSITIVE
HRRZ T2,BUFPTR ;GET ADDRESS-1
AOS T2 ;ADJUST
PUSHJ P,M$GIVW ;DEALLOCATE CORE
POPJ P, ;RETURN
RRBCHK: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,BLKNUM(P4) ;GET CURRENT BLOCK ON STRUCTURE
AOS P2 ;MAKE IOWD INTO AOBJN POINTER
RRBCH1: MOVE T1,P1 ;GET BLOCK ON STRUCTURE
HRRZ T2,P2 ;AND ADDRESS OF RIB IN CORE
PUSHJ P,F$VRIB ;VALIDATE RIB
JRST RRBCH2 ;NOT A RIB
MOVE P3,T1 ;COPY RESULTS
PUSHJ P,RRBSTO ;STORE THIS RIB
RRBCH2: AOS P1 ;ADVANCE BLOCK NUMBER
ADD P2,[BLKSIZ,,BLKSIZ] ;ADVANCE TO NEXT BLOCK
JUMPL P2,RRBCH1 ;LOOP BACK IF MORE
POPJ P, ;ELSE ALL DONE
RRBDIR: PUSH P,U ;SAVE UNIT
MOVE T4,.DFLVL(D) ;GET MAXIMUM SFD LEVEL
AOS T4 ;PLUS ONE FOR THE PPN
SKIPA T1,RIBUFD(P2) ;ENTER LOOP
RRBDI1: MOVE T1,RIB+RIBUFD ;GET BLOCK NUMBER OF PARENT DIRECTORY
PUSHJ P,F$BLKU ;SET UP UNIT AND BLOCK ON UNIT
JRST RRBDI3 ;ILLEGAL BLOCK--SAY MISSING PARENT DIRECTORY
MOVE T2,[IOWD BLKSIZ,RIB] ;IOWD
MOVSI T3,(UN.NER) ;BIT TO SET
IORM T3,.UNFLG(U) ;SILENCE I/O ERROR WARNINGS
PUSHJ P,U$READ ;READ THAT BLOCK
JRST RRBDI2 ;GIVE UP ON I/O ERRORS
SKIPE T1,RIB+RIBUFD ;GET PARENT DIRECTORY BLOCK NUMBER
SKIPN T2,RIB+RIBNAM ;GET DIRECTORY NAME
JRST RRBDI3 ;WEEK OUT POTENTIAL JUNK
; MOVE T1,RIB+RIBPPN ;GET PPN
; TLNE T1,-1 ;CAN'T HAVE A ZERO PROJECT NUMBER
; TRNN T1,-1 ;OR A ZERO PROGRAMMER NUMBER
; JRST RRBDI3 ;JUNK
CAME T1,RIBUFD(P2) ;FOUND OURSELVES?
CAMN T2,.DFMFD(D) ;OR THE MFD?
JRST RRBDI4 ;YES--EXIT LOOP
PUSH P,T2 ;SAVE
SOJGE T4,RRBDI1 ;LOOP
TLO P3,(FB.SFD) ;SFDS NESTED TOO DEEPLY
MOVN T4,.DFLVL(D) ;GET -VE MAXIMUM SFD LEVEL
SOS T4 ;PLUS ONE FOR THE PPN
HRLS T4 ;PUT IN BOTH HALVES
ADD P,T4 ;PHASE STACK
JRST RRBDI5 ;GO FINISH UP
RRBDI2: TLO P3,(FB.IOE) ;I/O ERROR WHILE SCANNING DIRECTORY TREE
RRBDI3: TLO P3,(FB.MPD) ;MISSING PARENT DIRECTORY
RRBDI4: SUB T4,.DFLVL(D) ;COMPUTE LEVELS FOUND
SOJE T4,RRBDI5 ;INCLUDE THE PPN AND JUMP IF A UFD
HRLZS T4 ;GET -VE PPN+SFD LEVEL COUNT IN LH
HRR T4,BLKPTR(P4) ;GET CURRENT FILE BLOCK STORAGE OFFSET
ADDI T4,BLKBUF+.FBPPN(P4) ;OFFSET TO PPN WORD
MOVE T1,(P) ;ONE LAST SANITY CHECK ON THE PPN
TLNE T1,-1 ;CAN'T HAVE A ZERO PROJECT NUMBER
TRNN T1,-1 ;OR A ZERO PROGRAMMER NUMBER
MOVE T1,BLKBUF+.FBPPN(P4) ;JUNK SO DON'T MAKE THINGS WORSE
MOVEM T1,(P) ;UPDATE
POP P,(T4) ;GET A DIRECTORY NAME BACK
AOBJN T4,.-1 ;LOOP FOR ALL LEVELS
RRBDI5: POP P,U ;RESTORE U
POPJ P, ;RETURN
RRBSTO: SKIPE T1,BLKPTR(P4) ;AOBJN POINTER SETUP?
JRST RRBST1 ;ALREADY DONE
MOVSI T1,BLKBUF(P4) ;START OF BUFFER
HRRI T1,BLKBUF+1(P4) ;MAKE A BLT POINTER
SETZM BLKBUF(P4) ;CLEAR FIRST WORD
BLT T1,BLKBUF+BLKSIZ-1(P4) ;CLEAR ENTIRE BLOCK
HLLZ T1,.DFFBB(D) ;SET IT UP NOW
MOVEM T1,BLKPTR(P4) ;UPDATE
;OVERHEAD WORDS
RRBST1: ADDI T1,BLKBUF(P4) ;OFFSET TO FIRST STORAGE IN BUFFER
AOS T2,.DFFBN(D) ;ASSIGN NEXT FILE BLOCK NUMBER
DPB T2,[POINTR (.FBIDN(T1),FB.NUM)] ;STORE IT
MOVEM P1,.FBBLK(T1) ;SAVE BLOCK NUMBER FOR THIS RIB
MOVE T2,RIBUFD(P2) ;BLOCK NUMBER WITHIN OWNING DIRECTORY
MOVEM T2,.FBUFD(T1) ;SAVE
;FILE ATTRIBUTE WORDS
RRBST2: MOVEM P3,.FBFLG(T1) ;SAVE FLAGS
MOVE T2,RIBNAM(P2) ;FILE NAME
MOVEM T2,.FBNAM(T1)
LDB T2,[POINT 9,RIBPRV(P2),8] ;PROTECTION CODE
HLL T2,RIBEXT(P2) ;EXTENSION
MOVEM T2,.FBEXT(T1)
LDB T2,[POINT 3,RIBEXT(P2),20] ;GET HIGH DATE
LSH T2,14 ;POSITION IT
LDB T3,[POINT 12,RIBPRV(P2),35] ;GET LOW DATE
ADD T2,T3
HRLZS T2 ;PUT IN LH
LDB T3,[POINT 11,RIBPRV(P2),23] ;GET MINUTES SINCE MIDNIGHT
IOR T2,T3 ;MERGE THE TWO
MOVEM T2,.FBCRE(T1) ;SAVE DATE,,TIME
MOVE T2,RIBVER(P2) ;VERSION
MOVEM T2,.FBVER(T1)
MOVE T2,RIBALC(P2) ;FILE ALLOCATION
MOVEM T2,.FBALC(T1)
MOVE T2,RIBPPN(P2) ;PPN
MOVEM T2,.FBPPN(T1)
PUSHJ P,RRBDIR ;SCAN DIRECTORY TREE
;END OF FILE BLOCK PROCESSING
RRBST3: MOVE T1,.DFFBL(D) ;GET LENGTH OF A FILE BLOCK
HRLI T1,1 ;JUST ONE BLOCK
ADDB T1,BLKPTR(P4) ;ADVANCE POINTER
JUMPGE T1,RRBST4 ;JUMP AND WRITE BLOCK OUT IF FULL
PJRST D$WHDR ;ELSE JUST UPDATE HEADER WITH NEW BLKPTR
RRBST4: MOVE T1,BLKNUM(P4) ;GET CURRENT BLOCK
MOVEM T1,BLKCKP(P4) ;SAVE AS LAST CHECKPOINTED BLOCK
SETZM BLKPTR(P4) ;RESET POINTER FOR NEXT TIME
MOVE T1,.DFEOF(D) ;GET EOF POINTER
SKIPN .DFFIL(D) ;ALREADY HAVE OFFSET TO FILE BLOCK STORAGE?
MOVEM T1,.DFFIL(D) ;NO--SET IT NOW
MOVEI T2,BLKBUF-1(P4) ;POINT TO START OF BLOCK -1
HRLI T2,-BLKSIZ ;MAKE AN IOWD
PJRST D$WRIT ;WRITE THE BLOCK OUT AND RETURN
RRBFIN: MOVE T1,.DFEOF(D) ;GET EOF POINTER
SKIPN .DFFIL(D) ;ALREADY HAVE OFFSET TO FILE BLOCK STORAGE?
MOVEM T1,.DFFIL(D) ;NO--SET IT NOW
SETZM BLKPTR(P4) ;ZAP POINTER
MOVEI T2,BLKBUF-1(P4) ;POINT TO START OF BLOCK -1
HRLI T2,-BLKSIZ ;MAKE AN IOWD
PJRST D$WRIT ;WRITE THE BLOCK OUT AND RETURN
SUBTTL DATA FILE PROCESSING -- D$RSAT - READ SAT BLOCKS
D$RSAT: INFO (RSB,.+1,<Reading SAT blocks>,)
PUSHJ P,SAVE3 ;SAVE SOME ACS
XMOVEI P1,SATBUF ;POINT TO SAT BUFFERS, ETC.
PUSHJ P,DRSATZ ;INITIALIZE PARAMETERS
PUSHJ P,DRSATA ;ALLOCATE DATA FILE STORAGE FOR SATS
PUSHJ P,DRSATR ;READ SAT.SYS RIB
POPJ P, ;FAILED (ERROR MESSAGE ALREADY ISSUED)
MOVE P2,.DFSAT(D) ;GET -VE COUNT,,OFFSET
ADDI P2,(D) ;RELOCATE
SETZ P3, ;INIT CLUSTER COUNTER
DRSAT1: MOVSI T1,(P1) ;POINT TO BUFFERS, ETC.
MOVSI T1,0(P1) ;POINT TO START OF SAT BUFFERS, ETC.
HRRI T1,1(P1) ;MAKE A BLT POINTER
SETZM (P1) ;CLEAR FIRST WORD
BLT T1,.SDLEN-1(P1) ;CLEAR STORAGE
MOVSI T1,(P2) ;POINT TO INCORE DATA
HRRI T1,(P1) ;AND BUFFER AREA
BLT T1,.SDMIN-1(P1) ;LOAD BUFFERS, ETC.
PUSHJ P,DRSATC ;COMPUTE & STORE CLUSTERS AND WORDS PER SAT
PUSH P,.SDWPS(P1) ;SAVE WORDS PER SAT
PUSH P,.SDSCN(P1) ;AND INITIAL SCANNING POINTER
MOVSI T1,(P1) ;POINT TO BUFFERS, ETC.
HRRI T1,(P2) ;AND TO INCORE DATA
BLT T1,.SDMIN-1(P2) ;UPDATE
PUSHJ P,F$RSAT ;READ SAT FROM DISK
SKIPA ;FAILED
PUSHJ P,SATCND ;COUNT FREE CLUSTERS
POP P,.SDSCN(P1) ;RESTORE INITIAL SCANNING POINTER
POP P,.SDWPS(P1) ;AND WORDS PER SAT
MOVEM P3,.SDFIR(P1) ;SAVE STARTING CLUSTER NUMBER
ADD P3,.SDCPS(P1) ;GET LAST CLUSTER + 1
MOVE T1,P3 ;MAKE A COPY
SUBI T1,1 ;THIS IS THE LAST CLUSTER IN THIS SAT
MOVEM T1,.SDLAS(P1) ;SAVE IT TOO
PUSHJ P,F$WSAT ;WRITE SAT TO DISK
JFCL ;DON'T CARE ABOUT ERRORS HERE
DRSAT2: ADDI P2,.SDMIN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P2,DRSAT1 ;LOOP FOR ALL SAT BLOCKS
PUSHJ P,D$WHDR ;UPDATE HEADER
POPJ P, ;RETURN
;ROUTINE TO ALLOCATE DATA FILE STORAGE FOR THE SATS
DRSATA: MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
SETZ P2, ;CLEAR COUNTER
ADD P2,.UNSPU(U) ;ADD SATS ON UNIT TO TOTAL
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,.-2 ;DO ALL UNIT BLOCKS
MOVEI T1,(P2) ;GET TOTAL NUMBER OF SAT BLOCKS
IMULI T1,.SDMIN ;COMPUTE SD WORDS TO KEEP IN CORE
SKIPN T2,.DFSAT(D) ;ALREADY HAVE OFFSET?
PUSHJ P,D$VGET ;ALLOCATE STORAGE
MOVNS P2 ;NEGATE
HRL T2,P2 ;GET -VE COUNT,,OFFSET
MOVEM T2,.DFSAT(D) ;STORE OFFSET
ADDI T2,(D) ;RELOCATE
MOVE P2,T2 ;COPY TO A SAFER PLACE
MOVEI P3,.DFSEB(D) ;POINT TO BYTE MAP
HRLI P3,(POINT 9,,8) ;MAKE A BYTE POINTER
SETZM .DFNSB(D) ;CLEAR SAT BLOCK COUNT
DRSAA1: MOVSI T1,0(P1) ;POINT TO START OF SAT BUFFERS, ETC.
HRRI T1,1(P1) ;MAKE A BLT POINTER
SETZM (P1) ;CLEAR FIRST WORD
BLT T1,.SDLEN-1(P1) ;CLEAR STORAGE
AOS T1,.DFNSB(D) ;GET SAT BLOCK NUMBER
MOVEM T1,.SDNUM(P1) ;STORE IT
SKIPN T1,.SDBLK(P2) ;GET POSITION OF THIS SD IN DATA FILE
MOVE T1,.DFEOF(D) ;NOT SET UP YET, SO USE EOF
MOVEM T1,.SDBLK(P1) ;REMEMBER FOR LATER
SETZ T1, ;GET A ZERO
IDPB T1,P3 ;CLEAR ERROR CODE
MOVEM P3,.SDERR(P1) ;STORE BYTE POINTER FOR ERROR REPORTING
MOVSI T1,(P1) ;POINT TO BUFFERS, ETC.
HRRI T1,(P2) ;AND TO IN CORE STORAGE
BLT T1,.SDMIN-1(P2) ;COPY DATA
MOVE T1,.SDBLK(P1) ;GET DATA FILE POSITION
MOVEI T2,-1(P1) ;POINT TO START OF BUFFERS, ETC.
HRLI T2,-.SDLEN ;MAKE AN IOWD
PUSHJ P,D$WRIT ;WRITE THE BLOCK OUT
DRSAA2: ADDI P2,.SDMIN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P2,DRSAA1 ;LOOP FOR ALL SAT BLOCKS
PUSHJ P,D$WHDR ;WRITE HEADER OUT
POPJ P, ;RETURN
;ROUTINE TO COMPUTE THE NUMBER OF CLUSTERS AND WORDS PER SAT
DRSATC: MOVE U,.SDUNI(P1) ;GET UNIT
IMULI U,.UNLEN ;TIMES WORDS PER UNIT
ADDI U,.DFUNI(D) ;INDEX INTO UNIT DATA STORAGE
MOVE T1,.UNUSZ(U) ;GET BLOCKS ON THIS UNIT
IDIV T1,.DFBPC(D) ;DIVIDE BY BLOCKS PER CLUSTER
SOS T1 ;MINUS ONE
IDIV T1,.UNSPU(U) ;DIVIDE BY SATS PER UNIT
MOVEM T1,.SDCPS(P1) ;STORE CLUSTERS-1 PER SAT
AOS .SDCPS(P1) ;CORRECT OFF-BY-ONE
IDIVI T1,44 ;DIVIDE BY BITS PER WORD
ADDI T1,1 ;ROUND UP
MOVNS T1 ;NEGATE
HRLZM T1,.SDWPS(P1) ;STORE -VE WORDS PER SAT,,0
HRLZM T1,.SDSCN(P1) ;STORE INITIAL POINTER FOR SAT SCANNING
POPJ P, ;RETURN
;ROUTINE TO READ THE RIB OF SAT.SYS
DRSATR: MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;INITIALIZE IT
MOVSI T2,SATFIL ;POINT TO SCAN BLOCK
HRRI T2,(T1) ;AND TO DESTINATION
BLT T2,SATFLL-1(T1) ;COPY INTO WORKING STORAGE
MOVE T1,[1,,.IODMP] ;MODE = DISK-DIRECTORY LOOKUP, DUMP I/O
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;IOWD
PUSHJ P,F$INI ;INITIALIZE FOR FILE I/O
FATAL (IOF,CPOPJ,<I/O set up failed for >,T$FERR)
MOVE T2,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T2,(D) ;RELOCATE
PUSHJ P,F$LKP ;FIND A FILE
JRST DRSAR1 ;GO REPORT ERROR
SETZ T1, ;WANT TO READ THE PRIME RIB
PUSHJ P,F$POS ;POSITION
JRST DRSAR1 ;REPORT ERROR
PUSHJ P,F$IBUF ;READ THE PRIME RIB
JRST DRSAR1 ;FAILED
MOVE T1,CPYBUF+RIBSLF ;GET BLOCK NUMBER OF RIB
MOVEM T1,.DFSRB(D) ;SAVE FOR FILE SERVICE
JRST DRSAR2 ;ONWARD
DRSAR1: CAIN T1,FEFNF% ;FILE NOT FOUND?
SKIPA T2,.DFINP(D) ;MUST USE INPUT SPEC
MOVE T2,.DFRSB(D) ;ELSE USE TRANSLATION SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (SIF,.+1,<SAT initialization failure; >,T$FERR)
PUSHJ P,DRSATZ ;RESET CRITICAL PARAMETERS
PJRST F$FIN ;CLEAN UP AND RETURN
DRSAR2: PUSHJ P,F$CLOS ;CLOSE FILE
JFCL ;IGNORE ERRORS
PUSHJ P,F$FIN ;CLEAN UP
MOVE P2,.DFSAT(D) ;GET -VE COUNT,,OFFSET
ADDI P2,(D) ;RELOCATE
MOVE P3,CPYBUF+RIBFIR ;GET AOBJN POINTER TO RETRIEVAL POINTERS
ADDI P3,CPYBUF ;RELOCATE
MOVNI T4,1 ;SET FLAG TO IGNORE PRIME RIB
DRSAR3: SKIPN R,(P3) ;GET AN ENTRY
JRST DRSAR8 ;EOF
TDNE R,[-1-RIPNUB-MAXUNI] ;CHANGE OF UNIT POINTER?
JRST DRSAR4 ;NO
TRZ R,RIPNUB ;CLEAR CHANGE BIT
CAML R,.DFSTN(D) ;REASONABLE LOGICAL UNIT NUMBER?
FATAL (IUP,CPOPJ,<Invalid change of unit pointer in SAT.SYS RIB>,)
MOVEM R,.SDUNI(P2) ;SAVE UNIT NUMBER
JRST DRSAR5 ;CONTINUE BUT DON'T STEP TO NEXT SD
DRSAR4: AOJE T4,DRSAR5 ;JUMP IF FIRST REAL RETRIEVAL POINTER (RIB)
LDB T1,.DFCLP(D) ;GET CLUSTER ADDRESS
IMUL T1,.DFBPC(D) ;TRANSLATE TO BLOCK NUMBER
MOVEM T1,.SDUBN(P2) ;SAVE UNIT-RELATIVE BLOCK NUMBER
ADDI P2,.SDMIN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJP P2,DRSAR6 ;JUMP IF WE READ ALL EXPECTED SATS
DRSAR5: AOBJN P3,DRSAR3 ;READ ALL RETRIEVAL POINTERS
DRSAR6: SUBI P2,.SDMIN ;BACK OFF TO LAST SAT DESCRIPTOR
DRSAR7: AOBJP P3,.+2 ;CHECK FOR SAT.SYS TOO SHORT
SKIPN R,(P3) ;GET AN ENTRY
FATAL (PRS,CPOPJ,<Premature EOF reading SAT.SYS>,)
TDNN R,[-1-RIPNUB-MAXUNI] ;CHANGE OF UNIT POINTER?
JRST DRSAR7 ;IGNORE IT
SKIPE 1(P3) ;MORE VALID POINTERS?
FATAL (STB,CPOPJ,<SAT.SYS describes too many SAT blocks>,)
DRSAR8: MOVE T1,.DFNSB(D) ;GET NUMBER OF SAT BLOCKS EXPECTED
CAME T1,.SDNUM(P2) ;DID WE FIND THAT MANY?
FATAL (SCW,CPOPJ,<SAT block count wrong in RIB for SAT.SYS>,)
JRST CPOPJ1 ;RETURN
;INPUT SCAN BLOCK FOR SAT.SYS
SATFIL: EXP SB.DEV!SB.NAM!SB.EXT ;SCANNER FLAGS
EXP 'SYS ' ;DEVICE
EXP -1 ;DEVICE MASK
EXP 'SAT ' ;FILE NAME
EXP 0 ;FILE NAME MASK
XWD 'SYS',0 ;EXTENSION,,MASK
SATFLL==.-SATFIL ;LENGTH OF BLOCK
;ROUTINE TO ZERO OUT CRITICAL PARAMETERS
DRSATZ: SETZM .DFNSB(D) ;ZAP NUMBER OF SAT BLOCKS
SETZM .DFSRB(D) ;ZERO OUT BLOCK NUMBER FOR SAT.SYS RIB
MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,.-2 ;DO ALL UNIT BLOCKS
MOVSI T1,.DFSEB(D) ;POINT TO START OF ERROR BYTE STORAGE
HRRI T1,.DFSEB+1(D) ;MAKE A BLT POINTER
SETZM .DFSEB(D) ;CLEAR FIRST WORD
BLT T1,.DFSEB+<MAXSAT/4>-1(D) ;CLEAR ALL WORDS
POPJ P, ;RETURN
;ROUTINE TO COUNT BITS IN A SAT BLOCK
;CALL: MOVE T1, AOBJN POINTER TO BLOCK
; PUSHJ P,SATCN
; <RETURN> ;T2 := COUNT
SATCN: SETZ T2, ;T2 WILL COUNT 0'S FOUND
PUSH P,T3 ;SAVE T3
PUSH P,T4 ;SAVE T4
SATCN1: MOVE T3,(T1) ;COUNT 0-BITS IN 0(T1)
SETCMB T4,T3 ;ITS EASIER TO COUNT 1'S
LSH T4,-1 ;SHIFT RIGHT NOE BIT
AND T4,[333333,,333333] ;MASK OUT LEAST SIGNIFICANT BITS
SUB T3,T4
LSH T4,-1 ;SHIFT RIGHT ONE BIT
AND T4,[333333,,333333] ;MASK OUT MIDDLE BITS
SUBB T3,T4 ;EACH OCTAL DIGIT REPLACED BY # OF 1S IN IT
LSH T4,-3 ;SHIFT RIGHT ONE OCTAL DIGIT
ADD T3,T4 ;ADD NUMBERS IN DIGIT PAIRS
AND T3,[070707,,070707] ;THROUW OUT EXTRA PAIR SUMS
IDIVI T3,77 ;CASTING OUT 63S
ADDI T2,(T4) ;ACCUMULATE ANSWER IN T2
AOBJN T1,SATCN1 ;COUNT BITS IN NEXT WORD
POP P,T4 ;RESTORE T4
POP P,T3 ;RESTORE T3
POPJ P, ;RETURN
SATCNM: MOVEI T1,.SDMUL(P1) ;POINT TO MULTIPLY DEFINED SAT
SKIPA
SATCNC: MOVEI T1,.SDCOM(P1) ;POINT TO COMPUTED SAT
SKIPA
SATCND: MOVEI T1,.SDDSK(P1) ;POINT TO DISK SAT
HLL T1,.SDWPS(P1) ;MAKE AOBJN POINTER TO BUFFER
PUSHJ P,SATCN ;COUNT FREE SATS
MOVEM T2,.SDTAL(P1) ;STORE RESULTS
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$IOER - REPORT I/O ERROR
;REPORT AN INPUT OR OUTPUT ERROR
;CALL: MOVE T1, BLOCK NUMBER
; MOVE T2, IOWD
; MOVE T3, 0 (READ) OR 1 (WRITE)
; PUSHJ P,D$IOER
D$IOER: GETSTS DATCHN,DATIOS ;READ I/O STATUS ON ERROR
FATAL (DFE,CPOPJ,<Data file error >,DIOER1)
DIOER1: PUSH P,T1 ;SAVE FAILING BLOCK NUMBER
MOVE T1,DATIOS ;GET I/O STATUS
PUSHJ P,T$IOST ;PRINT IT
MOVEI T1,[ASCIZ / reading block /]
SKIPE T3 ;CHECK DIRECTION OF I/O
MOVEI T1,[ASCIZ / writing block /]
PUSHJ P,T$STRG ;PRINT TEXT
POP P,T1 ;GET BLOCK NUMBER BACK
PUSHJ P,T$OCTW ;PRINT IT
SETZM DATACT ;SAY FILE NOT ACTIVE
CLOSE DATCHN, ;CLOSE AND
RELEAS DATCHN, ; RELEASE CHANNEL
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$RHDR/D$WHDR - READ/WRITE HEADER
D$RHDR: SKIPN DATACT ;FILE OPENED?
POPJ P, ;NO
PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVEI T1,1 ;BLOCK NUMBER
MOVE T2,DATIOW ;IOWD
PUSHJ P,D$READ ;READ HEADER
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
D$WHDR: SKIPN DATACT ;FILE OPENED?
POPJ P, ;NO
PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVEI T1,1 ;BLOCK NUMBER
MOVE T2,DATIOW ;IOWD
PUSHJ P,D$WRIT ;WRITE HEADER
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$READ - READ A BLOCK
;READ A BLOCK
;CALL: MOVE T1, BLOCK NUMBER
; MOVE T2, IOWD
; PUSHJ P,D$READ
D$READ: PUSHJ P,SAVT ;SAVE SOME ACS
USETI DATCHN,(T1) ;POSITION FOR INPUT
SETZ T3, ;TERMINATE IOWD
IN DATCHN,T2 ;READ DATA
POPJ P, ;NO ERRORS
JRST D$IOER ;REPORT READ ERROR
SUBTTL DATA FILE PROCESSING -- D$WRIT - WRITE A BLOCK
;WRITE A BLOCK
;CALL: MOVE T1, BLOCK NUMBER
; MOVE T2, IOWD
; PUSHJ P,D$WRIT
D$WRIT: PUSHJ P,SAVT ;SAVE SOME ACS
USETO DATCHN,(T1) ;POSITION FOR OUTPUT
SETZ T3, ;TERMINATE IOWD
OUT DATCHN,T2 ;WRITE DATA
CAIA ;NO ERRORS
AOJA T3,D$IOER ;REPORT WRITE ERROR
HLRE T3,T2 ;GET WORD COUNT
MOVMS T3 ;MAKE POSITIVE
IDIVI T3,BLKSIZ ;CONVERT TO BLOCKS
ADD T3,T1 ;COMPUTE NEW EOF
CAMG T3,.DFEOF(D) ;DID WE EXTEND THE FILE?
POPJ P, ;NO
MOVEM T3,.DFEOF(D) ;UPDATE NEW EOF POSITION
PUSHJ P,D$WHDR ;UPDATE HEADER TO REFLECT NEW LENGTH
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$SHWD - SHOW DATA FILE INFO
D$SHWD: XMOVEI T1,[ASCIZ /Data file/]
PUSHJ P,DSHTTL
XMOVEI T1,[ASCIZ /Written by/]
MOVE T2,.DFNAM(D)
PUSHJ P,DSHSIX
XMOVEI T1,[ASCIZ /Version/]
MOVE T2,.DFVER(D)
PUSHJ P,DSHVER
XMOVEI T1,[ASCIZ /File format/]
MOVE T2,.DFFMT(D)
PUSHJ P,DSHOCT
XMOVEI T1,[ASCIZ /File size/]
MOVE T2,.DFEOF(D)
SOS T2
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Storage available/]
HLRZ T2,.DFVFW(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Words used/]
HRRZ T2,.DFVFW(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Current task/]
XMOVEI T2,.DFTSK(D)
SKIPN (T2)
XMOVEI T2,[ASCIZ /none/]
PUSHJ P,DSHSTR
XMOVEI T1,[ASCIZ /File blocks/]
MOVE T2,.DFFBN(D)
PUSHJ P,DSHDEC
PJRST T$CRLF
SUBTTL DATA FILE PROCESSING -- D$SERR - SHOW ERROR SUMMARY
D$SERR: PUSHJ P,SAVE3 ;SAVE SOME ACS
XMOVEI T1,[ASCIZ /Error summary/]
PUSHJ P,DSHTTL ;PRINT TITLE
XMOVEI T1,SERUNT ;POINT TO HEADER TEXT
PUSHJ P,T$STRG ;PRINT IT
XMOVEI T1,[ASCIZ /HOM /]
MOVEI T2,LBNHOM
HLLZ P2,.DFHOM(D) ;GET ERROR MASK
PUSHJ P,SERUNI ;DISPLAY ERRORS
XMOVEI T1,[ASCIZ /HOM /]
MOVEI T2,LB2HOM
HRLZ P2,.DFHOM(D) ;GET ERROR MASK
PUSHJ P,SERUNI ;DISPLAY ERRORS
XMOVEI T1,[ASCIZ /BAT /]
MOVEI T2,LBNHOM+LBOBAT
HLLZ P2,.DFBAT(D) ;GET ERROR MASK
PUSHJ P,SERUNI ;DISPLAY ERRORS
XMOVEI T1,[ASCIZ /BAT /]
MOVEI T2,LB2HOM+LBOBAT
HRLZ P2,.DFBAT(D) ;GET ERROR MASK
PUSHJ P,SERUNI ;DISPLAY ERRORS
MOVSI P3,-<NBOOTB+1> ;-VE COUNT OF BOOT BLOCKS
DSERR1: XMOVEI T1,[ASCIZ /Boot/]
HRRZ T2,P3
HLLZ P2,.DFBTS+0(D) ;GET ERROR MASK
PUSHJ P,SERUNI ;DISPLAY ERRORS
TRNN P3,-1 ;FIRST TIME HERE?
HRRI P3,FBOOTB-1 ;YES--SKIP A FEW BLOCKS
AOBJN P3,DSERR1 ;LOOP FOR ALL BOOT BLOCKS
PUSHJ P,SERSAT ;DISPLAY SAT BLOCK ERRORS
POPJ P, ;RETURN
;PRINT MAP OF ERRORS IN SAT BLOCKS
SERSAT: XMOVEI T1,SERSTT ;POINT TO HEADER TEXT
PUSHJ P,T$STRG ;PRINT IT
MOVN P1,.DFNSB(D) ;GET -VE NUMBER OF SAT BLOCKS
SUBI P1,1 ;WE MUST DISPLAY NON-EXISTANT BLOCK ZERO
HRLZS P1 ;PUT IN LH
MOVEI P2,.DFSEB(D) ;POINT TO BYTE MAP
HRLI P2,(POINT 9,) ;MAKE A BYTE POINTER
MOVSI P3,-^D10 ;COLUMN COUNT
SERSA1: PUSHJ P,T$TABC ;TAB OVER
HRRZ T1,P1 ;GET SAT BLOCK NUMBER
JUSTIFY (R,3," ",T$DECW) ;PRINT IT
SERSA2: MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
ILDB T1,P2 ;GET A BYTE
SKIPN T1 ;ERROR CODE STORED?
SKIPA T1,['... '] ;NO
HLLZ T1,FETEXT(T1) ;TRANSLATE TO 3-CHARACTER MNEMONIC
TRNN P1,-1 ;BLOCK ZERO?
SETZ T1, ;IT DOESN'T EXIST (START COUNTING FROM 1)
JUSTIFY (L,3," ",T$SIXN) ;PRINT MNEMONIC
AOBJP P1,SERSA3 ;JUMP IF DONE
AOBJN P3,SERSA2 ;JUMP IF MORE ON THIS LINE
PUSHJ P,T$CRLF ;ELSE END LINE
MOVSI P3,-^D10 ;RESET COLUMN COUNT
JRST SERSA1 ;LOOP BACK
SERSA3: PUSHJ P,T$CRLF ;END LINE
PJRST T$CRLF ;ONE MORE AND RETURN
SERSTT: ASCIZ \
SAT block errors
0 1 2 3 4 5 6 7 8 9
--- --- --- --- --- --- --- --- --- ---
\
;PRINT MAP OF ERRORS ON CRITICAL BLOCKS ON A PER-UNIT BASIS
SERUNI: PUSH P,T2 ;SAVE BLOCK NUMBER
PUSHJ P,T$STRG ;PRINT LINE INDENTIFIER
PUSHJ P,T$SPAC ;SPACE OVER
POP P,T1 ;GET BLOCK BACK
JUSTIFY (L,3," ",T$DECW) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
MOVE P1,.DFSTN(D) ;GET LOGICAL UNIT COUNT
SERUN1: MOVEI T1," " ;ASSUME NO ERRORS
TLNE P2,400000 ;ERROR ON BLOCK?
MOVEI T1,"*" ;YES
JUSTIFY (R,2," ",T$CHAR) ;PRINT FLAG
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
LSH P2,1 ;POSITION BIT FOR NEXT UNIT
SOJG P1,SERUN1 ;LOOP FOR ALL UNITS
PJRST T$CRLF ;END LINE AND RETURN
SERUNT: ASCIZ \
Logical units
0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16
-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- --
\
SUBTTL DATA FILE PROCESSING -- D$SSAT - SHOW SAT-BLOCKS
D$SSAT: PUSHJ P,SAVE3 ;SAVE SOME ACS
XMOVEI T1,DSSATT ;POINT TO TITLE TEXT
PUSHJ P,T$STRG ;PRINT IT
MOVN P1,.DFNSB(D) ;GET -VE NUMBER OF SAT BLOCKS
HRLZS P1 ;MAKE AN AOBJN POINTER
HRR P1,.DFSAT(D) ;GET OFFSET TO IN CORE SD STORAGE
ADDI P1,(D) ;MAKE AN AOBJN POINTER
SETZB P2,P3 ;CLEAR CLUSTER COUNTS
DSSAT1: PUSHJ P,T$SPAC ;START WITH A BLANK
MOVE T1,.SDNUM(P1) ;GET SAT BLOCK NUMBER
JUSTIFY (R,3," ",T$DECW) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
LDB T1,.SDERR(P1) ;GET ERROR BYTE
SKIPN T1 ;WAS THERE AN ERROR?
SKIPA T1,['... '] ;NO
HLLZ T1,FETEXT(T1) ;ELSE GET MNEMONIC
JUSTIFY (L,3," ",T$SIXN) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
MOVE T1,.SDTAL(P1) ;GET FREE CLUSTERS
ADD P3,T1 ;ACCUMULATE
JUSTIFY (R,^D12," ",T$DECW) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
MOVE T1,.SDUNI(P1) ;GET UNIT
JUSTIFY (R,4," ",T$DECW) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
MOVE T1,.SDUBN(P1) ;GET BLOCK ON UNIT
JUSTIFY (R,^D11," ",T$DECW) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
MOVE T1,P2 ;GET STARTING CLUSTER
JUSTIFY (R,^D11," ",T$DECW) ;PRINT IT
PUSHJ P,T$COLN ;PRINT SEPARATOR
ADD P2,.SDCPS(P1) ;TALLY UP CLUSTER COUNT
MOVE T1,P2 ;GET FIRST CLUSTER IN NEXT SAT
SUBI T1,1 ;REDUCE TO LAST CLUSTER IN THIS SAT
JUSTIFY (L,^D11," ",T$DECW) ;PRINT IT
DSSAT2: PUSHJ P,T$CRLF ;END LINE
ADDI P1,.SDMIN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P1,DSSAT1 ;LOOP FOR ALL SAT BLOCKS
XMOVEI T1,[ASCIZ / A total of /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,P3 ;GET TOTAL FREE CLUSTERS
PUSHJ P,T$DECW ;PRINT IT
XMOVEI T1,[ASCIZ / clusters free (/]
CAIN P3,1 ;JUST ONE?
XMOVEI T1,[ASCIZ / cluster free (/]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,P3 ;GET NUMBER OF FREE CLUSTERS
IMUL T1,.DFBPC(D) ;CONVERT TO BLOCKS
MOVE P3,T1 ;SAVE RESULTS
PUSHJ P,T$DECW ;PRINT FREE BLOCKS
XMOVEI T1,[ASCIZ / blocks) in /]
CAIN P3,1 ;JUST ONE?
XMOVEI T1,[ASCIZ / block) in /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,.DFNSB(D) ;GET NUMBER OF SATS IN STRUCTURE
MOVE T2,T1 ;MAKE A COPY
PUSHJ P,T$DECW ;PRINT IT
XMOVEI T1,[ASCIZ / SAT blocks/]
CAIN T2,1 ;JUST ONE?
XMOVEI T1,[ASCIZ / SAT block/]
PUSHJ P,T$STRG ;PRINT TEXT
PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,[ASCIZ / Actual free blocks = /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,P3 ;GET TOTAL FREE
PUSHJ P,T$DECW ;PRINT IT
XMOVEI T1,[ASCIZ / - /]
PUSHJ P,T$STRG ;PRINT SEPARATOR
MOVE T1,.DFOVR(D) ;GET OVERDRAW
PUSHJ P,T$DECW ;PRINT IT
XMOVEI T1,[ASCIZ / = /]
PUSHJ P,T$STRG ;PRINT SEPARATOR
MOVE T1,P3 ;GET TOTAL FREE AGAIN
SUB T1,.DFOVR(D) ;MINUS OVERDRAW
PUSHJ P,T$DECW ;PRINT ACTUAL FREE BLOCKS
PJRST T$CRLF ;ANOTHER BLANK LINE AND RETURN
DSSATT: ASCIZ \
No. Err Free Unit Address Cluster range
--- --- ------------ ---- ----------- -----------------------
\
SUBTTL DATA FILE PROCESSING -- D$SDMP - SHOW DUMP DESCRIPTORS
D$SDMP: XMOVEI T1,DSDMPT ;POINT TO HEADER TEXT
MOVSI T2,-MAXDMP ;-VE NUMBER OF ENTRIES
HRRI T2,.DFDMP(D) ;AND ADDR OF BUFFER
PJRST D$SFMT ;ENTER FORMATTED DESCRIPTOR ROUTINE
DSDMPT: ASCIZ \
DUMP
Format Descriptors
\
SUBTTL DATA FILE PROCESSING -- D$SIOT - SHOW I/O TRACE DESCRIPTORS
D$SIOT: XMOVEI T1,DSIOTT ;POINT TO HEADER TEXT
MOVSI T2,-MAXIOT ;-VE NUMBER OF ENTRIES
HRRI T2,.DFIOT(D) ;AND ADDR OF BUFFER
PJRST D$SFMT ;ENTER FORMATTED DESCRIPTOR ROUTINE
DSIOTT: ASCIZ \
I/O
Format Descriptors
\
;ROUTINE TO DISPLAY A FORMATTED DATA DESCRIPTOR
;CALL: MOVE T1, ADDRESS OF TITLE TEXT
; MOVE T2, AOBJN POINTER TO BUFFER
; PUSHJ P,D$SFMT
; <RETURN>
D$SFMT: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,T2 ;COPY AOBJN POINTER TO DESCRIPTOR BUFFER
PUSHJ P,T$STRG ;PRINT TITLE TEXT
SETZ P2, ;CLEAR A COUNTER
DSFMT1: SKIPN .FMKEY(P1) ;HAVE SOMETHING HERE?
JRST DSFMT4 ;NO--ALL DONE
JUMPN P2,DSFMT2 ;JUMP IF NOT FIRST TIME HERE
XMOVEI T1,DSFMTT ;POINT TO HEADER TEXT
PUSHJ P,T$STRG ;PRINT IT
DSFMT2: AOS P2 ;COUNT THE ENTRY
PUSHJ P,T$SPAC ;SPACE OVER
MOVE T1,P2 ;GET DESCRIPTOR NUMBER
JUSTIFY (R,3," ",T$DECW) ;PRINT IT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
XMOVEI T1,1(P1) ;POINT TO FORMAT KEYWORD
JUSTIFY (L,^D20," ",T$STRG) ;PRINT IT
MOVE T1,1(P1) ;COPY ANSWER
MOVE T2,2(P1) ;...
CAMN T1,[ASCII "PAUSE"] ;PAUSE I/O?
CAME T2,[ASCIZ "-IO" ] ;...
SKIPA T1,[EXP 2] ;NO
JRST DSFMT3 ;DONE WITH THIS LINE
PUSHJ P,T$SPAN ;SPACE OVER
HRRZ T1,0(P1) ;GET BLOCK OFFSET
JUSTIFY (R,6," ",T$DECW) ;PRINT IT
MOVEI T1,4 ;SPACE
PUSHJ P,T$SPAN ; OVER
LDB T1,[POINT 6,.FMBPT(P1),5] ;GET RIGHT-MOST BIT (BPT FORMAT)
LDB T2,[POINT 6,.FMBPT(P1),11] ;GET BYTE SIZE
MOVNS T1 ;NEGATE
ADDI T1,43 ;THIS IS THE RIGHT-MOST BIT
PUSH P,T1 ;SAVE
SKIPE T1 ;FULL WORD QUANTITY?
SUBI T1,-1(T2) ;THIS IS THE STARTING BIT NUMBER
JUSTIFY (R,2,"0",T$DECW) ;PRINT IT
PUSHJ P,T$COLN ;PRINT SEPARATOR
POP P,T1 ;GET RIGHT-MOST BIT BACK
SKIPN T1 ;FULL WORD QUANTITY?
MOVEI T1,43 ;YES
JUSTIFY (R,2,"0",T$DECW) ;PRINT IT
DSFMT3: PUSHJ P,T$CRLF ;END LINE
ADDI P1,<1+MAXHKS>-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P1,DSFMT1 ;LOOP FOR ALL ENTRIES
DSFMT4: XMOVEI T1,DSFMTN ;INCASE NONE ...
SKIPN P2 ;AT LEAST ONE?
PUSHJ P,T$STRG ;NO
PJRST T$CRLF ;APPEND A CRLF AND RETURN
DSFMTN: ASCIZ \
There are none defined
\
DSFMTT: ASCIZ \
No. Display format Offset Bit range
--- -------------------- ------ ---------
\
SUBTTL DATA FILE PROCESSING -- D$SHWE - SHOW ERSATZ DEVICES
D$SHWE: PUSHJ P,SAVE3 ;SAVE SOME ACS
XMOVEI T1,[ASCIZ /Ersatz devices/]
PUSHJ P,DSHTTL
MOVE P1,.DFEDV(D) ;GET -LENGTH,,OFFSET
ADDI P1,(D) ;RELOCATE
MOVN P2,LSTWID ;GET -VE WIDTH OF PAGE
IDIVI P2,^D19 ;DIVIDE BY WIDTH OF ONE ERSATZ DISPLAY
HRLZS P2 ;MAKE AN AOBJN POINTER
MOVE P3,P2 ;GET COLUMN COUNTER
DSHWE1: SKIPN 0(P1) ;HAVE A NAME?
JRST DSHWE4 ;IGNORE BLANKS
PUSHJ P,T$SPAC ;SPACE OVER
HLLZ T1,0(P1) ;GET DEVICE NAME
JUSTIFY (L,4," ",T$SIXN) ;PRINT NAME
XMOVEI T1,[ASCIZ / /]
SKIPN 1(P1) ;GET THE PPN
PUSHJ P,T$STRG ;NONE THERE--SPACE OVER
SKIPN 1(P1) ;CHECK AGAIN
JRST DSHWE3 ;CHECK FURTHER
HLRZ T1,1(P1) ;GET PROJECT NUMBER
JUSTIFY (R,6," ",T$OCTW) ;PRINT IT
PUSHJ P,T$COMA ;PRINT COMMA
HRRZ T1,1(P1) ;GET PROGRAMMER NUMBER
JUSTIFY (L,6," ",T$OCTW) ;PRINT IT
DSHWE3: MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
AOBJN P3,DSHWE4 ;COUNT COLUMNS
PUSHJ P,T$CRLF ;END LINE
MOVE P3,P2 ;RESET COUNTER
DSHWE4: ADDI P1,1 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN P1,DSHWE1 ;LOOP BACK FOR MORE
PUSHJ P,T$CRLF ;END LINE
PJRST T$CRLF ;ONE MORE AND RETURN
SUBTTL DATA FILE PROCESSING -- D$SHWP - SHOW PARAMETERS
D$SHWP: XMOVEI T1,[ASCIZ /Parameters/]
PUSHJ P,DSHTTL
XMOVEI T1,[ASCIZ /HOM updating/]
XMOVEI T2,OFNKEY
MOVSI T3,(DF.HOM)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ /BAT updating/]
XMOVEI T2,OFNKEY
MOVSI T3,(DF.BAT)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ /SAT updating/]
XMOVEI T2,OFNKEY
MOVSI T3,(DF.SAT)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ /RIB updating/]
XMOVEI T2,OFNKEY
MOVSI T3,(DF.RIB)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ /Zero RIBSIZ/]
XMOVEI T2,OFNKEY
MOVSI T3,(DF.ZRS)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ /Checksum error detection/]
MOVEI T2,OFNKEY
MOVSI T3,(DF.CED)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ /LOOKUP by any RIB/]
MOVEI T2,OFNKEY
MOVSI T3,(DF.LBA)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ /LOOKUP by Prime RIB/]
MOVEI T2,OFNKEY
MOVSI T3,(DF.LBP)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ /LOOKUP by Spare RIB/]
MOVEI T2,OFNKEY
MOVSI T3,(DF.LBS)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ .I/O tracing.]
MOVEI T2,OFNKEY
MOVSI T3,(DF.IOT)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ /File access/]
LDB T2,[POINTR (.DFFLG(D),DF.FAC)]
MOVE T2,FLKP.N(T2)
PUSHJ P,DSHSTR
XMOVEI T1,[ASCIZ /Blocks per read/]
MOVE T2,.DFBPR(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Checkpoint interval/]
MOVE T2,.DFCPI(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /SFD levels/]
MOVE T2,.DFLVL(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Patch buffer size/]
MOVE T2,.DFDPS(D)
PUSHJ P,DSHOCT
XMOVEI T1,[ASCIZ /Sort buffer size/]
MOVE T2,.DFSRT(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Default DUMP format/]
LDB T2,[POINTR (.DFFLG(D),DF.DMP)]
MOVE T2,DUMP.N(T2)
PUSHJ P,DSHSTR
XMOVEI T1,[ASCIZ /Block range (inclusive)/]
XMOVEI T2,.DFRNG(D)
PUSHJ P,DSHRNG
XMOVEI T1,[ASCIZ /Current PPN/]
MOVE T2,.DFPPN(D)
PUSHJ P,DSHPPN
XMOVEI T1,[ASCIZ /Logged-in PPN/]
MOVE T2,.DFLPN(D)
PUSHJ P,DSHPPN
XMOVEI T1,[ASCIZ /Path/]
MOVE T2,.DFPTH(D)
ADDI T2,(D)
PUSHJ P,DSHPTH
PJRST T$CRLF
;DISPLAY TITLE LINES
;CALL: MOVE T1, TEXT STRING
; PUSHJ P,DSHTTL
; <RETURN>
DSHTTL: PUSH P,T1 ;SAVE STRING ADDRESS
HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
MOVE T2,[POINT 7,SHWBUF] ;POINT TO SCRATCH BUFFER
MOVEI T3,"-" ;GET A DASH
DSHTT1: ILDB T4,T1 ;GET A CHARACTER
JUMPE T4,DSHTT2 ;DONE?
IDPB T3,T2 ;STORE DASH
JRST DSHTT1 ;LOOP BACK
DSHTT2: PUSHJ P,T$CRLF ;START WITH A BLANK LINE
XMOVEI T1,T$STRG ;ROUTINE TO EXECUTE
MOVEM T1,CMDJST+1 ;STORE
HRLZ T1,LSTWID ;GET WIDTH OF PAGE
TDO T1,[200000,," "] ;CENTER JUSTIFY, PAD WITH A SPACE
MOVEM T1,CMDJST+2 ;STORE
POP P,T1 ;GET STRING BACK
PUSHJ P,CMDJST ;JUSTIFY
PUSHJ P,T$CRLF ;END LINE
XMOVEI T1,SHWBUF ;POINT TO DASHES
PUSHJ P,CMDJST ;JUSTIFY
PJRST T$CRLF ;END LINE AND RETURN
;DISPLAY SINGLE BIT QUANTITIES
;CALL: MOVE T1, TEXT STRING
; MOVE T2, KEYWORD TABLE
; MOVE T3, BIT IN .DFFLG
; PUSHJ P,DSHWBT
; <RETURN>
DSHWBT: PUSHJ P,DSHJTX ;PRINT TEXT
TDNE T3,.DFFLG(D) ;TEST BIT
AOS T2 ;1ST TABLE ENTRY
AOS T2 ;2ND TABLE ENTRY
MOVE T1,(T2) ;GET TEXT STRING
PUSHJ P,T$STRG ;PRINT IT
PJRST T$CRLF ;END LINE AND RETURN
;DISPLAY FILESPECS
;CALL: MOVE T1, TEXT STRING
; MOVE T2, DATA FILE OFFSET
; PUSHJ P,DSHWFL
; <RETURN>
DSHWFL: PUSHJ P,DSHJTX ;PRINT TEXT
SKIPE T1,T2 ;COPY SCAN BLOCK ADDRESS
PUSHJ P,T$FILE ;PRINT FILESPEC
XMOVEI T1,[ASCIZ /none/]
SKIPN T2 ;CHECK FOR FILESPEC
PUSHJ P,T$STRG ;PRINT TEXT
PJRST T$CRLF ;END LINE AND RETURN
;DISPLAY DECIMAL/OCTAL/SIXBIT/STRING/VERSION VALUES
;CALL: MOVE T1, TEXT STRING
; MOVE T2, DATA FILE OFFSET
; PUSHJ P,DSHWXX
; <RETURN>
DSHDEC: SKIPA T4,[T$DECW] ;DECIMAL
DSHOCT: MOVEI T4,T$OCTW ;OCTAL
JRST DSHWXX ;ENTER COMMON CODE
DSHSIX: SKIPA T4,[T$SIXN] ;SIXBIT
DSHSTR: MOVEI T4,T$STRG ;STRING
JRST DSHWXX ;ENTER COMMON CODE
DSHPTH: SKIPA T4,[T$PATH] ;PATH
DSHPPN: MOVEI T4,T$PPN ;PPN
JRST DSHWXX ;ENTER COMMON CODE
DSHRNG: SKIPA T4,[T$RNGD] ;RANGE
DSHVER: MOVEI T4,T$VERW ;VERSION
DSHWXX: PUSHJ P,DSHJTX ;PRINT TEXT
MOVE T1,T2 ;GET DATA
PUSHJ P,(T4) ;PRINT IT
PJRST T$CRLF ;END LINE AND RETURN
DSHJTX: PUSH P,T1 ;SAVE T1
XMOVEI T1,T$STRG ;ALL ARGUMENTS ARE IN ASCII
MOVEM T1,CMDJST+1 ;STORE ROUTINE TO EXECUTE
MOVE T1,LSTWID ;GET WIDTH OF PAGE
SUBI T1,2 ;ALLOW FOR TWO COLUMN SEPARATORS
ASH T1,-1 ;DIVIDE BY 2
TDO T1,[" ",,400000] ;RIGHT JUSTIFIED, PAD WITH A SPACE
MOVSM T1,CMDJST+2 ;STORE DESCRIPTOR
POP P,T1 ;RESTORE T1
PUSHJ P,CMDJST ;JUSTIFY TEXT
MOVEI T1,2 ;SPACE
PUSHJ P,T$SPAN ; OVER
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$SHPT - SHOW PATCH DATA
D$SHPT: XMOVEI T1,[ASCIZ /Patch data/]
PUSHJ P,DSHTTL
XMOVEI T1,[ASCIZ /Patch in progress/]
XMOVEI T2,YNQKEY
MOVSI T3,(DF.PIP)
PUSHJ P,DSHWBT
MOVSI T1,(DF.PIP)
TDNN T1,.DFFLG(D)
POPJ P,
SETZ T1,
XMOVEI T2,PATSPC
PUSHJ P,T$XLAT
MOVE T2,T1
XMOVEI T1,[ASCIZ /Patching/]
PUSHJ P,DSHSTR
XMOVEI T1,[ASCIZ /Inhibit buffer clearing/]
XMOVEI T2,OFNKEY
MOVSI T3,(DF.IBC)
PUSHJ P,DSHWBT
XMOVEI T1,[ASCIZ /Buffer size/]
MOVE T2,.DFDPS(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Last block read/]
MOVE T2,.DFPLR(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Last block written/]
MOVE T2,.DFPLW(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ .Last I/O.]
SKIPN .DFPIO(D)
SKIPA T2,['READ ']
MOVE T2,['WRITE ']
PUSHJ P,DSHSIX
POPJ P,
SUBTTL DATA FILE PROCESSING -- D$SHWS - SHOW STRUCTURE DATA
D$SHWS: XMOVEI T1,[ASCIZ /Structure/]
PUSHJ P,DSHTTL
XMOVEI T1,[ASCIZ /Name/]
MOVE T2,.DFSTR(D)
PUSHJ P,DSHSIX
XMOVEI T1,[ASCIZ /Number of units/]
MOVE T2,.DFSTN(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Blocks per cluster/]
MOVE T2,.DFBPC(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Blocks per super cluster/]
MOVE T2,.DFBSC(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Super clusters per unit/]
MOVE T2,.DFSCU(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Largest unit size/]
MOVE T2,.DFBUS(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Highest block on structure/]
MOVE T2,.DFHLB(D)
PUSHJ P,DSHDEC
XMOVEI T1,[ASCIZ /Overdraw/]
MOVE T2,.DFOVR(D)
PUSHJ P,DSHDEC
PJRST T$CRLF
SUBTTL DATA FILE PROCESSING -- D$TSKS - SCHEDULE A TASK
;ROUTINE TO SCHEDULE A TASK
;CALL: PUSHJ P,D$TSKN
; <RETURN>
;
;ON RETURN, T1 := SUBROUTINE TO CALL
D$TSKS: SKIPN .DFTSK(D) ;HAVE A CURRENT TASK?
STOPCD (NAT,<No active task>,)
XMOVEI T1,.DFTSK(D) ;POINT TO NAME
XMOVEI T2,TASK.N ;AND TO NAME TABLE
PUSHJ P,C$KEYW ;FIND THE TASK
STOPCD (TNC,<Task name corrupted; >,T$STRG)
MOVE T3,TASK.P(T2) ;GET PROCESSOR (DISPATCH) TABLE
SKIPN T2,.DFCRS(D) ;GET AOBJN POINTER
MOVE T2,.TKPTR(T3) ;MUST INITIALIZE
MOVEM T2,.DFCRS(D) ;UPDATE
ADDI T2,.TKRTN(T3) ;INDEX INTO TASK TABLE
MOVE T1,(T2) ;GET SUBROUTINE TO EXECUTE
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$VARS - SET VARIOUS RUNTIME VARIABLES
D$VARS: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVEI T1,.DFLEN-.DFVAR ;GET TOTAL WORDS AVAILABLE
HRLZM T1,.DFVFW(D) ;SAVE COUNT
MOVEI P1,.DFVAR ;GET WORDS WHICH CANNOT BE ALLOCATED
MOVE P2,D ;START OF FILE HEADER
ADD P2,[-MAPSIZ,,.DFVMP] ;MAKE AOBJN POINTER TO BIT MAP
MOVSI P3,(1B0) ;STARTING BIT
MOVEI P4,1 ;STOPCODE ON DESCREPANCIES
PUSHJ P,BITSET ;MARK OFF BITS SO WORDS CANNOT BE ALLOCATED
DVARS1: PUSHJ P,DATPBX ;ALLOCATE PATH BLOCK
PUSHJ P,DATFBX ;ALLOCATE FILE BLOCKS
PUSHJ P,DATSBX ;ALLOCATE SCAN BLOCKS
PUSHJ P,D$EDVL ;LOAD UP ERSATZ DEVICE TABLE
MOVSI T1,(DF.LBP!DF.LBS) ;GET BITS TO SET
IORM T1,.DFFLG(D) ;ENABLE LOOKUP BY PRIME AND SPARE RIBS
PUSHJ P,D$WHDR ;UPDATE HEADER
POPJ P, ;RETURN
;ALLOCATE PATH BLOCKS FROM DATA FILE VARIABLE STORAGE
DATPBX: HRROI T1,.GTPPN ;LOAD GETTAB TABLE NUMBER
GETTAB T1, ;READ OUR CURRENT PPN
SETZ T1, ;??
MOVEM T1,.DFPPN(D) ;STORE FOR LATER
HRROI T1,.GTLPN ;LOAD GETTAB TABLE NUMBER
GETTAB T1, ;READ OUR LOGGED-IN PPN
MOVE T1,.DFPPN(D) ;OLD MONITOR
MOVEM T1,.DFLPN(D) ;STORE FOR LATER
MOVE T1,.DFLVL(D) ;GET MAXIMUM SFD LEVEL
ADDI T1,.PTPPN+1 ;ADD OVERHEAD + PPN + TERMINATOR WORDS
PUSHJ P,D$VGET ;ALLOCATE PATH BLOCK
MOVNS T1 ;NEGATE
HRLZM T1,.DFPTH(D) ;STORE -VE LENGTH
MOVMS T1 ;MAKE POSITIVE AGAIN
HRRM T2,.DFPTH(D) ;SAVE OFFSET
HRLZS T1 ;PUT LENGTH IN LH
HRR T1,T2 ;AND OFFSET IN RH
ADDI T1,(D) ;RELOCATE
MOVE T2,[.PTFRD] ;FUNCTION CODE TO READ DEFAULT PATH
MOVEM T2,(T1) ;STORE IT
MOVE T2,T1 ;COPY ARGUMENT BLOCK ADDRESS
MOVE T3,.DFPPN(D) ;INCASE OF ERROR ...
PATH. T1, ;READ DEFAULT PATH
MOVEM T3,.PTPPN(T2) ;USE OUR PPN INSTEAD
POPJ P, ;RETURN
;ALLOCATE SCAN BLOCKS FROM DATA FILE VARIABLE STORAGE
DATSBX: MOVE T1,.DFLVL(D) ;GET MAXIMUM SFD LEVEL
CAIGE T1,5 ;COMPARE AGAINST THIS MONITOR
MOVEI T1,5 ;PICK THE LARGER OF THE TWO
LSH T1,1 ;TIMES TWO FOR TWO-WORD SFD PAIRS
ADDI T1,.SBMIN ;PLUS THE SCAN BLOCK OVERHEAD
MOVEM T1,.DFSBL(D) ;SAVE LENGTH
PUSHJ P,D$VGET ;ALLOCATE SCAN BLOCK FOR COMMANDS
MOVEM T2,.DFCMD(D) ;SAVE OFFSET
PUSHJ P,D$VGET ;ALLOCATE SCAN BLOCK FOR INPUT SPEC
MOVEM T2,.DFINP(D) ;SAVE OFFSET
PUSHJ P,D$VGET ;ALLOCATE SCAN BLOCK FOR OUTPUT
MOVEM T2,.DFISV(D) ;SAVE OFFSET
PUSHJ P,D$VGET ;ALLOCATE SCAN BLOCK FOR SAVED SPEC
MOVEM T2,.DFOUT(D) ;SAVE OFFSET
PUSHJ P,D$VGET ;ALLOCATE SCAN BLOCK FOR RETURNED SPEC
MOVEM T2,.DFRSB(D) ;SAVE OFFSET
PUSHJ P,D$VGET ;ALLOCATE SCAN BLOCK FOR SAVED SPEC
MOVEM T2,.DFRSV(D) ;SAVE OFFSET
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$VGET - ALLOCATE VARIABLE STORAGE
;ALLOCATE VARIABLE STORAGE WITHING THE DATA FILE HEADER
;CALL: MOVE T1, NUMBER OF WORDS
; PUSHJ P,D$VGET
; <RETURN> ;T2 := OFFSET WITHIN DATA FILE HEADER
;
;THIS WILL STOPCODE ON FAILURES AS THERE IS NO WAY TO RECOVER FROM
;OVER ALLOCATION.
D$VGET: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;REQUESTED BIT (WORD) COUNT
MOVEI P2,.DFVMP(D) ;POINT TO START OF BIT MAP
HRLI P2,-MAPSIZ ;MAKE AN AOBJN POINTER
MOVSI P3,(1B0) ;STARTING BIT POSITION
PUSHJ P,BITZER ;FIND A FREE BIT
STOPCD (DVE,<Data file variable storage exhausted>,)
PUSH P,P1 ;SAVE REQUESTED WORD COUNT
HRRZ T1,P2 ;GET MAP ADDRESS
SUBI T1,.DFVMP(D) ;REDUCE TO DATA FILE HEADER OFFSET
IMULI T1,44 ;GET BASE ADDRESS
PUSH P,T1 ;SAVE TEMPORARILY
MOVE T1,P3 ;GET STARTING BIT POSITION
JFFO T1,.+1 ;FIND FIRST ONE
ADDI T2,(D) ;MAKE ADDRESSABLE AGAIN
ADDM T2,(P) ;COMPLETE ADDRESS OF FIRST ASSIGNED WORD
MOVEI P4,1 ;WANT STOPCODE IF DESCREPANCY
PUSHJ P,BITSET ;SET BITS
MOVE T1,(P) ;GET STARTING ADDRESS
SETZM (T1) ;CLEAR FIRST WORD
HRLS T1 ;PUT IN BOTH HALVES
AOS T1 ;MAKE A BLT POINTER
MOVE T2,(P) ;GET ADDRESS AGAIN
ADD T2,-1(P) ;COMPUTE END OF BLOCK
BLT T1,-1(T2) ;CLEAR STORAGE
POP P,T2 ;GET ADDRESS BACK
SUB T2,D ;RETURN RELATIVE OFFSET WITHIN HEADER
MOVE T1,(P) ;GET REQUESTED WORD COUNT
ADDM T1,.DFVFW(D) ;COUNT WORDS IN USE
PUSHJ P,D$WHDR ;UPDATE HEADER
POP P,T1 ;RESTORE REQUESTED WORD COUNT
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$VGIV - DEALLOCATE VARIABLE STORAGE
;DEALLOCATE VARIABLE STORAGE WITHING THE DATA FILE HEADER
;CALL: MOVE T1, NUMBER OF WORDS
; MOVE T2, OFFSET WITHIN DATA FILE
; PUSHJ P,D$VGIV
; <RETURN>
D$VGIV: PUSHJ P,SAVE4 ;SAVE SOME ACS
PUSH P,T1 ;SAVE WORD COUNT
PUSH P,T2 ;AND OFFSET
MOVE P1,T1 ;REQUESTED BIT (WORD) COUNT
MOVEI P2,(T2) ;GET OFFSET
IDIVI P2,44 ;COMPUTE STARTING WORD
HRLS P2 ;PUT IN BOTH HALVES
ADD P2,[-MAPSIZ,,.DFVMP] ;MAKE AOBJN POINTER
ADD P2,D ;FILL IN ADDRESS
MOVN P4,P3 ;NEGATE STARTING BIT POSITION
MOVSI P3,(1B0) ;GET LEFT MOST BIT
ROT P3,(P4) ;POSITION STARTING BIT
MOVEI P4,1 ;WANT STOPCODE IF DESCREPANCY
PUSHJ P,BITCLR ;CLEAR BITS
HRRZ T1,.DFVFW(D) ;GET COUNT OF WORDS USED
SUB T1,-1(P) ;ACCOUNT FOR THOSE DEALLOCATED
HRRM T1,.DFVFW(D) ;UPDATE
PUSHJ P,D$WHDR ;UPDATE DISK TOO
POP P,T2 ;RESTORE OFFSET
POP P,T1 ;RESTORE WORD COUNT
POPJ P, ;RETURN
SUBTTL DATA FILE PROCESSING -- D$WILD - DO WILDCARD COMPARRISIONS
;COMPARE A FILE BLOCK WITH A POSSIBLY WILDCARDED SCAN BLOCK
;CALL: MOVE T1, FILE BLOCK ADDRESS
; MOVE T2, SCAN BLOCK ADDRESS
; PUSHJ P,D$WILD
; <NON-SKIP> ;NO MATCH
; <SKIP> ;FILE BLOCK SATISFIES CONDITIONS
D$WILD: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;COPY FILE BLOCK ADDRESS
MOVE P2,T2 ;COPY SCAN BLOCK ADDRESS
AOS .FWFIL+0(F) ;COUNT FILE SCANNED
AOS FILFIL+0 ;AND ADD TO THE TOTAL COUNT
;DEVICE
MOVE P3,.DFSTR(D) ;GET STRUCTURE NAME
XOR P3,.SBDEV(P2) ;COMPARE
AND P3,.SBDVM(P2) ;MASK OUT DIFFERENCES
JUMPE P3,DWILD2 ;CONTINUE IF A MATCH
;*** CHECK UNILOG HERE?
POPJ P, ;NO MATCH
;FILE NAME
DWILD2: MOVE P3,.FBNAM(P1) ;GET FILE NAME
XOR P3,.SBNAM(P2) ;COMPARE
AND P3,.SBNMM(P2) ;MASK OUT DIFFERENCES
JUMPN P3,CPOPJ ;RETURN IF NO MATCH
;EXTENSION
HLLZ P3,.FBEXT(P1) ;GET EXTENSION
XOR P3,.SBEXT(P2) ;COMPARE
HRLZ P4,.SBEXT(P2) ;GET MASK
AND P3,P4 ;MASK OUT DIFFERENCES
JUMPN P3,CPOPJ ;RETURN IF NO MATCH
;DIRECTORY
ADDI P1,.FBPPN ;OFFSET TO START OF DIRECTORY
ADDI P2,.SBDIR ;...
MOVN P3,.DFLVL(D) ;GET -VE MAXIMUM SFD LEVEL
SOS P3 ;ONE MORE LEVEL FOR THE PPN
HRLZS P3 ;MAKE AN AOBJN POINTER
DWILD3: MOVE P4,0(P1) ;GET DIRECTORY COMPONENT
XOR P4,0(P2) ;COMPARE
AND P4,1(P2) ;MASK OUT DIFFERENCES
JUMPN P4,CPOPJ ;RETURN IF NO MATCH
AOS P1 ;ADVANCE FILE BLOCK POINTER
ADDI P2,2 ;ADVANCE SCAN BLOCK POINTER
AOBJN P3,DWILD3 ;LOOP FOR ALL LEVELS
SUB P1,.DFLVL(D) ;REDUCE BY NUMBER OF SFDS
SUBI P1,.FBPPN+1 ;AND RESET FB ADDRESS TO BEGINING
;LOOKUP BITS
DWILD4: MOVE P3,.FBFLG(P1) ;GET FILE BLOCK'S FLAG WORD
MOVSI P4,(DF.LBA) ;MAYBE ANY RIB WILL DO
TRNE P3,FB.PRM ;PRIME RIB?
TLO P4,(DF.LBP) ;YES
TRNE P3,FB.SPR ;SPARE RIB?
TLO P4,(DF.LBS) ;YES
TDNN P4,.DFFLG(D) ;WANT TO SEE THIS FILE?
POPJ P, ;NO
JRST CPOPJ1 ;CALL IT A MATCH
SUBTTL FILE SERVICE -- F$ADVP - ADVANCE POSITION WITHIN FILE
F$ADVP: MOVE T1,.FWRPT(F) ;GET CURRENT POINTER
SKIPLE .FWRWC(F) ;ANY WORDS REMAIN TO BE READ?
SKIPN (T1) ;OR PTR SAYS ALREADY AT EOF?
JRST FADVP3 ;YES--CAN GO NO FURTHER
SKIPGE .FWLFT(F) ;CURRENT POINTER RUN OUT?
JRST CPOPJ1 ;NO
SKIPE .FWLFT(F) ;FIRST TIME THROUGH?
FADVP1: AOBJP T1,FADVP3 ;NO--ADVANCE
MOVEM T1,.FWRPT(F) ;UPDATE
SKIPN R,(T1) ;CHECK FOR EOF
FERR (EOF,F$ERET) ;END OF FILE
TDNE R,[-1-RIPNUB-MAXUNI] ;CHANGE OF UNIT POINTER?
JRST FADVP2 ;NO
TRZ R,RIPNUB ;CLEAR CHANGE BIT
CAML R,.DFSTN(D) ;REASONABLE LOGICAL UNIT NUMBER?
FERR (NUB,F$ERET) ;BAD NEW UNIT POINTER
MOVEM R,.FWUNI(F) ;SAVE FOR LATER
MOVEI U,(R) ;GET UNIT NUMBER
IMULI U,.UNLEN ;TIMES WORDS PER UNIT STORAGE
ADDI U,.DFUNI(D) ;INDEX TO BLOCK FOR THIS UNIT
JRST FADVP1 ;LOOP BACK FOR NEXT DATA POINTER
FADVP2: LDB T2,.DFCNP(D) ;GET CLUSTERS DESCRIBED BY THIS POINTER
IMUL T2,.DFBSC(D) ;CONVERT TO BLOCKS
MOVE T3,.FWRWC(F) ;GET REMAINING WORD COUNT IN FILE
TRNE T3,BLKSIZ-1 ;PARTIAL BLOCK
ADDI T3,BLKSIZ ;ROUND UP
IDIVI T3,BLKSIZ ;CONVERT TO BLOCKS
CAML T2,T3 ;WILL THIS GROUP PUT US PAST EOF?
MOVE T2,T3 ;YES--LIMIT THE BLOCK COUNT
SKIPE .FWSAT(F) ;IS THIS SAT.SYS?
MOVEI T2,1 ;ONLY FIRST BLOCK IN EACH CLUSTER IS VALID
MOVNS T2 ;NEGATE
HRLZS T2 ;PUT IN LH
EXCH T2,.FWLFT(F) ;SAVE NUMBER LEFT TO PROCESS
JUMPN T2,CPOPJ1 ;DONE UNLESS FIRST TIME THROUGH
MOVE T2,.FWLFT(F) ;GET LEFTOVER POINTER AGAIN
AOS T3,.FWRIF(F) ;INVALIDATE RIB-READING FLAG
SOJLE T3,CPOPJ1 ;RETURN IF READING A RIB
AOSE .FWSFB(F) ;WANT TO SKIP FIRST BLOCK (RIB)?
JUMPL T2,CPOPJ1 ;RETURN IF DIDN'T RUN OUT
MOVNI T1,BLKSIZ ;WANT TO SKIP OVER THE RIB
PUSHJ P,F$XFRB ;COUNT AS BLOCKS TRANSFERED
JRST F$ADVP ;LOOP BACK AND DO IT AGAIN
FADVP3: SKIPN R,.FWRIB+RIBXRA(F) ;HAVE AN EXTENDED RIB?
FERR (EOF,F$ERET) ;NO--THEN WE'RE AT EOF
LDB T1,[POINT DESRBC,R,DENRBC] ;GET NEXT XRIB NUMBER
MOVEM T1,.FWRBO(F) ;SAVE AS RIB/BLOCK OFFSET FOR POSITIONING
LDB T1,[POINT DESRBU,R,DENRBU] ;GET UNIT
CAML T1,.DFSTN(D) ;REASONABLE NUMBER?
FERR (XRW,F$ERET) ;NOPE
MOVEM T1,.FWUNI(F) ;SAVE FOR LATER
LDB T2,[POINT DESRBA,R,DENRBA] ;GET CLUSTER ADDRESS
IMUL T2,.DFBPC(D) ;COMPUTE BLOCK ON UNIT
PUSHJ P,F$BLKS ;TRANSLATE TO BLOCK ON STRUCTURE
FERR (IBN,F$ERET) ;ILLEGAL BLOCK ON STRUCTURE
MOVEM T1,.FWADR(F) ;SAVE AS CURRENT RIB ADDRESS
PUSHJ P,F$SETX ;SET UP AN EXTENEDED RIB
POPJ P, ;PROPAGATE ERROR BACK
JRST F$ADVP ;LOOP BACK AND PROCESS THIS RIB
SUBTTL FILE SERVICE -- F$BLKS - CONVERT UNIT/BLOCK TO STRUCTURE
;ROUTINE TO TAKE A BLOCK NUMBER RELATIVE TO A UNIT AND CONVERT IT
;TO A STRUCTURE-RELATIVE BLOCK
;CALL: MOVE T1, LOGICAL UNIT NUMBER
; MOVE T2, BLOCK NUMBER
; PUSHJ P,F$BLKS
; <NON-SKIP> ;ILLEGAL BLOCK NUMBER
; <SKIP> ;T1:= STRUCTURE-RELATIVE BLOCK
F$BLKS: CAIL T1,0 ;RANGE CHECK
CAML T1,.DFSTN(D) ;REASONABLE UNIT NUMBER?
POPJ P, ;NO
PUSH P,T3 ;SAVE T3
MOVE T3,.DFBSC(D) ;GET BLOCKS PER SUPER CLUSTER
IMUL T3,.DFSCU(D) ;TIMES SUPER CLUSTERS PER UNIT
IMUL T1,T3 ;GET BLOCK AT START OF UNIT
ADD T1,T2 ;OFFSET FROM START OF UNIT
POP P,T3 ;RESTORE T3
JRST CPOPJ1 ;RETURN
SUBTTL FILE SERVICE -- F$BLKU - CONVERT BLOCK NUMBER TO UNIT
;ROUTINE TO TAKE A BLOCK NUMBER RELATIVE TO A STRUCTURE AND CONVERT IT
;TO A UNIT-RELATIVE BLOCK AND SET UP AC 'U' FOR THE APPROPRIATE UNIT
;CALL: MOVE T1, BLOCK NUMBER
; PUSHJ P,F$BLKU
; <NON-SKIP> ;ILLEGAL BLOCK NUMBER, T1 UNCHANGED
; <SKIP> ;T1:= UNIT-RELATIVE BLOCK, U:= UNIT
F$BLKU: CAIL T1,0 ;RANGE
CAMLE T1,.DFHLB(D) ; CHECK
POPJ P, ;ILLEGAL BLOCK ON STRUCTURE
PUSH P,T1 ;SAVE TARGET BLOCK
MOVE T2,.DFBSC(D) ;GET BLOCKS PER SUPER CLUSTER
IMUL T2,.DFSCU(D) ;TIMES SUPER CLUSTERS PER UNIT
IDIV T1,T2 ;COMPUTE UNIT NUMBER
CAML T1,.DFSTN(D) ;REASONABLE?
JRST TPOPJ ;NO
MOVEI U,(T1) ;GET UNIT NUMBER
IMULI U,.UNLEN ;TIMES WORDS PER UNIT STORAGE
ADDI U,.DFUNI(D) ;INDEX TO BLOCK FOR THIS UNIT
MOVE T1,T2 ;PLACE BLK # IN EXPECTED PLACE
CAMLE T1,.UNHLB(U) ;WITHIN LIMITS OF UNIT?
JRST TPOPJ ;NO
POP P,(P) ;PHASE STACK
JRST CPOPJ1 ;RETURN
SUBTTL FILE SERVICE -- F$BUFS - BUFFER SETUP
F$BUFS: PUSHJ P,SAVE3 ;SAVE SOME ACS
MOVE P1,.FWMOD(F) ;GET MODE WORD
HRRZ P2,.FWIOW(F) ;GET BUFFER ADDRESS -1
AOS P2 ;CORRECT FOR IOWD
HLRE P3,.FWIOW(F) ;GET -VE WORD COUNT
MOVMS P3 ;MAKE POSITIVE
LDB T1,[POINTR (P1,IO.MOD)] ;GET MODE
SKIPN IOBSIZ(T1) ;LEGAL?
FERR (IMD,F$ERET) ;ILLEGAL I/O MODE
TLNE P1,(UU.IBC) ;INHIBIT BUFFER CLEAR?
JRST FBUFS2 ;YES
;CLEAR BUFFER
FBUFS1: MOVSI T1,0(P2) ;GET STARTING ADDRESS
HRRI T1,1(P2) ;MAKE A BLT POINTER
MOVE T2,P2 ;GET STARTING ADDRESS AGAIN
ADDI T2,(P3) ;COMPUTE END OF BUFFER
SETZM (P2) ;CLEAR FIRST WORD
BLT T1,-1(T2) ;CLEAR ENTIRE BUFFER
;SET BUFFER ADDRESS
FBUFS2: MOVSI T1,(BF.VBR) ;VIRGIN BUFFER
TLNE P1,(UU.IBC) ;INHIBIT BUFFER CLEAR?
TLO T1,(BF.IBC) ;YES
HRR T1,P2 ;LOAD UP BUFFER ADDRESS
MOVEM T1,.FWBRH+.BFADR(F) ;SAVE
;SET BYTE POINTER
FBUFS3: HRLI T1,(44B5) ;START BUILDING BYTE POINTER
LDB T2,[POINT 6,.FWBRH+.BFPTR(F),11] ;GET CURRENT BYTE SIZE
LDB T3,[POINTR (P1,IO.MOD)] ;GET MODE
MOVE T3,IOBSIZ(T3) ;AND ASSOCIATED BYTE SIZE
SKIPN T2 ;ALREADY SET?
MOVEI T2,(T3) ;NO--DO IT NOW
DPB T2,[POINT 6,T1,11] ;SET BYTE SIZE
MOVEM T1,.FWBRH+.BFPTR(F) ;SAVE BYTE POINTER
;SET BYTE COUNT
FBUFS4: MOVEI T1,44 ;BITS PER WORD
LDB T2,[POINTR (P1,IO.MOD)] ;GET MODE
MOVE T2,IOBSIZ(T2) ;AND ASSOCIATED BYTE SIZE
IDIVI T1,(T2) ;COMPUTE BYTES PER WORD
PUSH P,T1 ;SAVE TEMPORARILY
MOVE T1,.FWIOD(F) ;GET DIRECTION OF I/O
HLRE T2,.FWIOW(F) ;GET BUFFER SIZE
MOVMS T2 ;MAKE POSITIVE
SKIPGE T3,.FWRWC(F) ;AND REMAINING WORD COUNT
JUMPE T1,[STOPCD (SBE,<Setting up buffers after EOF>,)]
MOVMS T3 ;MAKE IT POSITIVE
CAMLE T2,T3 ;MORE WORDS THAN WILL FILL BUFFER?
MOVE T2,T3 ;NO--REDUCE COUNT (NEARING EOF)
POP P,T1 ;RESTORE BYTES PER WORD
IMULI T1,(T2) ;GET BYTES IN ACTUAL WORDS
MOVEM T1,.FWBRH+.BFCTR(F) ;SAVE BYTE COUNT
JRST CPOPJ1 ;RETURN
;BYTE SIZE TABLE INDEXED BY I/O MODE
IOBSIZ: DEC 7 ;(00) ASCII
DEC 7 ;(01) ASCII LINE
DEC 9 ;(02) PACKED IMAGE MODE
DEC 8 ;(03) BYTE MODE
DEC 8 ;(04) EIGHT-BIT ASCII MODE
DEC 0 ;(05) RESERVED
DEC 0 ;(06) RESERVED
DEC 0 ;(07) RESERVED
DEC 36 ;(10) IMAGE
DEC 0 ;(11) RESERVED
DEC 0 ;(12) RESERVED
DEC 36 ;(13) IMAGE BINARY
DEC 36 ;(14) BINARY
DEC 36 ;(15) IMAGE DUMP
DEC 36 ;(16) DUMP RECORDS
DEC 36 ;(17) DUMP
SUBTTL FILE SERVICE -- F$CHKS - GENERATE A CHECKSUM
;ROUTINE TO GENERATE A CHECKSUM
;CALL: MOVE T1, WORD TO BE CHECKSUMMED
; PUSHJ P,F$CHKS
; <RETURN> ;T1 := RESULT
F$CHKS: PUSH P,T2 ;SAVE T2
PUSH P,T3 ;SAVE T3
PUSH P,T4 ;SAVE T4
MOVE T2,T1 ;COPY WORD TO BE CHECKSUMMED
MOVE T4,.DFCKP(D) ;GET CHECKSUM POINTER
HRRI T4,T2 ;WHERE THE DATA LIVES
LDB T3,[POINT 6,T4,11] ;GET SIZE OF CHECKSUM IN BITS
MOVNS T3 ;SET FOR LSH
TLZA T4,770000 ;SET TO BIT 35
FCHKS1: ADD T2,T1 ;ADD BYTE TO REST OF WORD (FOLD CHKSUM)
LDB T1,T4 ;GET A BYTE OF CHKSUM SIZE
LSH T2,(T3) ;THROW AWAY THE BYTE
JUMPN T2,FCHKS1 ;FINISHED WHEN NO MORE OF ORIGINAL WORD
POP P,T4 ;RESTORE T4
POP P,T3 ;RESTORE T3
POP P,T2 ;RESTORE T2
POPJ P, ;RETURN WITH ANSWER IN T1
SUBTTL FILE SERVICE -- F$CLOS - CLOSE A FILE
F$CLOS: SKIPN .FWCLS(F) ;BUFFERS TO WRITE?
JRST FCLOS1 ;NO
PUSHJ P,F$OBUF ;OUTPUT REMAINING BUFFERS
SKIPA ;FAILED
JRST FCLOS1 ;CONTINUE
SETZM .FWCLS(F) ;AVOID RECURSION
POPJ P, ;RETURN
FCLOS1: AOS (P) ;FLAG SUCCESS
POPJ P, ;RETURN
SUBTTL FILE SERVICE -- F$CVTF - CONVERT FILE BLOCK TO SCAN BLOCK
;ROUTINE TO CONVERT A FILE BLOCK INTO SCAN BLOCK FORMAT
;CALL: MOVE T1, FILE BLOCK ADDRESS
; MOVE T2, SCAN BLOCK ADDRESS
; PUSHJ P,F$CVTF
; <RETURN>
F$CVTF: PUSHJ P,SAVE3 ;SAVE SOME ACS
MOVE P1,T1 ;COPY FILE BLOCK ADDRESS
MOVE P2,T2 ;COPY SCAN BLOCK ADDRESS
MOVE T1,P2 ;COPY SCAN BLOCK ADDRESS
PUSHJ P,C$ZFIL ;CLEAR IT OUT
MOVSI T1,(SB.DEV!SB.NAM!SB.EXT!SB.DIR) ;FLAGS
MOVEM T1,.SBFLG(P2)
MOVE T1,.DFSTR(D) ;DEVICE
MOVEM T1,.SBDEV(P2)
SETOM .SBDVM(P2)
MOVE T1,.FBNAM(P1) ;FILE NAME
MOVEM T1,.SBNAM(P2)
SETOM .SBNMM(P2)
HLLZ T1,.FBEXT(P1) ;EXTENSION
HLLOM T1,.SBEXT(P2)
MOVE T1,.FBPPN(P1) ;PPN
MOVEM T1,.SBDIR(P2)
SETOM .SBDIM(P2)
MOVN P3,.DFFBL(D) ;-VE FILE BLOCK LENGTH
HRLZS P3 ;PUT IN LH
HRRI P3,(P1) ;POINT TO START OF SFDS
ADD P3,[.FBMIN,,0] ;COUNT ONLY THE SFDS
XMOVEI T2,.SBMIN(P2) ;POINT TO SFD LIST IN SCAN BLOCK
FCVTF1: SKIPN T1,.FBMIN(P3) ;END OF SFDS?
JRST FCVFT2 ;YES
MOVEM T1,(T2) ;SAVE SFD NAME
ADDI T2,2 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN P3,FCVTF1 ;LOOP FOR ALL SFDS
FCVFT2: MOVE T1,P1 ;RESTORE FILE BLOCK ADDRESS
MOVE T2,P2 ;RESTORE SCAN BLOCK ADDRESS
POPJ P, ;RETURN
SUBTTL FILE SERVICE -- F$DEL - DELETE A FILE
;DELETE A FILE AND ATTEMPT TO FREE UP BLOCKS
;CALL: PUSHJ P,F$DEL
; <NON-SKIP> ;T1 := ERROR CODE
; <SKIP> ;T1 := ALLOCATED BLOCKS FREED
F$DEL: PUSHJ P,SAVE2 ;SAVE P1 AND P2
PUSHJ P,F$SAVE ;SAVE THE STATE OF THE FILE SYSTEM
MOVE T1,.DFRSB(D) ;GET OFFSET TO RETURNED SCAN BLOCK
ADDI T1,(D) ;RELOCATE
MOVE P1,.SBNAM(T1) ;SAVE TARGET FILE NAME
HLRZ P2,.SBEXT(T1) ; AND THE EXTENSION
PUSHJ P,FDELIN ;FIXUP INPUT SCAN BLOCK
MOVEI T1,.IOIMG ;MODE = IMAGE
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;IOWD
PUSHJ P,F$INI ;INITIALIZE FOR FILE I/O
JRST FDELER ;I/O SETUP FAILED
PUSHJ P,F$LKP ;FIND THE DIRECTORY
FERR (DLF,FDELER) ;REPORT DIRECTORY LOOKUP FAILURE
FDEL1: PUSHJ P,F$IBUF ;READ A BUFFER
JRST FDELER ;FAILED (EOF CONSIDERED FAILURE HERE TOO)
MOVE T1,[-BLKSIZ,,CPYBUF] ;AOBJN POINTER TO BUFFER
FDEL2: HLRZ T2,1(T1) ;GET EXTENSION
CAMN P1,0(T1) ;FILE NAME MATCH?
CAIE P2,(T2) ;EXTENSION MATCH?
AOBJN T1,.+2 ;NO
JRST FDEL3 ;GO REMOVE DIRECTORY ENTRY
AOBJN T1,FDEL2 ;LOOP THROUGH BUFFER
JRST FDEL1 ;GO READ ANOTHER BUFFER
FDEL3: SETZM 0(T1) ;CLEAR FILE NAME
SETZM 1(T1) ;CLEAR EXTENSION & CFP
MOVE T1,.FWSBN(F) ;GET BLOCK ON STRUCTURE
PUSHJ P,F$BLKU ;SET UP UNIT AND BLOCK ON UNIT
FERR (IBN,FDELER) ;ILLEGAL BLOCK NUMBER
MOVE T2,[IOWD BLKSIZ,CPYBUF] ;GET IOWD
PUSHJ P,U$WRIT ;WRITE DIRECTORY DATA BLOCK
FERR (OER,FDELER) ;OUTPUT ERROR
PUSHJ P,F$REST ;RESTORE THE STATE OF THE FILE SYSTEM
PUSHJ P,F$DRIB ;DEALLOCATE ALL CLUSTERS FOR THIS FILE
TDZA T1,T1 ;CAN'T
MOVE T1,T2 ;COPY BLOCKS FREED
JRST CPOPJ1 ;RETURN WITH COUNT OF BLOCKS FREED IN T1
;HERE ON ERRORS
FDELER: MOVE T1,.FWECD(F) ;GET ERROR CODE
CAIN T1,FEFNF% ;FILE NOT FOUND?
SKIPA T2,.DFINP(D) ;MUST USE INPUT SPEC
MOVE T2,.DFRSB(D) ;ELSE USE TRANSLATION SCAN BLOCK
ADDI T2,(D) ;RELOCATE
FATAL (LKP,.+1,<LOOKUP failed for >,T$FERR)
PUSHJ P,F$REST ;RESTORE THE STATE OF THE FILE SYSTEM
MOVE T1,.FWECD(F) ;GET ERROR CODE BACK
POPJ P, ;RETURN
;ROUTINE TO FIXUP INPUT SPEC
FDELIN: MOVE T1,.DFRSB(F) ;GET OFFSET TO RETURNED SCAN BLOCK
ADDI T1,(D) ;RELOCATE
MOVE T2,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T2,(D) ;RELOCATE
PUSH P,T2 ;SAVE FOR LATER
HRLZS T1 ;PUT IN LH
HRRI T1,(T2) ;MAKE A BLT POINTER
ADD T1,.DFSBL(D) ;COMPUTE END OF BLT
BLT T1,-1(T2) ;MAKE NEW INPUT SCAN BLOCK
POP P,T1 ;GET INPUT SCAN BLOCK BACK
MOVEI T2,.SBDIR(T1) ;POINT TO START OF PATH
FDELI1: SKIPN 0(T2) ;DIRECTORY COMPONENT SPECIFIED?
SKIPE 1(T2) ;NO--END OF PATH?
AOJA T2,[AOJA T2,FDELI1] ;SEARCH FOR END
SUBI T2,2 ;BACK OFF TO LAST COMPONENT
SETZ T3, ;CLEAR AC
EXCH T3,0(T2) ;GET DIRECTORY COMPONENT, ZERO STORAGE
MOVEM T3,.SBNAM(T1) ;STORE AS FILE NAME
SETZ T3, ;CLEAR AC
EXCH T3,1(T2) ;GET MASK, ZERO STORAGE
MOVEM T3,.SBNMM(T1) ;STORE IT TOO
HRLOI T3,'UFD' ;ASSUME A UFD
CAIE T2,.SBDIR(T1) ;AT THE BEGINING (PPN)?
HRLI T3,'SFD' ;NO--MUST BE AN SFD
MOVEM T3,.SBEXT(T1) ;STORE EXTENSION & MASK
MOVE T3,.DFMFD(D) ;GET MFD PPN
CAIN T2,.SBDIR(T1) ;AT THE BEGINING (PPN)?
MOVEM T3,.SBDIR(T1) ;YES--STORE MFD FOR PPN
SETOM .SBDIM(T1) ;MAKE SURE MASK IS SET FOR PPN COMPONENT
POPJ P, ;RETURN
SUBTTL FILE SERVICE -- F$ECOD - STORE AN ERROR CODE
F$ECOD: EXCH T1,(P) ;SAVE T1, GET CALLER'S ADDRESS
MOVE T1,(T1) ;FETCH ERROR CODE TO STORE
HLRZM T1,FILERR ;STORE GLOBAL ERROR CODE
SKIPE FILMEM ;DATA BASE SETUP?
HLRZM T1,.FWECD(F) ;SAVE IT AWAY
HRRM T1,-1(P) ;SET RETURN ADDRESS
JRST TPOPJ ;RESTORE T1 AND DISPATCH
F$ERET: SKIPN FILMEM ;DATA BASE SETUP?
SKIPA T1,FILERR ;NO--USE GLOBAL LOCATION
MOVE T1,.FWECD(F) ;GET ERROR CODE
POPJ P, ;RETURN
SUBTTL FILE SERVICE -- F$ETXT - RETURN ERROR TEXT
F$ETXT: PUSHJ P,F$ERET ;GET ERROR CODE
HRRZ T1,FETEXT-1(T1) ;TRANSLATE TO TEXT
POPJ P, ;RETURN
;ERROR TABLE
DEFINE X (NAM,TXT),<XWD ''NAM'',[ASCIZ \TXT\]>
FETEXT: FERRT
SUBTTL FILE SERVICE -- F$FIN - FINISH I/O PROCESSING
F$FIN: PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
SETZM .FWCLS(F) ;DON'T FORCE OUT BUFFERS
PUSHJ P,F$CLOS ;DO OTHER CLEANUP
JFCL ;IGNORE ERRORS
MOVE T1,FILMEM+0 ;GET WORD COUNT
SKIPE T2,FILMEM+1 ;AND ADDRESS
PUSHJ P,M$GIVW ;RELEASE CORE
MOVE T1,[Z.FILB,,Z.FILB+1] ;SET UP BLT
SETZM Z.FILB ;CLEAR FIRST WORD
BLT T1,Z.FILE-1 ;CLEAR ALL STORAGE
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL FILE SERVICE -- F$FMOD - FETCH WILDCARD MODE
;ROUTINE TO FETCH THE PROPER WILDCARDMODE INDEX
;CALL: MOVE T1, MODE WORD
; PUSHJ P,F$FMOD
;
;ON RETURN, T1 := WILDCARD MODE INDEX
F$FMOD: HLRZS T1 ;MOVE TO LH
ANDI T1,(F.WILD) ;ISOLATE IT
SKIPN T1 ;DEFAULTING?
LDB T1,[POINTR (.DFFLG(D),DF.FAC)] ;YES
PUSH P,T2 ;SAVE T2
HLRE T2,FLKP.N ;GET -VE LENGTH OF TABLE
MOVMS T2 ;MAKE POSITIVE
CAIL T1,1 ;KNOWN
CAILE T1,(T2) ; TYPE?
STOPCD (IMI,<Illegal mode index; >,T$OCTW)
POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
SUBTTL FILE SERVICE -- F$FSCN - FIXUP SCAN BLOCK DEFAULTS
;ROUTINE TO FILL IN EMPTY PORTIONS OF A SCAN BLOCK
;CALL: MOVE T1, SCAN BLOCK ADDRESS
; PUSHJ P,F$FSCN
; <NON-SKIP> ;ILLEGAL DATA IN SCAN BLOCK
; <SKIP> ;SCAN BLOCK READY TO USE
F$FSCN: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,T1 ;COPY SCAN BLOCK ADDRESS
MOVE P2,.SBFLG(P1) ;PICK UP SCAN BLOCK FLAGS
PUSHJ P,FSCDEV ;DO DEVICE FIXUPS
POPJ P, ;FAILED
PUSHJ P,FSCUFD ;DO UFD FIXUPS
PUSHJ P,FSCPPN ;DO PPN FIXUPS
PUSHJ P,FSCPTH ;DO PATH FIXUPS
MOVEM P2,.SBFLG(P1) ;UPDATE FLAGS
MOVE T1,P1 ;RESET SCAN BLOCK ADDRESS
JRST CPOPJ1 ;RETURN
;VALIDATE DEVICE
FSCDEV: MOVE T1,.SBDEV(P1) ;GET DEVICE
MOVE T2,.SBDVM(P1) ;AND MASK
CAMN T1,T2 ;MATCH EACH OTHER (LOOKING FOR ZERO)?
JUMPE T1,FSCDE3 ;OK IF NOTHING SPECIFIED
AOJN T2,FSCDE2 ;JUMP IF WILDCARDED DEVICE
MOVSS T1 ;SWAP HALVES
CAIE T1,'D ' ;ABBREVIATION
CAIN T1,'DS ' ; FOR DSK?
MOVEI T1,'DSK' ;YES
CAIN T1,'DSK' ;OR GENERIC DSK?
SKIPA T1,.DFSTR(D) ;THAT'S ALLOWED
MOVSS T1 ;ELSE SWAP HALVES BACK
CAMN T1,.DFSTR(D) ;MATCH STRUCTURE?
JRST FSCDE3 ;YES
MOVN T2,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS T2 ;PUT IN LH
HRRI T2,.DFUNI(D) ;MAKE AN AOBJN POINTER
FSCDE1: CAMN T1,.UNLOG(U) ;LOGICAL UNIT NAME?
JRST FSCDE3 ;YES
ADDI T2,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN T2,FSCDE1 ;TRY ALL UNIT BLOCKS
SETZ T2, ;DON'T KNOW THE PPN
PUSHJ P,D$EDVF ;SEARCH THE ERSATZ DEVICE TABLE
FSCDE2: FERR (IDV,F$ERET) ;RETURN ILLEGAL DEVICE
MOVEM T2,.SBDIR(P1) ;SET PPN
SETOM .SBDIM(P1) ;AND MASK
TLO P2,(SB.PPN) ;REMEMBER PPN WAS ALREADY FIXED UP
TLNN P2,(SB.DIR) ;SOME SORT OF DIRECTORY SPECIFIED?
TLNN P2,(SB.DPT) ;NO--DID USER TYPE FOO:[-]
TLO P2,(SB.DIR) ;OVERRIDE ENTIRE DIRECTORY
FSCDE3: MOVE T1,.DFSTR(D) ;IN THE END, ALWAYS USE STRUCTURE NAME
MOVEM T1,.SBDEV(P1) ;UPDATE DEVICE INCASE IT CHANGED
SETOM .SBDVM(P1) ;SET NON-WILDCARDED DEVICE MASK
TLO P2,(SB.DEV) ;SAY DEVICE SPECIFIED
JRST CPOPJ1 ;RETURN GOODNESS
;VALUDATE UFDS
FSCUFD: MOVE T1,.SBEXT(P1) ;GET EXTENSION AND MASK
TLNN P2,(SB.DIR!SB.DPT!SB.DCP!SB.DLP!SB.PPN) ;DIR OR FIXUP NEEDED?
CAME T1,['UFD',,-1] ;"UFD" EXTENSION WITHOUT WILDCARDS?
POPJ P, ;THEN DO NOTHING HERE
MOVE T1,.DFMFD(D) ;GET MFD PPN
MOVEM T1,.SBDIR(P1) ;STORE PPN
SETOM .SBDIM(P1) ;SET MASK
TLO P2,(SB.DIR!SB.PPN) ;HAVE DIRECTORY NOW CUZ PPN FIXED UP
POPJ P, ;RETURN
;VALIDATE PPN
FSCPPN: SETZ T1, ;DON'T KNOW WHAT TO DO YET
TLZE P2,(SB.DCP) ;NEED TO DEFAULT CURRENT PPN?
MOVE T1,.DFPPN(D) ;YES
TLZE P2,(SB.DLP) ;NEED TO DEFAULT LOGGED-IN PPN?
MOVE T1,.DFLPN(D) ;YES
JUMPE T1,CPOPJ ;RETURN IF NO WORK TO DO
;PROJECT NUMBER
FSCPP1: HLRE T2,.SBDIR(P1) ;GET PROJECT NUMBER
JUMPN T2,FSCPP2 ;JUMP IF ONE SPECIFIED
HLRE T2,.SBDIM(P1) ;GET MASK
AOJN T2,FSCPP2 ;JUMP IF WILDCARDED
HLLM T1,.SBDIR(P1) ;SET PROJECT NUMBER
HRROS .SBDIM(P1) ;AND MASK
;PROGRAMMER NUMBER
FSCPP2: HRRE T2,.SBDIR(P1) ;GET PROGRAMMER NUMBER
JUMPN T2,FSCPP3 ;JUMP IF ONE SPECIFIED
HRRE T2,.SBDIM(P1) ;GET MASK
AOJN T2,FSCPP3 ;JUMP IF WILDCARDED
HRRM T1,.SBDIR(P1) ;SET PROGRAMMER NUMBER
HLLOS .SBDIM(P1) ;AND MASK
FSCPP3: TLO P2,(SB.PPN) ;MARK PPN AS FIXED UP
POPJ P, ;RETURN
;VALIDATE PATH
FSCPTH: TLNN P2,(SB.DIR) ;WAS ANY DIRECTORY SPECIFIED?
TLO P2,(SB.DPT) ;NO--FORCE DEFAULT PATH
TLZN P2,(SB.DPT) ;NEED TO USE DEFAULT PATH?
POPJ P, ;NO
MOVE T1,.DFPTH(D) ;GET -VE LENGTH,,OFFSET
ADDI T1,.PTPPN(D) ;RELOCATE TO START OF ACTUAL PATH
MOVEI T2,.SBDIR(P1) ;POINT TO START OF PATH IN SCAN BLOCK
TLNE P2,(SB.PPN) ;PPN FIXED UP?
JRST FSCPT2 ;YES--SKIP FIRST ENTRY IN DIRECTORY
FSCPT1: SKIPN T3,(T1) ;GET LEVEL FROM USER'S DEFAULT PATH
SOS T1 ;BLANK--HOLD POINTER
MOVEM T3,0(T2) ;STORE IN ARGUMENT AREA
SKIPE T3 ;SEE IF BLANK
SETOM T3 ;NO--FULL MATCH
MOVEM T3,1(T2) ;STORE AWAY
FSCPT2: ADDI T2,2 ;ADVANCE STORAGE
AOBJN T1,FSCPT1 ;LOOP UNTIL DONE
TLO P2,(SB.DIR) ;SAY DIRECTORY SPECIFIED
POPJ P, ;RETURN
SUBTTL FILE SERVICE -- F$RHOM - READ A HOM BLOCK
;READ A HOM BLOCK GIVEN A UNIT
;CALL: MOVE T1, BUFFER ADDRESS
; PUSHJ P,F$RHOM/U
; <NON-SKIP> ;FAILED
; <SKIP> ;SUCCESS
;
;ON EITHER RETURN, T1 := ERROR FLAGS (1ST,,2ND)
F$RHOM: TDZA T2,T2 ;FILE I/O ENTRY POINT
F$UHOM: MOVNI T2,1 ;PHYSICAL UNIT ENTRY POINT
PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;COPY BUFFER ADDRESS
MOVNI P2,1 ;FLAG FIRST TIME THROUGH
SETZ P3, ;CLEAR 1ST,,2ND ERROR FLAGS
MOVE P4,T2 ;SAVE FLAG
PUSH P,[EXP 0] ;RESTORE TEMP STORAGE
FRHOM1: SKIPA T1,[LBNHOM] ;FIRST BLOCK NUMBER
FRHOM2: MOVEI T1,LB2HOM ;SECOND BLOCK
JUMPL P4,FRHOM3 ;JUMP IF UNIT ALREADY SET UP
PUSHJ P,F$BLKU ;CONVERT TO LBN TO BLOCK ON UNIT
WARN (HTE,FRHOM5,<HOM block translation error on block >,T$DECW)
FRHOM3: MOVEM T1,(P) ;SAVE BLOCK NUMBER
MOVSI T2,-BLKSIZ ;NUMBER OF WORDS
HRRI T2,-1(P1) ;BUFFER ADDRESS
PUSHJ P,U$READ ;READ THE BLOCK
JRST FRHOM5 ;I/O ERROR
JRST FRHOM6 ;GO CHECK IT OUT
FRHOM4: WARN (HBC,.+1,<HOM block consistancy error on >,E..HBC)
SKIPGE P2 ;WHICH HOM BLOKC
TLOA P3,400000 ;FIRST
TRO P3,400000 ;SECOND
FRHOM5: AOJE P2,FRHOM2 ;TRY OTHER BLOCK
MOVE T1,.UNNAM(U) ;GET UNIT NAME
JUMPL P4,FRHOM7 ;SKIP FATAL ERROR IF PHYSICAL UNIT GIVEN
FATAL (CRH,FRHOM7,<Cannot read HOM blocks on unit >,T$SIXN)
FRHOM6: MOVS T1,HOMNAM(P1) ;GET SIXBIT 'HOM'
CAIE T1,'HOM' ;CHECK IT
JRST FRHOM4 ;NO GOOD
MOVE T1,HOMCOD(P1) ;GET MAGIC CODE
CAIE T1,CODHOM ;MATCH?
JRST FRHOM4 ;NO
MOVE T1,HOMSLF(P1) ;GET SELF POINTER
CAME T1,(P) ;MATCH REQUESTED BLOCK NUMBER?
JRST FRHOM4 ;NO
MOVE T1,P1 ;COPY BUFFER ADDRESS
AOS -1(P) ;FORCE SKIP
FRHOM7: POP P,(P) ;PHASE STACK
MOVE T1,P3 ;GET ERROR FLAGS BACK
POPJ P, ;RETURN
E..HBC: MOVE T1,.UNNAM(U) ;GET UNIT NAME
PUSHJ P,T$SIXN ;PRINT IT
MOVEI T1,[ASCIZ /, block /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,.UNPOS(U) ;GET POSITION BEFORE I/O
PJRST T$DECW ;PRINT IT AND RETURN
SUBTTL FILE SERVICE -- F$IBUF - INPUT
F$IBUF: SETZM .FWIOD(F) ;SET I/O DIRECTION (READ)
MOVE T1,.FWRPT(F) ;GET CURRENT RETRIEVAL POINTER
MOVEM T1,.FWOPT(F) ;SAVE FOR LATER COMPARRISON
PUSHJ P,F$ADVP ;ADVANCE RETRIEVAL POINTER IF NECESSARY
PJRST F$ERET ;FETCH ERROR CODE AND RETURN TO CALLER
PUSHJ P,F$BUFS ;SET UP BUFFER RING HEADER
PJRST F$ERET ;BAD MODE, ETC.
MOVE R,.FWRPT(F) ;GET ADDRESS OF RETRIEVAL POINTER
MOVE R,(R) ;AND THE POINTER ITSELF
HRRZ T1,.FWLFT(F) ;GET BLOCKS INTO THE CURRENT POINTER
LDB T2,.DFCLP(D) ;GET CLUSTER ADDRESS
IMUL T2,.DFBPC(D) ;TRANSLATE TO BLOCK NUMBER
ADD T2,T1 ;THIS IS THE STARTING BLOCK TO READ
MOVE T1,.FWUNI(F) ;GET CURRENT UNIT
PUSHJ P,F$BLKS ;TRANSLATE TO BLOCK ON STRUCTURE
FERR (IBN,F$ERET) ;ILLEGAL
MOVEM T1,.FWSBN(F) ;SAVE STRUCTURE-RELATIVE BLOCK NUMBER
PUSHJ P,F$BLKU ;SET UP UNIT AND BLOCK ON UNIT
FERR (IBN,F$ERET) ;ILLEGAL BLOCK NUMBER
MOVEM T1,.FWUBN(F) ;SAVE UNIT-RELATIVE BLOCK NUMBER
MOVE T2,.FWIOW(F) ;GET IOWD
PUSHJ P,U$READ ;READ DATA
FERR (IER,F$ERET) ;REPORT INPUT ERROR
MOVEI T1,RIPABC ;BIT TO TEST
MOVSI T2,(DF.CED) ;...
TDNN T1,.FWRIB+RIBSTS(F) ;DOES FILE ALWAYS HAVE BAD CHECKSUM?
TDNN T2,.DFFLG(D) ;NO--DO WE WANT CHECKSUM ERROR DECTECTION?
JRST FIBUF1 ;SKIP CHECKSUM STUFF
MOVE T1,.FWRPT(F) ;GET CURRENT RETRIEVAL POINTER
CAMN T1,.FWOPT(F) ;MATCH THE OLD ONE?
JRST FIBUF1 ;THEN NO NEED TO COMPARE CHECKSUMS
HRRZ T1,.FWIOW(F) ;GET ADDRESS-1 OF USER BUFFER
MOVE T1,1(T1) ;GET THE FIRST WORD IN THE BUFFER
PUSHJ P,F$CHKS ;GENERATE CHECKSUM
MOVE R,.FWRPT(F) ;GET ADDRESS OF RETRIEVAL POINTER
MOVE R,(R) ;AND THE POINTER ITSELF
LDB T2,.DFCKP(D) ;FETCH CHECKSUM
CAIN T1,(T2) ;MATCH?
JRST FIBUF1 ;YES
FERR (CKS,F$ERET) ;REPORT CHECKSUM ERROR
FIBUF1: HLRE T1,.FWIOW(F) ;GET WORDS JUST TRANSFERED
PUSHJ P,F$XFRB ;COUNT BLOCKS
PUSHJ P,F$TRAC ;SEE IF I/O TRACING ENABLED
FERR (STP,F$ERET) ;USER STOPPED I/O
JRST CPOPJ1 ;RETURN
SUBTTL FILE SERVICE -- F$IBYT - INPUT A BYTE
F$IBYT: SOSGE .FWBRH+.BFCTR(F) ;COUNT CHARACTERS
JRST FIBYT1 ;BUFFER EMPTY
ILDB T1,.FWBRH+.BFPTR(F) ;GET A CHARACTER
JRST CPOPJ1 ;AND RETURN
FIBYT1: PUSHJ P,F$IBUF ;INPUT A BUFFER
PJRST F$ERET ;FAILED--RETURN ERROR CODE
JRST F$IBYT ;LOOP BACK AND TRY AGAIN
SUBTTL FILE SERVICE -- F$INI - INITIAL FOR FILE I/O
;ROUTINE TO INITIALIZE THE FILE I/O DATA BASE. MUST BE
;CALLED PRIOR TO ANY FILE OPERATION.
;CALL: MOVE T1, MODE WORD
; MOVE T2, IOWD TO BUFFER
; PUSHJ P,F$INI
; <NON-SKIP> ;FAILED
; <SKIP> ;READ FOR LOOKUP/ENTER/REMANE
F$INI: PUSHJ P,SAVE2 ;SAVE P1 AND P2
PUSHJ P,F$FIN ;MAKE SURE WE HAVE A CLEAN START
MOVEM T1,FILMOD ;SAVE MODE WORD
MOVEM T2,FILIOW ;SAVE IOWD
PUSHJ P,F$FMOD ;GET WILDCARD MODE INDEX
DPB T1,[POINTR (FILMOD,F.WILD)] ;UPDATE
MOVSI T2,(F.NOIO) ;GET A BIT
CAIN T1,1 ;*** DISK-DIRECTORY?
ANDCAM T2,FILMOD ;I/O SUPPRESS LEGAL IF LOOKUP VIA DATA FILE
MOVE T2,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T2,(D) ;RELOCATE
SKIPN .DFSTR(D) ;STRUCTURE PARAMETERS SETUP YET?
FERR (SPN,F$ERET) ;NO
MOVE T1,T2 ;COPY SCAN BLOCK ADDRESS
PUSHJ P,F$FSCN ;DO NECESARY FIXUPS
JRST [MOVE T2,.DFINP(D) ;GET OFFSET
ADDI T2,(D) ;RESET SCAN BLOCK ADDRESS
POPJ P,] ;PROPAGATE ERROR BACK
MOVE T2,.DFLVL(D) ;GET MAXIMUM SFD LEVEL
ADDI T2,1+1 ;+ 1 FOR UFD + 1 FOR DATA FILE
MOVEI T1,.FWLEN ;GET LENGTH OF DIRECTORY LEVEL DATA BLOCK
IMULI T1,(T2) ;TIMES N LEVELS
ADDI T1,(T2) ;PLUS ROOM FOR THE TABLE ITSELF
PUSHJ P,M$GETW ;ALLOCATE CORE FOR DIRECTORY TABLE
MOVEM T1,FILMEM+0 ;SAVE WORD COUNT
MOVEM T2,FILMEM+1 ;SAVE ADDRESS
MOVEM T2,FILTBL ;SAVE TABLE ADDRESS
MOVE T1,.DFLVL(D) ;GET MAXIMUM SFD LEVEL
ADDI T1,1+1 ;+ 1 FOR UFD + 1 FOR DATA FILE
MOVNS T1 ;NEGATE
HRLZS T1 ;PUT IN LH
HRR T1,T2 ;INCLUDE TABLE ADDRESS
MOVEM T1,FILPTR ;SAVE TABLE POINTER
MOVE F,FILMEM+1 ;GET START OF DATA STORAGE
ADD F,.DFLVL(D) ;OFFSET TO FIRST DIRECTORY LEVEL BLOCK
ADDI F,1+1 ;+ 1 FOR UFD + 1 FOR DATA FILE
MOVEI T2,0 ;INIT DIRECTORY LEVEL COUNTER
FINI1: MOVEM T1,.FWLVP(F) ;STORE POINTER TO OURSELVES
MOVEM F,(T1) ;STORE DIRECTORY LEVEL BLOCK ADDRESS
MOVEM T2,.FWLVL(F) ;STORE "THIS" LEVEL NUMBER
MOVE T3,FILIOW ;GET IOWD
MOVEM T3,.FWIOW(F) ;SAVE FOR THIS MODE
MOVE T3,FILMOD ;GET MODE WORD
MOVEM T3,.FWMOD(F) ;SAVE FOR THIS LEVEL
ADDI F,.FWLEN ;OFFSET TO NEXT BLOCK
AOS T2 ;ADVANCE LEVEL COUNTER
AOBJN T1,FINI1 ;FILL THE TABLE
MOVE P1,FILPTR ;TABLE OF DIRECTORY LEVEL POINTERS
ADD P1,[1,,0] ;DONT ALLOW ACCESS TO DATA FILE BLOCK
MOVEI P2,.SBDIR ;STARTING DIRECTORY OFFSET
FINI2: MOVE F,(P1) ;GET A FILE I/O BLOCK ADDRESS
MOVE T4,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T4,(D) ;RELOCATE
MOVE T1,.SBNAM(T4) ;GET FILE NAME
MOVEM T1,.FWNAM+0(F)
MOVE T1,.SBNMM(T4) ;AND MASK
MOVEM T1,.FWNAM+1(F)
MOVE T2,.SBEXT(T4) ;GET EXTENSION & MASK
HLLZM T2,.FWEXT+0(F)
HRLZM T2,.FWEXT+1(F)
CAIN P2,.SBDIR ;UFD?
SKIPA T3,['UFD '] ;YES
MOVSI T3,'SFD' ;ELSE MUST BE AN SFD
MOVEI T4,(P2) ;COPY OFFSET
ADD T4,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T4,(D) ;RELOCATE
SKIPN T1,0(T4) ;GET NAME
JRST FINI3 ;END OF SPECIFIED PATH
MOVEM T1,.FWDIR+0(F) ;SAVE DIRECTORY NAME
MOVE T1,1(T4) ;GET MASK
MOVEM T1,.FWDIR+1(F) ;SAVE IT TOO
ADDI P2,2 ;ADVANCE SCAN BLOCK OFFSET
SKIPE T1,0(T4) ;GET LAST DIRECTORY LEVEL?
AOBJN P1,FINI2 ;NO--ADVANCE TO NEXT LEVEL
FINI3: SKIPGE P1 ;FULL PATH?
AOBJN P1,.+1 ;ADVANCE TO NEXT LEVEL
FINI5: MOVE F,(P1) ;GET BLOCK POINTER
MOVN T1,.FWLVL(F) ;GET THIS LEVEL NUMBER
HRLM T1,FILPTR ;FIX MAXIMUM DEPTH OF SEARCH
MOVE P1,FILPTR ;GET UPDATED TABLE POINTER
MOVE F,(P1) ;GET A FILE I/O DATA BLOCK
MOVEM P1,.FWLVP(F) ;STORE POINTER TO OURSELVES
AOBJN P1,.-2 ;LOOP FOR ALL LEVELS
MOVE F,(P1) ;FOR DATA FILE
MOVEM P1,.FWLVP(F) ;SET ITS POINTER TOO
MOVE P1,FILPTR ;GET TABLE POINTER ONCE AGAIN
MOVE F,(P1) ;POINT TO TOP LEVEL
SETOM FILINI ;FLAG ALL INITIALIZED
JRST CPOPJ1 ;RETURN
SUBTTL FILE SERVICE -- F$LKP - LOOKUP
F$LKP: SKIPN FILINI ;PROPERLY INITIALIZED?
FERR (INI,F$ERET) ;NO
PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE T1,.FWMOD(F) ;GET MODE WORD
SETZM FILIOT ;DON'T DO I/O TRACING ON INTERNAL CALLS
PUSHJ P,F$FMOD ;GET WILDCARD MODE INDEX
JRST @FLKP.P(T1) ;DISPATCH TO APPROPRIATE CODE
;COMMON ERROR EXIT
FLKPER: SETOM FILIOT ;ALLOW I/O TRACING
SKIPN FILFIL+1 ;FOUND ANY FILES?
FERR (FNF,F$ERET) ;NO--SAY FILE NOT FOUND
FERR (NMF,F$ERET) ;ELSE RETURN NO MORE FILES
DEFINE KEYS,<
KEY (<DISK-DIRECTORY>, FLKPD, , )
KEY (<POSITIONAL-FILE-BLOCK>, FLKPP, , )
KEY (<SORTED-FILE-BLOCK>, FLKPS, , )
>
KEYTAB (FLKP,<TBL,NAM,PRC>)
DEFFAC: ASCIZ /DISK-DIRECTORY/ ;DEFAULT ACCESS TYPE
BLOCK MAXHKS-<.-DEFFAC> ;PAD OUR REMAINDER
;DIRECTORY SCAN LOOKUP USING HOM BLOCKS
FLKPD: AOSN .FWCON(F) ;WANT TO CONTINUE SCANNING PREVIOUS LEVEL?
JRST FLKPD7 ;YES
FLKPD1: PUSHJ P,LKPLVL ;SET UP CURRENT LEVEL
JRST FLKPD8 ;PROBABLY EOF
;READ A DIRECTORY BLOCK
FLKPD2: PUSHJ P,F$IBUF ;READ A BUFFER
JRST FLKPD8 ;MAYBE EOF
MOVSI T1,-BLKSIZ ;-VE BUFFER LENGTH
HRRI T1,.FWBUF(F) ;MAKE AN AOBJN POINTER
;SCAN THE DIRECORY BLOCK
FLKPD3: MOVEM T1,.FWPTR(F) ;SAVE POINTER WITHIN CURRENT BLOCK
PUSHJ P,LKPWLD ;COMPARE
FLKPD4: SKIPA T1,.FWPTR(F) ;GET POINTER WITHIN CURRENT DIRECTORY BLOCK
JRST FLKPD5 ;ADVANCE TO NEXT LEVEL
AOBJN T1,.+1 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN T1,FLKPD3 ;LOOP BACK FOR ANOTHER ENTRY
JRST FLKPD2 ;GO GET ANOTHER DIRECTORY BLOCK
;DROP DOWN ONE LEVEL
FLKPD5: HRRZ T3,1(T1) ;GET COMPRESSED FILE POINTER
IMUL T3,.DFBPC(D) ;BLOCK := CFP * BLOCKS PER CLUSTER
MOVE T2,.FWLVP(F) ;GET LEVEL POINTER
AOBJN T2,.+1 ;ADVANCE TO NEXT LEVEL
MOVE T2,(T2) ;GET ADDR
EXCH T2,F ;SWAP LEVEL POINTERS
MOVEM T3,.FWPRM(F) ;SAVE DISK ADDRESS FOR NEXT FILE
SKIPGE .FWPAS(T2) ;IF PASS 1
JRST FLKPD6 ; THEN RETURN THE FILE NO MATTER WHAT
SKIPN .FWDIF(T2) ;IS THIS A DIRECTORY?
JRST FLKPD ;NO--SKIP IT
MOVSI T3,(F.DIRB) ;BITS TO TEST
MOVSI T4,(F.RETB) ;...
TDNE T3,.FWMOD(T2) ;WANT THE DIRECTORY FILE NOW?
TDNE T4,.FWMOD(T2) ;HAVE WE ALREADY RETURNED DIRECTORY AS A FILE?
JRST FLKPD ;DO IT ONLY ONCE
IORM T4,.FWMOD(T2) ;REMEMBER WHAT WE'RE ABOUT TO DO
;HERE WHEN A FILE IS FOUND
FLKPD6: AOS .FWFIL+1(F) ;COUNT FILES FOUND
AOS FILFIL+1 ;THE GLOBAL COUNT TOO
PUSHJ P,LKPLVL ;READ THE RIB INTO CORE
JFCL ;LET ALL ERRORS TRICKLE BACK TO CALLER
MOVE T1,FILIOW ;GET CALLER-SPECIFIED IOWD
MOVEM T1,.FWIOW(F) ;RESET IT
SETOM .FWBRH+.BFCTR(F) ;FORCE FIRST INPUT TO BE DONE
SETZM .FWBRH+.BFPTR(F) ;FORCE CALLER SPECIFIED MODE TO BE SET
PUSHJ P,LKPRFS ;SETUP RETURNED FILESPEC SCAN BLOCK
SETOM .FWCON(F) ;PICK UP AT PREVIOUS LEVEL NEXT TIME
SETOM .FWOPF(F) ;FLAG FILE IS NOW "OPENED"
MOVEM F,FILSVF ;SAVE F
SETOM FILIOT ;ALLOW I/O TRACING
JRST CPOPJ1 ;RETURN
;CONTINUE FROM WHERE WE LEFT OFF
FLKPD7: PUSHJ P,LKPBAK ;BACKUP ONE LEVEL
MOVE T1,.FWMOD(F) ;GET MODE WORD
TLNE T1,(F.RETB) ;WAS DIRECTORY RETURED "BEFORE"?
JRST FLKPD ;NOW RETURN THE CONTENTS
JRST FLKPD4 ;GO GET NEXT ENTRY
;POP BACK UP A LEVEL
FLKPD8: MOVE T1,.FWLVP(F) ;GET OUR LEVEL POINTER
AOSN .FWPAS(F) ;END PASS 1
AOBJN T1,[PUSHJ P,LKPLVL ;ADVANCE DOWN A LEVEL
JRST FLKPD8 ;SHOULDN'T HAPPEN
AOS .FWPAS(F) ;STARTING PASS 2 (LKPLVL RESETS FLAG)
JRST FLKPD2] ;AND CONTINUE
SKIPG .FWLVL(F) ;EOF READING THE MFD?
PJRST FLKPER ;YES--GO FINISH UP
PUSHJ P,LKPBAK ;BACKUP ONE LEVEL
SKIPN .FWDIF(F) ;A DIRECTORY FILE?
JRST FLKPD4 ;NO--IGNORE DATA FILES HERE
MOVSI T1,(F.DIRA) ;BIT TO TEST
MOVSI T2,(F.RETA) ;ONE MORE
TDNE T1,.FWMOD(F) ;WANT DIRECTORY FILE AFTER ITS CONTENTS?
TDNE T2,.FWMOD(F) ;AND HAVE WE ALREADY DONE THIS?
JRST FLKPD4 ;ALL DONE PROCESSING THIS DIRECTORY
; IORM T2,.FWMOD(F) ;REMEMBER WHAT WE'RE ABOUT TO DO
MOVE T2,.FWLVP(F) ;GET OUR LEVEL POINTER
AOBJN T2,.+1 ;ADVANCE DOWN ONE
MOVE T2,(T2) ;GET NEXT LEVEL
EXCH F,T2 ;SWAP
MOVE T1,.FWPTR(T2) ;GET ADDR OF DIRECTORY BLOCK ENTRY
HRRZ T2,1(T1) ;GET COMPRESSED FILE POINTER
IMUL T2,.DFBPC(D) ;BLOCK := CFP * BLOCKS PER CLUSTER
MOVEM T2,.FWPRM(F) ;SAVE DISK ADDRESS FOR NEXT FILE
JRST FLKPD6 ;LOOP BACK
;BACKUP ONE LEVEL
;CALL: PUSHJ P,LKPBAK
LKPBAK: MOVSI T1,(F.RETA!F.RETB!F.RETP) ;GET DIRECTORY BITS
ANDCAM T1,.FWMOD(F) ;CLEAR FOR NEXT TIME
MOVE T1,.FWLVP(F) ;GET OUR POINTER
SETOM .FWPAS(F) ;INVALIDATE PASS FLAG
SUB T1,[1,,1] ;BACKUP ONE
CAMGE T1,FILPTR ;GONE TOO FAR?
MOVE T1,FILPTR ;YES--RESET TABLE POINTER
MOVE F,(T1) ;SET UP FILE I/O DATA BLOCK
POPJ P, ;RETURN
LKPLVL: SKIPE .FWLVL(F) ;AT THE BEGINING?
JRST LKPLV1 ;NO
MOVEI T1,.FWRIB(F) ;USE RIB BUFFER FOR HOM BLOCK
PUSHJ P,F$RHOM ;READ THE HOM BLOCKS
FERR (HRE,F$ERET) ;HOM BLOCK READ ERROR
MOVE T1,.FWRIB+HOMMFD(F) ;GET BLOCK NUMBER FOR THE MFD
MOVEM T1,.FWPRM(F) ;SAVE AS TARGET DISK ADDRESS
LKPLV1: PUSHJ P,F$SETU ;SETUP FOR I/O
POPJ P, ;FAILED--PROPAGATE ERROR BACK
MOVSI T1,-BLKSIZ ;-VE BUFFER LENGTH
HRRI T1,.FWBUF-1(F) ;MAKE AN IOWD
MOVEM T1,.FWIOW(F) ;SAVE IT
REPEAT 0,<
SETZM .FWPAS(F) ;ASSUME ONLY PASS 2 NEEDED
HLRZ T1,.FWRIB+RIBEXT(F) ;GET EXTENSION
CAIE T1,'UFD' ;A DIRECTORY FILE?
CAIN T1,'SFD' ; ...
SKIPN .FWDIR+1(F) ;AND FULLY WILD?
TDZA T1,T1 ;ONLY NEED PASS 2
MOVNI T1,1 ;ELSE NEED PASS 1 AS WELL
MOVEM T1,.FWPAS(F) ;SET FLAG
JRST CPOPJ1 ;RETURN
> ;END REPEAT 0
SETZM .FWPAS(F) ;ASSUME ONLY PASS 2 NEEDED
HLRZ T1,.FWRIB+RIBEXT(F) ;GET EXTENSION
CAIE T1,'UFD' ;A DIRECTORY FILE?
CAIN T1,'SFD' ; ...
SKIPA T1,.FWLVP(F) ;YES--CHECK FURTHER
JRST CPOPJ1 ;ONLY READ DATA FILES ONCE
MOVE T1,(T1) ;POINT TO THE NEXT
SKIPN .FWDIR+1(T1) ;FULLY WILD?
SETOM .FWPAS(F) ;NEED PASS 1
JRST CPOPJ1 ;RETURN
;SET UP RETURNED FILESPEC BLOCK
LKPRFS: PUSHJ P,SAVE2 ;SAVE P1 AND P2
PUSH P,F ;SAVE FROM DESTRUCTION
MOVE P1,.DFRSB(D) ;GET OFFSET TO RETURNED FILESPEC SCAN BLOCK
ADDI P1,(D) ;RELOCATE
MOVE T1,P1 ;COPY SCAN BLOCK ADDRESS
PUSHJ P,C$ZFIL ;CLEAR SCAN BLOCK
MOVE P2,.DFRFB(D) ;GET OFFSET TO RETURNED FILE BLOCK
ADDI P2,(D) ;RELOCATE
MOVSI T1,0(P2) ;POINT TO START
HRRI T1,1(P2) ;MAKE A BLT POINTER
SETZM (P2) ;CLEAR FIRST WORD
MOVE T2,P2 ;COPY ADDRESS
ADD T2,.DFFBL(D) ;COMPUTE END
BLT T1,-1(T2) ;CLEAR IT OUT
;RETURN FILESPEC PARTS
LKPRF0: MOVE T1,.DFSTR(D) ;STRUCTURE NAME
MOVEM T1,.SBDEV(P1)
SETOM .SBDVM(P1)
MOVE T1,.FWRIB+RIBNAM(F) ;FILE NAME FROM RIB
MOVEM T1,.SBNAM(P1)
SETOM .SBNMM(P1)
MOVEM T1,.FBNAM(P2)
HLLO T1,.FWRIB+RIBEXT(F) ;EXTENSION FROM RIB
MOVEM T1,.SBEXT(P1)
HLLZM T1,.FBEXT(P2)
MOVE T1,.FWRIB+RIBPPN(F) ;PPN FROM RIB
MOVEM T1,.SBDIR(P1)
SETOM .SBDIM(P1)
MOVEM T1,.FBPPN(P2)
MOVE T2,FILPTR ;GET AOBJN POINTER TO DIRECTORY LEVELS
AOBJP T2,LKPRF2 ;ADVANCE PAST MFD
LKPRF1: MOVE F,(T2) ;GET FILE I/O BLOCK
CAMN F,(P) ;FOUND THE END?
JRST LKPRF2 ;YES
MOVE T3,.FWRIB+RIBNAM(F) ;DIRECTORY NAME
MOVEM T3,.SBDIR(P1) ;SAVE IT
SETOM .SBDIM(P1) ;SET MASK
MOVEM T3,.FBPPN(P2) ;SAVE IN FILE BLOCK TOO
ADDI P1,2 ;ACCOUNT FOR TWO WORD ENTRIES
AOS P2 ;ADVANCE FB STORAGE
AOBJN T2,LKPRF1 ;NO--STEP DOWN TO NEXT LEVEL
MOVE F,(P) ;RESTORE FILE I/O BLOCK
LKPRF2: MOVE P1,.DFRSB(D) ;GET OFFSET TO RETURNED FILESPEC SCAN BLOCK
ADDI P1,(D) ;RELOCATE
MOVE P2,.DFRFB(D) ;GET OFFSET TO RETURNED FILE BLOCK
ADDI P2,(D) ;RELOCATE
MOVSI T1,(SB.DEV!SB.NAM!SB.EXT!SB.DIR) ;ALL FILESPEC PARTS
MOVEM T1,.SBFLG(P1) ;MARK THE PARTS FILLED IN
LKPRF3: MOVE T1,.FWRIB+RIBSLF(F) ;RIB BLOCK NUMBER
MOVEM T1,.FBBLK(P2)
MOVE T1,.FWRIB+RIBUFD(F) ;BLOCK NUMBER WITHIN DIRECTORY
MOVEM T1,.FBUFD(P2)
MOVEI T1,FB.RIB+FB.PRM ;PRIME RIB FLAGS
MOVEM T1,.FBFLG(P2)
MOVE T1,.FWRIB+RIBVER(F) ;VERSION NUMBER
MOVEM T1,.FBVER(P2)
MOVE T1,.FWRIB+RIBALC(F)
MOVEM T1,.FBALC(P2)
LDB T1,[POINT 9,.FWRIB+RIBPRV(F),8] ;PROTECTION CODE
HRRM T1,.FBEXT(P2)
LDB T1,[POINT 3,.FWRIB+RIBEXT(F),20] ;GET HIGH DATE
LSH T1,14 ;POSITION IT
LDB T2,[POINT 12,.FWRIB+RIBPRV(F),35] ;GET LOW DATE
ADD T1,T2
HRLZS T1 ;PUT IN LH
LDB T2,[POINT 11,.FWRIB+RIBPRV(F),23] ;GET MINUTES SINCE MIDNIGHT
IOR T1,T2 ;MERGE THE TWO
MOVEM T1,.FBCRE(P2) ;SAVE DATE,,TIME
LKPRF4: POP P,F ;RESTORE F
POPJ P, ;RETURN
;WILDCARDED DIRECTORY COMPARE
LKPWLD: SETZM .FWDIF(F) ;CLEAR DIRECTORY FLAG
MOVE T2,0(T1) ;GET FILE NAME
IOR T2,1(T1) ;AND EXTENSION
JUMPE T2,CPOPJ ;IGNORE EMPTY SLOTS IN DIRECTORY
AOS .FWFIL+0(F) ;COUNT FILE SCANNED
AOS FILFIL+0 ;AND ADD TO THE TOTAL COUNT
MOVE T2,.FWLVP(F) ;GET CURRENT LEVEL POINTER
AOBJP T2,LKPWL2 ;DO NORMAL FILE PROCESSING IT AT BOTTOM
HLRZ T2,1(T1) ;ELSE GET EXTENSION
CAIE T2,'UFD' ;A DIRECTORY?
CAIN T2,'SFD' ;...
AOS .FWDIF(F) ;REMEMBER FOR LATER
SKIPE .FWDIF(F) ;A DIRECTORY?
JRST LKPWL1 ;YES
SKIPL .FWPAS(F) ;DOING PASS 1?
POPJ P, ;SAY NO MATCH
JRST LKPWL2 ;ELSE GO COMPARE FILENAME & EXTENSION
LKPWL1: MOVE T2,0(T1) ;GET DIRECTORY NAME
XOR T2,.FWDIR+0(F) ;COMPARE
AND T2,.FWDIR+1(F) ;MASK OUT DIFFERENCES
JUMPN T2,CPOPJ ;JUMP IF NO MATCH
JRST LKPWL4 ;RETURN THIS FILE
LKPWL2: MOVE T2,0(T1) ;GET FILE NAME FROM DIRECTORY BLOCK
XOR T2,.FWNAM+0(F) ;COMPARE
AND T2,.FWNAM+1(F) ;MASK OUT DIFFERENCES
JUMPN T2,LKPWL3 ;JUMP IF NO MATCH
HLLZ T2,1(T1) ;GET EXTENSION FROM DIRECTORY BLOCK
XOR T2,.FWEXT+0(F) ;COMPARE
AND T2,.FWEXT+1(F) ;MASK OUT DIFFERENCES
JUMPN T2,LKPWL3 ;JUMP IF NO MATCH
JRST LKPWL4 ;RETURN THIS FILE
LKPWL3: SKIPL .FWPAS(F) ;DOING PASS 1 OF DIRECTORY SCAN?
POPJ P, ;WE'RE BEYOND THAT POINT
MOVSI T2,(F.DIRP) ;BIT TO TEST
TDNN T2,.FWMOD(F) ;RETURN PARENT DIRECTORY IF LOWER LEVEL WILD?
POPJ P, ;NO
MOVSI T1,(F.RETP) ;GET SPECIAL BIT
IORM T1,.FWMOD(F) ;REMEMBER WHAT WE'RE ABOUT TO DO
LKPWL4: JRST CPOPJ1 ;RETURN SUCCESSFUL
;POSITIONAL LOOKUP USING FILE BLOCKS
FLKPP: MOVEI T1,1 ;FATAL FLAG
PUSHJ P,D$ACTV ;DATA FILE OPENED?
FERR (DNO,F$ERET) ;NO
MOVE T1,FILPTR ;POINT TO TABLE OF FILE I/O BLOCKS
MOVE F,(T1) ;SET UP BLOCK ADDRESS
SKIPE FILIFB ;FIRST TIME THROUGH?
JRST FLKPP1 ;NO
MOVEI T1,1 ;GET FIRST FILE BLOCK NUMBER
JRST FLKPP2 ;AND ENTER LOOP
FLKPP1: MOVE T2,FILIFB ;GET CURRENT FILE BLOCK
LDB T1,[POINTR (.FBIDN(T2),FB.NUM)] ;GET THIS FILE BLOCK #
AOS T1 ;ADVANCE TO NEXT
FLKPP2: CAMLE T1,.DFFBN(D) ;GONE TOO FAR?
PJRST FLKPER ;YES--RETURN AN ERROR
PUSHJ P,D$FNUM ;READ INTO CORE
FERR (IFN,F$ERET) ;ILLEGAL FILE NUMBER
MOVEM T1,FILIFB ;SAVE FILE BLOCK ADDRESS
MOVE T2,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T2,(D) ;RELOCATE
PUSHJ P,D$WILD ;COMARE FILE AND SCAN BLOCKS
JRST FLKPP1 ;NO MATCH
PJRST FLKPS3 ;ENTER COMMON EXIT CODE
;SORTED LOOKUP USING FILE BLOCKS
FLKPS: MOVEI T1,1 ;FATAL FLAG
PUSHJ P,D$ACTV ;DATA FILE OPENED?
FERR (DNO,F$ERET) ;NO
MOVE T1,FILPTR ;POINT TO TABLE OF FILE I/O BLOCKS
MOVE F,(T1) ;SET UP BLOCK ADDRESS
SKIPE FILIFB ;FIRST TIME THROUGH?
JRST FLKPS1 ;NO
MOVE T1,.DFFSF(D) ;GET FIRST FILE BLOCK NUMBER
JRST FLKPS2 ;AND ENTER LOOP
FLKPS1: MOVE T2,FILIFB ;GET CURRENT FILE BLOCK
LDB T1,[POINTR (.FBIDN(T2),FB.SRT)] ;GET NEXT FILE BLOCK
FLKPS2: JUMPE T1,FLKPER ;RETURN IF NO MORE FILE BLOCKS
PUSHJ P,D$FNUM ;READ INTO CORE
FERR (IFN,F$ERET) ;ILLEGAL FILE NUMBER
MOVEM T1,FILIFB ;SAVE FILE BLOCK ADDRESS
MOVE T2,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T2,(D) ;RELOCATE
PUSHJ P,D$WILD ;COMARE FILE AND SCAN BLOCKS
JRST FLKPS1 ;NO MATCH
JRST FLKPS3 ;GO FINISH UP
;COMMON EXIT FOLLOWING SUCCESSFUL LOOKUP USING FILE BLOCKS
FLKPS3: MOVE T1,FILIFB ;POINT TO FILE BLOCK
MOVE T2,.FBFLG(T1) ;GET FILE BLOCK FLAGS
MOVEM T1,.FWFBF(F) ;STORE THEM
MOVE T2,.FBBLK(T1) ;GET RIB ADDRESS ON DISK
MOVEM T2,.FWPRM(F) ;STORE IT
PUSHJ P,F$SETU ;SETUP FOR I/O
POPJ P, ;FAILED--PROPAGATE ERROR BACK
AOS .FWFIL+1(F) ;COUNT FILES FOUND
AOS FILFIL+1 ;THE GLOBAL COUNT TOO
MOVE T1,FILIOW ;GET CALLER-SPECIFIED IOWD
MOVEM T1,.FWIOW(F) ;RESET IT
MOVE T1,.DFRFB(D) ;GET OFFSET TO RETURNED FILE BLOCK
ADDI T1,(D) ;RELOCATE
HRLZ T2,FILIFB ;POINT TO FILE BLOCK
HRRI T2,(T1) ;AND TO STORAGE
MOVE T3,.DFFBL(D) ;GET FILE BLOCK LENGTH
ADDI T3,(T1) ;COMPUTE END
BLT T2,-1(T3) ;LOAD UP RETURNED FILE BLOCK
MOVE T1,FILIFB ;GET FILE BLOCK ADDRESS BACK
MOVE T2,.DFRSB(D) ;GET OFFSET TO RETURNED FILESPEC SCAN BLOCK
ADDI T2,(D) ;RELOCATE
PUSHJ P,F$CVTF ;CONVERT FILE BLOCK TO SCAN BLOCK
MOVEM F,FILSVF ;SAVE F
SETOM FILIOT ;ALLOW I/O TRACING
JRST CPOPJ1 ;RETURN
SUBTTL FILE SERVICE -- F$OBUF - OUTPUT
F$OBUF: PUSHJ P,SAVE1 ;SAVE P1
MOVEI T1,1 ;GET A FLAG
MOVEM T1,.FWIOD(F) ;SET I/O DIRECTION (WRITE)
MOVE T1,.FWRPT(F) ;GET CURRENT RETRIEVAL POINTER
MOVEM T1,.FWOPT(F) ;SAVE FOR LATER COMPARRISON
PUSHJ P,F$ADVP ;ADVANCE RETRIEVAL POINTER IF NECESSARY
PJRST F$ERET ;BAD MODE, ETC.
MOVE T1,.FWRPT(F) ;GET CURRENT RETRIEVAL POINTER
CAMN T1,.FWOPT(F) ;MATCH THE OLD ONE?
JRST FOBUF1 ;THEN NO NEED TO GENERATE CHECKSUMS
HRRZ T1,.FWIOW(F) ;GET ADDRESS-1 OF USER BUFFER
MOVE T1,1(T1) ;GET THE FIRST WORD IN THE BUFFER
PUSHJ P,F$CHKS ;GENERATE CHECKSUM
MOVE R,.FWRPT(F) ;GET ADDRESS OF RETRIEVAL POINTER
MOVE R,(R) ;AND THE POINTER ITSELF
DPB T1,.DFCKP(D) ;UPDATE CHECKSUM
AOS .FWRRB(F) ;FLAG RIB NEEDS TO BE REWRITTEN
FOBUF1: MOVE R,.FWRPT(F) ;GET ADDRESS OF RETRIEVAL POINTER
MOVE R,(R) ;AND THE POINTER ITSELF
HRRZ T1,.FWLFT(F) ;GET BLOCKS INTO THE CURRENT POINTER
LDB T2,.DFCLP(D) ;GET CLUSTER ADDRESS
IMUL T2,.DFBPC(D) ;TRANSLATE TO BLOCK NUMBER
ADD T2,T1 ;THIS IS THE STARTING BLOCK TO READ
MOVE T1,.FWUNI(F) ;GET CURRENT UNIT
PUSHJ P,F$BLKS ;TRANSLATE TO BLOCK ON STRUCTURE
FERR (IBN,F$ERET) ;ILLEGAL
MOVEM T1,.FWSBN(F) ;SAVE STRUCTURE-RELATIVE BLOCK NUMBER
PUSHJ P,F$BLKU ;SET UP UNIT AND BLOCK ON UNIT
FERR (IBN,F$ERET) ;ILLEGAL BLOCK NUMBER
MOVEM T1,.FWUBN(F) ;SAVE UNIT-RELATIVE BLOCK NUMBER
PUSHJ P,F$TRAC ;SEE IF I/O TRACE ENABLED
FERR (STP,F$ERET) ;USER STOPPED I/O
MOVE T1,.FWUBN(F) ;GET BLOCK ON UNIT BACK
MOVE T2,.FWIOW(F) ;GET IOWD
PUSHJ P,U$WRIT ;WRITE DATA
FERR (IER,F$ERET) ;REPORT INPUT ERROR
HLRE T1,.FWIOW(F) ;GET WORDS JUST TRANSFERED
PUSHJ P,F$XFRB ;COUNT BLOCKS
PUSHJ P,F$BUFS ;SET UP BUFFER RING HEADER
PJRST F$ERET ;BAD MODE, ETC.
JRST CPOPJ1 ;RETURN
SUBTTL FILE SERVICE -- F$OBYT - OUTPUT A BYTE
F$OBYT: SOSGE .FWBRH+.BFCTR(F) ;COUNT CHARACTERS
JRST FOBYT1 ;BUFFER EMPTY
IDPB T1,.FWBRH+.BFPTR(F) ;PUT A CHARACTER
AOS .FWCLS(F) ;FLAG WORK FOR CLOSE TO PERFORM
JRST CPOPJ1 ;AND RETURN
FOBYT1: PUSHJ P,F$OBUF ;OUTPUT A BUFFER
PJRST F$ERET ;FAILED--RETURN ERROR CODE
SETZM .FWCLS(F) ;ALL BUFFERS OUTPUT NOW
JRST F$OBYT ;LOOP BACK AND TRY AGAIN
SUBTTL FILE SERVICE -- F$POS - POSITION FOR I/O
;ROUTINE TO SET THE NEXT BLOCK FOR I/O
;CALL: MOVE T1, BLOCK NUMBER
; PUSHJ P,FPOS
; <ERROR> ;ERROR CODE SET
; <SKIP> ;READY FOR I/O TO SELECTED BLOCK
;
;THE SPECIFIED BLOCK MAY BE ON EOF THE FOLLOWING:
; 1. POSITIVE FOR A FILE DATA BLOCK NUMBER
; 2. ZERO FOR THE PRIME RIB
; 3. MINUS ONE FOR EOF
; 4. NEGATIVE N WHERE "N" IS AN EXTENDED RIB NUMBER
F$POS: PUSHJ P,SAVE2 ;SAVE P1 AND P2
JUMPE T1,FPOSP ;JUMP IF PRIME RIB REQUESTED
MOVE P1,T1 ;GET THE TARGET BLOCK
CAMG P1,[EXP -2] ;EXTENDED RIB REQUESTED?
AOJA P1,FPOSX ;YES
CAMN P1,[EXP -1] ;WANT EOF?
HRLOI P1,377777 ;YES
PUSHJ P,F$SETU ;REWIND THE FILE
POPJ P, ;FAILED
;HERE FOR DATA BLOCKS
FPOSD: CAMN P1,.FWBLK(F) ;ALREADY AT DESIRED POSITION?
JRST FPOSD3 ;YES
PUSHJ P,F$ADVP ;ADVANCE POINTERS
JRST FPOSD2 ;FAILED
HLRE T1,.FWLFT(F) ;GET BLOCKS REMAINING IN THIS GROUP
MOVMS T1 ;MAKE POSITIVE
MOVE T2,.FWBLK(F) ;GET POSITION SO FAR
ADD T2,T1 ;COMPUTE NEW POSITION WITHIN FILE
CAML P1,T2 ;BEYOND TARGET?
JRST FPOSD1 ;NO
SUBM P1,T2 ;GET -VE DIFFERENCE
ADD T1,T2 ;ADJUST BLOCKS TO REPOSITION
FPOSD1: MOVE T2,.FWRWC(F) ;GET REMAINING WORD COUNT IN FILE
IDIVI T2,BLKSIZ ;CONVERT TO BLOCKS
CAML T1,T2 ;WILL THIS GROUP PUT US PAST EOF?
MOVE T1,T2 ;YES--LIMIT THE BLOCK COUNT
IMUL T1,[-BLKSIZ] ;CONVERT TO -VE WORDS
PUSHJ P,F$XFRB ;PRETEND WE'VE TRANSFERED THAT MUCH DATA
JRST FPOSD ;DO BACK AND DO IT AGAIN
FPOSD2: CAIN T1,FEEOF% ;END OF FILE?
CAME P1,[377777,,-1] ;AND LOOKING FOR EOF?
POPJ P, ;NO--ERROR
SKIPA T1,.FWBLK(F) ;GET EOF BLOCK NUMBER
FPOSD3: MOVE T1,P1 ;GET DESIRED POSITION BACK
JRST CPOPJ1 ;RETURN
;HERE FOR THE PRIME RIB
FPOSP: MOVE T1,.FWRIB+RIBSIZ(F) ;GET FILE SIZE IN WORDS
MOVEM T1,.FWRWC(F) ;SAVE AS WORDS REMAINING TO BE READ
SETZM .FWSFB(F) ;DON'T SKIP THE FIRST BLOCK (PRIME RIB!)
SETZB T1,.FWRIF(F) ;THIS IS THE BLOCK REQUESTED
JRST CPOPJ1 ;RETURN
;HERE FOR AN EXTENDED RIB
FPOSX: SKIPN R,.FWRIB+RIBXRA(F) ;GET EXTENDED RIB ADDRESS
FERR (NXR,F$ERET) ;RETURN "NO EXTENDED RIB"
LDB P2,[POINT DESRBC,R,DENRBC] ;GET RIB NUMBER
MOVNS P2 ;NEGATE (FOR LATER)
LDB T1,[POINT DESRBA,R,DENRBA] ;GET CLUSTER ADDRESS
IMUL T1,.DFBSC(D) ;COMPUTE BLOCK NUMBER
MOVEM T1,.FWADR(F) ;SAVE AS CURRENT RIB ADDRESS
PUSHJ P,F$BLKU ;SETUP U
FERR (IBN,F$ERET) ;ILLEGAL BLOCK NUMBER
MOVSI T2,-BLKSIZ ;-VE LENGTH OF BUFFER
HRRI T2,.FWRIB-1(F) ;MAKE AN IOWD
PUSHJ P,U$READ ;READ AN EXTENDED RIB
FERR (XRI,F$ERET) ;RETURN "EXTENDED RIB INPUT ERROR"
CAMN P1,P2 ;FOUND THE RIB WE'RE LOOKING FOR?
JRST FPOSX ;NOT YET
SOS T1,P1 ;GET BLOCK NUMBER BACK
MOVEM T1,.FWRIF(F) ;SAVE AS A FLAG
JRST CPOPJ1 ;RETURN
SUBTTL FILE SERVICE -- F$RBAT - READ A BAT BLOCK
;READ A BAT BLOCK GIVEN A UNIT
;CALL: MOVE T1, BUFFER ADDRESS
; PUSHJ P,F$RBAT/U
; <NON-SKIP> ;FAILED
; <SKIP> ;SUCCESS
;
;ON EITHER RETURN, T1 := ERROR FLAGS (1ST,,2ND)
F$RBAT: TDZA T2,T2 ;FILE I/O ENTRY POINT
F$BATU: MOVNI T2,1 ;PHYSICAL UNIT ENTRY POINT
PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;COPY BUFFER ADDRESS
MOVNI P2,1 ;FLAG FIRST TIME THROUGH
SETZ P3, ;CLEAR 1ST,,2ND ERROR FLAGS
MOVE P4,T2 ;SAVE FLAG
PUSH P,[EXP 0] ;RESTORE TEMP STORAGE
FRBAT1: SKIPA T1,[LBNHOM+LBOBAT] ;FIRST BLOCK NUMBER
FRBAT2: MOVEI T1,LB2HOM+LBOBAT ;SECOND BLOCK
JUMPL P4,FRBAT3 ;JUMP IF UNIT ALREADY SET UP
PUSHJ P,F$BLKU ;CONVERT TO LBN TO BLOCK ON UNIT
WARN (BTE,FRBAT5,<BAT block translation error on block >,T$DECW)
FRBAT3: MOVEM T1,(P) ;SAVE BLOCK NUMBER
MOVSI T2,-BLKSIZ ;NUMBER OF WORDS
HRRI T2,-1(P1) ;BUFFER ADDRESS
PUSHJ P,U$READ ;READ THE BLOCK
JRST FRBAT5 ;I/O ERROR
JRST FRBAT6 ;GO CHECK IT OUT
FRBAT4: WARN (BBC,.+1,<BAT block consistancy error on >,E..HBC)
SKIPGE P2 ;WHICH BLOCK
TLOA P3,400000 ;FIRST
TRO P3,400000 ;SECOND
FRBAT5: AOJE P2,FRBAT2 ;TRY OTHER BLOCK
MOVE T1,.UNNAM(U) ;GET UNIT NAME
JUMPL P4,FRBAT7 ;SKIP FATAL ERROR IF PHYSICAL UNIT GIVEN
FATAL (CRB,FRBAT7,<Cannot read BAT blocks on unit >,T$SIXN)
FRBAT6: MOVS T1,BAFNAM(P1) ;GET SIXBIT 'BAT'
CAIE T1,'BAT' ;CHECK IT
JRST FRBAT4 ;NO GOOD
MOVE T1,BAFCOD(P1) ;GET MAGIC CODE
CAIE T1,CODBAT ;MATCH?
JRST FRBAT4 ;NO
MOVE T1,BAFSLF(P1) ;GET SELF POINTER
CAME T1,(P) ;MATCH REQUESTED BLOCK NUMBER?
JRST FRBAT4 ;NO
MOVE T1,P1 ;COPY BUFFER ADDRESS
AOS (P) ;FORCE SKIP
FRBAT7: POP P,(P) ;PHASE STACK
MOVE T1,P3 ;GET ERROR FLAGS BACK
POPJ P, ;RETURN
E..BBC: MOVE T1,.UNNAM(U) ;GET UNIT NAME
PUSHJ P,T$SIXN ;PRINT IT
MOVEI T1,[ASCIZ /, block /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,.UNPOS(U) ;GET POSITION BEFORE I/O
PJRST T$DECW ;PRINT IT AND RETURN
SUBTTL FILE SERVICE -- F$RSET - RESET FILE SYSTEM
;ROUTINE TO RESET FILE SYSTEM WITH NO REGARD TO THE STATE OF
;"OPENED" FILES OR DIRECTORIES.
;CALL: PUSHJ P,F$RSET
; <RETURN>
F$RSET: SKIPE FILFLG ;FILE SYSTEM SAVED?
PUSHJ P,F$REST ;YES--RESTORE IT NOW
PJRST F$FIN ;ZAP OPENED FILE(S)
SUBTTL FILE SERVICE -- F$REST - RESTORE THE FILE SYSTEM
;ROUTINE TO RESTORE THE STATE OF THE FILE SYSTEM
;CALL: PUSHJ P,F$REST
; <RETURN>
F$REST: SKIPN FILFLG ;HAS IT BEEN SAVED?
STOPCD (FNS,<File system not saved>,)
PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVNI T1,1 ;GET A FLAG
EXCH T1,CCTRAP ;DISABLE CONTROL-C
PUSH P,T1 ;SAVE OLD FLAG
MOVE T1,FILMEM+0 ;GET WORD COUNT
SKIPE T2,FILMEM+1 ;AND ADDRESS
PUSHJ P,M$GIVW ;RELEASE CORE
;RESTORE LOW CORE STORAGE
MOVE T1,[FILSAV,,Z.FILB] ;SET UP BLT
BLT T1,Z.FILE-1 ;RESTORE THE SAVED STATE
MOVE T1,[FILSAV,,FILSAV+1] ;SET UP BLT
SETZM FILSAV ;CLEAR FIRST WORD
BLT T1,FILSAV+<Z.FILE-Z.FILB>-1 ;CLEAR SAVED STORAGE
;RESTORE INPUT SPEC
MOVE T1,.DFISV(D) ;GET OFFSET TO SAVED INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
MOVE T2,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T2,(D) ;RELOCATE
HRLZS T1 ;PUT IN LH
HRRI T1,(T2) ;MAKE A BLT POINTER
ADD T2,.DFSBL(D) ;COMPUTE END OF BLT
BLT T1,-1(T2) ;RESTORE INPUT SPEC
;RESTORE RETURNED SPEC
MOVE T1,.DFRSV(D) ;GET OFFSET TO SAVED RETURNED SCAN BLOCK
ADDI T1,(D) ;RELOCATE
MOVE T2,.DFRSB(D) ;GET OFFSET TO RETURNED SCAN BLOCK
ADDI T2,(D) ;RELOCATE
HRLZS T1 ;PUT IN LH
HRRI T1,(T2) ;MAKE A BLT POINTER
ADD T2,.DFSBL(D) ;COMPUTE END OF BLT
BLT T1,-1(T2) ;RESTORE INPUT SPEC
;DONE
SETZM FILFLG ;CLEAR FLAG
POP P,CCTRAP ;RESTORE CONTROL-C STATE
POP P,T2 ;RESTORE T2
JRST TPOPJ ;RESTORE T1 AND RETURN
SUBTTL FILE SERVICE -- F$SAVE - SAVE THE FILE SYSTEM
;ROUTINE TO SAVE THE STATE OF THE FILE SYSTEM
;CALL: PUSHJ P,F$SAVE
; <RETURN>
F$SAVE: SKIPE FILFLG ;ALREADY SAVED?
STOPCD (FSR,<File save recursion>,)
PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVNI T1,1 ;GET -1 FLAG
EXCH T1,CCTRAP ;DISABLE CONTROL-C
PUSH P,T1 ;SAVE OLD FLAG
;SAVE LOW CORE STORAGE
MOVE T1,[Z.FILB,,FILSAV] ;SET UP BLT
BLT T1,FILSAV+<Z.FILE-Z.FILB>-1 ;COPY TO PROTECTED AREA
MOVE T1,[Z.FILB,,Z.FILB+1] ;SET UP BLT
SETZM Z.FILB ;CLEAR FIRST WORD
BLT T1,Z.FILE-1 ;CLEAR ALL STORAGE
;SAVE INPUT SPEC
MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
MOVE T2,.DFISV(D) ;GET OFFSET TO SAVED SCAN BLOCK
ADDI T2,(D) ;RELOCATE
HRLZS T1 ;PUT IN LH
HRRI T1,(T2) ;MAKE A BLT POINTER
ADD T2,.DFSBL(D) ;COMPUTE END OF BLT
BLT T1,-1(T2) ;SAVE INPUT SPEC
;SAVE RETURNED SPEC
MOVE T1,.DFRSB(D) ;GET OFFSET TO RETURNED SCAN BLOCK
ADDI T1,(D) ;RELOCATE
MOVE T2,.DFRSV(D) ;GET OFFSET TO SAVED RETURNED SCAN BLOCK
ADDI T2,(D) ;RELOCATE
HRLZS T1 ;PUT IN LH
HRRI T1,(T2) ;MAKE A BLT POINTER
ADD T2,.DFSBL(D) ;COMPUTE END OF BLT
BLT T1,-1(T2) ;SAVE INPUT SPEC
;DONE
SETOM FILFLG ;LITE THE FLAG
POP P,CCTRAP ;RESTORE CONTROL-C STATE
POP P,T2 ;RESTORE T2
JRST TPOPJ ;RESTORE T1 AND RETURN
SUBTTL FILE SERVICE -- F$SETU - POST LOOKUP SET UP
;ROUTINE CALLED AFTER A FILE HAS BEEN FOUND TO COMPLETE THE
;BOOKKEEPING NECESSARY TO INITIATE FILE I/O
;CALL: MOVE T1, RIB BLOCK NUMBER
; MOVEM T1,.FWPRM(F)
; PUSHJ P,F$SETU/X
; <ERROR> ;ERROR CODE SET
; <SKIP> ;READY FOR I/O
;
;NOTE: ENTER AT F$SETX TO SETUP EXTENDED RIBS
F$SETU: MOVSI T1,(F.NOIO) ;BIT TO TEST
TDNE T1,.FWMOD(F) ;SUPPRESS I/O FUNCTIONS?
JRST FSETU2 ;YES
MOVE T1,.FWPRM(F) ;GET DISK ADDRESS OF PRIME RIB
MOVEM T1,.FWADR(F) ;SAVE AS CURRENT RIB ADDRESS
SETZM .FWRBO(F) ;ZAP ADJUSTMENT IN .FWBLK FOR XRIBS
SETZM .FWRWC(F) ;DON'T KNOW FILE SIZE YET
F$SETX: MOVE T1,.FWADR(F) ;GET DISK ADDRESS OF TARGET
PUSHJ P,F$BLKU ;SETUP U
FERR (IBN,F$ERET) ;ILLEGAL BLOCK NUMBER
MOVSI T2,-BLKSIZ ;-VE LENGTH OF BUFFER
HRRI T2,.FWRIB-1(F) ;MAKE AN IOWD
PUSHJ P,U$READ ;READ A RIB
FERR (TRN,F$ERET) ;REPORT TRANSMISSION ERROR
SKIPE T1,.FWFBF(F) ;ALREADY HAVE RIB FLAGS?
JRST FSETU1 ;YES
MOVE T1,.FWADR(F) ;GET BLOCK ON STRUCTURE
MOVEI T2,.FWRIB(F) ;AND ADDRESS OF RIB IN CORE
PUSHJ P,F$VRIB ;VALIDATE RIB
FERR (TRN,F$ERET) ;NOT A RIB??
MOVEM T1,.FWFBF(F) ;STORE ERROR & DESCRIPTOR FLAGS
FSETU1: TLNE T1,-1-(FB.ALC) ;SERIOUS PROBLEMS WITH RIB?
FERR (TRN,F$ERET) ;YES--SAY TRANSMISSION ERROR
MOVE T1,.FWRIB+RIBFIR(F) ;GET POINTER TO RETRIEVAL POINTERS
ADDI T1,.FWRIB(F) ;OFFSET TO BEGINING
MOVEM T1,.FWRPT(F) ;SAVE AS CURRENT AOBJN TO RETRIEVAL POINTERS
MOVE T1,.FWADR(F) ;GET DISK ADDRESS OF THIS RIB
CAMN T1,.FWPRM(F) ;IS IT THE PRIME RIB?
SETZM .FWRIB+RIBFLR(F) ;YES--OLD RIBS CONTAIN JUNK IN THIS WORD
MOVEI T1,BLKSIZ ;ACCOUNT FOR THIS RIB
SKIPN .FWRIB+RIBFLR(F) ;IS THIS AN EXTENDED RIB?
ADD T1,.FWRIB+RIBSIZ(F) ;NO--ADD TO TOTAL FILE SIZE
ADDM T1,.FWRWC(F) ;STORE OR UPDATE REMAINING WORD COUNT
MOVEI T1,1 ;GET A FLAG
MOVEM T1,.FWRIF(F) ;NEED EXPLICIT POSITIONING CALL TO DO RIB I/O
MOVE T1,.FWRIB+RIBFLR(F) ;GET STARTING POSITION
ADD T1,.FWRBO(F) ;INCLUDE OFFSET FOR POSITIONING
MOVEM T1,.FWBLK(F) ; WITHIN FILE FOR THIS RIB
SETZM .FWLFT(F) ;NO BLOCKS LEFT IN CURRENT POINTER
SETOM .FWSFB(F) ;SKIP 1ST BLOCK IN 1ST RET POINTER (RIB)
SETOM .FWSLB(F) ;SKIP LAST BLOCK IN LAST RET POINTER (RIB)
SETOM .FWBRH+.BFCTR(F) ;FORCE FIRST INPUT TO BE DONE
SETZM .FWBRH+.BFPTR(F) ;FORCE CALLER SPECIFIED MODE TO BE SET
SETZM .FWSAT(F) ;ASSUME NOT READING SAT.SYS
MOVE T1,.FWRIB+RIBSLF(F) ;BLOCK NUMBER FOR THIS RIB
CAME T1,.DFSRB(D) ;RIB FOR SAT.SYS?
JRST FSETU2 ;NO
SETOM .FWSAT(F) ;SET FLAG FOR F$ADVP
MOVE T1,.FWRPT(F) ;GET AOBJN POINTER TO RETRIEVAL POINTERS
SKIPE (T1) ;FOUND LAST RETRIEVAL POINTER?
AOBJN T1,.-1 ;KEEP SEARCHING
SETZM -1(T1) ;MAKE LAST POINTER INACCESSIBLE (SPARE RIB)
FSETU2: SETZM .FWECD(F) ;CLEAR STALE ERROR CODE
SETOM .FWOPF(F) ;FLAG FILE IS NOW "OPENED"
JRST CPOPJ1 ;RETURN
SUBTTL FILE SERVICE -- F$TRAC - I/O TRACE
;ROUTINE TO TRACE I/O ACTIVITY
;CALL: PUSHJ P,F$TRAC
; <NON-SKIP> ;USER STOPPED I/O
; <SKIP> ;CONTINUE I/O
F$TRAC: SKIPE FILIOT ;I/O TRACING ALLOWED?
SKIPN .DFIOT+.FMKEY(D) ;AND ANYTHING IN THE BUFFER TO DISPLAY?
JRST CPOPJ1 ;NO
PUSH P,T1 ;SAVE T1
MOVSI T1,(DF.IOT) ;BIT TO TEST
TDNN T1,.DFFLG(D) ;I/O TRACE ENABLED?
JRST TPOPJ1 ;NO
POP P,T1 ;PHASE STACK
PUSHJ P,SAVT ;SAVE SOME ACS
MOVSI T1,-MAXIOT ;-VE NUMBER OF ENTRIES
HRRI T1,.DFIOT(D) ;AND ADDRESS OF BUFFER
MOVE T2,.FWIOW(F) ;GET IOWD
XMOVEI T3,FMTI.T ;TABLE OF DISPATCH TABLES
XMOVEI T4,FTRACX ;POINT TO LINE IDENTIFIER
PUSHJ P,FMTDPY ;DISPLAY SOMETHING
FERR (STP,F$ERET) ;I/O STOPPED BY USER
JRST CPOPJ1 ;RETURN
FTRACX: XMOVEI T1,[ASCIZ /Read>> LBN:/]
SKIPE .FWIOD(F) ;CHECK DIRECTION OF I/O
XMOVEI T1,[ASCIZ /Write>> LBN:/]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,.FWSBN(F) ;STRUCTURE-RELATIVE BLOCK
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$SPAC ;SPACE OVER
XMOVEI T1,[ASCIZ /Unit:/]
PUSHJ P,T$STRG
MOVE T1,.FWUNI(F) ;GET UNIT
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$SPAC ;SPACE OVER
XMOVEI T1,[ASCIZ /PBN:/]
PUSHJ P,T$STRG
MOVE T1,.FWUBN(F) ;UNIT-RELATIVE BLOCK
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$SPAC ;SPACE OVER
XMOVEI T1,[ASCIZ /BLK:/]
PUSHJ P,T$STRG
MOVE T1,.FWFBN(F) ;FILE-RELATIVE BLOCK
PJRST T$DECW ;PRINT IT AND RETURN
SUBTTL FILE SERVICE -- F$DRIB - DEALLOCATE ALL CLUSTERS
;ROUTINE TO DEALLOCATE ALL CLUSTERS ASSIGNED TO A FILE
;CALL: MOVE F, FILE DATA BASE
; PUSHJ P,F$DRIB
; <NON-SKIP> ;RIB I/O ERROR
; <SKIP> ;SUCCESSFUL
;
;ON EITHER RETURN, T1 HAS A POSSIBLE ERROR CODE (VALID ONLY ON FAILURES)
;AND T2 HAS THE COUNT OF BLOCKS FREED WITHOUT ERROR
F$DRIB: PUSHJ P,SAVE1 ;SAVE P1
SETZ P1, ;CLEAR COUNT OF BLOCKS FREED
PUSHJ P,F$SETU ;REWIND THE FILE
JRST FDRIB2 ;FAILED
FDRIB1: PUSHJ P,F$ADVP ;ADVANCE POINTERS
JRST FDRIB2 ;FAILED
MOVE T1,.FWRPT(F) ;GET CURRENT POINTER
MOVE R,(T1) ;AND THE RETRIEVAL POINTER
LDB T1,.DFCNP(D) ;GET CLUSTER COUNT
LDB T2,.DFCLP(D) ;GET CLUSTER ADDRESS
PUSHJ P,F$DSAT ;DEALLOCATE CLUSTERS
TDZA T1,T1 ;SOME BIT(S) ALREADY ZERO IN SAT
LDB T1,.DFCNP(D) ;GET CLUSTER COUNT AGAIN
ADD P1,T1 ;COUNT CLUSTERS FREED
HLRE T1,.FWLFT(F) ;GET BLOCKS REMAINING IN THIS GROUP
IMULI T1,BLKSIZ ;CONVERT TO WORDS
PUSHJ P,F$XFRB ;PRETEND WE'VE TRANSFERED THAT MUCH DATA
JRST FDRIB1 ;LOOP BACK FOR NEXT RETRIEVAL POINTER
FDRIB2: CAIN T1,FEEOF% ;END OF FILE?
AOS (P) ;YES
MOVE T2,P1 ;COPY CLUSTERS FREED
IMUL T2,.DFBPC(D) ;CONVERT TO BLOCKS FREED
POPJ P, ;RETURN
SUBTTL FILE SERVICE -- F$VRIB - VALIDATE A RIB
;ROUTINE TO VALIDATE A RIB AND RETURN A MASK OF ERROR FLAGS
;AND DESCRIPTOR BITS
;CALL: MOVE T1, BLOCK ON STRUCTURE
; MOVE T2, ADDRESS OF RIB STORAGE
; PUSHJ P,F$VRIB
; <NON-SKIP> ;NOT A RIB
; <SKIP> ;T1 := ERROR & DESCRIPTIVE BITS
F$VRIB: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P1,T1 ;PRESERVE BLOCK ON STRUCTURE
MOVE P2,T2 ;COPY ADDRESS OF RIB IN CORE
SETZ P3, ;NO BITS YET
FVRIB1: MOVE T1,RIBCOD(P2) ;GET CODE UNIQUE TO RIBS
CAIE T1,CODRIB ;VALID?
JRST FVRIB3 ;NOT A RIB--ON TO THE NEXT BLOCK
MOVEI P3,FB.RIB ;INIT RIB FLAGS
MOVSI P4,-FVRLEN ;AOBJN POINTER TO TABLE OF TEST ROUTINES
FVRIB2: PUSHJ P,@FVRTAB(P4) ;PERFORM A TEST
TDO P3,FVRBIT(P4) ;FAILED--SET APPROPRIATE ERROR BITS
AOBJN P4,FVRIB2 ;TRY NEXT TEST
AOS (P) ;RIB IS PROBABLY USEABLE
FVRIB3: MOVE T1,P3 ;COPY ANSWER
POPJ P, ;ELSE ALL DONE
DEFINE RTESTS,<
;;ORDERING IS CRITICAL. EACH ROUTINE DEPENDS UPON THE RESULTS OF
;;THE PREVIOUS.
X FVRFIR,FB.FIR ;;RIBFIR
X FVRSLF,FB.SLF ;;RIBSLF
X FVRPTR,0 ;;TEST FOR GOOD POINTERS
X FVRPRM,0 ;;TEST FOR PRIME RIB
X FVRSPR,0 ;;TEST FOR SPARE RIB
> ;;END DEFINE RTESTS
DEFINE X (SUBR,BITS),<EXP SUBR>
FVRTAB: RTESTS
FVRLEN==.-FVRTAB ;LENTH OF TABLE
DEFINE X (SUBR,BITS),<EXP BITS>
FVRBIT: RTESTS
;RIBFIR
FVRFIR: SKIPL T1,RIBFIR(P2) ;AOBJN POINTER IN RIB
POPJ P, ;MUST BE NEGATIVE
HLRE T2,T1 ;GET LH
HRRES T1 ;GET OFFSET WITHIN RIB
JUMPLE T1,CPOPJ ;MUST BE GREATER THAN ZERO
MOVMS T2 ;MAKE LENGTH POSITIVE
CAIG T1,BLKSIZ ;OFFSET MUST BE WITHIN A BLOCK
CAILE T2,BLKSIZ-2 ;AND LENGTH MUST BE LESS THAN A BLOCK LONG
POPJ P, ;IT ISN'T
JRST CPOPJ1 ;THIS WORD CHECKS OUT OK
;RIBSLF
FVRSLF: CAMN P1,RIBSLF(P2) ;SELF BLOCK NUMBER MATCH?
AOS (P) ;THIS WORD CHECKS OUT OK
POPJ P,
;TEST FOR GOOD RETRIEVAL POINTERS
FVRPTR: TRNE P3,FB.RIB ;DO WE THINK WE FOUND A RIB?
TLNE P3,(FB.FIR) ;YES, CAN WE FIND THE RETRIEVAL POINTERS?
POPJ P, ;NO--THEN CAN'T CHECK ITS TYPE
HRRZ T1,P2 ;POINT TO START OF BUFFER
ADD T1,RIBFIR(P2) ;MAKE AOBJN TO RETRIEVAL POINTERS
SETOB T2,T3 ;RESET UNIT AND BLOCK NUMBERS
SKIPE R,(T1) ;GET RETRIEVAL POINTER
TDNE R,[-1-RIPNUB-MAXUNI] ;CHANGE OF UNIT POINTER?
JRST FVRPT1 ;NO
TRZ R,RIPNUB ;CLEAR CHANGE BIT
CAMGE R,.DFSTN(D) ;REASONABLE LOGICAL UNIT NUMBER?
JRST FVRPT2 ;YES
;*** WHAT ABOUT EXTENDED RIBS?
FVRPT1: SKIPE RIBFLR(P2) ;EXTENDED RIB?
JRST FVRPT2 ;OLD-STYLE DIDN'T ALWAYS HAVE NEW UNIT WORD
TLO P3,(FB.NUB) ;NO NEW UNIT POINTER
JRST CPOPJ1 ;BAD RIB
FVRPT2: MOVNI T2,1 ;FLAG WAITING FOR CHANGE OF UNIT POINTER
SKIPN RIBFLR(P2) ;EXTENDED RIB?
JRST FVRPT3 ;NO
TRO P3,FB.XTR ;REMEMBER EXTENDED RIB
LDB T2,[POINT DESRBC,RIBXRA(P2),DENRBC] ;GET RIB NUMBER
SOSG T2 ;-1 CUZ RIBXRA POINTS TO NEXT XRIB
TLOA P3,(FB.XRW) ;OOPS--MONITOR SCREWED UP!
DPB T2,[POINTR (P3,FB.XRN)] ;REMEMBER RIB NUMBER
MOVEI T2,0 ;CHANGE OF UNIT POINTER NOT ALWAYS PRESENT
FVRPT3: SKIPN R,(T1) ;GET RETRIEVAL POINTER
JRST FVRPT5 ;BAD IF ZERO (MAY BE END)
TDNE R,[-1-RIPNUB-MAXUNI] ;CHANGE OF UNIT POINTER?
JRST FVRPT4 ;NO
TDZA T2,T2 ;FLAG HAVE CHANGE OF UNIT POINTER
FVRPT4: MOVEI T2,1 ;FLAG HAVE DATA POINTER
AOBJN T1,FVRPT3 ;LOOP BACK FOR MORE
FVRPT5: JUMPL T2,FVRPT6 ;JUMP IF NEED CHANGE OF UNIT POINTER
SKIPE T2 ;SKIP IF NEED DATA POINTER
JRST CPOPJ1 ;ALL IS WELL
TLOA P3,(FB.MRE) ;BAD (MISSING) RETRIEVAL ENTRY
FVRPT6: TLO P3,(FB.NUB) ;LITE MISSING CHANGE OF UNIT POINTER
JRST CPOPJ1 ;RETURN ON ERRORS
;TEST FOR PRIME RIB
FVRPRM: TRNN P3,FB.RIB ;DO WE THINK WE FOUND A RIB?
POPJ P, ;NO
TLNN P3,(FB.FIR!FB.MRE!FB.NUB) ;RETRIEVAL POINTERSS OK?
TRNE P3,FB.XTR ;OR RIB TYPE ALREADY KNOWN?
JRST CPOPJ1 ;CAN'T DETERMINE
HRRZ T1,P2 ;POINT TO START OF BUFFER
ADD T1,RIBFIR(P2) ;MAKE AOBJN TO RETRIEVAL POINTERS
AOBJP T1,CPOPJ1 ;ADVANCE BEYOND CHANGE OF UNIT POINTER
MOVE R,(T1) ;GET RETRIEVAL POINTER
LDB T2,.DFCLP(D) ;FETCH CLUSTER ADDRESS
IMUL T2,.DFBSC(D) ;COMPUTE BLOCK NUMBER
CAMN T2,RIBSLF(P2) ;POINT TO SELF?
TRO P3,FB.PRM ;YES--THEN IT'S A PRIME RIB
JRST CPOPJ1 ;RETURN
;TEST FOR A SPARE RIB
FVRSPR: TRNN P3,FB.RIB ;DO WE THINK WE FOUND A RIB?
POPJ P, ;NO
TLNN P3,(FB.FIR!FB.MRE!FB.NUB) ;RETRIEVAL POINTERS OK?
TRNE P3,FB.PRM!FB.XTR ;OR RIB TYPE ALREADY KNOWN?
JRST CPOPJ1 ;CAN'T BE A SPARE RIB
HRRZ T1,P2 ;POINT TO START OF BUFFER
ADD T1,RIBFIR(P2) ;MAKE AOBJN TO RETRIEVAL POINTERS
AOBJP T1,CPOPJ1 ;ADVANCE BEYOND CHANGE OF UNIT POINTER
MOVE T2,RIBSIZ(P2) ;GET WRITTEN SIZE IN WORDS
ADDI T2,BLKSIZ-1 ;ROUND UP
IDIVI T2,BLKSIZ ;COMPUTE BLOCKS
FVRSP1: SKIPN R,(T1) ;GET DATA ENTRY
SOJA T1,FVRSP2 ;PROCESSED LAST ONE
LDB T3,.DFCNP(D) ;FETCH CLUSTER COUNT
IMUL T3,.DFBSC(D) ;COMPUTE NUMBER OF BLOCKS
SUB T2,T3 ;COUNT BLOCKS
JUMPL T2,FVRSP2 ;DONE?
AOBJN T1,FVRSP1 ;LOOP BACK FOR ANOTHER POINTER
SUBI T1,1 ;BACK OFF TO LAST POINTER
FVRSP2: ADD T2,T3 ;COMPUTE BLOCKS WRITTEN IN LAST GROUP
MOVE R,(T1) ;RELOAD LAST POINTER
LDB T3,.DFCLP(D) ;GET CLUSTER ADDRESS
IMUL T3,.DFBSC(D) ;TRANSLATE TO A BLOCK NUMBER
ADD T3,T2 ;ADD OFFSET TO EOF
ADDI T3,1 ;ADVANCE ONE FOR THE RIB
CAMN T3,RIBSLF(P2) ;MATCH SELF POINTER?
TRO P3,FB.SPR ;YES
JRST CPOPJ1 ;RETURN
SUBTTL FILE SERVICE -- F$XFRB - COUNT BLOCKS TRANSFERED
;COUNT BLOCKS TRANSFERED
;CALL: MOVE T1, NEGATIVE WORD COUNT
; PUSHJ P,F$XFRB
; <RETURN>
;
;ON RETURN, THE REMAINING BLOCK COUNT FOR THE CURRENT GROUP WILL
;BE ADJUSTED.
F$XFRB: ADDM T1,.FWRWC(F) ;ADJUST REMAINING WORD COUNT IN FILE
MOVMS T1 ;MAKE POSITIVE
TRNE T1,BLKSIZ-1 ;FRACTION OF A BLOCK?
ADDI T1,BLKSIZ ;YES--ROUND UP
IDIVI T1,BLKSIZ ;TRANSLATE TO BLOCKS
ADDM T1,.FWBLK(F) ;REMEMBER WHERE WE ARE
HRLS T1 ;PUT IN LH TOO
ADDM T1,.FWLFT(F) ;TALLY UP BLOCKS TAKEN FROM CURRENT GROUP
POPJ P, ;RETURN
SUBTTL FILE SERVICE -- F$DSAT - DEALLOCATE BITS IN A SAT
;ROUTINE TO DEALLOCATE BITS IN A SAT BLOCK
;CALL: MOVE T1, CLUSTER COUNT
; MOVE T2, CLUSTER ADDRESS
; PUSHJ P,F$DSAT
; <NON-SKIP> ;SOME BITS ALREADY ZERO
; <SKIP> ;SUCCESS (SAT UPDATED)
;
;IN KEEPING WITH MONITOR TRADITION AND HOW RETRIEVAL POINTERS ARE
;FORMATTED, A RETRIEVAL POINTER CANNOT SPAN MULTIPLE SAT BLOCKS.
;THEREFORE, THIS ROUTINE HAS NO LOGIC TO STEP ACROSS SATS. THE
;CALLER MUST GUARANTEE THAT GOOD ARGUMENTS ARE PAST OR A STOPCODE
;WILL RESULT.
F$DSAT: MOVEM T1,SATCNT ;SAVE CLUSTER COUNT
MOVEM T2,SATCLA ;SAVE STARTING CLUSTER
PUSHJ P,SATFND ;LOCATE THE SAT IN QUESTION
PUSHJ P,SATSET ;SET UP BUFFERS, ETC.
PUSHJ P,F$RSAT ;READ SAT BLOCK INTO THE BUFFERS
JFCL ;WILL USE SAT FROM DATA FILE
SKIPL .SDVAL(P1) ;DISK SAT VALID?
POPJ P, ;NOPE--CAN'T DO ANYTHING WITHOUT IT
MOVN T1,SATCNT ;GET -VE CLUSTER COUNT
HRLZS T1 ;MAKE AN AOBJN POINTER
MOVE T2,SATCLA ;GET STARTING CLUSTER BACK
SUB T2,.SDFIR(P1) ;COMPUTE CLUSTER OFFSET IN THIS SAT
IDIVI T2,44 ;DIVIDE BY BITS PER WORD
ADDI T2,.SDDSK(P1) ;INDEX INTO THE DISK SAT
MOVN T4,T3 ;GET -VE REMAINDER
MOVSI T3,400000 ;AND FIRST BIT IN WORD
LSH T3,(T4) ;POSITION TO STARTING BIT
SETZM SATERR ;CLEAR ERROR COUNTER
FDSAT1: TDNN T3,(T2) ;BIT ON?
WARN (BAZ,.+1,<Bit already zero for cluster >,E..BAZ)
ANDCAM T3,(T2) ;CLEAR THE BIT
TRNE T3,1 ;ABOUT OT WRAP?
AOS T2 ;ADVANCE TO NEXT WORD
ROT T3,-1 ;ADVANCE TO NEXT BIT
AOBJN T1,FDSAT1 ;LOOP FOR ALL CLUSTERS
PUSHJ P,F$WSAT ;WRITE SAT BACK
JFCL ;WE TRIED
SKIPN SATERR ;ANY ERRORS?
AOS (P) ;NO
POPJ P,
E..BAO:!
E..BAZ: AOS SATERR ;COUNT ERRORS
HRRZS T1 ;ISOLATE CLUSTER OFFSET
ADD T1,SATCLA ;GET CLUSTER IN ERROR
PJRST T$DECW ;PRINT CLUSTER AND RETURN
SUBTTL FILE SERVICE -- F$RSAT - READ A SAT BLOCK FROM DISK
;ROUTINE TO READ A SAT BLOCK INTO THE BUFFER AREA
;CALL: PUSHJ P,F$RSAT
; <NON-SKIP> ;I/O ERROR
; <SKIP> ;DONE
F$RSAT: PUSHJ P,SATSET ;SAVE ACS, SETUP BUFFER AND IN CORE POINTERS
MOVE T1,.SDBLK(P2) ;GET DATA FILE POSITION OF THIS SD
MOVSI T2,-.SDLEN ;-VE SD WORD COUNT
HRRI T2,-1(P1) ;MAKE AN IOWD
PUSHJ P,D$READ ;READ SD FROM THE DATA FILE
SETZ T1, ;GET A ZERO
DPB T1,.SDERR(P2) ;NO ERRORS HERE
MOVSI T1,(P2) ;POINT TO IN CORE STORAGE
HRRI T1,(P1) ;AND TO BUFFER AREA
BLT T1,.SDMIN-1(P1) ;UPDATE BUFFER AREA
FRSAT1: MOVSI T1,(DF.PFS) ;BIT TO TEST
TDNE T1,.DFFLG(D) ;PREFER DATA FILE SAT OVER THE ONE ON DISK?
JRST FRSAT3 ;YES
MOVEI T2,FESBZ% ;INCASE OF ERROR
SKIPN T1,.SDUBN(P2) ;GET UNIT-RELATIVE BLOCK NUMBER
JRST FRSAT2 ;SAT BLOCK ZERO
MOVSI T2,-BLKSIZ ;-VE SIZE OF SAT
HRRI T2,.SDDSK-1(P1) ;MAKE AN IOWD
PUSHJ P,U$READ ;READ IN FROM DISK
SKIPA T2,T1 ;PRESERVE ERROR CODE
SETZ T2, ;NO ERRORS
FRSAT2: DPB T2,.SDERR(P2) ;STORE ERROR CODE OR ZERO FOR LATER DISPLAY
SKIPN T2 ;SKIP IF ERRORS
HRROS .SDVAL(P1) ;ELSE MARK THE DISK SAT AS VALID
MOVE T1,.SDBLK(P2) ;GET DATA FILE POSITION OF THIS SD
MOVSI T2,-.SDLEN ;-VE SD WORD COUNT
HRRI T2,-1(P1) ;MAKE AN IOWD
PUSHJ P,D$WRIT ;UPDATE THE DATA FILE
FRSAT3: PUSHJ P,D$WHDR ;UPDATE DATA FILE HEADER
LDB T1,.SDERR(P1) ;GET ERROR BYTE
JUMPE T1,CPOPJ1 ;RETURN SUCCESS IF NO ERRORS
WARN (SRE,CPOPJ,<SAT read error on SAT block >,E..SRE)
E..SWE:!
E..SRE: PUSH P,T1 ;SAVE ERROR CODE
MOVE T1,.SDNUM(P1) ;GET SAT NUMBER
PUSHJ P,T$DECW ;PRINT IT
XMOVEI T1,[ASCIZ /; /]
PUSHJ P,T$STRG ;PRINT SEPARATOR
POP P,T1 ;GET ERROR CODE BACK
PUSHJ P,F$ETXT ;TRANSLATE ERROR INTO TEXT
PJRST T$STRG ;PRINT IT AND RETURN
SUBTTL FILE SERVICE -- F$WSAT - WRITE A SAT BLOCK TO DISK
;ROUTINE TO UPDATE A SAT BLOCK ON DISK
;CALL: PUSHJ P,F$WSAT
; <NON-SKIP> ;I/O ERROR
; <SKIP> ;DONE
F$WSAT: PUSHJ P,SATSET ;SAVE ACS, SETUP BUFFER AND IN CORE POINTERS
MOVSI T1,(P1) ;POINT TO BUFFERS, ETC.
HRRI T1,(P2) ;AND TO IN CORE DATA AREA
BLT T1,.SDMIN-1(P2) ;UPDATE INCORE DATA
MOVE T1,.SDBLK(P2) ;GET DATA FILE POSITION OF THIS SD
MOVSI T2,-.SDLEN ;-VE SD WORD COUNT
HRRI T2,-1(P1) ;MAKE AN IOWD
PUSHJ P,D$WRIT ;WRITE SAT BUFFERS, ETC. TO DATA FILE
SETZ T1, ;GET A ZERO
DPB T1,.SDERR(P2) ;NO ERRORS HERE
DPB T1,.SDERR(P1) ;...
PUSHJ P,D$WHDR ;UPDATE DATA FILE HEADER
MOVSI T1,(DF.SAT) ;AND A BIT TO TEST
TDNN T1,.DFFLG(D) ;NO--ARE SAT UPDATES ALLOWED?
JRST FWSAT2 ;DON'T WRITE ON THE DISK
MOVEI T2,FESBZ% ;INCASE OF ERROR
SKIPN T1,.SDUBN(P2) ;GET UNIT-RELATIVE BLOCK NUMBER
JRST FWSAT1 ;SAT BLOCK ZERO
MOVSI T2,-BLKSIZ ;-VE SIZE OF SAT
HRRI T2,.SDDSK-1(P1) ;MAKE AN IOWD
PUSHJ P,U$WRIT ;WRITE IT OUT TO DISK
SKIPA T2,T1 ;PRESERVE ERROR CODE
SETZ T2, ;NO ERRORS
FWSAT1: DPB T2,.SDERR(P2) ;STORE ERROR CODE OR ZERO FOR LATER DISPLAY
FWSAT2: LDB T1,.SDERR(P2) ;GET ERROR BYTE
JUMPE T1,CPOPJ1 ;RETURN SUCCESS IF NO ERRORS
WARN (SWE,CPOPJ,<SAT write error on SAT block >,E..SWE)
;ROUTINE TO FIND A SAT BLOCK GIVEN A CLUSTER ADDRESS
;CALL: MOVE T1, POSITIVE CLUSTER COUNT
; MOVE T2, CLUSTER ADDRESS
; PUSHJ P,SATFND
; <RETURN>
;
;ON RETURN THE SAT BUFFER AREA CONTAINS THE TARGET SAT BLOCK NUMBER
SATFND: MOVE T3,.DFSAT(D) ;GET -VE SAT COUNT,,OFFSET
ADDI T3,(D) ;RELOCATE
SETZ T4, ;CLEAR CLUSTER COUNTER
SATFN1: ADD T4,.SDCPS(T3) ;GET CLUSTERS IN THIS SAT
CAMG T2,T4 ;TARGET IN THIS SAT?
JRST SATFN2 ;YES
ADDI T3,.SDMIN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN T3,SATFN1 ;LOOP FOR ALL SAT BLOCKS
STOPCD (CES,<Cluster exceeds structure size; >,T$DECW)
SATFN2: JUMPLE T1,SATFN3 ;JUMP IF NO CLUSTER COUNT SPECIFIED
PUSH P,T1 ;SAVE T1
ADD T1,T2 ;GET ENDING CLUSTER NUMBER
CAMLE T1,T4 ;ALSO WITHIN THIS SAT BLOCK?
STOPCD (CPS,<Cluster count & address spans multiple SATs>,)
POP P,T1 ;RESTORE CLUSTER COUNT
SATFN3: MOVE T4,.SDNUM(T3) ;GET SAT BLOCK NUMBER
MOVEM T4,SATBUF+.SDNUM ;STORE FOR LATER
POPJ P, ;RETURN
;CO-ROUTINE TO SET UP THE SAT BUFFER AREA AND IN CORE POINTER
;GIVEN A SAT BLOCK NUMBER
;CALL: PUSHJ P,SATSET
; <RETURN>
;
;ON RETURN P1, P2, AND U ARE SAVED. P1 := SAT BUFFER AREA,
;P2 := IN CORE POINTER, U := UNIT BLOCK ADDRESS
SATSET: PUSH P,P1 ;SAVE P1
PUSH P,P2 ;SAVE P2
PUSH P,U ;SAVE U
XMOVEI P1,SATBUF ;POINT TO BUFFER
MOVE P2,.DFSAT(D) ;GET -VE SAT COUNT,,OFFSET
ADDI P2,(D) ;RELOCATE
SATSE1: MOVE T2,.SDNUM(P1) ;GET TARGET SAT BLOCK FROM BUFFERS, ETC.
CAMN T2,.SDNUM(P2) ;FOUND IT IN THE DATA FILE HEADER?
JRST SATSE2 ;YES
ADDI P2,.SDMIN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P2,SATSE1 ;LOOP FOR ALL SAT BLOCKS
MOVE T1,.SDNUM(P1) ;GET TARGET BLOCK
STOPCD (SNF,<SAT block not found; >,T$DECW)
SATSE2: MOVE T2,P2 ;COPY DATA FILE HEADER POINTER
SUBI T2,(D) ;REDUCE TO THE OFFSET
MOVEM T2,.SDHDR(P1) ;UPDATE IN BUFFER AREA
MOVE U,.SDUNI(P2) ;SET UP UNIT
IMULI U,.UNLEN ;TIMES WORDS OF STORAGE PER UNIT
ADDI U,.DFUNI(D) ;RELOCATE
PUSHJ P,@-3(P) ;CALL THE CALLER
SKIPA ;NON-SKIP RETURN
AOS -4(P) ;ADJUST RETURN PC
POP P,U ;RESTORE U
POP P,P2 ;RESTORE P2
POP P,P1 ;RESTORE P1
POP P,(P) ;PHASE STACK
POPJ P, ;RETURN
SUBTTL LISTING CONTROL -- L$CHAR - CHARACTER OUTPUT
;ROUTINE TO STORE A CHARACTER IN THE LISTING FILE, TAKING INTO
;ACCOUNT THE NEED TO FORCE PAGE BREAKS AND WRITE OUT A STANDARD
;BANNER AND HEADER ON EACH PAGE
;CALL: MOVE T1, CHARACTER
; PUSHJ P,L$CHAR
; <RETURN>
L$CHAR: PUSH P,T2 ;SAVE T2
MOVE T2,LSTLIN ;GET COUNT OF REMAINING LINES
CAIN T1,12 ;LINE-FEED?
SUBI T2,1 ;YES
CAIN T1,13 ;VERTICAL-TAB?
SUBI T2,4 ;YES
CAIN T1,14 ;FORM-FEED?
SETZ T2, ;YES
MOVEM T2,LSTLIN ;UPDATE COUNTER
POP P,T2 ;RESTORE T2
CAIL T1,12 ;VERTICAL
CAILE T1,14 ;MOTION?
AOS LSTCOL ;NO--ADVANCE COLUMN COUNT
CAIN T1,15 ;CARRIAGE-RETURN?
SETZM LSTCOL ;RESET COUNT
SKIPG LSTLIN ;OR NEED TO START A NEW PAGE?
JRST LCHAR1 ;DO SPECIAL TOP OF FORM PROCESSING
JRST LCHAR5 ;ELSE ROOM FOR MORE ON THIS PAGE
LCHAR1: SKIPE LSTFLG ;FIRST TIME HERE?
JRST LCHAR5 ;NO--AVOID RECURSION
SETOM LSTFLG ;FLAG INTERNAL CALL
PUSH P,T1 ;SAVE CHARACTER
MOVEI T1,15 ;START WITH A
PUSHJ P,T$CHAR ;CARRIAGE-RETURN
PUSHJ P,T$FORM ;NEXT A FORM-FEED
MOVE T1,LSTLPP ;GET LINES PER PAGE
MOVEM T1,LSTLIN ;RESET COUNT
XMOVEI T1,LSTBAN ;POINT TO BANNER
PUSHJ P,T$STRG ;PRINT IT
PUSHJ P,L$PGSZ ;GET PAGE SIZE
HLRZS T1 ;ISOLATE WIDTH
SUBI T1,^D13 ;FIGURE WIDTH FOR "PAGE XXXXX-YY"
PUSHJ P,L$TABS ;POSITION TO THAT COLUMN
XMOVEI T1,[ASCIZ /Page /]
PUSHJ P,T$STRG ;PRINT TEXT
SKIPE LSTHGR ;HAVE A HEADER GENERATION ROUTINE?
SKIPGE LSTSPN ;YES--BUT WILL IT BE SUB-PAGE 0?
AOSA T1,LSTPAG ;TIME TO ADVANCE PAGE COUNTER
MOVE T1,LSTPAG ;DOING A SUB-PAGE
PUSHJ P,T$DECW ;PRINT IT
SKIPN LSTHGR ;HAVE A HEADER GENERATION ROUTINE?
JRST LCHAR3 ;NO
SKIPE LSTSPF ;SUB-PAGE PROCESSING ENABLED?
AOSN T1,LSTSPN ;ADVANCE SUB-PAGE NUMBER
JRST LCHAR3 ;NO
MOVNS T1 ;NEGATE
PUSHJ P,T$DECW ;PRINT AS NEGATIVE NUMBER
LCHAR3: PUSHJ P,T$CRLF ;APPEND A CRLF
PUSHJ P,T$CRLF ;GO DOWN A
PUSHJ P,T$CRLF ; COUPLE OF LINES
SKIPN LSTHGR ;HAVE A HEADER GENERATION ROUTINE?
JRST LCHAR4 ;NO
XMOVEI T1,LSTTYO ;SPECIAL ROUTINE FOR HEADERS
PUSHJ P,T$SETO ;SET UP FOR OUTPUT
PUSH P,T1 ;SAVE OLD ROUTINE
PUSHJ P,L$HEAD ;SET UP FOR HEADER GENERATION
MOVE T1,LSTSPN ;GET SUB-PAGE NUMBER (FOR SUBR)
PUSHJ P,@LSTHGR ;NOW'S THE TIME TO CALL IT
POP P,T1 ;GET OLD TYPEOUT ROUTINE
PUSHJ P,T$SETO ;RESET IT
LCHAR4: XMOVEI T1,LSTHDR ;POINT TO HEADER
SKIPE (T1) ;ANY TEXT THERE?
PUSHJ P,T$STRG ;PRINT IT
SETZM LSTFLG ;CLEAR INTERNAL CALL FLAG
POP P,T1 ;RESTORE CHARACTER
CAIL T1,12 ;GOT HERE DUE
CAILE T1,14 ; TO VERTICAL MOTION?
CAIA ;NO--MUST PRINT CHARACTER NOW
POPJ P, ;ELSE IGNORE IT
LCHAR5: SOSGE LSTBRH+.BFCTR ;COUNT CHARACTERS
JRST LCHAR6 ;BUFFER FULL
IDPB T1,LSTBRH+.BFPTR ;STORE CHARACTER
SKIPN LSTTTY ;LISTING TO TTY?
POPJ P, ;NO
CAIL T1,12 ;VERTICAL
CAILE T1,14 ; MOTION?
POPJ P, ;NO
OUT LSTCHN, ;FORCE OUTPUT AT EOL
POPJ P, ;RETURN
JRST LCHAR7 ;GO REPORT ERROR
LCHAR6: OUT LSTCHN, ;WRITE BUFFER OUT
JRST LCHAR5 ;LOOP BACK AND STORE CHARACTER
LCHAR7: GETSTS LSTCHN,T1 ;READ I/O STATUS
FATAL (LFO,.+1,<Listing file output error >,T$IOST)
PUSHJ P,L$CLOS ;CLOSE FILE
PJRST REENTR ;STOP EVERYTHING AND RETURN TO TOP LEVEL
SUBTTL LISTING CONTROL -- L$CLOS - CLOSE FILE
L$RSET: MOVEI T1,LSTCHN ;GET CHANNEL NUMBER
RESDV. T1, ;RESET THE CHANNEL
JFCL ;THAT'S OK
JRST LCLOS1 ;ENTER CLEANUP CODE
L$CLOS: CLOSE LSTCHN, ;CLOSE OFF THE CHANNEL
RELEAS LSTCHN, ;...
LCLOS1: SETZM LSTOPF ;MARK FILE CLOSED
SETZB T1,T2 ;CLEAR ACS
EXCH T1,LSTMEM+0 ;GET BUFFER SIZE
EXCH T2,LSTMEM+1 ;AND ADDRESS
SKIPE T1 ;ALREADY GIVEN BACK?
PUSHJ P,M$GIVW ;RELEASE CORE
MOVE T1,LSTSAV ;GET SAVED CHARACTER STICKER
PUSHJ P,T$SETO ;RESET OUTPUT ROUTINE
SETZM LSTHDR ;ZAP HEADER TEXT
SETZM LSTHGR ;AND HEADER GENERATION ROUTINE
POPJ P, ;RETURN
SUBTTL LISTING CONTROL -- L$ENVI - LIST ENVIRONMENT
;ROUTINE CALLED BY COMMANDS WHICH ARE WRITING TO A FILE (AS
;OPPOSED TO THE TERMINAL). THIS WILL WRITE OUT ENVIRONMENTAL
;DATA WHICH IS OBTAINED FROM THE DATA FILE.
;CALL: PUSHJ P,L$ENVI
; <RETURN>
L$ENVI: SKIPE LSTTTY ;LISTING TO TTY?
POPJ P, ;YES--NO ENVIRONMENTAL INFO
MOVE T1,[PUSHJ P,T$JUST] ;ROUTINE TO DO JUSTIFICATION
MOVEM T1,CMDJST+0 ;SAVE FOR LATER
PUSHJ P,LSTPSZ ;NOW DETERMINE PAGE SIZE
PUSHJ P,T$CRLF ;START WITH
PUSHJ P,T$CRLF ; A FEW
PUSHJ P,T$CRLF ; BLANK LINES
XMOVEI T1,[ASCIZ /Environmental Data/]
PUSHJ P,DSHTTL ;PRINT TEXT
PUSHJ P,T$CRLF ;END LINE
PUSHJ P,T$CRLF ;ONE MORE
PUSHJ P,D$SHWS ;DISPLAY STRUCTURE DATA
PUSHJ P,D$SHWP ;DISPLAY PARAMETERS
PUSHJ P,T$FORM ;FORM FEED
PUSHJ P,D$SHWD ;DISPLAY DATA FILE INFO
PUSHJ P,D$SHPT ;DISPLAY PATCH DATA
PUSHJ P,T$FORM ;FORM FEED
PUSHJ P,D$SSAT ;DISPLAY SAT BLOCKS
PUSHJ P,T$FORM ;FORM FEED
PUSHJ P,D$SERR ;DISPLAY ERROR SUMMARY
PUSHJ P,T$FORM ;FORM FEED
PUSHJ P,D$SHWE ;DISPLAY ERSATZ DEVICES
POPJ P, ;RETURN
SUBTTL LISTING CONTROL -- L$FILE - SET UP OUTPUT SCAN BLOCK
;ROUTINE TO SET UP OUTPUT SCAN BLOCK AND APPLY DEFAULTS
;CALL: MOVE T1, PARSED SCAN BLOCK ADDRESS OR ZERO
; MOVE T2, LAST SCANNED CHARACTER
; PUSHJ P,L$FILE
; <RETURN>
L$FILE: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,T1 ;COPY SCAN BLOCK ADDRESS
MOVE P2,T2 ;SAVE LAST SCANNED CHARACTER
JUMPE P1,LFILE1 ;JUST DO DEFAULTING IF NO SCAN BLOCK
MOVSI T1,(P1) ;GET RETURNED SCAN BLOCK
HRR T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
HRRZ T2,T1 ;POINT TO DESTINATION
ADD T2,.DFSBL(D) ;COMPUTE ENDING ADDRESS
BLT T1,-1(T2) ;COPY SCAN BLOCK
LFILE1: XMOVEI T1,LFLDOB ;POINT TO DEFAULT OUTPUT BLOCK
MOVEI T2,LFLDOL ;GET ITS LENGTH
MOVE T3,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
PUSHJ P,C$DFIL ;APPLY DEFAULTS
MOVE T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
MOVE T2,.SBFLG(T1) ;AND THE FLAGS
TLOE T2,(SB.NAM) ;WAS A FILE NAME SPECIFIED?
JRST LFILE2 ;YES
MOVEM T2,.SBFLG(T1) ;UPDATE FLAGS
MOVE T2,.DFSTR(D) ;GET THE STRUCTURE NAME
MOVEM T2,.SBNAM(T1) ;AND USE IT FOR THE OUTPUT FILE NAME
SETOM .SBNMM(T1) ;SET MASK ACCORDINGLY
LFILE2: MOVE T1,P1 ;RESTORE T1
MOVE T2,P2 ;RESTORE T2
POPJ P, ;RETURN
;DEFAULT OUTPUT SCAN BLOCK
LFLDOB: EXP SB.DEV!SB.EXT ;SCANNER FLAGS
EXP 'TTY ' ;DEVICE
EXP -1 ;DEVICE MASK
EXP 0 ;FILE NAME
EXP 0 ;FILE NAME MASK
XWD 'LST',-1 ;EXTENSION,,MASK
LFLDOL==.-LFLDOB ;LENGTH OF BLOCK
SUBTTL LISTING CONTROL -- L$HDRS - SET HEADER SUBROUTINE
;SET THE LISTING HEADER SUBROUTINE TO BE CALLED AT THE START OF
;NEW PAGE.
;CALL: MOVE T1, ADDRESS
; PUSHJ P,L$HDRS/L$HDRN
; <RETURN>
;
;AT THE START OF A NEW PAGE, THE SUPPLIED SUBROUTINE WILL BE CALLED WITH
;T1 CONTAINING THE CONTINUATION PAGE COUNT. IF ZERO, THEN THIS IS THE
;FIRST PAGE SINCE THE LAST HEADER GENERATION. ENTER AT L$HDRN IF NO
;SUB-PAGE PROCESSING IS WANTED.
L$HDRN: SETZM LSTSPF ;NO SUB-PAGE PROCESSING WANTED
CAIA
L$HDRS: SETOM LSTSPF ;ENABLE SUB-PAGE PROCESSING
MOVEM T1,LSTHGR ;SAVE HEADER GENERATION ROUTINE
SETOM LSTSPN ;RESET SUB-PAGE NUMBER
POPJ P, ;RETURN
SUBTTL LISTING CONTROL -- L$HDRZ - ZERO HEADER COUNTERS
;ROUTINE TO ZERO HEADER COUNTERS AND TERMINATE HEADER GENERATION
;CALL: PUSHJ P,L$HDRZ
; <RETURN>
L$HDRZ: SETZM LSTHGR ;RESET HEADER GENERATION ROUTINE
SETOM LSTSPN ;RESET SUB-PAGE NUMBER
POPJ P, ;RETURN
SUBTTL LISTING CONTROL -- L$HEAD - GENERATE BANNER/HEADER
;ROUTINE TO GENERATE A LISTING HEADER
;CALL: PUSHJ P,L$HEAD
; <RETURN>
L$HEAD: SKIPA T1,[POINT 7,LSTHDR] ;BYTE POINTER TO HEADER
LHEAD1: MOVE T1,[POINT 7,LSTBAN] ;BYTE POINTER TO BANNER
MOVEM T1,LSTPTR ;SAVE
MOVEI T1,LSTSIZ ;BYTE COUNT
MOVEM T1,LSTCTR ;SAVE
HRRZ T1,LSTPTR ;GET BUFFER ADDRESS
MOVSI T2,0(T1) ;START ADDRESS
HRRI T2,1(T1) ;MAKE A BLT POINTER
SETZM (T1) ;CLEAR FIRST WORD
BLT T2,LSTWDS-1(T1) ;CLEAR BUFFER
POPJ P, ;RETURN
LSTTYO: SOSG LSTCTR ;COUNT CHARACTERS
STOPCD (LBO,<Listing buffer overflow>,)
IDPB T1,LSTPTR ;STORE CHARACTER
POPJ P, ;RETURN
SUBTTL LISTING CONTROL -- L$OPEN - OPEN FILE
L$OPEN: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,T1 ;COPY SCAN BLOCK ADDRESS
SETZM LSTMEM+0 ;NO BUFFERS
SETZM LSTMEM+1 ; ALLOCATED YET
SETZM LSTSAV ;NO CHARACTER TYPER STORED YET
PUSHJ P,LSTBLK ;SET UP OPEN/ENTER/PATH BLOCKS
PUSHJ P,LSTCRE ;CREATE THE FILE
POPJ P, ;CAN'T
SETOM LSTOPF ;MARK FILE OPENED
PUSHJ P,LSTPSZ ;DETERMINE PAGE SIZE
XMOVEI T1,L$CHAR ;SPECIAL CHARACTER STICKER
PUSHJ P,T$SETO ;SET OUTPUT ROUTINE
MOVEM T1,LSTSAV ;SAVE FOR LATER
SETZM LSTLIN ;MARK THE NEED FOR A PAGE BREAK
SETZM LSTCOL ;SAY AT LEFT MARGIN
SETZM LSTPAG ;INITIALIZE PAGE COUNTER
PUSHJ P,BLDBAN ;BUILD BANNER
JRST CPOPJ1 ;RETURN
BLDBAN: PUSHJ P,LHEAD1 ;SET UP FOR BANNER GENERATION
XMOVEI T1,LSTTYO ;SPECIAL TYPEOUT ROUTINE
PUSHJ P,T$SETO ;SET IT
PUSH P,T1 ;SAVE OLD ROUTINE
XMOVEI T1,[ASCIZ / Listing by /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,[OURNAM] ;GET OUR NAME
PUSHJ P,T$SIXN ;PRINT IT
XMOVEI T1,[ASCIZ / version /]
PUSHJ P,T$STRG ;PRINT SEPARATOR
MOVE T1,JOBVER ;GET OUR VERSION
PUSHJ P,T$VERW ;PRINT IT
XMOVEI T1,[ASCIZ / on /]
PUSHJ P,T$STRG ;PRINT SEPARATOR
PUSHJ P,T$DATN ;PRINT TODAYS DATE
XMOVEI T1,[ASCIZ / at /]
PUSHJ P,T$STRG ;PRINT SEPARATOR
PUSHJ P,T$TIMN ;PRINT THE CURRENT TIME
POP P,T1 ;GET OLD CHARACTER TYPER
PJRST T$SETO ;RESET IT AND RETURN
;SETUP OPEN/ENTER/PATH BLOCKS
LSTBLK: XMOVEI P2,LSTDEV ;POINT TO OPEN BLOCK
;SET UP OPEN BLOCK
LSTBL1: MOVEI T1,.IOASC ;ASCII MODE
MOVEM T1,.OPMOD(P2)
MOVE T1,.SBDEV(P1) ;DEVICE
MOVEM T1,.OPDEV(P2)
MOVSI T2,LSTBRH ;BUFFER RING HEADER
MOVEM T2,.OPBUF(P2)
;SET UP ENTER BLOCK
LSTBL2: XMOVEI P2,LSTENT ;POINT TO ENTER BLOCK
MOVSI T1,0(P2) ;START ADDR
HRRI T1,1(P2) ;MAKE A BLT POINTER
SETZM (P2) ;CLEAR FIRST WORD
BLT T1,.RBMAX-1(P2) ;CLEAR ENTIRE BLOCK
MOVEI T1,.RBMAX ;BLOCK LENGTH
MOVEM T1,.RBCNT(P2)
MOVEI T1,LSTPTH ;PATH BLOCK ADDRESS
SKIPE .SBDIR(P1) ;DIRECTORY SPECIFIED?
MOVEM T1,.RBPPN(P2)
MOVE T1,.SBNAM(P1) ;FILE NAME
MOVEM T1,.RBNAM(P2)
HLLZ T1,.SBEXT(P1) ;EXTENSION
MOVEM T1,.RBEXT(P2)
MOVE T1,JOBVER ;VERSION
MOVEM T1,.RBVER(P2)
MOVE T1,[OURNAM] ;PROGRAM NAME
MOVEM T1,.RBSPL(P2)
;SET UP PATH BLOCK
LSTBL3: XMOVEI P2,LSTPTH ;POINT TO PATH BLOCK
MOVSI T1,0(P2) ;START ADDR
HRRI T1,1(P2) ;MAKE A BLT POINTER
SETZM (P2) ;CLEAR FIRST WORD
BLT T1,.PTMAX-1(P2) ;CLEAR ENTIRE BLOCK
ADDI P2,.PTPPN ;OFFSET TO PPN WORD
MOVSI T1,-5
HRRI T1,.SBDIR(P1) ;AOBJN POINTER TO PATH
LSTBL4: MOVE T2,(T1) ;GET A WORD
MOVEM T2,(P2) ;PUT A WORD
AOS P2 ;ADVANCE POINTER
AOS T1 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN P2,LSTBL4 ;LOOP THROUGH PATH
POPJ P, ;RETURN
;CREATE THE FILE
LSTCRE: MOVE T1,LSTDEV+.OPDEV ;INCASE OF ERROR
OPEN LSTCHN,LSTDEV ;OPEN DEVICE
FATAL (COD,CPOPJ,<Cannot open device >,T$SIXN)
MOVE T1,P1 ;INCASE OF ERROR
ENTER LSTCHN,LSTENT ;CREATE FILE
FATAL (CCL,L$RSET,<Cannot create listing file >,T$FILE)
MOVEI T2,T3 ;ARG BLOCK ADDRESS
MOVE T3,LSTDEV+.OPMOD ;GET MODE WORD
MOVEI T4,LSTCHN ;AND CHANNEL NUMBER
DEVSIZ T2, ;READ BUFFER SIZE
FATAL (CBS,L$RSET,<Cannot determine buffer size for >,T$FILE)
HRRZ T1,T2 ;COPY BUFFER SIZE
HLRZS T2 ;ISOLATE DEFAULT NUMBER OF BUFFERS
IMULI T1,(T2) ;COMPUTE TOTAL WORDS NEEDED
PUSHJ P,M$GETW ;ALLOCATE CORE
MOVEM T1,LSTMEM+0 ;SAVE WORD COUNT
MOVEM T2,LSTMEM+1 ;AND ADDRESS
PUSH P,JOBFF ;SAVE FIRST FREE
MOVEM T2,JOBFF ;BUILD BUFFERS HERE
OUTBUF LSTCHN, ;...
POP P,JOBFF ;RESTORE JOBFF
JRST CPOPJ1 ;RETURN
;DETERMINE PAGE SIZED
LSTPSZ: SETZM LSTTTY ;CLEAR LISTING TO TTY FLAG
MOVEI P2,LSTCHN ;GET I/O CHANNEL
SKIPE LSTOPF ;FILE OPENED?
DEVTYP P2, ;YES--MUST DETERMINE DEVICE TYPE
SETZ P2, ;CHANNEL NOT OPENED?
JUMPE P2,LSTPS1 ;ASSUME CONTROLLING TTY IF DEVTYP FAILS
MOVEI T1,DEFLWD ;LOAD UP DEFAULT WIDTH FOR LPT
MOVEI T2,DEFLPP ;AND THE DEFAULT LINES PER PAGE FOR LPT
LDB T3,[POINTR (P2,TY.DEV)] ;GET DEVICE TYPE
CAIE T3,.TYTTY ;TERMINAL?
JRST LSTPS2 ;NO
LSTPS1: SETOM LSTTTY ;REMEMBER LISTING TO A TERMINAL
MOVE T1,[2,,T2] ;SET UP UUO AC
MOVEI T2,.TOWID ;FUNCTION CODE
MOVEI T3,LSTCHN ;GET CHANNEL
SKIPE P2 ;DEVTYP FAIL?
DEVNAM T3, ;CONVERT TO DEVICE NAME
CAIA ;CAN'T DO IT
IONDX. T3, ;CONVERT NAME TO I/O INDEX
MOVNI T3,1 ;ASSUME CONTROLLING TTY
TRMOP. T1, ;READ WIDTH
MOVEI T1,DEFTWD ;ASSUME DEFAULT WIDTH
PUSH P,T1 ;SAVE FOR A MOMENT
MOVE T1,[2,,T2] ;SET UP UUO AC
MOVEI T2,.TOPSZ ;FUNCTION TO RETURN PAGE SIZE
TRMOP. T1, ;READ IT
SETZ T1, ;FAILED
SKIPN T2,T1 ;COPY RESULT
MOVEI T2,DEFTWD ;DEFAULT FOR A TERMINAL
CAIG T2,DEFTWD ;BIG SCREEN?
MOVEI T2,DEFLPP ;NO--DON'T BE RIDICULOUS
POP P,T1 ;GET WIDTH BACK
LSTPS2: MOVEM T1,LSTWID ;SAVE PAGE WIDTH
MOVEM T2,LSTLPP ;SAVE LINES PER PAGE
POPJ P, ;RETURN
SUBTTL LISTING CONTROL -- L$PGSZ - RETURN PAGE SIZE
;ROUTINE TO RETURN THE PAGE SIZE
;CALL: PUSHJ P,L$PGSZ
; <RETURN> ;T1 := WIDTH,,LENGTH
L$PGSZ: HRLZ T1,LSTWID ;GET WIDTH OF PAGE
HRR T1,LSTLPP ;AND LINES PER PAGE
POPJ P, ;RETURN
SUBTTL LISTING CONTROL -- L$TABS - TAB TO SPECIFIED COLUMN
;ROUTINE TO POSITION FOR OUTPUT AT THE SPECIFIED COLUMN
;CALL: MOVE T1, COLUMN
; PUSHJ P,L$TABS
; <RETURN>
L$TABS: SUB T1,LSTCOL ;COMPUTE COLUMNS TO SPACE OVER
JUMPLE T1,CPOPJ ;RETURN IF ALREADY THERE (OR PAST)
PUSHJ P,T$SPAC ;SPACE OVER
SOJG T1,.-1 ;LOOP 'TIL AT DESIRED COLUMN
POPJ P, ;RETURN
SUBTTL LISTING CONTROL -- L$TEST - TEST PAGE
;THIS ROUTINE DOES A "TEST PAGE" FUNCTION TO DETERMINE IF THERE ARE
;ENOUGH LINES REMAINING ON A PAGE TO ACCOMODATE MULTI-LINE DISPLAYS
;CALL: MOVE T1, LINES REQUIRED
; PUSHJ P,L$TEST
; <RETURN>
;
;ON RETURN, A PAGE BREAK WILL BE FORCED IF THERE ARE NOT ENOUGH LINES
;TO SATISFY THE REQUIREMENTS OF THE CALLER. NOTE THAT THIS SHOULD NOT
;BE CALLED IN THE MIDDLE OF A LINE.
L$TEST: CAMLE T1,LSTLIN ;ARE THERE ENOUGH LINES REMAINING?
SETZM LSTLIN ;NO--FORCE A PAGE BREAK NOW
POPJ P, ;RETURN
SUBTTL MEMORY MANAGER -- M$GETW - ALLOCATE CORE
;ALLOCATE CORE. THIS ROUTINE WILL RETURN CORE CHUNKS STARTING
;FROM THE END OF THE LOW SEGMENT. IT MAKES NO ATTEMPT TO HANDLE
;DISCONTIGUOUS SEGMENTS. THE ONLY RESTRICTIONS ARE THAT YOU RUN
;OUT OF CORE WHEN YOU HIT THE START OF THE HIGH SEGMENT AND VMDDT
;WILL GET BLOWN AWAY BY CORE UUOS.
;
;CALL: MOVE T1, NUMBER OF WORDS
; PUSHJ P,M$GETW
; <RETURN> ;T1 =: WORD COUNT, T2 := ADDRESS OF CORE CHUNK
;
;AC USAGE: ALL PRESERVED
;
;AC USAGE WITHIN THIS ROUTINE:
; P1 = # WORDS TO BE GOTTEN
; P2 = LINK BEING LOOKED AT
; P3 = ADDRESS OF LINK TO LINK IN P2
; P4 = NUMBER OF REQUESTED WORDS
; T1 = ADDRESS OF LINK IN P2
; LINK FORMAT IS ADDRESS,,NUNBER
M$GETW: PUSHJ P,SAVE4 ;SAVE SOME ACS
MOVE P4,T1 ;SAVE NUMBER OF WORDS REQUESTED
SKIPE P1,T1 ;COPY # WORDS TO GET
TLNE P1,-1 ;NONZERO AND 18 BITS?
STOPCD (TMW,<Too many words asked for: >,T$OCTW)
HLRZ T1,FREPTR ;SET UP ADR OF FIRST POINTER
MOVEI P3,FREPTR ;AND ADR OF ADR
JUMPE T1,MGETW6 ;GO IF END OF LIST
MGETW1: MOVE P2,(T1) ;GET NEXT LINK
JUMPE P2,MGETW2 ;SKIP IF NO POINTER AT ALL
TRNN P2,-1 ;HAVE A GOOD POINTER
STOPCD (BCP,<Bad core pointer>,)
MGETW2: CAILE P1,(P2) ;ENOUGH ROOM IN THIS BLOCK?
JRST MGETW5 ;NO, TRY NEXT ONE
MGETW3: SUBI P2,(P1) ;P2 = NEXT BLOCK,,NEW #
TRNN P2,-1 ;USED UP ENTIRE BLOCK?
JRST MGETW4 ;YES, THEN LINK IT AROUND ENTIRELY
ADDI P1,(T1) ;INDEX P1 TO NEW LINK WORD
MOVEM P2,(P1) ;STORE NEW LINK WORD
HRLM P1,(P3) ; AND LINK TO THIS LINK
JRST MGETW7 ;SET UP ACS AND RETURN
MGETW4: HLLM P2,(P3) ;RE-LINK PREVIOUS BLOCK TO NEXT ONE
JRST MGETW7 ;SET UP ACS AND RETURN
MGETW5: MOVE P3,T1 ;COPY ADR OF LINK
HLRZ T1,P2 ;AND LINK ITSELF
JUMPN T1,MGETW1 ;TRY NEXT BLOCK IF ANY ARE LEFT
;HERE IF WE NEED MORE CORE TO SATISFY REQUEST
MGETW6: MOVE T1,JOBREL ;GET LAST CORE ADR
ADDI T1,(P1) ;PLUS HOW MUCH WE NEED
CORE T1, ;GET IT
STOPCD (CUF,<CORE UUO failed>,)
MOVE T1,JOBREL ;GET NEW LAST WORD ADR
MOVE P2,T1 ;SAVE IT
EXCH T1,JOBFF ;SET JOBFF IN CASE SOMEBODY GOOFS
SUBI P2,(T1) ;COMPUTE AMMOUNT OF CORE NEEDED
ADDI T1,1 ;POINT TO CORRECT PLACE
JRST MGETW3 ; AND ALLOCATE DESIRED WORDS FROM THIS
MGETW7: MOVE T2,T1 ;GET ADDRESS
MOVE T1,P4 ;RELOAD REQUESTED NUMBER OF WORDS
SETZM (T2) ;CLEAR FIRST WORD OF CHUNK
HRLZI P1,(T2) ;GET STARTING ADDRESS OF CHUNK
HRRI P1,1(T2) ;MAKE A BLT POINTER
MOVEI P2,(T2) ;GET STARTING ADDRESS OF CHUNK
ADDI P2,(T1) ;COMPUTE END ADDRESS
BLT P1,-1(P2) ;ZERO OUT THE CHUNK
POPJ P, ;RETURN
SUBTTL MEMORY MANAGER -- M$GIVW - DEALLOCATE CORE
;DEALLOCATE CORE. THIS ROUTINE WILL FREE UP CHUNKS OF CORE AND
;LINK THEM INTO THE FREE CORE LIST. NO CORE COMPRESSION IS DONE.
;CALL: MOVE T1, NUMBER OF WORDS
; MOVE T2, CHUNK ADDRESS
; PUSHJ P,M$GIVW
; <RETURN>
;
;AC USAGE: T1 AND T2
;
;NOTE THAT LINKS IN ACS ARE SWAPPED (NUMBER,,ADDRESS) FOR
;CONVIENENCE IN THIS ROUTINE.
M$GIVW: EXCH T1,T2 ;SWAP COUNT AND ADDRESS
PUSHJ P,SAVE2 ;SAVE P1 AND P2
SKIPE FREPTR ;IS THERE ANY CORE LEFT?
JRST MGIVW1 ;YES, DO THE COMPLEX STUFF
MOVEM T2,(T1) ;SAVE THE SIZE OF THIS BLOCK
HRLZM T1,FREPTR ;SAVE ADD OF THIS BLOCK AS START OF FREE LIST
JRST MGIVW6 ;FINISH UP
MGIVW1: PUSH P,T2 ;SAVE # WORDS NOW
CAMGE T1,LOWEND ;GIVING LOW SEGMENT AWAY?
STOPCD (GLA,<Giving low segment away>,)
TLNE T1,-1 ;MORE THAN 18 BITS OF ADR
STOPCD (ATB,<Address too large>,)
CAMLE T1,JOBREL ;WITHIN THE LOW SEG?
STOPCD (NXM,<Non-existant memory>,)
MOVE P1,T1 ;P1 = ADR TO BE RE-LINKED
MOVEI P2,FREPTR ;P2 = PTR TO CURRENT LINK
MGIVW2: MOVS T1,(P2) ;T1 = ADR OF NEXT BLOCK
CAIN P1,(T1) ;SAME PLACE?
STOPCD (CLS,<Current link same as next block>,)
TRNE T1,-1 ;ANY MORE?
CAIG P1,(T1) ;YES, PAST PLACE TO INSERT BLOCK?
JRST MGIVW3 ;YES, OR NO MORE, LINK THINGS UP NOW
MOVE P2,T1 ;NO,
JRST MGIVW2 ;ON TO NEXT LINK
;HERE WHEN SPOT FOR BLOCK IS FOUND. SEE IF THIS BLOCK CAN BE
;CONCATENATED WITH PREVIOUS BLOCK.
MGIVW3: HLRZ T2,T1 ;GET LENGTH OF PREVIOUS BLOCK
ADDI T2,(P2) ;T2 = ADR AFTER PREVIOUS BLOCK
CAILE T2,(P1) ;PREVIOUS BLOCK OVERLAP THIS ONE?
STOPCD (BOL,<Blocks overlap>,)
CAIE T2,(P1) ;CONCATINATE?
JRST MGIVW4 ;NO
MOVSS T1 ;YES, T1=ADR,,N
ADD T1,(P) ;T1=ADR,,N OF BOTH BLOCKS
MOVEM T1,(P2) ;FIX LINK WORD OF PREVIOUS BLOCK
MOVSS T1 ;FIX UP T1 FOR BELOW
JRST MGIVW5 ;CONTINUE BELOW
;LINK THE BLOCK INTO THE FREE LIST
MGIVW4: HRL T1,(P) ;T1=LEN,,ADR OF NEXT BLOCK
MOVSM T1,(P1) ;NOW THIS IS A LEGIT BLOCK
HRLM P1,(P2) ;THIS POINTS TO NEXT BLOCK
MOVS P2,(P2) ;GET THE ADDRESS AND THE SIZE
;NOW MERGE THIS BLOCK WITH THE NEXT ONE IF POSSIBLE
MGIVW5: POP P,T2 ;FIXUP STACK
TRNN T1,-1 ;END OF THE LIST?
JRST MGIVW6 ;YES--RETURN
HLRZ T2,T1 ;GET LENGTH OF THIS BLOCK
ADDI T2,(P2) ;+ADR=ADR AFTER THIS BLOCK
CAILE T2,(T1) ;DO THESE BLOCKS OVERLAP THIS WAY?
STOPCD (BTL,<Block too long>,)
CAIE T2,(T1) ;CONCATINATE WITH NEXT BLOCK?
JRST MGIVW6 ;YES--ALMOST DONE
MOVE T2,(T1) ;RH T2=LEN OF NEXT BLOCK
MOVSS T1 ;T1=ADR,,N
ADDI T2,(T1) ;T2=ADR,,N OF THIS+NEXT
MOVEM T2,(P2) ;FIX LINK OF PREVIOUS BLOCK
;TRY TO REDUCE CORE
MGIVW6: POPJ P,
HLRZ T1,FREPTR ;GET FREE CORE LIST HEADER
JUMPE T1,CPOPJ ;EMPTY??
MOVEI P1,LOWEND ;DEFEND AGAINST JUMPE FOLLOWING
MGIVW7: HLRZ T2,(T1) ;GET STORAGE ADDRESS
JUMPE T2,MGIVW8 ;END OF LIST?
MOVE P1,T1 ;SAVE PREDESSOR
MOVE T1,T2 ;COPY ADDRESS
JRST MGIVW7 ;SEARCH FOR LAST BLOCK
MGIVW8: HLLZS (P1) ;CLEAR WORD COUNT FOR LAST CHUNK
MOVEM T1,JOBFF ;UPDATE FIRST FREE
CORE T1, ;REDUCE CORE
JFCL ;WE TRIED
POPJ P, ;RETURN
SUBTTL MEMORY MANAGER -- M$INIT - INITIALIZATION
M$INIT: HLRZ T1,JOBSA ;GET SAVED COPY OF JOBFF
MOVEM T1,JOBFF ;RESET IT
MOVEM T1,LOWEND ;SAVE END OF LOW SEGMENT
CORE T1, ;REDUCE CORE
JFCL ;IGNORE ERRORS
SETZM FREPTR ;CLEAR ADDR OF FREE CORE LIST
MOVEI T1,<<JOBDA!777>+1>_-11 ;FIRST CODE PAGE PAST JOBDAT
HLRZ T2,JOBDDT ;GET DDT END ADDRESS
TRNE T2,777 ;OVERFLOW A PAGE?
ADDI T2,1000 ;ROUND UP
LSH T2,-11 ;CONVERT TO A PAGE NUMBER
CAIGE T1,(T2) ;DDT BELOW PROGRAM?
MOVEI T1,(T2) ;YES--USE LAST DDT PAGE
MOVE T4,T1 ;COPY STARTING PAGE
SUBI T4,LITEND_-11 ;COMPUTE NUMBER OF CODE PAGES
HRLZS T4 ;PUT IN LH
HRRI T4,(T1) ;MAKE AOBJN POINTER
MINIT1: MOVE T1,[.PAGWL,,T2] ;SET UP UUO
MOVEI T2,1 ;DO ONE PAGE
HRRZ T3,T4 ;GET PAGE NUMBER
TLO T3,(PA.GAF) ;TURN ON WRITE-LOCK BIT
PAGE. T1, ;WRITE-LOCK THE PAGE
CAIN T1,PAGWL% ;OK IF PAGE ALREADY WRITE-LOCKED
JRST MINIT2 ;CONTINUE IF NO ERRORS
POPJ P, ;EITHER UUO NOT IMPLEMENTED OR FATAL ERROR
MINIT2: AOBJN T4,MINIT1 ;LOOP FOR ALL CODE PAGES
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$INIT - INITIALIZATION
T$INIT: MOVE T1,[Z.TXTB,,Z.TXTB+1] ;SET UP BLT
SETZM Z.TXTB ;CLEAR FIRST WORD
BLT T1,Z.TXTE-1 ;CLEAR STORAGE
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$ADDR - PRINT AN ADDRESS
T$ADDR: PUSH P,T1 ;SAVE ADDRESS
PUSH P,T2 ;SAVE T2
PUSH P,T3 ;SAVE T3
HLRZS T1 ;ISOLATE SECTION
JUMPE T1,TADDR1 ;HAVE ONE?
PUSHJ P,T$OCTW ;PRINT SECTION NUMBER
PUSHJ P,T$COMA ;PRINT A COMMA
PUSHJ P,T$COMA ;ONE MORE
TADDR1: HRLZ T2,-2(P) ;ISOLATE ADDRESS WITHIN SECTION
MOVEI T3,6 ;COLUMN COUNT
TADDR2: LSHC T1,3 ;GET A DIGIT
ANDI T1,7 ;MASK OFF JUNK
ADDI T1,"0" ;CONVERT TO ASCII
PUSHJ P,T$CHAR ;PRINT CHARACTER
SOJG T3,TADDR2 ;LOOP FOR ALL DIGITS
POP P,T3 ;RESTORE T3
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$ASCI - ASCII WORD
;PRINT A SINGLE ASCII WORD
;CALL: MOVE T1, WORD
; PUSHJ P,T$ASCI
T$ASCI: JUMPE T1,CPOPJ ;CHECK FOR NULL REQUEST
PUSH P,T1 ;SAVE WORD
PUSH P,[EXP 0] ;TERMINATE IT
XMOVEI T1,-1(P) ;GET ADDRESS
PUSHJ P,T$STRG ;OUTPUT TEXT
POP P,(P) ;TRIM STACK
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$BPTR - PRINT A BYTE POINTER
;PRINT A BYTE POINTER
;CALL: MOVE T1, BYTE POINTER
; PUSHJ P,T$BPTR
T$BPTR: PUSH P,T1 ;SAVE BYTE POINTER
XMOVEI T1,[ASCIZ /POINT /]
PUSHJ P,T$STRG ;PRINT TEXT
LDB T1,[POINT 6,(P),11] ;GET BYTE SIZE
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$COMA ;PRINT COMMA
MOVSI T1,(@) ;GET INDIRECT BIT
TDNE T1,(P) ;IS IT ON?
PUSHJ P,T$ATSN ;YES
HLRZ T1,(P) ;GET LH
ANDI T1,17 ;KEEP ONLY INDEX AC
JUMPE T1,TBPTR1 ;JUMP IF NONE
PUSHJ P,T$LPAR ;START WITH LEFT PARENTHESIS
PUSHJ P,T$OCTW ;INCLUDE INDEX AC
PUSHJ P,T$RPAR ;FINISH IT
TBPTR1: HRRZ T1,(P) ;GET ADDRESS FIELD
PUSHJ P,T$OCTW ;PRINT IT
PUSHJ P,T$COMA ;PRINT COMMA
LDB T1,[POINT 6,(P),5] ;GET BYTE POSITION
PUSHJ P,T$DECW ;PRINT IT
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$CHAR - PRINT A CHARACTER
T$CHAR: ANDI T1,377 ;MASK DOWN
SKIPE TYPOUT ;HAVE A SPECIAL OUTPUT ROUTINE?
PJRST @TYPOUT ;YES--GO TO IT
OUTCHR T1 ;ELSE DO SIMPLE TERMINAL OUTPUT
POPJ P, ;AND RETURN
SUBTTL TEXT PROCESSING -- T$DATE - 15-BIT DATE
;OUTPUT DATE IN DECSYSTEM10 15 BIT FORMAT
;CALL: MOVE T1, DATE ;FOR T$DATE
; PUSHJ P,T$DATN ;FOR TODAY'S DATE
; PUSHJ P,T$DATE
T$DATN: DATE T1, ;GET TODAY'S DATE
T$DATE: PUSHJ P,SAVE1 ;SAVE P1
IDIVI T1,^D31 ;GET DAYS
MOVE T4,T1 ;SAVE REST
MOVEI T1,1(T2) ;GET DAYS AS 1-31
CAIGE T1,^D10 ;SINGLE DIGIT?
PUSHJ P,T$SPAC ;PUT OUT A LEADING SPACE
PUSHJ P,T$DECW ;PRINT DAYS
IDIVI T4,^D12 ;GET MONTHS
MOVE T1,MTHTAB(P1) ;GET ASCII MONTH
PUSHJ P,T$ASCI ;OUTPUT IT
MOVEI T1,^D64(T4) ;GET YEAR SINCE 1900
IDIVI T1,^D100 ;GET JUST YEARS IN CENTURY
MOVEI T1,"0" ;GET A ZERO
CAIGE T2,^D10 ;SINGLE DIGIT?
PUSHJ P,T$CHAR ;PUT OUT A LEADING ZERO
MOVE T1,T2 ;GET YEAR
PJRST T$DECW ;PRINT IT AND RETURN
MTHTAB: ASCII /-Jan--Feb--Mar--Apr--May--Jun-/
ASCII /-Jul--Aug--Sep--Oct--Nov--Dec-/
SUBTTL TEXT PROCESSING -- T$DIRB - DIRECTORY
;PRINT A DIRECTORY
;CALL: MOVE T1, SCAN BLOCK ADDRESS
; PUSHJ P,T$DIRB
T$DIRB: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVEI P1,.SBDIR(T1) ;POINT TO START OF DIRECTORY INFORMATION
MOVE P2,.DFSBL(D) ;GET SCAN BLOCK LENGTH
SUBI P2,.SBMIN ;COMPUTE NUMBER OF SFD/MASK PAIRS
LSH P2,-1 ;DIVIDE BY TWO
MOVNS P2 ;NEGATE
HRLZS P2 ;MAKE AN AOBJN POINTER
PUSHJ P,T$LBRK ;START OFF WITH A LEFT SQUARE BRACKET
;PPN
TDIRB1: MOVE T1,0(P1) ;GET PPN
MOVE T2,1(P1) ;AND PPN MASK
PUSHJ P,T$PPNM ;PRINT IT
ADDI P1,2 ;ACCOUNT FOR TWO WORD PAIRS
;SFDS
TDIRB2: SKIPN T1,(P1) ;HAVE AN SFD?
PJRST T$RBRK ;NO--PRINT RIGHT SQUARE BRACKET AND RETURN
PUSHJ P,T$COMA ;PRINT A COMMA
PUSHJ P,T$SIXN ;PRINT AN SFD NAME
ADDI P1,2 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN P2,TDIRB2 ;LOOP FOR ALL SFDS
PJRST T$RBRK ;PRINT RIGHT SQUARE BRACKET AND RETURN
SUBTTL TEXT PROCESSING -- T$DTTM - DATE/TIME
;OUTPUT DATE AND TIME IN SMITHSONIAN UNIVERSAL DATE-TIME FORMAT
;CALL: MOVE T1, UDT
; PUSHJ P,T$DTTM
T$DTTM: PUSHJ P,SAVT ;SAVE T1-T4
PUSHJ P,.CNTDT ;TAKE APART
ADDI T1,^D500 ;ROUND TO SECOND FOR PRINTING
CAMG T1,[^D24*^D60*^D60*^D1000] ;PAST MIDNIGHT?
JRST TDTTM1 ;NO, NORMAL CASE
ADDI T2,1 ;WAS 23:59:59.835, BUMP DAY
SUB T1,[^D24*^D60*^D60*^D1000] ;MAKE TIME 0:0:0
TDTTM1: PUSH P,T1 ;SAVE TIME
MOVE T1,T2 ;POSITION DATE
PUSHJ P,T$DATE ;OUTPUT DATE
PUSHJ P,T$COLN ;OUTPUT A COLON
POP P,T1 ;RESTORE TIME
PJRST T$TIME ;OUTPUT TIME AND RETURN
SUBTTL TEXT PROCESSING -- T$ETIM - ELAPSED TIME
;PRINT ELAPSED TIME
;CALL: MOVE T1,DATE/TIME IN UDT FORMAT
; PUSHJ P,T$ETIM
T$ETIM: PUSHJ P,SAVT ;SAVE SOME ACS
TLNN T1,-1 ;DAYS?
JRST TETIM1 ;NO
PUSH P,T1 ;SAVE DATE/TIME
HLRZS T1 ;ISOLATE DATE COMPONENT
PUSHJ P,T$DECW ;PRINT DAYS
XMOVEI T1,[ASCIZ /D+/] ;GET DELIMITER
PUSHJ P,T$STRG ;PRINT IT
POP P,T1 ;GET DATE/TIME BACK
TETIM1: PUSHJ P,.CNTDT ;CONVERT TIME COMPONENT TO MILLISECONDS
PJRST T$TIME ;PRINT TIME AND RETURN
SUBTTL TEXT PROCESSING -- T$FCHR - FUNNY CHARACTER
T$FCHR: PUSH P,T1 ;SAVE CHARACTER
PUSH P,T2 ;AND T2
MOVSI T2,-FCHLEN ;GET -LENGTH OF TABLE
TFCHR1: HLL T1,FCHTAB(T2) ;GET MNEMONIC IN LH
CAME T1,FCHTAB(T2) ;A MATCH?
AOBJN T2,TFCHR1 ;NO
JUMPGE T2,TFCHR2 ;NO MATCHES
HLLZS T1 ;KEEP JUST THE MNEMONIC
LSH T1,-6 ;MAKE ROOM FOR BRACKETS
MOVE T2,['< > '] ;ASSUME THREE CHARACTER MNEMONIC
TRNN T1,770000 ;WAS IT THREE?
MOVE T2,['< > '] ;NO--MAKE IT TWO
IOR T1,T2 ;COMPLETE THE WORD
JRST TFCHR3 ;GO FINISH UP
TFCHR2: XMOVEI T2,T$CHAR ;ASSUME SINGLE CHARACTER
HRRZS T1 ;KEEP JUST THE CHARACTER
CAIL T1," " ;CONTROL CHARACTER?
PJRST TFCHR4 ;NO--READABLE ASCII
ADDI T1,"@"-" " ;CONVERT TO SIXBIT
LSH T1,^D24 ;POSITION IT
TLO T1,'^ ' ;PREFIX BY AN UP-ARROW
TFCHR3: XMOVEI T2,T$SIXN ;SIXBIT OUTPUT
TFCHR4: PUSHJ P,(T2) ;PRINT SOMETHING
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE CHARACTER
POPJ P, ;RETURN
FCHTAB: 'EOF',,-1 ;END OF FILE
'EOL',,000 ;END OF LINE
'BEL',,007 ;BELL
'TAB',,011 ;HORIZONTAL TAB
'LF ',,012 ;LINE FEED
'VT ',,013 ;VERTICAL TAB
'FF ',,014 ;FORM FEED
'CR ',,015 ;CARRIAGE RETURN
'ESC',,033 ;ESCAPE
'DEL',,177 ;RUBOUT
FCHLEN==.-FCHTAB ;LENGTH OF TABLE
SUBTTL TEXT PROCESSING -- T$FILE - FILE (SCAN) BLOCK
;PRINT A FILESPEC FROM A SCAN BLOCK
;CALL: MOVE T1, SCAN BLOCK ADDRESS
; PUSHJ P,T$FILE
T$FILE: PUSHJ P,SAVT ;SAVE SOME ACS
PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,T1 ;COPY ADDRESS
MOVE P2,.SBFLG(P1) ;GET FLAGS
;DEVICE
TFILE1: TLNN P2,(SB.DEV) ;HAVE A DEVICE?
JRST TFILE2 ;NO
MOVE T1,.SBDEV(P1) ;GET DEVICE
PUSHJ P,T$SIXN ;PRINT IT
PUSHJ P,T$COLN ;ADD A COLON
;FILE NAME
TFILE2: TLNN P2,(SB.NAM) ;HAVE A FILE NAME?
JRST TFILE3 ;NO
XMOVEI T3,T$SIXN ;ASSUME A SIXBIT NAME
MOVE T1,.SBNAM(P1) ;GET FILE NAME
MOVE T2,.SBNMM(P1) ;AND MASK
HLRZ T4,.SBEXT(P1) ;GET EXTENSION
CAIN T4,'UFD' ;A UFD?
XMOVEI T3,T$PPNB ;YES--PRINT FILE NAME AS A PPN
SKIPGE T1 ;UNLESS IT'S
XMOVEI T3,T$SIXN ; A SIXBIT PPN
PUSHJ P,(T3) ;PRINT IT
;EXTENSION
TFILE3: TLNN P2,(SB.EXT) ;HAVE AN EXTENSION?
JRST TFILE4 ;NO
PUSHJ P,T$DOT ;PRINT A PERIOD
HLLZ T1,.SBEXT(P1) ;GET EXTENSION
PUSHJ P,T$SIXN ;PRINT IT
;PATH
TFILE4: MOVE T1,P1 ;POINT TO SCAN BLOCK
TLNE P2,(SB.DIR) ;HAVE A DIRECTORY?
PUSHJ P,T$DIRB ;PRINT IT
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$HTIM - HIGH PRECISION TIME
;OUTPUT HIGH PRECISION TIME
;CALL: MOVE T1, TIME IN MILLISECONDS
; PUSHJ P,T$HTIM
T$HTIM: PUSHJ P,SAVT ;SAVE SOME ACS
IDIVI T1,^D1000 ;GET MILLISECONDS
PUSH P,T2 ;SAVE THEM
IDIVI T1,^D60 ;T1:= MINUTES, T2:= SECONDS
PUSH P,T2 ;SAVE SECONDS
IDIVI T1,^D60 ;T1:= HOURS, T2:= MINUTES
PUSH P,T2 ;SAVE MINUTES
JUMPE T1,THTIM1 ;LESS THAN ONE HOUR?
PUSHJ P,T$DECW ;OUTPUT HOURS
PUSHJ P,T$COLN ;OUTPUT A COLON
THTIM1: POP P,T1 ;GET MINUTES
JUSTIFY (R,2,"0",T$DECW) ;PRINT IT
PUSHJ P,T$COLN ;OUTPUT A COLON
POP P,T1 ;GET SECONDS
JUSTIFY (R,2,"0",T$DECW) ;PRINT IT
PUSHJ P,T$DOT ;OUTPUT A PERIOD
POP P,T1 ;GET MILLISECONDS
JUSTIFY (R,3,"0",T$DECW) ;PRINT IT
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$JUST - JUSTIFY OUTPUT
T$JUST: EXCH T1,(P) ;SAVE T2, GET ADDRESS OF ARGUMENTS
PUSH P,T2 ;SAVE T2
MOVE T2,0(T1) ;GET SUBROUTINE TO CALL
MOVEM T2,TXTSUB ;SAVE
LDB T2,[POINT 2,1(T1),1] ;GET L/C/R FLAG
MOVEM T2,TXTFLG ;SAVE IT
LDB T2,[POINT 9,1(T1),17] ;GET COLUMN COUNT
MOVEM T2,TXTCOL ;SAVE COUNTER
LDB T2,[POINT 8,1(T1),35] ;GET CHARACTER FOR PADDING
SKIPN T2 ;ZERO?
MOVEI T2," " ;DEFAULT TO A SPACE
MOVEM T2,TXTPAD ;SAVE IT
TJUST1: MOVE T1,[TXTBUF,,TXTBUF+1] ;SET UP BLT
SETZM TXTBUF ;CLEAR FIRST WORD
BLT T1,TXTBUF+TXTJWD-1 ;CLEAR BUFFER
MOVEI T1,<TXTJWD*5>-1 ;GET MAXIMUM BYTE COUNT
MOVEM T1,TXTBCT ;SAVE
MOVE T1,[POINT 7,TXTBUF] ;BYTE POINTER TO STORAGE
MOVEM T1,TXTBPT ;SAVE
MOVEI T1,JSTTYO ;GET SPECIAL CHARACTER ROUTINE
PUSHJ P,T$SETO ;SET OUTPUT
MOVEM T1,TXTSVT ;SAVE PREVIOUS ROUTINE
TJUST2: MOVE T1,-1(P) ;RELOAD T1
MOVE T2,(P) ;RELOAD T2
PUSHJ P,@TXTSUB ;CALL SUBROUTINE
JFCL ;INCASE OF SKIP RETURNS
MOVE T1,TXTSVT ;GET SAVED CHARACTER TYPER
PUSHJ P,T$SETO ;RESET IT
MOVE T1,TXTFLG ;GET LEFT/CENTER/RIGHT FLAG
MOVEI T2,<TXTJWD*5>-1 ;GET MAX COUNT
SUB T2,TXTBCT ;COMPUTE CHARACTERS IN BUFFER
MOVNS T2 ;NEGATE
ADD T2,TXTCOL ;COMPUTE EMPTY COLUMNS
SKIPGE T2 ;FIELD OVERFLOW?
MOVNI T1,1 ;YES--PRINT ASTERISKS
PUSHJ P,@JSTTAB(T1) ;POSITION AND PRINT TEXT
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
;LEFT JUSTIFY
TJUSTL: XMOVEI T1,TXTBUF ;ELSE POINT TO BUFFER
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,TXTPAD ;GET PAD CHARACTER
SKIPE T2 ;SKIP IF A FULL FIELD
PUSHJ P,T$CHAR ;PRINT CHARACTER
SOJG T2,.-1 ;LOOP FOR REMAINING COLUMNS
POPJ P, ;AND RETURN
;CENTER JUSTIFY
TJUSTC: PUSH P,T3 ;SAVE T3
IDIVI T2,2 ;DIVIDE BY 2
MOVNS T2 ;NEGATE COLUMN COUNT
HRLZS T2 ;MAKE AN AOBJN POINTER
HRR T2,T3 ;GET REMAINDER
POP P,T3 ;RESTORE T3
MOVE T1,TXTPAD ;GET PAD CHARACTER
JUMPE T2,.+3 ;SKIP IF A FULL FIELD
PUSHJ P,T$CHAR ;PRINT CHARACTER
AOBJN T2,.-1 ;LOOP FOR REMAINING COLUMNS
XMOVEI T1,TXTBUF ;ELSE POINT TO BUFFER
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,TXTPAD ;GET PAD CHARACTER
JUMPE T2,CPOPJ ;RETURN IF A FULL FIELD
PUSHJ P,T$CHAR ;PRINT CHARACTER
SOJG T2,.-1 ;LOOP FOR REMAINING COLUMNS
POPJ P, ;RETURN
;RIGHT JUSTIFY
TJUSTR: MOVE T1,TXTPAD ;GET PAD CHARACTER
SKIPE T2 ;SKIP IF A FULL FIELD
PUSHJ P,T$CHAR ;PRINT CHARACTER
SOJG T2,.-1 ;LOOP FOR REMAINING COLUMNS
XMOVEI T1,TXTBUF ;ELSE POINT TO BUFFER
PJRST T$STRG ;PRINT TEXT AND RETURN
;PRINT STARS ON COLUMN OVERFLOW
TJUSTX: MOVE T2,TXTCOL ;GET COLUMN WIDTH
PUSHJ P,T$ASTR ;PRINT AN ASTERISK
SOJG T2,.-1 ;LOOP FOR WIDTH OF COLUMN
POPJ P, ;RETURN
;LEFT/CENTER/RIGHT DISPATCH TABLE
IFIW TJUSTX ;ASTERISKS
JSTTAB: IFIW TJUSTL ;LEFT
IFIW TJUSTC ;CENTER
IFIW TJUSTR ;RIGHT
;INTERNAL CHARACTER TYPER
JSTTYO: SOSLE TXTBCT ;COUNT DOWN
IDPB T1,TXTBPT ;STORE IN BUFFER
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$RDXW - PRINT NUMBERS
;PRINT DECIMAL
T$DECW: PUSH P,T2 ;SAVE T2
MOVEI T2,12 ;RADIX 10
PUSHJ P,T$RDXW ;PRINT NUMBER
POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
;PRINT OCTAL
T$OCTW: PUSH P,T2 ;SAVE T2
MOVEI T2,10 ;RADIX 8
PUSHJ P,T$RDXW ;PRINT NUMBER
POP P,T2 ;RESTORE T2
POPJ P, ;RETURN
;COMMON RADIX OUTPUT
T$RDXW: PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
PUSH P,T3 ;SAVE T3
MOVEI T3,(T2) ;COPY RADIX
PUSHJ P,TRDXW1 ;PRINT NUMBER
POP P,T3 ;RESTORE T3
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
TRDXW1: SKIPGE T1 ;NEGATIVE?
PUSHJ P,T$DASH ;PRINT A MINUS SIGN
TRDXW2: IDIV T1,T3 ;DIVIDE BY RADIX
MOVMS T2 ;GET MAGNITUDE
PUSH P,T2 ;SAVE REMAINDER
SKIPE T1 ;SEE IF ANYTHING LEFT
PUSHJ P,TRDXW2 ;YES--LOOP BACK WITH PD LIST
POP P,T1 ;GET BACK A DIGIT
ADDI T1,"0" ;CONVERT TO ASCII
CAILE T1,"9" ;SEE IF OVERFLOW DIGITS
ADDI T1,"A"-"9"-1 ;YES--SWITCH TO ALPHABETICS
PJRST T$CHAR ;PRINT IT AND RETURN
SUBTTL TEXT PROCESSING -- T$PATH - PATH BLOCK
;PRINT A PATH BLOCK
;CALL: MOVE T1,[-VE LENGTH,,PATH BLOCK ADDRESS]
; PUSHJ P,T$PATH
T$PATH: PUSHJ P,SAVE1 ;SAVE P1
MOVE P1,T1 ;COPY PATH BLOCK POINTER
ADDI P1,.PTPPN ;ADVANCE TO START OF PATH INFORMATION
PUSHJ P,T$LBRK ;START OFF WITH A LEFT SQUARE BRACKET
;PPN
TPATH1: MOVE T1,0(P1) ;GET PPN
MOVNI T2,1 ;NO WILDCARDS
PUSHJ P,T$PPNM ;PRINT IT
AOBJN P1,.+1 ;ADVANCE POINTER
;SFDS
TPATH2: SKIPN T1,(P1) ;HAVE AN SFD?
PJRST T$RBRK ;NO--PRINT RIGHT SQUARE BRACKET AND RETURN
PUSHJ P,T$COMA ;PRINT A COMMA
PUSHJ P,T$SIXN ;PRINT AN SFD NAME
AOBJN P1,TPATH2 ;LOOP FOR ALL SFDS
PJRST T$RBRK ;PRINT RIGHT SQUARE BRACKET AND RETURN
SUBTTL TEXT PROCESSING -- T$PPN - PPN
;PRINT A PPN
;CALL: MOVE T1, PPN
; PUSHJ P,T$PPN
T$PPN: PUSH P,T1 ;SAVE PPN
PUSHJ P,T$LBRK ;START WITH LEFT BRACKET
SKIPL T1,(P) ;SIXBIT?
JRST TPPN1 ;NO
PUSHJ P,T$SIXN ;PRINT WORD
JRST TPPN2 ;FINISH UP
TPPN1: HLRZ T1,(P) ;GET PROJECT NUMBER
PUSHJ P,T$OCTW ;PRINT IT
PUSHJ P,T$COMA ;PRINT COMMA
HRRZ T1,(P) ;GET PROGRAMMER NUMBER
PUSHJ P,T$OCTW ;PRINT IT
TPPN2: PUSHJ P,T$RBRK ;PRINT RIGHT BRACKET
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$PPNB - BRACKETED MASKED PPN
;PRINT A MASKED PPN WITHSQUARE BRACKETS
; CALL: MOVE T1, PPN
; MOVE T2, PPN MASK
; PUSHJ P,T$PPNB
T$PPNB: PUSHJ P,T$LBRK ;PRINT LEFT SQUARE BRACKET
MOVSS T2 ;T1,T2=LH(V),RH(V),RH(M),LH(M)
ROTC T1,-^D18 ;T1,T2=LH(M),LH(V),RH(V),RH(M)
PUSH P,T2 ;SAVE SECOND HALF (V,,M)
MOVSS T1 ;T1:=LH V,,M
PUSHJ P,TPPNM1 ;PRINT MASKED OCTAL HALF-WORD
PUSHJ P,T$COMA ;OUTPUT A COMMA
POP P,T1 ;RESTORE RH V,,M
PUSHJ P,TPPNM1 ;PRINT MASKED OCTAL HALF-WORD
PJRST T$RBRK ;PRINT RIGHT SQUARE BRACKET AND RETURN
SUBTTL TEXT PROCESSING -- T$PPNM - MASKED PPN
;PRINT A MASKED PPN WITHOUT SQUARE BRACKETS
; CALL: MOVE T1, PPN
; MOVE T2, PPN MASK
; PUSHJ P,T$PPNM
T$PPNM: MOVSS T2 ;T1,T2=LH(V),RH(V),RH(M),LH(M)
ROTC T1,-^D18 ;T1,T2=LH(M),LH(V),RH(V),RH(M)
PUSH P,T2 ;SAVE SECOND HALF (V,,M)
MOVSS T1 ;T1:=LH V,,M
PUSHJ P,TPPNM1 ;PRINT MASKED OCTAL HALF-WORD
PUSHJ P,T$COMA ;OUTPUT A COMMA
POP P,T1 ;RESTORE RH V,,M
;FALL INTO TPPNM1
;HERE TO TYPE MASKED OCTAL HALF WORD
;T1 := VALUE,,MASK
TPPNM1: TRCN T1,-1 ;MAKE MASK BIT 0 IF NOT WILD
PJRST T$ASTR ;OUTPUT AN ASTERISK IF WILD
MOVE T2,T1 ;MOVE TO CONVENIENT PLACE
MOVEI T3,6 ;SET LOOP COUNT
TPPNM2: MOVEI T1,0 ;CLEAR ACCUMULATOR
LSHC T1,3 ;POSITION FIRST DIGIT
JUMPN T1,TPPNM4 ;GO IF NON-ZERO
SOJG T3,TPPNM2 ;LOOP UNTIL ALL DONE
TPPNM3: MOVEI T1,0 ;CLEAR ACCUMULATOR
LSHC T1,3 ;GET NEXT DIGIT
TPPNM4: ADDI T1,"0" ;CONVERT TO ASCII
TLNE T2,7 ;CHECK MASK
MOVEI T1,"?" ;CHANGE TO ? IF WILD
PUSHJ P,T$CHAR ;TYPE CHARACTER
SOJG T3,TPPNM3 ;LOOP UNTIL DONE
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$RNGD - RANGE
T$RNGD: PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVE T2,1(T1) ;GET HIGH LIMIT
IOR T2,0(T1) ;MERGE
JUMPE T2,TRNGD1 ;JUMP IF BOTH ZERO
MOVE T1,0(T1) ;GET LOWER LIMIT
PUSHJ P,T$DECW ;PRINT IT
PUSHJ P,T$COLN ;PRINT SEPARATOR
MOVE T1,-1(P) ;GET ADDR BACK
MOVE T1,1(T1) ;GET UPPER LIMIT
PUSHJ P,T$DECW ;PRINT IT
JRST TRNGD2 ;FINISH UP
TRNGD1: XMOVEI T1,[ASCIZ /(none)/]
PUSHJ P,T$STRG ;PRINT TEXT
TRNGD2: POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$SETO - SET ALTERNATE CHARACTER OUTPUT ROUTINE
T$SETO: EXCH T1,TYPOUT ;SWAP WITH OLD ROUTINE
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$SIXN - PRINT A SIXBIT WORD
;PRINT SIXBIT
T$SIXN: PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVE T2,T1 ;COPY WORD
TSIXN1: JUMPE T2,TSIXN2 ;DONE?
LSHC T1,6 ;SHIFT IN A CHARACTER
ANDI T1,77 ;STRIP OFF JUNK
ADDI T1,40 ;CONVERT SIXBIT TO ASCII
PUSHJ P,T$CHAR ;PRINT IT
JRST TSIXN1 ;LOOP BACK FOR MORE
TSIXN2: POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$TIME - TIME
;OUTPUT TIME IN MILLISECONDS
;CALL: MOVE T1, MILLISECONDS ;FOR T$TIME
; PUSHJ P,T$TIMN ;FOR CURRENT TIME
; PUSHJ P,T$TIME
;
;THIS ROUTINE TRUNCATES THE TIME; IT WILL PRINT 15:59:59.995
;AS 15:59:59, NOT 16:00:00. THIS IS BECAUSE A ROUND UP COULD
;CAUSE THE DAY TO INCREMENT, AND THIS ROUTINE DOESN'T KNOW THE
;DAY (IT HAS PROBABLY ALREADY BEEN PRINTED). THE CALLER OF THIS
;ROUTINE MUST MAKE SURE THE TIME HAS ALREADY BEEN ROUNDED TO THE
; NEAREST SECOND HIMSELF. SEE THE CODE AT T$DTTM FOR AN EXAMPLE.
T$TIMN: MSTIME T1, ;GET CURRENT TIME
T$TIME: IDIV T1,[^D3600000] ;GET HOURS
MOVE T4,T2 ;SAVE REST
PUSHJ P,TTIME1 ;PRINT HOURS
PUSHJ P,T$COLN ;OUTPUT A COLON
MOVE T1,T4 ;RESTORE REST
IDIVI T1,^D60000 ;GET MINUTES
MOVE T4,T2 ;SAVE REST
PUSHJ P,TTIME2 ;PRINT MINUTES
PUSHJ P,T$COLN ;OUTPUT A COLON
MOVE T1,T4 ;RESTORE THE REST
IDIVI T1,^D1000 ;GET SECONDS
JRST TTIME2 ;FINISH UP
TTIME1: SKIPA T2,[" "] ;GET A SPACE
TTIME2: MOVEI T2,"0" ;GET A ZERO
EXCH T1,T2 ;SWAP AROUND
CAIGE T2,^D10 ;SINGLE DIGIT?
PUSHJ P,T$CHAR ;PAD LEADING CHARACTER
MOVE T1,T2 ;GET NUMBER BACK
PJRST T$DECW ;PRINT IT AND RETURN
SUBTTL TEXT PROCESSING -- T$STRG - PRINT A STRING
T$STRG: HRLI T1,(POINT 7,) ;MAKE A BYTE POINTER
PUSH P,T1 ;SAVE IT
TSTRG1: ILDB T1,(P) ;GET A CHARACTER
JUMPE T1,TSTRG2 ;END OF LINE?
PUSHJ P,T$CHAR ;PRINT IT
JRST TSTRG1 ;LOOP BACK FOR MORE
TSTRG2: POP P,T1 ;PHASE STACK
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- T$VERW - VERSION
;DECSYSTEM-10 VERSION WORD OUTPUT
;CALL: MOVE T1,WORD
; PUSHJ P,T$VERW
T$VERW: PUSHJ P,SAVT ;SAVE SOME ACS
MOVE T4,T1 ;MOVE WORD TO A SAFER PLACE
LDB T1,[POINT 9,T4,11] ;GET MAJOR VERSION
SKIPE T1 ;IF NON-ZERO,
PUSHJ P,T$OCTW ;OUTPUT IT
LDB T1,[POINT 6,T4,17] ;GET MINOR VERSION
JUMPE T1,TVERW2 ;IS THERE ONE?
SOS T1 ;PRINT IN MODIFIED
IDIVI T1,^D26 ; RADIX 26 ALPHA
JUMPE T1,TVERW1 ;JUMP IF ONE CHAR
MOVEI T1,"A"-1(T1) ;GET FIRST CHARACTER
PUSHJ P,T$CHAR ;OUTPUT IT
TVERW1: MOVEI T1,"A"(T2) ;GET LAST CHARACTER
PUSHJ P,T$CHAR ;OUTPUT IT
TVERW2: HRRZ T1,T4 ;GET EDIT NUMBER
JUMPE T1,TVERW3 ;NON-ZERO?
PUSHJ P,T$LPAR ;OUTPUT LEFT PARENTHESIS
HRRZ T1,T4 ;GET EDIT NUMBER AGAIN
PUSHJ P,T$OCTW ;OUTPUT IT
PUSHJ P,T$RPAR ;OUTPUT RIGHT PARENTHESIS
TVERW3: LDB T1,[POINT 3,T4,2] ;GET WHO FIELD
JUMPE T1,CPOPJ ;IS THERE ONE?
MOVNS T1 ;NEGATE IT
PJRST T$OCTW ;OUTPUT -N AND RETURN
SUBTTL TEXT PROCESSING -- T$VMSG - VERBOSITY CONTROLLED MESSAGE
T$VMSG: MOVEM 0,CRSHAC+0 ;SAVE AC 0
MOVE 0,[1,,CRSHAC+1] ;SET UP BLT
BLT 0,CRSHAC+17 ;SAVE THE ACS
HRRZ P1,(P) ;GET ADDRESS OF ARGS FROM CALL
POP P,(P) ;GET EXTRA PUSHJ OFF THE STACK
HRRZ T1,1(P1) ;GET CONTINUATION ADDRESS
MOVEM T1,(P) ;RETURN HERE
MOVEM P,CRSHAC+P ;UPDATE FOR LATER
HRROI T1,.GTWCH ;GET WATCH BITS
GETTAB T1, ;...
SETZ T1, ;FAILED??
TLNN T1,(JW.WPR!JW.WFL) ;ANY BITS SET?
TLO T1,(JW.WPR!JW.WFL) ;DEFAULT
PUSH P,T1 ;SAVE THEM FOR LATER
PUSHJ P,T$NEWL ;START WITH A CRLF IF NEEDED
HLRZ T2,1(P1) ;GET MESSAGE TYPE
CAIG T2,1 ;STOPCODE OR FATAL ERROR?
CLRBFI ;CLEAR TYPEAHEAD
JUMPN T2,TVMSG1 ;JUMP FOR NORMAL MESSAGES
MOVEI T1,[ASCIZ /? Stopcode /] ;THIS IS A BAD ONE
PUSHJ P,T$STRG ;TYPE TEXT
HLLZ T1,0(P1) ;GET PREFIX
PUSHJ P,T$SIXN ;TYPE IN SIXBIT
MOVEI T1,[ASCIZ / -/] ;SEPARATE FROM
PUSHJ P,T$STRG ; MAIN TEXT
JRST TVMSG2 ;ONWARD
TVMSG1: MOVE T1,[EXP "?","?","%","["](T2) ; AND THE SEVERITY CHARACTER
PUSHJ P,T$CHAR ;TYPE IT
MOVE T1,(P) ;GET VERBOSITY BITS
TLNN T1,(JW.WPR) ;PREFIX?
JRST TVMSG2 ;NO
MOVSI T1,OURPFX ;GET OUR PREFIX
HLR T1,0(P1) ;INCLUDE ONE FOR MESSAGE
PUSHJ P,T$SIXN ;TYPE IN SIXBIT
TVMSG2: PUSHJ P,T$SPAC ;SPACE
POP P,T1 ;GET VERBOSITY BITS
TLNN T1,(JW.WFL) ;FIRST LINE?
JRST TVMSG4 ;NO
TVMSG3: HRRZ T1,0(P1) ;GET TEXT ADDRESS
PUSHJ P,T$STRG ;TYPE STRING
HLRZ T1,2(P1) ;GET ADDRESS FOR ADDITIONAL TYPEOUT
JUMPE T1,TVMSG4 ;JUMP IF NONE
MOVEM T1,ERRSUB ;SAVE ADDRESS
MOVEM P1,ERRSP1 ;SAVE P1
MOVE 0,[CRSHAC+1,,1] ;SET UP BLT
BLT 0,17 ;RESTORE THE ACS
MOVE 0,CRSHAC ;RELOAD AC 0
PUSHJ P,@ERRSUB ;CALL ADDITIONAL TYPEOUT ROUTINE
MOVE P1,ERRSP1 ;RELOAD P1
TVMSG4: HLRZ T2,1(P1) ;GET ERROR TYPE
MOVEI T1,"]" ;JUST IN CASE ...
CAIN T2,3 ;INFORMATIONAL?
PUSHJ P,T$CHAR ;YES--TERMINATE WITH A BRACKET
PUSHJ P,T$CRLF ;TYPE A CRLF
HLRZ T1,1(P1) ;GET ERROR TYPE AGAIN
JUMPN T1,TVMSG6 ;JUMP IF A NORMAL MESSAGE
MOVEI T1,[ASCIZ / CRSHAC starts at location /]
PUSHJ P,T$STRG ;TYPE TEXT
MOVEI T1,CRSHAC ;GET ADDRESS
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
PUSHJ P,T$CRLF ;END WITH A CRLF
SKIPE JOBSYM ;HAVE SYMBOLS?
SKIPN JOBBPT ;AND DDT LOADED WITH SPECIAL BREAKPOINT?
JRST TVMSG5 ;NO--JUST EXIT
MOVEI T1,[ASCIZ / Entering DDT/]
PUSHJ P,T$STRG ;TYPE TEXT
PUSHJ P,T$CRLF ;A CRLF
PUSHJ P,T$CRLF ;ONE MORE
MOVE 0,[CRSHAC+1,,1] ;SET UP BLT
BLT 0,17 ;RESTORE THE ACS
MOVE 0,CRSHAC ;RELOAD AC 0
JSR @JOBBPT ;YES--ENTER IT
JRST TVMSG6 ;CONTINUE FROM DDT
TVMSG5: MOVE 0,[CRSHAC+1,,1] ;SET UP BLT
BLT 0,17 ;RESTORE THE ACS
MOVE 0,CRSHAC ;RELOAD AC 0
PUSHJ P,MONRET ;RETURN TO MONITOR
TVMSG6: MOVE 0,[CRSHAC+1,,1] ;SET UP BLT
BLT 0,17 ;RESTORE THE ACS
MOVE 0,CRSHAC ;RELOAD AC 0
POPJ P, ;AND RETURN
SUBTTL TEXT PROCESSING -- T$XLAT - TRANSLATE DATA TO STRING STORAGE
;CALL: MOVE T1, DATA
; MOVE T2, OUTPUT ROUTINE
; PUSHJ P,T$XLAT
;
;ON RETURN, T1 WILL CONTAIN THE STORAGE ADDRESS
T$XLAT: PUSH P,T1 ;SAVE DATA WORD
MOVE T1,[TXTTBF,,TXTTBF+1] ;SET UP BLT
SETZM TXTTBF ;CLEAR FIRST WORD
BLT T1,TXTTBF+TXLWDS-1 ;CLEAR STORAGE
MOVE T1,[POINT 7,TXTTBF] ;BYTE POINTER TO STORAGE
MOVEM T1,TXTTPT ;SAVE
MOVEI T1,<TXLWDS*5>-1 ;BYTE COUNT
MOVEM T1,TXTTCT ;SAVE
XMOVEI T1,TXLTYO ;INTERMEDIATE OUTPUT ROUTINE
PUSHJ P,T$SETO ;SET IT
EXCH T1,(P) ;SAVE OLD ROUTINE, RESTORE DATA
PUSHJ P,(T2) ;CALL SUPPLIED OUTPUT ROUTINE
POP P,T1 ;GET OLD OUTPUT ROUTINE BACK
PUSHJ P,T$SETO ;RESET IT
XMOVEI T1,TXTTBF ;POINT TO TEMP STORAGE
POPJ P, ;RETURN
TXLTYO: SOSLE TXTTCT ;COUNT DOWN
IDPB T1,TXTTPT ;STORE CHARACTER
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- SPECIAL SINGLE CHARACTERS
T$ASTR: PUSHJ P,TSSC ;PRINT ASTERISC AND RETURN
EXP "*"
T$ATSN: PUSHJ P,TSSC ;PRINT ATSIGN AND RETURN
EXP "@"
T$COLN: PUSHJ P,TSSC ;PRINT COLON AND RETURN
EXP ":"
T$COMA: PUSHJ P,TSSC ;PRINT COMMA AND RETURN
EXP ","
T$DASH: PUSHJ P,TSSC ;PRINT A DASH AND RETURN
EXP "-"
T$DOT: PUSHJ P,TSSC ;PRINT A DOT AND RETURN
EXP "."
T$DQUO: PUSHJ P,TSSC ;PRINT DOUBLE QUOTES AND RETURN
EXP """"
T$LANG: PUSHJ P,TSSC ;PRINT LEFT ANGLE BRACKET
EXP "<"
T$LBRK: PUSHJ P,TSSC ;PRINT LEFT SQUARE BRACKET
EXP "["
T$LPAR: PUSHJ P,TSSC ;PRINT LEFT PARENTHESIS
EXP "("
T$PERC: PUSHJ P,TSSC ;PRINT PERCENT SIZE
EXP "%"
T$PLUS: PUSHJ P,TSSC ;PRINT PLUS SIGN
EXP "+"
T$RANG: PUSHJ P,TSSC ;PRINT RIGHT ANGLE BRACKET
EXP ">"
T$RBRK: PUSHJ P,TSSC ;PRINT RIGHT SQUARE BRACKET
EXP "]"
T$RPAR: PUSHJ P,TSSC ;PRINT RIGHT PARENTHESIS
EXP ")"
T$SLSH: PUSHJ P,TSSC ;PRINT SLASH AND RETURN
EXP "/"
T$SPAC: PUSHJ P,TSSC ;PRINT SPACE AND RETURN
EXP " "
T$TABC: PUSHJ P,TSSC ;PRINT TAB AND RETURN
EXP 11
TSSC: EXCH T1,(P) ;SAVE T1, GET POINTER TO CHARACTER
MOVE T1,(T1) ;GET CHARACTER
PUSHJ P,T$CHAR ;PRINT IT
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL TEXT PROCESSING -- MISCELLANEOUS ROUTINES
;PRINT A FILE ERROR
;CALL: MOVE T1, ERROR CODE
; MOVE T2, SCAN BLOCK ADDRESS
T$FERR: PUSH P,T1 ;SAVE ERROR CODE
MOVE T1,T2 ;COPY SCAN BLOCK ADDRESS
PUSHJ P,T$FILE ;PRINT SCAN BLOCK
XMOVEI T1,[ASCIZ /; /] ;PRINT
PUSHJ P,T$STRG ; SEPARATOR
POP P,T1 ;GET FILE I/O ERROR CODE BACK
PUSHJ P,F$ETXT ;TRANSLATE IT INTO TEXT
PJRST T$STRG ;PRINT IT AND RETURN
;PRINT I/O STATUS
;CALL: MOVE T1, I/O STATUS
; PUSHJ P,T$IOST
T$IOST: PUSH P,T1 ;SAVE STATUS
MOVEI T1,"(" ;OPEN PARENTHESIS
PUSHJ P,T$CHAR ;PRINT IT
MOVE T1,(P) ;GET STATUS BACK
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
MOVEI T1,")" ;CLOSE PARENTHESIS
PUSHJ P,T$CHAR ;PRINT IT
POP P,T1 ;RESTORE STATUS
POPJ P, ;RETURN
;PRINT A CRLF IF NOT AT THE LEFT MARGIN
T$NEWL: PUSH P,T1 ;SAVE T1
PUSH P,[EXP .TOFLM] ;FORCE LEFT MARGIN
PUSH P,[EXP -1] ;CONTROLLING TTY
POP P,(P) ;PHASE
POP P,(P) ; STACK
MOVSI T1,2 ;ARG BLOCK LENGTH
HRRI T1,1(P) ;AND ADDRESS
TRMOP. T1, ;FORCE LEFT MARGIN
JRST TCRLF1 ;FAILED, SO ASSUME CRLF NEEDED
POP P,T1 ;RESTORE T1
POPJ P, ;THEN DON'T NEED A NEW LINE
;PRINT A CRLF
T$CRLF: PUSH P,T1 ;SAVE T1
TCRLF1: XMOVEI T1,[BYTE(7) 15,12,0] ;<CR><LF>
PUSHJ P,T$STRG ;PRINT CRLF
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
;PRINT A FORM-FEED
T$FORM: PUSH P,T1 ;SAVE T1
MOVEI T1,14 ;GET <FF>
PUSHJ P,T$CHAR ;PRINT IT
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
;PRINT SEVERAL SPACES
T$SPAN: JUMPE T1,CPOPJ ;RETURN IF ZERO SPACES REQUESTED
PUSHJ P,T$SPAC ;PRINT ONE SPACE
SOJG T1,.-1 ;LOOP FOR SPECIFIED COUNT
POPJ P, ;RETURN
;PRINT AN "XWD" QUANTITY
T$XWD: PUSH P,T1 ;SAVE QUANTITY
HLRZS T1 ;ISOLATE LH
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
PUSHJ P,T$COMA ;PRINT A COMMA
PUSHJ P,T$COMA ;ONE MORE
HRRZ T1,(P) ;ISOLATE RH
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
;PRINT A "YES" OR "NO"
T$YN: PUSH P,T1 ;SAVE FLAG
TRNN T1,1 ;TEST
SKIPA T1,['NO ']
MOVSI T1,'YES'
PUSHJ P,T$SIXN ;PRINT SOMETHING
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL UNIT PROCESSING -- U$CLOS - CLOSE A CHANNEL
;CLOSE A CHANNEL
;CALL: MOVE U, UNIT BLOCK
; PUSHJ P,U$CLOS
; <RETURN>
U$CLOS: PUSH P,T1 ;SAVE T1
SKIPL T1,.UNCHN(U) ;GET CHANNEL NUMBER
RESDV. T1, ;RESET THE CHANNEL
JFCL ;IGNORE ERRORS
SETOM .UNCHN(U) ;INDICATE CHANNEL CLOSED
POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL UNIT PROCESSING -- U$OPEN - OPEN A CHANNEL
;OPEN A DISK FOR SUPER I/O
;CALL: MOVE U, UNIT BLOCK
; PUSHJ P,U$OPEN
; <NON-SKIP> ;OPEN FAILED, FATAL ERRROR ISSUED
; <SKIP> ;CHANNEL AVAILABLE FOR I/O
U$OPEN: PUSH P,T1 ;SAVE T1
SKIPL .UNCHN(U) ;CHANNEL ALREADY OPENED?
JRST UOPEN3 ;THEN JUST DO BOOKKEEPING
PUSH P,U ;SAVE U
MOVN U,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS U ;PUT IN LH
HRRI U,.DFUNI(D) ;MAKE AN AOBJN POINTER
UOPEN1: PUSHJ P,U$CLOS ;CLOSE CHANNEL
ADDI U,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN U,UOPEN1 ;LOOP FOR ALL UNIT BLOCKS
POP P,U ;RESTORE U
MOVEI T1,.UNNAM(U) ;POINT TO NAME
HRLI T1,1 ;1-WORD ARGUMENT BLOCK
DSKCHR T1,UU.PHY ;READ DISK CHARACTERISTICS
JRST UOPNE1 ;FAILED
LDB T1,[POINTR (T1,DC.TYP)] ;GET ARGUMENT TYPE
CAIE T1,.DCTPU ;PHYSICAL UNIT?
JRST UOPNE1 ;NO
UOPEN2: MOVEI T1,DSKCHN ;CHANNEL TO USE
RESDV. T1, ;CLEAN UP
JFCL ;IGNORE ERRORS
MOVE T1,[UU.PHS+.IODMP] ;PHYSICAL I/O, DUMP MODE
HRRZM T1,.UNIOM(U) ;SAVE OPEN BITS RESETTING I/O STATUS
PUSH P,T1 ;SAVE OPEN BLOCK MODE WORD
PUSH P,.UNNAM(U) ;DISK NAME
PUSH P,[EXP 0] ;NO BUFFER RING HEADERS
OPEN DSKCHN,-2(P) ;OPEN THE DEVICE
TDZA T1,T1 ;FAILED
MOVNI T1,1 ;SUCCESS
POP P,(P) ;TRIM
POP P,(P) ; STACK
POP P,(P) ; ...
JUMPE T1,UOPNE2 ;CHECK FOR ERRORS
MOVEI T1,DSKCHN ;GET CHANNEL
MOVEM T1,.UNCHN(U) ;SAVE CHANNEL
UOPEN3: SETZM .UNIOC+1(U) ;TERMINATE I/O COMMAND LIST
SETOM .UNBLK(U) ;NO BLOCK NUMBER YET
POP P,T1 ;RESTORE T1
JRST CPOPJ1 ;RETURN
UOPNE1: MOVE T1,.UNNAM(U) ;GET DEVICE NAME
FATAL (DND,UOPNEX,<Device is not a physical disk unit>,T$SIXN)
UOPNE2: MOVE T1,.UNNAM(U) ;GET DEVICE NAME
FATAL (OPF,UOPNEX,<OPEN failed for >,T$SIXN)
UOPNEX: POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
SUBTTL UNIT PROCESSING -- U$POSI - POSITION FOR I/O
;THIS ROUTINE MUST BE CALLED ONLY AFTER ALL I/O HAS BEEN SETUP
;CALL: MOVE U, UNIT BLOCK
; PUSHJ P,U$POSI
; <NON-SKIP> ;NO PRIVILEGES
; <SKIP> ;POSITIONED AND READY FOR I/O
U$POSI: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,.UNPOS(U) ;GET DESIRED BLOCK NUMBER
MOVE P2,.UNBLK(U) ;GET CURRENT BLOCK NUMBER
CAMN P1,P2 ;ALREADY POSITIONED?
JRST CPOPJ1 ;YES
MOVE P2,.UNCHN(U) ;GET CHANNEL NUMBER
DPB P2,[POINTR (P1,SU.SCH)] ;SAVE IT
MOVSI P2,(UN.OUT) ;BIT TO TEST
TDNE P2,.UNFLG(U) ;DOING OUTPUT?
TLO P1,(SU.SOT) ;YES
MOVE P2,P1 ;MAKE A COPY
SUSET. P1, ;POSITION FOR I/O
SKIPA ;FAILED
JRST CPOPJ1 ;DONE
CAME P1,P2 ;AC UNCHANGED (OLD MONITOR)?
FATAL (NPV,,<No privileges to perform super I/O>,)
MOVSI P2,(UN.OUT) ;BIT TO TEST
TDNE P2,.UNFLG(U) ;GET DIRECTION OF I/O
SKIPA P1,[USETO @.UNPOS(U)] ;OUTPUT
MOVE P1,[USETI @.UNPOS(U)] ;INPUT
MOVEI P2,.UNCHN(U) ;GET CHANNEL
DPB P2,[POINT 4,P1,12] ;COMPLETE THE INSTRUCTION
XCT P1 ;POSITION
JRST CPOPJ1 ;RETURN
SUBTTL UNIT PROCESSING -- U$READ/U$WRIT - READ & WRITE
;READ OR WRITE THE DISK, POSITIONING IF NECESSARY
;CALL: MOVE U, UNIT BLOCK
; MOVE T1, DESIRED BLOCK NUMBER
; MOVE T2, IOWD
; PUSHJ P,U$READ/U$WRIT
; <NON-SKIP> ;INPUT FAILED
; <SKIP> ;BUFFER FILLED
U$READ: PUSHJ P,U$OPEN ;MAKE SURE A CHANNEL IS OPENED
POPJ P, ;PROPAGATE ERROR BACK
PUSH P,T1 ;SAVE T1
MOVSI T1,(UN.OUT) ;GET OUTPUT FLAG
ANDCAB T1,.UNFLG(U) ;CLEAR IT
JRST RDWT1 ;ONWARD
U$WRIT: PUSHJ P,U$OPEN ;MAKE SURE A CHANNEL IS OPENED
POPJ P, ;PROPAGATE ERROR BACK
PUSH P,T1 ;SAVE T1
MOVSI T1,(UN.OUT) ;GET OUTPUT FLAG
IORB T1,.UNFLG(U) ;SET IT
RDWT1: EXCH T1,(P) ;SAVE BITS AND RETRIEVE POSITION
MOVEM T1,.UNPOS(U) ;SET DESIRED BLOCK NUMBER
MOVEM T2,.UNIOC(U) ;STORE IOWD
POP P,T1 ;GET BITS BACK
PUSHJ P,U$POSI ;POSITION FOR I/O
POPJ P, ;FAILED
MOVSI T2,(UN.OFL) ;GET THE OFF-LINE BIT
ANDCAM T2,.UNFLG(U) ;CLEAR IT
TLNE T1,(UN.OUT) ;CHECK DIRECTION OF I/O
SKIPA T2,[OUT .UNIOC(U)] ;OUTPUT
MOVE T2,[IN .UNIOC(U)] ;INPUT
MOVE T1,.UNCHN(U) ;GET CHANNEL
DPB T1,[POINT 4,T2,12] ;COMPLETE THE INSTRUCTION
RDWTPC: XCT T2 ;DO I/O
TDZA T2,T2 ;GOOD RETURN
MOVNI T2,1 ;REMEMBER FAILURE
PUSH P,T2 ;SAVE FLAG
MOVE T2,[GETSTS .UNIOS(U)]; TO READ STATUS
MOVE T1,.UNCHN(U) ;GET CHANNEL
DPB T1,[POINT 4,T2,12] ;COMPLETE THE INSTRUCTION
XCT T2 ;READ I/O STATUS
POP P,T2 ;GET FLAG BACK
PUSH P,.UNFLG(U) ;SAVE FLAGS
MOVSI T1,(UN.NER) ;GET "IGNORE ERROR" FLAG
ANDCAM T1,.UNFLG(U) ;CLEAR FOR NEXT TIME
POP P,T1 ;RETRIEVE OLD FLAG WORD
JUMPL T2,RDWT3 ;DON'T UPDATE NEW POSITION ON ERRORS
HLRE T1,.UNIOC(U) ;GET NUMBER OF WORDS TRANSFERED
MOVMS T1 ;MAKE POSITIVE
ADDI T1,BLKSIZ-1 ;ROUND UP
IDIVI T1,BLKSIZ ;CONVERT TO BLOCKS
ADD T1,.UNPOS(U) ;PLUS THE STARTING POSITION
MOVEM T1,.UNBLK(U) ;REMEMBER DISK POSITION FOR NEXT TIME
JRST CPOPJ1 ;RETURN
RDWT3: MOVE T2,.UNCHN(U) ;GET CHANNEL NUMBER
LSH T2,23 ;POSITION TO THE PROPER FIELD
TLO T2,(SETSTS) ;INCLUDE OPCODE
IOR T2,.UNIOM(U) ;AND THE I/O MODE
XCT T2 ;RESET I/O STATUS FOR NEXT TIME
TLNE T1,(UN.NER) ;IGNORING ERRORS?
POPJ P, ;YES--THEN KEEP QUIET
MOVSI T1,(UN.OUT) ;BIT TO TEST
TDNE T1,.UNFLG(U) ;CHECK DIRECTION OF I/O
WARN (OER,CPOPJ,<Output error >,RDWT4)
WARN (IER,CPOPJ,<Input error >,RDWT4)
RDWT4: MOVE T1,.UNIOS(U) ;GET STATUS
PUSHJ P,T$IOST ;PRINT IT
MOVEI T1,[ASCIZ / on /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,.UNNAM(U) ;GET DEVICE NAME
PUSHJ P,T$SIXN ;PRINT IT
MOVEI T1,[ASCIZ /, block /]
PUSHJ P,T$STRG ;PRINT TEXT
MOVE T1,.UNBLK(U) ;BLOCK NUMBER
PJRST T$DECW ;PRINT IT AND RETURN
SUBTTL AC SAVE CO-ROUTINES
;SAVE P1
SAVE1: PUSH P,P1 ;SAVE P1
PUSHJ P,@-1(P) ;CALL THE CALLER
SKIPA ;NON-SKIP RETURN
AOS -2(P) ;ADJUST RETURN PC
JRST RES1 ;GO RESTORE
;SAVE P1 AND P2
SAVE2: PUSH P,P1 ;SAVE P1
PUSH P,P2 ;SAVE P2
PUSHJ P,@-2(P) ;CALL THE CALLER
SKIPA ;NON-SKIP RETURN
AOS -3(P) ;ADJUST RETURN PC
JRST RES2 ;GO RESTORE
;SAVE P1, P2 AND P3
SAVE3: PUSH P,P1 ;SAVE P1
PUSH P,P2 ;SAVE P2
PUSH P,P3 ;SAVE P3
PUSHJ P,@-3(P) ;CALL THE CALLER
SKIPA ;NON-SKIP RETURN
AOS -4(P) ;ADJUST RETURN PC
JRST RES3 ;GO RESTORE
;SAVE P1, P2, P3 AND P4
SAVE4: PUSH P,P1 ;SAVE P1
PUSH P,P2 ;SAVE P2
PUSH P,P3 ;SAVE P3
PUSH P,P4 ;SAVE P4
PUSHJ P,@-4(P) ;CALL THE CALLER
SKIPA ;NON-SKIP RETURN
AOS -5(P) ;ADJUST RETURN PC
RES4: POP P,P4 ;RESTORE P4
RES3: POP P,P3 ;RESTORE P3
RES2: POP P,P2 ;RESTORE P2
RES1: POP P,P1 ;RESTORE P1
POP P,(P) ;PHASE STACK
POPJ P, ;RETURN
;SAVE T1, T2, T3 AND T4
SAVT: PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
PUSH P,T3 ;SAVE T3
PUSH P,T4 ;SAVE T4
PUSHJ P,@-4(P) ;CALL THE CALLER
SKIPA ;NON-SKIP RETURN
AOS -5(P) ;ADJUST RETURN PC
POP P,T4 ;RESTORE T4
POP P,T3 ;RESTORE T3
POP P,T2 ;RESTORE T2
POP P,T1 ;RESTORE T1
POP P,(P) ;PHASE STACK
POPJ P, ;RETURN
;POPULAR RETURNS
TPOPJ1: AOS -1(P) ;SKIP
TPOPJ: POP P,T1 ;RESTORE T1
POPJ P, ;RETURN
CPOPJ1: AOS (P) ;SKIP
CPOPJ: POPJ P, ;RETURN
SUBTTL FILE COPYING ROUTINES -- CPYBLK - SETUP UUO BLOCKS
CPYBLK: XMOVEI P2,CPYDEV ;POINT TO OPEN BLOCK
;SET UP OPEN BLOCK
CPYBL1: MOVEI T1,.IOIMG ;IMAGE MODE
MOVEM T1,.OPMOD(P2)
MOVE T1,.SBDEV(P1) ;DEVICE
MOVEM T1,.OPDEV(P2)
MOVE T2,[CPYBRH,,CPYBRH] ;BUFFER RING HEADER
MOVEM T2,.OPBUF(P2) ;FIXUP UP LATER
;SET UP LOOKUP/ENTER BLOCK
CPYBL2: XMOVEI P2,CPYLEB ;POINT TO LOOKUP/ENTER BLOCK
MOVSI T1,0(P2) ;START ADDR
HRRI T1,1(P2) ;MAKE A BLT POINTER
SETZM (P2) ;CLEAR FIRST WORD
BLT T1,.RBMAX-1(P2) ;CLEAR ENTIRE BLOCK
MOVEI T1,.RBMAX ;BLOCK LENGTH
MOVEM T1,.RBCNT(P2)
MOVEI T1,CPYPTH ;PATH BLOCK ADDRESS
MOVSI T2,(SB.DIR) ;BIT TO TEST
TDNE T2,.SBFLG(P1) ;WAS A DIRECTORY SPECIFIED?
MOVEM T1,.RBPPN(P2) ;YES
MOVE T1,.SBNAM(P1) ;FILE NAME
MOVEM T1,.RBNAM(P2)
HLLZ T1,.SBEXT(P1) ;EXTENSION
MOVEM T1,.RBEXT(P2)
;SET UP PATH BLOCK
CPYBL3: XMOVEI P2,CPYPTH ;POINT TO PATH BLOCK
MOVSI T1,0(P2) ;START ADDR
HRRI T1,1(P2) ;MAKE A BLT POINTER
SETZM (P2) ;CLEAR FIRST WORD
BLT T1,.PTMAX-1(P2) ;CLEAR ENTIRE BLOCK
ADDI P2,.PTPPN ;OFFSET TO PPN WORD
MOVSI T1,-5
HRRI T1,.SBDIR(P1) ;AOBJN POINTER TO PATH
CPYBL4: MOVE T2,(T1) ;GET A WORD
MOVEM T2,(P2) ;PUT A WORD
AOS P2 ;ADVANCE POINTER
AOS T1 ;ACCOUNT FOR TWO WORD ENTRIES
AOBJN P2,CPYBL4 ;LOOP THROUGH PATH
POPJ P, ;RETURN
SUBTTL FILE COPYING ROUTINES -- CPYCLS - CLOSE FILE
CPYRST: MOVEI T1,CPYCHN ;GET CHANNEL NUMBER
RESDV. T1, ;RESET THE CHANNEL
JFCL ;THAT'S OK
JRST CPYCL1 ;ENTER CLEANUP CODE
CPYCLS: CLOSE CPYCHN, ;CLOSE OFF THE CHANNEL
RELEAS CPYCHN, ;...
CPYCL1: SETZM CPYOPF ;MARK FILE CLOSED
SETZB T1,T2 ;CLEAR ACS
EXCH T1,CPYMEM+0 ;GET BUFFER SIZE
EXCH T2,CPYMEM+1 ;AND ADDRESS
SKIPE T1 ;ALREADY GIVEN BACK?
PUSHJ P,M$GIVW ;RELEASE CORE
POPJ P, ;RETURN
SUBTTL FILE COPYING ROUTINES -- CPYCMD - READ FILESPECS
;ROUTINE TO READ OUTPUT AND INPUT FILESPECS FOR A COPY
;CALL: MOVE T1, OUTPUT DEFAULT BLOCK
; MOVE T2, INPUT DEFAULT BLOCK
; PUSHJ P,CPYCMD
; <NON-SKIP> ;SYNTAX ERRORS, ETC.
; <SKIP> ;OUTPUT AND INPUT SPECS SET UP
;
;NOTE THAT IN PLACE OF THE SPECIFIED SCAN BLOCKS A ZERO INDICATES
;THERE IS NO DEFAULT SCAN BLOCK
CPYCMD: PUSHJ P,SAVE3 ;SAVE SOME ACS
MOVE P1,T1 ;GET OUTPUT DEFAULT
MOVE P2,T2 ;AND INPUT DEFAULT
MOVE T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;INITIALIZE IT
MOVE T1,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,C$ZFIL ;INITIALIZE IT
PUSHJ P,C$CEOL ;AT END OF LINE?
JRST CPYCM1 ;NO
SETZ P3, ;TERMINATOR IS EOL
PUSHJ P,CPDOUT ;DO OUTPUT DEFAULTING
PUSHJ P,CPDINP ;DO INPUT DEFAULTING
JRST CPYCM3 ;AND FINISH UP
;READ OUTPUT FILESPEC
CPYCM1: PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
MOVSI T3,(SB.WLD) ;BIT TO TEST
TDNE T3,.SBFLG(T1) ;WILDCARDED SPEC?
FATAL (WOI,CPOPJ,<Wildcarded output filespec is illegal>,T$FILE)
MOVE P3,T2 ;SAVE TERMINATOR
MOVSI T3,(T1) ;GET RETURNED SCAN BLOCK
HRR T3,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
HRRZ T4,T3 ;POINT TO DESTINATION
ADD T4,.DFSBL(D) ;COMPUTE ENDING ADDRESS
BLT T3,-1(T4) ;COPY SCAN BLOCK
PUSHJ P,CPDOUT ;DO OUTPUT DEFAULTING
;READ INPUT FILESPEC
CPYCM2: CAIE P3,"=" ;OUTPUT FILE?
PJRST C$EILD ;ILLEGAL DELIMITER
PUSHJ P,C$SKIP ;SKIP LEADING TABS AND SPACES
PUSHJ P,C$FILE ;READ A FILESPEC
POPJ P, ;SYNTAX ERROR
MOVSI T3,(SB.WLD) ;BIT TO TEST
TDNE T3,.SBFLG(T1) ;WILDCARDED SPEC?
FATAL (WOI,CPOPJ,<Wildcarded output filespec is illegal>,T$FILE)
MOVSI T3,(T1) ;GET RETURNED SCAN BLOCK
HRR T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
HRRZ T4,T3 ;POINT TO DESTINATION
ADD T4,.DFSBL(D) ;COMPUTE ENDING ADDRESS
BLT T3,-1(T4) ;COPY SCAN BLOCK
PUSHJ P,CPDINP ;DO INPUT DEFAULTING
CPYCM3: PUSHJ P,C$CEOL ;CHECK FOR EOL
PJRST C$EEOL ;ERROR AT EOL
MOVE T1,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
SKIPGE P1 ;OUTPUT SPEC WANTED?
SETZ T1, ;NO
MOVE T2,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T2,(D) ;RELOCATE
SKIPGE P2 ;INPUT SPEC WANTED?
SETZ T2, ;NO
JRST CPOPJ1 ;RETURN
;INPUT SPEC DEFAULTING
CPDINP: HRRZ T1,P2 ;POINT TO DEFAULT INPUT BLOCK
JUMPE T1,CPOPJ ;RETURN IF NO DEFAULT SPEC
HLRZ T2,P2 ;GET ITS LENGTH
MOVE T3,.DFINP(D) ;GET OFFSET TO INPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
PJRST C$DFIL ;APPLY DEFAULTS AND RETURN
;OUTPUT SPEC DEFAULTING
CPDOUT: HRRZ T1,P1 ;POINT TO DEFAULT OUTPUT BLOCK
JUMPE T1,CPOPJ ;RETURN IF NO DEFAULT SPEC
HLRZ T2,P1 ;GET ITS LENGTH
MOVE T3,.DFOUT(D) ;GET OFFSET TO OUTPUT SCAN BLOCK
ADDI T3,(D) ;RELOCATE
PJRST C$DFIL ;APPLY DEFAULTS AND RETURN
SUBTTL FILE COPYING ROUTINES -- CPYENT - CREATE OUTPUT FILE
;ROUTINE TO CREATE THE OUTPUT FILE
;CALL: MOVE T1, OUTPUT SCAN BLOCK
; PUSHJ P,CPYENT
; <NON-SKIP> ;FAILED, ERROR MESSAGE ISSUED
; <SKIP> ;OPENED AND READY FOR I/O
CPYENT: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,T1 ;COPY SCAN BLOCK ADDRESS
SETZM CPYMEM+0 ;NO BUFFERS
SETZM CPYMEM+1 ; ALLOCATED YET
SETZM CPYOPF ;FILE NOT OPENED YET
PUSHJ P,CPYFSC ;FIX UP SCAN BLOCK
POPJ P, ;FAILED
PUSHJ P,CPYBLK ;SET UP OPEN/ENTER/PATH BLOCKS
HLLZS CPYDEV+.OPBUF ;DOING OUTPUT
MOVE T1,CPYDEV+.OPDEV ;INCASE OF ERROR
OPEN CPYCHN,CPYDEV ;OPEN DEVICE
FATAL (COD,CPOPJ,<Cannot open device >,T$SIXN)
MOVE T1,P1 ;INCASE OF ERROR
ENTER CPYCHN,CPYLEB ;CREATE FILE
FATAL (COF,CPYRST,<Cannot create output file >,T$FILE)
MOVEI T1,CPYCHN ;GET CHANNEL
PUSHJ P,GETDCH ;READ DISK CHARACTERISTICS
TDZA T2,T2 ;SHOULDN'T FAIL
MOVE T2,DCHBLK+.DCSNM ;PICK UP STRUCTURE NAME
MOVEM T2,.SBDEV(P1) ;UPDATE
MOVE T1,P1 ;COPY SCAN BLOCK ADDRESS
CAMN T2,.DFSTR(D) ;SAME AS TARGET STRUCTURE?
FATAL (OSI,CPYRST,<Output to selected structure is illegal; >,T$FILE)
MOVEI T2,T3 ;ARG BLOCK ADDRESS
MOVE T3,CPYDEV+.OPMOD ;GET MODE WORD
MOVEI T4,CPYCHN ;AND CHANNEL NUMBER
DEVSIZ T2, ;READ BUFFER SIZE
FATAL (CBS,CPYRST,<Cannot determine buffer size for >,T$FILE)
HRRZ T1,T2 ;COPY BUFFER SIZE
HLRZS T2 ;ISOLATE DEFAULT NUMBER OF BUFFERS
IMULI T1,(T2) ;COMPUTE TOTAL WORDS NEEDED
PUSHJ P,M$GETW ;ALLOCATE CORE
MOVEM T1,CPYMEM+0 ;SAVE WORD COUNT
MOVEM T2,CPYMEM+1 ;AND ADDRESS
PUSH P,JOBFF ;SAVE FIRST FREE
MOVEM T2,JOBFF ;BUILD BUFFERS HERE
OUTBUF CPYCHN, ;...
POP P,JOBFF ;RESTORE JOBFF
SETOM CPYOPF ;MARK FILE OPENED
JRST CPOPJ1 ;RETURN
SUBTTL FILE COPYING ROUTINES -- CPYFSC - FIXUP SCAN BLOCK
;DO SCAN BLOCK FIXUPS
;CALL: MOVE P1, SCAN BLOCK ADDRESS
; PUSHJ P,CPYFSC
; <NON-SKIP> ;ILLEGAL DEVICE, MESSAGE ISSUED
; <SKIP> ;SUCCESS
CPYFSC: MOVE P2,.SBFLG(P1) ;PICK UP SCAN BLOCK FLAGS
PUSHJ P,CPFDEV ;DO DEVICE FIXUPS
POPJ P, ;ILLEGAL DEVICE
PUSHJ P,FSCUFD ;DO UFD FIXUPS
PUSHJ P,FSCPPN ;DO PPN FIXUPS
PUSHJ P,FSCPTH ;DO PATH FIXUPS
MOVEM P2,.SBFLG(P1) ;UPDATE FLAGS
JRST CPOPJ1 ;RETURN
CPFDEV: MOVE T1,.SBDEV(P1) ;GET DEVICE
MOVE T2,.SBDVM(P1) ;AND MASK
CAMN T1,T2 ;MATCH EACH OTHER (LOOKING FOR ZERO)?
JUMPE T1,CPFDE1 ;OK IF NOTHING SPECIFIED
AOSE T2 ;SKIP IF NOT WILDCARDED
FATAL (WDI,CPOPJ,<Wildcarded device illegal; >,T$SIXN)
MOVSS T1 ;SWAP HALVES
CAIE T1,'D ' ;ABBREVIATION
CAIN T1,'DS ' ; FOR DSK?
CPFDE1: MOVEI T1,'DSK' ;YES
MOVSS T1 ;ELSE SWAP HALVES BACK
CAMN T1,.DFSTR(D) ;MATCH STRUCTURE?
CPFDE2: FATAL (SSI,CPOPJ,<Selected structure illegal; >,T$SIXN)
MOVN T2,.DFSTN(D) ;GET -VE UNITS IN STRUCTURE
HRLZS T2 ;PUT IN LH
HRRI T2,.DFUNI(D) ;MAKE AN AOBJN POINTER
CPFDE3: CAMN T1,.UNLOG(U) ;LOGICAL UNIT NAME?
JRST CPFDE2 ;YES--ERROR
ADDI T2,.UNLEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN T2,CPFDE3 ;TRY ALL UNIT BLOCKS
SETZ T2, ;DON'T KNOW THE PPN
PUSHJ P,D$EDVF ;SEARCH THE ERSATZ DEVICE TABLE
JRST CPFDE4 ;USE WHAT WE WERE GIVEN
MOVSI T1,'DSK' ;CHANGE TO GENERIC DSK
MOVEM T2,.SBDIR(P1) ;SET PPN
SETOM .SBDIM(P1) ;AND MASK
TLO P2,(SB.PPN) ;REMEMBER PPN WAS ALREADY FIXED UP
TLNN P2,(SB.DIR) ;SOME SORT OF DIRECTORY SPECIFIED?
TLNN P2,(SB.DPT) ;NO--DID USER TYPE FOO:[-]
TLO P2,(SB.DIR) ;OVERRIDE ENTIRE DIRECTORY
CPFDE4: MOVEM T1,.SBDEV(P1) ;UPDATE DEVICE INCASE IT CHANGED
SETOM .SBDVM(P1) ;SET NON-WILDCARDED DEVICE MASK
TLO P2,(SB.DEV) ;SAY DEVICE SPECIFIED
JRST CPOPJ1 ;RETURN GOODNESS
SUBTTL FILE COPYING ROUTINES -- CPYFEX - FIXUP FILENAME & EXTENSION
;ROUTINE TO DEFAULT FILENAME & EXTENSION FROM ONE SCAN BLOCK
;TO ANOTHER, CALLED AFTER THE LOOKUP OR ENTER
;CALL: MOVE T1, SOURCE SCAN BLOCK
; MOVE T2, DESTINATION SCAN BLOCK
; PUSHJ P,CPYFEX
; <RETURN>
CPYFEX: MOVE T3,.SBFLG(T2) ;GET DESTINATION FLAGS
MOVE T4,.SBNAM(T1) ;GET FILENAME AFTER LOOKUP/ENTER
TLON T3,(SB.NAM) ;FILENAME SPECIFIED?
MOVEM T4,.SBNAM(T2) ;NO--SET IT NOW
SETOM .SBNMM(T2) ;SET MASK
HLLZ T4,.SBEXT(T1) ;GET EXTENSION AFTER LOOKUP/ENTER
TLON T3,(SB.EXT) ;EXTENSION SPECIFIED?
HLLOM T4,.SBEXT(T2) ;NO--SET IT NOW (MASK TOO)
MOVEM T3,.SBFLG(T2) ;UPDATE DESTINATION FLAGS
POPJ P, ;RETURN
SUBTTL FILE COPYING ROUTINES -- CPYFLP - FLIP SCAN BLOCKS
;ROUTINE TO SWAP THE CONTENTS OF TWO SCAN BLOCKS
;CALL: MOVE T1, FIRST SCAN BLOCK ADDRESS
; MOVE T2, SECOND SCAN BLOCK ADDRESS
; PUSHJ P,CPYFLP
; <RETURN>
CPYFLP: PUSH P,T1 ;SAVE T1
PUSH P,T2 ;SAVE T2
MOVE T3,.DFSBL(D) ;GET SCAN BLOCK LENGTH
CPYFL1: MOVE T4,(T1) ;GET A WORD
EXCH T4,(T2) ;SWAP
MOVEM T4,(T1) ;PUT A WORD
ADDI T1,1 ;ADVANCE STORAGE
ADDI T2,1 ;...
SOJG T3,CPYFL1 ;LOOP FOR ALL WORDS
POP P,T2 ;RESTORE T2
JRST TPOPJ ;RESTORE T1 AND RETURN
SUBTTL FILE COPYING ROUTINES -- CPYLKP - LOOKUP A FILE
;ROUTINE TO FIND AN EXISTING FILE
;CALL: MOVE T1, SCAN BLOCK ADDRESS
; PUSHJ P,CPYLKP
; <NON-SKIP> ;FILE NOT FOUND, ERROR MESSAGE ISSUED
; <SKIP> ;READY FOR I/O
CPYLKP: PUSHJ P,SAVE2 ;SAVE P1 AND P2
MOVE P1,T1 ;COPY SCAN BLOCK ADDRESS
SETZM CPYMEM+0 ;NO BUFFERS
SETZM CPYMEM+1 ; ALLOCATED YET
SETZM CPYOPF ;FILE NOT OPENED YET
PUSHJ P,CPYFSC ;FIX UP SCAN BLOCK
POPJ P, ;FAILED
PUSHJ P,CPYBLK ;SET UP OPEN/ENTER/PATH BLOCKS
HRRZS CPYDEV+.OPBUF ;DOING INPUT
MOVE T1,CPYDEV+.OPDEV ;INCASE OF ERROR
OPEN CPYCHN,CPYDEV ;OPEN DEVICE
FATAL (COD,CPOPJ,<Cannot open device >,T$SIXN)
MOVE T1,P1 ;INCASE OF ERROR
LOOKUP CPYCHN,CPYLEB ;FIND THE FILE
FATAL (CLF,CPYRST,<Cannot LOOKUP input file >,T$FILE)
MOVEI T1,CPYCHN ;GET CHANNEL
PUSHJ P,GETDCH ;READ DISK CHARACTERISTICS
TDZA T2,T2 ;SHOULDN'T FAIL
MOVE T2,DCHBLK+.DCSNM ;PICK UP STRUCTURE NAME
MOVEM T2,.SBDEV(P1) ;UPDATE
MOVE T1,P1 ;COPY SCAN BLOCK ADDRESS
CAMN T2,.DFSTR(D) ;SAME AS TARGET STRUCTURE?
FATAL (ISI,CPYRST,<Input from selected structure is illegal; >,T$FILE)
MOVEI T2,T3 ;ARG BLOCK ADDRESS
MOVE T3,CPYDEV+.OPMOD ;GET MODE WORD
MOVEI T4,CPYCHN ;AND CHANNEL NUMBER
DEVSIZ T2, ;READ BUFFER SIZE
FATAL (CBS,CPYRST,<Cannot determine buffer size for >,T$FILE)
HRRZ T1,T2 ;COPY BUFFER SIZE
HLRZS T2 ;ISOLATE DEFAULT NUMBER OF BUFFERS
IMULI T1,(T2) ;COMPUTE TOTAL WORDS NEEDED
PUSHJ P,M$GETW ;ALLOCATE CORE
MOVEM T1,CPYMEM+0 ;SAVE WORD COUNT
MOVEM T2,CPYMEM+1 ;AND ADDRESS
PUSH P,JOBFF ;SAVE FIRST FREE
MOVEM T2,JOBFF ;BUILD BUFFERS HERE
INBUF CPYCHN, ;...
POP P,JOBFF ;RESTORE JOBFF
SETOM CPYOPF ;MARK FILE OPENED
JRST CPOPJ1 ;RETURN
SUBTTL FILE COPYING ROUTINES -- CPYRFS - READ RETURNED FILESPEC
;ROUTINE TO READ THE RETURNED FILESPEC
;CALL: MOVE T1, SCAN BLOCK ADDRESS
; PUSHJ P,CPYRFS
; <RETURN>
CPYRFS: PUSHJ P,SAVE1 ;SAVE P1
MOVE P1,T1 ;SAVE SCAN BLOCK ADDRESS
MOVE T1,[2,,T2] ;SET UP UUO AC
MOVE T2,[CPYCHN,,.FOFIL] ;CHANNEL,,FUNCTION
MOVE T3,[.FOFMX,,CPYFIL] ;LENGTH,,BLOCK ADDRESS
FILOP. T1, ;READ THE ACTUAL FILESPEC
JRST CPYRF1 ;OLD MONITOR
MOVE T1,CPYFIL+.FOFDV ;GET DEVICE
MOVE T1,[-<.FOFMX+.FOFPP>,,CPYFIL+.FOFPP]
JRST CPYRF2 ;ENTER LOOP TO STORE PATH
CPYRF1: MOVEI T1,CPYCHN ;GET CHANNEL
PUSHJ P,GETDCH ;READ DISK CHARACTERISTICS
POPJ P, ;NOT A DISK
MOVE T1,[.PTMAX,,CPYPTH] ;SET UP UUO AC
MOVEI T2,CPYCHN ;GET I/O CHANNEL
MOVEM T2,CPYPTH ;SAVE IN PATH BLOCK
PATH. T1, ;READ PATH
POPJ P, ;GIVE UP
MOVE T1,[-<.PTMAX+.PTPPN>,,CPYPTH+.PTPPN]
MOVE T2,DCHBLK+.DCSNM ;PICK UP STRUCTURE NAME
CPYRF2: MOVEM T2,.SBDEV(P1) ;UPDATE SCAN BLOCK
SETOM .SBDVM(P1) ;SET MASK
MOVSI T2,(SB.DEV) ;GET A BIT
IORM T2,.SBFLG(P1) ;SAY DEVICE PRESENT
MOVEI T2,.SBDIR(P1) ;POINT TO START OF DIRECTORY
CPYRF3: MOVE T3,(T1) ;GET DIRECTORY COMPONENT
MOVEM T3,0(T2) ;STORE IT
SETOM 1(T2) ;SET MASK
ADDI T2,2 ;ADVANCE STORAGE
AOBJN T1,CPYRF3 ;LOOP FOR ALL COMPONENTS
SUBTTL FILE COPYING ROUTINES -- CPYSUM - PRINT SUMMARY
;ROUTINE TO PRINT THE SUMMARY FOLLOWING A SUCCESSFUL COPY
;CALL: PUSHJ P,CPYSUM
; <RETURN>
CPYSUM: PUSHJ P,T$SPAC ;SPAC OVER
MOVE T1,.DFOUT(D) ;GET OUTPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,T$FILE ;PRINT FILE
XMOVEI T1,[ASCIZ / = /]
PUSHJ P,T$STRG ;PRINT SEPARATOR
MOVE T1,.DFINP(D) ;GET INPUT SCAN BLOCK
ADDI T1,(D) ;RELOCATE
PUSHJ P,T$FILE ;PRINT FILESPEC
PJRST T$CRLF ;END LINE AND RETURN
SUBTTL MISCELLANEOUS ROUTINES -- BIT MAP HANDLING
;ROUTINE TO CLEAR OR SET BITS IN A MAP
;CALL: MOVE P1, BIT COUNT
; MOVE P2, AOBJN POINTER TO MAP
; MOVE P3, STARTING BIT
; MOVE P4, STOPCODE FLAG (0=OFF, 1=ON)
; PUSHJ P,BITCLR/BITSET
; <RETURN>
BITCLR: SKIPA T1,[TDNE P3,(P2)] ;CLEAR BITS
BITSET: SKIPA T1,[TDNN P3,(P2)] ;SET BITS
SKIPA T2,[ANDCAM P3,(P2)] ;CLEAR BITS
MOVE T2,[IORM P3,(P2)] ;SET BITS
BITCS1: JUMPE P4,BITSC2 ;CARE ABOUT PREVIOUS SETTING?
XCT T1 ;YES--IS BIT IN WRONG POSITION?
JRST BITSC2 ;NO
TDNE P3,(P2) ;MAKE POSITIVE TEST
STOPCD (BAO,<Bit already set to a 1>,)
STOPCD (BAZ,<Bit already set to a 0>,)
BITSC2: XCT T2 ;SET/CLEAR A BIT
TRNE P3,1 ;AT RIGHTMOST BIT?
AOBJP P2,CPOPJ ;END OF BIT MAP?
ROT P3,-1 ;SHIFT OVER ONE BIT
SOJG P1,BITCS1 ;LOOP FOR ALL BITS
POPJ P, ;RETURN
;ROUTINE TO FIND ONES OR ZEROS IN A BIT MAP
;CALL: MOVE P1, BIT COUNT
; MOVE P2, AOBJN POINTER TO BIT MAP
; MOVE P3, STARTING BIT
; PUSHJ P,BITONE/BITZER
; <NON-SKIP> ;NONE OR NOT ENOUGH AVAILABLE
; <SKIP> ;P1-P3 POINT TO START OF AVAILABLE BITS
BITONE: SKIPA T2,[TDNE P3,T2] ;TO FIND A ONE
BITZER: MOVE T2,[TDNN P3,T2] ;TO FIND A ZERO
PUSH P,P1 ;SAVE REQUESTED BIT COUNT
PUSH P,P2 ;SAVE AOBJN POINTER TO BIT MAP
PUSH P,P3 ;SAVE STARTING BIT
PUSH P,P4 ;SAVE P4
MOVE P4,T2 ;COPY INSTRUCTION
;FIND A STARTING POINT IN THE BIT MAP
BITOZ1: MOVE T2,(P2) ;GET WORD FROM BIT MAP
XCT P4 ;FOUND A STARTING POINT?
JRST BITOZ2 ;NO
TRNE P3,1 ;AT RIGHTMOST BIT?
AOBJP P2,BITOZ4 ;RETURN IF END OF BIT MAP
ROT P3,-1 ;SHIFT OVER ONE BIT
JRST BITOZ1 ;KEEP SEARCHING
;COUNT THE NUMBER OF AVAILABLE BITS
BITOZ2: MOVEM P2,-2(P) ;SAVE UPDATED AOBJN POINTER TO BIT MAP
MOVEM P3,-1(P) ;SAVE UPDATED STARTING BIT
MOVE P1,-3(P) ;COPY REQUESTED BIT COUNT
BITOZ3: MOVE T2,(P2) ;GET A WORD FROM BIT MAP
XCT P4 ;AVAILABLE?
SKIPA ;YES
JRST BITOZ1 ;NO--LOOK FOR ANOTHER STARTING POINT
TRNE P3,1 ;AT RIGHTMOST BIT?
AOBJP P2,BITOZ4 ;RETURN IF END OF BIT MAP
ROT P3,-1 ;SHIFT OVER ONE BIT
SOJG P1,BITOZ3 ;KEEP SEARCHING
AOS -4(P) ;SUCCESS
;RESTORE THE UPDATED POINTERS
BITOZ4: POP P,P4 ;RESTORE P4
POP P,P3 ;GET UPDATED STARTING BIT
POP P,P2 ;GET UPDATED AOBJN POINTER
POP P,P1 ;GET REQUESTED BIT COUNT
POPJ P, ;RETURN
SUBTTL MISCELLANEOUS ROUTINES -- DATE/TIME CONVERSION
;CONVERT FROM SMITHSONIAN UNIVERSAL DATE-TIME TO DECSYSTEM10 DATE-TIME.
;CALL: MOVE T1, UDT
; PUSHJ P,.CNTDT
;
;ON RETURN, T1:= TIME IN MILLISECONDS AND T2:= DECSYSTEM10 15 BIT DATE
;
;AC USAGE: T1-T4
;
;THIS ROUTINE WAS TAKEN FROM SCAN.MAC AND IS BASED ON IDEAS BY
;JOHN BARNABY, DAVID ROSENBERG, AND PETER CONKLIN.
.CNTDT: PUSH P,T1 ;SAVE TIME FOR LATER
JUMPL T1,CNTDT6 ;DEFEND AGAINST JUNK INPUT
HLRZ T1,T1 ;GET DATE PORTION (DAYS SINCE 1858)
RADIX 5+5 ;* NOTE WELL *
ADDI T1,<1857-1500>*365+<1857-1500>/4-<1857-1500>/100+<1857-1500>/400+31+28+31+30+31+30+31+31+30+31+17
;T1=DAYS SINCE JAN 1, 1501
IDIVI T1,400*365+400/4-400/100+400/400
;SPLIT INTO QUADRACENTURY
LSH T2,2 ;CONVERT TO NUMBER OF QUARTER DAYS
IDIVI T2,<100*365+100/4-100/100>*4+400/400
;SPLIT INTO CENTURY
IORI T3,3 ;DISCARD FRACTIONS OF DAY
IDIVI T3,4*365+1 ;SEPARATE INTO YEARS
LSH T4,-2 ;T4=NO DAYS THIS YEAR
LSH T1,2 ;T1=4*NO QUADRACENTURIES
ADD T1,T2 ;T1=NO CENTURIES
IMULI T1,100 ;T1=100*NO CENTURIES
ADDI T1,1501(T3) ;T1 HAS YEAR, T4 HAS DAY IN YEAR
MOVE T2,T1 ;COPY YEAR TO SEE IF LEAP YEAR
TRNE T2,3 ;IS THE YEAR A MULT OF 4?
JRST CNTDT0 ;NO--JUST INDICATE NOT A LEAP YEAR
IDIVI T2,100 ;SEE IF YEAR IS MULT OF 100
SKIPN T3 ;IF NOT, THEN LEAP
TRNN T2,3 ;IS YEAR MULT OF 400?
TDZA T3,T3 ;YES--LEAP YEAR AFTER ALL
CNTDT0: MOVEI T3,1 ;SET LEAP YEAR FLAG
;UNDER RADIX 10 **** NOTE WELL ****
CNTDT1: SUBI T1,1964 ;SET TO SYSTEM ORIGIN
IMULI T1,31*12 ;CHANGE TO SYSTEM PSEUDO DAYS
JUMPN T3,CNTDT2 ;IF NOT LEAP YEAR, PROCEED
CAIGE T4,31+29 ;LEAP YEAR--SEE IF BEYOND FEB 29
JRST CNTDT5 ;NO--JUST INCLUDE IN ANSWER
SOS T4 ;YES--BACK OFF ONE DAY
CNTDT2: MOVSI T2,-11 ;LOOP FOR 11 MONTHS
CNTDT3: CAMGE T4,MONTAB+1(T2) ;SEE IF BEYOND THIS MONTH
JRST CNTDT4 ;YES--GO FINISH UP
ADDI T1,31 ;NO--COUNT SYSTEM MONTH
AOBJN T2,CNTDT3 ;LOOP THROUGH NOVEMBER
CNTDT4: SUB T4,MONTAB(T2) ;GET DAYS IN THIS MONTH
CNTDT5: ADD T1,T4 ;INCLUDE IN FINAL RESULT
CNTDT6: EXCH T1,(P) ;SAVE ANSWER, GET TIME
TLZ T1,-1 ;CLEAR DATE
MUL T1,[24*60*60*1000] ;CONVERT TO MILLI-SEC.
ASHC T1,17 ;POSITION RESULT
POP P,T2 ;RECOVER DATE
POPJ P, ;RETURN
;UNDER RADIX 10 **** NOTE WELL ****
;CONVERT FROM DECSYSTEM10 DATE-TIME TO SMITHSONIAN UNIVERSAL DATE-TIME
;CALL: MOVE T1, TIME IN MILLISECONDS
; MOVE T2, DECSYSTEM10 15 BIT DATE
; PUSHJ P,.CNVDT
;
;ON RETURN, T1:= UDT OR -1 IF DATE BEYOND 27-SEP-2217
.CNVDT: PUSHJ P,SAVE1 ;PRESERVE P1
PUSH P,T1 ;SAVE TIME FOR LATER
IDIVI T2,12*31 ;T2=YEARS-1964
CAILE T2,2217-1964 ;SEE IF BEYOND 2217
JRST GETNW2 ;YES--RETURN -1
IDIVI T3,31 ;T3=MONTHS-JAN, T4=DAYS-1
ADD T4,MONTAB(T3) ;T4=DAYS-JAN 1
MOVEI P1,0 ;LEAP YEAR ADDITIVE IF JAN, FEB
CAIL T3,2 ;CHECK MONTH
MOVEI P1,1 ;ADDITIVE IF MAR-DEC
MOVE T1,T2 ;SAVE YEARS FOR REUSE
ADDI T2,3 ;OFFSET SINCE LEAP YEAR ISN'T COUNTED
IDIVI T2,4 ;HANDLE REGULAR LEAP YEARS
CAIE T3,3 ;SEE IF THIS IS LEAP YEAR
MOVEI P1,0 ;NO--WIPE OUT ADDITIVE
ADDI T4,<1964-1859>*365+<1964-1859>/4+<31-18>+31(T2)
;T4=DAYS BEFORE JAN 1,1964 +SINCE JAN 1
; +ALLOWANCE FOR ALL LEAP YRS SINCE 64
MOVE T2,T1 ;RESTORE YEARS SINCE 1964
IMULI T2,365 ;DAYS SINCE 1964
ADD T4,T2 ;T4=DAYS EXCEPT FOR 100 YR. FUDGE
HRREI T2,64-100-1(T1) ;T2=YEARS SINCE 2001
JUMPLE T2,GETNW1 ;ALL DONE IF NOT YET 2001
IDIVI T2,100 ;GET CENTURIES SINCE 2001
SUB T4,T2 ;ALLOW FOR LOST LEAP YEARS
CAIE T3,99 ;SEE IF THIS IS A LOST LEAP YEAR
GETNW1: ADD T4,P1 ;ALLOW FOR LEAP YEAR THIS YEAR
CAILE T4,^O377777 ;SEE IF TOO BIG
GETNW2: SETOM T4 ;YES--SET -1
POP P,T1 ;GET MILLISEC TIME
MOVEI T2,0 ;CLEAR OTHER HALF
ASHC T1,-17 ;POSITION
DIV T1,[24*60*60*1000] ;CONVERT TO 1/2**18 DAYS
CAMLE T2,[^D24*^D60*^D60*^D1000/2] ;OVER 1/2 TO NEXT?
ADDI T1,1 ;YES, SHOULD ACTUALLY ROUND UP
HRL T1,T4 ;INCLUDE DATE
GETNWX: POPJ P, ;RETURN
;UNDER RADIX 10 **** NOTE WELL ****
MONTAB: EXP 0,31,59,90,120,151,181,212,243,273,304,334,365
RADIX 4+4
SUBTTL MISCELLANEOUS ROUTINES -- GET DISK CHARACTERISTICS
;READ DISK CHARACTERISTICS
;CALL: MOVE T1, NAME
; PUSHJ P,GETDCH
; <NON-SKIP> ;FAILED
; <SKIP> ;T1 = TYPE & T2 = PHYSICAL UNIT NAME
GETDCH: PUSH P,T1 ;SAVE ARGUMENT
MOVE T1,[DCHBLK,,DCHBLK+1] ;SET UP BLT
SETZM DCHBLK ;CLEAR FIRST WORD
BLT T1,DCHBLK+.DCMAX-1 ;CLEAR ENTIRE BLOCK
POP P,DCHBLK+.DCNAM ;STORE ARGUMENT
MOVE T1,[.DCMAX,,DCHBLK] ;SET UP UUO AC
DSKCHR T1,UU.PHY ;READ DISK CHARACTERISTICS
SKIPA T1,DCHBLK+.DCNAM ;FAILED--RESTORE ARGUMENT
AOSA (P) ;SUCCESS
POPJ P, ;ERROR RETURN
LDB T1,[POINTR (T1,DC.TYP)] ;GET ARGUMENT TYPE
MOVE T2,DCHBLK+.DCUPN ;GET PHYSICAL DEVICE NAME
POPJ P, ;AND RETURN
SUBTTL MISCELLANEOUS ROUTINES -- PDP-11 STRING PROCESSING
;ROUTINE TO TRANSLATE A PDP-11 STRING TO ASCII
;CALL: MOVE T1, STRING ADDRESS
; MOVE T2, BYTE COUNT
; PUSHJ P,P11GET
; <RETURN> ;T1 := TRANSLATED STRING ADDRESS
P11GET: PUSHJ P,SAVE3 ;SAVE SOME ACS
MOVE P1,T1 ;COPY ADDRESS OF STRING
MOVN P2,T2 ;GET -VE BYTE COUNT
HRLZS P2 ;MAKE AN AOBJN POINTER
MOVE P3,[POINT 7,P11BUF] ;BYTE POINTER TO STORAGE
MOVE T1,[P11BUF,,P11BUF+1] ;SET UP BLT
SETZM P11BUF ;CLEAR FIRST WORD
BLT T1,P11BUF+P11SIZ-1 ;CLEAR BUFFER
P11GE1: HRRZ T3,P2 ;GET BYTE COUNT
IDIVI T3,4 ;GET WORD AND BYTE OFFSETS
MOVE T1,P11PTR(T4) ;COPY BYTE POINTER
ADDI T1,(T3) ;INDEX TO PROPER WORD
LDB T1,T1 ;GET CHARACTER
IDPB T1,P3 ;STORE IT
AOBJN P2,P11GE1 ;LOOP FOR ALL CHARACTERS
XMOVEI T1,P11BUF ;POINT TO TRANSLATION BUFFER
POPJ P, ;RETURN
P11PTR: POINT 7,(P1),17 ;BYTE 0
POINT 7,(P1),9 ;BYTE 1
POINT 7,(P1),35 ;BYTE 2
POINT 7,(P1),27 ;BYTE 3
;INTERRUPT HANDLING
INTLOC: MOVEM T1,INTSAV ;SAVE T1
MOVEM T2,INTSAV+1 ;SAVE T2
HLLZ T1,INTBLK+.ERCCL ;GET INTERRUPT CLASS BITS
TLZ T1,(ER.MSG) ;CLEAR MESSAGE SUPPRESSION BIT
JFFO T1,.+1 ;FIND FIRST BIT
JRST @INTTAB(T2) ;DISPATCH
;RETURN FROM INTERRUPT
INTRET: MOVE T1,INTBLK+.EROPC ;GET INTERRUPTING PC WORD
EXCH T1,INTSAV ;RESTORE T1
MOVE T2,INTSAV+1 ;RESTORE T2
SETZM INTBLK+.EROPC ;RE-ENABLE INTERRUPTS
JRSTF @INTSAV ;RETURN
;ILLEGAL INTERRUPTS
INTBAD: STOPCD (ILI,<Illegal interrupt >,E.ILI)
E.ILI: PUSHJ P,T$LPAR ;PRINT LEFT PARENTHESIS
HLRZ T1,INTBLK+.ERCCL ;GET LH
PUSHJ P,T$OCTW ;PRINT IT
PUSHJ P,T$COMA ;SEPARATE
PUSHJ P,T$COMA ;ONE MORE
HRRZ T1,INTBLK+.ERCCL ;GET RH
PUSHJ P,T$OCTW ;PRINT IT
MOVEI T1,[ASCIZ /) at PC /]
PUSHJ P,T$STRG ;PRINT TEXT
HRRZ T1,INTBLK+.EROPC ;GET OLD PC
JUSTIFY (R,6,"0",T$OCTW) ;PRINT IT
POPJ P, ;RETURN
INTTAB: REPEAT ^D29-^D18,<IFIW INTBAD>
IFIW INTEIJ ;(29) ERROR IN JOB
IFIW INTTLX ;(30) TIME LIMIT EXCEEDED
IFIW INTQEX ;(31) QUOTA EXHAUSTED
IFIW INTFUL ;(32) FILE STRUCTURE FULL
IFIW INTOFL ;(33) DISK UNIT OFFLINE
IFIW INTICC ;(34) CONTROL-C INTERCEPT
IFIW INTIDV ;(35) PROBLEM ON DEVICE
;GET INTERRUPTING DEVICE NAME
INTDEV: HRRZ T1,INTBLK+.ERCCL ;GET OFFENDING CHANNEL
DEVNAM T1, ;TRANSLATE TO DEVICE NAME
PUSHJ P,INTBAD ;SHOULD NEVER FAIL
POPJ P, ;RETURN
;ASK TO PROCEED
;HERE WHEN FILE ALREADY EXISTS
INTPRO: MOVEI T1,[ASCIZ /Proceed?/]
MOVEI T2,1 ;ASSUME "YES"
PUSHJ P,C$AYNQ ;ASK YES/NO QUESTION
JUMPE T2,REENTR ;JUMP IF "NO"
JRST INTRET ;ELSE RETURN
INTEIJ: STOPCD (EIJ,<Error in job>,)
INTTLX: STOPCD (TLX,<Time limit exceeded>,)
;QUOTA EXHAUSTED
INTQEX: PUSHJ P,INTDEV ;GET DEVICE NAME
WARN (QEX,INTPRO,<Quota exhausted on structure >,T$SIXN)
;STRUCTURE FULL
INTFUL: PUSHJ P,INTDEV ;GET DEVICE NAME
WARN (FUL,INTPRO,<Structure >,E..FUL)
E..FUL: PUSHJ P,T$SIXN ;PRINT STRUCTURE NAME
MOVEI T1,[ASCIZ / is full/]
PJRST T$STRG ;PRINT TEXT AND RETURN
;DEVICE OFFLINE
INTOFL: PUSHJ P,INTDEV ;GET DEVICE NAME
WARN (OFL,INTPRO,<Device >,E..OFL)
E..OFL: PUSHJ P,T$SIXN ;PRINT DEVICE NAME
MOVEI T1,[ASCIZ / offline/]
PJRST T$STRG ;PRINT TEXT AND RETURN
;CONTROL-C
INTICC: SKIPN CCTRAP ;OK TO EXIT ON CONTROL-C?
PUSHJ P,MONRET ;RETURN TO MONITOR
JRST INTRET ;THE FOOL TYPED CONTINUE
;PROBLEM ON DEVICE
INTIDV: PUSHJ P,INTDEV ;GET DEVICE NAME
WARN (POD,INTPRO,<Problem on device >,T$SIXN)
SUBTTL LITERAL POOL
LITS: LIT
LITEND:!
SUBTTL IMPURE STORAGE
CCTRAP: EXP -1 ;NON-ZERO IF NO EXIT ON CONTROL-C
DEBUGF: BLOCK 1 ;NON-ZERO IF DEBUGGING
INTBLK: XWD 4,INTLOC ;INTERCEPT BLOCK - INTERRUPT ADDRESS
EXP ER.ICC ;INTERCEPT BLOCK - CLASS BITS
EXP 0,0 ;INTERCEPT BLOCK - OLD & NEW PC
SAVFLG: EXP -1 ;FLAG INDICATING SYMBOL LOCS VALID
SAVBPT: BLOCK 1 ;SAVED COPY OF JOBBPT
SAVDDT: BLOCK 1 ;SAVED COPY OF JOBDDT
SAVSYM: BLOCK 1 ;SAVED COPY OF ORIGINAL JOBSYM
SAVUSY: BLOCK 1 ;SAVED COPY OF ORIGINAL JOBUSY
Z.BEG:! ;START OF AREA TO CLEAR ON STARTUP
PDL: BLOCK PDLSIZ ;PUSH DOWN LIST
INTSAV: BLOCK 2 ;TEMP STORAGE FOR INTERRUPTS
CNAME: BLOCK 1 ;ADDRESS OF FULL COMMAND NAME
FREPTR: BLOCK 1 ;FREE CORE LIST
LOWEND: BLOCK 1 ;END OF THE LOW SEGMENT
CRSHAC: BLOCK 20 ;STORAGE FOR ACS ON ERRORS
DDTGO: BLOCK 1 ;INSTRUCTION TO ENTER DDT
ERRSP1: BLOCK 1 ;SPECIAL SAVED COPY OF P1
ERRSUB: BLOCK 1 ;ADDITIONAL TYPEOUT SUBROUTINE
CMDTBL: BLOCK 1 ;ADDRESS OF COMMAND TABLES
CMDNAM: BLOCK 1 ;NAME TABLE
CMDPRC: BLOCK 1 ;PROCESSOR TABLE
CMDHLP: BLOCK 1 ;HELP TABLE
CMDNXT: BLOCK 1 ;ADDRESS OF NEXT COMMAND TABLE
CMDJST: BLOCK 3 ;JUSTIFICATION BLOCK FOR HELP
CMDDEF: BLOCK 1 ;DEFAULT STRING
CMDOPF: BLOCK 1 ;-1 IF OPTION DATA VALID
CMDOTB: BLOCK 1 ;OPTION TABLE
CMDOTY: BLOCK 1 ;OUTPUT ROUTINE
Z.CMDB:! ;START OF BLOCK TO ZERO
CMDAT6: BLOCK 1 ;SIXBIT ATOM
CMDATB: BLOCK <ATMWDS==4> ;ATOM BUFFER
CMDATC: BLOCK 1 ;BYTE COUNT FOR ATOM BUFFER
CMDATP: BLOCK 1 ;BYTE PONTER TO ATOM BUFFER
CMDCNV: BLOCK 1 ;NON-ZERO IF DOING CASE CONVERSION
CMDEOF: BLOCK 1 ;NON-ZERO IF EOF ENCOUNTERED
CMDEOL: BLOCK 1 ;NON-ZERO IF SEARCHING FOR EOL
CMDCTR: BLOCK 1 ;BYTE COUNT FOR COMMAND BUFFER
CMDBUF: BLOCK CMDWDS+1 ;COMMAND BUFFER
CMDMSK: BLOCK 1 ;SIXBIT MASK
CMDNUL: BLOCK 1 ;ZERO IF A NO QUANTITY TYPED
CMDPMT: BLOCK 1 ;PROMPT STRING ADDRESS
CMDPTR: BLOCK 1 ;BYTE POINTER TO COMMAND BUFFER
CMDQUO: BLOCK 1 ;QUOTE FLAG
CMDTTY: BLOCK 1 ;NON-ZERO IF READING FROM THE TERMINAL
CMDXCT: BLOCK 1 ;INSTRUCTION TO FETCH A CHARACTER
CMDWLD: BLOCK 1 ;NON-ZERO IF A WILDCARDED QUANTITY TYPED
Z.CMDE:! ;END OF BLOCK TO ZERO
Z.TXTB:! ;START OF BLOCK TO ZERO
TXTAP1: BLOCK 1 ;SAVED AC P1
TXTAT1: BLOCK 1 ;SAVED AC T1
TXTARG: BLOCK 1 ;SAVED ARGUMENT ADDRESS
TXTBUF: BLOCK <TXTJWD==30> ;JUSTIFICATION BUFFER
TXTBCT: BLOCK 1 ;BUFFER BYTE COUNT
TXTBPT: BLOCK 1 ;BYTE POINTER TO BUFFER
TXTCOL: BLOCK 1 ;JUSTIFICATION COLUMN COUNTER
TXTFLG: BLOCK 1 ;LEFT/CENTER/RIGHT JUSTIFICATION FLAG
TXTPAD: BLOCK 1 ;CHARACTER FOR COLUMN PADDING
TXTSUB: BLOCK 1 ;SUBROUTINE TO CALL
TXTSVT: BLOCK 1 ;SAVED CHARACTER ROUTINE FOR JUSTIFY
TXTTBF: BLOCK <TXLWDS==30> ;TEMPORARY STORAGE FOR T$XLAT
TXTTCT: BLOCK 1 ;BYTE COUNT
TXTTPT: BLOCK 1 ;BYTE POINTER TO BUFFER
Z.TXTE:! ;END OF BLOCK TO ZERO
BUFPTR: BLOCK 1 ;ADDRESS OF BUFFER
DCHBLK: BLOCK .DCMAX ;DSKCHR UUO BLOCK
DMPCBN: BLOCK 1 ;CURRENT BLOCK NUMBER FOR DUMP
DMPFMT: BLOCK 1 ;REQUESTED DUMP FORMAT
DMPIDN: BLOCK 1 ;ADDRESS OF ASCIZ BLOCK IDENTIFIER
DMPLBN: BLOCK 1 ;LAST BLOCK TO DUMP
DMPMOD: BLOCK 1 ;DUMP MODE (STR=-1, UNIT=0, FILE=+1)
FOROFS: BLOCK 1 ;FORMAT - NEXT OFFSET
FORBSZ: BLOCK 1 ;FORMAT - NEXT BYTE SIZE
FORSTP: BLOCK 1 ;FORMAT - NON-ZERO TO STOP I/O
FORBUF: BLOCK MAXFMT*.FMLEN ;FORMAT - DESCRIPTOR BUFFER
PTHBLK: BLOCK 3 ;PATH. UUO BLOCK FOR DEV/PPN
P11BUF: BLOCK P11SIZ ;PDP-11 STRING TRANSLATION BUFFER
SELBUF: BLOCK 40 ;SELECTION PROMPT BUFFER
SELPTR: BLOCK 1 ;BYTE POINTER TO BUFFER
SHWBUF: BLOCK <^D132/5>+1 ;TITLE UNDERSCORE BUFFER
TYPOUT: BLOCK 1 ;ALTERNATE CHARACTER OUTPUT ROUTINE
UNIPTR: BLOCK 1 ;CURRENT UNIT
PATCH: BLOCK PATSIZ ;PATCH SPACE
SYMTAB: BLOCK SYMLEN ;PATCH SYMBOL TABLE
RIB: BLOCK BLKSIZ ;RIB BLOCK STORAGE
SATBUF: BLOCK .SDLEN ;SAT BUFFERS, ETC.
SATCLA: BLOCK 1 ;CLUSTER ADDRESS
SATCNT: BLOCK 1 ;CLUSTER COUNT
SATERR: BLOCK 1 ;NON-ZERO IF ERRORS PROCESSING SATS
CPYBRH: BLOCK 3 ;BUFFER RING HEADER
CPYBUF: BLOCK BLKSIZ ;COPY BUFFER
CPYDEV: BLOCK 3 ;OPEN BLOCK
CPYFIL: BLOCK .FOFMX ;RETURNED FILESPEC BLOCK
CPYLEB: BLOCK .RBMAX+1 ;LOOKUP/ENTER BLOCK
CPYMEM: BLOCK 2 ;BUFFER SIZE AND ADDRESS
CPYOPF: BLOCK 1 ;NON-ZERO IF FILE OPENED
CPYPTH: BLOCK .PTMAX ;PATH BLOCK
DATACT: BLOCK 1 ;NON-ZERO IF DATA FILE ACTIVE (OPEN)
DATBUF: BLOCK BLKSIZ*4 ;RANDOM BUFFER FOR DATA FILE I/O
DATHDR: BLOCK .DFLEN ;DATA FILE HEADER
BUF=:DATHDR+.DFPBF ;CREATE SYMBOL "BUF" FOR DEBUGGING
DATFSP: BLOCK .FOFMX ;RETURNED FILESPEC BLOCK
DATIOW: BLOCK 2 ;IOWD FOR DATA FILE HEADER
DATIOS: BLOCK 1 ;I/O STATUS
DATLEB: BLOCK .RBMAX+1 ;LOOKUP/ENTER BLOCK
DATOPN: BLOCK 3 ;OPEN UUO BLOCK
DATPTH: BLOCK .PTMAX ;PATH BLOCK
FBXBUF: BLOCK BLKSIZ ;RIB BUFFER
FBXCTD: BLOCK 1 ;COUNT OF FILES IN DIRECTORY
FBXCTT: BLOCK 1 ;COUNT OF TOTAL FILES
FBXETD: BLOCK FBENUM ;ERRORS FOR DIRECTORY
FBXETC: BLOCK FBENUM ;TOTAL ERRORS
Z.FILB:! ;START OF FILE I/O DATA TO ZERO
FILERR: BLOCK 1 ;ERROR CODE STORAGE IF NO FILE OPENED
FILFIL: BLOCK 2 ;COUNT OF FILES SCANNED & MATCHED
FILIFB: BLOCK 1 ;ADDRESS OF INPUT FILE BLOCK
FILINI: BLOCK 1 ;NON-ZERO IF INITIALIZED FOR I/O
FILIOT: BLOCK 1 ;NON-ZERO IF I/O TRACING ALLOWED
FILIOW: BLOCK 1 ;IOWD
FILMEM: BLOCK 2 ;POINTER TO DYNAMIC STORAGE
FILMOD: BLOCK 1 ;MODE WORD
FILPTR: BLOCK 1 ;POINTER TO DIRECTORY LEVEL TABLES
FILSVF: BLOCK 1 ;SAVED COPY OF AC 'F'
FILTBL: BLOCK 1 ;DIRECTORY TABLE ADDRESS
Z.FILE==.-1 ;END OF FILE I/O DATA TO ZERO
FILFLG: BLOCK 1 ;NON-ZERO IF FILSAV AREA VALID
FILSAV: BLOCK Z.FILE-Z.FILB ;AREA FOR SAVING STATE OF OPENED FILES
;LISTING STORAGE
LSTBAN: BLOCK LSTWDS ;BANNER BUFFER
LSTBRH: BLOCK 3 ;BUFFER RING HEADER
LSTCOL: BLOCK 1 ;CURRENT COLUMN
LSTCTR: BLOCK 1 ;BYTE COUNT FOR HEADER BUFFER
LSTDEV: BLOCK 3 ;OPEN BLOCK
LSTENT: BLOCK .RBMAX+1 ;LOOKUP/ENTER BLOCK
LSTFLG: BLOCK 1 ;NON-ZERO IF DOING INTERNAL OUTPUT
LSTHDR: BLOCK LSTWDS ;HEADER BUFFER
LSTHGR: BLOCK 1 ;SUBROUTINE TO GENERATE A HEADER
LSTLIN: BLOCK 1 ;CURRENT LINE
LSTLPP: BLOCK 1 ;LINES PER PAGE
LSTMEM: BLOCK 2 ;LISTING BUFFER SIZE AND ADDRESS
LSTOPF: BLOCK 1 ;NON-ZERO IF FILE OPENED
LSTPAG: BLOCK 1 ;PAGE COUNTER
LSTPTH: BLOCK .PTMAX ;PATH BLOCK
LSTPTR: BLOCK 1 ;BYTE POINTER TO HEADER BUFFER
LSTSAV: BLOCK 1 ;SAVED CHARACTER TYPER
LSTSPF: BLOCK 1 ;NON-ZERO IF SUB-PAGE PROCESSING WANTED
LSTSPN: BLOCK 1 ;SUB-PAGE NUMBER
LSTTTY: BLOCK 1 ;NON-ZERO IF LISTING TO TTY
LSTWID: BLOCK 1 ;WIDTH OF PAGE
;DATA FOR REFRESHER-WRITTEN FILE CHECKING
IGNMEM: BLOCK 2 ;LENGTH & ADDR OF CORE BLOCK
IGNSIZ: BLOCK 1 ;RUNNING TALLY OF FILE SIZE
IGNSLF: BLOCK 1 ;BLOCK OF RIB ON UNIT
IGNUAD: BLOCK 1 ;UNIT ADDRESS
SRTBLK: BLOCK 1 ;CURRENT DATA FILE BLOCK NUMBER
SRTCHG: BLOCK 1 ;NON-ZERO IF A CHANGE IN SORT BUFFER
SRTDPT: BLOCK 1 ;POINTER TO FILE BLOCK IN DATA FILE BUFFER
SRTFBN: BLOCK 1 ;NUMBER OF FILE BLOCKS IN BUFFER
SRTFCT: BLOCK 1 ;FILE COUNTER
SRTFRM: BLOCK 1 ;NUMBER OF SORT FRAME ENTRIES
SRTMEM: BLOCK 2 ;LENGTH & ADDRESS OF SORT CORE
SRTPAS: BLOCK 1 ;DATA FILE PASS COUNT (INFORMATIONAL ONLY)
SRTSPT: BLOCK 1 ;POINTER TO FILE BLOCK IN SORT BUFFER
STRERR: BLOCK 1 ;NON-ZERO IF STRUCTURE INCONSISTANCIES
STRFIE: BLOCK 1 ;NON-ZERO IF ERRORS WHILE READING DATA FILE
STRFIL: BLOCK 1 ;NON-ZERO IF PARAMETERS FROM DATA FILE
STRSFT: BLOCK 2 ;OPTION TABLE FOR SFDS
Z.END:! ;END OF AREA TO CLEAR ON STARTUP
END START ;A GOOD PLACE TO BEGIN