perm filename CREF.MAC[X,AIL] blob
sn#038617 filedate 1973-08-19 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) ;MOVE INFORMATION
JRST CMB3 ;AND GO DELETE OLD ONE
SETLAB: PUSHJ PP,FREAD ;GET LABEL
EXCH AC0,SVLAB ;CHANGE FOR OLD
JUMPE AC0,FM2 ;NO OLD, GO GET MORE
MOVSI SX,IOSYM ;SET TO DEFINE
JRST FM6
DLAB: MOVE AC0,SVLAB ;USE LAST LABEL
SETZM SVLAB
JUMPE AC0,ERROR ;ERROR IF NONE THERE
MOVSI SX,IOSYM
TLO IO,IODEF
JRST FM6
BBEG: AOS TEMP,LEVEL ;GET CURRENT LEVEL
MOVSI SX,0
PUSHJ PP,COMBG ;GO INSER
JRST FM2
BBEND: MOVE TEMP,LEVEL ;CURRENT LEVEL
MOVEI SX,1
PUSHJ PP,COMBG
SOS LEVEL ;RESET
JRST FM2
COMBG: PUSHJ PP,FREAD ;GET NAME
SKIPA
LSH AC0,6
TLNN AC0,770000
JRST .-2
MOVE TEMP1,FREE
ADDI FREE,4 ;RESERVE 4 WORDS
CAML FREE,JOBREL
PUSHJ PP,XCEED ;OVERLAP
MOVEM AC0,(TEMP1) ;SAVE NAME
HRLZM TEMP,1(TEMP1) ;AND LEVEL
MOVEM LINE,2(TEMP1) ;AND CURRENT LINE
HRLM SX,2(TEMP1)
MOVE TEMP,BLKND ;SAVE CURRENT POINTER
HRRM TEMP1,1(TEMP) ;SET UP LINK
MOVEM TEMP1,BLKND
POPJ PP,
BLKPRN: PUSHJ PP,LINOUT
MOVE CS,@BLKND
PUSHJ PP,OUTASC
MOVEI C,11
PUSHJ PP,WRITE
MOVE CS,[SIXBIT /PROGRAM/]
PUSHJ PP,OUTASC
MOVEI C,"M"
PUSHJ PP,WRITE
BLKP3: PUSHJ PP,LINOUT
HLRZ BYTEM,1(BYTEX)
LSH BYTEM,-1
JUMPE BYTEM,BLKP1
PUSHJ PP,TABOUT
SOJG BYTEM,.-1
BLKP1: HLRZ BYTEM,1(BYTEX)
HLRZ SX,2(BYTEX)
TRNE BYTEM,1
ADDI SX,4
JUMPE SX,BLKP2
MOVEI C," "
PUSHJ PP,WRITE
SOJG SX,.-1
BLKP2: MOVE CS,(BYTEX)
PUSHJ PP,OUTASC
HLRZ SX,2(BYTEX)
MOVNS SX
ADDI SX,5
SKIPA CS,(BYTEX)
LSH CS,-6
TRNN CS,77
AOJA SX,.-2
MOVEI C," "
PUSHJ PP,WRITE
SOJG SX,.-1
HRRZ C,2(BYTEX)
PUSHJ PP,CNVRT
HRRZ BYTEX,1(BYTEX)
JUMPN BYTEX,BLKP3
TLO IO,IOPAGE
POPJ PP,
SRCH: MOVE BYTEX,AC0 ;GET SIXBIT
IDIVI BYTEX,HASH
MOVMS TX
TLNE SX,IOOP
MOVEI TX,OPTBL(TX) ;SEARCH CORRECT ONE
TLNE SX,IOMAC
MOVEI TX,MACTBL(TX)
TLNE SX,IOSYM
MOVEI TX,SYMTBL(TX)
SKIPN SX,(TX)
JRST NTFND
SRCH1: CAMN AC0,(SX)
JRST STV10
SKIPE SX,1(SX)
JRST SRCH1
NTFND: SKIPE SX,FSTPNT
JRST [MOVE BYTEX,1(SX)
MOVEM BYTEX,FSTPNT ;RESET FREE STG
JRST NTFND1]
MOVE SX,FREE
ADDI FREE,4 ;GET A SPACE TO PUT NEW SYMBOL
CAML FREE,JOBREL
PUSHJ PP,XCEED
NTFND1: MOVEM AC0,(SX)
MOVE BYTEX,(TX) ;LINK INTO TABLE
MOVEM BYTEX,1(SX)
MOVEM SX,(TX)
SETZM 3(SX)
MOVE TX,FREE
ADDI FREE,2
CAML FREE,JOBREL
PUSHJ PP,XCEED
SETZM 1(TX)
MOVEI BYTEX,1(TX)
HRLI BYTEX,(POINT 6,0,5)
MOVEI C,1
TLNE IO,IODEF
TRC C,3
DPB C,[POINT 6,1(TX),5]
MOVE C,LINE
LSH C,1
TLZN IO,IODEF
IORI C,1
HRLM LINE,2(SX)
HRRM TX,2(SX)
JRST STV12
STV10: LDB C,[POINT 17,2(SX),17]
HRRZ TX,2(SX)
CAME C,LINE
JRST STV10A
LDB TEMP,[POINT 6,1(TX),5]
TLNN IO,IODEF
JRST STV10B
TROE TEMP,2
POPJ PP,
JRST STV10C
STV10B: TROE TEMP,1
POPJ PP,
JRST STV10C
STV10A: MOVEI TEMP,1
TLNE IO,IODEF
TRC TEMP,3
STV10C: DPB TEMP,[POINT 6,1(TX),5]
STV10D:
DPB LINE,[POINT 17,2(SX),17]
LSH LINE,1
TLZN IO,IODEF
IORI LINE,1
LSH C,1
SUBM LINE,C
LSH LINE,-1 ;NOW ELIMINATE DEFINE BIT
MOVE BYTEX,0(TX)
STV12: ORM FLAG,2(SX)
CAIGE C,↑D32
JRST STV20
MOVEM PP,PPTEMP
STV14: IDIVI C,↑D32
PUSH PP,CS
CAIL C,↑D32
JRST STV14
STV16: TRO C,40
PUSHJ PP,STV20
POP PP,C
CAME PP,PPTEMP
JRST STV16
STV20: TRNE BYTEX,1
CAML BYTEX,[POINT 6,,16]
JRST STV22
HRRM FREE,0(BYTEX)
MOVE BYTEX,FREE
HRLI BYTEX,(POINT 6,,)
ADDI FREE,2
CAML FREE,JOBREL
PUSHJ PP,XCEED
STV22: IDPB C,BYTEX
MOVEM BYTEX,0(TX)
POPOUT: POPJ PP,
GETVAL: TLZN IO,IODEF
JRST GETV20
MOVEI C,"#"
PUSHJ PP,WRITE
GETV20: CAMN BYTEX,BYTEM
POPJ PP,
AOS 0(PP)
PUSHJ PP,TABOUT
MOVEI C,0
GETV10: TRNE BYTEX,1
CAML BYTEX,[POINT 6,,16]
JRST GETV12
MOVE BYTEX,0(BYTEX)
HRLI BYTEX,(POINT 6,,)
GETV12: ILDB CS,BYTEX
ROT CS,-5
LSHC C,5
JUMPN CS,GETV10
TRNN C,1 ;SET DEFINED FLAG
TLO IO,IODEF
LSH C,-1
ADDB LINE,C
POPJ PP,
TABOUT: MOVEI C,11
SOJGE WPL,WRITE0
PUSHJ PP,LINOUT
JRST TABOUT
LINOUT: SOSG LPP
TLO IO,IOPAGE
MOVEI C,15
PUSHJ PP,WRITE
MOVEI C,12
PUSHJ PP,WRITE
MOVEI WPL,.WPL
POPJ PP,
WRITE0: TLZN IO,IOPAGE
JRST WRITE
PUSH PP,C
MOVEI C,14
PUSHJ PP,WRITE
MOVEI C,.LPP
MOVEM C,LPP
POP PP,C
WRITE: SOSG LSTBUF+2
PUSHJ PP,DMPLST
IDPB C,LSTBUF+1
POPJ PP,
XCEED:
PUSH PP,1
HRRZ 1,JOBREL ;GET CURRENT TOP
MOVEI 1,2000(1)
XCEED2: HRROI RC,[SIXBIT /INSUFFICIENT CORE@/]
CORE 1, ;REQUEST MORE CORE
JRST ERRFIN ;ERROR, BOMB OUT
POP PP,1
POPJ PP,
FINIS: TLZN IO,IOEOF ;END OF FILE SEEN?
JRST RECYCL ;NO, RECYCLE
TLNE IO,IORPG
JRST RPGFN
PUSHJ PP,CRLF
PUSHJ PP,CRLF
MOVE C,FREE
LSH C,-↑D10
ADDI C,1
IDIVI C,↑D10
JUMPE C,FINIS1
ADDI C,"0"
PUSHJ PP,TYO
FINIS1: MOVEI C,"0"(CS)
PUSHJ PP,TYO
HRROI RC,[SIXBIT /K CORE@/]
PUSHJ PP,TYPMS1
RPGFN: CLOSE LST,
PUSHJ PP,TSTLST ;YES, TEST FOR ERRORS
RELEAS LST,
CLOSE CHAR,
RELEAS CHAR,
TLNN IO,IORPG
JRST CREF ;RETURN FOR NEXT ASSEMBLY
RELEAS CTL,0
MOVE C,SVJFF
MOVEM C,JOBFF
MOVSI IO,IOPAGE!IOMAC!IOSYM!IORPG
RPGFN2: PUSHJ PP,TTYIN
CAIG C,15
CAIGE C,12
SKIPA
JRST RPGFN2
MOVSI C,70000
ADDM C,CTIBU2+1
AOS CTIBU2+2
JRST RETRPG
INSET: PUSHJ PP,NAME1 ;GET NEXT COMMAND NAME
SKIPN ACDEV
MOVSI ACDEV,(SIXBIT /DSK/)
MOVEM ACDEV,INDEV ;STORE DEVICE
SKIPN ACFILE
MOVE ACFILE,[SIXBIT /CREF/]
MOVEM ACFILE,INDIR ;STORE FILE IN DIRECTORY
PUSHJ PP,INDEVI
TLZE TIO,TIORW ;REWIND?
MTAPE CHAR,1 ;YES
JUMPGE CS,INSET2
MTAPE CHAR,17
MTAPE CHAR,17
AOJL CS,.-1
WAIT CHAR,
STATO CHAR,1B24
MTAPE CHAR,16
INSET2: SOJGE CS,.-1
INSET3: INBUF CHAR,2
JUMPN ACEXT,INSET4 ;TAKE USER'S EXTENSION IF NON-BLANK
IFN STANSW,<MOVSI ACEXT,(SIXBIT /LST/) ;STANFORD DEFLT.>
IFE STANSW,< MOVSI ACEXT,(SIXBIT /CRF/)> ;BLANK, TRY .TMP FIRST
PUSHJ PP,INSETI
INSET4: PUSHJ PP,INSETI
JUMPE ACEXT,ERRCF ;ERROR IF ZERO
POPJ PP,
INSETI: HLLM ACEXT,INDIR+1 ;STORE EXTENSION
LOOKUP CHAR,INDIR
TDZA ACEXT,ACEXT ;CLEAR EXTENSION IF NOT FOUND
AOS 0(PP) ;SKIP-RETURN IF FOUND
POPJ PP,
NAME1: SETZB ACDEV,ACFILE
SETZB ACEXT,ACDEL
SETZB TIO,CS
NAME3: MOVSI ACPNTR,(POINT 6,AC0) ;SET POINTER
TDZA AC0,AC0 ;CLEAR SYMBOL
SLASH: PUSHJ PP,SW0
GETIOC: PUSHJ PP,TTYIN ;GET INPUT CHARACTER
CAIN C,"/"
JRST SLASH
CAIN C,"("
JRST SWITCH
CAIN C,":"
JRST DEVICE
CAIN C,"."
JRST NAME
CAIE C,"←"
CAIG C,15
JRST TERM
CAIN C,"["
JRST PROGNP ;GET PROGRAMER NUMBER PAIR
SUBI C,40 ;CONVERT TO 6-BIT
TLNE ACPNTR,770000 ;HAVE WE STORED SIX BYTES?
IDPB C,ACPNTR ;NO, STORE IT
JRST GETIOC ;GET NEXT CHARACTER
DEVICE: SKIPA ACDEV,AC0 ;DEVICE NAME
NAME: MOVE ACFILE,AC0 ;FILE NAME
MOVE ACDEL,C ;SET DELIMITER
JRST NAME3 ;GET NEXT SYMBOL
TERM: CAIE ACDEL,":" ;IF PREVIOUS DELIMITER
CAIN ACDEL,0 ;ASSUME FILE NAME IF NOTHING ELSE
MOVE ACFILE,AC0 ;SET FILE
CAIN ACDEL,"." ;IF PERIOD,
HLLZ ACEXT,AC0 ;SET EXTENSION
POPJ PP, ;EXIT
PROGNP: JUMPL PP,PROGN2 ;ERROR IF OUTPUT
ERRCM: HRROI RC,[SIXBIT /COMMAND ERROR@/]
JRST ERRFIN
PROGN1: HRLZM RC,INDIR+3 ;COMMA, STORE LEFT HALF
PROGN2: MOVEI RC,0 ;CLEAR AC
PROGN3: PUSHJ PP,TTYIN
CAIN C,","
JRST PROGN1 ;STORE LEFT HALF
HRRM RC,INDIR+3 ;ASSUME TERMINAL
CAIN C,"]"
JRST GETIOC ;YES, RETURN TO MAIN SCAN
LSH RC,3 ;SHIFT PREVIOUS RESULT
ADDI RC,-"0"(C) ;ADD IN NEW NUMBER
JRST PROGN3 ;GET NEXT CHARACTER
SWITCH: PUSHJ PP,TTYIN
CAIL C,"0"
CAILE C,"9"
JRST SWIT1
PUSHJ PP,GETLIM
CAIE C,","
JRST SWIT2
MOVEM RC,LOWLIM
PUSHJ PP,TTYIN
PUSHJ PP,GETLIM
CAIE C,")"
JRST ERRCM
MOVEM RC,UPPLIM
CAMGE RC,LOWLIM
TLO IO,IONCRF
JRST GETIOC
SWIT2: CAIN C,")"
JRST GETIOC
MOVE FREE,RC
PUSHJ PP,SW1
JRST SWITCH
SWIT1: CAIN C,")"
JRST GETIOC
PUSHJ PP,SW1
PUSHJ PP,TTYIN
JRST SWIT1
GETLIM: TDZA RC,RC
GETLI1: PUSHJ PP,TTYIN
CAIL C,"0"
CAILE C,"9"
POPJ PP,
IMULI RC,↑D10
ADDI RC,-"0"(C)
JRST GETLI1
SW0: PUSHJ PP,TTYIN
SW1: MOVEI C,-"A"(C) ;CONVERT FROM ASCII TO NUMERIC
CAILE C,"Z"-"A" ;WITHIN BOUNDS?
JRST ERRCM ;NO, ERROR
MOVE RC,[POINT 4,BYTAB]
IBP RC
SOJGE C,.-1 ;MOVE TO PROPER BYTE
LDB C,RC ;PICK UP BYTE
JUMPE C,ERRCM ;TEST FOR VALID SWITCH
CAIG C,SWTABT-SWTAB ;LEGAL ON SOURCE?
JUMPL PP,ERRCM ;NO, TEST FOR SOURCE
XCT SWTAB-1(C) ;EXECUTE INSTRUCTION
POPJ PP, ;EXIT
DEFINE SETSW (LETTER,INSTRUCTION) <
INSTRUCTION
J= <"LETTER"-"A">-↑D9*<I=<"LETTER"-"A">/↑D9>
SETCOD \I,J>
DEFINE SETCOD (I,J)
<BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>
BYTAB0= 0 ;INITIALIZE TABLE
BYTAB1= 0
BYTAB2= 0
SWTAB:
SETSW Z,<TLO TIO,TIOCLD >
SWTABT:
SETSW A,<ADDI CS,1 >
SETSW B,<SUBI CS,1 >
SETSW K,<TLZ IO,IOSYM >
SETSW L,<MOVEM FREE,LOWLIN>
SETSW M,<TLZ IO,IOMAC >
SETSW O,<TLO IO,IOOP >
SETSW S,<TLO IO,IOLST!IOLSTS >
SETSW T,<TLO TIO,TIOLE >
SETSW U,<MOVEM FREE,UPLIN>
SETSW W,<TLO TIO,TIORW >
BYTAB:
+BYTAB0
+BYTAB1
+BYTAB2
TTYIN: TLNE IO,IORPG
JRST RPGIN
ILDB C,CTIBUF+1 ;GET CHARACTER
TTYIN2: CAIE C," " ;SKIP BLANKS
CAIN C," " ;AND TABS
JRST TTYIN
POPJ PP, ;NO, EXIT
TYPMSG: PUSHJ PP,CRLF ;MOVE TO NEXT LINE
TYPMS1: HLRE CS,RC ;GET FIRST MESSAGE
JUMPL CS,TYPM1 ;BRANCH IF NEGATIVE
PUSHJ PP,TYPM2 ;TYPE MESSAGE
TYPM1: HRRZ CS,RC ;GET SECOND HALF
PUSHJ PP,TYPM2
CRLF: MOVEI C,15 ;OUTPUT CARRIAGE RETURN
PUSHJ PP,TYO
MOVEI C,12 ;AND LINE FEED
TYO: SOSG CTOBUF+2 ;BUFFER FULL?
OUTPUT CTL,0 ;YES, DUMP IT
IDPB C,CTOBUF+1 ;STORE BYTE
CAIE C,14 ;FORM FEED?
CAIN C,12 ;OR LINE FEED?
OUTPUT CTL,0 ;YES
POPJ PP, ;AND EXIT
TYPM2: MOVSI C,(1B0) ;ANTICIPATE REGISTER WORD
CAIG CS,17 ;IS IT?
MOVEM C,1(CS) ;YES, STORE TERMINATOR
HRLI CS,(POINT 6,,) ;FORM BYTE POINTER
TYPM3: ILDB C,CS ;GET A SIXBIT BYTE
CAIN C,40 ;"@"?
JRST TYO ;YES, TYPE SPACE AND EXIT
ADDI C,40 ;NO, FORM 7-BIT ASCII
PUSHJ PP,TYO ;OUTPUT CHARACTER
JRST TYPM3
RPGIN: SOSG CTIBU2+2
JRST CKRPGI
RPGIN1: IBP CTIBU2+1
MOVE C,@CTIBU2+1
TRNN C,1
JRST RPGIN2
AOS CTIBU2+1
MOVNI C,5
ADDM C,CTIBU2+2
JRST RPGIN
RPGIN2: LDB C,CTIBU2+1
JUMPE C,RPGIN
JRST TTYIN2
CKRPGI: IFN TMPCC,<
SKIPE TMPCOR
CALLI 12 ;ALL DONE.
>
IN CTL2,0
JRST RPGIN1
STATO CTL2,740000
JRST RPGCK2
HRROI RC,[SIXBIT /ERROR READING COMMAND FILE@/]
JRST ERRFIN
RPGCK2: SETZM CMDDIR
SETZM CMDDIR+3 ;GET RID OF PPN
RENAME CTL2,CMDDIR
HALT
CALLI 12
ERRCE: SKIPA RC,[XWD [SIXBIT /CANNOT ENTER FILE@/],ACFILE]
ERRCF: MOVE RC,[XWD [SIXBIT /CANNOT FIND@/],ACFILE]
ERRFIN: PUSHJ PP,TYPMSG
RELEAS CTL,
JRST CREF
READ: SOSG INBUF+2 ;BUFFER EMPTY?
JRST READ3 ;YES
READ1: ILDB C,INBUF+1 ;PLACE CHARACTER IN C
JUMPE C,READ
POPJ PP,
READ3: INPUT CHAR,0 ;GET NEXT BUFFER
STATO CHAR,762000 ;ERROR?
JRST READ1 ;NO, GET CHARACTER
TLO IO,IOEOF ;FLAG EOF SEEN
STATO CHAR,742000
JRST R0
MOVE AC0,INDEV
MOVSI RC,[SIXBIT /INPUT ERROR ON DEVICE@/]
JRST ERRFIN
DMPLST: OUTPUT LST,0 ;OUTPUT BUFFER
TSTLST: STATO LST,740000 ;ANY ERRORS?
POPJ PP, ;NO, EXIT
MOVE AC0,LSTDEV
ERRLST: MOVSI RC,[SIXBIT /DATA ERROR DEVICE@/]
JRST ERRFIN
LSTINI: INIT LST,AL ;LIST IN ASCII LINE MODE
LSTDEV: BLOCK 1
XWD LSTBUF,0
JRST EINIT ;ERROR EXIT
POPJ PP, ;GOOD EXIT
INDEVI: INIT CHAR,A
INDEV: BLOCK 1
XWD 0,INBUF
INDEVE: SKIPA ACDEV,INDEV ;ERROR, SKIP AND SET ACDEV
POPJ PP,
EINIT: MOVE RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]
JRST ERRFIN
SVJFF: 0
CTIBU2: BLOCK 3
CMDDIR: BLOCK 4
STCLR:
PPSET: BLOCK .PP
CTIBUF: BLOCK 3
CTOBUF: BLOCK 3
INBUF: BLOCK 3
INDIR: BLOCK 4
LSTBUF: BLOCK 3
LSTDIR: BLOCK 4
LPP: BLOCK 1
PPTEMP: BLOCK 1
OPTBL: BLOCK HASH
SYMTBL: BLOCK HASH
MACTBL: BLOCK HASH
LOWLIN: BLOCK 1
LOWLIM: BLOCK 1
UPPLIM: BLOCK 1
UPLIN: BLOCK 1
LEVEL: 0
SVLAB: 0
BLKST: 0
BLKND: 0
ENDCLR= .-1
END CREF