image of READY prompt

Wang2200.org

Listing of file='IPL-DATE' on disk='vmedia/701-2049C.wvd.zip'

# Sector 28, program filename = 'IPL-DATE'
0010 REM IPL-DATE,00-00(02/18/76),12003A - COPYRIGHT WANG LABS. INC., 1976
0060 COM Q1$8,Q1,S,S1
   : DIM Q6$64,W$8,W3$3,W4$1,W$(3)8,Q4(3),Q5(3)
   : DIM U9$8,U8$64
   : DATA LOAD DC OPEN T#0,"MEMORY"
   : DATA LOAD DC S,Q1$,Q1,S1
   : DATA SAVE DC CLOSEALL
   : PRINT HEX(03)
   : GOSUB '220("ENTER TODAY'S DATE AS MM/DD/YY.")
   : Q1$=U9$
   : Q1=U9
0200 DATA LOAD DC OPEN T#0,"MEMORY"
   : DATA SAVE DC #0,S,Q1$,Q1,S1
   : DATA SAVE DC CLOSEALL
   : LOAD DC T#0,"START"
0290 DEFFN'220(U8$)
0300 GOSUB '243(U8$,8)
   : GOSUB '221(Q6$)
   : IF Q6$="E"THEN 300
   : GOSUB '223(U9)
   : GOSUB '248(1,0,3)
   : PRINT "IS DATE OK?   (Y/N)",U9$,U9
0360 GOSUB '244(1)
   : IF Q6$="N"THEN 290
   : IF Q6$<>"Y"THEN 360
   : RETURN
0410 DEFFN'221(Q6$)
   : U9$=Q6$
   : IF Q6$=" "THEN 750
   : IF POS(Q6$="/")-1<>NUM(Q6$)THEN 750
   : CONVERT STR(Q6$,1,NUM(Q6$))TO U8
   : IF U8<1THEN 750
   : IF U8>12THEN 750
   : STR(Q6$,1)=STR(Q6$,POS(Q6$="/")+1)
   : IF POS(Q6$="/")-1<>NUM(Q6$)THEN 750
   : CONVERT STR(Q6$,1,NUM(Q6$))TO U6
0520 IF U6<1THEN 750
   : IF U6>31THEN 750
   : STR(Q6$,1)=STR(Q6$,POS(Q6$="/")+1)
   : IF NUM(Q6$)<>64THEN 750
   : CONVERT Q6$TO U0
   : U7=(1-SGN(U0-INT(U0/4)*4))*SGN((U8-1)*(U8-2))
   : ON U8GOTO 720,700,690,680,670,660,650,640,630,620,610,600
0600 U7=U7+30
0610 U7=U7+31
0620 U7=U7+30
0630 U7=U7+31
0640 U7=U7+31
0650 U7=U7+30
0660 U7=U7+31
0670 U7=U7+30
0680 U7=U7+31
0690 U7=U7+28
0700 U7=U7+31
0720 U9=U7+U6+U0*1000
   : RETURN
0750 Q6$="E"
   : RETURN
0780 DEFFN'222(U8$)
   : GOSUB '245(U8$,5,0)
   : GOSUB '223(Q9)
   : GOSUB '221(U9$)
   : GOSUB '248(1,0,3)
   : PRINT "IS DATE OK?   (Y/N)",U9$,U9
0840 GOSUB '244(1)
   : IF Q6$="N"THEN 780
   : IF Q6$<>"Y"THEN 840
   : RETURN
0890 DEFFN'223(U9)
   : U1=INT(U9/1E3)
   : U2=U9-U1*1E3
   : U3=1-SGN(U1-INT(U1/4)*4)
   : IF U2<=334+U3THEN 1010
   : U4=U2-334-U3
   : U5=12
   : GOTO 1540
1010 IF U2<=304+U3THEN 1060
   : U4=U2-304-U3
   : U5=11
   : GOTO 1540
1060 IF U2<=273+U3THEN 1110
   : U4=U2-273-U3
   : U5=10
   : GOTO 1540
1110 IF U2<=243+U3THEN 1160
   : U4=U2-243-U3
   : U5=9
   : GOTO 1540
1160 IF U2<=212+U3THEN 1210
   : U4=U2-212-U3
   : U5=8
   : GOTO 1540
1210 IF U2<=181+U3THEN 1260
   : U4=U2-181-U3
   : U5=7
   : GOTO 1540
1260 IF U2<=151+U3THEN 1310
   : U4=U2-151-U3
   : U5=6
   : GOTO 1540
1310 IF U2<=120+U3THEN 1360
   : U4=U2-120-U3
   : U5=5
   : GOTO 1540
1360 IF U2<=90+U3THEN 1410
   : U4=U2-90-U3
   : U5=4
   : GOTO 1540
1410 IF U2<=59+U3THEN 1460
   : U4=U2-59-U3
   : U5=3
   : GOTO 1540
1460 IF U2<=31THEN 1510
   : U4=U2-31
   : U5=2
   : GOTO 1540
1510 U4=U2
   : U5=1
1540 CONVERT U5TO STR(U9$,1,2),(##)
   : CONVERT U4TO STR(U9$,4,2),(##)
   : CONVERT U1TO STR(U9$,7,2),(##)
   : STR(U9$,3,1),STR(U9$,6,1)="/"
   : RETURN
1600 DEFFN'224(Q9)
   : U2=INT(365.25*(INT(Q9/1E3)-1))+Q9-INT(Q9/1E3)*1E3
   : Q9=INT((U2)/365.25)
   : Q9=Q9*1E3+(U2-INT(365.25*Q9))+1E3
   : RETURN
1660 DEFFN'225(U1,U2)
   : U3=INT(365.25*(INT(U2/1E3)-1))+U2-INT(U2/1E3)*1E3
   : U3=U3-(INT(365.25*(INT(U1/1E3)-1))+U1-INT(U1/1E3)*1E3)
   : RETURN
1710 DEFFN'242(W0,Q6$)
   : IF W0<=0THEN 1760
   : IF W0=1THEN 1750
   : STR(Q6$,2)=STR(Q6$,1,W0-1)
1750 PRINT Q6$;
1760 RETURN
1780 DEFFN'243(Q6$,Q0)
   : GOSUB 2230
1800 SELECT CO 205
   : Q6$=" "
   : INPUT Q6$
   : IF Q0=0THEN 2300
   : IF LEN(Q6$)<=Q0THEN 2300
   : GOSUB 2200
1870 DEFFN'244(Q0)
   : GOSUB 2280
   : GOSUB 2250
   : GOTO 1800
1920 DEFFN'245(Q6$,Q2,Q3)
   : Q0=ABS(Q2)+Q3+1
   : GOSUB 2230
1950 IF ABS(Q2)+ABS(Q3)=0THEN 1990
   : GOSUB '242(ABS(Q2)+2,HEX(09))
   : PRINT "/"
   : GOTO 2000
1990 PRINT ,," "
2000 GOSUB 2280
   : SELECT CO 205
   : Q9,W0=-1E-99
   : INPUT Q9
   : IF W0=Q9THEN 2080
   : IF ABS(Q2)+Q3=0THEN 2180
   : IF Q9>=0THEN 2150
   : IF Q2<=0THEN 2150
2080 GOSUB 2200
2100 DEFFN'246(Q2,Q3)
   : Q0=ABS(Q2)+Q3+1
   : GOSUB 2280
   : GOSUB 2250
   : GOTO 1950
2150 IF ABS(Q9)>=10^ABS(Q2)THEN 2080
   : W0=ABS(Q9*10^Q3)
   : IF INT(W0)<>W0THEN 2080
2180 GOSUB '248(3,0,1)
   : RETURN
2200 GOSUB '248(3,0,1)
   : PRINT "RE-ENTER"
   : RETURN
2230 SELECT PRINT 005(64),CO 005
   : PRINT HEX(010A);STR(Q6$,1);
2250 SELECT PRINT 005(64),CO 005
   : GOSUB '242(Q0+2,"-")
   : PRINT TAB(64)
2280 PRINT HEX(010A0A)
   : RETURN
2300 PRINT HEX(0A);TAB(64)
   : SELECT PRINT 005(64),CO 005
   : RETURN
2340 DEFFN'248(Q6,Q7,Q8)
   : GOSUB 2480
   : IF Q8<1THEN 2450
   : GOSUB 2450
   : SELECT PRINT 205
   : Q6$=" "
   : PRINT STR(Q6$,Q7+1)
   : IF Q8<2THEN 2450
   : FOR W0=2TO Q8
   : PRINT HEX(0A);STR(Q6$,1)
   : NEXT W0
2450 PRINT HEX(01)
   : GOSUB '242(Q7,HEX(09))
   : GOSUB '242(Q6,HEX(0A))
2480 SELECT PRINT 005(64),CO 005
   : RETURN