Trailing-Edge
-
PDP-10 Archives
-
decuslib10-06
-
43,50417/libmac.mac
There are no other files named libmac.mac in the archive.
00100 ;
00200 ; (C) COPYRIGHT H.-H. NAGEL
00300 ; INSTITUT FUER INFORMATIK
00400 ; DER UNIVERSITAET HAMBURG
00500 ; SCHLUETERSTRASSE 70
00600 ; 2000 HAMBURG 13
00700 ; GERMANY
00800 ; 1976
00900 ;
01000 ;*** PASCAL RUNTIME PROGRAM LIBRARY (18-AUG-76, KISICKI)
01100 ;
01200 ;*** DICTIONARY ***
01300 ;
01400 ;PAGE1 : DICTIONARY
01500 ;PAGE2 : FREE
01600 ;PAGE3 : EXPO
01700 ;PAGE4 : ROUND
01800 ;PAGE5 : ...
01900 ;PAGE6 : RUNPGM
02000 ;PAGE7 : WRTSTR
02100 ;PAGE8 : NEW
02200 ;PAGE9 : READC
02300 ;PAGE10: ...
02400 ;PAGE11: ...
02500 ;PAGE12: WRTOCT
02600 ;PAGE13: WRTHEX
02700 ;PAGE14: WRTBOL
02800 ;PAGE15: READR
02900 ;PAGE16: TRUNC
03000 ;PAGE17: INTREA
03100 ;PAGE18: WRITEC
03200 ;PAGE19: WRTREA
03300 ;PAGE20: WRTINT
03400 ;PAGE21: ...
03500 ;PAGE22: READI
03600 ;PAGE23: TTYOPN
03700 ;PAGE24: ...
03800 ;PAGE25: OPEN
03900 ;PAGE26: REASTR
04000 ;PAGE27: CLOSE
04100 ;PAGE28: PUT
04200 ;PAGE29: GET
04300 ;PAGE30: DATE.
04400 ;PAGE31: TIME.
04500 ;PAGE32: EXIT
04600 ;PAGE33: DEBSP
04700 ;PAGE34: ...
04800 ;PAGE35: WRTFNM
04900 ;PAGE36: TMPTST
05000 ;PAGE37: ASTOSX
05100 ;PAGE38: REAAUX
05200 ;PAGE39: SETEOF
05300 ;PAGE40: WRTAUX
05400 ;PAGE41: FORER.
00100 TITLE FREE *** PROCEDURE FREE ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY FREE
00700 ;
00800 ;*** EXTERNAL-REFERENCES ***
00900 ;
01000 EXTERN WRTPC
01100 ;
01200 ;*** REGISTER DEFINITION ***
01300 ;
01400 AC0= 0
01500 AC1= 1
01600 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01700 REG= REGIN+1
01800 REG1= REGIN+1+1
01900 REG2= REGIN+1+2
02000 REG3= REGIN+1+3
02100 REG4= REGIN+1+4
02200 REG5= REGIN+1+5
02300 REG6= REGIN+1+6
02400 NEWREG= 15
02500 TOPP= 17
02600 ;
02700 ;*** ADDRESSES
02800 ;
02900 .JBSA= 120
03000 ;
03100 ;*** START OF INVARIANT CODE
03200 ;
03300 RELOC 400000
03400 ;
03500 ;*** PROCEDURE FREE
03600 ; - RESET NEWREG
03700 ; - <AC0>=VARIABLE TO BE RETAINED
03800 ; - AC1=LENGTH OF VARIABLE
03900 ;
04000 FREE: CAIGE AC0 ,(NEWREG) ;A(VAR) >= NEWREG
04100 JRST FREERR ;NO - INVALID ARG TO FREE
04200 ADD AC0 ,AC1 ;NEW POSITION
04300 HLRZ AC1 ,.JBSA ;NEW POS.
04400 CAIL AC0 ,(AC1) ;< .JBSA
04500 JRST FREERR ;NO - INVALID ARG TO FREE
04600 HRRZ NEWREG ,AC0 ;RESET NEWREG
04700 POPJ TOPP , ;RET TO CALLER
04800 FREERR: OUTSTR [ASCIZ/
04900 %? POINTER OUT OF BOUNDS: CANNOT RETAIN VARIABLE/]
05000 JRST WRTPC
05100 ;
05200 ;*** LITERALS ***
05300 ;
05400 LIT
05500 PRGEND
00100 TITLE EXPO *** FUNCTION EXPO ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS
00500 ;
00600 ENTRY EXPO
00700 ;
00800 ;*** REGISTER DEFINITION ***
00900 ;
01000 AC0= 0
01100 AC1= 1
01200 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01300 REG= REGIN+1
01400 REG1= REGIN+1+1
01500 REG2= REGIN+1+2
01600 REG3= REGIN+1+3
01700 REG4= REGIN+1+4
01800 REG5= REGIN+1+5
01900 REG6= REGIN+1+6
02000 NEWREG= 15
02100 TOPP= 17
02200 ;
02300 ;*** START OF INVARIANT CODE
02400 ;
02500 RELOC 400000
02600 ;
02700 ;*** FUNCTION EXPO
02800 ; - RETURN THE EXPONENT OF A REAL VALUE
02900 ; - REG=REAL VALUE
03000 ; - 1(TOPP):=EXPONENT AS INTEGER
03100 ;
03200 EXPO: JUMPGE REG ,.+2 ;POS. ARG.?
03300 MOVM REG ,REG ;GET MAGNITUDE IF NOT
03400 LDB REG ,[POINT 8,REG,8] ;GET EXPONENT
03500 SUBI REG ,200 ;200 FOR EXPONENT
03600 MOVEM REG ,1(TOPP) ;STORE FUNCTION RESULT
03700 POPJ TOPP ,
03800 ;
03900 ;*** LITERALS
04000 ;
04100 LIT
04200 PRGEND
00100
00200 TITLE ROUND *** FUNCTION ROUND ***
00300 TWOSEG
00400 ;
00500 ;*** ENTRY-POINTS
00600 ;
00700 ENTRY ROUND
00800 ;
00900 ;*** EXTERNAL REFERENCES
01000 ;
01100 EXTERN TRUNC
01200 ;
01300 ;*** REGISTER DEFINITION ***
01400 ;
01500 AC0= 0
01600 AC1= 1
01700 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01800 REG= REGIN+1
01900 REG1= REGIN+1+1
02000 REG2= REGIN+1+2
02100 REG3= REGIN+1+3
02200 REG4= REGIN+1+4
02300 REG5= REGIN+1+5
02400 REG6= REGIN+1+6
02500 NEWREG= 15
02600 TOPP= 17
02700 ;
02800 ;*** START OF INVARIANT CODE
02900 ;
03000 RELOC 400000
03100 ;
03200 ;*** FUNCTION ROUND
03300 ; - ROUND REAL VALUE TO NEAREST INTEGER
03400 ; - REG=REAL VALUE
03500 ; - 1(TOPP):=TRUNC(REG + 0.5)
03600 ;
03700 ROUND: FADR REG ,[0.5] ;GET ARG. FOR TRUNC
03800 PUSH TOPP ,REG1 ;SAVE REG1
03900 MOVEI REG1 ,0 ;2ND ARG. FOR TRUNC
04000 PUSHJ TOPP ,TRUNC ;CALL TRUNC
04100 MOVE REG ,2(TOPP) ;GET RESULT FROM TRUNC
04200 POP TOPP ,REG1 ;RESTORE REG1
04300 MOVEM REG ,1(TOPP) ;STORE FUNCTION RESULT
04400 POPJ TOPP , ;RETURN TO CALLER
04500 ;
04600 ;*** LITERALS
04700 ;
04800 LIT
04900 PRGEND
00100 TITLE RUNPGM *** PROCEDURE RUN ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY RUNPGM
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 EXTERN ASTOSX
01100 EXTERN WRTSIX
01200 EXTERN WRTPC
01300 ;
01400 ;*** REGISTER DEFINITION ***
01500 ;
01600 AC0= 0
01700 AC1= 1
01800 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01900 REG= REGIN+1
02000 REG1= REGIN+1+1
02100 REG2= REGIN+1+2
02200 REG3= REGIN+1+3
02300 REG4= REGIN+1+4
02400 REG5= REGIN+1+5
02500 REG6= REGIN+1+6
02600 NEWREG= 15
02700 TOPP= 17
02800 ;
02900 ;*** START OF VARIANT CODE ***
03000 ;
03100 RUNBLK: SIXBIT / /
03200 SIXBIT / /
03300 SIXBIT / /
03400 XWD 0 ,0
03500 XWD 0 ,0
03600 XWD 0 ,0
03700 ;
03800 ;*** START OF INVARIANT CODE ***
03900 ;
04000 RELOC 400000
04100 ;
04200 ;*** PROCEDURE RUN
04300 ; - ISSUE RUN-UUO
04400 ; - <REG>=ASCII/9 CHAR. FILENAME/
04500 ; - <REG1>=ASCII/6 CHAR. DEVICE/
04600 ; - REG2=PROJ.-PROG.-NR.
04700 ; - REG3=CORE REQUIREMENT
04800 ;
04900 RUNPGM: MOVE AC0 ,[SIXBIT/SYS /] ;ASSUME
05000 MOVEM AC0 ,RUNBLK ;SYS
05100 JUMPE REG1 ,NODEV ;DEVICE?
05200 MOVEI REG5 ,6 ;YES, SET LENGTH
05300 MOVEI AC1 ,RUNBLK
05400 PUSHJ TOPP ,ASTOSX ;AND CONV. TO SIXBIT
05500 NODEV: HRRI REG1 ,(REG) ;ADDR OF FILENAME
05600 MOVEI AC1 ,RUNBLK+1
05700 MOVEI REG5 ,6
05800 PUSHJ TOPP ,ASTOSX ;CONV. FILEN. TO SIXBIT
05900 MOVEM REG2 ,RUNBLK+4
06000 IMULI REG3 ,2000
06100 HRRZM REG3 ,RUNBLK+5
06200 HRLI AC1 ,1
06300 HRRI AC1 ,RUNBLK
06400 RUN AC1 , ;RUN SPECIFIED PROGRAM
06500 RUNERR: OUTSTR [ASCIZ/
06600 %? CANNOT RUN /]
06700 MOVEI REG1 ,RUNBLK+1 ;PROGRAM'S NAME
06800 PUSHJ TOPP ,WRTSIX ;WRITE OUT NAME
06900 JRST WRTPC
07000 ;
07100 ;*** LITERALS
07200 ;
07300 LIT
07400 PRGEND
00100 TITLE WRTSTR *** PROCEDURES WRTPST AND WRTUST ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY WRTPST
00700 ENTRY WRTUST
00800 ENTRY WRTPS1
00900 ENTRY WRTUS1
01000 ;
01100 ;*** EXTERNAL REFERENCES ***
01200 ;
01300 EXTERN PUTCH
01400 ;
01500 ;*** REGISTER DEFINITION ***
01600 ;
01700 AC0= 0
01800 AC1= 1
01900 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02000 REG= REGIN+1
02100 REG1= REGIN+1+1
02200 REG2= REGIN+1+2
02300 REG3= REGIN+1+3
02400 REG4= REGIN+1+4
02500 REG5= REGIN+1+5
02600 REG6= REGIN+1+6
02700 NEWREG= 15
02800 TOPP= 17
02900 ;
03000 ;*** START OF INVARIANT CODE ***
03100 ;
03200 RELOC 400000
03300 ;
03400 ;*** PROCEDURE WRTPST/WRTUST
03500 ; - WRITE PACKED STRING/STRING
03600 ; - <REG1>=STRING
03700 ; - REG2=TOTAL LENGTH OF OUTPUT
03800 ; - REG3=LENGTH OF STRING
03900 ;
04000 WRTPS1: MOVE REG2 ,REG3 ;DEFAULT LENGTH
04100 JRST WRTPST
04200 WRTUS1: MOVE REG2 ,REG3 ;DEFAULT LENGTH
04300 JRST WRTUST
04400 WRTPST: HRLI REG1 ,440700 ;WRITE PACKED STRING
04500 JRST BLANK-1
04600 WRTUST: HRLI REG1 ,444400
04700 JUMPLE REG2 ,WRTRET ;FIELDWIDTH = 0 ?
04800 BLANK: CAIG REG2 ,(REG3) ;LEADING BLANKS REQUESTED ?
04900 JRST START ;NO
05000 MOVEI AC0 ," "
05100 PUSHJ TOPP ,PUTCH
05200 SOJA REG2 ,BLANK ;MORE LEADING BLANKS ?
05300 START: ILDB AC0 ,REG1
05400 PUSHJ TOPP ,PUTCH
05500 SOJG REG2 ,START ;ANY CHARACTER LEFT ?
05600 WRTRET: POPJ TOPP , ;NO - RETURN
05700 ;
05800 ;*** LITERALS ***
05900 ;
06000 LIT
06100 PRGEND
00100 TITLE NEW *** PROCEDURE NEW ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY NEW
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 EXTERN WRTPC
01100 ;
01200 ;*** REGISTER DEFINITION ***
01300 ;
01400 AC0= 0
01500 AC1= 1
01600 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01700 REG= REGIN+1
01800 REG1= REGIN+1+1
01900 REG2= REGIN+1+2
02000 REG3= REGIN+1+3
02100 REG4= REGIN+1+4
02200 REG5= REGIN+1+5
02300 REG6= REGIN+1+6
02400 NEWREG= 15
02500 TOPP= 17
02600 ;
02700 ;*** START OF INVARIANT CODE ***
02800 ;
02900 RELOC 400000
03000 ;
03100 ;*** PROCEDURE NEW
03200 ; - ALLOCATE DYNAMIC VARIABLES
03300 ; - REG=LENGTH OF VARIABLE
03400 ; - <REG>:=VARIABLE
03500 ;
03600 NEW: SUB NEWREG ,REG ;UPDATE NEWREG
03700 CAIL NEWREG ,40(TOPP) ;40 LOCATIONS TO ACCOUNT FOR
03800 ;USE OF STACK BY RUNTIME SUPPORT
03900 JRST ALLOC ;OK - ALLOCATE STORAGE
04000 ADDI NEWREG ,(REG) ;RESET NEWREG ON OVERRUN
04100 JRST NEWERR
04200 ALLOC: HRR AC1 ,NEWREG
04300 MOVN REG ,REG
04400 HRL AC1 ,REG
04500 CLEAR: SETZM (AC1) ;SET REQUESTED
04600 AOBJN AC1 ,CLEAR ;STORAGE TO ZERO
04700 MOVE REG ,NEWREG ;RETURN ADDR OF VARIABLE
04800 POPJ TOPP ,
04900 NEWERR: OUTSTR [ASCIZ/
05000 %? HEAP OVERRUNS STACK: RETRY WITH MORE CORE/]
05100 JRST WRTPC
05200 ;
05300 ;*** LITERALS
05400 ;
05500 LIT
05600 PRGEND
00100 TITLE READC *** PROCEDURE READC ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY READC
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 EXTERN GETCH
01100 ;
01200 ;*** REGISTER DEFINITION ***
01300 ;
01400 AC0= 0
01500 AC1= 1
01600 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01700 REG= REGIN+1
01800 REG1= REGIN+1+1
01900 REG2= REGIN+1+2
02000 REG3= REGIN+1+3
02100 REG4= REGIN+1+4
02200 REG5= REGIN+1+5
02300 REG6= REGIN+1+6
02400 NEWREG= 15
02500 TOPP= 17
02600 ;
02700 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
02800 ;
02900 FILPTR= 0
03000 FILEOF= 1
03100 FILEOL= 2
03200 FILOPN= 3
03300 FILLKP= 4
03400 FILENT= 5
03500 FILIN= 6
03600 FILOUT= 7
03700 FILCLS= 10
03800 FILSTA= 11 ;.+0 FOR FILESTATUS
03900 ;.+1 FOR DEVICE
04000 ;.+2 FOR POINTER TO BUFFERHEADER
04100 FILNAM= 14
04200 FILEXT= 15
04300 FILPRO= 16
04400 FILPPN= 17
04500 FILBFH= 20 ;BUFFER HEADER
04600 FILBTP= 21 ;BYTE POINTER
04700 FILBTC= 22 ;BYTE COUNT IN BUFFER
04800 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
04900 ;CTERS
05000 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
05100 ;R OF WORDS IN COMPONENT
05200 ;IF ASCII MODE : CHARACTERCNT IN LIN
05300 ;E AND TAB INDICATOR
05400 ;RH= ADDRESS OF FIRST WORD IN COMPONE
05500 ;NT
05600 FILCMP= 25 ;FIRST WORD OF COMPONENT
05700 ;
05800 ;*** START OF INVARIANT CODE ***
05900 ;
06000 RELOC 400000
06100 ;
06200 ;*** PROCEDURE READC
06300 ; - READ SINGLE CHARACTER
06400 ; - <REG1>=CHAR
06500 ;
06600 READC: MOVE AC0 ,FILCMP(REG)
06700 MOVEM AC0 ,(REG1)
06800 PUSHJ TOPP ,GETCH
06900 POPJ TOPP ,
07000 ;
07100 ;*** LITERALS ***
07200 ;
07300 LIT
07400 PRGEND
00100 TITLE WRTOCT *** PROCEDURE WRTOCT ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY WRTOCT
00700 ENTRY WRTOC1
00800 ;
00900 ;*** EXTERNAL REFERENCES ***
01000 ;
01100 EXTERN PUTCH
01200 ;
01300 ;*** REGISTER DEFINITION ***
01400 ;
01500 AC0= 0
01600 AC1= 1
01700 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01800 REG= REGIN+1
01900 REG1= REGIN+1+1
02000 REG2= REGIN+1+2
02100 REG3= REGIN+1+3
02200 REG4= REGIN+1+4
02300 REG5= REGIN+1+5
02400 REG6= REGIN+1+6
02500 NEWREG= 15
02600 TOPP= 17
02700 ;
02800 ;*** START OF INVARIANT CODE ***
02900 ;
03000 RELOC 400000
03100 ;
03200 ;*** PROCEDURE WRTOCT
03300 ; - WRITE OCTAL FORMAT
03400 ; - REG1=OCTAL NUMBER
03500 ; - REG2=TOTAL LENGTH OF OUTPUT
03600 ;
03700 WRTOC1: HRRZI REG2 ,14 ;DEFAULT LENGTH 12
03800 JRST OCTEST
03900 WRTOCT: JUMPLE REG2 ,OCTRET ;FIELDWIDTH = 0 ?
04000 WRTOIN: CAIG REG2 ,14 ;LEAD. BLKS. REQ.?
04100 JRST OCTEST ;NO
04200 MOVEI AC0 ," "
04300 PUSHJ TOPP ,PUTCH
04400 SOJA REG2 ,WRTOIN ;MORE BLANKS TO BE INSERTED ?
04500 OCTEST: MOVE REG3 ,[POINT 3,REG1]
04600 HRREI AC1 ,-14(REG2)
04700 JUMPE AC1 ,OCTWRT ;LESS THAN 12 POSITIONS REQUIRED ?
04800 IBP REG3 ;YES
04900 AOJL AC1 ,.-1
05000 OCTWRT: ILDB AC0 ,REG3 ;GET DIGIT
05100 ADDI AC0 ,60 ;CONVERT TO ASCII
05200 PUSHJ TOPP ,PUTCH
05300 SOJG REG2 ,OCTWRT ;MORE DIGITS TO BE OUTPUT ?
05400 OCTRET: POPJ TOPP , ;NO - RETURN
05500 ;
05600 ;*** LITERALS
05700 ;
05800 LIT
05900 PRGEND
00100 TITLE WRTHEX *** PROCEDURE WRTHEX ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY WRTHEX
00700 ENTRY WRTHX1
00800 ;
00900 ;*** EXTERNAL REFERENCES ***
01000 ;
01100 EXTERN PUTCH
01200 ;
01300 ;*** REGISTER DEFINITION ***
01400 ;
01500 AC0= 0
01600 AC1= 1
01700 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01800 REG= REGIN+1
01900 REG1= REGIN+1+1
02000 REG2= REGIN+1+2
02100 REG3= REGIN+1+3
02200 REG4= REGIN+1+4
02300 REG5= REGIN+1+5
02400 REG6= REGIN+1+6
02500 NEWREG= 15
02600 TOPP= 17
02700 ;
02800 ;*** START OF INVARIANT CODE ***
02900 ;
03000 RELOC 400000
03100 ;
03200 ;*** PROCEDURE WRTHEX
03300 ; - WRITE SEDECIMAL NUMBER
03400 ; - REG1=HEXADECIMAL NUMBER
03500 ; - REG2=TOTAL LENGHT OF OUTPUT
03600 ;
03700 WRTHX1: HRRZI REG2 ,11 ;DEFAULT LENGTH 9
03800 JRST HEXTST
03900 WRTHEX: JUMPLE REG2 ,HEXRET ;FIELD = 0?
04000 WRTHIN: CAIG REG2 ,11 ;LEADING BLANKS REQUIRED?
04100 JRST HEXTST ;NO
04200 MOVEI AC0 ," "
04300 PUSHJ TOPP ,PUTCH
04400 SOJA REG2 ,WRTHIN
04500 HEXTST: MOVE REG3 ,[POINT 4,REG1]
04600 HRREI AC1 ,-11(REG2)
04700 JUMPE AC1 ,HEXWRT ;LESS THEN 11 POSITIONS
04800 IBP REG3 ;YES
04900 AOJL AC1 ,.-1
05000 HEXWRT: ILDB AC0 ,REG3
05100 ADDI AC0 ,60
05200 CAIL AC0 ,72 ;DIGIT?
05300 ADDI AC0 ,7 ;NO LETTER
05400 PUSHJ TOPP ,PUTCH
05500 SOJG REG2 ,HEXWRT
05600 HEXRET: POPJ TOPP ,
05700 ;
05800 ;*** LITERALS ***
05900 ;
06000 LIT
06100 PRGEND
00100 TITLE WRTBOL *** PROCEDURE WRTBOL ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY WRTBOL
00700 ENTRY WRTBO1
00800 ;
00900 ;*** EXTERNAL REFERENCES ***
01000 ;
01100 EXTERN PUTCH
01200 EXTERN WRTBLK
01300 ;
01400 ;*** REGISTER DEFINITION ***
01500 ;
01600 AC0= 0
01700 AC1= 1
01800 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01900 REG= REGIN+1
02000 REG1= REGIN+1+1
02100 REG2= REGIN+1+2
02200 REG3= REGIN+1+3
02300 REG4= REGIN+1+4
02400 REG5= REGIN+1+5
02500 REG6= REGIN+1+6
02600 NEWREG= 15
02700 TOPP= 17
02800 ;
02900 ;*** START OF INVARIANT CODE ***
03000 ;
03100 RELOC 400000
03200 ;
03300 ;*** PROCEDURE WRTBOL
03400 ; - WRITE BOOLEAN CONSTANT
03500 ; - REG1=BOOLEAN VARIABLE
03600 ; - REG2=TOTAL LENGTH OF OUTPUT
03700 ;
03800 WRTBO1: HRRZI REG2 ,1 ;DEFAULT LENGTH 5
03900 JRST BLANK
04000 WRTBOL: CAIGE REG2 ,5 ;FORMAT GREATER OR EQUAL FIVE ?
04100 JRST BSMALL ;NO - SMALL OUTPUT
04200 SUBI REG2 ,5
04300 BLANK: PUSHJ TOPP ,WRTBLK ;WRITES LEADING BLANKS IF ANY
04400 MOVEI REG2 ,5 ;FIVE CHARACTERS ARE GIVEN OUT
04500 MOVE REG3 ,[ASCII/FALSE/]
04600 SKIPE REG1 ;TRUE OR FALSE? - SKIP IF FALSE
04700 MOVE REG3 ,[ASCII/ TRUE/]
04800 MOVE REG1 ,[POINT 7,REG3,-1]
04900 ILDB AC0 ,REG1 ;GETS CHARACTER
05000 PUSHJ TOPP ,PUTCH
05100 SOJG REG2 ,.-2 ;MORE CHARACTERS?
05200 POPJ TOPP , ;NO - RETURN
05300 BSMALL: JUMPE REG2 ,BOLEND ;FIELDWIDTH = 0?
05400 SUBI REG2 ,1
05500 PUSHJ TOPP ,WRTBLK ;WRITES LEADING BLANKS IF ANY
05600 MOVEI AC0 ,"F"
05700 SKIPE REG1 ;TRUE OR FALSE? - SKIP IF FALSE
05800 MOVEI AC0 ,"T"
05900 PUSHJ TOPP ,PUTCH
06000 BOLEND: POPJ TOPP ,
06100 ;
06200 ;*** LITERALS ***
06300 ;
06400 LIT
06500 PRGEND
00100 TITLE READR *** PROCEDURE READR ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY READR
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 ;
01100 EXTERN GETCH
01200 EXTERN CONERR
01300 EXTERN READI
01400 EXTERN INTREA
01500 EXTERN GETINT
01600 EXTERN GETSGN
01700 EXTERN RTEST
01800 ;*** REGISTER DEFINITION ***
01900 ;
02000 AC0= 0
02100 AC1= 1
02200 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02300 REG= REGIN+1
02400 REG1= REGIN+1+1
02500 REG2= REGIN+1+2
02600 REG3= REGIN+1+3
02700 REG4= REGIN+1+4
02800 REG5= REGIN+1+5
02900 REG6= REGIN+1+6
03000 NEWREG= 15
03100 TOPP= 17
03200 ;
03300 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
03400 ;
03500 FILPTR= 0
03600 FILEOF= 1
03700 FILEOL= 2
03800 FILOPN= 3
03900 FILLKP= 4
04000 FILENT= 5
04100 FILIN= 6
04200 FILOUT= 7
04300 FILCLS= 10
04400 FILSTA= 11 ;.+0 FOR FILESTATUS
04500 ;.+1 FOR DEVICE
04600 ;.+2 FOR POINTER TO BUFFERHEADER
04700 FILNAM= 14
04800 FILEXT= 15
04900 FILPRO= 16
05000 FILPPN= 17
05100 FILBFH= 20 ;BUFFER HEADER
05200 FILBTP= 21 ;BYTE POINTER
05300 FILBTC= 22 ;BYTE COUNT IN BUFFER
05400 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
05500 ;CTERS
05600 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
05700 ;R OF WORDS IN COMPONENT
05800 ;IF ASCII MODE : CHARACTERCNT IN LIN
05900 ;E AND TAB INDICATOR
06000 ;RH= ADDRESS OF FIRST WORD IN COMPONE
06100 ;NT
06200 FILCMP= 25 ;FIRST WORD OF COMPONENT
06300 ;
06400 ;*** START OF INVARIANT CODE ***
06500 ;
06600 RELOC 400000
06700 ;
06800 ;*** PROCEDURE READR
06900 ; - READ REAL FORMAT
07000 ; - <REG1>=REAL VALUE
07100 ; - REG2=TOTAL LENGTH OF OUTPUT
07200 ; - REG3=LENGTH OF FRACTION
07300 ;
07400 READR: PUSHJ TOPP ,GETSGN ;GETS SIGN IF ANY AND FIRST COMPONET
07500 ;TO AC0
07600 PUSHJ TOPP ,RTEST ;TEST IF FIRST COMPONENT IN DIGITS
07700 ;IF NOT ERROR - MESSAGE AND EXIT
07800 PUSHJ TOPP ,GETINT ;GETS INTEGER BEFORE POINT TO REG2
07900 MOVEI AC1 ,REG2 ;CONVERTS TO ASCII
08000 PUSHJ TOPP ,INTREA
08100 MOVE REG4 ,REG2 ;FURTHER WORKING FOR REAL ON REG4
08200 SETZ REG6 , ;FOR DECIMAL EXPONENT
08300 MOVE AC0 ,FILCMP(REG)
08400 CAIE AC0 ,"." ;NOW HAS TO COME DECIMAL POINT
08500 JRST CONERR ;NO POINT - ERROR MESSAGE AND EXIT
08600 BEHPNT: SKIPE FILEOL(REG)
08700 JRST REXP
08800 PUSHJ TOPP ,GETCH
08900 MOVE AC0 ,FILCMP(REG) ;GET NEXT COMPONENT
09000 CAIG AC0 ,"9" ;IN DIGITS ?
09100 CAIGE AC0 ,"0"
09200 JRST REXP ;NO
09300 SOJ REG6 , ;INCREMENT EXPONENT
09400 FMPR REG4 ,[10.0]
09500 SUBI AC0 ,"0" ;CONVERTS ASCII TO INTEGER
09600 FSC AC0 ,233 ;CONVERTS INTEGER TO REAL
09700 FADR REG4 ,AC0 ;ADD NEW DIGIT TO REST
09800 JRST BEHPNT ;GET NEXT DIGITS IF ANY
09900 REXP: SKIPL REG6 ;ONE OR MORE DIGITS BEHIND POINT ?
10000 JRST CONERR ;NO - WRITE ERROR MESSAGE AND RETURN
10100 MOVEI REG5 ,(REG3) ;SAVES SIGN
10200 CAIE AC0 ,"E" ;DIGIT EQUAL E ?
10300 JRST .+5 ;NO
10400 SKIPN FILEOL(REG)
10500 PUSHJ TOPP ,GETCH ;GET NEXT COMPONENT
10600 PUSHJ TOPP ,READI ;GETS EXPONENT TO REG2
10700 ADD REG6 ,REG2
10800 JUMPL REG6 ,REXP1
10900 SOJL REG6 ,REAOUT ;DEXIMAL EXPONENT EQUAL 0?
11000 FMPR REG4 ,[10.0] ;NO - TOO LARGE - DIVIDIDE REAL VALUE
11100 JRST .-2
11200 REXP1: FDVR REG4 ,[10.0] ;NO - TOO SMALL - MULTIPLY REAL VALUE
11300 AOJL REG6 ,.-1
11400 REAOUT: JFCL 10 ,CONERR ;OVERFLOW - BIT SET ?
11500 ;IF SET JUMP TO CONERR
11600 SKIPE REG5 ;SIGN EQUAL PLUS ?
11700 MOVN REG4 ,REG4 ;NO - NEGATE REAL VALUE
11800 MOVEM REG4 ,(REG1) ;STORE VALUE INTO VARIABLE
11900 POPJ TOPP ,
12000 ;
12100 ;*** LITERALS ***
12200 ;
12300 LIT
12400 PRGEND
00100 TITLE TRUNC *** FUNCTION TRUNC ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY TRUNC
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 EXTERN INTREA
01100 ;
01200 ;*** REGISTER DEFINITION ***
01300 ;
01400 AC0= 0
01500 AC1= 1
01600 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01700 REG= REGIN+1
01800 REG1= REGIN+1+1
01900 REG2= REGIN+1+2
02000 REG3= REGIN+1+3
02100 REG4= REGIN+1+4
02200 REG5= REGIN+1+5
02300 REG6= REGIN+1+6
02400 NEWREG= 15
02500 TOPP= 17
02600 ;
02700 ;*** START OF INVARIANT CODE ***
02800 ;
02900 RELOC 400000
03000 ;
03100 ;*** FUNCTION TRUNC
03200 ; - CONVERT REAL TO INTEGER
03300 ; - REG=REAL VALUE
03500 ; - 1(TOPP):=[REG] AS INTEGER
03600 ;
03700 TRUNC: SETZM 1(TOPP) ;CLEARS SIGN BIT
03800 MOVE AC0 ,REG
03900 JUMPGE AC0 ,POSVAL ;NEGATIVE NUMBER ?
04000 AOS 1(TOPP) ;YES - SET SIGN BIT
04100 MOVM AC0 ,AC0 ;MAKE IT POSITIVE
04200 POSVAL: LDB REG ,[POINT 8,AC0,8] ;GETS EXPONENT
04300 TLZ AC0 ,377000 ;RESET EXPONENT TO ZERO
04400 SUBI REG ,233 ;200 FOR OFFSET, 33 FOR MANTISSE
04600 SETZ AC1 , ;CLEAR AC1
04700 ASHC AC0 ,(REG) ;AC0 := AC0 * 2 ** REG
04800 SKIPN 1(TOPP) ;NEGATIVE SIGN ?
04900 JRST READY ;NO - OVERJUMP
05000 SKIPE AC1 ;REST EQUAL ZERO ?
05100 AOS AC0 ;NO - INCREMENT
05200 MOVN AC0 ,AC0 ;AND MAKE NEGATIVE
05300 READY: MOVEM AC0 ,1(TOPP) ;STORE FUNCTION RESULT
05400 POPJ TOPP , ;RETURN TO CALLER
05500 ;
05600 ;*** LITERALS ***
05700 ;
05800 LIT
05900 PRGEND
00100 TITLE INTREA *** FUNCTION INTREA ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY INTREA
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 ;
01100 ;*** REGISTER DEFINITION ***
01200 ;
01300 AC0= 0
01400 AC1= 1
01500 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01600 REG= REGIN+1
01700 REG1= REGIN+1+1
01800 REG2= REGIN+1+2
01900 REG3= REGIN+1+3
02000 REG4= REGIN+1+4
02100 REG5= REGIN+1+5
02200 REG6= REGIN+1+6
02300 NEWREG= 15
02400 TOPP= 17
02500 ;
02600 ;*** START OF INVARIANT CODE ***
02700 ;
02800 RELOC 400000
02900 ;
03000 ;*** FUNCTION INTREA
03100 ; - CONVERT INTEGER TO REAL
03200 ; - <AC1>=INTEGER VALUE
03300 ; - <AC1>:=<AC1> AS REAL
03400 ;
03500 INTREA: MOVE AC0 ,(AC1) ;GETS INTEGER TO AC0
03600 JUMPGE AC0 ,.+3 ;VALUE NEGATIVE ?
03700 TLO AC1 ,400000 ;SETS SIGN BIT
03800 MOVM AC0 ,AC0 ;AC0 := ABS(AC0)
03900 MOVEM AC1 ,1(TOPP) ;SAVES ADRESS AND SIGN BIT
04000 JFFO AC0 ,.+2 ;WHERE IS THE FIRST "ONE"?
04100 JRST .+7 ;AC0 CONTAINS ONLY ZERO'S
04200 SUBI AC1 ,11 ;AC1 := NR OF LEADING 0'S - 9
04300 JUMPGE AC1 ,.+4 ;BITS OF EXPONENT EQUAL ZERO ?
04400 LSH AC0 ,(AC1) ;NO - SET ZERO
04500 MOVM AC1 ,AC1 ;AND INCREMENT EXPONENT BY COUNT
04600 JRST .+2
04700 SETZ AC1 ,
04800 ADDI AC1 ,233 ;AC1 CONTAINS UNNORMALIZED EXPONENT
04900 FSC AC0 ,(AC1) ;CONVERTS TO NORMALIESRD REAL
05000 MOVE AC1 ,1(TOPP) ;GETS SIGN BIT AND ADDRESS
05100 SKIPGE AC1 ;SIGN BIT SET ?
05200 MOVN AC0 ,AC0 ;YES - NEGATE REAL VALUE
05300 MOVEM AC0 ,(AC1) ;STORE FUNCTION RESULT
05400 POPJ TOPP , ;RETURN
05500 ;
05600 ;*** LITERALS ***
05700 ;
05800 LIT
05900 PRGEND
00100 TITLE WRITEC *** PROCEDURE WRITEC ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY WRITEC
00700 ENTRY WRITC1
00800 ;
00900 ;*** EXTERNAL REFERENCES ***
01000 ;
01100 EXTERN PUTCH
01200 ;
01300 ;*** REGISTER DEFINITION ***
01400 ;
01500 AC0= 0
01600 AC1= 1
01700 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01800 REG= REGIN+1
01900 REG1= REGIN+1+1
02000 REG2= REGIN+1+2
02100 REG3= REGIN+1+3
02200 REG4= REGIN+1+4
02300 REG5= REGIN+1+5
02400 REG6= REGIN+1+6
02500 NEWREG= 15
02600 TOPP= 17
02700 ;
02800 ;*** START OF INVARIANT CODE ***
02900 ;
03000 RELOC 400000
03100 ;
03200 ;*** PROCEDURE WRITEC
03300 ; - WRITE A SINGLE CHAR
03400 ; - REG1=CHAR
03500 ; - REG2=NUMBER OF LEAD. BLANKS
03600 ;
03700 WRITC1: HRRZI REG2 ,1 ;DEFAULT LENGTH 1
03800 WRITEC: JUMPLE REG2 ,WRITRT ;FIELDWIDTH = 0 ?
03900 SOJE REG2 ,PRINT ;LEADING BLANKS REQUESTED ?
04000 LOOP: MOVEI AC0 ," " ;YES
04100 PUSHJ TOPP ,PUTCH
04200 SOJG REG2 ,LOOP ;MORE LEADING BLANKS ?
04300 PRINT: MOVE AC0 ,REG1 ;CHAR TO BE OUTPUT INTO AC0
04400 PUSHJ TOPP ,PUTCH
04500 WRITRT: POPJ TOPP ,
04600 ;
04700 ;*** LITERALS ***
04800 ;
04900 LIT
05000 PRGEND
00100 TITLE WRTREA *** PROCEDURE WRTREA ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY WRTREA
00700 ENTRY WRTRE1
00800 ENTRY WRTRE2
00900 ;
01000 ;*** EXTERNAL REFERENCES ***
01100 ;
01200 EXTERN PUTCH
01300 EXTERN WRTOPN
01400 EXTERN WRTSGN
01500 EXTERN WRTOPN
01600 EXTERN TOOSML
01700 EXTERN WRTBLK
01800 EXTERN WRTINT
01900 ;
02000 ;*** REGISTER DEFINITION ***
02100 ;
02200 AC0= 0
02300 AC1= 1
02400 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02500 REG= REGIN+1
02600 REG1= REGIN+1+1
02700 REG2= REGIN+1+2
02800 REG3= REGIN+1+3
02900 REG4= REGIN+1+4
03000 REG5= REGIN+1+5
03100 REG6= REGIN+1+6
03200 NEWREG= 15
03300 TOPP= 17
03400 ;
03500 ;*** START OF INVARIANT CODE ***
03600 ;
03700 RELOC 400000
03800 ;
03900 ;*** PROCEDURE WRTREA
04000 ; - WRITE REAL FORMAT
04100 ; - REG1=REAL VALUE
04200 ; - REG2=TOTAL LENGTH OF OUTPUT
04300 ; - REG3=LENGTH OF FRACTION
04400 ;
04500 WRTRE2: HRRZI REG2 ,20 ;DEFAULT LENGTH 16
04600 WRTRE1: HRRZI REG3 ,123456 ;DEFAULT FLOATING REAL
04700 JRST WRTREA
04800 WRTMAT: SOJL REG5 ,.+4 ;MORE LEADING ZERO'S REQUEST
04900 MOVEI AC0 ,"0" ;YES - WRITE THEM OUT
05000 PUSHJ TOPP ,PUTCH
05100 SOJG REG4 ,.-3 ;MORE LEADING ZERO'S BEFORE POINT ?
05200 JUMPLE REG4 ,MATEND ;NO - MORE DIGITS BEFORE POINT ?
05300 JUMPE REG1 ,.+7 ;MANTISSE EQUAL ZERO ?
05400 LDB AC0 ,[POINT 9,REG1,8] ;NO - GET NEXT DIGIT
05500 TLZ REG1 ,777000 ;RESETZ THIS BITS
05600 IMULI REG1 ,12
05700 ADDI AC0 ,"0" ;CONVERTS THEM TO ASCII
05800 PUSHJ TOPP ,PUTCH
05900 SOJG REG4 ,.-6 ;MORE DIGITS BEFORE POINT FROM REG1 ?
06000 JUMPLE REG4 ,MATEND ;NO - MORE DIGITS BEFORE POINT ?
06100 MOVEI AC0 ,"0" ;YES - WRITES ONE ZERO OUT
06200 PUSHJ TOPP ,PUTCH
06300 SOJG REG4 ,.-1
06400 MATEND: POPJ TOPP ,
06500 WRTREA: JUMPLE REG2 ,REARET ;FIELDWIDTH = 0?
06600 PUSHJ TOPP ,WRTOPN ;SETS SIGN BIT AND PUTS FIELDWIDTH TO
06700 ; REG5
06800 SETZ REG6 , ;TO SAVE DECIMAL EXPONENT
06900 JUMPN REG1 ,.+3 ;VALUE EQUAL ZERO ?
07000 MOVEI AC0 ,555555 ;YES - REMEMBER IT IN AC0
07100 JRST WRTFF ;AND WRITE IT OUT
07200 CAML REG1 ,[10.0] ;REAL VALEU SHOULD BE LESS THEN 10.0
07300 JRST TOOBIG ;AND GREATER OR EQUAL THEN 1.0
07400 CAML REG1 ,[1.0]
07500 JRST NOWCOR ;NOW CORRECTLY POSITIONED
07600 FMPR REG1 ,[10.0] ;IT'S TOO SMALL
07700 SOJA REG6 ,.-3 ;EXPONENT BECOMES NEGATIV - CHECK AGA
07800 ;IN
07900 TOOBIG: FDVR REG1 ,[10.0] ;REAL VALUE IS TOO LARGE
08000 AOJ REG6 , ;EXPONENT BECOMES POSITIV
08100 CAML REG1 ,[10.0] ;STILL TOO LARGE?
08200 JRST TOOBIG ;YES
08300 NOWCOR: LDB REG2 ,[POINT 8,REG1,8] ;GETS BINARY EXPONENT
08400 SUBI REG2 ,200
08500 TLZ REG1 ,377000 ;CLEARS EXPONENT
08600 LSH REG1 ,(REG2) ;SHIFTS MANTISSE BY BINARY EXPONENT L
08700 ;EFT
08800 WRTFF: CAIN REG3 ,123456 ;FIXEDREAL OR FLOATING REAL ?
08900 JRST WRTFLO ;FLOATING REAL
09000 MOVEI REG2 ,(REG5) ;FIXED REAL - GET FORMAT
09100 SUBI REG2 ,(REG3) ;REG3 CONTAINS NR OF DIGITS AFTER POI
09200 ;NT
09300 JUMPL REG6 ,.+7 ;EXPONENT NEGATIV ?
09400 HRRI REG4 ,1(REG6) ;NOW REG4 CONTAINS NR OF DIGITS BEFOR
09500 ; POINT
09600 CAIGE REG2 ,1(REG4) ;FORMAT LARGE ENOUGH ?
09700 JRST WRTFLO ;NO - WRITES FLOATING FORMAT IF POSSI
09800 ;BLE
09900 CAIE AC0 ,555555 ;VALUE EQUAL ZERO ?
10000 SETZ REG5 , ;NO - NO LEADING ZERO'S
10100 JRST .+5
10200 CAIGE REG2 ,2
10300 JRST TOOSML
10400 HRRI REG4 ,1 ;ONE ZERO BEFORE POINT
10500 MOVM REG5 ,REG6 ;NUMBER OF LEADING ZEROS'S
10600 MOVEI REG6 ,765432 ;TO REMEMBER THAT NO EXPONENT SHALL
10700 ;BE GIVEN OUT
10800 SUBI REG2 ,1(REG4) ;FOR POINT AND DIGITS BEFORE POINT
10900 JRST WRTOUT
11000 WRTFLO: HRRI REG4 ,1 ;ONE DIGIT BEFORE POINT
11100 SETZ REG2 , ;NORMALLY NO LEADING BLANKS
11200 TLNE REG4 ,400000 ;SIGN EQUAL MINUS ?
11250 JRST .+3 ;NO
11300 MOVEI REG2 ,1 ;ONE LEADING BLANK FOR PLUS
11350 SUBI REG5 ,1 ;ACCOUNT IN FORMAT LENGTH
11400 CAIGE REG5 ,7 ;FORMAT BIG ENOUGH ?
11500 JRST TOOSML ;NO - WRITES "*" 'S INTO FORMAT AND R
11600 ;ETURN
11700 MOVEI REG3 ,-6(REG5) ;DIGITS BEHIND POINT
11800 CAIE AC0 ,555555 ;VALUE EQUAL ZERO ?
11900 SETZ REG5 , ;NO - NO LEADING ZERO'S IN FLOATING F
12000 ;ORMAT
12100 ;<REG1>: VALUE OF MANTISSE
12200 ;<REG2>: NR OF LEADING BLANKS
12300 ;<REG3>: NR OF DIGITS BEHIND POINT
12400 ;<REG4>: NR OF DIGITS BEFORE POINT
12500 ;<REG5>: NR OF LEADING ZERO'S
12600 WRTOUT: PUSHJ TOPP ,WRTBLK ;WRITES LEADING BLANKS
12700 PUSHJ TOPP ,WRTSGN ;WRITES SIGN
12800 PUSHJ TOPP ,WRTMAT ;WRITES MANTISSE BEFORE POINT
12900 MOVEI AC0 ,"." ;WRITES DECIMAL POINT OUT
13000 PUSHJ TOPP ,PUTCH
13100 MOVEI REG4 ,(REG3)
13200 PUSHJ TOPP ,WRTMAT ;WRITES MANTISSE BEHIND POINT
13300 CAIN REG6 ,765432 ;WRITE EXPONENT OR NOT ?
13400 JRST REARET ;NO
13500 JUMPN REG6 ,.+3 ;EXPONENT EQUAL ZERO ?
13600 MOVEI REG2 ,4 ;YES - WRITES BLANKS INSTEAD ZERO EXP
13700 ;ONENT
13800 JRST WRTBLK ;AND RETURN TO SURCEPROGRAMM
13900 MOVEI AC0 ,"E" ;YES - WRITE E OUT
14000 PUSHJ TOPP ,PUTCH
14100 MOVEI AC0 ,"+" ;WRITES SIGN OUT
14200 SKIPGE REG6 ;EXPONENT POSITIV
14300 MOVEI AC0 ,"-" ;NO - WRITE MINUS SIGN
14400 PUSHJ TOPP ,PUTCH ;WRITES OUT SIGN
14500 MOVM REG1 ,REG6 ;DEZIMAL EXPONENT TO REG1 - FOR WRITE
14600 ;INTEGER
14700 MOVEI AC0 ,"0" ;TO WRITE ONE ZERO IF EXPONENT LESS T
14800 ;HAN 12
14900 CAIGE REG1 ,12 ;EXPONENT GREATER 12
15000 PUSHJ TOPP ,PUTCH ;NO - WRITE ONE ZERO OUT
15100 MOVEI REG2 ,2 ;FORMAT - TWO DIGITS NORMALLY
15200 CAIGE REG1 ,12 ;NEED MORE THAN ONE DIGIT ?
15300 MOVEI REG2 ,1 ;NO - FORMAT ONLY ONE DIGIT
15400 PUSHJ TOPP ,WRTINT ;WRITES DECIMAL EXPONENT OUT
15500 REARET: POPJ TOPP , ;RETURN
15600 ;
15700 ;*** LITERALS ***
15800 ;
15900 LIT
16000 PRGEND
00100 TITLE WRTINT *** PROCEDURE WRTINT ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY WRTINT
00700 ENTRY WRTIN1
00800 ;
00900 ;*** EXTERNAL REFERENCES ***
01000 ;
01100 EXTERN PUTCH
01200 EXTERN TOOSML
01300 EXTERN WRTBLK
01400 EXTERN WRTSGN
01500 EXTERN WRTOPN
01600 ;
01700 ;*** REGISTER DEFINITION ***
01800 ;
01900 AC0= 0
02000 AC1= 1
02100 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02200 REG= REGIN+1
02300 REG1= REGIN+1+1
02400 REG2= REGIN+1+2
02500 REG3= REGIN+1+3
02600 REG4= REGIN+1+4
02700 REG5= REGIN+1+5
02800 REG6= REGIN+1+6
02900 NEWREG= 15
03000 TOPP= 17
03100 ;
03200 ;*** START OF INVARIANT CODE ***
03300 ;
03400 RELOC 400000
03500 ;
03600 ;*** PROCEDURE WRTINT
03700 ; - WRITE INTEGER FORMAT
03800 ; - REG1=INTEGER VALUE
03900 ; - REG2=TOTAL LENGTH OF OUTPUT
04000 ;
04100 WRTIN1: HRRZI REG2 ,14 ;SET DEFAULT LENGTH 12
04200 WRTINT: JUMPLE REG2 ,INTRET ;FIELDWIDTH = 0?
04300 PUSHJ TOPP ,WRTOPN
04400 JUMPE REG1 ,.+4
04500 IDIVI REG1 ,12 ;GETS LOWEST DIGIT TO REG2
04600 PUSH TOPP ,REG2 ;AND SAVES IT IN PUSH-LIST
04700 AOJA REG4 ,.-3
04800 TRNE REG4 ,777777 ;VALUE EQUAL 0?
04900 JRST .+4 ;NO
05000 SETZ REG2 , ;YES - PUTS ONE ZERO INTO PUSH-LIST
05100 PUSH TOPP ,REG2
05200 AOJ REG4 ,
05300 CAIL REG5 ,(REG4) ;FORMAT LARGE ENOUGH ?
05400 JRST .+6 ;YES
05500 TLZ REG4 ,400000 ;CLEARS SIGN BIT IF ANY
05600 SOJL REG4 ,.+3 ;RESET PUSH-LIST
05700 POP TOPP ,REG2
05800 JRST .-2
05900 JRST TOOSML ;WRITES "*" 'S INTO FORMAT AND RETURNS
06000 SUBI REG5 ,(REG4) ;GETS NUMBER OF LEADING BLANKS
06100 MOVEI REG2 ,(REG5) ;WRITEBLANK-ROUTINE WORKS ON REG2
06200 PUSHJ TOPP ,WRTBLK ;WRITES BLANKS IF ANY
06300 PUSHJ TOPP ,WRTSGN ;WRITES SIGN : " " IF POSITIV,"-" IF
06400 ;NEGATIV
06500 POP TOPP ,AC0 ;GETS DIGIT IN PUSH-LIST
06600 ADDI AC0 ,"0" ;CONVERTS TO ASCII
06700 PUSHJ TOPP ,PUTCH ;WRITES THEM OUT
06800 SOJG REG4 ,.-3 ;MORE DIGITS ?
06900 INTRET: POPJ TOPP , ;NO - RETURN
07000 ;
07100 ;*** LITERALS ***
07200 ;
07300 LIT
07400 PRGEND
00100 TITLE READI *** PROCEDURE READI ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY READI
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 EXTERN GETSGN
01100 EXTERN GETINT
01200 EXTERN CONERR
01300 EXTERN RTEST
01400 ;
01500 ;*** REGISTER DEFINITION ***
01600 ;
01700 AC0= 0
01800 AC1= 1
01900 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02000 REG= REGIN+1
02100 REG1= REGIN+1+1
02200 REG2= REGIN+1+2
02300 REG3= REGIN+1+3
02400 REG4= REGIN+1+4
02500 REG5= REGIN+1+5
02600 REG6= REGIN+1+6
02700 NEWREG= 15
02800 TOPP= 17
02900 ;
03000 ;*** START OF INVARIANT CODE ***
03100 ;
03200 RELOC 400000
03300 ;
03400 ;*** PROCEDURE READI
03500 ; - READ INTEGER NUMBER
03600 ; - <REG1>=INTEGER VARIABLE
03700 ;
03800 READI: PUSHJ TOPP ,GETSGN ;GETS SIGN AND FIRST CHAR
03900 PUSHJ TOPP ,RTEST ;TEST IF FIRST COMPONENT IN DIGITS
04000 PUSHJ TOPP ,GETINT ;GETS INTEGER TO REG2
04100 SKIPE REG3 ;SIGN EQUAL MINUS ?
04200 MOVN REG2 ,REG2 ;YES - NEGATE INTEGER
04300 JFCL 10 ,CONERR ;OVERFLOW BIT SET ?
04400 MOVEM REG2 ,(REG1) ;PUTS INTEGER IN PLACE LOADED TO REG1
04500 POPJ TOPP ,
04600 ;
04700 ;*** LITERALS ***
04800 ;
04900 LIT
05000 PRGEND
00100 TITLE TTYOPN *** PROCEDURE TTYOPN ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY TTYOPN
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 EXTERN PUTLN
01100 EXTERN PUTCH
01200 EXTERN PUTBUF
01300 ;
01400 ;*** REGISTER DEFINITION ***
01500 ;
01600 AC0= 0
01700 AC1= 1
01800 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01900 REG= REGIN+1
02000 REG1= REGIN+1+1
02100 REG2= REGIN+1+2
02200 REG3= REGIN+1+3
02300 REG4= REGIN+1+4
02400 REG5= REGIN+1+5
02500 REG6= REGIN+1+6
02600 NEWREG= 15
02700 TOPP= 17
02800 ;
02900 ;*** START OF INVARIANT CODE ***
03000 ;
03100 RELOC 400000
03200 ;
03300 ;*** PROCEDURE TTYOPN
03400 ; - PROMPT PASCAL USER IF TTY-INPUT
03500 ; TO HIS PROGRAM IS REQUESTED
03600 ;
03700 TTYOPN: PUSHJ TOPP ,PUTLN
03800 MOVEI AC0 ,"*" ;TYPE ASTERISK
03900 PUSHJ TOPP ,PUTCH
04000 PUSHJ TOPP ,PUTBUF
04100 POPJ TOPP ,
04200 ;
04300 ;*** LITERALS
04400 ;
04500 LIT
04600 PRGEND
00100 TITLE OPEN *** PROCEDURES RESET AND REWRITE ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY RESETF
00700 ENTRY REWRIT
00800 ENTRY TMPBLK
00900 ;
01000 ;*** EXTERNAL REFERENCES ***
01100 ;
01200 EXTERN SETEOF
01300 EXTERN GETCH
01400 EXTERN GET
01500 EXTERN ASTOSX
01600 EXTERN WRTPC
01700 EXTERN TMPTST
01800 EXTERN WRTFNM
01900 EXTERN GETLN
02000 EXTERN CLSFIL
02100 ;
02200 ;*** REGISTER DEFINITION ***
02300 ;
02400 AC0= 0
02500 AC1= 1
02600 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02700 REG= REGIN+1
02800 REG1= REGIN+1+1
02900 REG2= REGIN+1+2
03000 REG3= REGIN+1+3
03100 REG4= REGIN+1+4
03200 REG5= REGIN+1+5
03300 REG6= REGIN+1+6
03400 NEWREG= 15
03500 TOPP= 17
03600 ;
03700 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
03800 ;
03900 FILDAT= 1 ;FLAG TO TEST FOR TEXT-FILE
04000 FILBIN= 17 ;FLAG TO TEST FOR ASCII-MODE
04100 FILPTR= 0 ;LH= PASCAL FILE FLAGS
04200 ;RH= PTR TO COMPONENT
04300 FILEOF= 1
04400 FILEOL= 2
04500 FILOPN= 3
04600 FILLKP= 4
04700 FILENT= 5
04800 FILIN= 6
04900 FILOUT= 7
05000 FILCLS= 10
05100 FILSTA= 11 ;.+0 FOR FILESTATUS
05200 ;.+1 FOR DEVICE
05300 ;.+2 FOR POINTER TO BUFFERHEADER
05400 FILNAM= 14
05500 FILEXT= 15
05600 FILPRO= 16
05700 FILPPN= 17
05800 FILBFH= 20 ;BUFFER HEADER
05900 FILBTP= 21 ;BYTE POINTER
06000 FILBTC= 22 ;BYTE COUNT IN BUFFER
06100 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
06200 ;CTERS
06300 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
06400 ;R OF WORDS IN COMPONENT
06500 ;IF ASCII MODE : CHARACTERCNT IN LIN
06600 ;E AND TAB INDICATOR
06700 ;RH= ADDRESS OF FIRST WORD IN COMPONE
06800 ;NT
06900 FILCMP= 25 ;FIRST WORD OF COMPONENT
07000 ;
07100 ;*** CONSTANTS ***
07200 ;
07300 TMPSIZ= 200
07400 ;
07500 ;*** ADDRESSES ***
07600 ;
07700 .JBFF= 121
07800 .JBREL= 44
07900 ;
08000 ;*** START OF VARIANT CODE
08100 ;
08200 TMPFLG: XWD 0 ,0
08300 RESFLG: XWD 0 ,0
08400 TMPBLK: SIXBIT / /
08500 IOWD 0 ,0
08600 ;
08700 ;*** START OF INVARIANT CODE ***
08800 ;
08900 RELOC 400000
09000 ;
09100 ;*** PROCEDURE RESETF
09200 ; - OPEN A FILE FOR INPUT
09300 ; - READ 1ST COMPONENT
09400 ; - <REG>=FILE-BLOCK
09500 ;
09600 RESETF: HRRZI AC0 ,FILBFH(REG) ;INPUT BUFFER HEADER ADDRESS
09700 SETOM RESFLG ;RESET IN PROGRESS
09800 PUSHJ TOPP ,REOPEN ;CLOSE AND REOPEN FILE
09900 MOVEI AC1 ,GETLN ;ADDR FOR ASCII-MODE
10000 HLR AC0 ,FILPTR(REG) ;TEXT-FILE?
10100 TRNE AC0 ,FILDAT ;SKIP IF YES
10200 MOVEI AC1 ,GET ;ADDR FOR BINARY-MODE
10300 SKIPE TMPFLG ;TEMPCORE-FILE OPEN?
10400 JRST TMPSKP ;YES, SKIP LOOKUP
10500 SKIPN FILEOF(REG)
10600 XCT FILLKP(REG) ;LOOKUP
10700 JRST SETEOF ;ERROR ON LOOKUP OR OPEN
10800 XCT FILIN(REG) ;SET UP INPUT BUFFER RING
10900 SKIPA
11000 JRST SETEOF ;NO FILE FOR NONDIRECTORY DEVICES
11100 TMPSKP: SETZM TMPFLG ;TEMPCORE OPEN FINISHED
11200 PUSHJ TOPP ,(AC1) ;GET FIRST COMPONENT (OR CHARACTER)
11300 POPJ TOPP ,
11400 ;
11500 ;*** PROCEDURE REWRITE
11600 ; - OPEN A FILE FOR OUTPUT
11700 ; - <REG>=FILE-BLOCK
11800 ;
11900 REWRIT: HRLZI AC0 ,FILBFH(REG) ;OUTPUT BUFFER HEADER ADDR
12000 SETZM RESFLG ;REWRITE IN PROGRESS
12100 PUSHJ TOPP ,REOPEN ;CLOSE AND REOPEN FILE
12200 AOSG FILEOF(REG) ;ERROR ON OPEN ?
12300 JRST REWERR ;YES
12400 XCT FILENT(REG) ;ENTER
12500 JRST REWERR ;ERROR ON ENTER
12600 XCT FILOUT(REG) ;SET UP BUFFER RING
12700 POPJ TOPP , ;OK - RETURN
12800 REWERR: OUTSTR [ASCIZ/
12900 %? NO ACCESS TO OR NO DISK SPACE FOR FILE /]
13000 PUSHJ TOPP ,WRTFNM
13100 OUTSTR [ASCIZ/: ERROR IN REWRITE/]
13200 JRST WRTPC
13300 ;
13400 ;*** PROCEDURE TEMPCR
13500 ; - ALLOCATE SPACE FOR TEMP-CORE BUFFER
13600 ; - ISSUE TMPCOR-UUO
13700 ; - FAKE BUFFER-HEADER
13800 ; - PREPARE OPEN FOR DISK-FILE IF UUO FAILS
13900 ; - <REG>=FILE-BLOCK
14000 ;
14100 TEMPCR: SKIPN RESFLG ;RESET?
14200 JRST TMPSW ;NO, REWRITE
14300 HRRZ AC1 ,.JBFF ;1ST FREE WORD
14400 HRRZ AC0 ,.JBREL ;END OF USER-CORE
14500 CAIGE AC0 ,TMPSIZ(AC1) ;WILL BUFFER FIT?
14600 JRST [
14700 ADDI AC0 ,TMPSIZ ;CORE NEEDED TO AC1
14800 CORE AC0 , ;GET ANOTHER K
14900 JRST TMPER1 ;BULLSHIT
15000 JRST .+1] ;BACK IN LINE
15100 HRRM AC1 ,TMPBLK+1 ;BUFFER-ADDR TO CONT.-BLOCK
15200 SOS TMPBLK+1 ;PROPER IOWD-FORMAT
15300 MOVEI AC0 ,-TMPSIZ ;MAX READ-LENGTH
15400 HRLM AC0 ,TMPBLK+1 ;TO CONT.-BLOCK
15500 HRLI AC1 ,440700 ;ASCII-BYTE-PTR
15600 HRR AC0 ,FILSTA(REG) ;ASCII-MODE?
15700 TRNE AC0 ,FILBIN ;SKIP IF YES
15800 HRLI AC1 ,444400 ;BINARY-BYTE-PTR IF NOT
15900 MOVEM AC1 ,FILBTP(REG) ;BYTE-PTR TO BUFFER-HEADER
16000 MOVE AC0 ,FILNAM(REG) ;FILNAME
16100 MOVEM AC0 ,TMPBLK ;TO CONT.BLOCK
16200 MOVE AC0 ,[XWD 2,TMPBLK] ;DO TEMPCORE-READ
16300 TMPCOR AC0 , ;WITH DELETE
16400 JRST TMPSW ;FAILED
16500 ADDM AC0 ,.JBFF ;SAVE DATA FROM DELETION
16600 HRR AC1 ,FILSTA(REG) ;BINARY-MODE?
16700 TRNN AC1 ,FILBIN ;SKIP IF YES
16800 IMULI AC0 ,5 ;CALCULATE BYTE-COUNT
16900 MOVEM AC0 ,FILBTC(REG) ;STORE INTO BUFFER-HEADER
17000 SETOM TMPFLG ;SHOW TEMPCORE-READ
17100 JRST FIXBUF ;CONTINUE IN MAIN STREAM
17200 TMPSW: PJOB REG1 , ;GET JOBNAME
17300 MOVEI AC0 ,3 ;LENGTH IN DECIMAL
17400 MOVE REG3 ,FILNAM(REG) ;GET FILENAME
17500 TMPLP: IDIVI REG1 ,12 ;CONVERT
17600 ADDI REG2 ,"0"-40 ;JOBNAME
17700 LSHC REG2 ,-6 ;TO
17800 SOJG AC0 ,TMPLP ;SIXBITIZED DECIMAL
17900 MOVEM REG3 ,FILNAME(REG) ;NEW FILENAME IS NNNXXX.YYY
18000 JRST TMPRET ;RETRY FROM DISK
18100 ;
18200 ;*** PROCEDURE REOPEN
18300 ; - CLOSE A FILE
18400 ; - OPEN SAME OR NEW FILE
18500 ; - <REG>=FILE-BLOCK
18600 ; - <REG1>=FILENAME
18700 ; - REG2=PROTECTION-CODE
18800 ; - REG3=PROJ.-PROGR.-NR.
18900 ; - <REG4>=DEVICE
19000 ;
19100 REOPEN: HRRZ REG6 ,FILBFH(REG) ;GET ADDRESS OF NEXT BUFFER IN RING
19200 SETZM TMPFLG ;NO TEMPCORE-FILE
19300 SKIPE REG4 ;NEW DEVICE
19400 SETZM REG6 ;YES - FORCE GETTING NEW
19500 ;BUFFERS AFTER OPEN
19600 PUSHJ TOPP ,CLSFIL ;CLOSE
19700 MOVEM AC0 ,FILSTA+2(REG) ;INSERT APPROPRIATE BF-HEADER ADDRESS
19800 LSH REG2 ,33 ;SHIFT LEFT PROT 27 BITS
19900 MOVEM REG2 ,FILPROT(REG) ;INSERT PROTECTION CODE
20000 MOVEM REG3 ,FILPPN(REG) ;PROJECT-PROGR. NUMBER
20200 HLLZS AC1 ,FILEXT(REG) ;TO GET CORRECT CRE-DATE
20300 JUMPE REG1 ,OPN ;RETAIN PREVIOUS FILENAME
20400 ;AS DEFAULT IF NO ADDRESS IS SPECIFIED
20500 HRRI AC1 ,FILNAM(REG) ;WHERE TO DEPOSIT IT
20600 MOVEI REG5 ,11 ;BYTE COUNT
20700 PUSHJ TOPP ,ASTOSX ;CONVERT FILENAME TO SIXBIT
20800 JUMPE REG4 ,OPN ;NEW DEVICE ?
20900 MOVEI REG1 ,(REG4) ;YES - GET ADDRESS OF DEVICE NAME
21000 MOVEI AC1 ,FILSTA+1(REG) ;AND WHERE TO PUT SIXBIT NAME
21100 MOVEI REG5 ,6 ;BYTE COUNT
21200 PUSHJ TOPP ,ASTOSX ;CONVERT TO SIXBIT
21300 OPN: SETZM FILEOF(REG) ;CLEAR EOF - MARKER
21400 SETZM FILEOL(REG) ;CLEAR EOL - MARKER
21500 AOS FILEOL(REG) ;SET EOL TO FORCE TEST FOR LINENR.
21600 SETZM FILCMP(REG) ;CLEARS COMPONENT
21700 MOVE AC0 ,[ASCII/-----/] ;INITIALIZE LINE-NUMBER
21800 MOVEM AC0 ,FILLNR(REG)
21900 HLR AC0 ,FILPTR(REG) ;FILE-FORM?
22000 TRNN AC0 ,FILDAT ;SKIP IF BINARY
22100 HRRZS FILCNT(REG) ;CLEAR CHARACTERCOUNT IF ASCII
22200 PUSHJ TOPP ,TMPTST ;IS IT A TEMP-FILE?
22300 JRST TEMPCR ;YES, OPEN TEMPCORE-FILE
22400 TMPRET: XCT FILOPN(REG) ;OPEN
22500 JRST SETEOF ;ERROR ON OPEN
22600
22700 FIXBUF: JUMPE REG6 ,REOPRT ;BUFFER RING ESTABLISHED ?
22800 TLO REG6 ,400000 ;YES - RESET RING USE BIT
22900 MOVEM REG6 ,FILBFH(REG) ;
23000 HRLZI AC0 ,400000 ;MASK TO CLEAR BUFFER USE BIT
23100 ANDCAM AC0 ,(REG6)
23200 HRR REG6 ,(REG6) ;ADDRESS OF NEXT BUFFER IN RING
23300 CAME REG6 ,FILBFH(REG) ;ONCE AROUND ?
23400 JRST .-3 ;NOT YET
23500 REOPRT: POPJ TOPP , ;OK - RETURN
23600
23700 TMPER1: OUTSTR [ASCIZ/
23800 %? NOT ENOUGH CORE TO READ TEMPCORE-FILE /]
23900 PUSHJ TOPP ,WRTFNM
24000 JRST WRTPC
24100 ;
24200 ;*** LITERALS
24300 ;
24400 LIT
24500 PRGEND
00100 TITLE REASTR *** PROCEDURES READS AND READPS ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY READS
00700 ENTRY READPS
00800 ;
00900 ;*** EXTERNAL REFERENCES ***
01000 ;
01100 EXTERN CONERR
01200 EXTERN GETCH
01300 ;
01400 ;*** REGISTER DEFINITION ***
01500 ;
01600 AC0= 0
01700 AC1= 1
01800 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01900 REG= REGIN+1
02000 REG1= REGIN+1+1
02100 REG2= REGIN+1+2
02200 REG3= REGIN+1+3
02300 REG4= REGIN+1+4
02400 REG5= REGIN+1+5
02500 REG6= REGIN+1+6
02600 NEWREG= 15
02700 TOPP= 17
02800 ;
02900 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
03000 ;
03100 FILPTR= 0
03200 FILEOF= 1
03300 FILEOL= 2
03400 FILOPN= 3
03500 FILLKP= 4
03600 FILENT= 5
03700 FILIN= 6
03800 FILOUT= 7
03900 FILCLS= 10
04000 FILSTA= 11 ;.+0 FOR FILESTATUS
04100 ;.+1 FOR DEVICE
04200 ;.+2 FOR POINTER TO BUFFERHEADER
04300 FILNAM= 14
04400 FILEXT= 15
04500 FILPRO= 16
04600 FILPPN= 17
04700 FILBFH= 20 ;BUFFER HEADER
04800 FILBTP= 21 ;BYTE POINTER
04900 FILBTC= 22 ;BYTE COUNT IN BUFFER
05000 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
05100 ;CTERS
05200 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
05300 ;R OF WORDS IN COMPONENT
05400 ;IF ASCII MODE : CHARACTERCNT IN LIN
05500 ;E AND TAB INDICATOR
05600 ;RH= ADDRESS OF FIRST WORD IN COMPONE
05700 ;NT
05800 FILCMP= 25 ;FIRST WORD OF COMPONENT
05900 ;
06000 ;*** START OF INVARIANT CODE ***
06100 ;
06200 RELOC 400000
06300 ;
06400 ;*** PROCEDURE READS/READPS
06500 ; - READ STRING/PACKED STRING
06600 ; - <REG>=FILE-BLOCK
06700 ; - <REG1>=STRING
06800 ; - REG2=LENGTH
06900 ;
07000 READS: MOVE REG3 ,[POINT 36,(REG1),-1] ;BYTE-PTR FOR FULLWORD
07100 SKIPA
07200 READPS: MOVE REG3 ,[POINT 7,(REG1),-1] ;BYTE-PTR FOR PACKED-ASCII
07300 SKIPBL: MOVE AC0 ,FILCMP(REG) ;FETCH COMP.
07400 CAIE AC0 ," " ;BLANK?
07500 JRST NONBLK ;NO
07600 PUSHJ TOPP ,GETCH ;SKIP BLANK
07700 JRST SKIPBL ;LOOP AROUND
07800 NONBLK: CAIE AC0 ,"'" ;HYPHON?
07900 JRST CONERR ;HMM...
08000 PUSHJ TOPP ,GETCH ;SKIP IT
08100 MOVEI REG4 ," " ;PREV. CHAR NON-HYPHON
08200 SKIPA
08300 READLP: PUSHJ TOPP ,GETCH ;GET NEXT
08400 MOVE AC0 ,FILCMP(REG) ;FETCH 1ST BYTE OF STRG
08500 CAIN AC0 ,"'" ;HYPHON?
08600 JRST HYPHON ;YES
08700 CAIN REG4 ,"'" ;PREV. CHAR HYPHON?
08800 JRST CONERR ;YES-MUST NOT HAPPEN
08900 JRST DEPSIT ;NO-DEPOSIT CHAR
09000 HYPHON: CAIN REG4 ,"'" ;PREV. CHAR HYPHON?
09100 JRST DEPSIT ;YES-DEPOSIT HYPH.
09200 MOVE REG4 ,AC0 ;SAVE HYPHON
09300 JRST READLP ;LOOP AROUND
09400 DEPSIT: IDPB AC0 ,REG3 ;DEPOSIT BYTE
09500 MOVEI REG4 ," " ;PREV. CHAR NON-HYPHON
09600 SOJG REG2 ,READLP ;LOOP AROUND
09700 PUSHJ TOPP ,GETCH
09800 MOVE AC0 ,FILCMP(REG) ;FETCH LAST BYTE
09900 CAIE AC0 ,"'" ;IS IT A HYPHON?
10000 JRST CONERR ;SORRY...
10100 PUSHJ TOPP ,GETCH ;POSITION FILE
10200 POPJ TOPP , ;AND RETURN TO USER
10300 ;
10400 ;*** LITERALS
10500 ;
10600 LIT
10700 PRGEND
00100
00200 TITLE CLOSE *** PROCEDURE CLSFIL ***
00300 TWOSEG
00400 ;
00500 ;*** ENTRY-POINTS ***
00600 ;
00700 ENTRY CLSFIL
00800 ;
00900 ;*** EXTERNAL-REFERENCES ***
01000 ;
01100 EXTERN TMPCR1
01200 EXTERN TMPTST
01300 ;
01400 ;*** REGISTER DEFINITION ***
01500 ;
01600 AC0= 0
01700 AC1= 1
01800 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01900 REG= REGIN+1
02000 REG1= REGIN+1+1
02100 REG2= REGIN+1+2
02200 REG3= REGIN+1+3
02300 REG4= REGIN+1+4
02400 REG5= REGIN+1+5
02500 REG6= REGIN+1+6
02600 NEWREG= 15
02700 TOPP= 17
02800 ;
02900 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
03000 ;
03100 FILPTR= 0
03200 FILEOF= 1
03300 FILEOL= 2
03400 FILOPN= 3
03500 FILLKP= 4
03600 FILENT= 5
03700 FILIN= 6
03800 FILOUT= 7
03900 FILCLS= 10
04000 FILSTA= 11 ;.+0 FOR FILESTATUS
04100 ;.+1 FOR DEVICE
04200 ;.+2 FOR POINTER TO BUFFERHEADER
04300 FILNAM= 14
04400 FILEXT= 15
04500 FILPRO= 16
04600 FILPPN= 17
04700 FILBFH= 20 ;BUFFER HEADER
04800 FILBTP= 21 ;BYTE POINTER
04900 FILBTC= 22 ;BYTE COUNT IN BUFFER
05000 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
05100 ;CTERS
05200 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
05300 ;R OF WORDS IN COMPONENT
05400 ;IF ASCII MODE : CHARACTERCNT IN LIN
05500 ;E AND TAB INDICATOR
05600 ;RH= ADDRESS OF FIRST WORD IN COMPONE
05700 ;NT
05800 FILCMP= 25 ;FIRST WORD OF COMPONENT
05900 ;
06000 ;*** START OF INVARIANT CODE
06100 ;
06200 RELOC 400000
06300 ;
06400 ;*** PROCEDURE CLSFIL
06500 ; - CLOSE OPENED FILE
06600 ; - ISSUE TEMPCORE-UUO ON TEMP-FILES
06700 ; - <REG>=FILE-BLOCK
06800 ;
06900 CLSFIL: SKIPN AC1, FILSTA+2(REG) ;NEVER OPENED?
07000 POPJ TOPP, ;YES - NOTHING TO CLOSE
07100 TLNN AC1, 777777 ;OPEN FOR OUTPUT?
07200 JRST CLSIN ;NO - CLOSE IT
07300 PUSHJ TOPP, TMPCR1 ;ISSUE TEMPCORE-UUO
07400 ;IF TEMP-FILE
07500 PUSHJ TOPP, TMPTST ;WAS IT TEMP-FILE?
07600 POPJ TOPP, ;YES - NOTHING TO CLOSE
07700 CLSIN: XCT FILCLS(REG) ;CLOSE FILE
07800 POPJ TOPP, ;RETURN TO CALLER
07900 ;
08000 ;*** LITERALS
08100 ;
08200 LIT
08300 PRGEND
00100 TITLE PUT *** PROCEDURES PUT, PUTCH, PUTLN, PUTPG AND TMPCRW ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY PUT
00700 ENTRY TMPCRW
00800 ENTRY TMPCR1
00900 ENTRY PUTCH
01000 ENTRY PUTBUF
01100 ENTRY PUTLN
01200 ENTRY PUTPG
01300 ;
01400 ;*** EXTERNAL-REFERENCES ***
01500 ;
01600 EXTERN PUTERR
01700 EXTERN TMPBLK
01800 EXTERN SETEOF
01900 EXTERN TMPTST
02000 EXTERN WRTPC
02100 EXTERN WRTFNM
02200 ;
02300 ;*** REGISTER DEFINITION ***
02400 ;
02500 AC0= 0
02600 AC1= 1
02700 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02800 REG= REGIN+1
02900 REG1= REGIN+1+1
03000 REG2= REGIN+1+2
03100 REG3= REGIN+1+3
03200 REG4= REGIN+1+4
03300 REG5= REGIN+1+5
03400 REG6= REGIN+1+6
03500 NEWREG= 15
03600 TOPP= 17
03700 ;
03800 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
03900 ;
04000 FILBIN= 17 ;FLAGS TO TEST FOR ASCII-MODE
04100 FILPTR= 0
04200 FILEOF= 1
04300 FILEOL= 2
04400 FILOPN= 3
04500 FILLKP= 4
04600 FILENT= 5
04700 FILIN= 6
04800 FILOUT= 7
04900 FILCLS= 10
05000 FILSTA= 11 ;.+0 FOR FILESTATUS
05100 ;.+1 FOR DEVICE
05200 ;.+2 FOR POINTER TO BUFFERHEADER
05300 FILNAM= 14
05400 FILEXT= 15
05500 FILPRO= 16
05600 FILPPN= 17
05700 FILBFH= 20 ;BUFFER HEADER
05800 FILBTP= 21 ;BYTE POINTER
05900 FILBTC= 22 ;BYTE COUNT IN BUFFER
06000 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
06100 ;CTERS
06200 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
06300 ;R OF WORDS IN COMPONENT
06400 ;IF ASCII MODE : CHARACTERCNT IN LIN
06500 ;E AND TAB INDICATOR
06600 ;RH= ADDRESS OF FIRST WORD IN COMPONE
06700 ;NT
06800 FILCMP= 25 ;FIRST WORD OF COMPONENT
06900 ;
07000 ;*** CONSTANTS ***
07100 ;
07200 TMPSIZ= 200
07300 ;
07400 ;*** START OF VARIANT CODE
07500 ;
07600 CLSFLG: XWD 0,0
07700 RENBLK: XWD 0,0
07800 XWD 0,0
07900 XWD 0,0
08000 XWD 0,0
08100 RENUUO: XWD 0,RENBLK
08200 ;
08300 ;*** START OF INVARIANT CODE
08400 ;
08500 RELOC 400000
08600 ;
08700 ;*** PROCEDURE PUTCH
08800 ; - PUT ONE CHAR
08900 ; - <REG>=FILE-BLOCK
09000 ; - AC0=CHAR
09100 ;
09200 PUTCH: SKIPG FILEOF(REG) ;EOF?
09300 JRST PUTNEOF ;NO
09400 PTCTEST:SOSGE FILBTC(REG) ;SPACE LEFT IN BUFFER?
09500 JRST [
09600 PUSHJ TOPP ,PUTBF1 ;PUT CURRENT BUFFER
09700 JRST PTCTEST] ;RET TO CALLER
09800 IDPB AC0 ,FILBTP(REG) ;DEPOSIT CHARACTER IN OUTPUT BUFFER
09900 POPJ TOPP , ;RETURN
10000 ;
10100 ;*** PROCEDURE PUT
10200 ; - PUT FILE-COMPONENT
10300 ; - <REG>=FILE-BLOCK
10400 ;
10500 PUT: SKIPG FILEOF(REG) ;EOF ?
10600 JRST PUTNEOF ;NO
10700 MOVE AC1 ,FILCNT(REG) ;GET TRANSFER COUNT
10800 ;FOR FILE COMPONENT
10900 PUTEST: SOSGE FILBTC(REG) ;SPACE LEFT IN BUFFER ?
11000 JRST [
11100 PUSHJ TOPP ,PUTBF1 ;PUT CURRENT BUFFER
11200 JRST PUTEST] ;RET TO CALLER
11300 MOVE AC0 ,(AC1) ;GET NEXT WORD OF COMPONENT
11400 IDPB AC0 ,FILBTP(REG) ;DEPOSIT IN OUTPUT BUFFER
11500 AOBJN AC1 ,PUTEST ;MORE WORDS IN COMPONENT ?
11600 POPJ TOPP , ;NO
11700 ;
11800 ;*** PROCEDURE PUTBUF
11900 ; - PUT CURRENT BLOCK
12000 ; DISK-BLOCKS ARE ALWAYS FILLED UP
12100 ; WITH ZEROS TO 128 WORDS, EXCEPT OF
12200 ; THE LAST ONE WRITTEN BY CLOSE
12300 ; - <REG>=FILE-BLOCK
12400 ;
12500 PUTBUF: PUSHJ TOPP ,PUTBF1
12600 POPJ TOPP ,
12700 PUTBF1: PUSHJ TOPP ,TMPCRW ;WRITE TEMP-FILE
12800 XCT FILOUT(REG) ;PUT BUFFER
12900 POPJ TOPP , ;OK-RETURN TO CALLER
13000 JRST PUTERR ;I/O-ERROR
13100
13200 PUTNEOF:OUTSTR [ASCIZ/
13300 %? REWRITE FOR FILE /]
13400 PUSHJ TOPP ,WRTFNM
13500 OUTSTR [ASCIZ/ REQUIRED/]
13600 JRST WRTPC
13700 ;
13800 ;*** PROCEDURE PUTLN
13900 ; - WRITE <CR><LF>
14000 ; - <REG>=FILE-BLOCK
14100 ;
14200 PUTLN: MOVEI AC0 ,15 ;<CR>
14300 PUSHJ TOPP ,PUTCH
14400 MOVEI AC0 ,12 ;<LF>
14500 PUSHJ TOPP ,PUTCH
14600 POPJ TOPP ,
14700 ;
14800 ;*** PROCEDURE PUTPG
14900 ; - WRITE <CR><FF>
15000 ; - <REG>=FILE-BLOCK
15100 ;
15200 PUTPG: MOVEI AC0 ,15 ;<CR>
15300 PUSHJ TOPP ,PUTCH ;
15400 MOVEI AC0 ,14 ;<FF>
15500 PUSHJ TOPP ,PUTCH
15600 POPJ TOPP ,
15700 ;
15800 ;*** PROCEDURE TMPCRW
15900 ; - ISSUE TMPCOR-UUO ON CURRENT BUFFER
16000 ; - RETURN TO CALLER IF UUO FAILS
16100 ; - SET EOF TO PREVENT WRITING OF
16200 ; MORE THAN 1 BUFFER IF OK
16300 ; - <REG>=FILE-BLOCK
16400 ;
16500 TMPCR1: SETOM CLSFLG ;COMING FROM CLSFIL OR REOPEN
16600 SKIPA
16700 TMPCRW: SETZM CLSFLG ;COMING FROM PUTBUFFER
16800 PUSH TOPP ,AC0
16900 PUSH TOPP ,AC1
17000 PUSH TOPP ,REG1
17100 HLLZ AC1 ,FILEXT(REG)
17200 CAME AC1 ,[SIXBIT/TMP /]
17300 JRST LEAVE
17400 HLLZ AC1 ,FILNAM(REG)
17500 CAMLE AC1 ,[SIXBIT/999 /]
17600 JRST LEAVE
17700 HRLZ AC0 ,FILNAM(REG)
17800 MOVEM AC0 ,TMPBLK ;PTR TO CONT.-BLOCK
17900 MOVE AC0 ,FILBTC(REG) ;BUFFER'S BYTE-COUNT
18000 HRR AC1 ,FILSTA(REG) ;BINARY-MODE?
18100 TRNN AC1 ,FILBIN ;SKIP IF YES?
18200 PUSHJ TOPP ,ASCFI ;CORRECT BYTE-COUNT
18300 SUBI AC0 ,TMPSIZ ;GET NEG NUM OF CHARS
18400 HRLM AC0 ,TMPBLK+1 ;TO CONT.-BLOCK
18500 HRR AC0 ,FILBFH(REG) ;GET BUFFER'S ADDR
18600 ADDI AC0 ,1 ;POINT TO 1ST CHAR
18700 HRRM AC0 ,TMPBLK+1 ;TO CONT.-BLOCK
18800 MOVE AC0 ,[XWD 3,TMPBLK] ;DO TEMPCORE
18900 TMPCOR AC0 , ;WRITE
19000 JRST LEAVE
19100 HRLZI AC0 ,400000 ;KILL
19200 IORM AC0 ,FILBFH(REG) ;BUFFER-RING
19300 XCT FILCLS(REG) ;CLOSE DISK FILE
19400 HLL AC1, FILENT(REG) ;SET
19500 TLZ AC1, 22000 ;UP
19600 HLLM AC1, RENUUO ;RENAME-UUO
19700 XCT RENUUO ;AND DELETE DISK FILE
19800 SKIP
19900 MOVE AC1, FILNAM(REG) ;RESTORE
20000 HRLZM AC1, FILNAM(REG) ;FILENAME
20100 SKIPE CLSFLG
20200 JRST LEAVE
20300 POP TOPP ,REG1 ;RESTORE REG1
20400 POP TOPP ,AC1 ;RESTORE AC1
20500 POP TOPP ,AC0 ;RESTORE AC0
20600 POP TOPP ,
20700 POP TOPP ,
20800 JRST SETEOF
20900 LEAVE: POP TOPP ,REG1 ;RESTORE REG1
21000 POP TOPP ,AC1
21100 POP TOPP ,AC0
21200 POPJ TOPP ,
21300 ASCFI: IDIVI AC0 ,5
21400 CAIG AC1 ,0
21500 POPJ TOPP ,
21600 MOVEI REG1 ," "
21700 IDPB REG1 ,FILBTP(REG)
21800 SOJG AC1 ,.-1
21900 POPJ TOPP ,
22000 ;
22100 ;*** LITERALS
22200 ;
22300 LIT
22400 PRGEND
00100 TITLE GET *** PROCEDURES GET, GETCH AND GETLN ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY GET
00700 ENTRY GETBUF
00800 ENTRY GETCH
00900 ENTRY GETLN
01000 ;
01100 ;*** EXTERNAL REFERENCES ***
01200 ;
01300 EXTERN TMPTST
01400 EXTERN SETEOF
01500 EXTERN WRTPC
01600 EXTERN WRTFNM
01700 ;
01800 ;*** REGISTER DEFINITION ***
01900 ;
02000 AC0= 0
02100 AC1= 1
02200 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02300 REG= REGIN+1
02400 REG1= REGIN+1+1
02500 REG2= REGIN+1+2
02600 REG3= REGIN+1+3
02700 REG4= REGIN+1+4
02800 REG5= REGIN+1+5
02900 REG6= REGIN+1+6
03000 NEWREG= 15
03100 TOPP= 17
03200 ;
03300 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
03400 ;
03500 FILPTR= 0
03600 FILEOF= 1
03700 FILEOL= 2
03800 FILOPN= 3
03900 FILLKP= 4
04000 FILENT= 5
04100 FILIN= 6
04200 FILOUT= 7
04300 FILCLS= 10
04400 FILSTA= 11 ;.+0 FOR FILESTATUS
04500 ;.+1 FOR DEVICE
04600 ;.+2 FOR POINTER TO BUFFERHEADER
04700 FILNAM= 14
04800 FILEXT= 15
04900 FILPRO= 16
05000 FILPPN= 17
05100 FILBFH= 20 ;BUFFER HEADER
05200 FILBTP= 21 ;BYTE POINTER
05300 FILBTC= 22 ;BYTE COUNT IN BUFFER
05400 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
05500 ;CTERS
05600 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
05700 ;R OF WORDS IN COMPONENT
05800 ;IF ASCII MODE : CHARACTERCNT IN LIN
05900 ;E AND TAB INDICATOR
06000 ;RH= ADDRESS OF FIRST WORD IN COMPONE
06100 ;NT
06200 FILCMP= 25 ;FIRST WORD OF COMPONENT
06300 ;
06400 ;*** START OF INVARIANT CODE
06500 ;
06600 RELOC 400000
06700 ;
06800 ;*** PROCEDURE GETLN
06900 ; - READ 1ST CHAR OF NEXT LINE
07000 ; - TEST FOR LINE-NUMBER AND PAGE-MARK
07100 ; - <REG>=FILE-BLOCK
07200 ;
07300 PUSHJ TOPP ,GETCH ;GETS NEXT CHARACTER IN LINE
07400 GETLN: SKIPN FILEOL(REG) ;IS EOLN = TRUE
07500 JRST GETLN-1 ;NO - CHARAKTER'S IN LINE
07600 ;WILL BE OVERREAD
07700 PUSHJ TOPP ,GETCNT ;GET 1ST CHAR OF NEXT LINE
07800 SKIPE FILEOF(REG) ;EOF?
07900 JRST GETEOF ;YES
08000 MOVEI AC0 ,1 ;TEST FOR LINENR OR PAGEMARK
08100 TDNN AC0 ,@FILBTP(REG) ;LAST BIT EQUAL ZERO?
08200 JRST GETRET ;YES - RETURN
08300 MOVE AC1 ,@FILBTP(REG) ;NO - GET LINENUMBER OR PAGEMARK
08400 TRZ AC1 ,1 ;BIT 35 TO ZERO
08500 MOVEM AC1 ,FILLNR(REG) ;STORE IT TO FILLNR
08600 MOVE AC0 ,FILBTC(REG)
08700 SUBI AC0 ,5 ;TO OVERREAD LAST FOUR DIGITS AND TAB
08800 JUMPGE AC0 ,GETNCP ;ALL THIS FIVE CHARACTERS IN THIS BUF
08900 ;FER?
09000 PUSHJ TOPP ,GETBUF ;GET A NEW BUFFER
09100 IBP FILBTP(REG) ;TO OVERREAD TAB OR FIRST CARRIGE RET
09200 ;URN
09300 SOS FILBTC(REG)
09400 JRST .+3
09500 GETNCP: MOVEM AC0 ,FILBTC(REG) ;RESTORE BYTECOUNT
09600 AOS FILBTP(REG) ;INCREMENTS BYTEPOINTER BY 5
09700 ;4 DIGITS AND TAB
09800 CAME AC1 ,[ASCII/ /] ;PAGE MARK ?
09900 JRST .+4 ;NO - GET NEXT CHARACTER
10000 AOS FILEOL(REG) ;YES - SET END OF LINE
10100 SETZ AC1 , ;CHARACTERCNT TO ZERO
10200 JRST GETBLK
10300 HRRZS FILCNT(REG) ;SETS CHARACTERCOUNT TO ZERO
10400 ;
10500 ;*** PROCEDURE GETCH
10600 ; - READ ONE CHAR
10700 ; - <REG>=FILE-BLOCK
10800 ;
10900 GETCH: SKIPE FILEOF(REG) ;EOF ?,(GETCH GETS ONE CHARACTER,TEXT
11000 ;FILES ONLY)
11100 JRST GETEOF ;YES - TEST WETHER TOO MANY
11200 ;ATTEMPTS TO OVERREAD EOF
11300 SKIPE FILEOL(REG) ;EOLN ?
11400 JRST GETLN ;YES - LOOK FOR LINER
11500 getcnt: skipn filsta+2(reg) ;file open?
11600 jrst geterr ;no - pufffffff
11700 MOVE AC1 ,FILCNT(REG) ;GET TRANSFER WORD FOR FILECOMPONENT
11800 JUMPGE AC1 ,GTCTEST ;REMAINING BLANKS FREE?
11900 AOBJP AC1 ,.+1 ;YES - INCREMENT CHARACTERCNT
12000 ;(WILL NEVER JUMP)
12100 TLNN AC1 ,7 ;CHARACTERCNT IS ZERO MODE 7
12200 TLZ AC1 ,400000 ;YES - CLEAR TAB INDICATOR
12300 JRST GETRET
12400 PUSHJ TOPP ,GETBUF ;GET NEXT BUFFER
12500 GTCTEST:SOSGE FILBTC(REG) ;ANY BYTE LEFT IN BUFFER ?
12600 JRST GTCTEST-1 ;NO - GO FOR NEXT BUFFER
12700 ILDB AC0 ,FILBTP(REG) ;GET NEXT BYTE
12800 MOVEM AC0 ,(AC1) ;DEPOSIT IT IN FILE COMPONENT
12900 AOBJN AC1 ,GTCTEST ;NEVER JUMPS
13000 SETZM FILEOL(REG) ;RESETS FILEOL IN ASCII-FILE
13100 CAILE AC0 ,137 ;CHECK FOR LEGAL PASCAL-CHARACTER
13200 JRST GETCON ;CORRECT LOWER TO UPPER CASE
13300 CAIL AC0 ," " ;BELOW BLANK ?
13400 JRST GETRET ;NO-VALID PASCAL CHAR
13500 CAIN AC0 ,11 ;HORIZONTAL TAB
13600 JRST GETTAB ;YES
13700 CAIE AC0 ,12 ;LINE FEED?
13800 JRST GETCNT ;NO - FORGET IT
13900 AOS FILEOL(REG) ;SET EOLN
14000 SETZ AC1 , ;CLEARS CHARACTERCOUNT
14100 JRST GETBLK ;GET BLANK IF LF
14200 GETCON: SUBI AC0 ,40 ;CORR. CHAR
14300 JRST GETNEW ;DEP. INTO FILCOMP
14400 GETTAB: TLNE AC1 ,7 ;IS THIS TAB ON
14500 ;CHARACTERCOUNT MODULO 8 = 0
14600 TLO AC1 ,400000 ;NO -SETS TAB INDICATOR
14700 GETBLK: MOVEI AC0 ," "
14800 GETNEW: MOVEM AC0 ,FILCMP(REG)
14900 GETRET: HLLM AC1 ,FILCNT(REG) ;SAVES NEW CHARACTERCNT AND TAB INDIC
15000 ;ATOR
15100 POPJ TOPP ,
15200 GETEOF: AOSGE FILEOF(REG) ;TOO MANY ATTEMPTS ?
15300 POPJ TOPP , ;NO - RETURN
15400 AOS FILEOF(REG) ;SET EOF TRUE
15500 OUTSTR [ASCIZ/
15600 %? INPUT ERROR: ATTEMPT TO READ BEYOND EOF OF /]
15700 errout: PUSHJ TOPP ,WRTFNM ;WRITE FILE NAME
15800 JRST WRTPC
15900 geterr: outstr [asciz/
16000 %? INPUT ERROR: RESET REQUIRED FOR /]
16100 jrst errout
16200 ;
16300 ;*** PROCEDURE GET
16400 ; - READ NEXT FILE-COMPONENT
16500 ; - <REG>=FILE-BLOCK
16600 ;
16700 GET: SKIPE FILEOF(REG) ;EOF?
16800 JRST GETEOF ;YES-TEST WETHER TOO MANY ATTEMPTS TO
16900 ; OVERREAD EOF
17000 MOVE AC1 ,FILCNT(REG) ;GET TRANSFER WORD FOR FILECOMPONENT
17100 GETEST: SOSGE FILBTC(REG) ;ANY BYTE LEFT IN BUFFER?
17200 JRST [
17300 PUSHJ TOPP ,GETBUF ;GET NEXT BUFFER
17400 JRST GETEST] ;RETURN TO CALLER
17500 ILDB AC0 ,FILBTP(REG) ;GET NEXT BYTE
17600 MOVEM AC0 ,(AC1) ;DEPOSIT IT IN FILECOMPONENT
17700 AOBJN AC1 ,GETEST ;MORE BYTES IN THIS COMPONENT?
17800 POPJ TOPP , ;NO ,RETURN
17900 ;
18000 ;*** PROCEDURE GETBUF
18100 ; - GET NEXT BUFFER
18200 ; - <REG>=FILE-BLOCK
18300 ;
18400 GETBUF: PUSHJ TOPP ,TMPTST ;IS IT A TEMPFILE?
18500 JRST BADIO ;YES-ONLY 1 BUFFER ALLOWED
18600 XCT FILIN(REG) ;GET NEXT BUFFER
18700 POPJ TOPP , ;OK-RETURN TO CALLER
18800 BADIO: POP TOPP , ;FORGET LAST LINK
18900 JRST SETEOF ;SET EOF IF ERROR
19000 ;
19100 ;*** LITERALS ***
19200 ;
19300 LIT
19400 PRGEND
00100 TITLE DATE *** PROCEDURE DATE ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY DATE.
00700 ENTRY DATE
00800 ;
00900 ;*** EXTERNAL REFERENCES ***
01000 ;
01100 ;
01200 ;*** REGISTER DEFINITION ***
01300 ;
01400 AC0= 0
01500 AC1= 1
01600 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01700 REG= REGIN+1
01800 REG1= REGIN+1+1
01900 REG2= REGIN+1+2
02000 REG3= REGIN+1+3
02100 REG4= REGIN+1+4
02200 REG5= REGIN+1+5
02300 REG6= REGIN+1+6
02400 NEWREG= 15
02500 TOPP= 17
02600 ;
02700 ;*** START OF INVARIANT CODE ***
02800 ;
02900 RELOC 400000
03000 ;
03100 ;*** PROCEDURE DATE
03200 ; - STORE STANDARD ASCII-DATE
03300 ; DD-MMM-YY INTO LOCATION <REG>
03400 ; - <REG>=ASCII/10 CHAR. DATE/
03500 ;
03600 GETINF: GETTAB AC0 , ;GET VALUE FROM SYSTEM-TABLE
03700 POPJ TOPP ,
03800 IDIVI AC0 ,144
03900 HRRZ AC0 ,AC1
04000 IDIVI AC0 ,12 ;DIV BY 10
04100 ADDI AC0 ,60 ;GET TWO
04200 ADDI AC1 ,60 ;ASCII NUMBERS
04300 IDPB AC0 ,REG1 ;DEPOSIT 1ST
04400 IDPB AC1 ,REG1 ;DEPOSIT 2ND
04500 POPJ TOPP , ;RETURN TO CALLER
04600
04700 DATE:
04800 DATE.: PUSH TOPP ,REG1 ;SAVE
04900 PUSH TOPP ,REG2 ;THREE
05000 PUSH TOPP ,REG3 ;REGS
05100 MOVE REG1 ,[POINT 7,(REG),-1] ;BTP FOR DATE-STRING
05200 MOVE AC0 ,[XWD 60,11] ;GET DAY
05300 PUSHJ TOPP ,GETINF
05400 HRRZI AC0 ,"-" ;DEPOSIT "-"
05500 IDPB AC0 ,REG1
05600 MOVE AC1 ,[XWD 57,11] ;GET MONTH
05700 GETTAB AC1 ,
05800 JRST END ;MERDE
05900 MOVE REG2 ,[POINT 7,MONTHS-1(AC1),-1] ;BTP FOR MONTH-ABBREV.
06000 HRRZI REG3 ,3 ;COUNTER
06100 LOOP: ILDB AC0 ,REG2 ;GET CHAR
06200 IDPB AC0 ,REG1 ;DEPOSIT IN STRING
06300 SOJG REG3 ,LOOP ;DO IT THREE TIMES
06400 HRRZI AC0 ,"-" ;ANOTHER "-"
06500 IDPB AC0 ,REG1
06600 MOVE AC0 ,[XWD 56,11] ;GET YEAR
06700 PUSHJ TOPP ,GETINF
06800 HRRZI AC0 ," "
06900 IDPB AC0 ,REG1
07000 END: POP TOPP ,REG3 ;RESTORE
07100 POP TOPP ,REG2 ;SAVED
07200 POP TOPP ,REG1 ;REGS
07300 POPJ TOPP , ;RET TO CALLER
07400
07500 MONTHS: ASCIZ/JAN FEB MAR APR MAY JUN JUL AUG SEP OCT NOV DEC /
07600 ;
07700 ;*** LITERALS ***
07800 ;
07900 LIT
08000 PRGEND
00100 TITLE TIME *** PROCEDURE TIME ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY TIME.
00700 ENTRY TIME
00800 ;
00900 ;*** EXTERNAL REFERENCES ***
01000 ;
01100 ;
01200 ;*** REGISTER DEFINITION ***
01300 ;
01400 AC0= 0
01500 AC1= 1
01600 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01700 REG= REGIN+1
01800 REG1= REGIN+1+1
01900 REG2= REGIN+1+2
02000 REG3= REGIN+1+3
02100 REG4= REGIN+1+4
02200 REG5= REGIN+1+5
02300 REG6= REGIN+1+6
02400 NEWREG= 15
02500 TOPP= 17
02600 ;
02700 ;*** START OF INVARIANT CODE ***
02800 ;
02900 RELOC 400000
03000 ;
03100 ;*** PROCEDURE TIME
03200 ; - STORE STANDARD ASCII-TIME
03300 ; HH:MM:SS INTO LOCATION <REG>
03400 ; - <REG>=ASCII/10 CHAR. TIME/
03500 ;
03600 GETINF: GETTAB AC0 , ;GET VALUE FROM SYSTEM-TABLE
03700 POPJ TOPP ,
03800 IDIVI AC0 ,12 ;DIV BY 10
03900 ADDI AC0 ,60 ;GET TWO
04000 ADDI AC1 ,60 ;ASCII NUMBERS
04100 IDPB AC0 ,REG1 ;DEPOSIT 1ST
04200 IDPB AC1 ,REG1 ;DEPOSIT 2ND
04300 POPJ TOPP , ;RETURN TO CALLER
04400
04500 TIME:
04600 TIME.: PUSH TOPP ,REG1 ;SAVE REG1
04700 MOVE REG1 ,[POINT 7,(REG),-1] ;BTP FOR TIME-STRING
04800 MOVE AC0 ,[XWD 61,11] ;GET HOURS
04900 PUSHJ TOPP ,GETINF
05000 HRRZI AC0 ,":" ;DEPOSIT ":"
05100 IDPB AC0 ,REG1
05200 MOVE AC0 ,[XWD 62,11] ;GET MINUTES
05300 PUSHJ TOPP ,GETINF
05400 HRRZI AC0 ,":" ;ANOTHER ":"
05500 IDPB AC0 ,REG1
05600 MOVE AC0 ,[XWD 63,11] ;GET SECONDS
05700 PUSHJ TOPP ,GETINF
05800 HRRZI AC0 ," "
05900 IDPB AC0 ,REG1
06000 HRRZI AC0 ," "
06100 IDPB AC0 ,REG1
06200 END: POP TOPP ,REG1 ;RESTORE REG1
06300 POPJ TOPP , ;RETURN TO CALLER
06400 ;
06500 ;*** LITERALS ***
06600 ;
06700 LIT
06800 PRGEND
00100 TITLE EXIT *** PROCEDURES WRTPC AND OTHER EXITS ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY WRTPC
00700 ENTRY CORERR
00800 ENTRY OVERF.
00900 ENTRY INXERR
01000 ENTRY SRERR
01100 ENTRY CONERR
01200 ENTRY PUTERR
01300 ENTRY END
01400 ENTRY STOP
01500 ENTRY IPTERR
01600 ENTRY SETERR
01700 ENTRY NOCORE
01800 ;
01900 ;*** EXTERNAL REFERENCES ***
02000 ;
02100 EXTERN WRTFNM
02200 ;
02300 ;*** REGISTER DEFINITION ***
02400 ;
02500 AC0= 0
02600 AC1= 1
02700 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02800 REG= REGIN+1
02900 REG1= REGIN+1+1
03000 REG2= REGIN+1+2
03100 REG3= REGIN+1+3
03200 REG4= REGIN+1+4
03300 REG5= REGIN+1+5
03400 REG6= REGIN+1+6
03500 NEWREG= 15
03600 BASIS= 16
03700 TOPP= 17
03800 ;
03900 ;*** ADDRESSES ***
04000 ;
04100 .JBDDT= 74
04200 .JBTPC= 127
04300 ;
04400 ;*** START OF INVARIANT CODE ***
04500 ;
04600 RELOC 400000
04700 ;
04800 ;*** PROCEDURE WRTPC
04900 ; - WRITE USER'S PC AND JUMP
05000 ; INTO PASDDT IF LOADED
05100 ;
05200 WRTPC: OUTSTR [ASCIZ/ AT USER PC /]
05300 HRRZ REG ,(BASIS) ;IF RH = LH = 0 THEN WE
05400 HLRZ AC1 ,(BASIS) ;ARE ON MAIN-PROGRAM LEVEL
05500 CAIN REG ,(AC1) ;IS IT MAIN?
05600 JRST MAIN ;YES
05700 HRRZ REG ,-1(REG) ;GET STARTADD. OF THIS PROCEDURE
05800 SEARCH: HLRZ AC1 ,(REG) ;SEARCH THE INSTRUCTION
05900 CAIE AC1 ,541757 ;HRRI 17,X(17) WHERE X-1 IS THE
06000 AOJG REG ,SEARCH ;LENGTH OF THE ACTIVATION-RECORD
06100 HRRZ AC1 ,(REG) ;THIS IS THE FIRST JUMP
06200 GETADR: ADDI AC1 ,1(BASIS) ;INTO THE RUNTIME-SUPPORT
06300 HRRZ REG ,(AC1) ;RETURN-ADDR IN REG FOR PASDDT
06400 SOJ REG , ;ALWAYS MINUS ONE
06500 HRRZI REG2 ,6
06600 MOVE REG3 ,[POINT 3,REG,17]
06700 ILDB AC1 ,REG3
06800 ADDI AC1 ,60
06900 OUTCHR AC1 ;WRITE PC
07000 SOJG REG2 ,.-3
07100 MOVEI AC1 ,15
07200 OUTCHR AC1
07300 MOVEI AC1 ,12
07400 OUTCHR AC1
07500 HRR AC1 ,.JBDDT ;LOAD PASDDT-ADDR
07600 JUMPE AC1 ,END ;EXIT
07700 JRST 0 ,-1(AC1) ;GOTO 'ERRDB.'
07800 END: EXIT ;EXIT TO MONITOR
07900 MAIN: HRRZ REG ,400000 ;START ADDR OF PROGRAM
08000 HRRZ AC1 ,3(REG) ;WORDS OF STACK USED BY MAIN
08100 JRST GETADR ;CONTINUE TO CALC. USER PC
08200 CORERR: OUTSTR [ASCIZ/
08300 %? STACK OVERRUNS HEAP: RETRY WITH MORE CORE/]
08400 HRRZ REG ,(BASIS) ;TEST IF ERROR IN
08500 HLRZ AC1 ,(BASIS) ;INITIALIZATION
08600 CAIN REG ,(AC1) ;OF PROGRAM
08700 JRST END
08800 STOP: MOVEI TOPP ,-1(BASIS) ;RESET TOPP
08900 HLR BASIS ,-1(BASIS) ;AND BASIS
09000 JRST WRTPC
09100 CONERR: OUTSTR [ASCIZ/
09200 %? INPUT DATA ERROR IN FILE /]
09300 PUSHJ TOPP ,WRTFNM
09400 JRST WRTPC
09500 INXERR: OUTSTR [ASCIZ/
09600 %? ARRAY INDEX OUT OF BOUNDS/]
09700 JRST WRTPC
09800 SRERR: OUTSTR [ASCIZ/
09900 %? SCALAR OUT OF RANGE/]
10000 JRST WRTPC
10100 PUTERR: OUTSTR [ASCIZ/
10200 %? OUTPUT ERROR: DISK SPACE EXHAUSTED FOR FILE /]
10300 PUSHJ TOPP ,WRTFNM ;WRITE FILE NAME
10400 JRST WRTPC
10500 OVERF.: OUTSTR [ASCIZ/
10600 %? ARITHMETIC OVERFLOW OR ZERODIVIDE AT USER PC /]
10700 HRRZ REG, .JBTPC
10800 JRST GETADR+2
10900 IPTERR: OUTSTR [ASCIZ/
11000 %? SCALAR OUT OF RANGE IN FILE /]
11100 PUSHJ TOPP ,WRTFNM
11200 JRST WRTPC
11300 SETERR: OUTSTR [ASCIZ/
11400 %? MORE THAN 72 SET ELEMENTS/]
11500 JRST WRTPC
11600 NOCORE: OUTSTR [ASCIZ/
11700 %? CORE REQUIREMENT GREATER THAN "CORMAX"/]
11800 JRST WRTPC
11900 ;
12000 ;*** LITERALS ***
12100 ;
12200 LIT
12300 PRGEND
00100 TITLE DEBSP *** DEBUG SUPPORT ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS
00500 ;
00600 ENTRY INDEB.
00700 ENTRY EXDEB.
00800 ;
00900 ;*** EXTERNAL REFERENCES
01000 ;
01100 EXTERN END,DEBUG
01200 EXTERN OVERF.
01300
01400 ;REGISTER DEFINITION
01500
01600 AC0=0
01700 AC1=1
01800 REGIN=1 ;INITILISATION OF REGISTERSTACK
01900 REG= REGIN+1
02000 REG1=REGIN+1+1
02100 REG2=REGIN+1+2
02200 REG3=REGIN+1+3
02300 REG4=REGIN+1+4
02400 REG5=REGIN+1+5
02500 REG6=REGIN+1+6
02600 JBFFLW=14
02700 NEWREG=15
02800 BUFFER=15
02900 BASIS=16
03000 TOPP=17
03100 ;
03200 ;*** DESCRIPTION OF FILEBLOCK( SEE WRITEMC)
03300 ;
03400 FILPTR= 0
03500 FILEOF= 1
03600 FILEOL= 2
03700 FILOPN= 3
03800 FILLKP= 4
03900 FILENT= 5
04000 FILIN= 6
04100 FILOUT= 7
04200 FILCLS=10
04300 FILSTA=11 ; .+0 FOR FILESTATUS
04400 ; .+1 FOR DEVICE
04500 ; .+2 FOR POINTER TO BUFFERHEADER
04600 FILNAM=14
04700 FILEXT=15
04800 FILPRO=16
04900 FILPPN=17
05000 FILBFH=20 ;BUFFER HEADER
05100 FILBTP=21 ;BYTE POINTER
05200 FILBTC=22 ;BYTE COUNT IN BUFFER
05300 FILLNR=23 ;IF ASCII MODE - LINENR IN ASCIICHARACTERS
05400 FILCNT=24 ;LH= IF BINARY MODE : NEG. NUMBER OF WORDS IN COMPONENT
05500 ; IF ASCII MODE : NR. OF CH. IN LINE AND TAB INDICATOR
05600 ;RH= ADDRESS OF FIRST WORD IN COMPONENT
05700 FILCMP=25 ;FIRST WORD OF COMPONENT
05800 ;
05900 ;*** CONSTANTS
06000 ;
06100 MAXEOF=10
06200 DEBSIZE=2000 ;1K
06300 ;
06400 ;*** ADDRESSES
06500 ;
06600 .JBREL= 44
06700 .JBDDT= 74
06800 .JBSA=120
06900 .JBFF=121
07000 .JBAPR=125
07100 .JBCNI=126
07200 .JBTPC=127
07300 .JBOPC=130
07400 RGSTRS=140
07500 STACKBO=143
07600 STATUS=144
07700 LIMIT=145
07800 .GTSGN=14
07900 .GTLIM=40
08000 ;
08100 ;*** START OF VARIANT CODE
08200 ;
08300 LOC .JBDDT ;UPDATE .JBDDT
08400 XWD 0,DDTDB.
08500
08600 LOC .JBAPR ;UPDATE .JBAPR
08700 XWD 0, APRINT ;INTERRUPT-ROUTINE
08800 ;
08900 ;*** START OF INVARIANT CODE
09000 ;
09100 RELOC 400000
09200 ;
09300 ;*** PROCEDURE INDEB.
09400 ; - INITIALIZE DEBUG SYSTEM
09500 ;
09600 INDEB.: PUSHJ TOPP ,SHRCOD ;CALL SHARABLE"
09700 JUMPE AC1 ,.+3 ;NOT SHR
09800 OUTSTR [ASCIZ/
09900 %? PROGRAMS COMPILED WITH THE DEBUG-OPTION MUST NOT BE SHARABLE:
10000 RETRY WITH .SAVE INSTEAD OF .SSAVE/]
10100 JRST END
10200 SOJ NEWREG , ;INCREMENT NEWREG
10300 HRRI AC1 ,377777 ;LOAD FIRST LINK - WORD
10400 HRLI AC1 ,377777 ;FOR HEAP - DUMP
10500 MOVEM AC1 ,(NEWREG) ;DEPOSITE LINK - WORD
10600 HRRZ AC1 ,.JBFF ;GET HIGHEST LOC
10700 MOVEM AC1 ,RGSTRS ;OLD CORE-END BECOMES BEGIN OF DEBUG AREA
10800 ADDI AC1 ,DEBSIZE
10900 CORE AC1 , ;GET CORE FOR DEBUGGING
11000 HALT ;ERROR RETURN
11100 HRRZ AC1 ,RGSTRS
11200 MOVEI AC1 ,DEBSIZE(AC1)
11300 HRRM AC1 ,.JBFF
11400 PUSHJ TOPP ,SAVERG ;SAVE REGISTERS
11500 SETZM 0 ,STATUS ;LH='INIT', RH=PROG.BEGIN
11600 PUSHJ TOPP ,INIAPR ;
11700 PUSHJ TOPP ,DEBUG.
11800 POPJ TOPP ,
11900 ;
12000 ;*** PROCEDURE EXDEB.
12100 ; - ENTER THE DEBUG SYSTEM
12200 ;
12300 EXDEB.: PUSHJ TOPP ,SAVERG ;SAVE REGISTERS
12400 HRLI AC1 ,1 ;STATUS='STOP'
12500 HRR AC1 ,0(TOPP) ;RH=RETURNADDR
12600 SUBI AC1 ,1 ;RH=STOPADDR
12700 MOVEM AC1 ,STATUS
12800 PUSHJ TOPP ,DEBUG. ;CALL DEBUG
12900 POPJ TOPP ,
13000 ;
13100 ;*** AUXILIARY PROCEDURES OF THE DEBUG SYSTEM
13200 ;
13300 HALT.: JRST 0 ,HALT1 ;THIS ENTRY MUST BE 2 LOC.
13400 ;BEFORE DDTDB.
13500 ERRDB.: JRST 0 ,ERRDB1 ;THIS ENTRY MUST BE BEFORE DDTDB.
13600
13700 DDTDB.: PUSHJ TOPP ,SAVERG ;SAVE REGISTERS
13800 HRLI AC1 ,2 ;STATUS='DDT'
13900 HRR AC1 ,.JBOPC ;RETURNADDR
14000 MOVEM AC1 ,STATUS
14100 PUSHJ TOPP ,DEBUG. ;CALL DEBUG
14200 JRST 0 ,@.JBOPC ;RETURN TO PROGRAM
14300 ;*******************************************************************************
14400 HALT1: HRLI AC0 ,4 ;STATUS='HALT'
14500 SKIPA
14600 ERRDB1: HRLI AC0 ,3 ;STATUS='RUNTIME ERROR'
14700 HRRZ AC1 ,TOPP
14800 CAML AC1 ,RGSTRS ;ERROR IN DEBUG?
14900 JRST END
15000 MOVEM AC0 ,STATUS
15100 PUSHJ TOPP ,SAVERG ;SAVE REGISTERS
15200 PUSHJ TOPP ,DEBUG. ;CALL DEBUG
15300 JRST 0 ,END ;EXIT
15400 ;*******************************************************************************
15500 SAVERG: MOVEM AC0 ,@RGSTRS ;SAVE USER-REGISTERS
15600 MOVE AC0 ,AC1
15700 HRRZ AC1 ,RGSTRS
15800 MOVEM AC0 ,1(AC1)
15900 HRRI AC0 ,2(AC1)
16000 HRLI AC0 ,2
16100 BLT AC0 ,17(AC1)
16200 POPJ TOPP ,0
16300 ;*******************************************************************************
16400 INIAPR: MOVE AC1 ,[XWD -1, .GTLIM] ;ARGUMENT FOR GETTAB
16500 GETTAB AC1 , ;
16600 HALT ;ERROR RETURN
16700 TLNN AC1 ,200 ;TEST IF BATCH-JOB
16800 JRST NOTBAT ;NO
16900 TLZ AC1 ,777740 ;SET BITS 0-12 TO ZERO
17000 IMULI AC1 ,24 ;CONVERT JIFFIES TO MSEC
17100 MOVEM AC1 ,LIMIT ;STORE TIME LIMIT
17200 MOVEI AC1 ,21110 ;ARGUMENT FOR APRENB
17300 APRENB AC1 , ;ILL-MEM-REF + CLOCK-FLAG
17400 POPJ TOPP ,
17500 ;*******************************************************************************
17600 NOTBAT: MOVEI AC1 ,1 ;STORE,THAT THIS JOB IS
17700 HRLM AC1 ,STACKBO ;A TIMESSHARING-JOB
17800 MOVEI AC1 ,20110 ;ARGUMENT FOR APRENB
17900 APRENB AC1 , ;ILL-MEM-REF
18000 POPJ TOPP ,
18100 ;*******************************************************************************
18200 APRINT: MOVEM AC0 ,@RGSTRS ;SAVE AC0
18300 HRRZ AC0 ,.JBCNI ;GET REASON FOR INTERRUPT
18400 TRNE AC0 ,1000 ;TEST IF TIME INTERRUPT
18500 JRST TIMINT ;JUMP TO TIME-INTERRUPT-ROUTINE
18600 TRNE AC0 ,110 ;TEST IF ARITHMETIC OVERFLOW
18700 JRST OVERF. ;YES
18800 MOVE AC0 ,.JBTPC ;MOVE PC IN AC0
18900 OUTSTR [ASCIZ/
19000 %? ILLEGAL MEMORY REFERENCE/]
19100 JRST ERRDB1 ;AND JUMP TO ERRDEB1
19200 ;*******************************************************************************
19300 TIMINT: SETZ AC0 ,
19400 RUNTIM AC0 , ;GET RUNTIME
19500 SUB AC0 ,LIMIT ;
19600 JUMPGE AC0 ,TIMLIM ;IF THERE IS NOT ENOUGH TIME
19700 MOVEI AC0 ,21000 ;ARGUMENT FOR APRENB
19800 APRENB AC0 ,
19900 MOVE AC0 ,@RGSTRS ;RESTORE AC0
20000 JRSTF @.JBTPC ;JUMP BACK TO THE PROGRAM
20100 ;*******************************************************************************
20200 TIMLIM: OUTSTR [ASCIZ/
20300 %? TIME LIMIT EXCEEDED/]
20400 MOVE AC0 ,.JBTPC ;PC TO AC0
20500 JRST ERRDB1 ;JUMP TO ERRDEB1
20600 ;
20700 ;*** PROCEDURE DEBUG.
20800 ; - SAVE USER REGISTERS
20900 ; - PROVIDE PROGRAM STACK FOR DEBUG SYSTEM
21000 ; - ENTER DEBUG SYSTEM
21100 ; - RESTORE USER REGISTERS AND RETURN
21200 ;
21300 DEBUG.: MOVE AC1 ,RGSTRS ;GET DEBUG-REGISTERS
21400 MOVEI NEWREG ,DEBSIZE(AC1)
21500 MOVEI BASIS ,20(AC1)
21600 MOVEI TOPP ,1(BASIS)
21700 PUSHJ TOPP ,DEBUG ;DEBUG
21800 HRLZ 17 ,RGSTRS ;RESTORE USER-REGISTERS
21900 BLT 17 ,17
22000 POPJ TOPP ,
22100 ;
22200 ;*** FUNCTION SHRCOD
22300 ; - RETURN TRUE IF HIGH-SEGMENT IS
22400 ; SHARABLE, OTHERWISE FALSE
22500 ;
22600 SHRCOD: HRROI AC1 ,.GTSGN ;SEE IF HGH SEGM. IS SH.
22700 GETTAB AC1 , ; LOOK AT .GTSGN TABLE
22800 HALT ;ERROR RETURN
22900 LSH AC1 ,777736 ;SHIFT BIT 1 TO RIGHTMOST PLACE
23000 ANDI AC1 ,1 ;CLEAR THE OTHER BITS
23100 POPJ TOPP ,
23200 ;
23300 ;*** LITERALS
23400 ;
23500 LIT
23600 PRGEND
00100 TITLE WRTFNM *** PROCEDURES WRTFNM AND WRTSIX ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY WRTFNM
00700 ENTRY WRTSIX
00800 ;
00900 ;*** EXTERNAL REFERENCES ***
01000 ;
01100 ;
01200 ;*** REGISTER DEFINITION ***
01300 ;
01400 AC0= 0
01500 AC1= 1
01600 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01700 REG= REGIN+1
01800 REG1= REGIN+1+1
01900 REG2= REGIN+1+2
02000 REG3= REGIN+1+3
02100 REG4= REGIN+1+4
02200 REG5= REGIN+1+5
02300 REG6= REGIN+1+6
02400 NEWREG= 15
02500 TOPP= 17
02600 ;
02700 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
02800 ;
02900 FILPTR= 0
03000 FILEOF= 1
03100 FILEOL= 2
03200 FILOPN= 3
03300 FILLKP= 4
03400 FILENT= 5
03500 FILIN= 6
03600 FILOUT= 7
03700 FILCLS= 10
03800 FILSTA= 11 ;.+0 FOR FILESTATUS
03900 ;.+1 FOR DEVICE
04000 ;.+2 FOR POINTER TO BUFFERHEADER
04100 FILNAM= 14
04200 FILEXT= 15
04300 FILPRO= 16
04400 FILPPN= 17
04500 FILBFH= 20 ;BUFFER HEADER
04600 FILBTP= 21 ;BYTE POINTER
04700 FILBTC= 22 ;BYTE COUNT IN BUFFER
04800 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
04900 ;CTERS
05000 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
05100 ;R OF WORDS IN COMPONENT
05200 ;IF ASCII MODE : CHARACTERCNT IN LIN
05300 ;E AND TAB INDICATOR
05400 ;RH= ADDRESS OF FIRST WORD IN COMPONE
05500 ;NT
05600 FILCMP= 25 ;FIRST WORD OF COMPONENT
05700 ;
05800 ;*** START OF INVARIANT CODE ***
05900 ;
06000 RELOC 400000
06100 ;
06200 ;*** PROCEDURES WRTFNM AND WRTSIX
06300 ; - WRITE CURRENT FILENAME(WRTFNM)
06400 ; - WRITE SIXBIT-STRING(WRTSIX)
06500 ; - <REG>=FILE-BLOCK
06600 ; - <REG1>=SIXBIT-STRING
06700 ; - REG2=LENGTH
06800 ;
06900 WRTFNM: HRRI REG1 ,FILNAM(REG) ;ADDRESS OF FILENAME
07000 MOVEI REG2 ,6 ;CHARACTER COUNT
07100 WRTSIX: HRLI REG1 ,440600 ;SET UP BYTE POINTER
07200 ILDB REG3 ,REG1 ;GET NEXT CHARACTER
07300 ADDI REG3 ,40 ;CONVERT TO ASCII
07400 OUTCHR REG3
07500 SOJG REG2 ,.-3 ;MORE CHARACTERS ?
07600 MOVEI REG3 ,56 ;INSERT PERIOD
07700 OUTCHR REG3
07800 MOVEI REG2 ,3 ;TYPE EXTENSION
07900 ILDB REG3 ,REG1
08000 ADDI REG3 ,40
08100 OUTCHR REG3
08200 SOJG REG2 ,.-3 ;ALL THREE BYTES TRANSFERRED ?
08300 POPJ TOPP , ;RETURN
08400 ;
08500 ;*** LITERALS
08600 ;
08700 LIT
08800 PRGEND
00100 TITLE TMPTST *** PROCEDURE TMPTST ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY TMPTST
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 ;
01100 ;*** REGISTER DEFINITION ***
01200 ;
01300 AC0= 0
01400 AC1= 1
01500 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01600 REG= REGIN+1
01700 REG1= REGIN+1+1
01800 REG2= REGIN+1+2
01900 REG3= REGIN+1+3
02000 REG4= REGIN+1+4
02100 REG5= REGIN+1+5
02200 REG6= REGIN+1+6
02300 NEWREG= 15
02400 TOPP= 17
02500 ;
02600 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
02700 ;
02800 FILPTR= 0
02900 FILEOF= 1
03000 FILEOL= 2
03100 FILOPN= 3
03200 FILLKP= 4
03300 FILENT= 5
03400 FILIN= 6
03500 FILOUT= 7
03600 FILCLS= 10
03700 FILSTA= 11 ;.+0 FOR FILESTATUS
03800 ;.+1 FOR DEVICE
03900 ;.+2 FOR POINTER TO BUFFERHEADER
04000 FILNAM= 14
04100 FILEXT= 15
04200 FILPRO= 16
04300 FILPPN= 17
04400 FILBFH= 20 ;BUFFER HEADER
04500 FILBTP= 21 ;BYTE POINTER
04600 FILBTC= 22 ;BYTE COUNT IN BUFFER
04700 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
04800 ;CTERS
04900 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
05000 ;R OF WORDS IN COMPONENT
05100 ;IF ASCII MODE : CHARACTERCNT IN LIN
05200 ;E AND TAB INDICATOR
05300 ;RH= ADDRESS OF FIRST WORD IN COMPONE
05400 ;NT
05500 FILCMP= 25 ;FIRST WORD OF COMPONENT
05600 ;
05700 ;*** START OF INVARIANT CODE ***
05800 ;
05900 RELOC 400000
06000 ;
06100 ;*** PROCEDURE TMPTST
06200 ; - TEST IF FILE IS TEMPCORE-FILE
06300 ; - <REG>=FILE-BLOCK
06400 ;
06500 TMPTST: PUSH TOPP ,AC1 ;SAVE AC1
06600 MOVE AC1 ,FILSTA+1(REG) ;GET DEVICE MNEMONIC
06700 CAME AC1 ,[SIXBIT/DSK /] ;IS IT DSK?
06800 JRST OUT1 ;NO
06900 HRL AC1 ,FILNAM(REG) ;RIGHTMOST 3 OF FILNAM
07000 HLR AC1 ,FILEXT(REG) ;LEFTMOST 3 OF EXTENSION
07100 CAMN AC1 ,[SIXBIT/ TMP/] ;TEMP-FILE?
07200 JRST OUT ;YES - RETURN TO OLD PC
07300 OUT1: MOVE AC1 ,-1(TOPP) ;NO - RETURN TO OLD PC+1
07400 AOJ AC1 ,
07500 MOVEM AC1 ,-1(TOPP)
07600 OUT: POP TOPP ,AC1
07700 POPJ TOPP ,
07800 ;
07900 ;*** LITERALS
08000 ;
08100 LIT
08200 PRGEND
00100 TITLE ASTOSX *** PROCEDURE ASTOSX ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY ASTOSX
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 ;
01100 ;*** REGISTER DEFINITION ***
01200 ;
01300 AC0= 0
01400 AC1= 1
01500 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01600 REG= REGIN+1
01700 REG1= REGIN+1+1
01800 REG2= REGIN+1+2
01900 REG3= REGIN+1+3
02000 REG4= REGIN+1+4
02100 REG5= REGIN+1+5
02200 REG6= REGIN+1+6
02300 NEWREG= 15
02400 TOPP= 17
02500 ;
02600 ;*** START OF INVARIANT CODE ***
02700 ;
02800 RELOC 400000
02900 ;
03000 ;*** PROCEDURE ASTOSX
03100 ; - CONVERT ASCII- TO SIXBIT-STRING
03200 ; - <REG1>RH=ASCII-STRING
03300 ; - <AC1>RH=SIXBIT-STRING
03400 ; - REG5=LENGTH
03500 ;
03600 ASTOSX: HRLI REG1 ,440700 ;SET UP BYTE POINTER TO PICK
03700 ;UP ASCII STRING
03800 HRLI AC1 ,440600 ;
03900 NXTBYT: ILDB AC0 ,REG1 ;GET BYTE
04000 SUBI AC0 ,40 ;CONVERT TO SIXBIT
04100 IDPB AC0 ,AC1
04200 SOJG REG5 ,NXTBYT ;ALL BYTES TRANSFERRED ?
04300 POPJ TOPP ,
04400 ;
04500 ;*** LITERALS ***
04600 ;
04700 LIT
04800 PRGEND
00100 TITLE REAAUX *** PROCEDURES GETSGN, GETINT AND RTEST ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY GETSGN
00700 ENTRY GETINT
00800 ENTRY RTEST
00900 ;
01000 ;*** EXTERNAL REFERENCES ***
01100 ;
01200 EXTERN GETCH
01300 EXTERN CONERR
01400 ;
01500 ;*** REGISTER DEFINITION ***
01600 ;
01700 AC0= 0
01800 AC1= 1
01900 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02000 REG= REGIN+1
02100 REG1= REGIN+1+1
02200 REG2= REGIN+1+2
02300 REG3= REGIN+1+3
02400 REG4= REGIN+1+4
02500 REG5= REGIN+1+5
02600 REG6= REGIN+1+6
02700 NEWREG= 15
02800 TOPP= 17
02900 ;
03000 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
03100 ;
03200 FILPTR= 0
03300 FILEOF= 1
03400 FILEOL= 2
03500 FILOPN= 3
03600 FILLKP= 4
03700 FILENT= 5
03800 FILIN= 6
03900 FILOUT= 7
04000 FILCLS= 10
04100 FILSTA= 11 ;.+0 FOR FILESTATUS
04200 ;.+1 FOR DEVICE
04300 ;.+2 FOR POINTER TO BUFFERHEADER
04400 FILNAM= 14
04500 FILEXT= 15
04600 FILPRO= 16
04700 FILPPN= 17
04800 FILBFH= 20 ;BUFFER HEADER
04900 FILBTP= 21 ;BYTE POINTER
05000 FILBTC= 22 ;BYTE COUNT IN BUFFER
05100 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
05200 ;CTERS
05300 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
05400 ;R OF WORDS IN COMPONENT
05500 ;IF ASCII MODE : CHARACTERCNT IN LIN
05600 ;E AND TAB INDICATOR
05700 ;RH= ADDRESS OF FIRST WORD IN COMPONE
05800 ;NT
05900 FILCMP= 25 ;FIRST WORD OF COMPONENT
06000 ;
06100 ;*** START OF INVARIANT CODE ***
06200 ;
06300 RELOC 400000
06400 ;
06500 ;*** PROCEDURES GETSGN, GETINT AND RTEST
06600 ; - AUXILIARY FUNCTIONS FOR FORMATTED READ
06700 ;
06800 GTSGN: SKIPE FILEOF(REG) ;END-OF-FILE = TRUE
06900 POPJ TOPP , ;YES- RETURN
07000 PUSHJ TOPP ,GETCH ;GETS NEXT COMPONENT
07100 GETSGN: MOVE AC0 ,FILCMP(REG) ;GETS FIRST COMPONENT
07200 CAIN AC0 ," " ;LEADING BLANKS
07300 JRST GTSGN ;YES - OVERREAD THEM
07400 SETZ REG2 , ;FOR INTEGER VALUE
07500 SETZ REG3 , ;FOR SIGN
07600 CAIN AC0 ,"+" ;FIRST COMPONENT EQUAL PLUS ?
07700 JRST .+4 ;YES - GET NEXT COMPONENT
07800 CAIE AC0 ,"-" ;FIRST COMPONENT EQUAL MINUS ?
07900 POPJ TOPP , ;NO - RETURN
08000 MOVEI REG3 ,1 ;YES - SET SIGN BIT
08100 SKIPN FILEOL(REG) ;ENDOFLINE = TRUE ?
08200 PUSHJ TOPP ,GETCH ;NO - GET NEXT COMPONENT
08300 MOVE AC0 ,FILCMP(REG) ;FOR FOLLOWING PARTS TO AC0
08400 POPJ TOPP ,
08500
08600 GETINT: JFCL 10 ,.+1 ;CLAERS FLAGS
08700 GTINT: CAIG AC0 ,"9" ;COMPONENT IN DIGITS ?
08800 CAIGE AC0 ,"0"
08900 POPJ TOPP , ;NO - RETURN
09000 SUBI AC0 ,"0" ;CONVERTS ASCII TO INTEGER
09100 IMULI REG2 ,12 ;OLD INTEGER
09200 ADD REG2 ,AC0 ;ADD NEW ONE
09300 SKIPN FILEOL(REG) ;ENDOFLINE = TRUE ?
09400 PUSHJ TOPP ,GETCH ;NO - GET NEXT COMPONENT
09500 MOVE AC0 ,FILCMP(REG) ;AND GETS IT FOR FOLLOWING PARTS
09600 JRST GTINT ;GET NEXT DIGIT IF ANY
09700
09800 RTEST: CAIG AC0 ,"9" ;CARACTER IN DIGITS ?
09900 CAIGE AC0 ,"0"
10000 JRST CONERR ;NO - WRITE ERROR MESSAGE AND EXIT
10100 POPJ TOPP , ;YES - RETURN
10200 ;
10300 ;*** LITERALS ***
10400 ;
10500 LIT
10600 PRGEND
00100 TITLE SETEOF *** PROCEDURE SETEOF ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY SETEOF
00700 ;
00800 ;*** EXTERNAL REFERENCES ***
00900 ;
01000 ;
01100 ;*** REGISTER DEFINITION ***
01200 ;
01300 AC0= 0
01400 AC1= 1
01500 REGIN= 1 ;INITILISATION OF REGISTERSTACK
01600 REG= REGIN+1
01700 REG1= REGIN+1+1
01800 REG2= REGIN+1+2
01900 REG3= REGIN+1+3
02000 REG4= REGIN+1+4
02100 REG5= REGIN+1+5
02200 REG6= REGIN+1+6
02300 NEWREG= 15
02400 TOPP= 17
02500 ;
02600 ;*** DESCRIPTION OF PASCAL-FILEBLOCK (SEE PROCEDURE WRITEMC OF COMPILER) ***
02700 ;
02800 FILDAT= 1 ;FLAG TO TEST FOR TEXT-FILE
02900 FILBIN= 17 ;FLAG TO TEST FOR ASCII-MODE
03000 FILPTR= 0 ;LH= PASCAL FILE FLAGS
03100 ;RH= PTR TO COMPONENT
03200 FILEOF= 1
03300 FILEOL= 2
03400 FILOPN= 3
03500 FILLKP= 4
03600 FILENT= 5
03700 FILIN= 6
03800 FILOUT= 7
03900 FILCLS= 10
04000 FILSTA= 11 ;.+0 FOR FILESTATUS
04100 ;.+1 FOR DEVICE
04200 ;.+2 FOR POINTER TO BUFFERHEADER
04300 FILNAM= 14
04400 FILEXT= 15
04500 FILPRO= 16
04600 FILPPN= 17
04700 FILBFH= 20 ;BUFFER HEADER
04800 FILBTP= 21 ;BYTE POINTER
04900 FILBTC= 22 ;BYTE COUNT IN BUFFER
05000 FILLNR= 23 ;IF ASCII MODE - LINENR IN ASCIICHARA
05100 ;CTERS
05200 FILCNT= 24 ;LH= IF BINARY MODE : NEGATIVE NUMBE
05300 ;R OF WORDS IN COMPONENT
05400 ;IF ASCII MODE : CHARACTERCNT IN LIN
05500 ;E AND TAB INDICATOR
05600 ;RH= ADDRESS OF FIRST WORD IN COMPONE
05700 ;NT
05800 FILCMP= 25 ;FIRST WORD OF COMPONENT
05900 ;
06000 ;*** CONSTANTS ***
06100 ;
06200 MAXEOF= 10
06300 ;
06400 ;*** START OF INVARIANT CODE ***
06500 ;
06600 RELOC 400000
06700 ;
06800 ;*** PROCEDURE SETEOF
06900 ; - SET UP EOF-COUNTER
07000 ; - SET EOLN, CLEAR CHAR-COUNTER
07100 ; - RETURN TO USER
07200 ; - <REG>=FILE-BLOCK
07300 ;
07400 SETEOF: MOVNI AC0 ,MAXEOF ;INITIALIZE COUNT FOR
07500 ;MAXIMUM NUMBER OF ATTEMPTS
07600 MOVEM AC0 ,FILEOF(REG) ;TO READ BEYOND EOF
07700 MOVEI AC0 ," " ;INSERT BLANK
07800 MOVEM AC0 ,FILCMP(REG) ;INTO FILE-COMPONENT
07900 AOS FILEOL(REG) ;SET EOLN = TRUE
08000 HLR AC0 ,FILPTR(REG) ;TEXT-FILE?
08100 TRNN AC0 ,FILDAT ;SKIP IF NOT
08200 HRRZS FILCNT(REG) ;CLEARS CHARACTERCNT
08300 POPJ TOPP , ;RETURN
08400 ;
08500 ;*** LITERALS
08600 ;
08700 LIT
08800 PRGEND
00100 TITLE WRTAUX *** PROCEDURES WRTBLK, TOOSML, WRTSGN AND WRTOPN ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY WRTBLK
00700 ENTRY TOOSML
00800 ENTRY WRTOPN
00900 ENTRY WRTSGN
01000 ;
01100 ;*** EXTERNAL REFERENCES ***
01200 ;
01300 EXTERN PUTCH
01400 ;
01500 ;*** REGISTER DEFINITION ***
01600 ;
01700 AC0= 0
01800 AC1= 1
01900 REGIN= 1 ;INITILISATION OF REGISTERSTACK
02000 REG= REGIN+1
02100 REG1= REGIN+1+1
02200 REG2= REGIN+1+2
02300 REG3= REGIN+1+3
02400 REG4= REGIN+1+4
02500 REG5= REGIN+1+5
02600 REG6= REGIN+1+6
02700 NEWREG= 15
02800 TOPP= 17
02900 ;
03000 ;*** START OF INVARIANT CODE ***
03100 ;
03200 RELOC 400000
03300 ;
03400 ;*** PROCEDURES WRTBLK, WRTSGN, WRTOPN AND TOOSML
03500 ; - AUXLIARY FUNCTIONS FOR FORMATTED WRITE
03600 ;
03700 WRTBLK: JUMPLE REG2 ,.+4 ;WRITES BLANKES OUT
03800 MOVEI AC0 ," "
03900 PUSHJ TOPP ,PUTCH
04000 SOJG REG2 ,.-1 ;COUNT EQUAL ZERO?
04100 POPJ TOPP , ;YES - RETURN
04200
04300 WRTOPN: MOVEI REG5 ,(REG2) ;SAVES FORMAT BECAUSE REG2 IS USED FOR
04400 ;IDIVI-INSTRUCTION
04500 SETZ REG4 , ;RH - COUNT OF DIGITS ON PUSH-LIST
04600 ;LH - EQ 400000 IF SIGN = '-'
04700 JUMPGE REG1 ,OUT ;NEGATIV NUMBER?
04800 TLO REG4 ,400000 ;YES - SET SIGN MARKER
04900 TLNE REG1 ,377777 ;LH = 400000?
05000 JRST OK ;NO - GET MAGNITUDE
05100 TRNN REG1 ,777777 ;RH = 000000?
05200 JRST TOOSM1 ;FOR 400000000000B ONLY OCTAL
05300
05400 OK: SUBI REG5 ,1 ;ONE PLACE IN FORMAT USE FOR SIGN
05500 MOVM REG1 ,REG1
05600 OUT: POPJ TOPP ,
05700
05800 WRTSGN: TLZN REG4 ,400000 ;SIGN EQUAL '-'?
05900 POPJ TOPP , ;NO - RETURN
06000 MOVEI AC0 ,"-" ;YES
06100 JRST PUTCH ;PUTCH RETURNS OVER PUT
06200
06300 TOOSM1: POP TOPP ,AC0 ;DIRECT RETURN TO USER
06400 TOOSML: MOVEI AC0 ,"*" ;FORMAT IS TOO SMALL
06500 PUSHJ TOPP ,PUTCH
06600 SOJG REG5 ,.-1
06700 POPJ TOPP , ;RETURNS OUT OF WRITE-ROUTINE
06800 ;
06900 ;*** LITERALS
07000 ;
07100 LIT
07200 PRGEND
00100 TITLE FORER. *** PROCEDURE FORER. ***
00200 TWOSEG
00300 ;
00400 ;*** ENTRY-POINTS ***
00500 ;
00600 ENTRY FORER.
00700 ;
00800 ;*** START OF INVARIANT CODE ***
00900 ;
01000 RELOC 400000
01100 ;
01200 ;*** FORTRAN ERROR-EXIT
01300 ;
01400 FORER.: OUTSTR [ASCIZ/
01500 %? ERROR IN FORTRAN PROCEDURE/]
01600 EXIT
01700 ;
01800 ;*** LITERALS ***
01900 ;
02000 LIT
02100 PRGEND
02100 END