Trailing-Edge
-
PDP-10 Archives
-
bb-d868a-bm
-
3-sources/maklib.mac
There are 31 other files named maklib.mac in the archive. Click here to see a list.
TITLE MAKLIB - RELOCATABLE BINARY FILE MANIPULATION PROGRAM
SUBTTL I.L. GOVERMAN (VERSION 2, PATCHING TOOL) 18-AUG-75
SUBTTL JANET EGAN (SCAN INTERFACE)/JIE 10-JAN-75
SUBTTL E. YOURDON (FUDGE2 PROGRAM)
CUSTVR==0
DECVER==2
DECMVR==0
DECEVR==20
; VERSION NUMBER TO .JBVER
LOC 137
EXP <<DECVER>B11+<DECMVR>B17+<DECEVR>>
RELOC
;LOAD SYSTEM WIDE SYMBOLS FROM APPROPRIATE PLACES
SEARCH SCNMAC,UUOSYM,MACTEN
;LOAD MODULES THAT WE REQUIRE
.REQUEST SYS:SCN7B, SYS:WILD, SYS:HELPER
;DEFAULT TO TWO-SEGMENT CODE
ND PURESW,1
IFN PURESW,<TWOSEGMENTS
LOW: RELOC 400000>
;MAKE CLEAN LISTING, UNLESS SOME MACRO BLOWS UP
ND BIGLST,0
IFE BIGLST, <SALL>
IFN BIGLST, <LALL>
SUBTTL EDIT HISTORY FOR MAKLIB
;EDIT SPR DESCRIPTION
;---- --- -----------
;
;7 (NONE) PRESERVE T2 ACROSS CALL TO CORE UUO IN ALLOC ROUTINE
;10 (NONE) FIX ?FILE NOT FOUND MESSAGE
; ** END OF VERSION 1 **
;11 (NONE) ADD BINARY PATCHING TOOL
;12 (NONE) FIX HANDLING OF .TEXT ASCIZ
;13 (NONE) MAKE WILD CARDS WORK FOR TRANSACTION FILES
;14 (NONE) MAKE WILD CARDS WORK FOR MASTER ON /L,/T AND /P
;15 (NONE) ALLOW USE OF THE FULL RADIX50 CHARACTER SET
;16 (NONE) DONT INCREMENT 2ND WORD OF HISEG PRODUCED TYPE 3 BLOCK
;17 (NONE) MKLNIO (NO INDEX) MESSAGE GIVES WRONG FILENAME
;20 (19567) "?ILL UUO ..." WHEN DOING INSERT CORRECTED
SUBTTL DEFINE THE ACCUMULATORS
;MAKLIB ACCUMULATOR DEFINITIONS
F==0 ;FLAGS
T1==1 ;SCAN INTERFACE AC
T2==T1+1 ; "
T3==T2+1 ; "
T4==T3+1 ; "
R==5 ;SYMBOL NAME
T==6 ;HISTORICAL AC
N==7 ;NUMBER OR WORD FOR IO
CC==10 ;CHARACTER AC FOR INPUT
A==11 ;ARGUMENT AC, USED BY ROUTINES
B==12 ;..
C==13 ;..
D==14 ;..
IOC==15 ;IO CHANNEL FOR ACTIVE FILE
FPT==16 ;POINTER TO FILE AREA FOR CURRENT FILE
P==17 ;STACK POINTER
SUBTTL SCAN INTERFACE BIT DECLARATIONS
SW.APP==1B18 ;APPEND
SW.DEL==1B19 ;DELETE
SW.EXT==1B20 ;EXTRACT
SW.INS==1B21 ;INSERT
SW.MAS==1B22 ;MASTER
SW.REP==1B23 ;REPLACE
SW.FIX==1B24 ;FIX
SW.WHO==1B25 ;WHO
SW.LST==1B35 ;LIST
SW.NOL==1B34 ;DELETE LOCAL SYMBOLS
SW.POI==1B33 ;LIST ENTRY POINTS
SW.IND==1B32 ;INDEX
SW.TRC==1B31 ;TRACE
SW.ADV==1B30
SW.EOT==1B29
SW.REW==1B28
SW.ZER==1B27
SUBTTL DECLARATION OF PARAMETERS
;INPUT-OUTPUT CHANNELS
SCNCHN==0 ;RESERVED FOR SCAN
OCHN==1 ;OUTPUT CHANNEL
MIN==2 ;MASTER FILE INPUT CHANNEL
TRIN==3 ;TRANSACTION FILE INPUT (ALSO USED FOR PATCH FILE)
; SYMBOL TABLE BITS THAT AGREE WITH THE DEFINITIONS THAT LINK USES
R5.DDT==400000,,0 ;SUPRESSED TO DDT
R5.REQ==600000,,0 ;GLOBAL REQUEST
R5.LCL==100000,,0 ;LOCAL SYMBOL
R5.GLB==040000,,0 ;GLOBAL DECLARATION
R5.FXA==1B0 ;GLOBAL FIXUP WORD 2,ADDITIVE FIXUP
R5.FXL==1B1 ; " " " ", TO LEFT HALF
R5.FXS==1B2 ; SYMBOL TABLE FIXUP
; DEFINAEABLE PARAMETERS
ND MAXMOD,^D20 ;NUMBER OF ARGS MAXIMUM FOR SWITCHES
ND FSSIZE,<.FXLEN+1+MAXMOD> ;TOTAL SIZE OF SPEC AREA
.FXPRG==.FXLEN+1 ;OFFSET IN SPEC AREA TO PROGRAM NAMES
ND SIZE,200 ;SIZE OF ENTRY BLOCK THAT PROGRAM CAN HAVE
ND MTBSIZ,200 ;SIZE OF MASTER AND/OR TRANSACTION FILE BUFFER
ND TABS1,20 ;NUMBER OF TAB STOPS FOR NON-TTY DEVICE
ND TABS2,11 ;FOR TTY
ND FTBPT,1 ;DEFAULT TO INCLUDE BPT
IFE FTBPT,<DEBUG==0> ;NO DEBUGGING IF NO BPT
ND CREMAX,^D100 ;MAXIMUM NUMBER OF NEW SYMBOLS
CREMAX==<CREMAX+^D8>/^D9*^D9 ;ROUND UP TO NEXT LINK BLOCK
ND PATMAX,^D512 ;MAXIMUM NUMBER OF NEW CODE WORDS
PATMAX==<PATMAX+^D16>/^D17*^D17 ;ROUND UP TO NEXT LINK BLOCK
ND TRCMAX,^D100 ;MAX. NUMBER OF TRACE WORDS AVAILABLE
ND ISTMAX,^D75 ;MAXIMUM NUMBER OF FORWARD REFERENCES OUTSTANDING
ND OPRSIZ,^D40 ;SIZE OF OPERAND STACK (4 WDS PER OPERAND)
ND OPTSIZ,^D10 ;SIZE OF OPERATOR STACK (1 WD PER OPERATOR)
ND MACSIZ,^D100 ;MAX. NR. OF MACRO CHARACTERS PER LINE
ND DEBUG,0 ;DEFAULT DEBUGGING STATUS
ND LI$TRC,1060 ;HEADER ID FOR TRACE BLOCK IN REL FILE
ND $EOL,12 ;CONVERT ALL BREAKS TO THIS
ND PD$LEN,^D150 ;DEFAULT PUSHDOWN LIST SIZE
SUBTTL FLAGS
; MACRO TO DEFINE FLAG BITS
DEFINE BIT($NAME)<
IFE $1BIT,<PRINTX ?TOO MANY FLAG BITS DEFINED>
$NAME==$1BIT
$1BIT==$1BIT*2
> ; END OF BIT DEFINITION
$1BIT==1 ;INIT
BIT(DEVTTY) ;ON MEANS OUTPUT DEVICE IS THE TTY
BIT(FOTTY) ;ON MEANS FORCE OUTPUT TO TTY
BIT(NOLOCB) ;ON MEANS DELETE LOCAL SYMBOLS
BIT(ERRB) ;ON MEANS PROGRAM ENTRY BLOCK TOO LARGE
BIT(IAE) ;ON MEAN BETWEEN .EDIT AND .ENDE
BIT(IAI) ;ON MEANS BETWEEN .INSERT AND .ENDI
BIT(F4IB) ;ON MEANS IGNORE F4 OUTPUT
BIT(XFLG) ;ON MEANS INDEX REQUESTED FOR FILE
BIT(DTAFLG) ;ON MEANS OUTPUT DEVICE IS DTA (SPECIAL INDEX)
BIT(NOWARN) ;ON MEANS DELETE "INDEX DELETED" MSG.
BIT(LSTENT) ;ON MEANS LIST ENTRY BLOCKS
BIT(FIXMOD) ;ON MEANS /FIX SWITCH WAS GIVEN
BIT(FSTMOD) ;ON MEANS [EDIT] SEEN SINCE LAST [MODULE]
BIT(CPASS2) ;ON MEANS WE'VE ALREADY REWOUND MASTER FILE
BIT(QUOTE) ;ON MEANS DONT EDIT CHARACTERS IN INPUT
BIT(REGET) ;ON MEANS GIVE LAST PATCH CHARACTER AGAIN
BIT(DEBMOD) ;ON MEANS IN DEBUGGING MODE
BIT(DEBIMC) ;ON MEANS DEBUGGING INTERNAL MACRO CODE
SUBTTL ERROR MESSAGE MACRO
; THESE MACROS INTERFACE WITH SCAN'S ERROR MESSAGE PROCESSOR.
; ALL BEHAVE ROUGHLY THE SAME. ALL USE T1-T4.
; $WARN IS USED TO PUT OUT A MESSAGE "%MKLXYZ TEXT"
; $TELL IS USED TO PUT OUT A MESSAGE OF THE FORM "[MKLXYZ TEXT]"
; $KILL IS USED TO PUT OUT A MESSAGE OF THE FORM "?MKLXYZ TEXT"
;
;
; ALL THREE MACROS TAKE UP TO FOUR ARGUMENTS;
;
; $PFX- THE UNIQUE 3 LETTER CODE FOR THIS ERROR. A LABEL IS CREATED
; OF THE FORM "E$$'$PFX"
;
; $TXT- THE REST OF THE MESSAGE TO BE TYPED OUT.
;
; $TYPO- A ROUTINE TO BE CALLED FOR TYPEOUT OF AC N. (OPTIONAL)
; IF PRESENT, IT IS PUSHJ P'ED TO AFTER THE TEXT IS TYPED.
;
; $CONT-IF THIS FIELD IS NON-BLANK, THEN MESSAGE CONTINUES. THE FINAL
; CALL TO .TCRLF SHOULD BE LABELED "X$$'$PFX"
; IF $CONT IS NON-BLANK AND NO LABEL X$$'$PFX EXISTS THEN
; ON SHORT ERROR STATUS CONTROL PASSES TO LABEL "DONERR"
; NOTE: ON A CONTINUED MESSAGE, FLAG BIT "FOTTY" IS STILL SET
; SO THAT AT THE LABEL "X$$'$PFX" AN INSTRUCTION LIKE
; TXZ F,FOTTY MUST BE PRESENT, UNLESS THE PROGRAM RESTARTS.
;
DEFINE $ERR($FLG,$PFX,$TXT,$TYPO,$CONT)<
IFB <$TXT>, <..TMP1==[EXP 0]>
IFNB <$TXT>, <..TMP1==[ASCIZ \$TXT\]>
E$$'$PFX:
IFIDN <$FLG>,<?>, <JSP T1,E$KIL>
IFIDN <$FLG>,<%>, <JSP T1,E$WRN>
IFIDN <$FLG>,<[>, <JSP T1,E$TEL>
IFE BIGLST,<XLIST>
XWD ''$PFX'',..TMP1
..TMP1==0
..TMP2==0
IFNB <$TYPO>, <..TMP1==$TYPO>
IFNB <$CONT>,<
IF1,<..TMP2==-1>
IF2,< IFDEF X$$'$PFX,<..TMP2==X$$'$PFX>
IFNDEF X$$'$PFX,<..TMP2==DONERR>
>>
XWD ..TMP1,..TMP2
LIST
> ;END OF $ERR DEFINITION
; FATAL ERROR:
DEFINE $KILL($PFX,$TXT,$TYPO,$CONT)<
$ERR(?,$PFX,<$TXT>,$TYPO,$CONT)>
; WARNING:
DEFINE $WARN($PFX,$TXT,$TYPO,$CONT)<
$ERR(%,$PFX,<$TXT>,$TYPO,$CONT)>
; COMMENTARY:
DEFINE $TELL($PFX,$TXT,$TYPO,$CONT)<
$ERR([,$PFX,<$TXT>,$TYPO,$CONT)>
; ROUTINES TO USE FOR TYPOUT OF AC N. NOTE THAT THESE ROUTINES ARE
; PUSHJ'ED TO AFTER AC T1 IS LOADED FROM AC N.
;
N$DEC==.TDECW## ;DECIMAL OUTPUT
N$OCT==.TOCTW## ;OCTAL
N$SIX==.TSIXN## ;SIXBIT
N$STRG==.TSTRG## ;STRING
N$50== PTYPO ;RADIX 50
N$CHR==.TCHAR## ;CHARACTER
N$PPN==.TPPNW## ;PPN
N$XWD==.TXWDW## ;XWD
SUBTTL INTERNAL FAILURE (STOPCODE) ERROR MACRO
; MAKLIB MAKES CHECKS ON ITS OWN BEHAVIOR AND REPORTS FAILURES
; AND INCONSITENCIES VIA THE $STPCD MACRO AND PROCESSOR.
DEFINE $STPCD($MSG)<
PUSHJ P,[MOVEI N,[ASCIZ \$MSG\]
PUSHJ P,STOPCD]
> ; END OF $STPCD MACRO
; MACROS AND PSEUDO-INTSTRUCTIONS USED BY BINARY PATCHING TOOL
;
IFN FTBPT,< ;DONT DEFINE IF BPT NOT INCLUDED
;MACRO TO GET FIRST NON-BLANK CHARACTER
DEFINE BYPASS<
PUSHJ P,MIC
XLIST
CAIN CC," "
JRST .-2
LIST >
;SOME COMMON INSTRUCTIONS
OPDEF SKPNUM [PUSHJ P,TDIGIT] ;SKIP IF CHARACTER IS NUMERIC
OPDEF SKPR50 [PUSHJ P,TR50] ;SKIP IF CHARACTER IS RADIX50
OPDEF SKPCM [CAIE CC,","] ;SKIP IF CHARACTER IS COMMA
OPDEF SKPNCM [CAIN CC,","] ;SKIP IF CHARACTER IS NOT COMMA
> ; NFI FTBPT
COMMENT \
FORMAT OF TRACE BLOCK (LINK ITEM TYPE 1060)
THE LINK ITEM TYPE, "TRACE BLOCK DATA" IS USED TO INCLUDE IN
THE REL FILE INFORMATION THAT CAN BE USED TO BOTH VERIFY AND CHANGE
THE PATCH STATUS OF A PROGRAM. THE FORMAT OF THE TRACE BLOCK FOLLOWS:
THE FIRST PART OF THE TRACE BLOCK IS THE STATIC AREA. THIS AREA APPEARS
IN EACH MODULE THAT IS AFFECTED BY THE PARTICULAR EDIT. THE STATIC AREAS
GIVE INFORMATION COMMON TO ALL MODULES AFFECTED BY AN EDIT AND
THE VARIABLE AREA GIVES THE CHANGING DATA ON THE
PARTICULAR EDIT AS IT GOES FROM MODULE TO MODULE.
!=====================================!
TB$HED ! LINK ITEM NUMBER ! LENGTH OF BLOCK !
!-------------------------------------!
TB$EDT ! SIXBIT EDIT NAME (UP TO 6 CHRS) !
!-------------------------------------!
TB$STA ! -1 IF ACTIVE !WHO LAST AFFECTED !
!-------------------------------------!
TB$MAK ! WHO CREATED ! DATE (15 BIT) !
!-------------------------------------!
TB$INS ! WHO INSTALLED ! DATE (15 BIT) !
!-------------------------------------!
TB$FUT ! RESERVED FOR FUTURE USE !
!-------------------------------------!
TB$LEN ! # OF ASS. EDITS ! # OF PCO GROUPS !
!=====================================!
THE STATIC AREA, WHICH IS REPEATED IN EACH MODULE, IS FOLLOWED
BY A VARIABLE AREA. THE VARIABLE AREA CONSISTS OF TWO PARTS, THE
FIRST GIVING DATA ON THE ASSOCIATED EDIT STATUS FOR THIS MODULE AND
THE NEXT GIVING THE ACTUAL PROGRAM CHANGE ORDERS (PCO'S). THE
LENGTH OF EACH OF THESE AREAS APPEARS IN THE STATIC AREA OF THE TRACE
BLOCK.
FOR EACH ASSOCIATED EDIT, THE FOLLOWING GROUP APPEARS:
!=====================================!
TB$AEN ! SIXBIT EDIT NAME OF A.E. !
!-------------------------------------!
TB$AES !X! RESERVED FOR FUTURE ! X=0 IF MUST NOT BE PRESENT
!=====================================! =1 IF MUST BE PRESENT
AFTER THE ASSOCIATED EDIT GROUPS APPEAR, IF THERE ARE ANY, THE
PCO GROUPS FOR THAT MODULE APPEAR. THERE ARE CURRENTLY THREE TYPES
OF PCO GROUPS; INSERT,REMOVE AND RE-INSERT. THEY CAN
APPEAR IN ANY ORDER AND THE TOTAL NUMBER IS OF COURSE VARIABLE.
INSERT PCO:
!=====================================!
TB$PCO !PCO TYPE CODE (1) ! LENGTH OF GROUP !
!-------------------------------------!
TB$DAT ! 0 !INSTS INSRTD! ADDR. OF INSERT !
!-------------------------------------! NR. OF NEW INSTRUCTIONS INSERTED (BITS 10-17)
TB$PAT ! NEW ADDR OF ORG ! ADDR OF PAT CODE!
!=====================================!
REMOVE PCO:
!=====================================!
TB$PCO !PCO TYPE CODE (2) ! LENGTH OF GROUP !
!-------------------------------------!
TB$REN ! SIXBIT EDIT NAME !
!=====================================!
RE-INSERT PCO:
!=====================================!
TB$PCO !PCO TYPE CODE (3) ! LENGTH OF GROUP !
!-------------------------------------!
TB$RIN ! SIXBIT EDIT NAME !
!=====================================!
\
SUBTTL DEFINED MNEMONICS FOR THE TRACE BLOCK DATA
DEFINE TBDA($NAME)<
TB$'$NAME==$OFFSET
$OFFSET==TB$'$NAME+1
>
$OFFSET==0 ;INIT
TBDA(HED) ;HEADER
TBDA(EDT) ;EDIT NAME
TBDA(STA) ;STATUS
TBDA(MAK) ;MAKER
TBDA(INS) ;INSERTER
TBDA(FUT) ;RESERVED
TBDA(LEN) ;LENGTH OF AREA
TBDA(VAR) ;VARIABLE AREA
TB$SIZ==$OFFSET-2 ;SIZE OF BLOCK STATIC AREA COUNT
$OFFSET==0 ;RELATIVE ADDRESS
TBDA(AEN) ;ASSOCIATED EDIT NAME
TBDA(AES) ;ASSOCIATED EDIT STATUS REQUIRED
AESIZ==$OFFSET ;SIZE OF ASSOCIATED EDIT
$OFFSET==0 ;RELATIVE ADDRESS
;PCO TYPE 1, INSERT
TBDA(PCO) ;ALWAYS THERE
TBDA(DAT) ;INSERTION DATA
TBDA(PAT) ;NEW ADDR OF DISPLACED INSTR,,1ST INSTRUCTION OF PATCH
PCO1SZ==$OFFSET ;SIZE OF PCO TYPE 1 GROUP
$OFFSET==0 ;PCO TYPE 2,REMOVE
TBDA(PCO) ;SAME AS ABOVE
TBDA(REN) ;SIXBIT EDIT TO REMOVE
PCO2SZ==$OFFSET
$OFFSET==0 ;PCO TYPE 3,RE-INSERT
TBDA(PCO) ;
TBDA(RIN) ;RE-INSERT EDIT NAME
PCO3SZ==$OFFSET
SUBTTL INITIALIZE AND SETUP OF MAKLIB
MAKLIB:
TDZA T1,T1 ; IN CASE OF CCL ENTRY
MOVEI T1,1 ;COMPUTE STARTING OFFSET
RESET ;RESET I/O DEVICES
MOVE [XWD LOW,LOW+1]
SETZM LOW
BLT LOWTOP-1
IFN PURESW,<
MOVE [XWD HIGH,LOW]
BLT LOWBLK>
MOVE P,[IOWD PD$LEN,PDLIST] ;SET UP PUSHDOWN POINTER
MOVEM T1,OFFSET ;STORE STARTING OFFSET
MOVE T1,[3,,[0
XWD OFFSET,'LIB' ;MY OFFSET AND CCL NAME
XWD 0,BOUT ] ;USE BOUT FOR TYPEOUT
]
TXO F,FOTTY ;FORCE ANY OUTPUT TO TTY
PUSHJ P,.ISCAN## ;INITIALIZE SCAN
MOVE T1,.JBFF## ;SAVE .JBFF
MOVEM T1,ORGFF ; FOR LATER
MOVEM P,ORGPP ;
SUBTTL MAKLIB COMMAND SCANNER
MAKSCN: ;SCAN ARGUMENT BLOCK
MOVX F,FOTTY ;CLEAR FLAGS , FORCE OUTPUT TO TTY
MOVE P,ORGPP ;RESET PDL PHASE
RESET 0 ;CLEAR ALL I/O DEVICES
MOVE T1,ORGFF ;IF HAVE WE SWOLLEN
MOVEM T1,.JBFF## ;WE MUST REDUCE
IFE DEBUG,< ;DONT GET RID OF CORE IF DEBUGGING
MOVE T2,.JBREL## ;BY 1K OR MORE?
SOS T1 ;OUR MINIMUM LEGAL SIZE
CAIG T1,-2000(T2) ;IF SO,
CORE T1, ;REDUCE OUR SIZE
JFCL ;WELL, WE TRIED
> ;EFI DEBUG
MOVE T1,[11,,[IOWD MKLSWL,MKLSWN
XWD MKLSWD,MKLSWM
XWD 0,MKLSWP
-1
XWD CLRANS,0
XWD ALLIN,ALLOUT
0
0
XWD 0,STORER ]]
PUSHJ P,.TSCAN## ;SCAN THE COMMAND LINE
MOVE T1,[5,,[IOWD MKLSWL,MKLSWN
XWD MKLSWD, MKLSWM
XWD 0 ,MKLSWP
-1
0]] ;SET TO FILL IN FROM SWITCH.INI
PUSHJ P,.OSCAN## ;FILL IN FROM THERE
PUSHJ P,CHECK ;SEE IF EVERYTHING IS THERE
SETZM WLDTMP ;CLEAR OUT TEMPORARY AREA FOR WILD
MOVE T1,OUTBEG ;TELL SCAN START OF OUTPUT SPEC
MOVEI T2,OPNBLK ; NAME OF OPEN BLOCK
MOVE T3,[.RBSIZ+1,,LKPBLK] ; LOOKUP BLOCK
HLRZM T3,LKPBLK
PUSHJ P,.STOPN## ;SCAN BLKS TO OPEN &LOOKUP BLKS
JRST WIOERR ;NO WILD CARDS ON OUTPUT
TXZ F,FOTTY ;NO LONGER FORCE OUTPUT TO TTY
;NOTE THAT ERROR MSG PROCESSOR
;WILL SET THIS WHEN NEEDED
JRST SWTPRC ;NOW TO PROCESS THE SWITCHES
OPNFAI:
TXO F,FOTTY
PUSHJ P,E.DFO##
JRST MAKSCN ;GO PROMPT AGAIN
LKPFAI:
MOVEI T1,LKPBLK
MOVEI T2,6
MOVE T3,INBEG ;POINT TO INPUT SPEC
TXO F,FOTTY ;FORCE TO TTY
PUSHJ P,E.LKEN##
JRST MAKSCN
WIOERR:
$KILL(WIO,Wild cards illegal for OUTPUT file specification)
DM XXX,1,0,0
;;**[15] CHANGE SWTCHS DEFINITION TO USE INTERNAL PROCESSOR
DEFINE SWTCHS,<
SP *APPEND,SW.APP,SYMSW,XXX
SP *DELETE,SW.DEL,SYMSW,XXX
SP *EXTRAC,SW.EXT,SYMSW,XXX
SP INSERT,SW.INS,SYMSW,XXX
SP *MASTER,SW.MAS,SYMSW,XXX,FS.VRQ
SP *REPLAC,SW.REP,SYMSW,XXX
SP *FIX,SW.FIX,SYMSW,XXX
SP *WHO,SW.WHO,SYMSW,XXX,FS.VRQ
SS *LIST,<POINTR (SWIWRD,SW.LST)>,1,FS.NUE
SS *NOLOC,<POINTR (SWIWRD,SW.NOL)>,1,FS.NUE
SS *POINTS,<POINTR (SWIWRD,SW.POI)>,1,FS.NUE
SS INDEX,<POINTR (SWIWRD,SW.IND)>,1,FS.NUE
SS *TRACE,<POINTR (SWIWRD,SW.TRC)>,1,FS.NUE
>
DOSCAN(MKLSW)
CLRANS:
SETZM SCNBEG ;CLEAR ANSWER AREA
MOVE T1,[SCNBEG,,SCNBEG+1] ;STANDARD ZERO-AREA BLT
BLT T1,SCNEND ;CLEAR OUT CURRENT ANSWER
MOVE T1,ORGFF ;RESTORE
MOVEM T1,.JBFF## ; .JBFF
POPJ P,
ALLOUT:
MOVE T1,.JBFF## ;POINT TO
MOVEM T1,OUTEND ; END OF OUTPUT AREA
SKIPN OUTBEG ;HAVE WE STARTED ALREADY?
MOVEM T1,OUTBEG ;NO--THIS IS THE BEGINNING
JRST ALLOC1
ALLIN:
MOVE T1,.JBFF## ;POINT TO
MOVEM T1,INEND ; END OF INPUT AREA
SKIPN INBEG ; IF WE HAVEN'T STARTED YET
MOVEM T1,INBEG ; THIS IS THE BEGINNING
ALLOC1:
MOVEM T1,A ;SAVE AWAY CURRENT FILE POINTER
MOVEI T2,FSSIZE-1(T1)
CAMG T2,.JBREL##
JRST ALLOC2
PUSH P,T2 ;PRESERVE T2, WE NEED IT
CORE T2, ;AND EXPAND CORE
JRST NECERR ;?NOT EVEN ENOUGH CORE FOR SWITCHES
POP P,T2 ;RESTORE ALLOCATION POINTER
ALLOC2:
HRLI T1,TMAREA
BLT T1,(T2)
MOVE T1,A ;RESTORE CURRENT FILE POINTER
SETZM TMAREA+.FXLEN
MOVEI T2,FSSIZE
ADDM T2,.JBFF##
POPJ P,
STORER:
TLZ T2,-1
TXNE T2,SW.WHO ;IS THIS /WHO?
JRST [ SKIPN WHO ;DONT OVERWRITE
HLRZM N,WHO ;ELSE STORE IT
POPJ P,] ;AND DONT CONFLICT
TRC T2,-1
TDNE T2,TMAREA+.FXLEN
JRST [$KILL(TMS,Too many switches)]
TRC T2,-1
IORM T2,TMAREA+.FXLEN
JUMPE N,CPOPJ
HLRZ T2,TMAREA+.FXLEN
CAIL T2,MAXMOD
JRST [$KILL(TMN,Too many module names)]
AOS T2
HRLM T2,TMAREA+.FXLEN
MOVEM N,TMAREA+.FXLEN(T2)
POPJ P,
;;**[15] ADD ROUTINES TO DO RADIX50 INPUT
; THIS ROUTINE INPUTS IN SIXBIT FORM 1 WORD WHICH CONTAINS
; A RADIX50 CHARACTER SET SYMBOL. THE ROUTINE CONFORMS
; TO SCAN STANDARDS AND UPDATES THE TERMINATOR.
;
SYMSW:
PUSHJ P,.TICQT## ;ALLOW QUOTING
MOVEI N,0 ;START WITH NULL RESULT
MOVEI T1,.TSIXN## ;FOR ERROR MESSAGES
MOVEM T1,.LASWD## ;TELL SCAN WHAT TO DO
MOVE T1,[POINT 6,N] ;BYTE POINTER INITED
SYMS1:
PUSHJ P,.TIAUC## ;GET A CHARACTER
PUSHJ P,.TIMUC## ;CONVERT TO UPPER CASE
SKIPLE .QUOTE## ;QUOTED?
JRST SYMS2 ;YES
PUSHJ P,TICSY ;IN RADIX50 SET?
JRST [ MOVEM N,.NMUL## ;NO,SO DEPOSIT INTO RESULT
POPJ P,] ;AND RETURN
SYMS2:
CAIL CC,40 ;IN PROPER RANGE AT LEAST?
CAILE CC,137 ;
JRST E.ILSC## ;NO, "?ILLEGAL CHAR."
SUBI CC," "-' ' ;CONVERT TO SIXBIT
TLNE T1,(77B5) ;DISCARD PAST FIRST WORD
IDPB CC,T1 ;DEPOSIT IN INTERMEDIATE RESULT
JRST SYMS1 ;GO BACK FOR MORE
TICSY:
CAIE CC,"%" ;ALLOW %.$
CAIN CC,"$" ;
JRST CPOPJ1 ;TAKE GOOD RETURN
PUSHJ P,.TICAN## ;IS IT ALPHANUMERIC
CAIN CC,"." ;NO, IS IT DOT?
AOS 0(P) ;YES,TAKE GOOD RETURN
POPJ P, ;RETURN IN EITHER CASE
CHECK:
SKIPN T1,OUTBEG ;IS THERE AN OUTPUT SPEC?
JRST [$KILL(MCE,Command error)]
SKIPN T2,INBEG ;POINT TO INPUT AREA
JRST E$$MCE
SKIPE .FXNAM(T1) ;IS THERE A FILENAME?
JRST CHECK1 ;YES--GOOD
SKIPN T3,.FXNAM(T2) ;IF THERE'S A MASTER
JRST [$KILL(NEA,Not enough arguments specified)]
MOVEM T3,.FXNAM(T1) ;USE NAME OF MASTER INSTEAD
SETOM T3,.FXNMM(T1) ;MASK IT 'CAUSE NOT WILD
CHECK1:
SKIPE T3,.FXEXT(T1) ;IS THERE AN EXT SPECIFIED?
JRST CHECK2 ;EXT ALREADY THERE GO ON
MOVE C,.FXMOD(T1) ;CHECK MODIFIER WORD TO SEE
TXNN C,FX.NUL ; IF EXPLICITLY NULL EXT
JRST CHK1A
MOVE T4,SWIWRD ;GET THE SWITCHES
TXNE T4,SW.LST!SW.POI!SW.TRC ;SOME SORT OF LISTING SPECIFIED?
JRST CHK1B ;IF YES LST IS DEFAULT
HRLOI T3,'REL' ;IF NONE--REL IS DEFAULT
CHK1A: MOVEM T3,.FXEXT(T1) ;SO FILL IT IN
JRST CHECK2
CHK1B: HRLOI T3,'LST'
MOVEM T3,.FXEXT(T1)
CHECK2:
SKIPE T3,.FXLEN(T1) ;ANY SWITCH SEEN?
JRST [$KILL(SIO,Switches are illegal on output)]
SKIPN T3,.FXNAM(T2) ;MASTER FILENAME THERE?
JRST E$$NEA ;NOT ENOUGH ARGUMENTS
SKIPE T3,.FXEXT(T2) ;NO EXT SPECIFIED?
JRST CHECK4 ;EXT ALREADY THERE
MOVE C,.FXMOD(T2) ;CHECK MODIFIER WORD TO SEE
TXNE C,FX.NUL ;IF NULL EXT SPECIFIED
HRLOI T3,'REL' ;IF NONE .REL IS DEFAULT
MOVEM T3,.FXEXT(T2) ;SO FILL IN DEFAULT
CHECK4:
MOVE T3,.FXLEN(T2) ;ANY SWITCH THERE?
JUMPE T3,CHECK6 ;NO SWITCH,SEE IF THAT'S OK
TXNE T3,SW.INS+SW.REP+SW.FIX ;INSERT OR REPLACE OR FIX?
JRST [$KILL(ISM,</INSERT,/REPLACE and /FIX are illegal switches on MASTER>)]
TXNN T3,SW.APP ;APPEND SPECIFIED?
JRST CHECKE ;NO-DON'T WORRY ABOUT IT
CAIN T3,400000 ;IF NO COUNT WE'RE O.K.
JRST CHK4A
$WARN(EMA,Entire MASTER file will be appended)
CHK4A:
JRST CHECKE ;AND CONTINUE
CHECK5:
MOVE T3,.FXLEN(T2) ;POINT TO SWITCHES
JUMPE T3,CHECK6 ;NONE THERE
TXNE T3,SW.MAS ;MASTER?
JRST [$KILL(MTF,/MASTER switch cannot be used on TRANSACTION file)]
TXNE T3,SW.FIX ;IS PATCHING WANTED?
TXO F,FIXMOD ;YES- MARK FIX MODE
SKIPE T3,.FXEXT(T2) ;IS AN EXT SPECIFIED?
JRST CHECKE ;EXT ALREADY THERE
MOVE C,.FXMOD(T2) ;SEE IF NULL EXT
TXNE C,FX.NUL ;ALREADY SPECIFIED
JRST [HRLOI T3,'REL' ;USE "REL" FOR DEFAULT
TXNE F,FIXMOD ;OR "FIX" IF WE ARE READING
HRLOI T3,'FIX' ;A PATCH FILE
JRST .+1]
MOVEM T3,.FXEXT(T2) ;SO FILL IT IN
JRST CHECKE ;AND FINISH UP
CHECK6:
CAME T2,INBEG ;IS THIS THE MASTER FILE?
JRST [$KILL(CSR,Command switch is required)]
CAME T2,INEND ;SEE IF ANY TRANS FILES
JRST CHECKE ;YES THEN CONTINUE
MOVE T1,SWIWRD ;GET SWITCHES
JUMPE T1,E$$CSR ;ERROR IF NONE
JRST CHECKE ;CONTINUE IF NO ERROR
CHECKE:
ADDI T2,FSSIZE ;INCREMENT THE POINTER
CAMG T2,INEND ;RUN OUT OF ROOM OR TRANS FILES YET?
JRST CHECK5 ;MORE TRANS FILES
POPJ P,
SUBTTL COMMAND SWITCH PROCESSOR
SWTPRC:
MOVE T2,SWIWRD ;GET SWITCH BITS
TXNE T2,SW.LST!SW.POI!SW.TRC ;WANT LISTING?
JRST OLIST ;YES,GO DO IT
TXNN T2,SW.IND ;WANT INDEXING?
JRST NOLCHK ;NO--OTHER THINGS
MOVE T1,INBEG ;GET POINTER TO INPUT SPEC
SKIPE .FXLEN(T1) ;ANOTHER SWITCH THERE?
JRST E$$TMS ;INDEX MUST BE ALONE
PUSHJ P,INDOPN ;OPEN I/O STUFF
PUSHJ P,INDEX ;DO THE INDEXING
PUSHJ P,INDCLS ;FINISHED SO CLOSE
JRST MAKSCN ;AND BEGIN AGAIN
NOLCHK:
TXNN T2,SW.NOL ;DELETE LOCAL SYMBOLS?
JRST SWTDIS ;NO--OTHER THINGS
MOVE T1,INBEG ;POINTER TO INPUT SPEC
SKIPE .FXLEN(T1) ;NOLOCALS MUST BE ALONE
JRST E$$TMS ;TELL HER TOO MANY SWITCHES
PUSHJ P,INDOPN ;OPEN BINARY OUTPUT
PUSHJ P,DELCPY ;GO DELETE AND COPY
JRST RSTRT ; BEGIN AGAIN
SUBTTL DO OUTPUT LISTINGS FOR /TRACE, /POINTS AND /LIST
OLIST:
MOVE T1,INBEG ;GET POINTER TO INPPUT FILE
SKIPE .FXLEN(T1) ;IS THERE FILE-SPECIFIC SWITCH?
JRST E$$TMS ;YES,LEGAL ONLY FOR SWITCHES IN SWIWRD
TXZ F,LSTENT ;CLEAR LIST ENTRIES FLAG
TXNE T2,SW.POI ;LIST ENTRY POINTS?
TXO F,LSTENT ;SET FLAG TO LIST ENTRIES
MOVE T1,OUTBEG ;POINT TO THE OUTPUT SPEC
MOVE T1,.FXDEV(T1) ;PUT THE OUTPUT DEVICE IN T1
DEVCHR T1, ;DO A DEVCHR
TXNE T1,DV.TTY ;IS OUTPUT DEVICE A TTY?
TXO F,DEVTTY ;YES,REMEMBER THAT
PUSHJ P,OPNLKO ;OPEN OUTPUT FILE
MOVEI T1,[ASCIZ " Listing of "]
PUSHJ P,.TSTRG## ;GIVE SOME IDENTIFICATION
MOVE T2,SWIWRD ;GET SWITCHES
TXNE T2,SW.POI!SW.LST ;IF POINT OR LIST
JRST [ MOVEI T1,[ASCIZ "Modules"]
TXNE T2,SW.POI ;IF BOTH,SAY SO
MOVEI T1,[ASCIZ "Modules and Entry points"]
JRST OLIST0]
MOVEI T1,[ASCIZ "TRACE blocks"]
OLIST0:
PUSHJ P,.TSTRG## ;OUTPUT WHAT WE HAVE
PUSHJ P,.TCRLF## ;END LINE
MOVEI T1,[ASCIZ "Produced by MAKLIB Version "]
PUSHJ P,.TSTRG## ;
MOVE T1,.JBVER## ;GIVE VERSION NUMBER
PUSHJ P,.TVERW## ;FOR LISTING
MOVEI T1,[ASCIZ " on "] ;DATE TOO
PUSHJ P,.TSTRG## ;
PUSHJ P,.TDATN## ;OUTPUT DATE AND
MOVEI T1,[ASCIZ " at "] ;TIME TOO
PUSHJ P,.TSTRG##
PUSHJ P,.TTIMN## ;
PUSHJ P,.TCRLF## ;END WITH CRLF
OLIST1:
PUSHJ P,LIOCLS ;OPEN NEXT MASTER FILE
JRST MAKSCN ;ALL DONE
MOVEI T1,[ASCIZ "
**************************
File: "]
PUSHJ P,.TSTRG## ;SEPARATE FILES
MOVEI T1,OPNBLK ;SET UP T1/ADDR OF OPEN BLOCK
MOVEI T2,LKPBLK ; " " T2/ADDR OF LOOKUP BLOCK
PUSHJ P,.TOLEB## ;TYPE THE DATA THERE
PUSHJ P,.TCRLF## ;END WITH CRLF
PUSHJ P,.TCRLF##
MOVE T2,SWIWRD ;FETCH SWITCH WORD
TXNE T2,SW.TRC ;WANT TRACE?
JRST OLIST2 ;YES,GO DO IT
PUSHJ P,LIST ;CALL LISTING ROUTINE
JRST OLIST1 ;GO BACK FOR NEXT FILE
OLIST2:
PUSHJ P,TRACE ;DO THE TRACE
JRST OLIST1 ;AND GO BACK FOR NEXT FILE
SUBTTL FILE MANIPULATION ROUTINES FOR LISTING ROUTINES
OPNLKO:
MOVX T1,.IOASC ;ASCII OUTPUT FOR LISTING
IORM T1,OPNBLK+.OPMOD
MOVSI T1,OBUF ;CALCULATE BUFFER HEADER PTR
MOVEM T1,OPNBLK+2 ; FOR OPEN BLOCK
OPEN OCHN,OPNBLK ;OPEN OUTPUT FOR LISTING
JRST OPNFAI ;CANT DO IT
ENTER OCHN,LKPBLK ;NOW ENTER THE OUTPUT
JRST LKPFAI ;FAILURE
OUTBUF OCHN, ;OPEN OUTPUT BUFFERS
MOVE T1,.JBFF## ;REMEMBER WHERE OUTPUT BUFFER ENDS
MOVEM T1,LSTFF ;FOR MULTIPLE INPUT FILES
POPJ P, ;THEN RETURN
; LIOCLS IS CALLED AFTER EACH INPUT FILE IS PROCESSED (EOF SEEN)
; IT SKIPS AFTER NEXT FILE IS OPENED , OR NON-SKIPS IF ITS THE END,
; AFTER FINISHING UP BY CLOSING FILES.
LIOCLS:
CLOSE MIN, ;CLOSE MASTER FILE
MOVE T1,LSTFF ;RECLAIM MASTER BUFFER SPACE
MOVEM T1,.JBFF## ;BY RESTORING FIRST-FREE
MOVE T1,[4,,[INBEG,,INEND ;POINTERS TO INPUT AREA
OPNBLK,,LKPBLK ;OPEN & LOOKUP BLOCKS
FSSIZE,,.RBSIZ+1;SIZE OF INSPEC&LKPBLK
WLDTMP+1B0]] ;ALL FOR LKWLD
PUSHJ P,.LKWLD## ;WILD LOOKS FOR MASTER FILE
JRST LSTEND ;END OF LISTINGS
MOVX T1,.IOBIN ;BINARY FOR MASTER INPUT
IORM T1,OPNBLK+.OPMOD
MOVEI T1,MBUF ;MASTER FILE BUFFER
MOVEM T1,OPNBLK+2
OPEN MIN,OPNBLK ;MASTER INPUT ON CHANNEL MIN
JRST OPNFAI ;CAN'T DO IT
LOOKUP MIN,LKPBLK ;DO THE LOOKUP
JRST LKPFAI ;CAN'T
INBUF MIN, ;SET UP THE BUFFER
JRST CPOPJ1 ;TAKE SKIP RETURN
LSTEND:
CLOSE OCHN, ;DONE WITH THIS CHANNEL
STATZ OCHN,760000 ;CHECK FOR ERROR
JRST FSOERR ;ERROR
POPJ P, ;NEXT COMMAND
SUBTTL FILE MANIPULATION ROUTINES FOR INDEXING AND DELETING LOCAL SYMBOLS
INDOPN:
MOVX T1,.IOBIN ; FOR TRANSACTION OUTPUT TOO
IORM T1,OPNBLK+.OPMOD
MOVSI T1,OBUF ;OUTPUT BUFFER HEADER
MOVEM T1,OPNBLK+2 ;PUT POINTER IN THE OPEN BLOCK
OPEN OCHN,OPNBLK ;BINARY OUTPUT ON CH. OCHN
JRST OPNFAI
;CAN'T OPEN
ENTER OCHN,LKPBLK ;ENTER THE FILE
JRST LKPFAI ;CAN'T
MOVE T1,[4,,[INBEG,,INEND ;INFO FOR WILD
OPNBLK,,LKPBLK
FSSIZE,,.RBSIZ+1
WLDTMP+1B0]]
PUSHJ P,.LKWLD## ;WILD
JRST INDOPE ;END
SETZM NAMCTR ;CLEAR PROGRAM NAME COUNTER
MOVX T1,.IOBIN
IORM T1,OPNBLK+.OPMOD
MOVEI T1,MBUF ;HEADER FOR MASTER FILE
MOVEM T1,OPNBLK+2 ;AND PUT IT IN THE OPEN BLOCK
OPEN MIN,OPNBLK ;OPEN
JRST OPNFAI ;CAN'T
LOOKUP MIN,LKPBLK ;LOOKUP
JRST LKPFAI ;CAN'T
INBUF MIN,
INDOPE:
POPJ P,
INDCLS:
CLOSE OCHN, ;DO LAST BLOCK
STATZ OCHN,760000 ;CHECK FOR ERROR
JRST FSOERR ;ERROR
CLOSE MIN, ;DONE WITH INPUT TOO
STATZ MIN,760000 ;CHECK FOR ERROR
JRST FSMERR
JRST MAKSCN
TRNCLS:
CLOSE TRIN,
STATZ TRIN,760000
JRST FSTERR ;FILE STATUS ERROR FOR TRANSACTION
POPJ P,
SWTDIS:
MOVE T1,OUTBEG ;GET OUTPUT SPEC
MOVE T1,.FXDEV(T1) ;WHAT DEVICE?
DEVCHR T1, ;MAKE SURE ITS LEGAL
TXNN T1,<DV.DSK!DV.DTA> ;MAKE SURE DISK OR DECTAPE
JRST [$KILL(ODD,Output device must be DISK or DECTAPE)]
MOVX T1,.IOBIN ;BINARY OUTPUT
IORM T1,OPNBLK+.OPMOD
MOVSI T1,OBUF ;BUFFER HEADER LOCATION
MOVEM T1,OPNBLK+2 ;AND PUT IT IN THE OPEN BLOCK
MOVE T2,[XWD OPNBLK,BCKBLK]
BLT T2,BCKBLK+<.RBSIZ+2+3>-1 ;SAVE OUTPUT SPECS
MOVE T1,.JBFF## ;SAVE JOBFF FOR LATER THINGS
MOVEM T1,BCKFF ;SAVE FOR BACKING UP.
OPEN OCHN,OPNBLK
JRST OPNFAI
ENTER OCHN,LKPBLK
JRST LKPFAI
OUTBUF OCHN,
MOVE T1,INBEG ;GET INPUT
MOVE T1,.FXDEV(T1) ;GET MASTER DEVICE
DEVCHR T1,
TXNN T1,1B<^D35-.IOBIN> ;SEE IF BINARY AND DIRECT
JRST [$KILL(MCB,MASTER device must be capable of binary IO)]
MOVE T1,[4,,[INBEG,,INEND
OPNBLK,,LKPBLK
FSSIZE,,.RBSIZ+1
WLDTMP+1B0]]
PUSHJ P,.LKWLD##
$STPCD(Master file spec was missing)
SETZM NAMCTR ;CLEAR PROG NAME COUNTER
MOVX T1,.IOBIN
IORM T1,OPNBLK+.OPMOD
MOVEI T1,MBUF ;GET BUFFER HEADER
MOVEM T1,OPNBLK+2 ; FOR THE OPEN BLOCK
OPEN MIN,OPNBLK
JRST OPNFAI
LOOKUP MIN,LKPBLK
JRST LKPFAI
INBUF MIN,
MOVE T1,WLDTMP ;SEE IF ANY TRANSACTION FILES
CAMN T1,INEND ;WERE SPECIFIED
JRST SWT2 ;NO,SO DONT OPEN ANY
SWT1:
MOVE T1,[4,,[INBEG,,INEND
OPNBLK,,LKPBLK
FSSIZE,,.RBSIZ+1
WLDTMP+1B0]]
PUSHJ P,.LKWLD##
JRST INDCLS
SETZM TNMCTR ;CLEAR TRANS PROG NAME COUNTER
MOVX T1,.IOBIN
TXNE F,FIXMOD ;IN PATCH MODE?
MOVX T1,.IOASC ;YES,SO WE WANT ASCII MODE
IORM T1,OPNBLK+.OPMOD
MOVEI T1,TBUF ;GET BUFFEER HEADER POINTER
MOVEM T1,OPNBLK+2 ; FOR THE OPEN BLOCK
OPEN TRIN,OPNBLK
JRST OPNFAI
LOOKUP TRIN,LKPBLK
JRST LKPFAI
INBUF TRIN,
SWT2:
MOVE T3,WLDTMP
HRLZ T1,.FXLEN(T3)
JFFO T1,.+2
JRST E$$CSR ;ERROR IF NO SWITCH
CAILE T2,SWTBLL ;WITHIN RANGE OF TABLE?
$STPCD(Dispatch index out of range)
PUSHJ P,@SWTBL(T2) ;PROCESS THE SWITCH
JRST SWT1
$STPCD(A COMMAND processor took the skip return)
SWTBL:
APPEND
DELETE
EXTRCT
INSERT
CPOPJ ;IN CASE /MASTER
REPLCE
FIXX
SWTBLL==.-SWTBL
SUBTTL MAKLIB COMMAND PROCESSORS
SUBTTL LIST & POINTS PROCESSOR
;LIST PROCESSOR
;THIS ROUTINE PROCESSES THE L COMMAND IN MAKLIB. BINARY
;PROGRAMS ARE READ, AND THEIR NAMES OUTPUT, UNTIL AN END
;OF FILE IS REACHED.
LIST:
MOVE A,INBEG ;POINT TO INPUT AREA
MOVE T,.FXNAM(A) ;GET MASTER FILE NAME
SETOM END2 ;SIGNAL FIRST TIME THROUGH
PUSHJ P, MSTGET ;GET THE MASTER DEVICE
JRST E$$NEA ;NOT ENOUGH ARGUMENTS
TXO F,NOWARN ;DON'T GIVE WARNING MESSAGE IF INDEX SEEN
LIST2: PUSHJ P, READ ;READ A PROGRAM NAME
JRST [TXNN F,LSTENT ;LISTED ENTRIES?
PUSHJ P,LIST5 ;NO, SO LIST RELOCATION
POPJ P,0 ] ;FINISHED
TXNE F,LSTENT ;LIST ENTRIES
JRST LIST4 ;YES, SO NO SIZE
SKIPL END2 ;BUT NOT FIRST TIME (NOT SET UP YET)
PUSHJ P,LIST5 ;LIST RELOCATION WORDS
LIST4: MOVE T1, A ;GET THE PROGRAM NAME IN B
PUSHJ P, PTYPO ;TYPE IT OUT
TXNE F,LSTENT ;ENTRY BLOCK AS WELL?
JRST LISTE ;YES
JRST LIST2 ;RETURN FOR MORE PROGRAM NAMES
LISTE: HRRZ C,ENTBLK ;GET NUMBER OF ENTRIES
JUMPE C,LIST3 ;NONE IN THIS PROGRAM
MOVNS C ;NEGATE
MOVSS C ;PUT IN LEFT HALF
HRRI C,ENTBLK+2 ;START OF ENTRIES
MOVEI D,TABS1 ;ASSUME NOT TTY
TXNE F,DEVTTY ;WAS IT?
MOVEI D,TABS2 ;TTY HAS SHORTER LINE
MOVEM D,TABCNT ;STASH IT
LISTE1: SKIPN T1,(C) ;GET AN ENTRY
AOJA C,.-1 ;IGNORE RELOCATION WORD
PUSHJ P,TYPTAB ;OUTPUT A TAB
PUSHJ P,PTYPO ;FOLLOWED BY SYMBOL
AOBJN C,LISTE1 ;FOR ALL OF BLOCK
LIST3: PUSHJ P, CRLF ;TYPE A CRLF
JRST LIST2 ;RETURN FOR MORE PROGRAM NAMES
LIST5: PUSH P,A ;SAVE NAME
MOVE B,END1 ;GET FIRST END WORD
TRNE B,-1 ;KLUDGE FOR FORTRAN
JRST LISTF ;YES, IT WAS
PUSHJ P,TYPTB1 ;ALWAYS LEAD WITH TAB
HLRZ T1,B ;OUTPUT OCTAL HALF WORD
PUSHJ P,OUTHW ;
SKIPN B,END2 ;IF SECOND WORD ZERO,
JRST LISTF ;DONT BOTHER TO LIST IT
PUSHJ P,TYPTB1 ;PRINT SECOND WORD
HLRZ T1,B
PUSHJ P,OUTHW
LISTF: PUSHJ P,CRLF ;TYPE CRLF AND RETURN
POP P,A ;RESTORE NAME
TXZ F,LSTENT ;CLEAR ENTRY POINT FLAG
POPJ P,
SUBTTL TRACE PROCESSOR
; /TRACE/ - THE COMMAND PROCESSOR TO TRACE THE PATCH BLOCKS
;
; THIS ROUTINE TRACES ALL EDIT/PATCH BLOCKS IN THE MASTER FILE.
;
TRACE:
TXO F,NOWARN ;DONT WORRY ABOUT INDICES
PUSHJ P,MSTGET ;SET UP INPUT IO CHANNEL
JRST E$$NEA ;IF ERROR RETURN
TRC1:
PUSHJ P,READ ;READ NEXT PROGRAM
JRST TRC9 ;EOF, ALL DONE
MOVEM A,CURMOD ;SAVE MODULE NAME
TRC3:
PUSHJ P,GETIN ;GET FIRST WORD
HLRZ B,A ;OF BLOCK AND EXAMINE HEADER
CAIN B,LI$TRC ;TRACE BLOCK?
JRST TRC5 ;YES,PROCESS IT
MOVEM B,SAVEBT ;REMEMBER TYPE CODE
CAILE B,3777 ;NOT ASCIZ TEXT IS IT?
JRST TRC4 ;YES,DAMMIT
PUSHJ P,COUNT ;NO, SO COUNT WORDS IN BLOCK
JUMPE B,TRC3 ;IF ZERO COUNT,IGNORE
PUSHJ P,GETIN ;DISCARD WORDS
SOJG B,.-1 ;TO CLEAR BLOCK
MOVE A,SAVEBT ;CHECK FOR END-OF-PROGRAM
CAIE A,1040
CAIN A,5 ;BOTH OLD AND NEW STYLE
JRST TRC1 ;END,SO GET NEXT MODULE
JRST TRC3 ;NOT END,GET NEXT BLOCK
TRC4:
ANDI A,177 ;DISCARD ALL BUT LAST BYTE
JUMPE A,TRC3 ;IF NULL BYTE, ITS OVER
PUSHJ P,GETIN ;GET A WORD
JRST TRC4 ;AND TRY AGAIN
TRC5:
HRRZ D,A ;GET COUNT IN SAFER PLACE
PUSHJ P,.TCRLF##
MOVEI T1,[ASCIZ "Module: "]
PUSHJ P,.TSTRG## ;MODULE NAME
MOVE T1,CURMOD ;IS IN RAD50
PUSHJ P,PTYPO ;
SOJL D,E$$TBF ;ERROR IF NO WORDS LEFT
PUSHJ P,GETIN ;GET WORD 1
MOVEI T1,[ASCIZ " Edit: "]
PUSHJ P,.TSTRG##
MOVE T1,A ;GET EDIT NAME
PUSHJ P,.TSIXN## ;OUTPUT IN SIXBIT
MOVEI T1,[ASCIZ "
Status is "]
PUSHJ P,.TSTRG##
SOJL D,E$$TBF
PUSHJ P,GETIN ;GET WORD 2
MOVEI T1,[ASCIZ "Active"]
TLNN A,400000 ;SEE IF LH IS -1
MOVEI T1,[ASCIZ "Inactive"]
PUSHJ P,.TSTRG##
TRNN A,-1 ;IF RH IS BLANK,NO /WHO WAS USED
JRST TRC5A ;AND SO WE SKIP OUTPUTING IT
MOVEI T1,[ASCIZ "
Last affected by "]
PUSHJ P,.TSTRG##
HRLZ T1,A ;OUTPUT THE INITIALS
PUSHJ P,.TSIXN## ;IN SIXBIT
TRC5A:
PUSHJ P,.TCRLF## ;END CURRENT LINE
SOJL D,E$$TBF ;NEG WORD COUNT INDICATES ERROR
PUSHJ P,GETIN ;READ WORD 3
JUMPE A,TRC5D ;ALL OPTIONAL INFO IN TB$MAK
MOVEI T1,[ASCIZ " Created"]
PUSHJ P,.TSTRG## ;CREATION DATA
TLNN A,-1 ;WERE INITIALS SPECIFIED?
JRST TRC5B ;NO,SO SKIP IT
MOVEI T1,[ASCIZ " By "] ;
PUSHJ P,.TSTRG## ;
HLLZ T1,A ;GET LH OF WORD 3,SIXBIT INITIALS
PUSHJ P,.TSIXN##
TRC5B:
TRNN A,-1 ;DATE SPECIFIED?
JRST TRC5C ;NO SO SKIP IT
MOVEI T1,[ASCIZ " On "]
PUSHJ P,.TSTRG##
HRRZ T1,A ;GET 15 BIT DATE
PUSHJ P,.TDATE## ;AND PRINT IT
TRC5C:
PUSHJ P,.TCRLF## ;END LINE
TRC5D:
SOJL D,E$$TBF ;
PUSHJ P,GETIN ;GET WORD 4
JUMPE A,TRC5G ;IF BLANK
MOVEI T1,[ASCIZ " Installed"]
PUSHJ P,.TSTRG##
TLNN A,-1 ;SEE IF INSTALLERS INITIALS THERE
JRST TRC5E ;NO, THEY ARE NOT
MOVEI T1,[ASCIZ " By "]
PUSHJ P,.TSTRG##
HLLZ T1,A ;INSTALLERS INITIALS FROM /WHO
PUSHJ P,.TSIXN##
TRC5E:
TRNN A,-1 ;SEE IF DATE THERE
JRST TRC5F ;NO,GO FINISH LINE
MOVEI T1,[ASCIZ " On "]
PUSHJ P,.TSTRG##
HRRZ T1,A ;GET 15 BIT 'DATE UUO' FORMAT DATE
PUSHJ P,.TDATE## ;USE SCAN OUTPUT ROUTINE
TRC5F:
PUSHJ P,.TCRLF## ;END THE LINE
TRC5G:
SOJL D,E$$TBF ;GET WORD 5 (CURRENTLY UNUSED)
PUSHJ P,GETIN ;
SOJL D,E$$TBF ;GET WORD 6
PUSHJ P,GETIN ;COUNT OF A.E.S AND PCOS
PUSH P,A ;SAVE THE COUNT
TLNN A,-1 ;ARE THERE ANY A.SSOCIATED E.DITS?
JRST TRC7 ;NO,GO PROCESS PCOS
HLRZ C,A ;COUNT OF PCOS
MOVEI T1,[ASCIZ " Associated edits:
"]
PUSHJ P,.TSTRG##
TRC6:
SUBI D,AESIZ ;SUBTRACT SIZE OF ASSOCIATED EDIT
JUMPL D,E$$TBF ;NOT THERE THOUGH
PUSHJ P,TYPTB1 ;OUTPT THE TAB
PUSHJ P,GETIN ;GET FIRST WORD
PUSH P,A ;SAVE IT
PUSHJ P,GETIN ;GET SECOND WORD
MOVEI T1,[ASCIZ "Requires edit "]
TLNN A,(1B0) ;IF 1B0 IS ON,REQUIRED
MOVEI T1,[ASCIZ "Precludes edit "]; ELSE ITS PRECLUDED
PUSHJ P,.TSTRG## ;
POP P,T1 ;RESTORE EDIT NAME
PUSHJ P,.TSIXN##
PUSHJ P,.TCRLF## ;END LINE
SOJG C,TRC6 ;IF MORE ASSOCIATED EDITS
TRC7:
POP P,A ;RESTORE THE COUNT
HRRZ C,A ;GET COUNT OF PCOS
JUMPE C,TRC8 ;IF NO CHANGE ORDERS
MOVEI T1,[ASCIZ " Program changes:
"]
PUSHJ P,.TSTRG##
TRC7A:
SOJL D,E$$TBF ;IF NO WORDS LEFT
PUSHJ P,GETIN ;GET THE WORD
PUSHJ P,TYPTB1 ;START WITH TAB
HRRZ B,A ;GET LENGTH OF PCO GROUP
HLRZ T1,A ;GET PCO INDEX
JRST @[ TRC71
TRC72
TRC73 ]-1(T1) ;DISPATCH TO RIGHT PROCESS
TRC71: ;FOR PCO TYPE 1
SUBI D,2 ;MUST HAVE TWO WORDS LEFT
JUMPL D,E$$TBF
PUSHJ P,GETIN ;GET WORD
MOVEI T1,[ASCIZ "Inserts "]
PUSHJ P,.TSTRG## ;CODE INSERT
LDB T1,[POINT 10,A,17] ;GET NR. OF INSTRUCTIONS INSERTED
PUSHJ P,.TDECW## ;OUTPUT IT
MOVEI T1,[ASCIZ " instruction(s) at location "]
PUSHJ P,.TSTRG##
HRRZ T1,A ;GET THE ADDRESS
PUSHJ P,OUTHW ;AND OUTPUT IT
MOVEI T1,"'" ;FLAG AS RELOCATABLE
PUSHJ P,.TCHAR## ;IN CASE THEY LOOK
PUSHJ P,GETIN ;EAT THE NEXT WORD
JRST TRC7B ;AND THATS IT
TRC72: ;FOR PCO TYPE 2
MOVEI T1,[ASCIZ "Removes edit "]
TRC72A:
PUSHJ P,.TSTRG##
SOJL D,E$$TBF ;INSURE PROPER COUNT
PUSHJ P,GETIN ;GET THE EDIT NAME
MOVE T1,A ;FOR OUTPUT
PUSHJ P,.TSIXN## ;OUTPUT IT
JRST TRC7B ;END OF PCOS 2 AND 3
TRC73: ;FOR PCO TYPE 3
MOVEI T1,[ASCIZ "Reinserts edit "]
JRST TRC72A ;CONTINUE AS PER PCO 2
TRC7B:
PUSHJ P,.TCRLF## ;END LINE
SOJG C,TRC7A ;IF MORE PCOS LEFT
TRC8:
JUMPN D,E$$TBF ;SHOULD BE NO MORE WORDS LEFT
JRST TRC3 ;GET NEXT BLOCK
TRC9:
POPJ P, ;RETURN TO COMMAND LEVEL
$WARN(TBF,TRACE block is badly formatted in module,,$MORE)
MOVE T1,CURMOD
PUSHJ P,PTYPO ;GIVE MODULE NAME
X$$TBF:
PUSHJ P,.TCRLF## ;END WITH CR-LF
TXZ F,FOTTY ;NO MORE FORCED TO TTY
JRST TRC3 ;TRY TO CONTINUE
SUBTTL REPLACE PROCESSOR
;THIS ROUTINE PROCESSES THE R COMMAND IN MAKLIB. THE TOTAL
;COMMAND STRING IS BROKEN INTO A LIST OF PROGRAMS FOR THE MASTER
;DEVICE, AND A LIST OF PROGRAMS FOR THE TRANSACTION DEVICES.
;THE ROUTINE READS THE MASTER FILE UNTIL ONE OF THE DESIRED
;REPLACEMENT PROGRAMS IS REACHED, THEN SWITCHES TO THE
;TRANSACTION DEVICE TO FIND THE PROGRAM WHICH IS TO REPLACE THE
;PROGRAM IN THE MASTER FILE. AFTER THE REPLACEMENT HAS BEEN
;EFFECTED, RESET IS CALLED TO RESTORE THE MASTER DEVICE TO ITS
;OLD POSITION.
REPLCE:
PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER DEVICE
JRST [PUSHJ P,COPY ;NO MORE, COPY REST OF MASTER
JRST INDCLS] ;
PUSHJ P, COPYTO ;COPY UP TO THE PROGRAM NAME
PUSHJ P, TRNGET ;GET A PROGRAM FROM TRANSACTION
JRST [$KILL(NTM,Not enough TRANSACTION modules were specified)]
PUSHJ P, FINDCP ;FIND THE PROGRAM AND COPY IT
JRST REPLCE ;LOOK FOR MORE REPLACEMENTS
SUBTTL INSERT PROCESSOR
;THIS SUBROUTINE PROCESSES THE I COMMAND IN FUDGE. IT READS AND
;WRITES PROGRAMS FROM THE MASTER FILE UNTIL IT FINDS THE
;PROGRAM NAME CURRENTLY POINTED TO, AT WHICH TIME IT STARTS READING
;FROM THE TRANSACTION DEVICE, MAKING AN INSERTION AT THE
;PROPER PLACE.
INSERT:
PUSHJ P, MSTGET ;GET FIRST PROGRAM FROM MASTER FILE
JRST [$KILL(IRM,/INSERT requires at least one /MASTER specification)]
INSER1: MOVEM R,NAMSAV ;COPY NAME TO SAFE PLACE
PUSHJ P, COPYTO ;COPY UP TO A PROGRAM NAME
MOVEM C, SAVEAC ;SAVE SPECIAL ACCUMULATOR
MOVE D, [XWD ENTBLK,SVEBLK]
;**;[20] INSER1+4 [REPLACE 1 INSTRUCTION] ILG 14-APR-76
BLT D,SVEBLK-ENTBLK(C) ;[20]MOVE ENTRY BLOCK TO SAVE BLOCK
INSER2: PUSHJ P, TRNGET ;GET NEXT TRANSACTION FILE
JRST E$$NTM ;FATAL - NOT ENOUGH TRANSACTION MODS
PUSHJ P, FINDCP ;FIND TRANSACTION FILE AND COPY
PUSHJ P,MSTGET ;GET NEXT MASTER FILE
JRST [PUSHJ P,FIXUP ;COPY OUT THE LAST MASTER PROG
PUSHJ P,COPY ;COPY THE REST OF THE FILE
JRST INDCLS] ;FINISH UP
CAMN R,NAMSAV ;THIS MODULE SAME AS LAST
JRST INSER2 ;YES,NO NEED TO TOUCH MASTER
PUSHJ P,FIXUP ;DIFFERS SO WRITE OUT CURRENT MASTER PRG.
JRST INSER1 ;AND GET NEXT
FIXUP: MOVE C, SAVEAC ;RESTORE SPECIAL AC
MOVS D, [XWD ENTBLK,SVEBLK]
BLT D, (C) ;RESTORE ENTRY BLOCK
MOVEI IOC,MIN ;SET UP CHANNEL AC
MOVEI T,MBUF+1 ;COUNT
MOVEM T,IBUF1 ;SET UP
AOS T
MOVEM T,IBUF2 ;DONE
MOVE FPT,INBEG ;
PUSHJ P, WRITE ;WRITE OUT THE CURRENT FILE
POPJ P, ;RETURN TO CALLER
SUBTTL EXTRACT PROCESSOR
;THIS ROUTINE PROCESSES THE E COMMAND IN FUDGE. RATHER THAN
;ONE MASTER AND SEVERAL TRANSACTION FILES, ALL FILES ARE
;TREATED THE SAME. AFTER A CALL TO EITHER MSTGET OR TRNGET
;PROGRAMS ARE SEARCHED FOR AND WRITTEN ON THE OUTPUT DEVICE.
EXTRCT: TXO F,NOWARN ;NO WARNING MESSAGE
PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER DEVICE
JRST EPROC1 ;ALL DONE WITH MASTER DEVICE
JUMPN R,.+3 ;ANY PROGRAMS THIS FILE? **VJC
PUSHJ P,COPY ;NO, COPY ENTIRE FILE ***VJC
JRST EPROC1 ; ***VJC
PUSHJ P, FINDCP ;FIND THE PROGRAM AND COPY IT
JRST EXTRCT ;RETURN FOR MORE MASTER PROGRAMS
EPROC1:
PUSHJ P, TRNGET ;GET PROGRAM FROM TRANS FILES
POPJ P, ;ALL DONE
JUMPN R,.+3 ;ANY PROGRAMS THIS FILE? ***VJC
PUSHJ P,COPY ;NO, COPY ENTIRE FILE ***VJC
JRST EPROC1 ; ***VJC
PUSHJ P, FINDCP ;FIND THE PROGRAM AND COPY IT
JRST EPROC1 ;RETURN FOR MORE TRANS FILES
SUBTTL DELETE PROCESSOR
;THIS ROUTINE PROCESSES THE DELETE COMMAND IN MAKLIB.
; NOTE: ONLY ONE INPUT FILE WILL BE READ, AND THE PROGRAM NAMES ASSOCIATED
;WITH ITS LIST WILL BE DELETED.
DELETE:
MOVEI T1,INDCLS ; RESET RETURN ADDRESS
HRRM T1,(P) ;BECAUSE DELETE IS ONE TIME ONLY
DELET1:
PUSHJ P,MSTGET ; GET A PROGRAM FROM MASTER FILE
JRST DELET3 ; NO MORE SPECIFIED-FINISH OFF MASTER
PUSHJ P,RAD50 ;CONVERT R TO RADIX 50
DELET2:
PUSHJ P,READ ; READ A PROGRAM
JRST MNFERR ; EOF - PROGRAM NOT IN FILE
CAMN R,A ; IS THIS THE RIGHT PROGRAM
JRST DELET1 ; YES - DELETE IT AND CONTINUE
PUSHJ P,WRITE ; NO - COPY THIS ONE
JRST DELET2 ; AND CONTINUE LOOKING
DELET3:
PUSHJ P,COPY ; COPY OUT REST OF MASTER FILE
POPJ P, ; AND GO HOME
SUBTTL APPEND PROCESSOR
;THIS ROUTINE HANDLES THE APPEND COMMAND IN MAKLIB.
;IT WILL COPY THE ENTIRE MASTER FILE, THEN START OBTAINING TRANSACTION
;FILES WITH CALLS TO TRNGET, APPENDING ONE OR MORE
;PROGRAMS FROM EACH FILE.
APPEND:
PUSHJ P,MSTGET ;GET A PROGRAM FROM MASTER FILE
$STPCD(APPEND can't find MASTER specifications)
;FATAL SINCE WE JUST WANT TO SET UP
PUSHJ P,COPY ;COPY ENTIRE MASTER
APPND1:
PUSHJ P,TRNGET ;GET A PROGRAM NAME FROM TRANSACTION
POPJ P, ;NO MORE PROG NAMES IN THIS FILE
PUSHJ P,FINDCP ;FIND PROGRAM AND COPY IT
JUMPE R,CPOPJ ;ZERO NAME DON'T LOOP
JRST APPND1 ;LOOP FOR MORE PROGRAMS
SUBTTL INDEX PROCESSOR
;THIS ROUTINE PROCESSES THE X COMMAND (INDEX LIBRARY)
;AND CAN FALL INTO DELETE LOCAL SYMBOLS CODE,IF DESIRED
;BY NOT SKIPPING TO DELCPY+1
INDEX:
MOVE A,OUTBEG ;GET OUTPUT DEVICE
MOVE A,.FXDEV(A)
DEVCHR A, ;GET ITS CHARACTERISTICS
TXNN A,DV.DSK!DV.DTA ;ONLY ALLOW DSK AND DTA
JRST E$$ODD ;GIVE ERROR MESSAGE
TXO F,NOWARN ;NO WARNING MESSAGE IF /X
TXOA F,XFLG ;INDEX FLAG YES, DELETE LOCALS NO
SUBTTL DELETE LOCAL SYMBOLS PROCESSOR
;THIS ROUTINE PROCESSES THE NOLOCALS COMMAND
; THE MASTER FILE IS COPIED OUT TO THE OUTPUT EXCEPT THAT ALL
; LOCAL SYMBOLS ARE DELETED FROM THE SYMBOL TABLE BLOCKS.
; (LINK ITEM TYPE 2).
DELCPY: TXO F, NOLOCB ;SET FLAG TO DELETE LOCAL SYMBOLS
PUSHJ P, MSTGET ;GET A PROGRAM FROM MASTER FILE
JRST E$$NEA ;NOT ENOUGH ARGUMENTS
PUSHJ P,INDEX0 ;SET UP POINTERS FOR INDEXING
PUSHJ P, COPY ;COPY ENTIRE FILE
TXNN F,XFLG ;INDEX FLAG ON?
JRST RSTRT ;ALL DONE
JRST INDEX3 ;YES DO PASS 2
SUBTTL DUMMY "FIX" PROCESSOR TO HANDLE COMMAND IF NOT ASSEMBLED
IFE FTBPT,<
FIXX:
$KILL(BNI,Binary patching tool not included in MAKLIB)
> ;EFI FTBPT
SUBTTL FIX PROCESSOR (STARTS LONG 'IFN FTBPT' CONDITIONAL)
IFN FTBPT,<
FIXX:
MOVEM P,FIXXP ;SAVE P, EOF CAN COME FROM ANYWHERE
MOVE FPT,WLDTMP ;GET ADDRESS OF TRANS FILE STUFF
HLRZ T1,.FXLEN(FPT) ;ANY ARGS SPECIFIED?
JUMPE T1,FIX0 ;IF 0, ITS OK
$WARN(AFI,Arguments to /FIX switch are ignored)
FIX0:
MOVE FPT,INBEG ;SEE IF /MASTER SPECIFIED
HLRZ FPT,.FXLEN(FPT) ;BECAUSE WE IGNORE IT
JUMPE FPT,FIX0A ;IF 0, WAS NOT SPEFIFIED
$WARN (MNI,/MASTER module names are ignored when patching)
FIX0A:
SETZM CURMOD ;CLEAR CURRENT MODULE NAME
SETZM LLABEL ;CLEAR LAST LABEL SEEN
TXZ F,IAE!IAI ;NOT IN EDIT OR INSERT
SETZM PRGINC ;NO PROGRAM IN CORE RIGHT NOW
MOVEI T1,TRCBLK ;SET UP AREA FOR TRACE BLOCK
MOVEM T1,TRCVAP ;
PUSHJ P,ISTINI ;INITIALIZE THE IST
MOVEI T1,^D8 ;INITIAL RADIX IS RADIX 8.(10)
MOVEM T1,CRADIX ;DONE
FIXLL: ;CODE EVALUATION LOOP
PUSHJ P,ISTSAV ;SAVE IST ACROSS IN CASE OF ERROR
PUSHJ P,EVAL ;EVALUATE CODE
IFN DEBUG,<
TXNE F,DEBMOD ;IN DEBUGGING MODE?
JRST [PUSHJ P,LSTCOD ;YES,JUST LIST CODE
PUSHJ P,ISTRST ;RESTORE IST POINTERS
JRST FIXLL ] ;AND GET MORE
> ; NFI DEBUG
TXNN F,IAI ;RETURNED WITH CODE,INSIDE INSERT?
JRST FIX9 ;NO, SO COMPLAIN
MOVE C,R%V ;VALUE RETURNED
MOVE B,R%R ;RELOCATION
TLNE B,1 ;LH RELOCATED TOO?
TRO B,<1B34> ;YES,INDICATE THAT
TLZ B,-1 ;AND CLEAR LEFT HALF
PUSHJ P,NEWCODE ;INSERT CODE
JRST INSERR ;TOO LITTLE ROOM
PUSHJ P,PMEXT ;FIXUP ANY EXTERNALS
PUSHJ P,PMMWS ;FIXUP ANY MULTI-WORD STRINGS
AOS CPINST ;ONE MORE INSTRUCTION INSERTED
SKIPN BARFLG ;IF REPLACING,
AOS CPRET ;UPDATE RETURN
JRST FIXLL ;BACK FOR MORE CODE
FIX1:
TXNE F,IAE ;WERE WE BETWEEN EDITS?
JRST PEFERR ;NO,SO EOF WAS PREMATURE
FIX4:
PUSHJ P,PUTPG ;PUSH OUT PROGRAM IN CORE (IF ANY)
PUSHJ P,MSTGET ;RESET INPUT IO TO MASTER
JFCL ;DONT CARE IF NO FILE NAMES
PUSHJ P,COPY ;COPY OUT THE REST OF FILE
MOVE P,FIXXP ;RESTORE PUSHDOWN LIST POINTER
POPJ P, ;AND RETURN
FIX9:
$WARN(CII,Code generated outside of range of .INSERT was ignored:,,$MORE)
PUSHJ P,.TCRLF##
PUSHJ P,TYPTB1
MOVEI T1,MACBUF
PUSHJ P,.TSTRG##
SKIPA
X$$CII:
PUSHJ P,.TCRLF##
TXZ F,FOTTY
PUSHJ P,ISTRST ;RESTORE IST TO STATE BEFORE CALL
JRST FIXLL ;BACK FOR NEXT LINE
; NOTE WELL: *******
; STILL UNDER IFN FTBPT WHICH CONTINUES FOR QUITE A FEW PAGES
;
SUBTTL YANKPG- ROUTINE TO YANK ONE PROGRAM INTO CORE
;THIS ROUTINE LOADS THE PROGRAM INTO CORE, SETTING UP POINTERS TO
;VARIOUS AREAS OF INTEREST IN THE FILE. NOTE THAT THE ENTRY AND
;NAME BLOCKS HAVE ALREADY BEEN PLACED IN ENTBLK.
YANKPG:
MOVEM C,SAVEAC ;SAVE C, IT GIVES END OF ENTBLK
SETZM FMZLOC ;CLEAR FIRST MODULE ZERO
MOVE C,[XWD FMZLOC,FMZLOC+1] ;AND CLEAR REST OF AREA
BLT C,LMZLOC ;CLEAR TO LAST
MOVE C,.JBFF## ;GET END OF CORE USED
MOVEM C,PSLOC ;SAVE START OF PROGRAM
SOS C ;BACK OFF ONE SO DEPWRD CAN INCREMENT
YANK1:
PUSHJ P,GETIN ;GET A WORD OF REL FILE
PUSHJ P,DEPWRD ;DEPOSIT INTO CORE
HLRZ B,A ;GET BLOCK TYPE
CAILE B,3777 ;IS IT ASCIZ .TEXT?
JRST YANK3 ;YES,HANDLE IT DIFFERENTLY
MOVSI T,-BLKLEN ;GET READY TO LOOK IT UP
YANK2:
CAMN B,BLKCOD(T) ;A CODE
JRST @YTABLE(T) ;MATCHES!
AOBJN T,YANK2 ;NO MATCH,TRY AGAIN
CAIG B,37 ;IN RANGE 0-37?
JRST YANK2A ;YES,SO ITS LEGAL OLD TYPE
CAIL B,1000 ;CHECK RANGE 1000-1777 FOR
CAILE B,1777 ;NEW TYPE LINK ITEMS
JRST IBTERR ;NOT A RECOGNIZED BLOCK TYPE
YANK2A:
PUSHJ P,COUNT ;COUNT WORDS THAT FOLLOW
YANK2B:
JUMPE B,YANK1 ;IF NULL BLOCK
PUSHJ P,GETIN ;GET A WORD
PUSHJ P,DEPWRD ;PUT INTO CORE
SOJG B,.-2 ;MORE TO DO?
JRST YANK1 ;NO, GET NEXT BLOCK
YANK3:
PUSHJ P,GETIN ;GET A WORD OF ASCIZ BLOCK
PUSHJ P,DEPWRD ;DEPOSIT IT
ANDI A,177 ;GET RID OF ALL BUT LAST BYTE
JUMPE A,YANK1 ;IF NULL, WE ARE DONE
JRST YANK3 ;ELSE LOOP
SUBTTL TABLE AND PROCESSORS FOR YANK MODULE
;THIS TABLE SETS UP CORRESPONDENCE BETWEEN CODES AND WHAT WE DO
;WHEN WE SEE EACH TYPE OF BLOCK. MOST BLOCKS ARE JUST YANKED INTO CORE
;BUT SEVERAL TYPES GET SPECIAL HANDLING.
BLKCOD:
1 ;A CODE BLOCK
2 ;A SYMBOL BLOCK
5 ;END BLOCK
1040 ;END BLOCK
3 ;HI SEGMENT ITEM
LI$TRC ;TRACE ITEM
YTABLE:
PRGCOD
PRGSYM
ENDPRG
ENDPRG
HISEGI
TRACEI
BLKLEN==.-YTABLE
;HERE TO HANDLE THE CODE BLOCK ITEMS. WE STORE A POINTER TO THE FIRST ONE
;OF THESE.
PRGCOD: SKIPN SPCLOC ;FIRST TIME HERE?
MOVEM C,SPCLOC ;NO,SAVE POINTER
PUSHJ P,COUNT ;GET SIZE OF BLOCK
MOVE T,C ;SO WE CAN KNOW THE END
ADD T,B ;
MOVEM T,EPCLOC ;
JRST YANK2B ;THEN POLISH OFF BLOCK
;HERE TO HANDLE SYMBOL BLOCK ITEMS. STORE POINTER TO BEGINNING AND END
PRGSYM:
SKIPN SSTLOC ;FIRST TIME?
MOVEM C,SSTLOC ;YES, STORE POINTER
PUSHJ P,COUNT ;GET SIZE OF BLOCK
MOVE T,C ;START OF BLOCK
ADD T,B ;AND NOW (T) IS LAST WORD USED
MOVEM T,ESTLOC ;END OF SYMBOL TABLE
JRST YANK2B ;FINISH UP
;HERE WHEN END OF PROGRAM IS SEEN
ENDPRG:
MOVEM A,SEB ;STORE IN SAFE PLACE
SOS C ;BACK OFF ONE
MOVEM C,PELOC ;AND MARK END OF PROGRAM
PUSHJ P,COUNT ;SIZE OF BLOCK
MOVEI T,SEB+1 ;STORE IN SAVE-END-BLOCK
ENDPR1:
PUSHJ P,GETIN ;INPUT WORD
MOVEM A,(T) ;AND INTO SAVE BLOCK
AOS T ;UPDATE
SOJG B,ENDPR1 ;MORE TO DO?
SETOM PRGINC ;CURRENTLY A PROGRAM IN CORE
JRST CPOPJ1 ;NO,RETURN OVER EOF RETURN
;ROUTINE TO SET UP POINTER TO HI SEGMENT ITEM
HISEGI:
SKIPN HSILOC ;MARK HISEGMENT ITEM LOCATION
MOVEM C,HSILOC ;
JRST YANK2A
;ROUTINE TO SET UP POINTER TO BEGINNING AND END OF TRACE BLOCK AREA
TRACEI:
SKIPN STBLOC ;MARKED START OF TRACE BLOCKS?
MOVEM C,STBLOC ;NOT YET, DO SO NOW
PUSHJ P,COUNT ;AND GET COUNT
MOVE T,C ;POINT TO END
ADD T,B ;
MOVEM T,ETBLOC ;AND MARK IT
JRST YANK2B ;FINISH UP READING BLOCK
;ROUTINE TO DEPOSIT A WORD FROM REGISTER A INTO THE END OF CORE. (C)
;IS THE ADDRESS TO DEPOSIT INTO. MORE CORE IS OBTAINED AS NEEDED.
DEPWRD:
AOS C ;UPDATE DEPOSIT ADDRESS
MOVEM C,.JBFF## ;AND MAKE IT BE NEXT FREE
DEPWD1: CAMG C,.JBREL## ;ARE WE PAST OUR MEMORY?
JRST DEPWD2 ;NO,DEPOSIT
PUSH P,C ;SAVE C
CORE C, ;GET CORE
JRST NECERR ;NOT ENOUGH CORE
POP P,C ;RESTORE C
JRST DEPWD1 ;BE SAFE, CHECK AGAIN
DEPWD2: MOVEM A,(C) ;DEPOSIT WORD
POPJ P, ;AND RETURN
SUBTTL PUTPG - ROUTINE TO WRITE BACK OUT THE CORRECTED PROGRAM
;/PUTPG/ - A ROUTINE TO WRITE OUT THE CORRECTED PROGRAM
; PUTPG COLLECTS THE VARIOUS NEW AND OLD BLOCKS AND RE-WRITES
; THEM INTO THE OUTPUT FILE. PUTPG COLLECTS CODE
; FROM THE FOLLOWING PLACES IN THE FOLLOWING ORDER:
; 1-ITEMS STORED IN THE BUFFER "ENTBLK", USUALLY ENTRY AND NAME ITEMS
; 2-EXISTING PROGRAM CODE
; 3-NEW PROGRAM CODE (FROM PATCOD)
; 4-OLD SYMBOL TABLE
; 5-NEW SYMBOL TABLE (FROM CRESYM)
; 6-ANYTHING ELSE TO END OF OLD PROGRAM
; 7-NEW TRACE BLOCKS
; 8-UPDATED END BLOCK (FROM SEB)
;
PUTPG:
SKIPL PRGINC ;ANYTHING TO DO?
POPJ P, ;NO, SO JUST RETURN
SETZM PRGINC ;CLEAR FLAG
SOS B,SAVEAC ;GET OLD POINTER,ADJ BACK ONE
CAIGE B,ENTBLK ;ANYTHING TO DO?
JRST PUTPG3 ;NO, SO GO TO NEXT SECTION
MOVEI C,ENTBLK ;ELSE PUT BUFFER OUT
PUSHJ P,PUTTO ;FROM (C) TO (B)
PUTPG3:
MOVE C,PSLOC ;GET START OF READ-IN STUFF
MOVE B,EPCLOC ;AND END OF OLD CODE
PUSHJ P,PUTTO ;COPY OUT
MOVEM C,SAVEAC ;SAVE POINTER
SKIPN B,PATPTR ;ANY PATCH CODE?
JRST PUTPG4 ;NO,GO TO NEXT SECTION
MOVE C,PATCOD ;BEGINNING OF PATCH BLOCK
SOS B ;END PTR
PUSHJ P,PUTTO ;FROM PATCOD TO <PATCOD+PATPTR>-1
PUTPG4:
MOVE C,SAVEAC ;RESTORE C
SKIPN B,ESTLOC ;ANY SYMBOL TABLE?
JRST PUTPG5 ;NO, SKIP IT
PUSHJ P,PUTTO ;ELSE COPY IT OUT
PUTPG5:
SKIPN B,CREPTR ;ANY CREATED SYMBOLS?
JRST PUTPG6 ;NO,NEXT SECTION
SOS B ;"TO" PTR
MOVEM C,SAVEAC ;SAVE C
MOVE C,CRESYM ;"FROM" PTR
PUSHJ P,PUTTO ;COPY IT OUT
MOVE C,SAVEAC ;RESTORE C
PUTPG6:
MOVE B,ETBLOC ;GET END OF TRACE BLOCK
PUSHJ P,PUTTO ;SHOULD END STUFF
SKIPN B,TRCVAP ;AND NEXT COPY OUT ANY NEW BLOCKS
JRST PUTPG7 ;IN CASE
TXNE F,FSTMOD ;CHANGED EDIT?
MOVE B,TRCPTR ;YES,DONT COPY STATIC AREA
;FOR NEW EDIT INTO OLD MODULE
SOS B ;BACK OFF ONE FROM END
MOVEM C,SAVEAC ;SAVE C
MOVEI C,TRCBLK ;WRITE IT OUT
PUSHJ P,PUTTO ;FROM TRCBLK TO END OF TRCBLK
MOVEI A,TRCBLK ;MAKE SURE ONLY ONE EDIT IN CORE
CAMN A,TRCPTR ;
JRST PTPG6A ;ITS OK.
MOVS B,TRCPTR ;FROM TRCPTR TO
HRRI B,TRCBLK ;TRCBLK
BLT B,TRCBLK+TB$SIZ-1 ;SAVE ONLY THE STATIC AREA
MOVEI B,TRCBLK ;AND RESET POINTER
MOVEM B,TRCPTR ;TO CURRENT AREA
PTPG6A:
MOVE B,[LI$TRC,,TB$SIZ] ;RESET STATIC HEADER
MOVEM B,TB$HED(A) ;
SETZM TB$LEN(A) ;AND THE LEN WORD FOR VARIABLE
ADDI A,TB$VAR ;UPDATE
MOVEM A,TRCVAP ;VARIABLE POINTER
MOVE C,SAVEAC ;
PUTPG7:
MOVE B,PELOC ;COPY REST OF PROGRAM (IF ANY)
PUSHJ P,PUTTO ;AS A SAFETY MEASURE
MOVEI C,SEB ;AND LAST COMES THE END BLOCK
MOVE A,SEB ;PICK UP HEADER
PUSHJ P,COUNT
ADDI B,SEB ;END OF BLOCK
PUSHJ P,PUTTO ;
MOVE C,PSLOC ;RESTORE JBFF
MOVEM C,.JBFF## ;SO WE DONT SWELL TOO MUCH
POPJ P, ;RETURN TO CALLER
PUTTO:
CAMLE C,B ;ANY MORE TO DO?
POPJ P, ;NO
MOVE T1,0(C) ;GET A WORD
PUSHJ P,BOUT ;AND WRITE IT
AOJA C,PUTTO ;AND LOOP
SUBTTL PROCESSORS AND ROUTINES FOR PATCHING
; /SYMSRC/ - ROUTINE TO FIND A SYMBOL IN REL FILE'S SYMBOL TABLE
; WHERE SYMBOL IN AC R IS SIXBIT
; /SYMSRN/ -ROUTINE TO FIND NEXT SYMBOL IN REL FILE'S SYMBOL TABLE
; WHERE SYMBOL IS NEXT OCCURANCE OF SYMBOL IN LAST CALL TO SYMSRC
;
; /SYMSRA/ - SAME AS SYMSRC, ONLY SYMBOL IS IN RADIX50
;
; INPUT- AC R CONTAINS SYMBOL IN SIXBIT OR RADIX50
; IF AC R IS ZERO, THEN ANY SYMBOL IS A MATCH
; OUTPUT- AC A CONTAINS VALUE OF SYMBOL ( 2ND WORD OF PAIR)
; AC B CONTAINS 4 BIT CODE OF SYMBOL IN BITS 30-33
; AC C POINTS TO IN-CORE LOCATION OF 1ST WORD OF SYMBOL PAIR
; AC D CONTAINS THE RIGHT JUSTIFIED 2 BIT RELOC BYTE FOR CONTENTS OF AC A
; AC R IS PRESERVED, UNLESS IT WAS 0. IF IT WAS 0
; THEN RADIX50 NEXT SYMBOL NAME IS RETURNED
;
; RETURNS- CPOPJ=SYMBOL NOT FOUND CPOPJ1=SYMBOL FOUND
SYMSRC:
JUMPE R,SYMSRA ;HANDLE 0 (WILD CARD) SAME
;FOR SIXBIT OR RADIX50
PUSH P,R ;SAVE SIXBIT OF SYMBOL
PUSHJ P,RAD50 ;CONVERT TO RADIX 50
PUSHJ P,SYMSRA ;NOW CONTINUE, WITH R50
CAIA ;FAILURE RETURN
AOS -1(P) ;SKIP RETURN
POP P,R ;RESTORE ORIG AC R
POPJ P, ;RETURN
SYMSRA:
PUSH P,T1 ;SAVE T1-2
PUSH P,T2 ;...
MOVE T,ESTLOC ;LOAD T WITH END OF FIRST SEARCH
SKIPN C,SSTLOC ;DO WE HAVE SYMBOLS?
JRST SYMSR4 ;NO,SEE IF ANY CREATED SYMBOLS
SYMSR1:
MOVE A,(C) ;GET A HEADER
HLRZ D,A ;PICK OUT TYPE
PUSHJ P,COUNT ;GET LENGTH OF BLOCK
CAIE D,2 ;IS THIS REALLY A SYMBOL BLOCK?
JRST [CAILE D,3777 ;ASCII TEXT BLOCK?
JRST SYMSR5 ;YES,IGNORE IT
ADDI C, 1(B) ;POINT TO NEXT BLOCK
CAMG C,T
JRST SYMSR1
JRST SYMSR4] ;IF NOT,GET NEXT BLOCK OR SWITCH
MOVEI D,23(C) ;POINT TO NEXT RELOCATION WORD
MOVE T2,1(C) ;T2 GETS RELOC WORD
ADDI C,2 ;NOW POINT TO FIRST SYMBOL PAIR
SOS B ;AND ACCOUNT FOR SKIPPED WORD
SYMSR2:
CAMLE C,T ;PAST END OF THIS TABLE?
JRST SYMSR4 ;YES-, TRY FOR NEW SYMBOLS
JUMPLE B,SYMSR1 ;END OF THIS BLOCK?
CAMN D,C ;TIME TO IGNORE RELOC WORD?
JRST [ SOS B ;YES
MOVE T2,0(C) ;GET RELOCATION WORD
MOVEI D,22(C) ;AND PTR
AOS C
JRST SYMSR2] ;AND TRY AGAIN
MOVE A,(C) ;GET A SYMBOL
TLZ A,740000 ;TURN OFF CODE BITS
LSHC T1,4 ;GET RELOC BYTE
JUMPE R,SYMSR3 ;ALWAYS MATCH ON (R)=0
CAMN R,A ;A MATCH?
JRST SYMSR3 ;YES,SET PTRS AND RETURN
SYMS2A: ADDI C,2 ;SKIP PAIR
SUBI B,2 ;DECREMENT COUNT
JRST SYMSR2 ;AND TRY AGAIN
SYMSR3:
PUSH P,A ;SAVE A
MOVE A,[XWD T1,SYMBLK] ;SAVE STATE
BLT A,SYMBLK+D ;FOR SYMSRN ROUTINE
POP P,R ;RESTORE SYMBOL NAME
MOVE A,1(C) ;GET VALUE OF SYMBOL INTO REG. A
LDB B,[POINT 4,0(C),3] ;AND BITS INTO B
LSH B,2 ;GET IT INTO BITS 30-33
LDB D,[POINT 2,T1,35] ;GET RELOCATION BYTE
POP P,T2 ;RESTORE TEMPS
POP P,T1 ;...
JRST CPOPJ1 ;AND TAKE GOOD RETURN
SYMSR4:
SKIPE CREPTR ;IF NO CREATED SYMS OR
CAME T,ESTLOC ;JUST FINISHED WITH THEM
PJRST T2POPJ ;NO,SO MUST BE DONE W/NEW TOO.
MOVE C,CRESYM ;POINT TO CREATED SYMBOLS
MOVE T,CREPTR ;POINT TO END OF NEW SYMS+1
SOJA T,SYMSR1 ;ADJUST AND GO TO IT
SYMSR5:
SETZM B ;CLEAR WORD COUNT
MOVE A,0(C) ;GET WORD WE POINT TO
ADDI C,1 ;POINT TO NEXT WORD
ANDI A,177 ;DISCARD ALL BUT LAST BYTE
JUMPE A,SYMSR2 ;IF END , CHECK FOR END OF TABLE
JRST SYMSR5 ;ELSE REPEAT
SYMSRN: ;ALT. ENTRY FOR NEXT SYMBOL
PUSH P,T1
PUSH P,T2 ;SAVE ACS FOR GOOD PDL PHASE
MOVS A,[XWD T1,SYMBLK] ;RESTORE ACS
BLT A,D ;FROM LAST SEARCH
JRST SYMS2A ;AND CONTINUE
; /WRDSRC/ - ROUTINE TO TAKE A VALUE AND FIND THE WORD IN THE
; REL FILE THAT CORRESPONDES TO THAT VALUE. I.E.
; GIVEN A VALUE OF N, FIND THE WORD IN THE REL FILE
; THAT WILL BE LOADED INTO WORD N OF THE CORE IMAGE.
;
; INPUT- AC A SHOULD CONTAIN A VALUE (PRESERVED)
; OUTPUT- AC C WILL CONTAIN THE IN-CORE POSITION OF THE DESIRED WORD
; AC B WILL CONTAIN THE IN-CORE POSITION OF THE HEADER WORD
; THE CODE ITEM THAT THE WORD APPEARS IN.
;
; RETURNS- CPOPJ=WORD IS NOT IN FILE, CPOPJ1=WORD IS IN FILE
;
WRDSRC:
MOVE T,EPCLOC ;FIRST SEARCH IS IN EXISTING CODE
;AREA. IE. FROM (SPCLOC) TO (EPCLOC)
SKIPN B,SPCLOC ;DO WE KNOW WHERE CODE IS?
JRST WRDSR4 ;NO, SEE IF IN NEW CODE AREA
WRDSR1:
HLRZ C,0(B) ;GET BLOCK TYPE
CAIE C,1 ;INSURE THAT ITS CODE BLOCK
JRST WRDSR2 ;ITS NOT, SO DISCARD IT
LDB D,[POINT 2,1(B),1] ;GET RELOCATION OF START ADDR
JUMPE D,WRDSR3 ;IGNORE ABSOLUTE CODE
MOVE D,2(B) ;POINT TO FIRST START ADDR WORD
HRRZ C,0(B) ;GET NR. OF DATA WORDS IN BLOCK
SUBI C,2 ;BACK OFF TWO AS ADDITIVE ADJ.
;I.E. SO S.ADDRESS OF BLOCK + (C)
;IS HIGHEST ADDR THIS BLOCK
CAMLE D,A ;IS START ADDR .GT. VALUE?
JRST WRDSR3 ;YES,SO CANT BE IN THIS BLOCK
ADD D,C ;GET HIGHEST ADDRESS THIS BLOCK
CAMGE D,A ;IF .LT. VALUE ,NOT IN BLOCK
JRST WRDSR3 ;SO GET NEXT ONE
MOVE D,A ;DESIRED VALUE
SUB D,2(B) ;MINUS START ADDRESS
ADDI D,3(B) ;PLUS BASE GIVES CORE POSITION
MOVE C,D ;RETURN IT IN C
JRST CPOPJ1 ;AND RETURN
WRDSR2:
CAIG C,3777 ;IF NOT ASCIZ TEXT BLOCK,
JRST WRDSR3 ;IGNORE BY HEADER VALUE
WRDS2A: MOVE C,0(B) ;GET WORD WE POINT TO
ADDI B,1 ;POINT TO NEXT WORD
ANDI C,177 ;GET LAST BYTE IN WORD
JUMPE C,WRDS3A ;MAKE END OF TABLE CHECKS
JRST WRDS2A ;ELSE REPEAT
WRDSR3:
PUSH P,A ;SAVE A
MOVE D,B ;COPY B
MOVE A,(B) ;GET HEADER INTO A
PUSHJ P,COUNT ;SO WE CAN COUNT
POP P,A ;RESTORE A
ADDI B,1(D) ;POINT TO NEXT HEADER
WRDS3A: CAMGE B,T ;OVER THE END?
JRST WRDSR1 ;NO,SO EXAMINE BLOCK
JRST WRDSR4 ;YES, SEE IF END OR SWITCH TO
; NEW CODE AREA
WRDSR4:
SKIPE PATPTR ;NO CREATED CODE?
CAME T,EPCLOC ;CHECKED NEW CODE ALREADY?
POPJ P, ;YES, FINALLY RETURN W/ERROR
MOVE B,PATCOD ;NO, LOAD LOWER BOUND W/PATCOD
MOVE T,PATPTR ;AND LOWER WITH END OF BLOCK
SOJA T,WRDSR1 ;ADJ, AND GO SEARCH
; /FGREF/ - ROUTINE TO FIND THE IN-CORE ADDRESS OF THE SYMBOL TABLE
; OR CODE WORD THAT IS THE IMMEDIATE PREDECESSOR OF THE
; WORD WHOSE RELOCATABLE ADDRESS IS (A) , IN THE GLOBAL
; FIXUP CHAIN THAT STARTS WITH THE SYMBOL (R).
;
; INPUTS- AC A CONTAINS THE RELOCATABLE (LOAD) ADDRESS OF
; WORD WE THINK IS IN A GLOBAL CHAIN
; AC R CONTAINS A SIXBIT SYMBOL NAME THAT IS A GLOBAL
; WE THINK HEADS SOME CHAIN THAT WE THINK (A) IS
; A PART OF.
;
; OUTPUTS- AC C CONTAINS THE IN-CORE ADDRESS OF A WORD THAT
; IS EITHER A CODE WORD WHOSE RIGHT-HALF POINTS TO (A)
; OR IS THE SECOND WORD OF A 2 WORD SYMBOL TABLE ENTRY
; THAT HEADES THE CHAIN
; THAT POINTS TO ADDR (A)
; THE LEFT HALF OF C (ON SUCCESSFUL RETURN) IS:
; -1 IF (C)RH POINTS TO SYMBOL TABLE ENTRY
; (WORD 2 OF PAIR)
; 0 IF (C)RH POINTS TO WORD OF CODE
; AC B CONTAINS THE ADDRESS OF THE BLOCK HEADER THAT
; HEADS THE LINK ITEM TYPE WORD APPEARS IN
; SO THAT THE RELOCATION BYTE OF THIS SYMBOL
; IS ACCESIBLE
;
;
; RETURNS- CPOPJ=CANNOT FIND REFERENCE
; CPOPJ1 = REFERENCE FOUND.
;
; NOTE: ALT. ENTRY FGREFN FINDS NEXT GLOBAL REFERENCE
; NOTE: IF (R) IS 0 THEN ANY GLOBAL IS A MATCH.
;
;
FGREF:
MOVEM A,SAVEA ;SAVE REFERENCE
PUSHJ P,SYMSRC ;FIND FIRST REFERENCE TO SYM.
POPJ P, ;NO REFERENCE FOUND
FGREF1:
CAIE B,60 ;IS IT A GLOBAL SYMBOL?
JRST FGREF5 ;NO,SKIP IT
JUMPE A,[JUMPE D,FGREF5 ;ALLOW SYMBOL WITH NO CHAIN
JRST .+1] ;THATS WORD2=RELOC=0
HRROI C,1(C) ;PRETEND SUCCESS
HRRZS A ;CLEAR BITS IN LH
CAMN A,SAVEA ;A MATCH?
JRST CPOPJ1 ;YES
MOVE A,0(C) ;FOLLOW CHAIN
TXNE A,R5.FXA ;IF THERE IS ADDITIVE PROCESSING
JRST FGREF5 ;THEN THERE IS NO CHAIN
FGREF2:
PUSHJ P,WRDSRC ;LOOKUP WORD WE POINT TO
$STPCD(GLOBAL chain points outside of REL file)
HRRZ A,0(C) ;GET ADDRESS FIELD
JUMPE A,FGREF4 ;CHECK RELOC BITS IF ZERO
FGREF3:
TLZ C,-1 ;CLEAR IT
CAMN A,SAVEA ;A MATCH?
JRST CPOPJ1 ;YES,TAKE GOOD RETURN
JRST FGREF2 ;NO,FOLLOW CHAIN
FGREF4:
PUSHJ P,GETREL ;GET RELOCATION FOR THIS WORD
TRNN D,1 ;RELOC BIT ON?
JRST FGREF5 ;NO ITS END OF CHAIN
SETZ A, ;YES,ITS REF TO WORD 0
JRST FGREF3 ;PROCESS IT
FGREFN:
FGREF5:
PUSHJ P,SYMSRN ;GET NEXT INSTANCE OF SYMBOL
POPJ P, ;DONE
JRST FGREF1 ;PROCESS IT
; /GFIXUP/ - ROUTINE TO CHANGE GLOBAL CHAINS WHEN A WORDS POSITION IS CHANGED
;
; GFIXUP HUNTS DOWN THE GLOBAL CHAINS (AT MOST TWO,AT LEAST 0)
; THAT POINT TO A WORD AND UPDATES THEM TO POINT TO THE CORRECT
; PLACE. THIS ROUTINE SHOULD BE USED WHEN ANY WORD IS CHANGED
; IN LOCATION IN THE REL FILE.
;
; INPUTS- AC A SHOULD CONTAIN THE PRESENT RELOCATABLE ADDRESS OF
; WORD IN QUESTION.
; AC B SHOULD CONTAIN THE RELOCATABLE ADDRESS WHERE THE WORD
; IS GOING.
;
; OUTPUTS- UPDATED SYMBOL TABLE AND / OR CHAINS.
;
; RETURNS- ALWAYS CPOPJ
;
;
GFIXUP:
PUSH P,B ;SAVE B ACROSS CALLS
PUSH P,A ;SAVE A ACROSS CALLS
SETZ R, ;DONT KNOW SYMBOL NAME
PUSHJ P,FGREF ;FIND FIRST REFERENCE
JRST GFIXU2 ;NOT IN ANY CHAIN
MOVE B,-1(P) ;GET NEW ADDRESS
HRRM B,0(C) ;UPDATE ADDRESS
MOVE A,0(P) ;RESTORE ADDRESS
PUSHJ P,FGREFN ;GET 2ND REFERENCE
JRST GFIXU2 ;NOT THERE
MOVE B,-1(P) ;GET NEW ADDRESS
HRRM B,0(C) ;STORE NEW LOCATION
GFIXU2:
POP P,A ;RESTORE A
POP P,B ;RESTORE B
POPJ P, ;RETURN
; /NEWSYM/ - ROUTINE TO INSERT A SYMBOL PAIR INTO THE CREATED SYMBOL BLOCK
; FOR LATER MERGING WITH EXISTING SYMBOL BLOCK
;
; INPUT- AC R SHOULD CONTAIN A RADIX 50 SYMBOL NAME WITH APPROPRIATE
; BITS SET IN 0-3. IF NONE ARE SET, FLAGS ARE INSERTED WITH
; MEANING [LOCAL SYMBOL].
; AC A SHOULD CONTAIN THE VALUE (WORD 2 OF PAIR) DESIRED. NOTE
; THAT FOR LOCAL SYMBOLS THIS IS THE VALUE OF THE SYMBOL AND
; FOR GLOBAL REQUESTS, THIS IS THE ADDRESS TO DO THE FIXUP TO.
; AC B SHOULD CONTAIN THE 2 BIT RELOCATION BYTE FOR THIS
; SYMBOLS'S VALUE. THE USUAL WILL BE 01(2) MEANING
; RELOCATE THE RIGHT HALF.
;
;
;
; OUTPUT- UPDATED CRESYM AND CREPTR.
;
; RETURNS- CPOPJ=NO ROOM FOR SYMBOL CPOPJ1=SYMBOL INSERTED
;
NEWSYM:
TLNN R,740000 ;SOME BITS ON?
TXO R,R5.LCL ;NO, MAKE IT A LOCAL SYMBOL
SKIPN CREPTR ;POINTER SET UP?
JRST [PUSHJ P,CRESET ;NO , SET UP
JRST NEWSY1] ;AND FORCE NEW BLOCK
HRRZ D,@LSYMHW ;GET COUNT OF CURRENT BLOCK
CAIE D,22 ;TIME FOR A NEW BLOCK?
JRST NEWSY2 ;NO, GO PROCESS
NEWSY1:
MOVE T,CREPTR ;GET POINTER TO CURRENT LOC
MOVE C,CRELST ;GET END OF AREA FOR NEW SYMBOLS
CAILE T,-3(C) ;ROOM FOR HEADER,RELOC,SYM NAME
;AND SYM VALUE WORDS?
POPJ P, ;NO SO,RETURN W/FAILURE
MOVEM T,LSYMHW ;STORE LOC OF NEW HEADER
MOVE D,[XWD 2,0] ;2 IS SYMBOL CODE
MOVEM D,(T) ;STORE HEADER (0)
MOVE D,[BYTE (2) 0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1,0,1]
MOVEM D,1(T) ;STORE RELOC (1)
ADDI T,2 ;UPDATE THE POINTER
MOVEM T,CREPTR ;AND STORE IT
NEWSY2:
MOVE T,CREPTR ;FETCH POINTER
MOVE C,CRELST ;TWO WORDS FREE FOR NAME,VALUE?
CAILE T,-1(C) ;
POPJ P, ;NO, SO RETURN
MOVEM R,0(T) ;STORE SYMBOL NAME
MOVEM A,1(T) ;AND ITS VALUE
MOVEI T,2 ;UPDATE COUNTERS
ADDM T,CREPTR ;TO CURRENT LOCATION
ADDM T,@LSYMHW ;TO BLOCK HEADER
CAIN B,1 ;CHECK FOR LABEL TYPE RELOC
JRST NEWSY3 ;USUAL CASE OF 01(2),SKIP THIS
MOVE T,LSYMHW ;LOAD ADDRESS OF BLOCK HEADER
HRRZ C,0(T) ;PICK UP RH OF HEADER (WORD COUNT)
ADD T,[POINT 2,1] ;CONVERT AC T TO BYTE POINTER TO
;RELOCATION WORD
IBP T ;UPDATE TO POINT TO RIGHT PLACE
SOJG C,.-1 ;
CAILE B,3 ;MAKE SURE WE DONT HAVE GARBAGE
$STPCD(Relocation argument incorrect)
DPB B,T ;STORE THE RELOCATION
NEWSY3:
TLZ R,740000 ;TURN FLAGS OFF AGAIN
JRST CPOPJ1 ;TAKE GOOD RETURN
; THESE ARE AUXIALLIARY ENTRY POINTS TO NEWSYM.
; /GLRSYM/ - TURNS ON BITS TO INDICATE SYMBOL IS GLOBAL REQUEST
; /GLDSYM/ - TURNS ON BITS TO INDICATE SYMBOL IS GLOBAL DECLARATION
;
; INPUTS - SAME AS FOR ROUTINE NEWSYM
GLRSYM:
TXOA R,R5.REQ ;FLAG AS GLOBAL REQUEST
GLDSYM: TXO R,R5.GLB ;FLAG AS GLOBAL DECLARATION
JRST NEWSYM ;AND CONTINUE
;/NEWCOD/ - ROUTINE TO INSERT A CODE WORD INTO THE PATCH CODE
; BLOCK FOR LATER MERGING WITH EXISTING CODE.
;
; INPUTS - AC C CONTAINS THE WORD OF CODE TO BE INSERTED.
; AC B CONTAINS THE 2 BIT RELOCATION FOR THIS WORD
;
; OUTPUTS- UPDATED PATCOD,PATPTR AND THEIR ASSOCIATED DATA ITEMS
; NOTE::: CPADDR MUST BE SET UP WITH LOCATION TO PATCH
; INTO. CPADDR,HI SEGMENT AND END BLOCKS WILL BE UPDATED ON
; EACH CALL. ALSO NOTE THAT CPSFLG MUST BE SET
; TO INDICATE THE SEGMENT TO PATCH INTO.
;
; RETURNS- CPOPJ=NO ROOM LEFT IN PATCOD CPOPJ1=WORD INSERTED.
NEWCOD:
MOVE A,CPADDR ;LOAD PATCH ADDRESS
SKIPN PATPTR ;IS PATCH POINTER INITED?
JRST [PUSHJ P,PATSET ;NO,SET IT UP
JRST NEWCO1] ;AND FORCE NEW BLOCK
HRRZ T,@LCODHW ;PICK UP COUNT
CAIE T,22 ;TIME FOR OUR FRIEND THE RELOC?
JRST NEWCO2 ;YES,FORCE NEW BLOCK
NEWCO1:
MOVE D,PATPTR ;PICK UP CURRENT POINTER
MOVE T,PATLST ;ROOM FOR HEADER , RELOC,START ADDR
CAILE D,-3(T) ;AND WORD OF CODE?
POPJ P, ;NO,RETURN W/FAILURE
MOVE T,[XWD 1,1] ;HERE TO SET UP NEW BLOCK
MOVEM T,(D) ;1)HEADER WORD
HRLZI T,(1B1) ;2)RELOCATION WORD
MOVEM T,1(D) ;RELOCATE STARTING ADDRESS
MOVEM A,2(D) ;3)STARTING ADDRESS
MOVEM A,LCADDR ;AND SAVE AS LAST ADDRESS USED
MOVEM D,LCODHW ;SAVE POINTER TO LAST HEADER WD
ADDI D,3 ;POINT TO FIRST FREE
MOVEM D,PATPTR ;AND SAVE
JRST NEWCO3
NEWCO2:
MOVE D,PATPTR ;PICK UP THE POINTER
CAMLE D,PATLST ;ROOM FOR ONE WORD?
POPJ P, ;NO, TAKE ERROR RETURN
SUB A,LCADDR ;SEE IF WORKING CONTIGUOSLY
CAIE A,1 ;WHICH IS USUAL
JRST [ADD A,LCADDR ;NOT CONTIGUUS, FORCE NEW BLOCK
JRST NEWCO1]
AOS A,LCADDR
NEWCO3:
MOVEM C,0(D) ;STORE WORD OF CODE
AOS PATPTR ;AND IN-CORE BLOCK INDEX TOO
AOS CPADDR ;UPDATE THE ADDRESS TO PATCH
SKIPGE CPSFLG ;HI-SEGMENT FLAG UP?
JRST NEWC3A ;NO,SO USE LOW SEGMENT UPDATE
MOVSI T,1 ;ADD 1 TO LEFT HALF OF FIRST
MOVE A,HSILOC ;
;;[16] NEWCO3+8 ILG 6-APR-76
SKIPE 2(A) ;[16]HISEG TYPE 3 BLOCK HAS 0
;[16]SO DONT INCREMENT IT
ADDM T,2(A) ;DATA WORD
AOS SEB+2 ;UPDATE END BLOCK TOO
JRST NEWC3B ;AND FINISH
NEWC3A:
MOVEI T,SEB+2 ;POINT TO FIRST "END" DATA WORD
SKIPE HSILOC ;BUT IF HAVE A HI-SEGMENT,
AOS T ;POINT TO SECOND DATA WORD
AOS 0(T) ;UPDATE PROGRAM LOW-SEG BREAK
NEWC3B:
AOS T,@LCODHW ;UPDATE NR WORDS IN HEADER
HRRZS T ;T NOW HAS THAT COUNT
JUMPE B,CPOPJ1 ;IF RELOC BITS 0, WE ARE DONE
LSH T,1 ;SHIFT BITS TO 36.-INDEX*2
MOVEI D,^D36 ;
SUB D,T
LSH B,(D) ;BITS NOW IN POSITION
MOVE T,LCODHW ;GET ADDRESS OF BLOCK HEADER
IORM B,1(T) ;RELOC IS ONE BELOW
JRST CPOPJ1 ;AND RETURN
; /CHGREL/ - ROUTINE TO CHANGE THE RELOCATION BITS FOR A WORD
; IN THE REL FILE.
;
; INPUT- AC B CONTAINS ADDRESS OF THE HEADER WORD OF THE
; LINK ITEM TYPE BLOCK THAT WORD IS IN.
; AC C CONTAINS THE ADDRESS OF THE WORD ITSELF WHOSE RELOCATION
; BYTE WE ARE CHANGING.
; AC D CONTAINS THE 2 BIT RELOCATION BYTE DESIRED ( IN BITS 34-35)
;
; ACS ARE PRESERVED
;
; RETURN- ALWAYS CPOPJ
;
CHGREL:
PUSH P,T1 ;SAVE ACS T1-2 ,C
PUSH P,T2
PUSH P,C ;SAVE ACS
SUBI C,1(B) ;GET INDEX OF WORD IN THIS BLOCK
MOVE T1,1(B) ;GET ORIGINAL RELOC WORD
LSH C,1 ;DOUBLE THE INDEX
LSHC T1,-^D36(C) ;POSITION RELOC BYTE IN BITS 34-5 OF T1
TRZ T1,3 ;TURN THEM OFF
IOR T1,D ;MAKE THEM THE NEW ONES
MOVNS C ;NEGATE C
LSHC T1,^D36(C) ;REVERSE SHIFT (SHIFT INTO REVERSE?)
MOVEM T1,1(B) ;STORE RESULT
POP P,C ;RESTORE AC C
PJRST T2POPJ ;RETURN,RESTOREING T1-T2
; /GETREL/ - ROUTINE TO READ RELOCATION BYTE FOR A WORD
;
; INPUTS - AC B CONTAINS IN-CORE LOCATION OF HEADER
; AC C CONTAINS IN-CORE LOCATION OF WORD ITSELF
;
; OUTPUTS - AC D WILL CONTAIN IN BITS 34-35 THE TWO BIT RELOC. BYTE
;
GETREL:
PUSH P,C ;SAVE AC C
SUBI C,1(B) ;GET INDEX
ASH C,1 ;MULT. * 2
MOVE D,1(B) ;GIVE D THE RELOCATION WORD
LSH D,-^D36(C) ;GET INTO RIGHT PLACE
ANDI D,3 ;MASK IT
POP P,C ;RESTORE C
POPJ P, ;RETURN
;/FNDEDT/ - ROUTINE TO FIND AN EDIT IN THE CURRENT MODULE
; IN CORE.
;
; INPUTS- AC A CONTAINS THE SIXBIT NAME OF THE EDIT TO LOOK FOR
;
; OUTPUTS- AC B CONTAINS THE POINTER TO THE TRACE BLOCK CONTAINING
; THE EDIT-TRACE INFORMATION.
;
; RETURNS- CPOPJ=EDIT WAS NOT FOUND CPOPJ1=EDIT WAS FOUND
;
FNDEDT:
MOVE T,ETBLOC ;LOAD T WITH END OF OLD TRACE BLOCKS
SKIPN B,STBLOC ;ANY OLD TRACE BLOCKS?
JRST FNDED3 ;NO, SEE IF ANY ADDED
FNDED1:
CAMN A,TB$EDT(B) ;A MATCH?
JRST CPOPJ1 ;YES, SO RETURN
PUSH P,A
PUSH P,B ;SAVE A-B
MOVE A,TB$HED(B) ;LOAD HEADER
PUSHJ P,COUNT ;AND COUNT
ADD B,0(P) ;GET ADDRESS NEXT HEADER
AOS B ;PAST END OF THIS BLOCK
POP P,A ;POP OFF
POP P,A ;RESTORE A
CAMG B,T ;OVER THE END OF CURRENT SEARCH
JRST FNDED1 ;NO, SEE IF MATCH ETC...
FNDED3:
CAMN T,ETBLOC ;ARE WE DOING PART A?
SKIPN T,TRCPTR ;YES,DO WE HAVE PART B?
POPJ P, ;EITHER WERE DOING ADDED OR DONT HAVE
MOVEI B,TRCBLK ;BEGINNING OF IT
SUBI T,2 ;-1 TO ADJ PTR
;-1 BECAUSE DONT WANT TO SEE THIS
;EDIT
CAMLE B,T ;END .GT. BEGINNING?
POPJ P, ;RETURN /FAIL
JRST FNDED1 ;NO,SO CONTINUE SEARCH
;IS SET TO FIRST.FREE
; /CHKCNF/ - ROUTINE TO SEE IF THE ACT OF INSERTING,RE-INSERTING OR
; REMOVING AN EDIT CONFLICTS WITH THE [ASSOCIATED]
; SPECIFICATION OF AN EXISTING,ACTIVE EDIT IN THE
; CURRENT MODULE.
;
; INPUTS- AC A SHOULD CONTAIN THE SIXBIT NAME OF THE EDIT CURRENTLY
; BEING REMOVED OR INSERTED OR RE-INSERTED.
; AC B SHOULD CONTAIN :
; 1B0 IF THIS EDIT IS BEING REMOVED
; 1B1 IF REINSERTED OR INSERTED
;
; NOTE: CONFLICT WARNINGS ARE GENERATED INSIDE THE ROUTINE ITSELF.
; SO THERE IS ONLY ONE RETURN. CURRENTLY THE MESSAGES ARE ONLY
; WARNINGS, BUT A CHANGE TO FATAL INVOLVES ONLY CHANGEING THE
; MACRO TO "$KILL" AND CHANGING X$$CNF+1 TO JRST RSTRT1
;
; RETURNS- ALWAYS CPOPJ
;
CHKCNF:
PUSH P,B ;SAVE AC B, IT HAS ARG
PUSHJ P,FRED ;FIND FIRST REFERENCE
JRST T1POPJ ;CLEAN STACK AND RETURN
JRST CHKCN2 ;FOUND REFERENCE, SO PROCESS
CHKCN1:
PUSHJ P,FREDN ;HERE TO FIND NEXT REFERENCE
JRST T1POPJ ;TO RETURN WITH PDL PHASE CORRECT
CHKCN2:
SKIPL 0(P) ;WAS ARG 1B1?
JRST CHKCN3 ;NO,SO EDIT IS BEING REMOVED
JUMPL C,CHKCN1 ;NO CONFLICT IS TB$AES WAS 1B1
MOVEI N,[ASCIZ/Insertion of edit /] ;ERROR MESSAGE
JRST CHKCN4 ;USE COMMON ERROR MESSAGE
CHKCN3:
JUMPE C,CHKCN1 ;IS THERE A COMMON CONFLICT?
MOVEI N,[ASCIZ/Removal of edit /]
CHKCN4:
$WARN(CNF,,N$STRG,$MORE) ;GIVE THE APPROPRIATE WARNING
MOVE T1,A ;GIVE EDIT NAME
PUSHJ P,.TSIXN##
CAMN T1,CUREDT ;IS THIS EDIT CURRENT EDIT?
JRST CHKC4A ;YES,DONT SAY WHO THEN
MOVEI T1,[ASCIZ / by edit /]
PUSHJ P,.TSTRG## ;SAY WHAT EDIT DOES THIS
MOVE T1,CUREDT ;ITS THE CURRENT EDIT
PUSHJ P,.TSIXN##
CHKC4A:
MOVEI T1,[ASCIZ/ conflicts with edit /]
PUSHJ P,.TSTRG## ;
MOVE T1,D ;GIVE REFERENCE EDIT NAME
PUSHJ P,.TSIXN## ;
X$$CNF: PUSHJ P,.TCRLF##
JRST CHKCN1 ;SEE IF MORE CONFLICTS
; /FRED/ - ROUTINE TO FIND FIRST REFERENCE TO A SPECIFIC EDIT
; /FREDN/- ROUTINE TO FIND NEXT REFERENCE TO A SPECIFIC EDIT
; THESE ROUTINES ARE USED TO FIND , IN THE TRACE
; BLOCKS OF THE MODULE IN CORE, ALL REFERENCES TO A SPEFICIC
; EDIT. FRED IS USED TO FIND THE FIRST SUCH REFERENCE AND
; SUCCESSIVE CALLS ARE TO FREDN TO FIND ANY OTHERS.
;
; INPUTS- AC A SHOULD CONTAIN A SIXBIT EDIT NAME,
; /FRED/ - ROUTINE TO FIND FIRST REFERENCE TO A SPECIFIC EDIT
; /FREDN/- ROUTINE TO FIND NEXT REFERENCE TO A SPECIFIC EDIT
; THESE ROUTINES ARE USED TO FIND , IN THE TRACE
; BLOCKS OF THE MODULE IN CORE, ALL REFERENCES TO A SPEFICIC
; EDIT. FRED IS USED TO FIND THE FIRST SUCH REFERENCE AND
; SUCCESSIVE CALLS ARE TO FREDN TO FIND ANY OTHERS.
;
; INPUTS- AC A SHOULD CONTAIN A SIXBIT EDIT NAME, REFERENCE TO IT
; ARE WHAT TO LOOK FOR.
;
; OUTPUTS- AC A IS PRESERVED.
; AC B CONTAINS THE ADDRESS OF THE TRACE BLOCK IN WHICH THE
; REFERENCE WAS FOUND.
; AC C CONTAINS THE STATUS WORD (TB$AES) OF THE ASSOCIATED
; EDIT PAIR OF THE REFERENCE.
; AC D CONTAINS THE SIXBIT NAME OF THE EDIT THAT REFERS
; TO THE EDIT IN AC A.
;
; RETURNS- CPOPJ=NO REFERENCE FOUND OR ALL REFERENCES EXHAUSTED
; CPOPJ1 MEANS THAT THE ACS ARE SET UP WITH A REFERENCE.
;
;
FRED:
MOVE T,ETBLOC ;LOAD T WITH FIRST PART SEARCH END
SKIPN B,STBLOC ;ANY TRACE BLOCKS?
JRST FRED4 ;NO, SEARCH ADDED BLOCKS
FRED1:
MOVE C,TB$STA(B) ;GET IF ACTIVE WORD
JUMPE C,FRED3 ;IF NOT ACTIVE,IGNORE IT
HLRZ C,TB$LEN(B) ;GET THE VARIABLE AREA LENGTH
JUMPE C,FRED3 ;IF NO ASSOCIATED EDITS,SKIP BLOCK
MOVEI D,TB$VAR(B) ;START OF ASSOC EDIT AREA
FRED2:
MOVE T1,0(D) ;GET AN A.E. NAME
CAMN T1,A ;SAME?
JRST [ MOVEM B,SAVEB ;SAVE ACS B-D FOR FREDN
MOVEM C,SAVEC ;
MOVEM D,SAVED ;
MOVE C, 1(D) ;LOAD WITH STATUS
MOVE D,TB$EDT(B) ;LOAD D WITH EDIT NAME
JRST CPOPJ1 ] ;TAKE GOOD RETURN
FRED2A:
SOJLE C,FRED3 ;ANY MORE A.E.S THIS BLOCK?
ADDI D,AESIZ ;YES,GET NEXT
JRST FRED2 ;
FRED3:
PUSH P,A ;SAVE A,B
PUSH P,B ;OVER CALL TO COUNT
MOVE A,TB$HED(B) ;GET HEADER
PUSHJ P,COUNT ;AND COUNT WORDS TO SKIP
ADD B,0(P) ;
AOS B
POP P,A
POP P,A ;CLEAR STACK,RESTORE A
CAMG B,T ;ARE WE DONE?
JRST FRED1 ;NO,SO EXAMINE THIS BLOCK
FRED4:
CAMN T,ETBLOC ;END OF ORIG TRACE CODE?
SKIPN T,TRCPTR ;AND HAVE NEW TRACE CODE?
POPJ P, ;NO,WE ARE DONE.
MOVEI B,TRCBLK ;LOAD B WITH ADDRESS OF NEW STUFF
SUBI T,2 ;ADJUST POINTER
CAMLE B,T ;IS ONLY NEW T.B. CURRENT T.B.?
POPJ P, ;YES,SO DONT EXAMINE IT
JRST FRED1 ;NO, PROCESS IT
;ALTERNATE ENTRY FOR NEXT EDIT
FREDN:
MOVE B,SAVEB ;RESTORE B-D
MOVE C,SAVEC
MOVE D,SAVED
JRST FRED2A ;CONTINUE
SUBTTL END OF CONDITIONAL (IFN FTBPT)
> ;NFI FTBPT
SUBTTL MAKLIB IO SUBROUTINES
;ROUTINES TO COPY FILES, COPY UP TO A GIVEN PROGRAM IN A FILE
;AND TO FIND A GIVEN PROGRAM IN A FILE AND COPY IT.
;THE COPY ROUTINE WILL COPY BINARY PROGRAMS FROM WHEREVER THE
;INPUT DEVICE HAPPENS TO BE WHEN IT IS CALLED, UP TO THE
;END OF FILE. SINCE COPY IS CALLED WITH A PUSHJ, THE END-OF-
;FILE EXIT IN INGET WILL EXIT TO THE PLACE THAT CALLED COPY.
COPY: PUSHJ P, READ ;READ A PROGRAM
POPJ P, ;EXIT WHEN ALL THROUGH FILE
PUSHJ P, WRITE ;WRITE OUT THE PROGRAM
JRST COPY ;RETURN FOR MORE PROGRAMS
;THE COPYTO ROUTINE WILL READ AND WRITE PROGRAMS FROM THE
;INPUT DEVICE UNTIL THE PROGRAM WHOSE NAME IS IN ACCUMULATOR
;R IS FOUND, AT WHICH TIME IT EXITS
COPYTO:
PUSHJ P,RAD50 ;CHANGE NAME TO RADIX 50
COPYT1:
PUSHJ P, READ ;READ A PROGRAM
JRST MNFERR ;EOF - MODULE NOT FOUND ERROR
CAMN R, A ;IS IT THE CORRECT PROGRAM?
POPJ P, ;YES, EXIT
PUSHJ P, WRITE ;NO, WRITE IT OUT
JRST COPYT1 ;READ SOME MORE PROGRAMS
;THE FINDCP ROUTINE WILL SEARCH THE INPUT FILE FOR A PROGRAM
;WHOSE NAME IS IN ACCUMULATOR R, AND HAVING FOUND IT, WILL
;WRITE IT OUT. IF THE CONTENTS OF AC R ARE ZERO, THE ENTIRE
;FILE IS COPIED.
FINDCP: JUMPE R, COPY ;COPY ENTIRE FILE?
PUSHJ P,RAD50 ;CONVERT NAME TO RADIX 50
FIND1: PUSHJ P, READ ;READ A PROGRAM FROM INPUT FILE
JRST MNFERR ;EOF, TRY REWINDING AND TRYING AGAIN
CAME R, A ;IS THIS THE RIGHT ONE?
JRST FIND1 ;NO, TRY AGAIN
JRST WRITE ;YES, WRITE IT OUT AND EXIT
;ROUTINE MSTGET RETRIEVES A PROGRAM NAME FROM THE MASTER
;DEVICE SPECIFICATIONS. IT SAVES THE POINTER IN FILBUF,
;CHANGES IT TO POINT TO ITS OWN BLOCK, THEN CALLS GETDEV
MSTGET:
MOVE FPT, INBEG ;GET THE POINTER TO CURRENT FILE
MOVEI IOC,MIN ;SET FOR INPUT ON MASTER CHANNEL
JRST GETDEV ;CALL COMMON ROUTINE
;ROUTINE TRNGET RETRIEVES A PROGRAM NAME FROM THE TRANSACTION
;FILES. IT RESETS THE POINTER THAT MSTGET WIPED OUT, AND CALLS
;THE COMMON PROGRAM RETRIEVAL PROGRAM GETDEV.
TRNGET:
MOVE FPT, WLDTMP ;GET SAVED POINTER
CAMN FPT,INBEG ;IS THIS REALLY THE MASTER FILE?
JRST CPOPJ ;YES-LOSE NOW
MOVEI IOC,TRIN ;INPUT ON TRANSACTION CHANNEL
JRST GETDEV ;CALL COMMON ROUTINE
GETDEV:
DPB IOC,[POINT 4,INGET2,12] ;STORE CHAN NR. FOR IN UUO
DPB IOC,[POINT 4,INGET3,12] ;AND FOR STATUS READING UUO
MOVEI T,MBUF+1 ;START WITH MASTER FILE BUFFER
CAIE IOC,MIN ;IS IT REALLY MASTER?
MOVEI T,TBUF+1 ;NO,ITS TRANSACTION
MOVEM T,IBUF1 ;STORE LOCATION OF INPUT BYTE POINTER
AOS T
MOVEM T,IBUF2 ;AND CURRENT BYTE COUNTER TOO.
SETZ R, ;IN CASE OF NO PROGRAM NAMES
HLRZ T2,.FXLEN(FPT) ;GET COUNT OF PROG NAMES
JUMPE T2,CPOPJ1 ;RETURN WITH R=0 IF NONE
CAIN IOC,TRIN ;DID WE COME HERE FROM TRNGET?
JRST GET1 ;YES SO USE DIFFERENT COUNTER
CAMG T2,NAMCTR ;ANY MORE NAMES TO RETURN?
POPJ P, ;NO MORE
MOVEI T2,.FXPRG(FPT) ;GET POINTER TO BASE OF NAMES
ADD T2,NAMCTR ;INDEX TO CURRENT NAME
MOVE R,(T2) ;RETURN NAME IN R
AOS NAMCTR ;INCREMENT COUNTER
JRST CPOPJ1 ;GOOD RETURN
GET1:
CAMG T2,TNMCTR ;MORE TRANS NAMES TO RETURN?
PUSHJ P,GET2 ;MAYBE SOME IN ANOTHER FILE
MOVEI T2,.FXPRG(FPT) ;GET POINTER TO BASE OF TRN NAMES
ADD T2,TNMCTR ;INDEX TO CURRENT NAME
MOVE R,(T2) ;RETURN THE NAME IN R
AOS TNMCTR ;INCREMENT THE COUNTER
JRST CPOPJ1 ;SKIP RETURN
GET2:
CAMN FPT,INEND ;ARE THERE MORE TRANS FILES?
JRST POPOUT ;NO MORE--NON SKIP RETURN
PUSHJ P,TRNCLS ;CLOSE CURRENT TRANS FILE
MOVE T1,[4,,[INBEG,,INEND
OPNBLK,,LKPBLK
FSSIZE,,.RBSIZ+1
WLDTMP+1B0]]
PUSHJ P,.LKWLD## ;WILD LOOKUP FOR NEXT TRANS FILE
JFCL
SETZM TNMCTR ;CLEAR COUNTER
MOVX T1,.IOBIN ;BINARY INPUT
IORM T1,OPNBLK+.OPMOD
MOVEI T1,TBUF ;BUFFER HEADER POINTER
MOVEM T1,OPNBLK+2 ;PUT THIS STUFF IN THE OPEN BLOCK
OPEN TRIN,OPNBLK ;OPEN A NEW TRANS FILE CHANNEL
JRST OPNFAI
LOOKUP TRIN,LKPBLK ;LOOKUP THE NEW TRANS FILE
JRST LKPFAI ;LOOKUP FAILED
INBUF TRIN, ;SET UP BUFFER
MOVE FPT,WLDTMP ;SET UP FILE POINTER
JRST CPOPJ ;GO BACK TO GETDEV CODE
CPOPJ1: AOSA (P) ;GOOD RETURN
POPOUT: POP P,(P) ;POP UP ONE LEVEL
CPOPJ: POPJ P, ;EXIT
SUBTTL ROUTINE TO INPUT ONE PROGRAM AT A TIME
;THE FIRST WORD THAT THE PROGRAM READS WILL BE A BLOCK HEADER.
;BLOCKS ARE READ UNTIL AN ENTRY BLOCK IS FOUND, AND THE ENTIRE
;ENTRY BLOCK IS STORED IN AN INTERNAL BUFFER,SIZE PERMITTING.
;FOLLOWING THAT, THE NAME BLOCK IS READ, AND THE NAME OF THE
;PROGRAM IS RETURNED IN ACCUMULATOR A. PROVISION IS MADE FOR
;BLOCKS OF WORD COUNT ZERO. THE SECTION OF CODING AROUND READ2
;DELIBERATELY OMITS THIS CHECK IN ORDER TO READ IN THE NEXT
;BLOCK HEADER WITH A MINIMUM OF INSTRUCTIONS. ORDINARILY, EACH
;PROGRAM WILL BEGIN WITH AN ENTRY BLOCK, BUT THE ROUTINE WILL
;ALSO ALLOW THE PROGRAM TO BEGIN WITH A NAME BLOCK IF NO
;ENTRY BLOCK IS SEEN.
READ: MOVEI C,ENTBLK ;SET UP POINTER TO BUFFER
READ1: PUSHJ P,GETIN ;GET A BLOCK HEADER
HLRZ B, A ;GET THE BLOCK CODE
CAILE B,3777 ;IS IT ASCIZ TEXT BLOCK?
JRST READ17 ;YES,HANDLE IT DIFFERENTLY
MOVSI T,-BLKTYL ;MAKE UP AOBJN POINTER
READ2B: CAMN B,BLKTYP(T) ;SEARCH THE TABLE OF BLOCKTYPES AND COMPARE
JRST @RTABLE(T) ;FOUND A MATCH--GO PROCESS IT
AOBJN T,READ2B ;NOT END YET--KEEP SEARCHING
CAIG B,37 ;TEST FOR LEGAL BLOCKTYPES
JRST READ2D ; THESE ARE CLEARLY LEGAL
CAIL B,1000 ;IF 1000-1777 ALSO LEGAL
CAILE B,1777 ;NEW TYPES
JRST IBTERR ;ELSE ITS AN ERROR
READ2D:
PUSHJ P, COUNT ;CALCULATE SIZE OF BLOCK
JUMPE B, READ1 ;WORD COUNT OF ZERO?
READ2:
CAML B,@IBUF2 ;DOES BLOCK OVERLAP IO BUFFERS?
JRST READ3 ;ADJUST B AND GET ANOTHER BUFFER
MOVE A,@IBUF2 ;NO, DIDDLE BUFFER HEADER COUNT
SUB A, B ;ELIMINATE BLOCK OF LENGTH C(B)
MOVEM A,@IBUF2 ;PUT NEW WORD COUNT BACK
ADDM B,@IBUF1 ;MOVE BYTE POINTER PAST BLOCK
JRST READ1 ;GET NEXT BLOCK
READ3: SUB B,@IBUF2 ;ACCOUNT FOR REST OF THIS BUFFER
SETZM @IBUF2 ;FORCE ANOTHER BUFFER
PUSHJ P,GETIN ;GET ANOTHER BUFFER OF INPUT
JRST READ2 ;CHECK AGAIN
;CODE MODIFIED TO HANDLE MORE THAN ONE ENTRY BLOCK.
;FAIL AND SAIL BOTH ISSUE MULTIPLE ENTRY BLOCKS.
SIZZ==SIZE-<<SIZE+21>/22>-4 ;ACCOUNT FOR HDR BLKS, RELOC WDRS, PROGNAME
READ4: SETZM ENTBLK ;SAME AS (C) AT PRESENT
HRLI C,-1 ;AOBJN WILL OVERFLOW FIRST TIME
TRNE A,-1 ;TEST FOR ZERO WORD COUNT
JRST READ5 ;NO
PUSHJ P,GETIN ;YES, THROW AWAY RELOCATION WORD
ADDI C,1 ;UPDATE INSERT COUNTER
SETZB A,(C) ;ENTRY BLOCK RELOCATION IS ALWAYS ZERO
;BACK HERE FOR EACH NEW BLOCK
READ5: MOVNI B,400000(A) ;-1 IN LH, 377777-CT IN RH
HRRZS A
ADD A,ENTBLK ;NEW COUNT IF IT FITS
CAILE A,SIZZ ;TOO MUCH NOW?
TXOA F,ERRB ;YES, MARK ENTRY BLOCK TOO BIG
MOVEM A,ENTBLK ;NO, UPDATE USED COUNT
;HERE FOR EACH NEW WORD
READ6: TRNN B,377777 ;END OF LOADER BLOCK?
JRST READ8 ;YES, CHECK NEXT
AOBJN B,NXTWRD ;TIME FOR SOME RELOC BITS?
PUSHJ P,GETIN ;YES, GET THEN AND TOSS THEM AWAY
HRLI B,-22 ;AND RESET COUNT
NXTWRD: PUSHJ P,GETIN ;GET A DATA WORD
;ROUTINE TAKEN FROM LOADER
AOBJN C,READ7 ;NEED TO INSERT RELOC WORD?
TXNN F,ERRB ;YES, UNLESS NOT INSERTING
SETZM (C) ;ALL ENTRY RELOCS ARE 0
ADD C,[-22,,1] ;LH 0 BEFORE ADD, SET UP NEXT
READ7: TXNN F,ERRB ;ARE WE INSERTING?
MOVEM A,(C) ;YES, PUT IT AWAY
JRST READ6 ;LOOP
READ8: PUSHJ P,GETIN ;GET NEXT HEADER WORD
HLRZ B,A ;TYPE
CAIN B,4 ;ANOTHER ENTRY?
JRST READ5 ;YES, STORE IT
;PROGRAM NAME - FINISH ENTRY OUT
MOVEI B,4 ;ENTRY BLOCK TYPE
HRLM B,ENTBLK ;NOW CORRECT TYPE,,COUNT
HRLI C,0 ;CLEAR LH COUNT
AOJA C,READ9 ;STORE NAME BLOCK HEADER AND CONTINUE
READ9: MOVEM A, (C) ;STORE NAME BLOCK HEADER
ADDI C,1
PUSHJ P, COUNT ;CALCULATE SIZE OF BLOCK
JUMPE B, READ13 ;WORD COUNT OF ZERO?
READ11: PUSHJ P,GETIN ;GET A WORD
MOVEM A, (C) ;STORE IT
AOJ C, ;INCREMENT BUFFER POINTER
SOJG B, READ11 ;DONE READING YET?
SKIPE CNTCWF ;DID COUNT CATCH A COMMON WORD?
MOVE A, -2(C) ;GET PROGRAM NAME IN A
JUMPE A, READ13 ;IGNORE WORD OF ZERO
MOVE B, A ;GET RID OF EXTRA BLANKS
PUSH P,B+1 ;SAVE C
READ12:
IDIVI B, 50 ;TRY DIVIDING IT BY 50
JUMPN B+1, REA13A ;FILTERED OUT ALL THE BLANKS?
MOVE A, B ;NO, STORE SYMBOL AGAIN
JRST READ12 ;TRY ANOTHER DIVISION
REA13A:
POP P,B+1 ;RESTORE C
READ13: TXNN F, ERRB ;ERROR CONDITION?
JRST RD13B ;NO
MOVE N,A ;SET UP FOR PRINT OUT
$KILL(ETL,ENTRY block is too large to read in for module,N$50)
RD13B:
TXNN F,XFLG ;INDEX FLAG ON?
JRST CPOPJ1 ;NO, SKIP EXIT
JRST INDEX1 ;YES SAVE ENTRIES
READ14: TXO F,F4IB ;DONT OUTPUT DURING F4 SEARCH
PUSH P,C ;SAVE ENTRY BLOCK
PUSHJ P,F4 ;PASS F4 BLOCKS
POP P,C ;RESTORE ENTRY BLOCK
TXZ F,F4IB ;TURN OFF IGNORE BIT
HRRZM C,END1 ;FORTRAN CANNOT DO ANY BETTER
SETZM END2 ;CLEAR FIRST TIME FLAG
JRST READ1 ;GO PROCESS NEXT PROGRAM
READ15: PUSHJ P,COUNT ;GET SIZE OF BLOCK
SETZM END1 ;CLEAR STORAGE
SETZM END2
SOJE B,READ1 ;SHOULD N'T BE
PUSHJ P,GETIN ;GET RID OF BYTE WORD
PUSHJ P,GETIN ;GET FIRST END WORD
HRLZM A,END1 ;STORE IT
SOJE B,READ1 ;ONLY ONE WORD?
PUSHJ P,GETIN ;NO
HRLZM A,END2 ;STORE 2ND
SOJE B,READ1 ;SHOULD BE END
JRST READ2 ;JUST IN CASE
READ16: TXOE F,NOWARN ;DO WE WANT A MESSAGE?
JRST RD16B ;SKIP MESSAGE
$WARN(NIO,OUTPUT file ,,$MORE)
;**[17] READ16+3 ILG 7-APR-76
MOVEI T1,BCKBLK ;[17]POINT TO SAVED OUTPUT SPEC
MOVEI T2,BCKBLK+3 ;[17]T1/OPEN INFO T2/FILE INFO
PUSHJ P,.TOLEB## ;[17]AND TELL USER
MOVEI T1,[ASCIZ " will not be INDEXed"]
PUSHJ P,.TSTRG## ;OUTPUT REST OF LINE
X$$NIO: PUSHJ P,.TCRLF## ;FINISH MESSAGE
TXZ F,FOTTY ;NO MORE FORCED IO TO TELETYPE
RD16B:
SETZM @IBUF2 ;FORCE NEXT BUFFER
PUSHJ P,GETIN ;INPUT THE NEXT BLOCK
JRST READ1+1 ;AND RETURN TO CODE
READ17:
ANDI A,177 ;GET RID OF ALL BUT LAST BYTE
JUMPE A,READ1 ;IF STRING EXHAUSTED,GET NEXT BLOCK
PUSHJ P,GETIN ;ELSE GET THE NEXT BYTE
JRST READ17 ;AND REPEAT LOOP
;BLKTYP IS A TABLE OF LEGAL BLOCKTYPES RECOGNIZED BY FUDGE.
;WHEN A MATCH BETWEEN THE CODE IN THE LEFT HALF OF THE BLOCK
;HEADER AND A VALUE IN THE TABLE IS FOUND THE
;CORRESPONDING PART OF THE READ ROUTINE IS JUMPED TO.
;RTABLE IS A TABLE OF LABELS FOR THE APPROPRIATE SECTIONS OF CODE
;IN THE READ ROUTINE. THESE SECTIONS OF CODE ARE ACCESSED BY A
;JRST @RTABLE(T) WHERE T IS USED AS AN INDEX.
BLKTYP:
EXP 14 ;INDEX BLOCK
EXP 4 ;ENTRY BLOCK
EXP 1001 ;ENTRY BLOCK
EXP 1002 ;LONG ENTRY BLOCK
EXP 6 ;NAME BLOCK
EXP 1003 ;NAME BLOCK
EXP 401 ;SPECIAL MANTIS(F40)DEBUGGER
EXP 400 ;FORTRAN 4 SIGNAL WORD
EXP 5 ;END BLOCK
EXP 1040 ;END BLOCK
BLKTYL== .-BLKTYP ; TABLE LENGTH
RTABLE:
READ16
READ4
READ4
READ4
READ9
READ9
READ14
READ14
READ15
READ15
SUBTTL ROUTINE TO OUTPUT ONE PROGRAM AT A TIME
;THE WRITE SUBROUTINE WILL OUTPUT AN ENTIRE BINARY RE-
;LOCATABLE PROGRAM AS WRITTEN BY MACRO6. IT ASSUMES THAT THE
;ENTRY BLOCK AND NAME BLOCK FOR THE PROGRAM ARE IN THE
;INTERNAL BUFFER ENTBLK, AND OUTPUTS THESE BEFORE PICKING UP
;MORE BLOCKS FROM THE CURRENT INPUT DEVICE. BLOCKS ARE READ
;AND WRITTEN UNTIL THE END BLOCK HAS BEEN PROCESSED. PROVISION I
;IS MADE FOR BLOCKS WITH A WORD COUNT OF ZERO.
WRITE: SUBI C, ENTBLK ;GET COUNT OF ENTRY BLOCK
JUMPE C, WRITE3 ;NOTHING TO OUTPUT?
MOVEI B, ENTBLK ;GET A POINTER IN B
WRITE2: MOVE T1, (B) ;GET A BINARY WORD
PUSHJ P, BOUT ;OUTPUT IT
AOJ B, ;INCREMENT POINTER
SOJG C, WRITE2 ;KEEP GOING UNTIL BUFFER EMPTY
WRITE3: PUSHJ P,GETIN ;GET A BLOCK HEADER
HLRZ B,A ;GET THE BLOCK TYPE CODE
TXNN F,NOLOCB ;DELETE LOCAL SYMBOLS?
JRST .+3 ;NO
CAIN B,2 ;IS IT A SYMBOL BLOCK?
JRST DELLOC ;GO DELETE LOCAL SYMBOL
;COME BACK TO WRITE3
;UNLESS EXIT ON END-OF-FILE
MOVE T1,A
PUSHJ P,BOUT ;OUTPUT IT
CAIE B, 401 ;SPECIAL MANTIS F4?
CAIN B, 400 ;IS THIS A FORTRAN IV SIGNAL WORD?
JRST F4 ;YES, PROCESS F4 OUTPUT
CAILE B,3777 ;IS THIS ASCIZ TEXT?
JRST WRITE5 ;YES,HANDLE SPECIALLY
MOVEM B, SAVEBT ;SAVE THE BLOCK TYPE
PUSHJ P, COUNT ;NO, GET SIZE OF BLOCK
JUMPE B, WRITE3 ;WORD COUNT OF ZERO?
WRITE4: PUSHJ P,GETIN ;OUTPUT THE BLOCK
MOVE T1,A
PUSHJ P, BOUT ;...
SOJG B, WRITE4 ;LOOP BACK UNTIL DONE
MOVE A, SAVEBT ;RETRIEVE THE BLOCK TYPE
CAIE A,1040 ;WAS IT AN END BLOCK?
CAIN A, 5 ;WAS IT AN END BLOCK?
POPJ P, ;EXIT
JRST WRITE3 ;NO, RETURN FOR MORE BLOCKS
WRITE5:
ANDI A,177 ;DISCARD ALL BUT LAST BYTE
JUMPE A,WRITE3 ;IF NULL, WE ARE DONE
PUSHJ P,GETIN ;ELSE GET NEXT WORD
MOVE T1,A ;AND THEN WRITE
PUSHJ P,BOUT ;IT OUT ,THEN REPEAT
JRST WRITE5 ;LOOP
; /COUNT/ - THIS ROUTINE CALCULATES THE LENGTH OF THE VARIOUS BLOCKS
; USED BY THE TRANSLATORS. THE ROUTINE ESSENTIALLY JUST RETURNS
; THE CONTENTS OF THE RIGHT HALF OF THE HEADER WORD FOR
; NEW LINK ITEM TYPES (1000-3777) AND RETURNS A COUNT ADJUSTED FOR
; HIDDEN RELOCATION WORDS FOR OLD LINK ITEM TYPES (0-777).
;
; INPUT- AC A SHOULD CONTAIN THE CONTENTS OF THE
; BLOCK HEADER WORD
;
; OUTPUT- AC B WILL CONTAIN THE POSITIVE NUMBER OF
; WORDS THAT FOLLOW THE BLOCK HEADER WORD.
;
COUNT:
PUSH P,T1 ;SAVE T1
PUSH P,T2 ;AND T2
HLRZ T1,A ;GET TYPE CODE
CAILE T1,3777 ;IN RANGE OF REASON?
$STPCD(Attempt to compute length of ASCIZ text block)
CAIL T1,1000 ;IS THIS NEW LINK TYPE?
JRST [HRRZ B,A ;YES,JUST GET COUNT
JRST T2POPJ] ;AND CLEAN UP,RETURN
HRRZ T1, A ;GET NUMBER OF WORDS
IDIVI T1, 22 ;1SUBHEADER/18 DATA WORDS
ADDI T1,(A) ;ADD INTO WORD COUNT
JUMPE T2,.+2 ;1 EXTRA SUBHEADER FOR
AOJ T1, ;STRAY ONES
SETZM CNTCWF ;FLAG FOR READ 11 SET WHEN REM IS 2
CAIN T2,2 ;SO WE KNOW HOW LONG NAME WAS
SETOM CNTCWF ;
MOVE B, T1 ;RESULTS IN AC B
T2POPJ: POP P,T2
T1POPJ: POP P,T1
POPJ P, ;EXIT
SUBTTL ROUTINE TO HANDLE FORTRAN OUTPUT
;SUBSECTION OF THE WRITE ROUTINE TO HANDLE OUTPUT FROM THE
;FORTRAN IV COMPILER. THE MAIN OBJECT OF THE ROUTINE IS TO
;LOOK FOR THE END BLOCK. OTHER BLOCKS ARE MERELY COPIED OUT.
;THE BLOCK TYPES ARE GIVEN BY THE FOLLOWING TABLE
;----------------------------------------------------------------
;BITS 0-17 BITS18-23 BITS 24-35 TYPE
;777777 70 N DATA STATEMENT
;777777 50 N ABSOLUTE MACHINE CODE
;777777 77 N MANTIS DATA
;777777 0 - PROGRAMMER LABELS
;777777 31 - MADE LABELS
;777777 60 - ENTRY LABELS
;777777 777776 END BLOCK
;-----------------------------------------------------------------
F4: PUSHJ P,GETIN ;GET A FORTRAN IV BLOCK HEADER
PUSHJ P, OUT4 ;OUTPUT IT
TLC A, -1 ;TURN ONES TO ZEROES IN LEFT HALF
TLNE A, -1 ;NO, WAS LEFT HALF ALL ONES?
JRST F4 ;NO, IT WAS CALCULATED MACHINE CODE
CAIN A, -2 ;YES, IS RIGHT HALF = 777776?
JRST ENDST ;YES, PROCESS F4 END BLOCK
LDB B, [POINT 6,A,23];GET CODE BITS FROM BITS 18-23
TRZ A, 770000 ;THEN WIPE THEM OUT
CAIE B, 70 ;IS IT A DATA STATEMENT?
CAIN B, 50 ;IS IT ABSOLUTE MACHINE CODE?
JRST MACHCD ;YES, TREAT IT LIKE DATA STATEMENTS
CAIN B, 77 ;SPECIAL MANTIS DEBUGGER DATA?
JRST MACHCD ;YES, TREAT IT LIKE DATA
PUSHJ P,GETIN ;NO, ITS A LABEL OF SOME SORT
PUSHJ P, OUT4 ;WHICH CONSISTS OF ONE WORD
JRST F4 ;LOOK FOR NEXT BLOCK HEADER
MACHCD: HRRZ B, A ;GET THE WORD COUNT IN AC B
PUSHJ P,GETIN ;INPUT A WORD
PUSHJ P, OUT4 ;OUTPUT IT
SOJG B, MACHCD+1 ; LOOP BACK FOR REST OF THE BLOCK
JRST F4 ;GO LOOK FOR NEXT BLOCK
ENDST: MOVEI B,1 ;TWO WORDS, FIVE TABLES, ONE WORD, ONE TABLE
MOVEI C,6 ;TO GO
F4LUP1: PUSHJ P,GETIN ;GET TABLE MEMBER
F4LUP3: PUSHJ P,OUT4 ;OUTPUT WORD
SOJGE B,F4LUP1 ;LOOP WITHIN A TABLE
JUMPL C,CPOPJ ;LAST TABLE - RETURN
SOJG C,F4LUP2 ;FIRST TWO WORDS AND FIVE TABLES
JUMPE C,F4LUP1 ;COMMON LENGTH WORD
F4LUP2: PUSHJ P,GETIN ;READ HEADER WORD
MOVE B,A ;COUNT TO COUNTER
JRST F4LUP3 ;STASH
OUT4:
MOVE T1,A ;GET WORD INTO OUTPUT POSITION
TXNN F,F4IB ;DONT DO OUTPUT?
PUSHJ P,BOUT ;YES, DO OUTPUT
POPJ P, ;RETURN
SUBTTL ROUTINE TO DELETE LOCAL SYMBOLS FROM SYMBOL BLOCK
;ALL LOCAL AND SUPPRESSED LOCAL SYMBOLS ARE DELETED
;EXTERNALS,INTERNAL AND SUPPRESSED INTERNALS ARE NOT DELETED.
DELLOC: HRRZM A,BSZ ;SIZE OF SYMBOL BBLE
PUSHJ P,DELINI ;CLEAR NEW HEADER & RELOC WORDS
;SET PB = SYMBLK+2
DELGTR: PUSHJ P,GETIN ;GET RELOCATION WORD
MOVEM A,RELOCS ;SAVE IT
MOVE A,[POINT 4,RELOCS] ;INIT POINTER TO GET
MOVEM A,PTGRS ;RELOCATION WORD
DELGT1: PUSHJ P,GETIN ;GET FIRST WORD OF PAIR
ILDB B,PTGRS ;GET RELOCATION BITS & HOLD
TXNE A,R5.LCL ;IS SYMBOL LOCAL?
JRST DELDEC ;YES, DON'T COPY
MOVEM A,0(T) ;STORE FIRST WORD
PUSHJ P,GETIN ;GET SECOND WORD INTO A
MOVEM A,1(T) ;STORE SECOND WORD
IDPB B,PTSRS ;STORE RELOCATION BITS
MOVEI A,2 ;COUNT WORDS STORED
ADDM A,SYMBLK ;I.E. UPDATE WORD COUNT
ADDI T,2 ;UPDATE NEXT LOCATION TO STORE
MOVE A,PTSRS ;HAVE WE STORED 9
TLNN A,770000 ;SYMBOL PAIRS?
PUSHJ P,DELWRT ;YES, WRITE IT OUT
JRST DELDEC+1 ;ALREADY HAVE 2ND WORD
DELDEC: PUSHJ P,GETIN ;GET SECOND WORD INTO A
SOS BSZ ;HAVE WE EXHAUSTED
SOSG BSZ ;ALL WORDS IN BLOCK?
JRST DELFIN ;YES, NONE LEFT
MOVE A,PTGRS ;HAVE WE GOT 9
TLNE A,770000 ;SYMBOL PAIRS YET?
JRST DELGT1 ;NO, GET NEXT PAIR
JRST DELGTR ;YES, GET RELOCATION
DELFIN: PUSHJ P,DELWRT ;ORIGINAL BLOCK EMPTY NOW
JRST WRITE3 ;GET NEXT BLOCK
SUBTTL ROUTINE TO WRITE OUT NEW SYMBOL TABLE
DELWRT: SKIPN A,SYMBLK ;ANYTHING TO WRITE
JRST DELINI ;NO, CAN LEAVE
HRRZ C,A ;GET WORD COUNT
HRLI A,2 ;PUT IN BLOCK TYPE
MOVE T1,A ;INTO OUTPUT POSITION
PUSHJ P,BOUT ;WRITE BLOCK HEADER
MOVEI B,SYMBLK ;LOC OF FIRST WORD
DELWRU: ADDI B,1 ;LOC OF RELOC WORD
MOVE T1,0(B) ;GET WORD
PUSHJ P,BOUT ;OUTPUT
SOJGE C,DELWRU ;ALL THROUGH?
;ROUTINE TO INITIALIZE NEW SYMBOL TABLE
DELINI: SETZM SYMBLK ;YES, CLEAR COUNT
SETZM SYMBLK+1 ;CLEAR RELOCATION
MOVE A,[POINT 4,SYMBLK+1] ;INIT POINTER
MOVEM A,PTSRS ;FOR STORING NEW RELOC
MOVEI T,SYMBLK+2 ;SET TO STORE FIRST GLOBAL
POPJ P,
SUBTTL ROUTINES TO INDEX THE LIBRARY
COMMENT * THE INDEXING OF LIBRARY FILES IS DONE IN TWO PASSES.
ON PASS 1 THE LIBRARY FILE IS COPIED AND ALL ENTRIES STORED
IN CORE ALLONG WITH A POINTER TO THE BEGINING OF THE BLOCK.
A DUMMY INDEX BLOCK (TYPE 14) IS OUTPUT AT THE BEGINING OF THE
NEW LIBRARY AND ONE IS OUTPUT WHENEVER THE CURRENT INDEX BLOCK
FILLS A BUFFER.
ON PASS 2 THE DUMMY INDEX BLOCKS ARE REPLACED BY REAL ONES.
MAKLIB USED USETO'S AND DUMP MODE.
IF THE OUTPUT DEVICE IS DTA MAKLIB USES UGETF UUO'S TO FIND
THE NEXT BLOCK AND NON-STANDARD DUMP MODE TO WRITE THE INDICES.
DESIGN AND CODING BY D.M.NIXON JULY 1970
*
INDEX0: MOVE A,INDEXH ;BLOCK HEADER
TXNE F,DTAFLG ;DTA IS 1 WORD LESS
SUBI A,1
AOS BLKCNT ;START ON BLOCK #1
MOVE T1,A
PUSHJ P,BOUT ;OUTPUT IT
OUTPUT OCHN, ;FORCE OUTPUT
MOVE T,OBUF+2 ;BUFFER SIZE
MOVEM T,XCOUNT
MOVEM T,BUFSIZ ;SAVE IT AWAY
AOS OBUF+2 ;COUNT IS OFF BY ONE BECAUSE OF OUT UUO
AOS T,.JBREL ;TO GET 1K MORE
MOVEM T,XPNTR
MOVEM T,XBEG ;START OF INDEX BUFFERS
CORE T,
JRST NECERR ;NOT ENUF CORE
MOVEI A,1 ;START ON BLOCK #1 (IF DSK)
MOVEM A,@XPNTR ;STORE FIRST BLOCK #
AOS XPNTR
MOVE A,INDEXH
MOVEM A,@XPNTR
AOS XPNTR
SOS XCOUNT
SOS XCOUNT ;RESERVE SPACE FOR NEXT LINK WORD
POPJ P, ;RETURN
;HERE ON PASS 1 TO STORE ENTRIES AND POINTERS.
INDEX1: AOS (P) ;SET SKIP RETURN
HRRZ T,ENTBLK ;GET SIZE OF BLOCK
JUMPE T,CPOPJ ;IF NO ENTRIES, JUST RETURN
MOVN A,T
ADDI T,1 ;WORD OF INFO
CAML T,XCOUNT ;ENUF ROOM IN BLOCK?
JRST NOROOM ;NO
MOVE T,ENTBLK ;GET HEADER WORD
MOVEM T,@XPNTR
AOS XPNTR
SOS XCOUNT
HRLS A
HRRI A,ENTBLK+1
INDEXA: SKIPN T,(A)
AOJA A,.-1
MOVEM T,@XPNTR
SOS XCOUNT
AOS XPNTR
AOBJN A,INDEXA
INDEX2: MOVE T,BUFSIZ
SUB T,OBUF+2
HRLI T,1(T) ;WORD COUNT IS CORRECT FOR LOADER
HRR T,BLKCNT
MOVEM T,@XPNTR
SOS XCOUNT
AOS XPNTR
POPJ P,
;HERE WHEN CURRENT INDEX BLOCK IS FULL.
NOROOM: MOVE A,INDEXH ;HEADER BLOCK OF INDEX FOR LOADER
TXNE F,DTAFLG ;DTA IS 1 WORD LESS
SUBI A,1
MOVE T1,A
PUSHJ P,BOUTGO
OUTPUT OCHN,
AOS OBUF+2 ;COUNT IS OUT BY ONE BECAUSE OF OUTPUT UUO
MOVE T,BLKCNT ;GET INDEX BLOCK #
HRROM T,@XPNTR ;STORE IT WITH -1 IN LEFT HALF
MOVE A,XCOUNT ;PART OF BLOCK NOT FILLED
ADDB A,XPNTR ;START OF NEW BLOCK
ADD A,BUFSIZ ;ENSURE NEXT BUFFER WILL FIT IN CORE
CAMG A,.JBREL ;WILL IT?
JRST .+3 ;YES
CORE A, ;GET ENOUGH CORE
JRST NECERR ;NOT ENOUGH CORE
MOVE A,BUFSIZ
MOVEM A,XCOUNT
;MARK IT AS AN INDEX INCASE BLOCK FULL
HRROM T,@XPNTR ;SAVE BLOCK # FOR PASS 2
AOS XPNTR
TXNN F,DTAFLG ;NOT IF DTA
AOS BLKCNT ;ONE FOR OUTPUT
MOVE A,INDEXH
TXNE F,DTAFLG ;DTA IS 1 WORD LESS
SUBI A,1
MOVEM A,@XPNTR
AOS XPNTR
SOS XCOUNT
SOS XCOUNT ;SPACE FOR LINK WORD TO NEXT INDEX
JRST INDEX1+1
;HERE FOR PASS 2. WRITE OUT THE INDEX BLOCKS
INDEX3: SETOM @XPNTR ;TERMINATE WITH END OF INDEX MARKER
OUTPUT OCHN, ;SO LAST BLOCK IS WRITTEN
TXNE F,DTAFLG ;IS IT DTA?
JRST INDEX5 ;YES, TREAT DIFFERENTLY
SETSTS OCHN,16
MOVNI A,200
HRLM A,XBEG
INDEX4: SETZM XBEG+1
MOVE A,@XBEG
USETO OCHN,(A)
OUTPUT OCHN,XBEG
STATZ OCHN,760000
JRST FSOERR ;FILE STATUS ERROR
MOVEI A,200
ADDB A,XBEG
HRRZS A
CAMG A,XPNTR
JRST INDEX4
JRST RSTRT
INDEX5: CLOSE OCHN, ;AND A SEPARATE EOF BLOCK
SETSTS OCHN,116 ;NON STANDARD MODE
MOVNI A,200 ;IOWD COUNT
HRLM A,XBEG ;SET IT UP FOR OUTPUT
USETI OCHN,@BLKCNT ;SET ON LAST BLOCK
INPUT OCHN,DIRIOW ;READ IT IN
LDB A,[POINT 10,DIRBLK,27] ;GET FIRST BLOCK #
HRRM A,@XBEG ;STORE IT FOR COMMON LOOP
SETZM XBEG+1 ;MAKE SURE IT'S ZERO
INDEX6: MOVE A,@XBEG ;GET BLOCK NUMBER
USETI OCHN,(A) ;SET FOR INPUT
INPUT OCHN,DIRIOW ;INPUT BLOCK
MOVE T,DIRBLK ;TO FIND LINK WORD
EXCH T,@XBEG ;PUT IT IN OUTPUT BLOCK
SOS XBEG ;BACK UP POINTER
USETO OCHN,(A) ;NOW FOR OUTPUT
OUTPUT OCHN,XBEG ;OUT IT GOES
STATZ OCHN,760000 ;UNLESS IN ERROR
JRST FSOERR ;FILE STATUS ERROR
MOVEI A,200 ;GET TO NEXT DUMP BLOCK
ADDB A,XBEG ;ADVANCE POINTER
HRRZS A ;JUST WORD LOCATION
CAMG A,XPNTR ;ALL DONE?
JRST INDEX6 ;NO, LOOP
SETSTS OCHN,16 ;BACK TO STANDARD MODE TO UPDATE DIR.
JRST RSTRT ;YES, FINISH UP
INDEXH: XWD 14,177 ;USED TO SIGNAL INDEX BLOCK TO LOADER
SUBTTL INPUT SERVICE ROUTINE
;THE INPUT ROUTINE GETS CHARACTERS FROM THE DEVICE WHOSE
;CHANNEL NUMBER IS IN ACCUMULATOR D. IT CALCULATES THE POSITION
;OF THE BUFFER HEADER OF THE DEVICE, THEN EITHER LOADS AC A
;FROM THE BYTE POINTER, OR DOES AN INPUT. IF AN END OF FILE
;IS FOUND, THE ROUTINE EXITS WITH A POPJ, SINCE THE READ ROUTINE
;IS CALLED WITH A PUSHJ, FOLLOWED BY AN EOF RETURN. THE NORMAL
;EXIT FROM GETIN IS BY A JRST @GETIN.
GETIN: SOSG @IBUF2 ;IS APPROPRIATE BUFFER EMPTY?
JRST INGET2 ;YES, GET ANOTHER BUFFER
GETIN1: ILDB A,@IBUF1 ;LOAD AC A WITH A CHARACTER
POPJ P,
; /BOUT/ - ROUTINE TO TAKE A BYTE FROM AC T1 AND PLACE IT
; IN THE CHANNEL OCHN. THE MODE IS PREDETERMINED AT
; OPEN TIME. THIS ROUTINE IS USED FOR BOTH ASCII AND BINARY
; OUTPUT.
;
BOUT:
TXNE F,FOTTY ;IS SCAN IN COMMAND OF THE OUTPUT?
JRST [ OUTCHR T1 ;YES,DO TTCALL AND RETURN
POPJ P,] ;
SOSG OBUF+2 ;IS THERE ROOM IN THE BUFFER?
JRST BOUTGO ;NO,SO OUTPUT BUFFER
BOUT1: IDPB T1,OBUF+1 ;UNLOAD THE CHARACTER
TXNE F,DEVTTY ;IF OUTPUT IS TO TTY
CAIE T1,12 ;AND THIS IS LINEFEED
POPJ P, ;BUT ITS NOT,SO RETURN
OUTPUT OCHN, ;OUTPUT BUFFER
POPJ P, ;AND RETURN
BOUTGO: ;HERE TO UNLOAD BUFFER
TXNN F,XFLG ;CURRENTLY INDEXING?
JRST BOUTG1 ;NO,SKIP THIS
TXNN F,DTAFLG ;IF INDEXING TO DSK
AOSA BLKCNT ;INCREMENT COUNT, BUT FOR DECTAPE
UGETF OCHN,BLKCNT ;GET NEXT FREE BLOCK
BOUTG1:
OUT OCHN, ;OUTPUT THE BUFFER
JRST BOUT1 ;DO UNLOAD THE CHARACTER/BYTE
JRST FSOERR ;SOME SORT OF ERROR ON THAT OUTPUT
SUBTTL GO UNDER IFN FTBPT CONDITIONAL THAT LASTS FOR MANY PAGES
IFN FTBPT,<
SUBTTL ROUTINES TO INITIALIZE THE AREAS FOR NEW CODE,SYMBOLS AND TRACE
; /PATSET/ - SET UP POINTER TO PATCH CODE AREA
; /CRESET/- SET UP POINTER TO CREATED SYMBOL AREA
;
; THESE ROUTINES GRAB APPROPRIATE AMOUNTS OF FREE CORE AND ALLOCATE
; THEM FOR THE PURPOSE OF CREATING NEW LINK BLOCKS.
; THE POINTERS SET UP ARE THE ANCHOR (BEGINNING), THE POINTER (INITED TO
; BE SAME AS ANCHOR) AND THE END (LAST WORD IN AVAILABLE BLOCK).
;
;
PATSET:
PUSH P,T1 ;SAVE TEMP
MOVEI T1,PATMAX+<3*<PATMAX/^D17>> ;ACCOUNT FOR HD,RELOC,S.A.
PUSHJ P,GETCOR ;ALLOCATE THE CORE
MOVEM T1,PATCOD ;STARTING LOCATION
MOVEM T1,PATPTR ;INITIAL POINTER
MOVE T1,.JBFF## ;ENDING LOCATION IS FIRST FREE-1
SOS T1
MOVEM T1,PATLST ;STORE IT AWAY
PJRST T1POPJ ;RETURN,RESTORING T1
CRESET:
PUSH P,T1 ;SAVE T1
MOVEI T1,CREMAX*2+<2*<CREMAX/^D9>> ;2 WDS PERS SYMBOL
;ACCOUNT FOR HD,RELOC
PUSHJ P,GETCOR ;ALLOCATE THE CORE
MOVEM T1,CRESYM ;STORE START
MOVEM T1,CREPTR ;AND POINTER
MOVE T1,.JBFF##
SOS T1
MOVEM T1,CRELST ;AND LAST
PJRST T1POPJ ;RETURN,RESTORING POINTER
; /GETCOR/ - ROUTINE TO ALLOCATE FREE CORE
;
; INPUT- T1 CONTAINS THE NUMBER OF WORDS TO ALLOCATE
; OUTPUT- T1 CONTAINS THE FIRST WORD OF THE BLOCK ALLOCATED
;
; RETURNS- POPJ OR TO LABEL NECERR IF NO CORE AVAILABLE
;
GETCOR:
SKIPG T1 ;CHECK OUR ARGUMENT
$STPCD(Negative amount of core requested)
PUSH P,.JBFF## ;SAVE ORIGINAL FFREE
ADDB T1,.JBFF## ;UPDATE THE CORE MARKER
SOS T1 ;FIRST FREE CAN BE ONE GREATER THAN .JBREL
CAMLE T1,.JBREL## ;IN BOUNDS?
AOJA T1,[ CORE T1, ;NO SO ALLOCATE CORE
JRST NECERR ;NO CORE LEFT
JRST .+1] ;CONTINUE
PJRST T1POPJ ;RETURN, RESTORING T1 FROM
;ORIGINAL .JBFF
SUBTTL BIN- INPUT A BYTE IN ASCII FROM TRANSACTION FILE
;/BIN/ - ROUTINE TO GET A BYTE FROM INPUT (FIX FILE) AND LOAD
; IT INTO CC.
BIN:
SOSG TBUF+2 ;ANYTHING IN THE BUFFER
PUSHJ P,BIN2 ;NO, GET ANOTHER
ILDB CC,TBUF+1 ;LOAD BYTE
JUMPE CC,BIN ;IGNORE NULLS
POPJ P, ;RETURN
BIN2:
IN TRIN, ;GET A BUFFER
POPJ P, ;NO ERRORS,JUST RETURN
STATZ TRIN,IO.EOF ;EOF?
JRST FIX1 ;YES,TRAP TO EOF HANDLER
JRST FSTERR ;ERROR MESSAGE FOR OTHER ERROR STATUSES
SUBTTL MACLOD- ROUTINE TO GET A LINE OF MACRO CODE INTO MACBUF
; /MACLOD/- SINCE FOR ERROR PROCESSING AND FOR SYNTAX CHECKING
; IT IS USEFUL TO BE ABLE TO RESCAN MACRO CODE,
; THE PROCESSOR (EVAL) USES AN INPUT STREAM FROM AN INTERNAL
; BUFFER. MACLOD READS AN INPUT STREAM INTO THE MACRO CODE BUFFER
; "MACBUF"
;
; INPUTS- NONE
;
; OUTPUT- MACBUF IS LOADED WITH ASCIZ STRING OF MACRO CODE
; MACPTR IS A BYTE POINTER TO THIS STRING
; MACCNT IS THE COUNT OF CHARACTERS IN BUFFER,UP TO EOL
;
; RETURNS: ALWAYS CPOPJ
;
MACLOD:
TXNE F,DEBIMC ;USING INTERNAL BUFFER?
POPJ P, ;YES,SO JUST RETURN
PUSH P,T1 ;SAVE REGISTER T1
SETZM MACCNT ;RESET COUNT
MOVE T1,[POINT 7,MACBUF] ;SET UP POINTER
MOVEM T1,MACPTR ;SAVE IT FOR RE-READS
MACLD1:
PUSHJ P,BIN ;GET CHARACTER
IDPB CC,T1 ;DEPOSIT CHARACTER
AOS MACCNT ;UPDATE COUNT
SKIPE MACLST ;NOT INTO SAFETY WORD,ARE WE?
JRST MACLD2 ;YES,ERROR
CAIL CC,12 ;WATCH FOR END OF LINE
CAILE CC,14 ;ITS OUR DELIMITER
JRST MACLD1 ;NOT END OF LINE,GET NEXT CHARACTER
SETZ CC, ;DEPOSIT NULL AFTER LINE
IDPB CC,T1 ;FOR ERROR MESSAGES
POP P,T1 ;RESTORE T1
AOS LLOFF ;LINES SINCE LAST LABEL
POPJ P, ;RETURN
MACLD2:
MOVEI CC,12 ;FINISH LINE WITH BREAK
IDPB CC,T1 ;SO ERROR MESSAGE IS GOOD
$KILL(LTL,MACRO code line is too long,,$MORE)
JRST MCCOMM ;CONTINUE WITH ERROR
SUBTTL MIC - ROUTINE TO LOAD CHARACTER (AND EDIT IT) FROM MACRO CODE BUFFER
; /MIC/ - THIS ROUTINE READS CHARACTERS FROM THE BUFFER "MACBUF"
; POINTED TO BY MACPTR. A COUNT IS DECREMENTED , AND CHECKED
; OF CHARACTERS LEFT, AND IF NOT EXHAUSTED, A CHARACTER
; IS LOADED. THE FLAG, "REGET" IS TESTED AND READ ALSO.
;
; SOME EDITTING OF THE CHARACTERS IS DONE ALSO.
;
MIC:
TXZN F,REGET ;IS REGET OF CHARACTER ON?
PUSHJ P,MIC5 ;NO,LOAD CHARACTER
CAIL CC,12 ;CONVERT END-OF-LINE
CAILE CC,14 ;TO $EOL
CAIA
JRST [ MOVEM CC,REOL ;SAVE "REAL" END OF LINE
MOVEI CC,$EOL ;AND REPLACE WITH FAKE ONE
JRST .+1 ] ;AND CONTINUE
TXNE F,QUOTE ;CONVERION SUPRESSED?
POPJ P, ;YES,SO JUST RETURN
CAIN CC," " ;CONVERT <TAB>
MOVEI CC," " ;TO <SPACE>
CAIL CC,"a" ;LOWER CASE LETTER?
SUBI CC,"a"-"A" ;YES,CONVERT
CAIE CC,$EOL ;END OF LINE OR
CAIL CC," " ;NOT LESS THAN BLANK
POPJ P, ;JUST RETURN
JRST MIC ;ELSE LOAD ANOTHER CHARACTER
MIC5:
SOSGE MACCNT ;DONT LET CHARACTER COUNT GO NEGATIVE
$STPCD(MACRO evaluator read past its end of buffer)
ILDB CC,MACPTR ;LOAD CHARACTER
POPJ P, ;RETURN TO CALLER
SUBTTL ROUTINES TO MANIPULATE THE MACRO CODE BUFFER
; /MACPEK/- ROUTINE TO RETURN THE CHARACTER AFTER THE NEXT ONE
;
; INPUT- NONE
; OUTPUT- AC A WILL CONTAIN THE CHARACTER AFTER THE CURRENT ONE
; IE. CHARACTER NEXT ILDB WILL GET
;
MACPEK:
PUSH P,T1 ;SAVE T1
MOVE T1,MACPTR ;GET THE POINTER
ILDB A,T1 ;GET CHARACTER
PJRST T1POPJ ;RESTORE AND RETURN
; /MACSAV/ AND /MACRST/ - ROUTINES TO SAVE AND RESTORE THE STATE OF
; THE BUFFER POINTER AND COUNT.
;
; MACSAV- SAVES AWAY THE COUNT AND POINTER WORDS
; MACRST- RESTORES COUNT AND POINTER FROM LAST CALL TO MACSAV
;
MACSAV: PUSH P,MACPTR ;GET POINTER
POP P,MACSV1 ;STORE IT
PUSH P,MACCNT ;GET COUNT
POP P,MACSV2 ;SAVE IT ALSO
POPJ P, ;RETURN
MACRST:
PUSH P,MACSV1 ;GET POINTER
POP P,MACPTR ;RESTORE IT
PUSH P,MACSV2 ;GET COUNT
POP P,MACCNT ;RESTORE IT
TXZ F,REGET ;INVALIDATE ANY REGET
POPJ P, ;RETURN
SUBTTL ROUTINE TO BACK UP THE REL FILE
;/BACKUP/ - THIS ROUTINE CLOSES THE MASTER AND OUTPUT FILES. IT THEN
; OPENS AS THE NEW MASTER THE OLD OUTPUT.
; IT THEN ENTERS AS NEW OUTPUT A NEW FILE WITH
; THE SAME NAME AS THE OLD OUTPUT. THIS HAS THE EFFECT
; OF BACKING US UP INTO WHAT WAS THE OLD MASTER WITHOUT
; ACTUALLY DESTROYING THE OLD MASTER.
BACKUP:
PUSHJ P,COPY ;INSURE THAT ALL DONE
CLOSE MIN, ;CLOSE OMASTER
STATZ MIN,760000 ;CHECK FOR ERRORS
JRST FSMERR
RELEAS MIN,
CLOSE OCHN, ;CLOSE OUTPUT
STATZ OCHN,760000 ;
JRST FSOERR ;
RELEASE OCHN,
MOVE T1,[XWD BCKBLK,OPNBLK] ;RESTORE OUTPUT SPECS
BLT T1,OPNBLK+<.RBSIZ+2+3>-1 ;FOR RE-OPENS
MOVE T1,BCKFF ;RESTORE CORE MARKER
EXCH T1,.JBFF## ;
MOVEM T1,BCKFF+1 ;SO WE DONT SWELL
OPEN OCHN,OPNBLK ;OPEN OUTPUT
JRST OPNFAI ;
ENTER OCHN,LKPBLK ;ENTER IT
JRST LKPFAI ;
OUTBUF OCHN, ;SET UP BUFFER
MOVE T1,[BCKBLK,,OPNBLK] ;RESTORE SPECS AGAIN
BLT T1,OPNBLK+<.RBSIZ+2+3>-1 ;
MOVEI T1,MBUF ;CORRECT HEADER POINTER
MOVEM T1,OPNBLK+2 ;
OPEN MIN,OPNBLK ;OPEN MASTER FOR INPUT AGAIN
JRST OPNFAI
LOOKUP MIN,LKPBLK ;AND LOOKUP
JRST LKPFAI
INBUF MIN,
MOVE T1,BCKFF+1 ;RESTORE FIRST FREE
MOVEM T1,.JBFF## ;DONE
POPJ P, ;RETURN
SUBTTL OCTIN,DECIN,CRADIN - ROUTINES TO DO NUMERIC INPUT FROM FIX FILE
; /DECIN/ - ROUTINE TO INPUT A DECIMAL (10.) NUMBER FROM
; FIX FILE INTO AC A.
; /OCTIN/ - SAME AS ABOVE, OCTAL (8.)
; /CRADIN/ - READ NUMBER IN USING VALUE IN LOCATION
; CRADIX AS THE CURRENT RADIX.
;
; DELIMITER IS LEFT IN CC. IT IS THE FIRST NON-DIGIT (0-9) ENCOUNTERED.
; IF A DIGIT GREATER THAN THE CURRENT RADIX IS FOUND, THE INPUT
; IS AUTOMATICALLY CHANGED TO RADIX10.
;
OCTIN: SKIPA T,[^D8] ;FOR BASE 8 INPUT
DECIN: MOVEI T,^D10 ;FOR DECIMAL
JRST .+2
CRADIN:
MOVE T,CRADIX ;T IS LOADED WITH CURRENT RADIX
SETZ A, ;CLEAR RESULT
SETZM DECNUM ;CLEAR FORCED RADIX 10 NUMBER
RADI1:
PUSHJ P,MIC ;GET A CHARACTER
SKPNUM ;IS IT A DIGIT?
POPJ P, ;NO,SO RETURN
SUBI CC,"0" ;CONVERT TO NUMBER
CAML CC,T ;LESS THAN CURRENT RADIX?
JRST [ MOVEI T,^D10 ;NO,FORCE RADIX 10
MOVE A,DECNUM
JRST .+1 ] ;AND CONTINUE
IMULI A,(T) ;SHIFT OVER
ADDI A,0(CC) ;
EXCH A,DECNUM ;MAKE RADIX10 NUMBER
IMULI A,^D10
ADDI A,0(CC) ;
EXCH A,DECNUM ;
JRST RADI1 ;AND GO BACK FOR NEXT
SUBTTL SYMIN - ROUTINE TO FORM A SYMBOL FROM THE INPUT STREAM
;/SYMIN/ - THIS ROUTINE LOADS CHARACTERS INTO AC A FORMING A
; SYMBOL THAT IS LEFT JUSTIFIED. THE SYMBOL IS DELIMITED
; BY THE FIRST CHARACTER NOT IN THE RADIX-50 CHARACTER
; SET.
; THE DELIMITING CHARACTER IS LEFT IN AC CC. THE SYMBOL
; IS LEFT IN SIXBIT FORM. THE DELIMITER IS IN ASCII
; CHARACTERS IN EXCESS OF THE MAX. OF 6 ARE EATEN AND DISCARDED.
;
SYMIN:
SETZM A ;START WITH NO SYMBOL
PUSH P,T1 ;SAVE T1
MOVE T1,[POINT 6,A] ;AND GIVE IT A POINTER TO A
SYMIN1:
PUSHJ P,MIC ;READ A CHAR FROM PATCH FILE
SKPR50 ;IS IT RADIX50?
JRST T1POPJ ;NO,SO RETURN,RESTORING T1
SYMIN2:
TRNE A,77 ;HAVE WE GOT ROOM?
JRST SYMIN1 ;NO,JUST DISCARD CHARACTER
SUBI CC,40 ;CONVERT TO SIXBIT
ANDI CC,77 ;FOR SYMBOL STORAGE
IDPB CC,T1 ;AND INCLUDE CHARACTER
JRST SYMIN1 ;GET NEXT CHARACTER
; /TDIGIT/- ROUTINE TO TEST IF CHARACTER IN AC CC IS A VALID DIGIT (0-9)
;
; SKIP RETURN IF DIGIT, NON-SKIP IF NOT
;
TDIGIT:
CAIL CC,"0" ;LESS THAN 0?
CAILE CC,"9" ;.GT. 9?
POPJ P, ;NOT DIGIT
PJRST CPOPJ1 ;DIGIT
;/TR50/ - ROUTINE TO TEST IF A CHARACTER IS IN THE RADIX50 SET.
;
;
TR50:
PUSHJ P,TDIGIT ;NUMBERS ARE
CAIN CC,"." ;AND SO ARE PERIODS
JRST CPOPJ1 ;SO TAKE GOOD RETURN
CAIL CC,"A" ;CHECK
CAILE CC,"Z" ;ALPHABET
CAIN CC,"$" ;AS IS DOLLAR SIGN
JRST CPOPJ1 ;SO TAKE GOOD RETURN
CAIN CC,"%" ;CHECK PERCENT SIGN
JRST CPOPJ1
POPJ P, ;NOT IN 0-9,A-Z,$,%,.
SUBTTL DESCRIPTION OF INTERIM SYMBOL TABLE (IST)
COMMENT \
THE INTERIM SYMBOL TABLE (IST) CONTAINS PAIRS OF WORDS
THAT DESCRIBE ACTIONS TO BE TAKEN FOR FIXING UP FORWARD REFERENCES TO
SYMBOLS, EXTERNALS AND LITERALS.
THE IST IS ALSO USED FOR ASCII,ASCIZ AND SIXBIT STRINGS THAT
EXTEND FOR MORE THAN ONE WORD.
WHEN EVAL FINDS A SYMBOL THAT IS UNDEFINED:
1) SET OPERAND RESULT (AC A) TO 0, RELOCATABILTY TO 1
2) SET SYMBOL FIXUP POINTER (AC C) TO BE POINTER TO ENTRY IN IST
3) SET IST WORD 1 TO BE SIXBIT THIS SYMBOL NAME
4) SET 2ND WORD OF IST PAIR TO IS.UDF, ALSO IS.DER IFF SYMBOL FOLLOWED BY ##
ALSO, RELOC IS CLEARED IF EXTERNAL.
5) THE RELOC AND SYMBOL FIXUP ARE CARRIED THRU ALL LATER OPERATIONS
6) AT THE END OF EVAL, THE RH OF IST ENTRY WORD 2 IS REVERSED TO POINT
BACK AT THE LOCATION THAT CODE WORD IS STORED IN.
8) WHEN SYMBOL IS RESOLVED, ITS VALUE IS STORED INTO THE APPROPRIATE
HALF OF THE WORD.
WHEN EVAL FINDS A REFERENCE TO AN EXTERNAL:
1) RESULT,RELOCATABILTY ARE SET TO 0.
2) SYMFIX (AC C ) IS SET TO POINT TO FIRST FREE IST PAIR
3) WORD 1 OF PAIR GETS SIXBIT SYMBOL NAME
4) WORD 2 GETS FLAG OF IS.DER (DEFFERED EXTERNAL REFERENCE)
5) OPERAND IS CARRIED THRU LATER OPERATIONS
6) AT END OF EVAL, POINTER IS REVERSED TO INDICATE FIXUP ADDRESS
7) IF ALL GOES WELL, A SYMBOL TABLE ENTRY IS MADE LATER TO HOOK
REQUEST INTO GLOBAL CHAIN.
WHEN EVAL FINDS A REFERENCE TO AN LITERAL:
1) THE EXPRESSION WITHIN BRACKETS IS EVALUATED. IT MUST GENERATE
ONE AND ONLY ONE WORD OF CODE.
1A) THE EXPRESSION RESULT,ITS RELOC AND SYMFIX ARE STORED IN
FREE CORE
2) A POINTER TO THE TRIPLET IS PUT INTO THE FIRST WORD OF THE IST PAIR
4) RESULT IS SET TO 0, RELOC TO RH ONLY (1), SYMFIX (AC C) IS SET TO
POINT BACK AT THE IST PAIR. FLAG (AC D) IS SET TO C.LIT
5) THE OPERAND IS PASSED BACK FOR FURTHER USE.
6) AT THE END, THE LITERAL WORD IS TO BE INSERTED WITH APPROPRIATE
RELOCATION AND THEN THE POINTER IS USED TO DUE THE NORMAL FIXUP.
WHEN EVAL FINDS THAT A STRING EXTENDS FOR MORE THAN ONE WORD:
1) THE FIRST WORD OF THE STRING IS LEFT ALONE
2) AN IST PAIR ENTRY IS MADE. THE FIRST WORD IS:
XWD -COUNT OF WORDS, ADDRESS OF STRING
3) THE EXCESS WORDS ARE GENERATED INTO FREE CORE (THAT WORD 1 OF IST PAIR
POINTS TO)
4) THE USUAL STUFF IS DONE WITH IST POINTER CARRIED AROUND BY THE
EXPRESSION AND REVERSED AT EXIT FROM EVAL.
THE SECOND WORD OF THE IST IS THEN: IS.MWS,,ADDRESS 1ST WORD GENERATED INTO
5) AT FIXUP TIME, THE STRING IS GENERATED.
\
; FLAGS IN LH OF WORD TWO OF IST PAIR
$1BIT=1B17 ;LEAVE RH FREE
BIT(IS.UDF) ;THIS SYMBOL IS NOT IN SYMBOL TABLE
BIT(IS.LH) ;THIS FIXUP IS TO LEFT HALF OF WORD
BIT(IS.FW) ;THIS IS OK AS A FULLWORD FIXUP
BIT(IS.DER) ;THIS IS A DEFERRED EXTERNAL REQUEST
BIT(IS.NEG) ;THIS IS A REQUEST TO SUBTRACT
BIT(IS.LIT) ;THIS IS A PSEUDO-LITERAL
BIT(IS.MWS) ;THIS IS THE CONTINUANCE OF A MULTI-WORD STRING
BIT(IS.SYM) ;THIS FIXUP IS TO SYMBOL TABLE,NOT CORE
SUBTTL ROUTINES FOR MANIPULATING THE IST (INTERIM SYMBOL TABLE)
; /ISTINI/- ROUTINE TO ZERO THE IST MAP
;
ISTINI:
PUSH P,T1 ;SAVE T1
MOVE T1,[XWD ISTMAP,ISTMAP+1]
SETZM ISTMAP
BLT T1,ISTMAP+<<ISTMAX+^D35>/^D36>-1
PJRST T1POPJ
; /ISTGET/ - ROUTINE TO FIND THE FIRST AVAILABLE SLOT ON THE IST
;
; THIS ROUTINE IS USED FOR ALLOCATING A SLOT IN THE INTERIM SYMBOL TABLE
;
; INPUTS-NONE
;
; OUTPUTS- AC C WILL CONTAIN THE ADDRESS OF THE SLOT IN THE IST
; OR THE FATAL ERROR MESSAGE FOR ROOM EXHAUSTED IS GIVEN
;
; RETURNS- ALWAYS POPJ, OR TO ERROR PROCESSOR
;
ISTGET:
PUSH P,T1 ;SAVE T1-2
PUSH P,T2
MOVE T1,[POINT 1,ISTMAP] ;POINTER TO BIT MAP
MOVEI C,IST ;INITIAL GUESS AS TO FREE SLOT
ISTGE1:
ILDB T2,T1 ;GET BIT
JUMPE T2,[ SETOM T2 ;MARK AS IN USE
DPB T2,T1 ;
PJRST T2POPJ ] ;AND RETURN
ADDI C,2 ;NOT THIS PAIR
CAIG C,ISTLST ;OVER THE END?
JRST ISTGE1 ;NO
$KILL(IST,<Interim symbol table overflowed, Code too complex in edit>,N$SIX)
; /ISTVAL/ - ROUTINE TO SEE IF PARTICULAR PAIR OF IST IS IN USE
;
; INPUT- AC T1 CONTAINS POINTER TO PAIR IN IST
; OUTPUT - AC T1 IS PRESERVED
;
; RETURNS - CPOPJ= PAIR IS NOT IN USE
; CPOPJ1 = PAIR IS IN USE
;
ISTVAL:
PUSH P,T1 ;SAVE INPUT ARG
PUSH P,T2
SUBI T1,IST ;MAKE INDEX
LSH T1,-1 ;TWO WORDS PER PAIR
MOVE T2,[POINT 1,ISTMAP] ;
IBP T2 ;ADJUST BYTE POINTER
SOJGE T1,.-1
LDB T2,T2
SKIPE T2 ;IF IN USE
AOS -2(P) ;UPDATE TO BE SKIP RETURN
PJRST T2POPJ ;RETURN , RESTORE THE ACS
;
; /ISTSAV/ & /ISTRST/ - ROUTINE TO SAVE AND RESTORE THE STATE OF
; THE IST SO THAT UPON ERRORS AND CODE COMPARE, WE CAN DE-ALLOCATE
; IST SPACE TEMPORARILY USED.
;
ISTSAV:
PUSH P,T1 ;SAVE T1
MOVE T1,[XWD ISTMAP,ISTALT] ;
BLT T1,ISTALT+<<ISTMAX+^D35>/^D36>-1
PJRST T1POPJ ;RESTORE T1,RETURN
ISTRST:
PUSH P,T1 ;SAVE T1
MOVS T1,[XWD ISTMAP,ISTALT]
BLT T1,ISTMAP+<<ISTMAX+^D35>/^D36>-1
PJRST T1POPJ ;RESTORE,RETURN
SUBTTL ROUTINES TO DO POST-FIXUPS FOR THE INTERIM SYMBOL TABLE
; THE FOLLOWING ROUTINES REMOVE ENTRIES FROM THE INTERIM FIXUP TABLE
; WHEN THINGS ARE DEFINED. THINGS DEFINED INCLUDE EXTERNAL AND LOCAL FIXUPS
; LITERAL AND STRING CONTINUATION FIXUPS.
;
; /PMLOC/ - ROUTINE TO REMOVE ENTRIES FROM THE IST REFERRING TO
; A LOCAL SYMBOL (LABEL)
;
; INPUTS- NONE
;
; OUTPUTS- IF THERE ARE FORWARD REFERENCES, THEY ARE REMOVED,FIXED UP
; AND THE IST IS COLLAPSED.
;
; RETURNS- ALWAYS CPOPJ
;
PMLOC:
MOVEI T1,ISTLST-1 ;GET POINTER TO LAST PAIR
PMLOC1:
CAIN T1,IST ;ARE WE AT FRONT OF TABLE?
POPJ P, ;YES , RETURN
SUBI T1,2 ;ADJ TO POINT TO CURRENT ENTRY
MOVE T2,1(T1) ;FETCH FLAG,,ADDR
TRNE T2,-1 ;IGNORE IF NOT GENERATED AND
TXNE T2,IS.LIT!IS.DER!IS.MWS ;IGNORE IF NOT LOCAL SYMBOL FIXUP
JRST PMLOC1
PUSHJ P,ISTVAL ;SEE IF VALID
JRST PMLOC1 ;ITS NOT
MOVE R,0(T1) ;GET THE SYMBOL NAME
PUSHJ P,SYMSRC ;LOOKUP THE SYMBOL
JRST PMLOC1 ;NOT DEFINED YET
MOVE T2,A ; LOAD T2 WITH SYMBOL VALUE
MOVE T3,D ;T3 GETS RELOCATION
MOVE T4,1(T1) ;GET FLAG WORD AGAIN
TXNN T4,IS.LH ;MAKE CHECK IF LH FIXUP
TXNN T4,IS.FW ;SKIP CHECK IF FULL WORD
JRST [ TLNE T2,-1 ;INSURE NULL LH
TLC T2,-1 ;TRY MAKING HALFWORD NEGATIVES
TLNE T2,-1 ;
TLZ T2,-1 ;JUST TRUNCATE IT THEN
JRST .+1 ] ;
PUSHJ P,PMFIX ;PATCH REL FILE,COLLAPSE IST
JRST PMLOC1 ;AND RE-ITERATE
;
; /PMLIT/ - ROUTINE TO GENERATE LITERAL WORDS AND TO
; DO THE FIXUP NECESSARY SINCE LITERALS ARE FORWARD REFERENCES
;
; INPUT- IST PTR TO CHAIN OF LITERAL BLOCKS
;
; OUTPUTS - APPROPRIATE WORDS OF CODE AND COLLAPSED IST
;
; NOTE: DO NOT CHANGE BACK TO FRONT SWEEP OF IST FOR LITERAL FIXUPS.
; THIS WILL BREAK NESTED LITERALS.
;
; RETURNS- ALWAYS CPOPJ
;
PMLIT:
MOVEI T1,ISTLST-1 ;GET POINTER TO LAST PAIR
PMLIT1:
CAIN T1,IST ;AT FRONT?
POPJ P, ;YES,SO RETURN
SUBI T1,2 ;BACK UP OVER PAIR
MOVE T2,1(T1) ;GET FLAGS,,FIXUP DESTINATION
TLNE T2,-1 ;IF NOT READY YET OR
TXNN T2,IS.LIT ;NOT A LITERAL
JRST PMLIT1 ;JUST IGNORE
PUSHJ P,ISTVAL ;VALID?
JRST PMLIT1 ;NO,SO SKIP IT
MOVE A,0(T1) ;GET ADDRESS OF CODE TRIPLET
PUSH P,CPADDR ;SAVE ADDRESS OF START OF LITERAL
PMLIT2:
MOVE C,0(A) ;LOAD WORD OF CODE
MOVE B,1(A) ;GET RELOCATION WORD
TLNE B,1 ;IS LEFT HALF RELOCATED?
TRO B,1B34 ;YES,SO FLAG IT SO
HRRZS B ;
MOVE T2,CPADDR ;GET ADDRESS THIS WORD WILL GO TO
HRRZ D,2(A) ;GET RIGHT HALF OF SYMBOL FIXUP WORD
JUMPE D,.+2 ;IF 0,NO RH FIXUP REQUIRED
IORM T2,1(D) ;FIXUP NEEDED, DEPOSIT ADDRESS
HLRZ D,2(A) ;DO THE SAME FOR THE LEFT HALF
JUMPE D,.+3
TXO T2,IS.LH ;FLAG AS LEFT HALF FIXUP
IORM T2,1(D) ;DEPOSIT ADDRESS AND FLAG
HRRZS T2
PUSH P,3(A) ;SAVE LINK WORD
PUSHJ P,NEWCODE ;INSERT THE CODE
JRST INSERR
PUSH P,T1 ;PRESERVE T1
PUSHJ P,PMMWS ;SEE IF MORE TO FOLLOW
POP P,T1 ;RESTORE T1
POP P,A ;RESTORE LITERAL LINK
JUMPN A,PMLIT2 ;IF NON-ZERO, FOLLOW IT
POP P,T2 ;T2 GETS ADDRESS OF LITERAL
SETZ T3, ;RELOC IS ALREADY SET
PUSHJ P,PMFIX ;DO THE FIXUP
PUSH P,T1 ;INVOKE LOCAL AND EXTERNAL FIXUPS
PUSHJ P,PMLOC ;SINCE FIXUP IS DEFERRED UNTIL
PUSHJ P,PMEXT ;LITERAL ACTUALLY GENERATED
POP P,T1 ;RESTORE CURRENT IST POINTER
JRST PMLIT1 ;AND RE-ITERATE
; /PMEXT/ - ROUTINE TO REMOVE EXTERNAL REFERENCES FROM THE IST
;
; INPUTS- NONE
;
; OUTPUTS- PROGRAM SYMBOL TABLE IS UPDATED TO MAKE REQUEST AND THE
; IST IS COLLAPSED.
;
; NOTE THAT EXTERNAL REFERENCES IN PATCH CODE ARE ALWAYS ADDED USING
; AN ADDITIVE GLOBAL REQUEST (LINK TYPE 2) OF FORM:
; 1ST WORD / 60 RADIX50-NAME
; 2ND WORD/ 1B0+(POSSIBLY 1B1)+ADDRESS OF REQUEST
;
; 1B1 IS ON FOR LEFT HALF FIXUP, OFF IF FIXUP IS TO RIGHT HALF
;
; RETURNS- ALWAYS CPOPJ
;
PMEXT:
MOVEI T1,ISTLST-1 ;PICK UP POINTER
PMEXT1:
CAIN T1,IST ;AT FRONT?
POPJ P, ;YES,SO RETURN
SUBI T1,2 ;BACK OVER THE FRAME
MOVE T2,1(T1) ;PICK UP FLAG WORD,,ADDRESS OF REQUESTING WORD
TRNE T2,-1 ;WORD HAS BEEN GENERATED AND
TXNN T2,IS.DER ;THIS IS A REQUEST, RIGHT?
JRST PMEXT1 ;NO,SO SKIP IT
PUSHJ P,ISTVAL ;CHECK FOR EMPTINESS
JRST PMEXT1 ;EMPTY,SO SKIP IT
MOVE R,0(T1) ;GET SYMBOL NAME
PUSHJ P,RAD50 ;CONVERT TO RADIX 50
HRRZ A,T2 ;GET ADDRESS OF FIXUP
TXO A,R5.FXA ;INDICATE ADDITIVE GLOBAL
TXNE T2,IS.LH ;IS REQUEST TO LEFT HALF?
TXO A,R5.FXL ;YES,INDICATE SO
MOVEI B,1 ;RELOCATE PTR TO FIXUP
PUSHJ P,GLRSYM ;ADD GLOBAL REQUEST SYMBOL
JRST STOERR ;IF NO ROOM LEFT
PUSHJ P,PMFIX1 ;COLLAPSE INTERIM TABLE
JRST PMEXT1 ;AND CONTINUE
; /PMMWS/ - ROUTINE TO GENERATE 2ND THRU NTH WORDS OF MULTI-WORD STRING
;
; INPUTS- IST ENTRY OF FORMAT:
; 1/ AOBJN PTR TO STRING
; 2/ IS.MWS,,ADDRESS THAT 1ST WORD OF STRING WENT INTO.
;
; OUTPUTS- 2ND THRU NTH WORD GENERATED
;
; RETURNS- ALWAYS CPOPJ
;
PMMWS:
MOVEI T1,ISTLST-1 ;GET POINTER TO END OF TABLE
PMMWS1:
CAIN T1,IST ;ALL DONE?
POPJ P, ;YES,RETURN
SUBI T1,2 ;GET TO FRONT OF PAIR
MOVE T2,1(T1) ;GET SECOND WORD OF PAIR
TRNE T2,-1 ;IF WORD NOT GENEATED YET
TXNN T2,IS.MWS ;OR NOT STRING
JRST PMMWS1 ;IGNORE THE ENTRY
PUSHJ P,ISTVAL ;
JRST PMMWS1 ;IGNORE NULL ENTRIES
MOVE T3,CPADDR ;ELSE CONFIRM THAT WE
CAIE T3,1(T2) ;CAN GENERATE INTO PROPER PLACE
$STPCD(Multiple word generator called at wrong time)
MOVE T4,0(T1) ;GET AOBJN POINTER
PMMWS2:
MOVE C,0(T4) ;LOAD WORD OF STRING
SETZ B, ;WITH NO RELOCATION
PUSHJ P,NEWCOD ;GENERATE INTO MODULE
JRST INSERR
AOBJN T4,PMMWS2 ;IF MORE TO DO
PUSHJ P,PMFIX1 ;REMOVE ENTRY FROM IST
JRST PMMWS1 ;SEE IF MORE IS.MWS ENTRIES
; /PMFIX/ -PATCH A VALUE AND RELOCATION INTO THE REL FILE
; /PMFIX1/ - REMOVE AN ENTRY FROM THE IST
;
; NOTE THAT A CALL TO PMFIX GENERATES ONE TO PMFIX1
;
; INPUTS- AC T1 SHOULD CONTAIN PTR TO WORD 1 OF CURRENT IST PAIR
; AC T2 SHOULD CONTAIN THE VALUE OF TOKEN BEING FIXED UP
; AC T3 SHOULD CONTAIN IN BITS 34-35 A TWO BIT RELOCATION TO
; 'OR' IN WITH EXISTING BITS
;
; OUTPUTS- ACS T1 & T2 ARE PRESERVED
; THE ENTRY POINTED TO IS REMOVED FROM THE IST AND THE
; TABLE IS COLLAPSED WITH ISTPTR BEING DECREMENTED.
;
PMFIX:
TRNE T3,2 ;CONVERT TO HALFWORD RELOCATION
TLO T3,1
TRZ T3,2 ;I.E. 1,,0 ETC INSTED OF 1B34
PUSH P,T3 ;SAVE RELOCATION
MOVE T3,1(T1) ;GET FLAG WORD OF PAIR
TXNN T3,IS.LH ;IS THIS A LEFT HALF FIXUP?
JRST .+3 ;NO,SKIP SWAP
HRLZS T2 ;YES,GET IT INTO POSITION
HRLZS 0(P) ;THE VALUE AND RELOCATION
TXNN T3,IS.NEG ;IS THIS A NEGATIVE REQUEST?
JRST .+3 ;NO,SKIP NEGATION OF VALUE,RELOC
MOVNS T2 ;YES,NEGATE VALUE
MOVNS 0(P) ;AND RELOCATION
HRRZ A,1(T1) ;PICK UP LOCATION TO BE FIXED UP
PUSHJ P,WRDSRC ;MAP IT IN CORE
$STPCD(INTERIM SYMBOL TABLE fouled up)
MOVE T4,0(C) ;PICK UP ORIGINAL
ADDM T2,0(C) ;ADD IN OUR STUFF
TXNN T3,IS.LH!IS.FW ;IF NOT LH OR FULLWORD
HLLM T4,0(C) ;INSURE LH NOT DISTURBED
PUSHJ P,GETREL ;GET RELOCATION FROM (B) &(C)
POP P,T4 ;GET NEW RELOCATION
TRNE D,2 ;CONVERT TO USEABLE FORMAT
TLO D,1 ;FOR ADDITION
TRZ D,2
PUSH P,D ;SAVE IT
ADD D,T4 ;MERGER RELOCATIONS
TXNE T3,IS.LH!IS.FW ;UNLESS LH OR FULL WORD
HLL D,0(P) ;RESTORE LH OF RELOCATION
POP P,0(P) ;
TDNE D,[^-<1,,1>] ;MAKE SURE ITS VALID
JRST FXRERR ;
TLNE D,1 ;RESET TO RELOCATION IN BITS 34-5
TRO D,2 ;
HRRZS D
PUSHJ P,CHGREL ;AND RE-DEPOSIT RELOCATION
PMFIX1:
PUSH P,T1 ;SAVE T1 ACROSS CALL
MOVE T2,[POINT 1,ISTMAP] ;POINTER TO MAP
SUBI T1,IST ;GET INDEX INTO IST
LSH T1,-1 ;TWO WORDS PER PAIR
IBP T2 ;INCREMENT BYTE POINTER
SOJGE T1,.-1 ;TO BE IN RIGHT PLACE
SETZM T1
DPB T1,T2 ;DEPOSIT BYTE
PJRST T1POPJ ;RETURN, RESTORING BYTE POINTER
FXRERR:
MOVE N,0(T1) ;PICK UP SYMBOL NAME
$KILL(IRF,Illegal reloc. in FORWARD reference to,N$SIX,$MORE)
JRST SAYEDT
SUBTTL MACRO STATMENT EVALUATOR
; /EVAL/ - THIS ROUTINE TAKES INPUT FROM THE SOURCE STREAM
; AND RETURNS A FULL WORD THAT IS THE RESULT OF EVALUATING IT
; AS MACRO-10 ASSEMBLY LANGUAGE.
; IT ALSO SETS UP THE IST (INTERIM SYMBOL TABLE) AND THE
; SYMBOL TABLE .
;
EVAL:
MOVEM P,EVLPP ;SAVE PDL POINTER ON ENTRY
PUSHJ P,MACLOD ;GET A LINE OF MACRO CODE
EVAL0:
PUSHJ P,MACSAV ;SAVE BUFFER POINTER
BYPASS ;GET FIRST NON-BLANK CHARACTER
CAIE CC,";" ;COMMENT CHARACTER? OR
CAIN CC,$EOL ;END OF LINE?
JRST EVAL ;YES,IGNORE LINE
TXO F,REGET ;REGET CHARACTER
EVAL1:
SKPNUM ;IS NEXT CHARACTER A DIGIT?
SKPR50 ;NO, IS IT RADIX50 SYMBOL?
JRST EVAL5 ;NOT LABEL
CAIN CC,"." ;"." FOLLOWED BY 0-9 IS A NUMBER
JRST [PUSHJ P,MACPEK ;LOOK AHEAD ONE CHARACTER
CAIL A,"0"
CAILE A,"9" ;BASE 10
JRST .+1 ;NOT NUMERIC
JRST EVAL5] ;WAS NUMERIC
PUSHJ P,SYMIN ;GET A SYMBOL
CAIE CC,":" ;DID IT END WITH COLON?
JRST [ PUSHJ P,MACRST ;RESTORE
JRST EVAL5] ;AND CONTINUE
MOVE R,A ;LOAD R WITH SYMBOL NAME
PUSHJ P,SYMSRC ;AND LOOK IT UP
CAIA ;NOT THERE SO ITS OK
JRST MERROR ;DONT ALLOW REDEF OF EXISTING LABEL
SETZ B, ;START WITH NO SYMBOL FLAGS
PUSHJ P,MACPEK ;LOOK BEHIND THE ":"
CAIN A,":" ;IS IT A COLON TOO?
JRST [PUSHJ P,MIC ;YES,SWALLOW IT
TXO B,R5.GLB ;FLAG AS GLOBAL DECLARATION
PUSHJ P,MACPEK ;LOOK BEHIND THE SECOND COLON
JRST .+1] ;AND CONTINUE
CAIN A,"!" ;EXCL PT. BEHIND COLON?
JRST [PUSHJ P,MIC ;YES,EAT IT
TXO B,R5.DDT ;AND FLAG AS SUPRESSED
JRST .+1] ;AND CONTINUE
MOVEM R,LLABEL ;STORE LAST LABEL
SETZM LLOFF ;AND ZERO THE OFFSET
PUSHJ P,RAD50 ;CONVERT TO RADIX50
IOR R,B ;TURN ON ANY FLAGS COLLECTED
MOVE A,CPADDR ;GET VALUE FOR THIS SYMBOL
TXNN F,IAI ;ARE WE IN AN INSERT?
JRST [ MOVE N,LLABEL
$WARN(LII,LABEL outside of .INSERT was ignored:,N$SIX)
JRST EVAL0]
MOVEI B,1 ;RELOCATE THE ADDRESS OF SYMBOL
PUSHJ P,NEWSYM ;REGISTER THE SYMBOL
JRST STOERR ;SYMBOL TABLE OVERFLOW
PUSHJ P,PMLOC ;CLEAR ANY LOCAL FIXUPS ON THIS SYMBOL
JRST EVAL0 ;CHECK FOR MORE LABELS,ETC.
EVAL5:
MOVEI A,ETCERR ;GET PDL OVERFLOW TRAP LOCATION
MOVEM A,.JBAPR## ;AND SET FOR APR INTERUPT
MOVX A,AP.POV ;TRAP ONLY PDL OVERFLOW
APRENB A, ;DO IT
SETZM OPRPTR ;CLEAR STACK POINTERS
SETZM OPTPTR ;FOR OPERATORS AND OPERANDS
PUSHJ P,EVALS ;EVALUATE STATEMENT
CAIE CC,$EOL ;SHOULD ONLY RETURN ON $EOL
CAIN CC,";" ;OR COMMENT STARTED
CAIA
JRST QERROR ;ILLEGAL TERMINATOR
SKIPE NULFLG ;IF NULL STATEMENT,GO GET
JRST EVAL ;GET ANOTHER ONE
SETZM .JBAPR## ;UN-DO THE TRAP
SETZ A, ;FOR PDL OVERFLOW
APRENB A, ;SINCE IT COULD BE MISLEADING
MOVE C,CPADDR ;CURRENT ADDRESS
HRRZ B,R%S ;SEE IF IST NEEDS FIXUP
JUMPE B,.+2
IORM C,1(B) ;SET IT UP
HLRZ B,R%S ;
JUMPE B,.+3 ;SAME FOR LEFT HALF
TXO C,IS.LH ;LEFT HALF FIXUP FLAG
IORM C,1(B) ;DONE
MOVE D,R%R ;MAKE CHECK ON RELOCATABILITY
TDNE D,[^-<1,,1>] ;CAN BE 0,,0 1,,1 1,,0 OR 0,,1
JRST RERROR ;BUT IT WASNT, CALL IT ERROR
POPJ P, ;RETURN
COMMENT \
THIS ROUTINE IS A RECURSIVE MACRO STATMENT EVALUATOR
WHICH IS CALLED WHENEVER :
1) THERE IS A PRIMARY STATEMENT (IE JUST LEFT LABEL FIELD)
2) A LEFT BRACKET 74 WAS SEEN
3) A LEFT PARENTHESIS WAS SEEN "("
4) A LEFT BRACKET WAS SEEN "["
THE CURRENT STATE IS SAVED ON ENTRY, AS REFLECTED BY THE
ACS %F,%V,%R,%S. THE RESULT IS RETURNED ON EXIT IN THE MEMORY LOCATIONS
R%F,R%V,R%R,R%S.
USAGE: %V CONTAINS THE VALUE OF THE STATEMENT
%R CONTAINS IN EACH HALF THE MULTIPLIER OF RELOC CONSTANT
WHICH CAN BE EITHER 0 OR 1
%S CONTAINS IN EACH HALF EITHER 0 OR THE ADDRESS OF A
TWO WORD ENTRY IN THE IST FOR FIXING UP FORWARD REFERENCES
%F CONTAINS FLAGS INDICATING OUR POSITION
IN THE MACRO-10 STATEMENT.
EVALUATION OF THE MACRO-10 EXPRESSIONS IS DONE USING A TWO STACK
PRECEDENCE GRAMMAR EVALUATOR. ONE STACK CONTAINS THE OPERANDS
AND THE OTHER CONTAINS THE OPERATORS.
EACH OPERAND ENTRY CONTAINS 4 WORDS,SIMILIAR
IN USE TO THE ACS %F,%V,%R,AND %S. THESE ARE COMBINED
TO FORM LARGER EXPRESSIONS AND FINALLY A FULL MACRO-10 STATEMENT.
\
; LOCAL ACS
%V==T1
%R==T2
%S==T3
%F==T4
; FLAGS IN %F
$1BIT==1
BIT(C.SYM) ;CURRENT CELL IS A SYMBOL
BIT(C.NUM) ;CURRENT CELL IS A NUMBER
BIT(C.AT) ;CURRENT CELL WAS "@"
BIT(C.IDX) ;CURRENT CELL WAS "(...)"
BIT(C.FLT) ;CURRENT CELL IS FLOATING POINT
BIT(C.UDF) ;CURRENT CELL IS AN UNDEFINED SYMBOL
BIT(C.EXT) ;CURRENT CELL IS EXTERNAL SYMBOL
BIT(C.LHNZ) ;CURRENT CELL HAS DATA IN LH
BIT(C.NULL) ;CURRENT CELL IS NOT THERE
BIT(C.OP) ;CURRENT CELL IS AN OP CODE SYMBOL
BIT(C.ASG) ;CURRENT CELL IS SYMBOL TO ASSIGN VALUE TO
BIT(C.POP) ;CURRENT CELL IS A PSEUDO-OP SYMBOL
BIT(C.LIT) ;CURRENT CELL IS A PSEUDO-LITERAL
;USED FOR CURRENT CELL IS EXPRESSION ---
BIT(S.AT) ;SEEN A @
BIT(S.ADR) ;SAW AN ADDRESS
BIT(S.IDX) ;SAW AN INDEX
BIT(S.AC) ;SAW AN AC
BIT(S.OP) ;SEEN AN OPCODE
BIT(S.ASG) ;THIS STATEMENT ASSIGNS VALUE
BIT(S.DC) ;SAW A ,,
BIT(S.DC1) ;TEMP BIT FOR ,, PROCESSING
BIT(S.IOWD) ;SEEN AN IOWD
BIT(S.XWD) ;SEEN AN XWD
BIT(S.EXT) ;SAW "##" AFTER SYMBOL NAME
BIT(S.DEF) ;SAW "#" AFTER SYMBOL NAME
BIT(S.NNUL) ;STATEMENT IS NOT NULL
BIT(S.NPS) ;STATEMENT IS NOT PRIMARY,IE. "<>" OR "[]" OR "()"
BIT(I.OP) ;IN OP-CODE FIELD
BIT(S.ASCZ) ;CURRENT ASCII GETS NULL AT END
BIT(P.IOWD) ;IOWD PSEUDO OP PENDING
BIT(P.XWD) ;XWD PENDING
BIT(P.AT) ;@ INDICATOR PENDING
EVALS:
PUSH P,%F ;SAVE CURRENT STATE
PUSH P,%S
PUSH P,%R
PUSH P,%V ;ACS %(F,S,R,V)
SETZB %R,%F ;CLEAR THE ACS
SETZB %V,%S ;FOR CURRENT USE
CAIE CC,74 ;START WITH 74
CAIN CC,"[" ;OR WITH LITERAL INDICATOR?
TXO %F,S.NPS ;NOT A PRIMARY THEN
CAIN CC,"(" ;ALSO IF INDEX
TXO %F,S.NPS ;THEN ITS NOT PRIMARY
TXO %F,I.OP ;START IN OP CODE FIELD
EVALS1:
PUSHJ P,EVALEX ;GET FIRST EXPRESSION
TXNN D,C.ASG ;IS THIS ASSIGNMENT?
JRST EVLS1A ;NO,SO SKIP SETTING UP
TXOE %F,S.ASG ;REMEMBER THIS FOR LATER
JRST QERROR ;ERROR IF WE ALREADY KNOW
PUSH P,ASGSYM ;SAVE OLD SYMBOL TO ASSIGN TO
PUSHJ P,ASGEVL ;GO EVALUATE PLETHORA OF TYPES
JRST EVALS1 ;NOW GO DO THE STATMENT ITSELF
EVLS1A:
TXNN D,C.NULL ;IF NOT NULL CELL,
TXO %F,S.NNUL ;TURN ON NOT NULL BIT
TXZN %F,P.AT ;INDIRECT BIT INDICATOR SEEN?
JRST EVALS2 ;NO,SKIP TEST,TURN ON
TXOE %F,S.AT ;ONLY ONE INDIRECT BIT PER STATEMENT
JRST QERROR ;FILTER OUT DUPLICATES
TXO %V,<@> ;TURN IT ON IN THE WORD RETURNED
TXO %F,S.OP ;ILLEGAL TO SEE OPCODE NOW
TXZ %F,I.OP ;AND WE ARE NOT IN THAT FIELD
EVALS2:
TXNE %F,I.OP ;IN OPCODE FIELD?
TXNN D,C.OP ;WITH AN OPCODE RETURNED?
CAIA
JRST EVALS4 ;YES,SO ITS NOT AN AC
BYPASS ;GET NEXT CHARACTER
SKPCM ;END WITH COMMA?
JRST [TXO F,REGET ;NO
JRST EVALS4] ;SO ITS NOT AN AC
TXNE %F,P.XWD!P.IOWD ;IF IOWD OR XWD SEEN,
JRST EVLS2B ;PROCESS IT
PUSH P,A ;SAVE AC A
PUSHJ P,MACPEK ;LOOK AHEAD ONE CHARACTER
CAIN A,"," ;OR IS IT ANOTHER COMMA?
JRST EVLS2A ;YES,HANDLE IT
POP P,A ;NO,RESTORE VALUE
TXNN D,C.IDX+C.AT ;TRY TO CATCH SOME JUNK
TXOE %F,S.AC ;AND CHECK FOR STUFF
JRST QERROR ;ONLY 1 AC FIELD ALLOWED
JUMPN B,RERROR ;MUST BE ABSOLUTE AND DEFINED
JUMPN C,FERROR ;TO BE USED AS AN AC
ANDI A,17 ;MASK TO MAXIMUM
LSH A,^D23 ;GET IT INTO POSITION
ADD %V,A ;AND ADD INTO IT
JRST EVALS7
EVLS2A:
POP P,A ;RESTORE VALUE
PUSHJ P,MIC ;EAT THE SECOND COMMA
EVLS2B:
TXOE %F,S.DC!S.AC!S.XWD!S.IOWD ;MAKE SYNTAX CHECK
JRST QERROR ;
TXO %F,S.DC1 ;MORE PROCESSING LATER
JRST EVALS5 ;CONTINUE
EVALS4:
TXNN D,C.IDX ;INDEX?
JRST EVALS5 ;NO
TXOE %F,S.IDX ;PREVENT DUPLICATES
JRST QERROR
TXO %F,S.OP!S.AC!S.AT!S.ADR ;PREVENT ANY FURTHER STUFF
ADD %V,A ;ADD IN
ADD %R,B ;ALSO THE RELOCATABILITY
JRST EVALS6 ;CHECK IST AND CONTINUE
EVALS5:
TXZN %F,I.OP ;STILL IN OPCODE FIELD?
JRST EVLS5A ;NO,MUST BE ADDRESS FIELD
TXOE %F,S.OP ;FLAG OPCODE SEEN AND
JRST QERROR ;KILL ON DUPLICATE
MOVE %V,A ;LOAD VALUE
MOVE %R,B ;RELOCATABILITY
JRST EVALS6 ;CONTINUE AS USUAL
EVLS5A:
TXOE %F,S.ADR ;ADDRESS?
JRST QERROR ;BY DEFAULT , I GUESS IT IS
TXO %F,S.OP!S.AC!S.AT ;PREVENT REDUNDANT STUFF
TLNE A,-1 ;IS LEFT HALF ZERO?
TLC A,-1 ;NO,TRY COMPLEMENT
TLNE A,-1 ;AND REPEAT TEST
JRST QERROR ;ERROR IF NOT -1,,VALUE OR 0,,VALUE
TLNE C,-1 ;CANT BE A FIXUP ON LH
JRST QERROR
JUMPN C,[ MOVX T,IS.FW ;ADDRESS IS NOT FULL WORD FIXUP
ANDCAM T,1(C) ;SO TURN OFF THAT FLAG IN IST
JRST .+1] ;SO ONLY RH GETS FIXED
MOVE T,%V ;DO HALF WORD ADDITION
ADD T,A ;SO DONT WIPE OUT
HRRM T,%V ;OPCODE ETC.
ADD %R,B ;ADD IN THE RELOCATION TOO
EVALS6:
TLNE %S,-1 ;DONT ALLOW 2 RHALVES OR 2 LHALVES ON
TLNN C,-1
CAIA
JRST FERROR
TRNE %S,-1
TRNN C,-1
CAIA
JRST FERROR ;IE LH(%S) + RH(C) IS OK,ETC
IOR %S,C ;MERGE THE TWO
TXZN %F,S.DC1 ;HALFWORD SWAP INDICATED?
JRST EVALS7 ;NO,SO CHECK DELIMITERS
TLNN %R,-1 ;IF FIXED UP OR RELOCATED LH
TLNE %S,-1 ;
JRST QERROR ;THEN CANT DO WITHOUT LOSING DATA
TLNE %V,-1 ;IS VALUE ITSELF 0 IN LH?
TLC %V,-1 ;NO,TRY TO SEE IF ITS -1
TLNE %V,-1 ;AND REPEAT TEST
JRST QERROR ;INDICATE LOST DATA
MOVSS %V ;SWAP VALUE
MOVSS %R ;RELOCATION
MOVSS %S ;AND FIXUP
;FALL INTO EVALS7
EVALS7:
TXZ %F,I.OP ;NOT IN OPCODE AFTER FIRST TOKEN
BYPASS ;GET NEXT NON BLANK
CAIE CC,")" ;RETURN ON ),L. ANGLE BRACKET,$EOL
CAIN CC,76
JRST EVALS9 ;END OF EXPRESSION
CAIN CC,"]" ;END OF PSEUDO-LITERAL
JRST EVALS9 ;YES,EXIT
CAIE CC,";" ;END OF LINE?
CAIN CC,$EOL ;OF SOME FLAVOR
JRST EVALS9 ;YES, RETURN
TXO F,REGET ;REGET IT
JRST EVALS1 ;AND RED-ITERATE
EVALS9:
TXNN %F,P.IOWD ;IOWD SEEN?
JRST EVLS9A ;NO,SO SKIP THE FIX UP
TLNE %R,-1 ;ABSOLUTE REQUIRED
JRST RERROR
TLNE %S,-1 ;MUST BE KNOWN TOO
JRST FERROR
HLRZ T,%V ;GET VALUE TO NEGATE
MOVNS T ;NEGATE IT
SOS %V ;BACK ADDRESS BACK ONE
HRLM T,%V ;RESTORE VALUE (LH)
EVLS9A:
MOVEM %V,R%V ;RETURN ACS INTO R%<AC>
MOVEM %R,R%R ;
MOVEM %S,R%S
MOVEM %F,R%F ;FOR LATER EXAMINATION
SETZM NULFLG ;CLEAR "THIS IS NULL STATEMENT" FLAG
TXNN %F,S.NNUL ;IS NOT NULL FLAG ON?
SETOM NULFLG ;NO,SO IT IS NULL
TXNN %F,S.ASG ;WAS THIS BEING ASSIGNED TO SYMBOL?
JRST EVLS9B ;NO,SO DONT CALL ASGMAK
PUSHJ P,ASGMAK ;MAKE THE ASSIGNMENT
POP P,ASGSYM ;RESTORE PREVIOUS VALUE
EVLS9B:
POP P,%V ;RESTORE PREVIOUS VALUES
POP P,%R
POP P,%S
POP P,%F ;
POPJ P, ;AND THEN RETURN
; /EVADR/ - ROUTINE TO EVALUATE STANDARD ADDRESS FORMAT
;
; THIS ROUTINE RETURNS IN THE AC BLOCK A-D AN EXPRESSION
; CREATED BY EVALUATING A STRING OF THE FORM:
; (WITH ALL PARTS OPTIONAL)
; <@> <EXPRESSION> <(EXPRESSION)>
;
EVADR:
SETZ A, ;START WITH 0
BYPASS
CAIN CC,"@" ;INDIRECT BIT WOULD COME FIRST
SKIPA A,[<@>] ;MARK PROPER BIT ON
TXO F,REGET ;OTHERWISE,REGET CHARACTER
PUSH P,A ;SAVE PARTIAL RESULT
PUSHJ P,EVALEX ;EVALUATE ADDRESS PART
TLNE A,-1 ;INSURE LH=0
TLC A,-1
TLNE A,-1
JRST QERROR ;
IORM A,0(P) ;UPDATE PARTIAL RESULT
PUSH P,B ;SAVE RELOC
PUSH P,C ;SAVE FIXUP
CAIE CC,"(" ;DO WE HAVE INDEX NEXT?
JRST EVADR2 ;NO,SO SKIP IT
PUSHJ P,EVALEX ;EVALUATE IT
CAIN CC,")" ;MAKE SURE OF MATCHING PARENS
JRST QERROR ;ELSE BOMB OUT
BYPASS ;LOAD NEXT CHARACTER
TXO F,REGET ;FOR CHECKS LATER
MOVE T,0(P) ;GET FIXUP WORD
TLNE T,-1 ;PREVENT FOULUPS
JRST [TLNE C,-1
JRST FERROR
JRST .+1]
TRNE T,-1
JRST [TRNE C,-1
JRST FERROR
JRST .+1]
ADDM A,-2(P) ;UPDATE VALUE
ADDM B,-1(P) ;UPDATE RELOCATION
ADDM C,0(P) ;UPDATE FIXUP
EVADR2:
POP P,C ;RETURN WITH FIXUPS HERE
POP P,B ;RELOC HERE
POP P,A ;VALUE HERE
TLNE C,-1 ;DONT ALLOW LH FIXUPS
JRST QERROR
JUMPN C,[ MOVX T,IS.FW ;THIS IS 18 BIT ADDRESS
ANDCAM T,1(C) ;SO ITS NOT A FULLWORD FIXUP
JRST .+1] ;
TDNE A,[<^-<Z @ -1(17)>>] ;GENERATE Q ERROR IF NON-ADDR
JRST QERROR ;AREN'T 0
MOVX D,C.NUM ;CALL IT A NUMBER
POPJ P, ;AND RETURN
; /EVALEX/ - THIS ROUTINE COMBINES CELLS SEPARATED BY BINARY OPERATORS
; INTO EXPRESSIONS. THE ROUTINE USES A TABLE OF OPERATORS AND
; THEIR RELATIVE PRECEDENCE TO KNOW WHEN TO STACK AND WHEN TO EXECUTE
; AND COLLAPSE. THE ROUTINE EXITS WHEN THE SYMBOL AFTER
; A READ IN CELL IS NOT RECOGNIZED AS A VALID BINARY OPERATOR.
; TWO STACKS ARE USED: OPRSTK FOR OPERANDS AND OPTSTK FOR
; OPERATORS. SPECIAL SAFETY CHECKS ARE MAINTAINED TO INSURE PHASE OF THESE STACKS
; ROUTINE CELL RETURNS THE 4 REGISTER BLOCK OF
; VALUE,RELOCATION,FIXUP , FLAGS IN ACS A-D AND EVALEX IN TURN RETURNS ONE
; VALUE FOR THE WHOLE EXPRESSION, IN THESE ACS.
;
IMPCHR==200 ;IMPOSSIBLE ASCII CHARACTER
;USED TO MAKE CHARACTER ENTRY IN TABLES
;FOR TWO CHARACTER OPS (IE ^!)
EVALEX:
PUSH P,OPRTOP ;SAVE LAST TOP OF STACK
PUSH P,OPTTOP ;FOR OPERANDS AND OPERATORS
MOVE T,OPTPTR ;SET OUR CURRENT STACK FRAME START
MOVEM T,OPTTOP
MOVE T,OPRPTR ;SO WE KNOW OUR LIMITS
MOVEM T,OPRTOP
PUSHJ P,CELL ;GET FIRST CELL
TXNE D,C.NULL ;IS IT THE NULL CELL?
JRST EVLXX1 ;YES,RETURN 0
JRST .+2 ;PROCESS EXPRESSION
EVALXB:
PUSHJ P,CELL ;GET A CELL
EVLXB1:
TXNE D,C.NULL ;DONT ALLOW NULL CELLS HERE
JRST QERROR
PUSHJ P,PSHOPR ;PUSH OPERAND QUARTET ONTO STACK
TXNN %F,I.OP ;SPECIAL CHECK FOR OPCODE FIELD
JRST EVLXB2 ; NOT IN THAT FIELD
TXNE D,C.OP!C.ASG ;IS THIS OPCODE OR ASSIGNMENT SYMBOL?
JRST [SETZ A, ;YES,SO FORCE END OF EXPRESSION
JRST EVALX2] ;
EVLXB2:
BYPASS ;GET FIRST NON-BLANK CHAR
TXNE D,C.NUM ;SKIP THIS IF CELL NON-NUMERIC
CAIE CC,"B" ;DID CELL TERMINATE ON "B"?
JRST EVLXB3 ;NO,SO SKIP THIS
PUSH P,A ;SAVE A
PUSH P,CC ;SAVE CC
PUSHJ P,MACPEK ;LOOK AHEAD ONE CHARACTER
SETZ T, ;ZERO FLAG
MOVE CC,A ;GET INTO POSITION
SKPNUM ;SEE IF NEXT CHARACTER IS DIGIT
SKPR50 ;SEE IF NEXT CHARACTER IS RADIX50
SETO T, ;TURN FLAG ON IF NUMERIC OR NOT RADIX50
POP P,CC ;RESTORE CC
POP P,A ;RESTORE A
JUMPL T,EVALXN ;PROCESS BIT POSITIONER
EVLXB3:
CAIN CC,"^" ;IF CHARACTER IS UPARROW
JRST [ PUSHJ P,MACPEK ;LOOK AHEAD
CAIE A,"!" ;CURRENT BOP FOLLOWING ^ IS !
JRST .+1
PUSHJ P,MIC
MOVEI CC,IMPCHR+"!"
JRST .+1]
MOVSI A,-BOPLEN ;LENGTH OF TABLE
EVALX1:
LDB B,[POINT 8,BOPTAB(A),7] ;GET A CHARACTER FROM TABLE
CAMN B,CC ;IS IT A MATCH?
JRST EVALX2 ;YES,WE HAVE A BOP
AOBJN A,EVALX1 ;NO. ANY MORE LEFT?
TXO F,REGET ;RE-EAT THE CHARACTER
SKIPA A,[0] ;USE FAKE INDEX OF 0
EVALX2:
HRRZS A ;A IS NOW INDEX TO TABLE
MOVE T,OPTPTR ;GET POINTER TO OPTSTAK
CAMN T,OPTTOP ;IS IT THE EMPTY STACK?
JRST [JUMPLE A,EVALXX ;YES,IF A.LE.0,SIMPLE CELL
MOVE T,A ;SO SAVE OPERAND,OPERATOR ON STACK
PUSHJ P,PSHOPT ;FOR LATER EVALUATION
JRST EVALXB] ;AND GET RH OF EXPRESSION
LDB B,[POINT 5,BOPTAB(A),12] ;GET PRECEDENCE OF WINDOW OP
PUSHJ P,POPOPT ;POP OP ON TOP OF STACK
LDB C,[POINT 5,BOPTAB(T),12];GET ITS PRECEDENCE
CAML C,B ;EXECUTE TIME?
JRST EVALX4 ;YES,GO DOIT
PUSHJ P,PSHOPT ;NO,RESTORE OLD OP TO TOP OF STACK
MOVE T,A ;GET INDEX OF CURRENT OP
PUSHJ P,PSHOPT ;STACK IT TOO
JRST EVALXB ;GET NEXT CELL
EVALX4:
PUSH P,A ;SAVE WINDOW OP'S INDEX
PUSHJ P,$XCT ;EXECUTE THE OPERATOR
POP P,A ;RESTORE INDEX
JRST EVALX2 ;AND RE-ITERATE
EVALXX:
PUSHJ P,POPOPR ;LOAD A-D WITH FINAL OPERAND QUARTET
MOVE T,OPRPTR ;FINAL CONSISTENCY CHECK
CAME T,OPRTOP ;STACK SHOULD BOTH BE EMPTY
JRST QERROR
EVLXX1:
POP P,OPTTOP ;RESTORE TOP OF STACKS
POP P,OPRTOP ;FOR LAST CALLER
TLNN A,-1 ;SEE IF ANY DATA IN LEFT HALF OF
TLNE B,-1 ;RETURNED EXPRESSION
TXO D,C.LHNZ ;FOR EASE OF CHECK VALIDITY
TLNE C,-1 ;LATER
TXO D,C.LHNZ ;
POPJ P, ;AND RETURN
EVALXN: ;HERE FOR <NUMBER>B<CELL>
PUSHJ P,CELL10 ;EVALUATE NEXT CELL,RADIX10.
TXNE D,C.NULL ;IF NULL CELL
JRST NERROR ;ITS AN ERROR
JUMPN B,RERROR ;MUST BE ABSOLUTE
JUMPN C,FERROR ;IN CASE WE DONT KNOW IT
MOVEI T,^D35 ;SET UP FOR SHIFT
SUB T,A ;SHIFT 36-<CELL>
PUSHJ P,POPOPR ;GET THE OPERAND
LSH A,(T) ;SHIFT INTO PLACE
LSH B,(T) ;ALSO SHIFT RELOCATABLE BITS
JRST EVLXB1 ;AND CONTINUE
EVLX10: ;HERE TO CALL EVALEX WITH RADIX=^D10
PUSH P,CRADIX ;SAVE CURRENT RADIX
MOVEI T,^D10 ;USE BASE 10.
MOVEM T,CRADIX ;FOR RADIX IN THIS EXPRESSION
PUSHJ P,EVALEX ;NOW EVALUATE EXPRESSION
POP P,CRADIX ;RESTORE RADIX
POPJ P, ;AND RETURN
; SUBROUTINE TO EXECUTE BINARY OPERATORS IN MACRO STATEMENTS
;
; ENTER WITH AC T BEING THE INDEX INTO BOPTAB
; TOP TWO OPERAND QUARTETS ON OPRSTK ARE EVALUTED AND THE RESULT
; PUSHED BACK ONTO OPRSTK
;
; LOCAL REGISTER ASSIGNMENTS
%LV==A ;LEFT HAND VALUE
%LR==B ;LEFT HAND RELOC
%LS==C ;LEFT HAND SYMBOL FIXUP
%LF==D ;LEFT HAND FLAGS
%RV==T1 ;RIGHT HAND VALUE
%RR==T2 ;RIGHT HAND RELOC
%RS==T3 ;RIGHT HAND SYMBOL FIXUP
%RF==T4 ;RIGHT HAND FLAGS
$XCT:
PUSHJ P,.PSH4T## ;SAVE ACS,WE NEED THEM
PUSHJ P,POPOPR ;GET OPERAND (LH)
MOVE %RV,A ;STORE RIGHT HAND SIDE AWAY
MOVE %RR,B
MOVE %RS,C
MOVE %RF,D
PUSHJ P,POPOPR ;POP LEFT HAND OPERAND
JRST @BOPTAB(T) ;DISPATCH ON TABLE
$ADD:
ADD %LV,%RV ;ADD IS LV+RV
ADD %LR,%RR ;ADD IS RELOC+RELOC
TLNE %LS,-1 ;ALLOW EITHER HALF TO BE FIXED UP
JRST [ TLNE %RS,-1
JRST FERROR
JRST .+1]
TRNE %LS,-1
JRST [ TRNE %RS,-1
JRST FERROR
JRST .+1]
IOR %LS,%RS ;INCLUSIVE OR THE SYMBOL FIXUPS
JRST $XCT2 ;DONE
$SUB:
MOVE T,%RS ;GET RH SYMBOL FIXUP
JUMPN T,[JUMPN %LS,FERROR ;CHECK FORWARD REFERENCE
PUSH P,A
MOVX A,IS.DER ;DONT ALLOW SUBTRACTION OF EXTERNAL
TDNE A,1(T)
JRST FERROR
MOVX A,IS.NEG ;NEGATE FIXUP
IORM A,1(T) ;SET FLAG TO INDICATE IT
HLRZS T
POP P,A
JRST .] ;TRY OTHER HALF
IOR %LS,%RS
SUB %LV,%RV ;DO THE SUBTRACTION
SUB %LR,%RR ;ALSO THE RELOCATION
JRST $XCT2 ;AND CONTINUE
$MUL:
JUMPE %LR,.+3 ;MUST HAVE ONE SIDE FIXED
JUMPE %RR,.+2 ;
JRST RERROR ;BUT WE DONT
JUMPN %LS,FERROR ;CANT LET
JUMPN %RS,FERROR ;EITHER SIDE BE DEFERRED
TXNN %LF,C.FLT ;CANT MULTIPLY FLOATING POINT
TXNE %RF,C.FLT ;
JRST NERROR ;
IOR %LR,%RR ;
JUMPE %RR,.+2 ;MAKE RIGHT SIDE BE FIXED VALUE
EXCH %RV,%LV ;SO RELOC COMES OUT RIGHT
IMUL %LV,%RV ;DO THE MULTIPLICATION
IMUL %LR,%RV ;ALSO ON THE RELOC BITS
JRST $XCT2 ;DONE
$DIV:
JUMPN %LS,FERROR ;BOTH SIDES MUST BE KNOWN
JUMPN %RS,FERROR
JUMPN %RR,RERROR ;DENOMINATOR MUST BE FIXED
TXNN %LF,C.FLT ;CANT DIVIDE FLOATING POINT
TXNE %RF,C.FLT ;
JRST NERROR ;
PUSH P,%LV+1 ;COVER UP
IDIV %LV,%RV ;DIVIDE
POP P,%LV+1
IDIV %LR,%RV ;
SETZM %LS ;INCASE DIVIDE OF %LR PUTS ANYTHING HERE
JRST $XCT2 ;DONE
$AND:
JUMPN %LS,FERROR ;FOR AND MUST HAVE BOTH SIDES
JUMPN %RS,FERROR
IOR %LR,%RR ;FOR LATER CHECK
AND %LV,%RV ;AND THE VALUES
JRST $XCT1 ;THATS ALL
$OR:
JUMPN %LS,FERROR ;MUST KNOW BOTH
JUMPN %RS,FERROR
IOR %LV,%RV ;OR THE VALUES
IOR %LR,%RR ;AND RELOC
JRST $XCT1 ;DONE
$XOR:
JUMPN %LS,FERROR ;CANT USE DEFERRED VALUES
JUMPN %RS,FERROR
XOR %LV,%RV ;XOR
IOR %LR,%RR ;FOR LATER CHECK
JRST $XCT1
$LSH:
JUMPN %LS,FERROR ;
JUMPN %RS,FERROR ;BOTH MUST BE KNOWN
JUMPN %RR,RERROR ;SHIFT VALUE MUST BE FIXED
LSH %LV,(%RV) ;DO THE SHIFT
LSH %LR,(%RV) ;ALSO ON THE RELOC
JRST $XCT2
$XCT1:
JUMPN %LR,RERROR ;CHECK FOR FIXED RESULT
$XCT2:
IOR %LF,%RF ;COMBINE FLAGS
PUSHJ P,PSHOPR ;
PUSHJ P,.POP4T## ;RESTORE THE ACS
POPJ P, ;RETURN
; TABLE OF BINARY OPERATORS AND THEIR PRECEDENCES
;
; FORMAT OF EACH ENTRY IS AS FOLLOWS:
;
; BITS:
; 0-7 ASCII CHARACTER OF OPERATOR,NOTE THAT ITS 8 BITS TO ALLOW
; FOR FAKE CHARACTERS.
; 8-12 THE RELATIVE PRECEDENCE FOR THIS OPERATOR, IN RANGE 0-32
; 13 LEAVE IT OFF, SO CAN USE INDIRECT SAFELY
; 18-35 ADDRESS OF ROUTINE TO EXECUTE THIS OPERATOR
;
DEFINE DBOP<
X 0,0,0 ;FAKE ENTRY TO FORCE REDUCTION
X "+",2,$ADD
X "-",2,$SUB
X "*",4,$MUL
X "/",4,$DIV
X "&",6,$AND
X "!",6,$OR
X "!"+IMPCHR,6,$XOR
X "_",8,$LSH
> ; END OF DBOP DEFINITION
DEFINE X($A,$B,$C)<
IFG <$B>-^D32, <PRINTX PRECEDENCE TOO GREAT IN BOPTAB>
<$A>B7+<$B>B12+<$C>
>
BOPTAB:
DBOP
BOPLEN==.-BOPTAB
; /CELL/- THIS ROUTINE EVALUATES THE LOWEST LEVEL OF MACRO TOKEN.
; SUCH AS SYMBOL,NUMBER, CONSTANT ETC. THESE ARE COMBINED BY
; EVALEX WITH EVALS DOING THE CONTEXT SENSITIVE INTERPRETATION.
; CELL INTERPRETS THE LOW LEVEL TOKENS BY LOOKING AT THE
; FIRST CHARACTER OF THE CELL AND THEN DISPATCHING TO THE APPROPRIATE
; PROCESSOR FOR THAT CELL. THE VALUE ETC OF THE CELL IS RETURNED
; IN A FOUR WORD AC BLOCK.
;
; OUTPUTS:
; AC A CONTAINS THE VALUE OF THE READ IN CELL
; AC B CONTAINS THE RELOCATION MULTIPLIER IN EACH HALF WORD
; AC C CONTAINS , IN EACH HALFWORD POSSIBLE POINTERS TO THE
; IST FOR FIXUPS ON LITERALS,EXTERNALS AND FORWARD REFERENCES
; AC D CONTAINS FLAG(S) WHICH TELL HIGHER ROUTINES WHAT KIND
; OF CELL WAS JUST READ IN.
;
; IF THE FIRST CHARACTER IS NOT RECOGNIZED, A Q ERROR IS GENERATED.
CELL:
PUSHJ P,MIC ;GET A CHARACTER
SKPNUM ;TEST FOR NUMERIC
CAIA ;SKIP IF NOT
JRST EVLP1 ;PROCESSOR 1 (NUMBER)
CAIN CC,"." ;PERIOD?
JRST CELL1C ;YES,SHORT CIRCUIT THE SYMBOL CUTOUT
SKPR50 ;RADIX50 SYMBOL?
CAIA ;NO
JRST EVLP2 ;PROCESSOR 2 (SYMBOL)
CELL1C:
MOVSI A,-FCDSPL ;LENGTH OF FIRST CHARACTER TABLE
CELL1D:
LDB B,[POINT 7,FCDSP(A),6] ;GET CHARACTER
CAMN CC,B ;A MATCH?
JRST @FCDSP(A) ;YES,GO TO IT
AOBJN A,CELL1D ;MORE LEFT?
JRST QERROR ;NO,SO GIVE ERROR MESSAGE
ECELL:
POPJ P, ;RETURN
NCELL: ;HERE FOR NULL CELL
TXO F,REGET ;REGET THE DELIMITER
SETZB A,B ;CLEAR RESULT
SETZ C,
MOVX D,C.NULL ;FLAG IT AS NULL
JRST ECELL ;AND RETURN
CELL10: ;RADIX10 CELL CALL
MOVEI A,^D10 ;USE RADIX 10.
PUSH P,CRADIX ;SAVE CURRENT RADIX
MOVEM A,CRADIX ;
PUSHJ P,CELL ;EVALUATE CELL
POP P,CRADIX ;RESTORE RADIX
POPJ P, ;AND RETURN
MECELL: ;THIS CELL MUST TERMINATE STATEMENT
TXO F,REGET ;START WITH CURRENT CHARACTER
MCELL1: BYPASS ;START W/NEXT CHARACTER
CAIE CC,$EOL ;MUST BE END OF LINE OR
CAIN CC,";" ;COMMENT
JRST NCELL ;ITS A NULL CELL
JRST QERROR ;ITS A QERROR
DEFINE FC < ;DEFINE FIRST CHARACTER DISPATCH
;TABLE FOR EVALUATOR
IFE BIGLST,<XLIST>
X " ",CELL ;SKIP BLANKS
X "+",CELL ;AND UNARY "+"
X "@",EVLP3 ;AT SIGN (INDIRECT BIT)
X "-",EVLP4 ;UNARY MINUS "-"
X "'",EVLP5 ;SINGLE QUOTE,SIXBIT RIGHT JUSTIFIED
X 42,EVLP5A ;DOUBLE QUOTE ASCII RIGHT JUSTIFIED
X "(",EVLP6 ;( MEANS INDEXING
X "[",EVLP7 ;[ MEANS START PSEUDO-LITERAL
X 74,EVLP8 ;L. BRACKET,START EXPRESSION
X ".",EVLP9 ;PERIOD. NUMBER,CURRENT LOC, OR SYMBOL
X "^",EVLP12 ;UP-ARROW QUALIFIER
X <";">,NCELL ;IF INTO COMMENT,NULL CELL
X $EOL,NCELL ;SAME FOR END OF LINE
X <"]"> , NCELL ;AND LITERAL
X 51 , NCELL ;AND INDEX
X 76, NCELL ;AND EXPRESSION
X 54,NCELL ;ALLOWS THINGS LIKE SETZM,FOO
LIST
> ; END OF FC DEFINITION
; NOW LETS CREATE THE TABLE
DEFINE X($A,$B)<
<$A>B6+$B>
FCDSP: FC
FCDSPL==.-FCDSP
; PROCESSOR 1 - PROCESS NUMBER
EVLP1:
PUSH P,CC ;SAVE FIRST CHARACTER
TXO F,REGET ;REGET FIRST DIGIT
PUSHJ P,MACSAV ;SAVE POSITION
PUSHJ P,CRADIN ;GET NUMBER
CAIN CC,"." ;IS TERMINATOR A PERIOD?
JRST EVLP1A ;YES,GO HANDLE IT
POP P,0(P) ;CLEAN STACK
SETZB B,C ;NOT RELOCATABLE OR A SYMBOL
MOVX D,C.NUM ;FLAG CELL AS NUMERIC
TXO F,REGET ;REGET OUR DELIMITER
JRST ECELL ;END OF CELL
EVLP1A:
PUSHJ P,MACRST ;START NUMBER OVER AGAIN
POP P,CC ;RESTORE CHARACTER
TXO F,REGET ;AND REGET IT
SETZ A, ;CLEAR RESULT
EVLN1A:
PUSHJ P,MIC ;GET CHARACTER
CAIN CC,"." ;PERIOD?
JRST EVLN2 ;YES,HANDLE FRACTION
SKPNUM ;IS IT A DIGIT?
JRST NERROR ;NO,BADLY FORMED DIGIT
SUBI CC,"0" ;MAKE NUMBER
TLO CC,233000 ;FLOAT IT
FMPR A,[10.0] ;SHIFT OVER
FADR A,CC ;ADD IN OUR PART
JRST EVLN1A ;GO BACK FOR MORE
EVLN1B:
SETZ A, ;NUMBER FRACTION ONLY
EVLN2:
MOVE D,[0.1] ;FIRST FRACTION DIGIT
EVLN2A:
PUSHJ P,MIC ;GET CHARACTER
SKPNUM ;IS IT NUMERIC?
JRST EVLNF ;NO,FINISH UP
SUBI CC,"0" ;NUMBER IT
TLO CC,233000 ;FLOAT IT
FMPR CC,D ;MULTIPLY TO GET IT FRACTIONAL
FADR A,CC ;ADD IN THIS PART
FDVR D,[10.] ;MAKE OUR FRACTION SMALLER
JRST EVLN2A ;BACK FOR MORE
EVLNF:
CAIN CC,"E" ;END IN EXPONENT?
PUSHJ P,NUMEXP ;YES,GO PROCESS
SETZB B,C ;NO FIXUP OR RELOC
TXO F,REGET ;REGET DELIMITER
MOVX D,C.NUM+C.FLT ;
JRST ECELL ;END IT
NUMEXP:
PUSH P,A ;SAVE VALUE OF NUMBER
PUSHJ P,CELL10 ;GET EXPONENT IN RADIX10
JUMPE A,QERROR ;E0 IS ILLEGAL
TXNN D,C.FLT+C.IDX+C.LIT+C.SYM+C.NULL ;FILTER OUT SOME JUNK
TXNN D,C.NUM ;BUT MUST BE NUMERIC
JRST NERROR
CAIG A,^D38 ;DONT LET IT BE TOO BIG
CAMGE A,[-^D38] ;OR TOO SMALL
JRST NERROR ;
JUMPN C,FERROR ;MUST BE COMPLETELY KNOWN
JUMPN B,NERROR ;AND NON-RELOCATABLE
MOVE C,[1.0] ;START C WITH EXP MULTIPLIER
MOVE B,[10.0] ;FOR POSITIVE EXPONENT
JUMPG A,NUMEX1 ;WAS IT POSITIVE?
MOVMS A ;NO,MAKE IT SO
MOVE B,[0.1] ;AND MAKE IT FRACTIONAL
NUMEX1:
FMPR C,B ;MULTIPLY BY EXPONENT (10. OR 0.1)
SOJG A,.-1 ;GO BACK <EXP> TIMES
FMPRM C,0(P) ;EXPONENTIATE PREVIOUS VALUE
POP P,A ;AND RESTORE IT
CAIN CC,76 ;IF EXPRESSION WAS EXPONENT
PUSHJ P,MIC ;EAT IT
POPJ P, ;THEN RETURN
; PROCESSOR 2 -PROCESS A SYMBOL
EVLP2:
TXZ %F,S.EXT!S.DEF ;CLEAR FLAGS
TXO F,REGET ;REGET THE CHARACTER
PUSHJ P,SYMIN ;GET THE SYMBOL
CAIN CC,"=" ;IS THIS "SYMBOL="?
JRST EVLP2D ;YES,GO HANDLE IT
CAIN CC,"#" ;DOES SYMBOL END WITH #?
JRST [PUSHJ P,MIC ;YES,GET NEXT CHARACTER
TXO %F,S.DEF ;CALL IT DEFINING REFERENCE
CAIE CC,"#" ;NEXT CHAR. ALSO A POUND SIGN?
JRST .+1 ;NO,RETURN HAVING EATEN SINGLE #
TXZ %F,S.DEF ;CLEAR FIRST FLAG
TXO %F,S.EXT ;AND,FLAG AS EXTERNAL
PUSHJ P,MIC ;GET NEXT CHARACTER
JRST .+1 ] ;AND RETURN
TXO F,REGET ;REGET DELIMITER OF SYMBOL
MOVE R,A ;PREPARE TO LOOK UP SYMBOL
TXNE %F,I.OP ;IN OPCODE FIELD?
JRST [PUSHJ P,MACSRC ;YES,SEARCH THAT FIRST
JRST .+1 ;SEARC FAILED
JRST EVLP20 ] ;SEARCH WAS SUCCESSFUL
PUSHJ P,SYMSRC ;
JRST [ TXNN %F,I.OP ;IN OPCODE FIELD?
PUSHJ P,MACSRC ;NO,HAVENT TRIED BUILT IN STUFF YET
JRST EVLP2A ;SEARCH EXHAUSTED
JRST EVLP20 ] ;FOUND IN BUILT IN TABLES
CAIN B,60 ;GLOBAL REQUEST TYPE SYMBOL?
JRST EVLP2C ;YES,PROCESS AS SUCH
MOVE B,D ;RELOCATION OF THE SYMBOL
TRNE D,2 ;CONVERT LH RELOCATION TO THIS FORMAT
TLO B,1 ;OF 1,,1 ETC
TRZ B,^-<1> ;DONT ALLOW ANYMORE IN RH
SETZ C, ;NO SYMBOL FIXUP NEEDED
MOVX D,C.SYM ;PUSH THE OPERAND
EVLP20:
TXNE %F,S.EXT!S.DEF ;WAS USER SAYING ITS EXTERNAL OR NEW?
JRST MERROR ;BUT ITS LOCAL AND EXISTING,SO COMPLAIN
TXNE D,C.POP ;IS THIS A PSEUDO-OP?
JRST 0(A) ;YES,THEN RETURNED VALUE IS NAME (IE ADDRESS)
;OF PROCESSOR FOR THIS PSEUDO-OP
JRST ECELL
EVLP2A:
PUSHJ P,ISTGET ;GET SLOT IN INTERIM SYMBOL TABLE
MOVEM R,0(C) ;STORE SYMBOL NAME
SETZM 1(C) ;CLEAR SECOND WORD
MOVX D,C.UDF+C.SYM ;FLAG AS UNDEFINED
MOVX A,IS.UDF ;UNDEFINED SYMBOL
TXNN %F,S.EXT ;WAS IT UNDEFINED EXTERNAL?
TXOA A,IS.FW ;NO,JUST MAKE IT OK FOR FULLWORD
TXO A,IS.DER ;YES,DEFERRED EXTERNAL REQUEST
MOVEM A,1(C) ;STORE AWAY THE FLAGS
SETZB A,B ;CLEAR RESULT AND RELOC
JRST ECELL ;END OF CELL
EVLP2C:
TXNE %F,S.DEF ;WASNT FOLLOWED BY "#"?
JRST MERROR ;ELSE ITS ERROR
PUSHJ P,ISTGET ;GET SLOT ON IST
MOVEM R,0(C) ;STORE SYMBOL NAME
MOVX A,IS.DER ;DEFFERED EXTERNAL REFERENCE
MOVEM A,1(C) ;STORE IT
SETZB A,B ;CLEAR VALUE,RELOCATION
MOVX D,C.EXT+C.SYM ;EXTERNAL SYMBOL
JRST ECELL ;END OF CELL
EVLP2D: ;HERE FOR "SYMBOL="
TXNN %F,I.OP ;ONLY ALLOW IT IN OPCODE FIELD
JRST QERROR ;ELSE ITS ERROR
MOVX D,C.SYM+C.ASG ;FLAG IT THE RIGHT WAY
SETZB B,C ;CLEAR RELOC AND SYMFIX
JRST ECELL ;AND RETURN
; PROCESSOR 3 -PROCESS AN AT-SIGN ( @ )
EVLP3:
TXOE %F,P.AT ;INDIRECT BIT PENDING ALREADY?
JRST QERROR ;YES,SO THIS IS AN ERROR
JRST CELL ;AND CONTINUE TO PROCESS THE CELL
; PROCESSOR 4 -PROCESS UNARY MINUS
EVLP4:
PUSHJ P,CELL ;GET CELL
TXNE D,C.OP!C.POP!C.AT!C.IDX!C.NULL ;FILTER OUT SOME STUFF
JRST QERROR ;ELSE ITS AN ERROR
JUMPN B,RERROR ;CANT NEGATE ADDRESS
JUMPN C,RERROR ;OR FORWARD REFERENCE
TXO D,C.NUM ;ITS A NUMBER
MOVNS A ;NEGATE CELL VALUE
JRST ECELL ;AND RETURN
; PROCESSOR 5 -PROCESS SIXBIT COMPRESSED ASCII
EVLP5:
SETZ A, ;CLEAR RESULT
MOVEI B,6 ;SET MAXIMUM
EVLP56:
PUSHJ P,MIC ;LOAD A CHARACTER
CAIN CC,"'" ;IS IT THE END?
JSP C,EVLP5C ;YES,DO END WORK
CAIN CC,$EOL ;DONT ALLOW END OF LINE
JRST QERROR ;INSIDE QUOTE
SOJL B,QERROR ;IF MAXIMUM EXCEEDED
SUBI CC," "-' ' ;CONVERT TO SIXBIT
ANDI CC,77 ;MAKE SURE IT COMES OUT RIGHT
LSH A,6 ;MAKE ROOM
IORI A,(CC) ;OR IN THE NEW CHARACTER
JRST EVLP56 ;GO AGAIN
; PROCESSOR 5A -PROCESS ASCII SEVEN BIT CHARACTERS
EVLP5A:
SETZ A, ;CLEAR RESULT
MOVEI B,5 ;5 CHARACTERS
TXO F,QUOTE ;DONT CONVERT CHARACTERS
EVLP57:
PUSHJ P,MIC ;GET A CHARACTER
CAIN CC,"""" ;IS THIS THE END?
JSP C,EVLP5C ;YES,DO FINISH UP WORK
SOJL B,QERROR ;IF MORE THAN 5 CHARACTERS
CAIN CC,$EOL ;END OF LINE?
JRST QERROR
LSH A,7 ;MAKE ROOM
IORI A,(CC) ;OR IN THE NEW CHARACTER
JRST EVLP57 ;NEXT CHARACTER
EVLP5C:
MOVEM A,T ;SAVE RESULT AWAY
PUSHJ P,MACPEK ;LOOK AHEAD ONE CHARACTER
EXCH A,T ;RESTORE RESULT, CHAR TO SAFE PLACE
CAME CC,T ;IS THIS CASE OF DOUBLE DELIMITER?
JRST EVLP5D ;NO,SO CONTINUE WITH END
PUSHJ P,MIC ;EAT THE SECOND OCCURENCE
JRST 0(C) ;AND CONTINUE PROCESSING
EVLP5D:
SETZB B,C ;CLEAR RELOC,SYMFIXUP
MOVX D,C.NUM ;CALL IT A NUMBER
TXZ F,QUOTE ;RESTORE NORMAL MODE
JRST ECELL ;END OF CELL
; PROCESSOR 6 -PROCESS AN INDEX EXPRESSION "(...)"
EVLP6:
PUSHJ P,EVALS ;CALL EVALUATE AGAIN
CAIE CC,")" ;SHOULDNT BE HERE TILL )
JRST QERROR ;IF NOT,ERROR
MOVS A,R%V ;SWAP HALVES OF RETURNED VALUE
MOVS B,R%R ;AND RELOCATION
MOVS C,R%S ;ALSO FORWARD REFERENCES
MOVX D,C.NUM+C.IDX ;NUMERIC,INDEX
JRST ECELL ;END OF CELL
; PROCESSOR 7 - PROCESS A PSEUDO-LITERAL "[......]"
EVLP7:
PUSH P,T1 ;SAVE ORIGINAL AC T1
MOVEI T1,4 ;GET 4 WORDS OF CORE
PUSHJ P,GETCOR ;FROM FREE MEMORY
PUSH P,T1 ;SAVE START ADDRESS AS START OF CHAIN
PUSH P,T1 ;SAVE START ADDRESS ACROSS EVALUTATION
EVLP7A:
PUSHJ P,EVALS ;EVALUATE STATEMENT
MOVE A,R%V ;RETURNED VALUE
MOVE B,R%R ;RETURNED RELOCATION
MOVE C,R%S ;RETURNED FIXUP
POP P,T1 ;GET POINTER TO 4-WORD BLOCK
MOVEM A,0(T1) ;WORD 0 GETS VALUE
MOVEM B,1(T1) ;WORD 1 GETS RELOCATION
MOVEM C,2(T1) ;WORD 2 GETS FIXUP
SETZM 3(T1) ;LINK TO NEXT BLOCK IS ZERO FOR NOW
TDNE B,[^-<1,,1>] ;CHECK FOR VALID RELOCATION
JRST RERROR ;BETTER TO GIVE ERROR MSG NOW
CAIN CC,"]" ;IS THIS CLOSE LITERAL?
JRST EVLP7B ;YES,SO GO FINISH UP
CAIE CC,";" ;CHECK FOR END OF LINE
CAIN CC,$EOL ;COMMENT OR REGULAR
SKIPA ;
JRST QERROR ;NOT ONE OF ($EOL, ; , ] ) IS ERROR
ADDI T1,3 ;T1 GETS POINTER TO LINK WORD OF BLOCK
PUSH P,T1 ;SAVE IT
MOVEI T1,4 ;GET NEXT BLOCK
PUSHJ P,GETCOR
MOVEM T1,@0(P) ;STORE THE LINK FROM PREV TO NXT
MOVEM T1,0(P) ;AND STORE THE BASE OF BLOCK
PUSHJ P,MACLOD ;LOAD NEXT LINE
JRST EVLP7A ;AND EVALUATE IT
EVLP7B:
PUSHJ P,ISTGET ;GET POINTER TO IST SLOT
POP P,0(C) ;WORD 1 OF PAIR IS POINTER TO 1ST
;BLOCK OF STRING OF BLOCKS
MOVX A,IS.LIT ;SET FLAGS IN WORD 2 OF PAIR
MOVEM A,1(C) ;
SETZ A, ;RETURN VALUE OF 0
MOVEI B,1 ;RELOCATED IN RH (WILL BE ADDRESS OF LITERAL)
MOVX D,C.LIT ;FLAG AS LITERAL
POP P,T1 ;RESTORE T1 TO ITS VALUE ON ENTRY
JRST ECELL ;END OF CELL
; PROCESSOR 8 -PROCESS A BRACKETED EXPRESSION "<.....>"
EVLP8:
PUSHJ P,EVALS ;EVALUATE STATEMNT
CAIE CC,76 ;RETURN VIA RIGHT A.BRACKET?
JRST QERROR ;NO,SO RETURN
MOVE A,R%V ;VALUE
MOVE B,R%R ;RELOCATION
MOVE C,R%S ;IST POINTER(S)
MOVX D,C.NUM ;NUMERIC
JRST ECELL ;END OF CELL
; PROCESSOR 9 - PROCESS THE CELL STARTING WITH . (PERIOD)
EVLP9:
PUSHJ P,MACPEK ;LOOK AHEAD ONE CHARACTER
EXCH CC,A ;PLACE WHERE TEST ROUTINES GET IT
SKPNUM ;A DIGIT FOLLOWS IT?
JRST .+2 ;NO
JRST EVLN1B ;PROCESS FLT PT NUMBER FRACTION
SKPR50 ;IN RADIX50 SET?
JRST .+3 ;NO
EXCH CC,A ;RESET CHARACTER AC
JRST EVLP2 ;PROCESS AS SYMBOL
MOVE A,CPADDR ;CURRENT LOCATION
MOVEI B,1 ;WHICH IS ADDRESS (IE RIGHT RELOC)
SETZ C, ;NO FORWARD REFERENCE
MOVX D,C.SYM ;ITS A SYMBOL
JRST ECELL ;DONE
; PROCESSOR 12 -PROCESS ^ (UP-ARROW) QUALIFIER.
EVLP12:
BYPASS ;LOAD NEXT NON-BLANK CHARACTER
SETZ T, ;CLEAR RADIX
CAIN CC,"D" ;BASE 10.?
MOVEI T,^D10 ;YES,SET IT
CAIN CC,"B" ;BASE 2.?
MOVEI T,^D2 ;YES,SET IT
CAIN CC,"O" ;BASE 8.?
MOVEI T,^D8 ;YES,SET IT
CAIN CC,"F" ;DECIMAL FRACTION?
JRST [$KILL(FNI,Qualifier ^F not implemented)]
CAIN CC,"L" ;JFFO INST?
JRST EVP12A ;YES,GO HANDLE IT
CAIN CC,"-" ;UNARY .NOT. ?
JRST EVP12B ;YES,GO HANDLE IT
JUMPE T,NERROR ;IF HERE WITH T=0,ITS ERROR
PUSH P,CRADIX ;SAVE CURRENT RADIX
MOVEM T,CRADIX ;AND REPLACE IT WITH OURS
PUSHJ P,CELL ;GET NEXT CELL,UNDER THIS RADIX
POP P,CRADIX ;RESET RADIX
TXNE D,C.NULL ;ILLEGAL TO QUALIFY NOTHING
JRST QERROR ;
EVP12Z:
TXNN D,C.NUM ;WAS GOTTEN CELL A NUMBER?
JRST NERROR ;NO,COMPLAIN
JRST ECELL ;ELSE RETURN
; ^L PROCESSOR
EVP12A:
PUSHJ P,CELL ;GET FOLLOWING CELL
TXNE D,C.NULL
JRST QERROR
JUMPN C,FERROR ;IF FORWARD REFERENCE , CANT HANDLE
JFFO A,.+2 ;COUNT ZEROES TO FIRST 1
MOVEI B,^D36 ;IF WHOLE WORD IS ZERO
MOVE A,B ;RETURNED VALUE IS RESULT
SETZ B, ;AND IT IS NOT RELOCATED
JRST EVP12Z ;RETURN
; ^- PROCESSOR
EVP12B:
PUSHJ P,CELL ;GET CELL
TXNE D,C.NULL
JRST QERROR
JUMPN C,FERROR ;CANT HANDLE FORWARD REFERENCE
JUMPN B,RERROR ;ERROR IF ITS RLOCATABLE
SETCA A, ;COMPLEMENT AC A (AC A,YOU'RE GREAT)
JRST EVP12Z ;AND FINISH,WITH USUAL CHECKS
; PROCESSORS 70-89 ARE RESERVED FOR PSEUDO-OPERATORS
;
;
; PROCESSOR 70 - PROCESS THE PSEUDO-OPERATOR 'ASCII'
EVP70:
MOVE C,[POINT 7,A] ;POINTER TO VALUE
MOVE D,[POINT 7,5] ;D GETS XWD PTR,BYTES PER WORD
SETZB A,WRDCNT ;CLEAR VALUE AND WORD COUNT
BYPASS ;GET DELIMITER
CAIN CC,$EOL ;IS IT END OF LINE?
JRST QERROR ;YES,RETURN ERROR
MOVEM CC,T ;SAVE DELIMITER
MOVEI B,5 ;BYTE COUNTER
TXO F,QUOTE ;NO CHARACTER CONVERSION
EVP70A:
PUSHJ P,MIC ;INPUT THE BYTE
CAMN CC,T ;A MATCH ON DELIMITER?
JRST EVP70D ;YES, END IT
PUSHJ P,NWCHK ;SEE IF NEW WORD NEEDED
CAIN CC,$EOL ;IS THIS AN END OF LINE?
JRST [PUSHJ P,MACLOD ;YES,SO LOAD NEXT LINE
MOVE CC,REOL ;RESTORE REAL END OF LINE
JRST .+1] ;AND CONTINUE
IDPB CC,C ;STORE THE CHARACTER
JRST EVP70A ;AND BACK FOR MORE
; PROCESSOR 71 - PROCESS THE PSEUDO-OPERATOR 'SIXBIT'
EVP71:
MOVE C,[POINT 6,A] ;POINTER TO VALUE
MOVE D,[POINT 6,6] ;D GETS PTR,,BYTES PER WORD
SETZB A,WRDCNT ;CLEAR VALUE,,OVERFLOW COUNT
BYPASS ;GET DELIMITER
CAIN CC,$EOL ;IS IT END OF LINE?
JRST QERROR ;YES,RETURN ERROR
MOVEM CC,T ;SAVE DELIMITER
MOVEI B,6 ;CURRENT BYTE COUNT
EVP71A:
PUSHJ P,MIC ;INPUT THE BYTE
CAMN CC,T ;A MATCH ON DELIMETER?
JRST EVP70D ;YES , SO END IT
PUSHJ P,NWCHK ;SEE IF NEW WORD NEEDED
SUBI CC," "-' ' ;CONVERT TO SIXBIT
JUMPL CC,AERROR ;IF NO SIXBIT REPRESENTATION
IDPB CC,C ;STORE THE CHARACTER
JRST EVP71A ;AND BACK FOR MORE
EVP70D: ;HERE ON END OF STRING
TXZE %F,S.ASCZ ;SPECIAL ASCIZ ?
JRST [SETZ CC, ;YES, DEPOSIT A NULL
PUSHJ P,NWCHK ;MAY CAUSE NEW WORD
IDPB CC,C ;DEPOSIT IT
JRST .+1 ] ;AND CONTINUE
TXZ F,QUOTE ;NO MORE QUOTED STRING
MOVX D,C.NUM ;NUMERIC
SETZ C, ;NO FIXUP
SKIPN B,WRDCNT ;WAS IT MORE THAN ONE WORD?
JRST ECELL ;NO,JUST RETURN
PUSHJ P,ISTGET ;GET SLOT ON IST
HLRZM B,0(C) ;STORE ADDRESS OF STRING IN RH OF WORD 1
HRRZS B ;WORD COUNT ALONE NOW
MOVNS B ;NEGATE IT
HRLM B,0(C) ;WORD 1/ -COUNT,,ADDRESS
MOVX B,IS.MWS ;FLAG TYPE OF ENTRY
MOVEM B,1(C) ;AND STORE IT
SETZ B, ;NOT RELOCATED
JRST ECELL ;END OF THIS CELL
NWCHK: ;HERE TO CHECK FOR NEW WORD NEEDED
;NOTE- DONT CALL GETCOR DURING
;STRING EVALUATION,EXCEPT HERE
SOJGE B,CPOPJ ;IF COUNT OK,JUST RETURN
PUSH P,T1 ;SAVE AC
MOVEI T1,1 ;GET WORD
PUSHJ P,GETCOR ;ALLOCATE IT
HRRZ C,T1 ;RH OF NEW BYTE POINTER
HLL C,D ;LH OF NEW BYTE POINTER
MOVEI B,-1(D) ;ALSO RESET COUNT,ADJ BY 1
SKIPN WRDCNT ;IF FIRST OVERFLOW,
HRLZM T1,WRDCNT ;STORE THE STRING'S ADDRESS
AOS WRDCNT ;UPDATE COUNT
PJRST T1POPJ ;RESTORE T1,RETURN
; PROCESSOR 70Z - PROCESS THE PSEUDO-OPERATOR 'ASCIZ'
;
EVP70Z:
TXO %F,S.ASCZ ;TURN ON FLAG BIT
JRST EVP70 ;NOW GO HANDLE LIKE ASCII
; PROCESSOR 72 - PROCESS THE PSEUDO-OPERATOR 'IOWD'
; PROCESSOR 73 - PROCESS THE PSEUDO-OPERATOR 'XWD'
EVP72:
SKIPA T,[P.IOWD] ;FLAG AS IOWD PSEUDO-OP
EVP73: MOVX T,P.XWD ;
TDOE %F,T ;TURN ON BIT,TEST FOR DUPLICATE
JRST QERROR ;THIS IS LEGAL BUT WE DONT HANDLE IT
JRST CELL ;PROCESS MORE OF THE CELL
; PROCESSOR 74 - PROCESS THE PSEUDO OPERATORS 'SQUOZE' & 'RADIX50'
EVP74:
PUSHJ P,EVALEX ;READ IN AND EVALUATE BITS
SKPNCM ;END WITH COMMA?
TDNE A,[^-74] ;AND PROPER VALUE?
JRST QERROR ;NO,FAILS SYNTAX CHECK
JUMPN B,RERROR ;CANT BE RELOCATABLE
JUMPN C,FERROR ;OR UNKNOWN/EXTERNAL
LSH A,^D30 ;GET IT INTO BITS 0-3
PUSH P,A ;SAVE THE CODE BITS AWAY
TXZ F,REGET ;DONT EAT THE , AGAIN
PUSHJ P,SYMIN ;READ THE SYMBOL IN
MOVE R,A ;GET INTO ARG FOR RAD50
PUSHJ P,RAD50 ;CONVERT TO RADIX50
IORM R,0(P) ;MERGE BITS AND SYMBOL
POP P,A ;VALUE OF CELL TO RETURN
SETZB B,C ;NO RELOC OR FIXUP
MOVX D,C.NUM ;TAG AS NUMBER
TXO F,REGET ;REGET SYMBOL DELIMITER
JRST ECELL ;AND END THE CELL
; PROCESSOR 75 - PROCESS THE PSEUDO-OPERATOR 'POINT'
EVP75:
PUSH P,[0] ;PUSH 3 PLACE HOLDERS ON STACK
PUSH P,[0]
PUSH P,[<^D36>B5] ;DEFAULT BYTE POSITION
PUSHJ P,EVLX10 ;GET BYTE SIZE IN RADIX 10.
JUMPN B,RERROR ;MUST BE ABSOLUTE
JUMPN C,FERROR ;AND KNOWN
DPB A,[POINT 6,0(P),11] ;STORE THE BYTE SIZE
SKPCM ;DELIMITED BY COMMA?
JRST EVP75A ;NO,SO WE ARE DONE
TXZ F,REGET ;INSURE WE DONT SEE THAT COMMA AGAIN
PUSHJ P,EVADR ;EVALUATE ADDRESS
DPB A,[POINT 23,0(P),35] ;DEPOSIT ADDRESS
MOVEM B,-1(P) ;STORE RELOCATION
MOVEM C,-2(P) ;AND THE FIXUP
SKPCM ;END WITH COMMA?
JRST EVP75A ;NO,DONE
TXZ F,REGET ;DONT GET THE COMMA AGAIN
PUSHJ P,EVLX10 ;EVALUATE BYTE POSITION
TXNE D,C.NULL ;WAS ANYTHING THERE?
JRST EVP75A ;NO
JUMPN B,RERROR ;MUST BE ABSOLUTE
JUMPN C,FERROR ;AND KNOWN
MOVEI T,^D35 ;TRANSLATE TO HARDWARE POSITION
SUB T,A ;
JUMPL T,QERROR ;CALL THIS AN ERROR
DPB T,[POINT 6,0(P),5] ;UPDATE BYTE POSITION
EVP75A:
POP P,A ;RETURN VALUE
POP P,B ;RETURN RELOCATION OF POINTER
POP P,C ;RESTORE FIXUP WORD
MOVX D,C.NUM ;CALL IT A NUMBER
JRST ECELL ;EXIT THE CELL
; PROCESSOR 76 - PROCESS THE PSEUDO-OPERATOR 'COMMENT'
EVP76:
BYPASS ;GET FIRST NON-BLANK CHARACTER
CAIN CC,$EOL ;ERROR IF ITS END OF LINE
JRST QERROR
MOVEM CC,T ;SAVE DELIMITER
EVP76A:
PUSHJ P,MIC ;LOAD BYTE FROM INPUT
CAIN CC,$EOL ;IS IT END OF LINE?
JRST [ PUSHJ P,MACLOD ;THE NEXT LINE
JRST EVP76A] ;AND GET BYTE, ETC..
CAME CC,T ;MATCHES DELIMITER?
JRST EVP76A ;NO
JRST CELL ;
; PROCESSOR 77 - PROCESS THE PSEUDO-OPERATOR 'REMARK'
EVP77:
PUSHJ P,MIC ;GET A CHARACTER
CAIE CC,$EOL ;END OF LINE?
JRST EVP77 ;NO,TRY AGAIN
JRST NCELL ;YES,EOL SEEN,SO CALL IT NULL CELL
; PROCESSOR 78 - PROCESS THE PSEUDO-OPERATOR 'EXP'
EVP78:
PUSHJ P,EVALEX ;EVALUATE EXPRESSION
EVP78A:
MOVX D,C.NUM ;FLAG AS NUMERIC
SKPCM ;IF NOT COMMA,
JRST ECELL ;ITS END OF CELL
JRST WERROR ;ELSE TOO MANY WORDS FOR CURRENT
; PROCESSOR 79 - PROCESS THE PSEUDO-OPERATOR 'DEC'
EVP79:
PUSHJ P,EVLX10 ;EVALUATE EXPRESSION USING RADIX 10.
JRST EVP78A ;MAKE CHECKS
; PROCESSOR 80 - PROCESS THE PSEUDO-OPERATOR 'OCT'
EVP80:
PUSH P,CRADIX ;STORE CURRENT RADIX
MOVEI A,^D8 ;SET IT AS BASE (8)
MOVEM A,CRADIX ;
PUSHJ P,EVALEX ;EVALUATE EXPRESSION
POP P,CRADIX ;AND RESTORE RADIX
JRST EVP78A ;MAKE COMMON CHECKS
; PROCESSOR 81 - PROCESS THE PSEUDO-OPERATOR 'BYTE'
EVP81:
REPEAT 3,<PUSH P,[0]> ;MAKE ROOM FOR CODE TRIPLET
PUSH P,[POINT 0,0(P)] ;STORE BYTE POINTER
BYPASS ;GET FIRST NON-BLANK
CAIE CC,"(" ;MUST START WITH BYTE SIZE
JRST AERROR ;BUT ITS NOT
EVP81A:
PUSHJ P,EVLX10 ;READ EXPRESSION IN DECIMAL
JUMPN B,RERROR ;CANT BE RELOCATABLE
JUMPN C,FERROR ;OR UNKNOWN
CAIE CC,")" ;END IN MATCHING R PARENS?
JRST AERROR ;NO,SO FLAG ERROR
CAILE A,0 ;IF NOT IN RANGE 1-36 (10.)
CAILE A,^D36 ;
JRST AERROR ;FLAG ERROR
DPB A,[POINT 6,0(P),11] ;STORE SIZE INTO POINTER
EVP81B:
TXZ F,REGET ;DONT REGET THE R PARENS
PUSHJ P,EVALEX ;EVALUATE THE EXPRESSION
IBP 0(P) ;INCREMENT THE BYTE POINTER
SKIPN B ;MAKE SURE IF FIXUP OR RELOC
SKIPE C ;THAT BYTE ALIGNED ON BOUNDARY
JRST [ LDB T,[POINT 6,0(P),11] ;GET SIZE
CAIE T,^D36 ;MUST BE 18. OR 36.
CAIN T,^D18 ;ELSE ITS ERROR
JRST .+1 ;
JRST RERROR ] ;DONE
MOVE T,0(P) ;PICK UP THE POINTER
TRNE T,-1 ;IF INTO NEXT WORD,CANT HANDLE
JRST WERROR ;BECAUSE IT GENERATES MULTI-WORD
HRRI T,-1 ;STORE VALUE INTO -1(P)
DPB A,T ;
HRRI T,-2 ;STORE RELOC INTO -2(P)
DPB B,T ;
HRRI T,-3 ;STORE SYMFIX INTO -3(P)
DPB C,T ;
SKPNCM ;COMMA DELIMITS EXPRESSION?
JRST EVP81B ;YES,GET NEXT PIECE
CAIN CC,"(" ;IS IT L PARENS?
JRST [TXZ F,REGET ;YES,CHANGE BYTE SIZE
JRST EVP81A] ;AFTER EATING THE "("
POP P,0(P) ;CLEAR BP OFF STACK
POP P,A ;SET UP EXPRESSION
POP P,B ;
POP P,C
MOVX D,C.NUM ;FLAG NUMERIC
JRST ECELL ;END OF CELL
; PROCESSOR 82 - PROCESS THE PSEUDO-OPERATOR 'RADIX'
EVP82:
PUSHJ P,EVLX10 ;EVALUATE EXPRESSION USING BASE 10.
JUMPN B,RERROR ;MUST BE ABSOLUTE AND
JUMPN C,FERROR ;MUST BE KNOWN
CAIL A,2 ;AND IT MUST BE IN RANGE 2-10
CAILE A,^D10 ;
JRST AERROR ;ELSE ITS AN ARG ERROR
MOVEM A,CRADIX ;CHANGE RADIX
JRST MECELL ;MUST END LINE WITH THIS CELL
; /FP.EDT/ - THIS FIX PSEUDO-OP TAKES AS AN ARGUMENT THE EDIT NAME,
; WHICH CAN BE UP TO SIX RADIX-50 CHARACTERS LONG.
; IT ALSO ALLOCATES THE STATIC AREA FOR THE TRACE BLOCK
; AND RESETS THE INTERIM SYMBOL TABLE
;
;
FP.EDT:
PUSHJ P,.PSH4T## ;SAVE ACS
TXNE F,IAE ;INSIDE AN EDIT?
JRST [MOVE N,CUREDT
$KILL(MEP,Missing .ENDE for edit,N$SIX)]
BYPASS ;SKIP OVER BLANKS
TXO F,REGET ;AND REGET FIRST NON-BLANK
PUSHJ P,SYMIN ;GET EDIT NUMBER
JUMPE A,[$KILL(NEI,Null argument to .EDIT is illegal)]
TXO F,IAE!FSTMOD ;INSIDE EDIT,FIRST MODULE THIS EDIT
MOVEM A,CUREDT ;STORE CURRENT EDIT NAME
SETZM CPPART ;RESET EDIT PART ID
PUSHJ P,ISTINI ;RESET IST
MOVE T1,TRCVAP ;MAKE TRACE BLOCK FOLLOW
MOVEM T1,TRCPTR ;LAST ONE
CAILE T1,TRCLST-TB$SIZ ;ROOM LEFT?
JRST [MOVE N,A
$KILL(ITS,Insufficient TRACE block storage for edit,N$SIX)]
MOVE T2,[LI$TRC,,TB$SIZ] ;PICK UP A HEADER
MOVEM T2,TB$HED(T1) ;STORE IT
MOVEM A,TB$EDT(T1) ;STORE CURRENT EDIT NAME
MOVE T2,WHO ;AND OUR INITIALS
HRROM T2,TB$STA(T1) ;DEPOSIT AND MARK ACTIVE
HRLM T2,TB$INS(T1) ;ALSO AS PERSON INSTALLING
DATE T2, ;GET SYSTEM DATE
HRRM T2,TB$INS(T1) ;DEPOSIT DATE INSERTED
SETZM TB$LEN(T1) ;ZERO THE VAR. AREA LENGTH
MOVEI T2,TB$VAR(T1) ;START OF VARIABLE AREA
MOVEM T2,TRCVAP ;STORED
PUSHJ P,.POP4T## ;RESTORE ACS
JRST MECELL ;MUST END CELL
; /FP.MOD/- ROUTINE TO GET THE NAME OF MODULE TO BE PATCHED AND THEN
; EITHER RETURN TO DISPATCH (IF ALREADY IN CORE) OR
; ELSE SEARCH FOR IT IN THE REL FILE. NOTE THAT WE
; CAN SEARCH BACFPARDS HERE BUT GIVE AN ERROR MESSAGE
; IF THE MODULE IS NOT FOUND AT ALL.
FP.MOD:
PUSHJ P,.PSH4T## ;SAVE ACS
TXNN F,IAE ;IN ACTIVE EDIT?
JRST [$KILL(EPM,.EDIT pseudo-op is missing from FIX file)]
BYPASS ;
TXO F,REGET
PUSHJ P,SYMIN ;GET THE MODULE NAME
JUMPE A,[MOVE N,CUREDT
$KILL(NMS,Null specification to .MODULE in edit,N$SIX)]
CAMN A,CURMOD ;SAME MODULE NAME AS ONE IN CORE?
JRST MOD5 ;YES, JUST MAKE CHECKS
PUSHJ P,UDFCHK ;CHECK FOR UNDEFINED LABELS
MOVEM A,CURMOD ;MAKE THIS MODULE BE CURRENT
PUSHJ P,PUTPG ;UNLOAD PROGRAM IN CORE
PUSHJ P,MSTGET ;SET UP IO ROUTINES
JFCL ;DONT CARE
MOVE R,CURMOD ;GET MODULE NAME
PUSHJ P,RAD50 ;CONVERT TO RADIX 50
TXZ F,CPASS2 ;FIRST PASS
MOD2:
PUSHJ P,READ ;READ A PROGRAM
JRST [ TXOE F,CPASS2 ;EOF. ARE WE DOING 2ND PASS?
JRST MNFERR ;YES,REALLY NOT THERE
PUSHJ P,BACKUP ;REWIND THE FILES
JRST MOD2 ] ;AND MAKE 2ND PASS
CAMN R,A ;IS THIS THE RIGHT MODULE?
JRST MOD3 ;YES!
PUSHJ P,WRITE ;NO, SO WRITE IT OUT
JRST MOD2 ;AND TRY AGAIN
MOD3:
PUSHJ P,YANKPG ;YANK ALL OF PROGRAM INTO CORE
JRST [MOVE N,R
$KILL(EFF,End of file found before END block in module,N$50)]
SKIPE SSTLOC ;SYMBOLS FOUND?
JRST MOD4 ;YES
MOVE N,CURMOD ;GET MODULE NAME
$WARN (SNF,Symbols not found for module,N$SIX)
MOD4:
SKIPE SPCLOC ;ANY PROGRAM CODE FROM
JRST MOD5 ;MODULE FOUND?
MOVE N,CURMOD ;NO
$WARN (NPC,No program code was found for module,N$SIX)
MOD5:
TXZ F,FSTMOD ;SEEN A .MODULE SINCE LAST .EDIT
MOVE A,CUREDT ;SEE IF THIS MODULE HAS THIS EDIT
PUSHJ P,FNDEDT ;ALREADY. THIS IS AN ERROR
JRST MOD6 ;NO. ITS OK, EDIT NOT THERE
MOVE N,CURMOD ;BLOW THEM AWAY
$KILL (MHE,Module,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ already has an edit /]
PUSHJ P,.TSTRG## ;FINISH MESSAGE
MOVE T1,CUREDT ;IDENTIFY EDIT
PUSHJ P,.TSIXN## ;
JRST DONERR ;END MESSAGE
MOD6:
MOVE A,CUREDT ;SEE IF THERE ARE CONFLICTS
MOVSI B,400000 ;WITH THIS EDIT BEING INSERTED
PUSHJ P,CHKCNF ;
PUSHJ P,.POP4T## ;RESTORE ACS
JRST MECELL ;END OF CELL,I HOPE
; /FP.ASC/ - FIX-PSEUDO-OP PROCESSOR FOR LINE OF FORM:
; .ASSOCIATED EDIT,+EDIT,-EDIT,EDIT,+EDIT.... ;ASSOC. EDITS
;
; NOTE THAT A .MODULE FIX-PSEUDO-OP MUST BE PRESENT
; BEFORE THE .ASSOCIATE FIX-PSEUDO-OP, TO SELECT THE CURRENT MODULE
;
FP.ASC:
PUSHJ P,.PSH4T## ;FREE SOME ACS
TXNN F,IAE ;INSIDE AN ACTIVE EDIT?
JRST E$$EPM ;NO,COMPLAIN
TXNE F,FSTMOD ;[MODULE]SEEN YET?
JRST MKMERR ;NO,COMPLAIN
MOVE D,TRCVAP ;GET POINTER TO VARIABLE AREA
ASC1:
BYPASS ;SKIP OVER BLANKS
MOVE N,CUREDT ;SET UP FOR EDIT NAME
SETZ T4, ;MARK FOR "-" ASSOCIATION
CAIN CC,"-" ;IS IT?
JRST ASC2 ;YES
MOVSI T4,400000 ;SET FOR "+" ASSOCIATION
CAIE CC,"+" ;EXPLICIT?
TXO F,REGET ;NO,IMPLIED,REGET FIRST CHAR
ASC2:
PUSHJ P,SYMIN ;LOAD EDIT NAME
JUMPE A,AERROR
MOVE T1,TRCPTR ;GET POINTER
HRRZ T2,TB$LEN(T1) ;GET RH OF LENGTH
JUMPN T2,[$KILL(AAC,<.ASSOCIATED seen after .INSERT,.REMOVE or .REINSERT>,,$MORE)
JRST SAYEDT]
MOVSI T2,1 ;ADD 1 TO LH OF TB$LEN
ADDM T2,TB$LEN(T1) ;FOR A.E. COUNT
AOS TB$HED(T1) ;UPDATE WORD COUNT
AOS TB$HED(T1) ;BY TWO FOR AN A.E.
CAILE D,TRCLST-1 ;ROOM FOR THIS A.E.?
JRST E$$ITS ;NO,COMPLAIN
MOVEM A,TB$AEN(D) ;STORE ASSOCIATED NAME
MOVEM T4,TB$AES(D) ;AND REQUIRED STATUS
ADDI D,2 ;UPDATE POINTER
MOVEM D,TRCVAP ;AND STORE IT
PUSHJ P,FNDEDT ;LOOK IT UP
JRST ASC3 ;NOT FOUND
SKIPL TB$STA(B) ;WAS FOUND, IS IT ACTIVE?
JRST ASC3A ;NO
JUMPL T4,ASC4 ;IS ACTIVE, WANTED ACTIVE?
MOVE N,A ;WARN
$WARN(PEP,Precluded edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ is present in module /]
ASC2A:
PUSHJ P,.TSTRG## ;REST OF MESSAGE
MOVE T1,CURMOD ;GET MODULE NAME
PUSHJ P,.TSIXN## ;
X$$PEP:
X$$REM:
X$$RER:
PUSHJ P,.TCRLF## ;CLOSE MESSAGE
TXZ F,FOTTY ;
JRST ASC4
ASC3:
JUMPGE T4,ASC4 ;IS NOT ACTIVE.WANTED THIS?
MOVE N,A ;YES,SO WARN THAT ISNT THERE
$WARN(REM,Required edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ is missing from module /]
JRST ASC2A
ASC3A:
JUMPGE T4,ASC4 ;THERE BUT INACTIVE,WANTED THIS?
MOVE N,A ;NO,GIVE WARNING
$WARN(RER,Required edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " is inactive in module "]
JRST ASC2A
ASC4:
TXO F,REGET ;STARTING WITH DELIMITER OF EDIT NAME,
BYPASS ;GET NEXT NON-BLANK CHARACTER
SKPNCM ;IS IT A COMMA?
JRST ASC1 ;YES,INDICATES ANOTHER EDIT
PUSHJ P,.POP4T## ;RESTORE THE ACS
JRST MECELL ;AND RETURN
SAYEDT:
MOVEI T1,[ASCIZ " in edit "]
PUSHJ P,.TSTRG##
MOVE T1,CUREDT
PUSHJ P,.TSIXN##
PUSHJ P,.TCRLF##
JRST DONERR
; /FP.NAM/ - PSEUDO-OP TO GET THE PATCH CREATOR'S
; INITIALS OUT OF THE PATCH FILE
; .NAME III ;PERSON WHO CREATED THE PATCH
;
FP.NAM:
TXNN F,IAE ;IN AN EDIT
JRST E$$EPM ;NO, COMPLAIN
BYPASS ;LOAD INITIALS FROM
TXO F,REGET ;INPUT FILE, INDICATES
PUSHJ P,SYMIN ;PATCH CREATOR NAME
MOVE D,TRCPTR ;AND GET POINTER
HLLM A,TB$MAK(D) ;SET IT DOWN
JRST MECELL ;
; /FP.DAT/ - GET THE DATE OF THE PATCH FROM THE PSEUDO-OP .DATE
;
; FORMAT: .DATE DD-MON-YY ;THIS IS THE DATE OF THE THING
;
FP.DAT:
PUSHJ P,.PSH4T## ;SAVE ACS T1-4
BYPASS ;SKIP BLANKS BEFORE ARGUMENT
TXO F,REGET ;
PUSHJ P,DECIN ;GET A DECIMAL NUMBER
JUMPE A,[$KILL(BDA,Bad .DATE argument)]
CAIE CC,"-" ;SPECIAL SEPARATOR
JRST E$$BDA ;ELSE COMPLAIN
PUSH P,A ; STORE IT
PUSHJ P,SYMIN ;GET MONTH NAME
CAIE CC,"-" ;DASH?
JRST E$$BDA ;NO
TLNN A,770000 ;
JRST [LSH A,6 ;LEFT JUSTIFY IT
JRST .-1] ;
MOVE T1,[IOWD ^D12,[MTAB: SIXBIT/JAN/
SIXBIT/FEB/
SIXBIT/MAR/
SIXBIT/APR/
SIXBIT/MAY/
SIXBIT/JUN/
SIXBIT/JUL/
SIXBIT/AUG/
SIXBIT/SEP/
SIXBIT/OCT/
SIXBIT/NOV/
SIXBIT/DEC/]]
MOVE T2,A ;WHAT TO LOOK FOR
PUSHJ P,.LKNAM## ;HOW TO LOOK
JRST E$$BDA ;BAD FORMAT
HRRZ B,T1 ;GET RH
SUBI B,MTAB ;AND GET INTO PROPER RELATIVE
PUSHJ P,DECIN ;GET YEAR
MOVE T1,A ;GET FROM ARG AC
IDIVI T1,^D100 ;MAKE 2 DIGIT
SUBI T2,^D64 ;SINCE 1964
JUMPE T2,E$$BDA ;IF .LE. 0
IMULI T2,^D12 ;MULTIPLY TO GET RIGHT
ADD T2,B ;ADD THE (MONTH-1)
IMULI T2,^D31 ;GET OVER
ADD T2,0(P) ;ADD IN PARTIAL RESULT
SOS T2 ;ADJUST FOR THE MINUS ONE
POP P,0(P)
MOVE T3,TRCPTR ;STORE IN STATIC AREA OF TRACE BLOCK
HRRM T2,TB$MAK(T3) ;
PUSHJ P,.POP4T## ;RESTORE T1-T4
JRST MECELL ;END IT
; /FP.INS/ - ROUTINE TO INSERT A NEW EDIT. THIS ROUTINE PROCESSES
; FIX-PSEUDO-OPS OF THE FORMAT:
; .INSERT location, POSITION:arg, <code to match>
;
; WHERE THE FIRST FIELD (REQUIRED) IS THE LOCATION TO PATCH, (IE
; THE LOCATION THAT GETS THE "JUMPA <LOCATION-OF-PATCH-CODE>"
; WHERE THE SECOND FIELD (REQUIRED) IS THE POSITION OF THE PATCH
; IN RELATION TO THE DISPLACED INSTRUCTION (THE INSTRUCTION
; OVERWRITTEN WITH THE "JUMPA <LOCATION-OF-PATCH-CODE>"
; IF "POSITION" IS:
; AFTER THEN DISPLACED INSTR IS FIRST INSTRUCTION OF PATCH
; BEFORE THEN DISPLACED INSTR IS LAST INSTRUCTION OF PATCH
; REPLACE THEN FOR EACH INSTRUCTION TYPED IN, ONE IS DELETED
; AND NEVER EXECUTED
; REPLACE:n THEN n INSTRUCTIONS ARE NOT EXECUTED , REGARDLESS
; OF HOW MANY INSTRUCTIONS ARE INSERTED.
;
; NOTE: THE POSITION ARGUMENT CAN BE UNIQUE AT ONE LETTER (A,B,R)
;
; WHERE THE THIRD FIELD (OPTIONAL) IS THE WORD OF CODE AT THE
; LOCATION OF THE PATCH. IF PRESENT, THE ANGLE BRACKETS ARE
; REQUIRED. IF THE CODE DOES NOT MATCH THE ACTUAL CODE AT THE
; LOCATION SPECIFIED IN FIELD 1, A FATAL ERROR MESSAGE IS GIVEN.
;
;
FP.INS:
PUSHJ P,.PSH4T## ;SAVE ACS
TXNN F,IAE ;INSIDE EDIT?
JRST E$$EPM ;".EDIT FIX-PSEUDO-OP IS MISSING"
TXOE F,IAI ;INSIDE INSERT,WAS INSIDE?
JRST [$KILL(IIA,.INSERT pseudo-op illegal inside range of .INSERT,,$MORE)
JRST SAYEDT]
MOVE N,CUREDT
TXNE F,FSTMOD ;SEEN .MODULE FOR THIS EDIT?
JRST MKMERR ;NO,SO COMPLAIN
PUSHJ P,EVALEX ;EVALUATE EXPRESSION FOR LOCATION
TXNE D,C.NULL ;DONT ALLOW NULL
JRST [$KILL(IUN,Illegal to have null address in .INSERT,,$MORE)
JRST SAYEDT]
JUMPN C,FERROR ;DONT ALLOW LIT,EXT OR UDF
TLNN A,-1 ;MAKE SURE ITS VALID 18 BIT ADDRESS
TLNE B,-1 ;AND LH NOT RELOCATED
JRST [$KILL(IAI,Illegal address in .INSERT,,$MORE)
JRST SAYEDT]
PUSHJ P,WRDSRC ;MAKE SURE ITS VALID AS AN ADDRESS
JRST [MOVE N,CUREDT
$KILL(IAL,.INSERT address is not in current module in edit,N$SIX)]
MOVE T1,TRCPTR ;DO SOME HOUSEKEEPING
AOS TB$LEN(T1) ;INDICATE NEW PCO GROUP
MOVEI T2,PCO1SZ ;UPDATE SIZE OF BLOCK
ADDM T2,TB$HED(T1) ;FOR LINK ITEM TYPE HEADER
MOVE T2,[1,,PCO1SZ] ;MAKE A PCO TYPE 1 HEADER
MOVE T1,TRCVAP ;SET TO UPDATE VARIABLE AREA
MOVE N,CUREDT ;SEE IF MORE ROOM
CAILE T1,TRCLST-PCO1SZ+1 ;
JRST E$$ITS ;NOT ENUFF TRACE STOREAGE LEFT
MOVEM T2,TB$PCO(T1) ;STORE IT
HRRZM A,TB$DAT(T1) ;STORE THE ADDRESS OF THE PATCH
MOVE A,0(C) ;PICK UP ORIG INSTRUCTION
MOVEM A,SAVCOD ;STORE IT FOR LATER
PUSHJ P,GETREL ;GET RELOCATION BYTE
;FROM (C) AND (B)
MOVEM D,SAVREL ;STORE SAVED ORIG. RELOCATION
SKPCM ;SHOULD HAVE COMMA HERE
JRST AERROR ;NOT ENOUGH ARGUMENTS
TXZ F,REGET ;DONT REGET COMMA
PUSHJ P,SYMIN ;GET THE SYMBOL
JUMPE A,[MOVE N,CUREDT ;
$KILL(BAM,<BEFORE, AFTER or REPLACE missing from .INSERT in edit>,N$SIX)]
MOVE T2,A ;
MOVE T1,[IOWD 3,[SIXBIT/BEFORE/
SIXBIT/REPLAC/
SIXBIT/AFTER/]]
HRRZI A,2(T1) ;FOR LATER ADJUSTMENT
PUSHJ P,.LKNAM## ;LOOK IT UP
JRST [MOVE N,T2
$KILL(NRP,Not a recognized position switch:,N$SIX)]
TLZ T1,-1 ;GET RID OF AOBJN LEFT HALF
SUBI T1,(A) ;CONVERT TO -1,0,+1
SETZM CPINST ;NO INSTRUCTIONS INSERTED YET
MOVEM T1,BARFLG ;AND STORE IT
SETZM CPREPI ;DEFAULT NUMBER FOR REPLACE:N
JUMPN T1,INS4 ;IF NOT /REPLACE DONT LOOK FOR ARG
CAIE CC,":" ;ARG THERE?
JRST INS4 ;NO,LEAVE IT 0
BYPASS
TXO F,REGET
PUSHJ P,EVALEX ;GET NUMBER OF INSTRS TO SKIP ON RETURN FROM PATCH
JUMPN B,RERROR ;CAN'T BE RELOCATABLE
JUMPN C,FERROR ;OR FORWARD REFERENCE
MOVEM A,CPREPI ;DEPOSIT IT
MOVE T1,TRCVAP ;GET PCO POINTER AGAIN
HRRZ T2,TB$DAT(T1) ;GET ADDRESS OF PATCH BREAK
ADD A,T2 ;NOW ADD TOGETHER
PUSHJ P,WRDSRC ;MAKE SURE THIS IS NOT A CROQUE
SKIPA N,CPREPI ;RETURN PC NOT IN BOUNDS
JRST INS4 ;ITS OK
$KILL(RTL,.INSERT'S REPLACE argument of,N$OCT,$MORE)
MOVEI T1,[ASCIZ " too large for module "]
PUSHJ P,.TSTRG##
MOVE T1,CURMOD
PUSHJ P,.TSIXN##
JRST SAYEDT
INS4:
TXO F,REGET ;SKIP BLANKS
BYPASS ;
SKPCM ;END WITH COMMA?
JRST [ PUSHJ P,ORGCOA ;NO,MATCH CODE OMITTED
PUSHJ P,.POP4T## ;JUST DO SETUP AND RETURN
JRST MECELL ] ;MUST BE END OF CELL
PUSHJ P,ORGCOD ;READ ORIGINAL CODE,ETC
PUSHJ P,.POP4T##
JRST MCELL1 ;NEXT CHR ENDS CELL
; /FP.ENI/ - PROCESSOR TO HANDLE .ENDI FIX-PSEUDO-OP
; THIS PSEUDO-OP IS USED TO INDICATE THE END OF AN INSERT. WE
; DO SOME BOOKEEPING, FINISH THE PATCH WITH TWO
; INSTRUCTIONS OF FORM:
; JUMPA 1,CPRET
; JUMPA 2,CPRET+1
;
; AFTER THESE TWO INSTRUCTIONS, ALL "PSEUDO-LITERALS" ARE
; GENERATED.
;
FP.ENI:
PUSHJ P,.PSH4T## ;SAVE THE TEMPS
TXZN F,IAI ;OFF INSERT,WAS IT ON?
JRST [MOVE N,CUREDT
$KILL(IPM,.ENDI seen without .INSERT in edit,N$SIX)]
MOVE T1,TRCVAP ;GET VARIABLE AREA POINTER
SKIPL BARFLG ;WAS THIS A /BEFORE PATCH?
JRST ENI3 ;NO, MUST BE /AFTER OR /REPLACE
MOVE C,CPADDR ;GET ADDRESS INSTRUCTION GOES TO
HRLM C,TB$PAT(T1) ;PUT IT AWAY FOR NOW
MOVE C,SAVCOD ;GET DISPLACED INSTRUCTION
MOVE B,SAVREL ;GET RELOCATION FOR INSTRUCTION
PUSHJ P,NEWCOD ;GENERATE THE INSTRUCTION
JRST INSERR
ENI3:
HRRZ A,TB$DAT(T1) ;MOVING ORIG INSTR [FROM]
HLRZ B,TB$PAT(T1) ;ORIG INSTR [TO]
PUSHJ P,GFIXUP ;DO THE FIXUPS IF ANY
SKIPN BARFLG ;IF NOT /REPLACE OR
SKIPN CPREPI ;OR NO ARG TO /REPLACE
JRST ENI4 ;SKIP RETURN FIXUP
ADD A,CPREPI ;UPDATE BY NUMBER THEY SAID TO SKIP ON RETURN
MOVEM A,CPRET ;THIS IS RETURN PC TO USE
ENI4:
HRRZ T2,TB$DAT(T1) ;FETCH ADDRESS OF INSERT
CAML T2,CPRET ;RETURN IS TO GREATER ADDRESS ,RIGHT?
JRST [ SKIPE BARFLG ;IF NOT /REPLACE,
$STPCD(Patch return PC is incorrect)
AOS CPRET ;ITS CASE OF /REPLACING AN INSTR
;WITH NOTHING (IE DELETING IT)
JRST .+1 ] ;SO BUMP RETURN TO AVOID LOOP
MOVE T2,CPINST ;NUMBER OF INSTRUCTIONS INSERTED
DPB T2,[POINT 10,TB$DAT(T1),17] ;DEPOSIT INTO TRACE AREA
ADDI T1,PCO1SZ ;UPDATE SIZE OF VARIABLE AREA POINTER
MOVEM T1,TRCVAP ;SO NEXT PCO DOES NOT OVERWRITE THIS ONE
MOVSI C,(JUMPA 1,) ;GENERATE RETURNS
HRR C,CPRET ;
MOVEI B,1 ;RIGHT RELOCATED
PUSHJ P,NEWCOD ;GENERATE NEW CODE
JRST INSERR ;NO MORE ROOM
ADD C,[Z 1,1] ;SECOND RETURN INSTRUCTION
MOVEI B,1 ;ALSO RELOCATABLE
PUSHJ P,NEWCOD ;INSERT IT TOO
JRST INSERR
PUSHJ P,PMLIT ;DO LITERAL FIXUPS
PUSHJ P,.POP4T## ;RESTORE T1-4
JRST MECELL ;AND END IT
; /FP.REM/ - ROUTINE TO HANDLE .REMOVE FIX-PSEUDO-OP
;
; THIS FIX-PSEUDO-OP IS OF THE FORM :
; .REMOVE EDIT,EDIT , EDIT...
;
; THE PROCESSOR CHECKS FOR ERRORS, REPORTS CONFLICTS AND
; ALSO UPDATES POINTERS BESIDES REMOVING THE EDIT SPECIFIED.
;
FP.REM:
PUSHJ P,.PSH4T## ;SAVE T1-T4
TXNN F,IAE ;INSIDE AN EDIT?
JRST E$$EPM ;NO,ITS AN ERROR
TXNE F,FSTMOD ;.MODULE SEEN?
JRST MKMERR ;NO,ITS AN ERROR
REM1:
BYPASS ;SKIP BLANKS
TXO F,REGET
MOVE N,CUREDT ;IN CASE OF ERROR
PUSHJ P,SYMIN ;GET EDIT NAME
JUMPE A,AERROR ;IF NULL NAME
CAMN A,CUREDT ;NOT TRYING TO DIDDLE THIS EDIT,ARE WE?
JRST ERIERR ;YES,COMPLAIN
MOVE T1,TRCVAP ;CURRENT VARIABLE POINTER
CAILE T1,TRCLST-<PCO2SZ-1> ;ENUFF ROOM LEFT?
JRST E$$ITS ;NO.
MOVE T2,[2,,PCO2SZ] ;HEADER FOR CHANGE ORDER
MOVEM T2,TB$PCO(T1) ;STORE IT
MOVEM A,TB$REN(T1) ;AND EDIT NAME REMOVED
ADDI T1,PCO2SZ ;UPDATE POINTER
MOVEM T1,TRCVAP ;TO REFLECT PCO
MOVE T1,TRCPTR ;UPDATE STATIC AREA SIZE
MOVEI T2,PCO2SZ ;BY RIGHT NUMBER OF WORDS
ADDM T2,TB$HED(T1) ;ALSO THE LINK ITEM HEADER
AOS TB$LEN(T1) ;AND COUNTER OF PCO GROUPS
PUSHJ P,FNDEDT ;FIND EDIT
JRST REM9 ;NOT THERE!
SKIPL TB$STA(B) ;IS IT ACTIVE?
JRST REM8 ;NO,SO CANT REMOVE IT
PUSH P,B ;SAVE POINTER TO EDIT
SETZ B, ;AND CHECK FOR CONFLICTS
PUSHJ P,CHKCNF ;REPORT ANY
POP P,T1 ;T1 IS NOW PTR TO REMOVED EDIT TRACE BLOCK
MOVE T2,WHO ;RESET WHO TOUCHED AND ACTIVE FLG
HRRZM T2,TB$STA(T1) ;XWD 0,,WHO
MOVEI T3,TB$VAR(T1) ;T3 GETS START OF VARIABLE AREA
HLRZ T4,TB$LEN(T1) ;T4 GETS NR. OF ASSOC EDIT COUPLETS
IMULI T4,AESIZ ;NUMBER OF WORDS PER A.E.
ADD T3,T4 ;POINT PAST THE A.E.S (IF ANY)
HRRZ T4,TB$LEN(T1) ;GET NR OF PCO GROUPS
MOVE T1,T3 ;GET ADDRESS OF FIRST PCO INTO T1
REM2:
JUMPE T4,REM3 ;ANY PCOS LEFT TO DO?
HLRZ T3,TB$PCO(T1) ;YES,GET PCO TYPE
CAIE T3,1 ;ONLY PCO 1 (INSERT CODE) GETS ACTION
JRST [ HRRZ T3,TB$PCO(T1) ;GET LENGTH OF GROUP
ADDI T1,0(T3) ;AND POINT PAST IT
SOJA T4,REM2] ;SKIP PCOS 2 OR 3
HLRZ A,TB$PAT(T1) ;WHERE DISPLACED INSTR LIVES
HRRZ B,TB$DAT(T1) ;WHERE ITS GOING TO BE
PUSHJ P,GFIXUP ;FIXUP GLOBAL REQUEST CHAIN(S)
PUSHJ P,WRDSRC ;MAP RELOC ADDR TO IN-CORE
$STPCD(TRACE BLOCK is fouled up)
MOVE T2,0(C) ;PICK UP DISPLACED INSTR
PUSHJ P,GETREL ;AND ITS RELOCATION
PUSH P,D ;SAVE THE RELOCATION FOR LATER
HRRZ A,TB$DAT(T1) ;GET WHERE THE INSTRUCTION IS GOING
PUSHJ P,WRDSRC ;MAP IT IN OUR CORE
$STPCD(TRACE BLOCK is fouled up)
MOVEM T2,0(C) ;STORE DISP. INSTR WHERE IT WAS
POP P,D ;GET THE INSTUCTIONS'S RELOCATION
PUSHJ P,CHGREL ;AND PUT IT AWAY
ADDI T1,PCO1SZ ;UPDATE PTR
SOJA T4,REM2 ;AND BACK FOR NEXT PCO
REM3:
TXO F,REGET ;START WITH SYMBOL DELIMITER
BYPASS ;
SKPNCM ;A COMMA?
JRST REM1 ;YES,GET NEXT EDIT NAME
PUSHJ P,.POP4T##
JRST MECELL ;
ERIERR:
$KILL(ERI,Edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " tried to .REMOVE or .REINSERT itself"]
PUSHJ P,.TSTRG##
JRST DONERR
REM8:
MOVE N,CUREDT
$WARN(RIE,Edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " tried to .REMOVE already inactive edit "]
REM8A: PUSHJ P,.TSTRG##
MOVE T1,A
PUSHJ P,.TSIXN##
X$$RIE:
X$$RNE:
PUSHJ P,.TCRLF##
TXZ F,FOTTY
JRST REM3
REM9:
MOVE N,CUREDT
$WARN(RNE,Edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " tried to .REMOVE non-existent edit "]
JRST REM8A
; /FP.RNS/ - PROCESSOR FOR .REINSERT FIX-OP
;
; THIS FIX-PSEUDO-OP IS OF THE FORM :
; .REINSERT EDIT,EDIT...
;
; THE MODULES SPECIFIED ARE RE-ACTIVATED IF THEY HAVE BEEN
; REMOVED.
;
FP.RNS:
PUSHJ P,.PSH4T## ;SAVE T1-4
TXNN F,IAE ;INSIDE EDIT?
JRST E$$EPM ;NO
TXNE F,FSTMOD ;[MODULE] SEEN?
JRST MKMERR ;NO,ITS AN ERROR
MOVE N,CUREDT ;CURRENT EDIT
RNS1:
BYPASS ;EAT BLANKS
TXO F,REGET
PUSHJ P,SYMIN ;GET AN EDIT NAME
JUMPE A,AERROR ;IF NULL,THIS IS ERROR
CAMN A,CUREDT ;CHECK FOR TRYING TO RE-INSERT ITSELF
JRST ERIERR ;THATS FATAL ERROR
MOVE T1,TRCVAP ;NOW ADD PCO
CAILE T1,TRCLST-<PCO3SZ-1> ;IF ROOM, ELSE
JRST E$$ITS ;ABORT ON INSUFFICIENT SPACE
MOVE T2,[3,,PCO3SZ] ;PCO HEADER
MOVEM T2,TB$PCO(T1) ;DEPOSIT IT
MOVEM A,TB$RIN(T1) ;ALSO THE EDIT NAME
ADDI T1,PCO3SZ ;UPDATE POINTER
MOVEM T1,TRCVAP ;AND STORE IT
MOVE T1,TRCPTR ;GET TRACE POINTER
MOVEI T2,PCO3SZ ;UPDATE SIZE
ADDM T2,TB$HED(T1) ;OF LINK BLOCK HEADER
AOS TB$LEN(T1) ;INCREMENT COUNT OF PCO'S
PUSHJ P,FNDEDT ;NOW FIND THE EDIT
JRST RNS9 ;NOT THERE. ITS AN ERROR
SKIPGE TB$STA(B) ;CHECK IF ITS NOT ACTIVE
JRST RNS8
PUSH P,B ;SAVE POINTER
MOVSI B,400000 ;RE-INSERTION FLAG ON
PUSHJ P,CHKCNF ;GENERATE WARNINGS FOR CONFLICTS
POP P,T1 ;POINT TO TRACE BLOCK
MOVE T2,WHO ;WHO IS AFFECTING STATUS
HRROM T2,TB$STA(T1) ;-1,,WHO
MOVEI T3,TB$VAR(T1) ;GET T3 LOADED WITH ADDRESS OF VARIABLE AREA
HLRZ T4,TB$LEN(T1) ;GET NUMBER OF ASSOC EDITS
IMULI T4,AESIZ ;NUMBER OF WORDS PER AE
ADD T3,T4 ;UPDATE IT
HRRZ T4,TB$LEN(T1) ;GET NR. OF PCO GROUPS
MOVE T1,T3 ;T1 HAS ADDR OF FIRST PCO
RNS2:
JUMPE T4,RNS3 ;DONE?
HLRZ T3,TB$PCO(T1) ;NO,GET PCO TYPE
CAIE T3,1 ;ONLY PCO TYPE 1 GETS ACTION
JRST [HRRZ T3,TB$PCO(T1) ;GET LENGTH OF GROUP
ADDI T1,0(T3) ;POINT PAST GROUP
SOJA T4,RNS2] ;AND BACK FOR NEXT PCO
HRRZ A,TB$DAT(T1) ;GET WHERE ANCHOR INST IS
HLRZ B,TB$PAT(T1) ;AND WHERE WE WILL PUT IT
PUSHJ P,GFIXUP ;FIXUP THE GLOBAL CHAIN
PUSHJ P,WRDSRC ;GET WHERE TO BREAK CODE
$STPCD(TRACE BLOCK is fouled up)
MOVSI T2,(JUMPA 0,) ; LH OF "JUMPA PATCH"
HRR T2,TB$PAT(T1) ;RELOC PATCH ADDRESS
MOVEM T2,0(C) ;PATCH IT IN
MOVEI D,1 ;RELOC BYTE OF 01(2)
PUSHJ P,CHGREL ;RELOCATES RIGHT HALF
ADDI T1,PCO1SZ ;POINT TO NEXT PCO
SOJA T4,RNS2 ;BACK TO SEE IF THERE IS ONE
RNS3:
TXO F,REGET ;CHECK DELIMITER
BYPASS
SKPNCM ;COMMA?
JRST RNS1 ;YES,GET NEXT NAME
PUSHJ P,.POP4T##
JRST MECELL ;ELSE BETTER END CELL
RNS8:
MOVE N,CUREDT
$WARN(RIA,Edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " tried to .REINSERT already active edit "]
RNS8A:
PUSHJ P,.TSTRG##
MOVE T1,A
PUSHJ P,.TSIXN##
X$$RIA:
X$$RIN:
PUSHJ P,.TCRLF##
TXZ F,FOTTY
JRST RNS3
RNS9:
MOVE N,CUREDT
$WARN(RIN,Edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ " tried to .REINSERT non-existent edit "]
JRST RNS8A
; /FP.ENE/ - THIS ROUTINE PROCESSES THE ENE OF THE PATCH. ALL PATCHES
; START WITH THE FIX-PSEUDO-OP ".EDIT" AND END WITH THE
; FIX-PSEUDO-OP ".ENDE".
; FLAG "IAE" IS CLEARED TO INDICATE THAT
; WE ARE NOT IN AN EDIT. IT ALSO CHECKS FOR
; UNDEFINED SYMBOLS AND PRINTS AN ERROR MS. IF ANY EXIST.
FP.ENE:
MOVE N,CUREDT ;IN CASE OF ERROR
TXZN F,IAE ;ARE WE IN AN EDIT
JRST E$$EPM ;NO,ERROR
TXZE F,IAI ;WERE NOT IN INSERT WERE WE?
JRST [$KILL(EEI,.ENDE seen before .ENDI in edit,N$SIX)]
PUSHJ P,UDFCHK ;CHECK FOR UNDEFINED LABELS
JRST MECELL ;END OF CELL
IFE DEBUG,<XLIST> ;IF NOT DEBUGGING, CANT TEST
IFN DEBUG, <
; /FP.TST/ - INTERNAL CHECKING ROUTINE
; THIS ROUTINE IS AN INTERNAL TESTING PACKAGE FOR SOME OF THE BPT
; ROUTINES. TO USE IT, THE FOLLOWING SHOULD BE DONE.
; FOO.REL=MAKLIB.REL,TTY:/FIX ;COMMAND TO MAKLIB
; .EDIT XXXXX ;SOME SORT OF EDIT
; .MODULE MAKLIB ;USE CURRENT REL FILE
; .MKLTST ;START TESTS
;
; NOTE: DO NOT PATCH BEFORE OR AFTER TEST PACKAGE IS RUN BECAUSE
; ASSUMPTIONS ARE MADE AND TABLES CHANGED BY THIS ROUTINE.
;
;
DEFINE $TSTFAI, <JSP N,TELERR> ;REPORT TEST FAILURE
DEFINE $TSTDON,<
PUSHJ P,TELDON
>
DEFINE $TSTLBL($A)<TST.'$A:>
DEFINE $TSTGO($A),<
.ZZZ=.ZZZ+1
$TSTLBL(\.ZZZ)
MOVEI N,[ASCIZ "$A"]
MOVEM N,DEBROU
PUSHJ P,TELGO
>
.ZZZ==0
FP.TST:
PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVE A,[SIXBIT /MAKLIB/] ;MAKE SURE THEY SET US UP
CAME A,CURMOD ;BY READING IN MODULE MAKLIB
JRST [$KILL(TNI,<Tests not initialized, load MAKLIB>)]
$TELL (ITC,MAKLIB internal tests commencing...)
SETZM DEBFAI ;0 FAILURES SO FAR
$TSTGO(CODE INSERT)
MOVE A,SEB+2 ;GET A PROGRAM BREAK
MOVEI B,PATMAX ;AND A LIMIT
TST4:
PUSH P,A ;SAVE ACS
PUSH P,B
MOVEI B,1 ;RELOC
MOVEM A,CPADDR
SETOM CPSFLG
MOVE C,[JFCL 17,17] ;UNLIKELY CODE FOR LATER TEST
PUSHJ P,NEWCODE ;INSERT IT
$TSTFAI ;FAILURE
POP P,B ;RESTORE ACS
POP P,A ;
SOSE B ;DONE?
AOJA A,TST4 ;NO
AOS A
PUSHJ P,NEWCOD ;TEST THAT IT CATCHES OVERFLOW
CAIA
$TSTFAI
$TSTDON
$TSTGO(SYMBOL INSERT)
MOVE A,SEB+2 ;GET A STARTING ADDRESS
MOVEI B,CREMAX ;AND LIMIT
TST5:
PUSH P,A ;SAVE ACS
PUSH P,B ;
MOVE R,[RADIX50 0,..S000] ;MAKE BASE OF SYMBOL
ADD R,A ;UPDATE IT
SUB R,SEB+2 ;TO BE ..S<ADR>
MOVEI B,1 ;RELOCATION IS 01(2) I.E. RH
PUSHJ P,NEWSYM ;DO IT
$TSTFAI ;REPORT FAILURE
POP P,B
POP P,A
SOSE B
AOJA A,TST5 ;IF MORE TO DO
AOJ A,
MOVEI B,1 ;RELOCATED IN RH ONLY
PUSHJ P,NEWSYM ;SEE IF WE OVERFLOWED
CAIA
$TSTFAI ;SHOULD CATCH IT
$TSTDON
$TSTGO(INTEGRATED LOOK/SEARCH/MAP)
MOVE R,[SIXBIT /..S000/] ;LOOKUP A NEW SYMBOL
PUSHJ P,SYMSRC ;LOOK IT UP
$TSTFAI ;REPORT FAILURE
CAIE B,10 ;SEE IF LOCAL SYMBOL
$TSTFAI
CAIE D,1 ;MAKE SURE RELOC IS RIGHT
$TSTFAI
CAME A,SEB+2 ;SEE IF THE SAME
$TSTFAI ;NOT RIGHT VALUE
PUSHJ P,WRDSRC ;NOW GET THE NEW WORD
$TSTFAI ;HAS TO BE THERE,WE PUT IT THERE
MOVE A,[JFCL 17,17] ;SEE IF THE RIGHT WORD IS THERE
CAME A,0(C) ;IN THE SPECIFIED PLACE
$TSTFAI ;IF WHAT IS THERE IS NOT WHAT WE PUT THERE
$TSTDON
$TSTGO(SYMBOL SEARCH)
MOVE D,.JBSYM## ;GET SYMBOL TABLE ADDRESS
TSTA:
MOVE A,(D) ;FIND MAKLIB
CAMN A,[RADIX50 0,MAKLIB] ;SEARCH FOR HEADER
JRST TSTB ;IF FOUND
AOBJN D,TSTA
$WARN(NST,Cannot find MAKLIB symbol table,,$MORE)
X$$NST: JRST TST99 ;ABORT TESTS
TSTB:
HLRE B,1(D) ;GET NEG LENGTH INTO B
ADD D,B ;D IS START ADDRESS OF MAKLIB S.T.
HRL D,B ;D IS AOBJN PTR NOW
ADD D,[2,,2] ;ADJUST POINTER
TST1:
MOVE R,(D) ;LOAD A SYMBOL NAME
PUSH P,D ;SAVE D
TLZ R,740000 ;MASK OFF BITS
PUSHJ P,SYMSRA ;SEARCH FOR IT
$TSTFAI
POP P,D ;RESTORE D
ADD D,[2,,2] ;ADD FOR PAIR
JUMPL D,TST1
MOVE R,[RADIX50 0,$....$] ;MAKE SURE IT CAN FAIL
PUSHJ P,SYMSRA ;WHEN IT SHOULD
CAIA ;I.E. SYMBOL ISN'T THERE
$TSTFAI ;FAILURE MESSAGE
$TSTDON
$TSTGO(WORD SEARCH & MAP)
HRRZ A,.JBSA## ;GET STARTING ADDRESS
TST3A:
PUSHJ P,WRDSRC ;LOOK IT UP IN REL FILE
$TSTFAI
AOS A ;UPDATE A
CAIG A,DHISIZ ;TOO BIG?
JRST TST3A ;NO
MOVEI A,377777 ;MAKE SURE IT FAILS WHEN IT SHOULD
PUSHJ P,WRDSRC ;LOOK IT UP
CAIA
$TSTFAI
$TSTDON
$TSTGO(GLOBAL REFERENCE SEARCH)
MOVE R,[SIXBIT/TST6X/] ;MAP WORD IN REL FILE FIRST
PUSHJ P,SYMSRC ;LOOK IT UP
$TSTFAI
PUSHJ P,WRDSRC ;MAP IT
$TSTFAI
PUSH P,A ;SAVE A
JRST TST6B ;SKIP OVER TEST DATA
TST6X: 707070,,.TCRLF## ;XWD UNLIKELY CODE,REFERENCE
TST6B:
SETZB R,T1
PUSHJ P,FGREF ;HUNT THRU CHAIN WITHOUT
;KNOWING SYMBOL NAME
$TSTFAI
CAME R,[RADIX50 0,.TCRLF] ;CORRECT SYMBOL FOUND?
$TSTFAI
HRRZ A,0(C) ;GET POINTER FROM RESULT
PUSHJ P,WRDSRC ;MAP IT INTO REL FILE
$TSTFAI
HLRZ A,0(C) ;
CAIE A,707070 ;FOUND RIGHT WORD?
$TSTFAI ;NO,CONTENTS OF WORD ARE WRONG
MOVE R,[SIXBIT/.TCRLF/] ;KNOW REPEAT,WITH SYMBOL KNOWN
MOVE A,0(P)
PUSHJ P,FGREF ;HUNT THRU CHAIN
;KNOWING SYMBOL NAME
$TSTFAI ;IF NOT FOUND
CAME R,[SIXBIT ".TCRLF"] ;CORRECT SYMBOL FOUND?
$TSTFAI ;FOUND REFERENCE,BUT NOT RIGHT ONE
HRRZ A,0(C) ;GET POINTER FROM RESULT
PUSHJ P,WRDSRC ;MAP IT INTO REL FILE
$TSTFAI ;MAPPING FAILED
HLRZ A,0(C) ;
CAIE A,707070 ;FOUND RIGHT WORD?
$TSTFAI ;MAPPED WRONG WORD
MOVE R,[SIXBIT/$....$/] ;LOOK FOR NON-EX SYMBOL
POP P,A ;WITH RIGHT ADDRESS
PUSHJ P,FGREF ;SHOULD FAIL
SKIPA
$TSTFAI ;FOUND NON-EX REFERENCE SYMBOL
MOVE R,[SIXBIT/.TCRLF/] ;LOOK FOR RIGHT SYMBOL
MOVEI A,2 ;WITH WRONG ADDRESS
PUSHJ P,FGREF ;SHOULD FAIL
SKIPA
$TSTFAI ;FOUND NON-EX REFERENCE CHAIN
$TSTDON
$TSTGO(IST MANIPULATION)
PUSHJ P,ISTINI ;START WITH FRESH IST
MOVEI A,ISTMAX ;NUMBER OF IST ENTRIES
MOVEI C,IST ;SHOULD BE FIRST ALLOCATED
TST7:
PUSH P,A ;DONT ASSUME COUNT SAVED
MOVE T1,C ;SEE IF WE THINK ITS ALREADY VALID
PUSHJ P,ISTVAL ;WHICH IS AN ERROR
CAIA ;OK, CAUSE WE THINK ITS FREE
$TSTFAI ;REPORT FAILURE
PUSHJ P,ISTGET ;RETURN IN C THE ADDRESS OF IST PAIR
CAME T1,C ;DID WE GET THE ONE WE EXPECT?
$TSTFAI ;NO,NEXT IN ORDER NOT ALLOCATED!
PUSHJ P,ISTVAL ;NOW SEE IF ITS VALID.
$TSTFAI ;NO, AND IT SHOULD HAVE BEEN.
ADDI C,2 ;UPDATE ADDRESS
POP P,A ;RESTORE COUNT
SOJG A,TST7 ;IF MORE TO DO,TRY AGAIN
MOVE A,[^-<1B1>] ;FORCE DEALLOCATION OF 2ND PAIR ON
MOVEM A,ISTMAP ;BY ZEROING 2ND BIT IN MAP
MOVEI T1,IST+2 ;THIS WILL BE PAIR ALLOCATED
PUSHJ P,ISTVAL ;NOT VALID RIGHT NOW,RIGHT?
CAIA
$TSTFAI ;OH, OH, WELL REPORT ERROR
PUSHJ P,ISTSAV ;FORCE SAVE OF MAP
PUSHJ P,ISTGET ;NOW ALLOCATE
CAIE C,IST+2 ;GOT RIGHT PAIR?
$TSTFAI ;NO,SO SOMETHING IS WRONG
PUSHJ P,ISTVAL ;NOW IT IS VALID,OR SHOULD BE
$TSTFAI ;
PUSHJ P,ISTRST ;RESTORE MAP
PUSHJ P,ISTVAL ;NOW IT SHOULD NOT BE VALID
CAIA
$TSTFAI ;BECAUSE WE DID <SAVE><GET><RESTORE>
;SEQUENCE.
$TSTDON ;THATS OVER WITH
$TSTGO(OPCODE SEARCH)
MOVSI B,-OPNSIZ ;TEST OF TABLE FOR OPERATORS
MOVE C,[POINT 9,OPC] ;POINTER TO CODE TABLE
MOVE D,[POINT 18,OPH] ;POINTER TO AUX CODE TABLE
TST7A:
MOVE R,OPN(B) ;LOAD AN OPERATOR NAME
PUSH P,B ;SAVE INDEX
PUSH P,C ;AND POINTER
PUSH P,D ;AND POINTER
PUSHJ P,OPSRC ;LOOK IT UP
$TSTFAI
POP P,D ;RESTORE D
POP P,C ;RESTORE C
POP P,B ;RESTORE B
ILDB T4,C ;GET OPERATOR
LSH T4,^D27 ;PUT IT INTO POSITION
TLC T4,700000 ;
TLCE T4,700000
JRST TST77 ;HANDLE HALFWORD STUFF DIFFERENTLY
ILDB T4,D ; GET IT
HRLZS T4
TST77:
CAME T4,A ;
$TSTFAI ;FOUND,BUT INCORRECT CODE FOUND
AOBJN B,TST7A ;SEE IF MORE TO DO
SETZ R, ;MAKE SURE IT CAN FAIL
PUSHJ P,OPSRC ;WHEN IT SHOULD
CAIA
$TSTFAI ;FOUND NON-EXISTENT OP
$TSTDON
$TSTGO(MACRO CODE EVALUATION) ;CURSORY MACRO EVALUATION TEST
MOVEI B,400000 ;USE 400000 AS "."
MOVEM B,CPADDR
MOVSI B,-TST8CL ;NUMBER OF LINES TO DEBUG
TST8A:
TXO F,DEBMOD!DEBIMC ;TRAP ANY ERRORS,USE INTERNAL CODE
HRR C,TST8C(B) ;GET ADDRESS OF THE CODE
HRLI C,(POINT 7,) ;AND THE POINTER
MOVEM C,MACPTR ;STORE THE POINTER
MOVEI C,MACSIZ ;SET FOR MAXIMUM SIZE
MOVEM C,MACCNT ;SET THAT AS THE COUNT
PUSHJ P,ISTINI ;NO IST YET
PUSH P,B ;SAVE INDEX ACROSS CALL
PUSHJ P,EVAL ;CALL EVALUATOR
POP P,B ;RESTORE POINTER
MOVE C,R%V ;CHECK VALUE
CAME C,TST8V(B) ;A MATCH?
$TSTFAI ;NO,REPORT FAILURE
MOVE C,R%R ;AND RELOCATION
CAME C,TST8R(B) ;CHECK MATCH HERE TOO
$TSTFAI ;IF FAILS, REPORT IT
SKIPE R%S ;MAKE SURE IST NOT INVOLVED
$TSTFAI ;ANOTHER FAILURE
AOBJN B,TST8A ;BACK FOR NEXT
TXZ F,DEBMOD!DEBIMC!REGET ;CLEAR FLAGS
JRST TST8X ;DONE WITH TEST
IFE PURESW, <$RELOC==140> ;RELOCATION IF 1 SEGMENT
IFN PURESW, <$RELOC==10> ;RELOCATION IF NORMAL 2 SEGMENT
; MACRO ENTRY HAS FORM, CODE TO READ,CODE TO MATCH, RELOC TO MATCH
DEFINE TST8M,<
IFE BIGLST, <XLIST>
X <12345>,<12345>,0 ;;SIMPLE NUMBER
X <MAKLIB>,<MAKLIB-$RELOC>,1 ;;SIMPLE SYMBOL
X <1+2*2!1-<1!2*2+1>>, <1+2*2!1-<1!2*2+1>>,0 ;;CHECK PRECEDENCE
X <1.1>,<1.1>,0 ;;CHECK FLOATING POINT
X <^L<1>>, <^L<1>>,0 ;;JFFO OP
X < ^-<1B1>>, <^-<1B1> >,0 ;;COMPLEMENT
X <<SIXBIT "123"+ '456'>>, <'123456'>,0 ;;SIXBIT
X <<ASCII "123Ab">>,<<ASCII "123Ab">>,0 ;;ASCII
X <<IOWD PD$LEN,1000>>, << <-PD$LEN>B17+777>>,0 ;;IOWD
X <<RADIX50 4,MAKLIB>>,<<RADIX50 4,MAKLIB>>,0 ;;RADIX50
X <<POINT 10,FP.TST,^O10>>,<<POINT 10,FP.TST-$RELOC,^O10>>,1 ;;POINT OP
X <<99.99E<1>>>, <<99.99E1>>,0 ;;EXPONENT
X <<1^!2>>, <3>,0 ;;XOR
X <<EXP <1+3>>>, 4,0
X <<BYTE (6)33(12)-1(9)5,5>>,<<337777005005>>,0
X <<DEC 10>>,12,0
X <<OCT 10>>,10,0
LIST
> ; END OF TST8M DEFINITION
DEFINE X ($A,$B,$C)< [ASCIZ \ $A'; \]>
TST8C: TST8M
TST8CL==.-TST8C
DEFINE X($A,$B,$C) < EXP <$B> >
TST8V: TST8M
DEFINE X ($A,$B,$C) < EXP <$C> >
TST8R: TST8M
TST8X: $TSTDON
;HERE WHEN ALL TESTS DONE
TST99:
MOVE N,DEBFAI ;GET NUMBER OF FAILURES
$TELL(ITF,Internal tests finished. Failures:,N$DEC)
PUSHJ P,.POP4T## ;RESTORE T1-T4
JRST MECELL ;MUST END CELL
TELERR:
AOS DEBFAI ;UPDATE NUMBER OF FAILURES
MOVEI N,-1(N) ;GET PC OF ERROR CALL
PUSH P,N ;SAVE IT
MOVE N,DEBROU ;GET ERROR ROUTINE NAME
$WARN(TED,Test error detected in,N$STRG,$MORE)
MOVEI T1,[ASCIZ " routine. PC = "]
PUSHJ P,.TSTRG## ;
MOVE T1,0(P) ;GET ADDRESS
PUSHJ P,OUTHW ;AND PRINT IT
X$$TED:
PUSHJ P,.TCRLF## ;END WARNING
JRST CPOPJ1 ;RETURN
TELGO:
X$$EIT: $TELL(SIT,Starting test of,N$STRG,$MORE)
MOVEI T1,[ASCIZ " routine"]
PUSHJ P,.TSTRG##
X$$SIT:
MOVEI T1,[ASCIZ "]
"]
PUSHJ P,.TSTRG##
POPJ P, ;REPORT AND RETURN
TELDON:
$TELL(EIT,End of test)
POPJ P,
> ; NFI DEBUG
IFE DEBUG,<LIST> ;RESUME LISTING
IFN DEBUG, < ;ONLY IF DEBUGGING
; /FP.DME/ - ROUTINE TO HELP DEBUG MACRO EVALUATOR
;
; TO USE, INCLUDE PSEUDO-OP ".DMON" IN FIX FILE.
; INSTEAD OF GENERATING CODE, CODE IS EVALUATED AND THE RESULT PRINTED
; OUT. ALSO, THE MACRO CODE ERRORS, USUALLY FATAL, ARE RETURNED WITHOUT
; ABORTING THE RUN.
; TO GET OUT OF THIS MODE, US THE PSEUDO-OP ".DMOFF" IN THE FIX FILE.
;
FP.DME:
FP.DMN:
TXO F,DEBMOD ;PUT IT INTO DEBUG MODE
JRST MECELL ;END OF CELL
FP.DMF:
TXZ F,DEBMOD ;NO MORE DEBUG MODE
JRST MECELL ;END OF CELL
; /.GODDT/ - THIS PSEUDO-OP CAUSES MAKLIB TO ENTER DDT
; IF IT IS LOADED. TO EXIT FROM DDT, USE THE
; COMMAND "CONTIN$X".
;
OPDEF CONTIN [JRST .GODD1]
.GODDT:
SKIPN T,.JBDDT## ;SEE IF DDT LOADED
JRST MECELL ;NO,SO FORGET IT
PUSHJ P,.PSH4T## ;SAVE ACS
$TELL(DDT,Entering DDT)
JRST 0(T) ;GO TO DDT
.GODD1:
PUSHJ P,.POP4T## ;RESTORE T1-4
JRST MECELL ;MUST BE STANDING ALONE
> ; NFI DEBUG
SUBTTL UTILITY ROUTINES FOR THE MACRO STATEMENT EVALUATOR
; /PSHOPR/ - ROUTINE TO PUSH ACS A,B,C,D ONTO THE OPERAND STACK
; /POPOPR/ - COMPLIMENTARY POP ROUTINE
; BOTH ROUTINES USE STACK "OPRSTK" AND TRAP PDL OVER AND
; UNDERFLOW.
;
PSHOPR:
EXCH T,OPRPTR ;SAVE T,GET POINTER
CAILE T,OPRSIZ-3 ;4 LOCATIONS LEFT?
JRST ETCERR ;EXPRESSION TOO COMPLEX
MOVEM A,OPRSTK(T) ;STORE A-D
MOVEM B,OPRSTK+1(T) ;
MOVEM C,OPRSTK+2(T) ;
MOVEM D,OPRSTK+3(T)
ADDI T,4 ;UPDATE AND
EXCH T,OPRPTR ;STORE
POPJ P, ;RETURN
POPOPR:
EXCH T,OPRPTR ;GET POINTER
SUBI T,4 ;GET BOTTOM OF POP
CAMGE T,OPRTOP ;UNDERFLOW INTO NEXT FRAME?
$STPCD(Expression stack underflowed)
MOVE A,OPRSTK(T) ;LOAD A-D
MOVE B,OPRSTK+1(T) ;FROM STOREAGE
MOVE C,OPRSTK+2(T) ;
MOVE D,OPRSTK+3(T)
EXCH T,OPRPTR ;STORE THE UPDATED POINTER
POPJ P, ;AND TAKE RETURN
; /PSHOPT/- ROUTINE TO PUSH OPERATOR INDEX IN AC T ONTO STACK
; /POPOPT/- COMPLIMENTARY POP ROUTINE
;
PSHOPT:
EXCH D,OPTPTR ;GET POINTER
CAILE D,OPTSIZ ;ROOM LEFT?
JRST ETCERR ;EXPRESSION TO COMPLEX ERROR
MOVEM T,OPTSTK(D) ;
EXCH D,OPTPTR ;REPLACE POINTER
AOS OPTPTR ;UPDATE POINTER
POPJ P, ;RETURN
POPOPT:
EXCH D,OPTPTR ;GET POINTER
SOS D ;
CAMGE D,OPTTOP ;UNDERFLOW?
$STPCD(Expression stack undeflowed)
MOVE T,OPTSTK(D) ;DO IT
EXCH D,OPTPTR ;RESTORE
POPJ P, ;RETURN
; /ASGEVL/ - ROUTINE TO EVALUATE OPS AFTER "SYMBOL="
;
; THIS ROUTINE STORES THE SYMBOL AND FLGS FOR THE CASE OF:
; SYMBOL='????' WHERE '????' IS ONE OF:
; =, =:, :, ! , :!
;
; INPUTS- AC A IS SIXBIT SYMBOL NAME
;
; OUTPUTS- ASGSYM IS SET UP AS FLAGS IN BITS 0-3+<RADIX50 SYMBOL>
;
ASGEVL:
MOVE R,A ;GET SYMBOL NAME
PUSHJ P,RAD50 ;CONVERT TO RADIX50
TXO R,R5.LCL ;START AS LOCAL SYMBOL
PUSHJ P,MIC ;GET CHARACTER AFTER FIRST =
CAIN CC,"=" ;IS IT ANOTHER = (NODDT)?
JRST [TXO R,R5.DDT ;YES,SUPRESS IT
PUSHJ P,MIC ;AND EAT THE CHARACTER
JRST .+1] ;
ASGEV1:
CAIN CC,"!" ;IS IT "!" (ALSO SUPRESS)
JRST [TXOE R,R5.DDT ;YES,SUPRESS IT
JRST QERROR ;IF ALREADY ON
PUSHJ P,MIC ;EAT THE CHARACTER
JRST .+1] ;CONTINUE
CAIN CC,":" ;IS IT COLON?
JRST [TXOE R,R5.GLB ;YES,FLAG AS AVAILABLE
JRST QERROR ;TO OTHERS, IF NOT ALREADY
TXZ R,R5.LCL ;IF GLOBAL,ITS NOT LOCAL
PUSHJ P,MIC ;EAT IT
JRST ASGEV1] ;HANDLE CASE OF "=:!"
MOVEM R,ASGSYM ;STORE FLAGS+SYMBOL
TXO F,REGET ;REGET CHARACTER
POPJ P, ;RETURN TO CALLER
; /ASGMAK/ - ROUTINE TO MAKE THE ACTUAL ASSIGNMENT OF 'SYMBOL==EXPRESSION'
; THIS ROUTINE ASSIGNS THE VALUE OF THE CURRENT STATEMENT TO THE
; SYMBOL IN LOCATION "ASGSYM" . IN ADDITION, IT SETS THE NULL
; STATMENT FLAG IF THIS WAS A PRIMARY STATEMENT, SINCE IN THAT
; CASE WE DO NOT WISH TO GENERATE ANY CODE.
;
ASGMAK:
MOVE R,ASGSYM ;GET SYMBOL NAME
TLZ R,740000 ;CLEAR NON-SYMBOL BITS
TXNE F,IAE ;INSIDE EDIT AND
TXNE F,FSTMOD ;IS THERE A MODULE SELECTED?
JRST ASGWNM ;YES,THATS A MISTAKE
PUSHJ P,SYMSRA ;LOOK IT UP IN RADIX50
CAIA ;DONT ALLOW RE-DEFINES
JRST MERRO1 ;
JUMPN %S,ASGERR ;OR FORWARD AND/OR EXT REFERENCES
MOVE R,ASGSYM ;RESET AS SYMBOL+FLAGS
TDNE %R,[^-<1,,1>] ;MAKE SURE RELOCATION IS OK
JRST RERROR ;ELSE FLAG ERROR
MOVE A,%V ;PICK UP THE VALUE
HRRZ B,%R ;AND RELOCATION
TLNE %R,1 ;CONVERT TO RIGHT FORMAT
TRO B,1B34 ;FOR NEWSYM
PUSHJ P,NEWSYM ;REGISTER THE SYMBOL
JRST STOERR ;IF NO ROOM, BOMB OUT
TXNN %F,S.NPS ;SKIP IF NOT PRIMARY
ASGMA1: SETOM NULFLG ;DISCARD CODE
PUSHJ P,PMLOC ;TRY TO REDUCE SIZE OF IST
POPJ P, ;RETURN
ASGERR:
MOVE N,R ;GET SYMBOL
$KILL(ASG,FORWARD/EXTERNAL assignment to,N$50,$MORE)
JRST MCCOMM
ASGWNM:
MOVE N,R
$WARN(AMI,Assignment to,N$50,$MORE)
MOVEI T1,[ASCIZ " with no module selected was ignored:
"]
PUSHJ P,.TSTRG##
PUSHJ P,TYPTB1
MOVEI T1,MACBUF
PUSHJ P,.TSTRG##
SKIPA
X$$AMI: PUSHJ P,.TCRLF##
TXZ F,FOTTY
JRST ASGMA1
; /MACSRC/ - ROUTINE TO SEARCH ALL THE BUILT IN CODES FOR MACRO-10
;
; INPUTS- AC R SHOULD CONTAIN A SIXBIT SYMBOL
;
; OUTPUTS- AC A WILL CONTAIN THE PROPERLY SET UP MACRO-10 INSTRUCTION
; AC B & AC C WILL CONTAIN 0
; AC D WILL CONTAIN THE APPROPRIATE FLAGS INDICATING WHAT
; TYPE OF CELL IS BEING RETURNED.
; SHOULD BE ONE OF: C.OP, C.POP
;
; RETURNS: CPOPJ=NO MATCH AT ALL CPOPJ1=MATCH FOUND SOMEPLACE
;
; ORDER OF SEARCH IS: MACHINE OPS,CALLIS,TTCALLS,MTAPES,PSEUDO-OPS
;
MACSRC:
PUSHJ P,OPSRC ;FIRST LOOK AT MACHINE CODES
CAIA ;NOT THERE
JRST MACSR9 ;A MATCH!
MOVE A,[XWD -CALNTH,CALTBL] ;LOOK AT CALLI TABLE NOW
MACSR1:
CAMN R,0(A) ;CHECK FOR MATCH
JRST [ SUBI A,CALLI0 ;ADJUST CODE
HRLI A,(CALLI) ;SET INSTR. PART
JRST MACSR9] ;END IT
AOBJN A,MACSR1 ;LOOP BACK FOR MORE
MOVSI A,-TTCLTH ;NOW TRY THE TTCALLS
MACSR2:
CAMN R,TTCTBL(A) ;A MATCH?
JRST [ LSH A,5 ;YES,SET UP IN AC FIELD
ANDI A,(Z 17,) ;CLEAR OUT THE JUNK
HRLZI A,<(TTCALL)>(A) ;
JRST MACSR9 ] ;FINISH AS USUAL
AOBJN A,MACSR2 ;IF MORE TTCALLS LEFT
MOVSI A,-MTALTH ;NOW THE MTAPE CODES
MOVE B,[POINT 9,MTACOD] ;POINTER TO CODES USED
MACSR3:
ILDB C,B ;GET BITS FOR THIS CODE
CAMN R,MTATBL(A) ;LOOK UP IN TABLE
JRST [ MOVSI A,(MTAPE) ;UUO CODE
HRRI A,(C) ;AND PARTICULAR FUNCTION CODE
JRST MACSR9] ;END IT
AOBJN A,MACSR3
MOVSI B,-POPLTH
;DEFINE BITS FOR PSEUDO-OP CHARACTERISTIC FLAGS
$1BIT==1B17 ;LEAVE RH FREE FOR ADDRESS
BIT($INP) ;THIS PSEUDO-OP NOT DEFINED OUTSIDE OF PRIMARY STATEMENT
BIT($III) ;THIS PSEUDO-OP ILLEGAL INSIDE OF .INSERT
MACSR4:
MOVE A,POPDO(B) ;LOAD FLAGS,,ADDRESS OF PROCESSOR
CAMN R,POPNAM(B) ;IS IT A MATCH?
JRST MCSR4B ;YES,RETURN
MCSR4A: AOBJN B,MACSR4 ;TEST FOR MORE TRIES LEFT
SETZB A,B ;CLEAR RESULTS
SETZB C,D ;SINCE GARBAGE IN ACS
POPJ P, ;NO MATCH RETURN
MCSR4B:
TXNN A,$INP ;IS IGNORE IF NOT PRIMARY BIT ON?
JRST MCSR4C ;NO,SO FORGET THIS
TXNE %F,I.OP ;MUST BE IN OPCODE FIELD
TXNE %F,S.NPS ;OF PRIMARY STATEMENT
JRST MCSR4A ;ELSE IGNORE IT
MCSR4C:
TXNE A,$III ;IS POP ILLEGAL IN RANGE OF INSERT?
TXNN F,IAI ;YES,ARE WE IN THAT?
CAIA
JRST IIIERR ;YES,TRAP IT
SKIPA D,[C.POP] ;A PSEUDO-OP WAS FOUND
MACSR9: MOVX D,C.OP ; SOME SORT OF OPCODE OR UUO FOUND
SETZB B,C ;CLEAR RELOCATION AND SYMBOL FIXUP
JRST CPOPJ1 ;TAKE SUCCESSFUL RETURN
IIIERR:
MOVE N,R ;FOR ERROR MESSAGE
$KILL(III,Illegal pseudo-op in range of .INSERT: ,N$SIX,$MORE)
JRST MCCOMM
; /OPSRC/ - ROUTINE TO LOOKUP THE 9 BIT OPCODE FOR A SYMBOL, IF IT IS AN DEC-10 OPERATOR
;
; INPUTS- AC R CONTAINS SIXBIT SYMBOL
;
; OUTPUTS- IF SYMBOL IS -10 OPERATOR:
; AC A CONTAINS INSTRUCTION CODE IN BITS 0-8
; AC B & AC C CONTAIN 0
; AC D CONTAINS C.OP FLAG ON,ALL OTHERS OFF
;
; RETURNS: CPOPJ= SYMBOL NOT AN OPERATOR CPOPJ1=MATCH FOUND
;
OPSRC:
SETZB B,D ;START LOCATION OF LIST
MOVEI C,OPNSIZ ;AND END OF LIST
OPSRC1:
MOVE A,B ;GUESS IS (HIGH+LOW)/2
ADD A,C ;
ASH A,-1 ;
CAMN A,D ;SAME AS LAST GUESS?
POPJ P, ;YES,SO NO MATCH
MOVEM A,D ;STORE THIS GUESS INDEX
CAMLE R,OPN(A) ;GUESSED TOO LOW?
JRST [MOVE B,A ;YES,CORRECT LOW BOUND
JRST OPSRC1] ;
CAME R,OPN(A) ;A MATCH?
JRST [MOVE C,A ;NO,CORRECT UPPER BOUND
JRST OPSRC1] ;AND GO AGAIN
IDIVI A,4 ;FOUR CODES PER WORD OF OPC
MOVE A,OPC(A) ;GET CORRECT WORD
IMULI B,^D9 ;GET OPCODE IN BITS 26-35.
ROT A,^D9(B) ;FOR COMPARES ETC.
ANDI A,777 ;GET RID OF EXTRA STUFF
CAIGE A,700 ;"FAKE" OPCODE?
JRST OPSRC2 ;YES, SKIP HALFWORD STUFF
MOVEI B,-700(A) ;GET INDEX INTO TABLE
MOVE C,[POINT 18,OPH] ;POINTER TO TABLE
ILDB A,C ;GET HALFWORD
SOJGE B,.-1
HRLZS A ;BLANK OUT WRONG HALF
CAIA ;SKIP POSITIONING
OPSRC2:
LSH A,^D27 ;PUT 9 BIT OPCODE INTO PLACE
SETZB B,C ;CLEAR RELOC AND FIXUP
MOVX D,C.OP ;FLAG AS AN OPCODE
JRST CPOPJ1 ;TAKE GOOD RETURN
; TABLE OF OPCODE NAMES AND THEIR ASSOCIATED VALUES
; EACH ENTRY IN THE LIST SHOULD CONTAIN THE NAME OF THE
; OPCODE AND ITS ASSOCIATED 9 BIT CODE
; THE ENTRIES MUST BE IN ALPHABETIC ORDER.
;
;
; OPCODES THAT ARE NOT IN BITS 0-8 INCLUSIVE (I.E. IO INSTRUCTIONS AND
; AND PSEUDO-INSTRUCTIONS SHOULD USE THE Y MACRO RATHER THAN
; THE X. THE FIRST ARGUMENT TO Y IS SAME AS X, BUT THE SECOND
; IS A VALUE TO BE PLACE IN LH OF INSTRUCTION. EXAMPLE:
; Y HALT,<JRST 4,>
;
;
; THE FOLLOWING HANDWAVING IS USED TO AVOID STORING ALL THE OPCODES
; AND THEIR NAMES AS A MACRO, WHICH WOULD SLOW UP COMPILATION CONSIDERABLY
; INSTEAD, ON PASS1 WE RESERVE SPACE FOR CODES AND NAMES, AND ON
; PASS2 WE ACTUALLY GENERATE CODE IN THE PROPER PLACES.
; THE THREE TABLES GENERATED ARE:
; OPN- TABLE OF SIXBIT NAMES OF OPCODES
; OPC- TABLE OF 9 BIT OPCODES
; OPH- TABLE OF AUX. HALFWORD VALUES
;
.XCREF ;TOO MESSY TO CREF
IF1,<
OPNSIZ==0
OPHSIZ==0
DEFINE X($A,$B)<
OPNSIZ==OPNSIZ+1>
DEFINE Y($A,$B)<
OPHSIZ==OPHSIZ+1
X($A,$B) >
>
IF2,< NLOC==OPN
CLOC==OPC
HLOC==OPH
..TMP1==-1
..TMP2==0
..TMP3==700
..TMP4==0
DEFINE X($A,$B)<
.ORG NLOC
SIXBIT/$A/
NLOC==NLOC+1
.ORG CLOC
$CODE($B)
CLOC==. >
DEFINE Y($A,$B)<
.ORG HLOC
IFE ..TMP3&1,<..TMP4==<$B>>
IFN ..TMP3&1,< EXP ..TMP4+<<$B>_-^D18>>
HLOC==.
X($A,..TMP3)
..TMP3==..TMP3+1
>
>
X ADD , 270
X ADDB , 273
X ADDI , 271
X ADDM , 272
X AND , 404
X ANDB , 407
X ANDCA , 410
X ANDCAB, 413
X ANDCAI, 411
X ANDCAM, 412
X ANDCB , 440
X ANDCBB, 443
X ANDCBI, 441
X ANDCBM, 442
X ANDCM , 420
X ANDCMB, 423
X ANDCMI, 421
X ANDCMM, 422
X ANDI , 405
X ANDM , 406
X AOBJN , 253
X AOBJP , 252
X AOJ , 340
X AOJA , 344
X AOJE , 342
X AOJG , 347
X AOJGE , 345
X AOJL , 341
X AOJLE , 343
X AOJN , 346
X AOS , 350
X AOSA , 354
X AOSE , 352
X AOSG , 357
X AOSGE , 355
X AOSL , 351
X AOSLE , 353
X AOSN , 356
X ASH , 240
X ASHC , 244
Y BLKI , BLKI
Y BLKO , BLKO
X BLT , 251
X CAI , 300
X CAIA , 304
X CAIE , 302
X CAIG , 307
X CAIGE , 305
X CAIL , 301
X CAILE , 303
X CAIN , 306
X CALL , 040
X CALLI , 047
X CAM , 310
X CAMA , 314
X CAME , 312
X CAMG , 317
X CAMGE , 315
X CAML , 311
X CAMLE , 313
X CAMN , 316
X CLEAR , 400
X CLEARB, 403
X CLEARI, 401
X CLEARM, 402
X CLOSE , 070
Y CONI , CONI
Y CONO , CONO
Y CONSO , CONSO
Y CONSZ , CONSZ
Y DATAI , DATAI
Y DATAO , DATAO
X DFAD , 110
X DFDV , 113
X DFMP , 112
X DFN , 131
X DFSB , 111
X DIV , 234
X DIVB , 237
X DIVI , 235
X DIVM , 236
X DMOVE , 120
X DMOVEM, 124
X DMOVN , 121
X DMOVNM, 125
X DPB , 137
X ENTER , 077
X EQV , 444
X EQVB , 447
X EQVI , 445
X EQVM , 446
X EXCH , 250
X FAD , 140
X FADB , 143
X FADL , 141
X FADM , 142
X FADR , 144
X FADRB , 147
X FADRI , 145
X FADRM , 146
X FDV , 170
X FDVB , 173
X FDVL , 171
X FDVM , 172
X FDVR , 174
X FDVRB , 177
X FDVRI , 175
X FDVRM , 176
X FIX , 122
X FIXR , 126
X FLTR , 127
X FMP , 160
X FMPB , 163
X FMPL , 161
X FMPM , 162
X FMPR , 164
X FMPRB , 167
X FMPRI , 165
X FMPRM , 166
X FSB , 150
X FSBB , 153
X FSBL , 151
X FSBM , 152
X FSBR , 154
X FSBRB , 157
X FSBRI , 155
X FSBRM , 156
X FSC , 132
X GETSTS, 062
Y HALT , HALT
X HLL , 500
X HLLE , 530
X HLLEI , 531
X HLLEM , 532
X HLLES , 533
X HLLI , 501
X HLLM , 502
X HLLO , 520
X HLLOI , 521
X HLLOM , 522
X HLLOS , 523
X HLLS , 503
X HLLZ , 510
X HLLZI , 511
X HLLZM , 512
X HLLZS , 513
X HLR , 544
X HLRE , 574
X HLREI , 575
X HLREM , 576
X HLRES , 577
X HLRI , 545
X HLRM , 546
X HLRO , 564
X HLROI , 565
X HLROM , 566
X HLROS , 567
X HLRS , 547
X HLRZ , 554
X HLRZI , 555
X HLRZM , 556
X HLRZS , 557
X HRL , 504
X HRLE , 534
X HRLEI , 535
X HRLEM , 536
X HRLES , 537
X HRLI , 505
X HRLM , 506
X HRLO , 524
X HRLOI , 525
X HRLOM , 526
X HRLOS , 527
X HRLS , 507
X HRLZ , 514
X HRLZI , 515
X HRLZM , 516
X HRLZS , 517
X HRR , 540
X HRRE , 570
X HRREI , 571
X HRREM , 572
X HRRES , 573
X HRRI , 541
X HRRM , 542
X HRRO , 560
X HRROI , 561
X HRROM , 562
X HRROS , 563
X HRRS , 543
X HRRZ , 550
X HRRZI , 551
X HRRZM , 552
X HRRZS , 553
X IBP , 133
X IDIV , 230
X IDIVB , 233
X IDIVI , 231
X IDIVM , 232
X IDPB , 136
X ILDB , 134
X IMUL , 220
X IMULB , 223
X IMULI , 221
X IMULM , 222
X IN , 056
X INBUF , 064
X INIT , 041
X INPUT , 066
X IOR , 434
X IORB , 437
X IORI , 435
X IORM , 436
Y JCRY , JCRY
Y JCRY0 , JCRY0
Y JCRY1 , JCRY1
Y JEN , JEN
X JFCL , 255
X JFFO , 243
Y JFOV , JFOV
Y JOV , JOV
X JRA , 267
X JRST , 254
Y JRSTF , JRSTF
X JSA , 266
X JSP , 265
X JSR , 264
X JSYS , 104
X JUMP , 320
X JUMPA , 324
X JUMPE , 322
X JUMPG , 327
X JUMPGE, 325
X JUMPL , 321
X JUMPLE, 323
X JUMPN , 326
X LDB , 135
X LOOKUP, 076
X LSH , 242
X LSHC , 246
X MAP , 257
X MOVE , 200
X MOVEI , 201
X MOVEM , 202
X MOVES , 203
X MOVM , 214
X MOVMI , 215
X MOVMM , 216
X MOVMS , 217
X MOVN , 210
X MOVNI , 211
X MOVNM , 212
X MOVNS , 213
X MOVS , 204
X MOVSI , 205
X MOVSM , 206
X MOVSS , 207
X MTAPE , 072
X MTOP. , 024
X MUL , 224
X MULB , 227
X MULI , 225
X MULM , 226
X OPEN , 050
X OR , 434
X ORB , 437
X ORCA , 454
X ORCAB , 457
X ORCAI , 455
X ORCAM , 456
X ORCB , 470
X ORCBB , 473
X ORCBI , 471
X ORCBM , 472
X ORCM , 464
X ORCMB , 467
X ORCMI , 465
X ORCMM , 466
X ORI , 435
X ORM , 436
X OUT , 057
X OUTBUF, 065
X OUTPUT, 067
X POP , 262
X POPJ , 263
Y PORTAL, PORTAL
X PUSH , 261
X PUSHJ , 260
X RELEAS, 071
X RENAME, 055
X ROT , 241
X ROTC , 245
Y RSW , RSW
X SETA , 424
X SETAB , 427
X SETAI , 425
X SETAM , 426
X SETCA , 450
X SETCAB, 453
X SETCAI, 451
X SETCAM, 452
X SETCM , 460
X SETCMB, 463
X SETCMI, 461
X SETCMM, 462
X SETM , 414
X SETMB , 417
X SETMI , 415
X SETMM , 416
X SETO , 474
X SETOB , 477
X SETOI , 475
X SETOM , 476
X SETSTS, 060
X SETZ , 400
X SETZB , 403
X SETZI , 401
X SETZM , 402
X SKIP , 330
X SKIPA , 334
X SKIPE , 332
X SKIPG , 337
X SKIPGE, 335
X SKIPL , 331
X SKIPLE, 333
X SKIPN , 336
X SOJ , 360
X SOJA , 364
X SOJE , 362
X SOJG , 367
X SOJGE , 365
X SOJL , 361
X SOJLE , 363
X SOJN , 366
X SOS , 370
X SOSA , 374
X SOSE , 372
X SOSG , 377
X SOSGE , 375
X SOSL , 371
X SOSLE , 373
X SOSN , 376
X STATO , 061
X STATUS, 062
X STATZ , 063
X SUB , 274
X SUBB , 277
X SUBI , 275
X SUBM , 276
X TDC , 650
X TDCA , 654
X TDCE , 652
X TDCN , 656
X TDN , 610
X TDNA , 614
X TDNE , 612
X TDNN , 616
X TDO , 670
X TDOA , 674
X TDOE , 672
X TDON , 676
X TDZ , 630
X TDZA , 634
X TDZE , 632
X TDZN , 636
X TLC , 641
X TLCA , 645
X TLCE , 643
X TLCN , 647
X TLN , 601
X TLNA , 605
X TLNE , 603
X TLNN , 607
X TLO , 661
X TLOA , 665
X TLOE , 663
X TLON , 667
X TLZ , 621
X TLZA , 625
X TLZE , 623
X TLZN , 627
X TRC , 640
X TRCA , 644
X TRCE , 642
X TRCN , 646
X TRN , 600
X TRNA , 604
X TRNE , 602
X TRNN , 606
X TRO , 660
X TROA , 664
X TROE , 662
X TRON , 666
X TRZ , 620
X TRZA , 624
X TRZE , 622
X TRZN , 626
X TSC , 651
X TSCA , 655
X TSCE , 653
X TSCN , 657
X TSN , 611
X TSNA , 615
X TSNE , 613
X TSNN , 617
X TSO , 671
X TSOA , 675
X TSOE , 673
X TSON , 677
X TSZ , 631
X TSZA , 635
X TSZE , 633
X TSZN , 637
X TTCALL, 051
X UFA , 130
X UGETF , 073
X UJEN , 100
X UMOVE , 100
X UMOVEI, 101
X UMOVEM, 102
X UMOVES, 103
X USETI , 074
X USETO , 075
X XCT , 256
X XOR , 430
X XORB , 433
X XORI , 431
X XORM , 432
X Z , 000
IF1,<
OPN: BLOCK OPNSIZ
OPC: BLOCK <OPNSIZ+3>/4
OPH: BLOCK <OPHSIZ+1>/2
>
IF2,<
.ORG CLOC
IFG ..TMP1,< EXP ..TMP2>
.ORG HLOC
IFN ..TMP3&1, <EXP ..TMP4>
>
DEFINE $CODE($B)<
IFE ^D35-..TMP1,<
EXP ..TMP2
..TMP1==-1
..TMP2==0 >
..TMP1==..TMP1+^D9
..TMP2==..TMP2!<$B>B<..TMP1>
> ;END OF $CODE DEFINITION
.CREF ;RESUME CREF OUTPUT
;TABLES FOR OTHER BUILT - IN MNEMONIC CODES, CALLI'S ETC.
;TABLE OF CALL IMMEDIATE MNEMONICS
CALTBL:
;USER DEFINED CALLI'S GO HERE
SIXBIT /LIGHTS/ ;-1
CALLI0: SIXBIT /RESET/ ; 0
SIXBIT /DDTIN/ ; 1
SIXBIT /SETDDT/ ; 2
SIXBIT /DDTOUT/ ; 3
SIXBIT /DEVCHR/ ; 4
SIXBIT /DDTGT/ ; 5
SIXBIT /GETCHR/ ; 6
SIXBIT /DDTRL/ ; 7
SIXBIT /WAIT/ ;10
SIXBIT /CORE/ ;11
SIXBIT /EXIT/ ;12
SIXBIT /UTPCLR/ ;13
SIXBIT /DATE/ ;14
SIXBIT /LOGIN/ ;15
SIXBIT /APRENB/ ;16
SIXBIT /LOGOUT/ ;17
SIXBIT /SWITCH/ ;20
SIXBIT /REASSI/ ;21
SIXBIT /TIMER/ ;22
SIXBIT /MSTIME/ ;23
SIXBIT /GETPPN/ ;24
SIXBIT /TRPSET/ ;25
SIXBIT /TRPJEN/ ;26
SIXBIT /RUNTIM/ ;27
SIXBIT /PJOB/ ;30
SIXBIT /SLEEP/ ;31
SIXBIT /SETPOV/ ;32
SIXBIT /PEEK/ ;33
SIXBIT /GETLIN/ ;34
SIXBIT /RUN/ ;35
SIXBIT /SETUWP/ ;36
SIXBIT /REMAP/ ;37
SIXBIT /GETSEG/ ;40
SIXBIT /GETTAB/ ;41
SIXBIT /SPY/ ;42
SIXBIT /SETNAM/ ;43
SIXBIT /TMPCOR/ ;44
SIXBIT /DSKCHR/ ;45
SIXBIT /SYSSTR/ ;46
SIXBIT /JOBSTR/ ;47
SIXBIT /STRUUO/ ;50
SIXBIT /SYSPHY/ ;51
SIXBIT /FRECHN/ ;52
SIXBIT /DEVTYP/ ;53
SIXBIT /DEVSTS/ ;54
SIXBIT /DEVPPN/ ;55
SIXBIT /SEEK/ ;56
SIXBIT /RTTRP/ ;57
SIXBIT /LOCK/ ;60
SIXBIT /JOBSTS/ ;61
SIXBIT /LOCATE/ ;62
SIXBIT /WHERE/ ;63
SIXBIT /DEVNAM/ ;64
SIXBIT /CTLJOB/ ;65
SIXBIT /GOBSTR/ ;66
0 ;67
0 ;70
SIXBIT /HPQ/ ;71
SIXBIT /HIBER/ ;72
SIXBIT /WAKE/ ;73
SIXBIT /CHGPPN/ ;74
SIXBIT /SETUUO/ ;75
SIXBIT /DEVGEN/ ;76
SIXBIT /OTHUSR/ ;77
SIXBIT /CHKACC/ ;100
SIXBIT /DEVSIZ/ ;101
SIXBIT /DAEMON/ ;102
SIXBIT /JOBPEK/ ;103
SIXBIT /ATTACH/ ;104
SIXBIT /DAEFIN/ ;105
SIXBIT /FRCUUO/ ;106
SIXBIT /DEVLNM/ ;107
SIXBIT /PATH./ ;110
SIXBIT /METER./ ;111
SIXBIT /MTCHR./ ;112
SIXBIT /JBSET./ ;113
SIXBIT /POKE./ ;114
SIXBIT /TRMNO./ ;115
SIXBIT /TRMOP./ ;116
SIXBIT /RESDV./ ;117
SIXBIT /UNLOK./ ;120
SIXBIT /DISK./ ;121
SIXBIT /DVRST./ ;122
SIXBIT /DVURS./ ;123
SIXBIT /XTTSK./ ;124
SIXBIT /CAL11./ ;125
SIXBIT /MTAID./ ;126
SIXBIT /IONDX./ ;127
SIXBIT /CNECT./ ;130
SIXBIT /MVHDR./ ;131
SIXBIT /ERLST./ ;132
SIXBIT /SENSE./ ;133
SIXBIT /CLRST./ ;134
SIXBIT /PIINI./ ;135
SIXBIT /PISYS./ ;136
SIXBIT /DEBRK./ ;137
SIXBIT /PISAV./ ;140
SIXBIT /PIRST./ ;141
SIXBIT /IPCFR./ ;142
SIXBIT /IPCFS./ ;143
SIXBIT /IPCFQ./ ;144
SIXBIT /PAGE./ ;145
SIXBIT /SUSET./ ;146
SIXBIT /COMPT./ ;147
SIXBIT /SCHED./ ;150
SIXBIT /ENQ./ ;151
SIXBIT /DEQ./ ;152
SIXBIT /ENQC./ ;153
SIXBIT /TAPOP./ ;154
SIXBIT /FILOP./ ;155
SIXBIT /CAL78./ ;156
SIXBIT /NODE./ ;157
SIXBIT /ERRPT./ ;160
SIXBIT /ALLOC./ ;161
SIXBIT /PERF./ ;162
CALNTH==.-CALTBL
;TABLE OF TTCALL MNEMONICS
TTCTBL: SIXBIT /INCHRW/ ; 0 INPUT A CHAR. AND WAIT
SIXBIT /OUTCHR/ ; 1 OUTPUT A CHAR.
SIXBIT /INCHRS/ ; 2 INPUT A CHAR. AND SKIP
SIXBIT /OUTSTR/ ; 3 OUTPUT A STRING
SIXBIT /INCHWL/ ; 4 INPUT CHAR., WAIT, LINE MODE
SIXBIT /INCHSL/ ; 5 INPUT CHAR., SKIP, LINE MODE
SIXBIT /GETLCH/ ; 6 GET LINE CHARACTERISTICS
SIXBIT /SETLCH/ ; 7 SET LINE CHARACTERISTICS
SIXBIT /RESCAN/ ;10 RESET INPUT STREAM TO COMMAND
SIXBIT /CLRBFI/ ;11 CLEAR TYPEIN BUFFER
SIXBIT /CLRBFO/ ;12 CLEAR TYPEOUT BUFFER
SIXBIT /SKPINC/ ;13 SKIPS IF A CHAR. CAN BE INPUT
SIXBIT /SKPINL/ ;14 SKIPS IF A LINE CAN BE INPUT
SIXBIT /IONEOU/ ;15 OUTPUT AS AN IMAGE CHAR.
TTCLTH==.-TTCTBL
;TABLE OF MTAPE MNEMONICS
MTATBL: SIXBIT /MTWAT./ ; 0
SIXBIT /MTREW./ ; 1
SIXBIT /MTEOF./ ; 3
SIXBIT /MTSKR./ ; 6
SIXBIT /MTBSR./ ; 7
SIXBIT /MTEOT./ ; 10
SIXBIT /MTUNL./ ; 11
SIXBIT /MTBLK./ ; 13
SIXBIT /MTSKF./ ; 16
SIXBIT /MTBSF./ ; 17
SIXBIT /MTDEC./ ;100
SIXBIT /MTIND./ ;101
MTALTH==.-MTATBL
MTACOD: BYTE (9) 0,1,3,6
BYTE (9) 7,10,11,13
BYTE (9) 16,17,100,101
; PSEUDO-OPERATOR TABLE FOR THE MACRO EVALUATOR.
; THIS TABLE CONTAINS THE NAMES,CHARACTERISTICS AND THE ADDRESS
; OF THE PROCESSOR FOR EACH OF THE MACRO PSEUDO-OPS. THESE PSEUDO
; OPS ARE HANDLED AT THE LEVEL OF PRIMARY CELL, WHEN MACSRC
; FINDS THAT THE SYMBOL IT IS SEARCHING ON
; IS IN THIS TABLE.
;
; THERE ARE CURRENTLY TWO CHARACTERISTICS FOR PSEUDO-OPS
;
; 1) $INP - DONT FIND THIS PSEUDO-OP IF NOT PRIMARY STATEMENT
; THIS MEANS PRETEND ITS NOT FOUND IF WE HAVE:
; ['PSEUDO-OP' ...]
; ('P.O.'...)
; <'P.O.'...>
;IN OTHER WORDS, ANY CASE BUT :
; LABEL: PSEUDO-OP ....
;OR PSEUDO-OP.....
; 2) $III - MEANS IF THIS PSEUDO-OP IS FOUND INSIDE THE RANGE
; OF '.INSERT' ....... '.ENDI' THEN ITS A FATAL ERROR.
;
DEFINE POPMAK<
IFE BIGLST,<XLIST>
X (ASCII,EVP70)
X (ASCIZ,EVP70Z)
X (SIXBIT,EVP71)
X (IOWD,EVP72)
X (XWD,EVP73)
X (RADIX5,EVP74)
X (SQUOZE,EVP74)
X (POINT,EVP75)
X (COMMEN,EVP76,$INP)
X (REMARK,EVP77,$INP)
X (TITLE, EVP77,$INP)
X (SUBTTL,EVP77,$INP)
X (EXP, EVP78)
X (DEC, EVP79)
X (OCT, EVP80)
X (BYTE, EVP81)
X (RADIX, EVP82,$INP) ;
X(.EDIT,FP.EDT,$III!$INP)
X (.MODUL, FP.MOD, $III!$INP)
X(.NAME,FP.NAM,$INP)
X(.DATE,FP.DAT,$INP)
X(.ASSOC,FP.ASC,$III!$INP)
X(.REMOV,FP.REM,$III!$INP)
X (.REINS, FP.RNS,$III!$INP)
X (.INSER, FP.INS,$INP)
X (.ENDI, FP.ENI,$INP)
X (.ENDE, FP.ENE,$INP)
IFN DEBUG,<
X (.MKLTS, FP.TST,$INP!$III)
X (.DMON, FP.DMN, $INP)
X (.DMOFF,FP.DMF, $INP)
X (.GODDT,.GODDT, $INP)
> ; NFI DEBUG
LIST
> ;END OF POPMAK DEFINTION
DEFINE X($A,$B,$C)< SIXBIT /$A/> ;;DEFINE THE NAME TABLE
POPNAM: POPMAK
POPLTH==.-POPNAM
DEFINE X($A,$B,$C)< EXP <$B+$C>> ;;DEFINE THE PROCESSOR ADDRESS LIST
POPDO: POPMAK
; /ORGCOD/ - ROUTINE TO PROCESS THE ORIGINAL CODE MATCH
; WHERE HERE WE COMPARE THE MACRO
; CODE GIVEN TO WHAT IS THERE AND
; FILTER OUT ERRORS.
; THIS ROUTINE ALSO SETS UP MUCH OF THE BOOKKEEPING
; FOR LATER CODE INSERTS.
; /ORGCOA/ - ALT. ENTRY POINT WHEN MATCH CODE IS NOT PRESENT
; SO THAT COMMON BOOKKEEPING IS DONE
; INPUTS- NONE
; OUTPUTS- UPDATED FLAGS, MOSTLY OF THE CP???? (CURRENT PATCH) FLAVOR
;
;
ORGCOD:
PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVE T1,TRCVAP ;GET CURRENT LOCATION
HRRZ T1,TB$DAT(T1) ;OF PATCH BREAK FOR EVALS TO USE
MOVEM T1,CPADDR ;CURRENT PATCH ADDRESS
PUSHJ P,ISTSAV ;SAVE STATE OF IST
BYPASS ;EAT TILL THE "L.BRACKET"
TXO F,REGET ;REGET FIRST CHARACTER AGAIN
CAIE CC,74 ;MAKE SURE THATS WHATS THERE
JRST ORG0 ;IF NOT,SKIP EVALUATION
PUSHJ P,CELL ;GET EXPRESSION "<.....>"
CAIE CC,76 ;INSURE PROPER CLOSE
JRST QERROR
PUSHJ P,COMCOD ;COMPARE CODE
ORG0:
PUSHJ P,ISTRST ;RESTORE STATE OF IST
SKIPA
ORGCOA: PUSHJ P,.PSH4T## ;SAVE ACS ON ALT. ENTRY
MOVE T1,TRCVAP ;GET VARIABLE AREA POINTER
HRRZ T2,TB$DAT(T1) ;GET PATCH ADDRESS
SKIPN T3,HSILOC ;DOES PROGRAM HAVE HI-SEG?
JRST ORG1 ;NO,THAT SORT OF DECIDES IT
HRRZ T4,2(T3) ;GET FIRST DATA WORD (RH)
CAMGE T2,T4 ;PATCH LOC .GE. HISEG ORIGIN?
JRST ORG1 ;NO,PATCH TO LOW SEGMENT
SETZM CPSFLG ;SET FLAG FOR HI-SEG PATCH
MOVE T4,SEB+2 ;GET HI-SEG BREAK FROM END BLOCK
JRST ORG2 ;AND BACK INTO COMMON CODE
ORG1:
SETOM CPSFLG ;PATCH TO LOW SEGMENT
MOVE T4,SEB+2 ;LOAD WITH FIRST DATA WORD
SKIPE HSILOC ;UNLESS HAS HI-SEGMENT WHICH
MOVE T4,SEB+3 ;LOWSEG BREAK IS IN SECOND DATA WORD
ORG2:
MOVEM T4,CPADDR ;STORE CURRENT PATCH ADDRESS
SKIPGE BARFLG ;WAS IT /AFTER OR /REPLACE?
JRST ORG2A ;NO,SO JUST GO ON
HRLM T4,TB$PAT(T1) ;STORE WHERE ORIGINAL WENT
MOVE C,SAVCOD ;ORIGINAL CODE
MOVE B,SAVREL ;GET ORIG. INST. RELOCATION
PUSHJ P,NEWCOD ;INSERT NEW CODE
JRST INSERR ;INSERT ERROR
MOVE T4,CPADDR ;GET UPDATED ADDRESS
SKIPE BARFLG ;IF /AFTER POINT TO ORIG
SOS T4 ;CODE SO WE EXECUTE IT
ORG2A:
HRRM T4,TB$PAT(T1) ; FOR TRACE BLOCK .
MOVSI T3,(JUMPA 0,) ;BREAK EXISTING CODE FLOW
HRR T3,T4 ;TO POINT TO PATCH BLOCK
MOVE A,T2 ;GET IN-CORE ADDRESS OF WORD
PUSHJ P,WRDSRC ;TO BE CHANGED FOR PATCH LINK
$STPCD(.INSERT lost its pointers)
MOVEM T3,0(C) ;DONE.
MOVEI D,1 ;RESET RELOCATION TO BE
PUSHJ P,CHGREL ;01 (IE. RELOCATE RH)
SKIPE BARFLG ;EXCEPT FOR /REPLACE
AOS T2 ;SET RETURN PC TO JUMPA+1
MOVEM T2,CPRET ;FOR NOW
MOVSI R,'% ' ;START AC R ON ITS LABEL
MOVE T3,CUREDT ;CURENT EDIT NAME
TRNN T3,77 ;RIGHT JUSTIFY IT
JRST [ LSH T3,-6
JRST .-1 ] ;TO GET LEAST SIG. BITS
LSH T3,6 ;NOW MAKE ROOM FOR "<PART>"
TLZ T3,770000
AOS T2,CPPART ;GET PART ID
CAILE T2,^D26 ;CHECK FOR 26TH PART
JRST ORG3 ;YES,SO FORGET THIS
IORI T3,'A'-1(T2) ;T3 NOW HAS ' EDIT<PART>'
IOR R,T3 ;R NOW HAS "%EDIT<PART>"
PUSHJ P,SYMSRC ;LOOK UP THE SYMBOL
CAIA ;NOT FOUND RETURN
JRST ORG3 ;CONFLICTS, FORGET IT
HRRZ A,TB$PAT(T1) ;PATCH ADDRESS
PUSHJ P,RAD50 ;CONVERT SYMBOL TO RADIX50
MOVEI B,1 ;ITS A LABEL,SO RELOCATE RH
PUSHJ P,NEWSYM ;INSERT THE SYMBOL
JFCL ;IF FAILS,JUST FORGET IT
ORG3:
PUSHJ P,.POP4T## ;RESTORE T1-T4
POPJ P, ;RETURN
; /COMCOD/ - ROUTINE TO CHECK FOR MATCH BETWEEN CODES
;
; THE IDEA IS TO FIND OUT IF THERE IS MATCH BETWEEN THE CODE
; GIVEN BY THE PATCH FILE AND THE CODE IN REL FILE.
; THE INPUT IS FROM EVALS, SAVCOD AND THE IST.
; THIS CODE CATCHES MOST ERRORS, BUT PROBABLY NOT ALL OF THEM.
;
; INPUTS- AC A CONTAINS CODE RETURNED BY EVALS
; AC C CONTAINS THE IST POINTER FOR THE CODE FOURPLET
; CPADDR CONTAINS LOCATION OF INSERT
; SAVCOD CONTAINS THE ORIGINAL CODE AT THAT LOCATION
;
; OUTPUTS: NONE
; RETURNS: ALWAYS CPOPJ, OR TO FATAL ERROR HANDLER
;
COMCOD:
CAMN A,SAVCOD ;TAKE CARE OF 90% OF CASES RIGHT AWAY
POPJ P, ;MATCHES RIGHT OFF
PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVEM P,SAVEP ;SAVE PDL POINTER
JUMPE C,COMC99 ;IF NO IST POINTER,THERE IS NO HOPE
MOVE T1,SAVCOD ;LOAD T1 WITH ORIG
MOVE T2,A ;T2 WITH NEW CODE
MOVE T3,C ;T3 WITH FIXUP POINTER
MOVE T4,CPADDR ;T4 WITH LOCATION WE ARE LOOKING AT
PUSHJ P,COM1 ;CALL LOCAL ROUTINE
PUSHJ P,.POP4T## ;RESTORE TEMPS
POPJ P, ;AND RETURN
;/COM1/ - RECURSIVE MATCH CHECKER
; THIS ROUTINE TRIES TO MATCH CODE, TRACING LITERAL AND EXTERNAL POINTERS
; INPUTS: T1-ORIGINAL CODE
; T2-NEW CODE THAT TRIES TO MATCH
; T3-FIXUP WORD ON T2
; T4 ADDRESS THAT CONTENTS OF T1 CAME FROM
;
COM1:
SETZM COMDON ;START WITH LEFT HALF
HLRZ A,T1 ;LOAD A-D WITH T1-T4 LH
HLRZ B,T2
HLRZ C,T3
HLRZ D,T4
COM1A:
CAMN A,B ;DOES CODE MATCH?
JRST COM2 ;YES,TRY OTHER HALF OR QUIT
JUMPE C,COMC99 ;IF NOT IST,QUIT
MOVE D,1(C) ;GET 2ND WORD OF IST PAIR
TXNN D,IS.MWS ;MULTI-WORD STRING WONT SAVE US
TXNE D,IS.UDF ;SHOULD NOT BE AN UNDEFINED SYMBOL
JRST COMC99 ;IF IT IS,THERE IS ERROR
TXNN D,IS.DER ;IS THIS AN INDICATOR OF EXTERNAL REQUEST?
JRST COM1B ;NO,TRY LITERAL
MOVE R,0(C) ;GET SYMBOL NAME FROM IST
MOVE A,T4 ;MUST POINT TO THIS ADDRESS
PUSHJ P,FGREF ;LOOK UP THE REFERENCE
JRST COMC99 ;CANT FIND ONE
JRST COM2 ;CONTINUE
COM1B:
TXNN D,IS.LIT ;IS THIS A LITERAL?
$STPCD(INTERIM SYMBOL TABLE has illegal flags)
PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVE T4,A ;ADDRESS IS CONTENTS A
MOVE C,0(C) ;GET POINTER TO LIT TRIPLET
MOVE T2,0(C) ;NEW CODE IS THE LITERAL
MOVE T3,2(C) ;AND IT HAS ITS OWN FIXUP POINTER
PUSHJ P,WRDSRC ;MAP WORD THAT A POINTS TO
JRST COMC99 ;IF OUT OF BOUNDS,FORCE NOT MATCH
MOVE T1,0(C) ;PICK UP WORD AT THAT LOCATION
PUSH P,COMDON ;SAVE HALF WORD INDICATOR
PUSHJ P,COM1 ;AND EVALUATE NEXT LEVEL
POP P,COMDON ;RESTORE
PUSHJ P,.POP4T## ;ALL THAT WE DESTROYED
;FALL INTO COM2
COM2:
SKIPE COMDON ;DOING RIGHT HALF ?
POPJ P, ;YES,DONE
SETOM COMDON ;FLAG AS DOING RIGHT HALF
HRRZ A,T1 ;GET RIGHT HALVES
HRRZ B,T2
HRRZ C,T3
JRST COM1A ;CONTINUE
COMC99:
MOVE P,SAVEP ;GET POINTER
$KILL(CDM,Existing code does not match .ORIGINAL code,,$MORE)
PUSHJ P,.POP4T## ;RESTORE THE ACS
JRST MCCOMM ;TYPE OUT CURRENT LINE
IFN DEBUG,<
; /LSTCOD/ - THIS ROUTINE LISTS THE RESULTS OBTAINED IN CALL TO EVAL
; THE VALUES OF R%R,R%V AND SUCH ARE USED HERE TO PRINT OUT
; THE NUMERIC RESULT OF THE CALL TO EVAL
;
LSTCODE:
PUSHJ P,.PSH4T## ;SAVE T1-T4
TXO F,FOTTY ;OUTPUT IS TO TTY
LDB T1,[POINT 9,R%V,8] ;GET INST
CAIN T1,777 ;IF 777,PROBABLY NEG NUMBER
JRST MAC0
HLRZ T2,R%R ;IF LEFT RELOC THEN NOT INSTR
JUMPN T2,MAC0
JUMPE T1,MAC0 ;IF NO INSTR., USE HALFWORD ONLY
PUSHJ P,.TOCTW## ;OUTPUT IN INSTRUCTION FORMAT
PUSHJ P,.TSPAC## ;
LDB T1,[POINT 4,R%V,12] ;AC FIELD
PUSHJ P,FILLO ;2 DIGIT FILLED OCTAL
LDB T1,[POINT 1,R%V,13] ;INDIRECT BIT
PUSHJ P,.TOCTW##
PUSHJ P,.TSPAC##
LDB T1,[POINT 4,R%V,17] ;GET INDEX REGISTER
PUSHJ P,FILLO ;2 DIGIT ,0 FILLED OCTAL
HRRZ T1,R%V ;FINALLY THE VALUE
PUSHJ P,OUTHW ;OF THE ADDRESS FIELD
HRRZ T2,R%R ;SEE IF RIGHT RELOC
MOVEI T1,"'" ;IF RELOCATED , PRINT "'"
SKIPE T2
PUSHJ P,.TCHAR##
PUSHJ P,TYPTB1 ;TAB OVER
MAC0:
HLRZ T1,R%V ;HALFWORD FORMAT
PUSHJ P,OUTHW ;
HLRZ T2,R%R ;
MOVEI T1,[ASCIZ ",,"] ;PRETEND ITS NOT RELOCTATED
SKIPE T2 ;RELOCATION FLAG
MOVEI T1,[ASCIZ "',,"] ;IF LEFT HALF RELOCATED
PUSHJ P,.TSTRG## ;INDICATE SO
HRRZ T1,R%V
PUSHJ P,OUTHW ;SAME FOR RIGHT HALF
HRRZ T2,R%R
MOVEI T1,"'" ;SINGLE QUOTE IS RELOCATED
SKIPE T2
PUSHJ P,.TCHAR ;RELOCATION FLAG
PUSHJ P,.TCRLF## ;END LINE NOW
PUSHJ P,.POP4T## ;RESTORE ACS
TXZ F,FOTTY ;
POPJ P, ;AND RETURN
FILLO:
CAIL T1,10 ;2 DIGITS ALREADY?
JRST FILLO1 ;YES,SKIP "0" FILL
PUSH P,T1 ;SAVE VALUE
MOVEI T1,"0" ;
PUSHJ P,.TCHAR## ;OUTPUT ASCII 0
POP P,T1 ;RESTORE VALUE
FILLO1:
PUSHJ P,.TOCTW## ;OUTPUT OCTAL AC VALUE
PJRST .TSPAC## ;FOLLOWED BY SPACE
> ; NFI DEBUG
; /UDFCHK/ - THIS ROUTINE CHECKS FOR ENTRIES STILL IN IST AFTER ALL DEFINTION DONE
; THIS ROUTINE EXAMINES IST AND COMPLAINS ABOUT ANY ENTRIES
; REMAINING IN IT. THIS ASSUMES THAT ALL EXTERNAL AND LITERAL
; GENERATIONS HAVE BEEN DONE ALREADY.
;
; THE CALLS TO UDFCHK ARE MADE FROM FIX-PSEUDO-OPS ".ENDE" AND ".MODULE"
; TO INSURE PROPER DEFINITIONS HAVE BEEN MADE FOR ALL SYMBOLS.
;
; INPUTS- ONLY THE IST. REMEMBER TO DO ALL DEFINITIONS FIRST
;
; OUTPUTS- FATAL ERROR MESSAGE
;
; RETURN- POPJ
;
UDFCHK:
MOVE T1,[POINT 1,ISTMAP] ;ZERO UNUSED ENTRIES
MOVEI T2,IST ;SO DONT GET CONFUSED
SETZM T ;CLEAR T
UDF0:
ILDB T3,T1 ;GET BIT OF MAP
JUMPN T3,UDF00 ;IN USE
SETZM 0(T2) ;
JRST UDF01 ;NOT IN USE, SO SKIP CHECKS
UDF00: MOVEI T,2(T2) ;UPDATE POINTER TO LAST IN-USE
MOVE T4,1(T2) ;GET FLAG WORD
TXNE T4,IS.LIT!IS.MWS!IS.DER ;MAKE SURE ITS USER NOT PROGRAM ERROR
$STPCD(A necessary forward fixup was not done)
UDF01: ADDI T2,2 ;TWO WORDS PER ENTRY
CAIG T2,ISTLST ;OVER THE END?
JRST UDF0 ;NO
JUMPE T,CPOPJ ;IF NO SLOTS IN USE,JUST RETURN
MOVE N,CURMOD ;GET MODULE
$KILL(UDF,Module,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ in edit /]
PUSHJ P,.TSTRG## ;GIVE MOD AND EDIT
MOVE T1,CUREDT ;
PUSHJ P,.TSIXN##
MOVEI T1,[ASCIZ/ contains undefined symbol(s):
/]
PUSHJ P,.TSTRG## ;OUTPUT IT
UDF1:
CAIG T,IST ;AT FRONT OF LIST?
JRST DONERR ;YES,SO CLOSE UP
SUBI T,2 ;GET TO FRONT OF PAIR
SKIPN T1,0(T) ;LOAD LABEL NAME
JRST UDF1 ;IGNORE NULL LABELS
PUSHJ P,TYPTB1 ;OUTPUT TAB
PUSHJ P,.TSIXN## ;AND LABEL NAME
PUSHJ P,.TCRLF##
MOVE B,T ;DONT PRINT DUPLICATE LABELS
UDF2:
CAIG B,IST ;WAS THIS LAST ONE?
JRST UDF1 ;YES,BACK TO MAIN LOOP
SUBI B,2 ;KEEP BACKTRACKING
MOVE C,0(B) ;GET LABEL NAME
CAMN C,0(T) ;IS THIS DUPLICATE?
SETZM 0(B) ;YES,SO ZERO IT
JRST UDF2 ;AND LOOP BACK
SUBTTL ERROR MESSAGES FOR THE MACRO PROCESSOR
MERROR:
PUSHJ P,RAD50 ;CONVERT SIXBIT TO RAD50
MERRO1: ;HERE IF ALREADY RAD50
MOVE N,R ;SYMBOL FOR MUL DEF
$KILL(MCM,Attempt to redefine value of symbol,N$50,$MORE)
JRST MCCOMM
WERROR:
$KILL(MCW,<BYTE,EXP,DEC,or OCT more than one word>,,$MORE)
JRST MCCOMM
AERROR:
$KILL(MCA,Pseudo-operator argument error,,$MORE)
JRST MCCOMM
QERROR:
$KILL(MCQ,MACRO code is questionable,,$MORE)
JRST MCCOMM
NERROR:
$KILL(MCN,MACRO code numeric error,,$MORE)
JRST MCCOMM
ETCERR:
SKIPL P ;IF MASTER STACK OVERFLOWED THEN
MOVE P,EVLPP ;WE NEED EMERGENCY FIXUP
$KILL(ETC,MACRO code expression too complex,,$MORE)
JRST MCCOMM
FERROR:
$KILL(MCF,Illegal forward or external reference,,$MORE)
JRST MCCOMM
RERROR:
$KILL(MCR,MACRO code relocation error,,$MORE)
MCCOMM:
MOVE P,EVLPP ;RESTORE POINTER
SKIPN N,LLABEL ;DO WE HAVE A LABEL?
JRST MCCOM1 ;NO,CANT GIVE LABEL
MOVEI T1,[ASCIZ " at "] ;GIVE LABEL+OFFSET
PUSHJ P,.TSTRG## ;OUTPUT IT
MOVE T1,N ;NOW SAY IT
PUSHJ P,.TSIXN## ;
MOVEI T1,"+" ;PLUS OFFSET
PUSHJ P,.TCHAR## ;
MOVE T1,LLOFF ;OFFSET SINCE LAST LABEL
PUSHJ P,.TDECW ;IN DECIMAL
MCCOM1:
MOVEI T1,[ASCIZ " in edit "]
PUSHJ P,.TSTRG## ;OUTPUT EDIT NAME
MOVE T1,CUREDT ;EDIT NAME
PUSHJ P,.TSIXN## ;ITS IN SIXBIT
PUSHJ P,.TCRLF##
PUSHJ P,TYPTB1 ;OUTPUT <CR><LF><TAB>
MOVEI T1,MACBUF ;OUTPUT CURRENT MACRO LINE
PUSHJ P,.TSTRG## ;AS AN ASCIZ STRING
X$$MCM: X$$MCQ: X$$MCN: X$$ETC: X$$MCF: X$$MCR: X$$MCA: X$$III:
X$$MCW: X$$CDM: X$$ASG:
TXZ F,REGET!FOTTY ;CLEAR SOME FLAGS
IFN DEBUG,<
TXNE F,DEBMOD ;IN DEBUG MODE?
POPJ P, ;YES, GO BACK
>; NFI DEBUG
JRST DONERR ;END AS USUAL
SUBTTL END OF LONG,LONG CONDITIONAL UNDER IFN FTBPT
> ; NFI FTBPT
SUBTTL RADIX50 CONVERSION ROUTINE
RAD50:
PUSHJ P,.PSH4T## ;SAVE T1-T4
MOVE T3,[POINT 6,R] ;SET UP SIXBIT POINTER TO R
MOVEI T2,6 ;SET COUNTER TO SIX
MOVEI T4,0
JUMPE R,RAD504 ;NULL SYMBOL?
RAD501:
TRNE R,77 ;RIGHT-JUSTIFIED?
JRST RAD502 ;YES-CONVERT TO RADIX50
ROT R,-6 ;NO-SHIFT IT ONE PLACE RIGHT
JRST RAD501 ;CHECK AGAIN
RAD502:
ILDB T1,T3 ;PICK UP NEXT CHARACTER IN R
JUMPE T1,RAD503 ;A BLANK IS A BLANK IN ANY RADIX
IMULI T4,50 ;CONVERT TO RADIX50
CAIE T1,'%' ;IS IT A '%'?
CAIN T1,'$' ;IS IT A $ ?
ADDI T1,70 ;YES-COMPENSATE FOR SUBTRACTION
CAIN T1,'.' ;IS IT A '.' ?
ADDI T1,55 ;YES-COMPENSATE
CAILE T1,31 ;TRANSLATE RADIX50 CODE
SUBI T1,7 ;LETTER-SUBTRACT 26
SUBI T1,17 ;NUMBER-SUBTRACT 17
ADD T4,T1 ;COMBINE WITH PARTIAL WORD
RAD503:
SOJG T2,RAD502 ;LOOP FOR SIX CHARACTERS
RAD504:
MOVE R,T4 ;PUT SYMBOL BACK IN R
PUSHJ P,.POP4T## ;RESTORE OUR TEMPS
POPJ P, ;GIVE IT TO WHOEVER WANTED IT
SUBTTL ERROR ROUTINES
; /E$TEL/ - COMMENT MESSAGE
; /E$WRN/ - WARNING MESSAGE
; /E$KIL/ - FATAL MESSAGE AND RESTART
; CALLED VIA MACROS $KILL,$WARN,$TELL (SEE FRONT OF LISTING)
;
; INPUT- T1 POINTS TO BLOCK OF:
; XWD CODE (6BIT),[ASCIZ/TEXT/]
; XWD TYPEOUT OF AC N ROUTINE ADDRESS(OR 0),SKIP CONTINUATION ADDRESS (OR 0)
;
; RETURNS- NORMALLY AT CALL + 3 (WHICH JUST SKIPS THE ARGUMENTS)
; UNLESS THIS IS A FATAL ERROR MESSAGE, IN WHICH CASE WE RESTART.
;
; IF THE CONTINUATION FIELD IS NON-ZERO AND WE HAVE
; MESSAGE BITS SET FOR SHORT MESSAGE, WE JRST TO THE
; ADDRESS SPECIFIED IN RH OF CALL+2
; NOTE: FOR DEBUGGING, LOCATION ERRPC CONTAINS XWD FLAGS,PC OF ERROR CALL
FTEL==1B19 ;TEMPORARY BITS STORED IN ERRPC(LH)
FWRN==1B20
FKIL==1B21
E$TEL:
MOVSI T2,"["+FTEL ;COMMENT MESSAGE
JRST E$COM ;CONTINUE
E$WRN: SKIPA T2,["%"+FWRN,,0] ;WARNING MESSAGE
E$KIL: MOVSI T2,"?"+FKIL ;FATAL ERROR
E$COM:
TXO F,FOTTY ;FORCED OUTPUT TO TTY
MOVEM T1,ERRPC ;SAVE ERROR PC
HLLM T2,ERRPC ;AND ERROR TYPE FLAG
HRR T2,0(T1) ;RH T2 GETS TEXT ADDRESS
TLZ T2,<FWRN+FTEL+FKIL> ;TURN OFF FLAGS
MOVEI T3,-1(T1) ;GIVE T3 ADDRESS OF THE CALL
HRLI T1,'MKL' ;GIVE ME AN IDENTITY
HLR T1,0(T1) ;AND AN ERROR NAME
PUSHJ P,.ERMSA## ;DO THE MESSAGE
MOVE T2,ERRPC ;GET PC
TXNN T1,JWW.FL ;WANT MORE?
JRST E$COM2 ;NO.
HLRZ T3,1(T2) ;GET TYPOUT ROUTINE (IF ANY)
JUMPN T3,[ PUSHJ P,.TSPAC## ;TYPE A SPACE
MOVE T1,N ;GET DATA
PUSHJ P,(T3) ;DO THE ROUTINE
JRST .+1] ;AND BACK INTO LINE
MOVE T2,ERRPC ;RESTORE PC AGAIN
HRRZ T3,1(T2) ;ANY CONTINATION?
JUMPN T3,2(T2) ;YES,FALL INTO REST OF MESSAGE
E$COM2:
MOVE T1,ERRPC ;RESTORE PC
TLNE T1,FTEL ;WANT TO CLOSE COMMENT?
TTCALL 1,["]"] ;YES,DO SO
HRRZ T3,1(T1) ;ANY MORE MSG TO JUMP AROUND?
JUMPN T3,0(T3) ;YES, DO SO
PUSHJ P,.TCRLF## ;END THE LINE
TLNE T1,FKIL ;WAS ERROR FATAL?
JRST RSTRT1 ;YES,RESTART PROGRAM
TXZ F,FOTTY ;OFF WITH THE FLAG
JRST 2(T2) ;NO,SO CONTINUE
SUBTTL LONGER ERROR MESSAGES
MNFERR: ;MODULE NOT FOUND ERROR
JUMPE R,MNF2 ;IF NO NAME
MOVE N,R ;LOAD N WITH RADIX50 NAME
$KILL(MNF,Module,N$50,$MORE)
MOVEI T1,[ASCIZ/ was not found in file /]
TXNN F,FIXMOD ;IF NOT FIX MODE,ORDER
MOVEI T1,[ASCIZ/ was not found or incorrect order in file /]
PUSHJ P,.TSTRG## ;OUT
MNF1:
MOVE T1,FPT ;GET POINTER TO SCAN STYLE BLOCK
PUSHJ P,.TFBLK## ;AND TALK ABOUT IT
DONERR:
PUSHJ P,.TCRLF## ;
JRST RSTRT1
MNF2:
$KILL(NPS,No program names were specified for file ,,$MORE)
JRST MNF1
PEFERR:
MOVE N,CUREDT ;PREMATURE EOF IN PATCH FILE
$KILL(PEF,premature end-of-file during edit,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ in file /]
PUSHJ P,.TSTRG##
MOVE FPT,WLDTMP
JRST MNF1
FSIERR:
MOVE N,[GETSTS 0,N]
DPB IOC,[POINT 4,N,12]
XCT N
$KILL(FSI,<File status error on input (>,N$OCT,$MORE)
FSERR: MOVEI T1,[ASCIZ " ) for file "]
PUSHJ P,.TSTRG## ;
JRST MNF1 ;TYPE OUT CURRENT FILE SPEC
FSOERR:
GETSTS OCHN,N ;GET STATUS
MOVE FPT,OUTBEG ;SET UP REST OF MESSAGE
$KILL(FSO,<File status error on output (>,N$OCT,$MORE)
JRST FSERR
FSTERR: MOVEI IOC,TRIN ;TRANSACTION OR PATCH FILE ERROR
MOVE FPT,WLDTMP
JRST FSIERR
FSMERR:
MOVEI IOC,MIN ;MASTER INPUT ERROR
MOVE FPT,INBEG
JRST FSIERR
IBTERR: ;ILLEGAL BLOCK TYPE ERROR
MOVE N,B ;TYPEOUT OF BLOCK TYPE
$KILL(IBT,<Illegal block type (> ,N$OCT,$MORE)
MOVEI T1,[ASCIZ " ) was seen in file "]
PUSHJ P,.TSTRG##
JRST MNF1 ;FINISH WITH CURRENT FILE
NECERR:
$KILL(NEC,Not enough core is available)
INSERR:
MOVE N,CUREDT
$KILL (SCE,Storage for patch code was exhausted in edit,N$SIX)
STOERR:
MOVE N,CUREDT
$KILL(SSE,Storage for patch symbols was exhausted during edit,N$SIX)
MKMERR:
MOVE N,R
$KILL(MKM,,N$SIX,$MORE)
MOVEI T1,[ASCIZ/ pseudo-op in edit /]
PUSHJ P,.TSTRG##
MOVE T1,CUREDT
PUSHJ P,.TSIXN##
MOVEI T1,[ASCIZ/ without preceding .MODULE/]
PUSHJ P,.TSTRG##
JRST DONERR
STOPCD:
$KILL(IED,<Internal error detected:
>,N$STRG,$MORE)
MOVEI T1,[ASCIZ "
At location "]
PUSHJ P,.TSTRG##
MOVE T1,-1(P) ;GET PC OF ERROR
SOS T1 ;CORRECT IT
PUSHJ P,OUTHW ;OUTPUT IT AS ADDRESS
MOVEI T1,[ASCIZ " in MAKLIB"]
PUSHJ P,.TSTRG##
MOVE N,@0(P) ;GET SIXBIT CODE
X$$IED:
JRST DONERR ;
SUBTTL VARIOUS ERROR ROUTINES AND SMALL TYPE-OUT ROUTINES
PTYPO:
PUSHJ P,.PSH4T## ;SAVE THE TEMPS
PUSHJ P,PTYPO1 ;DO THE OUTPUT
PUSHJ P,.POP4T## ;RESTORE T1-T4
POPJ P, ;RETURN
PTYPO1:
MOVE T2,T1 ;GET NAME INTO TEMP
MOVEI T1, 6 ;SIX CHARACTERS TO GET
TLZ T2,740000 ;CLEAR CODE BITS
PTYPO2: IDIVI T2, 50 ;CONVERT TO SIXBIT CODE
HRLM T3, (P) ;STORE CHARACTER ON PD LIST
SOJLE T1,.+2 ;ALL DONE?
PUSHJ P, PTYPO2 ;NO, DIVIDE SOME MORE
HLRZ T1, (P) ;POP CHARACTERS OFF STACK
JUMPE T1, CPOPJ ;IGNORE BLANKS
CAILE T1, 12 ;LETTER OR NUMBER?
ADDI T1, 7 ;LETTER - ADD 66
ADDI T1, 57 ;NUMBER - ADD 57
CAIE T1, 135 ;PERCENT SIGN?
CAIN T1, 134 ;DOLLAR SIGN?
SUBI T1, 70 ;YES, SPECIAL CASE
CAIN T1, 133 ;PERIOD?
SUBI T1, 55 ;YES, SPECIAL CASE
PJRST BOUT ;RECURSIVE EXIT FOR MORE CHARS
CRLF:
PUSH P,T1 ;SAVE T1
MOVEI T1, 15 ;CARRIAGE RETURN
PUSHJ P,BOUT ;OUTPUT IT
MOVEI T1, 12 ;LINE FEED
PUSHJ P,BOUT ;OUTPUT IT
JRST T1POPJ ;RESTORE T1 AND RETURN
; OUTPUT A FULL HALFWORD, USING 0 FILLERS
OUTHW:
PUSHJ P,.PSH4T## ;SAVE TEMP ACS
LSHC T1,-22 ;SET UP THE ACS
MOVEI T3,6 ;NUMBER OF DIGITS TO OUTPUT
OUTHW1:
SETZ T1, ;CLEAR T1
LSHC T1,3 ;GET AN OCTAL DIGIT
ADDI T1,"0" ;MAKE ASCII FOR OUTPUT
PUSHJ P,BOUT ;OUTPUT THE CHARACTER
SOJG T3,OUTHW1 ;BACK FOR MORE?
PUSHJ P,.POP4T## ;RESTORE THE TEMPS
POPJ P, ;AND RETURN
TYPTAB:
SOSLE TABCNT ;NEED A NEW LINE?
JRST TYPTB1 ;NO
PUSHJ P,CRLF ;YES, OUTPUT ONE FIRST
MOVEI T4,TABS1-1 ;RESET THE COUNT
TXNE F,DEVTTY
MOVEI T4,TABS2-1 ;TTY
MOVEM T4,TABCNT ;AND STORE IT
TYPTB1:
PUSH P,T1 ;SAVE T1
MOVEI T1,11 ;A TAB
PUSHJ P,BOUT ;OUTPUT IT
JRST T1POPJ ;AND RETURN, RESTORING T1
RSTRT:
CLOSE OCHN, ;CLOSE OUTPUT CHANNELS
RSTRT1:
TXO F,FOTTY ;ENSURE TTY GETS CRLF
PUSHJ P,.TCRLF## ;OUTPUT IT
JRST MAKSCN ;SCAN NEXT COMMAND LINE
SUBTTL IMPURE CODE
IFN DEBUG, <DHISIZ== . >
IFN PURESW,<
HIGH: PHASE LOW>
INGET2: IN 0, ;INPUT A BUFFER OF DATA
JRST GETIN1 ;NO ERRORS
INGET3: STATZ , IO.EOF ;END OF FILE?
JRST POPOUT ;YES, HIGH LEVEL EXIT
JRST FSIERR ;ERROR
DIRIOW: IOWD 200,DIRBLK ;IOWD FOR DIRECTORY INPUT
0 ;MUST BE IN LOW SEGMENT
IFN PURESW,<
LOWBLK:
DEPHASE>
SUBTTL STORAGE AND BUFFERS
IFN PURESW,< RELOC LOW>
LOW:
IFN PURESW,< BLOCK LOWBLK-LOW>
PDLIST: BLOCK PD$LEN ;MASTER PUSH DOWN LIST
OFFSET: BLOCK 1 ;CCL OR REGULAR ENTRY FLAG TO SCAN
ERRPC: BLOCK 1 ;PC OF LAST CALL TO ERROR PROCESSOR
IFN DEBUG, < ;LOCATIONS FOR DEBUGGING
DEBFAI: BLOCK 1 ;NUMBER OF FAILURES DURING INTERNAL TESTS
DEBROU: BLOCK 1 ;POINTER TO ASCIZ NAME OF ROUTINE BEING TESTED
> ;NFI DEBUG
ORGFF: BLOCK 1 ;ORIGINAL CONTENTS OF .JBFF
ORGPP: BLOCK 1 ;ORIGINAL PUSHDOWN POINTER
LSTFF: BLOCK 1 ;FIRST FREE AFTER LISTING OUTPUT BUFFERS
SCNBEG: ;START OF AREA THAT CLRANS CLEARS
TMAREA: BLOCK FSSIZE ;AREA FOR STORING NAMES
SWIWRD: BLOCK 2 ;PLACE FOR SCAN TO STORE SWITCH BITS FOR NON-ARG SWITCHES
WHO: BLOCK 1 ;VALUE OF /WHO SWITCH
INBEG: BLOCK 1 ;START OF INPUT FILE-SPECS
INEND: BLOCK 1 ;END OF INPUT FILE-SPECS (FROM SCAN)
OUTBEG: BLOCK 1 ;START OF OUTPUT FILE-SPECS
OUTEND: BLOCK 1 ;END OF OUTPUT FILE-SPECS
CURMOD: BLOCK 1 ;CURRENT MODULE READ IN
CUREDT: BLOCK 1 ;CURENT EDIT (/FIX) FOR ERROR MSG.
OPNBLK: BLOCK .RBSIZ+2+3 ;OPEN UUO BLOCK
LKPBLK=OPNBLK+3 ;AND LOOKUP BLOCK (DEFINED AS TO NOT SEPARATE THEM)
BCKBLK: BLOCK .RBSIZ+2+3 ;SAVED OUTPUT FILE SPECS
BCKFF: BLOCK 2 ;SAVED AND CURRENT JOBFF
WLDTMP: BLOCK 1 ;POINTER TO CURRENT TRANSACTION FILE
NAMCTR: BLOCK 1
TNMCTR: BLOCK 1
SCNEND: ;END OF AREA THAT CLRANS CLEARS ON EACH COMMAND
SAVEAC: BLOCK 1 ;SAVE C (POINTER TO ENTBLK)
BLKCNT: BLOCK 1 ;NUMBER OF BUFFERS OUTPUT
SAVEBT: BLOCK 1 ;SAVED BLOCK TYPE
SAVEP: BLOCK 1 ;SAVED PUSHDOWN POINTER
ENTBLK: BLOCK SIZE+6 ;PLACE TO SAVE LINK ITEM TYPE 'ENTRY BLOCK'
;SVEBLK AND TRCBLK OVERLAP
;BECAUSE NEVER USED AT SAME TIME
IFN FTBPT,<
ZZ==TRCMAX+2*<TRCMAX+21>/22 ;REQUIREMENTS FOR TRACE BLOCK STOREAGE
> ; NFI FTBPT
IFE FTBPT, <ZZ==0>
IFG <SIZE+6>-ZZ,<ZZ==SIZE+6> ;IF ENTRY BLOCK MAX LARGER,USE THAT
TRCBLK:
SVEBLK: BLOCK ZZ
TRCLST==.-1 ;LAST LOCATION AVAILABLE FOR TRACE STORAGE
IFN FTBPT,<
TRCPTR: BLOCK 1 ;POINTER TO CURRENT STATIC AREA
TRCVAP: BLOCK 1 ;POINTER TO CURRENT LOCATION IN VARIABLE AREA
> ;NFI FTBPT
OBUF: BLOCK 3 ;IO HEADER FOR OUTPUT
MBUF: BLOCK 3 ;INPUT BUFFER HEADER FOR MASTER FILE
TBUF: BLOCK 3 ;INPUT BUFFER HEADER FOR TRANSACTION FILE
IBUF1: BLOCK 1 ;ADDRESS OF CURRENT BYTE COUNTER
IBUF2: BLOCK 1 ;ADDRESS OF CURRENT BYTE POINTER
DSKHDR: BLOCK MTBSIZ+2 ;TWO WORDS OF OVERHEAD [P,P]+EXT
DIRBLK=DSKHDR+2
DIRNAM=DIRBLK+123 ;FILENAMES IN DTA DIRECTORY START HERE
BSZ: BLOCK 1 ;SIZE OF OLD SYMBOL BLOCK
PTGRS: BLOCK 1 ;PTGR SAVED
PTSRS: BLOCK 1 ;PTSR SAVED
RELOCS: BLOCK 1 ;ORIGINAL RELOC
SYMBLK: BLOCK ^D20 ;NEW SYMBOL BLOCK (ALSO AC STORAGE FOR SYMSRC)
XCOUNT: BLOCK 1
XPNTR: BLOCK 1
BUFSIZ: BLOCK 1
XBEG: BLOCK 2
END1: BLOCK 1 ;FIRST WORD OF END BLOCK
END2: BLOCK 2 ;SECOND WORD OF END BLOCK
CNTCWF: BLOCK 1
TABCNT: BLOCK 1 ;COUNTS TABS LEFT FOR THIS LINE
NAMSAV: BLOCK 1
;; CONDITIONAL STOREAGE FOR BINARY PATCHING TOOL
IFN FTBPT,< ;DONT ALLOCATE IF NOT INCLUDED
FIXXP: BLOCK 1 ;PUSHDOWN POINTER ON ENTRY TO FIX PROCESSOR
CRADIX: BLOCK 1 ;CURRENT DEFAULT INPUT RADIX (MACRO)
DECNUM: BLOCK 1 ;SIMULTANEOUSLY BUILT RADIX 10. NUMBER (MACRO)
NULFLG: BLOCK 1 ;-1 IF STATMENT GENERATES NO CODE (MACRO)
PRGINC: BLOCK 1 ;-1 WHEN A PROGRAM IS IN BUFFER
BARFLG: BLOCK 1 ;-1,0,+1 FOR INSERT BEFORE,REPLACE,AFTER
SAVCOD: BLOCK 1 ;INSTR REPLACED BY "JUMPA PATCH-CODE"
SAVREL: BLOCK 1 ;SAVED RELOCATION FOR ABOVE INSTRUCTION
CPPART: BLOCK 1 ;PART OF CURRENT PATCH
CPSFLG: BLOCK 1 ;-1 IF PATCH IN LOWSEG,0 FOR HISEG
CPADDR: BLOCK 1 ;ADDRESS TO WRITE NEXT PATCH CODE WORD INTO
CPRET: BLOCK 1 ;PC TO RETURN TO AFTER PATCH
CPREPI: BLOCK 1 ;SPECIFIC NUMBER OF LOCATIONS TO SKIP ON RETURN FROM PATCH
CPINST: BLOCK 1 ;NUMBER OF INSTRUCTIONS IN CURRENT PATCH
MACBUF: BLOCK <MACSIZ+4>/5+1 ;PLACE TO PUT MACRO CODE
MACLST==.-1 ;LOCATION OF TERMINATING ZERO WORD
MACCNT: BLOCK 1 ;COUNT OF CHARACTERS LEFT
MACPTR: BLOCK 1 ;BYTE POINTER TO MACBUF
MACSV1: BLOCK 1 ;SAVED POINTER FOR RESCAN
MACSV2: BLOCK 1 ;ALSO SAVED FOR RESCAN, THE COUNT
REOL: BLOCK 1 ;"REAL" BREAK CHARACTER REPLACED BY MIC WITH $EOL VALUE
COMDON: BLOCK 1 ;TEMP FLAG FOR CODE COMPARE ROUTINE
WRDCNT: BLOCK 1 ;COUNT OF WORDS IN STRING,AFTER 1ST ONE
EVLPP: BLOCK 1 ;PDL POINTER AT ENTRY TO EVAL
LLABEL: BLOCK 1 ;R50 LAST LABEL MACRO PROCESSOR SAW
LLOFF: BLOCK 1 ;OFFSET SINCE LAST LABEL
R%V: BLOCK 1 ;EVALS RETURNS VALUE HERE
R%R: BLOCK 1 ;EVALS RETURNS RELOCATION HERE
R%S: BLOCK 1 ;EVALS RETURNS PTRS TO IST HERE
R%F: BLOCK 1 ;EVALS RETURNS FLAGS HERE
ASGSYM: BLOCK 1 ;RADIX50 SYMBOL+FLAGS TO ASSIGN VALUE TO
OPRSTK: BLOCK OPRSIZ ;BLOCK FOR STACKING OPERANDS
OPTSTK: BLOCK OPTSIZ ;BLOCK FOR STACKING OPERATORS
OPRPTR: BLOCK 1 ;SAVED PDL POINTER TO OPERANDS
OPTPTR: BLOCK 1 ;SAVED PDL POINTER TO OPERATORS
OPRTOP: BLOCK 1 ;IN CURRENT FRAME,TOP OF OPERAND STACK
OPTTOP: BLOCK 1 ;SAME FOR OPERATORS
SAVCHR: BLOCK 1 ;PLACE TO SAVE CHARACTER IN AC CC
SAVEA: BLOCK 1 ;PLACE TO SAVE ACS FOR REPEATED EDIT SEARCH
SAVEB: BLOCK 1
SAVEC: BLOCK 1
SAVED: BLOCK 1
FMZLOC: ;AREA TO ZERO WHEN NEW PROGRAM READ IN
;DO NOT SEPARATE TO LMZLOC
SPCLOC: BLOCK 1 ;POINTS TO FIRST WORD OF 1ST PROGRAM CODE BLOCK
SSTLOC: BLOCK 1 ;SAME AS ABOVE,FOR SYMBOL BLOCKS
HSILOC: BLOCK 1 ;SAME AS ABOVE FOR HI-SEGMENT BLOCK TYPE
STBLOC: BLOCK 1 ;SAME AS ABOVE , FOR TRACE TYPE BLOCK
PSLOC: BLOCK 1 ;FIRST WORD USED FOR STORING REL FILE
PELOC: BLOCK 1 ;LAST WORD USED FOR STORING REL FILE
EPCLOC: BLOCK 1 ;LOCATION OF LAST WORD IN YANKED REL FILE
ESTLOC: BLOCK 1 ;LOCATION OF LAST WORD OF LAST YANKED SYMBOL BLOCK
ETBLOC: BLOCK 1 ;LOCATION OF LAST WORD OF LAST YANKED TRACE ITEM
SEB: BLOCK 4 ;PLACE TO PUT END LINK ITEM OF YANKED PROGRAM
LCADDR: BLOCK 1 ;LAST NEW CODE WORD ADDRESS
LSYMHW: BLOCK 1 ;POINTS TO LAST HEADER WORD IN CRESYM
LCODHW: BLOCK 1 ;LAST CODE BLOCK HEADER WORD
CRESYM: BLOCK 1 ;POINTER TO START OF NEW SYMBOL STORAGE
CREPTR: BLOCK 1 ;POINTER TO CURRENT WORD IN SYMBOL BLOCK
CRELST: BLOCK 1 ;POINTER TO END OF NEW SYMBOL STORAGE
PATCOD: BLOCK 1 ;POINTER TO START OF NEW CODE STORAGE
PATPTR: BLOCK 1 ;POINTER TO CURRENT WORD IN CODE BLOCK
PATLST: BLOCK 1 ;POINTER TO END OF NEW CODE STORAGE
IST: BLOCK 2*ISTMAX ;INTERIM SYMBOL TABLE
ISTLST==.-1 ;LAST LOCATION OF ABOVE
ISTMAP: BLOCK <ISTMAX+^D35>/^D36 ;MAP FOR IST
ISTALT: BLOCK <ISTMAX+^D35>/^D36 ;SAVED MAP OF IST
LMZLOC==.-1
> ; NFI FTBPT ;END OF CONDITIONAL AREA FOR BPT
VAR ;JUST IN CASE
LOWTOP:
IFN PURESW,< RELOC>
END MAKLIB