Trailing-Edge
-
PDP-10 Archives
-
decuslib10-02
-
43,50233/uset.mac
There are no other files named uset.mac in the archive.
TITLE USET LOW LEVEL DISK MANIPULATOR.
SUBTTL THE HATFIELD POLYTECHNIC COMPUTER CENTRE--C.MITCHELL 1971
;ACCUMULATORS.
Q=0
A=1
B=2
C=3
X=4
Z=5
SUP=6
TEMP=7 ;MUST BE 7
READ=10
SAME=11
FIND=12
TEMP1=13
TEMP2=14
TEST1=15
K=16
P=17
;UUO'S
OPDEF MESS[BYTE(9)1]
OPDEF CHRIN[BYTE(9)2]
OPDEF HOMUP[BYTE(9)3]
OPDEF NHOMUP[BYTE(9)4]
OPDEF CHROUT[BYTE(9)5]
EXTERN JOBFF
TWOSEGS
PAGE
RELOC 400000
GSTART: MOVSI FIND,(SIXBIT /001/)
MOVEM FIND,EXT ;SET UP EXTENSION
MOVE FIND,[SIXBIT /USETI/]
MOVEM FIND,INFL
MOVE FIND,[SIXBIT /USETO/]
MOVEM FIND,OUTFL
MOVEI FIND,17 ;SET CHANNELS FOR DUMP MODE
MOVEM FIND,CH2 ;ONE
MOVEM FIND,CH3 ;THEN THE OTHER
MOVE FIND,[IOWD 200,BLKBUF]
MOVEM FIND,COPYBK ;SET UP IOWDS IN LOW SEGMENT
HRLI FIND,-^D25600
MOVEM FIND,COPYST ;BOTH OF THEM
SETZB FIND,READ
START: CALLI 0 ;RESET
MOVE P,PLIST ;SET UP PUSH DOWN POINTER.
INIT 1,1 ;FIRST TRY USET
USTDEV: SIXBIT /USET/
XWD 0,ITTY ;INPUT FIRST
JRST USETTY ;STRUCTURE DOES NOT EXIST
INIT 4,0 ;NOW ONE FOR OUTPUT
SIXBIT /USET/
XWD OTTY,0
JRST USETTY ;STRANGE!!!!!!
JRST SETBUF ;O.K. SO SET UP BUFFERS
USETTY: INIT 1,1 ;OPEN INPUT SIDE
TTDEV: SIXBIT /TTY/ ;TELETYPE.
XWD 0,ITTY ;INPUT ONLY
JRST ERR1 ;CANNOT
INIT 4,0 ;OPEN OUTPUT SIDE
SIXBIT /TTY/ ;TTY
XWD OTTY,0 ;OUTPUT ONLY
JRST ERR1 ;CANNOT
SETBUF: MOVEI A,TTYBUF ;SET FOR OUTPUT
EXCH A,JOBFF ;FOOL MONITOR.
OUTBUF 4,1 ;ONE BUFFER.
MOVEI B,TTYBUF+203 ;AND INPUT
MOVEM B,JOBFF ;STORE LIMIT
INBUF 1,1 ;ONE BUFFER.
EXCH A,JOBFF ;RESET JOBFF
MOVE A,[PUSHJ P,UUOH];SET UP LOC 41
MOVEM A,41 ;FOR UUO'S
MOVE A,EXT ;GET EXTENSION
MOVEM A,INFL+1 ;MODIFY INPUT FILE NAME
MOVEM A,OUTFL+1 ;AND OUTPUT FILE NAME
LOOKUP 1,INFL ;LOOKUP FILE
CALLI 12 ;OUT
ENTER 4,OUTFL ;ENTER RESULTS.
JRST ERR1 ;FAILED
MOVE A,USTDEV ;GET USETI IN A
CALLI A,4 ;GET CHARACTERISTICS
JUMPN A,CLRTFL ;EXISTS
MOVE A,TTDEV
CALLI A,4 ;GET DEVICE CHARACTERISTICS
CLRTFL: SETZM TTYP ;CLEAR TTY FLAG IN CASE
TLNE A,10 ;TTY?
SETOM TTYP ;YES!
NXTCMM: MESS STRWRD ;OUTPUT CRLF*
GETSH: CHRIN A ;GET CHAR IN A.
MOVEI C,BOTTAB ;SET FOR COMMAND SCAN.
SCAN: LDB B,[XWD 350700,(C)];GET CHAR FROM TABLE.
JUMPE B,BAD ;ZERO MEANS END
CAMN B,A ;MATCH?
JRST @(C) ;DISPATCH
AOJA C,SCAN ;KEEP GOING
BAD: MESS [ASCIZ/
ILLEGAL COMMAND
/]
NEWFL: MOVSI A,1 ;GET 1 IN LH
ADDM A,EXT ;BUMP EXTENSION
RELEASE 1, ;CLOSE UP
RELEASE 4, ;BOTH CHANNELS
SETZM INFL+2
SETZM INFL+3
SETZM OUTFL+2
SETZM OUTFL+3
JRST START ;RESTART
NXTCM: PUSHJ P,GARB ;CLEAR UP
MOVE P,PLIST ;SET UP PUSH DOWN POINTER
JRST NXTCMM ;GET NEXT COMMAND
BOTTAB: XWD 15_13,GETSH ;IGNORE CR
XWD 12_13,NXTCMM ;GET NEXT COMMAND.
XWD "R"_13,READD ;READ A BLOCK
XWD "W"_13,WRITE ;WRITE A BLOCK
XWD "E"_13,EXAMIN ;EXAMINE THE LOCATION
XWD "D"_13,DEPOSI ;DEPOSIT IN LOCATION
XWD "S"_13,SEARCH ;SEARCH FOR WORD.
XWD "L"_13,LIST ;LIST CURRENT MODES.
XWD "C"_13,COPY ;COPY DSK TO DSK
XWD "F"_13,NEWFL ;EXIT
XWD "P"_13,POINTR ;SET RETRIEVAL POINTER
XWD "G"_13,GROPE ;GROE AROUND
XWD "H"_13,CHOME ;CHANGE HOM BLOCK
Z ;ZERO MEANS END.
PAGE
UUOH: PUSH P,A ;STORE A
LDB A,[XWD 331100,40];GET UUO NUMBER.
CAIG A,TOPUUO ;IN RANGE?
JRST @UUOTAB-1(A) ;DISPATCH
OUTUUO: POP P,A ;RESTORE A
POPJ P, ;AND RETURN
UUOTAB: Z MESSG ;OUTPUT MESSAGE
Z CHIN ;INPUT CHARACTER.
Z HOMUPD ;UPDATE SIXBIT HOM ENTRY
Z NHOMD ;UPDATE NUMERICAL HOM ENTRY
Z CHOUT ;OUTPUT CHARACTER.
TOPTAB:
TOPUUO=TOPTAB-UUOTAB
MESSG: PUSH P,B ;SAVE B
MOVSI B,440700 ;SET UP BP
HRR B,40 ;WITH MESSAGE
KEPON: ILDB A,B ;GET CHAR.
JUMPE A,FINUP ;ALL DONE
SOSG OTTY+2 ;SPACE LEFT?
OUTPUT 4, ;NO
IDPB A,OTTY+1 ;STORE CHAR.
JRST KEPON ;KEEP GOING
FINUP: SKIPE TTYP ;DON'T FORCE OUTPUT UNLESS TTY
OUTPUT 4, ;CLEAR UP
POP P,B ;RESTORE B
JRST OUTUUO ;RETURN.
CHIN: SOSL ITTY+2 ;CHARS THERE?
JRST LFDEF ;YES
IN 1, ;GET SOME THEN
JRST YUP ;O.K.
STATZ 1,740000 ;ERROR?
JRST ERR1 ;YES
LFDEF: SKIPE CLRUP ;SKIP IF CLEARED UP
SKIPE ITTY+2 ;SKIP IF EXACTLY ZERO
JRST YUP ;ELSE GET CHAR
MOVEI A,12 ;LINE FEED DEFAULT (AL MODE)
JRST OUTCR ;EXIT
YUP: ILDB A,ITTY+1 ;GET CHAR
JUMPE A,CHIN ;FORGET NULLS
OUTCR: SETZM CLRUP ;UNSET CLEAR FLAG
EXCH A,(P) ;EXCHANGE A WITH TOP OF STACK
POP P,@40 ;CLEVER?
SKIPE TTYP ;SKIP IF NOT TTY
JRST OUTUUO+1 ;RETURN
PUSH P,A ;ELSE PRINT INPUT IN THE LOG FILE
CHOUT: MOVE A,@40 ;GET CHAR.
SOSG OTTY+2 ;ROOM?
OUTPUT 4, ;NO
IDPB A,OTTY+1 ;STORE BYTE
JRST OUTUUO ;RETURN.
;ADDRESS ON TOP OF STACK,MESS IN 40
HOMUPD: MOVE A,@(P) ;GET CONTENTS OF HOM ENTRY
MOVE C,40 ;GET MESS ADDRESS
MESS @C ;PRINT MESSAGE
MESS [ASCIZ/ IS /]
PUSHJ P,SIXOUT ;PRINT SIXBIT
MESS [ASCIZ / /] ;FORCE IT
PUSHJ P,GARB ;CLEAR UP FIRST
PUSHJ P,GETATM ;GET NEW VALUE
SKIPA ;NOT ONE
MOVEM A,@(P) ;STORE NEW VALUE
JRST OUTUUO ;FINISH.
NHOMD: MOVE A,@(P) ;GET CONTENTS OF HOM ENTRY
MOVE C,40 ;GET MESS ADDRESS
MESS @C ;PRINT MESSAGE
MESS [ASCIZ/ IS /]
PUSHJ P,OCTOUT ;PRINT OCTAL NUMBER.
MESS [ASCIZ / O.K.? /]
PUSHJ P,GARB ;CLEAR UP
PUSHJ P,GETNUM ;GET NEW ONE
SKIPA
MOVEM A,@(P) ;STORE VALUE
JRST OUTUUO ;FINISH
EXAMIN: SETZ SUP,0 ;CLEAR ZERO SUPPRESSOR.
PUSHJ P,GETNUM ;GET ADDRESS IN A
JRST DOALL ;DO ALL
CAIG A,177 ;IN RANGE?
JRST PRNTEM ;YES.
JRST BAD ;NO
DOALL: MESS [ASCIZ /
DUMP OF BLOCK /]
MOVE Z,READ ;GET BLOCK NUMBER
PUSHJ P,PRNTIT ;PRINT IT
MESS [ASCIZ / ON DEVICE /]
MOVE A,DEVICE ;GET INPUT DEVICE
PUSHJ P,SIXOUT ;PRINT IT
MESS CARLF ;ONE CR LF THEN--
MESS CARLF ;FINISH OFF
MOVE A,[XWD-200,0] ;SET UP COUNTER.
PRNTEM: PUSHJ P,OUTWRD ;PRINT WORD.
AOBJN A,.-1 ;KEEP GOING
JRST NXTCM ;ALL DONE
DEPOSI: PUSHJ P,GETNUM ;GET FIRST HALF IN A
JRST BAD ;NONE THERE
HRLZ TEMP,A ;PUT IN LEFT HALF
PUSHJ P,GETNUM ;GET SECOND HALF IN A
JRST BAD ;NONE THERE
HRR TEMP,A ;STORE IT
PUSHJ P,GETNUM ;GET ADDRESS
JRST BAD ;NONE THERE!
CAILE A,177 ;IN RANGE?
JRST BAD ;SO NEAR YET ---
MOVEM TEMP,BLKBUF(A) ;IN SHE GOES
JRST NXTCM ;AND OUT
WRITE: PUSHJ P,GETATM ;GET DEVICE IN A
JRST BOOB ;NO DEFAULT
MOVEM A,DEVIDE ;STORE DEVICE
PUSHJ P,GETNUM ;GET ADDRESS
JRST BOOB ;ERROR
OPEN 3,CH3 ;OPEN CHANNEL D
JRST BOOB ;FAILED
USETO 3,A ;SET FOR OUTPUT
MESS [ASCIZ /
WRITE BLOCK NUMBER /]
MOVE Z,A ;GET NUMBER
PUSHJ P,PRNTIT ;PRINT OCTAL NUMBER
MESS [ASCIZ / ON DEVICE /]
MOVE A,DEVIDE ;GET DEVICE
PUSHJ P,SIXOUT ;PRINT DEVICE
MESS [ASCIZ /
CONFIRM?/]
PUSHJ P,GETANS ;GET ANSWER
JRST NXTCM ;NO
OUT 3,COPYBK ;YES
JRST NXTCM ;O.K.
JRST BOOB ;FAILED
SEARCH: PUSHJ P,GETNUM ;GET LEFT HALF
JRST STUPP ;USE PREVIOUS VALUE
JUMPLE K,.+3 ;SKIP IF NOT INDIRECT
MOVE FIND,A ;ELSE GET WHOLE WORD
JRST STUPP ;AND CONTINUE
HRRZ FIND,A ;ELSE STORE LH IN RH
PUSHJ P,GETNUM ;GET RIGHT HALF
SKIPA A,FIND ;ONE HALF ONLY
MOVSS FIND ;SWAP HALVES
HRR FIND,A ;AND STORE RIGHT HALF
STUPP: PUSHJ P,STUP ;SEARCH
JRST NXTCM ;EXIT
STUP: MOVE A,[XWD -200,0] ;SET UP COUNTER
MOVE B,BLKBUF(A) ;GET WORD FROM BUFFER
CAMN B,FIND ;SAME?
PUSHJ P,PNTFND ;YES,PRINT IT
AOBJN A,.-3 ;KEEP MOVING
POPJ P, ;RETURN
READD: PUSHJ P,GETATM ;GET DEVICE IN A
AOJA READ,INUSE ;NONE THERE,BUMP BLK NO.
MOVEM A,DEVICE ;STORE DEVICE
PUSHJ P,GETNUM ;GET BLOCK NO
JRST BOOB ;ILLEGAL
PUSHJ P,INBLK ;READ BLOCK
JRST NXTCM ;EXIT
INUSE: PUSHJ P,INBLK+1 ;READ BLOCK
JRST NXTCM ;GET NEXT
INBLK: MOVEM A,READ ;STORE IT
OPEN 2,CH2 ;OPEN ANOTHER CHANNEL
JRST BOOB ;FAILED
USETI 2,READ ;SET FOR INPUT
IN 2,COPYBK ;READ BLOCK
POPJ P, ;EXIT
BOOB: MESS [ASCIZ /
FAILED!!
/]
JRST NXTCM ;NEXT TRY!
COPY: SETZB SAME,READ ;CLEAR THESE TWO FOR A MO
PUSHJ P,GETATM ;GET"FROM"DEVICE
JRST BAD ;ILLEGAL
MOVEM A,DEV1 ;STORE IT
PUSHJ P,GETATM ;GET "TO" DEVICE
JRST BAD ;ILLEGAL
MOVEM A,DEV2 ;STORE IT
CAIN B,175 ;ALTMODE TERMINATION?
SETOM SAME ;YES,SET FLAG
PUSHJ P,INTAL ;INITIALIZE
MESS [ASCIZ/
COPY FROM DEVICE /]
MOVE A,DEV1 ;GET "FROM"DEVICE
PUSHJ P,SIXOUT ;PRINT IT
MESS [ASCIZ/ TO DEVICE /]
MOVE A,DEV2 ;GET "TO"DEVICE
PUSHJ P,SIXOUT ;PRINT IT
SKIPE SAME ;SKIP IF NOT SAME SET
MESS [ASCIZ / SETTING IDENTITY/]
MESS [ASCIZ /
CONFIRM? /]
MOVEI A,GETANS ;HORRIBLE FUDGE COMING UP
JUMPE SAME,.+2 ;HELP!!!
AOS A ;DO NOT CLEAR UP IF ALTMODE
PUSHJ P,@A ;GET ANSWER
JRST NXTCM ;NO
SKIPE SAME ;RETAINING IDENTITY?
PUSHJ P,CHGHOM ;YES
MOVEI A,BLKBUF+^D25600
CALLI A,11 ;EXPAND!!
JRST BOOB ;CANNOT
SETZM TEMP2 ;CLEAR TEMP ACCUMULATOR
JUMPE SAME,RPTR ;IF NOT READING HOM BLOCK SKIP
USETI 3,[XWD 0,1] ;SET FOR HOM BLOCK
IN 3,COPYBK ;GET HOM
SKIPA B,BLKBUF+1 ;GET UNIT IDENTITY
JRST BOOB ;FAILED TO READ
MOVEM B,ID ;STORE
MOVE B,BLKBUF+4 ;GET STRUCTURE NAME
MOVEM B,STR ;STORE IT
MOVE B,BLKBUF+7 ;GET STRUCTURE NUMBER
MOVEM B,STRNO ;AND STORE IT
MOVE B,BLKBUF+3 ;GET POSITION IN SYS SEARCH LIST
MOVEM B,SYSCH ;SAVE IT
RPTR: USETI 2,READ ;SET FOR INPUT
USETO 3,READ ;SET FOR OUTPUT
IN 2,COPYST ;GET ONE CYLINDER
SKIPA ;OK
JRST SLOW ;FAILED
JUMPE SAME,.+3 ;SKIP IF NOT CONVERTING
MOVEI TEMP,^D200 ;SET FOR CONVERTER.
PUSHJ P,CONVRT ;AND CONVERT
OUT 3,COPYST ;OUTPUT
SKIPA ;OK
JRST SLOW ;SLOW UP
ADDI READ,^D200 ;SET FOR NEXT CYLINDER
TST1: CAIGE READ,^D40000 ;ALL DONE?
JRST RPTR ;NO
JUMPE SAME,COMPRS ;IF NOT RETAINING ID BYPASS
USETI 3,[XWD 0,1] ;ELSE READ HOM BLOCK
IN 3,COPYBK ;GET IT
SKIPA B,ID ;GET ID
JRST BOOB ;FAILED TO READ IT
MOVEM B,BLKBUF+1 ;STORE ID
MOVE B,STR ;GET STRUCTURE
MOVEM B,BLKBUF+4 ;STORE IT
MOVE B,STRNO ;GET STRUCTURE NUMBER
MOVEM B,BLKBUF+7 ;STORE IT
MOVE B,SYSCH ;GET POSITION IN SYS SEARCH LIST
MOVEM B,BLKBUF+3 ;RESTORE IT
PUSHJ P,UPDHOM ;WRITE THEM OUT
COMPRS: MOVEI A,BLKBUF+200 ;SET FOR CORE
CALLI A,11 ;AND SQUEEEZZE!
JRST BOOB ;HELP!
JRST NXTCM+1 ;GET NEXT COMMAND
CHGHOM: USETI 3,[XWD 0,1] ;SET FOR HOM
IN 3,COPYBK ;READ HOM
SKIPA ;OK
JRST BOOB ;FAILED
MESS [ASCIZ /
FOR THE FOLLOWING PARAMETERS TYPE CARRIAGE RETURN IF O.K.
ELSE TYPE THE NEW VALUE
/]
MOVEI A,BLKBUF+1 ;SET FOR ID CHANGE
HOMUP A,[ASCIZ/
UNIT ID/] ;UPDATE UNIT ID
MOVEI A,BLKBUF+4 ;SET FOR STRUCTURE
HOMUP A,[ASCIZ/
STRUCTURE NAME/] ;UPDATE STRUCTURE NAME
MOVEI A,BLKBUF+7 ;SET FOR STRUCTURE NUMBER.
HOMUP A,[ASCIZ/
STRUCTURE NUMBER/] ;UPDATE NUMBER
MOVEI A,BLKBUF+3 ;UPDATE SYS SEARC LIST
NHOMUP A,[ASCIZ/
POSITION IN SYS SEARCH LIST/] ;UPDATE IFNECC
JRST UPDHOM ;WRITE OUT HOME BLOCKS
UPDHOM: USETO 3,[XWD 0,1] ;SET FOR OUTPUT
MOVEI B,1 ;SET FOR FIRST
MOVEM B,BLKBUF+177 ;STORE BLOCK
OUT 3,COPYBK ;WRITE FIRST ONE
SKIPA B,[XWD 0,12] ;SET FOR SECOND
JRST BOOB ;FAILED!
MOVEM B,BLKBUF+177 ;STORE ADDRESS
USETO 3,[XWD 0,12] ;SET FOR OUTPUT
OUT 3,COPYBK ;PRINT IT
POPJ P, ;RETURN
JRST BOOB ;OUT.
SLOW: PUSHJ P,INTAL ;RE-INIT DSKS.
MOVEI A,^D200(READ) ;SET UPPER LIMIT
RPT1: USETI 2,READ ;SET FOR INPUT
USETO 3,READ ;SET FOR OUTPUT
IN 2,COPYBK ;READ ONE BLOCK
SKIPA
PUSHJ P,TELL ;REPORT IT
JUMPE SAME,.+3 ;SKIP IF NOT CONVERTING
MOVEI TEMP,1 ;SET UP
PUSHJ P,CONVRT ;CONVERT
OUT 3,COPYBK ;OUTPUT
SKIPA
PUSHJ P,INTAL ;RE-INIT.
ADDI READ,1 ;BUMP POINTER
CAMGE READ,A ;SKIP IF ALL DONE
JRST RPT1 ;KEEP GOING
JRST TST1 ;BACK TO CYLINDER MODE.
TSTRIB: MOVE TEST1,0(TEMP1) ;GET FIRST WORD OF BLOCK
CAME TEST1,[XWD 777635,33];ONE OF THESE?
JRST NTRIB ;NOT A RIB,THEN
MOVE TEST1,176(TEMP1);GET PENULTIMATE WORD
CAIE TEST1,777777 ;ONE OF THOSE?
JRST NTRIB ;NO
MOVE TEST1,177(TEMP1);GET LAST WORD.
CAMN TEST1,TEMP2 ;THE ACID TEST,SAME BLOCK ADDRESS?
AOS (P) ;BUMP RETURN FOR YES
NTRIB: POPJ P, ;RETURN
CONVRT: MOVEI TEMP1,BLKBUF ;GET BASE ADDRESS
CONV2: PUSHJ P,TSTRIB ;CHECK FOR RIB
JRST NOSTR ;NO
HLRZ TEST1,3(TEMP1) ;GET EXT
CAIN TEST1,(SIXBIT /UFD/)
JRST NOSTR ;UFD
MOVE TEST1,STRNO ;GET STRUCTURE POSITION
MOVEM TEST1,16(TEMP1) ;STORE IT
NOSTR: ADDI TEMP1,200 ;BUMP POINTER.
AOS TEMP2 ;AND BLOCK ADDRESS.
SOJG TEMP,CONV2 ;DO NEXT
POPJ P, ;RETURN.
TELL: MESS [ASCIZ /
BAD BLOCK NUMBER /]
MOVE Z,READ ;GET BLOCK NUMBER
PUSHJ P,PRNTIT ;PRINT IT
MESS [ASCIZ / ON DEVICE /]
PUSH P,A ;SAVE A
MOVE A,DEV1 ;GET DEVICE
PUSHJ P,SIXOUT ;PRINT IT
POP P,A ;RESTORE A
JRST INTAL ;RE-INIT AND EXIT
POINTR: PUSHJ P,GETATM ;GET DEVICE NAME
JRST BAD ;ILLEGAL
MOVEM A,DEVICE ;ELSE STORE IT
PUSHJ P,GETNUM ;GET LEFT HALF
JRST BAD ;ILLEGAL
JUMPLE K,.+3 ;SKIP IF NOT INDIRECT
MOVE TEMP,A ;ELSE GET WHOLE WORD
JRST STPNT ;AND CONTINUE
HRLZ TEMP,A ;STORE IT
PUSHJ P,GETNUM ;GET RIGHT HALF
JRST BAD ;ILLEGAL
HRR TEMP,A ;STORE IT
STPNT: MOVEM TEMP,POINAR+4 ;RETAIN
PUSHJ P,GETDSK ;GET DISK CHARACTERISTICS
MESS [ASCIZ /
POINTER SHOWS /]
LDB Z,POINAR ;GET CLUSTER COUNT
PUSHJ P,PRNTIT ;PRINT IT
MESS [ASCIZ /CLUSTERS (/]
IMUL Z,POINAR+3 ;CONVERT TO BLOCKS
PUSHJ P,PRNTIT ;PRINT IT
MESS [ASCIZ /BLOCKS) STARTING AT BLOCK NUMBER /]
LDB Z,POINAR+2 ;GET LOGICAL ADDRESS
IMUL Z,POINAR+3 ;CONVERT TO BLOCKS
PUSHJ P,PRNTIT ;PRINT IT
MESS CARLF ;FINISH OFF
JRST NXTCM ;EXIT
GETDSK: MOVEI A,1 ;SET FOR HOME BLOCK
EXCH A,READ ;RETAIN OLD BLOCK NUMBER
PUSHJ P,INBLK+1 ;READ BLOCK
EXCH A,READ ;RESET
MOVE A,[XWD BLKBUF+16,POINAR] ;SET FOR BLT
BLT A,POINAR+3 ;AND BLTIT
JRST INBLK+1 ;RE-READ BLOCK AND RETURN
CHKSUM: SKIPE SUMCHK ;SKIP IF FIRST ONE
POPJ P, ;ELSE IGNORE IT
MOVE TEMP,BLKBUF ;GET FIRST WORD
MOVE B,POINAR+1 ;GET BYTE POINTER
LDB C,[POINT 6,B,11];GET SIZE OF CHECKSUM FIELD
MOVNS C ;NEGATE IT
TLZA B,770000 ;SET FOR BIT 35
CHKSM1: ADD TEMP,K ;SECOND TIME AROUND ADD BYTE
LDB K,B ;ELSE GET BYTE
LSH TEMP,(C) ;LOSE BYTE
JUMPN TEMP,CHKSM1 ;KEEP GOING IF MORE
JUMPE K,.+3 ;SKIP IF ZERO
MOVEM K,SUMCHK ;ELSE STORE SUMCHK
POPJ P, ;AND RETURN
SETOM SUMCHK ;FLAG ZERO SUMCHK
POPJ P,
GROPE: SKIPN POINAR+4 ;POINTER SET?
JRST DOPFST ;NO TELL HIM
PUSHJ P,GETNUM ;NEW SEARCH WORD
JRST GRP ;NO
JUMPLE K,.+3 ;SKIP IF NOT INDIRECT
MOVE FIND,A ;ELSE GET WHOLE WORD
JRST GRP ;AND CONTINUE
HRRZ FIND,A ;GET FIRST HALF
PUSHJ P,GETNUM ;GET NEXT HALF
SKIPA A,FIND ;NONE THERE
MOVSS FIND ;ELSE SWAP HALVES
HRR FIND,A ;SET RIGHT HALF
GRP: MOVE TEMP,POINAR+4 ;GET POINTER
LDB TEMP2,POINAR+2 ;GETT START BLOCK
IMUL TEMP2,POINAR+3 ;CONVERT TO PHYSICAL BLOCK NUMBER
LDB Q,POINAR ;GET CLUSTER COUNT
IMUL Q,POINAR+3 ;CONVERT TO BLOCKS
SETZM SUMCHK ;CLEAR CHECK SUM
HEDER: MOVE A,TEMP2 ;GET BLOCK NUMBER
PUSHJ P,INBLK ;READ IT
SETOM PNTHDD ;SET FLAG
PUSHJ P,STUP ;SEARCH IT
MOVEI TEMP1,BLKBUF ;SET BASE OF BUFFER
PUSHJ P,TSTRIB ;RIB?
PUSHJ P,CHKSUM ;CHECKSUM IT
AOS TEMP2 ;BUMP READ
SOJG Q,HEDER ;MORE TO DO?
SETZM PNTHDD ;CLEAR FLAG
MESS [ASCIZ /
CFP IS /]
MOVE TEMP,POINAR+4 ;GET POINTER
SETCM A,SUMCHK ;GET COMPLEMENT OF SUMCHK
SKIPN A ;SKIP IF NOT ZERO
SETZM SUMCHK ;ELSE CLEAR SUMCHK
LDB A,POINAR+1 ;GET CHECKSUM
CAME A,SUMCHK ;SAME?
JRST .+3 ;NO
MESS [ASCIZ /CORRECT
/]
JRST NXTCM ;GET NEXT COMMAND
MOVE A,SUMCHK ;GET CHECKSUM
DPB A,POINAR+1 ;STORE IT
MESS [ASCIZ /INCORRECT
CORRECT VERSION IS /]
HLRZ Z,TEMP ;GET LEFT HALF
PUSHJ P,PRINIT ;PRINT IT
HRRZ Z,TEMP ;GET RIGHT HALF
PUSHJ P,PRINIT ;PRINT IT
MESS CARLFLF ;FINISH UP
JRST NXTCM ;EXIT
DOPFST: MESS [ASCIZ /
PLEASE SET POINTER FIRST
/]
JRST NXTCM
CHOME: PUSHJ P,GETATM ;GET DEVICE
JRST BAD ;NONE THERE
MOVEM A,DEV2 ;STORE IT
OPEN 3,CH3 ;OPEN A CHANNEL
JRST BOOB ;CANNOT
PUSHJ P,CHGHOM ;CHANGE HOM BLOCKS
JRST NXTCM ;NEXT PLEASE
PNTFND: SKIPN PNTHDD ;PRINT HEADER?
JRST JSTNUM ;NO
SETZM PNTHDD ;CLEAR FLAG
MESS [ASCIZ /
BLOCK NUMBER /]
MOVE Z,READ ;GET BLOCK NUMBER
PUSHJ P,PRNTIT ;PRINT IT
MESS CARLFLF
JSTNUM: MOVE Z,A ;GET WORD ADDRESS
JRST PRNTIT ;PRINT IT
PAGE
GETATM: SETZ A,0 ;CLEAR A
MOVE X,[XWD 440600,A];SET UP BP
NEXT: CHRIN Z ;GET CHR IN Z
CAIL Z,"0" ;DIGIT?
CAILE Z,"9" ;ANY OF THEM?
SKIPA ;NO
JRST OMIT ;YES
CAIL Z,"A" ;LETTER?
CAILE Z,"Z" ;ANY OF THEM
JRST DONE ;NO
OMIT: SUBI Z,40 ;SIXBITIT
TLNE X,770000 ;ALL IN?
IDPB Z,X ;NO,STORE IT
JRST NEXT ;GET NEXT
DONE: CAIN Z,40 ;SPACE
JUMPE A,NEXT ;IF LEADING,IGNORE
MOVE B,Z ;LAST CHAR IN B
SKIPE A ;SKIP IF ONE NOT FOUND
AOS (P) ;SKIP RETURN
POPJ P, ;RETURN.
GETNUM: SETZB A,K ;CLEAR A
TAGN: CHRIN Z ;GET CHAR IN Z
CAIL Z,"0" ;DIGIT
CAILE Z,"7" ;ANY OF THEM(OCTAL)
JRST DUN ;NO
LSH A,3 ;LEFT SHIFT A
SUBI Z,60 ;DIGITISE IT
SETOM K ;SET K
ADD A,Z ;ADD IT IN
JRST TAGN ;GET NEXT
DUN: CAIE Z,"@" ;INDIRECT?
JRST .+3 ;NO
MOVE A,BLKBUF(A) ;GET ENTRY FROM BUFFER
MOVEM Z,K ;SET INDIRECT FLAG
JUMPN K,CPOPJ ;SKIP IF NUMBER PRESENT
CAIN Z,40 ;SKIP IF NOT SPACE
JRST TAGN ;IGNORE LEADERS
CAIE Z,"/" ;SLASH?
JRST .+3 ;NO
MOVE X,[XWD 220600,A];SET MINI BP
JRST NEXT ;GET SIXBIT CHARS
CAIE Z,15 ;CR?
CAIN Z,12 ;LF?
JUMPE K,.+2 ;SKIP IF NUMBER FOUND.
CPOPJ: AOS (P) ;SKIP RETURN WITH NUMBER
TPOPJ: POPJ P, ;RETURN
OUTWRD: ;OCTAL DUMP WORD IN BUFFER
;INDEXED BY A.
MOVE B,BLKBUF(A) ;GET WORD
JUMPN B,NOTZER ;SKIP IF NOT ZERO
JUMPN SUP,TPOPJ ;OUT IF SUPPRESSING.
SETO SUP,0 ;ELSE SET SUP.
JRST CRLF ;AND PRINT ONLY CRLF
NOTZER: SETZ SUP,0 ;CLEAR SUPPRESSOR.
SETOM SUPRES ;SET FLAG
HRRZ Z,A ;GET ADDRESS
PUSHJ P,PRINIT ;PRINT IT
HLRZ Z,B ;GET LH OF WORD.
PUSHJ P,PRINIT ;PRINT IT
HRRZ Z,B ;GET RH OF WORD
PUSHJ P,PRINIT ;PRINT IT
CRLF: MESS CARLF ;PRINT CARLF
POPJ P, ;RETURN
PRNTIT: SETZM SUPRES ;DON'T WANT LEADING ZEROS
PRINIT: MOVE X,[XWD 220300,Z];SET BP
GETCH: ILDB C,X ;GET DIGIT
JUMPN C,.+3 ;SKIP IF NOT ZERO
SKIPN SUPRES ;SKIP IF NOT SUPRESSING
JRST TESTMR ;ELSE IGNORE IT
PNTLST: SETOM SUPRES ;AND SET FLAG
ADDI C,60 ;ASCIIFY IT
CHROUT C ;OUTPUT CHAR.
TESTMR: TLNE X,770000 ;ALL DONE?
JRST GETCH ;GET NEXT
SKIPN SUPRES ;SKIP IF CHAR PRODUCED
JRST PNTLST ;ELSE PRINT ZERO
SPSOUT: CHROUT [EXP 40] ;PRINT SPACE
POPJ P, ;RETURN
PAGE
ERR1: TTCALL 3,[ASCIZ/
CANNOT INIT TTY CHANNEL
/]
CALLI 12 ;EXIT
GARB: SETOM CLRUP ;SET CLEAR UP
CHRIN A ;GET CHAR
CAIE A,12 ;LF?
JRST GARB ;NO
POPJ P, ;RETURN.
LIST: MESS [ASCIZ/
CURRENT INPUT DEVICE /]
MOVE A,DEVICE ;GET DEVICE
PUSHJ P,SIXOUT ;PRINT NAME
MESS [ASCIZ/
LAST BLOCK READ WAS /]
MOVE Z,READ ;GET NUMBER
PUSHJ P,PRNTIT ;PRINT IT
MESS [ASCIZ/
CURRENT SEARCH WORD /]
HLRZ Z,FIND
PUSHJ P,PRINIT ;PRINT IT
HRRZ Z,FIND ;GET RIGHT HALF
PUSHJ P,PRINIT ;PRINT IT
MESS CARLFLF
JRST NXTCM ;GET NEXT COMMAND.
SIXOUT: MOVE X,[XWD 440600,A];SET BP
ILDB C,X ;GET CHAR.
ADDI C,40 ;ASCIIFY IT
CHROUT C ;PRINT CHAR.
TLNE X,770000 ;ALL DONE?
JRST SIXOUT+1 ;DO NEXT
JRST SPSOUT ;PRINT SPACE
OCTOUT: HLRZ Z,A ;GET LEFT HALF
SETOM SUPRES ;FORCE 12 CHARS
PUSHJ P,PRINIT ;PRINTIT
HRRZ Z,A ;GET RIGHT HALF
JRST PRINIT ;PRINTIT AND RETURN.
GETANS: PUSHJ P,GARB ;CLEAR UP
CHRIN Z ;GET CHAR
CAIN Z,"Y" ;YES?
AOSA (P) ;SKIP
CAIN Z,"N" ;NO?
POPJ P, ;RETURN
MESS [ASCIZ/
PLEASE ANSWER Y OR N
?/]
JRST GETANS+1 ;TRY AGAIN.
INTAL: OPEN 2,CH2 ;OPENINPUT CHANNEL
JRST BAD ;CANNOT
OPEN 3,CH3 ;AND THE OUTPUT CHANNEL
JRST BAD ;CANNOT
POPJ P, ;RETURN
PAGE
;I/0 LISTS ETC
PLIST: IOWD 10,STACK ;PUSH DOWN POINTER
STRWRD: XWD 064245,200000 ;CR LF*
CARLFL: XWD 064241,200000 ;CR LF LF
CARLF: XWD 064240,0 ;CR LF
LIT ;EXPAND LITERALS HERE
PAGE
;WORK AREA
RELOC 0
COPYBK: BLOCK 2
COPYST: BLOCK 2
CH2: BLOCK 1
DEVICE:
DEV1: BLOCK 1
BLOCK 1
CH3: BLOCK 1
DEVIDE:
DEV2: BLOCK 1
BLOCK 1
INFL: BLOCK 4
OUTFL: BLOCK 4
EXT: BLOCK 1
STR: BLOCK 1 ;FOR FILE STRUCTURE NAME
STRNO: BLOCK 1 ;FOR FILE STRUCTURE NUMBER
ID: BLOCK 1 ;UNIT IDENTITY
SYSCH: BLOCK 1 ;SYS SEARCH LIST POSITION
CLRUP: BLOCK 1
TTYP: BLOCK 1 ;IF NON ZERO OUTPUT IS TO TTY
SUPRES: BLOCK 1 ;IF ZERO SUPRESS LEADING 0'S
PNTHDD: BLOCK 1
SUMCHK: BLOCK 1
POINAR: BLOCK 5 ;CONTAINS DISK CHARACTERISTICS FROM HOM
ITTY: BLOCK 3 ;INPUT BUFFER HEADER
OTTY: BLOCK 3 ;OUTPUT BUFFER HEADER
TTYBUF: BLOCK 406 ;INPUT/OUTPUT BUFFERS.
STACK: BLOCK 10 ;PUSH DOWN STACK
BLKBUF: BLOCK 200 ;EXPANDIBLE BUFFER.
RELOC
END GSTART