Trailing-Edge
-
PDP-10 Archives
-
bb-x130a-sb
-
pivot.mac
There are 5 other files named pivot.mac in the archive. Click here to see a list.
TITLE PIVOT
SUBTTL DEFINITIONS
SEARCH JOBDAT,UUOSYM
TWOSEG
SALL
;STEPHEN WOLFE
;SOFTWARE SERVICES
;DIGITAL EQUIPMENT CORPORATION
;MR1-1/S43
;AC'S
F=0 ;FLAGS
T1=1 ;TEMPS
T2=T1+1
T3=T2+1
T4=T3+1
P1=5 ;PRESERVED
C=10 ;CURRENT CHAR
L=11 ;BP ASCII LINE
P=17 ;PDL
;I/O CHANNELS
U.CHN==1 ;TO READ USER-NAME FILE
;FLAGS
F.CCL==1 ;CCL ENTRY
F.TRM==2 ;TRMOP SUCCESS
F.TMP==4 ;TMPCOR ENTRY FOUND
F.SCN==10 ;PPN FOUND BY RESCAN
F.PVT==20 ;WE'RE PIVOTING
F.RUN==40 ;RUN FROM A "RUN" COMMAND
;ASSEMBLY PARAMETERS
PDLSIZ==20 ;SIZE OF PDL
IFNDEF BRKMSK<BRKMSK=1401016200>;MASK FOR BREAK CHARS
IFNDEF FTTRM<FTTRM==0> ;TRMOP THE OPR
IFNDEF FTLB<FTLB==0> ;SNITCH TO LITTLE BROTHER
IFNDEF %SILB<%SILB=<XWD 21,.GTSID>>;GETTAB FOR LB'S PID
IFNDEF LBPVT<LBPVT==17> ;CODE NUMBER
IFNDEF SFDS<SFDS==10> ;LEVELS OF SFD'S
IFNDEF FTCHG<FTCHG==-1> ;USE CHGPPN INSTEAD OF POKE
LINSIZ==^D60/5 ;SIZE OF LINE
BUFSIZ==SFDS+4 ;NUMBER TMPCOR&PATH WORDS
;OP CODES
OPDEF ERR[1B8] ;ERROR UUO
;MACROS
DEFINE ERROR(AA,BB,CC)<
ERR [<SIXBIT /AA/>+BB
ASCIZ /CC/]>
SUBTTL EDIT HISTORY
;VERSION
VWHO==0
VMAJOR==5
VMINOR==0
VEDIT==6
VEDIT==7 ;TRMOP. "OPR0" INSTEAD OF "OPR1"
;MAKE "OPR0" PHYSICAL ONLY
VEDIT==10 ;ONLY CHANGE SCAN WHEN PIVOTING
;BACK TO ORIGINAL PATH
VEDIT==11 ;LOTS OF PEOPLE USE PIVOT AS
;A CCL VERSION OF SETSRC.
;DON'T DO THE POKE IF ONLY CHANGING
;SFD (I.E. NOT CHANGING PPN).
;AND DON'T DO THE TRMOP.
VEDIT==12 ;AND ^R AS BREAK CHAR (IN CASE
;TTY IS SET RTCOMP)
VEDIT==13 ;7.00 LOGICALS, MORE EXPLICIT TYPEOUT,
;PIVOT & WHEEL USE SAME TMPCOR FILE.
VEDIT==14 ;PIVOT & WHEEL SAME PROGRAM
VEDIT==15 ;CLEAN UP THE CODE THAT IPC ADDED
VEDIT==16 ;ADD USER-NAMES, READ PIVOT.NMS
LOC .JBVER
BYTE (3)VWHO(9)VMAJOR(6)VMINOR(18)VEDIT
LOC .JB41
JRST VERBO
;PIVOT IS A CUSP TO CHANGE YOUR PPN TO [1,2] AND BACK.
;THE FIRST TIME PIVOT IS RUN, IT WRITES YOUR OLD PPN
;AND PATH TO TMPCOR, POKES YOUR PPN TO [1,2], AND
;CHANGES YOUR PATH TO [1,2].
;THE SECOND TIME PIVOT IS RUN, IT READS YOUR OLD PPN AND PATH
;FROM TMPCOR AND RESTORES THEM. TO KEEP TRACK OF WHICH
;IS HAPPENING, PIVOT ALWAYS TELLS YOU WHAT PPN YOU ARE BECOMING
;OPTIONALLY YOU CAN USE PIVOT TO CHANGE TO ANY PPN AND BACK.
;ADD "-[P,PN]" TO THE END OF THE RUN COMMAND.
;IF A TMPCOR ENTRY ALREADY EXISTS, IT WILL NOT BE OVERWRITEN.
;THUS YOU CAN PIVOT FROM PPN TO PPN AND STILL RETURN TO THE ORIGINAL
;PPN
;FORMAT OF THE TMPCOR FILE:
;WORD 0=PPN (JBTPPN TYPE)
;WORD 1=SCANNING SWITCH (PATH UUO)
;WORD 2=PPN (PATH TYPE)
;WORD 3=SFD 1
;WORD N=SFD N-2
;IF THERE IS NO ROOM IN TMPCOR, DISK IS NOT USED INSTEAD.
SUBTTL DATA AREAS
RELOC 0
MFDPPN: BLOCK 1 ;[1,1] PPN
PDL: BLOCK PDLSIZ ;PUSH DOWN LIST
BUF: BLOCK BUFSIZ ;PATH BLOCK AND TMPCOR BUF
TPTH: BLOCK BUFSIZ ;TARGET PATH
LINE: BLOCK LINSIZ ;LINE OF ASCII TEXT
PKBLK: BLOCK 3 ;POKE BLOCK
IFN FTLB<
IPCSIZ==5 ;SIZE OF IPCF PACKET
PACK: BLOCK IPCSIZ ;THE PACKET
>
UNAME: BLOCK 6 ;ALLOW 36 CHARACTERS
FNAME: BLOCK 6 ;NAME FROM USER-NAME FILE
U.IBUF: BLOCK 200
LOW:
RELOC 400000
CRLF: BYTE (7)15,12 ;<CR><LF>
HI: PHASE LOW
TMPBLK: SIXBIT /PVT/
BUF-1 ;RH OF IOWD
IFN FTTRM<
TRMBLK: .TOOUS ;TRMOP BLOCK
BLOCK 1
LINE
>
IFN FTLB<
HDR: IP.CFP ;PRIVED
0 ;FROM US
BLOCK 1 ;TO
XWD IPCSIZ,PACK ;POINTER
>
UNFLAG: EXP 0 ;-1 IF READING FROM USER-NAME FILE
U.BLK: U.CHN,,.FORED
EXP .IODMP
U.DEV: SIXBIT /DSK/
EXP 0,0
EXP U.LKP
EXP BUF
EXP 0
U.LKP: SIXBIT /PIVOT/
SIXBIT /NMS/
EXP 0
EXP BUF
U.READ: U.CHN,,.FOINP
.+1
IOWD 200,U.IBUF
EXP 0
DEPHASE
LOWSIZ=.-HI
RELOC LOW
BLOCK LOWSIZ
RELOC
SUBTTL INITIALIZATION
;START HERE
PIVOT: TDZA F,F ;CLEAR FLAGS
HRRZI F,F.CCL ;CCL ENTRY
MOVE P,[IOWD PDLSIZ,PDL] ;SET UP PDL
MOVE T1,[XWD HI,LOW] ;SET UP LOWSEG
BLT T1,LOW+LOWSIZ-1
HRROI T1,.GTPRG ;GET OUR NAME
GETTAB T1, ;IF STARTS WITH W, WHEEL
HALT
ROT T1,6
ANDI T1,77
CAIE T1,'W'
TRO F,F.PVT ;OTHERWISE PIVOT
MOVE T1,[%LDMFD] ;GET [1,1] PPN
GETTAB T1,
HALT
MOVEM T1,MFDPPN
MOVE T1,[XWD .GTPPN,.GTSLF] ;COMPUTE OUR ADDRESS IN JBTPPN
GETTAB T1,
HALT
PJOB T2,
ADDI T2,(T1)
MOVEM T2,PKBLK
HRROI T1,.GTPPN ;GET OUR PPN
GETTAB T1,
HALT
MOVEM T1,PKBLK+1
;BUILD TARGET ENTRY IN CASE RESCAN FAILS (ASSUME WANTS TO BE OPR)
MOVE T1,[%LDFFA] ;GET [1,2] PPN
GETTAB T1,
HALT
MOVEM T1,TPTH+.PTFCN ;STORE AS TARGET PPN
MOVEM T1,TPTH+.PTPPN ;AND PATH
SETZM TPTH+.PTPPN+1 ;NO SFDS
SETZM TPTH+.PTSWT ;DON'T CHANGE SCAN
;BUILD TMPCOR ENTRY IN CASE READ FAILS
MOVEI T1,.PTFRD ;READ PATH
MOVEM T1,BUF+.PTFCN
MOVE T1,[XWD BUFSIZ,BUF]
PATH. T1,
HALT
MOVEI T1,.PTSCN+.PTSCY ;GET RID OF NOISE BITS
ANDM T1,BUF+.PTSWT
MOVE T1,PKBLK+1 ;GET CURRENT PPN
MOVEM T1,BUF+.PTFCN
HRLZI T1,-BUFSIZ ;READ TMPCOR
HLLM T1,TMPBLK+1
MOVE T1,[XWD .TCRDF,TMPBLK]
TMPCOR T1,
TRZA F,F.TMP
TRO F,F.TMP ;FOUND TMPCOR ENTRY
SUBTTL RESCAN
TRNE F,F.CCL ;CCL ENTRY?
JRST NOSCN ;YES, DON'T RESCAN
RESCAN ;RESCAN PREVIOUS MONITOR COMMAND
PUSHJ P,CI ;GET 1ST CHAR
PUSHJ P,EATS ;EAT SPACES
CAIN C,"P" ;CHECK FOR CCL COMMAND
JRST CCLCMD ;IT WAS, BYPASS PIVOT -
CAIE C,"S" ;START COMMAND
CAIN C,"R" ;R OR RUN
TRO F,F.RUN ;YES, RUN COMMAND
DSHLOP: TRNN F,F.RUN ;RUN COMMAND?
JRST DSH1 ;NO, RUNNAM
CAIN C,"-" ;YES, DASH?
JRST EATDSH ;YES, GO GET PPN
JRST DSHNXT ;NO, GET NEXT CHAR
DSH1: PUSHJ P,ALPHAP ;ALPHANUMERIC?
JRST GTPPN ;NO, GO GET PPN
DSHNXT: PUSHJ P,BP ;ESC CHAR?
CAIA ;NO, KEEP LOOKING
JRST NOSCN ;YES, USER DIDN'T SPECIFY PPN
PUSHJ P,CI ;GET NEXT CHAR
JRST DSHLOP ;TRY AGAIN
CCLCMD: PUSHJ P,CI ;GET NEXT
CAIN C,"-" ;HAVE WE FOUND THE HYPHEN?
JRST EATDSH ;YES
PUSHJ P,ALPHAB ;CHECK FOR ALPHABETIC
TRNA ;ASSUME DONE WITH CCL NAME
JRST CCLCMD ;TRY AGAIN
PUSHJ P,EATS ;EAT UP ANY SPACES
CAIN C,"-" ;TEST FOR HYPHEN AGAIN
JRST EATDSH ;YES IT WAS
PUSHJ P,BP ;SEE IF A BREAK CHARACTER
JRST GTPPN ;NO, PPN OR NAME TO FOLLOW
JRST NOSCN ;PPN NOT SUPPLIED, USE DEFAULT
BADPPN: OUTSTR [ASCIZ /PPN: /] ;PROMPT USER
;HERE TO INPUT PPN
EATDSH: PUSHJ P,CI ;EAT DASH
GTPPN: PUSHJ P,EATS ;EAT SPACES
CAIL C,"A" ;A DEVICE OR USER-NAME?
CAILE C,"Z"
JRST NRMPPN ;NO, MUST BE PPN
PUSHJ P,SIXI ;YES, GET FIRST 6 CHARACTERS OF DEVICE NAME
CAIE C,":" ;IS IT A DEVICE?
JRST GETUSN ;NO, ASSUME USER-NAME
GTLNM: PUSHJ P,RDLOG
ERROR PPN,BADPPN,<Illegal PPN, try again>
CAIN C,":" ;EAT COLON
PUSHJ P,CI
JRST PDON
NRMPPN: CAIN C,"[" ;EAT LEFT BRACKET
PUSHJ P,CI
MOVEI T1,.PTFRD ;READ PATH
MOVEM T1,TPTH+.PTFCN
MOVE T1,[XWD BUFSIZ,TPTH]
PATH. T1,
HALT
MOVEI T1,.PTSCN+.PTSCY ;GET RID OF NOISE BITS
ANDM T1,TPTH+.PTSWT
PUSHJ P,OCTI ;INPUT PROJECT
TDNE T1,[777777400000]
ERROR PPN,BADPPN,<Illegal PPN, try again>
SKIPE T1
HRLM T1,TPTH+.PTPPN
PUSHJ P,EATS ;EAT SPACES
CAIE C,"," ;EAT COMMA OR SLASH
CAIN C,"/"
PUSHJ P,CI
PUSHJ P,OCTI ;INPUT PROGRAMMER
TLNE T1,-1
ERROR PPN,BADPPN,<Illegal PPN, try again>
SKIPE T1
HRRM T1,TPTH+.PTPPN
MOVEI P1,1 ;SETUP LOOP
PPN1: PUSHJ P,EATS ;EAT SPACES
CAIE C,"," ;ANOTHER SFD?
JRST PPN2 ;NO
PUSHJ P,CI ;YES, EAT THE COMMA
CAILE P1,SFDS ;TOO MANY?
ERROR PPN,BADPPN,<Illegal PPN, try again>
PUSHJ P,SIXI ;INPUT THE SFD
SKIPE T1 ;ZERO MEANS DEFAULT
MOVEM T1,TPTH+.PTPPN(P1) ;STORE IT
AOJA P1,PPN1 ;LOOP
PPN2: SETZM TPTH+.PTPPN(P1) ;TERMINATE PATH
CAIN C,"]" ;EAT RIGHT BRACKET
PUSHJ P,CI
PDON: PUSHJ P,EATS ;EAT SPACES
PUSHJ P,BP ;ESC CHAR?
ERROR PPN,BADPPN,<Illegal PPN, try again>
MOVE T1,TPTH+.PTPPN ;[1,1] IS ILLEGAL
CAMN T1,MFDPPN
ERROR PPN,BADPPN,<Illegal PPN, try again>
MOVEM T1,TPTH+.PTFCN ;STORE AS TARGET PPN
TRO F,F.SCN ;RESCAN FOUND PPN
NOSCN:
SUBTTL CHANGE PPN
TRNE F,F.TMP ;RETURNING?
TRNE F,F.SCN
JRST NORET ;NO
;HERE WHEN RETURNING TO ORIGINAL PPN
MOVE T1,[XWD BUF,TPTH] ;GET OLD ENTRY FROM TMPCOR
BLT T1,TPTH+BUFSIZ-1
JRST COMMON
;HERE WHEN NOT RETURNING TO ORIGINAL PPN
NORET: MOVEI T1,.PTPPN+1 ;COMPUTE SIZE OF PATH
SKIPE BUF(T1)
AOJA T1,.-1
MOVNI T1,1(T1)
HRLM T1,TMPBLK+1
MOVE T1,[XWD .TCRWF,TMPBLK] ;WRITE TO TMPCOR
TMPCOR T1,
ERROR TMP,EXT,Can't write temp core
COMMON: MOVE T1,TPTH+.PTFCN ;TARGET PPN
MOVEM T1,PKBLK+2
CAMN T1,PKBLK+1 ;SAME PPN?
JRST CHGOK2 ;YES, MIGHT NOT HAVE PRIVS
PUSHJ P,TRMOPR ;TRMOP THE OPR
IFN FTCHG<
MOVE T1,PKBLK+2 ;TRY CHGPPN 1ST
CHGPPN T1,
CAIA ;LOST
JRST CHGOK ;WON
>
MOVE T1,[XWD 3,PKBLK] ;POKE JBTPPN
POKE. T1,
ERROR POK,EXT,POKE failed
CHGOK: PUSHJ P,TRMOPR ;TRMOP THE OPR
CHGOK2: TRNN F,F.PVT ;ALWAYS CHANGE PATH IF PIVOT
JRST REP
HRRZI T1,.PTFSD ;CHANGE PATH
MOVEM T1,TPTH+.PTFCN
MOVE T1,[XWD BUFSIZ,TPTH]
PATH. T1,
ERROR PTH,EXT,Can't change PATH
SUBTTL REPORTING
REP: MOVE L,[POINT 7,LINE] ;SET UP BP
MOVE T1,PKBLK+2 ;MY PPN (JBTPPN)
TRNN F,F.PVT ;PIVOT OR WHEEL?
JRST REP1 ;WHEEL, ALWAYS TYPE PPN
CAMN T1,TPTH+.PTPPN ;NOT MY PPN (PATH)?
SKIPN TPTH+.PTPPN+1 ;OR NO SFD?
REP1: PUSHJ P,PPNO ;YES, OUTPUT PPN (JBTPPN)
TRNN F,F.PVT ;PIVOT OR WHEEL?
JRST REP2 ;WHEEL, NEVER TYPE PATH
MOVE T1,PKBLK+2 ;MY PPN (JBTPPN)
SKIPN TPTH+.PTPPN+1 ;PATH IS AN SFD?
CAME T1,TPTH+.PTPPN ;OR NOT MY PPN (PATH)?
PUSHJ P,PTHO ;YES, TYPE PATH TOO
REP2: MOVEI T1,CRLF ;<CR><LF>
PUSHJ P,STRO
SETZ T1, ;MAKE ASCIZ
IDPB T1,L
OUTSTR LINE
EXT: EXIT 1,
JRST EXT
;ROUTINE TO TYPE A PATH
PTHO: MOVEI T1,"["
IDPB T1,L
HLRZ T1,TPTH+.PTPPN ;PROJECT
PUSHJ P,OCTO
MOVEI T1,","
IDPB T1,L
HRRZ T1,TPTH+.PTPPN ;PROGRAMMER
PUSHJ P,OCTO
MOVEI P1,1 ;SETUP LOOP
PTHOLP: SKIPN T2,TPTH+.PTPPN(P1) ;ANOTHER SFD?
JRST PTHO2 ;NO
MOVEI T1,"," ;YES, COMMA
IDPB T1,L
PUSHJ P,SIXO ;OUTPUT SFD
AOJA P1,PTHOLP ;LOOP
PTHO2: MOVEI T1,"]" ;END OF PATH
IDPB T1,L
POPJ P,
SUBTTL USER-NAME
GETUSN: MOVEM T1,UNAME ;STORE FIRST WORD
JUMPE T2,GETUS1 ;FULL SIX CHARACTERS
CAIE C,"-" ;ALLOW A HYPHEN
JRST GOTUSN ;GOT ALL OF NAME
IDIVI T2,6 ;GET NO. OF CHARS LEFT IN FIRST WORD
MOVE T1,[POINT 6,UNAME,29
POINT 6,UNAME,23
POINT 6,UNAME,17
POINT 6,UNAME,11
POINT 6,UNAME,5
POINT 6,UNAME]-1(T2) ;GET BYTE POINTER
SUBI C,40 ;CONVERT TO SIXBIT
IDPB C,T1 ;STORE "-"
ADDI T2,^D30 ;ALLOW 36 CHAR NAME
JRST GETUS2
GETUS1: MOVEI T2,^D30 ;ALLOW 36 CHAR NAME
SKIPA T1,[POINT 6,UNAME+1] ;USE CHAR IN C
GETUS2: PUSHJ P,CI ;GET NEXT CHAR
PUSHJ P,ALPHAP ;ALPHANUMERIC?
JRST [CAIN C,"-" ;ALLOW HYPHEN
JRST .+1 ;YES IT IS
CAIE C,":" ;COLON IS ALSO SPECIAL
JRST GOTUSN ;NOT
JRST GTLNM] ;TRY FOR LOGICAL NAME
JUMPE T2,GETUS2 ;YES, ONLY 36
SUBI C,40 ;SIXBITIZE
IDPB C,T1 ;APPEND TO NAME
SOJA T2,GETUS2 ;LOOP
PUSHJ P,CI
GOTUSN: PUSHJ P,BP ;READ TO END OF LINE
JRST .-2 ;NOT THERE YET
SKIPE UNAME+1 ;IF ONLY 6 CHARACTERS
JRST GOTUS1 ; WE MIGHT HAVE A LOGICAL NAME
MOVE T1,UNAME ;GET NAME
PUSHJ P,RDLOG ;SEE IF IT IS
JRST GOTUS1 ;NO ITS NOT
JRST PDON ;YES IT WAS
GOTUS1: MOVE T1,[8,,U.BLK]
FILOP. T1,
ERROR CFF,EXT,Cannot find PIVOT.NMS
SETOB T4,UNFLAG ;INITIALIZE BUFFER COUNT
NEWLIN: PUSHJ P,GETFNM ;GET A NAME FROM FILE
MOVSI T1,-6 ;AOBJN POINTER
TRYNAM: MOVE T2,FNAME(T1)
CAME T2,UNAME(T1)
JRST NOMTCH ;NOT THIS ONE
AOBJN T1,TRYNAM
PUSHJ P,EATS ;EAT ANY SPACES
JRST NRMPPN ;THEN USE THE PPN WE FOUND
NOMTCH: PUSHJ P,CFI ;LOOK FOR END-OF-LINE
PUSHJ P,BP
JRST NOMTCH ;NOT YET
JRST NEWLIN ;YES
GETFNM: MOVE T1,[FNAME,,FNAME+1]
SETZM FNAME
BLT T1,FNAME+5
MOVE T1,[POINT 6,FNAME]
MOVEI T2,^D36 ;ALLOW 36 CHAR NAME
PUSHJ P,EATS
GETFN1: PUSHJ P,CI ;GET NEXT CHAR
PUSHJ P,ALPHAP ;ALPHANUMERIC?
JRST [CAIE C,"-" ;ALLOW HYPHEN
JRST GOTFNM ;NOT
JRST .+1]
SUBI C,40 ;SIXBITIZE
IDPB C,T1 ;APPEND TO NAME
SOJG T2,GETFN1 ;LOOP
GOTFNM: POPJ P,
SUBTTL TRMOP
;JOB NNN (XXXXXXXXXXXX) PIVOTING TO [NNNNNN,NNNNNN]
TRMOPR: TRNE F,F.TRM ;SUCCEEDED ALREADY?
POPJ P, ;YES, DON'T DO AGAIN
IFN FTLB<
MOVEI T1,LBPVT ;CODE NUMBER
MOVEM T1,PACK
PJOB T1, ;JOB NUMBER
MOVEM T1,PACK+1
HRROI T1,.GTNM1 ;USER NAME
GETTAB T1,
HALT
MOVEM T1,PACK+2
HRROI T1,.GTNM2
GETTAB T1,
HALT
MOVEM T1,PACK+3
MOVE T1,PKBLK+2 ;NEW PPN
MOVEM T1,PACK+4
MOVE T1,[%SILB] ;GET LB'S PID
GETTAB T1,
POPJ P,
JUMPE T1,CPOPJ ;DON'T BOTHER SYSINF PLEASE
MOVEM T1,HDR+.IPCFR
MOVE T1,[XWD 4,HDR] ;SEND THE PACKET
IPCFS. T1,
POPJ P,
> ;END FTLB
IFN FTTRM<
MOVE T1,[SIXBIT /OPR0/] ;GET I/O INDEX OF OPR
IONDX. T1,UU.PHY
POPJ P,
MOVEM T1,TRMBLK+1
MOVE L,[POINT 7,LINE] ;SET UP BP
MOVEI T1,[ASCIZ /
JOB /]
PUSHJ P,STRO
PJOB T1, ;JOB NUMBER
PUSHJ P,DECO
MOVEI T1,[ASCIZ / (/]
PUSHJ P,STRO
HRROI T2,.GTNM1 ;GET USER NAME
GETTAB T2,
POPJ P,
HRROI T3,.GTNM2
GETTAB T3,
POPJ P,
PUSHJ P,TWOO ;OUTPUT USER NAME
MOVEI T1,[ASCIZ /) PIVOTING TO /]
PUSHJ P,STRO
MOVE T1,PKBLK+2 ;OUTPUT NEW PPN
PUSHJ P,PPNO
MOVEI T1,CRLF ;<CR><LF>
PUSHJ P,STRO
SETZ T1, ;MAKE ASCIZ
IDPB T1,L
MOVE T1,[XWD 3,TRMBLK] ;TRMOP THE OPR
TRMOP. T1,
POPJ P,
> ;END FTTRM
TRO F,F.TRM ;SUCCESS
POPJ P,
SUBTTL INPUT ROUTINES
;EAT SPACES AND TABS
EATS1: PUSHJ P,CI ;EAT IT
;ENTER HERE
EATS: CAIE C," " ;SPACE OR TAB?
CAIN C,11
JRST EATS1 ;YES
POPJ P,
;INPUT AN OCTAL NUMBER
;T1 RETURNS THE NUMBER
OCTI: SETZ T1, ;DEFAULT IS ZERO
PUSHJ P,EATS ;EAT SPACES
OCTLOP: CAIL C,"0" ;NUMERIC?
CAILE C,"7"
POPJ P, ;NO, MUST BE END
LSH T1,3 ;YES, APPEND TO NUMBER
ADDI T1,-"0"(C)
PUSHJ P,CI ;TRY NEXT CHAR
JRST OCTLOP
;TEST IF CHAR IS ESC CHAR
;SKIP IF YES
BP: CAIN C,15 ;EAT CR
PUSHJ P,CI
MOVEI T1,1 ;AN ESC CHAR?
LSH T1,(C)
TDNE T1,[BRKMSK]
CPOPJ1: AOS (P) ;YES, SKIP
CPOPJ: POPJ P,
;ROUTINE TO INPUT A SIXBIT NAME
;T1 RETURNS NAME
SIXI: PUSHJ P,EATS ;EAT SPACES
SETZ T1,
MOVEI T2,6*6 ;BIT COUNT
SIXILP: PUSHJ P,ALPHAP ;ALPHANUMERIC?
JRST SIXI3 ;NO
JUMPE T2,SIXI3 ;YES, ONLY 6
LSH T1,6 ;APPEND TO NAME
ADDI T1,-40(C)
SUBI T2,6 ;COUNT IT
SIXI2: PUSHJ P,CI ;GET NEXT CHAR
JRST SIXILP ;LOOP
SIXI3: LSH T1,(T2) ;LEFT JUSTIFY
POPJ P,
;ROUTINE TO INPUT A CHARACTER
;C RETURNS THE CHAR
CI: SKIPE UNFLAG ;READING FROM USER-NAME FILE?
JRST CFI ;YES
INCHWL C ;INPUT THE CHAR
CI1: SUBI C,40 ;FOLD TO UC
CAIL C,"A"
CAILE C,"Z"
ADDI C,40
POPJ P,
NXTBUF: MOVE T3,[2,,U.READ]
FILOP. T3,
ERROR CFN,EXT,Cannot find user-name
MOVE T3,[POINT 7,U.IBUF]
MOVEI T4,5*200
CFI: SOJL T4,NXTBUF ;REFIL BUFFER IF EMPTY
ILDB C,T3
JRST CI1
;PREDICATE FOR ALPHANUMERICNESS
ALPHAP: CAIL C,"0" ;ALPHANUMERIC?
CAILE C,"9"
ALPHAB: CAIL C,"A" ;ALPHABETIC?
CAILE C,"Z"
POPJ P, ;NO
JRST CPOPJ1 ;YES
SUBTTL OUTPUT ROUTINES
;OUTPUT AN ASCIZ STRING
;T1 PASSES ADDRESS OF STRING
STRO: HRLI T1,(POINT 7,0)
ILDB T2,T1
JUMPE T2,CPOPJ
IDPB T2,L
JRST .-3
;OUTPUT A PPN <CRLF>
;T1 PASSES THE PPN
PPNO: PUSH P,T1 ;SAVE PPN
MOVEI T1,"[" ;OUTPUT LEFT BRACKET
IDPB T1,L
HLRZ T1,(P) ;OUTPUT PROJECT
PUSHJ P,OCTO
MOVEI T1,"," ;OUTPUT COMMA
IDPB T1,L
HRRZ T1,(P) ;OUTPUT PROGRAMMER
PUSHJ P,OCTO
MOVEI T1,"]"
IDPB T1,L
POP P,T1 ;RECALL PPN
POPJ P,
;OUTPUT A DECIMAL NUMBER
;T1 PASSES THE NUMBER
DECO: SKIPA T3,[^D10] ;RADIX
;FALL TO OCTO
;OUTPUT AN OCTAL NUMBER
;T1 PASSES NUMBER
OCTO: MOVEI T3,10 ;RADIX
;FALL TO NUMO
;ROUTINE TO OUTPUT A NUMBER
;T1 PASSES THE NUMBER
;T3 PASSES THE RADIX
NUMO: IDIV T1,T3 ;DIVIDE BY RADIX
HRLM T2,(P) ;SAVE REMAINDER
SKIPE T1 ;LOOP UNTIL 0
PUSHJ P,NUMO
HLRZ T1,(P) ;RECALL REMAINDER
ADDI T1,"0" ;OUTPUT AS DIGIT
IDPB T1,L
POPJ P, ;LOOP FOR EACH DIGIT
;ROUTINE TO OUTPUT AN SIXBIT NAME
;T2 PASSES THE NAME
SIXO: SETZ T3,
;FALL TO TWOO
;ROUTINE TO OUTPUT A SIXBIT DOUBLE WORD
;T2&T3 PASS THE DOUBLE WORD
TWOO: LSHC T1,6 ;GET HIGH CHAR
LSH T2,-6
LSHC T2,6
ANDI T1,77
ADDI T1,40 ;MAKE ASCII
IDPB T1,L ;STORE IT
JUMPN T2,TWOO ;LOOP UNTIL ALL GONE
JUMPN T3,TWOO
POPJ P,
SUBTTL ERRORS
VERBO: PUSH P,@.JBUUO ;SAVE RETURN ADR
HRROI P1,.GTWCH ;GET VERBOSITY BITS
GETTAB P1,
SETZ P1,
TLNN P1,(JW.WPR+JW.WFL)
TLO P1,(JW.WPR+JW.WFL)
CLRBFI ;EAT TYPE AHEAD
MOVE L,[POINT 7,LINE] ;SETUP BP
MOVEI T1,[BYTE (7)15,12,"?"] ;FATAL
PUSHJ P,STRO
HLRZ T2,@.JBUUO ;GET PREFIX
HRLI T2,'PVT'
TRNN F,F.PVT
HRLI T2,'WHL'
TLNE P1,(JW.WPR) ;WANT PREFIX?
PUSHJ P,SIXO ;YES
TLNN P1,(JW.WFL) ;WANT FIRST?
JRST VERBO1 ;NO
MOVEI T1," " ;YES
IDPB T1,L
AOS T1,.JBUUO ;TYPE FIRST
PUSHJ P,STRO
VERBO1: MOVEI T1,CRLF
PUSHJ P,STRO
SETZ T1,
IDPB T1,L
OUTSTR LINE
POPJ P,
SUBTTL ERSATZ NAMES
;ROUTINE TO READ A LOGICAL NAME
;T1 PASSES THE NAME
;TPTH RETURNS THE PATH
RDLOG: MOVEM T1,TPTH+.PTFCN ;SAVE THE PPN
MOVE T1,[XWD BUFSIZ,TPTH] ;GET ITS PATH
PATH. T1,
POPJ P,
SETZM TPTH+.PTSWT ;DON'T CHANGE SCAN
JRST CPOPJ1
END PIVOT