1
0
mirror of https://github.com/PDP-10/stacken.git synced 2026-02-28 09:07:42 +00:00
Files
Lars Brinkhoff 6e18f5ebef Extract files from tape images.
Some tapes could not be extracted.
2021-01-29 10:47:33 +01:00

723 lines
17 KiB
Plaintext
Raw Permalink Blame History

This file contains invisible Unicode characters
This file contains invisible Unicode characters that are indistinguishable to humans but may be processed differently by a computer. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.
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