* 
* THIS MODULE ALLOWS USER TO SET BREAK-POINTS 
* IN HIS MICROCODE. HE IS ALLOWED TO PLACE THEM 
* ANYWHERE EXCEPT IN LOCATIONS TO BE OCCUPIED 
* BY THE LOAD/DUMP ROUTINE. 
* 
* COMMAND FORMAT: 
*                 BREAK,<ADDRESS>  IF <ADDRESS>=0 BREAK-POINT 
*                                  IS REMOVED.
IBRAK CLA 
      JSB GTPAR     GET PARAMETER.
      LDA PRAM
      SZA           FOUND?
      JMP *+5 
ERR4  JSB ERROR    NO,
      DEF MES04   PARAMETER 
      DEF .+9       MISSING.
      JMP INCMD  GO GET NEXT COMMAND
      LDA PRAM+1    PICK UP 
      AND LOMSK     PARAMETER MASK OFF UPPER BITS 
      JSB BREAK     CALL BREAK PROCEDURE
      JMP INCMD     GET NEXT COMMAND. 
* 
BREAK NOP 
      LDB BFLAG     WAS THERE A PREVIOUS
      SZB           BREAK COMMAND?
      JSB BFIX      YES GO FIX IT.
      SZA,RSS       CLEAR BREAK?
      JMP BREAK,I   ALREADY DONE EXIT.
      CCB           SET BREAK 
      STB BFLAG     FLAG FOR NEXT TIME. 
      STA TMP70     SAVE ADDRESS. 
      LDA ORGIN   GET CURRENT START OF LOAD/DUMP. 
      LDB 0         ROUTINE 
      ADB LDLEN      AND UPPER BOUND. 
      JSB LCHEK     CHECK WHETHER ADDRESS 
      DEF TMP70     IS INSIDE.
      SSA 
      JMP *+5 
      JSB ERROR     YES 
      DEF MES05     ILLEGAL 
      DEF .11       ADDRESS.
      JMP BREAK,I   EXIT. 
      LDA TMP70     COMPUTE 
      ALS           ACTUAL
      ADA BBASE     BREAK ADDRESS 
      STA BKADR     AND SAVE. 
      LDA MDLE
      CMA,INA       JMP IS
      ADA LOMSK 
      SSA           IN
      JMP *+4 
      CLA           MODULE
      CLB           0 
      JMP B0
      ADA =B400 
      SSA 
      JMP *+4 
      LDA .+2       MODULE
      CLB           1 
      JMP B0
      ADA =B400 
      SSA 
      JMP *+4 
      CLA           MODULE
      LDB =B10000   2 
      JMP B0
      LDA .+2       MODULE
      LDB =B1000    3 
B0    STA MASK1     SAVE
      STB MASK2     MASKS 
      LDB BKADR     SAVE
      LDA 1,I       MICRO 
      STA BK1       INSTRUCTION 
      LDA TMP70    GET
      ALF,ALF    ADDRESS
      IOR MJMP1     OR IN JMP 
      IOR MASK1     OR IN MASK
      STA 1,I       STORE UPPER PART OF JUMP. 
      INB           POINT TO LOWER HALF.
      LDA 1,I       SAVE
      STA BK2       IT
      LDA MJMP2     GET LOWER PART OF JUMP
      IOR MASK2     OR IN MASK. 
      STA 1,I       STORE.
      JMP BREAK,I   EXIT. 
* 
* BREAK  REPAIR UTILITY 
* 
BFIX  NOP 
      STA BFLAG 
      LDB BKADR     GET PREVIOUS BREAK ADDRESS. 
      LDA BK1       AND 
      STA 1,I       RESTORE 
      INB           OLD 
      LDA BK2       INST ACTION.
      STA 1,I 
      LDA BFLAG 
      JMP BFIX,I    EXIT. 
* 
BFLAG NOP 1 
MASK1 BSS 1 
MASK2 BSS 1 
BK1   BSS 1 
BK2   BSS 1 
BKADR BSS 1 
MJMP1 OCT 375 
MJMP2 OCT 27725     TO BE MODIFIED BY MOVE ROUTINE. 
TMP70 BSS 1 
MES04 ASC 9,MISSING PARAMETER 
MES05 ASC 11,ILLEGAL BREAK ADDRESS
* 
* LCHECK CHECKS TO SEE WHETHER A GIVEN VALUE
* IS INSIDE OR OUTSIDE A GIVEN RANGE. 
* 
* CALLING SEQUENCE:  LDA LOWER BOUND  > 0 
*                    LDB UPPER BOUND  > 0 
*                    JSB LCHECK 
*                    DEF VALUE
*   ON RETURN:  A<0 => OUTSIDE  A>=0 :=INSIDE 
* 
LCHEK NOP 
      CMA,INA       NEGATE A AND
      STA L.000     SAVE. 
      LDA LCHEK,I  YES EXIT WITH A<0. 
      ISZ LCHEK 
      LDA 0,I 
      STA L.001     SAVE IT.
      ADA L.000     < LOWER 
      SSA           BOUND?
      JMP LCHEK,I   YES EXIT WITH A<0 
      LDA L.001     GET VALUE 
      CMA 
      ADA 1    ADD TO -VALUE. 
      JMP LCHEK,I   EXIT. 
* 
L.000 BSS 1 
L.001 BSS 1 
* 
*  PREPARE COMMAND MODULE 
* 
*  THIS MODULE PREPARES PROM MASK TAPES FOR 
*  USE IN PROGRAMMING PROM CHIPS. 
* 
*  COMMAND FORMAT:
*                 PREPARE[,UNIT #]   DEFAULT=4
* 
IPREP CLA,INA 
      JSB GTPAR     GET UNIT
      LDA PRAM      #.
      SZA,RSS       ONE GIVEN?
      JMP *+3 
      LDA PRAM+1    YES GET IT. 
      RSS 
      LDA .+4       NO USE DEFAULT. 
      STA PCH       SAVE. 
      CPA .+2       =DISC?
      RSS 
      JMP *+5 
      JSB ERROR     YES 
      DEF MES03     ERROR 
      DEF .+10
      JMP INCMD     GO GET NEXT COMMAND.
      CLA           COMPUTE 
      JSB CHECK     CHECKSUM. 
      LDB ABF3      CONVERT 
      RBL           TO
      JSB DECML     ASCII & SAVE. 
      JSB SPACE 
      JSB LEADR 
      JSB MSOUT     OUTPUT
      DEF PHEAD     HEAD- 
      DEF .15       ING.
      JSB SPACE 
      JSB MSOUT     ASK FOR 
      DEF PMES1     3 LINES OF
      DEF .17       I.D. INFO.
      JSB MSOUT     GET 
      DEF LINE1     LINE1 
      DEF .+4 
      JSB RDTTY     FROM
      DEF PL1 
      DEF .M72      USER. 
      CMB,INB 
      STB PL1L
      JSB PUNCH     PUNCH 
      DEF PL1 
      DEF PL1L      IT. 
      JSB MSOUT     GET 
      DEF LINE2 
      DEF .+4       LINE 2
      JSB RDTTY 
      DEF PL2       FROM
      DEF .M72
      CMB,INB       USER
      STB PL2L
      JSB PUNCH     AND 
      DEF PL2 
      DEF PL2L      PUNCH IT. 
      JSB MSOUT     GET 
      DEF LINE3 
      DEF .+4       LINE 3
      JSB RDTTY 
      DEF PL3       FROM
      DEF .M72
      CMB,INB       USER
      STB PL3L
      JSB PUNCH     AND 
      DEF PL3 
      DEF PL3L      PUNCH IT
      JSB PUNCH     PUNCH 
      DEF BF3       CHECK-
      DEF .-3       SUM.
      LDA PTAB0     SET PARAMETER 
      STA PTAB      TABL HEAD.
      CLA           GET SHIFT CODE
      LDB .+8       TO
P2    JSB PROC      PROCESS BITS 23-20. 
      JSB LEADR     PUNCH TRAILER.
      JSB SPACE 
      LDA PTAB,I    LAST
      SZA           TAPE? 
      JMP *+5 
      JSB MSOUT     YES 
      DEF PMES2     PRINT 
      DEF .17       END MESSAGE 
      JMP INCMD     GO GET NEXT COMMAND.
      JSB MSOUT     PRINT 
      DEF PMES3     NEXT
      DEF .12       TAPE
      LDA PTAB      TO
      STA *+2       BE
      JSB MSOUT     GENERATED.
      NOP 
      DEF .+3 
      ISZ PTAB      POINT 
      ISZ PTAB      TO NEXT 
      ISZ PTAB      SHIFTER 
      LDA PTAB,I    CODE IN TABLE 
      JSB CHECK     COMPUTE CHECK-SUM.
      LDB ABF3      CONVERT 
      RBL           TO ASCII
      JSB DECML     AND SAVE. 
      ISZ PTAB
      JSB SPACE 
      JSB MSOUT     ANY 
      DEF PMES4     CHANGE
      DEF .14       OF
      JSB MSOUT     I.D.
      DEF LN1       INFO
      DEF .+4       IN
      JSB RDTTY     LINE
      DEF LINE      # 
      DEF .-3       1?
      LDB ALINE 
      RBL 
      JSB LOADB 
      CPA .N
      JMP P3
      JSB MSOUT     YES 
      DEF LINE1     GET 
      DEF .+4 
      JSB RDTTY     NEW 
      DEF PL1 
      DEF .M72      LINE. 
      CMB,INB 
      STB PL1L
P3    JSB LEADR     PUNCH 
      JSB PUNCH 
      DEF PL1       IT. 
      DEF PL1L
      JSB MSOUT     ANY 
      DEF LN2 
      DEF .+4       CHANGE
      JSB RDTTY 
      DEF LINE      OF
      DEF .-3       I.D.
      LDB ALINE 
      RBL           INFO
      JSB LOADB     IN
      CPA .N        LINE 2
      JMP P5
      JSB MSOUT     GET 
      DEF LINE2 
      DEF .+4       NEW 
      JSB RDTTY 
      DEF PL2       LINE
      DEF .M72
      CMB,INB 
      STB PL2L
P5    JSB PUNCH     PUNCH 
      DEF PL2 
      DEF PL2L      IT. 
      JSB MSOUT     ANY 
      DEF LN3 
      DEF .+4       CHANGE
      JSB RDTTY 
      DEF LINE      OF
      DEF .-3 
      LDB ALINE     I.D. INFO 
      RBL 
      JSB LOADB     IN LINE3. 
      CPA .N
      JMP P9
      JSB MSOUT     YES 
      DEF LINE3 
      DEF .+4       GET 
      JSB RDTTY 
      DEF PL3       NEW 
      DEF .M72
      CMB,INB       LINE
      STB PL3L
P9    JSB PUNCH     AND 
      DEF PL3 
      DEF PL3L      PUNCH IT. 
      JSB PUNCH     PUNCH 
      DEF BF3       CHECK-
      DEF .-3       SUM 
      CLA           SET A-REG.
      LDB PTAB,I    PICK UP B-REG FLAG. 
      ISZ PTAB      BUMP POINTER
      JMP P2        GO PROCESS. 
* 
* PROCESS ROUTINE 
* 
PROC  NOP 
      STB TMP90+1   SAVE MASK FLAG
      CLB 
      STB CKSUM     CLEAR CHECKSUM. 
PR1   STA TMP90     SAVE A-REG. 
      LDB TMP90+1 
      JSB SETUP     SET UP
      DEF BUFR1     BUFR1 FOR OUTPUT. 
      JSB PUNCH     START 
      DEF BUFR1     PUNCH OF
      DEF .M48      BUFR1.
      LDA TMP90 
      CPA .248      FINISHED? 
      JMP PROC,I    YES,RETURN. 
      ADA .+8       NO, BUMP A BY 8.
      STA TMP90     SAVE
      LDB TMP90+1   LOAD MASK FLAG. 
      JSB SETUP     GO SETUP. 
      DEF BUFR2     BUFR2 FOR OUTPUT. 
      JSB PUNCH     START 
      DEF BUFR2     PUNCH OF
      DEF .M48      BUFR2 
      LDA TMP90 
      CPA .248      FINISHED? 
      JMP PROC,I    YES RETURN
      ADA .+8       NO BUMP A BY 8
      JMP PR1       GO DO BUFR1 
* 
* BUFUR SET UP ROUTINE
* 
SETUP NOP 
      STA TMP80     SAVE ADRS.
      STB TMP80+1   SAVE MASK FLAG
      LDA SETUP,I   GET 
      STA BUFAD     BUFUR ADRS. 
      ISZ SETUP     SET RETURN
      RAL           MAKE BUFUR ADRS 
      STA BADR1     BYTE ADRS AND SAVE
      LDA TMP80     PUT IN START
      LDB BADR1     ASCII 
      JSB DECML     ADRS. 
      LDA MINUS     PUT 
      JSB STORB     IN "-". 
      LDA TMP80      PUT IN END 
      ADA .+7       ASCII 
      JSB DECML     ADRS. 
      LDA BLANK    PUT
      JSB STORB 
      LDA BLANK      2
      JSB STORB 
      STB BADR1     BLANKS. 
      LDA .-4       SET 
      STA PCNT4 
      LDA .-8       POINTERS. 
      STA PCNT8 
      LDA TMP80     COMPUTE 
      ADA HBASE     ADRES OF
      STA HEADR     WCS 
      LDA TMP80 
      RAL           WORD AND
      ADA BBASE 
      STA ADBUF     SAVE. 
      LDB TMP80+1   GET 
      CLE,ELB       MASK FLAG 
      RBR           AND 
      SEZ           SET 
      JMP *+5       SHIFT 
      LDA LSL16     INSTRUCTION 
      IOR 1        TO 
      STA SETI     PROCESS
      JMP PS4       CORRECT 
      LDA LSR16     SET 
      IOR 1         OF
      STA SETI       BITS.
PS4   LDA HEADR,I   IS THIS 
      SZA,RSS       GOOD DATA?
      JMP PS3       NO, GO PUT IN DONT CARSS ('X'S) 
      DLD ADBUF,I    YES GET WCS WORD.
SETI  NOP           SHIFT CUREENT 4 BITS TO UPPER A.
      STA TMP80+2       SACE. 
      SSA          BIT=1? 
      JMP PS1      YES, GO SET HIGH.
      LDB BADR1    NO,
      LDA .L        SET 
PS2   JSB STORB     LOW(L)
      STB BADR1     SAVE BYTE ADRS. 
      LDA TMP80+2    SHIFT NEXT 
      RAL          BIT INTO POSITION. 
      ISZ PCNT4     WAS THAT LAST BUT?
      JMP SETI+1    NO, GO DO NEXT. 
      LDA BLANK    YES PUT
      JSB STORB     A BLANK 
      STB BADR1 
      LDA .-4     RESET 4 
      STA PCNT4     COUNTER.
      ISZ ADBUF     POINT 
      ISZ ADBUF     TO NEXT WCS WORD
      ISZ HEADR      BUMP HEADR ADRS. 
      ISZ PCNT8     END OF LINE?
      JMP PS4      NO GO DO NEXT
      JMP SETUP,I    YES EXIT.
PS1   LDB BADR1    BIT IS 1?
      LDA .H        STOR HIGH 
      ISZ CKSUM     BUMP CHECKSUM.
      JMP PS2       GO STORE HIGH.
PS3   LDB BADR1     WOR IS DONT CARE. 
      LDA .X       STORE
      JSB STORB     4 
      ISZ PCNT4      X'S
      JMP PS3+1 
      LDA BLANK    PUT IN 
      JSB STORB     BLANK.
      STB BADR1 
      LDA .-4       RESER 4 
      STA PCNT4     COUNTER.
      ISZ ADBUF     POINT 
      ISZ ADBUF     TO NEXT 
      ISZ HEADR     WCS WORD. 
      ISZ PCNT8      LAST WORD? 
      JMP PS4       NO GO BACK
      JMP SETUP,I    YES EXIT.
* 
*   DECIMAL ASCII CONVERSION ROUTINE
* 
DECML NOP 
      STA TMP50     STVE #
      STB TMP50+1   SAVE ADRES
      CLB 
      DIV .100     GET 100TH DIGIT
      STB TMP50     SAVE REMAINDER
      ADA B60      MAKE ASCII DIGI<.
      LDB TMP50+1 
      JSB STORB     STORE.
      STB TMP50+1 
      CLB          GET
      LDA TMP50 
      DIV .+10     10TH DIGIT 
      STB TMP50      AND
      ADA B60       DO
      LDB TMP50+1      SAME FOR 
      JSB STORB    10TH AND 
      LDA TMP50    1'S
      ADA B60 
      JSB STORB     DIGIT 
      JMP DECML,I   EXIT. 
* 
*  ASCII PUNCK ROUTINE
* 
PUNCH NOP 
      LDA PUNCH,I     GET 
      STA PBUF     BUFUR ADRS.
      ISZ PUNCH 
      LDA PUNCH,I   GET 
      STA PBUFL     BUFUR LENGTH ADRES. 
      ISZ PUNCH     SET RETURN
      LDA PCH       SET 
      IOR =B20000    NO WAIT BIT
      STA PLUN
      JSB EXEC      PUNCH 
      DEF *+5 
      DEF .+2       RECORD
      DEF PLUN
PBUF  NOP 
PBUFL NOP 
      JMP PUNCH,I   EXIT
* 
*     CHECKSUM COMPUTE ROUTINE
* 
CHECK NOP 
      ADA PBASE     GET CORRENT 
      LDA 0,I      SHIFT CONSTATN 
      STA SHIFT     FROM TABLE
      CLA        INITIALIZE 
      STA CKSUM     CHECKSUM. 
      LDB HBASE     FIND
CK0   LDA 1,I       NEXT
      SZA           HEADR 
      JMP CK1 
      INB 
      JMP *-4 
CK1   SSA,RSS      NEGATIVE?
      JMP *+3 
      LDA CKSUM     YES CHECKSUM IN 
      JMP CHECK,I   A AND EXIT. 
      STA TMP35     SAVE COUNT
      STB TMP35+1    SAVE ADRS. 
      ARS           HALVE COUNT.
      CMA,INA       MAKE NEGATIVE.
      STA TMP35+2    AND SAVE 
      LDA HBASE    COMPUTE
      CMA,INA      BUFUR
      ADA TMP35+1   ADRES 
      ALS            OF 
      ADA BBASE     ACTUAL
      STA BUFAD      ADRS AND ASVE
CK2   DLD BUFAD,I   GET WCS WORD
SHIFT NOP          SHIF TO LOWER 4 BITS 
      SLA           =0? 
      ISZ CKSUM    NO, BUMP CKSUM 
      RAR          ROTATE TO NEXT BIT 
      SLA            =0?
      ISZ CKSUM     NO, BUMP CKSUM
      RAR           ROTATE TO ENXT BIT
      SLA           =0? 
      ISZ CKSUM      NO, BUMP CKSUM.
      RAR          ROTATE TO ENXT BIT 
      SLA           =0? 
      ISZ CKSUM      NO BUMP CKSUM
      ISZ BUFAD       POINT TO ENXT 
      ISZ BUFAD      WCS WORD.
      ISZ TMP35+2    FINISHED?
      JMP CK2       NO, GO BACK.
      LDB TMP35      YES COMPUTE
      BRS          ADRES OF WHERE TO
      ADB TMP35+1      START OF NEXT SEARCH.
      JMP CK0        GO DO IT.
TMP35 BSS 3 
PBASE DEF *+1 
      LSR 4 
      NOP 
      RRL 4 
      RRL 8 
      RRL 12
      RRL 16
ABF3  DEF BF3 
BF3   BSS 2 
PHEAD ASC 15,GENERATION OF MASK BITS 23-20
PMES1 ASC 17,ENTER 3 LINES OF I.D. INFORMATION
LINE1 ASC 4,LINE 1- _   X 
PL1   BSS 36
PL1L  BSS 1 
LINE2 ASC 4,LINE 2- _   X 
PL2   BSS 36
PL2L  BSS 1 
LINE3 ASC 4,LINE 3- _   X 
PL3   BSS 36
PL3L  BSS 1 
PTAB0 DEF *+2 
PTAB  DEF *+1 
      ASC 3, 19-16
      DEC 1 
      OCT 14
      ASC 3, 15-12
      DEC 2 
      OCT 100000
      ASC 3, 11-08
      DEC 3 
      OCT 100014
      ASC 3, 07-04
      DEC 4 
      OCT 100010
      ASC 3, 03-00
      DEC 5 
      OCT 100004
      OCT 0 
PMES2 ASC 17,GENERATION OF MASK TAPES COMPLETED 
PMES3 ASC 12,GENERATION OF MASK BITS_ 
PMES4 ASC 14,ANY CHANGE OF I.D. INFO. IN
.100  DEC 100 
LN1   ASC 4,LINE 1? 
LN2   ASC 4,LINE 2? 
LN3   ASC 4,LINE 3? 
.M72  DEC -72 
.N    OCT 116 
BUFR1 BSS 60
.248  DEC 248 
BUFR2 BSS 60
TMP80 BSS 3 
BADR1 BSS 1 
MINUS OCT 55
PCNT4 BSS 1 
PCNT8 BSS 1 
LSL16 LSL 16
LSR16 LSR 16
.H    OCT 110 
.X    OCT 130 
PLUN  BSS 1 
* 
*  VERIFY COMMAND MODULE
* 
*  THIS MODULE VERIFES MASK TAPES PRODUCED BY THE 
*  PREPARE COMMAND MODULE.
* 
*  COMMAND FORMAT:
*                 VERIFY[,UNIT] 
*                               DEFAULT = 5 
* 
IVER  CLA,INA       GET UNIT
      JSB GTPAR     #.
      LDA PRAM      ANY 
      SZA,RSS       GIVEN?
      JMP *+3 
      LDA PRAM+1    YES GET 
      RSS           IT. 
      LDA .+5       NO USE DEFAULT. 
      STA RDR       SAVE. 
      CPA .+2       =DISC?
      JMP ERR3      YES ERROR.
      LDA .-4       SET 
      STA VCNT      COUNT.
VA0   JSB MSOUT     ASK 
      DEF VMES0     USER
      DEF .+6       FOR 
      JSB RDTTY     TAPE
      DEF LINE      NUMBER. 
      DEF .M72
      LDA LINE
      CLB,INB       B=1 
      CPA .A23      #=2320? 
      JMP VA1       YES GO PROCESS
      INB           B=2 
      CPA .A19      #=1916? 
      JMP VA1       YES GO PROCESS
      INB           B=3 
      CPA .A15      #=1512? 
      JMP VA1       GO PROCESS
      INB           B=4 
      CPA .A11      #=1108? 
      JMP VA1       GO PROCESS
      INB           B=5 
      CPA .A07      #=0704? 
      JMP VA1       GO PROCESS
      INB           B=6 
      CPA .A03      #=0300? 
      JMP VA1       GO PROCESS
      JSB ERROR     ILLEGAL 
      DEF VMES2     TAPE
      DEF .+7       #.
      JMP VA0       GO TRY AGAIN. 
VA1   STB TMP10     SAVE INDICATOR. 
V0    JSB AREAD     READ
      DEF BUFR1     ASCII 
      DEF .M72      RECORD
      JMP *-3       EOT RETURN. 
      JSB MSOUT     PRINT 
      DEF BUFR1     I.D.
      DEF TLOG      INFO. 
      ISZ VCNT
      JMP V0
      JSB SPACE     SPACE.
      LDB ABF1      GET 
      RBL           ASCII 
      CLA,INA       CHECKSUM AND
      JSB CNVRT     CONVERT TO BINARY.
      SOS           LEGAL?
      JMP *+5 
      JSB ERROR     NO
      DEF VMES3     WRONG 
      DEF .+6       INPUT 
      JMP INCMD     GO GET NEXT COMMAND.
      STA CKSM1     SAVE CHECKSUM FROM TAPE.
      LDB TMP10     GET SHIFT 
      ADB TBLE      FLAG
      LDB 1,I 
      STB TMP90+1   SAVE. 
      CLA           CLEAR 
      STA CKSUM     CKSUM.
      STA TMP90 
V1    JSB AREAD     READ
      DEF BUFR1     ASCII 
      DEF .M48      RECORD
      JMP V1
      LDA TMP90     SET 
      LDB TMP90+1   UP
      JSB SETUP     WHAT
      DEF BUFR0     WE HAVE INTERNALLY. 
      JSB COMP      COMPARE 
      DEF BUFR0     RESULTS.
      DEF BUFR1 
      LDA TMP90     WAS 
      CPA .248      THAT LAST RECORD? 
      JMP V2        YES GO CHECK CHECKSUMS. 
      ADA .+8       NO BUMP 
      STA TMP90     ADDRESS BY 8
      JMP V1        & REPEAT. 
V2    LDA CKSUM     CKSUMS
      CPA CKSM1     COMPARE?
      JMP V8
V3    JSB MSOUT     OUTPUT
      DEF VMES8    BAD MASK TAPE
      DEF .+7      MESSAGE. 
      JSB MSOUT     ASK USER
      DEF VMES4     IF HE WOULD 
      DEF .18       LIKE TAPE REPUNCHED?
      JSB RDTTY     READ
      DEF LINE      RESPONSE
      DEF .M72
      LDB ALINE     RESPONSE
      RBL           IS
      JSB LOADB 
      CPA .N
      JMP INCMD     NO,GO GET NEXT COMMAND. 
V4    JSB MSOUT     YES 
      DEF VMES5     GET 
      DEF .+9       PUNCH 
      JSB RDTTY     UNIT
      DEF LINE      NUMBER. 
      DEF .M72
      LDB ALINE 
      RBL           CONVERT 
      CLA,INA       TO
      JSB CNVRT     BINARY. 
      SOS           LEGAL?
      JMP *+5 
      JSB ERROR     NO ILLEGAL
      DEF MES08     DIGIT 
      DEF .11 
      JMP V4        TRY AGAIN 
      STA PCH       SAVE UNIT #.
      LDA .-3       SET 
      STA VCNT      COUNT 
      JSB LEADR     PUNCH LEADR.
      JSB MSOUT     GET 
      DEF PMES1 
      DEF .17       I.D.
V5    JSB MSOUT 
      DEF DASH      INFORMATION.
      DEF .+1 
      JSB RDTTY     READ
      DEF BUFR1 
      DEF .M72      IT
      CMB,INB 
      STB TLOG
      JSB PUNCH     PUNCH 
      DEF BUFR1     IT. 
      DEF TLOG
      ISZ VCNT      DO 3 LINES. 
      JMP V5
      LDA TMP10     MAKE
      ADA .-1       PASS FOR
      JSB CHECK     CKSUM.
      LDB ABF3      CONVERT 
      RBL           TO
      JSB DECML     ASCII & SAVE. 
      JSB PUNCH     PUNCH 
      DEF BF3       IT
      DEF .-3 
      LDB TMP90+1   GET SHIFTER.
      CLA        & SET
      STA CKSUM     CKSUM & 
      STA TMP90     ADDRESS TO 0
V6    JSB SETUP     GENERATE ASCII
      DEF BUFR1     RECORD. 
      JSB PUNCH     PUNCH 
      DEF BUFR1     IT
      DEF .M48
      LDA TMP90     LAST
      CPA .248      ONE?
      JMP V7
      ADA .+8       NO
      STA TMP90     BUMP ADDRESS
V6A   JSB EXEC    CHECK 
      DEF *+5 
      DEF .13 
      DEF PCH 
      DEF TLOG  PUNCH STATUS
      DEF TLOG
      SSA 
      JMP V6A 
      LDA TMP90 
      LDB TMP90+1   RESET SHIFTER 
      JMP V6        GO BACK 
V7    JSB LEADR     YES PUNCH TRAILER 
      JMP INCMD     EXIT. 
V8    JSB MSOUT     TAPE
      DEF VMES7     VERIFIED
      DEF .+7 
      JMP INCMD     EXIT
* 
VCNT  BSS 1 
VMES0 ASC 6,TAPE NUMBER?
.A23  ASC 1,23
.A19  ASC 1,19
.A15  ASC 1,15
.A11  ASC 1,11
.A07  ASC 1,07
.A03 ASC 1,03 
VMES2 ASC 7,ILLEGAL TAPE #
TLOG  BSS 1 
.M24  DEC -24 
VMES4 ASC 18,WOULD YOU LIKE THIS TAPE REPUNCHED?_ 
ABF1  DEF BUFR1 
VMES3 ASC 6,WRONG INPUT:
CKSM1 BSS 1 
TBLE  DEF * 
      OCT 10
      OCT 14
      OCT 100000
      OCT 100014
      OCT 100010
      OCT 100004
BUFR0 BSS 60
VMES5 ASC 9,ENTER PUNCH UNIT #
DASH  ASC 1,-_     X
VMES7 ASC 7,TAPE VERIFIED 
VMES8 ASC 7,BAD MASK TAPE!
* 
* COMPARE ROUTINE 
* 
COMP  NOP 
      LDA COMP,I    GET 
      STA S         SOURCE ADDRESS
      ISZ COMP
      LDA COMP,I    GET 
      STA D         DESTINATION ADDRESS 
      ISZ COMP
      LDA .M24      SET 
      STA VCNT      COUNT 
CP0   LDA S,I       COMPARE 
      CPA D,I       NEXT WORD. SAME 
      RSS 
      JMP V3        NO ERROR
      ISZ S         YES 
      ISZ D         BUMP
      ISZ VCNT      POINTERS FINISHED?
      JMP CP0       NO GO BACK
      JMP COMP,I    YES EXIT
S     BSS 1 
D     BSS 1 
* 
*   ASCII READ ROUTINE
* 
AREAD NOP 
      LDA AREAD,I   GET 
      STA VBUF      BUFUR ADDRESS 
      ISZ AREAD 
      LDA AREAD,I   GET BUFUR 
      STA VBUFL     LENGTH
      ISZ AREAD     SET 
      LDA AREAD 
      STA EOTX      EOT EXIT
      ISZ AREAD     SET NORMAL EXIT 
      JSB EXEC      READ
      DEF *+5       ASCII 
      DEF .+1 
      DEF RDR       RECORD
VBUF  BSS 1 
VBUFL BSS 1 
      SZB,RSS       IF EOT TAKE 
      JMP EOTX,I    EOT EXIT ELSE 
      CMB,INB 
      STB TLOG
      JMP AREAD,I   NORMAL EXIT 
EOTX  BSS 1 
      END START 
ASMB,R,B,L
      HED  ** FILE MANAGER ERROR PROCESSOR ** JDR 
      NAM IFMGR,7 
      ENT IFMGR 
      EXT EXEC,.ENTR
      SPC 1 
* THIS FUNCTION CHECKS FOR FILE MANAGER ERRORS. IF THE ERROR
* CODE IS < 0, THE ERROR MESSAGE IS PRINTED ON THE LOCAL TTY. 
* 
* IF ID IS >= 0, THE ERROR CODE IS RETURNED AS THE FUNCTION 
* VALUE.
* 
* IF ID IS < 0 AND THE ERROR CODE IS < 0, THEN THE PROGRAM IS 
* ABORTED.
      SPC 1 
* FORTRAN USEAGE EXAMPLE: 
*     IF (IFMGR (IERR,ID,LTTY,NAME)100,200
      SPC 1 
* ASSEMBLY CALL SEQUENCE
*     JSB IFMGR 
*     DEF *+4 
*     DEF IERR
*     DEF ID
*     DEF LTTY
*     DEF NAME
*                  ON RETURN A = IERR 
      SPC 1 
* WHERE:
* IERR = ERROR PARAMETER RETURNED FROM FILE MANAGER CALL. 
* ID   = CALL IDENTITY CODE (NEGATIVE TO ABORT IF ERROR EXSISTS)
*        AS FOLLOWS.
*          1 = APOSN
*          2 = CLOSE
*          3 = CREAT
*          4 = FCONT
*          5 = FSTAT
*          6 = LOCF 
*          7 = NAMF 
*          8 = OPEN 
*          9 = POSNT
*         10 = PURGE
*         11 = READF
*         12 = RWNDF
*         13 = WRITF
* LTTY = LOGICAL UNIT NUMBER OF DEVICE TO LIST ERROR
      SPC 2 
* PARAMETER ADDRESSES 
      SPC 1 
IERR  NOP          ERROR CODE 
ID    NOP          FILE MANAGER CALL ID 
LTTY  NOP          LOGICAL UNIT TO OUTPUT ERROR MESS
NAME NOP          NAME OF FILE FILE MANAGER FILE ADDS.
      SPC 1 
* ENTRY POINT 
      SPC 1 
IFMGR NOP 
      JSB .ENTR    USE .ENTR TO GET 
      DEF IERR      ADDRESSES OF PARAMETERS 
      LDA IERR,I   GET ERROR CODE 
      SSA,RSS      FILE MANAGER ERROR?
      JMP IFMGR,I   NO, RETURN TO USER
      SPC 1 
* ERROR! CONVERT ERROR TO ASCII AND PUT IT INTO OUTPUT BUFFER 
      SPC 1 
      MPY M1       MULTIPLY ERROR BY -1 & THEN
      DIV .10       DIVIDE BY TEN TO GET TENS DIGIT.
      STA ERROR    SAVE TEMPORARILY 
      MPY .10      MULTIPLY BY 10 AND DIVIDE BY 
      DIV .1        1 TO GET TENS VALUE ONLY
      ADA IERR,I   ADD ERROR CODE, RESULT = - UNITS 
      CMA,INA      MAKE UNITS POSITIVE
      LDB ERROR    GET TENS DIGIT 
      BLF,BLF      ROTATE IT TO HIGH HALF OF WORD 
      IOR B        OR IT WITH UNITS 
      IOR ASC00    OR IN ASCII CONSTANT 
      STA ERROR    PUT ASCII ERROR CODE IN MESS BUF 
      SPC 1 
* ADD CALL ID AND FILE NAME TO BUFFER 
      SPC 1 
      LDA ID,I     GET ID CODE
      SSA          IS IT NEGATIVE?
      CMA,INA       YES - MAKE POSITIVE 
      STA B        IS CODE
      ADB M14       GREATER 
      SSB,RSS        THAN 13? 
      CLA             YES - OUTPUT $$$$$ FOR ID 
      STA B        SAVE ERROR CODE
      ALS          MULTIPLY BY 2 AND
      ADA B         ADD IT TO ITSELF (X3) 
      ADA CALL     ADD BUFR STARTING ADDS TO OFFSET 
      LDB EMES     SET POINTER TO 
      STB PNTR      ID NAME 
      CLB          SET FLAG TO INDICATE NAME
      STB FLAG      BUFFER HAS TO BE TRANSFERRED. 
NFILE LDB M3       SET COUNTER TO 
      STB CNTR      TRANSFER 3 WORDS
LOOP  LDB A,I      GET ID WORD & PUT IT 
      STB PNTR,I    IN ERROR MESSAGE BUFFER 
      INA          INDEX ID AND 
      ISZ PNTR      ERROR MESSAGE POINTERS
      ISZ CNTR     TRANSFER COMPLETE? 
      JMP LOOP      NO - TRANSFER NEXT WORD 
      LDB FLAG
      SZB          NAME ARRAY TRANSFERRED?
      JMP OUT       YES - OUTPUT MESSAGE
      ISZ FLAG      NO - SET FLAG TO SAY YES
      LDA NAME     GET ADDRESS OF ARRAY IN A
      LDB NAMEB    PUT OUTPUT BUFFER
      STB PNTR      ADDRESS IN B
      JMP NFILE    TRANSFER FILE NAME 
      SPC 1 
* OUTPUT ERROR MESSAGE
      SPC 1 
OUT   JSB EXEC
      DEF *+5 
      DEF WRITE 
      DEF LTTY,I
EMES  DEF ERMES 
      DEF M32 
      SPC 1 
* CHECK FOR ABORT PROGRAM 
      SPC 1 
      LDA IERR,I   PUT ERROR CODE IN CASE WE RETURN 
      LDB ID,I     GET ID CODE
      SSB,RSS      DO WE ABORT? 
      JMP IFMGR,I   NO - RETURN 
      SPC 1 
* ABORT PROGRAM 
      SPC 1 
      JSB EXEC     WRITE
      DEF *+5       "PROGRAM ABORTED!"
      DEF WRITE      ON 
      DEF LTTY,I        THE 
      DEF ABORT       LOCAL 
      DEF M16          TTY
      JSB EXEC     ASK
      DEF *+2       RTE TO
      DEF .6         TERMINATE PROGRAM
      JMP *-3      JUST IN CASE RTE DOES NOT LISTEN 
      SPC 1 
* CONSTANTS, STORAGE ALLOCATION, AND MESSAGES 
      SPC 1 
A     EQU 0        A REGISTER 
B     EQU 1        B REGISTER 
      SPC 1 
* CONSTANTS 
      SPC 1 
.1    DEC 1 
.6    DEC 6 
.10   DEC 10
M1    DEC -1
M3    DEC -3
M14   DEC -14 
M16   DEC -16 
M32   DEC -32 
      SPC 1 
* MISC. CONSTANTS 
      SPC 1 
ASC00 ASC 1,00
WRITE DEC 2 
      SPC 1 
* NOP'S 
      SPC 1 
CNTR  NOP          UTILITY COUNTER
FLAG  NOP          ID/NAME TRANSFER FLAG
PNTR  NOP          TRANSFER POINTER TO MESSAGE BUFFR
      SPC 1 
* FILE MANAGER CALLS
      SPC 1 
CALL  DEF *+1 
      SUP 1 
      SPC 1 
      ASC 3,$$$$$ 
ID1   ASC 3,APOSN 
ID2   ASC 3,CLOSE 
ID3   ASC 3,CREAT 
ID4   ASC 3,FCONT 
ID5   ASC 3,FSTAT 
ID6   ASC 3,LOCF
ID7   ASC 3,NAMF
ID8   ASC 3,OPEN
ID9   ASC 3,POSNT 
ID10  ASC 3,PURGE 
ID11  ASC 3,READF 
ID12  ASC 3,RWNDF 
ID13  ASC 3,WRITF 
      SPC 1 
* ERROR MESSAGE 
      SPC 1 
ERMES BSS 3 
      ASC 4,ERROR  -
ERROR NOP 
      ASC 5, IN FILE
NAM.  BSS 3 
NAMEB DEF NAM.
      SPC 1 
* ABORT PROGRAM MESSAGE 
      SPC 1 
ABORT ASC 8,PROGRAM ABORTED!
      SPC 1 
      END