perm filename CREF.MAC[S,AIL]2 blob
sn#038287 filedate 1973-05-01 generic text, type T, neo UTF8
COMMENT ⊗ VALID 00032 PAGES
RECORD PAGE DESCRIPTION
00001 00001
00004 00002 TITLE CREF V002 - CROSS REFERENCE PROGRAM 19 AUG 67
00006 00003 A= 0 ASCII MODE
00007 00004 SETRPG: IFN TMPCC <
00009 00005 CREF: SKIPA
00010 00006 LSTSET: PUSHJ PP,NAME1 GET NEXT DEVICE
00011 00007 MOVE PP,[XWD -.PP,PPSET]
00012 00008 MLON
00015 00009 R0:
00017 00010 SORT: HRLI BYTEX,-HASH SET UP FOR FIST SORT AOBJN
00019 00011 OUTP: SKIPN SX,LINKL
00021 00012 FREAD: PUSHJ PP,READ GET CHARACTER COUNT
00024 00013 DEFMAC: SKIPA SX,[MACTBL]
00028 00014 SETLAB: PUSHJ PP,FREAD GET LABEL
00031 00015 SRCH: MOVE BYTEX,AC0 GET SIXBIT
00034 00016 GETVAL: TLZN IO,IODEF
00035 00017 TABOUT: MOVEI C,11
00036 00018 XCEED:
00037 00019 FINIS: TLZN IO,IOEOF END OF FILE SEEN?
00039 00020 INSET: PUSHJ PP,NAME1 GET NEXT COMMAND NAME
00041 00021 NAME1: SETZB ACDEV,ACFILE
00043 00022 PROGNP: JUMPL PP,PROGN2 ERROR IF OUTPUT
00044 00023 SWITCH: PUSHJ PP,TTYIN
00046 00024 DEFINE SETSW (LETTER,INSTRUCTION) <
00047 00025 TTYIN: TLNE IO,IORPG
00050 00026 ERRCE: SKIPA RC,[XWD [SIXBIT /CANNOT ENTER FILE@/],ACFILE]
00051 00027 READ: SOSG INBUF+2 BUFFER EMPTY?
00052 00028 DMPLST: OUTPUT LST,0 OUTPUT BUFFER
00053 00029 LSTINI: INIT LST,AL LIST IN ASCII LINE MODE
00054 00030 SVJFF: 0
00055 00031 END CREF
00056 00032
00057 ENDMK
⊗;
TITLE CREF V002 - CROSS REFERENCE PROGRAM 19 AUG 67
SUBTTL -- WARNING::: THIS IS NOT DEC'S CREF!!
;RFS 9/30/70 PUT IN NIH CCL FEATURES.
EXTERNAL JOBFF, JOBREL, JOBDDT, JOBSYM
INTERNAL CREF
STANSW==1
TMPCC==0 ;ON FOR TEMPCORE UUO.....
AC0= 0
TEMP= 1
TEMP1= 2
WPL= 3
RC= WPL
SX= 4
BYTEX= 5
BYTEM= 6
TX= BYTEM
C= 7
CS= 10
LINE= 11
FLAG= 12
FREE= 13
SYMBOL= 14
TOP= 15
IO= 16
PP= 17
P=PP
.WPL= ↑D10
.LPP= ↑D53
.PP= 30
IOLST= 000001
IONCRF= 000002
IOPAGE= 000004
IOFAIL= 000010
IODEF= 000020
IOENDL= 000040
IORPG= 000100
IOTABS= 000200
IOEOF= 000400 ;END OF FILE SEEN
IONLZ= 001000 ;LEADING ZERO TEST
IOTB2= 002000 ;FOR F4
IOLSTS==4000 ;SAVE STATE OF IOLST
IOSAME==2000 ;TO SYMBOLS WITH SAME NAME(PRINT BLOCKS)
IOSYM= 040000
IOMAC= 100000
IOOP= 200000
IODF2= 020000
%OP= 33
%MAC= 34
%LINE= 35
%SYM= 36
%EOF= 37 ;MULTIPLE-PROGRAM BREAK CHARACTER
HASH=↑D101
XX= -1
A= 0 ;ASCII MODE
AL= 1 ;ASCII LINE MODE
CTL= 0 ;CONTROL DEVICE NUMBER
CHAR= 2 ;INPUT DEVICE NUMBER
LST= 3 ;LISTING DEVICE NUMBER
CTL2= 4 ;RPG INPUT DEVICE NUMBER
; COMMAND STRING ACCUMULATORS
ACDEV= TEMP ;DEVICE
ACFILE= TEMP1 ;FILE
ACEXT= LINE ;EXTENSION
ACDEL= 4 ;DELIMITER
ACPNTR= 5 ;BYTE POINTER
TIO= 6
TIORW= 1000
TIOLE= 2000
TIOCLD= 20000
OPDEF RESET [CALLI 0]
OPDEF DEVCHR [CALLI 4]
OPDEF WAIT [MTAPE 0]
OPDEF CORE [CALLI 11]
OPDEF UTPCLR [CALLI 13]
SETRPG: IFN TMPCC <
SETZM TMPCOR#
HRRZ JOBFF
HRLI -200
MOVEM CTIBU2+1
SOS CTIBU2+1
MOVSI TEMP,(SIXBIT /CRE/)
MOVEM TEMP,CTIBU2
MOVE TEMP,[XWD 2,CTIBU2] ;READ AND DELETE CREF TEMP FILE.
CALLI TEMP,44 ;SEE IF TEMPCORE IS THERE.
JRST TMPEOD ;NO
ADD 0,TEMP
MOVEM 0,JOBFF
MOVEM 0,SVJFF
IMULI TEMP,5
ADDI TEMP,1 ;CHARACTER COUNT
MOVEM TEMP,CTIBU2+2
MOVEI TEMP,700
HRLM TEMP,CTIBU2+1 ;BYTE POINTER.
SETOM TMPCOR
JRST RPGQ
TMPEOD:>
INIT CTL2,A
SIXBIT /DSK/
CTIBU2
JRST CREF
IFN STANSW,< MOVE C,[SIXBIT /QQCREF/]
MOVEM C,CMDDIR>
IFE STANSW,<
MOVEI AC0,3
CALLI TEMP,30 ;JOB NUMBER
IDIVI TEMP,12
ADDI TEMP+1,20
LSHC TEMP+1,-6
SOJG AC0,.-3
HRRI TEMP+2,(SIXBIT /CRE/)
MOVEM TEMP+2,CMDDIR
>
IFN STANSW,< MOVSI C,(SIXBIT /RPG/)>
IFE STANSW,< MOVSI C,(SIXBIT /TMP/)>
MOVEM C,CMDDIR+1
SETZM CMDDIR+3
LOOKUP CTL2,CMDDIR
JRST CREF
INBUF CTL2,1
MOVE C,JOBFF
MOVEM C,SVJFF
RPGQ: MOVSI IO,IOPAGE!IOSYM!IOMAC!IORPG
JRST RETRPG
CREF: SKIPA
JRST SETRPG
RESET
MOVSI IO,IOPAGE!IOSYM!IOMAC
RETRPG: SETZM STCLR
MOVE 0,[XWD STCLR,STCLR+1]
BLT 0,ENDCLR
MOVEI PP,PPSET
HLLOS UPLIN ;SET TO A LARGE NUMBER
HLLOS UPPLIM
CTLSET: INIT CTL,AL ;INITIALIZE USER CONSOLE
SIXBIT /TTY/
XWD CTOBUF,CTIBUF
JRST CTLSET ;TRY AGAIN IF ERROR
INBUF CTL,1 ;INITIALIZE SINGLE CONTROL
OUTBUF CTL,1 ;BUFFERS
TLNE IO,IORPG
JRST LSTSET
PUSHJ PP,CRLF ;OUTPUT CARRIAGE RETURN - LINE FEED
MOVEI C,"*"
IDPB C,CTOBUF+1
OUTPUT CTL,
INPUT CTL,
LSTSET: PUSHJ PP,NAME1 ;GET NEXT DEVICE
SKIPN ACDEV
MOVSI ACDEV,(SIXBIT /LPT/) ;YES, SUPPLY LPT
MOVEM ACDEV,LSTDEV ;STORE DEVICE NAME
MOVEM ACFILE,LSTDIR ;STORE FILE NAME
MOVEM ACEXT,LSTDIR+1
PUSHJ PP,LSTINI ;INITIALIZE LISTING OUTPUT
TLZE TIO,TIORW ;REWIND REQUESTED?
MTAPE LST,1 ;YES
JUMPGE CS,LSTSE3
MTAPE LST,17
AOJL CS,.-1
WAIT LST,
STATO LST,1B24
MTAPE LST,16
LSTSE3: SOJG CS,.-1
TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?
UTPCLR LST, ;YES, CLEAR IT
OUTBUF LST,2 ;SET UP A TWO RING BUFFER
ENTER LST,LSTDIR ;SET UP DIRECTORY
JRST ERRCE ;ERROR
MOVE PP,[XWD -.PP,PPSET]
PUSHJ PP,INSET
MOVEI FREE,BLKST-1 ;SET UP THINGS FOR COMBG
MOVEM FREE,BLKND
RECYCL: HRRZ FREE,JOBFF ;RETURN FOR MULTIPLE F4 PROGS
ADDI FREE,1
TRZ FREE,1
SETZM FSTPNT#
MOVEI LINE,1
CAMGE LINE,LOWLIN
TLO IO,IOLST ;WE DON'T WANT LISTING YET
PUSHJ PP,READ ;TEST FIRST CHARACTER
CAIE C,%EOF ;PROGRAM BREAK?
JRST M2A ;NO, PROCESS
JRST M2 ;YES, BYPASS
JRST M2
MLON
M1: TLNN IO,IOLST
PUSHJ PP,WRITE
M2: PUSHJ PP,READ
M2A: CAIN C,177
JRST FAILM
CAIN C,12
JRST M1
CAIN C,15
JRST FCKLF
CAIG C,%EOF
CAIGE C,%OP
SKIPA
JRST M2C
TLZE IO,IOENDL
JRST [TLNE IO,IOLST
JRST .+1
PUSH PP,C
MOVEI C,11
PUSHJ PP,WRITE
POP PP,C
JRST .+1]
JRST M1
M2C: TLNE IO,IOFAIL
JRST M1 ;IGNORE IF FAIL
TLZ IO,IOENDL
TLO IO,IOTB2
XCT MTAB-%OP(C)
JRST M3
M2B: CAMGE LINE,LOWLIN
JRST TSTUP
TLNN IO,IOLSTS
TLZ IO,IOLST
TSTUP: CAMLE LINE,UPLIN
TLO IO,IOLST
TLNN IO,IOLST
PUSHJ PP,CNVRT
TLNE IO,IOTABS
JRST [MOVEI C,11
TLNN IO,IOLST
PUSHJ PP,WRITE
JRST .+1]
AOJA LINE,M2
M3: MOVEI AC0,0
M4: PUSHJ PP,READ
CAIGE C,40
JRST M5A ;NOT SIXBIT
LSH AC0,6
SUBI C,40
ANDI C,77 ;AMKE SURE
IOR AC0,C
JRST M4
M5A: PUSHJ PP,M5
JRST M2
LSH AC0,6
M5: TLNN AC0,770000 ;ANY BITS IN HIGH CHR?
JRST .-2 ;JUSTIFY
JUMPN AC0,M6
ERROR: HRROI RC,[SIXBIT /IMPROPER INPUT DATA@/]
JRST ERRFIN
M6: TDNE IO,SX
TLNE IO,IONCRF
POPJ PP,
CAML LINE,LOWLIM
CAMLE LINE,UPPLIM
TDZA FLAG,FLAG
MOVSI FLAG,(1B0)
JRST SRCH
POPJ PP,
MTAB: MOVSI SX,IOOP
MOVSI SX,IOMAC
SKIPA C,LINE
MOVSI SX,IOSYM
JRST R0 ;BREAK BETWEEN PROGRAMS
FCKLF: TLNE IO,IOTABS!IOTB2
TLO IO,IOENDL
JRST M1
R0:
SKIPE BYTEX,BLKST ;CHECK FOR FAIL BLOCK STRUCTURE
PUSHJ PP,BLKPRN
TLNN IO,IOSYM
JRST NOSYM
MOVEI BYTEX,SYMTBL
PUSHJ P,SORT
PUSHJ P,OUTP
NOSYM: TLNN IO,IOMAC
JRST NOMAC
MOVEI BYTEX,MACTBL
PUSHJ P,SORT
PUSHJ P,OUTP
NOMAC: TLNN IO,IOOP
JRST FINIS
MOVEI BYTEX,OPTBL
PUSHJ P,SORT
PUSHJ P,OUTP
JRST FINIS
CNVRT: MOVEI TEMP,5
MOVEI TEMP1,0
CNVRT1: IDIV C,TABL(TEMP)
ADD TEMP1,C
ADDI C,40
SKIPE TEMP1
ADDI C,20
PUSHJ PP,WRITE
MOVE C,CS
SOJGE TEMP,CNVRT1
POPJ PP,
TABL: DEC 1,10,100,1000,10000,100000
OUTASC: MOVEI C,0
LSHC C,6
ADDI C,40
PUSHJ P,WRITE0
JUMPN CS,OUTASC ;ANY MORE TO PRINT?
POPJ P, ;DONE
SORT: HRLI BYTEX,-HASH ;SET UP FOR FIST SORT AOBJN
L2: MOVEI SX,0
EXCH SX,(BYTEX) ;GET FIRST TABLE ENTRY
JUMPE SX,NXTENT ;NOTHING THERE
L3: MOVEI C,-1(BYTEX) ;GET A POINTER FOR LINKING IN
MOVE FLAG,(SX)
L1: SKIPN TX,1(C)
JRST INSRT ;AT END OF CHAIN SO PUT IT IN
CAML FLAG,(TX)
JRST CKEQ ;CHECK ON EQUALITY AND INSERT
L4: MOVE C,TX
JRST L1
CKEQ: CAME FLAG,(TX)
JRST INSRT ;NO THE SAME GO PUT IN
MOVE FLAG,3(SX)
MOVE FLAG,(FLAG)
MOVE TEMP,3(TX)
CAML FLAG,(TEMP)
JRST INSRT
MOVE FLAG,(SX)
JRST L4
INSRT: EXCH TX,1(SX)
MOVEM SX,1(C)
SKIPE SX,TX
JRST L3
NXTENT: AOBJN BYTEX,L2
SETZM LINKL# ;NO PUT ALL SORTED CHAINS TOGETHER
TRY0: SUBI BYTEX,HASH
MOVSI C,400000
HRLI BYTEX,-HASH
NXTSY: SKIPN TX,(BYTEX)
JRST TRYNXT
CAMG C,(TX)
JRST CKEQ2
TRYNXT: AOBJN BYTEX,NXTSY
CAMN C,[1B0]
POPJ P,
MOVE TX,(SX)
MOVE FLAG,LINKL
EXCH FLAG,1(TX)
MOVEM FLAG,(SX)
MOVEM TX,LINKL
JRST TRY0
CKEQ2: CAME C,(TX)
JRST FND
MOVE FLAG,3(TX)
MOVE FLAG,(FLAG)
MOVE TEMP,(SX)
MOVE TEMP,3(TEMP)
CAMGE FLAG,(TEMP)
JRST TRYNXT
FND: MOVE C,(TX)
MOVE SX,BYTEX
JRST TRYNXT
OUTP: SKIPN SX,LINKL
CPOPJ: POPJ P, ;NONE THERE
TLO IO,IOPAGE
OUTPA: SKIPL 2(SX) ;IGNORE SYMBOL?
JRST LNKOUT ;YES
PUSHJ P,LINOUT
MOVE CS,(SX)
PUSHJ P,OUTASC
MOVE CS,(SX)
MOVE TX,1(SX)
CAMN CS,(TX) ;SAME SYMBOL NAME
JRST ISBLK ;YES, PRINT BLOCK
TLZN IO,IOSAME ;OR LAST OF SET THAT IS THE SAME?
JRST NOBLK ;NO
SKIPA
ISBLK: TLO IO,IOSAME
DOBLK: PUSHJ P,TABOUT
MOVE CS,3(SX)
MOVE CS,(CS)
PUSHJ P,OUTASC
NOBLK: PUSHJ P,OUTP1
LNKOUT: SKIPN SX,1(SX)
POPJ P,
JRST OUTPA
OUTP1: MOVEI FLAG,3(SX)
LINLP: HLRZ FLAG,(FLAG)
JUMPE FLAG,LAST
HRRZ BYTEX,(FLAG)
HRLI BYTEX,(POINT 6,0,5)
ADDI BYTEX,1
MOVE BYTEM,-1(BYTEX)
PUSHJ P,OUTP2
JRST LINLP
LAST: HRRZ BYTEX,2(SX)
HRLI BYTEX,(POINT 6,0,5)
ADDI BYTEX,1
MOVE BYTEM,-1(BYTEX)
OUTP2: MOVEI LINE,0
R3: PUSHJ P,GETVAL
POPJ P,
PUSHJ P,CNVRT
JRST R3
FREAD: PUSHJ PP,READ ;GET CHARACTER COUNT
PUSH PP,TEMP
MOVE TEMP1,C
MOVEI TEMP,(C)
CAILE TEMP1,6
MOVEI TEMP1,6
MOVEI AC0,0
FM4: PUSHJ PP,READ
LSH AC0,6
SUBI C,40
ANDI C,77
IOR AC0,C
SOS TEMP
SOJG TEMP1,FM4
JUMPE TEMP,.+3
PUSHJ PP,READ
SOJN TEMP,.-2
POP PP,TEMP
POPJ PP,
FAILM: PUSHJ PP,READ ;IS THIS REALLY THE START?
CAIE C,102
JRST NOTINF
TLZ IO,IOENDL ;INFORMATION WAS SEEN
TLO IO,IOFAIL ;THIS IS FAIL
FM2: PUSHJ PP,READ
CAIN C,177 ;POSSIBLE END?
JRST TEND ;CHECK
CAILE C,16 ;IN RANGE?
JRST ERROR
XCT DTAB-1(C)
JUMPE SX,FM2
TLZE SX,IODF2 ;DO WE WANT TO DEFINE IT?
TLO IO,IODEF ;YES, SET FLAG
PUSHJ PP,FREAD ;GET THE SYMBOL
FM6: PUSHJ PP,M5 ;GO ENTER SYYMBOL
JRST FM2
NOTINF: PUSH PP,C ;PUT IT OUT AS IT WAS READ
MOVEI C,177
TLNN IO,IOLST
PUSHJ PP,WRITE
POP PP,C
JRST M1 ;BACK INTO MAIN STREAM
TEND: MOVE AC0,SVLAB ;IS THERE A LABEL TO PUT IN
SETZM SVLAB
MOVSI SX,IOSYM
SKIPE AC0
PUSHJ PP,M5
PUSHJ PP,READ ;CHECK FOR END CHARACTER
CAIN C,104
JRST M2 ;JUST EAT INFO BUT NO LINE NUMBER
CAIN C,101
TLO IO,IOTABS
CAIE C,103
CAIN C,101
SKIPA
JRST ERROR ;LOSE
MOVE C,LINE ;SET UP TO ENTER
JRST M2B
DTAB: JRST SETLAB
JRST DLAB
MOVSI SX,IOOP
MOVSI SX,IOOP!IODF2
MOVSI SX,IOMAC
MOVSI SX,IOMAC!IODF2
SETZB SX,SVLAB
JRST COMBIN
JRST DEFSYM
JRST ERROR
JRST DEFMAC
JRST ERROR
JRST BBEG
JRST BBEND
DEFMAC: SKIPA SX,[MACTBL]
DEFSYM: MOVEI SX,SYMTBL
PUSHJ P,FREAD
MOVE BYTEX,AC0
IDIVI BYTEX,HASH
MOVMS TX
ADDI TX,(SX)
SKIPN SX,(TX)
JRST DEFBYP
DEFS1: CAMN AC0,(SX) ;FIND SYMBOL
JRST DEFFD
SKIPE SX,1(SX)
JRST DEFS1
JRST DEFBYP ;NO FOUND
DEFFD: PUSHJ P,FREAD ;NOW GET DEFINITION
SKIPA
LSH AC0,6
TLNN AC0,770000
JRST .-2
MOVEM AC0,(SX)
MOVE AC0,BLKND ;AND BLOCK
HRRM AC0,3(SX)
JRST FM2
DEFBYP: PUSHJ P,FREAD
JRST FM2
COMBIN: PUSHJ P,FREAD ;GET FIRST
MOVE BYTEX,AC0 ;AND FINE
IDIVI BYTEX,HASH
MOVMS TX
MOVEI SX,SYMTBL-1(TX)
CMB1: MOVE TEMP,SX
SKIPN SX,1(TEMP)
JRST DEFBYP
CAME AC0,(SX)
JRST CMB1
PUSHJ P,FREAD ;GET OTHER NAME
MOVE BYTEX,AC0
IDIVI BYTEX,HASH
MOVMS TX
MOVEI TEMP1,SYMTBL-1(TX)
CMB2: MOVE TX,TEMP1
SKIPN TEMP1,1(TX)
JRST MOVSYM
CAME AC0,(TEMP1)
JRST CMB2
LDB BYTEX,[POINT 17,2(TEMP1),17] ;GET LINE
LDB AC0,[POINT 17,2(SX),17]
CAML BYTEX,AC0 ;AND SEE WHICH IS SMALLER
JRST CMBOK ;SMALLER IS ONE TO DELETE
MOVE AC0,2(SX)
EXCH AC0,2(TEMP1)
MOVEM AC0,2(SX)
MOVE AC0,3(SX)
EXCH AC0,3(TEMP1)
MOVEM AC0,3(SX)
CMBOK: MOVE BYTEX,FREE
ADDI FREE,2
CAML FREE,JOBREL
PUSHJ P,XCEED
MOVE AC0,2(SX) ;THIS CODE IS MAJIC
HLL AC0,3(TEMP1)
MOVEM AC0,(BYTEX)
SKIPN 3(TEMP1)
MOVEM BYTEX,3(TEMP1)
MOVE C,3(SX)
HLLM C,3(TEMP1)
JUMPE C,[HRLM BYTEX,3(TEMP1)
JRST .+2]
HRLM BYTEX,(C)
CMB3: MOVE TX,FSTPNT ;PUT DELETE BACK ON FREE
EXCH TX,1(SX) ;AND LINK AROUND
MOVEM SX,FSTPNT
MOVEM TX,1(TEMP)
JRST FM2
MOVSYM: MOVE BYTEX,AC0 ;GET THE SYMBOL NAME AGAIN
IDIVI BYTEX,HASH
MOVMS TX
SKIPE TEMP1,FSTPNT ;GET A BLOCK
JRST [MOVE BYTEX,1(TEMP1)
MOVEM BYTEX,FSTPNT
JRST MOVS1]
MOVE TEMP1,FREE
ADDI FREE,4
CAML FREE,JOBREL
PUSHJ P,XCEED
MOVS1: MOVE BYTEX,SYMTBL(TX) ;INSERT SYMBOL
MOVEM BYTEX,1(TEMP1)
MOVEM TEMP1,SYMTBL(TX)
MOVEM AC0,(TEMP1)
HRLI BYTEX,2(SX)
HRRI BYTEX,2(TEMP1)
BLT BYTEX,3(TEMP1) ;M