Directory of image this file is from
This file as a plain text file
/PARAMETER BLOCK CREATION DECSYSTEM-8
/THIS PROGRAM IS PART OF DECSYSTEM-8 FOR THE INITIAL
/CREATION OF A PARAMETER BLOCK ON FILE STRUCTURED
/DEVICES. THE PRIMARY REASONS FOR DESIRING A PARAMETER
/BLOCK ARE:
/ TO CARRY THE DEVICE LENGTH ON THE MEDIUM
/ TO CARRY A LOGICAL USER DEVICE NAME
/ TO CARRY A UNIQUE VOLUME NUMBER
/ TO CARRY INFORMATION FOR INTELEGENT SQUISH AND ZERO.
/AND OTHERS TO BE DEFINED IN THE FUTURE.
/THE PARAMETER BLOCK WILL EXIST IN BLOCK 6 OF THE
/DEVICE, WITH PRESENCE BEING SIGNALLED BY THE FIRST 3 WORDS
/IN THE BLOCK.
/NOTE THAT IF THE SYSTEM EVER EXTENDS THE SYSTEM
/INTO BLOCK 6 THESE WORDS WILL BE REPLACED
/THUS REMOVING THE PARAMETER BLOCK. THIS SHOULD
/SELDOME HAPPEN EXCEPT IN THE CASES OF RK8'S OR LOTS
/OF RFO8 DEVICES. THE MOTIVATION IS THAT FILE STORAGE
/SHOULD TAKE PRECIDENCE, AND MOST USERS PROBABLY DON'T
/CARE IF SYS HAS A PARAMETER BLOCK ANYWAY.
/LAYOUT OF THE PARAMETER BLOCK (BLOCK 6):
/WORD DESCRIPTION
/ 000 0427
/ 001 1203 SIGNALS PARAMETER BLOCK
/ 002 7777
/ 003 -LAST BLOCK # ON DEVICE
/ 004 =-1 IF NO "ZERO" ALLOWED
/ 005 =-1 IF NO SQUISH FROM OTHER DEVICES
/ 006 =-1 IF NO SQUISH EVEN TO ITSELF
/ 007 =-1 IF SYSTEM PRESENT(NOT IMPLEMENTED)
/ 010 START OF FILE STORAGE
/ 011-076 FUTURE EXPANSION
/ 077 INTERNAL FORM OF USER DEVICE NAME
/ 100-103 USER DEVICE NAME (ASCII) FOR AUTOAS.
/ 104 VOLUME I.D.
/ 105 SYSTEM I.D. IF SYSTEM PRESENT
/ 0 NO ID OR SYSTEM NOT PRESENT
/ -1 PS/8 SYSTEM
/ -2 OS/8 SYSTEM
/ -3 OS/12 SYSTEM
/ -4 DECSYSTEM-8 SYSTEM
/ ETC.
/ 106 VERSION NUMBER IF APPLICABLE
/ 107 RELEASE NUMBER
/ 110 EXPANSION
/ 111 EXPANSION
/ 112 CREATION DATE THIS BLOCK (PS/8-OS/8 DATE FORM)
/ 113-177 EXPANSION
/ 200-377 DESCRIPTIVE LABLE: IN UNPACKED ASCII
/ MUST BE TERMINATED WITH Z
/ 0'S FILLED TO 377
/THE FOLLOWING DEFINITIONS ARE VERSION DEPENDENT
/DEFINITIONS SYSTEM
KEYMON=7 /START OF KEYBOARD MONITOR
/SPECIFIC TO DECSYSTEM-8
/KEYBOARD MONITOR
LXR=14
X1=15
TEMP1=21
TEMP2=22
TM1=23
TMP1=23
SYSTEM=25
PCH=26
GLINE=27
GNAME=30
NM1=31;NM2=32;NM3=33;NM4=34
DEVHND=35
PRNAME=276
SRCH=1350
GLCNTC=1304 / C FOUND IN GLINE
BEGLN=1600 /SPECIFIC
/AND SOME PAGE ZERO REFS(WATCH OUT)
PRXR=12 /AN XR FOR ME
PRMSG=56
PRNM=57
CRLF=60
HELP=61
K7605=62
*2000
START, JMS I (7607 /FIRST GET KEYBOARD BACK IN
1000 /ALL OF IT
0000 /WHERE IT NORMALLY GOES
KEYMON
JMP START /TRY AGAIN
TAD (PRMESG /SET UP PAGE ZEROS
DCA PRMSG /FOR REFERENCE
TAD (PRNAME /PRINT A NAME ROUTINE
DCA PRNM
TAD (XCRLF /CRLF OUTPUT ROUTINE
DCA CRLF
TAD (XHELP /HELP FLAG ROUTINE
DCA HELP
TAD (7605 /FOR EXIT
DCA K7605
TAD (JMP I K7605
DCA I (GLCNTC /SO C IN GLINE GOES TO MON.
TAD (":
DCA 164 /WHERE "." IS IN KBOARD
CIF 10 /GET USR IN
JMS I SYSTEM
10
TAD (200 /AND SET "SYSTEM"
DCA SYSTEM
RESTRT, JMS I PRMSG
WNTHLP
JMS I (YESORNO
STA /ANSWER WAS YES
DCA I (HELPX /OR NO
JMP I (PARCONT
/DISPATCH ROUTINE ON ACC.
DISPAT, 0
DCA NM1 /THATS WHAT SRCH USES
TAD DISPATCH
DCA I (SRCH /FAKE SUBROUTNE CALL
JMP I (SRCH+1 /GO DO IT
/PRINT A MESSAGE
PRMESG, 0
CDF 0 /JUST IN CASE
KCC /CLEAR FLAG (FROM O
TAD I PRMESG /GET ADD OF MESSAGE
DCA DISPATC /STORE POINTER
ISZ PRMESG /NORMAL EXIT
PRST1, TAD I DISPATC
RTR;RTR;RTR /OVER FOR PRINT
JMS PRCHR /PRINT LEFT HALF
TAD I DISPATC
JMS PRCHR /PRINT RIGHT HALF
ISZ DISPATC /NEXT WORD
JMS I (CNTRLO /CHECK FOR O
JMP I PRMESG /YES IGNORE REST OF MESSAGE
JMP PRST1 /LOOP
PRCHR, 0
AND (77
SNA
JMP I PRMESG /IF ZERO QUIT
TAD (-40 /FOR EXTEND
SPA /SKIP IF NEUMERIC
TAD (100 /IS ALPHA
TAD (240 /BACK TO CORRECT
JMS I PCH /PRINT ROUTINE IN MONITOR
JMS I (CONSOL /CHECK CONSOL FOR C
JMP I PRCHR
/PRINT MESSAGE IF HELP WANTED
/CALL: JMS I HELP
/ MSPNT
/ RETURN
XHELP, 0
CDF 0 /JUST IN CASE
TAD I XHELP
DCA HLPPNT /STASH POINTER
ISZ XHELP /POINT TO RETURN
TAD HELPX
SNA CLA /SKIP IF HELP WANTED
JMP I XHELP /NO HELP
JMS I PRMSG /PRINT THE MESSAGE
HLPPNT, 0
JMS I CRLF
JMP I XHELP
HELPX, 0
/INPUT A YES OR NO AND TAKE
/CONDITIONAL BRANCH OUT.
/CALL: JMS I (YESORNO
/ RET1 /ANSWER=YES
/ RET2 /ANSWER=NO
YESORN, 0
KSF /WAIT FOR Y OR N
JMP .-1
KRB /GET CHAR
JMS I (DISPATC
-"C+100;7600
-"Y; YES
-"N; NO
0
JMS I CRLF
JMS I PRMSG
YESNO
JMS I CRLF
JMP YESORNO+1
/ANSWER IS YES TO HELP
YES, JMS I PRMSG /AND FINISH "YES"
MYES
JMP NOCONT
NO, ISZ YESORNO
JMS I PRMSG
MNO
NOCONT, JMS I CRLF
JMP I YESORNO
PAGE
/CONTINUING WITH MAIN LINE CODE
PARCON, JMS I HELP
HEAD1 /THIS PROGRAM ESTABLISHES A PARAMETER BLOCK
JMS I HELP
HEAD2 /ON DECSYSTEM-8 FILE STRUCTURED DEVICES.
JMS I CRLF
JMS I HELP
HEAD3 /TELL HIM ABOUT LINE SCANNER
GOOF1, JMS I CRLF
JMS I PRMSG
MESDEV /DEVICE NAME
JMS I (GTLINE /INPUT A LINE
JMS I CRLF /NEW LINE
JMS I GNAME /DECODE A DEVICE NAME
SKP
JMP MAINL2 /CONTINUE MAIN LINE
GOOF1A, JMS I PRMSG /HE GOOFED:TELL HIM
MGOOF1
JMP PARCON /ASK AGAIN
MAINL2, TAD NM1 /DECODE DEVICE
DCA DEVN-1 /NAME
TAD NM2
DCA DEVN
TAD (7200 /WHERE HANDLER GOES
DCA DEVN+1
CIF 10
JMS I SYSTEM /FETCH HANDLER
1
0
DEVN, 0;0
JMP GOOF1A /NOT THERE
TAD .-2 /ENTRY
DCA DEVHND /STASH FOR CALL
TAD DEVN /NOW TO SEE IF FILE STRUCTURED
TAD (7757 /INDEX INTO DCB TABLE
DCA DEVN-1 /A GOOD TEMP
CDF 10
TAD I DEVN-1 /PICK UP
CDF 0
DCA DTYPE /STASH FOR LATER
TAD DTYPE
SPA CLA /SKIP IF NOT FILE STRUCTURED
JMP .+4 /CONTINUE
JMS I PRMSG /TELL HIM
MNFLST /NOT FILE STRUCTURED
JMP GOOF1 /AND START OVER
JMS LEGAL /NOW SEE IF WE CAN PUT IN PARMS
TAD (4400-1 /SET UP XR
DCA PRXR /TO PARAMTER BLOCK
CDF 10
TAD (0427 /THE FIRST THREE
DCA I PRXR /WORDS IN THE PARAMETER
TAD (1203 /BLOCK INDICATE ITS
DCA I PRXR /PRESENCE.
STA /FOR MOST CASES WORD 2
DCA I PRXR /NEED ONLY BE TESTED.
JMS SQPARM /DO SQUISH AND ZERO PARAMS
JMS SYSPAR /AND SYSTEM PARAMETERS
JMS LENPAR /DEVICE LENGTH.
JMS UDNAME /DO USER NAME STUFF
JMS DLABLE /AND DESCRIPTIVE LABLE
JMS WRZERO /WRITE ZERO DIRECTORY IF REQUIRED
JMS WRPARAM /AND PARAMTER BLOCK
JMP RESTRT /START OVER
/ROUTINE USED BY DUMP TO DETERMINE IF USER
/WANTS TO CHANGE THE BLOCK.
/CALL: JMS I (CHANGE
/ RET1 /IF YES
/ RET2 /IF NO
CHANGE, 0
CDF 0
TAD CHANGF /FLAG FOR ASK QUESTION
SNA CLA /SKIP IF SELECTIVELY DESCIDE
JMP CHANG2 /PRETEND ANSWER WAS NO
JMS I CRLF /NEW LINE
JMS I PRMSG /CHANGE THIS?
MCHANGE
JMS YESORNO /ASK THE QUESTION
JMP .+3 /YES IS FIRST EXIT
CHANG2, ISZ CHANGE
JMP I CHANGE /AND RETURN
DCA CHANGI /SIGNAL SOMETHING WILL CHANGE
JMP I CHANGE
CHANGF, 0
CHANGI, -1
/CHECK TTY FOR C
CONSOL, 0
KSF /FLAG UP
JMP I CONSOL /NO=RETURN
KRS /READ BUFFER: NO FLAG CLEAR
TAD (-"C+100 /- C
SZA CLA
JMP I CONSOL /NOT C
TSF /WAIT FOR OUTPUT TO FINISH
JMP .-1
JMP I (7600 /RETURN TO PS/8
/CHECK CONSOL FOR O
CNTRLO, 0
KSF
JMP CNTRL1
KRS /READ STATIC
TAD (-"O+100 /CHECK FOR O
SZA CLA
JMP CNTRL1 /NOPE
KCC /CLEAR THE CHAR
JMP I CNTRLO /CALL+1=YES
CNTRL1, ISZ CNTRLO
JMP I CNTRLO /RET TO CALL+2
PAGE
/SUBROUTINE TO FIGURE OUT IF A PARAMETER BLOCK IS LEGAL
/ALSO SETS SWITCHES:
/ ZERO = -1 IF DEVICE HAS DIRECTORY
LEGAL, 0
JMS I DEVHND /READ IN 7 BLOCKS
1610 /AS MAY BE IN BLOCK 7
2000 /IN FIELD 1
0001
JMP PARERR /MIGHT BE PARITY ERROR
STA
DCA ZERO /INIT ZERO SWITCH
CDF 10 /LETS LOOK AT THE DIRECTORY
TAD I (2000 /PICK UP #ENTRIES SEG 1
CLL /FOR TEST
TAD (100 /SHOULD BE >-100
SNL CLA /MOST UNMARKED TAPES WILL FAIL THIS TEST
JMP NODIR /NO DIRECTORY
DCA I (5002 /TO MAKE SURE WILL END
TAD (2002 /WE ARE GOING TO SEE IF SEG 6
DCA LEPNT /IS USED FOR DIRECTORY
LEGAL1, TAD I LEPNT /PICK UP A LINK TO NEXT SEGMENT
SNA CLA /SKIP IF A LINK
JMP LEGAL2 /LAST LINK
TAD (400
TAD LEPNT /NEXT SEGMENT LINK
DCA LEPNT
JMP LEGAL1 /CONTINUE
LEPNT, 0
ZERO, 0 /0 IF NEEDS ZEROING
LEGAL2, CDF 0
TAD LEPNT /PICK UP POINTER
TAD (-4400 /IF RESULT >0 THEN BLOCK 6 USED
SPA CLA
JMP LEGAL3 /GO CHECK IF BLOCK ALREADY EXISTS
JMS I PRMSG /NO CAN MAKE PARAMETER BLOCK
MILLEGAL
JMP I K7605
NODIR, DCA ZERO /INDICATE DEVICE NEEDS ZEROING
LEGAL3, CDF 10 /IF COME FROM LEGAL2
ISZ I (4402 /SKIP IF ALREADY HAVE ONE
JMP I LEGAL /RETURN
JMS PRMSG2 /TELL HIM WE HAVE ONE
MHAVPARAM
MESS25 /DOES HE WANT TO
MESS26 /A:REPLACE
MESS27 /B:SELECTIVELY DESCIDE
MESS28 /C:PRINT IT
0
JMS I (OPTION
JMP I LEGAL /REPLACE
STA /SET UP FOR SELECTIVE
DCA I (CHANGF /CHANGE VIA FLAG
JMP I (DUMPP
/PRINT A BUNCH OF MESSAGES ON DIFFERENT LINES
PRMSG2, 0
CDF 0
TAD I PRMSG2 /PICK UP ONE
ISZ PRMSG2 /POINT TO NEXT
SNA /SKIP IF NOT DONE
JMP I PRMSG2 /DONE ALL MESSAGES
DCA .+2 /STORE FOR PRINT OUT
JMS I PRMSG /PRINT IT
0 /ADDRESS OF MESSAGE
JMS I CRLF /NEW LINE
JMP PRMSG2+1
/HANDLER ERROR ON INPUT.
PARERR, JMS I CRLF
JMS I PRMSG
MESS0 /TELL HIM ABOUT ERROR
JMS I CRLF
JMS I PRMSG /AND ASK HIM ABOUT CONTINUING.
MESS1
JMS I (YESORNO /WAIT FOR AN ANSWER
SKP /YES.
JMP I (RESTRT /NO=START OVER
DCA ZERO /DEVICE NEEDS ZEROING
JMS I PRMSG /TELL HIM WE WILL ZERO THE DIRECTORY
MESS2
JMS I CRLF
JMP I LEGAL /AND RETURN
/ASSEMBLE AN OCTAL NUMBER FROM LINEBUFFER
/CALL: JMS ASSEMB
/ ERROR /NON OCTAL NUMB
/ NORMAL /AC=NUMBER
ASSEMB, 0
DCA TM1 /DIGIT COUNTER
DCA TEMP1
TAD I LXR /PICK UP CHARACTER
SNA
JMP ASSDON /DONE.
DCA TEMP2
TAD TEMP2
TAD (-260
CLL /FOR TEST
TAD (-12
SNL CLA /LINC=1 IF ILLEGAL
JMP ASSCON /CONTINUE
TAD TM1 /TO SEE IF ANY INPUT
SZA CLA
JMP ASSDONE
JMS I PRMSG
MNOINPT /NO INPUT
JMP I ASSEMB /ERROR RETURN
ASSCON, TAD TEMP1
CLL RAL
DCA TEMP1
TAD TEMP1
CLL RAL
CLL RAL
TAD TEMP1 /*10
DCA TEMP1
TAD TEMP2
AND (17
TAD TEMP1
ISZ TM1
JMP ASSEMB+2
ASSDON, TAD TEMP1
ISZ ASSEMB
JMP I ASSEMB
PAGE
/SUBROUTINE TO GET DEVICE LENGTH
LENPAR, 0
JMS I (DATE /PUT DATE IN PARAM BLOCK
JMS PARCS /LOOK UP LENGTH IN TABLE
SNA CLA /SO WE DON'T ASK DUMB QUESTION
JMP PARC5 /IS NO ENTRY IN TABLE
JMS I HELP /GIVE NECESSARY HELP
HELP3
JMS I HELP
HELP3A
JMS I HELP
HELP3B
JMS I HELP
HELP3C
JMS I HELP
HELP3D
JMS I CRLF
JMS I PRMSG /AND ASK IF STANDARD LENGTH
MESS3
JMS I (YESORNO
JMP PARC2 /YES: USE TABLE
PARC5, JMS I PRMSG /NO
MESS4 /ASK FOR LENGTH
JMS I (GTLINE /INPUT A LINE
JMS ASSEMB /ASSEMBLE A NUMB.
JMP .-4 /ERROR-TRY AGAIN
CIA /-LENGTH DESIRED
SKP
PARC2, JMS PARCS /LOOK UP LENGTH
PARC3, CDF 10
DCA I (4403 /STASH -LENGTH
CDF 0
JMS I CRLF
PARC4, JMS I HELP
HLP24A
JMS I HELP /TELL ABOUT START OF FILE STORAGE
HLP24B
JMS I HELP
HLP24C
JMS I HELP
HLP24D
CDF 10 /PATCH TO ASK IF STANDARD
TAD I (4407 /SYSTEM PRESENT FLAG
SZA CLA /SKIP IF NOT PRESENT
TAD (70-7 /IS SYSTEM
TAD (7
DCA I (4410
JMS I PRMSG /ASK IF HE WANTS STANDARD
MES22A
JMS I (YESORNO
JMP I LENPAR /YES:GOT IT
JMS I PRMSG
MESS22
JMS I (GTLINE /INPUT START OF FILE STORAGE
JMS I (ASSEMB
JMP .-4
CDF 10
DCA I (4410
TAD I (4410
CDF 0
TAD (-7 /MUST BE >6
SPA CLA /SKIP IF LEGAL
JMP PARC4 /DO AGAIN
JMP I LENPAR /RETURN
/SUBROUTINE TO PICK UP SQUISH AND ZERO PARAMETERS
SQPARM, 0
JMS I (DATE /DATE THE PARAMETER BLOCK
JMS I CRLF
JMS I HELP /TELL HIM WHAT THIS MEANS
HELP5A
JMS I HELP
HELP5B
JMS I HELP
HELP5C /DESCRIBE IT
JMS I HELP
HELP5D
JMS I HELP
HELP5E
JMS I PRMSG /USE STANDARD?
MESS5
JMS I (YESORNO
SKP
JMP SQL1 /NO: INPUT SEPARATELY
CDF 10 /YES: USE STANDARD
STA
DCA I (4404 /NO ZERO ALLOWED
STA
DCA I (4405 /NO SQUASH FROM OTHER DEVICES
SQEXIT, CDF 10
DCA I (4406 /SQUASH TO SELF ALLOWED
CDF 0
JMP I SQPARM /AND RETURN
SQL1, JMS I PRMSG /ASK ABOUT ZERO
MESS6
JMS I (YESORNO
SKP
STA /NO ZEROS
CDF 10
DCA I (4404 /SET INDICATOR
JMS I PRMSG /HOW ABOUT SQ FROM ANOTHER DEV?
MESS7
JMS I (YESORNO
SKP /YES: DOIT AND EXIT
JMP .+3
CDF 10
JMP SQEXIT-1
CDF 10 /NO: MUST ASK MORE
STA
DCA I (4405
JMS I PRMSG /TO MYSELF?
MESS8
JMS I (YESORNO
SKP /YES
STA /NO: DISALLOW
JMP SQEXIT
PAGE
/DUMP OF PARAMETER BLOCK REQUESTED.
DUMPP, STA /TO INDICATE IF ANYTHING CHANGES
DCA I (CHANGI
JMS I CRLF
JMS I PRMSG /USER DEVICE NAME
MESS13
TAD (4500 /THEN PRINT NAME
JMS PRASCII
-4 /MAXIMUM CHARS
JMS I PRMSG
MESS14 /VOLUME ID
CDF 10
TAD I (4504
JMS DECPRN /PRINT IT
JMS I (CHANGE /CHANGE IT?
JMS I (UDNAME /YES
JMS I CRLF /NEW LINE
TAD (4600
JMS PRASCII /AND DESCRIPTIVE LABLE
-200 /MAX.
JMS I (CHANGE /CHANGE IT??
JMS I (DLABLE /YES
JMS I CRLF /OR NO
CDF 10
TAD I (4404 /PICK UP "ZERO" FLAG
SNA CLA
IAC /IS
TAD (HELP5B+1 /NOT
DCA .+2 /ALLOWED
JMS I PRMSG
HELP5B+1
JMS I CRLF
CDF 10
TAD I (4406 /NO SQUISHES
SNA CLA
JMP .+4 /SOME SQUISHES ALLOWED
JMS I PRMSG
HELP5C
JMP DUMPL2
TAD I (4405 /SQUISH TO MYSELF
SZA CLA
TAD (HELP5D-MESS20
TAD (MESS20
DCA .+2
JMS I PRMSG
MESS20
DUMPL2, JMS I (CHANGE /CHANGE SQUISH AND ZERO??
JMS I (SQPARM /YEP
JMS I CRLF /OR NO
CDF 10
TAD I (4407 /SYSTEM PRESENT
SNA CLA /SKIP IF PRESENT
JMP DUMPL3 /NO:JUMP AROUND
TAD I (4505
CDF 0
TAD (SYSTBL /INDEX INTO TABLE OF SYS MESSAGES
DCA TEMP1 /STASH FOR INDIRECT
TAD I TEMP1
DCA .+4
JMS I PRMSG
MESS10
JMS I PRMSG
0 /PRINT SYSTEM TYPE
JMS I PRMSG
MESS21 /VERSION
CDF 10
TAD I (4506
JMS DECPRN /PRINT VERSION #
TAD (". /FOLLOWED BY RELEASE NUMBER
JMS I PCH /PRINT IT
CDF 10
TAD I (4507 /PICK UP RELEASE NUMBER
JMS DECPRN /AND PRINT IT
JMP DUMPL3+2
/OUTPUT A CR. LF.
XCRLF, 0
TAD (215
JMS I PCH
TAD (212
JMS I PCH
JMP I XCRLF
PAGE
DUMPL3, JMS I PRMSG
MESS23 /NO SYSTEM PRESENT
JMS I (CHANGE /CHANGE IT??
JMS I (SYSPAR /YES
JMS I CRLF /OR NO
JMS I PRMSG
MESS4 /DEVICE SIZE
STA /RESTORE FLAG
CDF 10
DCA I (4402 /TO -1
TAD I (4403 /PICK UP SIZE
CIA /MAKE POSITIVE
JMS DECPRN /PRINT DECIMAL #
JMS I CRLF /NEW LINE
JMS I PRMSG /START OF FILE STORAGE
MESS22
CDF 10
TAD I (4410 /IS IN LOC 10
JMS DECPRN
JMS I (CHANGE /CHANGE LENGTH AND START?
JMS I (LENPAR /YES
JMS I CRLF
ISZ CHANGI /SKIP IF NOTHING WAS CHANGED
JMS I (WRPARA /WRITE OUT THE PARAMETER BLOCK
JMP I (RESTRT
/DIGITAL 8-22-U
/UNSIGNED DECIMAL PRINT
/CALL WITH NUMBER TO BE TYPED IN C(AC)
/RETURN TO LOCATION FOLLOWING THE JMS
DECPRN, 0
CDF 0
DCA VALUE /SAVE INPUT
CLA STL RAR /4000
DCA ASCDIG /START WITH IGNORE LEADING ZEROS
DCA DIGIT /CLEAR
TAD CNTRZA
DCA CNTRZB /SET COUNTER TO FOUR
TAD ADDRZA
DCA ARROW /SET TABLE POINTER
SKP
DCA VALUE /SAVE
CLL
TAD VALUE
ARROW, TAD TENPWR /SUBTRACT POWER OF TEN
SZL
ISZ DIGIT /DEVELOP BCD DIGIT
SZL
JMP ARROW-3 /LOOP
CLA /HAVE BCD DIGIT
TAD DIGIT /TAKE CARE OF LEADING ZEROS
SNA CLA /SKIP IF NOT ZERO
JMP .+3 /MAINTAIN SPACES OR ZERO
TAD K260
DCA ASCDIG /CHANGE TO NEUMERIC
TAD DIGIT /GET DIGIT
TAD ASCDIG /MAKE IT ASCII
SMA /NO PRINT LEADING ZEROS
JMS I PCH /PRINT IT
CLA
DCA DIGIT /CLEAR
ISZ ARROW /UPDATE POINTER
ISZ CNTRZB /DONE ALL FOUR?
JMP ARROW-1 /NO: CONTINUE
TAD ASCDIG /TO SEE IF PRINTED ANYTHING
SMA CLA /SKIP IF NO PRINT YET
JMP I DECPRN
TAD K260 /PRINT ONE 0
JMS I PCH
JMP I DECPRN
ADDRZA, TAD TENPWR
CNTRZA, -4
TENPWR, -1750 /ONE THOUSAND
-0144 /ONE HUNDRED
-0012 /TEN
-0001 /ONE
K260, 260
VALUE, 0
DIGIT, 0
CNTRZB, 0
ASCDIG, 4000
/LETS BE CUTE A LITTLE
LOCKDN, JMS I HELP
MLOCK8
JMS I HELP
MLOCK9 /SCRATCH A LITTLE TO THE LEFT...
STA CLL RAL /TWICE
DCA VALUE /A GOOD TEMP
LOCKQU, TAD (-5
DCA DIGIT
JMS I DEVHND
0210
5000
0050
CLA CLL
ISZ DIGIT
JMP LOCKQU+2
JMS I HELP
MMMM
ISZ VALUE
JMP LOCKQU
THANKS, JMS I HELP
MTHANKS
JMS I CRLF
TAD (LOCK-2
DCA LOCKED /RESET FOR NEXT TIME
JMS I CRLF
JMP I (RESTRT
PAGE
/PICK UP SYSTEM PARAMETERS
SYSPAR, 0
JMS I (DATE /DATE THE PARAMETER BLOCK
CDF 10
DCA I (4407
CDF 0
TAD (4504
JMS ZEROPR
-74 /W.C.
JMS I PRMSG
MESS9 /SYSTEM PRESENT?
JMS I (YESORNO
SKP /YES: CONTINUE
JMP I SYSPAR /NO:THIS INFO NOT NEEDED
STA
CDF 10
DCA I (4407
CDF 0
SYSP2, JMS I PRMSG
MESS10 /ESTABLISH ID
JMS I CRLF
JMS I HELP
HLP10A
JMS I HELP
HLP10B
JMS I HELP
HLP10C
JMS I HELP
HLP10D
JMS I HELP
HLP10E
JMS I (GTLINE
JMS ASSEMB /GET TYPE
JMP SYSP2 /BAD INPUT
CIA /THAT'S HOW WE STORE IT
CDF 10
DCA I (4505
CDF 0
JMS I PRMSG
MESS11 /GET VERSION NUMBER
JMS I (GTLINE
JMS I (ASSEMB /GET NUMBER
JMP .-4 /AGAIN
CDF 10
DCA I (4506
CDF 0
SYSP1, JMS I PRMSG
MESS12 /AND RELEASE
JMS I (GTLINE
JMS I (ASSEMB /GET RELEASE NUMBER
JMP SYSP1 /AGAIN
CDF 10
DCA I (4507
DCA I (4510
DCA I (4511
CDF 0
JMP I SYSPAR
/SELECT OPTIONS A,B,C
/CALL: JMS OPTION
/ RET1 /A
/ RET2 /B
/ RET3 /C
/ONLY CALLED BEFORE DUMP.
OPTION, 0
KSF /WAIT FOR KEYBOARD
JMP .-1 /TO HAVE A CHARACTER
KRB /READ IT
TSF
JMP .-1
TLS /ECHO IT:
JMS I (DISPATCH /AND COMPARE
-"A;OPTC+2
-"B;OPTC+1
-"C;OPTC
0
JMS I CRLF
JMS I PRMSG /BAD ANSWER
ANSABC /A,B,C ONLY
JMP OPTION+1
OPTC, ISZ OPTION
ISZ OPTION
JMS I CRLF
JMP I OPTION
/COME HERE FOR DEVICE LENGTH TABLE LOOKUP
PARCS, 0
TAD DTYPE /PICK UP TYPE
AND (770 /MASK TYPE
CLL RTR;RAR /OVER
TAD (LENTBL /PICK UP LENGTH
DCA TEMP1 /STASH FOR INDIRECT
TAD I TEMP1 /GOT IT
JMP I PARCS
DTYPE, 0 /DCB WORD
/ROUTINE CALLED WHEN DEVICE LOCKED (I.E. ERROR EXIT
/FROM HANDLER WHEN WRITING PARAMETER BLOCK.)
LOCKED, LOCK-2
JMP I LOCKED
CLA CLL /AC=4000 ERROR EX.
ISZ LOCKED
ISZ LOCKED
JMP I LOCKED
PAGE
/SUBROUTINE TO ZERO SOME ELEMENTS OF THE PARAMETER BLOCK
/CALL: TAD (START-1
/ JMS ZEROPR
/ -#WORDS
ZEROPR, 0
DCA PRXR /SET XR
TAD I ZEROPR
DCA ZROCNT /COUNTER
ISZ ZEROPR
CDF 10
DCA I PRXR
ISZ ZROCNT
JMP .-2
CDF 0
JMP I ZEROPR
ZROCNT, 0
/INPUT USER DEVICE NAME
UDNAME, 0
JMS I (DATE /DATE THE PARAMETER BLOCK
TAD (4476 /ZERO INFO
JMS ZEROPR
-6
JMS I CRLF
JMS I HELP /TELL HIM ABOUT USER NAMES
HLP12A
JMS I HELP
HLP12B
JMS I HELP
HLP12C
JMS I HELP
HLP12D
UDL4, JMS I PRMSG
MESS13
JMS I (GTLINE /GET LINE FOR LABEL
TAD (4500
DCA TEMP1 /USE FOR POINTER
TAD (-4
DCA TEMP2 /AND COUNTER
UDL2, TAD I LXR /PICK UP CHARACTER
SNA /DONE?
JMP UDL1 /YES
CDF 10
DCA I TEMP1 /STASH THIS CHAR
CDF 0
ISZ TEMP1
ISZ TEMP2
JMP UDL2
UDL1, TAD (BEGLN-1
DCA LXR /FOR MAKING INTERNAL NAME
JMS I GNAME /PACK IT UP
JMP UDNAME+1 /START OVER ILLEGAL CHAR
TAD NM2 /SECOND PACKED
SNA CLA
STA /FOR FORCING BIT 0 ON
DCA NM3 /ONLY 4 CHARS ALLOWED
TAD NM1
TAD NM2
RAL CLL /OVER FOR FORCING BIT 0 ON
ISZ NM3
STL
RAR
CDF 10
DCA I (4477 /PUT IN PACKED NAME
TAD I (4477
CDF 0
JMS NAMCHK /CHECK FOR DUP NAMES
UDL3, JMS I HELP
HLP13A
JMS I HELP
HLP13B
JMS I PRMSG
MESS14
JMS I (GTLINE
JMS I (ASSEMB /FORM DECMAL NUMBER
JMP UDL3 /BAD INPUT
CDF 10
DCA I (4504 /STASH
CDF 0
JMP I UDNAME
/DIALOGUE ABOUT LOCKED DEVICES.
LOCK, TAD HELPX /FIRST SEE IF HE IS GETTING HELP
SNA CLA /SKIP IF YES.
JMP NOHELP /BE A LITTLE HARDER ON HIM
JMS I HELP /TELL HIM TO WR-EN DEVICE
MLOCK1
JMS TTYWAIT /WAIT FOR KEY STRUCK
JMS LOCKED /RESET RETURN
JMS WRPARA /TRY AGAIN
JMP I (RESTRT /ALL O.K.
NOHELP, STA
DCA HELPX /FOR C.R. WITH MESSAGE
JMS I HELP
MLOCK2 /OUCH!!
JMS I HELP
MLOCK3 /YOU FORGOT SOMETHING!
JMS TTYWAIT /WAIT FOR KEYSTRUCK
JMS LOCKED /RESET RETURN
JMS WRPARA /TRY AGAIN
JMP THANKS /O.K.
JMS I HELP
MLOCK2 /OUCH!!
JMS I HELP
MLOCK4 /CLUE:YOU NEED TO PRESS A SWITCH
LOCK4, JMS TTYWAIT
JMS LOCKED
JMS WRPARA
JMP LOCKDN /O.K. GOT IT
JMS I (PRMSG2
MLOCK2 /OUCH!!
MLOCK5 /YOU DUMMY! I CAN'T DO EVERYTHING
MLOCK6 /THE DEVICE NEEDS TO BE WRITE ENABLED.
MLOCK7 /NEXT TIME GET HELP
0
JMP LOCK4
PAGE
/INPUT DESCRIPTIVE LABEL
DLABLE, 0
JMS DATE
TAD (4577
JMS ZEROPR
-200
JMS I HELP
HLP15
JMS I HELP
HLP15B
JMS I HELP
HLP15C
JMS I HELP
HLP15D
JMS I PRMSG
MESS15
TAD (-200
DCA XTM1 /A GOOD TEMP??
TAD (4600
DCA XTEMP1 /SET PARAM POINTER
JMP DLAB3-1
DLAB1, TAD (215 /PUT IN CR (IGNORED BY LINE SCANNER)
JMS PUTONE /INTO BUFFER
TAD (212 /AND LINE FEED
JMS PUTONE
JMS I (GTLINE /GET A LINE
DLAB3, TAD I LXR
SNA /SKIP IF LINE NOT ENDED
JMP DLAB1
JMS PUTONE
JMP DLAB3
/STICK IN BUFFER - CHECK FOR END, ETC.
PUTONE, 0
CDF 10
DCA I XTEMP1
TAD I XTEMP1
CDF 0
TAD (-"Z+100 /- Z
SNA CLA /SKIP IF NOT Z
JMP DLAB2 /DONE
ISZ XTEMP1 /NEXT POSITION
ISZ XTM1 /OVERFLOWING?
JMP I PUTONE
/NO: CONTINUE
JMS I PRMSG /TELL HIM OVERFLOW
MESS16
DLAB2, TAD ("Z-100 /FORCE Z IN
CDF 10
DCA I XTEMP1 /JUST IN CASE
CDF 0
JMP I DLABLE
/ROUTINE TO WRITE A ZERO DIRECTORY OUT
/IF "ZERO" IS =0
WRZERO, 0
ISZ I (ZERO
SKP /ZEROING NEEDED
JMP I WRZERO
TAD (2000
JMS I (ZEROPR /START BY ZEROING HEADER
-6
CDF 10
TAD I (4410 /PICK UP START OF FILE STORAGE
DCA I (2001 /FILE ORIGIN
STA
DCA I (2000 /1 FILE
STA
DCA I (2004 /1 WASTE WORD
TAD I (4403 /PICK UP LENGTH
TAD I (2001 /ADJUST FOR FILE START
DCA I (2006 /STICK IN A BIG EMPTY
CDF 0
JMS I DEVHND /AND WRITE LOTS OF BLOCKS OUT
5210 /5 OF THEM
2000 /FROM FIELD 1
0001
HLT /OR SOMETHING
JMP I WRZERO
/WRITE OUT THE PARAMETER BLOCK
WRPARA, 0
JMS I DEVHND
4210
4400
0006
JMP LOCKED+2
JMP I WRPARA
XTM1, 0
XTEMP1, 0
/SUBROUTINE TO GET A LINE & RESET LXR
GTLINE, 0
CDF 0
JMS I GLINE
TAD (BEGLN-1
DCA LXR
JMP I GTLINE
/PRINT ASCII STRING. IGNORE 0'S
/CALL: TAD (ADDRESS /FIELD 1
/ JMS I PRASCII
/ -COUNT /#DIGITS
PRASCI, 0
CDF 0
DCA TEMP1 /POINTER
TAD I PRASCII /WORD COUNT
DCA TM1
ISZ PRASCII
CDF 10
TAD I TEMP1 /PICK UP FIRST
CDF 0
SZA
JMS I PCH /PRINT IT
ISZ TEMP1
ISZ TM1 /SKIP WHEN DONE
JMP .-7
JMP I PRASCII
/SUBROUTINE TO PUT CURRENT DATE IN PARAMETER BLOCK
DATE, 0
CDF 10
TAD I (7666
DCA I (4512
CDF 0
JMP I DATE
PAGE
/ROUTINE TO CHECK FOR DUP NAMES.
/ENTER WITH HASHED USER ASSIGNED NAME.
NAMCHK, 0
CIA /NEGATE FOR CHECK
DCA NM4 /TEMP STORAGE
TAD (USEDL-1 /USED NAMES LIST
DCA PRXR /POINTER
TAD I PRXR /GET A USED NAME
SNA /SKIP IF ONE THERE
JMP I NAMCHK /NO CONFLICT
TAD NM4 /FOR COMPARISON
SZA CLA /A MATCH?
JMP .-5 /NO KEEP GOING
JMS I PRMSG /A CONFLICT
NM1 /TELL HIM HIS NAME
JMS I PRMSG /AND THAT IT CONFLICTS
NCONF / CONFLICTS WITH
TAD PRXR /CALC ADD OF USED
TAD (-USEDL /PRM NAME
DCA NM4 /TEMP STORAGE
TAD NM4 /3-WORDS/NAME
RAL CLL /*2
TAD NM4 /*3
TAD (USEDN /POINT TO USED NAMES
DCA .+2 /FOR MESSAGE
JMS I PRMSG
USEDN
JMS I CRLF
JMS I PRMSG
MAGAIN /TRY AGAIN?
JMS I (YESORNO
JMP UDL4 /YES
JMP I NAMCHK /NO
/WAIT FOR KEYSTRUCK
TTYWAI, 0
KSF
JMP .-1
KCC
JMP I TTYWAIT
PAGE
/STANDARD DEVICE LENGTH TABLES.
/USERS MAY CHANGE THIS TABLE TO MAKE
/NON-STANDARD DEVICES STANDARD.
LENTBL, 0;0;0;0;0;1520 /RK8 (3248)
6000;4000;2000;1 /RF08 VARIOUS SIZES
7601;7401;7201;7001 /DF32 VARIOUS SIZES
6437;6437 /DECTAPE AND LINCTAPE
0 /MAGTAPE??
6437 /TD8E DECTAPE
ZBLOCK 60 /OTHERS
/REVERSE ORDER SYSTEM TABLE
HLP10E;HLP10D;HLP10C;HLP10B;HLP10A
SYSTBL=.-1
MNOINP, TEXT NOT NEUMERIC INPUT
YESNO, TEXT PLEASE ANSWER YES OR NO
WNTHLP, TEXT DO YOU WANT HELP?
MYES, TEXT YES
MNO, TEXT NO
HEAD1, TEXT THIS PROGRAM ESTABLISHES A PARAMETER BLOCK
HEAD2, TEXT ON DECSYSTEM-8 FILE STRUCTURED DEVICES
HEAD3, TEXT INPUT IS VIA THE REGULAR MONITOR LINE SCANNER
MESDEV, TEXT DEVICE NAME
MGOOF1, TEXT ?BAD INPUT
MNFLST, TEXT DEVICE NOT FILE STRUCTURED
MILLEG, TEXT DIRECTORY OCCUPIES PARAMETER BLOCK
MHAVPA, TEXT DEVICE HAS PARAMETER BLOCK
MDUMP, TEXT DO YOU WISH TO DUMP IT?
MESS0, TEXT HANDLER ERROR READING BLOCKS 1-6 (PARITY?)
MESS1, TEXT SHALL I CONTINUE?
MESS2, TEXT DIRECTORY WILL BE ZEROED
MESS3, TEXT STANDARD DEVICE LENGTH?
HELP3, TEXT MOST DEVICES HAVE A STANDARD LENGTH
HELP3A, TEXT ANSWER YES TO THE NEXT QUESTION
HELP3B, TEXT UNLESS YOU HAVE A NON-STANDARD DEVICE.
HELP3C, TEXT STANDARD DEVICES ARE:
HELP3D, TEXT DTAN,LTAN,DF32,RF08,RK8,TD8E
MESS4, TEXT DEVICE LENGTH (DECIMAL)
MESS5, TEXT SHALL I USE STANDARD SQUASH AND ZERO PARAMETERS?
HELP5A, TEXT FOR "SQUASH" AND "ZERO" THE FOLLOWING ARE OPTIONS:
HELP5B, TEXT NO "ZERO" ALLOWED
HELP5D, TEXT ONLY "SQUASH" TO MYSELF
HELP5C, TEXT NO "SQUASH" PERIOD
HELP5E, TEXT STANDARD IS ONLY SELF SQUASH, NO ZERO
MESS6, TEXT "ZERO" ALLOWED?
MESS7, TEXT "SQUASH" FROM OTHER DEVICE ALLOWED?
MESS8, TEXT "SQUASH" TO MYSELF?
MESS9, TEXT IS A SYSTEM PRESENT?
MESS10, TEXT SYSTEM ID
HLP10A, TEXT 0=UNASSIGNED
HLP10B, TEXT 1=PS/8
HLP10C, TEXT 2=OS/8
HLP10D, TEXT 3=OS/12
HLP10E, TEXT 4=DECSYSTEM-8
MESS11, TEXT VERSION NUMBER (ASSOCIATED WITH SYSTEM AREA)
MESS12, TEXT VERSION RELEASE NUMBER
MESS13, TEXT USER ASSIGNED DEVICE NAME
HLP12A, TEXT THE USER ASSIGNED NAME IS A LOGICAL NAME USED
HLP12B, TEXT BY AUTOAS. IT IS RECOMMENDED THAT THIS NAME
HLP12C, TEXT BE A TWO CHARACTER NAME STARTING WITH AN ALPHA
HLP12D, TEXT TO INSURE UNIQUENESS.
MESS14, TEXT VOLUME ID
HLP13A, TEXT THE VOLUME ID IS AN EXTRA LABLE FOR IDENTIFICATION
HLP13B, TEXT PURPOSES ONLY. A DECIMAL NUMBER < 4096
MESS15, TEXT DESCRIPTIVE LABEL
HLP15, TEXT THE DESCRIPTIVE LABEL MAY BE ANY STRING OF
HLP15B, TEXT UP TO 127 CHARACTERS ON MULTIPLE LINES
HLP15C, TEXT IT MUST BE TERMINATED WITH A Z (CNT/Z)
HLP15D, TEXT FOLLOWED BY A CARRIAGE RETURN.
MESS16, TEXT MORE THAN 128 CHARS INPUT - TERMINATION FORCED
MESS20, TEXT ALL FORMS OF "SQUASH" ALLOWED
MESS21, TEXT VERSION: MARK
MES22A, TEXT USE STANDARD START OF FILE STORAGE?
MESS22, TEXT FILE STORAGE STARTS AT BLOCK (DECIMAL)
MESS23, TEXT NO SYSTEM PRESENT
HLP24A, TEXT THE NEXT PARAMETER IS USED FOR "ZERO" TO DETERMINE
HLP24B, TEXT WHERE FILE STORAGE BEGINS
HLP24C, TEXT STANDARD IS 7 FOR NON-SYSTEM DEVICES,
HLP24D, TEXT 56 FOR SYSTEM DEVICES
MLOCK8, TEXT MMMM!! THAT FEELS BETTER!
MLOCK9, TEXT SCRATCH A LITTLE TO THE LEFT....
MMMM, TEXT MMMMMMM!!
MCHANG, TEXT **CHANGE THIS**?
ANSABC, TEXT PLEASE ANSWER A, B, OR C
MESS25, TEXT DO YOU WISH TO
MESS26, TEXT A:REPLACE
MESS27, TEXT B:SELECTIVELY DECIDE
MESS28, TEXT C:PRINT IT?
MLOCK1, TEXT PLEASE WRITE ENABLE THE DEVICE
MLOCK2, TEXT OUCH!!
MLOCK3, TEXT YOU FORGOT SOMETHING.
MTHANK, TEXT THANKS!
MLOCK4, TEXT CLUE: YOU NEED TO PRESS A SWITCH
MLOCK5, TEXT YOU DUMMY! I CAN'T DO EVERYTHING
MLOCK6, TEXT THE DEVICE NEEDS TO BE WRITE ENABLED
MLOCK7, TEXT NEXT TIME GET HELP!
MAGAIN, TEXT TRY AGAIN?
NCONF, TEXT CONFLICTS WITH
/TABLE OF USED PERMANENT DEVICE NAMES
USEDL,
4631 /SYS
5723 /DSK
5524 /TTY
4020 /LPT
4024 /PTP
4224 /PTR
6504 /CDR
4604;4605;4606;4607;4610;4611;4612;4613 /DTAX
5604;5605;5606;5607;5610;5611;5612;5613 /LTAX
0 /ENDS LIST
/TABLE OF USED DEVICE NAMES
USEDN,
DEVICE SYS;0
DEVICE DSK;0
DEVICE TTY;0
DEVICE LPT;0
DEVICE PTP;0
DEVICE PTR;0
DEVICE CDR;0
DEVICE DTA0;0
DEVICE DTA1;0
DEVICE DTA2;0
DEVICE DTA3;0
DEVICE DTA4;0
DEVICE DTA5;0
DEVICE DTA6;0
DEVICE DTA7;0
DEVICE LTA0;0
DEVICE LTA1;0
DEVICE LTA2;0
DEVICE LTA3;0
DEVICE LTA4;0
DEVICE LTA5;0
DEVICE LTA6;0
DEVICE LTA7;0
$