Trailing-Edge
-
PDP-10 Archives
-
decuslib10-01
-
43,50135/bcdpip.mac
There are no other files named bcdpip.mac in the archive.
TITLE BCDPIP TRANSLATE IBM 7040 MAG TAPE TO ASCII FORMAT
SUBTTL DONALD TODD/ DEC 15,1970 /VERS 4.
PURE=1
JOBVER=137
INTERN JOBVER,PURE
EXTERN JOBSA,JOBFF,JOBOPC,JOBREN
IFNDEF PURE,<PURE=1>
IFN PURE,<HISEG>
BEG:
INIL:IFN PURE,<
MOVSI AC1,LOWE
HLLM AC1,JOBSA
>
BUFSIZ=^D2000
AC0=0
T=1
AC1=1
AC2=2
AC3=3
AC4=4
AC5=5
AC6=6
AC7=7
AC10=10
AC11=11
AC12=14
AC16=16
PSHAC=15
AC17=17
PNTAC=12
BCDPNT=13
RES: CALL [SIXBIT/RESET/] ;RESET ALL IO DEVICES
MOVEI AC1,REEN
MOVEM AC1,JOBREN
MOVE AC1,JOBFF
CALL AC1,[SIXBIT/CORE/]
JRST NOCORE ;CORE NOT AVAILABLE
MOVE AC1,[XWD LOWB,LOWB+1]
SETZM LOWB
BLT AC1,LOWE-1
AOS DOPN ;SET ASCII LINE MODE
MOVSI AC1,ASCBUF
MOVEM AC1,DOPN+2
MOVE AC1,[IOWD BUFSIZ,BCDBUF]
MOVEM AC1,BCDLST
MOVE PSHAC,[IOWD ^D20,JMPSTK]
TTCALL 1,STAR ;OUTPUT AN * TO SHOW READY
SETZ AC5, ;ZERO AC5
MOVE PNTAC,[POINT 6,DOPN+1] ;LOAD DEVICE POINTER
MOVEI AC4,":" ;SET DELIMITER
MOVEI AC0,6
PUSHJ PSHAC,PARAM ;SCAN FOR DEVICE
MOVE PNTAC,[POINT 6,ENT] ;SET POINTER TO FILE NAME
MOVEI AC0,6 ;ALLOW FOR 6 CHAR FILE NAME
MOVEI AC4,"." ;END OF FILE NAME
PUSHJ PSHAC,PARAM ;SCAN FOR FILE NAME
CAIE AC5,"." ;IS THERE AN EXTENT
JRST TDEV ;NO, SEARCH FOR INPUT DEVICE
MOVE PNTAC,[POINT 6,ENT+1] ;SET POINTER FOR ENTENT
MOVEI AC0,3 ;ALLOW FOR 3 CHAR EXTENT
MOVEI AC4,"_" ;SET DELIMETER
PUSHJ PSHAC,PARAM ;SCAN FOR EXTENT
TDEV: MOVE PNTAC,[POINT 6,TOPN+1] ;SET POINTER FOR INPUT
MOVEI AC0,6 ;ALLOW A 6 CHAR DEVICE
MOVEI AC4,":" ;SEARCH TO A :
PUSHJ PSHAC,PARAM ;PICK UP INPUT UNIT
MOVE AC1,TSTAT ;PICK UP STANDARD TAPE OPTION
SETZ AC0, ;ZERO FLAG WORD
SWITCH: SETZ AC5, ;ZERO THE INPUT BUFFER
TTCALL 4,AC5 ;IS THERE A SWITCH
CAIN AC5,15 ;C-R
JRST SETIO ;YES
CAIE AC5,"/" ;IS THER A SWITCH
JRST COMERR ;NO ERROR
TTCALL 4,AC5 ;YES READ IN SWITCH
CAIE AC5,"R" ;IS IT A REWIND
JRST .+3 ;NO, CONTINUE
TLO AC0,1 ;SET REWIND FLAG
JRST SWITCH
CAIN AC5,"D" ;IS THIS A DENSITY SWITCH
JRST DSW ;YES, PROCESS
ANDCMI AC0,7 ;ZERO THE RECORD TYPE
CAIE AC5,"T" ;IS THIS A TYPE RECORD SWITCH
JRST COMERR ;NO, ERROR RETURN
TTCALL 4,AC5 ;YES, READ IN TYPE
OR AC0,AC5 ;INSERT RECORD TYPE
JRST SWITCH ;CONTINUE PROCESSING SWITCHES
DSW: TTCALL 4,AC5 ;READ DENSITY PARAMTER
ANDI AC5,3 ;SAVE DENSITY ONLY
ANDI AC1,777177 ;SAVE INITIAL CONDITIONS
LSH AC5,7 ;POSITION DENSITY SWITCH
ORM AC5,AC1 ;INSERT IN ODPEN PARAMETER
JRST SWITCH ;CONTINUE SWITCHES
SETIO: TTCALL 4,AC5 ;DUMMY READ FOR L-F
MOVEM AC1,TOPN ;SAVE DENSITY
OPEN 1,DOPN ;OPEN OUTPUT DEVICE
JRST ODEVER ;NO OUTPUT UNIT
ENTER 1,ENT ;ENTER THE FILE NAME IN THE DIRECTORY
JRST ODEVER ;FILE IS IN USE
MOVE AC3,TOPN+1 ;LOAD OUTPUT DEVICE
CALL AC3,[SIXBIT/DEVCHR/]
TLNN AC3,20 ;IS THIS MAG TAPE
JRST IDEVER
OPEN 2,TOPN ;OPEN THETINPUT DEVICE
JRST IDEVER ;INPUT DEVICE NOT AVAILABLE
TLZN AC0,1 ;IS A REWIND REQUESTED
JRST .+3 ;NO CONTINUE
MTAPE 2,1 ;YES REWIND THE MAG TAPE
MTAPE 2,0 ;WAIT FOR THE OPERATION TO COMPLETE
GETSTS 2,AC17 ;PICK UP TAPE POSITION
TRNE AC17,4000 ;IS THIS BOT
TLO AC0,1 ;YES SET BOT FLAG
MOVE BCDPNT,[POINT 6,BCDBUF] ;INILIZE DUMMY BCD POINTER
SETZM BCDBUF ;SHOW BUFFER EMPTY
SETSTS 2,@TOPN
CONV: PUSHJ PSHAC,BCDIN ;READ THE 7040 BUFFE
TRANS: ILDB AC10,BCDPNT ;LOAD BCD CHARACTER
JUMPE AC10,ICR ;IS THIS THE END OF THE BUFFER
MOVE AC5,CTAB(AC10)
PUSHJ PSHAC,ASCOUT ;DEPOSITE ASCII CHARACTER IN OUTPUT BUFFER
SOJG AC11,TRANS ;CONTINUE UNTIL THE BUFFE IS EMPTY
ICR: MOVEI AC5,15 ;INSERT A C-R
PUSHJ PSHAC,ASCOUT ;OUTPUT C-R
MOVEI AC5,12 ;INSERT A L-F
PUSHJ PSHAC,ASCOUT ;OUTPUT L-F
AOS LRCT ;UPDATE LOGICAL RECORD COUNT
JRST CONV ;CONTINUE ON NEST BUFFER
BCDIN: ;LOGICAL READ FOR 7040 MAG TAPE
TRNE AC0,2 ;IS THIS A TYPE 2 OR 3 RECORD
JRST TYPE2 ;YES PROCESS TYPE 2-3
PUSHJ PSHAC,RBCD ;TYPE1 READ THE BUFFER
AOS PRCT ;UPDATE PHYSICAL RECORD COUNT
MOVEI AC11,6*BUFSIZ ;SET MAX CHARACTER COUNT
POPJ PSHAC,BCDIN ;RETURN
TYPE2:TYPE3:
ILDB AC6,BCDPNT ;LOAD FIRST BYTE OF DATA OR CONTROL WOR
MOVEI AC7,4 ;SET CONVERT COUNT TO 4
SETZ AC11, ;SET CHARACTER TO ZERO
JUMPN AC6,.+4 ;IS THIS BUFFE EMPTY
PUSHJ PSHAC,RBCD ;EMPTY BUFFE READ THE NEXT
AOS PRCT
ILDB AC6,BCDPNT ;LOAD NEW BYTE
CAIN AC6,12 ;IS THIS A 7040 ZERO
JRST .+3 ;YES SKIP THIS DIGIT
IMUL AC6,DECTAB(AC7) ;MULTIPLY BY DIGIT FACTOR
ADD AC11,AC6 ;ACCUMLATE THE PARTICAL SUMS
SOJGE AC7,.-5 ;CONTINUE
IBP ,BCDPNT ;SKIP THE CONTROL CHARACTER
SUBI AC11,6 ;SKIP THE 7040 CONTROL WORD
POPJ PSHAC,BCDIN ;RETURN
RBCD: ;PHYSICAL READ OF BCD MAG TAPE
SETZ AC17,
SETZM BCDBUF ;SET FOR ZERO OF BUFFER
MOVE BCDPNT,[XWD BCDBUF,BCDBUF+1] ;POINTER TO ZERO BUFFER
BLT BCDPNT,BCDBUF+BUFSIZ-1 ;ZERO THE BUFFER
MOVE BCDPNT,[POINT 6,BCDBUF] ;LOAD BCD BYTE POINTER
INPUT 2,BCDLST ;READ BCD FILE
GETSTS 2,AC17 ;PICK UP ERROR CODES
TRNE AC17,740000 ;IS THIS A PARITY ERROR
JRST PERR ;YES KILL THE JOB
TRNE AC17,20000 ;EOF
JRST .+3 ;YES
TLNN AC0,3 ;EXPECTED EOF OR HEADER CHECK
POPJ PSHAC, ;RETURN
TLZE AC0,1 ;IS THEIS BEGGING
JRST .+4 ;YES CHECK FOR HEADER
TLZN AC0,2 ;YES EOF WAS IT EXPECTED
JRST BCDEOF ;NO, EXIT TO BCDEOF
JRST RBCD ;YES, READ NEST RECORD
MOVE AC16,BCDBUF ;PICK UP FIRST WORD FOR HEADER CHECK
ANDCMI AC16,7777 ;SAVE ONLY FIVE CHARACTER
CAME AC16,[OCT 017064510000] ;IS THIS A HEADER RECORD
POPJ PSHAC,RBCD ;NO RETURN
HRLI AC0,2 ;HEADER RECORD SET EOF
JRST RBCD ;GO READ EOF
BCDEOF: CLOSE 1,2 ;CLOSE THE OUTPUT FILE
RELEAS 1, ;RELEASE THE OUTPUT UNIT
RELEAS 2, ;RELEASE THE MAG TAPE UNIT FOR INPUT
TTCALL 3,LOGMSG
MOVE T,LRCT
PUSHJ PSHAC,COVTYP
TTCALL 3,PHYMSG
MOVE T,PRCT
PUSHJ PSHAC,COVTYP
TTCALL 3,CRMSG
JRST RES ;LOOK FOR ANOTHER COMMAND
COVTYP: IDIVI T,12
PUSH PSHAC,T+1
SKIPE T
PUSHJ PSHAC,.-3
POP PSHAC,T
ADDI T,60
TTCALL 1,T ;OUTPUT A DIGIT
POPJ PSHAC,
PARAM: ;ROUTINE TO SEARCH AND CONVERT TO SIXBIT
SETZ AC5, ;CLEAR OUT THE GARBAGE
TTCALL 4,AC5 ;READ A CHARACTER
CAIN AC5,"_" ;IS THIS THE END
POPJ PSHAC,PARAM ;RETURN TO CALLER
CAMN AC5,AC4;IS THIS = TO SPECIAL DELIMITER
POPJ PSHAC,PARAM ;YES RETURN TO CALLER
CAIN AC5,15 ;IS THIS A C-R
JRST CLF ;YES CLEAR L-F
SUBI AC5,40 ;CONVERT TO SIXBIT CODE
SOJL AC0,.+2 ;SKIP IF END OF LIST
IDPB AC5,PNTAC ;SAVE THIS BYPE
JRST PARAM ;RETURN FOR NEST CHARACTER
CLF: TTCALL 4,AC5 ;CLEAR THE L-F CHARACTER
JUMPL AC0,.+2 ;BAD PARAMETER LISR
POPJ PSHAC,PARAM ;RETURN
COMERR: TTCALL 3,COMMSG ;INVALID COMMAND STRING
JRST RES ;RETURN FOR ANOTHER TYY
COMMSG: ASCIZ /COMMAND ERROR
/
ASCOUT: ;OUTPUT ASCII CHARACTER TO DEVICE
SOSG ASCBUF+2 ;INCREMENT BYTE COUNT
PUSHJ PSHAC,ASC01
IDPB AC5,ASCBUF+1 ;DEPOSIT THE ASCII CHARACTER
CAIN AC5,12 ;IS THIS A LINE FEED
TRZN AC0,2000 ;ARE WE FORCING EOT
POPJ PSHAC, ;NO RETURN
OUTPUT 1, ;OUTPUT A PARTICAL BUFFER
JRST ASC02 ;CLOSE OUT THE FILE
ODEVER: TTCALL 3,OERR ;NO OUTPUT UNIT
JRST RES
ASC01:
OUTPUT 1,
GETSTS 1,AC17
TRZE AC17,2000
TRO AC0,2000
POPJ PSHAC,
ASC02: CLOSE 1,0
MTAPE 1,0
MTAPE 1,1
MTAPE 1,0
TTCALL 3,EOTMSG
TTCALL 0,AC12 ;READ A CHARACTER
CAIE AC12,"C"
JRST .-2
POPJ PSHAC,
REEN: TRO AC0,2000
JRST 2,@JOBOPC
EOTMSG: ASCIZ /
EOF - REPLACE OUTPUT TAPE - TYPE "C" TO CONTINUE
/
OERR: ASCIZ /OUTPUT UNIT NOT AVAILABLE OR FILE NAME ILLEGAL
/
IDEVER: TTCALL 3,IERR ;NO INPUT UNIT
JRST RES ;TRY AGAIN
IERR: ASCIZ /INPUT UNIT NOT AVAILABLE
/
PERR: TTCALL 3,PMSG ;PARITY ERROR ON INPUT TAPE
JRST BCDEOF ;TRY AGAIN
PMSG: ASCIZ /INPUT UNREADABLE - OUTPUT SAVED
/
NOCORE: TTCALL 3,CMSG ;NO CORE LEFT
CALL [SIXBIT/EXIT/]
CMSG: ASCIZ / PHYSICAL CORE NOT LARGE ENOUGH RESTART
/
LOGMSG: ASCIZ /LOGICAL RECORDS: /
PHYMSG: ASCIZ / PHYSICAL RECORDS: /
CRMSG: ASCIZ /
/
CTAB: OCT 77,61,62,63,64,65,66,67
OCT 70,71,60,75,47,72,76,134
OCT 40,57,123,124,125,126,127,130
OCT 131,132,73,54,50,42,43,45
OCT 55,112,113,114,115,116,117,120
OCT 121,122,72,44,52,133,76,46
OCT 53,101,102,103,104,105,106,107
OCT 110,111,77,56,51,135,74,41
PAPTAB: OCT 20,40,1,2,3,4,5,6,7,10
OCT 153,100,32,112,16,117,127,54
DECTAB: EXP ^D1,^D10,^D100,^D1000,^D10000
TSTAT: EXP 1657 ;STANDARD MAG TAPE PARAMS
STAR: 52 ;OUTPUT AN *
LIT
IFN PURE,<LOC 140>
;
;
;
;
;
; LOW SEG BUFFERS AND STORAGE
;
;
;
;
LOWB:
TOPN: BLOCK 3
DOPN: BLOCK 3 ;ASCII LINE MODE
ENT: BLOCK 4 ;EXTION NAME
ASCBUF: BLOCK 3
BCDLST: BLOCK 2
LRCT: BLOCK 1
PRCT: BLOCK 1
JMPSTK: BLOCK ^D20 ;PUSH DOWN JUMP STACK
PAPBUF: BLOCK 3 ;RING HEADER FOR PAPER TAPE
BCDBUF: BLOCK BUFSIZ
LOWE: END INIL