Trailing-Edge
-
PDP-10 Archives
-
bb-k345a-sb
-
kmon.mac
There are 5 other files named kmon.mac in the archive. Click here to see a list.
TITLE KMON %20A 12-MAR-79
SUBTTL DEC MONITOR FOR "AID" A KOTOK N PAPPAS D NIXON
;COPYRIGHT (C) 1973,1978,1979 BY
;DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS.
;
;
;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.
VCUSTOM==0
VAID==20 ;VERSION NUMBER
VUPDATE==1 ;MINOR VERSION NUMBER
VEDIT==32 ;EDIT NUMBER
;IFN SEG2SW,<KMON USES TWO SEGMENT FEATURE>
IFDEF TWOSEG,<IFNDEF SEG2SW,<SEG2SW==1>>
IFNDEF SEG2SW,<SEG2SW==0>
IFN SEG2SW,<PURESW==1>
;IFN PURESW,<IMPURE AREA IS INITIALISED FROM HISEG>
IFNDEF PURESW,<PURESW==1>
LOC <.JBVER=137>
<VCUSTOM>B2+<VAID>B11+<VUPDATE>B17+VEDIT
LOC 124
EXP REE
RELOC 0
;ENTRIES TO/FROM MONITOR FOR TRANSFER OF CONTROL
INTERN MONENT ;NORMAL MONITOR ENTRY
INTERN KILL ;MONITOR ENTRY ON FATAL ERROR
EXTERN INTBEG ;ENTRY TO INTERPRETER ON INITIALIZATION
;AC DEFINITIONS
A=0
B=1
C=2
D=3
E=4
F=5
PP=17 ;USED FOR PUSH POP
MLON
IFN PURESW,<
IFN SEG2SW,< TWOSEGMENTS
RELOC 400000>
IFE SEG2SW,< HISEG>>
SUBTTL REVISION HISTORY
;START OF VERSION 20A
;32 ADD DATE75 HACK
SUBTTL DEC MONITOR FOR "AID"
;COLD START ROUTINE
INTERN START
EXTERN .JBFF,.JBREL,.JBOPC
START: CALLI 0 ;RESET ALL IO
MOVE B,[XWD LBEG,LBEG+1] ;START OF DATA
SETZM LBEG ;ZERO FIRST WORD
BLT B,LEND-1 ;AND REST
MOVE B,[XWD PH1C,S79.01]
BLT B,P75.08
MOVE B,[XWD OPENB,INITB]
BLT B,INITB+2
MOVE B,[XWD PH2C,S86]
BLT B,SR1+1
MOVE B,[XWD PH3C,P92]
BLT B,S80+1
MOVE B,[JRST S5460A]
MOVEM B,S54.60+1
MOVE B,[XWD 41000,SK11]
MOVEM B,SK11
SETZ B,
CALLI B,27 ;MAKE RUN TIME ONLY FOR AID
MOVEM B,STTIME ;TIME WHEN STARTED
MOVE PP,[XWD -20,PLIST]
MOVEM PP,PLIST ;SET UP PUSH-DOWN LIST
INIT 1 ;INITIALIZE CONSOLE
SIXBIT /TTY/
XWD OB,IB
HALT START
MOVEI A,BUF1 ;TTY OUT SETUP
MOVEM A,.JBFF
OUTBUF 1
OUTPUT ;DUMMY OUTPUT
MOVEI E,GRTNG ;TYPE GREETING (IN DDT MODE)
CALLI E,3
JRST INTBEG ;GO TO INTERPRETER
GRTNG: ASCIZ /
AID 20A(32) AT YOUR SERVICE ...
/
;DUMMY ERROR EXIT FROM INTERPRETER
KILL: HALT START
;HERE FOR REENTER
REE: TTCALL 12,0
SETOM RIF
JRSTF @.JBOPC
;NORMAL MONITOR ENTRY FROM INTERPRETER
;B CONTAINS REQUEST TYPE
;A AND C MAY BE CLOBBERED, EVIDENTLY. ALSO G.
MONENT: MOVE PP,PLIST ;RESTORE MONITOR PUSH-DOWN LIST
CAIL B,L.ETSW ;CHECK FOR WITHIN LIMIT
HALT START
PUSHJ PP,@ENTSW(B) ;DISPATCH TO ROUTINE
MONEXIT:CALLI B,23 ;NEED SPACE
IDIVI B,^D1000
IDIVI B,^D60
IDIVI B,^D60
MOVEM B+1,MIN
MOVEM B,HR
SETZ B,
CALLI B,27
SUB B,STTIME ;SUBTRACT STARTING TIME
IDIVI B,^D10
MOVEM B,SECOND
MONEX1: JRST @INTENT ;RETURN TO MONITOR
ENTSW: JRST SU ;SWITCH TO USER
JRST GBUF ;GET A BUFFER
JRST MONEXIT ;RETURN A BUFFER
JRST TU ;TRANSMIT BUFFER TO STATION
JRST TLSU ;TL AND SU
JRST MONEXIT ;BREAK POINT
JRST MONEXIT ;REQUEST DISK
JRST DCONT ;CONTINUE DISK ACTION
JRST DCOMP ;DISK ACTION COMPLETE
JRST MORCOR ;GET ANOTHER BLK OF CORE
JRST MORCI ;IMPERATIVE MORE CORE
JRST SENDFF ;MAKE UP AND SEND FORMFEED
HALT MONEXIT ;GET USER OFF
JRST RCOR ;RETURN BLOCKS OF CORE
HALT MONEXIT ;PAUSE FOR E SECONDS
L.ETSW==.-ENTSW+1 ;LENGTH OF THE SWITCH
;ROUTINES TO EXPAND/CONTRACT CORE
RCOR: MOVNI A,2000 ;DECREASE CORE BY 1K
JRST MORCI1
MORCOR:
MORCI: MOVEI A,2000 ;IMPERATIVE MORE CORE,DONT CHECK
MORCI1: ADD A,.JBREL
SETOI B, ;SUCCESS FLAG
CALLI A,11 ;TRY TO GET IT
SETZI B, ;FAILED. SET FLAG
JRST MONEX1
;UTILITY ROUTINES FOR TTY IO
SETUP: MOVE A,[POINT 7,BUF1+2,34]
MOVEM A,BUF1+1 ;POINTER TO BEGINNING OF BUFFER
MOVEI C,15 ;CR IN NEXT-TO-LAST BYTE
DPB C,[POINT 7,BUF1+3+^D18-1,27]
POPJ PP,
GETCH: ILDB C,BUF1+1 ;GET CHARACTER
MOVE A,BUF1+1
ILDB D,A ;AND LOOK AHEAD ONE CHARACTER
POPJ PP,
;TRANSMIT BUFFER AND SWITCH TO USER
TLSU: PUSHJ PP,TU ;TRANSMIT BUFFER,FALL INTO SU
;SWITCH TO USER (I.E., READ A LINE OF INPUT)
SU: MOVE A,[XWD 21,BUF1+1] ;TYPE "*"
MOVEM A,BUF1+1
SETZM BUF1+3 ;CLEAR FIRST WRD OF BFR
MOVEI C,"*"
IDPB C,OB+1
OUTPUT
PUSHJ PP,GBUF ;GET A FREE BUFFER
HRRZM E,.JBFF
INBUF 1 ;SET UP AS INPUT BFR
INPUT ;READ LINE FROM TTY
MOVNI C,1 ;SET FOR CURRENT JOB
GETLCH C ;GET LINE CHARACTERISTICS
SETZ B, ;SET FOR NO CONVERSION
TLNN C,(1B13) ;TEST FOR LOWER CASE INPUT FLAG ON
MOVEI B,40 ;NO, CONVERT LOWER CASE TO UPPER
CLOSE 1 ;CLOSE INPUT SIDE
MOVSI C,(ASCII/
/)
MOVEM C,BUF1+3+^D16 ;INSERT CARRIAGE RETURN AFTER BUFFER
SETZM (E) ;CLEAR LINK WORD (NEEDED??)
PUSHJ PP,SETUP ;SET UP FOR SCAN
PUSHJ PP,GETCH ;CHECK FOR LEADING "*"
CAIN C,32
JRST SU
CAIN C,"*"
JRST SUXRET ;DONT CONVERT IT
JRST SULP6
SULP: SKIPE EFG
JRST SULP1
PUSHJ PP,GETCH ;GET CHAR & LOOK AHEAD
SULP6: CAIN D,15
JRST SULP3
SULP4: CAIN C,"*"
JRST XEXP
CAIE C,"%"
CAIN C,"#"
TRC C,6 ;EXCHANGE CHARACTERS
CAIL C,"A"
CAILE C,"Z"
JRST .+2
ADDI C,(B) ;CONVERT TO LOWER CASE
CAIN C,"^" ;LET UP ARROW BE EXPONENTIATION (RPG)
MOVEI C,"*" ;...
CAIN C,"_" ;LET LEFT ARROW BE UNDERSCORE
MOVEI C,"^" ;...
CAIN D,"="
JRST XGELE
SUXRET: DPB C,1(E)
CAIE C,15 ;CARRIAGE RETURN?
JRST SULP ;NO, GO FOR MORE
MOVSI A,400000
MOVEM A,2(E) ;TTY FLAG (FOR JOSS USE)
JRST MONEXIT ;BACK TO JOSS
XEXP: SKIPE FORMFG
JRST .+3
CAIN D,15 ;TRAILING *?
JRST CLEAR ;CLEAR OUT LINE
CAIN D,"*"
JRST XX
XEXP2: MOVEI C,"&"
JRST SUXRET
CLEAR: PUSHJ PP,GBUF ;ZERO INPUT BUFFER
PUSHJ PP,SETUP ;SET UP BUFFER PNTR.
MOVEI C,1 ;ONLY ONE WORD
MOVEM C,BUF1+2 ;SET IT TO BE SO
MOVSI C,64240 ;CR-LF
MOVEM C,BUF1+3 ;FAKE NOTHING SEEN
MOVEI C,CR
MOVEI D,LF
JRST SULP ;SCAN AS IF BLANK LINE
XGELE: CAIN C,74
HRROI C,"\"
CAIN C,76
HRROI C,"@"
JUMPGE C,SUXRET
XXSPAC: MOVEI D," "
DPB D,A
JRST SUXRET
XX: SKIPE FORMFG
JRST XEXP2
JRST XXSPAC
SULP3: CAIE C,")" ;PARENTHETICAL DO?
JRST SULP7 ;NO
LDB D,[POINT 7,BUF1+3,6] ;GET FIRST CHAR.
CAIE D,"(" ;CHECK AGAIN
JRST SULP7 ;IT ISN'T
MOVE D,BUF1+1 ;SAVE BYTE POINTER
MOVEM D,SAVPTR ;FOR LATER
SULP7: MOVEI D,15 ;JUST IN CASE
CAIE C,"*"
SKIPE FORMFG
JRST SULP4
CAIE C,":"
CAIN C,"."
JRST SULP4
SETOM EFG1
SETOM EFG
MOVEI D,"."
JRST SULP4
SULP1: SKIPN EFG1
JRST SULP5
MOVEI C,"."
MOVEI D,15
SETZM EFG1
IBP 1(E)
JRST SULP4
SULP5: SETZM EFG
SKIPN SAVPTR ;PARENTHETICAL DO
JRST SULP8 ;NO
LDB C,BUF1+1 ;GET "."
LDB D,SAVPTR ;GET ")"
DPB C,SAVPTR ;SWAP THEM
DPB D,BUF1+1 ;ABOUT
SETZM SAVPTR ;BUT ONLY ONCE
SULP8: PUSHJ PP,GETCH
MOVEI C,15
MOVEI D,12
JRST SULP4
;TRANSMIT BUFFER TO USER
TU: PUSHJ PP,SETUP
MOVEI F,1
TULOOP: PUSHJ PP,GETCH ;GET CHAR & LOOK AHEAD
JUMPE C,TUSRT3 ;DONE ON NULL FROM JOSS
CAIE C,"#"
CAIN C,"%"
TRC C,6 ;EXCHANGE CHARACTERS
CAIN D," " ;FOLLOWING SPACE?
JRST TUSPC ;YES
CAIN C,"^" ;UNDERSCORE?
MOVEI C,"_" ;YUP, REPLACE BY LEFT ARROW
CAIN C,"*"
MOVEI C,"^" ;EXPON & NO ROOM FOR "**"
TUSRET: CAIN C,"&"
MOVEI C,"*"
DPB C,1(E)
CAIE C,15
TUSRT2: AOJA F,TULOOP
MOVEI C,12
IDPB C,1(E)
TUSRT3: MOVE A,1(E) ;FUDGE OUTPUT BUFFER
MOVEM A,OB+1
MOVE A,[XWD 21,BUF1+1]
MOVEM A,1(E)
OUTPUT
POPJ PP,
TUSPC: CAIN C," " ;TWO SPACES?
JRST CHKTAB
CAIN C,"\"
HRROI C,74
CAIN C,"@"
HRROI C,76
CAIN C,"*"
JRST TUSRET-1
JUMPGE C,TUSRET
MOVEI D,"="
JUMPL C,.+2
MOVEI D,"*"
DPB C,1(E)
IDPB D,1(E)
AOJA F,TUSRT2
CHKTAB: TRNN F,7 ;ONE-SPACE TAB?
JRST TUSRT2 ;YES, IGNORE IT
AOJA F,.+1
CHKTB1: TRNN F,7 ;END OF TAB?
JRST TAB ;YES, GO INSERT TAB
ILDB C,0
CAIN C," " ;SPACE NEXT?
AOJA F,CHKTB1 ;YES, KEEP LOOKING
MOVEM A,BUF1+1 ;NO TAB
ILDB D,A
AOJA F,TULOOP+1
TAB: MOVEI C,11 ;INSERT TAB A& NULLS
DPB C,BUF1+1
MOVEI C,0
IDPB C,BUF1+1
CAME A,BUF1+1
JRST .-2
AOJA F,TULOOP
;GET A FREE BUFFER AND CLEAR TO 0'S
GBUF: MOVEI E,BUF1 ;BUFFER ADDRESS
MOVSI A,(E) ;CLEAR IT
HRRI A,1(E)
SETZM (E)
BLT A,3+^D18-1(E)
POPJ PP,
SENDFF: PUSHJ PP,SETPAG
JRST MONEXIT
SETPAG: PUSHJ PP,GBUF ;GET A CLEAN BUFFER.
PUSHJ PP,SETUP ;INIT POINTER.
MOVEI C,FF ;SET UP FORMFEED
PUSHJ PP,TUSRT3-1 ;AND TYPE IT OUT.
MOVEI B,1 ;RESET LINE COUNTER(ITMLST ONLY)
MOVEM B,LINE
POPJ PP, ;RETURN TO INTERPRETER
FF==14
;SIMULATION OF JOSS DISK ROUTINES
DCONT: HRRZ B,ACTION ;GET REQUEST
CAILE B,5 ;LEGAL?
HALT START ;NO
EXCH B,ACTION ;GET & RESET FIRST-TIME FLAG
JRST .+1(B)
HALT START
JRST DDREAD
JRST DDWRI
JRST DDDEL
JRST ITMLST
JRST DDOPEN
DDREAD: TLNN B,1 ;FIRST TIME?
JRST DDRCNT ;NO
PUSHJ PP,DDLOOK ;DO LOOKUP
JRST DDLFAL ;NOT THERE
INBUF 1,1
DDRCNT: INPUT 1, ;READ A BLOCK
MOVEI A,3 ;NOT DONE FLAG
STATZ 1,20000 ;CHECK END OF FILE BIT
JRST .+3 ;ON
SKIPLE DB+2 ;CHECK BUFFER COUNT FOR END OF FILE
JRST DDCHK ;NO
MOVEI A,4 ;YES. SAY SO
MOVSI B,(136B7) ;AND MAKE BFR LOOK EMPTY
MOVEM B,BFR+1
DDCHK: STATZ 1,740000 ;ERRORS?
MOVEI A,^D12 ;YES. SAY SO.
DDEXIT: MOVEM A,RESULT ;TELL JOSS WHAT HAPPENED
JRST MONEXIT
DDWRI: TLNN B,1 ;FIRST TIME TO WRITE?
JRST DDWCNT
PUSHJ PP,DDLOOK ;ALREADY THERE?
JRST DDWRI2 ;NO, SO OK
MOVEI A,^D15 ;YES, DONT ALLOW WRITE
MOVE B,DDLK2 ;GET DEVICE NAME
CALLI B,4 ;DEVCHR
TLNE B,4 ;IS IT A DIRECTORY DEVICE
JRST DDEXIT
DDWRI2: MOVEI A,1 ;SUCCESS FLAG
HLLZS DIREN+1
SETZM DIREN+2 ;MAKE SURE OF DATE.
ENTER 1,DIREN
MOVEI A,^D11 ;TELL JOSS ABOUT ENTER FAIL
OUTBUF 1,1 ;SETUP OUTPUT BUFFER
OUTPUT 1, ;DUMMY OUTPUT
JRST DDEXIT
DDWCNT: MOVEI 1,177 ;SET TO WRITE 177 WORDS
ADDM 1,DB+1
OUTPUT 1,
DDCHK2: MOVEI A,1 ;SUCCESS FLAG
SKIPE FLAG
MOVEI A,2
JRST DDCHK
DDLFAL: MOVEI A,^D8 ;LOOKUP FAIL
JRST DDEXIT
DDOPEN: MOVEI A,^D14 ;OPEN ALWAYS SUCCEEDS
JRST DDEXIT
DDDEL: PUSHJ PP,DDLOOK ;LOOKUP BEFORE DELETING
JRST DDLFAL ;AIN'T NONE
SETZM DIREN ;SET UP FOR RENAME/DELETE
MOVEI A,5
RENAME 1,DIREN
MOVEI A,^D12 ;COULDNT DO IT
JRST DDEXIT
DCOMP: RELEAS 1, ;DISC ACTION COMPLETE
JRST MONEXIT ;CLOSE FILE AND RETURN
;CONVERT FILE NAME AND DO LOOKUP
DDLOOK: SKIPN C,KEY ;CONVERT FILE KEY TO SIXBIT DEVICE NAME
MOVE C,[ASCII /DSK/]
MOVEI A,6
DDLK1: LSH C,1
TLNE C,770000
TLC C,400000
LSHC C-1,6
SOJG A,DDLK1
MOVEM C-1,DDLK2
MOVEI A,BFR-2 ;SET UP FOR INBUF,OUTBUF
MOVEM A,.JBFF
MOVE A,FILE
PUSHJ PP,CONVRT
TLO A+2,616100
MOVEM A+2,DIREN
MOVE A,PROG
PUSHJ PP,CONVRT
TRC A+2,720000
HRLZM A+2,DIREN+1
OPEN 1,INITB
HALT .-1
LOOKUP 1,DIREN
POPJ PP,
AOS (PP)
POPJ PP,
;CONVERT DECIMAL NUMBER NNNN IN A TO SIXBIT FORM IN A+2
CONVRT: MOVSI C,440000
IDIVI A,12
ROTC A+1,-6
JUMPGE B,CONVRT+1
TDO A+2,[EXP 202020202020]
POPJ PP,
; PRINT ITEM-LIST
ITMLST: PUSHJ PP,GBUF ;GET A CLEAN BUFFER
PUSHJ PP,SETUP ;INIT POINTER
MOVE A,HDPTR ;PRINT HEADING
PUSHJ PP,HDLOP ;PRINT 1ST LINE OF HEADING
PUSHJ PP,GBUF
PUSHJ PP,SETUP
MOVE A,HDPTR2
PUSHJ PP,HDLOP ;AND 2ND LINE OF HEADING
SETZM PROG
HRREI A,^D-26 ;WILL LOOK FOR 25 ITEMS
MOVEM A,TESTIT
KLOP: AOS PROG
AOSL TESTIT
JRST DDCHK2 ;DONE WITH ITEMS
PUSHJ PP,DDLOOK ;DO A LOOKUP
JRST KLOP ;DOESN'T EXIST, TRY NEXT ONE.
PUSHJ PP,LNPNT ;EXISTS, TELL ABOUT IT.
AOS B,LINE ;BUMP LINE COUNT.
CAILE B,PSIZE
PUSHJ PP,SETPAG ;SEND A FORMFEED.
JRST KLOP ;SEE WHAT'S NEXT.
HDLOP: ILDB A+1,A ;PICK UP TEXT A POINTS AT
IDPB A+1,1(E) ;AND PUT IT IN BUFFER.
JUMPN A+1,HDLOP
JRST TUSRT3 ;PRINTS AND DOES POPJ.
PSIZE==^D54 ;LINES PER PAGE.
LNPNT: PUSHJ PP,GBUF ;GET A CLEAN BUFFER
PUSHJ PP,SETUP ;INIT POINTER
MOVE A,PROG ;GET ITEM NUMBER
PUSHJ PP,NUMPNT ;CONVERT AND DEPOSIT IT.
MOVNI A,SPACNM ;WILL PUT IN THIS MANY SPACES
SPLOP: MOVEI A+1,40
IDPB A+1,1(E)
AOJL A,SPLOP
LDB A,[POINT 12,DIREN+2,35] ;GET LOW 12 BITS OF DATE
LDB A+1,[POINT 3,DIREN+1,20] ;GET HIGH 3 BITS OF DATE
DPB A+1,[POINT 3,A,23] ;MERGE THE TWO PARTS
IDIVI A,^D31
MOVE C,A
MOVE A,A+1
ADDI A,1
PUSHJ PP,NUMPNT ;PRINT DAY
MOVE A,C
IDIVI A,^D12
MOVE C,MONPTR
ADD C,A+1 ;GET TABLE ENTRY FOR THE MONTH
HRREI D,^D-5
PNTMON: ILDB B,C
IDPB B,1(E) ;PRINT "-MONTH-"
AOJL D,PNTMON
ADDI A,^D64
PUSHJ PP,NUMPNT ;PRINT YEAR
MOVEI A,CR
IDPB A,1(E)
MOVEI A,LF
IDPB A,1(E) ;END RECORD
JRST TUSRT3 ;OUTPUT AND RETURN
;WILL POPJ BACK TO THE LOOKUP LOOP!
CR==15
LF==12
SPACNM==12
MONPTR:POINT 7,MONLST-1,34
MONLST: ASCII /-JAN-/
ASCII /-FEB-/
ASCII /-MAR-/
ASCII /-APR-/
ASCII /-MAY-/
ASCII /-JUN-/
ASCII /-JUL-/
ASCII /-AUG-/
ASCII /-SEP-/
ASCII /-OCT-/
ASCII /-NOV-/
ASCII /-DEC-/
HDPTR: POINT 7,.,34
ASCIZ / ITEM-LIST
/
HDPTR2: POINT 7,.,34
ASCIZ /ITEM DATE
/
; THIS ROUTINE CONVERTS A NUMBER TO A TWO DIGIT DECIMAL AND INSERTS
; THE CHARACTERS IN THE TTY OUTPUT BUFFER. NUMBER IS IN A.
NUMPNT: IDIVI A,12
ADDI A+1,60
PUSH PP,A+1 ;SAVE LOW DIGIT
JUMPN A,NOTZER
MOVEI A,40 ; THERE IS NO FIRST DIGIT
JRST DONNUM
NOTZER: IDIVI A,12
MOVEI A,60(A+1)
DONNUM: IDPB A,1(E) ;FIRST CHARACTER
POP PP,A
IDPB A,1(E) ;SECOND DIGIT
POPJ PP,
;DUMP THE LITTERALS IN THE HIGH SEGMENT
LIT
SUBTTL IMPURE AREA OF AID
RA=1
ASF=3
ASGN=2
INTERNAL P75.08
INTERNAL S79.01,P84.97,P90.04,P90.05,P91.03,P91.06
INTERNAL S83.99,S83.98,S83.97,S54.97,AS
INTERNAL S83.96,S83.95,S84.99,S84.98,S84.97
PH1C:
DEC 8; MAX:SET AND RESET BY S79
DEC 200000000; A LE 2.10*(-2)
MOVEI ASF,0
MOVEI ASF,0; RESTORE ASF
HRLZI ASGN,0; RESTORE SIGN
HRLZI ASGN,0; RESTORE SIGN AND SF
ASHC RA,0; SCALE AT 35
HRLZI ASGN,0; RESTORE ASGN
OPENB: EXP 10
Z
XWD DB,DB
PH2C: Z
JRST S86A
Z
JRST P75A
Z
JRST P78A
Z
JRST P82A
Z
JRST P77A
Z
JRST P81A
Z
JRST P80A
Z
JRST S87A
Z
JRST S75A
Z
JRST S82A
Z
JRST P76A
Z
JRST S5450A
Z
JRST P8530A
Z
JRST S5455A
Z
JRST S79A
Z
JRST SR1A
PH3C: Z
JRST P92A
Z
JRST P93A
Z;
JRST S61X;
Z;
JRST S62X;
Z;
JRST ERRX;
Z
JRST S78A
Z
JRST S83A
Z
JRST S84A
Z
JRST S81A
Z
JRST S76A
Z
JRST S77A
Z
JRST P91A
Z
JRST P79A
Z
JRST P83A
Z
JRST P84A
Z
JRST P85A
Z
JRST P90A
Z
JRST P94A
Z
JRST S80A
IFN PURESW,<
IFN SEG2SW,<RELOC>
IFE SEG2SW,< LOC 140 >>
LBEG: ;FIRST DATA WORD TO BE ZEROED
SXX: BLOCK 1
S83.99: BLOCK 1
S83.98: BLOCK 1
S83.97: BLOCK 1
S83.96: BLOCK 1
S83.95: BLOCK 1
S84.99: BLOCK 1
S84.98: BLOCK 1
S84.97: BLOCK 1
INTERN BFR, BUF1, BFRP,SAVPTR,SXX,LBEG
INTERN TEMP, TESTIT,FORMFG,EFG,EFG1
INTERN INITB, DDLK2, T7.9, COMEBA, CT14, USERS
INTERN HR, MIN, SECOND
INTERN IB, OB, DB, PLIST
INTERN ACTION, FILE, FLAG, KEY, NAME, PROG
INTERN RESULT, RPN, TYPE
S79.01:
S54.97: BLOCK 1; MAX:SET AND RESET BY S79
P84.97: BLOCK 1 ; A LE 2.10*(-2)
P90.04:
BLOCK 1
P91.06: BLOCK 1
P91.03: BLOCK 1
P90.05: BLOCK 1
AS: BLOCK 1
P75.08: BLOCK 1
;FLAG AND COUNT CELLS FOR INTERPRETER TO USE
INTERN T7.9,COMEBACK,CT14,HR,MIN,SECOND,USERS
T7.9: BLOCK 1 ;COUNT OF ARITH OPERATIONS
COMEBA: BLOCK 1 ;COMEBACK FLAG
;WHEN SET, INTERP CALLS MONITOR
CT14: BLOCK 1 ;COUNT OF STATEMENTS INTERPRETED
USERS: BLOCK 1 ;NO OF USERS ON (?)
HR: BLOCK 1 ;TIME OF DAY, HOUR PART
MIN: BLOCK 1 ;TIME OF DAY, MINUTE PART
SECOND: BLOCK 1 ;TIME OF DAY, SECOND PART
INTERN ACTION,BFR,BFRP,FILE,FLAG,KEY,NAME,PROG,RESULT,RPN,TYPE
INTERN STTIME
ACTION: BLOCK 1
FILE: BLOCK 1
FLAG: BLOCK 1
KEY: BLOCK 1
NAME: BLOCK 1
PROG: BLOCK 1
RESULT: BLOCK 1
RPN: BLOCK 1
TYPE: BLOCK 1
IB: BLOCK 3 ;TTY BUFFER HEADERS
OB: BLOCK 3
DB: BLOCK 3 ;DISK BUFFER HEADER
PLIST: BLOCK 1
BLOCK 20
SAVPTR: BLOCK 1 ;FOR PARENTHETICAL DO'S
EFG1: BLOCK 1
STTIME: BLOCK 1
EFG: BLOCK 1
FORMFG: BLOCK 1
TESTIT: BLOCK 1
INITB: BLOCK 1
DDLK2: BLOCK 2
DIREN: BLOCK 4
BLOCK 2 ;THESE TWO BLOCKS ARE NECESSARY
;WITHOUT THEN THE DIRECTORY HEADER WILL BE FOULED
;UP AND THE ERROR RETURN ON A LOOKUP WILL BE TAKEN
BFR: BLOCK ^D15
BUF1: BLOCK 3+^D18 ;JOSS TTY BUFFER
BLOCK 177+BFR-.
BFRP: BLOCK 1 ;END OF DRM BUFFER
BLOCK 1 ;DUMMY 200'TH DATA WORD
TEMP: BLOCK 1
EXTERN S86A,P75A,P78A,P82A,P77A,P81A,P80A,S87A,S5460A
EXTERN S75A,S82A,P76A,S5450A,P8530A,S5455A,S79A,SR1A
INTERN S86,P75,P78,P82,P77,P81,P80
INTERN S87,S75,S82,P76,S54.50,P85.30,S54.55,S79,SR1
S86: BLOCK 2
P75: BLOCK 2
P78: BLOCK 2
P82: BLOCK 2
P77: BLOCK 2
P81: BLOCK 2
P80: BLOCK 2
S87: BLOCK 2
S75: BLOCK 2
S82: BLOCK 2
P76: BLOCK 2
S54.50: BLOCK 2
P85.30: BLOCK 2
S54.55: BLOCK 2
S79: BLOCK 2
SR1: BLOCK 2
INTERN P79.90,P79.91,P79.92,P79.89,P79.85,P79.86
INTERN P79.87,P79.88,P80.97,P80.98,P80.99,P81.80
INTERN P81.81,P81.82,P81.99,P82.80,P82.81,P82.82
INTERN P82.90,P82.91,P82.92,P82.84,P83.94,P83.95
INTERN P83.96,P83.97,P83.98,P83.99,P85.99,P85.98
INTERN S75.93,S54.60,S54.98,S54.99,S80.98,S80.99
INTERN S81.98,S85,S85.80,S85.81,S85.90,S85.95
INTERN S85B,S85C,S85A,S85Y,S85M
P79.90: BLOCK 1
P79.91: BLOCK 1
P79.92: BLOCK 1
P79.89: BLOCK 1 ;TEMP STORE
P79.85: BLOCK 1 ;RG
P79.86: BLOCK 1 ;RH
P79.87: BLOCK 1 ;RI
P79.88: BLOCK 1 ;RJ
P80.97: BLOCK 1
P80.98: BLOCK 1
P80.99: BLOCK 1
P81.80: BLOCK 1
P81.81: BLOCK 1
P81.82: BLOCK 1
P81.99: BLOCK 1 ;STORE FOR SIGN OF ARG
P82.80: BLOCK 1
P82.81: BLOCK 1
P82.82: BLOCK 1
P82.90: BLOCK 1
P82.91: BLOCK 1
P82.92: BLOCK 1
P82.84: BLOCK 1 ; TEMP STORE FOR X(B-1)
P83.94: BLOCK 1
P83.95: BLOCK 1
P83.96: BLOCK 1
P83.97: BLOCK 1
P83.98: BLOCK 1
P83.99: BLOCK 1
P85.99: BLOCK 1 ;***TEMP STORE
P85.98: BLOCK 1 ;***ADJUSTED QUADRANT
S75.93: BLOCK 1 ;TEMP STORE FOR SF
S54.60: BLOCK 1
BLOCK 1 ; JRST S5460A
S54.98: BLOCK 1 ;SAVE "PWR" REGISTER
S54.99: BLOCK 1 ;BYTE POINTER TEMPORARY STORE
S80.98: BLOCK 1 ;TEMP STORE FOR N1
S80.99: BLOCK 1 ;TEMP. STORE FOR PTR
S81.98: BLOCK 1
S85: BLOCK 1
S85.80: BLOCK 1 ;CONVERT MONTH,DAY,YR,TENS AND UNITS OF # RECS.
S85.81: BLOCK 1 ;PUT OUT SLASH
S85.90: BLOCK 1 ;DEPOSIT 3 SPACES
S85.95: BLOCK 1 ;PUT OUT NAME OR RPN
S85B: BLOCK 1 ;PTR TO OUTPUT BFR
S85C: BLOCK 1 ;LOCN OF USER DICT
S85A: BLOCK 1 ;ITEM #
S85Y: BLOCK 1 ;YEAR
S85M: BLOCK 1 ;MONTH
INTERN SK1,SK2,SK3,SK4,SK5,SK6
INTERN SK7,SK8,SK9,SK10,SK11,PK1
INTERN PK2,PK3,PK4,PK5,PK6,PK7
INTERN PK8,PK9,PK10,PK11,PK12,PK13
INTERN PK14,PK15,PK16,PK17,PK18,PK19
INTERN PK20,PK21,PK22,PK23,PK24,PK25
INTERN PK26,PK27,PK28,PK29,PK30,PK31
INTERN PK32,PK33,PK34,PK35,PK36,PK37
INTERN PK38,PK39,PK40,T48,T49,T49X,JWSPDL
INTERN SPARE,VEND
SUBTTL; STRING KRAPPIES
SK1: BLOCK 1; S54 POINTER TO LAST 'IF'
SK2: BLOCK 1; S54 POINTER TO LAST QUOTE-MARK
SK3: BLOCK 1; S54 INDEX OF BYTE BEFORE LAST 'IF'
SK4: BLOCK 1; S54 OUTPUT-POINTER HIDEOUT
SK5: BLOCK 1; S54 OUTPUT-BYTE-COUNT HIDEOUT
SK6: BLOCK 1; S52 ZERO IF NULL LINE
SK7: BLOCK 1; S52 POINTER TO LAST NON-BLANK BYTE
SK8: BLOCK 1;
SK9: BLOCK 1;
SK10: BLOCK 1;
SK11: BLOCK 1 ; XWD 41000,SK11;
BLOCK 4;
SUBTTL; PROCESSOR KRAPPIES
PK1: BLOCK 1; P51 B1-REG. HIDEOUT
PK2: BLOCK 1; P51 B-REG. HIDEOUT
PK3: BLOCK 1; P51 B2-REG. HIDEOUT
PK4: BLOCK 1; P51 DIGITS TO LEFT OF DOT(SANS LEADING ZEROES)
PK5: BLOCK 1; P51 DIGITS TO RIGHT OF DOT
PK6: BLOCK 1; P51 NR. OF DIGITS
PK7: BLOCK 1; P55 BYTE-PTR. HIDEOUT
PK8: BLOCK 1; P56,P57 ADDRESS OF TREE TRUNK
PK9: BLOCK 1;
PK10: BLOCK 1; P60,P64 HEIGHT OF TREE
PK11: BLOCK 1; P60 DESCRIPTOR HIDEOUT
PK12: BLOCK 1; P41,P44 DITTO
PK13: BLOCK 1; P41 BYTE-POINTER HIDEOUT
PK14: BLOCK 1; P40 DESCRIPTOR HIDEOUT
PK15: BLOCK 1; P39 S/MAGNITUDE OF ROV INCREMENT
PK16: BLOCK 1; P39 EXPONENT OF INC
PK17: BLOCK 1; P39 SIGN OF INC.
PK18: BLOCK 1; SP17/18 COMPARATOR FOR MAX/MIN
PK19: BLOCK 1; V1 TYPE OF RHS
PK20: BLOCK 1; V1 S/MAG. OF RHS
PK21: BLOCK 1; V1 EXP. OF RHS
PK22: BLOCK 1; P73 PART INDEX
PK23: BLOCK 1; P73 PART INDEX
PK24: BLOCK 1;
PK25: BLOCK 1; V2,X51 CELL REQUIREMENTS
PK26: BLOCK 1;
PK27: BLOCK 1; V2 USED VARIOUSLY
PK28: BLOCK 1;
PK29: BLOCK 1; P71 PTR. TO FOR-CLAUSE
PK30: BLOCK 1; P71
PK31: BLOCK 1; P71
PK32: BLOCK 1; P71
PK33: BLOCK 1; P71
PK34: BLOCK 1; P71
PK35: BLOCK 1; X52 1 TO ADVANCE STEP
PK36: BLOCK 1; P38 OBJECT-OF-DISCOURSE DESCRIPTOR
PK37: BLOCK 1;
PK38: BLOCK 1;
PK39: BLOCK 1; V3
PK40: BLOCK 1; V3
SUBTTL T48,T49,T49X -- SCRATCH TABLES
; T48 IS USED VARIOUSLY FOR FORMULAS, ARRAYS, ...
T48: BLOCK 13;
; T49 IS USED MAINLY FOR ARRAYS - CONTAINS HEADERS
T49: BLOCK 13;
; T49X LIKE T49 BUT CONTAINS PREDECESSORS
T49X: BLOCK 13;
BLOCK 10; T48 MAY REQUIRE 40 SLOTS AT TIMES!
SUBTTL JWSPDL -- PDP-6 PUSHDOWN STACK
INTERNAL T61
T61: BLOCK 1
JWSPDL: BLOCK 24;
SPARE:
INTERNAL S62,S61,ERR,S78,S83,S84,S81,S76,S77
INTERNAL S80,P91,P79,P83,P84,P85,P90,P94
EXTERNAL P93A,P92A
INTERNAL P92,P93
EXTERNAL S62X,S61X,ERRX,S78A,S83A,S84A,S81A,S76A,S77A
EXTERNAL S80A,P91A,P79A,P83A,P84A,P85A,P90A,P94A
SUBTTL ENTRIES FOR JSR ROUTINES
P92: BLOCK 2
P93: BLOCK 2
S61: BLOCK 2;
S62: BLOCK 2;
ERR: BLOCK 2;
S78: BLOCK 2
S83: BLOCK 2
S84: BLOCK 2
S81: BLOCK 2
S76: BLOCK 2
S77: BLOCK 2
P91: BLOCK 2
P79: BLOCK 2
P83: BLOCK 2
P84: BLOCK 2
P85: BLOCK 2
P90: BLOCK 2
P94: BLOCK 2
S80: BLOCK 2
BLOCK 20
SUBTTL; USER'S BLOCK
DEFINE U(P)<INTERN P
P: BLOCK 1>
U(INTENT);
USER0=INTENT ;***FIRST LOC OF USER AREA
U(SEQ);
U(INITIALS);
U(JOBNO);
U(PAGNO);
U(ONTIME);
U(COMTIM);
U(SPARE1);
U(SPARE2);
U(SPARE3);
U(SPARE4);
U(SPARE5);
U(RISIG)
U(UBUF);
U(ME);
U(RETURN);
U(WIDTH)
U(SIZE)
U(SPACE);
U(LINE);
U(USIZE);
U(UTIME);
U(UUSERS);
U(UMIN);
U(UMIN1);
U(USEC);
U(UCR);
U(UA1);
U(UA);
U(UA2);
U(UB1);
U(UB);
U(UB2);
U(UACL);
U(UDS);
U(UPS);
U(UCP);
U(UCC);
U(U0)
U(U1);
U(U2);
U(U3);
U(U4);
U(U5);
U(U6);
U(U7);
U(U8);
U(FPDL);
U(LEVEL)
U(US0);
BLOCK 21;
U(US1);
BLOCK 26;
U(US2);
BLOCK 26;
U(US3);
BLOCK 5;
U(US4);
BLOCK 10;
U(US5);
U(US6);
U(US7);
U(UP0);
U(UP1);
U(UP2);
U(UP3);
U(UP4);
U(UP5);
U(UP6);
U(UP7);
U(UP8);
U(UP9);
U(UP10);
U(UP11);
U(UP12);
BLOCK 12;
U(UX1);
U(UX2);
U(UX3);
U(UX4);
U(TRUE);
BLOCK 1
U(FALSE);
BLOCK 1
U(PARTS);
BLOCK 1
U(FORMS);
BLOCK 1
U(MODE);
U(BASE)
U(JPDL);
U(JD);
U(U24);
U(U25);
U(CPI);
U(CSI);
U(CSA);
U(UDF1);
U(UDF2);
U(UBFR);
U(UFILE);
U(UKEY);
U(UNAME);
U(UITEM);
U(V);
BLOCK ^D103;
VEND: BLOCK INTENT+^D1023-.;
SYN RISIG,RIF;
INTERN LEND,PH1C,PH2C,PH3C,OPENB
LEND: END START