COND
* /--- FILE TYPE = E
* /--- BLOCK IDENT 00 000 81/07/14 07.27
IDENT COND
SYSCOM
*CALL PLASIJP
TITLE NON-OVERLAYABLE ROUTINES
CST
* /--- BLOCK VARS 00 000 81/07/28 01.29
* FROM CONDC
ENTRY OLDCMND
OLDCMND VFD 60/55555555555555550000B HOLDS PREVIOUS COMMAND
*
*
ENTRY CLINES
CLINES DATA 0 COUNTER FOR LINES CONDENSED
* FROM GETLIN
ENTRY ISTSAV,IENDSAV
ISTSAV BSS 1
IENDSAV BSS 1
*
* FROM CALCS
*
ENTRY CALCACT,NLABELS
CALCACT BSS 1 -1 WHEN -CALC- IS ACTIVE
NLABELS BSS 1 LENGTH OF LABEL TABLE
* /--- BLOCK LEVEL 00 000 81/08/21 23.02
ENTRY CONDENS
CONDENS EQ *
SB1 1 INITIAL ENTRY
SX7 LEVEL0
EQ LEXEC
ENTRY MTFIN
MTFIN SB1 2 FINISH UP AFTER MICRO-TUTOR
SX7 LEVEL0
EQ LEXEC
CMPGO SPACE 4,10
** CMPGO - CENTRAL MICRO PLATO INITIATION.
*
* LOAD AND EXECUTE THE CENTRAL MICRO PLATO OVERLAY.
*
* THE OVERLAY RETURNS CONTROL TO *CMPGOX* HERE WITH
* (X5) = TERMINATION CONDITION.
*
* THE MICRO PLATO PORTION OF THE FILE THAT WAS JUST
* CONDENSED IS TRANSLATED INTO AN EQUIVALENT TUTOR
* LESSON IN FILE *S0CMPN* WHERE N = THE CONDENSOR ORDINAL.
* IF THERE WERE NO ERRORS, *S0CMPN* IS CONDENSED.
*
* THE CONDENSOR COMMAND STATISTICS FLAG *TSCOMFG*
* IS SAVED AND RESTORED. IT IS SET TO OFF DURING
* THE CMP PHASE.
ENTRY CMPGOX
* RESTORE THE CONDENSOR COMMAND STATISTICS FLAG.
CMPGOX SA1 CMPGOA
BX6 X1
SA6 TSCOMFG
* CHECK FOR ERRORS.
SA1 APLACOM
SA5 CMPGOB+X5
NZ X5,CMPGO1 IF ERRORS
* SUBSTITUTE THE TRANSLATED FILE FOR THE SOURCE FILE.
SX0 PC.SRCF
SA0 CMP.OF ((A0)) = TRANSLATED FILE NAME.
IX0 X0+X1
+ WE 1
RJ =XECSPRTY
* SAVE THE USERS FILE DIRECTORY, TO BE RESTORED
* AFTER THE CONDENSE.
RJ SOD
* USE THE CURRENT BINARY BUFFER EM FWA AND LENGTH FOR
* THIS CONDENSE. IF THE ORIGINAL CONDENSE PRODUCED A
* BINARY LONGER THAN 8K, A DIFFERENT BUFFER IS IN USE
* NOW.
SA1 APLACOM
SX0 PC.BADR
SA0 CONBUFF ((A0)) = BINARY BUFFER EM FWA
IX0 X0+X1
+ WE 1
RJ =XECSPRTY
SX0 PC.BLTH
SA0 CBLTH ((A0)) = BINARY BUFFER LENGTH
IX0 X0+X1
+ WE 1
RJ =XECSPRTY
* MAKE S0CMP A SYSTEM LESSON.
MX6 60
SX0 PC.SYS
IX0 X0+X1
WX6 X0
* CONDENSE *S0CMP*.
RJ =XCONDENS
* RESTORE THE USER'7S FILE DIRECTORY.
RJ ROD
ENTRY CMPGO
CMPGO PS ENTRY/EXIT
* CHECK IF CENTRAL EXECUTION SELECTED.
SA1 CMPF
ZR X1,CMPGO RETURN IF NOT SELECTED
* CHECK IF THE MICRO PLATO CONDENSE WAS COMPLETED.
SA2 PLREQC
* /--- BLOCK LEVEL 00 000 81/08/21 23.02
SX2 X2-P.DONE
NZ X2,CMPGO IF NOT COMPLETE
* CHECK FOR CONDENSE ERRORS.
SA2 ERRTOT
NZ X2,CMPGO RETURN IF CONDENSE ERRORS
* SAVE AND CLEAR THE CONDENSOR COMMAND STATISTICS FLAG.
SA1 TSCOMFG
BX7 X1
SA6 A1
SA7 CMPGOA
* LOAD AND EXECUTE THE PRIMARY CMP OVERLAY.
SA1 CMPOV10
SB1 1
SX1 X1
BX6 -X1
NG X1,CMPGO3 IF CMP OFF
SX7 A1
EQ LEXEC
* CHECK CMP ERROR TYPE.
CMPGO1 PL X5,CMPGO2 IF FATAL CMP ERROR
* NON-FATAL ERRORS HAVE OCCURRED DURING THE TRANSLATION
* PHASE OF ACMP CONDENSE. RETURN TO PLATO WITH THE
* THESE ERRORS IN THE ERROR BUFFER, WHICH WILL BE
* DISPLAYED BY LESSON *CONDERR*.
SX0 PC.INF1
SA0 ERRTOT
IX0 X0+X1
+ WE 1
RJ =XECSPRTY
RJ EBH
SX6 P.CMPER
SA6 PLREQC
EQ CMPGO RETURN
* A FATAL ERROR HAS OCCURRED DURING THE TRANSLATION
* PHASE OF A CMP CODENSE. SET THE FATAL ERROR CODE,
* WHICH WILL BE USED BY UNIT *FILERR* OF LESSON
* *PLATO*, AND ABORT THE CONDENSE.
CMPGO2 SX6 X5+ (X6) = FATAL ERROR CODE
CMPGO3 SA6 IOBUFF
RJ ABORTC
EQ CMPGO RETURN
CMPGOA BSS 1
* TABLE FOR CATAGORIZING THE CMP TERMINATION CODE.
*
* .LT. 0 - NON-FATAL ERRORS FOR DISPLAY BY LESSON *CONDERR*.
* .EQ. 0 - NO ERRORS.
* .GT. 0 - FATAL ERROR NUMBER FOR UNIT *FILERR* OF
* LESSON *PLATO*.
CMPGOB DATA 0 NO ERRORS
DATA 34 OUTPUT FILE OVERFLOW
DATA 35 INPUT / OUTPUT ERROR
DATA 36 ILLEGAL OUTPUT LINE LENGTH
DATA 37 OUTPUT INITIALIZATION ERROR
DATA 38 INPUT INITIALIZATION ERROR
DATA 39 MISSING END OF OUTPUT LINE
DATA -1 UNTRANSLATABLE LESSON
ROD SPACE 4,10
** ROD - RESTORE ORIGINAL DIRECTORY.
*
* ENTRY (ACMPDIR) = SAVED DIRECTORY EM FWA.
*
* EXIT NONE.
*
* USES A - 0, 1.
* B - NONE.
* X - 0, 1.
*
* CALLS ECSPRTY.
*
* MACROS NONE.
ROD PS ENTRY/EXIT
* GET ADDRESS TO WRITE DIRECTORY.
SA1 APLACOM
SX0 PC.DIR
* /--- BLOCK LEVEL 00 000 81/08/21 23.02
IX0 X1+X0
SA0 RODA
+ RE 1
RJ =XECSPRTY
* READ DIRECTORY.
SA1 ACMPDIR
BX0 X1
SA0 WORK
+ RE 64
RJ =XECSPRTY
* WRITE DIRECTORY.
SA1 RODA
BX0 X1
+ WE 64
RJ =XECSPRTY
EQ ROD RETURN
RODA BSS 1 DIRECTORY EM FWA
SOD SPACE 4,10
** SOD - SAVE ORIGINAL DIRECTORY.
*
* ENTRY (ACMPDIR) = SAVED ORIGINAL DIRECTORY EM FWA.
*
* EXIT NONE.
*
* USES A - 0, 1.
* B - NONE.
* X - 0, 1.
*
* CALLS ECSPRTY.
*
* MACROS NONE.
SOD PS ENTRY/EXIT
* READ DIRECTORY EM FWA.
SA1 APLACOM
SX0 PC.DIR
IX0 X0+X1
SA0 SODA
+ RE 1
RJ ECSPRTY
* READ DIRECTORY.
SA1 SODA
BX0 X1
SA0 WORK
+ RE 64
RJ =XECSPRTY
* WRITE DIRECTORY.
SA1 ACMPDIR
BX0 X1
+ WE 64
RJ =XECSPRTY
EQ SOD RETURN
SODA BSS 1 EM DIRECTORY FWA
MTLOAD SPACE 10,20
ENTRY MTLOAD
MTLOAD SA1 MTREL GET RELEASE LEVEL
SB1 1 MINIMUM LEVEL ALLOWED
SB2 X1
LT B2,B1,BADLEV IF LESS THAN MINIMUM ALLOWED
SB3 B1+NLEVEL MAX LEVEL
GE B2,B3,BADLEV IF LEVEL OUT OF RANGE
SB1 B2-B1 OFFSET TO LOAD WORD
SA1 LEVEL+B1
SX1 X1
NG X1,NOLEV IF THIS LEVEL NOT AVAILABLE
SX7 A1
SB1 1 SAME ENTRY FOR ALL LEVELS
* LOAD AND EXECUTE THE DESIRED LEVEL.
* (X7) = FWA OF DESIRED OVERLAY INFORMATION WORD .
* (B1) = WORD WITHIN LEVEL TO JUMP TO.
LEXEC RJ LLD
SA2 CLEVEL
RJ =XLOADOV
SB2 B1+B2
JP B2
* THE SELECTED LEVEL OF MICRO PLATO HAS BEEN
* INTENTIONALLY INHIBITED ON THIS SYSTEM. ABORT
* THIS CONDENSE. -(X1) = ERRO NUMBER FOR UNIT
* FILERR OF LESSON PLATO.
NOLEV BX6 -X1 (X6) = ERROR CODE
SA6 IOBUFF
RJ ABORTC
EQ CONDENS END THIS CONDENSE
BADLEV SX6 B2
SA6 IOBUFF+1
* /--- BLOCK LEVEL 00 000 78/11/16 00.02
SX6 32
SA6 IOBUFF
RJ ABORTC
EQ =XCONDENS
ENTRY OVRLTAB,NOVRLYS
OVRLTAB BSS 0
CLEVEL BSSZ 1 ECS COPY OF RUNCFL DURING INITS
SUBOV LEVEL0
LEVEL SUBOV LEVEL1,44
SUBOV LEVEL2
SUBOV LEVEL3
SUBOV LEVEL4
SUBOV LEVEL5
*
* * * LOAD EXPERIMENTAL VERSION OF MICRO PLATO
SUBOV LEVEL6 (WAS LEVEL6,41,DEV)
NLEVEL EQU *-LEVEL
SUBOV CMPOV10 PRIMARY CMP OVERLAY OVERLAY
* INFO WORD
NOVRLYS EQU *-OVRLTAB
* LIBRARY FILE RANDOM INDEX TABLE.
RITAB BSS 0
RIT HERE
* /--- BLOCK -ABORTC- 00 000 81/07/21 01.49
TITLE -ABORTC- ABORT CONDENSE
*
*
* -ABORTC-
* TERMINATES CONDENSE WITHOUT RETURNING A BINARY
*
* ON ENTRY - IOBUFF(0) = ERROR TYPE
* IOBUFF(1) = ANY EXTRA INFORMATION
*
*
ENTRY ABORTC
ABORTC PS ENTRY/EXIT
SA1 APLACOM
SX0 PC.INFO
IX0 X0+X1
SA0 IOBUFF WRITE OUT ERROR INFO
+ WE 2
RJ ECSPRTY
SX6 P.ABORT SET PLATO REQUEST CODE
SA6 PLREQC
EQ ABORTC RETURN
*
* /--- BLOCK MASTOR 00 000 81/06/25 23.45
*
MACREF MASTOR$
MASTOR MACRO BUF,REQ,RECALL,P1,P2,P3,P4,P5,P6
MACREF MASTOR
SX6 REQ
SA6 BUF
.P ECHO ,P=(P1,P2,P3,P4,P5,P6),N=(2,3,4,5,6,7)
.N IFC NE,*P**
.M MICRO 1,1, P
.X IFC EQ,*".M"*X*
BX6 P
.X ELSE
SA1 P
BX6 X1
.X ENDIF
SA6 BUF+N
.N ENDIF
.P ENDD
SX1 BUF
RJ =XMASREQ
IFC NE,*RECALL**,2
SX1 BUF
RJ =XMASWAIT
ENDM
*
*
* /--- BLOCK CLOSE 00 000 81/07/14 07.12
CLOSE SPACE 5,11
TITLE DISK I/O ROUTINES
*** CLOSE - CLOSE ANY OPEN FILES.
ENTRY CLOSE
CLOSE EQ *
SA1 LESNME CHECK IF ANY FILES NEED CLOSING
ZR X1,CLOSE IF NO FILE
SB2 FREQ
RJ CPF CLOSE PLATO FILE
SB2 UREQ
SA1 B2+MS.RDIM+5
ZR X1,CLOSE IF NO USE FILE
RJ CPF CLOSE PLATO FILE
EQ CLOSE EXIT
CPF SPACE 5,11
** CPF - CLOSE PLATO FILE
*
* ENTRY - (B2) = FILE REQUEST BLOCK
ENTRY CPF
CPF EQ *
SX1 B2 WAIT FOR PENDING REQUEST
RJ MASWAIT
SA2 B2+MS.RDIM+6 X2 = OPEN ERROR CODE
SX2 X2-8 X2 = 8 IF ALREADY OPENED
ZR X2,CPF10 IF NO NEED TO CLOSE FILE
*
MASTOR B2,MS.CPF,R,B2+MS.RDIM+5
CPF10 BSS 0
BX6 X6-X6 SHOW NO FILE OPEN
SA6 B2+MS.RDIM+5
SA6 B2+MS.RDIM+7 CLEAR THE BAD CODEWORD FLAG
EQ CPF
* /--- BLOCK MASREQ 00 000 81/07/14 07.13
TITLE -MASREQ- ISSUE / WAIT FOR *MASTOR*.
SPACE 5,11
*** MASREQ - ISSUE *MASTOR* REQUEST
*
* ENTRY - (X1) - ADDRESS OF REQUEST BUFFER
ENTRY MASREQ
MASREQ EQ *
BX6 X0 SAVE X0, A0
SA6 MASA
SX6 A0
SA6 MASA+1
* FIND A FREE MASTOR REQUEST SLOT IN ECS
SA2 MASFREE ECS FWA OF NEXT FREE SLOT
SA0 A2
BX0 X2
NZ X2,MASR2 IF THERE IS A FREE SLOT
SA2 400000B FATAL ERROR, NO FREE SLOT
MASR2 RE 1 NEXT FREE ELEMENT TO *MASFREE*
RJ ECSPRTY
SA0 X1
SA1 MASB INDEX IN POINTER BUFFER
WE MS.RDIM WRITE REQUEST TO ECS
RJ ECSPRTY
* PLACE A POINTER IN THE CIRCULAR REQUEST BUFFER
SX6 X1+1 INCREMENT INDEX
SX0 X6-NMREQ
NG X0,MASR4 IF NO OVERFLOW
SX6 0 RESET
MASR4 SA6 A1 STORE NEW INDEX VALUE
BX6 X2 ECS FWA OF REQUEST
SA6 A0+1 SAVE IN 2ND WORD OF CM COPY
SA2 ACMASRQ
IX0 X1+X2 ADDRESS FOR POINTER WORD
WX6 X0 POST REQUEST TO MASTOR
SA1 MASA RESTORE A0/X0
BX0 X1
SA1 MASA+1
SA0 X1
EQ MASREQ
* /--- BLOCK MASWAIT 00 000 81/07/14 11.49
SPACE 5,11
*** MASWAIT - WAIT FOR *MASTOR* REQUEST TO COMPLETE
*
* ENTRY - (X1) = REQUEST TO WAIT FOR
* ADD RELEASED REQUEST AREA TO FRONT OF FREE CHAIN
MASW1A SA0 MASFREE
BX6 X0 ECS FWA OF RELEASED REQ. AREA
WE 1 WRITE OUT OLD *FIRST FREE*
RJ ECSPRTY
SA6 A0 NEW *FIRST FREE* POINTER
MASW1 SA0 X2 RE-STORE A0
ENTRY MASWAIT
MASWAIT EQ *
SX2 A0 SAVE A0
SA0 X1
SA1 X1+1 (X1) = ADDRESS OF ECS REQUEST
ZR X1,MASW1 IF NO REQUEST
BX0 X1
MASW2 RE MS.RDIM
RJ ECSPRTY
SA1 A0 CHECK IF COMPLETE
LX1 59-11
NG X1,MASW1A IF COMPLETE
CALL S=RCL
EQ MASW2 CHECK AGAIN
MASA DATA 0 STORAGE
DATA 0
MASB DATA 0 INDEX TO NEXT REQUEST AREA
ENTRY MASFREE
MASFREE BSS 1 FREE CHAIN POINTER
* /--- BLOCK CONSUB 00 000 81/07/25 15.11
TITLE CONDENSOR SUBROUTINES
*
TITLE -UNNAM- GET CURRENT UNIT NAME
*
*
*
* -UNNAM-
* ON EXIT - X1 = 0 IF VALID UNIT NAME
* X6 = UNIT NAME (IF X1=0)
* X1 = -1 IF BAD UNIT NUMBER
* X6 = LAST NAME IN TABLE (IF X1=-1)
*
ENTRY UNNAM
UNNAM EQ *
SA5 UNUMON UNIT NUMBER
BX6 X5 X6 = UNIT NUMBER
RJ UNNAMX6 X6 = UNIT NAME
EQ UNNAM
*
* -UNNAMX6-
* ON ENTRY - X6 = UNIT NUMBER
* ON EXIT - X1 = 0 IF VALID UNIT NAME
* X6 = UNIT NAME (IF X1=0)
* X1 = -1 IF BAD UNIT NUMBER
* X6 = LAST NAME IN TABLE (IF X1=-1)
*
ENTRY UNNAMX6
UNNAMX6 EQ *
LX6 48 HIGH ORDER BYTE = UNIT NUMBER
MX0 12
SA3 UNUMIN NUMBER OF UNITS
SB4 X3
SB3 B0
*
UNN1 SA1 B3+UNAME LOAD ENTRY
BX2 X0*X1 MASK OFF UNIT NUMBER
BX2 X2-X6 CHECK IF UNIT BEING SEARCH FOR
ZR X2,UNN2
SB3 B3+1
LT B3,B4,UNN1
MX1 -1 FLAG INVALID UNIT NUMBER
BX6 -X0*X1 USE LAST UNIT NAME
EQ UNNAMX6
*
UNN2 BX6 -X0*X1 MASK OFF UNIT NAME
MX1 0 INDICATE VALID UNIT NAME
MX2 48
SA3 KTUNIT CHECK FOR M-TUTOR UNIT
BX2 X2*X6
BX2 X3-X2
NZ X2,UNNAMX6 EXIT IF CPU UNIT
SX3 X6 PICK OFF M-TUTOR UNIT NUMBER
ZR X3,UNNAMX6 EXIT IF CPU UNIT
SA3 X3+UNITTAB LOAD M-TUTOR UNIT NAME
AX3 12
BX6 -X0*X3 X6 = UNIT NAME
EQ UNNAMX6
*
KTUNIT VFD 12/0,30/5LTUNIT,6/0,12/0
*
*
* /--- BLOCK LJUST 00 000 80/08/20 12.37
TITLE -LJUST- LEFT JUSTIFY NAME
*
*
* -LJUST-
* LEFT JUSTIFIES THE NAME IN X1 CHANGING TYPE
* OF FILL IF INDICATED
*
* B1 = OLD FILL CHARACTER
* B2 = NEW FILL CHARACTER
* USES X0,X1,X2,X3,X6,X7, B1,B2,B3
*
*
ENTRY LJUST
LJUST EQ *
SX6 B1 PICK UP FILL CHARACTERS
SX7 B2
ZR X1,LJ1
MX0 6 MASK FOR ONE CHARACTER
SB3 10
*
LJ BX2 X0*X1 LEFT JUSFIFY NAME
LX2 6
BX3 X2-X6 SEE IF OLD FILL CHARACTER
ZR X3,LJ0
BX3 X2-X7 SEE IF NEW FILL CHARACTER
NZ X3,LJ1
LJ0 LX1 6 POSITION NEXT CHARACTER
SB3 B3-1 END TEST
PL B3,LJ
*
LJ1 EQ B1,B2,LJUST
MX0 -6
SB3 10 END TEST
*
LJ2 BX2 -X0*X1 MASK OFF NEXT CHARACTER
BX3 X2-X7
ZR X3,LJ3 JUMP IF NEW FILL CHARACTER
BX3 X2-X6
NZ X3,LJUST EXIT IF NOT OLD FILL TYPE
BX1 X0*X1
BX1 X1+X7 REPLACE CHARACTER
*
LJ3 LX0 6 POSITION MASK
LX6 6 POSITION OLD FILL CHAR
LX7 6 POSITION REPLACEMENT CHAR
SB3 B3-1
NZ B3,LJ2 END TEST
EQ LJUST
*
*
* /--- BLOCK SSETBIT 00 000 80/07/02 14.19
TITLE BIT TABLE MANIPULATION
*
*
*
* -SSETBIT-
* ON ENTRY - X1 = INDEX IN BIT TABLE
* B1 = ADDRESS OF BIT TABLE
*
*
ENTRY SSETBIT
SSETBIT EQ *
PX2 X1 CONVERT TO FLOATING POINT
NX2 X2
SA3 =0.01 AVOID ROUND-OFF ERROR
FX2 X2+X3
NX2 X2
SA3 =60.0
FX2 X2/X3 COMPUTE WORD COUNT
UX2 X2,B2
LX2 X2,B2 CONVERT BACK TO INTEGER
SX3 60
DX3 X2*X3 COMPUTE REMAINDER
IX0 X1-X3
SB2 59
SB3 X0 COMPUTE SHIFT COUNT
SB2 B2-B3
SA2 X2+B1 LOAD PROPER WORD OF BIT TABLE
SX6 1
LX6 X6,B2 POSITION BIT
BX6 X2+X6
SA6 A2 STORE UPDATED WORD
EQ SSETBIT
*
*
TITLE RCTOXY
* THIS ROUTINE CONVERTS AN INTEGER SPECIFYING A ROW-COLUMN
* SCREEN POSITION TO ITS EQUIVALENT X AND Y SCREEN CO-ORDINATES.
*
* ON ENTRY -- X1 = ROW-COLUMN POSITION
* ON EXIT -- X6 = X
* X7 = Y
*
* THE FOLLOWING REGISTERS ARE USED--X2,X3,X4,X6,X7,B2.
* THE CONTENTS OF X1 ARE PRESERVED AND NO A REGISTERS ARE USED.
*
*
ENTRY RCTOXY
*
RCTOXY EQ *
SX2 100
PX2 X2 X2 = 100 IN FLOATING POINT FORMAT
PX3 X1 X3 = PACKED ROW-COLUMN POSITION
NX4 X2 NORMALIZE DIVISOR
FX4 X3/X4 DIVIDE BY 100
UX4 X4,B2
LX4 X4,B2 X4 = QUOTIENT
PX3 X4
DX2 X2*X3 X2 = 100*QUOTIENT
UX2 X2
IX2 X1-X2 X2 = REMAINDER
SX6 X2-1 SUBTRACT 1
LX6 3 AND MULTIPLY BY 8 TO GET X CO-ORDINATE
LX4 4 MULTIPLY BY 16
SX2 512
IX7 X2-X4 AND SUBTRACT FROM 512 TO GET Y CO-ORDINATE
EQ RCTOXY
*
*
* /--- BLOCK MVECS 00 000 81/06/25 04.50
CONDEN
*
* -MVECS-
* MOVE AN ECS BUFFER OF LENGTH (X3) FROM (X1)
* TO (X2) THROUGH CM BUFFER OF LENGTH (B1)
* AT (A0)
*
* USES X0-4, B1
*
ENTRY MVECS
MVECS EQ *
PL X3,NOTRAP
SA4 -1
NOTRAP BSS 0
IX4 X1-X2 SOURCE-DESTINATION
ZR X4,MVECS NO DISPLACEMENT
*
PL X4,MV10 IF MOVE TO LOWER ADDR
*
MX5 0
SX4 -B1 INCREMENT
IX1 X1+X3 END OF BUFFER + 1
IX1 X1+X4 LAST PAGE OF BUFFER
IX2 X2+X3 END OF BUFFER + 1
IX2 X2+X4 LAST PAGE OF BUFFER
EQ MV20
*
MV10 SX4 B1 INCREMENT
*
MV20 BSS 0
SX0 B1 (X0) = ABS(INCREMENT)
IX3 X3-X0 WORDS LEFT AFTER PAGE
NG X3,MV30 IF PARTIAL PAGE LEFT
*
BX0 X1
+ RE B1 READ PAGE
RJ ECSPRTY
BX0 X2
+ WE B1 WRITE PAGE
RJ ECSPRTY
IX1 X1+X4 MOVE SOURCE
IX2 X2+X4 MOVE DESTINATION
EQ MV20
*
MV30 BSS 0
PL X4,MV40 IF MOVING TO LOWER ADDR
*
IX1 X1-X3 REMAINDER SOURCE
IX2 X2-X3 REMAINDER DESTINATION
*
MV40 BX0 X1
SX3 X3+B1
SB1 X3 LENGTH OF REMAINDER
+ RE B1 READ REMAINDER
RJ ECSPRTY
BX0 X2
WE B1 WRITE REMAINDER
RJ ECSPRTY
EQ MVECS
*
ENDIF
*
* -MVECSD-
*
* MOVE ECS THROUGH DEFAULT BUFFER
*
* FOR REGISTER USAGE, SEE -MVECS-
*
ENTRY MVECSD
MVECSD EQ *
SA0 ECSMVBA ADDRESS OF ECS MOVE BUFFER
SB1 ECSMVBL LENGTH OF ECS MOVE BUFFER
RJ =XMVECS MOVE THROUGH A0/B1
EQ MVECSD
*
* /--- BLOCK MVECS 00 000 75/10/04 10.28
* -OPENECS-
*
* OPEN A HOLE IN AN ECS BUFFER ASSUMING
* ALL UNUSED SPACE IS AT THE END OF THE BUFFER
* ALSO MAY BE USED TO CLOSE A PREVIOUSLY OPENED
* HOLE BY SETTING X2 < X1
*
* ON ENTRY
* X1 = HOLE FWA
* X2 = HOLE LWA + 1
* X3 = NUMBER OF WORDS IN USE AFTER HOLE
* X4 = BUFFER LWA + 1
*
* ON EXIT
* X5 ^> 0 IF OPENED SUCCESSFULLY
* < 0 IF NO ROOM TO OPEN HOLE
*
* USES X0-5, A0 AND B1
*
ENTRY OPENECS
OPENECS EQ *
IX5 X2+X3 LWA OF ECS IN USE + 1
IX5 X4-X5 UNUSED WORDS AFTER OPENED
NG X5,OPENECS IF NO ROOM TO OPEN
*
OPECS10 RJ =XMVECSD SHUFFLE BUFFER AROUND
EQ OPENECS
*
TITLE KEY LIST
*
*
ENTRY NKLIST
ENTRY NKLEND
* LIST OF KEYS WHICH CAN PLAY ROLE OF NEXT KEY TO
* INITIATE JUDGING. THIS LIST IS USED BY CONDEN TO
* CONDENSE THE -JKEY- COMMAND, AND BY LEX AS A LIST OF
* SPECIAL NAMES AND ASSOCIATED KEY CODES.
*
* ** 'N'O'T'E '; CRUDELY DUPLICATED IN *LOGICX* FOR EXECUTOR. **
* ADDITIONAL KEY NAMES THAT ARE ALLOWED IN THE ',ZK',
* FUNCTION ARE LISTED IN DECK ',LEX',.
*
NKLIST VFD 42/6LFUNKEY,18/FUNKEY 200
VFD 42/0,18/FUNKEY+1 201
VFD 42/4LNEXT,18/NEXT 202
VFD 42/5LNEXT1,18/NEXT1 203
VFD 42/5LERASE,18/ERASE 204
VFD 42/6LERASE1,18/ERASE1 205
VFD 42/4LHELP,18/HELP 206
VFD 42/5LHELP1,18/HELP1 207
VFD 42/4LBACK,18/BACK 210
VFD 42/5LBACK1,18/BACK1 211
VFD 42/3LLAB,18/LAB 212
VFD 42/4LLAB1,18/LAB1 213
VFD 42/4LDATA,18/DATA 214
VFD 42/5LDATA1,18/DATA1 215
VFD 42/4LTERM,18/TERM 216
VFD 42/3LANS,18/ANS 217
VFD 42/4LCOPY,18/COPY 220
VFD 42/5LCOPY1,18/COPY1 221
VFD 42/4LEDIT,18/EDIT 222
VFD 42/5LEDIT1,18/EDIT1 223
VFD 42/5LMICRO,18/MICRO 224
VFD 42/6LMICRO1,18/MICRO1 225
VFD 42/4LSTOP,18/STOP 226
VFD 42/5LSTOP1,18/STOP1 227
VFD 42/3LTAB,18/TAB 230
VFD 42/0,18/TAB+1 231
VFD 42/0,18/TAB+2 232
VFD 42/6LTIMEUP,18/TIMEUP 233
VFD 42/0,18/TIMEUP+1 234
VFD 42/7LCATCHUP,18/CATCHUP 235
*
* /--- BLOCK MVECS 00 000 75/10/04 10.28
*
* 'HOME,'HOME1,'END,'END1,'INS,'INS1,
* 'DEL,'DEL1,'PG'UP,'PG'UP1,'PG'DN,'PG'DN1
*
VFD 42/70101715050000B,18/236B
VFD 42/70101715053400B,18/237B
VFD 42/70051604000000B,18/240B
VFD 42/70051604340000B,18/241B
VFD 42/70111623000000B,18/242B
VFD 42/70111623340000B,18/243B
VFD 42/70040514000000B,18/244B
VFD 42/70040514340000B,18/245B
VFD 42/70200770252000B,18/246B
VFD 42/70200770252034B,18/247B
VFD 42/70200770041600B,18/250B
VFD 42/70200770041634B,18/251B
*
* 'RTARR, 'LFARR, 'UPARR, 'DNARR,
* 'RTARR1, 'LFARR1, 'UPARR1, 'DNARR1
*
VFD 42/70222401222200B,18/252B
VFD 42/70140601222200B,18/253B
VFD 42/70252001222200B,18/254B
VFD 42/70041601222200B,18/255B
VFD 42/70222401222234B,18/256B
VFD 42/70140601222234B,18/257B
VFD 42/70252001222234B,18/260B
VFD 42/70041601222234B,18/261B
*
* ','ICON',
*
VFD 42/70110317160000B,18/262B
*
*
NKLEND BSS 1 TO PLANT SEARCH WORD
* /--- BLOCK COND RJERR 00 000 81/07/28 02.34
*
* -RJERR2- (SPECIFY YOUR OWN HEADER INFO)
*
* FOUR ARGUMENTS (B1,B2,X1,X2)
* B1 = ERROR NUMBER (VALUE > 2047)
* B2 = ZERO IF BAD LINE IS TO BE SAVED
* X1 = VALUE FOR SECOND HEADER WORD (IF 12 BITS
* OR LESS THEN IT IS MERGED WITH COMMAND)
* X2 = VALUE FOR THIRD HEADER WORD (IF 12 BITS
* OR LESS THEN IT IS MERGED WITH UNIT NAME)
*
ENTRY RJERR2
RJERR2 PS
SB6 RJERR2
EQ ERRGO JUMP INTO STANDARD ROUTINE
*
* -RJERRB- (SPECIFY YOUR OWN BUFFER)
*
* SIX ARGUMENTS (B1,B2,X1,X2,B3,B4)
* B1,B2,X1,X2 = SAME AS FOR ERR2
* B3 = ADDRESS OF SPECIAL BUFFER TO SAVE
* B4 = BUFFER LENGTH
ENTRY RJERRB
RJERRB PS
SB6 RJERRB B6 = RETURN ADDRESS
SX6 1
SA6 ZCONDOK SET ZCONDOK FLAG
RJ PUTBUF STORE THE USER BUFFER
EQ B2,ERRGO JUMP IF SAVING BAD LINE
RJ FIXCU STORE 2ND AND 3RD HEADER WORDS
EQ ERRGOH DONE IF NOT SAVING BAD LINE
*
ENTRY RJERNOZ
RJERNOZ EQ *
SB6 RJERNOZ SET RETURN ADDRESS
SB2 B0 CLEAR OTHER ARGUMENTS
SX1 B0
SX2 B0
EQ ERRNOZ
*
ENTRY RJERR
RJERR PS
SB6 RJERR B6 = RETURN ADDRESS
SB2 B0 CLEAR OTHER ARGUMENTS
SX1 B0
SX2 B0
* /--- BLOCK COND RJERR 00 000 81/07/28 01.25
* OTHER ROUTINES ENTER HERE
ERRGO SX6 1 SET ZCONDOK FLAG
SA6 ZCONDOK
ERRNOZ RJ FIXCU STORE 2ND AND 3RD HEADER WORDS
SB4 B0 SET TO NO BUFFER TO STORE
+ NE B2,*+1 JUMP IF NOT SAVING THE BAD LINE
RJ PACKTAG PACK UP TAG OF BAD LINE
SB3 ERRBUF ADDRESS OF THAT LINE
RJ PUTBUF STORE IN CEBUF AND SET HEADER
ERRGOH SA4 LCEBUF NOW MOVE HEADER TO CEBUF
SX0 3 THREE WORD HEADER
IX6 X4-X0
NG X6,ERRFULL
SA6 A4
SA4 ERRCNT INC COUNT OF ERRORS SAVED
SX6 X4+1
SA6 A4
SA4 PCEBUF ECS ADR OF WHERE TO PUT HEADER
IX6 X4+X0 NEW VALUE FOR PCEBUF
SA6 A4
BX0 X4
SA0 HEAD
+ WE 3 WRITE HEADER
RJ ECSPRTY
ERRFULL SA4 ERRTOT INC TOTAL NUMBER OF ERRORS
SX6 X4+1
SA6 ERRTOT
SX6 B0
SA6 HEAD CLEAR FIRST HEADER WORD
SA1 =XCALCACT
ZR X1,ERRGOX EXIT IF NO CALC IS ACTIVE
SA6 CALCACT DISCARD COMPILED CODE, IF ANY
ERRGOX JP B6 EXIT
* /--- BLOCK PUTBUF 00 000 81/06/25 04.50
*
* -PUTBUF-
*
* 'THIS ROUTINE STORES A BUFFER OF ERROR
* INFO INTO THE END OF CEBUF. 'IT SETS UP
* THE FIRST HEADER WORD WITH THE BUFFER LENGTH
* AND A POINTER HOLDING THE DISPLACEMENT OF
* THE BUFFER FROM THE FIRST WORD OF CEBUF.
* 'IF B4 IS NEG. OR ZERO ON ENTRY, THEN THE HEADER
* IS SET UP WITH ZERO FIELDS.
*
* ON ENTRY, (B3,B4) HOLD THE BUFFER ADR AND LENGTH
* (B1) HOLDS THE ERROR NUMBER
*
* PRESERVES REGISTERS B1,B2,X1,X2 (AND A5,B5..B7,X7)
*
PUTBUF DATA 0
LE B4,PUTBUFE JUST STORE HEADER IF NO BUFFER
SA4 LCEBUF SPACE LEFT IN CEBUF
SA0 B3 CM ADDRESS OF INFO
SB3 X4
GT B4,B3,ERRFULL EXIT IF NO ROOM
SX6 B3-B4 AMOUNT LEFT NOW
SA6 A4 UPDATE LCEBUF
SA4 PCEBUF POINTER INTO CEBUF (ABSOLUTE)
IX0 X4+X6 WHERE TO WRITE INFO
SA4 ACEBUF START OF CEBUF
IX6 X0-X4 REL DISPLACEMENT TO THIS BUFFER
+ WE B4
RJ ECSPRTY
PUTBUFH LX6 12 RELATIVE BUFFER POINTER
SX4 B4 BUFFER LENGTH
BX6 X6+X4
LX6 12
SX4 B1 ERROR NUMBER
BX6 X6+X4
SA4 HEAD LINE AND BLOCK NUMBER, IF ANY
LX6 48
BX6 X6+X4 MERGE
SA6 HEAD
EQ PUTBUF
PUTBUFE SB4 B0 STORE ZEROS IF NO BUFFER
SX6 B0
EQ PUTBUFH
* /--- BLOCK FIXCU 00 000 81/07/28 02.05
*
* -FIXCU-
*
* 'THIS ROUTINE STORES THE INFO FOR
* THE SECOND AND THIRD HEADER WORDS.
*
* X1 = INFO FOR SECOND HEADER WORD. 'IT IS
* MERGED WITH THE BAD COMMAND NAME
* IF THE TOP 48 BITS ARE ZERO.
*
* X2 = INFO FOR THIRD HEADER WORD. 'IT IS
* MERGED WITH THE UNIT NAME IF THE TOP
* 48 BITS ARE ZERO.
*
* PRESERVES REGISTERS B1,B2 (AND A5,B5,X5,A7,B7,X7)
*
FIXCU DATA 0
BX6 X1 MOVE USER INFO
MX0 48 SEE IF MORE THAN 12 BITS
BX1 X0*X1
BX0 X0*X2
+ NZ X1,*+1
SA1 COMMAND COMMAND THAT HAS ERROR
BX6 X1+X6 MERGE WITH COMMAND NAME
SA6 HEAD+1 STORE 2ND HEADER WORD
BX6 X2 MOVE 2ND WORD OF USER INFO
NZ X0,FIXCUX EXIT IF MORE THAN 12 BITS
* FIND THE UNIT NAME
SA3 PPTF CHECK IF CONDENSING PPT CODE
NZ X3,FU20
SA3 UNUMON UNIT NUMBER
MX0 12
LX3 48 PUT IN TOP 12 BITS
SA1 UNUMIN LENGTH
SB4 X1
SB3 B0
FULOOP SA1 B3+UNAME LOAD ENTRY
BX2 X0*X1 MASK OFF UNIT NUMBER
BX2 X2-X3 CHECK IF SAME UNIT NUMBER
ZR X2,FU JUMP IF YES
SB3 B3+1
LT B3,B4,FULOOP USE LAST UNIT NAME IF NOT FOUND
FU BX0 -X0*X1
LX0 12
BX6 X6+X0 MERGE WITH USER INFO
EQ FIXCUX
*
FU20 SA3 IUNUM LOAD CURRENT UNIT NUMBER
SA3 X3+UNITTAB LOAD UNIT NAME
MX0 -12
BX3 X0*X3 MASK OFF UNIT NAME
BX6 X3+X6 MERGE WITH USER INFO
FIXCUX SA6 HEAD+2 STORE 3RD HEADER WORD
EQ FIXCU
* /--- BLOCK PACKTAG 00 000 78/02/17 04.49
*
* -PACKTAG-
*
* 'THIS ROUTINE PACKS UP THE COMMAND TAG
* INTO THE CM BUFFER -ERRBUF-. 'RETURNS B4
* WITH THE NUMBER OF WORDS OF INFO (ALWAYS > 0).
* 'THE FIRST TWO CHARS OF THE FIRST WORD ARE
* SET TO WORDPT-TAG (I.E. COUNT FOR UNDERLINING).
*
* 'IF THE LINE CONTAINS HIDDEN CHARACTERS,
* BIT 49 IN THE FIRST HEADER WORD IS SET.
*
* 'THIS ROUTINE ALSO SAVES THE LINE AND BLOCK
* OF WHERE THE ERROR IS IN THE SOURCE.
*
* 'PRESERVES REGISTER B1 (AND A5,B5,X5,A7,B7,X7)
*
PACKTAG EQ *
SX4 0 X4 = ZERO IF NO HIDDEN CHARS
SA3 HIDDEN X3 = BITS SHOWING HIDDEN CHARS
SA1 COMMAND CHECK COMMAND FOR HIDDEN CHARS
MX0 54
BX1 X1*X0 TO INSURE ZERO AT END
HCMNDLP LX1 6
BX2 -X0*X1
ZR X2,HCMNDFIN
SB2 X2-4 E-O-L,A,B,C ARE NOT HIDDEN
LX2 X3,B2 SEE IF THIS CHAR IS HIDDEN
PL X2,HCMNDLP JUMP IF NOT
SX4 1 SET FLAG AND EXIT
*
HCMNDFIN SX0 B1+0 PRESERVE B1 IN X0
SB4 1 UNIVERSAL INCREMENT VALUE TO B4
SB2 B0
SX6 B0
SA6 TAG+TAGLTH GUARENTEE ZERO WORD AT END
SB3 8
SA1 ERRBUF-1 SET UP A6
BX6 X1
SA6 A1
SA1 WORDPT SET UP FIRST TWO CHARS
SX6 TAG
IX6 X1-X6
MX1 -12
BX1 X1*X6 CHECK WITHIN TAG BOUNDS
ZR X1,PCT10
SX6 0 INSURE LEGAL BIAS
PCT10 SX1 X6-TAGLTH
NG X1,PACKLOOP
SX6 0 INSURE LEGAL BIAS
* /--- BLOCK PACKTAG2 00 000 81/07/28 01.48
*
PACKLOOP SA1 TAG+B2 LOAD TAG CHARACTER
ZR X1,PACKOUT BRANCH IF END OF TAG
LX6 6
BX6 X6+X1
SB2 B2+B4 INCREMENT NO. TAG CHARS
SB3 B3-B4 DECREMENT CHAR/WORD
SB1 X1-4 E-O-L,A,B,C ARE NOT HIDDEN
LX1 X3,B1 SEE IF THIS CHAR IS HIDDEN
PL X1,PCKLOOPA JUMP IF NOT
SX4 1
PCKLOOPA NZ B3,PACKLOOP
SB3 10 CHARS/WORD RESET
SA6 A6+B4 STORE FULL WORD
MX6 0
EQ PACKLOOP
*
PACKOUT ZR B2,PACKO2 SENSE NO TAG
SA1 A1-1 CHECK FOR TRAILING SPACE
SX1 X1-1R
NZ X1,PACKO2
SX4 1 COUNT TRAIL SPACE AS HIDDEN
PACKO2 LX6 6
SB3 B3-B4
NZ B3,PACKO2 LEFT JUSTIFY LAST WORD
SA6 A6+B4 STORE LAST WORD
SB4 ERRBUF-1
SB4 A6-B4 B4 RETURNED WITH WORD COUNT
SA3 LINENUM SET LINE AND BLOCK NUMBER
LX3 24
LX4 11 POSITION FLAG FOR HIDDEN LINE
BX6 X3+X4 MERGE WITH LINE NUMBER
SA4 BLKNUM
LX4 36
BX6 X4+X6
SA6 HEAD STORE IN FIRST HEADER WORD
SB1 X0 RESTORE B1
EQ PACKTAG EXIT
*
*
ERRBFL SET TAGLTH+10
ERRBUF BSS ERRBFL/10 CM BUFFER FOR PACKED-UP TAG
*
HIDDEN DATA 00000000000000001716B
* /--- BLOCK UERRSET 00 000 81/07/28 01.49
*
* -UERRSET-
*
* 'THIS ROUTINE SETS THE BLOCK AND LINE
* NUMBER IN THE HEADER TO THE LAST UNIT COMMAND.
*
ENTRY UERRSET
UERRSET PS
SA1 ULINENM
SA2 UBLKNM
LX1 24
LX2 36
BX6 X1+X2
SA6 HEAD
EQ UERRSET
* /--- BLOCK END 00 000 81/07/14 11.49
*
EBH SPACE 4,10
** EBH - ERROR BUFFER HEADER.
*
* BUILD THE ERROR BUFFER HEADER.
*
* FORMAT - 60/NUMBER OF ERRORS IN THE BUFFER.
* 60/ACCOUNT NAME.
* 60/LESSON NAME.
* 20/TOTAL ERRORS, 20/UNITS, 20/LESSON LENGTH.
ENTRY EBH
EBH PS ENTRY/EXIT
SA1 ERRTOT TOTAL NUMBER OF ERRORS
SA2 UNUMIN
SX2 X2-IEUNUM NUMBER OF REAL UNITS
SA3 CONDPNT LESSON LENGTH
LX1 40
LX2 20
BX6 X1+X2
BX6 X6+X3
SA6 MAINBUF+3
SA1 ACCOUNT COPY ACCOUNT AND FILE NAME TO ERROR HEADER
SA2 LESSON
BX6 X1
BX7 X2
SA6 MAINBUF+1 ACCOUNT NAME
SA7 MAINBUF+2 LESSON NAME
SA1 ERRCNT COUNT OF ERRORS SAVED IN CEBUF
BX6 X1
SA6 MAINBUF
SA1 ACEBUF WRITE HEADER TO ECS
BX0 X1
SA0 A6
+ WE MAINHDL
RJ ECSPRTY
EQ EBH RETURN
*
* /--- BLOCK LLD 00 000 82/09/27 18.35
TITLE OVERLAY LOADING SUBROUTINES.
LLD SPACE 4,10
** LLD - LOAD A LEVEL FROM DISK.
*
* LOAD LEVEL OVERLAYS FROM DISK INTO EM.
*
* ENTRY (X7) = ADDR OF REQUESTED OVERLAY INFO WORD.
* (B1) = WORD IN OVERLAY TO JUMP TO (KLUDGE).
* (CLEVEL) = ADDR OF CURRENT OVERLAY INFO WD.
*
* EXIT (X7) = SAME AS ENTRY.
* (B1) = SAME AS ENTRY.
*
* USES X - 1, 7.
* A - 1, 7.
* B - 1.
*
* CALLS IOL, RMS.
*
* MACROS NONE.
LLD PS ENTRY / EXIT
* SEE IF LEVELS ARE BEING LOADED FROM DISK.
SA1 CDISK
ZR X1,LLD IF NOT LOADING FROM DISK
* SEE IF THE DESIRED LEVEL IS ALREADY IN EM.
SA1 CLEVEL
IX1 X7-X1
ZR X1,LLD IF LEVEL ALREADY LOADED
* SAVE REGISTERS.
SA7 LLDA SAVE X7
SX7 B1
SA7 LLDB SAVE B1
* INCREMENT COUNT.
SB1 1
SA1 ACLSTAT
SX0 SCDISK
IX0 X0+X1 (X0) = STATS WORD EM FWA
RX1 X0
SX6 X1+B1
WX6 X0
* INITIALIZE FOR OVERLAY LOADING.
RJ IOL
* GET RANDOM INDEX FOR REQUESTED LEVEL.
SA1 LLDA (X1) = LEVEL TO LOAD
SA1 X1+RITAB-LEVEL0 (X1) = RANDOM INDEX
* READ MASS STORAGE. (X1) = RANDOM INDEX.
RJ RMS
* LOWER THE CM FL BACK TO THE FL NEEDED TO RUN.
SA1 =XRUNCFL
SX6 X1
LX6 30
SA6 CMFL
CALL S=CM,CMFL
* RESTORE REGISTERS.
SA1 LLDA
BX7 X1 RESTORE X7
SA1 LLDB
SB1 X1 RESTORE B1
EQ LLD RETURN
* DATA.
LLDA BSS 1 SAVED X7
LLDB BSS 1 SAVED B1
* /--- BLOCK IOL 00 000 82/09/27 18.35
** IOL - INITIALIZE FOR OVERLAY LOADING.
*
* ENTRY (B1) = 1.
*
* EXIT LIBRARY FILE FET SET UP.
* LIBRARY FILE POSITIONED TO ULIB RECORD.
* (X1) = DATE OF NOGO.
* (X2) = TIME OF NOGO.
ENTRY IOL
IOL PS ENTRY / EXIT
* SET THE CM FL.
SA1 LOADFL
SX6 X1
LX6 30
SA6 CMFL
CALL S=CM,CMFL
* SET UP LIBRARY FILE FET.
* SET FILE NAME.
SA1 PGNR (X1) = LIBRARY / FILE NAME
MX0 42
BX1 X0*X1
SX6 B1
BX6 X6+X1
SA6 MASTER SET FILE NAME
* SET *FIRST*.
SA1 FIRST
SX6 X1
SA2 A6+B1
BX2 X0*X2
BX6 X2+X6
SA6 A2
* SET *IN*, *OUT*, AND *LIMIT.
SX6 X6
SA6 A6+B1 IN
SA6 A6+B1 OUT
SX6 X6+101B
SA6 A6+B1 LIMIT
* DETERMINE IF LOADING FROM LOCAL FILE OR SYSTEM.
STATUS MASTER
SA1 MASTER
SX2 7776B
BX2 X1*X2
NZ X2,IOL0 IF A LOCAL FILE EXISTS
* NO LOCAL FILE, SO LOADING FROM SYSTEM. ASSIGN IT.
ASSIGN MASTER,L
EQ IOL1
* LOADING FROM A LOCAL FILE. REWIND IT.
IOL0 REWIND MASTER,R
* /--- BLOCK IOL 00 000 82/09/27 18.35
* POSITION TO *ULIB* RECORD.
IOL1 SA1 MASTER+1 SET IN=OUT=FIRST
SX6 X1
SA6 A1+B1
SA6 A6+B1
READSKP MASTER,,R
SA1 MASTER
LX1 59-9
PL X1,IOL2 IF EOI NOT REACHED
CALL S=MSG,IOLA
CALL S=ABORT
IOL2 SA1 A1+B1
SA1 X1
SA3 A1+B1 (X3) = RECORD NAME
MX0 12
BX2 X1*X0
LX2 12
SX2 X2-7700B CHECK FOR IDENT TABLE
NZ X2,IOL1 IF NOT AN IDENT TABLE
SA2 MASTER CHECK FOR CORRECT RECORD NAME
BX2 X3-X2
MX6 42
BX2 X6*X2
NZ X2,IOL1 IF NOT CORRECT RECORD NAME
SA2 A1+7 CHECK FOR *ABS* RECORD TYPE
LX2 6
MX3 -6
BX2 -X3*X2
SX2 X2-1RA
NZ X2,IOL5 IF NOT *ABS* TYPE RECORD
* SAVE DATE / TIME OF NOGO.
SA3 A3+B1 (X3) = DATE OF NOGO
SA4 A3+B1 (X4) = TIME OF NOGO
BX6 X3
BX7 X4
SA6 IOLC
SA7 IOLD
IOL5 LX1 12
BX2 X1*X0 GET LENGTH OF TABLE
LX2 12
SB2 X2+B1 ACCOUNT FOR HEADER WORD
SA1 A1+B2
BX2 X0*X1
LX2 12
SX2 X2-7600B CHECK FOR *ULIB* TABLE
NZ X2,IOL1 IF NOT *ULIB* RECORD
* PASS DATE / TIME BACK TO CALLER.
SA1 IOLC
SA2 IOLD
EQ IOL RETURN
IOLA DATA C/ READOV - *ULIB* RECORD MISSING./
IOLB DATA 0
IOLC BSS 1 DATE OF NOGO
IOLD BSS 1 TIME OF NOGO
* /--- BLOCK RMS 00 000 82/09/27 18.35
RMS SPACE 5,11
** RMS - READ MASS STORAGE.
*
* THE OVERLAYS ARE READ FROM THE LIBRARY AND
* WRITTEN TO EM.
*
* ENTRY (X1) = 30/RANDOM ADDRESS FOR READ, 30/0.
*
* EXIT NONE.
*
* USES X - 0, 1, 2, 3, 6.
* A - 1, 2, 6.
* B - 2, 3, 4, 6, 7.
*
* CALLS BLV, ELV, PCS, PSO, S=ABORT, S=MSG.
*
* MACROS CALL, READ, RFILEB, RJTAB, S=CM.
ENTRY RMS
RMS PS ENTRY / EXIT
* SET UP FET FOR READ.
* SET THE RANDOM REQUEST.
SA2 MASTER+6
MX0 31
BX6 X0*X2
BX6 X6+X1
SA6 A2
* SET LIMIT.
SX6 B0
SA6 RMSA
CALL S=CM,RMSA
SA1 RMSA
AX1 30
SX6 X1 (X6) = LIMIT
SA6 MASTER+4
* READ THE NEXT RECORD.
RMS1 SA1 MASTER+1 SET IN = OUT = FIRST
SX6 X1
SA6 A1+1
SA6 A6+1
* SAVE THE CURRENT RANDOM INDEX.
SA1 MASTER+6
MX0 30
BX6 X0*X1
LX6 29-59+60 POSITION CURRENT RANDOM INDEX
SA6 LEVRI
READ MASTER,R
SA1 MASTER
LX1 59-4
NG X1,RMS2 IF END-OF-RECORD READ
CALL S=MSG,RMSB *NOT ENOUGH CM*
CALL S=ABORT
RMS2 LX1 1
NG X1,RMS5 IF END OF FILE
SA1 MASTER+2 IN
SA2 MASTER+3 OUT
IX3 X1-X2 READ WORD COUNT
ZR X3,RMS5 IF EMPTY RECORD READ
SA1 X2 FIRST DATA WORD
MX2 6
BX2 X2*X1
LX2 6
SX2 X2-77B
NZ X2,RMS5 IF NO PREFIX TABLE
LX1 24 LENGTH OF PREFIX TABLE
SB2 X1+1
SA1 A1+B2 (A1) = FWA OF OVERLAY
* /--- BLOCK RMS 00 000 82/09/27 18.35
* GET RECORD TYPE.
RMS3 SB4 A1 (B4) = 54 TABLE FWA
MX2 12
BX2 X2*X1
LX2 12 (X2) = RECORD TYPE
SX6 X2-7000B
ZR X6,RMS5 IF *OPLD* RECORD
SX6 X2-5400B
NZ X6,RMS6 IF NOT 5400 TABLE
LX1 -18
SB3 X1 (B3) = ADDRESS OF HEADER
LX1 -18
SB6 X1-0100B (B6) = OVERLAY TYPE - (1,0)
SA2 A1+4 (X2) = ADDR OF 1ST ENTRY POINT
SB2 X2 (B2) = ADDR OF 1ST ENTRY POINT
SB3 B2-B3 (B3) = OFFSET FOR STARTING LOC.
SA1 A1+B3 (X1) = FIRST WORD OF OVERLAY
* JUMP TO THE APPROPRIATE ROUTINE.
SB7 3 LARGEST = (1,3)
NG B6,RMS6 IF OUT OF RANGE
GT B6,B7,RMS6 IF OUT OF RANGE
SB6 B6+B6
JP B6+RMSTAB
RMSTAB RJTAB
RJTAB 0,BLV,RMS1 (1,0) - LEVEL BEGIN
RJTAB 1,PSO,RMS1 (1,1) - PROCESS SUBOVERLAY
RJTAB 2,ELV,RMS4 (1,2) - LEVEL END
RJTAB 3,PCS,RMS1 (1,3) - PROCESS CMP SUBOV
RJTAB 3
* IF NOT INITIAL RUN-THROUGH, WE ARE DONE.
RMS4 SA1 OVEMFWA
NG X1,RMS1 LOOP
* ALL DONE. IF LOADING LEVELS FROM DISK, REQUEST
* THE MAX EM NEEDED. (MAXOVEM) = MAX EM NEEDED.
RMS5 SA1 CDISK
ZR X1,RMS IF NOT LOADING FROM DISK
SA1 OVEMFWA
PL X1,RMS IF NOT FIRST TIME THROUGH
SA1 MAXOVEM
SB1 1
SB3 X1 (B3) = EM REQUIRED
RJ =XREM
SA1 OVLECS
BX6 X1 (X6) = EM FWA
SA6 OVEMFWA
EQ RMS RETURN
RMS6 CALL S=MSG,RMSC *BAD OVERLAY FILE*
CALL S=ABORT
* DATA.
MASTER RFILEB 0,1,(FET=8)
RMSA VFD 30/0,30/0 MEM STATUS WORD
RMSB DIS 0,*INSUFFICIENT CM FOR OVERLAYS*
RMSC DIS 0,*BAD OVERLAY FILE*
* /--- BLOCK BLV 00 000 82/09/27 18.35
BLV SPACE 4,10
** BLV - BEGIN LEVEL.
*
* RECEIVED (1,0) OVERLAY, INITIALIZE NEW LEVEL
* SET UP OFFSET POINTER, CHANGE I/O BUFFER POINTER
*
* ENTRY ((X1)) = OVERLAY INFORMATION WORD.
* (B2) = ADDRESS OF FIRST ENTRY POINT.
BLV PS ENTRY / EXIT
* CHECK FOR THIS LEVEL OFF.
* ((X1)) = OVERLAY INFORMATION WORD.
SA3 X1
SX3 X3
PL X3,BLV1 IF THIS LEVEL IS ON
* SET FLAG FOR SKIPPING THIS LEVEL.
SX6 -1
SA6 LVLOFF
EQ BLV RETURN
* SET FLAG TO LOAD THIS LEVEL.
BLV1 SX6 B0
SA6 LVLOFF
* SAVE THE RANDOM INDEX FOR THIS LEVEL IF THE FIRST
* TIME THROUGH.
SA2 OVEMFWA
PL X2,BLV2 IF NOT THE FIRST TIME THROUGH
SA2 LEVRI
BX6 X2 (X6) = RANDOM INDEX
SA6 X1-LEVEL0+RITAB
BLV2 SX1 B2 ADDRESS WHERE OVERLAY GOES
SX6 A1 LOCATION ADDRESS REALLY IS
SA6 LOC SAVE LOCATION OF OVERLAY
IX6 X6-X1 GET OFFSET TO SUBOV POINTERS
SA6 OFFSET USED TO PROCESS (1,1) OVERLAYS
SA1 MASTER+1 FIRST
SX6 X1
MX6 42
BX6 X6*X1
SA2 A1+1 NEXT FREE ADDRESS (IN)
BX6 X6+X2 SET FIRST
SA6 A1
* INITIALIZE THE EM REQUIRED FOR A LEVEL TO THE
* LENGTH OF THE 1,0 OVERLAY. (X6) = LWA + 1.
SA1 LOC (X1) = FWA
SX6 X6
IX6 X6-X1 (X6) = 1,0 OVERLAY LENGTH
SA6 OVEM
* SET THE WORD CONTAINING THE NEXT ADDRESS THAT
* A SUBOVERLAY WILL BE WRITTEN TO WHEN OVERLAYS
* ARE KEPT ON DISK TO THE FIRST WORD OF THE EM
* BUFFER. (X6) = 1,0 OVERLAY LENGTH.
SA1 OVEMFWA
IX6 X6+X1
SA6 OVLECS
EQ BLV RETURN
* /--- BLOCK PCS 00 000 82/09/27 18.35
PCS SPACE 5,10
** PCS - PROCESS CMP SUBOVERLAYS.
*
* THE CMP OVERLAY STRUCTURE BEGINS WITH THE PRIMARY
* (1,0) CMP OVERLAY FOLLOWED BY THE (1,3) CMP
* SUBOVERLAYS AND IS TERMINATED BY A (1,2) DUMMY
* OVERLAY.
*
* THE CENTRAL MICRO PLATO SUBOVERLAYS ARE FOUND IN
* LEVEL (1,3) OVERLAYS. EACH SUBOVERLAY CORRESPONDS
* TO A CYBIL MODULE OR COMPASS IDENT. THESE MODULES
* AND IDENTS MAY CONTAIN MULTIPLE ENTRY POINTS.
*
* IN EACH SUBOVERLAY, THE TRANSFER ADDRESS POINTS TO
* A TABLE USED TO LINK THE SUBOVERLAY INFORMATION
* WORDS (SIW) FOUND IN IDENT -CMPILXO- WITH THE
* ENTRY POINTS IN THE SUBOVERLAY. EACH ENTRY IN
* THIS TABLE IS ONE WORD, AND THE TABLE IS
* TERMINATED BY A ZERO WORD. THE FORMAT OF EACH
* ENTRY IS -
*
* 24/0, 18/SIW ADDRESS, 18/ENTRY ADDRESS.
*
* ENTRY (B4) = OVERLAY 54 TABLE FWA.
*
* EXIT NONE.
* /--- BLOCK PCS 00 000 82/09/27 18.35
PCS PS ENTRY / EXIT
SA3 LVLOFF
NG X3,PCS IF CMP = OFF
SB1 1
SA1 B4 (X1) = 54 TABLE FWA
* GET SUBOVERLAY ENTRY POINT TABLE FWA = XFR ADDR.
SA2 A1+4 (X2) = 42/ENTRY PT, 18/XFR ADDR
SB6 X2 (B6) = TRANSFER ADDRESS
* COMPUTE OFFSET = CURRENT HEADER LOCATION -
* FWAS.
LX1 42 POSTITION FWAS
SB5 X1 (B5) = FWAS
SB2 A1-B5 (B2) = CODE OFFSET
* COMPUTE OVERLAY LENGTH. LENGTH = LWA+1 - FWAS.
* (B5) = FWAS.
SA2 B4+B1 (X2) = 42/STUFF, 18/LWA+1
SB3 X2 (B3) = LWA+1
SB3 B3-B5 (B3) = OVERLAY LENGTH
* CHECK IF OVERLAYS ARE TO BE WRITTEN TO EM, OR
* ARE TO STAY ON DISK.
SA1 CDISK
NZ X1,PCS2 IF TO STAY ON DISK
* SUBOVERLAYS ARE TO BE WRITTEN TO EXTENDED MEMORY.
PCS1 BSS 0
* MAKE SURE THERE IS ENOUGH CM TO HOLD THIS OVERLAY.
* (B5) = FWAS. (B3) = OVERLAY LENGTH.
RJ =XCCC
* REQUEST EXTENDED MEMORY. (B3) = OVERLAY LENGTH.
RJ =XREM
* WRITE SUBOVERLAYS TO EM.
RJ WCS
EQ PCS RETURN
* SUBOVERLAYS ARE TO STAY ON DISK, AND ONLY LOADED
*
* WHEN NECESSARY.
PCS2 BSS 0
* DETERMINE IF THIS IS THE INITIAL RUN-THROUGH.
SA1 OVEMFWA
PL X1,PCS3 IF NOT INITIAL RUN-THROUGH
* COMPUTE SUBOVERLAY CM REQUIREMENT.
RJ =XCCC
* COMPUTE SUBOVERLAY EM REQUIREMENT.
RJ =XCSE
EQ PCS RETURN
* WRITE SUBOVERLAY TO EM.
PCS3 RJ WCS
EQ PCS RETURN
* /--- BLOCK WCS 00 000 82/09/27 18.35
WCS SPACE 4,10
** WCS - WRITE CMP SUBOVERLAYS TO EM.
*
* ENTRY (OVLECS) = EM FWA TO WRITE OVERLAYS.
* (B1) = 1.
* (B2) = CODE OFFSET.
* (B3) = OVERLAY LENGTH.
* (B4) = CURRENT CODE LOCATION
* (B5) = FWAS.
* (B6) = TRANSFER ADDRESS = POINTER TO
* ENTRY POINT TABLE.
*
* EXIT (OVLECS) = NEXT FREE EM ADDRESS.
* (B1) = SAME AS ENTRY.
* (B2) = SAME AS ENTRY.
* (B3) = SAME AS ENTRY.
* (B5) = SAME AS ENTRY.
*
* USES X - 0, 1, 2, 3, 6.
* A - 0, 1, 2, 6.
* B - 4, 6.
*
* CALLS NONE.
*
* MACROS NONE.
WCS PS ENTRY / EXIT
* WRITE OVERLAY TO EM. (OVLECS) = EM FWA.
SA1 OVLECS
BX0 X1 (X0) = EM FWA
SA0 B4 (A0) = CURRENT CODE LOCATION
+ WE B3
RJ =XECSPRTY
* UPDATE NEXT EM LOCATION.
SX6 B3
IX6 X6+X1
SA6 A1
* PREPARE TO SET CMP OVERLAY TABLE ENTRIES.
* FORM SUB-OVERLAY INFORMATION WORD (SIW).
* (X1) = EM FWA.
SX0 B3 (X0) = OVERLAY LENGTH
LX1 18
BX3 X1+X0
SX0 B5 (X0) = FWAS
LX3 18
BX3 X3+X0 (X3) = SIW.
SA1 OFFSET
SB4 X1 (B4) = CODE OFFSET.
* SET CMP OVERLAY TABLE ENTRIES. (X3) = SIW.
* (B6) = TRANSFER ADDRESS = POINTER TO ENTRY
* POINT TABLE. (B4) = OFFSET.
WCS3 SA1 B6+B2
ZR X1,WCS IF NO MORE ENTRY POINTS
* SET WORD 2 -
* 30/JUMP TO XDCLED PROCEDURE, 30/0.
LX1 42
SX2 X1+B4 (X1) = OVERLAY TABLE ENTRY FWA
SA2 X2+B1 (X2) = OV TABLE WORD 2
MX0 18
BX6 X0*X1 (X6) = 18/XDCLED ENTRY PT
LX6 47-59+60
BX6 X6+X2 (X6) = 30/EQ XDCL
SA6 A2
* SET WORD 3 -
* SIW = 24/EM FWA, 18/LENGTH, 18/CM FWA.
BX6 X3 (X6) = SIW
SA6 A2+B1
SB6 B6+B1 INCREMENT ENTRY POINT TABLE PTR
EQ WCS3 LOOP
* /--- BLOCK PSO 00 000 82/09/27 18.35
PSO SPACE 5,11
** PSO - PROCESS SUBOVERLAYS.
*
* IF OVERLAYS ARE TO STAY ON DISK AND THIS IS THE
* FIRST TIME THROUGH, COMPUTE THE CM/EM REQUIREMENTS
* AND RETURN.
*
* IF OVERLAYS ARE TO STAY ON DISK AND THIS IS NOT
* THE FIRST TIME THROUGH, WRITE THE SUBOVERLAY
* TO EM.
*
* IF OVERLAYS ARE NOT TO STAY ON DISK, REQUEST AN
* EM BUFFER AND WRITE THE SUBOVERLAY TO EM.
*
* ENTRY - (A1) - POINTER TO FIRST WORD OF OVERLAY
* (X1) - FIRST WORD OF OVERLAY
* (B2) - ADDRESS OF FIRST WORD
PSO PS ENTRY / EXIT
* IF THIS LEVEL IS OFF, DO NOTHING.
SA2 LVLOFF
NG X2,PSO IF THIS LEVEL IS OFF
ZR X1,PSO OVFILE LENGTH = 0 (FIRST WORD)
SB1 1
* GET LENGTH OF OVERLAY FILE AND SET POINTER TO
* FIRST SUBOVERLAY.
SB3 X1 (B3) = LENGTH OF OVERLAY FILE
SB4 A1+B1 (B4) = POINTER TO NEXT SUBOV
* SAVE B3, B4.
SX6 B4
LX6 18
IX6 X6+X1
SA6 PSOA
* CHECK IF OVERLAYS ARE TO BE WRITTEN TO EM, OR
* ARE TO STAY ON DISK.
SA1 CDISK
NZ X1,PSO2 IF TO STAY ON DISK
* SUBOVERLAYS ARE TO BE WRITTEN TO EXTENDED MEMORY.
PSO1 BSS 0
* REQUEST EXTENDED MEMORY FOR THE SUBOVERLAYS.
RJ =XREM
* COMPUTE SUBOVERLAY CM REQUIREMENT.
RJ =XCSC
* RESTORE B3, B4.
SA1 PSOA
SB3 X1
LX1 59-35+18
SB4 X1
* WRITE SUBOVERLAYS TO EM.
RJ WSE
EQ PSO RETURN
* SUBOVERLAYS ARE TO STAY ON DISK, AND ONLY LOADED
* WHEN NECESSARY.
PSO2 BSS 0
* DETERMINE IF THIS IS THE INITIAL RUN-THROUGH.
SA1 OVEMFWA
PL X1,PSO3 IF NOT INITIAL RUN-THROUGH
* COMPUTE SUBOVERLAY CM REQUIREMENT.
RJ =XCSC
* RESTORE B3, B4.
SA1 PSOA
SB3 X1
LX1 59-35+18
SB4 X1
* COMPUTE SUBOVERLAY EM REQUIREMENT.
RJ =XCSE
EQ PSO RETURN
* WRITE SUBOVERLAY TO EM.
PSO3 RJ WSE
EQ PSO RETURN
PSOA BSS 1 SAVED B3, B4
* /--- BLOCK WSE 00 000 82/09/27 18.35
WSE SPACE 4,10
** WSE - WRITE SUBOVERLAYS TO EM.
*
* ENTRY (OVLECS) = EM FWA TO WRITE SUBOVERLAY.
* (B1) = 1.
* (B2) = FWA OF OVERLAY FILE.
* (B3) = LENGTH OF OVERLAY FILE.
* (B4) = POINTER TO NEXT SUBOV.
*
* EXIT (OVLECS) = NEXT FREE EM ADDRESS.
* (B1) = SAME AS ENTRY.
* (B2) = SAME AS ENTRY.
*
* USES X - 0, 1, 2, 3, 6.
* A - 0, 1, 2, 3, 6.
* B - 3, 4, 7.
*
* CALLS NONE.
*
* MACROS NONE.
WSE PS ENTRY / EXIT
* SEE IF THERE ARE ANY MORE SUBOVERLAYS TO PROCESS.
WSE1 ZR B3,WSE IF NO MORE SUBOVERLAYS
* GET SUBOVERLAY LENGTH.
SA1 B4
SB7 X1 (B7) = SUBOVERLAY LENGTH
SB3 B3-B7
* GET SUBOVERLAY NAME AND ADDRESS.
SA1 B4+B1
SA2 OFFSET
IX2 X1+X2 (X2) = PTR TO SUBOV INFO WORD
SA2 X2
* MAKE SURE THE SUBOVERLAY NAMES MATCH.
MX6 42
BX2 X2-X1
BX6 X2*X6
NZ X6,"CRASH" IF NAMES DO NOT MATCH
* WRITE SUBOVERLAY TO EM.
SA0 A1 (A0) = CURRENT CM ADDRESS
SA3 OVLECS (X3) = SUBOVERLAY EM FWA
BX0 X3
+ WE B7
RJ =XECSPRTY
* UPDATE NEXT EM ADDRESS.
SX1 B7
IX6 X3+X1
SA6 A3
* FORM SUBOVERLAY INFO WORD.
SX6 B2 SUBOVERLAY CM FWA
LX1 18
BX6 X6+X1
LX0 18+18
BX6 X6+X0
SA6 A2
SB4 A1+B7 (B4) = POINTER TO NEXT SUBOV
EQ WSE1 LOOP
* /--- BLOCK ELV 00 000 82/09/27 18.35
ELV SPACE 4,10
** ELV - END LEVEL.
*
* RECEIVED (1,2) OVERLAY, SIGNALLING
* END OF LEVEL, AND ALSO CONTAINS POINTERS TO
* THE COMMAND TABLE. IF POINTER IS ZERO, HASHING
* IS NOT DONE.
ELV PS ENTRY / EXIT
SA3 LVLOFF
NG X3,ELV IF THIS LEVEL OFF
ZR X1,ELV1 FIRST WORD MEANS TTUTOR
RJ HASHI
ELV1 SB1 1
SA2 LOC (X2) = FWA
SA1 X2 (X1) = NAME AND SUBOV ADDR
SA3 X1 (X3) = SUBOV INFORMATION WORD
* COMPUTE THE LENGTH OF THE 1,0 SUBOVERLAY.
* (X2) = FWA.
SA1 MASTER+3 LWA+1
IX6 X1-X2 AMOUNT OF ECS REQUIRED
SB3 X6 (B3) = LENGTH
* CHECK IF LOADING FROM DISK OR EM.
SA1 CDISK
ZR X1,ELV2 IF LOADING FROM EM
* LOADING FROM DISK - CHECK IF THIS IS THE FIRST
* TIME THROUGH.
SA1 OVEMFWA
BX0 X1 (X0) = EM FWA
PL X1,ELV3 IF NOT THE FIRST TIME THROUGH
* LOADING FROM DISK, AND THE FIRST TIME THROUGH.
* COMPUTE THE MAXIMUM AMOUNT OF EM REQUIRED.
SA1 OVEM (X1) = EM REQUIRED BY THIS LVL
SA2 MAXOVEM (X2) = MAX EM REQUIRED SO FAR
IX0 X2-X1
PL X0,ELV4 IF NOT LARGER THAN MAX SO FAR
BX6 X1
SA6 A2
EQ ELV4
* LOADING FROM EM - REQUEST EM FOR 1,0 OVERLAY.
* (B3) = 1,0 OVERLAY LENGTH.
ELV2 RJ =XREM
SA1 OVLECS
BX0 X1 (X0) = EM FWA
* WRITE 1,0 SUBOVERLAY TO EM. (X0) = EM FWA.
* (B3) = LENGTH.
ELV3 SA2 LOC (X2) = CM FWA
SA0 X2 (A0) = CM FWA
+ WE B3
RJ =XECSPRTY
* FORM OVERLAY INFO WORD. (X0) = EM LOCATION.
* ((A3)) = SUBOV INFORMATION WORD.
* (X2) = FWA.
SA1 OFFSET
SX6 X2 LOCATION IT CURRENTLY IS
IX6 X2-X1 LOCATION IT SHOULD BE LOADED
SX1 B3
LX1 18
BX6 X6+X1 AND OVERLAY LENGTH
LX0 18+18
BX6 X6+X0 AND ECS ADDRESS
SA6 A3 STORE BACK IN SUBOV WORD
* RESTORE *FIRST*.
ELV4 SA1 FIRST
SA2 MASTER+1
MX6 42
BX6 X2*X6
BX6 X6+X1
SA6 A2 RESTORE FIRST
* /--- BLOCK ELV 00 000 82/09/27 18.35
EQ ELV RETURN
SPACE 4,10
** OVERLAY LOADING SUBROUTINE DATA.
OFFSET BSS 1
LOC BSS 1
ENTRY FIRST
FIRST BSS 1 CIO BUFFER FWA
ENTRY OVLECS
OVLECS BSS 1
LVLOFF DATA 0
OVEMFWA DATA -1 OVERLAY LEVEL EM FWA
MAXOVEM DATA 0 MAX EM NEEDED BY LEVELS
ENTRY OVEM
OVEM DATA 0 EM NEEDED BY A PARTICULAR LEVEL
ENTRY MAXCM
MAXCM DATA 0 MAX CM FL REQUIRED
LEVRI DATA 0 LEVEL RANDOM INDEX
ENTRY LOADFL
LOADFL DATA 0 CM REQUIRED TO LOAD FROM DISK
* COMMON DECKS.
*CALL COMCLFM
*CALL COMCCIO
* SETUP SYSTEM INTERFACES TO USE INTERFACE IN
* IDENT *CSYS* ONLY.
EXT S=SYS
SYS= EQU S=SYS
EXT S=WNB
WNB= EQU S=WNB
EXT S=RCL
RCL= EQU S=RCL
EXT S=MSGX
MSG= EQU S=MSGX
TITLE INITIALIZE COMINFO (THE HASH INFO TABLE)
*CALL MACROS
ADR MICRO 1,,/A0/ DEFINE A0 TO BE START OF TABLE
COM MICRO 1,,/X3/ X3 SET TO COMINFO FOR FIND
* ENTER WITH (A1) POINTING TO FIRST POINTER
* (X1) CONTAINS VALUE
*
HASHI EQ * CALLED FROM -READOV- PROCESSING
SB1 1
SA2 OFFSET RELOCATION OFFSET
IX6 X1+X2 COMNAMS
SA6 COMNAMS
SA1 A1+B1
BX6 X1 COMNAML
SA6 A6+B1
SA1 A1+B1
IX6 X1+X2 COMINFO
SA6 A6+B1
SA1 A1+B1
BX6 X1 COMINFL
SA6 A6+B1
SA1 A1+B1
IX1 X1+X2 HASHCD
SA3 X1
BX6 X3 (HASHCD)
SA6 A6+B1
SA1 A1+B1
IX1 X1+X2 CALCNAM
SA3 X1
BX6 X3 (CALCNAM)
SA6 A6+B1
SA1 A1+B1
BX6 X1 LABELI
SA6 A6+B1
SA1 A1+B1
IX6 X1+X2 LABINFO
SA6 A6+B1
SA1 CMNDTBL
BX0 X1
SA1 COMNAMS
SA0 X1
SA1 COMNAML
SB1 X1
+ WE B1 WRITE OUT COMMAND NAME TABLE
RJ ECSPRTY
SA1 COMINFO
SA0 X1 A0 = START OF COMINFO
SB1 1 B1 = CONSTANT *1*
* HASH EACH NAME AND MERGE WITH INFO IN COMINFO
SA1 COMNAML
SB3 X1 LENGTH OF NAME TABLE
* /--- BLOCK ELV 00 000 82/09/27 18.35
SB2 B0 COUNTER FOR END TEST
SB7 B0 B7 = NUMBER OF REAL COMMANDS
CINITA SA1 COMNAMS LOAD NEXT WORD OF NAME TABLE
SA1 X1+B2
MX0 6
BX2 X0*X1 GET FIRST CHAR
ZR X2,CINITAA IGNORE IF NOT A REAL COMMAND
HASH X1,X2,A3 X2 IS HASH NUMBER FOR THIS NAME
SB4 X2 MOVE TO B4
SA3 A0+B2 LOAD INFO FOR THIS COMMAND
PX3 X3,B2 COMMAND NUMBER
LX3 30
PX3 X3,B2 INDEX TO NAME TABLE
LX3 42 POSITION INFO WORD PROPERLY
PX6 X3,B4 MERGE WITH HASH NUMBER
SA1 COMNAMS SAVE TEMP IN NAME TABLE
SA6 X1+B7
SB7 B7+B1 INCREMENT REAL COMMAND COUNT
CINITAA SB2 B2+B1
LT B2,B3,CINITA
* INITIALIZE THE FREE CHAIN (ALL OF COMINFO)
SX0 B0 STORE ZERO IN LOWER 48 BITS
SB2 B0 POINTER FOR END TEST
SA1 COMINFL
SB6 X1-1 B6 = START OF FREE CHAIN
PX6 X0,B6 MAKE FIRST WORD POINT TO LAST
CINITB SA1 COMINFO STORE NEXT WORD OF CHAIN
SA6 X1+B2
PX6 X0,B2 NEXT WORD POINTS BACK ONE WORD
SB2 B2+B1 END TEST
LE B2,B6,CINITB
* CONSTRUCT THE ACTUAL HASH TABLE
SB2 0 B2 = POINTER TO NEXT COMMAND
CINITC SA1 A0+B6 LOAD FIRST WORD OF FREE CHAIN
UX6,B5 X1 B5 = ADDRESS OF NEXT FREE WORD
SA1 A0+B5 DELETE THIS WORD FROM CHAIN
UX1,B3 X1 GET POINTER TO THIRD WORD
PX6 X6,B3 MAKE FIRST WORD POINT TO THIRD
SA6 A0+B6 RESTORE FIRST FREE CHAIN WORD
SA2 COMNAMS NEXT COMMAND TO PROCESS
SA2 X2+B2
UX2,B3 X2 B3 = HASH CODE FOR THIS COMMAND
ADDLINK B3,B5,X2,B4,A1,A6 ADD NEXT LINK FOR THIS HASH CODE
SB2 B2+B1 END TEST
LT B2,B7,CINITC
* MAKE ALL REMAINING FREE WORDS INTO ONE WORD CHAINS
SB5 B6 CHANGE COMMAND WILL BE FASTER
CINITD SA1 A0+B5 LOAD NEXT FREE WORD
PX6 X1,B5 MAKE IT POINT TO ITSELF
SA6 A1 STORE
UX1,B5 X1 GET POINTER TO NEXT WORD
NE B5,B6,CINITD LOOP IF NOT BACK TO FIRST WORD
* SAVE THE INITIAL COMINFO TABLE IN ECS
SA1 CMNDINF
BX0 X1
SA1 COMINFL
SB7 X1
+ WE B7 WRITE OUT HASHED INFO TABLE
RJ ECSPRTY
* GET TRUE COPY OF COMMANDS BACK INTO CM
SA1 CMNDTBL
BX0 X1
SA1 COMNAMS
SA0 X1
* /--- BLOCK ELV 00 000 78/12/15 23.21
SA1 COMNAML
SB7 X1
+ RE B7 READ COMMAND NAME TABLE
RJ ECSPRTY
SA1 COMINFO
SA0 X1 RESTORE A0 FOR THE MACROS
* FIND THE INFO FOR THE -CALC- COMMAND
* A0 POINTS TO THE HASH TABLE AT THIS POINT
SA2 CALCNAM HOLERITH FOR -CALC-
HASH X2,X0,A1
SA3 COMNAMS X3 REFERENCED VIA -COM- MICRO
FIND X2,X0,CINITE,B1,X5,B5,B3,B4,A1
CALL S=ABORT CAN'7T HAPPEN
* COMPUTE CONTENTS OF -LABINFO-
CINITE SA1 LABELI WHERE STATEMENT LABEL JUMPS TO
MX6 -18
LX5 -12
BX5 X6*X5 CLEAR OLD JUMP VALUE
BX6 X5+X1 MERGE WITH ADDRESS -LABELI-
LX6 12
PX6 X6,B5 ATTACH TABLE INDEX
SA1 LABINFO
SA6 X1 STORE INFO FOR STATEMENT LABEL
EQ HASHI
*
* THIS LIST MATCHES WITH THE LIST IN IDENT -MARKER-
* THAT IS ASSEMBLED AT THE END OF CPU TUTOR OVERLAYS
*
COMNAMS BSS 1 RELOCATED
COMNAML BSS 1
COMINFO BSS 1 RELOCATED
COMINFL BSS 1
HASHCD BSS 1 RELOCATED
CALCNAM BSS 1 RELOCATED
LABELI BSS 1
LABINFO BSS 1 RELOCATED
* /--- BLOCK -ZERO- 00 000 79/01/03 13.35
ZEROSAV SPACE 5,11
** ZEROSAV - SAVE REGISTERS USED BY *ZERO* MACRO
*
* SAVE *X4*, *A4*, *X7*, *A7*
ENTRY ZEROSAV
ZEROSAV PS
SA0 A4 HOLD *A4*
BX0 X4 HOLD *X4*
SA4 A7 GET WHATS STORED AT *A7*
SA7 ZBSAVX7 SAVE *X7*
BX7 X4 GET WHAT IS STORED AT *A7*
SA7 ZBSAVXX SAVE WHAT SHOULD BE THERE
SX7 A4 GET *A7* ADDRESS
SA7 ZBSAVA7 SAVE *A7*
BX7 X0 WRITE *X4* TO SAVE AREA
SA7 ZBSAVX4 SAVE *X4*
SX7 A0 WRITE *A4* TO SAVE AREA
SA7 ZBSAVA4 SAVE *A4*
EQ ZEROSAV RETURN
ZERORST SPACE 5,11
** ZERORST - RESTORE REGISTERS USED BY *ZERO* MACRO
*
* RESTORE *X4*, *A4*, *X7*, *A7*
ENTRY ZERORST
ZERORST PS
SA4 ZBSAVA4 GET *A4*
SA0 X4 HOLD *A4* IN *A0*
SA4 ZBSAVX4 GET *X4*
BX0 X4 HOLD *X4* IN *X0*
SA4 ZBSAVXX GET WHAT IS STORED AT *A7*
BX7 X4 MOVE TO WRITE REGISTER
SA4 ZBSAVA7 GET *A7* ADDRESS
SA7 X4 SAVE ORIGINAL DATA, SET *A7*
SA4 ZBSAVX7 GET WHAT WAS IN *X7*
BX7 X4 RESET *X7*
SA4 A0 RESET *A4*
BX4 X0 RESET *X4*
EQ ZERORST RETURN
*
ZBSAVXX BSS 1
ZBSAVX7 BSS 1
ZBSAVA7 BSS 1
ZBSAVX4 BSS 1
ZBSAVA4 BSS 1
*
* /--- BLOCK ENDX 00 000 78/12/19 00.05
END