perm filename CREF.MAC[S,AIL]1 blob
sn#000834 filedate 1971-03-21 generic text, type T, neo UTF8
00100 TITLE CREF V002 - CROSS REFERENCE PROGRAM 19 AUG 67
00102 SUBTTL -- WARNING::: THIS IS NOT DEC'S CREF!!
00104
00106 ;RFS 9/30/70 PUT IN NIH CCL FEATURES.
00108
00110
00112
00200
00300 EXTERNAL JOBFF, JOBREL, JOBDDT, JOBSYM
00400 INTERNAL CREF
00500
00550 STANSW==0
00552 TMPCC==1 ;ON FOR TEMPCORE UUO.....
00600 AC0= 0
00700 TEMP= 1
00800 TEMP1= 2
00900 WPL= 3
01000 RC= WPL
01100 SX= 4
01200 BYTEX= 5
01300 BYTEM= 6
01400 TX= BYTEM
01500 C= 7
01600 CS= 10
01700 LINE= 11
01800 FLAG= 12
01900 FREE= 13
02000 SYMBOL= 14
02100 TOP= 15
02200 IO= 16
02300 PP= 17
02400 P=PP
02500
02600 .WPL= ↑D10
02700 .LPP= ↑D53
02800 .PP= 30
02900
03000 IOLST= 000001
03100 IONCRF= 000002
03200 IOPAGE= 000004
03300 IOFAIL= 000010
03400 IODEF= 000020
03500 IOENDL= 000040
03600 IORPG= 000100
03700 IOTABS= 000200
03800 IOEOF= 000400 ;END OF FILE SEEN
03900 IONLZ= 001000 ;LEADING ZERO TEST
04000 IOTB2= 002000 ;FOR F4
04100 IOLSTS==4000 ;SAVE STATE OF IOLST
04200 IOSAME==2000 ;TO SYMBOLS WITH SAME NAME(PRINT BLOCKS)
04300
04400 IOSYM= 040000
04500 IOMAC= 100000
04600 IOOP= 200000
04700 IODF2= 020000
04800
04900 %OP= 33
05000 %MAC= 34
05100 %LINE= 35
05200 %SYM= 36
05300 %EOF= 37 ;MULTIPLE-PROGRAM BREAK CHARACTER
05400 HASH=↑D101
05500
05600 XX= -1
00100 A= 0 ;ASCII MODE
00200 AL= 1 ;ASCII LINE MODE
00300
00400 CTL= 0 ;CONTROL DEVICE NUMBER
00500 CHAR= 2 ;INPUT DEVICE NUMBER
00600 LST= 3 ;LISTING DEVICE NUMBER
00700 CTL2= 4 ;RPG INPUT DEVICE NUMBER
00800
00900 ; COMMAND STRING ACCUMULATORS
01000
01100 ACDEV= TEMP ;DEVICE
01200 ACFILE= TEMP1 ;FILE
01300 ACEXT= LINE ;EXTENSION
01400 ACDEL= 4 ;DELIMITER
01500 ACPNTR= 5 ;BYTE POINTER
01600
01700 TIO= 6
01800
01900 TIORW= 1000
02000 TIOLE= 2000
02100 TIOCLD= 20000
02200
02300 OPDEF RESET [CALLI 0]
02400 OPDEF DEVCHR [CALLI 4]
02500 OPDEF WAIT [MTAPE 0]
02600 OPDEF CORE [CALLI 11]
02700 OPDEF UTPCLR [CALLI 13]
00100 SETRPG: IFN TMPCC <
00102 SETZM TMPCOR#
00104 HRRZ JOBFF
00106 HRLI -200
00108 MOVEM CTIBU2+1
00110 SOS CTIBU2+1
00112 MOVSI TEMP,(SIXBIT /CRE/)
00114 MOVEM TEMP,CTIBU2
00116 MOVE TEMP,[XWD 2,CTIBU2] ;READ AND DELETE CREF TEMP FILE.
00118 CALLI TEMP,44 ;SEE IF TEMPCORE IS THERE.
00120 JRST TMPEOD ;NO
00122 ADD 0,TEMP
00124 MOVEM 0,JOBFF
00126 MOVEM 0,SVJFF
00128 IMULI TEMP,5
00130 ADDI TEMP,1 ;CHARACTER COUNT
00132 MOVEM TEMP,CTIBU2+2
00134 MOVEI TEMP,700
00136 HRLM TEMP,CTIBU2+1 ;BYTE POINTER.
00138 SETOM TMPCOR
00140 JRST RPGQ
00142 TMPEOD:>
00144 INIT CTL2,A
00200 SIXBIT /DSK/
00300 CTIBU2
00400 JRST CREF
00500 IFN STANSW,< MOVE C,[SIXBIT /QQCREF/]
00501 MOVEM C,CMDDIR>
00502 IFE STANSW,<
00504 MOVEI AC0,3
00506 CALLI TEMP,30 ;JOB NUMBER
00508 IDIVI TEMP,12
00510 ADDI TEMP+1,20
00512 LSHC TEMP+1,-6
00514 SOJG AC0,.-3
00516 HRRI TEMP+2,(SIXBIT /CRE/)
00518 MOVEM TEMP+2,CMDDIR
00520 >
00700 IFN STANSW,< MOVSI C,(SIXBIT /RPG/)>
00702 IFE STANSW,< MOVSI C,(SIXBIT /TMP/)>
00800 MOVEM C,CMDDIR+1
00900 SETZM CMDDIR+3
01000 LOOKUP CTL2,CMDDIR
01100 JRST CREF
01300 INBUF CTL2,1
01400 MOVE C,JOBFF
01500 MOVEM C,SVJFF
01510 RPGQ: MOVSI IO,IOPAGE!IOSYM!IOMAC!IORPG
01600 JRST RETRPG
00100 CREF: SKIPA
00200 JRST SETRPG
00300 RESET
00400 MOVSI IO,IOPAGE!IOSYM!IOMAC
00500 RETRPG: SETZM STCLR
00600 MOVE 0,[XWD STCLR,STCLR+1]
00700 BLT 0,ENDCLR
00800 MOVEI PP,PPSET
00900 HLLOS UPLIN ;SET TO A LARGE NUMBER
01000 HLLOS UPPLIM
01100
01200 CTLSET: INIT CTL,AL ;INITIALIZE USER CONSOLE
01300 SIXBIT /TTY/
01400 XWD CTOBUF,CTIBUF
01500 JRST CTLSET ;TRY AGAIN IF ERROR
01600 INBUF CTL,1 ;INITIALIZE SINGLE CONTROL
01700 OUTBUF CTL,1 ;BUFFERS
01800 TLNE IO,IORPG
01900 JRST LSTSET
02000 PUSHJ PP,CRLF ;OUTPUT CARRIAGE RETURN - LINE FEED
02100 MOVEI C,"*"
02200 IDPB C,CTOBUF+1
02300 OUTPUT CTL,
02400 INPUT CTL,
00100 LSTSET: PUSHJ PP,NAME1 ;GET NEXT DEVICE
00200 SKIPN ACDEV
00300 MOVSI ACDEV,(SIXBIT /LPT/) ;YES, SUPPLY LPT
00400 MOVEM ACDEV,LSTDEV ;STORE DEVICE NAME
00500 MOVEM ACFILE,LSTDIR ;STORE FILE NAME
00600 MOVEM ACEXT,LSTDIR+1
00700 PUSHJ PP,LSTINI ;INITIALIZE LISTING OUTPUT
00800 TLZE TIO,TIORW ;REWIND REQUESTED?
00900 MTAPE LST,1 ;YES
01000 JUMPGE CS,LSTSE3
01100 MTAPE LST,17
01200 AOJL CS,.-1
01300 WAIT LST,
01400 STATO LST,1B24
01500 MTAPE LST,16
01600 LSTSE3: SOJG CS,.-1
01700
01800 TLNE TIO,TIOCLD ;DIRECTORY CLEAR REQUESTED?
01900 UTPCLR LST, ;YES, CLEAR IT
02000 OUTBUF LST,2 ;SET UP A TWO RING BUFFER
02100 ENTER LST,LSTDIR ;SET UP DIRECTORY
02200 JRST ERRCE ;ERROR
00100 MOVE PP,[XWD -.PP,PPSET]
00200 PUSHJ PP,INSET
00300 MOVEI FREE,BLKST-1 ;SET UP THINGS FOR COMBG
00400 MOVEM FREE,BLKND
00500
00600 RECYCL: HRRZ FREE,JOBFF ;RETURN FOR MULTIPLE F4 PROGS
00700 ADDI FREE,1
00800 TRZ FREE,1
00900
01000 SETZM FSTPNT#
01100
01200 MOVEI LINE,1
01300 CAMGE LINE,LOWLIN
01400 TLO IO,IOLST ;WE DON'T WANT LISTING YET
01500 PUSHJ PP,READ ;TEST FIRST CHARACTER
01600 CAIE C,%EOF ;PROGRAM BREAK?
01700 JRST M2A ;NO, PROCESS
01800 JRST M2 ;YES, BYPASS
01900 JRST M2
02000
00100 MLON
00200 M1: TLNN IO,IOLST
00300 PUSHJ PP,WRITE
00400 M2: PUSHJ PP,READ
00500 M2A: CAIN C,177
00600 JRST FAILM
00700 CAIN C,12
00800 JRST M1
00900 CAIN C,15
01000 JRST FCKLF
01100 CAIG C,%EOF
01200 CAIGE C,%OP
01300 SKIPA
01400 JRST M2C
01500 TLZE IO,IOENDL
01600 JRST [TLNE IO,IOLST
01700 JRST .+1
01800 PUSH PP,C
01900 MOVEI C,11
02000 PUSHJ PP,WRITE
02100 POP PP,C
02200 JRST .+1]
02300 JRST M1
02400 M2C: TLNE IO,IOFAIL
02500 JRST M1 ;IGNORE IF FAIL
02600 TLZ IO,IOENDL
02700 TLO IO,IOTB2
02800 XCT MTAB-%OP(C)
02900 JRST M3
03000 M2B: CAMGE LINE,LOWLIN
03100 JRST TSTUP
03200 TLNN IO,IOLSTS
03300 TLZ IO,IOLST
03400 TSTUP: CAMLE LINE,UPLIN
03500 TLO IO,IOLST
03600 TLNN IO,IOLST
03700 PUSHJ PP,CNVRT
03800 TLNE IO,IOTABS
03900 JRST [MOVEI C,11
04000 TLNN IO,IOLST
04100 PUSHJ PP,WRITE
04200 JRST .+1]
04300 AOJA LINE,M2
04400
04500 M3: MOVEI AC0,0
04600 M4: PUSHJ PP,READ
04700 CAIGE C,40
04800 JRST M5A ;NOT SIXBIT
04900 LSH AC0,6
05000 SUBI C,40
05100 ANDI C,77 ;AMKE SURE
05200 IOR AC0,C
05300 JRST M4
05400
05500 M5A: PUSHJ PP,M5
05600 JRST M2
05700 LSH AC0,6
05800 M5: TLNN AC0,770000 ;ANY BITS IN HIGH CHR?
05900 JRST .-2 ;JUSTIFY
06000 JUMPN AC0,M6
06100 ERROR: HRROI RC,[SIXBIT /IMPROPER INPUT DATA@/]
06200 JRST ERRFIN
06300
06400 M6: TDNE IO,SX
06500 TLNE IO,IONCRF
06600 POPJ PP,
06700
06800 CAML LINE,LOWLIM
06900 CAMLE LINE,UPPLIM
07000 TDZA FLAG,FLAG
07100 MOVSI FLAG,(1B0)
07200 JRST SRCH
07300 POPJ PP,
07400
07500 MTAB: MOVSI SX,IOOP
07600 MOVSI SX,IOMAC
07700 SKIPA C,LINE
07800 MOVSI SX,IOSYM
07900 JRST R0 ;BREAK BETWEEN PROGRAMS
08000
08100 FCKLF: TLNE IO,IOTABS!IOTB2
08200 TLO IO,IOENDL
08300 JRST M1
00100 R0:
00200 SKIPE BYTEX,BLKST ;CHECK FOR FAIL BLOCK STRUCTURE
00300 PUSHJ PP,BLKPRN
00400 TLNN IO,IOSYM
00500 JRST NOSYM
00600 MOVEI BYTEX,SYMTBL
00700 PUSHJ P,SORT
00800 PUSHJ P,OUTP
00900 NOSYM: TLNN IO,IOMAC
01000 JRST NOMAC
01100 MOVEI BYTEX,MACTBL
01200 PUSHJ P,SORT
01300 PUSHJ P,OUTP
01400 NOMAC: TLNN IO,IOOP
01500 JRST FINIS
01600 MOVEI BYTEX,OPTBL
01700 PUSHJ P,SORT
01800 PUSHJ P,OUTP
01900 JRST FINIS
02000
02100 CNVRT: MOVEI TEMP,5
02200 MOVEI TEMP1,0
02300 CNVRT1: IDIV C,TABL(TEMP)
02400 ADD TEMP1,C
02500 ADDI C,40
02600 SKIPE TEMP1
02700 ADDI C,20
02800 PUSHJ PP,WRITE
02900 MOVE C,CS
03000 SOJGE TEMP,CNVRT1
03100 POPJ PP,
03200
03300 TABL: DEC 1,10,100,1000,10000,100000
03400
03500 OUTASC: MOVEI C,0
03600 LSHC C,6
03700 ADDI C,40
03800 PUSHJ P,WRITE0
03900 JUMPN CS,OUTASC ;ANY MORE TO PRINT?
04000 POPJ P, ;DONE
00100 SORT: HRLI BYTEX,-HASH ;SET UP FOR FIST SORT AOBJN
00200 L2: MOVEI SX,0
00300 EXCH SX,(BYTEX) ;GET FIRST TABLE ENTRY
00400 JUMPE SX,NXTENT ;NOTHING THERE
00500 L3: MOVEI C,-1(BYTEX) ;GET A POINTER FOR LINKING IN
00600 MOVE FLAG,(SX)
00700 L1: SKIPN TX,1(C)
00800 JRST INSRT ;AT END OF CHAIN SO PUT IT IN
00900 CAML FLAG,(TX)
01000 JRST CKEQ ;CHECK ON EQUALITY AND INSERT
01100 L4: MOVE C,TX
01200 JRST L1
01300 CKEQ: CAME FLAG,(TX)
01400 JRST INSRT ;NO THE SAME GO PUT IN
01500 MOVE FLAG,3(SX)
01600 MOVE FLAG,(FLAG)
01700 MOVE TEMP,3(TX)
01800 CAML FLAG,(TEMP)
01900 JRST INSRT
02000 MOVE FLAG,(SX)
02100 JRST L4
02200 INSRT: EXCH TX,1(SX)
02300 MOVEM SX,1(C)
02400 SKIPE SX,TX
02500 JRST L3
02600 NXTENT: AOBJN BYTEX,L2
02700
02800 SETZM LINKL# ;NO PUT ALL SORTED CHAINS TOGETHER
02900 TRY0: SUBI BYTEX,HASH
03000 MOVSI C,400000
03100 HRLI BYTEX,-HASH
03200 NXTSY: SKIPN TX,(BYTEX)
03300 JRST TRYNXT
03400 CAMG C,(TX)
03500 JRST CKEQ2
03600 TRYNXT: AOBJN BYTEX,NXTSY
03700 CAMN C,[1B0]
03800 POPJ P,
03900 MOVE TX,(SX)
04000 MOVE FLAG,LINKL
04100 EXCH FLAG,1(TX)
04200 MOVEM FLAG,(SX)
04300 MOVEM TX,LINKL
04400 JRST TRY0
04500 CKEQ2: CAME C,(TX)
04600 JRST FND
04700 MOVE FLAG,3(TX)
04800 MOVE FLAG,(FLAG)
04900 MOVE TEMP,(SX)
05000 MOVE TEMP,3(TEMP)
05100 CAMGE FLAG,(TEMP)
05200 JRST TRYNXT
05300 FND: MOVE C,(TX)
05400 MOVE SX,BYTEX
05500 JRST TRYNXT
00100 OUTP: SKIPN SX,LINKL
00200 CPOPJ: POPJ P, ;NONE THERE
00300 TLO IO,IOPAGE
00400 OUTPA: SKIPL 2(SX) ;IGNORE SYMBOL?
00500 JRST LNKOUT ;YES
00600 PUSHJ P,LINOUT
00700 MOVE CS,(SX)
00800 PUSHJ P,OUTASC
00900 MOVE CS,(SX)
01000 MOVE TX,1(SX)
01100 CAMN CS,(TX) ;SAME SYMBOL NAME
01200 JRST ISBLK ;YES, PRINT BLOCK
01300 TLZN IO,IOSAME ;OR LAST OF SET THAT IS THE SAME?
01400 JRST NOBLK ;NO
01500 SKIPA
01600 ISBLK: TLO IO,IOSAME
01700 DOBLK: PUSHJ P,TABOUT
01800 MOVE CS,3(SX)
01900 MOVE CS,(CS)
02000 PUSHJ P,OUTASC
02100 NOBLK: PUSHJ P,OUTP1
02200 LNKOUT: SKIPN SX,1(SX)
02300 POPJ P,
02400 JRST OUTPA
02500
02600 OUTP1: MOVEI FLAG,3(SX)
02700 LINLP: HLRZ FLAG,(FLAG)
02800 JUMPE FLAG,LAST
02900 HRRZ BYTEX,(FLAG)
03000 HRLI BYTEX,(POINT 6,0,5)
03100 ADDI BYTEX,1
03200 MOVE BYTEM,-1(BYTEX)
03300 PUSHJ P,OUTP2
03400 JRST LINLP
03500 LAST: HRRZ BYTEX,2(SX)
03600 HRLI BYTEX,(POINT 6,0,5)
03700 ADDI BYTEX,1
03800 MOVE BYTEM,-1(BYTEX)
03900 OUTP2: MOVEI LINE,0
04000 R3: PUSHJ P,GETVAL
04100 POPJ P,
04200 PUSHJ P,CNVRT
04300 JRST R3
00100 FREAD: PUSHJ PP,READ ;GET CHARACTER COUNT
00200 PUSH PP,TEMP
00300 MOVE TEMP1,C
00400 MOVEI TEMP,(C)
00500 CAILE TEMP1,6
00600 MOVEI TEMP1,6
00700 MOVEI AC0,0
00800 FM4: PUSHJ PP,READ
00900 LSH AC0,6
01000 SUBI C,40
01100 ANDI C,77
01200 IOR AC0,C
01300 SOS TEMP
01400 SOJG TEMP1,FM4
01500 JUMPE TEMP,.+3
01600 PUSHJ PP,READ
01700 SOJN TEMP,.-2
01800 POP PP,TEMP
01900 POPJ PP,
02000
02100 FAILM: PUSHJ PP,READ ;IS THIS REALLY THE START?
02200 CAIE C,102
02300 JRST NOTINF
02400 TLZ IO,IOENDL ;INFORMATION WAS SEEN
02500 TLO IO,IOFAIL ;THIS IS FAIL
02600 FM2: PUSHJ PP,READ
02700 CAIN C,177 ;POSSIBLE END?
02800 JRST TEND ;CHECK
02900 CAILE C,16 ;IN RANGE?
03000 JRST ERROR
03100 XCT DTAB-1(C)
03200 JUMPE SX,FM2
03300 TLZE SX,IODF2 ;DO WE WANT TO DEFINE IT?
03400 TLO IO,IODEF ;YES, SET FLAG
03500 PUSHJ PP,FREAD ;GET THE SYMBOL
03600 FM6: PUSHJ PP,M5 ;GO ENTER SYYMBOL
03700 JRST FM2
03800
03900 NOTINF: PUSH PP,C ;PUT IT OUT AS IT WAS READ
04000 MOVEI C,177
04100 TLNN IO,IOLST
04200 PUSHJ PP,WRITE
04300 POP PP,C
04400 JRST M1 ;BACK INTO MAIN STREAM
04500
04600 TEND: MOVE AC0,SVLAB ;IS THERE A LABEL TO PUT IN
04700 SETZM SVLAB
04800 MOVSI SX,IOSYM
04900 SKIPE AC0
05000 PUSHJ PP,M5
05100 PUSHJ PP,READ ;CHECK FOR END CHARACTER
05200 CAIN C,104
05300 JRST M2 ;JUST EAT INFO BUT NO LINE NUMBER
05400 CAIN C,101
05500 TLO IO,IOTABS
05600 CAIE C,103
05700 CAIN C,101
05800 SKIPA
05900 JRST ERROR ;LOSE
06000 MOVE C,LINE ;SET UP TO ENTER
06100 JRST M2B
06200
06300 DTAB: JRST SETLAB
06400 JRST DLAB
06500 MOVSI SX,IOOP
06600 MOVSI SX,IOOP!IODF2
06700 MOVSI SX,IOMAC
06800 MOVSI SX,IOMAC!IODF2
06900 SETZB SX,SVLAB
07000 JRST COMBIN
07100 JRST DEFSYM
07200 JRST ERROR
07300 JRST DEFMAC
07400 JRST ERROR
07500 JRST BBEG
07600 JRST BBEND
00100 DEFMAC: SKIPA SX,[MACTBL]
00200 DEFSYM: MOVEI SX,SYMTBL
00300 PUSHJ P,FREAD
00400 MOVE BYTEX,AC0
00500 IDIVI BYTEX,HASH
00600 MOVMS TX
00700 ADDI TX,(SX)
00800 SKIPN SX,(TX)
00900 JRST DEFBYP
01000 DEFS1: CAMN AC0,(SX) ;FIND SYMBOL
01100 JRST DEFFD
01200 SKIPE SX,1(SX)
01300 JRST DEFS1
01400 JRST DEFBYP ;NO FOUND
01500 DEFFD: PUSHJ P,FREAD ;NOW GET DEFINITION
01600 SKIPA
01700 LSH AC0,6
01800 TLNN AC0,770000
01900 JRST .-2
02000 MOVEM AC0,(SX)
02100 MOVE AC0,BLKND ;AND BLOCK
02200 HRRM AC0,3(SX)
02300 JRST FM2
02400 DEFBYP: PUSHJ P,FREAD
02500 JRST FM2
02600 COMBIN: PUSHJ P,FREAD ;GET FIRST
02700 MOVE BYTEX,AC0 ;AND FINE
02800 IDIVI BYTEX,HASH
02900 MOVMS TX
03000 MOVEI SX,SYMTBL-1(TX)
03100 CMB1: MOVE TEMP,SX
03200 SKIPN SX,1(TEMP)
03300 JRST DEFBYP
03400 CAME AC0,(SX)
03500 JRST CMB1
03600 PUSHJ P,FREAD ;GET OTHER NAME
03700 MOVE BYTEX,AC0
03800 IDIVI BYTEX,HASH
03900 MOVMS TX
04000 MOVEI TEMP1,SYMTBL-1(TX)
04100 CMB2: MOVE TX,TEMP1
04200 SKIPN TEMP1,1(TX)
04300 JRST MOVSYM
04400 CAME AC0,(TEMP1)
04500 JRST CMB2
04600 LDB BYTEX,[POINT 17,2(TEMP1),17] ;GET LINE
04700 LDB AC0,[POINT 17,2(SX),17]
04800 CAML BYTEX,AC0 ;AND SEE WHICH IS SMALLER
04900 JRST CMBOK ;SMALLER IS ONE TO DELETE
05000 MOVE AC0,2(SX)
05100 EXCH AC0,2(TEMP1)
05200 MOVEM AC0,2(SX)
05300 MOVE AC0,3(SX)
05400 EXCH AC0,3(TEMP1)
05500 MOVEM AC0,3(SX)
05600 CMBOK: MOVE BYTEX,FREE
05700 ADDI FREE,2
05800 CAML FREE,JOBREL
05900 PUSHJ P,XCEED
06000 MOVE AC0,2(SX) ;THIS CODE IS MAJIC
06100 HLL AC0,3(TEMP1)
06200 MOVEM AC0,(BYTEX)
06300 SKIPN 3(TEMP1)
06400 MOVEM BYTEX,3(TEMP1)
06500 MOVE C,3(SX)
06600 HLLM C,3(TEMP1)
06700 JUMPE C,[HRLM BYTEX,3(TEMP1)
06800 JRST .+2]
06900 HRLM BYTEX,(C)
07000 CMB3: MOVE TX,FSTPNT ;PUT DELETE BACK ON FREE
07100 EXCH TX,1(SX) ;AND LINK AROUND
07200 MOVEM SX,FSTPNT
07300 MOVEM TX,1(TEMP)
07400 JRST FM2
07500 MOVSYM: MOVE BYTEX,AC0 ;GET THE SYMBOL NAME AGAIN
07600 IDIVI BYTEX,HASH
07700 MOVMS TX
07800 SKIPE TEMP1,FSTPNT ;GET A BLOCK
07900 JRST [MOVE BYTEX,1(TEMP1)
08000 MOVEM BYTEX,FSTPNT
08100 JRST MOVS1]
08200 MOVE TEMP1,FREE
08300 ADDI FREE,4
08400 CAML FREE,JOBREL
08500 PUSHJ P,XCEED
08600 MOVS1: MOVE BYTEX,SYMTBL(TX) ;INSERT SYMBOL
08700 MOVEM BYTEX,1(TEMP1)
08800 MOVEM TEMP1,SYMTBL(TX)
08900 MOVEM AC0,(TEMP1)
09000 HRLI BYTEX,2(SX)
09100 HRRI BYTEX,2(TEMP1)
09200 BLT BYTEX,3(TEMP1) ;MOVE INFORMATION
09300 JRST CMB3 ;AND GO DELETE OLD ONE
00100 SETLAB: PUSHJ PP,FREAD ;GET LABEL
00200 EXCH AC0,SVLAB ;CHANGE FOR OLD
00300 JUMPE AC0,FM2 ;NO OLD, GO GET MORE
00400 MOVSI SX,IOSYM ;SET TO DEFINE
00500 JRST FM6
00600
00700 DLAB: MOVE AC0,SVLAB ;USE LAST LABEL
00800 SETZM SVLAB
00900 JUMPE AC0,ERROR ;ERROR IF NONE THERE
01000 MOVSI SX,IOSYM
01100 TLO IO,IODEF
01200 JRST FM6
01300
01400 BBEG: AOS TEMP,LEVEL ;GET CURRENT LEVEL
01500 MOVSI SX,0
01600 PUSHJ PP,COMBG ;GO INSER
01700 JRST FM2
01800
01900 BBEND: MOVE TEMP,LEVEL ;CURRENT LEVEL
02000 MOVEI SX,1
02100 PUSHJ PP,COMBG
02200 SOS LEVEL ;RESET
02300 JRST FM2
02400
02500 COMBG: PUSHJ PP,FREAD ;GET NAME
02600 SKIPA
02700 LSH AC0,6
02800 TLNN AC0,770000
02900 JRST .-2
03000 MOVE TEMP1,FREE
03100 ADDI FREE,4 ;RESERVE 4 WORDS
03200 CAML FREE,JOBREL
03300 PUSHJ PP,XCEED ;OVERLAP
03400 MOVEM AC0,(TEMP1) ;SAVE NAME
03500 HRLZM TEMP,1(TEMP1) ;AND LEVEL
03600 MOVEM LINE,2(TEMP1) ;AND CURRENT LINE
03700 HRLM SX,2(TEMP1)
03800 MOVE TEMP,BLKND ;SAVE CURRENT POINTER
03900 HRRM TEMP1,1(TEMP) ;SET UP LINK
04000 MOVEM TEMP1,BLKND
04100 POPJ PP,
04200
04300 BLKPRN: PUSHJ PP,LINOUT
04400 MOVE CS,@BLKND
04500 PUSHJ PP,OUTASC
04600 MOVEI C,11
04700 PUSHJ PP,WRITE
04800 MOVE CS,[SIXBIT /PROGRAM/]
04900 PUSHJ PP,OUTASC
05000 MOVEI C,"M"
05100 PUSHJ PP,WRITE
05200 BLKP3: PUSHJ PP,LINOUT
05300 HLRZ BYTEM,1(BYTEX)
05400 LSH BYTEM,-1
05500 JUMPE BYTEM,BLKP1
05600 PUSHJ PP,TABOUT
05700 SOJG BYTEM,.-1
05800 BLKP1: HLRZ BYTEM,1(BYTEX)
05900 HLRZ SX,2(BYTEX)
06000 TRNE BYTEM,1
06100 ADDI SX,4
06200 JUMPE SX,BLKP2
06300 MOVEI C," "
06400 PUSHJ PP,WRITE
06500 SOJG SX,.-1
06600 BLKP2: MOVE CS,(BYTEX)
06700 PUSHJ PP,OUTASC
06800 HLRZ SX,2(BYTEX)
06900 MOVNS SX
07000 ADDI SX,5
07100 SKIPA CS,(BYTEX)
07200 LSH CS,-6
07300 TRNN CS,77
07400 AOJA SX,.-2
07500 MOVEI C," "
07600 PUSHJ PP,WRITE
07700 SOJG SX,.-1
07800 HRRZ C,2(BYTEX)
07900 PUSHJ PP,CNVRT
08000 HRRZ BYTEX,1(BYTEX)
08100 JUMPN BYTEX,BLKP3
08200 TLO IO,IOPAGE
08300 POPJ PP,
00100 SRCH: MOVE BYTEX,AC0 ;GET SIXBIT
00200 IDIVI BYTEX,HASH
00300 MOVMS TX
00400 TLNE SX,IOOP
00500 MOVEI TX,OPTBL(TX) ;SEARCH CORRECT ONE
00600 TLNE SX,IOMAC
00700 MOVEI TX,MACTBL(TX)
00800 TLNE SX,IOSYM
00900 MOVEI TX,SYMTBL(TX)
01000 SKIPN SX,(TX)
01100 JRST NTFND
01200 SRCH1: CAMN AC0,(SX)
01300 JRST STV10
01400 SKIPE SX,1(SX)
01500 JRST SRCH1
01600 NTFND: SKIPE SX,FSTPNT
01700 JRST [MOVE BYTEX,1(SX)
01800 MOVEM BYTEX,FSTPNT ;RESET FREE STG
01900 JRST NTFND1]
02000 MOVE SX,FREE
02100 ADDI FREE,4 ;GET A SPACE TO PUT NEW SYMBOL
02200 CAML FREE,JOBREL
02300 PUSHJ PP,XCEED
02400 NTFND1: MOVEM AC0,(SX)
02500 MOVE BYTEX,(TX) ;LINK INTO TABLE
02600 MOVEM BYTEX,1(SX)
02700 MOVEM SX,(TX)
02800 SETZM 3(SX)
02900 MOVE TX,FREE
03000 ADDI FREE,2
03100 CAML FREE,JOBREL
03200 PUSHJ PP,XCEED
03300 SETZM 1(TX)
03400 MOVEI BYTEX,1(TX)
03500 HRLI BYTEX,(POINT 6,0,5)
03600 MOVEI C,1
03700 TLNE IO,IODEF
03800 TRC C,3
03900 DPB C,[POINT 6,1(TX),5]
04000 MOVE C,LINE
04100 LSH C,1
04200 TLZN IO,IODEF
04300 IORI C,1
04400 HRLM LINE,2(SX)
04500 HRRM TX,2(SX)
04600 JRST STV12
04700
04800 STV10: LDB C,[POINT 17,2(SX),17]
04900 HRRZ TX,2(SX)
05000 CAME C,LINE
05100 JRST STV10A
05200 LDB TEMP,[POINT 6,1(TX),5]
05300 TLNN IO,IODEF
05400 JRST STV10B
05500 TROE TEMP,2
05600 POPJ PP,
05700 JRST STV10C
05800 STV10B: TROE TEMP,1
05900 POPJ PP,
06000 JRST STV10C
06100 STV10A: MOVEI TEMP,1
06200 TLNE IO,IODEF
06300 TRC TEMP,3
06400 STV10C: DPB TEMP,[POINT 6,1(TX),5]
06500 STV10D:
06600 DPB LINE,[POINT 17,2(SX),17]
06700 LSH LINE,1
06800 TLZN IO,IODEF
06900 IORI LINE,1
07000 LSH C,1
07100 SUBM LINE,C
07200 LSH LINE,-1 ;NOW ELIMINATE DEFINE BIT
07300 MOVE BYTEX,0(TX)
07400
07500 STV12: ORM FLAG,2(SX)
07600 CAIGE C,↑D32
07700 JRST STV20
07800 MOVEM PP,PPTEMP
07900
08000 STV14: IDIVI C,↑D32
08100 PUSH PP,CS
08200 CAIL C,↑D32
08300 JRST STV14
08400 STV16: TRO C,40
08500 PUSHJ PP,STV20
08600 POP PP,C
08700 CAME PP,PPTEMP
08800 JRST STV16
08900
09000 STV20: TRNE BYTEX,1
09100 CAML BYTEX,[POINT 6,,16]
09200 JRST STV22
09300 HRRM FREE,0(BYTEX)
09400 MOVE BYTEX,FREE
09500 HRLI BYTEX,(POINT 6,,)
09600 ADDI FREE,2
09700 CAML FREE,JOBREL
09800 PUSHJ PP,XCEED
09900
10000 STV22: IDPB C,BYTEX
10100 MOVEM BYTEX,0(TX)
10200 POPOUT: POPJ PP,
00100 GETVAL: TLZN IO,IODEF
00200 JRST GETV20
00300 MOVEI C,"#"
00400 PUSHJ PP,WRITE
00500 GETV20: CAMN BYTEX,BYTEM
00600 POPJ PP,
00700 AOS 0(PP)
00800 PUSHJ PP,TABOUT
00900 MOVEI C,0
01000 GETV10: TRNE BYTEX,1
01100 CAML BYTEX,[POINT 6,,16]
01200 JRST GETV12
01300 MOVE BYTEX,0(BYTEX)
01400 HRLI BYTEX,(POINT 6,,)
01500
01600 GETV12: ILDB CS,BYTEX
01700 ROT CS,-5
01800 LSHC C,5
01900 JUMPN CS,GETV10
02000 TRNN C,1 ;SET DEFINED FLAG
02100 TLO IO,IODEF
02200 LSH C,-1
02300 ADDB LINE,C
02400 POPJ PP,
00100 TABOUT: MOVEI C,11
00200 SOJGE WPL,WRITE0
00300 PUSHJ PP,LINOUT
00400 JRST TABOUT
00500
00600 LINOUT: SOSG LPP
00700 TLO IO,IOPAGE
00800 MOVEI C,15
00900 PUSHJ PP,WRITE
01000 MOVEI C,12
01100 PUSHJ PP,WRITE
01200 MOVEI WPL,.WPL
01300 POPJ PP,
01400
01500 WRITE0: TLZN IO,IOPAGE
01600 JRST WRITE
01700 PUSH PP,C
01800 MOVEI C,14
01900 PUSHJ PP,WRITE
02000 MOVEI C,.LPP
02100 MOVEM C,LPP
02200 POP PP,C
02300
02400 WRITE: SOSG LSTBUF+2
02500 PUSHJ PP,DMPLST
02600 IDPB C,LSTBUF+1
02700 POPJ PP,
00100 XCEED:
00200 PUSH PP,1
00300 HRRZ 1,JOBREL ;GET CURRENT TOP
00400 MOVEI 1,2000(1)
00500 XCEED2: HRROI RC,[SIXBIT /INSUFFICIENT CORE@/]
00600 CORE 1, ;REQUEST MORE CORE
00700 JRST ERRFIN ;ERROR, BOMB OUT
00800 POP PP,1
00900 POPJ PP,
01000
00100 FINIS: TLZN IO,IOEOF ;END OF FILE SEEN?
00200 JRST RECYCL ;NO, RECYCLE
00300 TLNE IO,IORPG
00400 JRST RPGFN
00500 PUSHJ PP,CRLF
00600 PUSHJ PP,CRLF
00700 MOVE C,FREE
00800 LSH C,-↑D10
00900 ADDI C,1
01000 IDIVI C,↑D10
01100 JUMPE C,FINIS1
01200 ADDI C,"0"
01300 PUSHJ PP,TYO
01400 FINIS1: MOVEI C,"0"(CS)
01500 PUSHJ PP,TYO
01600 HRROI RC,[SIXBIT /K CORE@/]
01700 PUSHJ PP,TYPMS1
01800
01900 RPGFN: CLOSE LST,
02000 PUSHJ PP,TSTLST ;YES, TEST FOR ERRORS
02100 RELEAS LST,
02200 CLOSE CHAR,
02300 RELEAS CHAR,
02400 TLNN IO,IORPG
02500 JRST CREF ;RETURN FOR NEXT ASSEMBLY
02600 RELEAS CTL,0
02700 MOVE C,SVJFF
02800 MOVEM C,JOBFF
02900 MOVSI IO,IOPAGE!IOMAC!IOSYM!IORPG
03000 RPGFN2: PUSHJ PP,TTYIN
03100 CAIG C,15
03200 CAIGE C,12
03300 SKIPA
03400 JRST RPGFN2
03500 MOVSI C,70000
03600 ADDM C,CTIBU2+1
03700 AOS CTIBU2+2
03800 JRST RETRPG
00100 INSET: PUSHJ PP,NAME1 ;GET NEXT COMMAND NAME
00200 SKIPN ACDEV
00300 MOVSI ACDEV,(SIXBIT /DSK/)
00400 MOVEM ACDEV,INDEV ;STORE DEVICE
00500 SKIPN ACFILE
00600 MOVE ACFILE,[SIXBIT /CREF/]
00700 MOVEM ACFILE,INDIR ;STORE FILE IN DIRECTORY
00800 PUSHJ PP,INDEVI
00900 TLZE TIO,TIORW ;REWIND?
01000 MTAPE CHAR,1 ;YES
01100 JUMPGE CS,INSET2
01200 MTAPE CHAR,17
01300 MTAPE CHAR,17
01400 AOJL CS,.-1
01500 WAIT CHAR,
01600 STATO CHAR,1B24
01700 MTAPE CHAR,16
01800 INSET2: SOJGE CS,.-1
01900
02000 INSET3: INBUF CHAR,2
02100 JUMPN ACEXT,INSET4 ;TAKE USER'S EXTENSION IF NON-BLANK
02102 IFN STANSW,<MOVSI ACEXT,(SIXBIT /LST/) ;STANFORD DEFLT.>
02200 IFE STANSW,< MOVSI ACEXT,(SIXBIT /CRF/)> ;BLANK, TRY .TMP FIRST
02300 PUSHJ PP,INSETI
02400 INSET4: PUSHJ PP,INSETI
02500 JUMPE ACEXT,ERRCF ;ERROR IF ZERO
02600 POPJ PP,
02700
02800 INSETI: HLLM ACEXT,INDIR+1 ;STORE EXTENSION
02900 LOOKUP CHAR,INDIR
03000 TDZA ACEXT,ACEXT ;CLEAR EXTENSION IF NOT FOUND
03100 AOS 0(PP) ;SKIP-RETURN IF FOUND
03200 POPJ PP,
00100 NAME1: SETZB ACDEV,ACFILE
00200 SETZB ACEXT,ACDEL
00300 SETZB TIO,CS
00400
00500 NAME3: MOVSI ACPNTR,(POINT 6,AC0) ;SET POINTER
00600 TDZA AC0,AC0 ;CLEAR SYMBOL
00700
00800 SLASH: PUSHJ PP,SW0
00900 GETIOC: PUSHJ PP,TTYIN ;GET INPUT CHARACTER
01000 CAIN C,"/"
01100 JRST SLASH
01200 CAIN C,"("
01300 JRST SWITCH
01400 CAIN C,":"
01500 JRST DEVICE
01600 CAIN C,"."
01700 JRST NAME
01800 CAIE C,"←"
01900 CAIG C,15
02000 JRST TERM
02100 CAIN C,"["
02200 JRST PROGNP ;GET PROGRAMER NUMBER PAIR
02300 SUBI C,40 ;CONVERT TO 6-BIT
02400 TLNE ACPNTR,770000 ;HAVE WE STORED SIX BYTES?
02500 IDPB C,ACPNTR ;NO, STORE IT
02600 JRST GETIOC ;GET NEXT CHARACTER
02700
02800 DEVICE: SKIPA ACDEV,AC0 ;DEVICE NAME
02900 NAME: MOVE ACFILE,AC0 ;FILE NAME
03000 MOVE ACDEL,C ;SET DELIMITER
03100 JRST NAME3 ;GET NEXT SYMBOL
03200
03300 TERM: CAIE ACDEL,":" ;IF PREVIOUS DELIMITER
03400 CAIN ACDEL,0 ;ASSUME FILE NAME IF NOTHING ELSE
03500 MOVE ACFILE,AC0 ;SET FILE
03600 CAIN ACDEL,"." ;IF PERIOD,
03700 HLLZ ACEXT,AC0 ;SET EXTENSION
03800 POPJ PP, ;EXIT
00100 PROGNP: JUMPL PP,PROGN2 ;ERROR IF OUTPUT
00200 ERRCM: HRROI RC,[SIXBIT /COMMAND ERROR@/]
00300 JRST ERRFIN
00400
00500 PROGN1: HRLZM RC,INDIR+3 ;COMMA, STORE LEFT HALF
00600 PROGN2: MOVEI RC,0 ;CLEAR AC
00700 PROGN3: PUSHJ PP,TTYIN
00800 CAIN C,","
00900 JRST PROGN1 ;STORE LEFT HALF
01000 HRRM RC,INDIR+3 ;ASSUME TERMINAL
01100 CAIN C,"]"
01200 JRST GETIOC ;YES, RETURN TO MAIN SCAN
01300 LSH RC,3 ;SHIFT PREVIOUS RESULT
01400 ADDI RC,-"0"(C) ;ADD IN NEW NUMBER
01500 JRST PROGN3 ;GET NEXT CHARACTER
00100 SWITCH: PUSHJ PP,TTYIN
00200 CAIL C,"0"
00300 CAILE C,"9"
00400 JRST SWIT1
00500 PUSHJ PP,GETLIM
00600 CAIE C,","
00700 JRST SWIT2
00800 MOVEM RC,LOWLIM
00900 PUSHJ PP,TTYIN
01000 PUSHJ PP,GETLIM
01100 CAIE C,")"
01200 JRST ERRCM
01300 MOVEM RC,UPPLIM
01400 CAMGE RC,LOWLIM
01500 TLO IO,IONCRF
01600 JRST GETIOC
01700
01800 SWIT2: CAIN C,")"
01900 JRST GETIOC
02000 MOVE FREE,RC
02100 PUSHJ PP,SW1
02200 JRST SWITCH
02300
02400 SWIT1: CAIN C,")"
02500 JRST GETIOC
02600 PUSHJ PP,SW1
02700 PUSHJ PP,TTYIN
02800 JRST SWIT1
02900
03000 GETLIM: TDZA RC,RC
03100 GETLI1: PUSHJ PP,TTYIN
03200 CAIL C,"0"
03300 CAILE C,"9"
03400 POPJ PP,
03500 IMULI RC,↑D10
03600 ADDI RC,-"0"(C)
03700 JRST GETLI1
03800
03900 SW0: PUSHJ PP,TTYIN
04000 SW1: MOVEI C,-"A"(C) ;CONVERT FROM ASCII TO NUMERIC
04100 CAILE C,"Z"-"A" ;WITHIN BOUNDS?
04200 JRST ERRCM ;NO, ERROR
04300 MOVE RC,[POINT 4,BYTAB]
04400 IBP RC
04500 SOJGE C,.-1 ;MOVE TO PROPER BYTE
04600 LDB C,RC ;PICK UP BYTE
04700 JUMPE C,ERRCM ;TEST FOR VALID SWITCH
04800 CAIG C,SWTABT-SWTAB ;LEGAL ON SOURCE?
04900 JUMPL PP,ERRCM ;NO, TEST FOR SOURCE
05000 XCT SWTAB-1(C) ;EXECUTE INSTRUCTION
05100 POPJ PP, ;EXIT
00100 DEFINE SETSW (LETTER,INSTRUCTION) <
00200 INSTRUCTION
00300 J= <"LETTER"-"A">-↑D9*<I=<"LETTER"-"A">/↑D9>
00400 SETCOD \I,J>
00500
00600 DEFINE SETCOD (I,J)
00700 <BYTAB'I=BYTAB'I!<.-SWTAB>B<4*J+3>>
00800
00900 BYTAB0= 0 ;INITIALIZE TABLE
01000 BYTAB1= 0
01100 BYTAB2= 0
01200
01300 SWTAB:
01400 SETSW Z,<TLO TIO,TIOCLD >
01500 SWTABT:
01600 SETSW A,<ADDI CS,1 >
01700 SETSW B,<SUBI CS,1 >
01800 SETSW K,<TLZ IO,IOSYM >
01900 SETSW L,<MOVEM FREE,LOWLIN>
02000 SETSW M,<TLZ IO,IOMAC >
02100 SETSW O,<TLO IO,IOOP >
02200 SETSW S,<TLO IO,IOLST!IOLSTS >
02300 SETSW T,<TLO TIO,TIOLE >
02400 SETSW U,<MOVEM FREE,UPLIN>
02500 SETSW W,<TLO TIO,TIORW >
02600
02700 BYTAB:
02800 +BYTAB0
02900 +BYTAB1
03000 +BYTAB2
00100 TTYIN: TLNE IO,IORPG
00200 JRST RPGIN
00300 ILDB C,CTIBUF+1 ;GET CHARACTER
00400 TTYIN2: CAIE C," " ;SKIP BLANKS
00500 CAIN C," " ;AND TABS
00600 JRST TTYIN
00700 POPJ PP, ;NO, EXIT
00800
00900 TYPMSG: PUSHJ PP,CRLF ;MOVE TO NEXT LINE
01000 TYPMS1: HLRE CS,RC ;GET FIRST MESSAGE
01100 JUMPL CS,TYPM1 ;BRANCH IF NEGATIVE
01200 PUSHJ PP,TYPM2 ;TYPE MESSAGE
01300 TYPM1: HRRZ CS,RC ;GET SECOND HALF
01400 PUSHJ PP,TYPM2
01500
01600 CRLF: MOVEI C,15 ;OUTPUT CARRIAGE RETURN
01700 PUSHJ PP,TYO
01800 MOVEI C,12 ;AND LINE FEED
01900
02000 TYO: SOSG CTOBUF+2 ;BUFFER FULL?
02100 OUTPUT CTL,0 ;YES, DUMP IT
02200 IDPB C,CTOBUF+1 ;STORE BYTE
02300 CAIE C,14 ;FORM FEED?
02400 CAIN C,12 ;OR LINE FEED?
02500 OUTPUT CTL,0 ;YES
02600 POPJ PP, ;AND EXIT
02700
02800 TYPM2: MOVSI C,(1B0) ;ANTICIPATE REGISTER WORD
02900 CAIG CS,17 ;IS IT?
03000 MOVEM C,1(CS) ;YES, STORE TERMINATOR
03100 HRLI CS,(POINT 6,,) ;FORM BYTE POINTER
03200
03300 TYPM3: ILDB C,CS ;GET A SIXBIT BYTE
03400 CAIN C,40 ;"@"?
03500 JRST TYO ;YES, TYPE SPACE AND EXIT
03600 ADDI C,40 ;NO, FORM 7-BIT ASCII
03700 PUSHJ PP,TYO ;OUTPUT CHARACTER
03800 JRST TYPM3
03900
04000 RPGIN: SOSG CTIBU2+2
04100 JRST CKRPGI
04200 RPGIN1: IBP CTIBU2+1
04300 MOVE C,@CTIBU2+1
04400 TRNN C,1
04500 JRST RPGIN2
04600 AOS CTIBU2+1
04700 MOVNI C,5
04800 ADDM C,CTIBU2+2
04900 JRST RPGIN
05000 RPGIN2: LDB C,CTIBU2+1
05100 JUMPE C,RPGIN
05200 JRST TTYIN2
05300 CKRPGI: IFN TMPCC,<
05302 SKIPE TMPCOR
05304 CALLI 12 ;ALL DONE.
05306 >
05308 IN CTL2,0
05400 JRST RPGIN1
05500 STATO CTL2,740000
05600 JRST RPGCK2
05700 HRROI RC,[SIXBIT /ERROR READING COMMAND FILE@/]
05800 JRST ERRFIN
05900 RPGCK2: SETZM CMDDIR
06000 SETZM CMDDIR+3 ;GET RID OF PPN
06100 RENAME CTL2,CMDDIR
06200 HALT
06300 CALLI 12
00100 ERRCE: SKIPA RC,[XWD [SIXBIT /CANNOT ENTER FILE@/],ACFILE]
00200
00300 ERRCF: MOVE RC,[XWD [SIXBIT /CANNOT FIND@/],ACFILE]
00400
00500 ERRFIN: PUSHJ PP,TYPMSG
00600 RELEAS CTL,
00700 JRST CREF
00100 READ: SOSG INBUF+2 ;BUFFER EMPTY?
00200 JRST READ3 ;YES
00300 READ1: ILDB C,INBUF+1 ;PLACE CHARACTER IN C
00400 JUMPE C,READ
00500 POPJ PP,
00600
00700 READ3: INPUT CHAR,0 ;GET NEXT BUFFER
00800 STATO CHAR,762000 ;ERROR?
00900 JRST READ1 ;NO, GET CHARACTER
01000 TLO IO,IOEOF ;FLAG EOF SEEN
01100 STATO CHAR,742000
01200 JRST R0
01300 MOVE AC0,INDEV
01400 MOVSI RC,[SIXBIT /INPUT ERROR ON DEVICE@/]
01500 JRST ERRFIN
00100 DMPLST: OUTPUT LST,0 ;OUTPUT BUFFER
00200 TSTLST: STATO LST,740000 ;ANY ERRORS?
00300 POPJ PP, ;NO, EXIT
00400 MOVE AC0,LSTDEV
00500 ERRLST: MOVSI RC,[SIXBIT /DATA ERROR DEVICE@/]
00600 JRST ERRFIN
00100 LSTINI: INIT LST,AL ;LIST IN ASCII LINE MODE
00200 LSTDEV: BLOCK 1
00300 XWD LSTBUF,0
00400 JRST EINIT ;ERROR EXIT
00500 POPJ PP, ;GOOD EXIT
00600
00700 INDEVI: INIT CHAR,A
00800 INDEV: BLOCK 1
00900 XWD 0,INBUF
01000 INDEVE: SKIPA ACDEV,INDEV ;ERROR, SKIP AND SET ACDEV
01100 POPJ PP,
01200 EINIT: MOVE RC,[XWD ACDEV,[SIXBIT /NOT AVAILABLE@/]]
01300 JRST ERRFIN
00100 SVJFF: 0
00200 CTIBU2: BLOCK 3
00300 CMDDIR: BLOCK 4
00400 STCLR:
00500 PPSET: BLOCK .PP
00600
00700 CTIBUF: BLOCK 3
00800 CTOBUF: BLOCK 3
00900
01000 INBUF: BLOCK 3
01100
01200 INDIR: BLOCK 4
01300
01400 LSTBUF: BLOCK 3
01500 LSTDIR: BLOCK 4
01600 LPP: BLOCK 1
01700
01800 PPTEMP: BLOCK 1
01900 OPTBL: BLOCK HASH
02000 SYMTBL: BLOCK HASH
02100 MACTBL: BLOCK HASH
02200
02300 LOWLIN: BLOCK 1
02400 LOWLIM: BLOCK 1
02500 UPPLIM: BLOCK 1
02600 UPLIN: BLOCK 1
02700 LEVEL: 0
02800 SVLAB: 0
02900 BLKST: 0
03000 BLKND: 0
03100
03200 ENDCLR= .-1
00100 END CREF