Trailing-Edge
-
PDP-10 Archives
-
decuslib20-02
-
decus/20-0040/cobstd.old
There is 1 other file named cobstd.old in the archive. Click here to see a list.
A=1
ST: CALLI 0
MOVEI 10,0
SETZ 14,
INIT 0,A
SIXBIT/DSK/;INIT DSK FOR I/P
XWD IBUF
JRST ERR1
INIT 1,A
SIXBIT/DSK/;INIT DSK FOR O/P
XWD OBUF,
JRST ERR1
CALLI 1,24;P.P.NO. IN ACC1
MOVEM 1,E+3
TTCALL 3,[ASCIZ "
NAME OF COBOL FILE TO BE STANDARDIZED?"]
MOVE P1,[POINT 6,E]
TTCALL 11,;CLEAR TYPEOUT BUFFER
NAME: TTCALL 0,3
CAIN 3,15
JRST .+4
SUBI 3,40
IDPB 3,P1
JRST NAME
TTCALL 3,[ASCIZ "
NAME STANDARDIZED COBOL FILE IS TO BE CALLED?
"]
MOVE P2,[POINT 6,E1]
TTCALL 11,
OUTNAM: TTCALL 0,3
CAIN 3,15
JRST .+4
SUBI 3,40
IDPB 3,P2
JRST OUTNAM
TTCALL 3,[ASCIZ "
"]
TTCALL 3,[ASCIZ "IF YOU WANT TO KEEP YOUR ORIGINAL
INDENTATIONS TYPE Y ELSE TYPE N
Y OR N?"]
TTCALL 11,
TTCALL 0,1
TTCALL 3,[ASCIZ "
"]
LOOKUP 0,E;LOOKUP FILE
JRST ERR2
ENTER 1,E1;ENTER FILE
JRST ERR3
JSR GETLIN
MOVEI 7,0
MOVEI 2,IDEN
JSR COMPAR
JSR OUTRT;O/P 7 SPACES & LINE
JSR GETLIN
CAIE 7,0
JRST NOTID
DIVENV: MOVEI 2,ENV;NOW THE ENVIROMENT DIV.
JSR COMPAR
CAIE 7,0
JRST NOTENV
JSR OUTRT
JSR GETLIN
DIVDAT:MOVEI 2,DATA
JSR COMPAR
CAIE 7,0
JRST NOTDAT
JSR OUTRT
JSR GETLIN
PRODIV: MOVEI 2,PROCED
JSR COMPAR
CAIE 7,0
JRST NOTPD
JSR OUTRT
FINAL:JSR GETLIN
MOVE P1,[POINT 7,WB1]
MOVE P2,[POINT 7,WB2]
ILDB 5,P1
IDPB 5,P2
CAIE 5,12;SKIP IF L.F.
JRST FINAL+3
JSR LABSEC
JRST FINAL
NOTPD: SETZ 7,
MOVEI 2,FILSEC
JSR COMPAR
CAIE 7,0
JRST WSSEC;NOT FILE SEC.
JSR OUTRT;O/P F.S.
MOVEI 7,0
JSR GETLIN
JRST PRODIV
WSSEC: MOVEI 2,WORKS
SETZ 7,
JSR COMPAR
CAIE 7,0
JRST ODDS
JSR OUTRT
MOVEI 7,0
JSR GETLIN
JRST PRODIV
ODDS: MOVE P1,[POINT 7,WB2]
ILDB 5,P1
CAIN 5,106;SKIP IF NOT F
JRST FD;IF F TEST FOR FD
CAIN 5,60;SKIP IF NOT 0
JRST LEVEL;IF 0 TEST FOR LEVEL
CAIN 5,123;SKIP IF S
JRST .+3;IF S TEST FOR SD
JSR LABSEC
JRST BACK
ILDB 5,P1
CAIE 5,104;SKIP IF D
JRST .+5;ORDINARY LINE
JSR OUTRT
BACK: SETZ 7,
JSR GETLIN
JRST PRODIV
JSR LABSEC
JRST BACK
FD: ILDB 5,P1
CAIE 5,104;SKIP IF FD
JRST BACK+3
JRST BACK-1
LEVEL: ILDB 5,P1
CAIE 5,61;SKIP IF LEVEL
JRST BACK+3
JRST BACK-1
COMPAR: 0;COMPARE WB1
MOVE P1,[POINT 7,(2)]
MOVE P2,[POINT 7,WB1]
MOVE P3,[POINT 7,WB2]
NEXT: ILDB 5,P2
IDPB 5,P3
CAIN 5,15;SKIP IF NOT C.R.
JRST KNOT
ILDB 6,P1
CAMN 5,6;SKIP IF NOT =
JRST MAY;TRY NEXT BYTES
MOVEI 7,1;SET SWITCH
FLIN: ILDB 5,P2
IDPB 5,P3
CAIE 5,12;SKIP IF L.F.
JRST FLIN
JRST @ COMPAR;O/P LINE
CAR: ILDB 5,P2
IDPB 5,P3
JRST @COMPAR
KNOT: ILDB 5,P2
IDPB 5,P3
MOVEI 7,1
JRST @COMPAR
MAY: ILDB 5,P2
CAIE 5,15
JRST .+3
IDPB 5,P3
JRST CAR
ILDB 6,P1
CAME 5,6
JRST .+3;NOT =
IDPB 5,P3
JRST MAY
CAIE 6,0
JRST FLIN-1;NOT NULL SO NOT =
ILDB 5,P2
CAIE 5,15
JRST .-2;NOT C.R.
IDPB 5,P3
JRST CAR
OUTRT: 0
SETZ 13,
MOVE P3,[POINT 7,WB2]
ILDB 5,P3
CAIN 5,40
JRST TEST
MOVEI 7,1
MOVEI 4,0
MOVEI 3,40;SPACE
JSR PUT
IDPB 3,OBUF+1;O/P SPACE
ADDI 13,1
ADDI 4,1
CAIE 4,7;SKIP IF 7 SPACES O/P
JRST OUTRT+9
MOVEI 7,0
CHAR: CAIN 5,15
JRST .+6
JSR PUT
IDPB 5,OBUF+1
ADDI 13,1
ILDB 5,P3
JRST CHAR
JSR PUT
IDPB 5,OBUF+1
ADDI 13,1
MOVEI 5,12
JSR PUT
IDPB 5,OBUF+1
ADDI 13,1
CAIL 13,110
ADDI 14,1
JRST @ OUTRT
TEST: MOVEI 4,1
ILDB 5,P3;2ND. BYTE
ADDI 4,1
CAIE 4,7
JRST TEST+1
CAIE 5,52;SKIP IF *
JRST INDENT
MOVE P3,[POINT 7,WB2]
JRST CHAR
INDENT: JSR OUTORD
JRST @OUTRT
NOTID: MOVEI 7,0;RESET COUNT
JSR COMPAR;TRY AGAIN
JSR OUTRT
JSR GETLIN
CAIN 7,0
JRST DIVENV
JRST NOTID
NOTENV:JSR OUTRT
JSR GETLIN
MOVEI 7,0
JSR COMPAR
CAIE 7,0
JRST NOTENV
JSR OUTRT
JSR GETLIN
JRST DIVDAT
NOTDAT: JSR LABSEC
MOVEI 7,0
JSR GETLIN
JRST DIVDAT
LABSEC:0
MOVE P1,[POINT 7,WB2]
ILDB 5,P1
CAIN 5,56;SKIP IF NOT .
JRST LABEL
CAIN 5,40
JRST SPAC;= SPACE SO TEST FOR SECTION
JRST LABSEC+2;TRY NEXT BYTE
LABEL: SETZ 7,
MOVEI 2,EX
MOVE P1,[POINT 7,WB2]
MOVE P2,[POINT 7,(2)]
ILDB 5,P1
CAIN 5,15
JRST .+6
ILDB 6,P2
CAMN 5,6
JRST .-5;=
JSR OUTRT;NOT EXIT SO LABEL
JRST @LABSEC
JSR OUTORD
JRST @LABSEC
SPAC: MOVEI 2,SECS
MOVE P2,[POINT 7,(2)]
ILDB 5,P1
CAIN 5,15;SKIP IF NOT C.R.
JRST LABEL
ILDB 6,P2
CAMN 5,6;SKIP IF NOT =
JRST SPAC+2
CAIE 6,0
JRST .+3;NOT NULL SO NOT =
JSR OUTRT
JRST @LABSEC
JSR OUTORD
JRST @LABSEC
OUTORD:0
SETZ 13,
MOVE P1,[POINT 7,WB2]
ILDB 5,P1
CAIN 5,40;SKIP IF NOT SPACE
JRST TEST1
SETZ 7,
MOVEI 3,40
POKE: JSR PUT
IDPB 3,OBUF+1
ADDI 13,1
ADDI 7,1
CAIE 7,^D11
JRST POKE
MOVE P1,[POINT 7,WB2]
CART: ILDB 5,P1
JSR PUT
IDPB 5,OBUF+1
ADDI 13,1
CAIE 5,15;SKIP IF C.R.
JRST CART
MOVEI 5,12
JSR PUT
IDPB 5,OBUF+1
ADDI 13,1
CAIL 13,110
ADDI 14,1
JRST @OUTORD
TEST1: MOVEI 4,1
ILDB 5,P1
ADDI 4,1
CAIE 4,7
JRST TEST1+1
CAIN 5,52;SKIP IF *
JRST CART-1;=*
CAIN 1,131;SKIP IF NOT Y
JRST POKE-2
MOVE P1,[POINT 7,WB2];NOT * SO ORD. LINE WITH INDENTS.
ILDB 5,P1
CAIN 5,40
JRST .-2;=SPACE
SETZ 13,
SETZ 7,
MOVEI 3,40
OGRE: JSR PUT
IDPB 3,OBUF+1
ADDI 13,1
ADDI 7,1
CAIE 7,^D11
JRST OGRE
JSR PUT
IDPB 5,OBUF+1;NOT SPACE
ADDI 13,1
CAIN 5,12;SKIP IF NOT L.F.
JRST .+3
ILDB 5,P1
JRST .-6
CAIL 13,110
ADDI 14,1
JRST @OUTORD
E:0
SIXBIT/CBL/
0
0
E1:0
SIXBIT/CBL/
0
0
PUT: 0
SOSLE OBUF+2
JRST OK
OUT 1,
JRST OK
JRST OUTERR
OK: JRST @ PUT
GETLIN:0
MOVE P2,[POINT 7,WB1]
SOSLE IBUF+2;DECREMENT BYTE COUNT
JRST GETOK
IN 0,;GET NEXT BUF FROM MON.
JRST GETOK
STATZ 1,740000
JRST INERR
JRST INEOF;ASSUME EOF
GETOK: ILDB 5,IBUF+1;GET CH. FROM BUF
JUMPE 5,GETLIN+2
CAIN 5,52;SKIP IF *
JRST COM
CAIN 5,55;SKIP IF -
JRST COM
LINE: CAIN 5,12;SKIP IF NOT L.F.
JRST .+5
CAIN 5,11
JRST .+5
IDPB 5,P2
JRST INP
IDPB 5,P2
JRST @ GETLIN
JSR HTAB
INP: SOSLE IBUF+2;DECREMENT BYTE COUNT
JRST OKY
IN 0,
JRST OKY
STATZ 1,740000
JRST INERR
JRST INEOF
OKY: ILDB 5,IBUF+1
JRST LINE
HTAB: 0
SETZ 7,
MOVEI 5,40
IDPB 5,P2
ADDI 7,1
CAIE 7,4
JRST HTAB+3
JRST @HTAB
COM: MOVEI 3,40
SETZ 4,
IDPB 3,P2
ADDI 4,1
CAIE 4,6
JRST COM+2
CONT: IDPB 5,P2
CAIN 5,12;SKIP IF L.F.
JRST @GETLIN
ILDB 5,IBUF+1
CAIN 5,11
SKIPA
JRST CONT
JSR HTAB
JRST CONT+3
ERR1: TTCALL 3,[ASCIZ "ERR. IN INIT OF DSK"]
JRST INEOF
ERR2: TTCALL 3,[ASCIZ "ERR. IN LOOKUP OF FILE"]
JRST INEOF
ERR3: TTCALL 3,[ASCIZ "ERR. IN ENTER OF FILE"]
JRST INEOF
OUTERR: TTCALL 3,[ASCIZ "ERR. IN O/P OF FILE"]
JRST INEOF
OBUF:BLOCK 3
IBUF:BLOCK 3
WB1:BLOCK 50
WB2:BLOCK 50
IDEN:ASCIZ/IDENTIFICATION DIVISION./
ENV:ASCIZ/ENVIRONMENT DIVISION./
DATA:ASCIZ/DATA DIVISION./
FILSEC:ASCIZ/FILE SECTION./
WORKS:ASCIZ/WORKING-STORAGE SECTION./
PROCED:ASCIZ/PROCEDURE DIVISION./
EX:ASCIZ/EXIT./
SECS:ASCIZ/SECTION./
INERR: TTCALL 3,[ASCIZ "ERR. IN I/P OF FILE"]
JRST INEOF
P3=15
P2=17
P1=16
STACK:BLOCK 20
INEOF:TTCALL 3,[ASCIZ "THERE ARE "]
MOVE 17,[XWD-20,STACK]
PUSHJ 17,DECPNT
RELEAS 0,
RELEAS 1,
TTCALL 3,[ASCIZ "LINES THAT ARE TOO LONG.PLEASE CORRECT"]
CALLI 12
DECPNT:IDIVI 14,12
PUSH 17,15
SKIPE 14
PUSHJ 17,DECPNT
DECPN1:POP 17,14
ADDI 14,60
TTCALL 1,14
POPJ 17,
ENDSTp